.NLIST .INCLUDE /ASCII.MAC/ .INCLUDE /HWDF.MAC/ .INCLUDE /DSMAC.MAC/ .INCLUDE /MYMAC.MAC/ .LIST MODULE NAME=, VER=<01>, COMM=, TYPE= .NLIST .INCLUDE /XXDPCM.MAC/ .INCLUDE /XXDPDF.MAC/ .LIST FROM DRIVER IMPORT X$XDRV, DR$TRA FROM DRIVER IMPORT SETPRM, LOOKUP FROM MEND IMPORT X$XTOP EXPORT QUALIFIED BEGIN EXPORT QUALIFIED NRDIR EXPORT QUALIFIED RESTRT EXPORT QUALIFIED SAV04, RST04, RESR5, RESR7 EXPORT QUALIFIED BCLEAR, BMOVE, CLRBUF EXPORT QUALIFIED TXNAM, CMPNAM EXPORT QUALIFIED CHROUT, TAB, MES EXPORT QUALIFIED BCDCV, DATUPK, ITOA, UPKNAM, UNPACK, UPACK1 EXPORT QUALIFIED READBK, BKREAD, NXTBLK EXPORT QUALIFIED DELAY EXPORT QUALIFIED DEVERR, EOMERR, FLNOTF, INVCMD EXPORT QUALIFIED RELCNT EXPORT QUALIFIED CRLF EXPORT QUALIFIED FSTMOD, PIPFLG EXPORT QUALIFIED $IDDB EXPORT QUALIFIED $TPNM1, $TXNAM, $BUF, $BUF2, BUF EXPORT QUALIFIED DIRECT EXPORT QUALIFIED D$RUNI ZERO =: ^O<0> .SBTTL Sizer, Monitor relocator and others goodies ; .ASECT ; .=^O<1000> .PSECT XXDP0 BEGIN: ; ; Init engine ; PROCEDURE BEGIN BEGIN LET SP := #SPBOT ; Setup stack LET CURDRV := D$RUNI ; Size Core LET V.TR4 := #30$ ; Point timeout trap to 30$ LET R0 := #-4000 ; Determine top of core in 1k chunks LET R1 := #0 ; Start address REPEAT LET R0 := R0 + #4000 LET (R0) := (R0) + #ZERO ; Reference unknown loc. LET R1 := R1 + #1 ; If here, no trap occured. UNTIL #^D<28> EQ R1 ; Until done 28 times LET R0 := R0 + #4000 20$: LET V.TR4 := #V.TR4+2 ; Restore error trap, IF R1 GE #^D<8> GOTO 40$ ; Branch, if 8K or greater JSR R5, MES ; Insufficient core message. .WORD NOMEM ; |INSUFFICIENT CORE| HALT LOOP ; Lock in halt END 30$: ; Trapped to here, exit to 20$ LET TOP := #20$ RTI 40$: ; Ready to type core size LET R1 := R1 L.SHIFT 1 ; kwords * 2 LET AK :B= KCODE(R1) LET AK+1 :B= KCODE+1(R1) LET R0 := R0 - LIMIT+2 ; Set up new load address LET R1 := R0 LET RELCNT := R1 ; Save it at RELTMP ; Update the literals of Resident Monitor LET R2 := #$LITTB WHILE #^O<-1> NE (R2) DO ; while not end of table.. LET @(R2)+ := @(R2)+ + R1 ; Correct for relocation END LET R1 := #0 ; Where program starts LET R2 := LIMIT+2 ; Where program ends REPEAT ; Relocate monitor to top of core LET (R0)+ :B= (R1)+ ; Relocate one byte at a time LET R2 := R2 - #1 ; One byte less UNTIL RESULT IS EQ ; Until done JSR R5, MES ; Type Title and core size .WORD NAME ; |DZQUD-E 21-JUL-76 RKDP - XXDP RK11 MONITOR xx K| JSR R5, MES ; Type restart addres .WORD ARSTRT ; |RESTART ADDR:| LET R3 := $COMC3 ; -> COMCO3 CALL ITOA ; Show num as OCTAL JSR R5, MES ; Show AsciZ string .WORD BOOTDV ; |BOOTED VIA UNIT#: | LET R3 := D$RUNI JSR R5, BCDCV ; Show N digits of Decimal .WORD 1 ; 1 digit JSR R5, MES ; Type for help message .WORD FHELP ; |TO ABORT THE FOLLOWING HELP MESSAGE TYPE CTRL C (^C)| JSR R5, MES ; Type for help message .WORD MNINST CALL DELAY ; Wait a bit LET PC := $COMC3 ; Goto resident monitor END BEGIN LIMIT: ; .LIMIT ; Still under construction .WORD X$XBEG ; Instead of .LIMIT .WORD X$XTOP KCODE: .ASCII | 0 1 2 3 4 5 6 7 8 9| .ASCII |10111213141516171819| .ASCII |202122232425262728| NAME: .ASCII |DZQUD-E 21-JUL-76 RKDP - XXDP RK11 MONITOR | AK: .ASCIZ | K| ARSTRT: .ASCIZ |RESTART ADDR:| BOOTDV: .ASCIZ |BOOTED VIA UNIT#: | NOMEM: .ASCIZ |INSUFFICIENT CORE| FHELP: .ASCIZ |TO ABORT THE FOLLOWING HELP MESSAGE TYPE CTRL C (^C)| MNINST: .ASCII .ASCII |TYPE:| .ASCII |F TO SET CONSOLE FILL COUNT| .ASCII |D FOR DIRECTORY ON CONSOLE, OR| .ASCII |D/F FOR SHORT DIRECTORY ON CONSOLE, OR| .ASCII |D/L FOR DIRECTORY ON LINE PRINTER, OR| .ASCII |D/L/F FOR SHORT DIRECTORY ON LINE PRINTER,| .ASCII |R COPY TO RUN COPY PROGRAM,| .ASCII |R FILENAME TO RUN ANY OTHER PROGRAM.| .ASCII |L FILENAME TO LOAD A PROGRAM ONLY| .ASCII |S TO START THE PROGRAM JUST LOADED,| .ASCII |S ADDR TO START THE PROGRAM AT SPECIFIC ADDRESS| .ASCII |C FILENAME TO RUN A CHAIN,| .ASCII |C FILENAME/QV TO RUN A CHAIN IN QUICK VERIFY MODE.| .ASCIZ |REFER TO XXDP USER MANUAL MD-11-DZQXA FOR ADDITIONAL HELP.| $LITTB: .WORD $REL1 .WORD $REL2 .WORD $REL3 .WORD $REL4 .WORD $REL4+2 .WORD $REL5 .WORD $REL5+2 .WORD $REL6 .WORD $REL6+2 .WORD $REL7 .WORD $REL10 .WORD $REL11 .WORD $REL12 .WORD $REL13 .WORD $REL14 .WORD $REL15 .WORD $REL16 .WORD $COMC3 .WORD $REL0 .WORD GETINO .WORD LOAD4 .WORD $BUF .WORD $BUF2 .WORD $TXNAM .WORD $IDDB .WORD -1 B.LKB <^O<10176-2774>> ; 2774..10176 .SBTTL Non-resident code .PSECT XXDP1 X$XBEG: ; ; Directory routine ; PROCEDURE NRDIR BEGIN ; POP off 1st stack element ; Get fill count ; Get the current drive number ; Get res monitor restart address ; Get KYBD pointer POP <, FILLCT, CURDRV, $COMC3, KBPTR> LET R2 := #0 ; For device set routine CALL SETI ; Set input. No name. LET FSTMOD :B= #0 ; Assume no fast mode switch CALL NRGTSW ; Get switches JSR R5, BCLEAR ; Clear name to ?'s .WORD INDEV+XXNAM .WORD '? .WORD FILNMS LET XFLMOD(R5) := R5 ; File mode indicator - indicate wild mode LET K10266 := #0 ; ?? CALL @DRT(R5) ; Go output directory RETURN END NRDIR K10266: .WORD 0 FSTMOD: .BYTE 0 E.VEN PROCEDURE SETFST BEGIN LET FSTMOD :B= FSTMOD + #1 ; Set fast mode GOTO NRGTSW END SETFST PROCEDURE NRGTSW BEGIN LET R1 := #NRSWTB ; Point to non-resident switch table JUMPTO GTOKK ; Go set switches END NRGTSW PROCEDURE LPSW BEGIN LET MREG := ALPS ; Change status reg LET MOUT := ALPB ; Change buffer reg LET FILLCT := FILLCT SET.BY #200 ; Make fillcount negative LET R2 := #FF ; Output a form feed done CALL DELAY ; Wait for form feed done GOTO NRGTSW ; See about other switches END LPSW ALPS: ; Line printer stat reg addr .WORD LPS ALPB: ; Line printer buffer reg addr .WORD LPB NRSWTB: $DEF <|/F|>, SETFST ; Definition for /F $DEF <|/L|>, LPSW ; Definition for /L $DEF <>, RTSPC ; Definition for CR $DEF <| |>, GTOK ; Definition dor SPACE $END PROCEDURE $TPNM1 BEGIN JSR R4, SAV04 ; Save regs 0-4 LET R3 := $TXNAM ; Addr of name to R3 LET R1 := #0 ; Char counter 10$: REPEAT REPEAT LET R2 :B= (R3)+ ; Get char 20$: CALL MES1 ; Type it LET R1 := R1 + #1 ; Up char count UNTIL R1 HIS #6 ; Until done 6 IF RESULT IS LOS THEN ; if no more 6 (exactly 6!) LET R2 :B= #'. ; Six - type a dot GOTO 20$ ; go type the dot END UNTILB R1 HIS #^D<10> ; Until done 10 CALL RST04 ; Restore regs 0-4 JUMPTO TAB ; Go TAB and return END $TPNM1 ; ; Show HT ; PROCEDURE TAB BEGIN JSR R5, MES ; Show AsciZ string .WORD AHT ; RETURN END TAB AHT: .ASCIZ .SBTTL Binary to decimal convert and type subroutine ; ; Show N digits of Decimal ; PROCEDURE BCDCV BEGIN JSR R4, SAV04 ; Save regs 0-4 LET R4 := (R5)+ ; Number of digits LET R0 := #DECTAB ; Table of decimal numbers PUSH #0 ; Stack word for indicator REPEAT TST -(R0) ; Step to largest digit LET R4 := R4 - #1 UNTIL RESULT IS LE LOOP LET R2 := #0 ; R2 is to receive the quotient LET R1 := (R0)+ ; The divisor IF RESULT IS EQ LEAVE LOOP ; Exit if zero LOOP LET R3 := R3 - R1 ; Divide by substracting IF RESULT IS LO LEAVE LOOP LET R2 := R2 + #1 ; Up the quotient after each sub END LET R3 := R3 + R1 ; Gone too far IF R2 EQ #0 AND (SP) EQ #0 THEN ; If quotient = 0 and leading zero's LET R2 := #SPACE ; Then print space ELSE ; Else LET TOP := TOP + #1 ; No more leading zero's LET R2 := R2 + #'0 ; Make it ASCII END CALL CHROUT ; Print it END POP ; Pop indicator word IF RESULT IS EQ THEN ; If zero then it was 0 converting LET R2 := #'0 ; Set ASCII 0 CALL CHROUT ; And type it END JUMPTO RESR5 ; Go restore regs 0-4 and do RTS R5 END BCDCV .WORD ^D<10000> .WORD ^D<1000> .WORD ^D<100> .WORD ^D<10> .WORD ^D<1> DECTAB: .WORD 0 ; end flag .SBTTL Date unpack and type subroutine ; ; Show Date ; PROCEDURE DATUPK BEGIN JSR R4, SAV04 ; Save them LET R4 := #^D<69> ; Base year is 1970 LET R3 := R3 OFF.BY #100000 ; get rid of config bit REPEAT LET R4 := R4 + #1 ; See! LET R3 := R3 - #^D<1000> ; Find what year UNTIL RESULT IS LE LET R3 := R3 + #^D<1000> ; Went too far LET DATTAB+2 := #^D<28> ; Assume lean year IF #3 OFF.IN R4 THEN ; If leap year LET DATTAB+2 := DATTAB+2 + #1 ; then correct for FEB END LET R0 := #DATTAB ; Go find what month WHILE R3 GT (R0) DO ; While greather than what this mon has LET R3 := R3 - (R0)+ ; Advance month END JSR R5, BCDCV ; Print out day first .WORD 2 LET 10$ := AMNTHS-DATTAB(R0) ; Point to month name JSR R5, MES ; And print it 10$: .WORD 0 LET R3 := R4 ; Now the year JSR R5, BCDCV ; Print that out .WORD 2 JUMPTO RESR7 ; Go restore regs 0-4 and do RETURN END DATUPK DATTAB: .WORD ^D<31> .WORD ^D<28> .WORD ^D<31> .WORD ^D<30> .WORD ^D<31> .WORD ^D<30> .WORD ^D<31> .WORD ^D<31> .WORD ^D<30> .WORD ^D<31> .WORD ^D<30> .WORD ^D<31> AMNTHS: .WORD $JAN .WORD $FEB .WORD $MAR .WORD $APR .WORD $MAY .WORD $JUN .WORD $JUL .WORD $AUG .WORD $SEP .WORD $OCT .WORD $NOV .WORD $DEC $JAN: .ASCIZ |-JAN-| $FEB: .ASCIZ |-FEB-| $MAR: .ASCIZ |-MAR-| $APR: .ASCIZ |-APR-| $MAY: .ASCIZ |-MAY-| $JUN: .ASCIZ |-JUN-| $JUL: .ASCIZ |-JUL-| $AUG: .ASCIZ |-AUG-| $SEP: .ASCIZ |-SEP-| $OCT: .ASCIZ |-OCT-| $NOV: .ASCIZ |-NOV-| $DEC: .ASCIZ |-DEC-| E.VEN ; ; Show Directory ; PROCEDURE DIRECT BEGIN IFB FSTMOD EQ #0 JSR R5, MES ; Show AsciZ string .WORD AHEAD ; |ENTRY#||FILNAM.EXT|| DATE||LENGTH||START| END 10$: LOOP CALL LOOKUP ; Call driver LEAVE LOOP ; exit on ?error? CALL CRLF LET R3 := XFLCNT(R5) ; File count CALL ITOA ; Show num as OCTAL CALL TAB ; Show HT CALL $TPNM1 ; ?File Name? IFB FSTMOD NE #0 GOTO 10$ LET R3 := XSVDAT(R5) ; ?Date? CALL DATUPK ; Show Date IF XSVDAT(R5) MI #0 THEN ; ?Contiguous file? LET R2 :B= #'C CALL CHROUT ; Output char END IFB FSTMOD NE #0 GOTO 10$ CALL TAB ; Show HT LET R3 := XBKLGT(R5) ; ?Length? JSR R5, BCDCV ; Show N digits of Decimal .WORD 4 CALL TAB ; Show HT LET R3 := X1STBK(R5) ; ?Start? CALL ITOA ; Show num as OCTAL END RETURN END DIRECT AHEAD: .ASCIZ |ENTRY#||FILNAM.EXT|| DATE||LENGTH||START| E.VEN .SBTTL Chain buffer RUNBUF: B.LKW <^D<256>> .SBTTL Command decoder, ini and delay routines ; Program stack R6STCK: B.LKW <^D<20>> SPBOT: ; ; End of pass chain mode entry point ; PROCEDURE RESTRT BEGIN PUSH <#0, (PC)+> ; Clear T-bit, will return to 10$ $REL11: .WORD 10$ RTI 10$: CALL CROUT2 ; Check for CtrlC IF @#SY.EXI EQ #0 GOTO COMCON ; If zero - abort current program IFB QVMODE NE #0 GOTO COMCON ; If non zero - quick verify mode LET (PC)+ := (PC)+ - #1 ; Decrement pass counter PCOUNT: .WORD 0 IF RESULT IS EQ GOTO COMCON ; If zero - all pass done RETURN ; If non zero - return to current program END RESTRT ; ; Error reporting routine ; PROCEDURE COMCO1 BEGIN CALL DELAY ; Wait a bit JSR R4, SAV04 ; Save regs 0-4 LET R0 := R5 ; Get addr of ASCIZ message JSR R5, MESO ; Type error message IFB RUNID NE #0 GOTO COMCON ; Goto, if it was RUN command LET PC := (PC)+ ; Go to COMCO3 $COMC3: .WORD COMCO3 END COMCO1 ; ; Chain mode is cleared here ; PROCEDURE COMCO3 BEGIN LET (PC)+ := #0 ; Clear chain nide CHN: ; Chain mode indicator .WORD 0 $GOTO COMCON END COMCO3 ; ; Where everithing starts ; PROCEDURE COMCON BEGIN LOOP LET SP := (PC)+ ; Set up the ctack $REL0: .WORD SPBOT JSR R5, BCLEAR ; Clear buffers, variables $REL1: .WORD CLRBEG .WORD 0 .WORD CLREND-CLRBEG JSR R5, MES ; Type a dot first .WORD ADOT JSR R5, INPUT ; Go fetch a command CALL GTOK ; Check command syntax END ; Till everything is done END COMCON ; ; Delay a little bit ; PROCEDURE DELAY BEGIN REPEAT LET #0 := #0 - #1 UNTIL RESULT IS EQ $GOTO RTSPC ; Done. RETURN END DELAY ; ; Done. RETURN ; PROCEDURE RTSPC BEGIN RETURN END RTSPC .SBTTL Chain setup routine ; ; Chain setup routine ; PROCEDURE DOIT BEGIN LET (PC)+ := #0 ; At first block, also clears BKCT: ; Contains chain block # .BYTE 0 QVMODE: ; Quick verify indicator .BYTE 0 LET INDEV+XXNAM+6 := #"CC ; Set up a CCC extension LET INDEV+XXNAM+6+2 :B= #'C CALL SETIN ; Set input device. Name needed CALL GTSW ; Get switches JSR R5, BMOVE ; Copy input DDB to batch DDB $REL6: .WORD BTCDDB+XFLMOD ; XFLMOD ?? XWCTR ?? .WORD INDEV+XFLMOD ; XFLMOD ?? XWCTR ?? .WORD DDB.LN-2 ; DDB.LN-2 ?? $GOTO DO1 END DOIT PROCEDURE DO1 BEGIN LET BKCT :B= BKCT + #1 ; Want first block of file $GOTO DO2 END DO1 PROCEDURE DO2 BEGIN PUSH R5 ; Save R5 JSR R5, BMOVE ; Batch DDB to input DDB $REL5: .WORD INDEV+XFLMOD .WORD BTCDDB+XFLMOD .WORD DDB.LN-2 JSR R4, SAV04 ; Save regs 0-4 CALL INITI ; Init input CALL RST04 ; Restore regs 0-4 LET R3 :B= BKCT ; Get the required block number LET BKCT :B= #0 REPEAT CALL READL ; Read linked file block JSR R5, BMOVE ; Input buffer to batch buffer $REL4: .WORD RUNBUF .WORD BUF .WORD <^D<256*2>> $REL13 =: .+2 LET CHN := #RUNBUF+2 ; Set chain mode with addre of 1st char LET BTCDDB+XNB := #^D<510> ; # of characters in buffer LET BKCT :B= BKCT + #1 ; Increment # of blocks read LET R3 := R3 - #1 UNTIL RESULT IS EQ ; Until read the wanted block POP R5 ; Restore R5 $GOTO RCKSUM END DO2 PROCEDURE RCKSUM BEGIN LET (PC)+ := #0 ; Checksum the batch buffer RCKSM: .WORD 0 LET R3 := (PC)+ ; Get addr of batch buffer $REL12: .WORD RUNBUF LET R4 := #^D<256> ; Will do 256 words REPEAT LET RCKSM := RCKSM + (R3)+ ; Checksum a word LET R4 := R4 - #1 ; One word less UNTIL RESULT IS EQ ; Until all done RETURN ; Return END RCKSUM .SBTTL Chain execution routine ; ; Chain execution routine ; PROCEDURE CHAIN BEGIN IF R0 EQ R1 THEN ; If at start of KYBD buffer PUSH RCKSM ; Save checksum CALL RCKSUM ; Rechecksum the buffer AND RCKSM NE (SP)+ THEN ; And checksum is matched PUSH ; Save chain mode indicator and last block # allocated CALL DO2 ; Get th block POP ; Restore chain mode indicator and last block # allocated END LOOP LET R3 := CHN ; Next command LET R4 := BTCDDB+XNB ; Count 10$: LET R4 := R4 - #1 IF RESULT IS PL LEAVE LOOP ; Exit if positive CALL DO1 ; Else - need new buffer END LET R2 :B= (R3)+ ; Get a byte IF RESULT IS EQ GOTO COMCO3 ; Back to COMCO3 IFB R2 EQ #LF GOTO 10$ ; If line feed - disregard it LET CHN := R3 ; Save chain mode indicator LET BTCDDB+XNB := R4 ; And last block # allocated RETURN ; Return END CHAIN .SBTTL Command processor PROCEDURE SETCNT BEGIN CALL ATOI ; Get the count LET INDEV+XWCTR := R2 ; Store it GOTO GTSW END SETCNT ; ; Set QV mode ; PROCEDURE SETQV BEGIN LET QVMODE :B= QVMODE + #1 ; Set QV mode $GOTO GTSW END SETQV PROCEDURE GTOK BEGIN ENTRY GTSW LET R1 := #COMTAB ; Device decoding comes heare $GOTO GTOKK END GTOK PROCEDURE GTOKK BEGIN LET R2 := RELCNT ; Get relocation factor LET R1 := R1 + R2 ; Correcto R1 for relocation REPEAT LET R0 := KBPTR ; Get string pointer LET R4 := (R1)+ ; Get dispatch address LET R3 := (R1)+ ; Get pointer to next entry REPEAT IFB (R0)+ NE (R1)+ GOTO 10$ ; If does not match character UNTILB (R1) EQ #0 ; Until last chr in entry LET KBPTR := R0 ; Save string pointer LET R4 := R4 + R2 ; Correct for relocation LET R2 := #0 JUMPTO (R4) ; Dispatch where needed 10$: LET R1 := R3 + R2 ; Point to next entry and correct for relocation UNTIL #-1 EQ (R1) ; Until not filled $GOTO INVCMD ; Report invalid command/sw END GTOKK .SBTTL Message routines ; ; Report invalid command/sw ; PROCEDURE INVCMD BEGIN JSR R5, COMCO1 ; Error reporting routine .ASCIZ |INVCMD/SW| END INVCMD ; ; Show AsciZ string ; PROCEDURE MES BEGIN JSR R4, SAV04 ; Save regs 0-4 LET R0 := (R5)+ + (PC)+ ; Message buffer to R0 and correct for relocation RELCNT: ; Relocation factor .WORD 0 $GOTO MESO END MES PROCEDURE MESO BEGIN LOOP LET R2 :B= (R0)+ ; Pick up one char to R2 IF RESULT IS EQ GOTO GEX04 ; Until 0 - go to restore regs 0-4, do RTS R5 CALL MES1 ; Go output char END ; gor for more END MESO PROCEDURE MES1 BEGIN IFB R2 EQ #CR GOTO OUTCR ; If CR - output with filler char IFB R2 NE #HT GOTO CHROUT ; If non HT - output char $GOTO TBASSP ; If HT - output as SPACEs END MES1 ; ; TAB subroutine - spaces do the tabbing ; PROCEDURE TBASSP BEGIN REPEAT LET R2 := #SPACE ; Spaces do the tabbing CALL CHROUT ; Output a space LET CHRCNT :B= CHRCNT OFF.BY #^C<^O<7>>&^O<377> ; See if done UNTIL RESULT IS EQ ; Until does not done RETURN ; Done. Return END TBASSP PROCEDURE OUTCR BEGIN CALL CHROUT ; Output CR LET R2 :B= FILLCT ; Get ready for filler chars REPEAT LET @MOUT := #0 ; Filler is 0 CALL CROUT1 ; Wait for ready LET R2 := R2 - #1 ; One less UNTIL RESULT IS LE ; Until done LET (PC)+ := #0 ; Clear the char count CHRCNT: ; Char count variable .WORD 0 RETURN ; Done. Return END OUTCR ; ; Sub to output character to console or line printer ; PROCEDURE CHROUT BEGIN LET @(PC)+ :B= R2 ; Output char MOUT: ; Buf address of output device .WORD TPB $GOTO CROUT1 ; Wait for ready END CHROUT ; ; Wait for ready ; PROCEDURE CROUT1 BEGIN REPEAT TSTB @(PC)+ ; Wait for ready MREG: ; CSR address of output device .WORD TPS UNTIL RESULT IS MI ; Until ready LET CHRCNT :B= CHRCNT + #1 ; Up character count $GOTO CROUT2 ; Check for CtrlC END CROUT1 ; ; Get char with CtrlC check ; PROCEDURE CROUT2 BEGIN CALL CKYBD ; Check keyboard RETURN ; exit if no char GOTO GETCR1 ; Check for CtrlC END CROUT2 PROCEDURE CRLF BEGIN JSR R5, MES ; Show AsciZ string .WORD ACRLF RETURN END CRLF .SBTTL Input routine ; ; Input routine ; To call 'INPUT' do a JSR R5, INPUT ; followed by(???) + Adr of message to be type prior to input ; PROCEDURE INPUT BEGIN ENTRY GETIN JSR R4, SAV04 ; Save regs 0-4 LET R0 := (PC)+ ; Input buffer GETINO: .WORD KBUF LET R1 := R0 ; Save the address REPEAT LOOP CALL GETCHR ; Get a character IFB R2 HIS #'a ANDB R2 LOS #'z THEN ; If lower case char LET R2 := R2 - #<'a-'A> ; Make it upper case END IFB R2 EQ #del LEAVE LOOP ; If rubout LET (R0)+ :B= R2 ; Else - store it, non special char IFB R2 EQ #CR GOTO 30$ ; If carrage return - quitting time 20$: CALL MES1 ; Echo the character END UNTIL R1 NE R0 ; Double leave - if rubout and buffer not empty LET R2 :B= -(R0) ; Get the last char GOTO 20$ ; And echo it 30$: ; CR - quitting LET (R0)+ :B= #LF ; Store LF too LET (PC)+ := R1 ; Point to start of keaboard buffer KBPTR: ; Keyboard pointer .WORD 0 CALL CRLF ; CR+LF $GOTO GEX04 ; Go to restore regs 0-4, do RTS R5 END INPUT ; ; Go to restore regs 0-4, do RTS R5 ; PROCEDURE GEX04 BEGIN JUMPTO RESR5 END GEX04 ; ; Conditionally get char ; PROCEDURE CKYBD BEGIN IFB @#TKS MI #0 THEN ; If keyboard active LET R2 := @#TKB OFF.BY #^C<^O<177>> ; Get character and clear out junk bits LET TOP := TOP + #2 ; Set up character in buffer return END $GOTO CKYBD1 ; Exit END CKYBD PROCEDURE CKYBD1 BEGIN RETURN ; Exit END CKYBD1 PROCEDURE GETCHR BEGIN IF CHN NE #0 THEN CALL CHAIN ; Chain execution routine GOTO GETCR1 END LOOP CALL CKYBD ; Conditionally get char END ; Skip next BR if char is ready $GOTO GETCR1 END GETCHR ; ; Is CtrlC ? ; PROCEDURE GETCR1 BEGIN IFB R2 NE #CTRLC GOTO CKYBD1 ; If no CtrlC LET PC := $COMC3 ; Yes, time to quit END GETCR1 ; ; Report device error ; PROCEDURE DEVERR BEGIN JSR R5, COMCO1 .ASCIZ |DEVERR| E.VEN END DEVERR .SBTTL ITOA subroutine ; ; ITOA subroutine ; Binary to ASCII routine ; Takes what's in R3 and shifts three bits into R2 ; Then calls printout routine to output them ; PROCEDURE ITOA BEGIN JSR R4, SAV04 ; I get screwed when I don't LET R4 := #6 ; Do only six times LET R2 := #0 ; Where the digits go GOTO 10$ LOOP LET R2 := R2 + #'0 ; Make it ASCII CALL CHROUT ; Type it LET R4 := R4 - #1 ; Onw down IF RESULT IS LE LEAVE LOOP ; If no more - to go LET R2 := #0 ; Get rid of old stuff LET R3 := R3 L.SHIFT 1 ; Shift combined LET R2 := R2 L.ROTATE 1 ; Three times LET R3 := R3 L.SHIFT 1 ; This is LET R2 := R2 L.ROTATE 1 ; Actually faster 10$: LET R3 := R3 L.SHIFT 1 ; And more efficient LET R2 := R2 L.ROTATE 1 ; Than a do loop END ; Keep going JUMPTO RESR7 ; Go restore regs 0-4, do RETURN END ITOA .SBTTL GETNUM/ATOI subroutines ; ; GETNUM ; PROCEDURE GETNUM BEGIN LET R0 := KBPTR ; Get string pointer 10$: LET R1 := #0 ; Data LET (PC)+ := #0 HASNUM: ; 'Has number' flag .WORD 0 LOOP LET R2 :B= (R0)+ ; Get a byte IFB R2 EQ #SPACE GOTO 10$ ; If space - ignore IFB #CR EQ R2 LEAVE LOOP ; If CR - all done IFB R2 LT #'0 LEAVE LOOP ; If less than 0 - all done IFB R2 GT #'7 LEAVE LOOP ; If greather than 7 - - all done LET R1 := R1 L.SHIFT 3 + R2 - #'0 ; Shift old stuff 3 times left ; I.e. mult by octal 10 ; Add new to old ; But get rid of ASCII stuff LET HASNUM :B= HASNUM + #1 ; Set flag END ; More, more $GOTO GTNMO ; No more END GETNUM PROCEDURE GTNMO BEGIN LET R0 := R0 - #1 LET KBPTR := R0 ; Save string pointer TSTB HASNUM RETURN ; No more END GTNMO ; ; Decimal ASCII to binary convert subroutine ; PROCEDURE ATOI BEGIN LET R0 := KBPTR LOOP LET R3 :B= (R0)+ - #'0 IF RESULT IS MI GOTO GTNMO IF R3 GT #^D<9> GOTO GTNMO LET R2 := R2 L.SHIFT 2 + R3 ; ????????? END END ATOI .SBTTL Device setup routine, input init routine PROCEDURE SETI BEGIN PUSH #0 ; Indicate no name GOTO DVSET END SETI PROCEDURE SETIN BEGIN PUSH PC ; Indicate name needed $GOTO DVSET END SETIN PROCEDURE DVSET BEGIN LET R5 := (PC)+ ; Input DDB addr to R5 $IDDB: .WORD INDEV PUSH RELCNT ; Put reloc factor in stack LET R0 := (PC)+ ; Get device table address $REL16: .WORD DEVTAB LET R0 := (R0) + (SP) ; Get device set up addr and correct for relocation CALL (R0) ; Go set up device LET R0 := R0 + (SP) ; Correct param addr for relocation LET $REL7+2 := R0 JSR R5, BMOVE ; Move device info to DDB $REL7: .WORD INDEV+XBT .WORD 0 .WORD XNB-XBT+2 ; From XBT to XNB LET XDN(R5) := CURDRV ; Driver number index LET R3 := $REL7 LET R1 := #^O</2> ; Entries for relocate REPEAT LET (R3)+ := (R3)+ + (SP) ; Relocate entry LET R1 := R1 - #1 ; One less UNTIL RESULT IS EQ ; Until done LET XDR(R5) := XDR(R5) + (SP)+ ; 1st directory block pointer - another one needs it IF (SP)+ EQ #0 GOTO RESR7A ; If name not needed - return JSR R5, BCLEAR ; Clear name area to blanks $REL3: .WORD INDEV+XXNAM .WORD SPACE .WORD 6 JSR R4, SAV04 ; Save regs 0-4 LET R0 := KBPTR ; KYBD buffer pointer ro R0 LET R4 := (PC)+ $REL2: .WORD INDEV+XXNAM LET R3 := #6 ; Up to 6 digits(??????) for name 10$: REPEAT LET R2 :B= (R0)+ ; Get a character IFB R2 EQ #'? THEN ; If question mark LET XFLMOD(R5) := R5 ; Set file mode indicator ELSE IFB R2 NE #CR THEN ; If not CR IFB R2 EQ #SPACE GOTO 10$ ; If space - skip ANDB R2 HIS #'0 THEN ; If not less than 0 IFB R2 LOS #'Z GOTO 20$ ; And not higher than Z 0 alpha-numeric char END LET R0 := R0 - #1 ; Move pointer back one LEAVE LOOP ; And go clean up END 20$: LET (R4)+ :B= R2 ; Else store the character LET R3 := R3 - #1 ; One char less UNTIL RESULT IS LE ; Until 6 chars done IF R3 NE #6 THEN ; If any name chars LET KBPTR := R0 ; Save string pointer GOTO RESR7 ; Restore regs, do RETURN END JSR R5, COMCO1 ; Reporting invalid name .ASCIZ |INVNAM| E.VEN END DVSET .SBTTL READL, READC and BKREAD0 subroutines ; ; Subroutine to read one block, set R0 and R1 pointers ; PROCEDURE GTDATA BEGIN LET R0 := $BUF2 ; Addr of 1st data byte LET R1 := #^D<510> ; Set byte count in R1 $GOTO READL END GTDATA ; ; Subroutine to read linked file block into buf ; PROCEDURE READL BEGIN LET R5 := $IDDB ; Point to inpit DDB LET PIPFLG :B= PIPFLG + #1 ; Set PIP mode IF XDT(R5) EQ #0 GOTO EOMERR ; If last block - error CALL BKREAD ENTRY READL1 LET XDT(R5) := BUF ; Save next block number address ENTRY NXTBL2 RETURN END READL ; ; Subroutine to input/output next block ; PROCEDURE NXTBLK BEGIN CALL READL1 ; Get next block number IF RESULT IS EQ GOTO NXTBL2 ; If 0 - no more, error return LET TOP := TOP + #2 ; Set for normal return $GOTO BKREAD END NXTBLK ; ; Subroutine to read a block into buf ; PROCEDURE BKREAD BEGIN CALL CLRBUF ; Clear the buffer 1st LET XBA(R5) := $BUF ; Set read address LET XWC(R5) := #^D<256> ; Set word count $GOTO READBK END BKREAD PROCEDURE READBK BEGIN LET XCO(R5) := XRD(R5) ; Set read command -> Command JSR R4, SAV04 ; Save regs 0-4 CALL @XSV(R5) ; Service routine (driver) - do it $GOTO RESR7 END READBK PROCEDURE RESR7 BEGIN CALL RST04 ; Restore regs 0-4 ENTRY RESR7A RETURN ; Return END RESR7 ; ; Report end of medium error ; PROCEDURE EOMERR BEGIN JSR R5, COMCO1 ; Report end of medium error .ASCIZ |EOM| END EOMERR .SBTTL Utility subroutines PROCEDURE SAV04 BEGIN PUSH ; Save R3-R0 LET PC := R4 ; R4 is already saved END SAV04 PROCEDURE RST04 BEGIN POP ; Return address, restore R0-R3 RTS R4 ; Restore R4 and return END RST04 ; ; Sub to clear buffer ; PROCEDURE CLRBUF BEGIN JSR R5, BCLEAR ; Call byte clear sub $BUF2: .WORD BUF+2 ; Destination .WORD 0 ; Clear value .WORD ^D<510> ; Count RETURN ; Exit END CLRBUF $BUF: .WORD BUF ; ; Routine to move byte fields ; PROCEDURE BMOVE BEGIN LET BMC2 := #^O ; Set a MOVB (R1)+, (R0)+ GOTO BMC1 END BMOVE PROCEDURE BCLEAR BEGIN LET BMC2 := #^O ; Set a MOVB R1, (R0)+ $GOTO BMC1 END BCLEAR PROCEDURE BMC1 BEGIN JSR R4, SAV04 ; Saver Regs 0-4 LET R0 := (R5)+ ; Get dest addr LET R1 := (R5)+ ; Get source LET R2 := (R5)+ ; Get count REPEAT BMC2: .WORD 0 LET R2 := R2 - #1 ; One byte less UNTIL RESULT IS EQ ; Until done GOTO UPKNM1 END BMC1 ; ; CMPNAME subroutine - compare two 9 characters names. Wild chars allowed ; PROCEDURE CMPNAM BEGIN JSR R4, SAV04 ; Save regs 0-4 LET R0 := (PC)+ ; Desired name address $REL15: .WORD INDEV+XXNAM LET R1 := (PC)+ ; Addr of name under question $TXNAM: .WORD TXNAM LET R2 := #FILNMS ; Compare up to 9 characters REPEAT IFB #'? EQ (R0) THEN ; If char a wild characer CMPB (R0)+, (R1)+ ; Then point to next char ELSE IFB (R0)+ NE (R1)+ GOTO 10$ ; Else - compare characters and go, if not same END LET R2 := R2 - #1 ; One char less UNTIL RESULT IS EQ ; Until done TST (R5)+ ; Set uo match exit 10$: GOTO UPKNM1 END CMPNAM ; ; Subroutine to convert RAD50 file name to ASCII ; PROCEDURE UPKNAM BEGIN JSR R4, SAV04 ; Save regs 0-4 LET R1 := (R5)+ ; Get ASCII addr LET R0 := (R5)+ ; Get RAD50 addr JSR R5, UNPACK ; Unpack 2 word into 6 ASCII bytes LET R0 := R0 + #4 ; Point to EXTension addr JSR R5, UPACK1 ; Unpack 1 word into 3 ASCII bytes $GOTO RESR5 END UPKNAM PROCEDURE RESR5 BEGIN ENTRY UPKNM1 CALL RST04 ; Restore regs 0-4 RTS R5 ; Done, return END RESR5 .SBTTL RAD50 unpack subroutine ; ; Input: R0 - addr of MOD40 number (2 words) ; R1 - addr of ASCII string (6 bytes) ; Output: R1 points one past last generated character ; ; If N is the MOD40 number, then ; N=C1*50^2+C2*50+C3 ; Thus, N/50^2 is C1 and remainder is C2*50+C3 ; The remainder is divided by 50 to get C2 etc. ; PROCEDURE UPACK1 BEGIN LET (PC)+ := #0 ; Unpack one word only PAKTMP: ; Major loop count .WORD 0 GOTO UNPA07 END UPACK1 PROCEDURE UNPACK BEGIN LET PAKTMP := #1 ; Unpack two words $GOTO UNPA07 END UNPACK PROCEDURE UNPA07 BEGIN JSR R4, SAV04 ; Save regs 0-4 REPEAT LET R4 := #^O<-3> ; Minor loop count LET R0 := (R0) ; Get MOD40 word LET R2 := (PC)+ ; Ptr to coefficient table $REL14: .WORD COEFF REPEAT LET R3 := #0 ; 0 quotient WHILE R0 HIS (R2) DO ; While not done with divide LET R0 := R0 - (R2) ; Subtract coeff LET R3 := R3 + #1 ; Add 1 to quotient END ; Divide done. Quot in R3, remainder in R0 ; Conver to an ASCII character IFB R3 NE #0 THEN ; If not blank IFB R3 EQ #33 GOTO 20$ ; "$" IF RESULT IS GT GOTO 10$ ; "." or "0-9" LET R3 := R3 + #40 ; "A-Z" END LET R3 := R3 + #16 ; Blank 10$: LET R3 := R3 + #11 ; "." or "0-9" 20$: LET R3 := R3 + #11 ; "$" LET (R1)+ :B= R3 ; Store character TST (R2)+ ; Advance to next coeff LET R4 := R4 + #1 ; Done 3 chars? UNTIL RESULT IS GE ; Until done LET R0 := (SP) ; Restore original R0 and TST (R0)+ ; Move to next word LET PAKTMP := PAKTMP - #1 ; Done all words? UNTIL RESULT IS MI ; Until done LET 2(SP) := R1 ; Put current R1 on onto the stack GOTO UPKNM1 ; Go exit END UNPA07 COEFF: .WORD 50*50 .WORD 50 .WORD 1 .SBTTL FILL, RUN and START routines PROCEDURE FILL BEGIN LET R3 := (PC)+ ; Get ready to type fill count FILLCT: .WORD ^D<12> CALL ITOA ; Ptint that out CALL TBASSP ; Tab over JSR R5, INPUT ; Wait for input CALL GETNUM ; Convert input string to binary IF RESULT IS NE THEN ; If does not just a CR, save new fill count LET FILLCT := R1 ; Put what he enterd there END RETURN END FILL ; ; START routine ; PROCEDURE START BEGIN CALL GETNUM ; Fetch starting adr IF RESULT IS EQ GOTO RUN10 ; If no data typed... LET R1 := R1 R.SHIFT 1 ; Good address? IF RESULT IS CC THEN ; If good LET R1 := R1 + R1 ; Restore address LET STADR := R1 ; Save addr GOTO RUN10 ; Data typed END JSR R5, COMCO1 ; Report Invalid address .ASCIZ |INVADR| E.VEN END START PROCEDURE RUN BEGIN LET RUNID :B= RUNID + #1 ; Set run indicator CALL LOAD ; Do a load 1st $GOTO RUN10 END RUN PROCEDURE RUN10 BEGIN CALL GTSW ; Get switches LET PCOUNT := INDEV+XWCTR ; Get I count if any IF RESULT IS EQ THEN ; If it zero LET PCOUNT := PCOUNT + #1 ; Make it one END IF CHN NE #0 THEN ; If chain mode LET @(PC)+ := (PC)+ ; Set restart addr in loc 42 $REL10: .WORD RESTRT ; Restart address .WORD SY.EXI ; Location 42 END LET R1 := STADR R.SHIFT 1 IF RESULT IS CS THEN ; If odd address LET R1 := #^O<200/2> ; Odd addr start at 200 END LET R1 := R1 L.SHIFT 1 ; Restore the addr ENTRY RUN40 PUSH ; Pass the fill count and indicate XXDP monitor load JUMPTO (R1) ; Start program END RUN10 .SBTTL DIR routine PROCEDURE DIR BEGIN CALL SETI ; No name needed LET XDN(R5) := D$RUNI ; Driver number CALL @XBT(R5) ; Boot routine LET XDT(R5) := R1 ; Monitor block number LET XWC(R5) := #MONCNT ; 4K's worth, starting at loc 0 LET XBA(R5) := #0 ; XFR starts at 0 CALL READBK ; Do it LET R1 := #NRDIR ; Point to non-res dir routine PUSH ; Pass the buffer pointer, monitor restart addr and current drive GOTO RUN40 ; Go to non-resident dir routine END DIR ; ; Input init routine ; PROCEDURE INITI BEGIN LET R5 := $IDDB ; Point to input DDB LET X1STBK(R5) := R5 ; Dummy block number CALL @SRH(R5) ; File search GOTO FLNOTF ; File not found LET XDT(R5) := X1STBK(R5) ; 1st block # to indt RETURN ; Found - return END INITI PROCEDURE FLNOTF BEGIN JSR R5, COMCO1 ; Report File not found .ASCIZ |NEXFIL| E.VEN END FLNOTF .SBTTL LOAD routine, .BIN or .BIC files only PROCEDURE LOAD BEGIN CALL SETIN ; Set input device. Name needed LET INDEV+XXNAM+6 := #"BI ; Set up .BIC extension LET INDEV+XXNAM+10 :B= #'C IF CHN EQ #0 THEN ; If not chain mode LET INDEV+XXNAM+10 :B= #'? ; Make last char wild LET XFLMOD(R5) := R5 ; Indicate file mode END CALL INITI ; Init for input CALL GTDATA ; Input a block of data $GOTO LOAD2 END LOAD PROCEDURE LOAD2 BEGIN 10$: REPEAT LET (PC)+ := #0 ; Initialize checksum CHKSUM: .WORD 0 CALL RDFRAM ; Read a Sync word UNTIL R3 NE #0 ; Until got not the NULL LET R3 := R3 - #1 ; See if it's a one IF RESULT IS NE GOTO CKSMER ; If not - load error CALL RDFRAM ; Sync is a word of 1 IFB R3 NE #0 GOTO CKSMER ; So the second half must be 0 CALL RD2FRM ; 2 bytes = 1 word LET R4 := R3 - #4 ; Assume not done yet, minus the header IF #2 EQ R4 GOTO LJMP ; If byte count = 6 - the end is neat CALL RD2FRM ; Get load adr LET R2 := R3 ; into R2 LOOP CALL RDFRAM ; Get a byte IF RESULT IS PL GOTO 20$ ; If byte count not zero yet IFB CHKSUM EQ #0 GOTO 10$ ; Check sum should be zero ENTRY CKSMER JSR R5, COMCO1 ; Report Load error .ASCIZ |CKSMER| E.VEN ENTRY POFLOW JSR R5, COMCO1 ; Program overflow message .ASCIZ |POFLO| E.VEN 20$: CMP R2, (PC)+ ; Protect the monitor LOAD4: .WORD R6STCK IF RESULT IS HIS GOTO POFLOW ; Abort LET (R2)+ :B= R3 ; Store the byte END ; Go get more END LOAD2 PROCEDURE LJMP BEGIN CALL RD2FRM ; Get the JUMP adr LET (PC)+ := R3 ; Store it for rainy days STADR: .WORD 1 CALL RDFRAM ; Make sure the checksum is OK IFB CHKSUM NE #0 GOTO CKSMER ; We check every block LET @#SY.COD :B= #2 ; Set load medium indicator (RK11??) LET @#SY.DEV :B= CURDRV RETURN ; Done. Get out END LJMP PROCEDURE RDFRAM BEGIN LOOP LET R1 := R1 - #1 ; Byte count in buffer IF RESULT IS PL LEAVE LOOP ; If something in buffer CALL GTDATA ; No, Get another buffer full END ; Do the house keeping LET R3 :B= (R0)+ ; Pick up chr LET CHKSUM := CHKSUM + R3 ; Do the checksum stuff LET R4 := R4 - #1 ; Load byte count RETURN END RDFRAM PROCEDURE RD2FRM BEGIN CALL RDFRAM ; Get one byte first LET (PC)+ := R3 ; Store it temporarily 10$: ; Temp storage .BYTE 0 20$: .BYTE 0 CALL RDFRAM ; Get the other byte LET 20$ :B= R3 ; Into the high byte LET R3 := 10$ ; Back into R3 RETURN ; Return END RD2FRM .SBTTL Batch device descriptor block (DDB) $DDB BTCDDB KBUF: ; Keyboard buffer B.LKW <^D<10>> .SBTTL Start of clearable core (during init) CLRBEG: ; Beginning of clearable core (during init) BUF: ; Main read/write buffer B.LKW <^D<256>> .SBTTL Input device descriptor block (DDB) $DDB INDEV .SBTTL Initializable variables/ASCII strings RUNID: .BYTE 0 PIPFLG: .BYTE 0 TXNAM: .BYTE 0, 0, 0, 0, 0, 0 TXEXT: .BYTE 0, 0, 0 CLREND: ; ASCII strings ADOT: .ASCIZ |.| ACRLF: .ASCIZ D$RUNI: .WORD 0 CURDRV: ; Offset to current drive * times 2 .WORD 0 .SBTTL Command, switch and device tables ; ; All commands are checked against the quotes, no abbreviations allowed ; COMTAB: $DEF <|/QV|>, SETQV ; Set QV mode $DEF <|/|>, SETCNT $DEF <|;|>, COMCON ; Where everithing starts $DEF <|F|>, FILL $DEF <|S|>, START $DEF <|L|>, LOAD $DEF <|R|>, RUN $DEF <|C|>, DOIT ; Chain setup routine $DEF <|D|>, DIR $DEF <|E|>, RTSPC ; Done. RETURN $DEF <>, RTSPC ; Done. RETURN $DEF <| |>, GTOK $END DEVTAB: .WORD SETPRM END DZQUDE .END