ørADð“—s v;v"Mò…ÁœÉBG@&I#ò‰.#éBI60"I0ðWÝ$[psI'0&I(ðdG$`&l MNh"dð›·ò€ý:õsS<,\&ò…¦ñBS>(Xð¶7òråµ'BYC "A;[ò…Æ(B[n$\Guò€ä&ƒB]U$eLò‰ìÉíBüá’œë$`n&òƒš#ß g2Mi $LðöÉ$|-BgBMmy$`|Bò…´IhXgS,i@&P +TE iX0Dò…Þ&{Bi&lP,\ðÏMsbBiJîm(I$pò‰.@å.xiJîmEV>0ðKò‚ýnÝPiJîmüõžysMòÜ¥BiJîmi>0ðMS$` "siJ}K.e@ð[Sò†qk#.xiSH$IðvóòŠY3sjI]?$\`B]P; -*-PALX-*- ; This module manages the asynchronous lines connected to the system. ; The following asynchronous line interfaces are supported: ; KL11 single line interface ; DL11 single line interface ; DZ11 8-line interface ; Each line is assinged a number. The system console (i.e. the KL11 at ; 177560) is always line 0. The KL11s have the next NKL line no.s, the ; DL11s the next NDL, and finally the DZ11 lines occupy the last NDZ*8 ; line no.s. ; For the MIT system the line no.s are currently as follows: ; Line no. Interface Connection ; 0 KL11(DL11-W) LA120 (system console) ; 1 DL11-E not used (autodialer??) ; 2 DL11-E Tektronix 4662 plotter ; 3 DL11-E HP2645A ; 4 DL11-E Vadic 305 modem (dialup 300) ; 3 DZ11,0 StupidBee ; 4 DZ11,1 VT52 #1 ; 5 DZ11,2 VT52 #2 ; 6 DZ11,3 VT52 #3 ; 7 DZ11,4 HP2645A ; 8 DZ11,5 Vadic 3415 modem (dialup 1200) ; 9 DZ11,6 Line to HP3000 ; 10 DZ11,7 MC-ITS 9600 baud line ; New DL11-E assignments ; Address Vector Speed Options ; 175610 310 1200 No parity,8 bits,1 Stop bit ; 175620 320 1200 Even parity,7 bits,1 Stop bit(Plotter) ; 175630 330 300 No parity,8 bits,1 Stop bit ; 175640 340 4800 No parity,8 bits,1 Stop bit ; For Steve Orszag's system the line no.s are currently as follows: ; Line no. Interface Connection ; 0 DLV11-J VT52 (system console) ; 1 DLV11-J Vadic 305 modem (300 baud) ; 2 DLV11-J Vadic 3415 modem (1200 baud) ; 3 DLV11-J Spinwriter printer ; 4 DLV11 LA180 .sbttl Definitions ; Define queue structure dsect < qsize:: .blkw 1 ; size of queue buffer qbp:: .blkw 1 ; ptr to buffer used as queue qfp:: .blkw 1 ; ptr to front of queue qrp:: .blkw 1 ; ptr to rear of queue qcc:: .blkw 1 ; room left in queue >,lq ; Define asynchronous line data structure dsect < .blkw 1 ; device address aldres:: .blkb 1 ; nonzero if device responding almode:: .blkb 1 ; holds flags for flow control purposes .even alib:: .blkw 1 ; bit to turn on interrupts for line aliq:: .blkb lq ; input queue aloq:: .blkb lq ; output queue >,laltab %alxon==1 ; this bit nonzero in ALMODE means DEC flow ; control protocol enabled for that line %alstp==2 ; this bit nonzero in ALMODE means we've just ; received a ^S and holding output till ^Q nal==1+nkl+ndl+ ; no. of asynchronous lines .macro al addr,ibit .word addr ; device address, .word 0 ; device responding flag .word ibit ; interrupt bit for line .blkb lq ; input queue .blkb lq ; output queue .endm altab: al 177560,100 ; Console terminal ifMIT < .rept nkl al 176500+<.rpcnt*10>,100 ; KL11s .endr > ifSAO < .rept nkl al 177500+<.rpcnt*10>,100 ; KL11s .endr > .rept ndl al 175610+<.rpcnt*10>,100 ; DL11s .endr .rept ndz al dzaddr+<.rpcnt*10>,1 al dzaddr+<.rpcnt*10>,2 al dzaddr+<.rpcnt*10>,4 al dzaddr+<.rpcnt*10>,10 al dzaddr+<.rpcnt*10>,20 al dzaddr+<.rpcnt*10>,40 al dzaddr+<.rpcnt*10>,100 al dzaddr+<.rpcnt*10>,200 .endr altabp: .blkw nal ; array of ptrs to LTAB entries .sbttl Initialization ; Line no. assignments klno==1 dlno==klno+nkl dzno==dlno+ndl ; DINIT is called to initialize the asynchronous lines at system startup. dinit: jsr r5,vecset ; setup console terminal interrupt vector .word 60,pr4+0,dlrint-.,dlxint-. .rept nkl jsr r5,vecset ; setup KL11 interrupt vector .word klv+<.rpcnt*10>,pr4+klno+.rpcnt,dlrint-.,dlxint-. .endr .rept ndl jsr r5,vecset ; setup DL11 interrupt vector .word dlv+<.rpcnt*10>,pr4+dlno+.rpcnt,dlrint-.,dlxint-. .endr .if ne ndz jsr r5,vecset ; setup DZ11 interrupt vector .word dzv,pr5,dzrint-.,dzxint-. clr dzric+0 clr dzric+2 clr dzrcc+0 clr dzrcc+2 clr dzxic+0 clr dzxic+2 clr dzxcc+0 clr dzxcc+2 .endc ; DINIT now falls into DPWRU which turns on interrupt enable bits. ; DPWRU is called when power returns after a power fail. It restarts i/o ; on the asynchronous lines. dpwru: mov pc,r1 ; ptr to ALTAB add #altab-.,r1 ; ... mov #nal,r0 ; no. of lines loop < clrb aldres(r1) ; clear device responding flag word add #laltab,r1 ; move ptr to next entry sorl r0 > mov #100,@#tks ; turn on console terminal interrupts mov #100,@#tps ; ... movb #1,altab+aldres ; indicate device responding .if ne nkl call catchn ; setup NXM catch for testing KLs 1$-. ifMIT < .rept nkl mov #100,@#176500+<.rpcnt*10> ; turn on KL interrupts mov #100,@#176504+<.rpcnt*10> ; ... movb #1,altab+aldres+<*laltab> .endr > ifSAO < .rept nkl mov #100,@#177500+<.rpcnt*10> ; turn on KL interrupts mov #100,@#177504+<.rpcnt*10> ; ... movb #1,altab+aldres+<*laltab> .endr > 1$: .endc .if ne ndl call catchn ; setup NXM catch for testing DLs 2$-. .rept ndl mov #106,@#175610+<.rpcnt*10> ; turn on DL interrupts mov #100,@#175614+<.rpcnt*10> ; ... movb #1,altab+aldres+<*laltab> .endr 2$: .endc .if ne ndz call catchn ; setup NXM catch for testing DZ 3$-. mov #dzaddr,r4 ; address of DZ11 mov #20,(r4) ; initialize clr nxmcat ; we have a DZ11, clear NXM catch loop < bit #20,(r4) ; wait for init to finish rptl ne > mov pc,r3 ; ptr to list of line parameters add #dzlpar-.,r3 ; ... mov #8.,r0 ; no. of DZ11 lines mov pc,r2 ; ptr to ALTAB+ALDRES for 1st DZ line add #altab+aldres+-.,r2 loop < movb #1,(r2) ; set line responding flag add #laltab,r2 ; advance ptr mov (r3)+,2(r4) ; setup line parameter register sorl r0 > mov #177777,4(r4) ; set all data term rdys, set all line enabs mov #040140,(r4) ; turn on ints, start DZ11 3$: .endc return ; VECSET is used to initialize interrupt vectors. vecset: mov (r5)+,r1 ; pick up vector address mov (r5)+,r2 ; pick up priority mov r5,(r1) ; set rcvr interrupt vector PC add (r5)+,(r1)+ ; ... mov r2,(r1)+ ; set rcvr interrupt vector PS mov r5,(r1) ; set xmit interrupt vector PC add (r5)+,(r1)+ ; ... mov r2,(r1)+ ; set xmit interrupt vector PS rts r5 .sbttl Asynchronous Line i/o ; ALINIT initializes the asynchronous line module. alinit: mov pc,r1 ; ptr to line table add #altab-.,r1 ; ... mov #nal,r0 ; no. of lines mov pc,r3 ; ptr to line table ptrs add #altabp-.,r3 ; ... loop < mov r1,(r3)+ ; save ptr to line table entry push #20./2,#60. ; ALOCW args: size, timeout call alocw ; allocate input buffer pop r2,* ; vals: ptr, error code bne 1$ clrb aldres(r2) ; clear line responding flag clrb almode(r2) ; clear other mode bits push r2,#20.,r1 ; QINIT args: buf size, buf ptr, queue ptr add #aliq,(sp) ; ... jsr r5,qinit ; initialize input queue push #60./2,#60. ; ALOCW args: size, timeout call alocw ; allocate output buffer pop r2,* ; vals: ptr, error code bne 1$ push r2,#60.,r1 ; QINIT args: buf size, buf ptr, queue ptr add #aloq,(sp) ; ... jsr r5,qinit ; initialize output queue add #laltab,r1 ; move to next line sorl r0 > return 1$: crash ^"No memory" ; ALREBF reallocates the buffers for asynchronous line input and output ; queues. This allows the no. of characters buffered to be dynamically ; changed. ; ARGS: VALS: ; SP -> output buffer size SP -> error code ; input buffer size ; line no. alrebf: push r1,r2 ; save regs mfps -(sp) ; save priority mov 14(sp),r1 ; get line no. argument asl r1 ; times two for indexing add pc,r1 ; for PICness mov altabp-.(r1),r1 ; get ptr to ALTAB entry cmp 12(sp),aliq+qsize(r1) ; already right size? if ne,< ; no, reallocate push aliq+qbp(r1) ; save ptr to old queue buffer push 12+2(sp) ; ALOCW arg1: size inc (sp) ; increment so odd sizes will win asr (sp) ; divide by two to get no. of words push #60. ; ALOCW arg2: timeout call alocw ; allocate input buffer pop r2,14+2(sp) ; vals: ptr, error code bne 2$ push r2,12+4(sp),r1 ; QINIT args: buf ptr, buf size, queue ptr add #aliq,(sp) ; ... spl 5 ; set high priority while redoing queue jsr r5,qinit ; initialize input queue mtps 2(sp) ; restore priority call free ; free old input queue buffer (arg on stack) > cmp 10(sp),aloq+qsize(r1) ; already the right size? if ne,< push aloq+qbp(r1) ; save ptr to old queue buffer push 10+2(sp) ; ALOCW arg1: size inc (sp) ; increment so odd sizes will win asr (sp) ; divide by two to get no. of words push #60. ; ALOCW arg2: timeout call alocw ; allocate output buffer pop r2,14+2(sp) ; vals: ptr, error code bne 2$ push r2,10+4(sp),r1 ; QINIT args: buf size, buf ptr, queue ptr add #aloq,(sp) ; ... spl 5 ; set high priority while redoing queue jsr r5,qinit ; initialize input queue mtps 2(sp) ; restore priority call free ; free old input queue buffer > 1$: mtps (sp)+ ; restore priority pop r2,r1 ; restore regs pop (sp),(sp) ; remove two args from the stack return 2$: pop * ; remove thing from stack br 1$ ; ALSMOD sets the modes of an asynchronous line ; ARGS: VALS: ; SP -> modes (as in ALMODE) none ; line no. alsmod: push r1 ; save reg mov 6(sp),r1 ; get line no. asl r1 ; times two for indexing add pc,r1 ; convert to offset into line table entry ptr mov altabp-.(r1),r1 ; ... movb 4(sp),almode(r1) ; set the modes pop r1,(sp),(sp) ; restore regs, remove args return ; ALGMOD gets the modes of an asynchronous line ; ARGS: VALS: ; SP -> line no. SP -> modes (as in ALMODE) algmod: push r1 ; save reg mov 4(sp),r1 ; get line no. asl r1 ; times two for indexing add pc,r1 ; convert to offset into line table entry ptr mov altabp-.(r1),r1 ; ... movb almode(r1),4(sp) ; get modes pop r1 ; restore reg return ; ALREAD reads a character from the input queue of an asynchronous line. ; REMW is first called to wait until a character is really in the queue. ; ARGS: VALS: ; SP -> timeout SP -> character ; line no. error code alread: push r1 ; save reg mov 6(sp),r1 ; get line no. asl r1 ; times two for indexing add pc,r1 ; convert to offset into line table entry ptr mov altabp-.(r1),r1 ; ... add #aliq,r1 ; make ptr to input queue structure push r1,4+2(sp) ; REMW args: queue ptr, timeout jsr r5,remw ; wait for a character to arrive in queue pop 6(sp) ; val: error code, pass it along if eq,< push r1 ; REMQ arg: queue ptr jsr r5,remq ; remove character from queue pop 4+2(sp),6(sp) ; vals: character, error code > pop r1 ; restore reg return .if ne asmpek ; ALPEEK reads a character from the input queue of an asynchronous line. ; but doesn't remove it from the input queue. ; REMW is first called to wait until a character is really in the queue. ; ARGS: VALS: ; SP -> timeout SP -> character ; line no. error code alpeek: push r1 ; save reg mov 6(sp),r1 ; get line no. asl r1 ; times two for indexing add pc,r1 ; convert to offset into line table entry ptr mov altabp-.(r1),r1 ; ... add #aliq,r1 ; make ptr to input queue structure push r1,4+2(sp) ; REMW args: queue ptr, timeout jsr r5,remw ; wait for a character to arrive in queue pop 6(sp) ; val: error code, pass it along if eq,< push r1 ; REMQ arg: queue ptr jsr r5,peekq ; remove character from queue pop 4+2(sp),6(sp) ; vals: character, error code > pop r1 ; restore reg return .endc ; ALWRIT outputs a character to an asynchronous line by inserting it in ; its output queue. If necessary ALWRIT waits until there is room in the ; queue. ; ARGS: VALS: ; SP -> character (none) ; line no. alwrit: push r1,r4 ; save regs mov 10(sp),r1 ; get line no. asl r1 ; times two for indexing add pc,r1 ; convert line no. to line table entry ptr mov altabp-.(r1),r1 ; ... tstb aldres(r1) ; device responding? if ne,< mov (r1),r4 ; device address add #aloq,r1 ; make ptr to output queue structure push #1,r1 ; ROOMQ args: no. of characters, queue ptr jsr r5,roomq ; wait for room for 1 character push 6(sp),r1 ; INSQ args: character, queue ptr jsr r5,insq ; insert character into queue pop * ; val: error code sub #aloq,r1 ; restore ptr to line table entry bisb alib(r1),4(r4) ; turn on this line's interrupt enable > pop r4,r1,(sp),(sp) ; restore regs, remove args from stack return ; ALWRIZ outputs an ASCIZ string to the specified line no. The ASCIZ ; string is specified by a relative ptr following the call. ; ARGS: VALS: ; SP -> line no. (none) alwriz: push r1 ; save reg mov r5,r1 ; pick up relative ptr after call add (r5)+,r1 ; make absolute ptr loop < tstb (r1) ; end of string? exitl eq push 4(sp) ; ALWRIT arg1: line no. movb (r1)+,-(sp) ; ALWRIT arg2: character jsr r5,alwrit ; send this character rptl > pop r1,(sp) ; restore reg, remove arg from stack return .sbttl DZ interrupt handlers .if ne ndz ; DZ11 receiver interrupt handler. dzrint: push r0,r1,r4 ; save regs add #1,dzric+0 ; increment DZ11 receiver interrupt count adc dzric+2 ; ... mov #dzaddr,r4 ; address of DZ11 loop < mov 2(r4),r0 ; read RBUF exitl pl ; character not valid, stop reading silo inc intflg ; indicate interrupt has occured add #1,dzrcc+0 ; increment DZ11 receiver character count adc dzrcc+2 ; ... mov r0,r1 ; get DZ11 line no. swab r1 ; ... bic #177770,r1 ; ... add #dzno,r1 ; convert to Trantor line no. bic #103400,r0 ; clear data valid bit and line no. jsr r5,alrint ; call general rcvr interrupt routine rptl > pop r4,r1,r0 ; restore regs rti dzric: .word 0,0 ; no. of DZ11 receiver interrupts dzrcc: .word 0,0 ; no. of DZ11 receiver characters ; DZ11 transmitter interrupt handler. dzxint: push r1,r4 ; save regs add #1,dzxic+0 ; increment DZ11 transmitter interrupts adc dzxic+2 ; ... mov #dzaddr,r4 ; address of DZ11 loop < mov (r4),r1 ; read CSR exitl pl ; no more lines ready inc intflg ; indicate interrupt has occured add #1,dzxcc+0 ; increment DZ11 transmitter character count adc dzxcc+2 ; ... swab r1 ; get DZ11 line no. bic #177770,r1 ; ... add #dzno,r1 ; convert to Trantor line no. jsr r5,alxint ; call general xmtr interrupt routine rptl > pop r4,r1 ; restore regs rti dzxic: .word 0,0 ; no. of DZ11 receiver interrupts dzxcc: .word 0,0 ; no. of DZ11 receiver characters .endc ; ne ndz .sbttl KL and DL interrupt handlers .if ne nkl+ndl ; KL11 and DL11 receiver interrupt handler. dlrint: mfps -(sp) ; save PS to extract unit no. push r0,r1,r4 ; save regs inc intflg ; indicate interrupt has occurred mov 6(sp),r1 ; get PS (unit no. in cc bits) bic #177760,r1 ; ... mov r1,r4 ; copy asl r4 ; times two for indexing add pc,r4 ; for PICness mov @altabp-.(r4),r4 ; get device address mov 2(r4),r0 ; get character jsr r5,alrint ; call general rcvr interrupt routine pop r4,r1,r0,* ; restore regs, remove PS from stack rti ; KL11 and DL11 transmitter interrupt handler. dlxint: mfps -(sp) ; save ps to extract unit no. push r1 ; save reg inc intflg ; indicate interrupt has occured mov 2(sp),r1 ; get PS (unit no. in cc bits) bic #177760,r1 ; ... jsr r5,alxint ; call general xmtr interrupt routine pop r1,* ; restore reg, remove PS from stack rti .endc ; ne ndl ; ALRINT ; ARGS: VALS: ; R0: character (none) ; R1: line no. alrint: ifSAO < ; the break character on SAO's machine ; can be a ^\ or a cmpb #34,r0 ; see if it's a requested break beq 5$ ; yes, break for Steve cmpb #234,r0 ; have to test both parities beq 5$ ; break??? but of course if equal > bit #20000,r0 ; Framing Error on this Character?? if ne,< ; yes, treat as a break 5$: push r2 ; save register mov pc,r2 ; get pointer to TTAB add #ttab-.,r2 ; .... mov #ntty,r0 ; number of TTY lines loop < cmp r1,tlinen(r2) ; is this the right Asynchronous line?? exitl eq ; yes, we found it add #lttab,r2 ; move to next terminal entry sorl r0 ; and look at it br 3$ ; this line is not a TTY so treat as a ; regular character > mov #-1,tbreak(r2) ; a break occurred on this line pop r2 ; restore register rts r5 ; no more processing necessary ; break was not a TTY line. 3$: pop r2 ; restore register > ; We have a good character so put it in the right queue for the line it ; was typed on. asl r1 ; times two for indexing add pc,r1 ; convert from line no. to line table entry ptr mov altabp-.(r1),r1 ; ... bitb #%alstp+%alxon,almode(r1) ; flow control mode on? if ne,< cmpb #23,r0 ; check for ^S for with both parities beq 1$ cmpb #223,r0 ifSAO < ; this is for SAO's LA180 beq 1$ ; which uses ^Q/^Q protocol cmpb #21,r0 ; look for a ^Q, either parity beq 1$ ; just return if its a ^Q cmpb #221,r0 ; .... > if eq,< 1$: bisb #%alstp,almode(r1) ; stop output on a ^S rts r5 > cmpb #21,r0 ; look for a ^Q, either parity beq 8$ ; just return if its a ^Q cmpb #221,r0 ; .... if eq,< 8$: bicb #%alstp,almode(r1) ; resume after a ^Q push r4 ; save r4 mov (r1),r4 ; get device address bicb alib(r1),4(r4) ; black magic bisb alib(r1),4(r4) ; enable that lines output interrupts again pop r4 ; restore regs rts r5 > > push r0,r1 ; INSQ args: character, queue ptr add #aliq,(sp) ; ptr to input queue jsr r5,insq ; insert into input queue pop * ; val: error code 2$: rts r5 ; ALXINT ; ARGS: VALS: ; R1: line no. (none) alxint: push r0,r4 ; save regs asl r1 ; times two for indexing add pc,r1 ; convert line no. to line table entry ptr mov altabp-.(r1),r1 ; ... mov (r1),r4 ; get device address bitb #%alstp,almode(r1) ; is this lines output shut off? bne 1$ ; pretend we're not waiting for anything push r1 ; REMQ arg: queue ptr add #aloq,(sp) ; ... jsr r5,remq ; get character from output queue pop r0,* ; vals: character, error code if eq,< movb r0,6(r4) ; send character out into the world > else < ; no character to send 1$: bicb alib(r1),4(r4) ; turn off line's interrupt enable > pop r4,r0 ; restore reg rts r5 .sbttl Queue management ; QINIT initializes a queue structure. ; ARGS: VALS: ; SP -> ptr to queue (none) ; buffer size ; buffer ptr qinit: push r1 ; save reg mov 4(sp),r1 ; get ptr to queue structure mov 6(sp),qsize(r1) ; save queue buffer size mov 10(sp),qbp(r1) ; set buffer ptr mov 10(sp),qfp(r1) ; set front ptr mov 10(sp),qrp(r1) ; set rear ptr mov 6(sp),qcc(r1) ; set room in queue to size (completely empty) pop r1,4(sp) ; restore reg, move up return r5 cmp (sp)+,(sp)+ ; pop off args return ; ROOMQ waits until a queue has a specified amount of room. ; ARGS: VALS: ; SP -> queue ptr (none) ; no. of chars roomq: push 2(sp) ; TWONHI arg1: address to wait on add #qcc,(sp) ; ... push 4+2(sp) ; TWONHI arg2: value to higher than dec (sp) ; ... call twonhi ; wait for QCC to be ge no. of chars pop (sp),(sp) ; remove args from stack return ; INSQ inserts a character into the rear of a queue. ; ARGS: VALS: ; SP -> queue ptr SP -> error code ; character insq: push r1 ; save reg mfps -(sp) ; save priority mov 6(sp),r1 ; ptr to queue structure spl 5 ; set no interrupt priority tst qcc(r1) ; room in queue? if eq,< mov #%eflq,10(sp) ; return queue full error br 1$ > dec qrp(r1) ; move to next char slot cmp qrp(r1),qbp(r1) ; wrap around to end? if lo,< add qsize(r1),qrp(r1) ; yes, make ptr to end of buffer > movb 10(sp),@qrp(r1) ; queue not full, put in this char dec qcc(r1) ; decrement space left in buffer clr 10(sp) ; zero error code for success return 1$: mtps (sp)+ ; restore priority pop r1,(sp) ; restore reg, pop off arg return ; REMW waits for a queue to be non-empty. After calling REMW a REMQ should ; never fail. ; ARGS: VALS: ; SP -> timeout SP -> error code ; queue ptr remw: push r1 ; save reg mov 6(sp),r1 ; ptr to queue structure clr 6(sp) ; zero error code tst 4(sp) ; zero timeout? if ne,< if pl,< ; no timeout if negative time call uptime ; get system up time add 4+4(sp),2(sp) ; add timeout to lo order uptime adc (sp) ; add carry to hi order uptime call tstot ; set timeout time for wait > push r1 ; TWONNE arg1: address to wait on add #qcc,(sp) ; ... push qsize(r1) ; TWONNE arg2: value to change from call twonne ; wait for room to be different from size clr 6(sp) ; set return error code to zero cmp qcc(r1),qsize(r1) ; timed out? if eq,< mov #%eemq,6(sp) ; yes, return queue empty error > > pop r1,(sp) ; restore reg, remove arg from stack return ; REMQ removes a character from the front of a queue. ; ARGS: VALS: ; SP -> queue pointer SP -> character ; error code remq: push (sp),r1 ; make room for results, save regs mov 6(sp),r1 ; ptr to queue structure cmp qcc(r1),qsize(r1) ; queue empty? if eq,< mov #%eemq,6(sp) ; return queue empty error mov #-1,4(sp) ; also return -1 as character br 1$ > dec qfp(r1) ; move rear ptr to next char cmp qfp(r1),qbp(r1) ; wrap around? if lo,< add qsize(r1),qfp(r1) ; yes, put ptr at end of buffer > clr 4(sp) ; so high byte will be clear movb @qfp(r1),4(sp) ; put character in its result slot inc qcc(r1) ; one more space in queue clr 6(sp) ; zero error code for success 1$: pop r1 ; restore reg return .if ne asmpek ; PEEKQ returns the character in front of the queue ; ARGS: VALS: ; SP -> queue pointer SP -> character ; error code peekq: push (sp),r1 ; make room for results, save regs mov 6(sp),r1 ; ptr to queue structure cmp qcc(r1),qsize(r1) ; queue empty? if eq,< mov #%eemq,6(sp) ; return queue empty error mov #-1,4(sp) ; also return -1 as character br 1$ > push qfp(r1) ; save old queue pointer dec qfp(r1) ; move rear ptr to next char cmp qfp(r1),qbp(r1) ; wrap around? if lo,< add qsize(r1),qfp(r1) ; yes, put ptr at end of buffer > clr 4+2(sp) ; so high byte will be clear movb @qfp(r1),4+2(sp) ; put character in its result slot pop qfp(r1) ; restore queue pointer clr 6(sp) ; zero error code for success 1$: pop r1 ; restore reg return .endcî; -*-palx-*- .sbttl console ; console's data structure dsect < .blkb lcs cheigh:: .blkw 1 ; screen height cline:: .blkw 1 ; line number connected to cipid:: .blkw 1 ; input process id copid:: .blkw 1 ; output process id cichar:: .blkw 1 ; Console's intercept character cimage:: .blkw 1 ; using image mode output cvpos:: .blkw 1 ; current horizontal position chpos:: .blkw 1 ; current vertical position ctopt:: .blkw 1 ; terminal's option word cofch:: .blkw 1 ; output file channel id cifch:: .blkw 1 ; input file channel id cwait:: .blkw 1 ; time to wait after each character (60th's) cwtchr:: .blkw 1 ; if non-zero wait after a CR only ceschr:: .blkw 1 ; if non-zero last character received ; was an escape ccecho:: .blkw 1 ; 0 = we don't need to echo, 1 = we do >,lcdat consol: push #lcdat/2 ; ALOCL arg: size call alocl ; allocate space for variables pop r1 ; val: ptr mov #lcs/2,r0 ; length of command structure loop < mov (r4)+,(r1)+ ; copy into trollr data area sorl r0 > sub #lcs,r4 ; get back ptr to command structure sub #lcs,r1 ; ... push r4 ; FREE arg: ptr call free ; free command structure mov r1,r4 ; use Trollr's version mov r4,filep(r4) ; ptr to FILNAM add #filnam,filep(r4) ; ... push uoch(r4) ; ORDER arg: channel id push #10000+tvmax,#0 ; ORDER args: order code, order arg call order ; read TVMAX inc (sp) ; we're one based pop cheigh(r4) ; vals: page height, error code push uoch(r4) ; ORDER arg: channel id push #10000+topt,#0 ; ORDER args: order code, order arg call order ; get terminal's option word pop ctopt(r4) ; val: order result (TOPT word for TTY) mov #',cichar(r4) ; set intercept character to ^^ clr cofch(r4) ; we're not connected to anything yet clr cwait(r4) ; no waiting on output by default clr cwtchr(r4) ; default to waiting after a CR tdtype clr ; clear screen call getpid ; get our process id pop cipid(r4) ; save as input side process id mov #-1,cline(r4) ; no current connection call moroff ; turn off more processing push r0 ; save reg mov pc,r0 ; get PIC address of default file name add #crfiln-.,r0 ; .... tst (r0)+ ; skip over directory mov (r0)+,filnam+2(r4) ; set file name mov (r0)+,filnam+4(r4) ; .... mov (r0)+,filnam+6(r4) ; set extension sub #10,r0 ; get back pointer to file name mov (r0)+,filnam+10(r4) ; set default directory mov (r0)+,filnam+12(r4) ; set filename mov (r0)+,filnam+14(r4) ; .... mov (r0)+,filnam+16(r4) ; set extension pop r0 ; restore reg br consi ; go do input side cr4: .word 0 .sbttl Input process consi: tst cline(r4) ; connected? bmi ccp push uich(r4) ; RCHAR arg: channel id call rchar ; read terminal input pop r0 ; val: character cmp r0,cichar(r4) ; Intercept character? beq ccp ; yes, call console command processor push cline(r4),r0 ; ALWRIT args: line no., character call alwrit ; output to line tst ccecho(r4) ; are we supposed to echo if ne,< push uoch(r4),r0 ; yes send character to terminal call wchar ; .... > br consi ; Console command processor ccp: push uoch(r4) ; ORDER arg: channel id push #10000+tvpos,#0 ; ORDER args: order code, order arg call order ; read vertical position inc (sp) ; we're one based pop cvpos(r4) ; val: vpos push uoch(r4) ; ORDER arg: channel id push #10000+thpos,#0 ; ORDER args: order code, order arg call order ; read horizontal position inc (sp) ; we're one based pop chpos(r4) ; val: hpos tst cimage(r4) ; using image mode output?? if ne,< push uoch(r4),#3 ; ORDER args: channel id, order code, push #%tcio ; order arg (cbit to turn off) call order ; turn off image output mode pop * ; val: return value (meaningless) > push cheigh(r4),#1 ; CPOSIT args: vpos, hpos call cposit ; move cursor to bottom line push uoch(r4) ; IOAC arg: channel call ioac ; output prompt .string ^"Console:" tdtype eol ; clear to end of line call rdcmdl ; read command line into buffer call rdcmdc ; read 1st character pop r0 ; val: character cmp r0,cichar(r4) ; intercept character? if eq,< tst cline(r4) ; connected to anything? bmi ccerr ; no, error push cline(r4),r0 ; ALWRIT args: line no., character call alwrit ; send intercept character br 3$ ; ccdone > call rrcmdc ; reread the 1st character call sarg ; read string argument push pc ; SCASE arg: ptr to list of string names add #cclist-.,(sp) ; ... call scase ; lookup command typed pop r0,* ; vals: ptr, error code bne ccerr jsr pc,@2(r0) 3$: tst errflg(r4) ; error occurred on last command if ne,< push uoch(r4),errflg(r4) ; WRITEZ args:output channel,asciz ptr call writez ; print error message type ^" " clr errflg(r4) ; no error now > jmp ccdone ccerr: push uoch(r4),#%tdbel ; WCHAR args: channel id, character call wchar ; feep a loser jmp ccdone cclist: .word 4 defcom ld, defcom cques, defcom cexit, defcom csic, defcom clink, defcom crecve, defcom cclse, defcom culink, defcom clpt, defcom csend, defcom ccwait, defcom csmart, defcom cdumb, ; defcom cmcftp, commentented out because the code doesn't ; exist. TWITS!!!!! -rll defcom cccCR, defcom cccCHR, defcom cecho, defcom cnecho, .word 0 cccCR: clr cwtchr(r4) ; wait only after a CR rts pc cccCHR: mov #1,cwtchr(r4) ; wait after each character rts pc csmart: jsr pc,cccCHR ; wait after each character mov #2,cwait(r4) ; time to wait rts pc cdumb: clr cwtchr(r4) ; wait after CR mov #21,cwait(r4) ; time for HP to catch up rts pc ccwait: call arg pop * call numarg ; get arg pop cwait(r4) ; got it save as number to wait rts pc cecho: mov pc,ccecho(r4) rts pc cnecho: clr ccecho(r4) rts pc csend: tst cline(r4) ; are we connected bmi ccerr1 ; can't send if we're not connected push filep(r4) ; FILARG arg: ptr tofilename buffers call filarg ; read the filename push pc ; ATTACH arg: device add #dskn-.,(sp) ; .... push filep(r4),diskno(r4),#0 ; ATTACH args:filename,unit #,cbits call attach ; open specified file pop cifch(r4),r0 ; vals: channel id, error code if ne,< jmp comerr ; report error in opening file > mov #-1,r2 ; default to sending linefeeds clr r3 ; default to not echoing call arg ; see if there is another arg pop r0 ; get number if ne,< ; if there is an arg mov #12,r2 ; set linefeed flag > tst cimage(r4) ; using image mode output?? if ne,< push uoch(r4),#2 ; ORDER args: channel id, order code, push #%tcio ; order arg (cbit to turn on) call order ; turn on image output mode pop * ; val: return value (meaningless) > loop < call quit ; see if user wants to quit sending pop * ; val: non-zero if time to quit bne 3$ push cifch(r4) ; RCHAR arg: channel id call rchar ; get next character pop r0 ; val: character exitl mi ; EOF???? cmp r0,r2 ; destroy all linefeeds!!???? if ne,< push cline(r4),r0 ; ALWRIT args: line no., character jsr r5,alwrit ; send character > tst r0 ; is the char we're sending a null rptl eq ; yes tst ccecho(r4) ; should we echo if ne,< ; yes if non-zero push uoch(r4),r0 ; WCHAR args: line no. character call wchar ; send character to screen > tst cwtchr(r4) ; if non-zero then wait after each charcter if ne,< 2$: push cwait(r4) ; TWFOR arg: time to wait (1/60th's of secs) call twfor ; wait for other machine to catch up rptl > else < ; if CWTCHR(R4) is zero then wait after a CR cmp r0,#15 ; did we just send a CR? beq 2$ ; yes, wait rptl ; else do more sending > > 3$: push cifch(r4) ; DETACH arg: channel id call detach ; close file clr cifch(r4) ; nothing being read rts pc clpt: tst cofch(r4) ; anything open bne ccerr1 ; yes. report error jsr pc,gettpl ; get the LPT if possible pop cofch(r4),* ; vals: channel id, error code rts pc ccerr1: push uoch(r4),#%tdbel ; WCHAR args: channel id, character call wchar ; feep a loser rts pc crecve: tst cofch(r4) ; anything open bne ccerr1 ; yes. report error push pc ; ATTACH arg1: device name add #dskn-.,(sp) ; ... push filep(r4) ; FILARG arg: pointer to filename buffer call filarg ; set filename (if any) push filep(r4) ; ATTACH arg2: file name push diskno(r4) ; ATTACH arg3: fdisk unit number push #%icrea+%iupd ; ATTACH arg4: cbits call attach ; open write file pop cofch(r4),* ; vals: channel id, error code rts pc cclse: call cclose rts pc clink: tst cline(r4) ; connected to anything? bge ccerr1 ; yes. error. call numarg ; read numeric argument to link command pop cline(r4) ; val: number push r3,r2 ; smashed by CTOTTY jsr pc,ctotty ; get TTYCH table ptr in R3 tst r3 ; zero R3 means bad link # beq cbadlk ; error take care of it tst pidtb-ttych(r3) ; see if a process owns this terminal bne cbadlk ; not-zero? some other process owns it call getpid ; get our process ID pop pidtb-ttych(r3) ; fill it into process ID table for owning TTY pop r2,r3 push pc ; MAKEP arg: initial PC add #conso-.,(sp) ; ... call makep ; create output side of Console pop copid(r4),* ; vals: process id, error code mov r4,cr4 ; pass R4 to output process push copid(r4) ; STARTP arg: process id call startp ; start output side pop * ; val: error code mov #-1,cimage(r4) ; default is image mode clr ccecho(r4) ; default is to not echo rts pc cbadlk: mov #-1,cline(r4) ; set to unconnected state pop r2,r3 ; restore registers br ccerr1 ; report error ; CTOTTY gets a pointer to TTYCH table in R3 for CLINE ; it uses r3 and r2 ctotty: clr r3 ; just for counting up to NTTY's mov pc,r2 add #ttab-.,r2 ; get PIC address of TTAB loop < cmp cline(r4),tlinen(r2) ; is this the right line #? exitl eq add #lttab,r2 inc r3 cmp #ntty,r3 blo 1$ rptl > asl r3 ; TTY #, convert for word address add pc,r3 ; pointer to TTYCH table add #ttych-.,r3 rts pc 1$: clr r3 rts pc cques: push uoch(r4),#%tdclr ; WCHAR args: channel id, character call wchar ; clear screen push pc ; LISTC arg: ptr to command list add #cclist-.,(sp) ; ... call listc ; typeout Console commands rts pc csic: call arg ; skip over spaces pop * ; val: character call rdcmdc ; read new intercept character pop cichar(r4) ; val: character rts pc ccdone: push cheigh(r4),#1 ; CPOSIT args: vpos, hpos jsr r5,cposit ; move to beginning of bottom line push uoch(r4),#%tdeol ; WCHAR args: channel id, character call wchar ; clear bottom line push cvpos(r4),chpos(r4) ; CPOSIT args: vpos, hpos call cposit ; restore cursor to where it was tst cimage(r4) ; image mode output?? if ne,< push uoch(r4),#2 ; ORDER args: channel id, order code, push #%tcio ; order arg (cbit to turn on) call order ; turn on image output mode pop * ; val: return value (meaningless) > jmp consi cfree: tst copid(r4) ; any output process? if ne,< ; yes, flush it push copid(r4) ; STOPP arg: process id call stopp ; stop output process pop * ; val: error code push copid(r4) ; KILLP arg: process id call killp ; kill output process pop * ; val: error code > call cclose ; close any output file tst cline(r4) if ge,< push r3,r2 ; free the TTY in PIDTB jsr pc,ctotty tst r3 if ne,< clr pidtb-ttych(r3) ; free it > pop r2,r3 > return cexit: tst cline(r4) ; are we connected if ge,< ; yes call cbufrt ; reset buffers > push uoch(r4) ; ORDER arg: channel id push #20000+topt,ctopt(r4) ; ORDER arg: order code, order arg call order ; restore terminal options pop * ; val: meaningless call cfree call moron ; turn on more processing push #lcs/2 ; ALOCL arg: size call alocl ; allocate command structure pop r1 ; val: ptr mov #lcs/2,r0 ; no. of words in command structure loop < mov (r4)+,(r1)+ ; copy TROLLR's command stuff sorl r0 ; ... > sub #lcs,r1 ; get back ptrs to start of data blocks sub #lcs,r4 ; ... push r4 ; FREE arg: ptr call free ; free Trollr's data block mov r1,r4 ; set command structure ptr mov r4,filep(r4) ; ptr to FILNAM add #filnam,filep(r4) ; ... pop * ; remove return PC from stack rts pc .if ne 0 ; don't assemble this code for now cdisp: push uoch(r4),#%tdclr ; WCHAR args: channel id,character call wchar ; clear screen push uoch(r4) ; IOAC arg: output channel tst cimage(r4) ; what type of output processing is happening if eq,< call ioac ; output message .string ^"No image output. " > else < call ioac ; output message .string ^"Image Output. " > cmp #-1,cline(r4) ; are we connected to anything?? if eq,< push uoch(r4) ; IOAC arg: output channel call ioac ; print message .string ^"Not connected. " > else < push cline(r4),uoch(r4) ; IOAC args: argument, output channel call ioac ; output message .string ^"Connected to ^d. " > push uoch(r4) ; IOAC arg: output channel tst cofch(r4) ; output channel open ??? if ne,< call ioac ; output message .string ^"Output file is open. " > else < call ioac ; output message .string ^"No output file is open. " > push uoch(r4) ; IOAC arg: output channel tst ccecho(r4) ; are we echoing???? if ne,< call ioac .string ^"Half-duplex (echoing enabled). " > else < call ioac .string ^"Full-duplex (echoing disabled). " > rts pc .endc culink: tst cline(r4) ; are we connected if ge,< call cfree ; free up output channels and ; kill output process call cbufrt ; reset buffers for cline > mov #-1,cline(r4) ; not connected to anything any more clr cofch(r4) ; no output file either rts pc ; return to console command processor cbufrt: push cline(r4),#20.,#60. ; ALREBF args: line #,input,output size call alrebf ; reset line buffers pop * ; VALS: error code return ; CPOSIT moves the terminal's cursor to the specified place. ; ARGS: VALS: ; SP -> horizontal position (none) ; vertical position cposit: bit #%todis,ctopt(r4) ; display terminal? if eq,< ; no push uoch(r4),#%tdhmv ; WCHAR args: channel id, character call wchar ; send code for horizontal move push uoch(r4),2+2(sp) ; WCHAR args: channel id, character call wchar ; send code for vertical move br 1$ > push uoch(r4),#%tdmov ; WCHAR args: channel id, character call wchar ; send software TTY code for cursor move push uoch(r4),4+2(sp) ; WCHAR args: channel id, character call wchar ; send vertical position push uoch(r4),2+2(sp) ; WCHAR args: channel id, character call wchar ; send horizontal position 1$: pop (sp),(sp) ; remove args from stack rts r5 .sbttl Output process conso: push #0,#80. ; SETSS args: process id, size call setss ; enlarge our stack pop * ; val: error code if ne,< lose 0 > mov cr4,r4 ; get ptr to Console's data area push cline(r4),#750. ; ALREBF args: line no., input buffer size push #20. ; output buffer size call alrebf ; re allocate buffers pop * ; val: error code coloop: push cline(r4),#-1 ; ALREAD args: line no., timeout (none) call alread ; read input from line pop r0,* ; vals: character, error code push uoch(r4),r0 ; WCHAR args: channel id, character call wchar ; output to terminal tst cofch(r4) ; output file open? beq coloop ; no bic #177600,r0 ; hack bits beq coloop ; don't write nulls to output file push cofch(r4),r0 ; WCHAR args: channel id, character call wchar ; output to file br coloop cclose: tst cofch(r4) ; anything open? if ne,< push cofch(r4) ; DETACH arg: channel id call detach ; close file clr cofch(r4) ; indicate nothing open > rts r5 crfiln: .rad50 "CONSOL" .rad50 "OUT" ð4«; Trantor Command processor -*-PALX-*- dsect < uich:: .blkw 1 ; user input channel uoch:: .blkw 1 ; user output channel cbsize:: .blkw 1 ; buffer size cendp:: .blkw 1 ; ptr to end of input line cbufp:: .blkw 1 ; ptr to next character to read in buffer lcmdb==120. ; length of command buffer cbuf:: .blkb lcmdb ; command buffer errflg:: .blkw 1 ; ptr to error message uname:: .blkw 1 ; user name (rad50) ready:: .blkw 1 ; number of ready messages diskno:: .blkw 1 ; current disk unit number diskn1:: .blkw 1 ; used by move command filep:: .blkw 1 ; ptr to filename buffer (next entry!) filnam:: .blkw 4 ; filename .blkw 4 ; used by rename >,lcs .macro type text push uoch(r4) call writec .string ^~text~ .endm .macro tdtype x push uoch(r4),#%td'x call wchar .endm .macro err text .string ^~text~,%.ttmp mov #%.ttmp,errflg(r4) .endm cp: push #0,#80. ; SETSS args: process id, size call setss ; set our stack size large pop * ; val: error code if ne,< lose 0 > push #lcs/2 ; ALOCL arg: size call alocl ; allocate data area for us pop r4 ; val: ptr mov #lcmdb,cbsize(r4) ; set command buffer size clr ready(r4) ; set number of readys to 0 mov r4,filep(r4) ; set FILEP to FILNAM add #filnam,filep(r4) ; ... ifSAO < mov #70700,uname(r4) mov #70700,filnam(r4) ; set SAO's default dir to RH; > clr diskno(r4) ; use disk number zero by default clr diskn1(r4) ; clear just in case push #0 ; GETUIO arg: process id (zero = self) call getuio ; get user input and user output channels pop uoch(r4),uich(r4),* ; vals: output ch, input ch, error code push uoch(r4),#%tdclr ; WCHAR args: channel id, character call wchar ; clear screen push #tvn ; IOAC arg: Trantor version no. push uoch(r4) ; IOAC arg: channel id call ioac ; print greeting message ifMIT < .if eq sysexp .string ^"Trantor ^d: MIT Math Department, Cambridge Mass. " .endc .else .string ^"Trantor ^dX: MIT Math Department, Cambridge Mass. " .endc > ifSAO < .string ^"Trantor ^x. " > ifMIT < push uoch(r4) ; PTIME arg1: channel id push #%pttime+%ptdate+%ptday+%ptzone ; PTIME arg2: cbits call time ; PTIME args 3 and 4: time lo, time hi call ptime ; print current time type ^| Type "help" for information on using the system. | > cploop: push uoch(r4) ; ORDER arg: channel id push #10000+topt,#0 ; ORDER arg: order code, order arg call order ; get terminal option word pop r0 ; got it bic #%tnech,r0 ; clear no output bit push uoch(r4) ; ORDER arg: channel id push #20000+topt,r0 ; ORDER args: order code, order arg call order ; set terminal option word pop * ; val: order result (meaningless) call rdcmdl ; read command line into buffer call arg ; skip over leading spaces pop * ; val: character beq cploop call sarg ; read a string argument ; SCASE args: ptr, length push pc ; SCASE arg3: ptr to list of strings add #cplist-.,(sp) ; ... call scase ; lookup command name in list pop r1,* ; vals: ptr to entry, error code if ne,< type ^"Illegal command. " br cploop > ifMIT < tst uname(r4) ; logged in? if eq,< cmp r1,#cpls1 ; command allowed when not logged in? if his,< type ^"You must login to use that command. " br cploop > > > push uich(r4) ; ORDER arg: channel id push #20000+tbreak,#0 ; ORDER arg: order code, order arg call order ; set tbreak back to zero pop * jsr pc,@2(r1) ; call routine for this command push uoch(r4) ; ORDER arg: channel id push #10000+topt,#0 ; ORDER arg: order code, order arg call order ; get terminal option word pop r0 ; got it bic #%tnech,r0 ; clear no output bit push uoch(r4) ; ORDER arg: channel id push #20000+topt,r0 ; ORDER args: order code, order arg call order ; set terminal option word pop * ; val: order result (meaningless) tst errflg(r4) ; error message to print? if ne,< push uoch(r4),errflg(r4) ; WRITEZ args: channel, asciz ptr call writez ; print error message jsr pc,crlf ; output CRLF jsr pc,crlf ; output another clr errflg(r4) ; clear error flag > mov filep(r4),r1 ; get pointer to filename add #10,r1 ; get end of filename push -(r1),-(r1) ; IOAC args: extension, 2nd filename push -(r1),-(r1) ; IOAC args: 1st filename, directory name ifMIT < .if eq push diskno(r4) ; get disk number add #71176,(sp) ; add offset to get diskname (RL0) .endc .if eq push diskno(r4) ; get disk number add #71436,(sp) ; add offset to get diskname (RP0) .endc > ifSAO < push diskno(r4) ; get disk number add #72136,(sp) ; add offset to get diskname (RX0) > inc ready(r4) ; another command executed push ready(r4),uoch(r4) ; IOAC args: number and channel id call ioac ; print ready message .string ^"r ^4z ^r:^r;^r^r.^r " br cploop ; JMP here to report expected argument missing. eeam: err ^"Expected argument missing" rts pc ; JMP here with error code in R0. comerr: push r0 ; ERRMSG arg: error code call errmsg ; get error message pop errflg(r4) ; val: ptr to asciz string rts pc .macro defcom a,names .irp n, .string ^"n",%.ctmp .word %.ctmp,a .endm .endm defcom cplist: .word 4 ; no. of bytes per entry defcom login, defcom logout, ifMIT < .lif ne 0 defcom help, > defcom flowon, defcom flowof, defcom cmoron, defcom cmorof, defcom clistc, defcom pstime, defcom dyofwk, defcom systat, defcom shutdn, defcom nshtdn, defcom stty, defcom messag, defcom rug, ; The commands from CPLS1 can only be used while logged in. cpls1: .lif ne asmtrl defcom trollr, .lif ne asmcns defcom consol, defcom df, defcom dfp, defcom ren, defcom copy, defcom move, defcom print, defcom sptype, defcom spinpr, .if ne nlp defcom tpl, defcom frmfed, .if ne 0 defcom tplsys, defcom tplld, defcom tpllu, defcom tplla, .endc .endc defcom uic, .if ne 0 ; don't assemble now defcom cd, defcom dd, .endc defcom ld, defcom lall, defcom lu, .lif ne asmcdc defcom u200, .if ne asmtek defcom tekplt, .lif ne 0 defcom teksnd, .lif ne 0 defcom memplt, .endc .if ne 0 ; don't assemble to save space defcom procpr, defcom memlst, .endc .word 0 ; terminator .sbttl Commands ; RUG command -- go to debugger rug: tst rugsta ; were we started from a rug? if ne,< bpt > rts pc ; LOGIN command. login: ifMIT < tst timsts ; time known? if eq,< ; no err ^"Please set the time before logging in." rts pc > > call arg ; ignore leading spaces pop * ; was the break character a NULL (end of line)? if eq,< err ^"No user name specified." rts pc > call cvr50 ; convert user id spec to rad50 pop *,r1 ; vals: word 2, word 1 mov r1,uname(r4) ; set user name ifMIT < push uoch(r4) ; include Channel Number push r1,ttych+0 ; output login message to system console call ioac .string ^"Login for ^r on TTY# ^d at " push ttych+0 ; PTIME arg: channel id push #%pttime+%ptdate+%ptslsh ; PTIME arg: control bits call time ; PTIME args: time lo, time hi call ptime ; print the time on the system console push ttych+0 call writec .string ^" " > jsr pc,messag ; print message of the day if any clr diskno(r4) ; start on disk 0 push diskno(r4) ; DUICLK arg: disk unit number push r1 ; DUICLK arg: dir name jsr r5,duiclk ; see if user has directory pop r0,* ; vals: block ptr, error code if ne,< mov (pc)+,r1 ; no directory of own .rad50 "rh " > else < push r0 ; DRELB arg: block ptr jsr r5,drelb ; release directory block pop * ; val: error code > mov filep(r4),r0 ; ptr to FILNAM mov r1,(r0)+ ; set directory in default mov #50561,(r0)+ ; set filename to MAIL mov #45400,(r0)+ mov uname(r4),(r0)+ ; set extention to login name sub #10,r0 ; ptr to FILNAM again push pc ; ATTACH arg: device name add #dskn-.,(sp) ; ... push r0,diskno(r4),#0 ; ATTACH args: filename,unit #,cbits call attach ; open file pop r0,* ; vals: channel id, error code if ne,< err ^"No mail." rts pc > push r0 ; DETACH arg: channel id call detach ; close mail file err ^"You have mail." rts pc ; LOGOUT command. logout: ifMIT < tst uname(r4) ; someone logged in logging out?? if ne,< push uoch(r4) ; include channeld id push uname(r4),ttych+0 ; output logout message to call ioac ; system console .string ^"Logout for ^r on TTY# ^d at " push ttych+0 ; PTIME arg: channel id push #%pttime+%ptdate+%ptslsh ; PTIME arg: control bits call time ; PTIME args: time lo, time hi call ptime ; print the time on the system console push ttych+0 call writec .string ^" " > > push uoch(r4) ; TMSG arg: channel id jsr r5,tmsg ; print console free message .string ^"Console free at " push r4 ; FREE arg: ptr call free ; free CP's data block pop * ; remove return PC from stack call getpid ; get our process id mov pc,r4 ; get ptr to PIDTB add #pidtb-.,r4 mov #ntty,r3 loop < cmp (r4)+,(sp) ; search PIDTB for this process's process ID exitl eq sorl r3 crash ^"PID not in PIDTB" > tst (sp)+ ; pop off our process ID mov #-1,prqtb-pidtb-2(r4) ; request ourselves to be killed push #0,pc ; TWONEQ arg: value, address call twoneq ; wait this word (the jsr instruction) = 0 ; ie. wait for the rest of our life. crash ^"JSR has opcode 0!" ; MESSAGE prints out the file MESSAG.OTD on disk 0 if it exits. ; MESSAGE command messag: push r0 ; save r0 push pc ; ATTACH arg: device name add #dskn-.,(sp) ; ... push pc ; ATTACH arg: filename add #msgfil-.,(sp) ; ... push #0,#0 ; ATTACH args: unit #,cbits call attach ; open file pop r0,* ; vals: channel id, error code bne 1$ ; error: no file or an error in attach push uoch(r4) ; XFRCHN arg: write channel id push r0 ; XFRCHN arg: read channel id call xfrchn ; Transfer the file from disk to TTY push r0 ; DETACH arg: channel id call detach ; release channel 1$: pop r0 ; restore r0,r1 rts pc msgfil: .rad50 "rh " ; Filename for RH;MESSAG.OTD .rad50 "mes" .rad50 "sag" .rad50 "otd" ; SHUTDOWN command. shutdn: call arg ; clear whitespace pop * ; ... if eq,< ; if no argument, assume 1 minute mov #2,r0 ; one minute for shutdown br 1$ > call numarg ; read a number (argument) pop r0 ; got it inc r0 ; in case immediate shutdown 1$: mov r0,sysc ; turn on bit to shutdown system ifMIT < jmp logout ; log this person out > ifSAO < rts pc > nshtdn: clr sysc ; someone doesn't want the system shutdown rts pc ifMIT < .if ne 0 ; HELP command. help: type ^|This is the MIT Math Department's PDP11 computer system. You may give commands to the system by typing a command name and striking the RETURN key. The command name may be optionally followed by a space and one or more arguments to the command, each separated by a space. To see a list of command names type "?". | rts pc .endc > ;;; Flowon turns XON/XOFF flow control on for that terminal connection. flowon: call getlnn ; get our terminal line number push r0 ; ALGMOD arg: Asynchronous line number call algmod ; get the modes for this line pop r1 ; val: modes bis #%alxon,r1 ; turn on XON/XOF flow control br flow ; go to the common code ;;; Flowoff turns off XON/XOFF flow control for that terminal connection. flowof: call getlnn ; get our line number push r0 ; ALGMOD arg: asychronous line number call algmod ; get the modes for this line pop r1 ; val: modes bic #%alxon+%alstp,r1 ; turn off flow control and turn ouput on ;;; Fall through to common code. flow: push r0,r1 ; ALSMOD args: Aline no., modes for line call alsmod ; set the modes rts pc ;;; Routine to get the asynchronous line number of our terminal ;;; and return it in R0 getlnn: mov pc,r3 ; get ptr to TTAB add #ttab-.,r3 ; ... mov pc,r1 ; get ptr to TTYCH add #ttych-.,r1 ; .... mov #ntty,r0 ; get number of TTYs loop < cmp uoch(r4),(r1)+ ; is this our terminal output channel # exitl eq ; yes add #lttab,r3 ; move to next TTAB entry sorl r0 ; do NTTY crash ^"Unknown terminal channel id." > mov tlinen(r3),r0 ; return asyncronous line number in R0 return ; MOREON command. Turn on *-MORE-* processing cmoron: call moron rts pc ; MOREOFF command. Turn off *-MORE-* processing cmorof: call moroff rts pc ; ? Command. clistc: push pc ; LISTC arg: ptr to command list add #cplist-.,(sp) ; ... call listc rts pc ; LISTC ; ARGS: VALS: ; SP -> ptr to command list (none) listc: jsr r5,save6 ; save regs mov 16(sp),r1 ; pick up argument: ptr to command list tst (r1)+ ; skip 1st word loop < call quit ; see if user wants to quit pop * ; val: non-zero if break typed exitl ne ; .... mov (r1),r0 ; ptr to next command name exitl eq push uoch(r4),r0 ; WRITEZ args: channel id, ptr call writez ; print command name push uoch(r4) ; ORDER arg: channel id push #10000+thpos,#0 ; ORDER args: order code, order argument call order ; read hpos from TTY DIM pop r3 ; val: order result (hpos) mov r3,r0 clr r2 ; for DIV div #24.,r2 ; move to next multiple of 24 sub #24.,r3 sub r3,r0 cmp r0,#71. if his,< jsr pc,crlf ; output a CRLF > else < push uoch(r4),#%tdhmv ; WCHAR args: channel id, character call wchar ; issue 1st half of horizontal move command inc r0 ; positions are passed one based push uoch(r4),r0 ; WCHAR args: channel id, character call wchar ; issue 2nd half of horizontal move > add @16(sp),r1 ; move to next entry on list rptl > jsr pc,crlf ; output a CRLF jsr r5,rest6 ; restore regs pop (sp) ; remove argument from stack return .sbttl Status commands ; TIME command. Print and set time. pstime: clr r1 ; change time marker pstim1: call arg ; move to argument pop r0 ; val: character beq 3$ ; no argument, just go print call time ; get current time call cvbtd ; convert to more usable form ; CVBTD vals: seconds, minutes, hours, ; day, month, year, day of week loop < tst r0 ; end of command line? exitl eq call numarg ; read no. call rdcmdc ; get character after no. pop r0 ; val: character cmp r0,#': ; time? beq 1$ cmp r0,#'/ ; date? beq 2$ pop * ; pop off NUMARG result err ^"Argument isn't a date or time." exitl 1$: pop 4(sp) ; set hours call numarg ; get minutes pop 2(sp) ; val: no. call rdcmdc ; get character after minutes pop r0 ; val: character cmp r0,#': ; seconds specified? rptl ne call numarg ; get seconds pop (sp) ; val: no. call rdcmdc ; get character pop r0 ; val: character rptl 2$: pop 10(sp) ; set month call numarg ; get day pop 6(sp) ; val: no. call rdcmdc ; read char after day pop r0 ; val: character cmp r0,#'/ ; year specified? rptl ne call numarg ; get year add #1900.,(sp) ; add 1900 to year typed in pop 12(sp) ; val: no. call rdcmdc ; read character after date pop r0 ; val: character rptl > call cvdtb ; convert back to internal form tst r1 if eq,< ; if 0 then change time call timset ; set time > else < pop r2,r3 ; save lo and hi times for below call to PTIME > 3$: push uoch(r4) ; PTIME arg1: channel id push #%pttime+%ptsecs+%ptdate+%ptday+%ptzone ; PTIME arg2: cbits tst r1 if eq,< ; if 0 then get time call time ; PTIME args 3 and 4: time lo, time hi > else < push r3,r2 ; PTIME args 3 and 4: time lo, time hi > call ptime ; print time jsr pc,crlf ; output a CRLF rts pc ; DAY_OF_WEEK command. Prints the day of the week for the specified date ; but does not alter the date dyofwk: mov pc,r1 ; set do not change time marker jmp pstim1 ; go do it ; SYSTAT command. systat: call arg ; argument specified? pop * ; val: character if eq,< ; no argument push #-1 ; use argument of -1 to indicate one time only > else < ; argument specified call numarg ; get numeric argument ; val: no. (leave on stack) push uoch(r4) ; ORDER arg: channel id push #2,#%tcniwt ; ORDER args: order code, order arg call order ; do BIS #%TCNIWT into control bits ; i.e. turn on no wait on input pop * ; val: order result (meaningless) > 1$: tdtype hom ; start display at top of screen tdtype eol ; ... call uptime ; get system up time pop r0,r1 ; UPTIME vals: uptime hi, uptime lo push r4 ; save reg jsr pc,ddiv60 ; convert from 60ths to seconds jsr pc,ddiv60 ; convert from seconds to minutes jsr pc,ddiv60 ; convert minutes to hours and minutes pop r4 ; restore reg push npwrf,r2,r1,#tvn ; IOAC args: power fails, minutes, hours, ; RH version no. push uoch(r4) ; IOAC arg: channel id call ioac .if eq sysexp .string ^"Trantor ^d. Uptime: ^d hours, ^d minutes. Power failures: ^d " .endc .else .string ^"Trantor ^dX. Uptime: ^d hours, ^d minutes. Power failures: ^d " .endc push uoch(r4) ; IOAC arg: channel id call ioac ; print message .string ^"Current time: " tst timsts ; time known? if ne,< ; yes push uoch(r4) ; PTIME arg: channel id push #%pttime+%ptdate+%ptslsh ; PTIME arg: control bits call time ; PTIME args: time hi, time lo call ptime ; print current time > jsr pc,crlf ; output a CRLF mov fsata+0,r1 ; get no. of words allocated sub fsft+0,r1 ; subtract no. freed mov r1,r2 ; copy no. in use mul #100.,r2 ; times 100 for % div fssize,r2 ; divide by size of free area push fsasl ; IOA arg: allocate search loops push fsflen,fsarc ; IOA args: freelist length, allocate reqs push r2,r1,fsac ; IOA args: % in use, words in use, push fssize ; blocks in use, free area push uoch(r4) ; IOA arg: channel id call ioac ; display free storage statistics .string ^"Free storage statistics: Total free storage area: ^d words In use: ^d blocks using ^d words (^d%) Allocate requests so far: ^d Length of Freelist: ^d Loops searching freelist: ^d " push tpwake+0,tpwake+2 ; IOA arg: no. of process wakeups push timout+0,timout+2 ; IOA arg: no. of times over quantum push preemc+0,preemc+2 ; IOA arg: no. of preemptions push tccnt+0,tccnt+2 ; IOA arg: no. of times round TC loop push tblkql,trunql,nproc ; IOA args: blocked, running, total push uoch(r4) ; IOA arg: channel id call ioac .string ^"Traffic Controller statistics: ^d processes; ^d running, ^d blocked TC loops: ^D Preemptions: ^D out of ^D Process wakeups so far: ^D " push notbmp ; IOAC arg: no. of times bitmap was written push nobnrd ; IOAC arg: no. of blocks not read push nioch ; IOAC arg: no. of i/o channels in use push uoch(r4) ; IOAC arg: channel id call ioac ; display io module statistics .string ^"IO module statistics: Channels in use: ^d Blocks in core when requested: ^d Number of times bit-map was written ^d " .if ne nrp push dfree+2 ; IOAC arg: number of free blocks push rpwtc,rperrc,rprdc ; IOAC args: errors, writes, reads push uoch(r4) ; IOAC arg: channel id call ioac ; display RP11 statistics .string ^"RP11 statistics: Reads: ^d Errors: ^d Free blocks: Writes: ^d RP0: ^d " .endc .if ne nrl push dfree+2,dfree ; IOAC arg: number of free blocks on both push rlwtc,rlerrc,rlrdc ; IOAC args: errors, writes, reads push uoch(r4) ; IOAC arg: channel id call ioac ; display RL11 statistics .string ^"RL11 statistics: Reads: ^d Errors: ^d Free blocks: Writes: ^d RL0: ^d RL1: ^d " .endc .if ne nrk push rkerrc,rkwtc,rkrdc ; IOAC args: errors, writes, reads push uoch(r4) ; IOAC arg: channel id call ioac ; display RK11 statistics .string ^"RK11 statistics: Reads: ^d Writes: ^d Errors: ^d " .endc .if ne nrx push rxserr,rxcerr,rxperr ; IOAC args: seek errs, CRC errs, parity errs push rxwtc,rxrdc ; IOAC args: writes, reads push uoch(r4) ; IOAC arg: channel id call ioac ; display RX11 statistics .string ^"RX11 statistics: Reads: ^d Writes: ^d Errors: ^d parity errors, ^d CRC errors, ^d seek errors " .endc .if ne ndz push dzxcc+0,dzxcc+2 ; IOA arg: no. of DZ11 characters transmitted push dzxic+0,dzxic+2 ; IOA arg: no. of DZ11 transmitter interrupts push dzrcc+0,dzrcc+2 ; IOA arg: no. of DZ11 characters received push dzric+0,dzric+2 ; IOA arg: no. of DZ11 receiver interrupts push uoch(r4) ; IOA arg: channel id call ioac ; display DZ11 statistics .string ^"DZ11 statistics: Receiver interrupts: ^D Received characters: ^D Transmitter interrupts: ^D Transmitted characters: ^D " .endc tdtype eos ; clear rest of screen pop r1 ; get time to repeat display if pl,< call quit ; see if user requests a break pop * ; val: non-zero if break typed bne 2$ ; ... mov r1,r3 mul #60.,r3 ; convert from seconds to 60ths push r3 ; TWFOR arg: wait time call twfor ; sleep for time specified by argument push uoch(r4) ; RCHAR arg: channel id call rchar ; see if anything typed pop * ; val: character if mi,< push r1 ; put back on stack for next time jmp 1$ ; repeat systat > 2$: push uoch(r4) ; ORDER arg: channel id push #3,#%tcniwt ; ORDER args: order code, order arg call order ; do BIC #%TCNIWT into control bits ; i.e. turn off no wait on input pop * ; val: order result (meaningless) > rts pc ; SET_TTY command. stty: call arg ; see if we've got an argument pop * ; val: character if eq,< jmp eeam > call sarg ; read string argument push pc ; ptr to list of terminal names add #ttylst-.,(sp) ; ... call scase ; lookup terminal name pop r1,* ; vals: ptr, error code if ne,< push uoch(r4) ; WRITEC arg: channel id call writec .string ^"Terminal name not known. Valid terminals are: " push pc ; LISTC arg: ptr to command list add #ttylst-.,(sp) ; ... call listc ; print list of terminals rts pc > tst (r1)+ ; skip over terminal name part of entry push uoch(r4) ; ORDER arg: channel id push #20000+tctyp,(r1)+ ; ORDER args: order code, order arg call order ; set TCTYP of terminal pop * ; val: order result (meaningless) push uoch(r4) ; ORDER arg: channel id push #20000+thmax,(r1)+ ; ORDER args: order code, order arg call order ; set THMAX of terminal pop * ; val: order result (meaningless) push uoch(r4) ; ORDER arg: channel id push #20000+tvmax,(r1)+ ; ORDER args: order code, order arg call order ; set TVMAX of terminal pop * ; val: order result (meaningless) push uoch(r4) ; ORDER arg: channel id push #20000+topt,(r1)+ ; ORDER args: order code, order arg call order ; set TOPT of terminal pop * ; val: order result (meaningless) mov pc,r3 ; get ptr to TTAB add #ttab-.,r3 ; ... mov pc,r1 ; get ptr to TTYCH add #ttych-.,r1 ; .... mov #ntty,r0 ; get number of TTYs loop < cmp uoch(r4),(r1)+ ; is this our terminal output channel # exitl eq ; yes add #lttab,r3 ; move to next TTAB entry sorl r0 ; do NTTY crash ^"Unknown terminal channel id." > call ttint ; do terminal initialization rts pc ; List of SET_TTY terminal names and their characteristics. ttylst: .word 10. ; no. of bytes per entry .string ^"printing",%.s .word %.s,%tntty,132.-1,0.-1,%toovr .string ^"spinwriter",%.s .word %.s,%tntty,132.-1,0.-1,%toovr+%tnxon .string ^"vt52",%.s .word %.s,%tnvt,80.-1,24.-1,%tomor+%tnxon+%todis+%toers+%toabs .string ^"vt100",%.s .word %.s,%tnvt1,80.-1,24.-1,%tomor+%todis+%toers+%toabs .string ^"vt132",%.s .word %.s,%tnvt1,80.-1,24.-1,%tomor+%tnxon+%todis+%toers+%toabs .string ^"vt132_wide",%.s .word %.s,%tnvt1,132.-1,24.-1,%tomor+%tnxon+%todis+%toers+%toabs .if df %tnsb .string ^"sb",%.s .word %.s,%tnsb,80.-1,25.-1,%todis+%toers+%toabs+%tocro+%tomor .endc .if df %tnhp .string ^"hp2645",%.s .word %.s,%tnhp,80.-1,24.-1,%todis+%toers+%toabs+%tocro+%tomor .endc .if df %tntrm .string ^"terminet",%.s .word %.s,%tntrm,120.-1,0.-1,%toovr+%tobs .endc .if df %tnla1 .string ^"la120",%.s .word %.s,%tnla1,132.-1,0.-1,%toovr+%tobs+%tnxon .endc .string ^"la36",%.s .word %.s,%tntty,132.-1,0.-1,%toovr+%tobs .if df %tnla1 .string ^"la120_wide",%.s .word %.s,%tnla1,217.-1,0.-1,%toovr+%tobs+%tnxon .endc .word 0 ; terminator moroff: push uoch(r4) ; ORDER arg: channel id push #10000+topt,#0 ; ORDER args: order code, order code call order ; get terminal options bic #%tomor+%tnech,(sp) ; clear more bits push (sp),(sp) ; make room for channel id mov uoch(r4),4(sp) ; ORDER arg: channel id mov #20000+topt,2(sp) ; ORDER arg: order code call order ; turn off more processing (order arg on stack) pop * ; val: meaningless return moron: push uoch(r4) ; ORDER arg: channel id push #10000+topt,#0 ; ORDER args: order code, order code call order ; get terminal options bis #%tomor,(sp) ; set more bits push (sp),(sp) ; make room for channel id mov uoch(r4),4(sp) ; ORDER arg: channel id mov #20000+topt,2(sp) ; ORDER arg: order code call order ; turn on More processing (order arg on stack) pop * ; val: meaningless return .sbttl File System Commands ; LIST_USERS or LU command. lu: push filep(r4) ; FILEARG arg: filename ptr call filarg ; parse filename if any push diskno(r4),#mfdb ; DGETB args: disk no., block no. jsr r5,dgetb ; get MFD pop r5,* ; vals: block ptr, error code mov #8.,r3 ; set up no. of users per line. 1$: mov r5,r2 ; get ptr that will inc to first entry sub #6,r2 ; ... mov #/10,r0 ; no. of entries in MFD 2$: call quit ; see if user typed a break pop * ; val: non-zero if break signaled bne 4$ ; .... add #10,r2 ; next uic in mfd. dec r0 bmi 3$ cmpb 1(r2),#1 ; ignore 0,* and 1,* blos 2$ push (r2) ; IOAC arg: directory name push uoch(r4) ; IOAC arg: channel id call ioac ; type directory name .string ^"^r " sob r3,2$ ; typed 8 on this line? jsr pc,crlf ; output a CRLF mov #8.,r3 ; set up no. of users per line. br 2$ 3$: push r5 ; DGNEXT arg: block ptr jsr r5,dgnext ; get next block of MFD pop r5,* ; DGNEXT vals: ptr, error code beq 1$ ; go print more if no error br 5$ 4$: push r5 ; DRELB arg: block to be released jsr r5,drelb ; release this block pop * ; val: error code 5$: jsr pc,crlf ; output a CRLF rts pc ; else were finished ;LIST_ALL prints out a ld of all the directories on the disk lall: mov r4,r1 ; get pointer to filename buffer add #filnam+12,r1 ; ... clr (r1)+ ; zero filename clr (r1)+ ; ... clr (r1)+ ; ... sub #10,r1 ; get back pointer to dir name push r1 ; FILARG arg: ptr to filename call filarg ; read in file name push diskno(r4),#mfdb ; DGETB args: disk no., block no. jsr r5,dgetb ; get MFD pop r5,* ; vals: block ptr, error code 3$: mov r5,r2 ; get ptr that will inc to first entry sub #6,r2 ; ... mov #/10,r0 ; no. of entries in MFD 1$: add #10,r2 ; next uic in mfd. dec r0 bmi 2$ cmpb 1(r2),#1 ; ignore 0,* and 1,* blos 1$ mov (r2),(r1) ; change dir name jsr r5,save6 ; save registers jsr pc,ld1 ; print out directory jsr pc,crlf ; output a crlf jsr r5,rest6 ; restore registers br 1$ 2$: push r5 ; DGNEXT arg: block ptr jsr r5,dgnext ; read in next block of MFD pop r5,* ; DGNEXT vals: block ptr,error code beq 3$ ; if no error then go print more rts pc ; UIC command. uic: call octarg ; first number swab (sp) call rdcmdc ; read break char between numbers pop * ; val: character call octarg ; second number movb (sp)+,(sp) ; put together pop filnam+0(r4) ; set default directory name to uic ; fall through to LD ; LIST_DIRECTORY or LD command. ld: mov r4,r1 ; ptr to second filename buffer add #filnam+10,r1 ; ... mov filnam+0(r4),(r1)+ ; copy directory name clr (r1)+ ; clear filename clr (r1)+ ; ... clr (r1)+ ; ... sub #10,r1 ; correct for 4 auto-increments push r1 ; FILARG arg: ptr to filename buffer call filarg ; read filename argument tdtype clr ; clear screen ld1: push filnam+10(r4) ; IOAC arg: dir name ifMIT < .if eq push diskno(r4) ; get disk number add #71176,(sp) ; add offset to get diskname (RL0) .endc .if eq push diskno(r4) ; get disk number add #71436,(sp) ; add offset to get diskname (RP0) .endc > ifSAO < push diskno(r4) ; get disk number add #72136,(sp) ; add offset to get diskname (RX0) > push uoch(r4) ; IOAC arg: channel id call ioac ; print it .string ^"Directory ^r:^r; " push diskno(r4) ; DUICLK arg: disk unit number push filnam+10(r4) ; DUICLK arg: directory name jsr r5,duiclk ; lookup directory, get first block pop r5,r0 ; vals: block ptr, error code if ne,< jmp comerr ; goto give error message > mov filnam+10(r4),filnam+0(r4) ; set default directory name tst filnam+12(r4) ; filename specified in match filename? if ne,< ; yes mov filnam+12(r4),filnam+2(r4) ; set default filename mov filnam+14(r4),filnam+4(r4) ; ... > tst filnam+16(r4) ; extension specified in match filename? if ne,< ; yes mov filnam+16(r4),filnam+6(r4) ; set default extension > clr r1 ; init count of blocks in dir mov #4,r0 ; file names per line loop < mov r5,r2 ; get ptr to first ufd entry tst (r2)+ ; ... mov #/lufde,r3 ; get no. of slots in ufd block loop < tst (r2) ; directory slot empty? beq 1$ ; yes, goto next tst filnam+12(r4) ; any filename to match? if ne,< ; yes cmp (r2),filnam+12(r4) ; does 1st half of filename match? bne 1$ cmp 2(r2),filnam+14(r4) ; does 2nd half of filename match? bne 1$ > tst filnam+16(r4) ; any extension to match? if ne,< ; yes cmp 4(r2),filnam+16(r4) ; does extension match? bne 1$ > add 14(r2),r1 ; add in length to total push 14(r2),4(r2),2(r2),(r2) ; IOAC args: filename, ext, length push uoch(r4) ; IOAC arg: channel id call ioac .string ^"^r^r.^r^5d" tstb 21(r2) ; file locked? if mi,< type ^"*" ; follow length with * for locked files > else < type ^" " > dec r0 ; filled a line yet? if ne,< type ^" " > else < jsr pc,crlf ; output a CRLF mov #4,r0 ; reset count iot ; hack to give some time to other processes > 1$: add #lufde,r2 dec r3 rptl ne > push r5 ; DGNEXT arg: block ptr jsr r5,dgnext ; get next directory block pop r5,* ; vals: block ptr, error code rptl eq > cmp r0,#4 if ne,< jsr pc,crlf ; output a CRLF > tst diskno(r4) ; find out which disk we're using if eq,< ; disk 0? push dfree > else < ; disk 1 otherwise push dfree+2 > push r1 ; IOAC args: directory total, system free push uoch(r4) ; IOAC arg: channel id call ioac .string ^" Total blocks used = ^d, Free blocks = ^d " rts pc .if ne 0 ; CREATE_DIRECTORY or CD command cd: push filep(r4) ; FILARG arg: ptr to filename call filarg ; read in filename push diskno(r4),filnam(r4) ; DUICLK args: disk number, dir name jsr r5,duiclk ; see if this dir already exists pop r5,r0 ; vals: ptr, error code if eq,< push r5 ; DRELB arg: block pointer call drelb ; release the UFD pop r0 ; val: error code type ^"Directory already exits. " rts pc ; exit, don't add this directory > push diskno(r4),#mfdb ; DGETB args: disk unit #,block number jsr r5,dgetb ; read in the MFD pop r5,* ; vals: block ptr,error code 1$: mov r5,r2 ; get ptr that will inc to first entry sub #6,r2 ; .... mov #/10,r0 ; get number of MFD slots loop < add #10,r2 ; move to next entry tst (r2) ; see if empty or not bne 2$ ; not empty tst 2(r2) ; see if a block number there also bne 2$ ; must be zero mov filnam(r4),(r2)+ ; set dir name (we've got an empty slot) push diskno(r4) ; DALLOC arg: disk number jsr r5,dalloc ; get us a block for a UFD pop r3,r0 ; vals: block ptr,error code bne 3$ ; if non-zero must have been an error mov dblk(r3),(r2)+ ; set block number of UFD mov #9.,(r2)+ ; 9. words per UFD entry clr (r2)+ ; not used (make sure it's zero) mov pc,dwtf(r5) ; set write flag push r5 ; DRELB arg: block ptr jsr r5,drelb ; release the MFD pop * ; val: error code mov r3,r5 ; get ptr to disk block (gotten by DALLOC) mov #,r0 ; get number of words/block mov r5,r2 ; get ptr that can be incremented loop < clr (r2)+ ; zero this location sorl r0 ; done yet? > mov pc,dwtf(r5) ; set write flag push r5 ; DRELB arg: block ptr jsr r5,drelb ; release the UFD pop r0 ; vals: error code bne 4$ rts pc ; done 2$: sorl r0 ; done with this block of the MFD yet? > tst (r5) ; is there a next block? if ne,< ; if so then get it and start again push r5 ; DGNEXT arg: block ptr jsr r5,dgnext ; get next block pop r5,r0 ; vals: ptr, error code bne 4$ ; if error then go hack it > else < ; otherwise we need to graft on a new block push diskno(r4) ; DALLOC args: disk number jsr r5,dalloc ; get us a new block to use pop r3,r0 ; vals: block number,error code bne 3$ ; if error then hack it mov dblk(r3),(r5) ; set link to new block mov pc,dwtf(r5) ; set write flag push r5 ; DRELB arg: block ptr jsr r5,drelb ; release this block pop * ; val: error code bne 4$ ; if error then go hack it mov r3,r2 ; get ptr that can be inc mov #,r0 ; get number of words/block loop < clr (r2)+ ; clear this location sorl r0 ; done yet? > mov r3,r5 ; reset ptr > br 1$ ; done now 3$: push r5 ; DRELB arg: block ptr jsr r5,drelb ; release this block pop * ; val: error code 4$: jmp comerr ; report error ; DELETE_DIRECTORY or DD command dd: push filep(r4) ; FILARG arg: ptr to filename call filarg ; read a filename push diskno(r4),filnam(r4) ; DUICLK args:disk number, dir name jsr r5,duiclk ; lookup directory pop r5,r0 ; vals: ptr, error code bne 1$ ; if error then stop and report it 3$: mov #/lufde,r0 ; get number of entries in this block mov r5,r2 ; get ptr that can be inc tst (r2)+ ; skip link block loop < tst (r2) ; first part of filename 0? bne 2$ ; no, error tst 2(r2) ; second part of filename 0? bne 2$ ; no, error tst 4(r2) ; extension of filename 0? bne 2$ ; no, error add #lufde,r2 ; move to next entry sorl r0 ; do it > push r5 ; DGNEXT arg: block ptr jsr r5,dgnext ; get next block of UFD pop r5,* ; vals: block ptr,error code beq 3$ ; if no error then process this block push diskno(r4),#mfdb ; DGETB args:disk no.,block number jsr r5,dgetb ; read in the MFD pop r5,r0 ; vals:ptr, error code bne 1$ ; error? 5$: mov r5,r2 ; get ptr that can be inc tst (r2)+ ; skip link block mov #/10,r0 ; get number of MFD entries loop < cmp (r2),filnam(r4) ; is rthis the right directory? if eq,< ; yes push diskno(r4),2(r2) ; DDF args: disk number, block number jsr r5,ddf ; delete the UFD pop r0 ; val: error code bne 4$ ; error ? clr (r2)+ ; clear entry clr (r2)+ ; clear entry clr (r2)+ ; clear entry clr (r2)+ ; clear entry mov pc,dwtf(r5) ; set write flag push r5 ; DRELB arg: ptr jsr r5,drelb ; release this block pop r0 ; val: error code bne 1$ ; error? rts pc > add #10,r2 ; move to next entry of MFD sorl r0 ; done yet > push r5 ; DGNEXT arg: ptr jsr r5,dgnext ; get next block of UFD pop r5,* ; vals: ptr, error code beq 5$ ; no error? rts pc 4$: push r5 ; DRELB arg: ptr jsr r5,drelb ; release this block pop * ; val: error code 1$: jmp comerr 2$: type ^"Directory not empty " rts pc .endc ;PRINT command. print: push filep(r4) ; FILARG arg: ptr to filename buffer call filarg ; parse a file name push pc ; ATTACH arg: device id add #dskn-.,(sp) ; .... push filep(r4) ; ATTACH arg: file name push diskno(r4),#0 ; ATTACH args: disk unit #, cbits call attach ; open file pop r2,r0 ; vals: channel id, error code if ne,< jmp comerr ; handler error opening file > push uoch(r4),r2 ; XFRCHN args: output, input channel ; ids call xfrchn ; transfer the characters 1$: push r2 ; DETACH arg: channel id call detach ; close file rts pc .if ne nlp ; TPL command. tpl: push filep(r4) ; FILARG arg: ptr to filename buffer call filarg ; parse a file name push pc ; ATTACH arg: device id add #dskn-.,(sp) ; .... push filep(r4) ; ATTACH arg: file name push diskno(r4),#0 ; ATTACH args: disk unit #, cbits call attach ; open file pop r2,r0 ; vals: channel id, error code if ne,< jmp comerr ; handle error opening file > jsr pc,gettpl ; attempt to get the TPL pop r1,r0 ; vals: channel id, error code if ne,< push r2 ; DETACH arg: channel id call detach ; close file jmp comerr ; handle error attaching LPT > push r1,r2 ; XFRCHN args: output, input channel ; ids call xfrchn ; transfer the characters 1$: push r2 ; DETACH arg: channel id call detach ; close file push r1 ; DETACH arg: channel id call detach ; let go of LPT rts pc ; Tries to get the TPL and returns channel id and error code on the stack gettpl: push (sp),(sp) ; make room for return args ; be careful to keep lpt unit 0 for SAO kludge push pc ; ATTACH arg: device id add #lptn-.,(sp) ; .... push #0,#0,#0 ; ATTACH args: file name,unit #,cbits call attach ; get the LPT pop 4(sp),4(sp) ; vals: channel id, error code rts pc .if ne 0 tplsys: rts pc ; broken somehow jsr pc,gettpl ; attempt to get the TPL pop r1,r0 ; vals: channel id, error code if ne,< jmp comerr ; report error > push uoch(r4),r1 ; save our output channel mov r1,uoch(r4) ; make the TPL channel id our ; output channel jsr pc,systat ; do a systat push uoch(r4) ; DETACH arg: channel id call detach ; release the TPL pop uoch(r4) ; restore output to the terminal rts pc ; send a LIST_DIRECTORY to the TPL tplld: jsr pc,gettpl ; attempt to get the TPL pop r1,r0 ; vals: channel id, error code if ne,< jmp comerr ; report error > push uoch(r4) ; save our output channel mov r1,uoch(r4) ; make the TPL channel id our ; output channel jsr pc,ld ; do a list_directory push uoch(r4) ; DETACH arg: channel id call detach ; release the TPL pop uoch(r4) ; restore output to the terminal rts pc ; send a LIST_USERS to the TPL tpllu: jsr pc,gettpl ; attempt to get the TPL pop r1,r0 ; vals: channel id, error code if ne,< jmp comerr ; report error > push uoch(r4) ; save our output channel mov r1,uoch(r4) ; make the TPL channel id our ; output channel jsr pc,lu ; do a list_users push uoch(r4) ; DETACH arg: channel id call detach ; release the TPL pop uoch(r4) ; restore output to the terminal rts pc ; send a LIST_ALL to the TPL tplla: jsr pc,gettpl ; attempt to get the TPL pop r1,r0 ; vals: channel id, error code if ne,< jmp comerr ; report error > push uoch(r4) ; save our output channel mov r1,uoch(r4) ; make the TPL channel id our ; output channel jsr pc,lall ; do a list_all push uoch(r4) ; DETACH arg: channel id call detach ; release the TPL pop uoch(r4) ; restore output to the terminal rts pc .endc ; ne 0 ; the FORM_FEED of (FF) command sends a form feed to the LPT frmfed: jsr pc,gettpl ; get the TPL pop r1,r0 ; vals: channel id, error code if ne,< jmp comerr ; handle error attaching LPT > push r1,#14 ; WCHAR args: channel id, character call wchar ; send a form feed push r1 ; DETACH arg: channel id call detach ; let go of LPT rts pc .endc ; ne nlp ; DELETE_FILE_PARANOID or DFP command dfp: push filep(r4) ; FILARG arg: ptr to filename buffer call filarg ; get filename to be deleted mov filep(r4),r1 ; get pointer file name add #12,r1 ; get ptr to 2nd filename buffer & skip dir mov #131045,(r1)+ ; copy save filename (%TEMP%.TMP) mov #51734,(r1)+ ; .... mov #77430,(r1)+ ; .... sub #10,r1 ; get back ptr to 2nd filename push pc ; DELETE arg: device name add #dskn-.,(sp) ; .... push r1,diskno(r4) ; DELETE args: filename ptr, disk unit # call delete ; delete the old temporary file pop * ; VAL: error code (don't care what it was) push pc ; RENAME arg: device name add #dskn-.,(sp) ; .... push filep(r4),r1 ; RENAME args: old filename,new filename push diskno(r4) ; RENAME arg: disk unit # call rename ; rename file pop r0 if ne,< jmp comerr ; must have been an error, this time > rts pc ; DELETE or DF command. df: push filep(r4) ; FILARG arg: ptr to filename buffer call filarg ; parse file name mov filep(r4),r1 ; get pointer to filename add #10,r1 ; get end of filename push -(r1),-(r1) ; IOAC args: extension, 2nd filename push -(r1),-(r1) ; IOAC args: 1st filename, directory name ifMIT < .if eq push diskno(r4) ; get disk number add #71176,(sp) ; add offset to get diskname (RL0) .endc .if eq push diskno(r4) ; get disk number add #71436,(sp) ; add offset to get diskname (RP0) .endc > ifSAO < push diskno(r4) ; get disk number add #72136,(sp) ; add offset to get diskname (RX0) > push uoch(r4) ; IOAC arg: channel id call ioac ; print out message .string ^"Do you want to delete ^r:^r;^r^r.^r ?" push uoch(r4) ; RCHAR arg: channel id call rchar ; get character pop r0 ; got it push uoch(r4),r0 ; WCHAR args: channel id,char call wchar ; echo typed char cmp r0,#'y ; was it a Y? beq 1$ ; yes cmp r0,#'Y ; was it a Y? bne 2$ ; no 1$: push pc ; DELETE arg: device name add #dskn-.,(sp) ; .... push filep(r4) ; DELETE args: file name push diskno(r4) ; DELETE args: disk unit # call delete ; delete the file pop r0 ; val: error code if ne,< jmp comerr ; handle error deleting file > 2$: jsr pc,crlf ; output a CRLF rts pc ; RENAME command. ren: call twofil ; read two filenames push pc ; RENAME arg: device name add #dskn-.,(sp) ; ... push r1,r2 ; RENAME args: old, new push diskn1(r4) ; RENAME arg: disk unit id call rename ; rename file mov diskn1(r4),diskno(r4) ; change disk number back(in ; case the luser tried to change it)!! pop r0 ; val: error code if ne,< jmp comerr ; handle error renaming file > rts pc ; MOVE command. move: mov pc,r3 ; set flag saying to delete after copy br copy1 ; COPY command. copy: clr r3 ; clear flag saying to delete after copy copy1: call twofil ; read two filenames push pc ; ATTACH arg: device name add #dskn-.,(sp) ; ... push r1,diskn1(r4),#0 ; ATTACH args: filename,unit #,cbits call attach ; open first file for reading pop r1,r0 ; vals: channel id, error code if ne,< jmp comerr ; handle error opening first file > push pc ; ATTACH arg: device name add #dskn-.,(sp) ; ... push r2,diskno(r4) ; ATTACH arg: file name,disk unit # push #%icrea+%iupd ; ATTACH args: cbits call attach ; open second file for writing pop r2,r0 ; vals: channel id, error code if ne,< push r1 ; DETACH arg: channel id call detach ; close first file jmp comerr > push r2,r1 ; XFRCHN args: output, input channel ; ids call xfrchn ; transfer the file push r1 ; DETACH arg: channel id call detach ; close first file push r2 ; DETACH arg: channel id call detach ; close second file tst r3 ; delete first file after copy? if ne,< push pc ; DELETE arg: device name add #dskn-.,(sp) ; ... push filep(r4) ; DELETE arg: filename add #10,(sp) ; ... push diskn1(r4) ; DELETE arg: disk unit number call delete ; delete first file after copy for MOVE pop r0 ; val: error code if ne,< jmp comerr ; go handle error deleting > > rts pc ; TWOFIL reads two filename arguments. This is a hack so RENAME, COPY, and ; MOVE share this code. R1 points to the first filename and R2 to the second. twofil: mov filep(r4),r2 ; get ptr to FILNAM push r2 ; FILARG arg: ptr to filename buffer call filarg ; get a filename argument mov r2,r1 ; copy ptr to FILNAM mov (r1)+,6(r1) ; copy old file name mov (r1)+,6(r1) ; ... mov (r1)+,6(r1) ; ... mov (r1)+,6(r1) ; ... mov diskno(r4),diskn1(r4) ; save disk unit number call arg ; skip over spaces pop r0 ; val: character if eq,< pop * ; remove return R5 from stack so can JMP away jmp eeam > push r2 ; FILARG arg: ptr to filename buffer call filarg ; read another filename argument return ; This goes through and lists process information procpr: jsr pc,systat ; print out a systat push uoch(r4) ; IOAC arg: channel id call ioac ; print out message .string ^" TTY # Channel ID Process ID Process RQT " clr r0 ; start with number 0 mov pc,r1 ; get pointer to TTYCH add #ttych-.,r1 ; .... loop < push prqtb-ttych(r1) ; IOAC arg: Process request push pidtb-ttych(r1) ; IOAC arg: Process id push (r1)+ ; IOAC arg: channel id for this tty push r0 ; IOAC arg: TTY number push uoch(r4) ; IOAC arg: channel id call ioac .string ^" ^d ^5o ^d ^d " inc r0 ; move to next tty cmp r0,#ntty ; done all yet?? rptl lo > rts pc ; The LIST_MEMORY prints out the process using that piece ; or tells that it's free and gives its size for either condition memlst: mov fslo,r0 ; get ptr to beginning of free storage push uoch(r4) ; IOAC arg: channel id call ioac ; print out message .string ^"Free Storage Area Usage: " loop < push (r0) ; IOAC arg: number of words in this block bic #100000,(sp) ; make sure "used" bit is off push r0 ; IOAC arg: block start address push uoch(r4) ; IOAC arg: channel id call ioac ; print out message .string ^"Block start: ^6O Number of Words: ^6O " tst (r0) ; is this part of memory in use?? if mi,< ; yes mov r0,r2 ; copy address mov (r0),r1 ; get number of words in block asl r1 ; make it a byte count add r1,r2 ; get ptr to process id that has this block sub #4,r2 ; .... push (r2) ; IOAC arg: process id push uoch(r4) ; IOAC arg: channel id call ioac ; print it out .string ^"In use by Process ^5d " > else < push uoch(r4) ; IOAC arg: channel id call ioac ; print it out .string ^"Block Free " > mov (r0),r1 ; get number of words in block asl r1 ; make byte count add r1,r0 ; move to next address cmp r0,fshi ; done yet?? exitl his rptl > rts pc ; done .sbttl Special purpose commands .if ne asmtek ; TEKSEND command. sends a file to the plotter. ^L seperates ; pages of text. .if ne 0 teksnd: push filep(r4) ; FILARG arg: ptr to filename buffer call filarg ; pick up file name arg push pc ; ATTACH arg: device name add #dskn-.,(sp) ; .... push filep(r4) ; ATTACH arg: file push diskno(r4),#0 ; ATTACH args: unit #,cbits call attach ; open file pop r3,r0 ; vals: channel id, error code if ne,< jmp comerr ; handle error opening file > mov #1,r5 ; r5 contains the page number in the file call tekbeg ; set up the plotter pop r0 ; VALS: error code if ne,< push r3 ; DETACH arg: channel id call detach ; release the file jmp comerr ; report error > loop < call quit ; see if user wants to quit pop * ; VAL: non-zero if we ae to quit bne 3$ ; quit this command and cleanup push r3 ; RCHAR arg: channel id call rchar ; get character pop r0 ; .... bmi 3$ ; if minus then EOF cmp r0,#14 ; check for start of page rptl ne ; not yet 2$: push r5,uoch(r4) ; IOAC args: page number, channel id call ioac ; print message .string ^"Print page #^d ?" push uoch(r4) ; RCHAR arg: channel id call rchar ; read a character pop r0 ; got it push uoch(r4),r0 ; WCHAR args: channel id, character call wchar ; echo the character jsr pc,crlf ; print a CR cmp r0,#'Y ; print plot? exitl eq ; yes!!! cmp r0,#'y ; print plot ? rptl ne ; no!!! exitl > call teksb ; send any stuff remaining in buffer push #teklno ; ALWRIZ arg: line no. call alwriz ; send Plotter On,move to Home position .string ^"AE" loop < push r3 ; RCHAR arg: channel id call rchar ; get next character pop r0 ; got it. bmi 3$ ; if minus then EOF cmp r0,#14 ; is this a break in the page? exitl eq ; yes!!! push r0 ; TEKASC arg: character call tekasc ; output character to the plotter rptl ; do next character > inc r5 ; increment the page number br 2$ ; start the next page 3$: call tekend ; end plotting... push r3 ; DETACH arg: channel id call detach ; relesase the file rts pc .endc ; TEKPLOT command. tekplt: push filep(r4) ; FILARG arg: ptr to filename buffer call filarg ; pick up file name arg push pc ; ATTACH arg: device name add #dskn-.,(sp) ; .... push filep(r4) ; ATTACH arg: file name push diskno(r4),#0 ; ATTACH args: unit #,cbits call attach ; open file pop r3,r0 ; vals: channel id, error code if ne,< jmp comerr ; handle error opening file > clr r5 ; r5 contains the plot number in the file tkplt1: mov #pltstr,r1 ; ptr to string to search for clr r2 ; no. of characters which match so far loop < call quit ; see if user wants to quit pop * ; VAL: non-zero if we are to quit bne tpen3 ; quit this command and cleanup push r3 ; RCHAR arg: channel id call rchar ; read character from plot file pop r0 ; val: character bmi tpen3 ; end of file cmpb r0,(r1) ; this the next character of the plot string? if ne, inc r1 ; advance ptr inc r2 ; and count tstb (r1) ; reached end of plot string? rptl ne ; no, keep going > inc r5 ; increment the plot number clr tekerr ; no error yet push r5,uoch(r4) ; IOAC args: plot number, channel id call ioac ; print message .string ^"Print plot #^d ?" push uoch(r4) ; RCHAR arg: channel id call rchar ; read a character pop r0 ; got it push uoch(r4),r0 ; WCHAR args: channel id, character call wchar ; echo the character jsr pc,crlf ; print a CR cmp r0,#'Y ; print plot? beq 1$ ; yes cmp r0,#'y ; print plot ? bne tkplt1 ; see if more plots in this file 1$: call tekbeg ; setup for plotting pop r0 ; VALS: error code if ne,< push r3 ; DETACH arg: channel id call detach ; release the file jmp comerr ; report error > tploop: call quit ; see if user wants to quit pop * ; VAL: non-zero if we are to quit beq 1$ ; quit this command and cleanup call tekend ; finished plotting br tpen3 ; and exit 1$: tst tekerr ; was there an error on last block sent if ne,< ; yes push uoch(r4) ; IOAC arg: output channel call ioac ; print out error on users terminal .string ^"Plotter Error " clr tekerr ; no error now br tpen1 ; finished with plot if error has happened > jsr pc,tpgetc ; get next plot character br tpen1 ; end of plot mov r0,-(sp) ; copy character so can mung it bic #3,(sp) ; clear low two bits (op code is bits 2-5) asr (sp) ; divide by two for dispatch cmp (sp),#10 if hi,< pop * ; remove bad value from stack err ^"Bad plot file." br tpen1 > add (sp)+,pc ; dispatch on opcode br tplm ; Long Move br tpld ; Long Draw br tpsm ; Short Move br tpsd ; Short Draw br tpac ; ASCII char tpen3: br tpen2 ; this is here for branch range ; Long Move tplm: jsr pc,tpg2 ; get long y coordinate mov r0,lsty ; save last y coordinate push r0 ; TEKMOV arg1: y jsr pc,tpg2 ; get long x coordinate mov r0,lstx ; save last x coordinate push r0 ; TEKMOV arg2: x call tekmov ; move to x,y br tploop ; Long Draw tpld: jsr pc,tpg2 ; get long y coordinate mov r0,lsty ; save last y coordinate push r0 ; TEKDRW arg1: y jsr pc,tpg2 ; get long x coordinate mov r0,lstx ; save last x coordinate push r0 ; TEKMOV arg2: x call tekdrw ; draw vector to x,y br tploop ; Short Move tpsm: mov r0,r2 ; save op code since it has sign bits jsr pc,tpgetc ; read relative y br tpen1 bit #2,r2 ; check op code, is y supposed to be negative? if ne,< neg r0 ; yes, negate value we've got > add r0,lsty ; add to last y value jsr pc,tpgetc ; read relative x br tpen1 bit #1,r2 ; check op code, is x supposed to be negative? if ne,< neg r0 ; yes, negate value we've got > add r0,lstx ; add to last x value push lsty,lstx ; TEKMOV args: y, x call tekmov ; move to specified location br tploop ; Short Draw tpsd: mov r0,r2 ; save op code since it has sign bits jsr pc,tpgetc ; read relative y br tpen1 bit #2,r2 ; check op code, is y supposed to be negative? if ne,< neg r0 ; yes, negate value we've got > add r0,lsty ; add to last y coordinate jsr pc,tpgetc ; read relative x br tpen1 bit #1,r2 ; check op code, is x supposed to be negative? if ne,< neg r0 ; yes, negate value we've got > add r0,lstx ; add to last x coordinate push lsty,lstx ; TEKDRW args: y, x call tekdrw ; draw a vector to specified location br tploop ; ASCII char tpac: bic #177776,r0 ; get low bit of op code which is bit 7 of char swab r0 ; shift to bit 7 asr r0 ; ... push r0 ; push partially formed arg to TEKASC jsr pc,tpgetc ; read low 6 bits of character br tpen1 add r0,(sp) ; add low 6 bits into word with bit 7 call tekasc ; draw character jmp tploop tpen1: call tekend ; terminate plotting jmp tkplt1 ; go do rest of plot file tpen2: push r3 ; DETACH arg: channel id call detach ; close plot file rts pc tekerr: .word 0 pltstr: .asciz "TEK4662 PLOT DATA:" .even ; Read two 6 bit data bytes from plot file and form into 12 bit number. tpg2: jsr pc,tpgetc ; get next char br 1$ swab r0 ; shift right 6 places ash #-2,r0 ; ... mov r0,r1 ; copy jsr pc,tpgetc ; get next char br 1$ add r1,r0 ; add to previous to get 12 bit value 1$: rts pc ; Get 6 bits of data from plot file. tpgetc: push r3 ; RCHAR arg: channel id call rchar ; get next character from file pop r0 ; val: character bmi 1$ ; end of file? cmp r0,#'; ; semicolon gobbles next char if eq,< push r3 ; RCHAR arg: channel id call rchar ; get next character from file pop r0 ; val: character bmi 1$ ; end of file? add pc,r0 ; yes, find correct value from table movb lpct-.-100(r0),r0 ; ... bmi 1$ ; ;C ends plot > else > add #2,(sp) ; return2 1$: rts pc lstx: .blkw 1 ; last X value lsty: .blkw 1 ; last Y value .endc ; ne asmtek .sbttl Command processor subroutines quit: push (sp) ; make room for return value push uich(r4) ; ORDER arg: channel id push #10000+tbreak,#0 ; ORDER arg: order code, order arg call order ; get tbreak word to see if a break ; was typed mov (sp)+,2(sp) ; copy val into return slot and remove ; from stack if ne,< ; non-zero means break key was struck push uich(r4) ; ORDER arg: channel id push #20000+tbreak,#0 ; ORDER arg: order code, order arg call order ; set tbreak back to zero pop * push uoch(r4) ; IOAC arg: channel id call ioac ; tell user a break occurred .string ^" Command interrupted (QUIT) " > return crlf: push uoch(r4) ; IOAC arg: channel id call ioac ; print CR & LF .string ^" " rts pc ; XFRCHN transfers characters from the read channel to the write ; channel and returns when a -1 is read from the read channel. If a ; break is encountered then the operation is aborted and a return is ; performed. xfrchn: push r0 ; save register loop < call quit ; see if user wants to quit pop * ; val: non-zero if break typed exitl ne ; .... push 4(sp) ; RCHAR arg: input channel call rchar ; get next character pop r0 ; got character exitl mi ; -1 returned for eof push 6(sp),r0 ; WCHAR args: output channel,character ; to send call wchar ; send character rptl ; loop until finished reading > pop r0 ; restore register pop (sp),(sp) ; remove args return ; RDCMDL reads a command into the command buffer. ; ARGS: VALS: ; R4: ptr to cs (none) rdcmdl: push r0,r1 ; save regs mov r4,cbufp(r4) ; set ptr to current position in command buf add #cbuf,cbufp(r4) ; ... push uich(r4),uoch(r4) ; READL args: input ch, output ch push cbsize(r4),cbufp(r4) ; READL args: buffer size call readl ; read an input line into the command buffer pop r0 ; val: no. of characters read mov cbufp(r4),cendp(r4) ; ptr to end of buffer add r0,cendp(r4) ; ... pop r1,r0 ; restore regs return ; RDCMDC reads the next character from the command line. ; ARGS: VALS: ; R4: ptr to cs SP -> character rdcmdc: push (sp) ; make return value slot clr 2(sp) ; start off with null return character cmp cbufp(r4),cendp(r4) ; reached end of command yet? if lo,< ; no movb @cbufp(r4),2(sp) ; get character from buffer > inc cbufp(r4) ; increment buffer ptr return ; RRCMDC backs up CBUFP so that the previous character from the command ; line will be reread by the next RCMDC. ; ARGS: VALS: ; R4: ptr to cs (none) rrcmdc: dec cbufp(r4) ; backup buffer ptr to last character read return ; ARG skips over whitespace in the command line. The next character read ; is guarenteed not to be whitespace. ; ARGS: VALS: ; R4: ptr to cs SP -> character arg: push (sp),r0 ; make return value slot, save reg loop < call rdcmdc ; get character pop r0 ; val: character cmp r0,#11 ; TAB? rptl eq cmp r0,#40 ; SP? rptl eq > call rrcmdc ; reread first char of arg mov r0,4(sp) ; return terminating character pop r0 ; restore reg return ; SARG ; ARGS: VALS: ; R4: cs ptr SP -> length ; ptr sarg: push (sp),(sp),r0 ; make two return value slots, save reg mov cbufp(r4),6(sp) ; return current ptr clr 4(sp) ; start off length at zero loop < call rdcmdc ; read character from command line pop r0 ; val: character exitl eq ; exit if reached end of command line cmp r0,#40 ; or if reached end of string (i.e. found exitl eq ; a space) inc 4(sp) ; increment length rptl > call rrcmdc ; reread character which terminated name pop r0 ; restore reg return ; OCTARG will return the value of a octal argument on the stack. ; Null arg implies default to 1. ; ARGS: VALS: ; R4: cs ptr SP -> no. octarg: push (sp) ; make slot for return value jsr r5,save6 ; save regs mov #8.,r5 ; set radix for octal input br ncomn ; NUMARG will return the value of a decimal argument on the stack. ; Null arg implies default to 1. ; ARGS: VALS: ; SP -> cs ptr SP -> no. numarg: push (sp) ; make slot for return value jsr r5,save6 ; save regs mov #10.,r5 ; set radix for decimal input ncomn: call arg ; ignore leading spaces pop * ; val: character clr r1 ; holds no. mov #1,r2 ; default arg if nothing specified loop < call rdcmdc ; read command character pop r0 ; val: character cmp r0,#'0 ; digit? exitl lo cmp r0,#'9 exitl hi sub #'0,r0 mul r5,r1 add r0,r1 mov r1,r2 ; a no. was specified, clobber default rptl > call rrcmdc ; reread the terminating character mov r2,16(sp) ; and put no. in return value slot jsr r5,rest6 ; restore regs return ; CVR50 ; ARGS: VALS: ; R4: cs ptr SP -> rad50 word 2 ; rad50 word 1 cvr50: push (sp),(sp) ; make slots for two return values jsr r5,save6 ; save regs clr r3 jsr r5,cvr1 ; read three chars and pack into rad50 word jsr r5,cvr1 jsr r5,cvr1 mov r3,20(sp) ; return rad50 word 1 clr r3 jsr r5,cvr1 ; three more chars and pack jsr r5,cvr1 jsr r5,cvr1 mov r3,16(sp) ; return rad50 word 2 loop < clr r3 jsr r5,cvr1 ; read characters until non-rad50 char tst r3 rptl ne > jsr r5,rest6 ; restore regs return cvr1: mul #50,r3 ; shove over chars in so far call rdcmdc ; get character pop r0 ; val: character cmp r0,#40 ; don't treat " " or "." as rad50 on input beq 2$ cmp r0,#'. ; ... beq 2$ cmp r0,#' ; but if ^Q then quote next character if eq,< call rdcmdc pop r0 > cmp r0,#'a ; lower case? blo 1$ cmp r0,#'z bhi 1$ bic #40,r0 ; convert to upper case 1$: mov pc,r1 ; ptr to rad50 to ascii convertion table add #r50asc-.,r1 ; ... mov #50,r2 ; size of table loop < cmpb (r1)+,r0 ; this the character? exitl eq sorl r2 2$: call rrcmdc ; not a rad50 character, leave to be reread return > sub pc,r1 ; subtract address of table to get offset sub #r50asc+1-.,r1 ; (which is rad50 character code) add r1,r3 ; add to word we're accumulating return ; FILARG reads a filename argument from the command line. ; ARGS: VALS: ; SP -> filename ptr (none) ; R4: cs ptr filarg: jsr r5,save6 ; save regs mov 16(sp),r3 ; ptr to filename buffer call arg ; ignore spaces before arg pop * ; val: character loop < call cvr50 ; read rad50 name pop r2,r1 ; vals: rad50 word 2, rad50 word 1 call rdcmdc ; get terminating character pop r0 ; val: character cmp r0,#'; ; semicolon? if eq,< mov r1,(r3) ; set directory name rptl > cmp r0,#': ; colon:?? if eq,< ifSAO ifMIT < .if eq sub #71176,r1 ; make disk unit number (RL0=71176) .endc .if eq sub #71436,r1 ; make disk unit number (RP0=71436) .endc > if eq,< ; was it disk 0 clr diskno(r4) ; yes > dec r1 ; check for disk 1 if eq,< mov #1,diskno(r4) ; yes it was > rptl > call rrcmdc ; reread terminator > tst r1 ; any rad50 accumulated? if ne,< mov r1,2(r3) ; yes, set the filename mov r2,4(r3) > cmp r0,#'. ; is rad50 terminator "."? if eq,< call rdcmdc ; read the "." pop * ; val: character call cvr50 ; read more rad50 pop *,6(r3) ; vals: word 2, word 1 (set the extension) > jsr r5,rest6 ; restore regs pop (sp) ; remove arg from stack return ; SCASE ; ARGS: VALS: ; SP -> ptr to command list SP -> ptr to entry ; length error code ; ptr to string scase: jsr r5,save6 ; save regs mov 16(sp),r5 ; ptr to list of strings tst (r5)+ ; skip over 1st word (entry size) loop < mov (r5),r1 ; ptr to asciz string from list if eq,< mov #-1,22(sp) ; return error indication exitl > mov 22(sp),r3 ; ptr to string to lookup mov 20(sp),r2 ; length of string 1$: movb (r3)+,r4 ; get next character of string and inc tstb (r1) ; string from list exhausted? beq 2$ ; if no next character then exit cmpb r4,#'A ; if the next character is a capital we blo 4$ ; want to lowercase it for comparison cmpb r4,#'Z bhi 4$ ; not uppercase at all bisb #40,r4 ; convert to lowercase for comparison 4$: cmpb (r1)+,r4 ; bytes the same in both strings? bne 2$ ; no sob r2,1$ ; keep going until passed string exhausted tstb (r1) ; if the string from list isn't done too bne 2$ ; then no match mov r5,20(sp) ; return ptr to entry clr 22(sp) ; and a zero error code exitl 2$: add @16(sp),r5 ; add entry size to list ptr rptl > jsr r5,rest6 ; restore regs pop (sp) ; remove one slot from stack return 5;;; DEFS - Definitions and configuration data -*-PALX-*- .nlist .auxil ;;; Define YES and NO so they're acceptable SETF answers yes===1 no===0 .macro setf q,a .if ndf a .print "q " .ttymac ans .if ndf ans setf ^"Bad input, try again:",a .mexit .endc a==ans .endm .endc .endm ; Define system names for following question mit===1 ; MIT's PDP 11/34 sao===2 ; SAO's LSI 11/03 lll===3 mit44==4 ; MIT's new PDP 11/44 drl===1 ; RL01 type disk drives drk===2 ; RK05 type disk drives drp===3 ; RP11 type disk drives setf ^"System (MIT, MIT44, SAO, or LLL)?",sys ;define some appropriate macros .if eq * .macro ifMIT code code .endm .macro ifSAO code .endm .macro ifLLL code .endm .macro ifOTHER code .endm .endc ; eq * .if eq sys-sao .macro ifMIT code .endm .macro ifSAO code code .endm .macro ifLLL code .endm .macro ifOTHER code .endm .endc ; eq sys-sao .if eq sys-lll .macro ifMIT code .endm .macro ifSAO code .endm .macro ifLLL code code .endm .macro ifOTHER code .endm .endc ; eq sys-lll .if ne <***> .macro ifMIT code .endm .macro ifSAO code .endm .macro ifLLL code .endm .macro ifOTHER code code .endm .endc ; all other systems .sbttl Math Department's PDP 11/34 system .if eq sys-mit ifMIT < ; Define CPU model pdp11==34 ; PDP11/34 havswr===1 ; presume it has swr, check at runtime now sysdsk===drl ; presume RL01s from henceforth .print "Are you sure you want to assemble for a machine you don't have??" ; No. of various devices nrk==0 ; RK11 nrx==0 ; RX11 nrl==2 ; RL11 nrp==0 ; RP11 ncr==0 ; CR11 nlp==1 ; LPT ndp==0 ; DP11 ndu==1 ; DU11 ; No. of various terminal interfaces ndz==1 ; DZ11 nkl==0 ; KL11, DL11-A,-B ndl==4 ; DL11-C,-D,-E ndc==1 ; DC11 (for simulator) ; Various options pfail===1 ; assemble power fail code > .endc .sbttl Math Department's PDP 11/44 system .if eq sys-mit44 ifMIT < ; Define CPU model pdp11==44 ; PDP11/44 havswr===1 ; it has switch register ;;; find out what disk to use setf ^"System disk (drp, drl, drk)?",sysdsk ; No. of various devices nrk==0 ; RK11 nrx==0 ; RX11 nrl==2 ; RL11 nrp==0 ; RP11 ncr==0 ; CR11 nlp==1 ; LPT ndp==0 ; DP11 ndu==1 ; DU11 .if eq nrp==1 ; have an RP11 nrl==0 ; have no RL11 .endc ; No. of various terminal interfaces ndz==1 ; DZ11 nkl==0 ; KL11, DL11-A,-B ndl==4 ; DL11-C,-D,-E ndc==1 ; DC11 (for simulator) ; Various options pfail===0 ; don't assemble power fail code > .endc .sbttl Orszag's LSI11 system ifSAO < ; Define CPU model pdp11==03 ; LSI11 sysdsk===0 ; No. of various devices nrk==0 ; RK11 nrx==1 ; RX11 nrl==0 ; RL11 nrp==1 ; RP11 ncr==0 ; CR11 nlp==1 ; LPT (well, actually a terminet kludge..) ndp==0 ; DP11 ndu==1 ; DU11 ; Maximum no. of various terminal interfaces ndz==0 ; DZ11 nkl==3 ; KL11, DL11-A,-B ndl==2 ; DL11-C,-D,-E ndc==0 ; DC11 ; Various options pfail===0 ; no power fail code > .sbttl LLL (S1 project LSI-11) ifLLL < ; Define CPU model pdp11==03 ; LSI11 sysdsk===0 ; No. of various devices nrk==0 ; RK11 nrx==1 ; RX11 nrl==0 ; RL11 nrp==0 ; RP11 ncr==0 ; CR11 nlp==1 ; LPT ndp==0 ; DP11 ndu==0 ; DU11 ; Maximum no. of various terminal interfaces ndz==0 ; DZ11 nkl==1 ; KL11, DL11-A,-B ndl==0 ; DL11-C,-D,-E ndc==0 ; DC11 ; Various options pfail===0 ; no power fail code > .sbttl Configuration calculations ; Floating vector address calculation ifSAO < dpv==0 ; no DP11 dzv==0 ; no DZ11 klv==300 ; DLV11-J first vector interrupt address dlv==330 ; DLV11s from here on duv==350 ; DUV11 > ifMIT < dpv==300 ; DP11 klv==0 ; no KL11, DL11-A,-B dlv==310 ; DL11-C,-D,-E dzv==350 ; DZ11 duv==360 ; DU11 > ; Floating address calculation ifSAO < duaddr==160010 ; address of 1st DU11 dzaddr==0 ; no DZ11 > ifMIT < duaddr==160010 ; address of 1st DU11 dzaddr==160020 ; address of 1st DZ11 > .sbttl Register definitons r0=%0 r1=%1 r2=%2 r3=%3 r4=%4 r5=%5 sp=%6 pc=%7 .xcref r0,r1,r2,r3,r4,r5,sp,pc ; Assume a switch register for most cpus, none for 11/03 and ask for 11/34. .if ndf havswr .iif eq pdp11-03, havswr===0 .iif eq pdp11-34, setf ^"Does your 11/34 have the real programmer's console?",havswr .endc .iif eq pdp11-44, havswr===1 ; PDP11/44 has a switch register!!! .iif ndf havswr, havswr===1 .if ne havswr swr==177570 ; switch register .endc .lif ne pdp11-03 ps==177776 ; processor status word .if ndf memman .iif eq *, memman===0 .ielse memman===1 .endc .if ndf eis .iif eq *, eis===0 .ielse eis===1 .endc pr0==000 ; processor priority definitions pr1==040 pr2==100 pr3==140 pr4==200 pr5==240 pr6==300 pr7==340 .lif ne pdp11-03 lks==177546 ; line clock tks==177560 ; console tty registers tkb==177562 tps==177564 tpb==177566 .if ne nrk rkdsr==177400 ; RK11 disk registers rkerr==177402 rkcsr==177404 rkwcr==177406 rkbar==177410 rkdar==177412 .endc .if ne nrl rlcsr==174400 ; RL11 disk registers rlbar==174402 rldar==174404 rlmpr==174406 .endc .if ne nrp rpcou1==176700 rpcou2==176702 rpcou3==176704 rpcou4==176706 rpdsr==176710 rperr==176712 rpcsr==176714 rpwcr==176716 rpbar==176720 rpcar==176722 rpdar==176724 rpm1r==176726 rpm2r==176730 rpm3r==176732 rpsucr==176734 rpsilo==176736 .endc .if ne nrx rxcs==177170 ; floppy disk control/status register rxdb==177172 ; floppy disk data buffer register .endc .if ne nlp lps==177514 lpb==177516 lvs==177510 lvb==177512 .endc .sbttl Instruction macros .if ne pdp11-03 .if ne pdp11-34 ; MTPS and MFPS macros simulate PS intructions on 11/03 (LSI) ; and 11/34 processors. .macro mtps src movb src,@#ps .endm .macro mfps dst movb @#ps,dst .endm .endc .endc .if ne pdp11-44 .if ne pdp11-45 .if ne pdp11-70 ; SPL macro changes the the priority to its argument. It ; (unfortunately) does this with a MOV, thus clobbering ; the condition codes and such. .macro spl n .iif ne n, mtps #n*40 .else .iif eq pdp11-03, mtps #0 .ielse clrb @#ps .endc .endm .endc .endc .endc .if eq * ; SOB macro expands into code which performs identically to ; the SOB instruction found on more powerfull 11 processors .macro sob r,addr dec r bne addr .endm ; RTT macro expands into a RTI. This is so RTTs can be used in ; places where they would be called for on 11/40s, 11/45s etc. .macro rtt rti .endm ; XOR macro simulates XOR instruction on 11/45. ; Caution: this macro is not intended to work with ; (Rn)+, -(Rn) or (SP) destinations. .macro xor r,d mov r,-(sp) bic d,(sp) bic r,d bis (sp)+,d .endm ; SXT macro performs sign extend as on PDP11/45. .macro sxt d if mi,< mov #-1,d > else < clr d > .endm .endc ; eq * .if eq eis ; ASH macro generates a series of ASR or ASL instructions to ; simulate the 11/45 ASH instruction. .macro ash src,r .ntype %.m,r .iif ne %.m&70, .error ASH dst must be register .ntype %.m,src .iif ne %.m-27, .error ASH macro must have constant shift %.m===0'src .if ge %.m .rept %.m asl r .endr .iff .rept -%.m asr r .endr .endc .endm ; MUL macro generates call to either MUL1 or MUL2 depending upon ; whether register destination is even or odd. Simulates 11/45 MUL. .macro mul src,r .ntype %.m,r .iif ne %.m&70, .error MUL dst must be register push src,r .iif ne %.m&1, jsr r5,mul1 .ielse jsr r5,mul2 pop r .iif eq %.m&1, pop r+1 .endm ; DIV macro generates call to DIV2 to simulate 11/45 DIV instruction. .macro div src,r .ntype %.m,r .iif ne %.m&70, .error DIV dst must be register push r,r+1,src jsr r5,div2 pop r+1,r .endm .endc ; eq eis .sbttl Random macros .macro push a0,a1,a2,a3,a4,a5,a6,a7 .irp d, .if idn d,#0 clr -(sp) .iff .lif nb d mov d,-(sp) .endc .endm .endm push .macro pop a0,a1,a2,a3,a4,a5,a6,a7 .irp d, .if idn d,* tst (sp)+ .iff .lif nb d mov (sp)+,d .endc .endm .endm pop .macro typval text .print ïtextŠ .endm ; .EXIT bootloads BOOT. .macro .exit ifMIT < reset mov #174400,r0 tstb (r0) bpl .-2 mov #13,4(r0) mov #4,(r0) tstb (r0) bpl .-2 mov #77601,4(r0) mov #6,(r0) tstb (r0) bpl .-2 mov #177400,6(r0) mov #0,4(r0) mov #0,2(r0) mov #14,(r0) tstb (r0) bpl .-2 clr pc > ifSAO < jmp @#173000 > ifOTHER < ; all other systems, jump to hardware boot .iif ndf asmrt1, asmrt1===0 ; if we don't know what asmrt1 is default to 0 .if eq asmrt1 jmp @#173000 .iff mov pc,r0 ; don't do an HRESET, we can be restarted emt 350 ; return to rt-11 > .endm ; DSECT defines a dummy section, used to define symbols ; that are offsets from a register (or some other variable). ; An optional second argument is set to length of structure. ; Example of use: ; DSECT < PCBNEXT: 0 ;PCBNEXT=0 ; PCBLAST: 0 ;PCBLAST=2 ; PCBFOOO: 0 ; > .macro dsect sect,len .if p1 ; define symbols only on pass 1 %.dtmp===. .=0 sect .iif nb len, len==. .=%.dtmp .endc .endm ; Text accumulation macros. TXTINT creates a text segment of the ; specified name. APPEND appends text to that segment. To insert the ; accumulated text into the assembly merely use the segment's name. .macro txtint name .macro name op1,op2,op3 op1'op2 op3 .endm name .endm txtint .macro append name,newcft .nlist name ^|.macro name op1,op2,op3 op1|,^|newcft'op2 op3|,.endm .list .endm append .sbttl Flow of control macros ; IF macro: Generates code that executes the if clause ; if the specified conditon is true, the else clause if ; it is false. The else clause is not required. Example: ; if eq,< ; mov r0,r1 ; mov (r1)+,r2 ; > ; else < ; jsr pc,foo ; > .macro if cond,code .nlist gncnt===gncnt+1 .irp foo,\gncnt .iif p1, .word 0 .else %.itmp===>/2 .iif gt %.itmp-377, .error Branch out of range .iif lt %.itmp+377, .error Branch out of range .iif eq &400, +%.itmp+400 .ielse +%.itmp-400 .endc code g'foo===. ifcnt===foo .endm .irp .list .endm if .macro else code gncnt===gncnt+1 .irp foo,\ifcnt .irp bar,\gncnt br g'bar g'foo===. code g'bar===. .endm .endm .endm else gncnt===777 ; gensym count ; LOOP macro allows loops without labels. Use RPTL and EXITL ; to repeat loop and exit loop. Both take branch condition arguments. ; If condition arg is null, then BR is used, i.e. unconditional. ; End of CODE falls out of loop unless specific RPTL is used. ; Example of LOOP macro: ; loop < cmpb r0,(r1)+ ; found char yet? ; exitl eq ; exit loop on equal ; inc r2 ; not found ; cmp r2,r5 ; too many? ; rptl lt ; no, keep going ; jmp error ; too many ; > ; ; EXITL comes here ; LOOP defines two lables around the code argument, ; the first for looping back via the RPTL macro, the ; second for exiting the loop via the EXITL macro. ; Labels are of the form %Ln or %Xn where n signifies ; that this is the nth use of the LOOP macro. %Yv ; gives the loop number of the v'th level of nesting. ; Up to 7 levels of nesting are allowed. %level===0 %loopn===0 .macro loop code %loopn===%loopn+1 .if gt %loopn-7777 .error Too many loops (maximum of 4095) .mexit .endc %level===%level+1 .if gt %level-7 .error Loop depth exceeds 7 .mexit .endc .irp n,\%level %y'n===%loopn .endm .irp n,\%loopn %l'n===. ; loop back to here code %x'n===. ; exit to here .endm %level===%level-1 .endm loop .macro rptl cond .if eq %level .error RPTL not inside LOOP .mexit .endc .irp n1,\%level .irp n2,\%y'n1 .iif b cond, br %l'n2 .ielse b'cond %l'n2 .endm .endm .endm rptl ; SORL expands into a SOB instruction back to the last LOOP ; point. SORL takes one arg, a register to use with the SOB ; instruction. .macro sorl r .if eq %level .error SORL not inside LOOP .mexit .endc .irp n1,\%level .irp n2,\%y'n1 sob r,%l'n2 .endm .endm .endm sorl .macro exitl cond .if eq %level .error EXITL not inside LOOP .mexit .endc .irp n1,\%level .irp n2,\%y'n1 .iif b cond, br %x'n2 .ielse b'cond %x'n2 .endm .endm .endm exitl .sbttl Literal macros ; Literal macros -- deposit literals into contants area which ; will have length %.clen. .iif p1, %.clen===0 ; start off length 0 ; .LITRL macro will store a literal -- a block of code that ; is the first argument to .LITRL. The literal is stored in ; the constant area at %.CONSTA, and will be forced to an even ; address. If there is no second argument the pointer to the ; literal will be stored inline; if there is a second arg the ; second arg will be set to the literal's pointer value. ; For example: ; The following stores a pointer to a string of bytes (0,1,2...) ; at location foo: ; foo: .litrl ^" ; .byte 0,1,2,3,4,5" ; The following sets foo to a pointer to a block of words and ; bytes (0,1,2,...): ; .litrl ^" ; .word 0,1,2 ; .byte 3,4,5",foo .macro .litrl litarg,litptr .nlist .if p1 %.ctmp===. .even litarg ; stick literal here now so can find its length %.clen===<<%.clen+1>&177776>+.-<<%.ctmp+1>&177776> .=%.ctmp .iff %.ctmp===. .=%.consta .even %.cadr===. litarg ; actual storage of literal %.consta===. .=%.ctmp .endc .if b litptr .even .word %.cadr-. ; deposit ptr to literal .iff litptr==%.cadr ; set ptr to pt to literal .endc .list .endm ; The .STRING macro stores an asciz string in the constants area, ; at %.CONSTA, and either stores the pointer to that string ; at the .STRING, or sets a value (if there is a second arg). ; For example, the following stores, at FOO, a relative pointer ; to the asciz string "hello": ; FOO: .string ^"hello" ; The following sets foo to a pointer to asciz string "hello": ; .string ^"hello",foo .macro .string text,strptr .nlist .if p1 %.clen===%.clen+.length ^ïtext¬+1 .iff %.ctmp===. .=%.consta %.cadr===. .asciz ïtextŠ %.consta===. .=%.ctmp .endc .if b strptr .word %.cadr-. .iff strptr==%.cadr .endc .list .endm ; CONSTANTS causes space to be allocated for the constants ; generated by .LITRL and .STRING .macro constants .nlist .even %.consta===. ; constants will be assembled here. .=.+%.clen ; reserve space for them. .even .if p1 .if gt %.clen .print " Constants area " typval \%.clen .print " bytes, From " typval \%.consta .print " to " typval \.-1 .print " inclusive. " .endc .endc .list .endm constants .list 78;;; Trantor disk routines -*-PALX-*- dkvn==%fnam2 .if ne nrp lblk==512. ; length of disk blocks in bytes nsecto==10. ; no. of sectors per track ntrack==6300. ; no. of tracks per disk mfdb==172723 bm1b==172725 nbm==102 ; no. of bitmap blocks lstblk==172723 .endc .if ne nrk lblk==512. ; length of disk blocks in bytes nsecto==12. ; no. of sectors per track ntrack==406. ; no. of tracks per disk mfdb==11272 bm1b==11273 nbm==5 ; no. of bitmap blocks lstblk==11272 .endc .if ne nrx lblk==128. ; length of disk blocks in bytes nsecto==26. ; no. of sectors per track ntrack==77. ; no. of tracks per disk mfdb==2 bm1b==3 nbm==3 ; no. of bitmap blocks lstblk==177777 .endc .if ne nrl lblk==256. ; length of disk blocks in bytes nsecto==26. ; no. of sectors per track ntrack==256. ; no. of tracks per disk mfdb==47750 ; block containing the MFD bm1b==47752 ; first bit map block nbm==26 ; number of bit maps lstblk==47750 ; do not alloacte this block or any higher .endc ;;; File System Structure - DOS ;;; UFD entry dsect < dufiln:: .blkw 3 ; 1st word of filename dudate:: .blkw 1 ; bit 15-12 are type, rest is date dubytc:: .blkw 1 ; byte count of last block dustart:: .blkw 1 ; starting block number dulen:: .blkw 1 ; length of file in blocks duend:: .blkw 1 ; block number of last block duprot:: .blkb 1 ; protecion code duuse:: .blkb 1 ; usage count >,lufde .sbttl Disk DIM Definition disk: defdim datt,ddet,dorder,dread,dwrite,ddel,dren,drfus dsect < ; Channel block .blkw 4 ; file name dnull:: .blkw 4 ; null file name (for finding free UFD slots) dctrlb:: .blkw 1 ; control bits from Attach ddskno:: .blkw 1 ; disk no. of file ddirbp:: .blkw 1 ; directory block ptr ddirep:: .blkw 1 ; directory entry ptr dfilbp:: .blkw 1 ; current file block ptr dfilbn:: .blkw 1 ; current block position in file (1 origin) dfilps:: .blkw 1 ; byte offset of next byte to r/w in ; current block >,ldchb ;;; DINIT is the disk DIM initializer. dkinit: clr dblist ; set list of disk blocks to nil clr dbmp ; no current bitmap return .sbttl Attach Entry ;;; DATT is the disk DIM attach entry point. ;;; ARGS: VALS: ;;; R1: unit number R0: error code ;;; R2: control bits R4: DIM data word for channel ;;; R3: file name ptr datt: push #ldchb/2,#2*60. ; ALOCW args: size, timeout call alocw ; allocate a channel data block pop r4,r0 ; vals: ptr, error code bne dabad4 ; no memory for channel block, return error mov (r3)+,(r4)+ ; copy file name into channel data block mov (r3)+,(r4)+ ; (later this can become parse) mov (r3)+,(r4)+ ; ... mov (r3)+,(r4)+ ; ... sub #10,r4 ; get ptr back to data block mov r2,dctrlb(r4) ; save control bits in channel data block mov #1,dfilbn(r4) ; start at block 1 bit #%icrea,r2 ; create a new file or look for old one? bne dac ;;; Attach existing file. push r1 ; DLOOK arg: disk unit number push r4 ; DLOOK arg: ptr to filename call dlook ; find the file pop r2,r1,r0 ; vals: entry ptr, block ptr, error code if ne,< jmp dabad3 > mov r1,ddirbp(r4) ; save directory block ptr mov r2,ddirep(r4) ; save ptr to entry in directory block mov ddno(r1),ddskno(r4) ; save disk no. file is on bit #%iupd,dctrlb(r4) ; update permission desired? if ne,< tstb duuse(r2) ; updating requested, file being used? if ne,< mov #%enafi,r0 ; give file not available error br dabad1 > bisb #200,duuse(r2) ; set lock bit so no one else mungs file > push ddskno(r4),dustart(r2) ; DGETB args: disk no., block no. call dgetb ; get first block of file pop dfilbp(r4),r0 ; vals: block ptr, error code bne dabad1 mov #2,dfilps(r4) ; set current position in block to start incb duuse(r2) ; increment usage count mov pc,dwtf(r1) ; set flag to show block has been written dabad4: return ;;; Create a new file rather than using an existing one. dac: mov (r4),dnull(r4) ; set directory name in null filename mov r1,r3 ; save disk unit # in case no free slots push r1 ; DLOOK arg: disk unit number push r4 ; DLOOK arg: ptr to filename add #dnull,(sp) ; ... call dlook ; look for a empty slot in directory pop r2,r1,r0 ; vals: ptr to entry, block ptr, error code if ne,< cmp r0,#%ensfl ; file not found? (i.e. no empty slots) bne dabad3 ; no some other error ;;; No empty slots in directory. Allocate new directory block. push r3 ; DUICLK arg: disk unit number push (r4) ; DUICLK arg: directory name call duiclk ; read in 1st directory block pop r2,r0 ; vals: block ptr, error code bne dabad3 push ddno(r2) ; DALLOC arg: disk no. call dalloc ; allocate another block for dir on same disk pop r1,r0 ; vals: block ptr, error code bne dabad2 mov (r2),(r1) ; copy link in 1st block to new (second) block mov dblk(r1),(r2) ; put link to new block in 1st block mov pc,dwtf(r2) ; indicate blocks modified mov pc,dwtf(r1) ; ... push r2 ; DRELB arg: block ptr call drelb ; release 1st directory block pop r0 ; val: error code bne dabad1 mov r1,r2 ; set entry ptr to first slot in new block tst (r2)+ ; ... > ;;; Ptr to directory block in R1. Ptr to free slot in directory block in R2. mov r1,ddirbp(r4) ; save ptr to directory block mov r2,ddirep(r4) ; save ptr to directory entry mov ddno(r1),ddskno(r4) ; set file's disk no. to dir's disk no. push ddskno(r4) ; DALLOC arg: disk no. call dalloc ; allocate first file block on same disk as dir pop dfilbp(r4),r0 ; vals: block ptr, error code bne dabad1 mov #2,dfilps(r4) ; set current position in block to start mov 2(r4),(r2)+ ; copy file name into directory entry mov 4(r4),(r2)+ ; ... mov 6(r4),(r2)+ ; ... call time ; get current date/time call cvbtf ; convert to file system date pop (r2)+ ; CVBTF val: date, copy into directory entry clr (r2)+ ; set byte count of last block to zero mov dfilbp(r4),r3 ; get block ptr to first block mov dblk(r3),(r2)+ ; set start block no. mov #1,(r2)+ ; set length to 1 mov dblk(r3),(r2)+ ; set end block no. mov #100633,(r2)+ ; protect code = 233, lock bit, usage count = 1 mov pc,dwtf(r1) ; set block written flag return dabad1: push r1 ; DRELB arg: block ptr call drelb ; release new directory block pop * ; val: error code br dabad3 dabad2: push r2 ; DRELB arg: block ptr call drelb ; release directory block pop * ; val: error code dabad3: push r4 ; FREE arg: ptr call free ; free disk channel data block return ;;; Order entry dorder: clr r0 return .sbttl Detach Entry ;;; DDET ;;; ARGS: VALS: ;;; R4: channel data block ptr (none) ddet: push dfilbp(r4) ; DRELB arg: block ptr call drelb ; release current file block pop * ; val: error code call dubm ; update bitmaps mov ddirbp(r4),r1 ; get directory block ptr mov ddirep(r4),r2 ; get directory entry ptr bit #%icrea+%iupd,dctrlb(r4) ; creating or updating this file? if ne,< mov dfilps(r4),dubytc(r2) ; put no. of bytes in last block sub #2,dubytc(r2) ; in directory push r1,r2 ; save regs mov r4,r3 ; DDEL arg: ptr to filename mov ddno(r1),r1 ; put disk unit number in R1 call ddel ; delete any files of same name pop r2,r1 ; restore regs > decb duuse(r2) ; decrement usage count cmpb duuse(r2),#300 ; lock and del bits set and usage zero? if eq,< bicb #100,duuse(r2) ; clear del bit clr (r2)+ ; clear filename to set entry free clr (r2)+ clr (r2)+ push ddno(r1),dustart-6(r2) ; DDF args: disk no., block no. call ddf ; delete the file pop * ; val: error code > cmpb duuse(r2),#200 ; locked and usage zero? if eq,< clrb duuse(r2) ; clear lock bit > mov pc,dwtf(r1) ; set block has been written flag push r1 ; DRELB arg: block ptr call drelb ; release the directory pop * ; val: error code push r4 ; FREE arg: ptr call free ; free DWDAT return drfus: crash ^"No peeking on the disk" .sbttl Write Entry ;;; DWRITE ;;; ARGS: VALS: ;;; R0: character (none) ;;; R4: channel data block ptr dwrite: bit #%iupd,dctrlb(r4) ; writing allowed? if eq,< lose %ebdio ; give bad i/o error > mov dfilbp(r4),r1 ; get block ptr to current block cmp dfilps(r4),#lblk ; room left in this file block? if eq,< ; no, get another tst (r1) ; link zero, i.e. no more blocks? if eq,< 1$: push ddskno(r4) ; DALLOC arg: disk no. call dalloc ; allocate another file block pop r2,* ; vals: block ptr, error code if ne,< lose %efldv ; give full device error br 1$ ; try again if continued > mov dblk(r2),(r1) ; graft block onto end of file mov ddirep(r4),r3 ; get directory entry ptr inc dulen(r3) ; add one to file length mov dblk(r2),duend(r3) ; and set last block no. mov ddirbp(r4),r3 ; get directory block ptr mov pc,dwtf(r3) ; set flag to show block has been written > else < push ddskno(r4),(r1) ; DGETB args: disk no., block no. call dgetb ; get next file block pop r2,* ; vals: block ptr, error code if ne,< lose %ebdda ; give bad data error > > push r1 ; DRELB arg: block ptr call drelb ; release current file block pop * ; val: error code mov r2,dfilbp(r4) ; make next block the current one mov r2,r1 ; ... inc dfilbn(r4) ; advance virtual block no. mov #2,dfilps(r4) ; set offset to first data byte > mov r1,r2 ; copy ptr to block add dfilps(r4),r2 ; add offset to get ptr to current pos movb r0,(r2) ; put byte into file block mov pc,dwtf(r1) ; indicate file block modified inc dfilps(r4) ; update offset return .sbttl Read Entry ;;; DREAD ;;; ARGS: VALS: ;;; R4: channel data block ptr R0: character dread: mov dfilbp(r4),r1 ; get ptr to current file block mov ddirep(r4),r2 ; get ptr to directory entry cmp dfilbn(r4),dulen(r2) ; reading from last block of file? if eq,< ; yes, check if beyond last char mov dubytc(r2),r3 ; get no. of bytes in last block cmpb (r3)+,(r3)+ ; add 2 to skip link word cmp dfilps(r4),r3 ; current position beyond last byte? if eq,< mov #-1,r0 ; yes, return end of file indication return > > cmp dfilps(r4),#lblk ; at end of current file block? if eq,< push r1 ; DGNEXT arg: block ptr call dgnext ; get next file block pop r1,r0 ; vals: block ptr, error code if ne,< ; some error, could be %EENFI or disk err mov #-1,r0 ; return end of file indication return > inc dfilbn(r4) ; advance virtual block no. of current position mov r1,dfilbp(r4) ; set block ptr to new current block mov #2,dfilps(r4) ; set offset to first data position of block > mov r1,r2 ; copy ptr to file block add dfilps(r4),r2 ; add offset to get ptr to current pos in block movb (r2),r0 ; get character bic #177600,r0 ; remove unwanted gunk since this a good char inc dfilps(r4) ; increment offset return .sbttl Delete and Rename ;;; DDEL ;;; ARGS: VALS: ;;; R1: Unit number R0: error code ;;; R3: file name ddel: push r1,r3 ; DLOOK arg: unit number, ptr to filename call dlook ; lookup filename pop r2,r1,r0 ; vals: ptr to entry, ptr to block, error code bne 1$ bitb #77,duuse(r2) ; file in use? if ne,< bisb #300,duuse(r2) ; set lock and delete bits mov pc,dwtf(r1) ; set flag to write back out push r1 ; DRELB arg: block ptr call drelb ; release directory block pop r0 ; val: error code br 1$ > push ddno(r1),dustart(r2) ; DDF args: disk no., block no. of file clr (r2)+ ; clear filename to indicate entry free clr (r2)+ clr (r2)+ mov pc,dwtf(r1) ; set flag so block is written back push r1 ; DRELB arg: block ptr call drelb ; release directory block pop r0 ; val: error code bne 1$ call ddf ; delete file (arg on stack from above) pop r0 ; val: error code 1$: return ;;; DREN ;;; ARGS: VALS: ;;; R3: old file name R0: error code ;;; R2: new file name ;;; R1: disk unit number dren: push r1,r3 ; DLOOK arg: disk unit #, ptr to filename call dlook ; lookup filename pop r3,r1,r0 ; vals: ptr to entry, ptr to block, error code bne 1$ tst (r2)+ ; bump ptr over directory name mov (r2)+,(r3)+ ; copy new file name over old mov (r2)+,(r3)+ ; ... mov (r2)+,(r3)+ ; ... mov pc,dwtf(r1) ; indicate block written push r1 ; DRELB arg: block ptr call drelb ; release directory block pop r0 ; val: error code 1$: return ;;; MOUNT prepares a file system for use. ;;; ARGS: VALS: ;;; SP -> disk no. SP -> error code mount: jsr r5,save6 ; save regs mov 16(sp),r5 ; get disk no. push r5 ; DSKTST arg: disk no. jsr r5,dsktst ; see if disk there pop 16(sp) ; val: error code bne 5$ ; exit if error mov r5,r4 ; copy asl r4 ; times two for word operations add pc,r4 ; for PICness add #dfree-.,r4 ; get ptr to DFREE word for disk ;;; Count no. of free blocks clr (r4) ; start no. of free blocks at zero mov #nbm-1,dbmno ; start bitmap no. at highest bitmap loop < push r5,dbmno ; DGBM args: disk no., bitmap no. call dgbm ; get bitmap pop r1 ; val: block ptr add #10,r1 ; bump ptr up to 1st bitmap word in block mov #74,r2 ; no. of words in bitmap loop < mov (r1)+,r0 ; get bitmap word com r0 ; complement so bit set for free block loop < asl r0 ; test high bit and for word zero exitl eq adc (r4) ; increment free count if bit set rptl > adc (r4) ; increment free count if bit set sorl r2 > sub #200,r1 ; get block ptr again push r1 ; DRBM arg: block ptr to bitmap call drbm ; release bitmap dec dbmno ; move to another bitmap rptl pl ; stop after bitmap no. zero > clr dbmno ; start off with bitmap no. zero ;;; Now grovel over disk structure, making it fit to use. All locked ;;; files are deleted and all usage counts set to zero. sub #dmsfs,sp ; create stack variables push r5,#mfdb ; DGETB args: disk no., block no. call dgetb ; read in MFD pop r4,16+dmsfs(sp) ; vals: block ptr, error code bne 4$ mov r4,dmfbp(sp) ; save ptr to MFD tst (r4)+ ; get ptr to 1st entry mov #/10,dmfcnt(sp) ; get no. of slots in MFD loop < tst (r4) ; slot empty? beq 2$ mov 2(r4),dufbn(sp) ; slot occupied, get UFD starting block no. beq 2$ loop < push r5,dufbn+2(sp) ; DGETB args: disk no., block no. call dgetb ; read in UFD block pop r3,16+dmsfs(sp) ; vals: block ptr, error code bne 3$ mov r3,r2 ; copy ptr mov (r2)+,dufbn(sp) ; save block no. of next UFD block mov #/lufde,r1 ; get no. of slots in UFD block loop < bisb duuse(r2),dwtf(r3) ; will need to write if usage nonzero bicb #177,duuse(r2) ; clear usage count, check lock bit if ne,< clr (r2) ; for now delete locked files by simply clr 2(r2) ; removing entry from UFD (blocks not freed clr 4(r2) ; since might have been reused). clrb duuse(r2) ; clear lock bit > add #lufde,r2 ; move ptr to next UFD slot sorl r1 > push r3 ; DRELB arg: block ptr call drelb ; release UFD block pop 16+dmsfs(sp) ; val: error code bne 3$ tst dufbn(sp) ; another UFD block? rptl ne > 2$: add #10,r4 ; move to next MFD slot dec dmfcnt(sp) ; done them all yet? rptl ne > 3$: push dmfbp(sp) ; DRELB arg: block ptr call drelb ; release the MFD pop * ; val: error code beq 4$ crash ^"Can't release MFD" 4$: add #dmsfs,sp ; remove variables from stack 5$: jsr r5,rest6 ; restore regs return dsect < ; Define stack variable offsets dmfbp:: .blkw 1 ; MFD block ptr dmfcnt:: .blkw 1 ; no. of entries in MFD left to go dufbn:: .blkw 1 ; current UFD block no. >,dmsfs .if ne nrl dsktst: jmp rltest ; jump to test routine, disk # on stack .endc .if ne nrp dsktst: jmp rptest ; jump to test routine, disk # on stack .endc .if ne nrx dsktst: jmp rxtest ; jump to test routine, disk # on stack .endc .if ne nrk dsktst: jmp rktest ; jump to test routine, disk # on stack .endc .sbttl Directory lookup ;;; DLOOK ;;; ARGS: VALS: ;;; SP -> filename ptr SP -> ptr to entry ;;; disk unit number block ptr ;;; error code dlook: push (sp) ; make room for three return vals jsr r5,save6 ; save regs mov 20(sp),r1 ; get ptr to file name push 22(sp) ; DUICLK arg: disk unit number push (r1) ; DUICLK arg: directory name call duiclk ; lookup up directory name pop r3,22(sp) ; vals: block ptr, error code bne 2$ loop < mov r3,r4 ; get ptr to first entry tst (r4)+ ; ... mov #/lufde,r0 ; no. of entries per directory block loop < tst 20(r4) ; locked? bmi 1$ cmp (r4),2(r1) ; compare filenames bne 1$ cmp 2(r4),4(r1) bne 1$ cmp 4(r4),6(r1) if eq,< mov r4,16(sp) ; return ptr to entry in directory mov r3,20(sp) ; return ptr to directory block br 2$ > 1$: add #lufde,r4 ; move to next entry in this block sorl r0 > push r3 ; DGNEXT arg: block ptr call dgnext ; get next block of UFD pop r3,22(sp) ; vals: block ptr, error code rptl eq cmp 22(sp),#%eenfi ; end of UFD or real error? exitl ne mov #%ensfl,22(sp) ; set error code to "file not found" > 2$: jsr r5,rest6 ; restore regs return .sbttl MFD lookup ;;; DUICLK ;;; ARGS: VALS: ;;; SP -> dir name SP -> block ptr ;;; disk unit number error code duiclk: jsr r5,save6 ; save regs mov 16(sp),r5 ; get directory name beq 2$ ; if dir=0 then don't look it up mov 20(sp),r4 ; get disk unit number push r4,#mfdb ; DGETB args: disk no., block no. call dgetb ; read in MFD pop r2,20(sp) ; vals: block ptr, error code bne 3$ 1$: mov r2,r1 ; get ptr to first entry tst (r1)+ ; ... mov #/10,r0 ; get no. of slots in MFD (10 bytes per entry) loop < cmp (r1),r5 ; this the desired directory name? if eq,< push r4,2(r1) ; DGETB args: disk no., block no. (call below) push r2 ; DRELB argument: block ptr call drelb ; release MFD block pop * ; val: error code call dgetb pop 16+2(sp),20(sp) ; vals: block ptr, error code br 3$ > add #10,r1 ; move to next entry in MFD sorl r0 > push r2 ; DGNEXT arg: block ptr jsr r5,dgnext ; get next MFD block pop r2,* ; vals: ptr, error code beq 1$ ; if no error then look through this block 2$: mov #%ensdi,20(sp) ; return no such directory error 3$: jsr r5,rest6 ; restore regs return .sbttl DDF ;;; DDF ;;; ARGS: VALS: ;;; SP -> starting block no. SP -> error code ;;; disk no. ddf: jsr r5,save6 ; save regs mov 20(sp),r4 ; get disk no. mov 16(sp),r3 ; get starting block no. if ne,< loop < mov r3,r1 ; copy block no. push r4,r3 ; DGETB args: disk no., block no. call dgetb ; read in block pop r5,20(sp) ; vals: ptr, error code bne 1$ mov (r5),r3 ; get next block no. push r5 ; DRELB arg: block ptr call drelb ; release this block pop * ; val: error code clr r0 ; for DIV div #1700,r0 ; get bitmap no. and offset push r4,r0 ; DGBM args: disk no., bitmap no. call dgbm ; get bitmap pop r5 ; val: ptr mov r1,r0 ; copy offset ash #-3,r1 ; get byte offset add r1,r5 ; add to block ptr bic #177770,r0 ; get no. of bit position bitb bits(r0),10(r5) ; bit already clear? if eq,< ; yes, don't clear anymore!! clr r3 ; by clearing next block no. sub r1,r5 ; restore ptr to block > else < bicb bits(r0),10(r5) ; clear bit for this block in bitmap sub r1,r5 ; restore ptr to block mov pc,dwtf(r5) ; set flag to show block written mov r4,-(sp) ; get ptr to DFREE word for disk asl (sp) ; ... add pc,(sp) ; ... add #dfree-.,(sp) ; ... inc @(sp)+ ; add one to no. of free blocks > push r5 ; DRBM arg: block ptr call drbm ; release bitmap tst r3 ; another block? rptl ne > > 1$: call dubm ; update bitmaps jsr r5,rest6 ; restore regs pop (sp) ; remove one arg from stack return .sbttl Linked file subr ;;; DGNEXT gets the next block of a file, UFD, MFD etc. given the current ;;; block. The first word of the current block specifies the block no. of ;;; the next block on the same disk. If there is no next block (i.e. the ;;; next block no. is zero) then a %EENFI error code is returned. ;;; ARGS: VALS: ;;; SP -> block ptr SP -> block ptr ;;; error code dgnext: push (sp),r1 ; make slot on stack for extra value, save reg mov 6(sp),r1 ; get block ptr push ddno(r1),(r1) ; DGETB args: disk no., block no. (call below) push r1 ; DRELB arg: block ptr call drelb ; release this block pop 6+4(sp) ; val: error code bne 1$ mov #%eenfi,6+4(sp) ; set error code to EOF in case no next block tst (sp) beq 1$ call dgetb ; get next block (args on stack from above) pop 4+2(sp),6(sp) ; vals: block ptr, error code br 2$ 1$: cmp (sp)+,(sp)+ ; remove DGETB args from stack 2$: pop r1 ; restore reg return .sbttl Block allocation ;;; DALLOC allocates and returns a disk block. ;;; ARGS: VALS: ;;; SP -> disk no. SP -> block ptr ;;; error code dalloc: push (sp) ; make slot for extra return val jsr r5,save6 ; save regs mov 20(sp),r5 ; get disk no. asl r5 ; times two for word addressing add pc,r5 ; for PICness add #dfree-.,r5 ; get address of DFREE(I) peof ; turn off preemption tst (r5) ; any free blocks? if eq,< mov #%efldv,20(sp) ; no free blocks, return device full error peon ; allow preemption again br 3$ > dec (r5) ; take one block for us peon ; allow preemption again mov 20(sp),r5 ; get disk no. again 1$: push r5,dbmno ; DGBM args: disk no, bitmap no. call dgbm ; get bitmap pop r4 ; val: block ptr mov r4,r1 add #10,r1 ; bump up ptr to 1st bitmap word mov r1,r2 ; save ptr mov #74,r0 ; no. of words in bitmap peof ; turn off preemption loop < cmp (r1)+,#177777 ; find a bitmap word with a free block bne 2$ sorl r0 > peon ; allow preemption again push r4 ; DRBM arg: block ptr to bitmap call drbm ; release bitmap inc dbmno cmp dbmno,#nbm-1 if hi,< clr dbmno > br 1$ 2$: tst -(r1) ; move ptr back to word with free block cmpb (r1),#377 ; low byte have any free blocks? if eq,< inc r1 ; no, use high byte > sub r1,r2 neg r2 ash #3,r2 clr r3 sec loop < rol r3 ; next bit in byte inc r2 ; increment block no. bitb r3,(r1) ; this block free? rptl ne > dec r2 ; correct for over incrementing bisb r3,(r1) ; set bit to allocate block mov pc,dwtf(r4) ; set flag to show block written mov dblk(r4),r0 ; get bitmap block no. peon ; allow preemption again push r4 ; DRBM arg: block ptr to bitmap call drbm ; release bitmap block ifMIT < cmp r2,#lstblk ; are we trying to allocate important if ge,< ; data space on the disk. crash ^"Attempt to allocate a bit-map block." > > sub #bm1b,r0 ; convert block no. to bitmap no. asl r0 ; times two for offset into table add pc,r0 ; get block no. of 1st block in bitmap add dbmtab-.(r0),r2 ; ... push #ldbuf/2,#60. ; ALOCW args: size, timeout call alocw ; get a sector buffer pop r4,20(sp) ; vals: ptr, error code bne 3$ mov #1,duse(r4) ; set usage count to 1 mov r5,ddno(r4) ; set disk no. mov r2,dblk(r4) ; set block no. mov pc,dwtf(r4) ; make sure block is written out mov r4,16(sp) ; return ptr to block peof ; turn off preemption mov dblist,dbll(r4) ; put block onto DBLIST mov r4,dblist ; ... peon ; allow preemption again 3$: jsr r5,rest6 ; restore regs return dbmtab: .word 0,1700,3600,5500,7400 .word 11300,13200,15100,17000 .word 20700,22600,24500,26400 .word 30300,32200,34100,36000 .word 37700,41600,43500,45400 .word 47300 dfree: .blkw 2 ; no. of free blocks on each disk .sbttl Bitmap i/o ;;; DGBM gets a bitmap given a bitmap no. A block ptr is returned. ;;; ARGS: VALS: ;;; SP -> bitmap no. SP -> block ptr ;;; disk no. dgbm: push 4(sp),2+2(sp) ; DGETB args: disk no., block no. add #bm1b,(sp) ; convert bitmap no. into block no. call dgetb ; get bitmap pop 4+2(sp),* ; vals: block ptr, error code if ne,< crash ^"Can't read bitmap" > pop (sp) ; remove arg from stack return ;;; DRBM releases a bitmap given a block ptr to it. ;;; ARGS: VALS: ;;; SP -> block ptr (none) drbm: push r1 ; save reg peof ; turn off preemption mov dbmp,r1 ; get current bitmap block ptr ;;; mov 4(sp),r1 ; get pointer to map being released ;;; dec duse(r1) ; one less person using this block mov 4(sp),dbmp ; make this block being released current peon ; allow preemption again ;;; cmp r1,4(sp) ; is the current bitmap the same ;;; ; as the previous??? ;;; if ne,< ; no, better save the previous tst r1 ; was there a previous current bitmap? if ne,< ; yes, release it ;;; inc duse(r1) ; make it one more user for DRELB ;;; ; we decremented it when released earlier push r1 ; DRELB arg: block ptr call drelb ; release previous current bitmap pop * ; val: error code bne dcrbm > ;;; > ;;; no need to do anything else if blocks are the same pop r1,(sp) ; restore reg, remove arg from stack return ;;; DUBM insures that the current bitmap is released, ;;; and will be written out when the usage count is 0. ;;; ARGS: VALS: ;;; (none) (none) dubm: push r1 ; save reg peof ; turn off preemption mov dbmp,r1 ; get block ptr to current bitmap clr dbmp ; no more current bitmap peon ; turn on preemption tst r1 ; any current bitmap? if ne,< ; yes ;;; inc duse(r1) ; one more user from when we decremented earlier push r1 ; DRELB arg: block ptr call drelb ; release current bitmap pop * ; val: error code bne dcrbm > pop r1 ; restore reg return dcrbm: crash ^"Can't release bitmap" dbmp: .blkw 1 ; block ptr to current bitmap dbmno: .blkw 1 ; bitmap no. .sbttl Disk buffer management dsect < .blkb lblk ; sector buffer ddno:: .blkw 1 ; disk no. dblk:: .blkw 1 ; block no. duse:: .blkw 1 ; usage count dwtf:: .blkw 1 ; write flag dbll:: .blkw 1 ; DBLIST link >,ldbuf ;;; DGETB returns a ptr to copy of a disk block. If there is already a copy ;;; in core that copy is shared. ;;; ARGS: VALS: ;;; SP -> block no. SP -> ptr to block ;;; disk no. error code dgetb: jsr r5,save6 ; save regs mov 16(sp),r3 ; get block no. mov 20(sp),r4 ; get disk no. clr 20(sp) ; set error code to zero jsr r5,dgb1 ; see if block is on list br 3$ ; found peon ; allow preemption again push #ldbuf/2,#60. ; ALOCW args: size, timeout call alocw ; allocate disk buffer for block pop r1,20(sp) ; vals: ptr, error code bne 2$ ; couldn't get memory? mov #1,duse(r1) ; we're only user so far mov r3,dblk(r1) ; set block no. mov r4,ddno(r1) ; and disk no. push r4,r3,r1 ; DKREAD args: disk no, block no, buffer call dkread ; read in block pop 20(sp) ; val: error code bne 1$ ; error, go free buffer ;;; Before adding the block to DBLIST the list is scanned again to make ;;; sure no one else put it on in the meantime. jsr r5,dgb1 ; scan DBLIST for block br 3$ ; found, forget block we just created mov dblist,dbll(r1) ; not found, put on list mov r1,dblist ; ... mov r1,16(sp) ; return val: ptr to block peon ; allow preemption again br 2$ 1$: push r1 ; FREE arg: ptr call free ; free disk buffer 2$: jsr r5,rest6 ; restore regs return 3$: inc nobnrd ; increment the numer of blocks not read jsr r5,rest6 ; restore regs return ;;; DGB1 scans DBLIST for a specified block. dgb1: peof ; turn off preemption mov dblist,r2 ; ptr to first block on DBLIST if ne,< loop < cmp r3,dblk(r2) ; this right block no.? if eq,< cmp r4,ddno(r2) ; right block no., this right disk no.? if eq,< inc duse(r2) ; add us as another user mov r2,16+2(sp) ; return val: ptr to block buffer peon ; allow preemption again rts r5 ; return1 for block found > > mov dbll(r2),r2 ; get next block buffer on list rptl ne > > tst (r5)+ ; set for return2 rts r5 ; return2 for block not found ;;; DRELB releases a block gotten via DGETB. ;;; ARGS: VALS: ;;; SP -> ptr to block SP -> error code drelb: push r1,r2 ; save regs mov 6(sp),r1 ; ptr to block clr 6(sp) ; set error code to zero peof ; turn off preemption dec duse(r1) ; decrement usage count of block if eq,< ; no more users mov dblist,r2 ; ptr to first block on DBLIST beq 1$ cmp r2,r1 ; this the one? if eq,< mov dbll(r1),dblist ; yes, set DBLIST to next > else < loop < cmp dbll(r2),r1 exitl eq mov dbll(r2),r2 rptl ne 1$: crash ^"Attempt to release unassigned block" > mov dbll(r1),dbll(r2) > peon ; allow preemption again tst dwtf(r1) ; block need to be written back? if ne,< clr dwtf(r1) ; clear write flag ifSAO < cmp dblk(r1),#bm1b ; writing a bit-map?? if eq,< inc notbmp ; one more written > cmp dblk(r1),#bm1b+1 ; writing a bit-map?? if eq,< inc notbmp ; one more written > cmp dblk(r1),#bm1b+2 ; writing a bit-map?? if eq,< inc notbmp ; one more written > > ifMIT < cmp dblk(r1),#lstblk+2 ; writing a bit-map?? if ge,< inc notbmp ; one more written > > push ddno(r1),dblk(r1),r1 ; DKWRIT args: disk no, block no, buf call dkwrit ; write back block pop 6(sp) ; val: error code > push r1 ; FREE arg: ptr call free ; free storage used by block buffer > pop r2,r1 ; restore regs return dblist: .blkw 1 ; list of disk blocks in core ;;; DKREAD reads one disk sector. ;;; ARGS: VALS: ;;; SP -> buffer ptr SP -> error code ;;; block no. ;;; disk no. .if ne nrk dkread: push (sp) ; create slot for function code mov #5,2(sp) ; function code for read jmp rkrw .endc .if ne nrx dkread: push (sp) ; create slot for function code clr 2(sp) ; zero for reeling jmp rxrw .endc .if ne nrl dkread: push (sp) ; create slot for function code mov #14,2(sp) ; function code for read jmp rlrw .endc .if ne nrp dkread: push (sp) ; create slot for function code mov #5,2(sp) ; function code for read jmp rprw .endc ;;; DKWRIT writes one disk sector. ;;; ARGS: VALS: ;;; SP -> buffer ptr SP -> error code ;;; block no. ;;; disk no. .if ne nrk dkwrit: push (sp) ; create slot for fcn code mov #3,2(sp) ; fcn code for write jmp rkrw .endc .if ne nrp dkwrit: push (sp) ; create slot for fcn code mov #3,2(sp) ; fcn code for write jmp rprw .endc .if ne nrx dkwrit: push (sp) ; create slot for function code mov #1,2(sp) ; nonzero for writhing jmp rxrw .endc .if ne nrl dkwrit: push (sp) ; create slot for function code mov #12,2(sp) ; function code for writing jmp rlrw .endc .sbttl RK subroutines .if ne nrk ;;; RK11 request block. RKRW creates a RK11 request block for each disk i/o ;;; operation requested and RKREQ puts it on the end of the RK11 request queue. ;;; The RK11 interrupt handler (RKINT) takes the request blocks off the queue ;;; and performs the desired operation. When RKINT finishes with a request ;;; the RKFINI word of the request block is incremented. dsect < .blkw 1 ; queue link word rkopt:: .blkw 1 ; option bits rkfcn1:: .blkw 1 ; RK11 function code (3 for write, 5 for read) rkecnt:: .blkw 1 ; recoverable error counter rkerrw:: .blkw 1 ; RK11 error register rkfini:: .blkw 1 ; incremented when finished ;;; Order of next 4 entries is important. RKDA-RKFCN are loaded into RK11 ;;; regs to perform the desired read/write. rkda:: .blkw 1 ; disk address rkba:: .blkw 1 ; bus address rkwc:: .blkw 1 ; word count rkfcn:: .blkw 1 ; function >,lrkrqb ; length of disk request block %rkwch==1 ; write check read or write ;;; RKINIT initializes the RK controller and RK data bases. rkinit: mov pc,-(sp) ; set RK interrupt vector to RKINT add #rkint-.,(sp) ; ... pop @#220 ; ... mov #pr5,@#222 ; set vector PS to priority 5 push pc ; set RKSW to RKIDLE add #rkidle-.,(sp) ; ... pop rksw ; ... clr rkrdc ; no reads yet clr rkwtc ; no writes yet clr rkerrc ; no errors yet clr rkrq ; nothing on request queue yet return .if ne pfail ;;; RKPWRU restarts the RK11 after a power failure. rkpwru: mov #1,@#rkcsr ; reset the RK11 controller loop < tstb @#rkcsr ; wait for Done rptl pl > mov #rkcsr,r0 ; ptr to RKCSR jsr pc,rknext ; check queue, restart any requests pop rksw ; save co-routine PC return .endc ;;; RKRW performs a read or write operation on the RK11. ;;; ARGS: VALS: ;;; SP -> function code SP -> error code ;;; bus address ;;; block no. ;;; disk no. rkrw: push r0,r1,r2 ; save regs bis #101,10(sp) ; turn on interrupt bit in function code push #lrkrqb/2,#60. ; ALOCW args: size, timeout call alocw ; allocate memory for request block pop r2,r0 ; vals: ptr, error code if ne,< ; couldn't get memory mov r0,16(sp) ; return error code br 1$ > mov 10(sp),rkfcn1(r2) ; set function code (either read or write) mov 10(sp),rkfcn(r2) ; ... mov 12(sp),rkba(r2) ; set bus address in request block mov #-,rkwc(r2) ; set word count in request block mov 14(sp),r1 ; get block no. ; R0 is already zero for DIV (from error code) div #12.,r0 ; get cylinder no. in r0, sector no. in r1 ash #4,r0 ; shift cylinder no. into place bis r1,r0 ; put cylinder no. and sector no. together mov 16(sp),r1 ; get disk no. swab r1 ; put disk no. into bits 15:12 of disk address ash #5,r1 ; ... bis r1,r0 ; ... mov r0,rkda(r2) ; set disk address in request block mov #%rkwch,rkopt(r2) ; write check i/o mov #7,rkecnt(r2) ; retry recoverable errors 7 times push r2 ; RKREQ arg: ptr to request block call rkreq ; queue disk request push r2 ; TWONNE arg1: location to wait on add #rkfini,(sp) ; ... push #0 ; TWONNE arg2: val to change from call twonne ; wait for disk i/o to complete clr 16(sp) ; clear error code tst rkerrw(r2) ; any error bits set? if ne,< push 10(sp),12+2(sp) push 14+4(sp),16+6(sp) push rkerrw(r2) call sysmsg .string ^"Bad Data on Disk. Error register = ^o Disk number = ^o. Block number = ^o. Bus Address = ^o. Function Code = ^o. " mov #170000,r0 ; some time to print out message loop < dec r0 ; ... rptl ne > mov #%ebdda,16(sp) ; give bad data error > push r2 ; FREE arg: ptr call free 1$: pop r2,r1,r0 ; restore regs pop 4(sp) ; move up return r5 cmp (sp)+,(sp)+ ; remove two args from stack return .endc ; ne nrk .if ne nrk ;;; RKREQ inserts a request block into the RK queue. ;;; ARGS: VALS: ;;; SP -> request block ptr SP -> (none) rkreq: push r0,r1,r2 ; save regs mov pc,r1 ; ptr to RK request queue add #rkrq-.,r1 ; ... mfps -(sp) ; save priority spl 5 ; set ours higher than RK11 loop < mov r1,r0 ; save ptr mov (r1),r1 ; move to next block rptl ne ; continue till found last block in queue > mov 10+2(sp),r1 ; ptr to request block to append clr (r1) ; set its link word to null mov r1,(r0) ; append to queue ;;; If the disk is idle then wake it up by faking an interrupt. push pc ; ptr to RKIDLE add #rkidle-.,(sp) ; ... cmp rksw,(sp)+ ; doing anything now? if eq,< ; no mov #rkcsr,r0 ; ptr to RK regs jsr pc,rknext ; fake an interrupt pop rksw ; store address to resume interrupt handler > mtps (sp)+ ; restore priority pop r2,r1,r0,(sp) ; restore regs, remove args from stack return .endc ; ne nrk .sbttl RK11 Interrupt handler .if ne nrk ;;; RK11 interrupts are dispatched to the part of the interrupt handler that ;;; caused them. This is accomplished by the handler executing a JSR PC,@(SP)+ ;;; when it expects an interrupt. The PC is copied into RKSW and when the ;;; interrupt occurs control is returned to that PC. ;;; Note: Only R0, R1 and R2 are saved by RKINT; any other regs used must be ;;; explicitly saved. R0 is initialized to RKCSR. rkint: push r0,r1,r2 ; save regs inc intflg ; indicate an interrupt occured mov #rkcsr,r0 ; ptr to disk regs bit #20000,(r0) ; seek complete interrupt? if ne,< jsr pc,rksint ; seek complete, go hack it > else < jsr pc,@rksw ; resume interrupt handler where it is waiting pop rksw ; store address to resume interrupt handler > pop r2,r1,r0 ; restore regs rti ;;; RKSINT handles seek complete interrupts. rksint: crash ^"Seek complete interrupt" ; not yet implemented rts pc ;;; RKNEXT initiates the next request on RKRQ. rknext: jsr r5,rkrst ; reset controller if it needs it mov rkrq,r1 ; ptr to next request block bne rkgo ; if another request then do it jsr pc,@(sp)+ ; no more requests, return from interrupt ;;; RKSW will contain RKIDLE when nothing is happening. rkidle: crash ^"Unexpected disk interrupt" ;;; RKRERR handles recoverable errors which occur during a request. A ;;; controller reset is performed if it was a hard error. The RKECNT ;;; entry in the request block controls the no. of times a request will ;;; be repeated if recoverable errors occur. rkrerr: jsr r5,rkrst ; reset controller if it needs it dec rkecnt(r1) ; try again? beq rkdone ; no, try maximum no. of times ;;; RKGO initiates a read or write function. rkgo: cmp rkfcn(r1),#103 ; write? if eq,< inc rkwtc ; increment write count > cmp rkfcn(r1),#105 ; read? if eq,< inc rkrdc ; increment read count > add #10,r0 ; ptr to beyond DAR add #rkda,r1 ; ptr to DAR in request block mov (r1)+,-(r0) ; set disk address mov (r1)+,-(r0) ; set bus address mov (r1)+,-(r0) ; set word count mov (r1)+,-(r0) ; perform fcn (read or write) jsr pc,@(sp)+ ; wait for interrupt mov rkrq,r1 ; ptr to request block again mov -2(r0),r2 ; get RKERR mov r2,rkerrw(r1) ; save in request block if ne,< inc rkerrc ; increment RK error count cmp -(r0),-(r0) ; get ptr to RKDSR mov pc,r1 ; get ptr to RKEREG add #rkereg-.,r1 ; ... loop < mov (r0)+,(r1)+ ; copy disk regs into save area cmp r0,#rkdar ; RKDAR is last reg rptl los > mov #rkcsr,r0 ; get ptr to RKCSR again mov rkrq,r1 ; ptr to request block again bit #166340,r2 ; non-recoverable error? bne rkdone ; yes, finish this request bit #011402,r2 ; recoverable error? bne rkrerr ; yes, try again ; only error left is write check mov rkfcn1(r1),rkfcn(r1) ; restore fcn code bis #%rkwch,rkopt(r1) ; write check fcn when done br rkrerr > bit #%rkwch,rkopt(r1) ; write check? beq rkdone ; no, finish this request mov #507,rkfcn(r1) ; set fcn code to write check bic #%rkwch,rkopt(r1) ; don't write check the write check br rkgo rkdone: mov rkrq,r1 ; ptr to request block again mov (r1),rkrq ; remove from queue inc rkfini(r1) ; indicate request done br rknext ; do next request ;;; RKRST resets the controller if it needs it. rkrst: bit #40000,(r0) ; hard error condtion? if ne,< mov (r0),r1 ; save drive status mov #1,(r0) ; perform controller reset loop < tstb (r0) ; wait for done rptl pl > ;;; Commented out because drive reset doesn't work on our drive .if ne 0 bit #1000,r1 ; seek incomplete error? if ne,< mov -4(r0),6(r0) ; copy drive no. from RKDSR to RKDAR mov #15,(r0) ; perform drive reset jsr pc,@(sp)+ ; wait for interrupt **Wrong** br rknext ; try again > .endc > rts r5 rkrq: .blkw 1 ; RK11 request queue, ptr to first ; request block rksw: .blkw 1 ; co-routine PC for RK interrupts rkrdc: .blkw 1 ; no. of disk reads rkwtc: .blkw 1 ; no. of disk writes rkerrc: .blkw 1 ; no. of RK errors rkereg: .blkw 6 ; regs from last error .endc ; ne nrk .sbttl RP subroutines .if ne nrp ;;; RP11 request block. RPRW creates a RP11 request block for each ;;; disk i/o operation requested and RPREQ puts it on the end of the ;;; RP11 request queue. The RP11 interrupt handler (RPINT) takes the ;;; request blocks off the queue and performs the desired operation. ;;; When RPINT finishes with a request the RPFINI word of the request ;;; block is incremented. dsect < .blkw 1 ; queue link word rpopt:: .blkw 1 ; option bits rpfcn1:: .blkw 1 ; RP11 function code (3 for write, 5 for read) rpecnt:: .blkw 1 ; recoverable error counter rperrw:: .blkw 1 ; RP11 error register rpfini:: .blkw 1 ; incremented when finished ;;; Order of next 5 entries is important. RPDA-RPFCN are loaded into ;;; RP11 regs to perform the desired read/write. rpda:: .blkw 1 ; disk address rpca:: .blkw 1 ; cylinder address rpba:: .blkw 1 ; bus address rpwc:: .blkw 1 ; word count rpfcn:: .blkw 1 ; function (RPCSR) >,lrprqb ; length of disk request block %rpwch==1 ; write check read or write ;;; RPINIT initializes the RP controller and RP data bases. rpinit: mov pc,-(sp) ; set RP interrupt vector to RPINT add #rpint-.,(sp) ; ... pop @#254 ; ... mov #pr5,@#256 ; set vector PS to priority 5 push pc ; set RPSW to RPIDLE add #rpidle-.,(sp) ; ... pop rpsw ; ... clr rprdc ; no reads yet clr rpwtc ; no writes yet clr rperrc ; no errors yet clr rprq ; nothing on request queue yet return .if ne pfail ;;; RPPWRU restarts the RP11 after a power failure. rppwru: mov #1,@#rpcsr ; reset the RP11 controller loop < tstb @#rpcsr ; wait for Done rptl pl > mov #rpcsr,r0 ; ptr to RPCSR jsr pc,rpnext ; check queue, restart any requests pop rpsw ; save co-routine PC return .endc ;;; RPRW performs a read or write operation on the RP11. ;;; ARGS: VALS: ;;; SP -> function code SP -> error code ;;; bus address ;;; block no. ;;; disk no. rprw: push r0,r1,r2 ; save regs bis #101,10(sp) ; turn on interrupt bit in function code push #lrprqb/2,#60. ; ALOCW args: size, timeout call alocw ; allocate memory for request block pop r2,r0 ; vals: ptr, error code if ne,< ; couldn't get memory mov r0,16(sp) ; return error code br 1$ > mov 10(sp),rpfcn1(r2) ; set function code (either read or write) mov 10(sp),rpfcn(r2) ; ... mov 12(sp),rpba(r2) ; set bus address in request block mov #-,rpwc(r2) ; set word count in request block mov 14(sp),r1 ; get block no. ; R0 is already zero for DIV (from error code) div #10.,r0 ; divide by number of sectors/track (10.) mov r1,rpda(r2) ; save sector number mov r0,r1 ; get ready for another divide clr r0 ; .... div #20.,r0 ; divide by number of tracks per ; cylinder to get track number swab r1 ; move track address to bits 8-12 clrb r1 ; clear lower just in case bis r1,rpda(r2) ; put track no. and sector no. together mov r0,rpca(r2) ; save cylinder number mov 16(sp),r1 ; get disk no. swab r1 ; put disk no. into bits 10-8 of RPCSR bis r1,rpfcn(r2) ; set disk number in function bis r1,rpfcn1(r2) ; and function1 mov #%rpwch,rpopt(r2) ; write check i/o mov #7,rpecnt(r2) ; retry recoverable errors 7 times push r2 ; RPREQ arg: ptr to request block call rpreq ; queue disk request push r2 ; TWONNE arg1: location to wait on add #rpfini,(sp) ; ... push #0 ; TWONNE arg2: val to change from call twonne ; wait for disk i/o to complete clr 16(sp) ; clear error code tst rperrw(r2) ; any error bits set? if ne,< push 10(sp),12+2(sp) push 14+4(sp),16+6(sp) push rperrw(r2) call sysmsg .string ^"Bad Data on Disk. Error register = ^o Disk number = ^o. Block number = ^o. Bus Address = ^o. Function Code = ^o. " mov #170000,r0 ; some time to print out message loop < dec r0 ; ... rptl ne > mov #%ebdda,16(sp) ; give bad data error > push r2 ; FREE arg: ptr call free 1$: pop r2,r1,r0 ; restore regs pop 4(sp) ; move up return r5 cmp (sp)+,(sp)+ ; remove two args from stack return .endc ; ne nrp .if ne nrp ;;; RPREQ inserts a request block into the RP queue. ;;; ARGS: VALS: ;;; SP -> request block ptr SP -> (none) rpreq: push r0,r1,r2 ; save regs mov pc,r1 ; ptr to RP request queue add #rprq-.,r1 ; ... mfps -(sp) ; save priority spl 5 ; set ours higher than RP11 loop < mov r1,r0 ; save ptr mov (r1),r1 ; move to next block rptl ne ; continue till found last block in queue > mov 10+2(sp),r1 ; ptr to request block to append clr (r1) ; set its link word to null mov r1,(r0) ; append to queue ;;; If the disk is idle then wake it up by faking an interrupt. push pc ; ptr to RPIDLE add #rpidle-.,(sp) ; ... cmp rpsw,(sp)+ ; doing anything now? if eq,< ; no mov #rpcsr,r0 ; ptr to RP regs jsr pc,rpnext ; fake an interrupt pop rpsw ; store address to resume interrupt handler > mtps (sp)+ ; restore priority pop r2,r1,r0,(sp) ; restore regs, remove args from stack return .endc ; ne nrp .sbttl RP11 Interrupt handler .if ne nrp ;;; RP11 interrupts are dispatched to the part of the interrupt handler that ;;; caused them. This is accomplished by the handler executing a JSR PC,@(SP)+ ;;; when it expects an interrupt. The PC is copied into RPSW and when the ;;; interrupt occurs control is returned to that PC. ;;; Note: Only R0, R1 and R2 are saved by RPINT; any other regs used must be ;;; explicitly saved. R0 is initialized to RPCSR. rpint: push r0,r1,r2 ; save regs inc intflg ; indicate an interrupt occured mov #rpcsr,r0 ; ptr to disk regs bit #20000,(r0) ; seek complete interrupt? if ne,< jsr pc,rpsint ; seek complete, go hack it > else < jsr pc,@rpsw ; resume interrupt handler where it is waiting pop rpsw ; store address to resume interrupt handler > pop r2,r1,r0 ; restore regs rti ;;; RPSINT handles seek complete interrupts. rpsint: crash ^"Seek complete interrupt" ; not yet implemented rts pc ;;; RPNEXT initiates the next request on RPRQ. rpnext: jsr r5,rprst ; reset controller if it needs it mov rprq,r1 ; ptr to next request block bne rpgo ; if another request then do it jsr pc,@(sp)+ ; no more requests, return from interrupt ;;; RPSW will contain RPIDLE when nothing is happening. rpidle: crash ^"Unexpected disk interrupt" ;;; RPRERR handles recoverable errors which occur during a request. A ;;; controller reset is performed if it was a hard error. The RPECNT ;;; entry in the request block controls the no. of times a request will ;;; be repeated if recoverable errors occur. rprerr: jsr r5,rprst ; reset controller if it needs it dec rpecnt(r1) ; try again? beq rpdone ; no, try maximum no. of times ;;; RPGO initiates a read or write function. rpgo: cmp rpfcn(r1),#103 ; write? if eq,< inc rpwtc ; increment write count > cmp rpfcn(r1),#105 ; read? if eq,< inc rprdc ; increment read count > add #12,r0 ; ptr to beyond DAR add #rpda,r1 ; ptr to DAR in request block mov (r1)+,-(r0) ; set sector and track addresses mov (r1)+,-(r0) ; set cylinder address mov (r1)+,-(r0) ; set bus address mov (r1)+,-(r0) ; set word count mov (r1)+,-(r0) ; perform fcn (read or write) jsr pc,@(sp)+ ; wait for interrupt mov rprq,r1 ; ptr to request block again mov -2(r0),r2 ; get RPERR mov r2,rperrw(r1) ; save in request block if ne,< inc rperrc ; increment RP error count cmp -(r0),-(r0) ; get ptr to RPDSR mov pc,r1 ; get ptr to RPEREG add #rpereg-.,r1 ; ... loop < mov (r0)+,(r1)+ ; copy disk regs into save area cmp r0,#rpdar ; RPDAR is last reg rptl los > mov #rpcsr,r0 ; get ptr to RPCSR again mov rprq,r1 ; ptr to request block again bit #177427,r2 ; non-recoverable error? bne rpdone ; yes, finish this request bit #000340,r2 ; recoverable error? bne rprerr ; yes, try again ; only error left is write check mov rpfcn1(r1),rpfcn(r1) ; restore fcn code bis #%rpwch,rpopt(r1) ; write check fcn when done br rprerr > bit #%rpwch,rpopt(r1) ; write check? beq rpdone ; no, finish this request movb #107,rpfcn(r1) ; set fcn code to write check bic #%rpwch,rpopt(r1) ; don't write check the write check br rpgo rpdone: mov rprq,r1 ; ptr to request block again mov (r1),rprq ; remove from queue inc rpfini(r1) ; indicate request done br rpnext ; do next request ;;; RPRST resets the controller if it needs it. rprst: bit #40000,(r0) ; hard error condtion? if ne,< mov (r0),r1 ; save drive status mov #1,(r0) ; perform controller reset loop < tstb (r0) ; wait for done rptl pl > > rts r5 ;;; RPTEST tests to see if the arg drive number is responding rptest: push r0,r1 ; save registers mov #rpcsr,r0 ; get address of disk registers mov 6(sp),r1 ; get disk number swab r1 ; put disk number into bits 8-10 bis #15,r1 ; function code for home seek clr 6(sp) ; assume that there is no error yet mov r1,(r0) ; perform a home seek loop < tstb (r0) ; wait for operation to complete rptl pl ; .... > bit #140000,(r0) ; hard error condition??? if ne,< mov #%enadv,6(sp) ; yes, report device not there > pop r1,r0 ; restore registers return rprq: .blkw 1 ; RP11 request queue, ptr to first ; request block rpsw: .blkw 1 ; co-routine PC for RP interrupts rprdc: .blkw 1 ; no. of disk reads rpwtc: .blkw 1 ; no. of disk writes rperrc: .blkw 1 ; no. of RP errors rpereg: .blkw 7 ; regs from last error .endc ; ne nrp .sbttl RX subroutines .if ne nrx ;;; RX11 request block. RXRW creates a RX11 request block for each ;;; disk i/o operation requested. RXREQ puts a request block on the ;;; RX11 queue. The RX11 interrupt handler (RXINT) takes request ;;; blocks off the queue and performs the desired operation. When ;;; RXINT finishes with the a request it increments the RXFINI word of ;;; the request block and goes on to the next item on the queue. dsect < .blkw 1 ; queue link word rxfini:: .blkw 1 ; incremented when request completed rxerc:: .blkw 1 ; error code rxadd:: .blkw 1 ; address to transfer to/from rxwtf:: .blkw 1 ; nonzero iff writing rxcmnd:: .blkw 1 ; command rxtrac:: .blkw 1 ; track address rxsect:: .blkw 1 ; sector address >,lrxrqb ; length of the RX11 request block ;;; RXINIT initializes the RX controller and RX data bases. rxinit: mov pc,-(sp) ; set RX interrupt vector to RXINT add #rxint-.,(sp) ; ... pop @#264 ; ... mov #pr5,@#266 ; set vector PS to priority 5 mov pc,-(sp) ; set RXSW to RXIDLE add #rxidle-.,(sp) ; ... pop rxsw ; ... clr rxrdc ; no reads yet clr rxwtc ; no writes yet clr rxperr ; no parity errors clr rxcerr ; no checksum errors clr rxserr ; no seek errors clr rxrq ; nothing on request queue yet return .if ne pfail ;;; RXPWRU restarts the RX11 after a power failure. rxpwru: foo return .endc ;;; RXRW does a floppy read or write operation. Only one sector is read or ;;; written. The write flag argument, if nonzero, specifies a write operation, ;;; else a read is done. ;;; ARGS: VALS: ;;; SP -> Write flag SP - > Error Code ;;; bus address ;;; block no. ;;; disk no. rxrw: push r0,r1,r2 ; save regs push #lrxrqb/2,#60. ; ALOCW args: size, timeout call alocw ; allocate memory for request block pop r2,r0 ; vals: ptr, error code if ne,< ; couldn't get memory mov r0,16(sp) ; return error code br 1$ > mov 12(sp),rxadd(r2) ; fill in bus address mov 14(sp),r1 ; get block number ; R0 already zero for DIV (from error code) div #nsecto,r0 ; divide block no./no. sectors per track asl r1 cmp r1,#nsecto if his, inc r1 ; sector no. in r1, make it one based mov r0,rxtrac(r2) ; track no. in r0, put it in request block mov r1,rxsect(r2) ; put in sector number mov 10(sp),rxwtf(r2) ; copy Write flag (nonzero for write) if eq,< mov #6,rxcmnd(r2) ; set read function code > else < mov #4,rxcmnd(r2) ; set write function code > tst 16(sp) ; unit 1 or 0? if eq,< ; NOTE: we're backwards here ; this is because the left floppy will usually ; still have the RT-11 diskette in it bis #20,rxcmnd(r2) ; set unit #1 for now. later check 16(sp) > push r2 ; RXREQ args: pointer to request block call rxreq ; issue request push r2 ; TWONNE arg1: location to wait on add #rxfini,(sp) ; ... push #0 ; TWONNE arg2: val to change from call twonne ; wait for RX i/o to complete mov rxerc(r2),16(sp) ; any error bits set? push r2 ; FREE arg: pointer call free ; free request block 1$: pop r2,r1,r0 ; restore regs pop 4(sp) ; move up return r5 cmp (sp)+,(sp)+ ; remove two args ffrom stack return ;;; RXREQ inserts a request block into the RX queue. ;;; ARGS: VALS: ;;; SP -> request block ptr SP -> (none) rxreq: push r0,r1,r2 ; save regs mov pc,r1 ; ptr to RX request queue add #rxrq-.,r1 ; ... mfps -(sp) ; save priority spl 5 ; set ours higher than RX-11 loop < mov r1,r0 ; save ptr mov (r1),r1 ; move to next block rptl ne ; continue till found last block in queue > mov 10+2(sp),r1 ; ptr to request block to append clr (r1) ; set its link word to null mov r1,(r0) ; append to queue ;;; If the disk is idle then wake it up by faking an interrupt. push pc ; ptr to RXIDLE add #rxidle-.,(sp) ; ... cmp rxsw,(sp)+ ; doing anything now? if eq,< ; no mov #rxcs,r0 ; ptr RX11 control/status register push r3,r4,r5 ; save rest of regs jsr pc,rxnext ; fake an interrupt pop rxsw ; store address to resume interrupt handler pop r5,r4,r3 ; restore some regs > mtps (sp)+ ; restore priority pop r2,r1,r0,(sp) ; restore regs, remove args from stack return .endc ; ne nrx .sbttl RX11 Interrupt Handler .if ne nrx rxint: jsr r5,save6 ; save regs inc intflg ; indicate an interrupt occured mov #rxcs,r0 ; get ptr to RX11 control/status reg jsr pc,@rxsw ; call RX11 co-routine pop rxsw ; save co-routine PC jsr r5,rest6 ; restore regs rti ;;; Process next request on queue. rxnext: mov rxrq,r1 ; get request block from queue bne rxgo ; something there, go do it jsr pc,@(sp)+ ; nothing on queue, return from interrupt ;;; RXSW will contain RXIDLE when nothing is happening. rxidle: crash ^"Unexpected disk interrupt" br rxnext ; in case continued ;;; RXGO initiates a read or write command. rxgo: tst rxwtf(r1) ; Write? beq rxrow ; no, don't fill ;;; Write request. Fill the RX01 buffer and then issue the write command. mov #10,r3 ; no. of times to retry parity errors in Fill loop < mov #1,(r0) ; send Fill command mov rxadd(r1),r2 ; get ptr to data loop < bitb #240,(r0) ; test Transfer Request and Done bits rptl eq ; wait till one sets exitl pl ; Done? movb (r2)+,2(r0) ; Transfer Request, load data byte rptl > tst (r0) ; Error (parity error in transfer to buffer)? exitl pl inc rxperr ; increment parity error count sorl r3 ; retry Fill mov #%ebdda,rxerc(r1) ; set error code br rxdone > ;;; Read or Write RX01 buffer to sector and track specified in request. rxrow: mov #10,r3 ; no. of times to retry errors loop < tst rxwtf(r1) ; reeling or writhing? if eq,< inc rxrdc ; reeling, increment read counter > else < inc rxwtc ; writhing, increment write counter > mov rxcmnd(r1),r2 ; get Reel or Writhe command bis #101,r2 ; set go and interrupt on Done loop < bit #40,(r0) ; wait for Done rptl eq > mov r2,(r0) ; send Reel or Writhe command loop < tstb (r0) ; wait for Transfer Request rptl pl > mov rxsect(r1),2(r0) ; send Sector address loop < tstb (r0) ; wait for Transfer Request rptl pl > mov rxtrac(r1),2(r0) ; send Track address jsr pc,@(sp)+ ; wait for Done mov rxrq,r1 ; ptr to request block we're processing tst (r0) ; Error? exitl pl ; no mov 2(r0),r2 ; read RXES to determine error bit #2,r2 ; parity error? if ne,< inc rxperr ; increment parity error count br 1$ > bit #1,r2 ; CRC error? if ne,< inc rxcerr ; increment CRC error count br 1$ > ;;; Seek error inc rxserr ; increment seek error count mov #17,(r0) ; send Read Error Register function jsr pc,@(sp)+ ; wait for Done tst (r0) ; error reading Error Register?? if pl,< mov 2(r0),rxerr ; save Error Register > mov #40000,(r0) ; initialize jsr pc,@(sp)+ ; wait for Done mov #%ebdda,rxerc ; set error code br 2$ ; give up 1$: sorl r3 ; retry operation 2$: mov #%ebdda,rxerc(r1) ; set error code br rxdone ; too many errors, give up > ;;; If request is a read then empty the RX01 buffer after doing the read ;;; operation. tst rxwtf(r1) ; Read? bne rxdone mov #10,r3 ; no. of times to retry parity errors in Empty loop < mov #3,(r0) ; send Empty function mov rxadd(r1),r2 ; get ptr to data area loop < bitb #240,(r0) ; test Transfer Request and Done bits rptl eq ; wait for one to set exitl pl ; Done? movb 2(r0),(r2)+ ; Transfer Request, get data byte rptl > tst (r0) ; Error (parity error in transfer from buffer)? exitl pl inc rxperr ; increment parity error count sorl r3 ; retry Empty mov #%ebdda,rxerc(r1) ; set error code > rxdone: inc rxfini(r1) ; indicate done mov (r1),rxrq ; remove request from RX queue jmp rxnext ; process next request rxtest: return ; for now.. rxrq: .blkw 1 ; RX11 request queue, ptr to 1st request block rxsw: .blkw 1 ; RX11 co-routine PC rxrdc: .blkw 1 ; no. of reads rxwtc: .blkw 1 ; no. of writes rxerr: .blkw 1 ; Error Register after last seek error rxperr: .blkw 1 ; no. of Fill or Empty parity errors rxcerr: .blkw 1 ; no. of CRC errors rxserr: .blkw 1 ; no. of seek errors .endc .sbttl RL subroutines .if ne nrl ;;; RL11 request block. RLRW creates a RL11 request block for each disk i/o ;;; operation requested and RLREQ puts it on the end of the RL11 request queue. ;;; The RL11 interrupt handler (RLINT) takes the request blocks off the queue ;;; and performs the desired operation. When RLINT finishes with a request ;;; the RLFINI word of the request block is incremented. dsect < .blkw 1 ; queue link word rlopt:: .blkw 1 ; option bits rlcs1:: .blkw 1 ; RL11 function code(12 for write,14 for read) rlecnt:: .blkw 1 ; recoverable error counter rlerrw:: .blkw 1 ; RL11 error register rlfini:: .blkw 1 ; incremented when finished ;;; Order of next 4 entries is important. RLMP-RLCS are loaded into RL11 ;;; regs to perform the desired read/write. rlmp:: .blkw 1 ; multi-purpose register rlda:: .blkw 1 ; disk address register rlba:: .blkw 1 ; bus address register rlcs:: .blkw 1 ; control status register >,lrlrqb ; length of disk request block %rlwch==1 ; write check ;;; RLINIT initializes the RL controller and RL data bases. rlinit: mov pc,-(sp) ; set RL interrupt vector to RLINT add #rlint-.,(sp) ; ... pop @#160 ; ... mov #pr5,@#162 ; set vector PS to priority 5 push pc ; set RLSW to RLIDLE add #rlidle-.,(sp) ; ... pop rlsw ; ... mov #13,@#rldar ; for reset/get status on drive mov #4,@#rlcsr ; do it (get status) loop < tstb @#rlcsr ; wait for disk controller rptl pl > clr rlrdc ; no reads yet clr rlwtc ; no writes yet clr rlerrc ; no errors yet clr rlrq ; nothing on request queue yet return .if ne pfail ;;; RLPWRU restarts the RL11 after a power failure. rlpwru: jsr r5,rlrst ; reset drive if necessary mov #rlcsr,r0 ; ptr to RLCSR jsr pc,rlnext ; check queue, restart any requests pop rlsw ; save co-routine PC return .endc ;;; RLRW performs a read or write operation on the RL11. ;;; ARGS: VALS: ;;; SP -> function code SP -> error code ;;; bus address ;;; block no. ;;; disk no. rlrw: push r0,r1,r2 ; save regs tst 16(sp) ; are we trying to acces disk 1 if ne,< ; yes tst disk1 ; is disk 1 there if ne,< ; no mov #%enadv,16(sp) ; return device not available br 1$ > > bis #100,10(sp) ; turn on interrupt bit in function code push #lrlrqb/2,#60. ; ALOCW args: size, timeout call alocw ; allocate memory for request block pop r2,r0 ; vals: ptr, error code if ne,< ; couldn't get memory mov r0,16(sp) ; return error code br 1$ > mov 16(sp),rlcs1(r2) ; set disk number swab rlcs1(r2) ; set disk number into bits 8-9 mov 10(sp),rlcs(r2) ; set function code bis rlcs1(r2),rlcs(r2) ; set disk number with function code mov 12(sp),rlba(r2) ; set bus address in request block mov #-,rlmp(r2) ; set word count in request block mov 14(sp),r1 ; get block no. ; R0 is already zero for DIV (from error code) div #40.,r0 ; get cylinder no. in r0, sector no. in r1 ash #6,r0 ; shift cylinder no. into place bis r1,r0 ; put cylinder no. and sector no. together mov r0,rlda(r2) ; set disk address in request block mov #7,rlecnt(r2) ; retry recoverable errors 7 times push r2 ; RLREQ arg: ptr to request block call rlreq ; queue disk request push r2 ; TWONNE arg1: location to wait on add #rlfini,(sp) ; ... push #0 ; TWONNE arg2: val to change from call twonne ; wait for disk i/o to complete clr 16(sp) ; clear error code tst rlerrw(r2) ; any error bits set? if ne,< mov pc,r0 add #rlereg-.,r0 push rlerrw(r2) push (r0)+,(r0)+,(r0)+,(r0)+ call sysmsg .string ^"Bad Data on Disk. Disk MPR= ^o. Disk DAR= ^o. Disk BAR= ^o. Disk CSR= ^o. Disk Error Register= ^o. " mov #170000,r0 ; some time to print out message loop < dec r0 ; ... rptl ne > mov #%ebdda,16(sp) ; give bad data error > push r2 ; FREE arg: ptr call free 1$: pop r2,r1,r0 ; restore regs pop 4(sp) ; move up return r5 cmp (sp)+,(sp)+ ; remove two args from stack return .endc ; ne nrl .if ne nrl ;;; RLREQ inserts a request block into the RL queue. ;;; ARGS: VALS: ;;; SP -> request block ptr SP -> (none) rlreq: push r0,r1,r2 ; save regs mov pc,r1 ; ptr to RL request queue add #rlrq-.,r1 ; ... mfps -(sp) ; save priority spl 5 ; set ours higher than RL11 loop < mov r1,r0 ; save ptr mov (r1),r1 ; move to next block rptl ne ; continue till found last block in queue > mov 10+2(sp),r1 ; ptr to request block to append clr (r1) ; set its link word to null mov r1,(r0) ; append to queue ;;; If the disk is idle then wake it up by faking an interrupt. push pc ; ptr to RLIDLE add #rlidle-.,(sp) ; ... cmp rlsw,(sp)+ ; doing anything now? if eq,< ; no mov #rlcsr,r0 ; ptr to RL regs jsr pc,rlnext ; fake an interrupt pop rlsw ; store address to resume interrupt handler > mtps (sp)+ ; restore priority pop r2,r1,r0,(sp) ; restore regs, remove args from stack return .endc ; ne nrl .sbttl RL11 Interrupt handler .if ne nrl ;;; RL11 interrupts are dispatched to the part of the interrupt handler that ;;; caused them. This is accomplished by the handler executing a JSR PC,@(SP)+ ;;; when it expects an interrupt. The PC is copied into RLSW and when the ;;; interrupt occurs control is returned to that PC. ;;; Note: Only R0, R1 and R2 are saved by RLINT; any other regs used must be ;;; explicitly saved. R0 is initialized to RLCSR. rlint: push r0,r1,r2 ; save regs inc intflg ; indicate an interrupt occured mov #rlcsr,r0 ; ptr to disk regs jsr pc,@rlsw ; resume interrupt handler where it is waiting pop rlsw ; store address to resume interrupt handler pop r2,r1,r0 ; restore regs rti ;;; RLNEXT initiates the next request on RLRQ. rlnext: jsr r5,rlrst ; reset controller if it needs it mov rlrq,r1 ; ptr to next request block bne rlgo ; if another request then do it jsr pc,@(sp)+ ; no more requests, return from interrupt ;;; RLSW will contain RLIDLE when nothing is happening. rlidle: crash ^"Unexpected disk interrupt" ;;; RLRERR handles recoverable errors which occur during a request. A ;;; controller reset is performed if it was a hard error. The RLECNT ;;; entry in the request block controls the no. of times a request will ;;; be repeated if recoverable errors occur. rlrerr: jsr r5,rlrst ; reset controller if it needs it dec rlecnt(r1) ; try again? beq rldone ; no, try maximum no. of times ;;; RLGO initiates a read or write function. rlgo: cmpb rlcs(r1),#112 ; write? if eq,< inc rlwtc ; increment write count > cmpb rlcs(r1),#114 ; read? if eq,< inc rlrdc ; increment read count > jsr r5,rlrst1 ; reset drive if necessary tst (r0) ; was there an error??? bmi 2$ ; yes if mi ;;; perform a seek on the disk to the right track movb #110,rlcs1(r1) ; set function for read header(add to disk #) mov rlcs1(r1),(r0) ; execute read headers function jsr pc,@(sp)+ ; wait for interupt push r3 ; save register mov 6(r0),r1 ; get current disk address mov rlrq,r3 ; get pointer to request block mov rlda(r3),r2 ; get desired disk address bic #77,r2 ; clear sector bits bic #177,r1 ; clear sector and surface bits mov r2,r3 ; copy desired disk address bic #177677,r3 ; isolate surface bit ash #-2,r3 ; position it for difference word in seek bic #100,r2 ; remove surface bit sub r2,r1 ; find difference word for seek operation bcc 1$ ; if CC actual >= desired position neg r1 ; make positive difference bis #4,r1 ; set bit to indicate move towards disk center 1$: inc r1 ; set marker bit bis r3,r1 ; merge in surface bit mov r1,4(r0) ; put difference word into RLDAR pop r3 ; restore reg mov rlrq,r1 ; get ptr to request block movb #106,rlcs1(r1) ; set code for seek (with disk number) mov rlcs1(r1),(r0) ; perform a seek function jsr pc,@(sp)+ ; wait for seek to finish ;now do read or write add #10,r0 ; ptr to beyond DAR mov rlrq,r1 ; get back ptr to request block add #rlmp,r1 ; ptr to DAR in request block mov (r1)+,-(r0) ; set word count mov (r1)+,-(r0) ; set disk address mov (r1)+,-(r0) ; set bus address mov (r1)+,-(r0) ; perform fcn (read or write) jsr pc,@(sp)+ ; wait for interrupt mov rlrq,r1 ; ptr to request block again clr rlerrw(r1) ; no error yet tst (r0) ; was there an error??? if mi,< 2$: inc rlerrc ; increment RL error count mov pc,r1 ; get ptr to RLEREG add #rlereg-.,r1 ; ... loop < mov (r0)+,(r1)+ ; copy disk regs into save area cmp r0,#rlmpr ; RLMPR is last reg rptl los > mov #rlcsr,r0 ; get ptr to RLCSR again mov rlrq,r1 mov #3,4(r0) ; do a get status on the drive movb #10,rlcs1(r1) ; opcode for get status mov rlcs1(r1),(r0) ; do it loop < tstb (r0) ; wait for operation to finish rptl pl ; .... > mov 6(r0),r2 ; get RL01 drive error register mov r2,rlerrw(r1) ; save in request block mov #rlcsr,r0 ; get ptr to RLCSR again mov rlrq,r1 ; ptr to request block again bit #40000,r2 ; drive error??? bne rldone ; yes, finish this request bit #100000,r2 ; recoverable error? bne rlrerr ; yes, try again > ;fall through to rldone (i.e. no error occured) rldone: mov rlrq,r1 ; ptr to request block again mov (r1),rlrq ; remove from queue inc rlfini(r1) ; indicate request done jmp rlnext ; do next request ;;; RLRST resets the controller if it needs it. rlrst: bit #140000,(r0) ; hard error condtion? if ne,< rlrst1: push r1 ; save register (RLRST1 is for unconditional ; reset of the drive mov rlrq,r1 ; get ptr to request queue mov #13,4(r0) ; perform controller reset movb #4,rlcs1(r1) ; set opcode for get status mov rlcs1(r1),(r0) ; ....(get status) loop < tstb (r0) ; wait for done rptl pl > pop r1 > rts r5 rltest: push r0,r1 ; save registers mov #rlcsr,r0 ; get address of disk registers mov 6(sp),r1 ; get disk number swab r1 ; put disk number into bits 8-9 bis #4,r1 ; function code for reset clr 6(sp) ; assume that there is no error yet mov #13,4(r0) ; perform a controller reset mov r1,(r0) ; do it loop < tstb (r0) ; wait for operation to complete rptl pl ; .... > bit #140000,(r0) ; hard error condition??? if ne,< mov #%enadv,6(sp) ; yes, report device not there > pop r1,r0 ; restore registers return rlrq: .blkw 1 ; RL11 request queue, ptr to first ; request block rlsw: .blkw 1 ; co-routine PC for RL interrupts rlrdc: .blkw 1 ; no. of disk reads rlwtc: .blkw 1 ; no. of disk writes rlerrc: .blkw 1 ; no. of RL errors rlereg: .blkw 4 ; regs from last error .endc ; ne nrl ð k; FSM -*-PALX-*- .sbttl Storage Management ; Storage manager: allocates and frees contiguous blocks of memory within ; within a special area. The free-storage list is a doubly-linked list of ; free blocks, pictured below. When allocated, each block still contains ; some overhead giving the size of the block, who allocated it, and a bit to ; show that it is in use. These help compaction, garbage collection of ; storage, and run-time checking that each process frees all storage that it ; allocated before killing itself. Allocation is by "first-fit"; ; deallocation will compact adjacent free blocks. ; Note that the free area is surrounded by -1 words, which represent ; boundary conditions of "allocated" so that compaction will not try ; to compact beyond the free area. ; FREE BLOCKS: ; |---|--------------------| ; | 0 | N (size in words) | ; |---|--------------------| ; | forward link | ; |------------------------| ; | backward link | ; |------------------------| ; | | ; | (N-4 words) | ; | | ; |---|--------------------| ; | 0 | N | ; |---|--------------------| ; ALLOCATED BLOCKS: ; |---|--------------------| ; | 1 | N (size in words) | ; |---|--------------------| ; | | ; | N-3 allocated words | ; | | ; |------------------------| ; | Process ID | ; |---|--------------------| ; | 1 | N (size in words) | ; |---|--------------------| ; The following defines the fsm offsets in a dummy section: dsect < .word 0 ; Freebit is bit-15, rest is size. fsfptr:: .word 0 ; Forward pointer. fsbptr:: .word 0 ; Backward pointer. > ; Reference section 2.5 in Knuth. .sbttl Free-storage initialization ; FSINIT sets up the free-storage area, and initializes the ; free-storage variables. The area of core bounded by FSINIT's ; two args is made into one large free block and is put into ; the freelist. ; ARGS: VALS: ; SP -> top of area + 2 (none) ; bottom of area fsinit: jsr r5,save6 ; save regs mov #-1,r5 ; will use this a few times mov 20(sp),r1 ; points to bottom of free area mov 16(sp),r2 ; points to top+2 of free area mov r1,fslo ; save for future reference mov r2,fshi ; ... add #2,fslo ; correct for surround of -1s sub #2,fshi ; ... mov r2,r3 ; now find size of free area sub r1,r3 ; have size in bytes sub #4,r3 ; correct for 2-words of boundary, i.e. there ; are 2 words of -1 which will surround the ; free area clc ; so can ROR ror r3 ; convert size to words if cs,< crash ^"Odd number bytes in free area." > cmp r3,#4 ; free area must have room for ; overhead (4 words) if lo,< crash ^"Free area too small." > mov r3,fssize ; save size of free area mov pc,r0 ; get ptr to fslist add #fslist-.,r0 ; R0 pts to FSLIST ; R1 pts to free area ; R2 pts to top of free area + 2 ; R3 has the size of the free block ; R5 has a -1 mov r5,(r1)+ ; set free-area boundary conditions, mov r1,2(r0) ; set fwd ptr to free block mov r3,(r1)+ ; set first word (size of free blk) mov r0,(r1)+ ; set fwd ptr of free block to fslist mov r0,(r1)+ ; set back ptr (both point to ; freelist-ptr block, making the ; fslist block and the free block into ; a doubly-linked ring) mov #1,(r0)+ ; set fslist size and freebit: ; size is fake (too small) so it ; will not be allocated mov (r0)+,(r0)+ ; set back ptr to free block mov #1,(r0) ; set fslist fake size and freebit mov r5,-(r2) ; i.e. -1 so that the surrounding ; area will look "allocated" to the ; free routine which will not try to ; compact outside the free area mov r3,-(r2) ; set last word in free area, ; i.e. freebit=0 and size clr fsmctr ; clear free counter clr fsflen clr fsac clr fsatr+0 clr fsatr+2 clr fsata+0 clr fsata+2 clr fsasl clr fsft+0 clr fsft+2 clr fsarc jsr r5,rest6 ; restore regs pop (sp),(sp) ; remove args from stack return ; ALLOC returns a ptr to a block of storage of the requested size. ; The first argument is the size of the block in words and the ; second is an id to be placed in the allocated block. ; ARGS: VALS: ; SP -> id of caller SP -> ptr to allocated block ; N words to allocate error code alloc: push r0,r1,r2,r3 ; save regs add #3,14(sp) ; correct reqested size to include ; size and caller-id words mov 14(sp),r2 ; and keep it around for search add r2,fsatr+0 ; update total alloc requests (+4) adc fsatr+2 ; hi order inc fsarc ; update number of alloc requests mov pc,r0 ; init ptr to point to the freelist ptr add #fslist-.,r0 ; The freelist ptr looks like a dummy block ; (i.e. 0 words in it) mov r0,r3 ; save ptr in R3, compare with this to see ; if done searching freelist peof ; turn off preemption ; Loop searching for a free block big enough for request: loop < mov fsfptr(r0),r0 ; next free block cmp r0,r3 ; any more? if eq,< mov #%enacr,14(sp) ; set error code to no core available peon ; allow preemption again br 2$ > inc fsasl ; increment no. of entries on freelist ; looked at tst (r0) ; yes, is free-bit = "free" (0)? if le,< crash ^"Free block isn't." > ; Either free-bit is "allocated" or else ; the length is 0 (which it can't be since ; it must include the overhead words. cmp (r0),r2 ; yes, big enough for request? rptl lt ; no, repeat loop, try next block > ; we have one of the right size. ; now remove the whole block from the free list. mov fsbptr(r0),r1 ; less -- remove free block from fslist mov fsfptr(r0),fsfptr(r1) ; link prev to next mov fsfptr(r0),r1 mov fsbptr(r0),fsbptr(r1) ; back-link next to prev ; now check to see if this block should be split into two parts sub (r0),r2 ; request+2-size_of_block neg r2 cmp r2,#fsmin ; if dif is less than fsmin, the dif ; won't be kept around as a free block, ; since would slow ALLOC's search if lt,< mov r0,r1 ; ptr to block to be given to caller dec fsflen ; decrement length of freelist > else < ; dif is greater than fsmin, so will have ; the remainder be a new, smaller, free block mov r2,r1 ; dif asl r1 ; times 2 for byte dif add r0,r1 ; points to block to give to caller mov r2,-2(r1) ; set size in dif block (and set to "free") mov r2,(r0) ; set 1st size and freebit word push r0 ; FSSORT arg: ptr to block to sorted into jsr r5,fssort ; the free list mov 14(sp),(r1) ; set size in caller's block > mov r1,r0 ; points to caller's block add (r1),fsata+0 ; yes, update total allocated, lo order adc fsata+2 ; hi order add (r1),r0 ; add twice for byte offset add (r1),r0 ; points to just after caller's block bis #100000,(r1) ; set "inuse" bit at beginning of block mov (r1)+,-(r0) ; set "inuse" at end of block and move ; ptr to caller area -- i.e. 2nd word ; in block. Also make r1 the pointer ; to caller's area. mov 12(sp),-(r0) ; put id into block peon ; allow preemption again loop < cmp r0,r1 ; now clear all data words in the block exitl los ; ... clr -(r0) ; ... rptl > clr 14(sp) ; set error code to zero to indicate success inc fsac ; increment no. of blocks allocated 2$: mov r1,12(sp) ; give caller pointer to allocated area pop r3,r2,r1,r0 ; restore regs return .sbttl FREE - Deallocation ; FREE takes a ptr to a block allocated by ALLOC and returns it to free ; storage. ; ARGS: VALS: ; SP -> Ptr to block (none) free: push r0,r1,r2,r3 ; save regs mov 12(sp),r0 ; block to be freed + 2. i.e. points ; to sizeword+2 tst -(r0) ; move ptr back to beginning of block ; and also check if freebit = "in use" if pl,< crash ^"Allocated block isn't." > bic #100000,(r0) ; clear freebit to "free" add (r0),fsft+0 ; low order of total freed adc fsft+2 ; hi order inc fsflen ; increment length of freelist peof ; turn off preemption ; Check blocks surrounding the one to be freed. If either is ; free, then it will be combined with the arg-block into a ; larger free block ("compaction"). mov -2(r0),r3 ; check block below this one -- free? if pl,< ; yes, so compact lower block and this one asl r3 ; word count times two for byte count sub r0,r3 ; will compact the two neg r3 ; points to block below one to be freed ; Compaction consists of removing the lower block from the ; free-storage list and combining it with the block to be ; freed to get a new (bigger) block to be freed. mov fsfptr(r3),r1 ; forward link of lower block mov fsbptr(r3),r2 ; back linkof lower block mov r2,fsbptr(r1) ; back-link next to prev mov r1,fsfptr(r2) ; link prev to next add (r0),(r3) ; combine two blocks by adding sizes mov r3,r0 ; new block to be freed is lower block dec fsflen ; decrement length of freelist > ; See if can compact block to be freed with block above it. mov r0,r3 ; ptr to block to be freed add (r0),r3 ; twice since word count add (r0),r3 ; block above it tst -2(r3) ; just a check -- make sure last word ; in block to be freed says that it is ; an allocated block if pl,< crash ^"Allocated block isn't." > tst (r3) ; is upper block free? if pl,< ; yes, so compact with upper block mov fsfptr(r3),r1 ; will compact block to be freed with ; block above mov fsbptr(r3),r2 ; back ptr of upper block mov r2,fsbptr(r1) ; back-link next to prev mov r1,fsfptr(r2) ; link prev to next, removing upper ; block from list add (r3),(r0) ; add sizes of block to be freed and ; upper block. thus getting new block ; to be freed mov r0,r3 ; ptr to new block to be freed add (r0),r3 ; twice since word count add (r0),r3 ; points to next block up, tst (r3) ; which should always be in use since ; compaction should catch it otherwise if pl,< crash ^"Compaction missed a block sometime." > dec fsflen ; decrement length of freelist > ; Now add the block to be freed to the freelist. This may be ; the original arg-block, or a bigger block created by ; compacting the arg-block with upper or lower blocks (if so, ; the other blocks have been removed from the freelist so that ; the total block is "free"). mov (r0),-2(r3) ; set freebit="free" and size in last ; word of block to be freed push r0 ; FSSORT arg: ptr to block to be sorted jsr r5,fssort ; into the free list. dec fsac ; decrement no. of blocks allocated inc fsmctr ; counts number of frees. allocates that fail ; can wait on this counter; when memory is ; freed the allocator can try again peon ; allow preemption again pop r3,r2,r1,r0,(sp) ; restore regs, remove arg from stack return ; FSSORT is called to take the block being freed and place it into ; the free list. The free list is kept sorted from least to greatest. ; ; ARGS: VALS: ; SP-> block to be freed (none) fssort: push r0,r1,r2 ; save registers mov 10(sp),r0 ; get ptr to block to be freed mov pc,r1 ; get PIC address of fslist add #fslist-.,r1 ; .... mov r1,r2 ; save ptr mov fsfptr(r1),r1 ; get 1st block on the free-list loop < cmp r1,r2 ; are we back to FSLIST?? exitl eq ; yes cmp (r1),(r0) ; is this block bigger than the one to ; be freed?? exitl ge ; yes, add to free list mov fsfptr(r1),r1 ; get ptr to next block rptl ; try again > ; R1 now points to the block that will be ahead of the block being ; freed. R0 points to the block being freed. mov r1,fsfptr(r0) ; set forward ptr to the next block mov fsbptr(r1),r2 ; get ptr to the block before mov r2,fsbptr(r0) ; set backward ptr to the prev block mov r0,fsfptr(r2) ; set prev forward ptr to this block mov r0,fsbptr(r1) ; set next block back ptr to this one pop r2,r1,r0,(sp) ; restore regs, remove arg rts r5 .sbttl Free-storage variables .iif ndf fsmin, fsmin==10 ; Free-list pointer, which is a "free block", but consists only ; of overhead, and has a fake size so that it can't be allocated. fslist: .word 1 ; fake size, and freebit=free .word 1,1 ; forward, back links .word 1 ; fake size, freebit fslo: .word 0 ; start of free storage area fshi: .word 0 ; end of free storage area (last address + 2) fssize: .word 0 ; size of free storage area fsata: .word 0,0 ; total of block-sizes allocated fsatr: .word 0,0 ; total requested fsac: .word 0 ; no. of block allocated at this moment fsflen: .word 0 ; length of freelist fsasl: .word 0 ; no. of blocks on freelist checked by ALLOC fsarc: .word 0 ; number of alloc requests fsft: .word 0,0 ; total of block-sizes freed fsmctr: .word 0 ; Counter to show number of times ; memory has been freed. ; If there isn't enuf memory then ; the allocator should wait for this ; location to change before retrying. ð; -*-PALX-*- ; The IO module .sbttl Definitions ; DIM definition structure. Each entry contains a JMP instruction to the ; DIM's entry point for the specified operation. The IO module translates ; various IO calls into a call indirect through one of these entries. dsect < ioatt:: .blkw 2 ; JMP to attach entry iodet:: .blkw 2 ; JMP to detach entry ioordr:: .blkw 2 ; JMP to order entry ioread:: .blkw 2 ; JMP to read entry iowrit:: .blkw 2 ; JMP to write entry iodel:: .blkw 2 ; JMP to delete entry ioren:: .blkw 2 ; JMP to rename entry iopeek:: .blkw 2 ; JMP to peek entry > ; DEFDIM is a macro to create a DIM definition structure. All entry points ; must be specified (unimplemented operations should use an entry which does ; a LOSE %EBDIO). .macro defdim a1,a2,a3,a4,a5,a6,a7,a8 .irp a, .lif b a .error Missing DIM entry point jmp a .endm .endm ; Attach control bits %icrea==1 ; create file (rather than using existing one) %iupd==2 ; want update permission (writing) .sbttl IO system initialization ; IOINIT clears all the DIMTAB entires thus freeing every channel. ; Also every CHLTAB entry is set to a channel id which could legitemately ; reside there. ioinit: mov pc,r1 ; get ptr to DIMTAB array add #dimtab-.,r1 ; ... mov #100,r0 ; start counter first legit channel id loop < mov r0,chltab-dimtab(r1) ; set CHLTAB entry clr (r1)+ ; clear DIMTAB entry inc r0 ; advance counter cmp r0,#100+64. ; done all 64 entries? rptl lo > return .sbttl READL ; READL reads a line from the terminal into the specified input buffer. ; ARGS: VALS: ; SP -> ptr to buffer SP -> no. of chars ; buffer size ; output channel id ; input channel id readl: push r0,r1,r2 ; save regs 10$: mov 10(sp),r2 ; get ptr to buffer mov 12(sp),r1 ; get no. of characters in buffer add r2,r1 ; get ptr to beyond last char in buffer 20$: loop < push 16(sp) ; RCHAR arg: channel id call rchar ; get input character pop r0 ; val: character cmp r0,#15 ; CR? exitl eq cmp r0,#' ; ^U? if eq,< push 14(sp),#15 ; WCHAR args: channel id, character call wchar ; Type CR push 14(sp),#%tdeol ; WCHAR args: channel id, character call wchar ; Type Erase to end of line br 10$ > cmp r0,#177 ; RUBOUT? if eq,< cmp r2,10(sp) ; anything in buffer (ptr at beginning)? beq 1$ ; yes, feep at loser push 14(sp) ; RUBOUT arg: channel id movb -(r2),-(sp) ; RUBOUT arg: character call rubout ; rubout character rptl > cmp r0,#14 ; ^L? if eq,< ; clear screen and retype line push 14(sp),#%tdclr ; WCHAR args: channel id, character call wchar ; clear screen br 2$ > cmp r0,#' ; ^R? if eq,< push 14(sp),#15 ; WCHAR args: channel id, character call wchar ; Type CR push 14(sp),#12 ; WCHAR args: channel id, character call wchar ; Type LF br 2$ > cmp r0,#' ; ^W? if eq,< loop < cmp r2,10(sp) exitl eq movb -(r2),r0 push 14(sp),r0 ; RUBOUT args: channel id, character call rubout ; rubout character push r0 ; CHBITS arg: character call chbits ; get bits describing character bit #%alpha+%numer,(sp)+ ; val: bits, test for alphanumeric rptl eq ; keep going until get one > loop < cmp r2,10(sp) exitl eq movb -1(r2),r0 push r0 ; CHBITS arg: character call chbits ; get bits describing character bit #%alpha+%numer,(sp)+ ; val: bits, test for alphanumeric exitl eq dec r2 push 14(sp),r0 ; RUBOUT args: channel id, character call rubout ; rubout character rptl > rptl > cmp r2,r1 ; more input than room in buffer? beq 1$ movb r0,(r2)+ ; put character in buffer push 14(sp),r0 ; WCHAR arg: channel id, character call wchar ; echo input character rptl 1$: push 14(sp),#%tdbel ; WCHAR arg: channel id, character call wchar ; feep at luser rptl ; Retype line so far 2$: mov 10(sp),r1 ; use R1 as ptr to scan buffer with loop < cmp r1,r2 ; typed out everything yet? exitl eq ; yep push 14(sp) ; WCHAR arg1: channel id movb (r1)+,-(sp) ; WCHAR arg2: character call wchar ; retype character rptl > mov 10(sp),r1 ; restore r1 as ptr to end of buffer add 12(sp),r1 ; ... jmp 20$ > push 14(sp),#15 ; WCHAR arg: channel id, character call wchar ; Echo CRLF push 14(sp),#12 ; WCHAR arg: channel id, character call wchar mov r2,16(sp) ; calculate no. of characters read sub 10(sp),16(sp) ; ... pop r2,r1,r0,4(sp) ; restore regs, remove three args from stack cmp (sp)+,(sp)+ ; ... return ; RUBOUT echoes a rubout. On a display it erases the last character from ; the screen. On a printing terminal it simply echoes the character rubbed ; out. ; ARGS: VALS: ; SP -> character (none) ; channel id rubout: push 4(sp) ; ORDER arg: channel id push #10000+topt,#0 ; ORDER args: order code, order arg call order ; read TOPT bit #%toers,(sp) ; can terminal erase? if eq,< ; no bit #%toovr,(sp) ; can terminal overstrike? if ne,< tst (sp)+ ; remove TOPT word from stack push 4(sp) ; WCHAR arg: channel id push 2+2(sp) ; WCHAR arg: character call wchar ; echo character rubbed out br 1$ > > tst (sp)+ ; remove TOPT word from stack push 4(sp),#%tders ; WCHAR args: channel id, char (software code) call wchar ; erase character before cursor and back up cmpb 2(sp),#40 ; control character? bhis 1$ push 4(sp),#%tders ; WCHAR args: channel id, char (software code) call wchar ; erase character before cursor and back up 1$: pop (sp),(sp) ; remove arguments from stack return ; CHBITS ; ARGS: VALS: ; SP -> character SP -> bits chbits: push r0 ; save reg mov 4(sp),r0 ; get character argument bic #177600,r0 ; clear garbage bits add pc,r0 ; for PICness movb chtbl-.(r0),4(sp) ; lookup character bits in table clrb 5(sp) ; make sure high byte is zero pop r0 ; restore reg return ; CHTBL is a lookup table, indexed by character code. %print==1 ; character is printable %alpha==2 ; alphabetic (i.e. A-Z and a-z) %numer==4 ; numeric (i.e. 0-9) chtbl: .rept 32. ; control characters .byte 0 .endr .rept 16. .byte %print ; random characters .endr .rept 10. .byte %print+%numer .endr .rept 7. ; random characters .byte %print .endr .rept 26. ; upper case letters .byte %print+%alpha .endr .rept 6. ; random characters .byte %print .endr .rept 26. ; lower case letters .byte %print+%alpha .endr .rept 4. ; random characters .byte %print .endr .byte 0 ; rubout .iif ne chtbl+128.-., .error CHTBL wrong size? .sbttl Cursor movement ; POSITN moves the cursor to the specified position. ; ARGS: VALS: ; SP -> horizontal pos (none) ; vertical pos ; channel id posit: push uoch(r4),#%tdmov ; WCHAR args: channel id, character call wchar ; send software TTY code to move cursor push uoch(r4),4+2(sp) ; WCHAR args: channel id, character inc (sp) ; positions have to be sent +1 call wchar ; send vertical postion push uoch(r4),2+2(sp) ; WCHAR args: channel id, character inc (sp) ; positions have to be sent +1 call wchar ; send horizontal position pop (sp),(sp),(sp) ; remove arguments from stack return .sbttl Delete and Rename ; DELETE deletes a file from the device attached to the specified channel. ; ARGS: VALS: ; SP -> disk unit number SP -> error code ; file id ; device id delete: push 6(sp) ; IODEV arg: device id jsr r1,iodev ; lookup device mov r0,22(sp) ; return error code if eq,< ; no error? mov 20(sp),r3 ; pass file name in R3 mov 16(sp),r1 ; put disk unit number in R1 jsr r5,iodel(r5) ; delete file mov r0,22(sp) ; copy error code to return slot > jsr r0,iorest ; restore regs pop (sp),(sp) ; remove two args from stack return ; RENAME renames a file on the device attached to the specified channel. ; ARGS: VALS: ; SP -> disk unit number SP -> error code ; new file id ; old file id ; device id rename: push 10(sp) ; IODEV arg: device id jsr r1,iodev ; lookup device id mov r0,24(sp) ; save error code in return val slot if eq,< mov 22(sp),r3 ; pass old file name in R3 mov 20(sp),r2 ; pass new file name in R2 mov 16(sp),r1 ; put disk unit number in R1 jsr r5,ioren(r5) ; rename file mov r0,24(sp) ; save error code in return val slot > jsr r0,iorest ; restore regs pop (sp),(sp),(sp) ; remove three args from stack return .sbttl Attach and Detach ; ATTACH creates a new channel and attaches it to the specified device ; interface module. Device id and file id are ptrs to asciz strings ; containing the device name and file name. The device name is looked up ; and the attach entry of the DIM is called. The file name is passed in ; R3, the unit number is passed in R1, and the control bits in R2. ; The DIM returns a data word in R4 (this data word is ; passed to i/o entries) and an error code in R0. If the DIM ; attach succeeds then a channel id is conjured up and returned. ; ; ARGS: VALS: ; SP -> control bits SP -> channel id ; unit number error code ; file id ; device id attach: push 10(sp) ; IODEV arg: device id jsr r1,iodev ; lookup device id mov r0,24(sp) ; val: error code (also R5 is a ptr to DIM) bne 1$ mov pc,r1 ; ptr to DIMTAB add #dimtab-.,r1 ; ... mov r1,r4 ; copy ptr mov #64.,r0 ; no. of entries in DIMTAB peof ; no preemption while scanning DIMTAB loop < tst (r1)+ ; entry free? exitl eq ; yes, use it sorl r0 mov #%enach,24(sp) ; no free entries! return error code clr 22(sp) ; return zero channel id for safety peon ; allow preemption again br 1$ > mov r5,-(r1) ; save ptr to DIM in DIMTAB peon ; allow preemption again 2$: add #100,chltab-dimtab(r1) ; add 1 to high part of channel id bcs 2$ ; don't allow a high part of zero mov chltab-dimtab(r1),r4 ; get channel id mov 16(sp),r2 ; get control bits mov 22(sp),r3 ; get file id mov r4,22(sp) ; store channel id in return val slot push r1 ; save ptr into DIMTAB mov 22(sp),r1 ; put unit # in R1 jsr r5,ioatt(r5) ; call DIM attach entry pop r1 ; restore ptr into DIMTAB mov r0,24(sp) ; store error code if eq,< mov r4,ddwtab-dimtab(r1) ; set DIM data word inc nioch ; increment no. of i/o channels in use > else < clr (r1) ; attach error, clear DIMTAB entry, freeing ch clr 22(sp) ; return zero channel id for safety > 1$: jsr r0,iorest ; restore regs pop (sp),(sp) ; remove two args from stack return ; DETACH destroys the attachment of a channel to a device interface ; module. The channel id is no longer valid. The DIM detach entry ; is called to inform the DIM of the detachment. The DIM data word ; for the channel is passed in R4. ; ARGS: VALS: ; SP -> channel id (none) detach: push 2(sp) ; IOCALL arg: channel id jsr r1,iocall ; lookup channel id clr dimtab-io1(r0) ; free channel jsr r5,iodet(r5) ; call DIM detach entry point dec nioch ; decrement no. of i/o channels in use jsr r0,iorest ; restore regs pop (sp) ; remove arg from stack return .sbttl Read entries ; RCHAR reads one character from the specified channel. The DIM read ; entry is called to get the char. It is expected to return a character ; (or -1 to indicate end of file) in R0. The DIM data word for the ; channel is passed in R4. ; ARGS: VALS: ; SP -> channel id SP -> character rchar: push 2(sp) ; IOCALL arg: channel id jsr r1,iocall ; io setup jsr r5,ioread(r5) ; call DIM to read a character mov r0,16(sp) ; return character jsr r0,iorest ; restore regs return ; READN reads a specified no. of characters from a channel. The DIM ; read entry is called repeatedly until the buffer has been filled or the ; end of file reached. The DIM is expected to return a character (or -1 ; to indicate end of file) in R0. The DIM data word for the channel ; is passed in R4. ; ARGS: VALS: ; SP -> no. of chars SP -> decremented char count ; buffer ptr ; channel id readn: push 6(sp) ; IOCALL arg: channel id jsr r1,iocall ; io setup loop < jsr r5,ioread(r5) ; read a character tst r0 ; end of file? exitl mi movb r0,@20(sp) ; store character in buffer inc 20(sp) ; update ptr dec 16(sp) ; decrement count rptl ne > jsr r0,iorest ; restore regs pop 2(sp),2(sp) ; pop ret R5 into arg 2's slot, pop dec'd return ; char count into arg 1's slot .if ne asmpek ; PCHAR reads one character from the specified channel, without ; removing it from the input buffer. The DIM read ; entry is called to get the char. It is expected to return a character ; (or -1 to indicate end of file) in R0. The DIM data word for the ; channel is passed in R4. ; ARGS: VALS: ; SP -> channel id SP -> character pchar: push 2(sp) ; IOCALL arg: channel id jsr r1,iocall ; io setup jsr r5,iopeek(r5) ; call DIM to read a character mov r0,16(sp) ; return character jsr r0,iorest ; restore regs return .endc .sbttl Write entries ; WCHAR writes one character to the specified channel. The DIM write ; entry is called and passed the character in R0. The DIM data word ; for the channel is passed in R4. ; ARGS: VALS: ; SP -> character SP -> (none) ; channel id wchar: push 4(sp) ; IOCALL arg: channel id jsr r1,iocall ; io setup mov 16(sp),r0 ; character to write bic #177400,r0 ; leave only low byte jsr r5,iowrit(r5) ; write char jsr r0,iorest ; restore regs pop (sp),(sp) ; remove args from stack return ; WRITEC is like WRITEZ but takes its argument as a relative ptr after the ; call. ; ARGS: VALS: ; SP -> channel id (none) writec: push (sp) ; create slot for WRITEZ arg mov r5,2(sp) ; pick up relative ptr after call add (r5)+,2(sp) ; and convert to absolute ; fall through to WRITEZ ; WRITEZ writes an asciz string to a channel. This call is turned ; into a call to WRITEN by calculating the length of the asciz string. ; ARGS: VALS: ; SP -> string ptr SP -> (none) ; channel id writez: push (sp),r1 ; make slot for char count, save reg mov 6(sp),r1 ; ptr to asciz string clr 4(sp) ; start character count at zero loop < tstb (r1)+ ; null terminates exitl eq inc 4(sp) ; increment character count rptl > pop r1 ; restore reg ; fall through to WRITEN ; WRITEN writes a specified no. of chars to a channel. The DIM write ; entry point is called repeatedly with each character of the string. ; The character is passed in R0. The DIM data word for the channel is ; passed in R4. ; ARGS: VALS: ; SP -> no. of chars SP -> (none) ; buffer ptr ; channel id writen: push 6(sp) ; IOCALL arg: channel id jsr r1,iocall ; io setup tst 16(sp) ; character count zero? if ne,< loop < movb @20(sp),r0 ; character to write inc 20(sp) bic #177400,r0 ; leave only low byte jsr r5,iowrit(r5) ; write char dec 16(sp) ; decrement count rptl ne > > jsr r0,iorest ; restore reg pop 4(sp) ; remove args from stack cmp (sp)+,(sp)+ ; ... return .sbttl Order ; ORDER passes the order code to the DIM in R3 and the order argument in R2. ; The DIM may interpret these in any way it chooses. The DIM returns a value ; in R0 which is returned to the caller. ; ARGS: VALS: ; SP -> order argument SP -> return value ; order code ; channel id order: push 6(sp) ; IOCALL arg: channel id jsr r1,iocall ; io setup mov 20(sp),r3 ; order code mov 16(sp),r2 ; random order argument jsr r5,ioordr(r5) ; call order entry mov r0,22(sp) ; store return value jsr r0,iorest ; restore regs pop (sp),(sp) ; remove one arg from stack return ; STATUS returns an error code indicating the status of the device ; attached (0 if no error). The DIM's status entry is called. It ; is expected to return an error code (status code) in R0. The DIM ; data word for the channel is passed in R4. .sbttl Device hackery ; IODEV is called only by the I/O system entries. It takes one arg on ; the stack which is the device id to lookup (device ids are ptrs to asciz ; device names). It also saves the regs on the stack in a funny way. On ; return R5 is a ptr the DIM and R0 is an error code. To cleanup from a ; call to IODEV use IOREST. ; Note: IODEV is called by JSR R1,IODEV. iodev: push r2,r3,r4,r5 ; save regs (R1 on stack from call) mov 12(sp),r5 ; device id mov r0,12(sp) ; save reg mov pc,r2 ; ptr to DNAMES add #dnames-.,r2 ; ... loop < tst (r2) ; end of table? exitl eq mov r2,r3 ; convert relative ptr in DNAMES table add (r2)+,r3 ; to an absolute one push r5 ; save reg (ptr to device name to lookup) loop < cmpb (r5)+,(r3)+ ; compare corresponding bytes of the strings exitl ne tstb -1(r5) ; both strings terminated (by NULL) ? rptl ne pop * ; throw away pushed R5 mov dptrs-dnames-2(r2),r5 ; put relative ptr to DIM in R5 add pc,r5 ; make absolute iod: clr r0 ; no error jmp (r1) ; return to caller > pop r5 ; restore reg (ptr to device name to lookup) tst (r2) ; at end of DNAMES table? rptl ne > mov #%ensdv,r0 ; No such device error jmp (r1) ; return to caller ; DNAMES is a list of DIM names. The names are stored as relative ptrs ; to ASCIZ strings. dnames: .word dskn-. .lif ne nlp .word lptn-. .word ttyn-. .word bufn-. .word 0 dskn: .asciz "DISK" lptn: .asciz "LPT" ttyn: .asciz "TTY" bufn: .asciz "BUFFER" .even ; DPTRS contains relative ptrs to the DIMs. The ptr addresses a structure ; as created by DEFDIM, i.e. an array of JMP instructions to the various ; DIM entry points. dptrs: .word disk-iod .if ne nlp ifSAO < .word tty-iod ; temporary kludge for terminet line printer > ifMIT < .word lpt-iod > .endc .word tty-iod .word buf-iod .sbttl Channel hackery ; IOCALL is called only by the I/O system entries. It takes one arg ; on the stack which is the channel id to lookup. It also saves the ; regs on the stack in a funny way. On return R5 points to the channel ; structure and R4 is the DIM data word (also R0 is relative ptr into ; some internal tables, this is used only in DETACH). To cleanup from ; a call to IOCALL use IOREST. ; Note: IOCALL is called by JSR R1,IOCALL. iocall: push r2,r3,r4,r5 ; save regs (R1 on stack from call) mov 12(sp),r5 ; channel id mov r0,12(sp) ; save reg mov r5,r0 ; copy channel id bic #177700,r0 ; low 6 bits asl r0 ; for word ops add pc,r0 ; for PIC addressing io1: cmp r5,chltab-io1(r0) ; error check, is this the right channel id? if ne,< lose %ensch ; no bomb > mov ddwtab-io1(r0),r4 ; DIM data word mov dimtab-io1(r0),r5 ; DIM ptr jmp (r1) ; return to caller ; IOREST is used to clean up after IOCALL. The regs are restored. ; Call by JSR R0,IOREST. iorest: pop *,r5,r4,r3,r2,r1 rts r0 chltab: .blkw 64. ; table of channel ids ddwtab: .blkw 64. ; table of DIM data words for channels dimtab: .blkw 64. ; table of DIM ptrs for each channel nioch: .blkw 1 ; no. of i/o channels in use .sbttl Buffer DIM buf: defdim bufatt,bufdet,bufbad,bufr,bufw,bufbad,bufbad,bufbad bufatt: mov r3,r4 ; copy buffer ptr into DIM data word clr (r4) ; start character count at zero clr r0 ; return no error return bufdet: return ; do nothing on detach bufr: mov r4,r3 ; get DIM data word (ptr to buffer) add (r4),r3 ; add count to get ptr into buffer movb 2(r3),r0 ; get character from buffer inc (r4) ; increment count return bufw: mov r4,r3 ; get DIM data word (ptr to buffer) add (r4),r3 ; add count to get ptr into buffer movb r0,2(r3) ; put character into buffer inc (r4) ; increment count return bufbad: lose %ebdio ; give bad i/o error ð; -*-PALX-*- ; IOA is used to produce ascii output from an asciz control string ; and a variable no. of arguments whose use is dictated by the ; control string. An "^" in the control string serves as a sort ; of escape character; the next character (possibly proceeded by ; a decimal arg) is used to edit various arguments or characters ; into the final output string. All other characters in the control ; string are merely copied to the output string. ; Example: ; push r1,r2 ; IOAC args: seconds, minutes ; push och ; IOAC arg: channel id ; call ioac ; print out in time format ; .string ^"^d:^2z" ; minutes, a colon, two digits of seconds ; IOA data area dsect < .blkw 6 ; register storage area .blkw 1 ; return R5 ioacs:: .blkw 1 ; ptr to IOA control string ioach:: .blkw 1 ; channel id to output to lioab==20. ; size of IOA buffer ioabuf:: .blkb lioab ; IOA buffer area >,lioad .sbttl IOA entry points ; IOAC is like IOA but takes the control string arg as a relative ; ptr following the call. ; ARGS: VALS: ; sp -> channel id (none) ; arg1 - argn ioac: push (sp) ; make slot for control string ptr mov r5,2(sp) ; get relative ptr add (r5)+,2(sp) ; make absolute ; fall through to IOA ; IOA ; ARGS: VALS: ; sp -> control string ptr (none) ; channel id ; arg1 ; . ; . ; . ; argn ioa: push r5 ; save reg push #lioad/2 ; ALOCL arg: size of block call alocl ; allocate IOA data area pop r5 ; val: ptr to block .irp s, mov s,(r5)+ ; save R0-R5, ret R5, cs ptr, and channel id .endm sub #ioach+2,r5 ; get ptr to data block again mov ioacs(r5),r3 ; get ptr to control string mov r3,ioacs(r5) ; save ptr to control string ioal: mov ioacs(r5),r3 ; get ptr to current pos in control string clr r4 ; set character count to zero loop < inc r4 ; keep no. of chars until NULL or ^ movb (r3)+,r0 ; get character exitl eq ; end of control string cmpb r0,#'^ ; IOA escape char? rptl ne > dec r4 ; uncount NULL or ^ if ne,< push ioach(r5),ioacs(r5),r4 ; WRITEN args: channel id, ptr, count call writen > tst r0 ; was last char NULL or ^? bne ioau ; Return from IOA call .irp s, mov (r5)+,s ; restore R0-R4 .endm push 2(r5),(r5) ; push return R5 and R5 sub #12,r5 ; get back ptr to IOA data area push r5 ; FREE arg: ptr call free ; free IOA data area pop r5 ; restore reg return .sbttl IOA formatter ; IOAU reads the character after a ^ in the control string and ; dispatches to the appropriate formatter. IOAU also reads parses ; the command's prefix argument if any. ioau: mov #1,r4 ; default argument to 1 clr r1 ; set argument accumulator to zero loop < movb (r3)+,r0 ; get character after ^ cmp r0,#'0 ; digit? exitl lo cmp r0,#'9 exitl hi mul #10.,r1 ; multiply arg so far by 10 sub #'0,r0 ; add in this digit add r0,r1 ; ... mov r1,r4 ; set argument rptl > cmp r4,#lioab ; argument too large (larger than our buffer)? if hi,< mov #lioab,r4 ; yes, set to size of buffer > mov r3,ioacs(r5) ; save ptr to current pos in control string mov r5,r2 ; get ptr to just IOA buffer add #lioad,r2 ; ... cmp r0,#'^ ; ^^? beq ioa.u cmp r0,#'a ; ^a? beq ioa.a cmp r0,#'d ; ^d? beq ioa.d cmp r0,#'D ; ^D? beq ioa.ud cmp r0,#'e ; ^e? beq ioa.e cmp r0,#'o ; ^o beq ioa.o cmp r0,#'O ; ^O beq ioa.uo cmp r0,#'r ; ^r? beq ioa.r cmp r0,#'z ; ^z? beq ioa.z jmp ioal ; ignore unknown ^ codes ; ^^ - Output ^ ioa.u: mov #'^,r3 ; set pad character to ^ br ioapad ; output ^s ; ^e - Output error message ioa.e: call errmsg ; convert error code (on stack) to asciz ; error message ptr ; fall through to ^a ; ^a - Output asciz ioa.a: pop r0 ; pick up next argument, ptr to asciz string push ioach(r5),r0 ; WRITEZ args: channel id, asciz ptr call writez ; output string jmp ioal ; ^z - Output decimal, pad with zeros instead of spaces ioa.z: mov #'0,r3 ; set pad character to zero br ioa.d1 ; ^d - Output decimal ioa.d: mov #40,r3 ; set pad character to space ioa.d1: pop r0 ; get no. to convert to decimal from stack loop < mov r0,r1 ; setup for DIV clr r0 ; ... div #10.,r0 ; get least significant digit in remainder add #'0,r1 ; convert to ascii movb r1,-(r2) ; store in buffer dec r4 ; decrement field size tst r0 ; more (non-zero) digits to go? rptl ne > br ioapad ; ^D - Output double word decimal ioa.ud: pop r0,r1 ; get no. to convert to decimal from stack mov r2,r3 ; copy buffer ptr loop < push r3,r4,r5 ; save regs jsr pc,ddiv10 ; divide r0,r1 by 10, remainder in r2 pop r5,r4,r3 ; restore regs add #'0,r2 ; convert to ascii movb r2,-(r3) ; store in buffer dec r4 ; decrement field size tst r0 ; more (non-zero) digits to go? rptl ne tst r1 rptl ne > mov r3,r2 ; copy buffer ptr back mov #40,r3 ; set pad character to space br ioapad ; ^O - leading zero octal (btw, if you reallywanted a full word octal like ; Multics has, its just ^5O dummy) ioa.uo: mov #'0,r3 ; set pad character to zero br ioa.o1 ; ^o - Output octal ioa.o: mov #40,r3 ; set pad character to space ioa.o1: mov (sp)+,r0 ; get no. in R0 loop < mov r0,r1 ; extract low octal digit from no. bic #177770,r1 ; ... add #60,r1 ; convert to ascii digit ; Note: Carry is cleared by this addition ; and not changed by next two intructions movb r1,-(r2) ; store digit in buffer dec r4 ; decrement field size ror r0 ; we use a ror here to avoid propogating asr r0 ; sign bit first time as ash would do, but asr r0 ; after the first bit, we can use ASR rptl ne ; is the number all gone? > br ioapad ; ^r - Output rad50 ioa.r: mov (sp)+,r0 ; get word of rad50 from stack mov r5,r2 ; get ptr to just past IOA buffer add #lioad,r2 ; ... jsr pc,ioa.r1 ; store 3rd char jsr pc,ioa.r1 ; store 2nd char jsr pc,ioa.r1 ; store 1st char push ioach(r5),r2,#3 ; WRITEN args: channel id, ptr, count call writen ; write out the three chars just converted jmp ioal ioa.r1: mov r0,r1 ; setup for DIV clr r0 ; ... div #50,r0 ; get rightmost rad50 char in R1, rest in R0 add pc,r1 ; for PIC use of conversion table movb r50asc-.(r1),-(r2) ; convert char to ascii and store in buffer rts pc r50asc: .ascii " ABCDEFGHIJKLMNOPQRSTUVWXYZ$%.0123456789" .even ; Pad out field with character in R3. ioapad: dec r4 ; keep going until field size goes negative bmi 1$ movb r3,-(r2) ; put pad character in buffer br ioapad 1$: push ioach(r5),r2,r5 ; WRITEN args: channel id, ptr, count add #lioad,(sp) ; ... sub r2,(sp) ; ... call writen ; write out field jmp ioal ; -*-PALX-*- ; Versatec Electrostatic Printer/Plotter DIM .lif ne asmplt nvpts==1024. ; no. of points on a plot line ; Note: changing nvpts requires rewriting ; Calls to LPT DIM dispatch through this table: lpt: defdim latt,ldet,lorder,lno,lwrite,lno,lno,lno ; LPT DIM initialization: make LPT available. lpinit: ; nothing to do but fall through lppwru: call catchn ; catch NXM traps 1$-. clr lpbusy ; make LPT unavailable tst @#lps ; LPT there? mov #-1,lpbusy ; make LPT available 1$: return lpbusy: .word 0 ; -1 if LPT not in use ; LPT data block. The DIM data word passed in R4 is a ptr to this ; structure. It is created at attach time, destroyed by detaching. dsect < lhpos:: .word 0 ; horizontal printer position lvpos:: .word 0 ; vertical printer position lbuf:: .blkb 132. ; printer buffer .if ne asmplt lplmp:: .word 0 ; ptr to plot message to match lplmc:: .word 0 ; count of matching characters lsemfl:: .word 0 ; semicolon flag vpc:: .word 0 ; plot co-routine PC vr1:: .word 0 ; plot co-routine R1 vvpos:: .word 0 ; vertical plotter position vlasty:: .word 0 ; previous y1 value, this is for checking data. vfree:: .word 0 ; plot block freelist vlist:: .word 0 ; ptr to first plot block in list vlstb:: .word 0 ; ptr to last plot block processed .lif ne asmspp spplin:: .word 0 ; counter used to determine when to spp vbuf:: .blkb nvpts/8. ; plotter buffer .endc >,ltbll ; LPT attach entry point. latt: inc lpbusy ; LPT already being use? if ne,< dec lpbusy ; compensate for INC mov #%enadv,r0 ; being used, give device not available error return > push #ltbll/2,#2*60. ; ALOCW args: size, timeout call alocw ; get LPT data block pop r4,r0 ; vals: ptr, error code bne 1$ ; couldn't get memory .if ne asmplt mov pc,-(sp) ; start LPLMP at LPLMSG add #lplmsg-.,(sp) ; ... mov (sp)+,lplmp(r4) ; ... .endc clr r0 ; attach successful, zero error code clr lvpos(r4) ; started at line no. 0 1$: return ; LPT detach entry ldet: tst lvpos(r4) ; on line 0?? if ne,< movb #14,@#lpb ; send a FF to print line and advance > push r4 ; FREE arg: ptr to block call free ; free LPT data block dec lpbusy ; set LPBUSY to -1 to indicate free return ; LPT read, delete, and rename entries lno: lose %ebdio ; LPT can't read, delete or rename ; LPT order entry lorder: cmp r3,#1 ; Status request? if eq,< clr r0 ; return zero unless LPT hung tst @#lps ; how's LPT feeling? if mi,< mov #%ehgdv,r0 ; bad, very bad. return device hung > return > lose %ebdoc ; Bad order code return ; LPT write entry lwrite: mov r4,r3 ; ptr to printer buffer add #lbuf,r3 ; ... .if ne asmplt tst vpc(r4) ; plotting? if ne,< jmp lplot ; yes, handle incoming data specially > cmpb r0,@lplmp(r4) ; this part of the plot message? if eq,< inc lplmp(r4) ; move to next character of message tstb @lplmp(r4) ; end of message? beq lvgo ; yes, start plotting inc lplmc(r4) ; no, indicate how far match goes > else .endc cmpb r0,#11 ; TAB? if eq,< add #10,lhpos(r4) ; move to next multiple of 8 bic #7,lhpos(r4) ; ... return > cmpb r0,#12 ; LF? if eq,< jsr r5,lpout ; print the line movb r0,@#lpb ; send the LF to print the line inc lvpos(r4) ; update line no. return > cmpb r0,#14 ; FF? if eq,< jsr r5,lpout ; output line jsr r5,lprdy ; wait for LPT to be ready movb r0,@#lpb ; send the FF to print line and advance clr lvpos(r4) ; clear vertical position clr lhpos(r4) ; clear horizontal position return > cmpb r0,#15 ; CR? if eq,< clr lhpos(r4) ; clear column no. return > add lhpos(r4),r3 ; get ptr into buffer cmpb r0,#40 ; spaces don't overwrite, just advance if ne,< cmp lhpos(r4),#132. ; beyond last print position? if lo,< movb r0,(r3) ; no, put character in buffer > > inc lhpos(r4) ; advance one print position return lplmsg: .asciz "*/-+" ; message to look for on incoming data, .even ; plotting data follows directly after lpout: push r1,r2,r3 ; save regs mov #lps,r1 ; printer status reg mov r4,r2 ; ptr to printer buffer add #lbuf,r2 ; ... mov #132.,r3 ; character count jsr r5,lprdy ; wait for LPT ready loop < tstb (r1) ; wait for ready rptl pl ; ... movb (r2),2(r1) ; output byte to LPT movb #40,(r2)+ ; clear buffer as we go sorl r3 ; exactly 132 characters > pop r3,r2,r1 ; restore regs rts r5 lprdy: push #lps,#100200 ; TWONBN args: address, bit mask call twonbn ; wait for ready bit in printer status reg tst @#lps ; error condition? if mi,< ; lose %ehgdv ; error, bomb out ; br lprdy ; continued, check again call sysmsg .string ^"LPT hung " push #lps,#100000 ; TWONBE args: address, bit mask call twonbe ; wait for error bit in printer status reg > rts r5 .sbttl Plot setup .if ne asmplt ; The following portion of the LPT DIM passes incoming plot ; data to the plot co-routine. The incoming characters are ; converted to 6 bit no.s before being passed to the plot ; co-routine. lvgo: sub #4,lplmp(r4) ; correct plot message ptr clr lplmc(r4) ; and count jsr r5,lprdy ; wait for LPT ready movb #14,@#lpb ; FF so plot starts on new page jsr pc,vgo ; call plot co-routine pop vpc(r4) ; save co-routine PC rts r5 lplot: tst lsemfl(r4) ; last character a ";"? if ne,< clr lsemfl(r4) ; clear the semicolon flag add pc,r0 ; yes, find correct value from table movb lpct-.-100(r0),r0 ; ... > else < cmp r0,#'; ; semicolon gobbles next character if eq,< mov pc,lsemfl(r4) ; indicate need another character return > sub #40,r0 ; make into values 0-77 blos 1$ ; ignore space and ctrl characters cmp r0,#'/-40 if eq,< clr r0 > > mov vr1(r4),r1 ; restore reg used by plot co-routine jsr pc,@vpc(r4) ; call handler as co-routine pop vpc(r4) ; save co-routine PC mov r1,vr1(r4) ; save reg used by plot co-routine 1$: return lpct: .byte 33,20,17,377,6 ; table of ";" escape equivilants .even .sbttl Plot Co-routine ; The plot co-routine takes incoming 6 bit plot data characters ; and fills plot blocks with vector calls. The vector calls ; are stored in a list (VLIST) which is scanned to plot each ; line on the Versatec. Once the last y value of a vector call ; is smaller than the line counter the vector call is used up ; and is removed from VLIST. ; Plot blocks have the following format: dsect < ; Note!!! The order of the following is critical .word 0 ; link to next plot block ; 0 iff this is last block ; -1 iff next block not yet in vy1:: .word 0 ; starting y value vy2:: .word 0 ; end y value (100000 for horizontal line) vmlo:: .word 0 ; low 10 bits of vm (bits 15-4) vxlo:: .word 0 ; low 10 bits of vx (bits 15-4) vmhi:: .word 0 ; hi 10 bits of vm (bits 9-0) vxhi:: .word 0 ; hi 10 bits of vx (bits 9-0) vlastx::.word 0 ; last x value plotted (-1 if none) vdash:: .word 0 ; dashlin patern >,vblen vgo: clr vvpos(r4) ; start at line 0 clr vlasty(r4) ; start previous y value at something small mov #-1,vlist(r4) ; no blocks on list yet .if ne asmspp mov #1,spplin(r4) ; set so 1st plot line will also print mov #1,@#lvs ; turn on simultaneous print/plot .endc jsr pc,@(sp)+ ; read and ignore the first two bytes jsr pc,@(sp)+ ; ... ; Come to VLINE to start processing a line vline: mov r4,r1 ; set last block to VLIST add #vlist,r1 ; ... ; Come to VNEXT to process next block vnext: mov r1,vlstb(r4) ; save ptr to last block mov (r1),r1 ; get ptr to next block beq vplot ; end of input cmp r1,#-1 ; next block in yet? (-1 if not in) if eq,< jmp vstuff ; not in, go stuff another > ; Come to VPROC to process a plot block vproc: mov vvpos(r4),r0 ; get plot line no. we're working on tst (r1)+ ; skip over link word cmp r0,(r1)+ ; up to this plot block yet? blo vplot ; no, plot current line cmp r0,(r1)+ ; check if beyond this plot block bhi vpast ; yes, we're past this plot block cmp -4(r1),-2(r1) ; horizontal line? if eq,< mov (r1)+,r3 ; horizontal line, get x2 cmp (r1)+,(r1)+ ; skip over vxlo and vmhi mov (r1)+,r2 ; get x1 tst (r1)+ ; move ptr to vdash entry for compatability sub r2,r3 ; get no. of points to put on this plot line br vhoriz > add (r1)+,(r1)+ ; add vmlo to vxlo adc 2(r1) ; double precision add (r1)+,(r1) ; add vmhi to vxhi bic #176000,(r1) ; clear high bits mov (r1)+,r2 ; and copy vxhi (integer part of vx) tst -6(r1) ; high bit set in vxlo? if mi,< inc r2 ; yes, round this x value up > mov (r1),r3 ; get last x for this plot block if mi,< mov r2,(r1)+ ; negative if this is first use > else < mov r2,(r1)+ ; set last x for next call sub r2,r3 ; get no. of points to put on this plot line > ; VHORIZ plots horizontal lines. Used for horizontal vector calls ; and for portions of other vector calls. vhoriz: mov r2,r0 ; r2 will be ptr, r0 will be bit bic #177770,r0 ; low three bits select bit pos ash #-3,r2 ; bits 3-9 select byte in buffer add r4,r2 ; add ptr to buffer add #vbuf,r2 ; ... add pc,r0 ; get ptr into table of bits movb bits-.(r0),r0 ; PICally (of course) loop < asr (r1) ; check dashline pattern if cs,< bis #1000,(r1) ; complete rotate bisb r0,(r2) ; set bit in buffer > tst r3 ; going left or right? exitl eq ; Note: C bit clear so can RORB and ROLB if pl,< rolb r0 ; moving right. if cs,< rolb r0 ; set high bit (wrap) inc r2 ; move to next byte > sorl r3 ; more bits to plot? > else < rorb r0 ; moving left, move to next bit if cs,< rorb r0 ; set low bit (wrap) dec r2 ; and move to previous byte > inc r3 ; more bits to go? rptl ne ; loop till all bits done > > sub #vdash,r1 ; set ptr back to beginning of block br vnext ; do next block ; VPAST is executed when the current line being plotted is beyond ; the last y value of a vector call. The vector call is removed ; from VLIST. vpast: sub #6,r1 ; set ptr back to beginning of block mov (r1),@vlstb(r4) ; remove block from VLIST mov vfree(r4),(r1) ; put onto freelist mov r1,vfree(r4) ; ... mov vlstb(r4),r1 ; ptr to last block br vnext ; continue from there ; Come to VPLOT to plot current line buffer vplot: push r1,r2,r3 ; save regs mov #lvs,r1 ; plot status register mov r4,r2 ; ptr to line buffer to be plotted add #vbuf+,r2 ; ... mov #nvpts/8.,r3 ; character count .if ne asmspp dec spplin(r4) ; time to reload print buffer? if eq,< mov #12.,spplin(r4) ; yes, reset counter jsr r5,lpout ; call standard routine to print > .endc jsr r5,lvrdy ; wait for LPT ready loop < tstb (r1) ; wait for ready rptl pl ; ... movb -(r2),2(r1) ; send byte to plotter clrb (r2) ; and clear our buffer as we do sorl r3 ; should gobble 1 line very quickly > pop r3,r2,r1 ; restore regs inc vvpos(r4) ; update line counter tst vlist(r4) ; anything left on list to plot? if ne,< jmp vline ; stuff left, go process more plot blocks > ; terminate plot with a FF 1$: jsr r5,lvrdy ; wait for LPT ready mov #20,@#lvs ; turn off simultaneous print/plot and FF ; free blocks on plot free list loop < mov vfree(r4),r1 ; ptr to 1st block on plot freelist exitl eq ; null ptr ends list mov (r1),vfree(r4) push r1 call free rptl > ; terminate plot co-routine push (sp) ; create slot for fake co-routine PC clr 2(sp) ; will put zero into VPC to terminate plot rts pc ; return to normal character output lvrdy: push #lvs,#100200 ; TWONBN args: address, bit mask call twonbn ; wait for ready bit in plotter status reg tst @#lvs ; error condition? if mi,< lose %ehgdv ; error, bomb out br lvrdy ; continued, check again > rts r5 ; This portion of the plot co-routine stuffs plot blocks from the ; incoming data. vstuff: jsr pc,@(sp)+ ; get plotting character tstb r0 if mi,< clr @vlstb(r4) ; clear link word in last block br vplot ; plot current line > mov vfree(r4),r1 ; plot block freelist ptr if eq,< push #vblen/2 ; ALOCW arg: size call alocl ; get another plot block pop r1 ; val: ptr > else < mov (r1),vfree(r4) ; remove block from freelist clr vxlo(r1) ; zero garbage from last use > ash #4,r0 ; shift left 4 places mov r0,vmhi(r1) ; put in plot block jsr pc,@(sp)+ ; get next character clr vmlo(r1) ; start vmlo off zero ror r0 ; shift 2 bits from r0 into vmlo<15:14> ror vmlo(r1) ; ... ror r0 ; ... ror vmlo(r1) ; ... bis r0,vmhi(r1) ; rest of character goes into vmhi<3:0> jsr pc,@(sp)+ ; get next character swab r0 ; shift left 8 places bis r0,vmlo(r1) ; and fill in vmlo<13:8> jsr pc,@(sp)+ ; get next character ash #2,r0 ; shift character left 2 bis r0,vmlo(r1) ; set vmlo<7:6> bic #77,vmlo(r1) ; clear unused bits ash #4,r0 ; shift character left 4 more mov r0,vdash(r1) ; set vdash<9:6> bic #176000,vdash(r1) ; clear unused bits jsr pc,@(sp)+ ; get yet another character bis r0,vdash(r1) ; fill in vdash<5:0> jsr pc,@(sp)+ ; another character ash #4,r0 ; shift left by 4 mov r0,vy2(r1) ; put in vy2<9:4> jsr pc,@(sp)+ ; another character movb r0,vy1+1(r1) ; put in vy1<9:8> bic #176377,vy1(r1) ; clear other bits ash #-2,r0 ; shift right 2 bis r0,vy2(r1) ; and put in vy2<3:0> jsr pc,@(sp)+ ; another character ash #2,r0 ; shift left 2 bis r0,vy1(r1) ; put in vy1<7:2> jsr pc,@(sp)+ ; another character ash #4,r0 ; shift so 2 bits over byte boundary swab r0 ; put 2 bits in low byte bisb r0,vy1(r1) ; put in vy1<1:0> clrb r0 ; clear 2 bits swab r0 ; restore bytes ash #2,r0 ; shift 2 more places left mov r0,vxhi(r1) ; set vxhi<9:6> jsr pc,@(sp)+ ; another character bis r0,vxhi(r1) ; set vxhi<5:0> cmp vy1(r1),vy2(r1) ; same starting and stopping y pos? if ne, else < mov vmlo(r1),r0 ; get into register asl r0 ; move high ten bits into low ten bits by: adc r0 ; rotating r0 left 2 asl r0 adc r0 swab r0 ; and then switching bytes mov r0,vmlo(r1) ; put back > cmp vy1(r1),vlasty(r4) ; are blocks in ascending order as they ; should be? if lo,< mov vfree(r4),(r1) ; free the block we're on now mov r1,vfree(r4) ; ... clr @vlstb(r4) ; clear link word in last block call sysmsg .string ^"Bad plot data " jmp vplot > mov vy1(r1),vlasty(r4) ; save this y value for ascension check mov #-1,vlastx(r1) ; to indicate not yet used mov #-1,(r1) ; -1 indicates next block not yet in mov r1,@vlstb(r4) ; link this block to last block in list mov r1,vlstb(r4) ; save ptr to this plot block jmp vproc .endc ; ne asmplt ; -*-PALX-*- .sbttl Memory_plot command x0==64. y0==1000. x1==4032. y1==2000. memplt: push #300./2 ; ALOCL arg: no. of words call alocl ; allocate buffer for title pop r3 ; val: ptr push pc ; ATTACH arg1: device name add #bufn-.,(sp) ; ... push r3 ; ATTACH arg2: filename (actually buffer ptr) push #0,#0 ; ATTACH arg3&4: disk unit #,control bits call attach ; get i/o channel to MPBUF pop r2,r0 ; vals: channel id, error code if ne,< jmp comerr ; go handle error > push #tvn ; IOA arg: Trantor version no. push r2 ; IOA arg: channel id call ioac ; starting consing up title .if eq sysexp .string ^" Trantor ^d Free Storage Area at " .endc .else .string ^" Trantor ^dX Free Storage Area at " .endc push r2 ; PTIME arg1: channel id push #%pttime+%ptdate+%ptday ; PTIME arg2: control bits call time ; PTIME args 3 and 4: time lo, time hi call ptime ; put time and date in title push fssize ; IOA arg: no. of words of free storage mov fsata+0,-(sp) ; get no. of words allocated sub fsft+0,(sp) ; subtract no. freed to get no. of words in ; use to get IOA arg push fsac ; IOA arg: no. of blocks in use push r2 ; IOA arg: channel id call ioac ; put total free storage area size in title .string ^" ^d blocks using ^d out of ^d words " push r2 ; DETACH arg: channel id call detach ; close channel to buffer call tekbeg ; initiate plotting pop r0 ; val: error code if ne,< jmp comerr ; hack error if non-zero > push #3124.-90.,#0. ; TEKMOV args: y coordinate, x coordinate call tekmov ; move to home position push r3 ; TEKSTR arg1: buffer ptr add #2,(sp) ; text starts at buffer+2 push (r3) ; TEKSTR arg2: no. of characters call tekstr ; put out title push r3 ; FREE arg: ptr call free ; free up buffer push #66.,#42. ; TEKSIZ args: vertical size, horizontal size call teksiz ; set character size to 3/4 normal push #90. ; TEKROT arg: rotation in degrees call tekrot ; use 90 degree rotation on characters ; Draw box push #y1,#x0 ; TEKMOV args: y coordinate, x coordinate call tekmov ; move to upper left corner push #y1,#x1 ; TEKDRW args: y coordinate, x coordinate call tekdrw ; draw to upper right corner push #y0,#x1 ; TEKDRW args: y coordinate, x coordinate call tekdrw ; draw to lower right corner push #y0,#x0 ; TEKDRW args: y coordinate, x coordinate call tekdrw ; draw to lower left corner push #y1,#x0 ; TEKDRW args: y coordinate, x coordinate call tekdrw ; draw to upper left corner ; Fill in regions push r4 ; save reg mov fslo,r5 ; ptr to beginning of free storage area mov #x0,r2 ; set current x position to left end clr mplax ; clear last address x coordinate call mpaddr ; draw address at left end loop < mov r2,r4 ; set last position to current position mov (r5),r2 ; get length of current block push r2 ; save header word for testing freebit later asl r2 ; times two to convert from words to bytes add r2,r5 ; get address of next block mov r5,r2 ; get offset of block in free storage area sub fslo,r2 ; ... mul #,r2 ; convert to plotter coordinate div fssize,r2 ; ... asr r2 ; (since FSSIZE is in words) add #x0,r2 ; ... tst (sp)+ ; test freebit of current block bpl 1$ ; free, skip shading add #8.,r4 ; width of rectangle to shade less than 8? cmp r2,r4 ; ... blo 1$ ; yes, skip shading sub #8.,r4 ; restore R4 mov r2,r3 ; find x coordinate to shade up to add #,r3 ; ... mov r4,r1 loop < add #40.,r1 ; next x1 cmp r1,r3 ; reached limit? exitl his ; Put X1,Y1 on stack cmp r1,r2 if hi,< push #y1 sub r1,(sp) add r2,(sp) push r2 > else < push #y1,r1 > ; Put X2,Y2 on stack push #y0,r1 sub #,(sp) cmp (sp),r4 if lt,< mov r4,(sp) mov #y1,2(sp) sub r1,2(sp) add r4,2(sp) > ; TEKLIN args: y1, x1, y2, x2 call teklin ; draw line rptl > 1$: cmp r5,fshi ; reached end of free storage area? exitl his push #y0,r2,#y1,r2 ; TEKLIN args: y1, x1, y2, x2 call teklin call mpaddr ; draw current address rptl > call mpaddr ; draw final address call tekend ; terminate plotting pop r4 ; restore reg rts pc ; Draw address at current x position. mpaddr: cmp r2,mplax ; too close to last address x coordinate? blos 1$ mov r2,mplax ; save for closeness comparision add #49.,mplax push #y1+42.,r2 ; TEKMOV args: y coordinate, x coordinate add #20.,(sp) ; ... call tekmov ; move to where address is to go mov (sp),r0 ; get address to draw (from saved R5 on stack) clr r1 sec ; this insures loop terminates after exactly ; six digits loop < rol r0 rol r1 add #'0,r1 push r1 ; TEKASC arg: character call tekasc ; draw digit clr r1 ; clear for shifting in next octal digit asl r0 exitl eq rol r1 asl r0 rol r1 rptl > 1$: return mplax: .blkw 1 ; last address x coordinate "%; User200 simulator for PDP11 -*-PALX-*- u2vn==%fnam2 .sbttl Definitions ; Message codes. usom==001 ; start of message ueom==003 ; end of message usit==160 ; site code urea==023 ; read uack==006 ; acknowledge urej==030 ; reject uerr==025 ; error uesc==076 ; escape code ue1==102 ; E1 ue2==040 ; E2 ue3==041 ; E3 ; User200 table definition. dsect < .blkb lcs ; room for command structure utrmln:: .blkw 1 ; saved width of users terminal udpfl:: .blkw 1 ; nonzero if DP11 ucsra:: .blkw 1 ; address of DP11/DU11 usts:: .blkw 1 ; status word ursw:: .blkw 1 ; receive co-routine PC ussw:: .blkw 1 ; send co-routine PC umbp:: .blkw 1 ; ptr to message buffer ulbp:: .blkw 1 ; ptr to LPT buffer urmp:: .blkw 1 ; receiver message ptr urcc:: .blkw 1 ; receiver character count urcs:: .blkw 1 ; receiver checksum uxmp:: .blkw 1 ; xmtr message ptr uxcc:: .blkw 1 ; xmtr character count uxcs:: .blkw 1 ; xmtr ckecksum urmc:: .blkw 1 ; read message count unwrit:: .blkw 1 ; no. of write messages received usta:: .blkw 1 ; station address of last message ucode:: .blkw 1 ; message code of last message uecode:: .blkw 1 ; E1, E2 or E3 from last message uwsta:: .blkw 1 ; station address of last write uosta:: .blkw 1 ; station address for next output uocode:: .blkw 1 ; control code for next output uoecod:: .blkw 1 ; E1, E2 or E3 for next message uhpid:: .blkw 1 ; process id of handler process uscrpq:: .blkb lq ; script queue structure ulof:: .blkw 1 ; LPT output flag udof:: .blkw 1 ; display output flag uosw:: .blkw 1 ; output co-routine PC ueof:: .blkw 1 ; echo output flag upbf:: .blkw 1 ; poll beep flag ueif:: .blkw 1 ; echo input flag ucwt:: .blkw 1 ; says whether clear_write should really clear udmf:: .blkw 1 ; debugging messages flag (transmitter) urdmf:: .blkw 1 ; debugging messages flag (receiver) ulpch:: .blkw 1 ; LPT channel id ucrch:: .blkw 1 ; Card Reader channel id ucomp:: .blkw 1 ; computer that u200 is talking to %upar:: .blkw 1 ; parity errors %ucar:: .blkw 1 ; carier loss %ufrm:: .blkw 1 ; framing error %uovr:: .blkw 1 ; overrun error ueff:: .blkw 1 ; form feeds allowed ucbuf:: .blkb 80. ; command buffer, input is copied here ucbfln:: .blkw 1 ; length of command buffer >,lutbl ; USTS bits %urbsy==1 ; receiver busy, i.e. received site code %umsg==2 ; message in buffer (reject all incoming msgs) %usndw==4 ; waiting to send a message %uint==10 ; interrupt CDC computer %usui==20 ; user input waiting to be sent %usrm==40 ; read message waiting to be sent .if ne ndp*ndu .macro ifdp code tst udpfl(r4) if ne,


.endm

.macro	ifdu code
	tst udpfl(r4)
	if eq,
.endm

.iff

  .if eq  ndp
      .macro	ifdp code
      .endm
      .macro	ifdu code
		code
      .endm
  .iff
      .macro	ifdp code
		code
      .endm
      .macro	ifdu code
      .endm
  .endc

.endc

.sbttl	User200 Initialization

; This is the U200 command.

u200:   push #0,#80.		; SETSS args: process id, size
	call setss		; get us a large stack
	pop *			; val: error code
	if ne,<
	  lose 0
	  >
; allocate UTBL (storage block for User200 simulator)
	push #lutbl/2,#60.	; ALOCW arg: size of block, timeout
	call alocw		; allocate UTBL
	pop r1,r0  		; val: ptr
	if ne,<
	  jmp comerr		; go handle error
	  >
	mov #lcs/2,r0		; length of command structure
loop <	  mov (r4)+,(r1)+	; copy into UTBL
	  sorl r0
	  >
	sub #lcs,r4		; get back ptr to command structure
	sub #lcs,r1		; ...
	push r4			; FREE arg: ptr
	call free		; free command structure
	mov r1,r4		; use User200's version
	mov r4,filep(r4)	; ptr to FILNAM
	add #filnam,filep(r4)	; ...
	clr ucomp(r4)		; default computer is NCAR
	call moroff		; turn off more processing
;	push uoch(r4)		; ORDER arg: channel id
;	push #10000+tvmax,#0	; ORDER args: order code, order arg
;	call order		; read page height
;	pop *			; val: page height
;	bgt 1$
;	err ^"U200 only works on display terminals."
;	jmp uex1

; Assign a DP11 or DU11.

1$:	push r4			; SYNASN arg: ptr to data block
	call synasn		; get a synchrounous interface (DP or DU),
	pop udpfl(r4)		; val: DP/DU flag
	pop ucsra(r4)		; val: CSR address of DP or DU
	pop r0			; val: error code
	beq 2$
	jmp usuer1		; hack error if any

; Allocate message buffer.

2$:	push #<1039.+1>/2,#60.	; ALOCW args: size of block, timeout
	call alocw		; allocate buffer for receiving messages
	pop umbp(r4),r0		; save ptr in UTBL
	bne usuer1		; go hack error if any

; Allocate LPT buffer.

	push #<1039.+1>/2,#60.	; ALOCW args: size of block, timeout
	call alocw		; allocate buffer for receiving messages
	pop ulbp(r4),r0		; save ptr in UTBL
	bne usuer1		; go hack error if any

; Allocate script buffer.

	push #200./2,#60.	; ALOCW args: size of block, timeout
	call alocw		; allocate buffer for scripting
	pop r1,r0		; vals: ptr to block, error code
	bne usuer1		; go hack error if any
	push r1,#200.,r4	; QINIT args: buffer ptr, buffer size, queue
	add #uscrpq,(sp)	; ptr
	call qinit		; initialize queue structure

; Setup LPT and CR channels.

	call ulatt		; attach LPT if possible
	clr ucrch(r4)		; no CR specified yet

; Create handler process

	mov r4,uhr4		; pass R4 to handler process
	push pc			; MAKEP arg: initial PC
	add #uhandl-.,(sp)	; ...
	call makep		; create User200 handler process
	pop uhpid(r4),r0	; vals: process id, error code
	bne usuer1
	push uhpid(r4)		; STARTP arg: process id
	call startp		; start the handler process
	pop r0			; val: error code
	bne usuer1

; Setup receiver co-routine.

	mov pc,ueif(r4)		; turn on input echoing
	mov pc,ueof(r4)		; turn on output echoing
	mov pc,upbf(r4)		; turn on poll beeping
	mov pc,ucwt(r4)		; turn off clear write screen clearing
	mov pc,%upar(r4)
	mov pc,%ucar(r4)
	mov pc,%uovr(r4)
	mov pc,%ufrm(r4)
	clr ueff(r4)		; no form feeds in output by default
	clr udmf(r4)		; turn on debugging messages
	mov ucsra(r4),r1	; get address of DP11/DU11
	spl 5			; high priority to setup
	jsr pc,urcv		; initiate reception
	pop ursw(r4)		; ...
	spl 0			; restore pr0
	push uoch(r4)		; WRITEC arg: channel id
	call writec		; print greeting message
	  .string ^"User200 in operation
"
	push uoch(r4)		; ORDER arg: channel id
	push #2,#%tcnctn	; ORDER args: order code, order arg
	call order		; BIS into cbits, turn off line continuation
	pop *			; val: order val
	push uoch(r4)		; ORDER arg: channel id
	push #10000+thmax,#0	; ORDER args: order code, order arg
	call order		; read width of terminal
	pop utrmln(r4)		; val: term width, save for later
	push uoch(r4)		; ORDER arg: channel id
	push #20000+thmax,#79.	; ORDER args: order code, order arg
	call order		; make terminal line length 79 cloumns
	pop *			; val: meaningless
	br ucoml		; enter User200 command loop

usuer1: br usuerr		; this is here for range

; Attach LPT as User200 output device.
ulatt:	jsr pc,gettpl		; try to get the TPL if possible
	pop ulpch(r4),r0	; vals: channel id, error code
	if ne,<
	  push r0		; IOA arg: error code
	  push uoch(r4)		; IOA arg: channel id
	  call ioac
	    .string ^"Can't get LPT - ^e
"
	  >
	return


; Handle error in User200 startup.  R0 contains error code.
usuerr:	push r0			; IOA arg: error code
	push uoch(r4)		; IOA arg: channel id
	call ioac
	  .string ^"Error in User200 startup - ^e
"
	jmp uex1

.sbttl	User200 command processor

ucoml:	call rdcmdl		; read command line into command input buffer
	call rdcmdc		; get first character
	cmpb (sp)+,#'@		; input data or command?
	bne uidata
; Interpret input line as simulator command
	call sarg		; read a string argument
				; SCASE args: ptr, length
	push pc			; SCASE arg3: ptr to list of strings
	add #uclist-.,(sp)	; ...
	call scase		; lookup command name in list
	pop r1,*		; vals: ptr to entry, error code
	if ne,<
	  err ^"Illegal command"
	  br 1$
	  >
	jsr pc,@2(r1)		; call routine for this command
	tst errflg(r4) 		; error message to print?
	if ne,<
1$:	  push uoch(r4),errflg(r4) 	; WRITEZ args: channel, asciz ptr
	  call writez 		; print error message
	  type ^"
"
	  clr errflg(r4) 	; clear error flag
	  >
	br ucoml

; Send whole input line to CDC computer.
uidata:	call rrcmdc		; reread the first character (the non-@).
	mov r4,r3		; ptr to UCBUF
	add #ucbuf,r3		; ...
	mov #80.,r2		; size of UCBUF
loop <	  call rdcmdc		; get character from command line
	  movb (sp)+,r0		; RDCMDC val: character
	  exitl eq
	  cmp r0,#40		; control character?
	  rptl lo		; yes, ignore
	  add pc,r0			; translate from ASCII to CDC code
	  movb uactab-40-.(r0),r0	; ... 
	  rptl eq		; ignore character if translation is zero
	  movb r0,(r3)+		; put character into UCBUF
1$:	  sorl r2
	  >
	tst ucomp(r4)		; are we talking to NCAR or a CDC computer
	if ne,<
	  mov #80.,ucbfln(r4)	; calculate the length of message
	  sub r2,ucbfln(r4)	; for the CDC computer
	  >
	else <
	  mov #80.,ucbfln(r4)	; send 80 characters to NCAR
	  call upad		; pad out rest of line with spaces
	  >
	bis #%usui,usts(r4)	; indicate there's user input to send
	br ucoml		; process more user input


; List of User200 simulator commands.
uclist:	.word 4			; no. of bytes per entry
	defcom shutdn,
	defcom nshtdn,
	defcom uother,
	defcom uncar,
.lif ne asmtrl
	defcom utroll,
	defcom uexit,
	defcom ureadf,
	defcom uwritf,
	defcom ucr,
	defcom ucw,
	defcom uenabl,
	defcom udisab,
	defcom uff,
	defcom uint,
	defcom udial,
	defcom uhang,
	defcom ulistc,
	defcom ld,
	.word 0			; terminator

; ROCHESTER tell PDP11 that U200 is talking to regular CDC computer.
uother: mov pc,ucomp(r4)
	rts pc

; NCAR tells the PDP11 that U200 is talking to  NCAR (which is a nicer CDC)
uncar:	clr ucomp(r4)
	rts pc

; READ command - open User200 card reader input file.
ureadf:	tst ucrch(r4)		; card reader file open?
	if ne,<			; yes
	  push ucrch(r4)	; DETACH arg: channel id
	  clr ucrch(r4)		; zero channel id so don't try to use
	  call detach		; close previous card reader file first
	  >
	push filep(r4)		; FILARG arg: ptr to filename buffer
	call filarg		; read a filename argument
	push pc			; ATTACH arg1: device name
	add #dskn-.,(sp)	; ...
	push filep(r4)		; ATTACH arg2: filename
	push diskno(r4),#0	; ATTACH args 3 and 4: disk unit #,cbits
	call attach		; open card reader file
	pop ucrch(r4),r0	; vals: channel id, error code
	if ne,<
	  jmp comerr		; handle open error
	  >
	rts pc


; WRITE command - open User200 output file.
uwritf:	tst ulpch(r4)		; LPT file open?
	if ne,<			; yes
	  push ulpch(r4)	; DETACH arg: channel id
	  clr ulpch(r4)		; zero channel id so don't try to use
	  call detach		; close previous output file first
	  >
	call arg		; see if argument to write command
	pop *			; val: character
	if eq,<			; no argument
	  call ulatt		; get LPT
	  rts pc
	  >
	push filep(r4)		; FILARG arg: ptr to filename buffer
	call filarg		; read a filename argument
	push pc			; ATTACH arg1: device name
	add #dskn-.,(sp)	; ...
	push filep(r4)		; ATTACH arg2:  filename
	push diskno(r4),#%icrea+%iupd	; ATTACH args 3 and 4:disk unit #,cbits
	call attach		; open LPT output file
	pop ulpch(r4),r0	; vals: channel id, error code
	if ne,<
	  jmp comerr		; handle open error
	  >
	rts pc


; CLOSE_READ or CR command - close User200 card reader input file.
ucr:	tst ucrch(r4)		; card reader file open?
	if ne,<
	  push ucrch(r4)	; DETACH arg: channel id
	  clr ucrch(r4)		; zero channel id so don't try to use
	  call detach		; close card reader file
	  >
	rts pc


; CLOSE_WRITE or CW command - close User200 LPT output file.
ucw:	tst ulpch(r4)		; LPT output file open?
	if ne,<
	  push ulpch(r4)	; DETACH arg: channel id
	  clr ulpch(r4)		; zero channel id so don't try to use
	  call detach		; close LPT output file
	  >
	rts pc


; ENABLE command.
uenabl:	call arg		; skip spaces until next argument
	pop *			; val: character
	call sarg		; read string argument
				; SARG vals: length, ptr
	push pc			; SCASE arg: ptr to list of options
	add #uopts-.,(sp)	; ...
	call scase		; lookup argument in table
	pop r1,*		; vals: ptr, error code
	bne ued1
	mov r4,-(sp)		; get address of flag by adding offset
	add 2(r1),(sp)		; from UOPTS to UTBL ptr in R4
	mov #1,@(sp)+		; set flag
	rts pc


; DISABLE command.
udisab:	call arg		; skip spaces until next argument
	pop *			; val: character
	call sarg		; read string argument
				; SARG vals: length, ptr
	push pc			; SCASE arg: ptr to list of options
	add #uopts-.,(sp)	; ...
	call scase		; lookup argument in table
	pop r1,r0		; vals: ptr, error code
	bne ued1
	mov r4,-(sp)		; get address of flag by adding offset
	add 2(r1),(sp)		; from UOPTS to UTBL ptr in R4
	clr @(sp)+		; clear flag
	rts pc


ued1:	push uoch(r4)		; WRITEC arg: channel id
	call writec
	  .string ^"Unrecognized option.  Valid option names are:
"
	push pc			; LISTC arg: ptr to table
	add #uopts-.,(sp)	; ...
	call listc
	rts pc


.macro	defopt a,names
	.irp n,
	  .string ^"n",%.ctmp
	  .word %.ctmp,a
	  .endm
.endm defopt

uopts:	.word 4			; no. of bytes per entry
	defopt ueif,
	defopt ueof,
	defopt upbf,
	defopt udmf,
	defopt urdmf,
	defopt ucwt,
	defopt %upar,
	defopt %ucar,
	defopt %ufrm,
	defopt %uovr,
	defopt ueff,
	.word 0			; terminator


; FF command - form feed LPT.
uff:	tst ulpch(r4)		; LPT open?
	if ne,<
	  push ulpch(r4),#14	; WCHAR args: channel id, character
	  call wchar		; output form feed to LPT
	  >
	rts pc


; I command - interrupt CDC computer.
uint:	bis #%uint,usts(r4)
	rts pc


; DIAL command - dial the phone.
udial:	mov ucsra(r4),r1	; get address of DP/DU
	ifdp <
	  bit #10000,4(r1)	; dataset ready?
	  bne 1$		; yes, must hangup first
	  >
	ifdu <
	  bit #1000,(r1)	; dataset ready?
	  bne 1$		; yes, must hangup first
	  >
	ifdp <
	  bic #1,4(r1)		; turn off before on
	  bis #1,4(r1)		; turn on data terminal ready
	  >
	ifdu <
	  bic #2,(r1)		; turn off befor on
	  bis #2,(r1)		; turn on data terminal ready
	  >
	push uoch(r4)		; WRITEC arg: channel id
	call writec		; explain command not yet implemented
	  .string ^"Works for 2000 baud only.
"
        push #3			; ALWRIZ arg: line no.
	call alwriz		; call the 2000 baud phone number
	  .litrl <
	    .byte 2
	    .ascii "9;13034994334"   ; NCAR 2000 baud phone number
	    .byte 74,77,3,0
	    >
	rts pc

1$:	push uoch(r4)		; WRITEC arg: channel id
	call writec		; tell loser that he must hangup first
	  .string ^"Hangup first
"
	rts pc


; HANGUP command - hangup the phone.
uhang:	mov ucsra(r4),r1	; get address of DP11/DU11
	ifdp <
	  bic #1,4(r1)		; turn off data terminal ready to hangup
	  >
	ifdu <
	  bic #2,(r1)		; turn off data terminal ready to hangup
	  >
	rts pc


; ? command - list User200 commands.
ulistc:	push pc			; LISTC arg: ptr to command list
	add #uclist-.,(sp)	; ...
	call listc		; typeout list of commands
	rts pc

.sbttl	User200 exit

.if ne  asmtrl
utroll:	call uex2		; clean up from a U200
	pop *			; remove return PC from stack
	jmp trollr		; start a TROLLR
.endc

uexit:	mov ucsra(r4),r1	; get address of DP11/DU11
ifSAO <
	ifdp <			; SAO wants EXIT to do a Hangup
	  bic #1,4(r1)		; hangup this line
	  >
	ifdu <
	  bic #2,(r1)		; hangup this line
	  >
	beq uex0		; exit U200 now
      >
ifMIT <
	ifdp <
	  bit #10000,4(r1)	; dataset ready?
	  beq uex0		; no, ok to exit
	  >
	ifdu <
	  bit #1000,(r1)	; dataset ready?
	  beq uex0		; no, ok to exit
	  >
	push uoch(r4)		; WRITEC arg: channel id
	call writec		; tell loser to hangup
	  .string ^"Hangup first
"
	rts pc
      >

uex0:	push uoch(r4)		; ORDER arg: channel id
	push #3,#%tcnctn	; ORDER args: order code, order arg
	call order		; BIC into cbits: turn on line continuation
	pop *			; val: order val
	push uoch(r4)		; ORDER arg: channel id
	push #20000+thmax,utrmln(r4)	; ORDER args: order code, order arg
	call order		; set terminal line length back
	pop *			; val: meaningless
	pop *			; remove return PC from stack

; The startup code jumps here on startup errors.
uex1:   call uex2		; cleanup from a U200
	rts pc

uex2:	tst ucsra(r4)		; DP11/DU11 assigned?
	if ne,<
	  push r4		; SYNDEA arg: ptr to data structure
	  call syndea		; give back DP11/DU11
	  >
	tst uhpid(r4)		; handler process?
	if ne,<
	  push uhpid(r4)	; STOPP arg: process id
	  call stopp		; stop handler process
	  pop *			; val: error code
	  push uhpid(r4)	; KILLP arg: process id
	  call killp		; kill handler process
	  pop *			; val: error code
	  >
	tst ucrch(r4)		; card reader channel?
	if ne,<
	  push ucrch(r4)	; DETACH arg: channel id
	  call detach		; close input file
	  >
	tst ulpch(r4)		; LPT channel?
	if ne,<
	  push ulpch(r4)	; DETACH arg: channel id
	  call detach		; close output file
	  >
	tst uscrpq+qbp(r4)	; scripting queue?
	if ne,<
	  push uscrpq+qbp(r4)	; FREE arg: ptr to block
	  call free		; free scripting buffer
	  >
	tst umbp(r4)		; message buffer?
	if ne,<
	  push umbp(r4)		; FREE arg: ptr to block
	  call free		; deallocate the message buffer
	  >
	tst ulbp(r4)		; message buffer?
	if ne,<
	  push ulbp(r4)		; FREE arg: ptr to block
	  call free		; deallocate the message buffer
	  >
	call moron		; turn on more processing
	push #lcs/2		; ALOCL arg: size
	call alocl		; allocate command structure
	pop r1			; val: ptr
	mov #lcs/2,r0		; no. of words in command structure
loop <	  mov (r4)+,(r1)+	; copy User200's command stuff
	  sorl r0		; ...
	  >
	sub #lcs,r1		; get back ptrs to start of data blocks
	sub #lcs,r4		; ...
	push r4			; FREE arg: ptr
	call free		; free User200's data block
	mov r1,r4		; set command structure ptr
	mov r4,filep(r4)	; ptr to FILNAM
	add #filnam,filep(r4)	; ...
	return


.sbttl	User200 interrupt handlers

; User200 Clear to Send interrupt handler
ucts:	bit #%usndw,usts(r4)	; CTS should only be asserted during XMT
	beq 1$			; if not during XMT, ignore the interrupt
	jsr pc,@ussw(r4)	; call send co-routine
	pop ussw(r4)		; save co-routine PC
1$:	jmp dpuret

; User200 transmitter ready handler.
uxrdy:	jsr pc,@ussw(r4)	; call send co-routine
	pop ussw(r4)		; save co-routine PC
	xor r0,uxcs(r4)		; keep checksum of stuff sent
	ifdp <
	  .if ne 1
1$:	    tstb 4(r1)		; xmtr ready?
	    bpl 1$
	    movb partab(r0),6(r1)	; send character
	    br uxrdy
	  .endc
	  movb partab(r0),6(r1)	; send character
	  >
	ifdu <
	  movb r0,6(r1)		; send character (DU11 computes parity bit)
	  >
	jmp dpuret


; User200 character received handler.
urchar:	bic #177600,r0		; clear random bits
	xor r0,urcs(r4)		; keep checksum
	jsr pc,@ursw(r4)	; call receiver co-routine
	pop ursw(r4)		; save co-routine PC
	jmp dpuret


; User200 receiver error handlers.  Come here on parity error, receiver
; overrun, or on losing carrier.
unocar: tst %ucar(r4)
	if ne,<
	  bit #%urbsy,usts(r4)	; were we in midst of recieving?
	  beq urerr1		; its not an error if we weren't recieving
	  call usstrc
	    .string ^"Lost Carrier  "
	  br urerr
	  >
	br urerr1
urpare: call usstrc		; put message in script queue
	 .string ^"Parity Error "
	br urerr
urover:	call usstrc
	 .string ^"Overrun Error "	
	br urerr
urfrme:	call usstrc
	 .string ^"Framing Error "

urerr:  push urcc(r4)		; type # of chars recieved thus far
	call usonum
	bit #%urbsy,usts(r4)	; receiving a message?
	if ne,<
	  jsr r5,userr		; yes, send error reply
	  >
	jsr pc,urcv		; initiate reception again
	pop ursw(r4)		; ...
urerr1:	jmp dpuret

.sbttl	Transmitter co-routine

; User200 transmitter co-routine.  Setup initially by
;	JSR PC,UXMT
;	POP USSW(R4)


uxmt:	tst udmf(r4)		; debugging?
	if ne,<
	  push #'(		; put ( in the script buffer
	  call uschar		; print it
	  >
	bis #%usndw,usts(r4)	; waiting to send a message
	ifdp <
	  mov #2,(r1)		; stop receiver, i.e. set only half duplex
	  mov #343,4(r1)	; turn on done, interrupt enable, idle sync
	  >
.if ne 1
	ifdu <
	  mov #6,(r1)		; stop receiver, turn on data terminal ready,
				; and request to send
	  mov #30,4(r1)		; turn on half duplex, send,
  loop <    bit #20000,(r1)	; test for Clear to Send
	    exitl ne		; if we've got it, try to xmit chars..
	    bis #40,(r1)	; if not, enable "state change" interrupt
	    jsr pc,@(sp)+	; wait for Clear to Send
	    rptl
	    >
	  bic #40,(r1)		; shut off "state change" interrupt
	  bis #100,4(r1)	; enable transmitter interrupts
	  >
.iff
	ifdu <
	  mov #6,(r1)		; stop receiver, turn on data terminal ready,
				; and request to send
	  mov #130,4(r1)	; turn on half duplex, send, and enable
				; transmitter interrupts
  loop <    bit #20000,(r1)	; wait for clear to send
	    rptl eq		; ...
	    >
	  >
.endc
.rept 4
	jsr pc,@(sp)+		; wait for xmtr ready
	mov #26,r0		; send sync
	call uxscrp		; possibly script it
.endr
	jsr pc,@(sp)+
	mov #177,uxcs(r4)	; initialize checksum
	mov #usom,r0		; send start of message code
	call uxscrp		; possibly script it
	jsr pc,@(sp)+
	mov #usit,r0		; send site code
	call uxscrp		; possibly script it
	jsr pc,@(sp)+
	mov uosta(r4),r0	; send station address
	call uxscrp		; possibly script it
	jsr pc,@(sp)+
	mov uocode(r4),r0	; get control code (READ, ACK, REJ, or ERR)
	call uxscrp		; possibly script it
	cmp r0,#urea		; read message?
	if ne,<			; no, must be ACK, REJ, or ERR
	  tst udmf(r4)
	  if ne,<
	    cmp r0,#uack
	    if eq,<
	      call usstrc
	        .string ^"ACK  "
	      >
	    cmp r0,#urej
	    if eq,<
	      call usstrc
	        .string ^"REJ  "
	      >
	    cmp r0,#uerr
	    if eq,<
	      call usstrc
	        .string ^"ERR  "
	      >
	    >
	  jsr pc,@(sp)+		; send control code, wait for ready
	  >
	else <
	  tst udmf(r4)		; debugging messages?
	  if ne,<
	    call usstrc		; say we're sending READ message
	      .string ^"READ, STA = "
	    push uosta(r4)	; USONUM arg: number
	    call usonum		; put station address in script buffer
	    call usstrc		; put two spaces in script buffer
	      .string ^"  "
	    >
	  jsr pc,@(sp)+		; send control code, wait for ready
	  mov umbp(r4),uxmp(r4)	; init xmtr buffer ptr to start of message
	  mov urmc(r4),uxcc(r4)	; init xmtr char count to no. of characters
  loop <    dec uxcc(r4)	; decrement count
	    exitl mi
	    tst ueif(r4)	; input echoing enabled?
	    if ne,<
	      movb @uxmp(r4),r0	; get data character
	      add pc,r0		; for PICness
	      movb ucatab-.(r0),-(sp)	; USCHAR arg: character
	      call uschar	; put stuff we send out in script queue
	      >
	    movb @uxmp(r4),r0	; get data character
	    inc uxmp(r4)	; update buffer ptr
	    jsr pc,@(sp)+	; send data character
	    rptl
	    >
	  mov #uesc,r0		; send ESC
	  call uxscrp		; possibly script it
	  jsr pc,@(sp)+
	  mov uoecod(r4),r0	; send E1, E2 or E3
	  call uxscrp		; possibly script it
	  jsr pc,@(sp)+
	  >
	mov #ueom,r0		; send end of message code
	call uxscrp		; possibly script it
	jsr pc,@(sp)+
	mov uxcs(r4),r0		; send checksum
	call uxscrp		; possibly script it
	jsr pc,@(sp)+
	mov #26,r0		; send extra character just to be sure
	call uxscrp		; possibly script it
	jsr pc,@(sp)+
	ifdu <			; DU wants two extra??
	  mov #26,r0
	  call uxscrp		; possibly script it
	  jsr pc,@(sp)+
	  >
; Message transmission is complete.  Now get ready for reply.
	tst udmf(r4)
	if ne,<
	  push #')		; end of transmisson to script
	  call uschar		; print it
	  >
	pop *			; throw away co-routine PC
	jsr pc,urcv		; reinitialize the receiver co-routine
	pop ursw(r4)		; save co-routine PC
	jmp dpuret		; and return directly from interrupt

uxscrp:	tst udmf(r4)		; debugging?
	if ne,<
	  push r0
	  call usonum
	  push #40
	  call uschar
	  >
	return


.sbttl	Receiver co-routine

; User200 receiver co-routine.  Setup initally by
;	JSR PC,URCV
;	POP URSW(R4)
; Each co-routine call (JSR PC,@(SP)+) returns with the next character
; in R0.  URCV buffers the incoming message and handles poll messages.
; Write messages wake up the handler process.

urcv:	tst urdmf(r4)		; debugging?
	if ne,<
	  push #'[		; put ( in the script buffer
	  call uschar		; print it
	  >
	bic #%urbsy,usts(r4)	; no site code received yet
	mov #177,urcs(r4)	; initialize checksum
	ifdp <
	  movb #26,3(r1)	; set sync register
	  mov #103,(r1)		; DP11, resync by clearing receive active
				; half-duplex, strip sync, interrupt enable
	  mov #41,4(r1)		; turn on data terminal ready, status ints
	  >
	ifdu <
	  mov #035026,2(r1)	; set DU11 parameter register, sync = 26,
				; even parity, 7 bits per character
	  mov #2,(r1)		; clear search sync (terminate receive)
	  mov #562,(r1)		; and set search sync and strip sync
	  mov #10,4(r1)		; set half duplex
	  >
; Interface is now trying to synchronize by locating two sync codes.
	jsr pc,@(sp)+		; get first character after syncronizing
	call urscrp		; possibly script it
	cmp r0,#usom		; start of message?
	bne urcv		; no, ignore
	jsr pc,@(sp)+		; next char
	call urscrp		; possibly script it
	cmp r0,#usit		; correct site code?
	bne urcv		; no, ignore

; Message header ok, we've got a real message coming (we think).
	bit #%umsg,usts(r4)	; message still in buffer?
	if ne,<
	  tst urdmf(r4)
	  if ne,<
	    call usstrc
	      .string ^"Input buffer busy, "
	    >
	  jmp usrej1		; yes, reject this message
	  >
	bis #%urbsy,usts(r4)	; indicate we're receiving (got site code)
	jsr pc,@(sp)+		; get station address
	mov r0,usta(r4)		; save station address
	call urscrp		; possibly script it
	jsr pc,@(sp)+		; get message code
	mov r0,ucode(r4)	; save message code
	call urscrp		; possibly script it
	mov umbp(r4),urmp(r4)	; initialize receiver buffer ptr
	clr urcc(r4)		; initialize receiver char count
loop <	  jsr pc,@(sp)+		; get received character
	  call urscrp		; possibly script it
	  cmp r0,#ueom		; end of message?
	  exitl eq		; yes, go get checksum
	  cmp r0,#uesc		; escape?
	  if eq,<
	    call urscrp		; possibly script it
	    jsr pc,@(sp)+	; yes, check out next char
	    call urscrp		; possibly script it
	    cmp r0,#ue1		; E1?
	    beq 1$
	    cmp r0,#ue2		; E2?
	    beq 1$
	    cmp r0,#ue3		; E3?
	    bne 2$
1$:	    mov r0,uecode(r4)	; save for later
	    bic #%usrm,usts(r4)	; forget about sending any read message
	    rptl		; continue receiving
2$:	    bis #200,r0		; 200 bit for space or zero compression codes
	    >
; R0 contains a message data byte.  Store in buffer.
	  bic #%usrm,usts(r4)	; forget about sending any read message
	  inc urcc(r4)		; update receiver character count
	  cmp urcc(r4),#1039.	; message too long?
	  bhi userr4		; yes, send error message
	  movb r0,@urmp(r4)	; put in buffer
	  inc urmp(r4)		; and update receiver buffer ptr
	  rptl
	  >
	ifdp <
	  bic #1,(r1)		; turn off strip sync while reading checksum
	  >
	ifdu <
	  bic #400,(r1)		; turn off strip sync while reading checksum
	  >
	jsr pc,@(sp)+		; get message parity word (checksum)
	tstb urcs(r4)		; should make checksum zero
	if ne,<			; message parity error
	  call usstrc
	    .string ^"CHECKSUM ERROR  "
	  br userr4
	  >
	tst urdmf(r4)
	if ne,<
	  push #']		; end of transmisson to script
	  call uschar		; print it
	  >
; Message received ok.  Check station address and control code.
	mov usta(r4),r0		; get station address
	mov r0,uwsta(r4)	; save write station address
	cmp r0,#140		; 140 or 160?
	beq upollm		; if so must be poll message
	cmp r0,#160
	beq upollm
; Message isn't a poll, must be some sort of write message.
	cmp r0,#141		; 141 or 161?
	if ne,<
	  cmp r0,#161
	  bne userr4		; not a legal station address
	  >
	mov ucode(r4),r0	; get message type
	cmp r0,#21		; write?
	beq uwrite
	cmp r0,#14		; reset-write?
	beq uwrite
	cmp r0,#22		; clear-write?
	beq uwrite
	cmp r0,#7		; alert?
	bne userr4		; unknown control code
	jmp urcv		; yes, ignore alert.

urscrp:	tst urdmf(r4)		; debugging?
	if ne,<
	  push r0
	  call usonum
	  push #40
	  call uschar
	  >
	return


; Send error message, then go back to waiting for receiver.
; (This here for branch range).
userr4:	jsr r5,userr		; send error message
	br urcvj


; Message is a write, reset-write, or clear-write.
uwrite:	bis #%umsg,usts(r4)	; indicate buffer holds a message
	tst udmf(r4)
	if ne,<
	  call usstrc		; put message into script queue
	    .string ^"WRITE, STA = "
	  push usta(r4)		; USONUM arg: number
	  call usonum		; put station address in script buffer
	  call usstrc		; follow number with spaces
	    .string ^"  "
	  >
	else <
	  push #%tdnop		; USCHAR arg: character
	  call uschar		; put a nop in the buffer to wakeup handler
	  >
	jsr r5,usack		; send acknowledge
	inc unwrit(r4)		; count write messages
	br urcvj

; Message is a poll.
upollm:	cmp ucode(r4),#5	; make sure control code is "poll"
	bne userr4
	inc uwsta(r4)		; make 140 or 160 a 141 or 161 for read 
				; messages if any
	tst upbf(r4)		; poll beeping enabled?
	if ne,<			; yes
	  push #%tdbel		; USCHAR arg: character
	  call uschar		; beep when poll messages are received
	  >
	bit #%uint,usts(r4)	; interrupt?
	if ne,<			; yes
	  bic #%uint+%usrm,usts(r4)	; clear interrupt request and pending
					; read message (if any)
	  br 1$
	  >
	bit #%usrm,usts(r4)	; waiting to send READ message?
	if ne,<			; yep, poll message is request to (re)send
	  jsr r5,usrea		; send a read message
	  br urcvj
	  >
	bit #%usui,usts(r4)	; Is there user input?
	if ne,<
	  mov umbp(r4),r3	; ptr to message buffer
	  mov r4,r2		; get UCBUF ptr (user typein)
	  add #ucbuf,r2		; ...
	  mov ucbfln(r4),r0	; no. of characters to copy
	  if ne,<
    loop <    movb (r2)+,(r3)+	; copy UCBUF into message buffer
	      sorl r0		; ...
	      >
	    >
	  bic #%usui,usts(r4)	; clear the user command flag
	  mov #ue1,uoecod(r4)	; make it a Read-E1
	  mov r3,urmc(r4)	; calculate length of message
	  sub umbp(r4),urmc(r4)	; ...
	  bis #%usrm,usts(r4)	; indicate read message waiting to be sent
	  jsr r5,usrea		; send the Read message
	  br urcvj
	  >
; No read message pending, reject the poll.
1$:   dec uwsta(r4)		; reject response to poll has station address
				; of 140 or 160, not 141 or 161
      jsr r5,usrej		; send reject to indicate nothing to read
      br urcvj


; Send reject message, then go back to waiting for receiver.
usrej1:	jsr r5,usrej		; send reject message
urcvj:
; don't really go back, instead wait for transmit process to restart us
;	jmp urcv
	pop *			; remove co-routine PC from stack
	jmp dpuret

.sbttl	Transmitter subroutines

; Send error message.
userr:	mov #uerr,r0		; error message code
	br ureply

; Send reject message.
usrej:	mov #urej,r0		; reject message code
	br ureply

; Send acknowledge message.
usack:	mov #uack,r0		; ack message code
	br ureply

; Send read message.
usrea:	mov #urea,r0		; read message code

ureply:	bic #%urbsy,usts(r4)	; clear busy bit to show we're not recieving
	mov r0,uocode(r4)	; set control code to send
	mov uwsta(r4),uosta(r4)	; set station address to that of last write
	jsr pc,uxmt		; setup transmitter co-routine
	pop ussw(r4)		; save co-routine PC
	rts r5

.sbttl	User200 scripting

; The following are called at interrupt level to put things in the script
; buffer.


; USCHAR adds a character to the script buffer.

;	ARGS:				VALS:
; SP ->	character			(none)

uschar:	push 2(sp)		; INSQ arg1: character
	push r4			; INSQ arg2: queue ptr
	add #uscrpq,(sp)	; ...
	call insq		; put character into queue
	pop *			; val: error code
	pop (sp)		; remove argument from stack
	return


; USSTRC adds a string constant (specified by a relative ptr after the call)
; to the script buffer.

;	ARGS:				VALS:
; relative ptr after call		(none)

usstrc:	push r0,r1		; save regs
	mov r5,r1		; pick up relative ptr after call and make
	add (r5)+,r1		; absolute
loop <	  movb (r1)+,r0		; get character from string
	  exitl eq		; zero byte terminates string
	  push r0		; INSQ arg1: character
	  push r4		; INSQ arg2: queue ptr
	  add #uscrpq,(sp)	; ...
	  call insq		; put character into queue
	  pop *			; val: error code
	  rptl
	  >
	pop r1,r0		; restore regs
	return


; USONUM outputs a number, in octal, to the script buffer.

;	ARGS:				VALS:
; SP ->	number				(none)

usonum:	push r0			; save reg
	mov 4(sp),r0		; get argument
	jsr r5,1$
	pop r0,(sp)		; restore reg, remove argument from stack
	return

; recursive octal conversion routine.  no. in R0.
1$:	push r0
	bic #177770,(sp)
	add #'0,(sp)
	ror r0
	asr r0
	asr r0
	if ne,<
	  jsr r5,1$
	  >
	call uschar
	rts r5

.sbttl	User200 handler process

; The handler process is woken to empty the script buffer and to handle
; received write messages.

uhr4:	.blkw 1			; R4 for handler process passed here

uhandl:	push #0,#80.		; SETSS args: process id, size
	call setss		; get us a large stack
	pop *			; val: error code
	if ne,<
	  lose 0
	  >
	mov uhr4,r4		; get ptr to User200 data structure
	if eq,<
	  crash ^"UHR4 not set"
	  >
	clr uhr4		; clear for safety
	jsr pc,uout		; initialize output co-routine
.if ne  0	; This code commented out because it doesn't work right
	tst ulpch(r4)		; anything open on LPT channel?
	if ne,<
	  mov #15,r0		; send CR so first character of first line
	  mov pc,ulof(r4)	; set flag so CR makes it to LPT
	  jsr pc,@(sp)+		; will be handled as carriage control
	  >
.endc
	pop uosw(r4)		; save co-routine PC

uhloop:	push r4			; REMW arg1: queue ptr
	add #uscrpq,(sp)	; ...
	push #-1		; REMW arg2: timeout
	call remw		; wait for something in queue
	pop *			; val: error code
	bne uhloop
loop <	  push r4		; REMQ arg: queue ptr
	  add #uscrpq,(sp)	; ...
	  call remq		; get character from queue
	  pop r0,*		; vals: character, error code
	  exitl ne
	  push uoch(r4),r0	; WCHAR args: channel id, character
	  call wchar		; output script character to user's terminal
	  rptl
	  >
uhwtst:	tst unwrit(r4)		; any write messages?
	beq uhloop
	dec unwrit(r4)		; acknowledge wakeup
	cmp ucode(r4),#21	; write?
	beq 1$			; yes
	cmp ucode(r4),#14	; reset write?
	if eq,<			; yes
	  push uoch(r4),#%tdhom	; WCHAR args: channel id, character
	  call wchar		; home
	  br 1$
	  >
	cmp ucode(r4),#22	; clear write?
	if eq,<			; yes
	  tst ucwt(r4)		; check clear write flag
	  beq 1$		; if clear'd, then don't do it
	  push uoch(r4),#%tdclr	; WCHAR args: channel id, character
	  call wchar		; clear 
	  br 1$
	  >
	push ucode(r4)		; IOA arg: message type code
	push uoch(r4)		; IOA arg: channel id
	call ioac		; tell user about it
	  .string ^"Unknown message type (^o) received!
"
	br uhandl
1$:	cmp uecode(r4),#ue3	; Write-E3 (read more cards)?
	if eq,<
	  jmp ucards		; read cards
	  >

; Write message was either LPT data (Write-E2) or DO data (Write-E1)

	mov umbp(r4),r3		; flip buffers so can receive another message
	mov ulbp(r4),umbp(r4)	; while sending this one to the LPT
	mov r3,ulbp(r4)		; ...
	mov r3,r5		; get ptr to just past last data byte
	add urcc(r4),r5		; by adding message length
; R3 and R5 setup, don't clobber in code below!
	bic #%umsg,usts(r4)	; having switched buffers the receiver buffer
				; no longer contains a message
	cmp uecode(r4),#ue1	; Write-E1 (send to display)?
	if eq,<			; yes, generate automatic read message
; Write-E1 (display data).
	  clr ulof(r4)		; clear LPT output flag
	  mov #1,udof(r4)	; set display output flag
	  >
	else <
; Write-E2 (LPT data).  Next will be poll asking status of LPT.
	  mov #1,ulof(r4)	; set LPT output flag
	  mov ueof(r4),udof(r4)	; set display output flag from echo output
				; option
	  tst ulpch(r4)		; write file open?
	  beq 5$		; no, treat as not ready
	  push ulpch(r4)	; ORDER arg: channel id
	  push #1,#0		; ORDER args: order code, order arg
	  call order		; issue status request to see if LPT ready
	  pop r0		; val: code
	  if ne,<
5$:	    mov #ue2,uoecod(r4)	; E2 to indicate printer hung
	    clr urmc(r4)	; message is 2 characters long
	    bis #%usrm,usts(r4)	; indicate we're trying to send read message
	    br uhwtst		; wait for another write message
	    >
	  mov #ue3,uoecod(r4)	; E3 to indicate printer ready
	  clr urmc(r4)		; message is 2 characters long
	  bis #%usrm,usts(r4)	; indicate we're trying to send read message
	  >

; Now expand compression codes and output.

; R3 and R5 setup above.
2$:	cmp r3,r5		; reached end of data yet?
	if eq,<
	  jmp uhwtst		; yes, go handle next write message
	  >
	movb (r3)+,r0		; find next escape code
	if pl,<			; (the rcvr interrupt level set the 200 bit)
	  add pc,r0		; for PIC addressing
	  movb ucatab-.(r0),r0	; translate to ascii
	  jsr pc,@uosw(r4)	; call output co-routine
	  pop uosw(r4)		; save co-routine PC
	  br 2$
	  >
	bic #177600,r0		; clear high bits
	cmp r0,#101		; Carriage Return?
	beq 3$
	cmp r0,#120		; End of Line?
	bne 4$
3$:	mov #15,r0		; output CR
	jsr pc,@uosw(r4)	; call output co-routine
	pop uosw(r4)		; save co-routine PC
	br 2$
4$:	mov r0,r1
	bit #40,r1		; space or zero compression?
	if ne,<
	  mov #40,r0		; space compression
	  >
	else <
	  mov #'0,r0		; zero compression
	  >
	bic #177740,r1		; clear everything but compression count
	push uosw(r4)		; get co-routine PC
loop <	  jsr pc,@(sp)+		; call output co-routine
	  sorl r1
	  >
	pop uosw(r4)		; save co-routine PC
	br 2$


uout:	jsr pc,@(sp)+		; co-call
	tst udof(r4)		; output to display?
	if ne,<
	  push uoch(r4),r0	; WCHAR args: channel id, character
	  call wchar		; output character to display
	  >
	tst ulof(r4)		; output to LPT?
	if ne,<
	  push ulpch(r4),r0	; WCHAR args: channel id, character
	  call wchar		; output character to LPT
	  >
	cmp r0,#15		; CR?
	bne uout
	tst udof(r4)		; display output?
	if ne,<
	  push uoch(r4),#12	; WCHAR args: channel id, character
	  call wchar		; output LF after CR to display
	  >
	tst ulof(r4)
	beq uout
	jsr pc,@(sp)+		; get character after CR
	cmp r0,#'+		; +?
	beq uout		; yes, overprint by not sending LF
	cmp r0,#'2		; 2?
	if eq,<
	  push ulpch(r4),#14	; WCHAR args: channel id, character
	  call wchar		; output FF
	  br uout
	  >
	cmp r0,#'0		; 0?
	beq 1$			; yes, double space
	cmp r0,#'1		; 1?
	bne 2$			; yes, should FF, double space to save paper
	tst ueff(r4)		; Form feeds allowed in output??
	if ne,<
	  push ulpch(r4),#14	; WCHAR args: channel id, char
	  call wchar		; output a form feed
	  br uout
	  >
1$:	push ulpch(r4),#12	; WCHAR args: channel id, char
	call wchar		; output LF
	push ulpch(r4),#15	; WCHAR args: channel id, char
	call wchar		; output CR
2$:	push ulpch(r4),#12	; WCHAR args: channel id, char
	call wchar		; output LF
	br uout


; Come here to handle Write-E3 messages.  Read card data into message
; buffer and prepare to send on next poll message.  If error (e.g. EOF)
; then send data with Read-E2, else send data with Read-E3.

ucards:	mov umbp(r4),r3		; ptr to message buffer
	mov #-1,r0		; presume end of file in case no CR file
	tst ucrch(r4)		; card reader file open?
	beq 2$			; no, send Read-E2 with no data
	mov #12.,r1		; no. of lines to read
1$:	mov #80.,r2		; no. of characters to put in each line
loop <	  push ucrch(r4)	; RCHAR arg: channel id
	  call rchar		; read character from User200 card reader
	  pop r0		; val: character
	  if mi,<		; end of file
	    call upad		; pad out last line with spaces
	    exitl
	    >
	  cmp r0,#12		; LF?
	  if eq,<
	    call upad		; yes, pad out this line with spaces
	    sob r1,1$		; go back to do next line
	    exitl
	    >
	  cmp r0,#40		; control character?
	  rptl lo		; yes, ignore
	  add pc,r0			; translate from ASCII to CDC code
	  movb uactab-40-.(r0),r0	; ...
	  rptl eq		; ignore if character translates to zero
	  dec r2		; ignore if more than than 80 characters
	  rptl mi		; in line
	  movb r0,(r3)+		; put character into message buffer
	  rptl
	  >
2$:	tst r0			; end of file?
	if pl,<
	  mov #ue3,uoecod(r4)	; no error, Read-E3
	  >
	else <
	  mov #ue2,uoecod(r4)	; error, Read-E2
	  tst ucrch(r4)		; read file open?
	  if ne,<
	    push ucrch(r4)	; DETACH arg: channel id
	    clr ucrch(r4)	; indicate its closed
	    call detach		; close read file
	    >
	  >
	mov r3,urmc(r4)		; calculate length of message
	sub umbp(r4),urmc(r4)	; ...
	bis #%usrm,usts(r4)	; card data will be sent on next poll
	bic #%umsg,usts(r4)	; unlock buffer
	jmp uhwtst


; UPAD pads out the current line with spaces.

;	ARGS:				VALS:
; R2:	no. of chars to pad		(none)
; R3:	buffer ptr

upad:	dec r2
	bmi 1$
	movb uactab,(r3)+
	br upad
1$:	return

.sbttl Translation tables

; Conversion table from ASCII to CDC

;	CHAR		MAPS TO 

;	@		0-8-6
;	[		8-7
;	]		0-8-2
;	%		8-6
;	#		8-4
;	"		0-8-5
;	'		11-0
;	\		0-8-7
;	^		11-8-5
;	!		11-8-6
;	<		12-0
;	>		11-8-7
;	_		8-5
;	?		12-8-5
;	;		12-8-7
;	&W		6-7-8-9
;	&X		7-8-9

uactab:	.byte 120,056,135,114,053,116,076,052	;  !"#$%&' (MAP & = 'ESC')
	.byte 134,074,054,060,133,040,073,121	; ()*+,-./
	.byte 112,101,102,103,104,105,106,107	; 01234567
	.byte 110,111,100,077,072,113,057,075	; 89:;<=>?
	.byte 136,061,062,063,064,065,066,067	; @ABCDEFG
	.byte 070,071,041,042,043,044,045,046	; HIJKLMNO
	.byte 047,050,051,122,123,124,125,126	; PQRSTUVW
	.byte 127,130,131,117,137,132,055,115	; XYZ[\]^_
	.byte 000,061,062,063,064,065,066,067	; `abcdefg
	.byte 070,071,041,042,043,044,045,046	; hijklmno
	.byte 047,050,051,122,123,124,125,126	; pqrstuvw
	.byte 127,130,131,000,000,000,000,000	; xyz{|}~


; Conversion table from CDC to ASCII.
; Things that shouldn't happen come out as !.

ucatab:	.byte 041,041,041,041,041,041,041,041
	.byte 041,041,041,041,041,041,041,041
	.byte 041,041,041,041,041,041,041,041
	.byte 041,041,041,041,041,041,041,041

	.byte 055,112,113,114,115,116,117,120
	.byte 121,122,047,044,052,136,041,076
	.byte 053,101,102,103,104,105,106,107
	.byte 110,111,074,056,051,077,046,073

	.byte 072,061,062,063,064,065,066,067
	.byte 070,071,060,075,043,137,045,133
	.byte 040,057,123,124,125,126,127,130
	.byte 131,132,135,054,050,042,100,134

	.even

; 126 070 065 126 !!!


.if ne  ndp
; Parity table.  Index by byte to get byte with odd parity.
partab:	.byte 200,001,002,203,004,205,206,007
	.byte 010,211,212,013,214,015,016,217
	.byte 020,221,222,023,224,025,026,227
	.byte 230,031,032,233,034,235,236,037

	.byte 040,241,242,043,244,045,046,247
	.byte 250,051,052,253,054,255,256,057
	.byte 260,061,062,263,064,265,266,067
	.byte 070,271,272,073,274,075,076,277

	.byte 100,301,302,103,304,105,106,307
	.byte 310,111,112,313,114,315,316,117
	.byte 320,121,122,323,124,325,326,127
	.byte 130,331,332,133,334,135,136,337

	.byte 340,141,142,343,144,345,346,147
	.byte 150,351,352,153,354,155,156,357
	.byte 160,361,362,163,364,165,166,367
	.byte 370,171,172,373,174,375,376,177
.endc	; ne ndp

urfiln:	.rad50 "RH"
	.rad50 "U200"
	.rad50 "OUT"
ð}; -*-PALX-*-
.sbttl	Disk i/o

.iif ndf  asmpr,  asmpr==0	; assume we can't print if we don't know how

.if eq  sysdsk-drk
lblk==512.			; no. of bytes per sector
nsecto==12.			; no. of sectors per track
ntrack==406.			; no. of tracks per disk
.endc
.if eq  sysdsk-drl
lblk==256.			; no. of bytes per sector
nsecto==40.			; no. of sectors per track
ntrack==256.			; no. of tracks per disk
.endc
.if ne  nrx
lblk==128.			; no. of bytes per sector
nsecto==26.			; no. of sectors per track
ntrack==77.			; no. of tracks per disk
.endc


; DOPENR sets up for reading from disk.
dopenr:	mov 2(sp),dblock	; set block no. to first block to read
	clr dbufc		; no characters in buffer yet
	pop (sp)		; remove arg from stack
	rts r5


; DOPENW sets up for writing to disk.
dopenw:	mov 2(sp),dblock	; set block no. to first block to write
	mov #lblk,dbufc		; room for 512 (or 256) characters in block
	mov pc,-(sp)		; set DBUFP to DBUF
	add #dbuf-.,(sp)	; ...
	mov (sp)+,dbufp		; ...
	pop (sp)		; remove arg from stack
	rts r5


; DCLSW finishes up writing to the disk.
dclsw:	cmp dbufc,#lblk		; something in buffer?
	if ne,<
  loop <    clrb @dbufp		; clear remainder of buffer
	    inc dbufp
	    dec dbufc
	    rptl ne
	    >
	  push dblock		; DKWRIT arg: block no.
	  jsr r5,dkwrit		; write out block
	  >
	rts r5


; DGETW reads a word from the disk.
dgetw:	push (sp)		; make room for return val
	jsr r5,dgetb		; read low byte
	movb (sp)+,2(sp)
	jsr r5,dgetb		; read high byte
	movb (sp)+,3(sp)
	rts r5

; DGETB reads a byte from the disk.
dgetb:	push (sp)		; make room for return val
	dec dbufc		; characters left to read in this block?
	if mi,<			; none left, read next block
	  push dblock		; DKREAD args: block no.
	  jsr r5,dkread		; read block
	  inc dblock		; increment block no.
	  mov #lblk-1,dbufc	; 511 (or 255) bytes left to read
          mov pc,-(sp)		; set DBUFP to DBUF
	  add #dbuf-.,(sp)	; ...
	  mov (sp)+,dbufp	; ...
	  >
	clr 2(sp)		; so high byte will be zero
	movb @dbufp,2(sp)	; get character
	inc dbufp		; move ptr to next
	rts r5

; DPUTW writes a word to the disk.
dputw:	push 2(sp)		; DPUTB arg: byte
	jsr r5,dputb		; write low byte
	swab 2(sp)		; switch bytes and fall through
				; to write high byte

; DPUTB writes one byte to the disk.
dputb:	movb 2(sp),@dbufp	; store character in buffer
	inc dbufp		; move ptr to next character slot
	dec dbufc		; buffer filled?
	if eq,<			; yes, write it out
	  push dblock		; DKWRIT args: block no.
	  jsr r5,dkwrit		; write out this block
	  inc dblock		; increment block no.
	  mov #lblk,dbufc	; room for 512 (or 256) more characters
	  sub #lblk,dbufp	; set DBUFP to DBUF
	  >
	pop (sp)		; remove arg from stack
	rts r5

.if eq  sysdsk-drk
dkread:	push (sp)
	mov #5,2(sp)
	br rkrw

dkwrit:	push (sp)
	mov #3,2(sp)
	br rkrw
.endc
.if eq	sysdsk-drl
dkread:	push (sp)
	mov #14,2(sp)
	br rlrw

dkwrit:	push (sp)
	mov #12,2(sp)
	br rlrw
.endc
.if ne  nrx
dkread:	br rxread

dkwrit:	br rxwrit
.endc



.sbttl  RL11 read/write
; RLRW
;
;	ARGS:	                        VALS:
;  SP ->op code				(none)
;	block number

.if eq sysdsk-drl
rlrw:  jsr r5,save6		; save registers
       mov 20(sp),r1		; get block number
       clr r0			; clear track counter
       mov #40.,r2		; there are 40. blocks per track
       div r2,r0		; get number of tracks in r0
       ash #6,r0		; mov into place for Cylinder address
       bis r1,r0		; merge sector (in r1) with track
       mov r0,20(sp)		; save converted disk address
       mov pc,r1		; pointer to DBUF
       add #dbuf-.,r1		; ...
       mov #7,r4		; number of times to try recoverable errors
;
; reset the drive
;

loop <   mov #rlcsr,r5		; get address of CSR
	 mov #13,4(r5)		; do a get status/reset drive
	 mov #4,(r5)		; perform function
  loop <   tstb (r5)		; has drive finished yet??
           rptl pl		; no yet
	   >
         tst (r5)		; check for errors
	 bmi rlerr		; go handle them
	 jsr pc,rlseek		; seek to the right track

; Now we can finally do the read/write operation!!!!!!!!!

	 mov #-,6(r5)	; set word count
	 mov r1,2(r5)		; set bus address
	 mov 20(sp),4(r5)	; set disk address
	 mov 16(sp),(r5)	; perform function
  loop <   tstb (r5)		; is the controller finished???
	   rptl pl		; not yet if plus
	   >
	 tst (r5)		; test for errors
	 exitl pl		; no error, we're through
	 bit #140000,(r5)	; see if a disk error
	 bne rlerr		; check out disk errors
	 sorl r4		; try a few more times
	 br rlerr
	 >
       jsr r5,rest6		; restore registers
       pop (sp),(sp)		; remove args from stack
       rts r5

; perform a seek on the disk to the right track

rlseek: push r0,r1,r2		; save registers
	mov #10,(r5)		; execute read headers function
loop <    tstb (r5)		; has drive finished yet????
	  rptl pl		; not yet
	  >
	mov 6(r5),r0		; get current disk address
	mov 20+10(sp),r1	; get desired disk address
	bic #77,r1		; clear sector bits
	bic #177,r0		; clear sector and surface bits
	mov r1,r2		; copy desired disk address
	bic #177677,r2		; isolate surface bit
	ash #-2,r2		; position it for difference word in seek
	bic #100,r1		; remove surface bit
	sub r1,r0		; find difference word for seek operation
	bcc 1$			; if CC actual >= desired position
	neg r0			; make positive difference
	bis #4,r0		; set bit to indicate move towards disk center
1$:     inc r0			; set marker bit
	bis r2,r0		; merge in surface bit
	mov r0,4(r5)		; put difference word into RLDAR
	mov #6,(r5)		; perform a seek function
loop <    tstb (r5)		; has controller finished
          rptl pl		; not yet
	  >
	pop r2,r1,r0		; restore registers
	rts pc

; perform error checking on the disk drive

rlerr: 
.if ne asmpr
       print ^"
RL01 disk error -- operation aborted
"
.endc
       jmp dskerr

.endc  ;eq sysdsk-drl



; RKRW performs disk transfers of one sector.  It takes two args:
; the block no. and operation code (3 for write, 5 for read).

;	ARGS:				VALS:
; SP ->	op code				(none)
;	block no.

.if eq sysdsk-drk
rkrw:	jsr r5,save6		; save regs
	clr r0			; divide block no. by 12
	mov 20(sp),r1		; ...
	div #12.,r0		; ...
	ash #4,r0		; multiply quotient by 16
	add r1,r0		; add remainder to get DAR
	bis rknum,r0		; put in disk no.
	mov pc,r1		; ptr to DBUF
	add #dbuf-.,r1		; ...
	mov #7,r5		; no. of times to retry recoverable errors
loop <	  mov #rkcsr,r4		; ptr to RKCSR
	  mov #1,(r4)		; controller reset
  loop <    tstb (r4)		; wait for done
	    rptl pl
	    >
	  mov #rkdar+2,r4	; ptr to RKDAR + 2
	  mov r0,-(r4)		; set RKDAR
	  mov r1,-(r4)		; set RKBAR
	  mov #-,-(r4)	; set RKWCR
	  mov 16(sp),-(r4)	; set RKCSR, i.e. perform operation
  loop <    tstb (r4)		; wait for done
	    rptl pl
	    >
	  tst (r4)		; errors?
	  exitl pl
	  bit #166340,-(r4)	; recoverable error?
	  if eq,<
	    sorl r5		; yes, try a few times
	    >
.if ne asmpr
	  print ^"
Disk Error -- operation aborted
"
.endc
	  jmp dskerr
	  >
	jsr r5,rest6		; restore regs
	pop (sp),(sp)		; remove args from stack
	rts r5

rknum:	.word 0			; Using disk number zero because
				; disk no. 1 (fixed) is not formatted
.endc

.sbttl	RX11 read/write

.if ne  nrx
; RXREAD

;	ARGS:				VALS:
; SP ->	block no.			(none)

rxread:	push r0,r1,r2		; save regs
	mov #rxcs,r0		; get bus address of RX11 controller
	push 10(sp),#7		; RXRW args: block no., op code
	bis rxnum,(sp)		; yes, set unit select in op code
	jsr r5,rxrw		; initiate read
loop <	  bit #40,(r0)		; wait for Done
	  rptl eq
	  >
	tst (r0)		; Error?
	bmi rxer
	mov #10,r2		; no. of times to retry parity errors in Empty
loop <	  mov #3,(r0)		; send Empty command
	  mov pc,r1		; ptr to buffer
	  add #dbuf-.,r1	; ...
  loop <    bitb #240,(r0)	; test Transfer Request and Done bits
	    rptl eq		; wait for one to set
	    exitl pl		; Done?
	    movb 2(r0),(r1)+	; no, Transfer Request, copy data byte
	    rptl
	    >
	  tst (r0)		; Error (parity error in transfer from buffer)?
	  exitl pl
	  sorl r2		; retry Empty operation
	  br rxer
	  >
	pop r2,r1,r0,(sp)	; restore regs, remove arg from stack
	rts r5


; RXWRIT writes a block on the floppy.

;	ARGS:				VALS:
; SP ->	block no.			(none)

rxwrit:	push r0,r1,r2		; save regs
	mov #rxcs,r0		; get bus address of RX11 controller
	mov #10,r2		; no. of times to retry parity errors in Fill
loop <	  mov #1,(r0)		; send Fill command
	  mov pc,r1		; get ptr to buffer
	  add #dbuf-.,r1	; ...
  loop <    bitb #240,(r0)	; test Transfer Request and Done bits
	    rptl eq
	    exitl pl		; Done?
	    movb (r1)+,2(r0)	; no, Transfer Request, load data byte
	    rptl
	    >
	  tst (r0)		; Error (parity error in transfer to buffer)?
	  exitl pl
	  sorl r3		; retry Fill
	  br rxer
	  >
	push 10(sp),#5		; RXRW args: block no., op code
	bis rxnum,(sp)		; yes, set unit select in op code
	jsr r5,rxrw		; initiate write
loop <	  bit #40,(r0)		; wait for Done
	  rptl eq
	  >
	tst (r0)		; Error?
	bmi rxer
	pop r2,r1,r0,(sp)	; restore regs, remove arg from stack
	rts r5



; RXRW issues a read or write command to the RX11.  If writing, the RX11
; buffer should already be filled with the stuff to be written.  If reading
; the RX11 buffer should be emptied afterward.  RXRW does not wait for the
; read or write operation to complete.

;	ARGS:				VALS:
; SP ->	op code				(none)
;	block no.

rxrw:	push r2,r3		; save regs
	clr r2			; divide block no. by 26 to get track
	mov 10(sp),r3		; and sector addresses
	div #nsecto,r2		; perform the division
	asl r3
	cmp r3,#nsecto
	if his,<
	  sub #nsecto-1,r3
	  >
	inc r3			; make sector address one based
loop <	  bit #40,(r0)		; wait for Done
	  rptl eq
	  >
	mov 6(sp),(r0)		; send read or write command
loop <	  tstb (r0)		; wait for Transfer Request
	  rptl pl
	  >
	mov r3,2(r0)		; send Sector address
loop <	  tstb (r0)		; wait for Transfer Request
	  rptl pl
	  >
	mov r2,2(r0)		; send Track address
	pop r3,r2,(sp),(sp)	; restore regs, remove args from stack
	rts r5

rxer:	mov @#rxdb,r0
	bit #1,r0
	if ne,<
.if ne asmpr
	  print ^"
CRC error detected reading diskette."
.endc
	  >
	bit #2,r0
	if ne,<
.if ne asmpr
	  print ^"
Parity error detected on command or address data being transfered to RX01."
.endc
	  >
.if ne  asmpr
	jmp dskerr
.iff
	pop r2,r1,r0,(sp)
	rts r5
.endc

rxnum:	.word 0			; disk no.

.endc  ; ne nrx

dbuf:	.blkb lblk	; disk sector buffer
dblock:	.word 0		; block no. for next disk i/o
dbufp:	.word 0		; ptr to next byte in disk buffer to read/write
dbufc:	.word 0		; read: no. of characters remaining in buffer
			; write: room left in buffer

ð»; Synchronous line module			-*-PALX-*-


.if ne  ndp

; DPINIT is called at system startup time to initialize the DP11s on the
; system.
dpinit:
.rept ndp
	jsr r5,vecset		; setup DP11 interrupt vector
	  .word dpv+<.rpcnt*10>,pr5+.rpcnt,dprint-.,dpxint-.
.endr
; fall through to DPPWRU

; DPPWRU is called when power is restored to reinitialize the DP11s.
dppwru:	mov pc,r1		; ptr to DPCSR
	add #dpcsr-.,r1		; ...
	mov pc,r2		; ptr to DPDTP
	add #dpdtp-.,r2		; ...
.rept ndp
	clr (r1)+
	clr (r2)+
.endr
        sub #ndp*2,r1		; get back pointer to DPCSR
	call catchn		; setup NXM catch for testing DPs
	  1$-.
.rept ndp
	clr @#174770-<.rpcnt*10>	; clear RCSR
	clr @#174770-<.rpcnt*10>+4	; clear XCSR
	mov #174770-<.rpcnt*10>,<.rpcnt*2>(r1)	; save address
.endr
1$:	return

dpcsr:	.blkw ndp
dpdtp:	.blkw ndp
.endc	; ne ndp


.if ne  ndu

; DUINIT is called at system startup time to initialize the DU11s on the
; system.
duinit:
.rept ndu
	jsr r5,vecset		; setup DU11 interrupt vector
	  .word duv+<.rpcnt*10>,pr5+.rpcnt,durint-.,duxint-.
.endr
; fall through to DUPWRU

; DUPWRU is called when power is restored to reinitialize the DU11s.
dupwru:	mov pc,r1		; ptr to DUCSR
	add #ducsr-.,r1		; ...
	mov pc,r2		; ptr to DUDTP
	add #dudtp-.,r2		; ...
.rept ndu
	clr (r1)+
	clr (r2)+
.endr
        sub #ndu*2,r1		; get back pointer to DUCSR
	call catchn		; setup NXM catch for testing DUs
	  1$-.
.rept ndu
	mov #400,@#duaddr+<.rpcnt*10>+4			; do master reset
	mov #duaddr+<.rpcnt*10>,<.rpcnt*2>(r1)		; save address
.endr
1$:	return

ducsr:	.blkw ndu
dudtp:	.blkw ndu
.endc	; ne ndu

; SYNASN is called to assign a DU or a DP to someone.
; It uses the data table ptr it is called with to lock the table.

;	ARGS:				VALS:
; SP -> data table pointer	 SP ->	0 for DP, or -1 for DU
;					CSR address for DP or DU
;					error code

synasn:	push (sp),(sp)		; create slots for two more return values
	clr 4(sp)		; make sure return zero CSR address if fail
	peof			; no preemption while testing table entry

; Always assign the DP first if it exists 

.if ne  ndp
	tst dpdtp+0		; DP11 in use?
	if eq,<
	  mov 6(sp),dpdtp+0	; put structure ptr in table
	  peon			; allow preemption again
	  mov dpcsr+0,4(sp)	; return CSR address of DP11
	  clr 2(sp)		; zero for DP11
	  clr 6(sp)		; return zero error code for success
	  return
	  >
.endc
.if ne  ndu
	tst dudtp+0		; DU11 in use?
	if eq,<
	  mov 6(sp),dudtp+0	; put structure ptr in table
	  peon			; allow preemption again
	  mov ducsr+0,4(sp)	; return CSR address of DU11
	  mov #-1,2(sp)		; nonzero for DU11
	  clr 6(sp)		; return zero error code for success
	  return
	  >
.endc
	peon			; allow preemption again
	mov #%enadv,6(sp)	; give device not available error
	return


; SYNDEA is called to deassign a DU or a DP.

;	ARGS:				VALS:
; SP -> data table pointer		(none)

syndea:	push r1			; save reg
.if ne  ndp
	cmp dpdtp+0,4(sp)	; this the one?
	if eq,<
	  clr dpdtp+0		; clear entry, making device free
	  mov dpcsr+0,r1	; get address of DP11 we're freeing
	  clr (r1)		; clear everything
	  clr 4(r1)		; ...
	  br 1$
	  >
.endc
.if ne  ndu
	cmp dudtp+0,4(sp)	; this the one?
	if eq,<
	  clr dudtp+0		; clear entry making device free
	  mov ducsr+0,r1	; get address of DU11 we're freeing
	  mov #400,4(r1)	; do a Master Reset
	  br 1$
	  >
.endc
1$:	pop r1,(sp)		; restore reg, remove argument from stack
	return

.sbttl	DP11 and DU11 interrupt handlers

; This module attempts to make the DP11 and DU11 appear as similar as
; possible.  Receiver and transmitter interrupts are handled and translated
; into five more relevant groups: character received, reception error,
; transmitter ready, loss of carrier, and clear to send.  The DP11 gives
; no clear to send interrupt, but then it is not necessary to wait for
; clear to send on a DP11 so thats ok (just start sending!).


.if ne  ndu
; DU11 receiver and status interrupts.
durint:	mfps -(sp)		; save PS for unit no.
	jsr r5,save6		; save regs
	mov 14(sp),r1		; get PS with unit no. in low four bits
	bic #177760,r1		; clear all but low bits
	asl r1			; times two for word addressing
	add pc,r1		; for PICness
1$:	mov dudtp-1$(r1),r4	; ptr to User200 data structure
	mov ducsr-1$(r1),r1	; address of DU11
	mov (r1),r0		; get RCSR
	if mi,<			; status interrupt, determine which one
	  bit #20000,r0		; clear to send?
	  if ne,<
	    jmp ucts		; yes, call clear to send entry
	    >
;	  bit #10000,r0		; carrier?  This commented out because
;      	  if eq,<		;           the code is not necessary with
;	      jmp unocar        ; call lost carrier entry
;	    >			            the DU11.......-RLL
	  br dpuret		; ignore all else
	  >
	mov 2(r1),r0		; get received character
	if mi,<
	  tst (r1)+		; point to err reg;no side effects on read??
	  bit #10000,(r1)	; check for parity error
	  if ne,<
	    tst %upar(r4)
	    if ne,<
	      jmp urpare	; parity error detected
	      >
	    >
	  bit #20000,(r1)	; framing error
	  if ne,<
	    tst %ufrm(r4)	; ignoring framing errors?
	    if ne,<
	      jmp urfrme
	      >
	    >
	  bit #40000,(r1)	; overrun error
	  if ne,<
	    tst %uovr(r4)	; ignoring overrun errors?
	    if ne,<
	      jmp urover	; call receiver error entry
	      >
	    >
	  >
	jmp urchar		; call receiver char entry


; DU11 transmitter interrupt.
duxint:	mfps -(sp)		; save PS for unit no.
	jsr r5,save6		; save regs
	mov 14(sp),r1		; get PS with unit no. in low four bits
	bic #177760,r1		; clear all but low bits
	asl r1			; times two for word addressing
	add pc,r1		; for PICness
1$:	mov dudtp-1$(r1),r4	; ptr to User200 data structure
	mov ducsr-1$(r1),r1	; address of DU11
	jmp uxrdy		; call transmitter ready entry

.endc	; ne ndu


.if ne  ndp
; DP11 receiver interrupt.
dprint:	mfps -(sp)		; save PS for unit no.
	jsr r5,save6		; save regs
	mov 14(sp),r1		; get PS with unit no. in low four bits
	bic #177760,r1		; clear all but low bits
	asl r1			; times two for word addressing
	add pc,r1		; for PICness
1$:	mov dpdtp-1$(r1),r4	; ptr to User200 data structure
	mov dpcsr-1$(r1),r1	; address of DP11
	movb 2(r1),r0		; get received character
	bit #10000,(r1)		; test parity
	if eq,<
	  tst %upar(r4)
	  if ne,<
	    jmp urpare		; even parity, call receiver error entry
	    >	
	  >
	jmp urchar		; call receiver char entry


; DP11 transmitter and status interrupts.
dpxint:	mfps -(sp)		; save PS for unit no.
	jsr r5,save6		; save regs
	mov 14(sp),r1		; get PS with unit no. in low four bits
	bic #177760,r1		; clear all but low bits
	asl r1			; times two for word addressing
	add pc,r1		; for PICness
1$:	mov dpdtp-1$(r1),r4	; ptr to User200 data structure
	mov dpcsr-1$(r1),r1	; address of DU11
	mov 4(r1),r0		; get XCSR
	if mi,<
	  jmp unocar		; call lost carrier entry
	  >
	bit #40000,r0		; receiver overrun?
	if ne,<
	  tst %uovr(r4)
	  if ne,<
	    jmp urover		; call receiver error entry
	    >
	  >
	cmpb r0,#140		; see if both interrupt enable and done on
	blo dpuret
	jmp uxrdy		; yes, we want to send and it's ready
.endc

dpuret:	jsr r5,rest6		; restore regs
	tst (sp)+		; remove PS pushed for unit no.
	rti
îi;					-*-PALX-*-
;SPINPRINT command.  Command is used to send files to the spinwriter.  ^L is
;used to seperate the text into different pages.  The user is queried before
;each page is printed.

ifSAO <
        splnno==2		; spinwriter is terminal 4 at SAO's
      >
ifMIT <
        splnno==<10.-1>		; spinwriter is terminal 10 - 1
				; (because of plotter) at MIT
      >

sptype: mov #splnno,r2		; get spinwriter terminal number
	asl r2			; mdouble for lookup in table
        add pc,r2		; get pointer into tty channel id table
	add #ttych-.,r2		; ....
	mov (r2),r2		; get channel id for TTY
	push r2,#2		; ORDER args: channel id, order code
	push #%tcio		; ORDER arg: (cbit to turn on)
	call order		; turn image mode on for the spinwriter
	pop *			; val: meaningless
loop   <  call quit		; see if user wants to quit
	  pop *			; val: non-zero if break typed
	  exitl ne		; ....
	  push uich(r4)		; RCHAR arg: input channel
	  call rchar		; get next character from user
	  pop r0		; val: character
	  exitl mi		; -1 returned for eof
	  cmp #26,r0		; ^Z typed by user?
	  exitl eq		; yes, we're through
	  push uoch(r4),r0	; WCHAR args: channel id, character
	  call wchar		; send character to spinwriter
	  push r2,r0		; WCHAR args: channel id, character
	  call wchar		; send character to console
	  rptl			; go back for more
	  >
	rts pc

spinpr: push filep(r4)		; FILARG arg: ptr to filename buffer
	call filarg		; parse a filename
	push pc			; ATTACH arg: device id
	add #dskn-.,(sp)	; ....
	push filep(r4)		; ATTACH arg: filename
	push diskno(r4),#0	; ATTACH args: unit #, cbits
	call attach		; open the file
	pop r3,r0  		; vals: channel id, error code
	if ne,<
	  jmp comerr		; handle error opening file
	  >
	mov #1,r5		; r5 contains the page number in the file
	clr r1			; R1 conains control bits for output
ifMIT <
	push #splnno+1,uoch(r4)	; IOAC args: spinwriter number,channel id
      >
ifSAO <
	push #splnno,uoch(r4)	; IOAC args: spinwriter number,channel id
      >
	call ioac		; tell user where you think the spinwriter is
	  .string ^"Assuming the spinwriter is on line number ^d.
"
        mov #splnno,r2		; get spinwriter terminal number
	asl r2			; mdouble for lookup in table
        add pc,r2		; get pointer into tty channel id table
	add #ttych-.,r2		; ....
	mov (r2),r2		; get channel id for TTY
	push r2,#2		; ORDER args: channel id, order code
	push #%tcio		; ORDER arg: (cbit to turn on)
	call order		; turn image mode on for the spinwriter
	pop *			; val: meaningless
	br 2$			; start at page one, right away
loop  <  call quit		; see if user wants to quit
	 pop *			; VAL: non-zero if we are to quit
	 bne 3$			; quit this command and cleanup
	 push r3		; RCHAR arg: channel id
	 call rchar		; get character
	 pop r0			; ....
	 bmi 3$			; if minus then EOF
	 cmp r0,#14		; check for start of page
	 rptl ne		; not yet
2$:	 push r5,uoch(r4)	; IOAC args: page number, channel id
	 call ioac		; print message
	   .string ^"Print page #^d ?"
	 push uoch(r4)		; RCHAR arg: channel id
	 call rchar		; read a character
	 pop r0			; got it
	 push uoch(r4),r0	; WCHAR args: channel id, character
	 call wchar		; echo the character
	 jsr pc,crlf		; print a CR
	 bic #40,r0		; make capitol letter
	 cmp r0,#'Y		; print this page?
	 exitl eq		; yes, do it
	 inc r5			; next page
	 rptl
	 >
       push uoch(r4)		; IOAC arg: channel id
       call ioac		; send message about Character set
         .string ^"Alternate Character Set? "
       push uoch(r4)		; RCHAR arg: channel id
       call rchar		; get response
       pop r0			; go it
       push uoch(r4),r0		; echo it
       call wchar
       jsr pc,crlf		; and type a CRLF
       bic #40,r0		; make capitol letter
       cmp #'Y,r0		; yes ???
       if eq,<
         bis #%rfont,r1		; set mode (font 1 wanted)
	 >
       else <
         bic #%rfont,r1		; clear mode (font 0 wanted)
	 >
loop  <  call quit		; see if user wants to quit
	 pop *			; val: non-zero if we are to quit
	 bne 3$			; user wants to punt
	 push r3		; RCHAR arg: channel id
	 call rchar		; get next character
	 pop r0			; got it.
	 bmi 3$			; if minus then EOF
	 cmpb r0,#14		; is this a break in the page?
	 exitl eq		; yes!!!
	 cmpb #12,r0		; a LF??
	 if eq,<
	   bit #%dspce,r1	; check for quadruple spacing
	   if ne,<
	     push r2,r0		; send an extra LF
	     call wchar		; ...
	     push r2,r0		; send an extra LF
	     call wchar		; ...
	     >
	   bit #%space,r1	; check for double spacing
	   if ne,<
	     push r2,r0		; send an extra LF
	     call wchar		; ...
	     >
	   br 5$		; send the LF
	   >

; send all other control-characters as is!!!!!!

	 cmpb r0,#40		; this character a space or control-character??
	 ble 5$			; yes, just send it
	 cmpb r0,#'\		; backslash escape character??
	 if eq,<
	   jsr r5,spbksl	; handle the next character as special
	   rptl
	   >
	 jsr r5,printp		; print this character???
	 pop *			; val: non-zero means print else send a space
	 if ne,<
	   jsr r5,sendch	; send this character
	   rptl
	   >
	 movb #40,r0		; make character a space
5$:	 push r2,r0		; WCHAR args: channel id, character
	 call wchar		; send character to spinwriter
	 rptl			; do next character
	 >
10$:   inc r5			; increment the page number
       br 2$			; start the next page

; cleanup our act

3$:    push r2,#3		; ORDER args: channel id, order code
       push #%tcio		; ORDER arg: (cbit to turn off)
       call order		; turn image mode off for the spinwriter
       pop *			; val: meaningless
       push r3			; DETACH arg: channel id
       call detach		; relesase the file
       rts pc
	
; PRINTP tests to see if we are printing in the requested font
; non-zero value returned on the stack means we are printing
; in the requested font.  

printp:  push (sp)		; make room for return value
	 clr 2(sp)		; assume not printing (fonts not same)
	 bit #%rfont,r1		; test requested font bit
	 if ne,<		; set if font 1 wanted
	   bit #%pfont,r1	; test the printing bit
	   if ne,<		; if font 1 also then send this character
	     inc 2(sp)		; tell user to print
	     >
	   >
	 else <
	   bit #%pfont,r1	; see if printing font 0
	   if eq,<
	     inc 2(sp)		; tell user to print
	     >
	   >
	 rts r5

; SENDCH sends a character and hacks boldfacing and underlining

sendch:	push r2,r0		; WCHAR args: channel id, character
	call wchar		; print character
	cmpb #40,r0		; just send a space
	if eq,<
	  bit #%udral,r1	; should we underline the space
	  beq 1$		; no
	  >
	bit #%under,r1		; underline anything??
	if ne,<			; yes
	  push r2		; IOAC arg: channel id
	  call ioac		; backspace and underline
	    .string ^"]A]P
_ _9= "
	  >
	bit #%bold,r1		; boldfacing wanted??
	if ne,<			; yes
	  push r2		; IOAC arg: channel id
	  call ioac		; backspace and change spacing
	    .string ^"]A "
	  push r2,r0		; WCHAR args: channel id, character
	  call wchar		; send character again
	  push r2		; IOAC arg: channel id
	  call ioac		; backspace, change spacing and space
	    .string ^"= "
	  >
1$:	rts r5


; SPBKSL gets the next character after a backslash and uses it
; to determine the next thing to do.
; R0 is the received character
; R1 is the output control bits
; R2 is the output channel id
; R3 is the input channel id

%bold==1			; when set print boldface
%under==2			; when set print underlines
%space==4			; when set do double spacing
%pfont==10			; when set we are printing in font 1
%rfont==20			; when set font 1 was requested to be printed
%udral==40			; when set underline spaces and all
%dspce==100			; when set quadruplespacing is on

spbksl: push r3			; read in the next character
	call rchar		; ...
	pop r0			; got it
	bicb #40,r0		; make it a uppercase or control character

; the following commands send specific commands or character
; to the spinwriter.

	cmpb #'\,r0		; Escape an escape char??
	if eq,<
	  jsr r5,sendch		; send this /
	  rts r5
	  >
	cmpb #'@,r0		; @?? (send a ^L to the spinwriter)
	if eq,<
	  push r2,#14		; WCHAR args: channel id, character
	  call wchar		; send a FF
	  rts r5
	  >
	cmpb #'U,r0		; U?? (move up one line)
	if eq,<
	  push r2		; IOAC arg: channel id
	  call ioac		; send commands to spinwriter
	    .string ^"9"
	  rts r5
	  >
	cmpb #'D,r0		; D?? (move down one line)
	if eq,<
	  push r2,#12		; WCHAR args: channel id, character
	  call wchar		; send a LF
	  rts r5
	  >
	cmpb #'0-40,r0		; 0?? (move up one-twelfth of an inch)
	if eq,<
	  push r2		; IOAC arg: channel id
	  call ioac		; send commands to spinwriter
	    .string ^"]Q9="
	  rts r5
	  >
	cmpb #'1-40,r0		; 1?? (move down one-twelfth of an inch)
	if eq,<
	  push r2		; IOAC arg: channel id
	  call ioac		; send commands to spinwriter
	    .litrl <
	      .ascii "]S"
	      .byte 12
	      .ascii "9="
	      >
	  rts r5
	  >
	cmpb #'N,r0		; N?? (shift in)
	if eq,<
	  push r2,#17		; WCHAR args: channel id, character
	  call wchar		; send a SI (shift in)
	  rts r5
	  >
	cmpb #'O,r0		; O?? (shift out)
	if eq,<
	  push r2,#16		; WCHAR args: channel id, character
	  call wchar		; send a SO (shift out)
	  rts r5
	  >
	cmpb #'H,r0		; H?? (backspace)
	if eq,<
	  push r2,#10		; WCHAR args: channel id, character
	  call wchar		; send a LF
	  rts r5
	  >

; Set and reset commands for spinwriter

	cmpb #'L,r0		; L?? (set Left Margin)
	if eq,<
	  push r2		; IOAC arg: channel id
	  call ioac		; send commands to spinwriter
	    .string ^"M"
	  rts r5
	  >
	cmpb #'M,r0		; M?? (reset Left Margin)
	if eq,<
	  push r2		; IOAC arg: channel id
	  call ioac		; send commands to spinwriter
	    .string ^"O"
	  rts r5
	  >
	cmpb #'J,r0		; J?? (set Right Margin)
	if eq,<
	  push r2		; IOAC arg: channel id
	  call ioac		; send commands to spinwriter
	    .string ^"J"
	  rts r5
	  >
	cmpb #'K,r0		; K?? (reset Right Margin)
	if eq,<
	  push r2		; IOAC arg: channel id
	  call ioac		; send commands to spinwriter
	    .string ^"K"
	  rts r5
	  >
	cmpb #'S,r0		; S?? (Reset Horizontal Tab)
	if eq,<
	  push r2		; IOAC arg: channel id
	  call ioac		; send commands to spinwriter
	    .string ^"2"
	  rts r5
	  >
	cmpb #'T,r0		; T?? (Set Horizontal Tab)
	if eq,<
	  push r2		; IOAC arg: channel id
	  call ioac		; send commands to spinwriter
	    .string ^"1"
	  rts r5
	  >

	cmpb #'V,r0		; V?? (read and restore panel switches)
	if eq,<
	  push r2		; IOAC arg: channel id
	  call ioac		; send commands to spinwriter
	    .string ^"="
	  rts r5
	  >

; the following commands change the forms advance control

	cmpb #'C,r0		; C?? (change advance to 1/48 LPI)
	if eq,<
	  push r2		; IOAC arg: channel id
	  call ioac		; send commands to spinwriter
	    .string ^"]P"
	  rts r5
	  >
	cmpb #'E,r0		; E?? (change advance to 2/48 LPI)
	if eq,<
	  push r2		; IOAC arg: channel id
	  call ioac		; send commands to spinwriter
	    .string ^"]Q"
	  rts r5
	  >
	cmpb #'F,r0		; F?? (change advance to 4/48 LPI)
	if eq,<
	  push r2		; IOAC arg: channel id
	  call ioac		; send commands to spinwriter
	    .string ^"]S"
	  rts r5
	  >
	cmpb #'G,r0		; G?? (change advance to 6/48 LPI)
	if eq,<
	  push r2		; IOAC arg: channel id
	  call ioac		; send commands to spinwriter
	    .string ^"]U"
	  rts r5
	  >
	cmpb #'I,r0		; I?? (change advance to 8/48 LPI)
	if eq,<
	  push r2		; IOAC arg: channel id
	  call ioac		; send commands to spinwriter
	    .string ^"]W"
	  rts r5
	  >
	cmpb #'+-40,r0		; +?? (change advance to 12/48 LPI)
	if eq,<
	  push r2		; IOAC arg: channel id
	  call ioac		; send commands to spinwriter
	    .string ^"]["
	  rts r5
	  >
	cmpb #'--40,r0		; -?? (change advance to 16/48 LPI)
	if eq,<
	  push r2		; IOAC arg: channel id
	  call ioac		; send commands to spinwriter
	    .string ^"]_"
	  rts r5
	  >

; the following are requests to the spinwriting program and set
; specific bits in R1.

	cmpb #'A,r0		; A?? (alternate character font)
	if eq,<
	  bis #%pfont,r1	; tell program font changed to alternate
	  rts r5
	  >
	cmpb #'5-40,r0		; 5?? (select normal font)
	if eq,<
	  bic #%pfont,r1	; tell program font is now the normal font
	  rts r5
	  >
	cmpb #'B,r0		; B?? (Boldfacing requested)
	if eq,<
	  bis #%bold,r1		; tell program to boldface
	  rts r5
	  >
	cmpb #'6-40,r0		; 6?? (Turn off boldfacing)
	if eq,<
	  bic #%bold,r1		; tell program no more boldfacing
	  rts r5
	  >
	cmpb #'_,r0		; _?? (Underlining requested)
	if eq,<
	  bis #%under,r1	; turn on underlining
	  rts r5
	  >
	cmpb #'4-40,r0		; 4?? (turn off underlining mode)
	if eq,<
	  bic #%under,r1	; tell program no more underlining
	  rts r5
	  >
	cmpb #'R,r0		; R?? (Normal mode output)
	if eq,<
	  bic #%pfont+%under+%bold+%udral,r1
				; turn off boldfacing and underlining
	  rts r5		; and reset to font0 being printed
	  >
	cmpb #'P,r0		; P?? (single spacing on)
	if eq,<
	  bic #%space+%dspce,r1	; turn on single spacing
	  rts r5
	  >
	cmpb #'Q,r0		; Q?? (double spacing on)
	if eq,<
	  bis #%space,r1	; turn on double spacing
	  bic #%dspce,r1	; turn off quadruple spacing
	  rts r5
	  >
	cmpb #'9-40,r0		; 9?? (double spacing on)
	if eq,<
	  bis #%space+%dspce,r1	; turn on quadruple spacing
	  rts r5
	  >
	cmpb #'2-40,r0		; ?? (turn on underline all)
	if eq,<
	  bis #%udral+%under,r1	; turn on underline all
	  rts r5
	  >
	cmpb #'3-40,r0		; ?? (turn off underline all)
	if eq,<
	  bic #%udral,r1	; turn off underline all
	  rts r5
	  >

; following two are No-ops

	cmpb #15,r0		; CR???
	if eq,<
	  push r3		; RCHAR arg: channel id
	  call rchar		; punt the next character (probably a LF)
	  pop *			; val: char, punt it
	  rts r5		; do nothing
	  >
	cmpb #12,r0		; LF??
	if eq,<
	  push r3		; RCHAR arg: channel id
	  call rchar		; punt the next character (probably a CR)
	  pop *			; val: char, punt it
	  rts r5
	  >

; special characters  (large [, ], |, and /.)
; integral sign,summation sign, and DEL operator.

	jsr r5,printp		; find out whether we are printing stuff
        cmpb #'W,r0		; W?? (DEL operator requested)
	if eq,<
	  pop *			; PRINTP val: non-zero implies print
	  if ne,<
	    push r2		; IOAC arg: channel id
	    call ioac		; print string of chars forming DEL
	      .litrl <
	        .ascii "]@J]U9]C "
		.byte 17,137,12,57,10,10,10
		.asciz "= "
	        >
             >
	  else <
	     jmp sendsp		; send a space
	     >
	 rts r5
	 >
	cmpb #'X,r0		; X?? (Large | requested)
	if eq,<
	  pop *			; PRINTP val: non-zero implies print
	  if ne,<
	    push r2		; IOAC arg: channel id
	    call ioac		; print string of chars forming large |
	      .litrl <
	        .ascii "]S]@9|"
		.byte 12,12
		.asciz "|9|= "
		>
	      >
	    else <
	      jmp sendsp	; send a space
	      >
          rts r5
	  >
	cmpb #'Y,r0		; Y?? (Summation Sign requested)
	if eq,<
	  pop *			; PRINTP val: non-zero implies print
	  if ne,<
	    push r2		; IOAC arg: channel id
	    call ioac		; print string of chars forming a Summation Sign
	      .litrl <
	        .ascii "]@]S9~"
		.byte 12,12
		.asciz "=]S[9="
		>
	      >
	    else <
	      jmp sendsp	; send a space
	      >
          rts r5
	  >
	cmpb #'Z,r0		; Z?? (large / requested)
        if eq,<
	  pop *			; PRINTP val: non-zero implies print
	  if ne,<
	    push r2		; IOAC arg: channel id
	    call ioac		; print string of chars forming a large /
	      .litrl <
	        .ascii "]D]T"
		.byte 12
		.ascii "/9/9/"
		.byte 12
		.asciz "    ="
		>
	      >
	    else <
	      jmp sendsp	; send a space
	      >
          rts r5
	  >
	cmpb #'[,r0		; [?? (large [ requested)
	if eq,<
	  pop *			; PRINTP val: non-zero implies print
	  if ne,<
	    push r2		; IOAC arg: channel id
	    call ioac		; print string of chars forming a large [
	      .litrl <
	        .ascii "]@]S9`"
		.byte 12,12
		.ascii "=]S"
		.byte 76
		.asciz "9="
		>
	      >
	    else <
	      jmp sendsp	; send a space
	      >
          rts r5
	  >
	cmpb #'],r0		; ]?? (large ] requested)
	if eq,<
	  pop *			; PRINTP val: non-zero implies print
	  if ne,<
	    push r2		; IOAC arg: channel id
	    call ioac		; print string of chars forming a large ]
	      .litrl <
	        .ascii "]@]S9"
		.byte 17,136,136,12,12,16
		.ascii "=]S@"
		.byte 17
		.asciz "9="
		>
	      >
	    else <
	      jmp sendsp	; send a space
	      >
          rts r5
	  >
	cmpb #'^,r0		; ^?? (Integral sign requested)
	if eq,<
	  pop *			; PRINTP val: non-zero implies print
	  if ne,<
	    push r2		; IOAC arg: channel id
	    call ioac		; print string of chars forming a integral sign
	      .litrl <
	        .ascii "]@]S9H"
		.byte 12,12
		.asciz "=]S@9="	  
		>
	      >
	    else <
	      jmp sendsp	; send a space
	      >
          rts r5
	  >
	pop *			; remove val from call to printp

; character gotten after the \ was invalid, report error

	push uoch(r4)		; IOAC arg: channel id
	call ioac		; report error to the user
	  .string ^"Bad escape character - "
	push uoch(r4),r0	; WCHAR args: channel id, character
	call wchar		; tell user what the offending char is
	jsr pc,crlf		; send a CRLF
	rts r5

; SENDSP sends a space to the channel id in R2

sendsp: push r2,#40		; WCHAR args: channel id, character
	call wchar		; send a space
	rts r5
f; STUFF - Very basic useful stuff   -*-PALX-*-
stvn==%fnam2


.sbttl	Register save/restore routines

; SAVE6 routine saves R0 through R5 on stack, R0 at top:
; SP ->	R0
;	R1
;	R2
;	R3
;	R4
;	R5
; Call by JSR R5,SAVE6.  Restore regs by REST6 routine.

save6:	push r4,r3,r2,r1,r0	; R5 already on stack by JSR.
	jmp (r5)		; return.


; REST6 routine restores R0 through R5 from stack, where
; R0 is considered to be the top word of the stack (which is
; how SAVE6 pushes the registers).  Call by JSR R5,REST6.
; REST6 returns with the 6 words popped off the stack.

rest6:	tst (sp)+		; forget old R5 contents.
	pop r0,r1,r2,r3,r4	; restore other regs.
	rts r5			; return and restore R5.

.sbttl	Multiply & Divide

.if eq  eis
; MUL1 multiplies two integers, producing a single precision product.  Both the
; multiplicand and multiplier are treated as signed numbers.  This routine is
; meant to be compatible with the single precision multiply instruction found
; on reasonable PDP11s.

;	ARGS:				VALS:
; SP ->	A			 SP ->	P
;	B

mul1:	push r1,r2		; save regs
	mov 6(sp),r1		; multiplicand
	mov 10(sp),r2		; multiplier
	clr 10(sp)		; clear product accumulator
loop <	  ror r2		; divide multiplier by 2, testing lowest bit
	  exitl eq		; nothing left
	  if cs,<
	    add r1,10(sp)	; if bit is 1 then add multiplicand to product
	    >
	  asl r1		; double multiplicand
	  clc			; so ROR is logical shift
	  rptl 			; and repeat.
	  >
	if cs,<
	  add r1,10(sp)		; one last add necessary if low bit was 1
	  >
	pop r2,r1,(sp)		; restore regs, remove arg2 from stack
	rts r5


; MUL2 is multiplies two integers producing a double precision product.  Both
; the multiplicand and multiplier are treated as signed numbers.  This routine
; is meant to be compatible with the double precision multiply instruction
; found on reasonable PDP11s.

;	ARGS: 				VALS:
; SP ->	multiplicand		 SP ->	P hi
;	multiplier			P lo

mul2:	push r0,r1,r2		; save regs
	clr r0			; multiplicand
	mov 10(sp),r1		; ...
	if mi,<
	  com r0		; if low part negative set high part to -1
	  >
	mov 12(sp),r2		; multiplier
	if mi,<
	  neg r2		; negate multiplier and multiplicand
	  neg r0		; double word negate
	  neg r1		; ...
	  sbc r0		; ...
	  >
	clr 10(sp)		; clear product accumulator
	clr 12(sp)		; ...
loop <	  asr r2		; divide multiplier by 2, testing lowest bit
	  exitl eq		; nothing left
	  if cs,<
	    add r1,12(sp)	; if bit is 1 then add multiplicand to product
	    adc 10(sp)		; ...
	    add r0,10(sp)	; ...
	    >
	  asl r1		; double multiplicand
	  rol r0		; ...
	  rptl
	  >
	if cs,<
	  add r1,12(sp)		; one last add necessary if low bit was 1
	  adc 10(sp)		; ...
	  add r0,10(sp)
	  >
	pop r2,r1,r0		; restore regs
	rts r5


; DIV2 divides a double word quantity by a single word quantity yielding a
; quotient and remainder.  It is meant to simulate the DIV instruction found
; on reasonable 11s.

;	ARGS:			VALS:
; SP ->	divisor		 SP ->	remainder
;	dividend lo		quotient
;	dividend hi

div2:	jsr r5,save6		; save regs
	mov 22(sp),r0		; dividend hi
	mov 20(sp),r1		; dividend lo
	mov 16(sp),r2		; divisor
	if mi,<
	  neg r2		; negate divisor and dividend
	  neg r0		; double word negate
	  neg r1		; ...
	  sbc r0		; ...
	  >
	clr r3
	mov #16.,r4
loop <	  asl r3
	  rol r1
	  rol r0
	  cmp r2,r0
	  if le,<
	    sub r2,r0
	    inc r3
	    >
	  sorl r4
	  >
	mov r3,22(sp)
	mov r0,20(sp)
	jsr r5,rest6
	pop (sp)
	rts r5

.endc	; eq eis

; DMUL performs double precision multiplication.  Both multiplicand and
; multiplier are treated as unsigned integers.  This routine is necessary
; because the PDP11 multiply instruction is too crufty for some things.

;	ARGS:				VALS:
; R0,R1: multiplicand		 R0,R1:	product
; R2:	 multiplier

dmul:	push r3,r4		; save regs
	mov r0,r3		; copy multiplicand
	mov r1,r4		; ...
	clr r0			; clear product accumulator
	clr r1			; ...
loop <	  clc			; clear carry so ROR is logical shift
	  ror r2		; divide multiplier by 2, testing lowest bit
	  exitl eq		; nothing left
	  if cs,<
	    add r4,r1		; if bit is 1 then add multiplicand to product
	    adc r0		; ...
	    add r3,r0		; ...
	    >
	  asl r4		; double multiplicand
	  rol r3		; ...
	  rptl
	  >
	if cs,<
	  add r4,r1		; one last add necessary if low bit was 1
	  adc r0		; ...
	  add r3,r0		; ...
	  >
	pop r4,r3		; restore regs
	rts r5


; DDIV performs double precision division.  It is best suited to dividing
; double precision no.s by some constant.  Both dividend and divisor are
; treated as unsigned integers.  This routine is necessary because the PDP11
; divide instruction is too crufty for just about anything.

;	ARGS:				VALS:
; R0,R1: dividend		 R0,R1:	quotient
; R2,R3: divisor normalized	 R2:	remainder
; R4,R5: 1 shifted same

; Note: DDIV is called by JSR PC,DDIV.

ddiv:	clr -(sp)		; start quotient at 0
	clr -(sp)		; ...
loop <	  cmp r2,r0
	  blo 1$
	  if eq,<
	    cmp r3,r1
	    if los,<
1$:	      sub r3,r1		; subtract from dividend
	      sbc r0
	      sub r2,r0
	      bis r4,2(sp)
	      bis r5,(sp)
	      >
	    >
	  clc
	  ror r2
	  ror r3
	  asr r4
	  ror r5
	  rptl ne
	  tst r4
	  rptl ne
	  >
	mov r1,r2		; put remainder in r2
	pop r1,r0		; put quotient in r0,r1
	rts pc


; DIV10 divides r0,r1 by 10, remainder in r2.  Clobbers r3, r4, and r5.
; Call with JSR PC,DDIV10.
ddiv10:	mov #120000,r2		; 10 normalized
	clr r3			; ...
	mov #10000,r4		; 1 shifted same amount as 10
	clr r5			; ...
	jmp ddiv		; jump to common double precision divide


; DIV24 divides r0,r1 by 24, remainder in r2.  Clobbers r3, r4, and r5.
; Call with JSR PC,DDIV24.
ddiv24:	mov #140000,r2		; 24 normalized
	clr r3			; ...
	mov #4000,r4		; 1 shifted same amount as 24
	clr r5			; ...
	jmp ddiv		; call common double precision divide


; DIV60 divides r0,r1 by 60, remainder in r2.  Clobbers r3, r4, and r5.
; Call with JSR PC,DDIV60.
ddiv60:	mov #170000,r2		; 60 normalized
	clr r3			; ...
	mov #2000,r4		; 1 shifted same amount as 60
	clr r5			; ...
	jmp ddiv		; call common double precision divide

.sbttl	random things

bits:	.byte	1,2,4,10,20,40,100,200


.if ne  ndz
ifMIT <
      ; DZ11 line parameters
      ;	10000=Reciever clock on
      ;	 7400=speed, 4 bits:    low order bits
      ;			       00   01   10   11
      ;			   ----------------------
      ;		high	00|    50   75  110  134.5
      ;		order	01|   150  300  600 1200
      ;		bits	10|  1800 2000 2400 3600
      ;			11|  4800 7200 9600 19.2K
      ;	  200=odd parity
      ;	  100=parity enabled
      ;	   40=stop code (on is 2 stop bits)
      ;	   30=character length, excluding parity, 00=5,01=6,10=7,11=8
      ;	    7=line number
dzlpar:	17120	; line  0: 9600 baud, even parity, 7 bits      (SB)
	17121	; line  1: 9600 baud, even parity, 7 bits      (VT52 #1)
	17122	; line  2: 9600 baud, even parity, 7 bits      (VT52 #2)
	17123	; line  5: 9600 baud, even parity, 7 bits      (VT52 #3)
	13524	; line  3: 1200 baud, even parity, 7 bits      (HP2645)
	13525	; line  4: 1200 baud, even parity, 7 bits      (Vadic 1200)
	15036	; line  6: 2400 baud, no parity, 8 bits	       (HP3000)
	17037	; line  7: 9600 baud, no parity, 8 bits        (MC)

      >
.endc				; if DZð	; -*-PALX-*-

.sbttl	Tektronix support
; Tektronix 4662 support.  This code could easily be modified to support
; Tektronix 4010 series graphics terminals.  TEKBEG, TEKEND, and TEKO
; would need to be changed; also TEKDRW would need to know not to send
; a XLOY byte to the 4010, 4011, or 4012.


; TEKROT sets the rotation to be used for drawing characters.

;	ARGS:				VALS:
; SP ->	no. of degrees			(none)

tekrot:	push r0			; save reg
	call teksb		; output any buffered text
	jsr pc,tekbb		; restart buffering co-routine
	pop teksw		; save co-routine PC
	mov 4(sp),tkrot		; save the no. of degrees of rotation
	call tekrst		; reset the plotter
	pop r0,(sp)		; restore reg, remove argument from stack
	return


; TEKSIZ sets the size of characters.

;	ARGS:				VALS:
; SP ->	horizontal size			(none)
;	vertical size

teksiz:	push r0			; save reg
	call teksb		; output any buffered text
	jsr pc,tekbb		; restart buffering co-routine
	pop teksw		; save co-routine PC
	mov 4(sp),tksizx	; save the x-dimension
	mov 6(sp),tksizy	; save the y-dimension
	call tekrst		; reset the plotter
	pop r0,(sp),(sp)	; restore reg, remove arguments from stack
	return


; TEKSTR draws a string of characters on the Tektronix.

;	ARGS:				VALS:
; SP ->	no. of characters		(none)
;	buffer ptr

tekstr:	tst 2(sp)		; zero characters?
	beq 1$			; yes, return immediately
loop <	  movb @4(sp),-(sp)	; TEKASC arg: character
	  inc 4+2(sp)		; increment ptr
	  call tekasc		; output character from string
	  dec 2(sp)		; decrement no. of characters
	  rptl ne		; keep going until all done
	  >
1$:	pop (sp),(sp)		; remove args from stack
	return


; TEKASC draws a character on the Tektronix.

;	ARGS:				VALS:
; SP ->	character			(none)

tekasc:	tst gsw			; already out of graphics mode?
	if ne,<
	  push #37		; TEKO arg: character
	  call teko		; send US to exit graphics mode
	  clr gsw		; remember we're out of graphics mode
	  >
	jmp teko		; output character and return

; TEKLIN draws a line between two points.

;	ARGS:				VALS:
; SP ->	x2				(none)
;	y2
;	x1
;	y1

teklin:	jsr r5,save6		; save regs
; calculate d2 = (x0-x2)^2+(y0-y2)^2
	mov tekx,r0
	sub 16(sp),r0
	mul r0,r0
	mov teky,r2
	sub 20(sp),r2
	mul r2,r2
	add r3,r1
	adc r0
	add r2,r0
; calculate d1 = (x0-x1)^2+(y0-y1)^2
	mov tekx,r2
	sub 22(sp),r2
	mul r2,r2
	mov teky,r4
	sub 24(sp),r4
	mul r4,r4
	add r5,r3
	adc r2
	add r4,r2
; compare d1 and d2
	cmp r2,r0
	blo 1$
	bhi 2$
	cmp r3,r1
	bhi 2$
1$:	push 24(sp),22+2(sp)	; TEKMOV args: y coordinate, x coordinate
	call tekmov		; move to x1,y1
	push 20(sp),16+2(sp)	; TEKDRW args: y coordinate, x coordinate
	call tekdrw		; draw to x2,y2
	br 3$
2$:	push 20(sp),16+2(sp)	; TEKMOV args: y coordinate, x coordinate
	call tekmov		; move to x2,y2
	push 24(sp),22+2(sp)	; TEKDRW args: y coordinate, x coordinate
	call tekdrw		; draw to x1,y1
3$:	jsr r5,rest6		; restore regs
	pop 6(sp)		; move up return R5
	add #6,sp		; remove args from stack
	return


; TEKMOV moves the cursor to the specified position.

;	ARGS:				VALS:
; SP ->	x coordinate			(none)
;	y coordinate

tekmov:	push #35		; TEKO arg: character
	call teko		; send GS to (re)enter graphics mode
	tst gsw			; already in graphics mode?
	if eq,<			; no
	  mov #-1,hiy		; set current position to -1 thus forcing
	  mov #-1,loy		; the next address to be sent in full
	  mov #1,gsw		; remember we're now in graphics mode
	  >
				; fall into TEKDRW to send position

; TEKDRW draws a vector from the current cursor position to the specified
; position.

;	ARGS:				VALS:
; SP ->	x coordinate			(none)
;	y coordinate

tekdrw:	push r0,r1,r2		; save regs
	tst gsw			; already in graphics mode?
	if eq,<
	  push #35		; TEKO arg: character
	  call teko		; send GS to enter graphics mode
	  push #7		; TEKO arg: character
	  call teko		; send BELL to make first vector visible
	  inc gsw		; remember we're in graphics mode
	  mov #-1,hiy		; set current position to -1 thus forcing
	  mov #-1,loy		; the next address to be sent in full
	  >
	mov pc,r0		; ptr to current position
	add #hiy-.,r0		; ...
	mov pc,r1		; ptr to save area
	add #ohiy-.,r1		; ...
	mov (r0)+,(r1)+		; save 5 old address bytes
	mov (r0)+,(r1)+		; ...
	movb (r0)+,(r1)+	; ...

; Compute address bytes for specified position.

 	mov 12(sp),r1		; get y coordinate
	mov r1,teky		; save last y coordinate
	mov r1,r0		; get low 2 bits of y coordinate
	bic #177774,r0		; ...
	ash #2,r0		; shift to put into bits 4:3 of XLOY byte
	bis #140,r0		; put 11 in tag bits to identify as XLOY byte
	movb r0,xloy		; save XLOY
	mov r1,r0		; get next 5 bits of y coordinate
	ash #-2,r0		; ...
	bic #177740,r0		; ...
	bis #140,r0		; put 11 in tag bits to identify as LOY
	movb r0,loy		; save LOY
	asl r1			; get high 5 bits of y coordinate
	swab r1			; ...
	bic #177740,r1		; ...
	bis #040,r1		; put 01 in tag bits to identify as HIY
	movb r1,hiy		; save HIY
	mov 10(sp),r1		; get x coordinate
	mov r1,tekx		; save last x coordinate
	mov r1,r0		; get low 2 bits of x coordinate
	bic #177774,r0		; ...
	bisb r0,xloy		; add to XLOY byte
	mov r1,r0		; get next 5 bits of x coordinate
	ash #-2,r0		; ...
	bic #177740,r0		; ...
	bis #100,r0		; put 10 in tag bits to identify as LOX
	movb r0,lox		; save LOX
	asl r1			; get high 5 bits of x coordinate
	swab r1			; ...
	bic #177740,r1		; ...
	bis #040,r1		; put 01 in tag bits to identify as HIX
	movb r1,hix		; save HIX

; Computed new address bytes, now see which haven't changed so don't have
; so send all five.

	mov #hiy,r0		; ptr to computed address bytes
	mov #ohiy,r1		; ptr to previous address bytes
	mov #20,r2		; R2 will be mask of which to send, init to LOX
	cmpb (r0)+,(r1)+	; HIY changed?
	if ne,<
	  bis #21,r2		; yes, send HIY and LOX
	  >
	cmpb (r0)+,(r1)+	; XLOY changed?
	if ne,<
	  bis #26,r2		; yes, send XLOY, LOY, and LOX
	  >
	cmpb (r0)+,(r1)+	; LOY changed?
	if ne,<
	  bis #24,r2		; yes, send LOY and LOX
	  >
	cmpb (r0)+,(r1)+	; HIX changed?
	if ne,<
	  bis #34,r2		; yes, send LOY, HIX, and LOX
	  >
	mov #hiy,r1		; ptr to address bytes
loop <	  movb (r1)+,r0		; get next byte
	  asr r2		; test mask to see if it needs to be sent
	  if cs,<
	    push r0		; TEKO arg: character
	    call teko		; send this address byte
	    >
	  tst r2		; any more to send?
	  rptl ne
	  >
	pop r2,r1,r0		; restore regs
	pop (sp),(sp)		; remove args from stack
	return


gsw:	.word 0			; nonzero if in grahpics mode
tekx:	.word 0			; last x coordinate
teky:	.word 0			; last y coordinate
hiy:	.byte -1
xloy:	.byte -1
loy:	.byte -1
hix:	.byte -1
lox:	.byte -1
.even
ohiy:	.byte -1
oxloy:	.byte -1
oloy:	.byte -1
ohix:	.byte -1
olox:	.byte -1
.even

; TEKO sends a character to the Tektronix 4662.

;	ARGS:				VALS:
; SP ->	character			(none)

teko:	push r0			; save reg
	mov 4(sp),r0		; get data character
	jsr pc,@teksw		; call buffering co-routine
	pop teksw		; save co-routine PC
	pop r0,(sp)		; restore reg, remove arg
	return



teklno==2			; Line no. of Tek4662
ltekb==250.			; if this changes then the constant
				; in TEKBEG will have to change also


; TEKBEG is called to prepare the Tek4662 for plotting.
tekbeg: push (sp)		; make room for return value
	tst tekuse		; plotter in use?
	if ne,<
	  mov #%enadv,2(sp)	; return error code
	  return
	  >
	inc tekuse		;say we are using the plotter
	clr 2(sp)		; no error on getting the plotter
	push #teklno		; ALWRIZ arg: line no.
	call alwriz		; send Reset, Blocksize, Plotter On
	  .string ^"ANAH256AE"
	clr gsw			; indicate not in graphics mode
	mov #56.,tksizx		; set default x-size
	mov #88.,tksizy		; set default y-size
	clr tkrot		; set default no. of degrees of rotation
	jsr pc,tekbb		; setup block buffering co-routine
	pop teksw		; save co-routine PC
	return


; TEKEND is called to terminate Tek4662 plotting.
tekend:	push #3124.,#4095.	; TEKMOV args: y,x
	call tekmov		; move to upper right hand corner
	call teksb		; send any stuff remaining in buffer
	push #teklno		; ALWRIZ arg: line no.
	call alwriz		; send Reset, Plotter Off
	  .string ^"ANAF"
	clr tekuse		; no one is using the plotter now
	return


; TEKBB is a co-routine which buffers a block to output to the Tek4662.
tekbb:	clr tekcnt		; start byte count at zero
	push pc			; ptr to TEKBUF
	add #tekbuf-.,(sp)	; ...
	pop tekbp		; set TEKBP (buffer ptr)
loop <	  jsr pc,@(sp)+		; get character
	  movb r0,@tekbp	; put character into buffer
	  inc tekbp		; update buffer ptr
	  inc tekcnt		; and count
	  cmp tekcnt,#ltekb	; filled the buffer?
	  rptl lo
	  >
	call teksb		; send the buffer as a block
	br tekbb


; TEKSB sends the current block being buffered.
teksb:	jsr r5,save6		; save regs
	mov #4,r3		; no. of times to retry errors
1$:	mov tekcnt,r1		; get no. of characters in buffer
	beq 3$			; return if none
	sub r1,tekbp		; move ptr to beginning of buffer
	push #teklno		; ALWRIZ arg: line no.
	call alwriz		; send Block Start
	  .string ^"A("
	mov #'(+'+'A+'),r2	; init checksum to Block start/end commands
loop <	  movb @tekbp,r0	; get character from buffer
	  inc tekbp		; update buffer ptr
	  push #teklno,r0	; ALWRIT args: line no., character
	  call alwrit		; send character to plotter
	  add r0,r2		; add character to checksum
	  cmp r2,#4095.		; overflow?
	  if hi,<
	    sub #4095.,r2	; yes, do end around carry
	    >
	  sorl r1
	  >
	push #teklno		; ALWRIZ arg: line no.
	call alwriz		; send Block End
	  .string ^"A)"
	mov r2,r0		; TEKNUM arg: number
	call teknum		; send checksum to plotter as decimal number
	push #teklno,#15	; ALWRIT args: line no., character
	call alwrit		; send checksum terminator
2$:	push #teklno,#2*60.*60. ; ALREAD args: line no., timeout
	call alread		; read response
	pop r0,*		; vals: character, error code
	if ne,<
4$:	  mov pc,tekerr		; say there was an error
	  call sysmsg		; print message on system console
	    .string ^"Plotter not responding
"
	  br 3$
	  >
	cmp r0,#'A		; A?
	beq 3$			; yes, block ok
	cmp r0,#'I		; I?
	bne 2$			; ignore anything else
	call sysmsg		; print message on system console
	  .string ^"Plotter Error
"
	push #teklno		; ALWRIZ arg: line no.
	call alwriz		; send RESET, Blocksize, Plotter On
	  .string ^"ANAH256AE"
	call tekrst		; reset the character sizes and rotation
	dec r3			; give up after 4 attempts
	bne 1$			; not zero yet
	mov pc,tekerr		; non-recoverable error
3$:	push #30.*5.		; wait 2.5 seconds for plotter to plot
	call twfor		; ....
	jsr r5,rest6		; restore regs
	return


; TEKRST resets the character size, and the character rotation

tekrst:	push #teklno		; ALWRIZ arg: line no.
	call alwriz		; send plotter on, alpha rotate commands
	  .string ^"AEAJ"
	mov tkrot,r0		; TEKNUM arg: number
	call teknum		; output degrees to plotter as decimal no.
	push #teklno		; ALWRIZ arg: line no.
	call alwriz		; send plotter on, alpha scale commands
	  .string ^"AEAI"
	mov tksizx,r0		; TEKNUM arg: number
	call teknum		; output horizontal size
	push #teklno,#54	; ALWRIT args: line no., character
	call alwrit		; output delimeter (comma)
	mov tksizy,r0		; TEKNUM arg: number
	call teknum		; output vertical size
	push #teklno,#15	; ALWRIT args: line no., character
	call alwrit		; output terminator
	return


; TEKNUM outputs a number in decimal to the Tek4662.

;	ARGS:				VALS:
; R0:	number				(none)

teknum:	push r1			; save reg
	mov r0,r1		; setup for DIV
	clr r0			; ...
	div #10.,r0		; divide number by 10
	tst r0			; quotient nonzero?
	if ne,<
	  call teknum		; yes, call self to convert quotient
	  >
	add #'0,r1		; remainder is digit, convert to ASCII
	push #teklno,r1		; ALWRIT args: line no., character
	call alwrit		; output digit
	pop r1			; restore reg
	return



; Tektronix 4662 output buffering stuff
teksw:	.blkw 1			; Tektronix 4662 co-routine switch
tekbuf:	.blkb ltekb		; Tektronix 4662 buffer
tekcnt:	.blkw 1			; Tektronix 4662 buffer count
tekbp:	.blkw 1			; Tektronix 4662 buffer ptr
tkrot:	.word 0			; amount of character rotation
tksizx:	.word 56.		; character size x-direction
tksizy:	.word 88.		; character size y-direction
ð; -*-PALX-*-
.sbttl	Time Routines

; This module keeps track of the current time and system uptime.

; TIMUT is the two word length of time the system has run, measured in
; 60ths of a second ("uptime").

; TIMST contains the two word time the system came up, measured in
; seconds since midnight January 1, 1900 GMT ("start time").


; Timer initialization.
; Turn on line clock interrupts and set up interrupt vector.
tiinit:	clr timut+0		; set uptime to zero
	clr timut+2		; ...
	clr timsts		; clear flag saying we know the time
	mov tgmt+0,timst+0	; set time system came up to zero
	mov tgmt+2,timst+2	; (local time)
	push pc			; set clock interrupt vector PC
	add #timint-.,(sp)	; ...
	pop @#100		; ...
	mov #pr6,@#102		; set clock interrupt vector PS
.lif df  lks
	mov #100,@#lks		; turn on clock interrupts
	return


; Timer interrupt handler.  Keep system up time by incrementing counter
; for every interrupt.
timint:	inc intflg		; indicate an interrupt has occured
	add #1,timut+0		; double-word increment (ADD since INC
	adc timut+2		; doesn't set C bit)
	dec tquant		; decrement time quantum
	bgt 2$			; still positive, let the process run
	add #1,timout+0		; increment timeout count
	adc timout+2		; ...
	cmpb 2(sp),#pr4		; is this clock interrupt interrupting an
				; interrupt?
	bhis 2$			; yes, hold off on preemption
	tst safety		; preemption deferred softwarily?
	bne 2$			; yes, hold off on preemption
	add #1,preemc+0		; increment preemption count
	adc preemc+2		; ...
.lif ne  asmpre
	jmp tc			; preempt this process, its time is up
2$:	rti


timut:	.blkw 2			; uptime
timsts:	.blkw 1			; flag set when time is known
timst:	.blkw 2			; start time
tgmt:	.word 5*60.*60.,0	; difference between GMT and local time

; UPTIME routine returns the current system up-time, in 60ths of a second.

;	ARGS:				VALS:
;	(none)			SP ->	uptime hi
;					uptime lo

uptime:	push (sp),(sp)		; make room for two return vals
	mfps -(sp)		; save priority
	spl 6			; set high priority to insure time valid
	mov timut+0,6(sp)	; get system up time
	mov timut+2,4(sp)	; ...
	mtps (sp)+		; restore priority
	return


; TIME returns the current time, measured in seconds since midnight
; January 1, 1900 (GMT).

;	ARGS:				VALS:
;	(none)			SP ->	time hi
;					time lo

time:	push (sp),(sp)		; create room for two return values
	jsr r5,save6		; save regs
	call uptime		; get system up time
	pop r0,r1		; UPTIME vals: time hi, time lo
	jsr pc,ddiv60		; divide system up time by 60 to get seconds
	peof			; no preemption while reading time system up
	add timst+0,r1		; add time system came up
	adc r0			; ...
	add timst+2,r0		; ...
	peon			; allow preemption again
	mov r1,20(sp)		; return current time
	mov r0,16(sp)		; ...
	jsr r5,rest6		; restore regs
	return


; TIMSET sets the current time from two binary words on the stack.
; This is accomplished by changing the time the system came up to
; the desired time minus the system up time (which remains unchanged).

;	ARGS:				VALS:
; SP ->	time hi				(none)
;	time lo

timset:	jsr r5,save6		; save regs
	call uptime		; get 60ths system has run
	pop r0,r1		; vals: time hi, time lo
	jsr pc,ddiv60		; divide by 60 to get seconds system has run
	sub r1,20(sp)		; subtract time system has run from desired
	sbc 16(sp)		; time to get time system came up
	sub r0,16(sp)		; ...
	peof			; turn off preemption while setting time
	mov 20(sp),timst+0	; change time system came up
	mov 16(sp),timst+2	; ...
	peon			; allow preemption again
	mov #1,timsts		; set flag saying time is set
	jsr r5,rest6		; restore regs
	pop (sp),(sp)		; remove arguments from stack
	push ttych+0		; WRITEC arg: channel id
	call writec		; put message on system console
	  .string ^"It is now  "
	push ttych+0				; PTIME arg: channel id
	push #%pttime+%ptdate+%ptday+%ptzone	; PTIME arg: control bits
	call time		; PTIME args: time lo, time hi
	call ptime		; print time on system console
	push ttych+0		; WRITEC arg: channel id
	call writec		; put message on system console
	  .string ^"
"
	return

.sbttl	Time conversion

; CVBTD converts time as measured in seconds since midnight January 1, 1900
; (GMT) to year, month, day, etc. values.

;	ARGS:				VALS:
; SP ->	time hi			 SP ->	seconds
;	time lo				minutes
;					hour
;					day
;					month
;					year
;					day of week

cvbtd:	sub #12,sp		; make room for 5 more return vals
	mov 12(sp),(sp)		; ...
	jsr r5,save6		; save regs
	mov 32(sp),r1		; get time lo
	mov 30(sp),r0		; get time hi
	sub tgmt+0,r1		; convert from GMT to local time
	sbc r0			; ...
	sub tgmt+2,r0		; ...
	jsr pc,ddiv60		; divide r0,r1 by 60, quotient (in r0,r1) is
				; minutes since 1900, remainder (in r2) is
				; seconds
	mov r2,16(sp)		; return seconds
	jsr pc,ddiv60		; divide r0,r1 by 60, quotient (in r0,r1) is
				; hours since 1900, remainder (in r2) is
				; minutes
	mov r2,20(sp)		; return minutes
	jsr pc,ddiv24		; divide r0,r1 by 24, quotient (in r0,r1) is
				; days since 1900, remainder (in r2) is hours
	mov r2,22(sp)		; return hours
	mov r1,r3		; copy days since 1900
	inc r3			; fudge so January 1, 1900 comes out as Monday
	clr r2			; for DIV
	div #7,r2		; divide by 7 to get day of week
	mov r3,32(sp)		; return day of week
	cmp r1,#31.+28.		; after Febuary 28, 1900?
	if his,<		; yes
	  inc r1		; add one to days so 1900 looks like leap year
	  >
	div #365.*4+1,r0	; divide days since 1900 by the no. of days in
				; four years
	ash #2,r0		; multiply by four to get year
	add #1900.,r0		; add 1900 to year
	mov r0,30(sp)		; return year (possibly add to this later)
	cmp r1,#31.+29.		; January of February of a leap year?
	if lo,<			; yes
	  mov #1,26(sp)		; January
	  cmp r1,#31.		; right?
	  blo 1$		; yes
	  inc 26(sp)		; no, February
	  sub #31.,r1		; adjust day of month
	  br 1$
	  >
	dec r1			; forget about February 29
	clr r0			; divide by 365 to get years since leap year
	div #365.,r0		; in r0, days since beginning of year in r1
	add r0,30(sp)		; add to year
	mov pc,r0		; ptr to TIMMOT
	add #timmot-.,r0	; ...
	clr 26(sp)		; init month return value
loop <	  inc 26(sp)		; increment month return value
	  sub (r0)+,r1		; subtract no. of days in that month
	  rptl his		; gone too far?
	  >
	add -(r0),r1		; went too far, back off
1$:	inc r1			; day of month is one based, not zero based
	mov r1,24(sp)		; return day of month
	jsr r5,rest6		; restore regs
	return

; Table of days in months.
timmot:	.word 31.,28.,31.,30.,31.,30.
	.word 31.,31.,30.,31.,30.,31.

; CVDTB converts date and time values to time measured in seconds since
; midnight January 1, 1900 (GMT).

;	ARGS:				VALS:
; SP ->	seconds			 SP ->	time hi
;	minutes				time lo
;	hour
;	day
;	month
;	year
;	day of week

cvdtb:	push r0,r1,r2		; save regs
	mov 22(sp),r1		; get year
	sub #1900.,r1		; make 1900 year zero
	clr r0			; divide year by 4, quotient is leap year
	div #4,r0		; group, remainder is year within group
	mul #365.,r1		; convert year within group to days
	mov r1,r2		; save
	mov r0,r1		; convert leap year group to days
	mul #365.*4+1,r1	; ...
	mov 20(sp),r0		; get month
	asl r0			; times two for indexing
	add pc,r0		; for PICness
	add tindmt-2-.(r0),r2	; convert month to no. of days and add in
	cmp r2,#31.+28.		; past January or February of the leap year?
	if his,<
	  inc r2		; yes, add one to account for February 29
	  >
	add 16(sp),r2		; add in day of month
	dec r2			; but decrement since its one origin
	add r2,r1
	cmp r1,#31.+29.		; past January or February of 1900?
	if his,<
	  dec r1		; yes, adjust for 1900 not being a leap year
	  >
	clr r0			; clear high order for multiplying
	mov #24.,r2		; DMUL arg: multiplier
	call dmul		; convert no. of days to no. of hours
	add 14(sp),r1		; add hour of the day
	adc r0			; ...
	mov #60.,r2		; DMUL arg: multiplier
	call dmul		; convert no. of hours to no. of minutes
	add 12(sp),r1		; add minutes
	adc r0			; ...
	mov #60.,r2		; DMUL arg: multiplier
	call dmul		; multiply R0,R1 by 60 to get seconds
	add 10(sp),r1		; add seconds
	adc r0			; ...
	add tgmt+0,r1		; convert from local time to GMT
	adc r0			; ...
	add tgmt+2,r0		; ...
	mov r1,24(sp)		; return lo order time
	mov r0,22(sp)		; return hi order time
	pop r2,r1,r0		; restore regs
	mov (sp),12(sp)		; move up return r5
	add #12,sp		; remove args from stack
	return
 
; Table of days preceeding current month in current year.
tindmt:	.word 0.,31.,59.,90.,120.,151.,181.,212.,243.,273.,304.,334.

.sbttl	Time Printing

; PTIME prints the given time on the given i/o channel.

;	ARGS:				VALS:
; SP ->	time hi				(none)
;	time lo
;	control bits
;	channel id

ptime:	push r0,r1		; save regs
	push 10(sp),6+2(sp)	; CVBTD args: time lo, time hi
	call cvbtd		; convert 2-word time to more useable form
	mov 4(sp),r0  		; swap seconds and hours to get in
	mov (sp),4(sp)  	; hours, minutes, seconds order
	mov r0,(sp)		; ...
	bit #%pt24hr,12+16(sp)	; 24 hour time or normal time?
	if eq,<			; normal time
	  mov pc,r1		; ptr to "AM"
	  add #ampm-.,r1	; ...
	  cmp r0,#12.		; afternoon?
	  if his,<
	    sub #12.,r0		; yes, subtract 12 hours
	    add #3,r1		; and change ptr to "PM"
	    >
	  mov r0,(sp)		; put hours on stack
	  if eq,<
	    mov #12.,(sp)	; convert zero hours to 12
	    >
	  >
	push 14+16(sp)  	; IOAC arg: channel id
	bit #%ptsecs,12+20(sp)	; print seconds?
	if ne,<
	  call ioac  		; print time
	    .string ^"^d:^2z:^2z"
	  >
	else <
	  call ioac		; print time
	    .string ^"^d:^2z"
	  pop *			; pop off seconds from stack
	  >
	bit #%pt24hr,12+10(sp)	; 24 hour time or normal time?
	if eq,<			; normal time
	  push 14+10(sp),r1	; WRITEZ args: channel id, ptr
	  call writez		; print AM or PM
	  >
	bit #%ptzone,12+10(sp)	; print time zone?
	if ne,<
	  push 14+10(sp)	; WRITEC arg: channel id
	  call writec		; print time zone
	    .string ^" EST"
	  >
	push 14+10(sp)		; WRITEC arg: channel id
	call writec		; output two spaces
	  .string ^"  "
	bit #%ptday,12+10(sp)	; print day of week?
	if ne,<
	  mov 6(sp),r0		; get day of week
	  asl r0		; times two for indexing
	  add pc,r0		; for PICness
	  add #daynam-.,r0	; ptr to ptr to  day's name
	  push 14+10(sp)	; WRITEZ arg1: channel id
	  mov (r0),-(sp)	; WRITEZ arg2: ptr to asciz string
	  add r0,(sp)		; ...
	  call writez		; print day of the week
	  push 14+10(sp)	; WRITEC args: channel id
	  call writec		; print comma, space
	    .string ^", "
	  >
	mov 2(sp),r0  		; swap day and month to get in
	mov (sp),2(sp)  	; month, day, year order
	mov r0,(sp)		; ...
	bit #%ptslsh,12+10(sp)	; slash dates?
	if eq,<			; no, real ones
	  asl r0		; 1st times two for indexing
	  add pc,r0		; convert month no. to month name
	  add #moname-2-.,r0	; ptr to relative ptr
	  mov (r0),(sp)		; convert relative ptr to absolute one
	  add r0,(sp)		; ...
	  push 14+10(sp)	; IOAC arg: channel id
	  call ioac		; print nice date
	    .string ^"^a ^d, ^d"
	  >
	else <			; slash dates
	  sub #1900.,4(sp)	; only print last two digits of year
	  push 14+10(sp)	; IOAC arg: channel id
	  call ioac		; print slash date
	    .string ^"^d/^d/^2z"
	  >
	pop *,r1,r0,6(sp)	; restore regs, remove args from stack
	add #6,sp		; ...
	return

%pttime==1			; print time (nyi)
%ptsecs==2			; print seconds
%pt24hr==4			; use losing 24-hour time
%ptdate==10			; print date (nyi)
%ptslsh==20			; use slash date
%ptday==40			; print day of week
%ptzone==100			; print time zone

ampm:	.asciz "AM"
	.asciz "PM"
	.even

daynam:	.string ^"Sunday"
	.string ^"Monday"
	.string ^"Tuesday"
	.string ^"Wednesday"
	.string ^"Thursday"
	.string ^"Friday"
	.string ^"Saturday"

moname:	.string ^"January"
	.string ^"February"
	.string ^"March"
	.string ^"April"
	.string ^"May"
	.string ^"June"
	.string ^"July"
	.string ^"August"
	.string ^"September"
	.string ^"October"
	.string ^"November"
	.string ^"December"


; CVBTF converts a two word binary time to a file system date.

;	ARGS:				VALS:
; SP ->	time hi			 SP ->	file date
;	time lo

cvbtf:	jsr r5,save6		; save regs
	mov 16(sp),r0		; get time argument (seconds since 1900)
	mov 20(sp),r1		; ...
; Following done because GMT is not correct if only storing no. of days.
; GMT could (and should) be used if at least the no. of hours were used.
	sub tgmt+0,r1		; convert from GMT to local time
	sbc r0			; ...
	sub tgmt+2,r0		; ...
	jsr pc,ddiv60		; divide r0,r1 by 60, quotient (in r0,r1) is
				; minutes since 1900, remainder (in r2) is
				; seconds
	jsr pc,ddiv60		; divide r0,r1 by 60, quotient (in r0,r1) is
				; hours since 1900, remainder (in r2) is
				; minutes
	jsr pc,ddiv24		; divide r0,r1 by 24, quotient (in r0,r1) is
				; days since 1900, remainder (in r2) is hours
	sub #28489.,r1		; convert from days since 1900 to days since
				; 1978
	if lo,<			; earlier than 1978
	  clr r1		; use January 1, 1978
	  >
	mov r1,20(sp)		; return days since 1978 as file date
	jsr r5,rest6		; restore regs
	pop (sp)		; remove argument from stack
	return


; CVFTB converts a file system date to a two word binary time.

;	ARGS:				VALS:
; SP ->	file date		 SP ->	time hi
;					time lo

cvftb:	push (sp)		; make slot for extra return value
	jsr r5,save6		; save regs
	mov 20(sp),r1		; get file date argument
	add #28489.,r1		; convert from days since 1978 to days
				; since 1900
	clr r0			; start off with high part clear
	mov #24.*60.,r2		; DMUL arg: multiplier
	call dmul		; convert from days to minutes
	mov #60.,r2		; DMUL arg: multiplier
	call dmul		; convert from minutes to seconds
; Following done because GMT is not correct if only storing no. of days.
; GMT could (and should) be used if at least the no. of hours were used.
	add tgmt+0,r1		; convert from local time to GMT
	adc r0			; ...
	add tgmt+2,r0		; ...
	mov r0,16(sp)		; return two word binary time
	mov r1,20(sp)		; ...
	jsr r5,rest6		; restore regs
	return
ð&3; TRANTOR - A PDP11 Multi-user Operating System   -*-PALX-*-
tvn==%fnam2	; TRANTOR version number.

.TITLE	TRANTOR

; This is the Trantor Operating System, written for the M.I.T.
; Applied Mathematics Department by Eugene Ciccarelli, Earl Killian,
; and Charles Frankston. Maintained currently by Richard Lawhorn.

; TRANTOR programming style and conventions:

; [1] Subroutine calls and returns:

; Subroutines are passed "arguments" and return "values" (or "ARGS" and
; "VALS").  The caller pushes the args, and calls the subr by JSR R5,SUBR. 
; The subroutine clears off all args from the stack and pushes any return
; vals.  Thus the caller need not worry about cleaning up the stack after
; return.  Often the last value is an error code; the operation requested
; was successful if it is zero.  Also, a few subroutines may have several
; returns showing various conditions and/or whether the subroutine action
; was successful.  The use of multiple returns is discouraged.  If there
; are multiple returns, the convention is that the last one be the normal
; return, and the others exceptional or error returns.  Each return
; ("RETURN1", "RETURN2", etc.) returns to a location 1-word beyond the
; last return, and each return but the last should have its instruction
; indented 2 spaces, e.g.:

;	jsr r5,subr	; the subroutine call
;	  br ret1	; return1
;	  br ret2	; return2
;	inc foo		; return3, normal


; [2] Subroutine argument, value, return description:

; It is important for reliability and readability that the arguments
; and values of a subroutine be clearly identified at the subroutine
; call.  Thus, arguments should be clearly identified by a comment at
; the subroutine call or on the line preceeding (when pushing args) or
; on the line popping args.  Usually it is clearer to use one PUSH
; macro to push the args (one line, showing the list of args clearly),
; and one POP macro to pop them, commented clearly to show the purpose
; of the args, e.g.:

;	push r1,#45	; ALOCW args: size of block, timeout
;	jsr r5,alocw	; allocate a block of storage
;	pop r2,r3	; vals: ptr to block, error code

; Each subroutine should be well commented, both as a whole,
; explaining the purpose and algorithm of the subroutine, and
; line-by-line.  To facilitate quicker scanning of the source and
; to allow TECO macros to get information about args, vals, and
; returns, each subroutine should be preceeded by a comment section
; like the following:

;	ARGS:				VALS:
; SP ->	no. of words		 SP ->	ptr to block
;	timeout (60ths)			error code

; This comment section should directly preceed the subroutine's
; label.


; [3] Position-independence

; Separate modules should be written so that they are position-
; independent relative to the other modules of the system.  Thus,
; they may at some time be dynamically loaded.  When making an address to
; position-indenpendent code, use a sequence such as the following:
;	mov pc,-(sp)
;	add #foo-.,(sp)		; now have ptr to foo on the stack.
;	pop ptr			; put the ptr where you want it.
; Be careful that the instruction sequence is compatible over the
; pdp11 family:  "mov pc,foo" for instance is not.  The use of
; the stack above insures compatibility.


; [4] Preemption

; Trantor does not currently preempt processes, however wherever
; possible the code has been written so as to be preemtable.  Where
; it is not, the routine should set priority 2 to indicate to any
; future traffic controller that the routine must be allowed to
; finish.  Priority 2 should be used for as short periods of time
; as possible.  This is out of date!

.sbttl	Definitions

.insrt pdp11;defs >

setf ^"Small system?",asm16k

.if ne  asm16k
.iif ndf  asmtek,  asmtek===0
.iif ndf  asmplt,  asmplt===0
setf ^"Trollr?",asmtrl
setf ^"Console?",asmcns
setf ^"User200?",asmcdc
.endc


ifMIT  <
       .iif ndf  asmcdc,  asmcdc===1
       .iif ndf  asmtek,  asmtek===1
       .iif ndf  asmplt,  asmplt===1
       .iif ndf  asmspp,  asmspp===0
       >

ifSAO  <
       .iif ndf  asmcdc,  asmcdc===1
       .iif ndf  asmtek,  asmtek===0
       .iif ndf  asmplt,  asmplt===0
       .iif ndf  asmspp,  asmspp===0
       >

.if eq   asmcdc
	 ndp==0
	 ndu==0
.endc

.iif ndf  asmtrl,  asmtrl===1
.iif ndf  asmcns,  asmcns===1
.iif ndf  asmrt1,  asmrt1===0		; if not defined we don't know RT11

setf ^"Preemption?",asmpre

ifMIT  <
       setf ^"Input Peeking?",asmpek
       setf ^"Experimental system?",sysexp	; experimental system???
       >

.iif ndf  sysexp, sysexp==0	; not an experimental system
.iif ndf  fsmin,  fsmin==10	; minimum size for a leftover free block
.iif ndf  asmpek,  asmpek===0	; no use for input peeking yet.



.sbttl	Macros

; The CRASH macro assembles into a BPT instruction, and also causes a .MSG
; to be put into the error file with the CRASH argument, thus allowing the
; message and the location to be associated and printed by a suitable TECO
; macro.

.macro	crash msg
	bpt		; trap to syserr or rug
	.if p1		; only print type crash msgs on pass 1
	%ttyfl===%ttyfl+1
	.msg	_C_ msg
	%ttyfl===%ttyfl-1
	.endc
.endm


; Define macro to handle software error conditions
.macro	lose n
	bpt
.endm


; Macros to disallow and allow preemption.
.macro	peof
	inc safety
.endm

.macro	peon
	call tpeon
.endm


; The CALL macro expands into either a "JSR R5,SUBR" or
; "JSR R5,@SUBR_LINK" depedning on whether or not SUBR
; is defined in the current assembly.  Thus the CALL macro
; provides a convienent interface to the dynamic linking
; facility.

.macro	call proc
.nlist
	.if p1
%'proc===1
	jsr r5,@1		; dummy JSR on pass 1
append linkb,^|
	.if ndf  proc		; create link block if external subr
	.if ne  %'proc		; and if link block not already defined
%'proc===.
	.word 40		; link vector
	.rad50	"proc  "	; rad50 of proc name
.=%'proc+6
	.endc
	.endc
	.iif p2,  %'proc===0
|
	.iff			; if pass 2
	.iif df  proc,	jsr r5,proc
	.ielse		jsr r5,@%'proc
	.endc 			; pass 1 or 2 conditional
.list
.endm call

.macro	call x
	jsr r5,x
.endm

.macro	return
	rts r5
.endm

.macro	retrn1
	rts r5
.endm

.macro	retrn2
	tst (r5)+
	rts r5
.endm

.lif p1
txtint linkb		; create link block

.sbttl	Startup

; When booted the system starts here at 1000.  The top of memory is
; determined and the memory management module is initialized.  The system
; is then started by creating the system process and transfering to it. 
; The system process will do the rest of the work necessary to get the
; system running. 

stack==1000

	.=stack			; code starts just above stack

go:	spl 7			; set high priority so no interrupts
	mov #stack,sp		; set stack ptr
	br go2
go1:	  mov pc,rugsta		; we're starting under a RUG debugger
	  br go
go2:::
ifSAO  <
	mov @#4,savnxm
	mov @#6,savnxm+2
	>
	mov #nxmt,@#4
	mov #pr7,@#6
.if ne  pfail
	push pc			; set power fail vector to POWERF
	add #powerf-.,(sp)	; ...
	pop @#24		; ...
	mov #pr7,@#26		; power fail is PR7 of course!
.endc
	push pc			; set IOT vector to TC
	add #tc-.,(sp)		; ...
	pop @#20		; ...
	mov #pr7,@#22		; TC runs at priority 0

; Determine how much memory the machine has.

	call catchn		; catch the nxm error
	  1$-.			; nxm error catch addr
	clr r1			; start test address at zero
loop <	  add #4000,r1		; add 1K to test address
	  tst (r1)		; keep testing until we get a NXM trap
	  rptl			; ...
	  >
1$:	mov r1,memtop		; save address of first nxm
	push pc			; FSINIT arg1: highest code location
	add #last-.,(sp)	; as bottom of free storage area
	push memtop		; FSINIT arg2: top of fs area to top of memory
;;;	sub #6000,(sp)		; Leave room for BOOT
	tst rugsta
	if ne,<
ifMIT <
	  sub #45000,(sp)	; gotta leave room for RUG
      >
ifSAO <
	  sub #56000,(sp)	; gotta leave room for RUG
      >
	  >
	jsr r5,fsinit		; set up free-storage area
.if df	swr
	clr istswr		; check for switch register at runtime now,
	call catchn		; for machines like /34 that may have one day,
	  2$-.			; but not the next
	tst @#swr		; this will go to 2$ if there is no swr
	mov pc,istswr		; didn't trap, there must be one
.endc

2$:	clr npwrf		; reset power fail count
	clr tpidct		; reset process-id counter
	clr nproc		; reset active process counter
	clr trun		; reset run queue
	clr trunql		; set runq length to zero
	clr tblock		; reset block queue
	clr tblkql		; set blockq length to zero
	clr tccnt+0		; reset no. of TC loops
	clr tccnt+2		; ...
	clr tpwake+0		; reset no. of process wakeups
	clr tpwake+2		; ...
	clr preemc+0		; reset no. of preemptions
	clr preemc+2		; ...
; for system metering
	clr nobnrd		; clear number of blocks not read but accessed
	clr notbmp		; clear no. of times bitmap was written
	mov #1,safety		; no preemption until system is started!

; Now create the system process.

	push #0			; MAKEP arg: initial PC (meaningless)
	jsr r5,makep		; create the system process
	pop *,*			; vals: process id, error code
	if ne,<
	  crash ^"Can't create system process"
	  >
	jmp sysp		; start system


memtop:	.blkw 1			; address of top of memory


; CATCHN is called to setup for an expected nxm trap.
; When the nxm trap occurs control will be passed to address
; specified by a relative ptr after the call.

catchn:	mov r5,@#nxmcat		; set catch for address specified
	add (r5)+,@#nxmcat	; by relative ptr after call
	return


nxmt:	tst @#nxmcat
	if eq,<
	  halt
	  rti
	  >
	mov @#nxmcat,(sp)
	clr @#nxmcat
	rti


nxmcat==42			; NXM catch location used by BOOT


pat: patch:	.blkw	100	; patch area

.insrt pdp11;stuff

.insrt pdp11;fsm

.insrt pdp11;time

.sbttl	Power fail handler

.if ne  pfail
; Traps here when AC LO is asserted on bus.  The registers
; are saved on the stack and the SP is saved in a fixed place
; so it can be restored after powerup.

powerf:	push r5,r4,r3,r2,r1,r0	; save regs on stack
	mov sp,pwrsp		; save sp in a fixed place
	add #poweru-powerf,@#24	; set vector to power up routine
	inc npwrf		; increment no. of power failures
	halt
 

; Comes here when power returns.  The registers are restored
; and the processor resumes where it left off.

poweru:	add #powerf-poweru,@#24	; set vector to power fail routine
	mov pwrsp,sp		; restore stack ptr
	peof			; turn off preemption
	mov #100,@#lks		; turn on clock
	spl 5			; allow clock interrupts
	call dpwru		; powerup terminals
.irp d,	; call RL,RK,RX,LP,DP, and DU powerup routines
	.lif ne n'd
	call d'pwru
.endm
	peon			; allow preemption again
	pop r0,r1,r2,r3,r4,r5	; restore regs
	rti			; continue execution

pwrsp:	.blkw 1			; SP stored here during power failure
.endc

npwrf:	.blkw 1			; no. of power failures

.sbttl	PCB Defintion
 
;      The Traffic Controller maintains a Process Control Block (PCB)
; for each process which contains all the information necessary to run
; the process.  MAKEP creates a process by allocating and initializing
; a PCB and adding it to the doubly linked circular list of PCBs.
; PCB's are freed when the process is killed by KILLP.
;      The PCB contains a process' complete state while it is not running.
; The stack (and also the registers, PC and PS) are saved in a separate
; block with a ptr in the PCB (see PCBSKP, PCBSKS and PCBSKM).  The first
; word of the PCB is its queue link.  A process can be on either the run
; queue, blocked queue, or neither; the first word is used to thread together
; all processes on a given queue.  When a process is on the blocked queue
; its PCB contains the conditions for it to be unblocked.  PCBLOC, PCBVAL,
; and PCBWT specify a address, value and a relation to be true before the
; process can be run.  PCBTL and PCBTH specify a time to unblock the process
; if the other wait conditions are not satisfied (or if there are none).

dsect <
		.blkw 1		; queue link, ptr to next pcb in queue
pcbfl::		.blkw 1		; ptr to pcb forward in ring
pcbbl::		.blkw 1		; ptr to pcb backward in ring
pcbid::		.blkw 1		; process ID
pcbsts::	.blkw 1		; process status
pcbloc::	.blkw 1		; location to wait on
pcbval::	.blkw 1		; value for waiting
pcbwt::		.blkw 1		; process waiting condition
pcbtl::		.blkw 1		; low order time
pcbth::		.blkw 1		; time to wait till, high order
pcbskp::	.blkw 1		; ptr to save area for stack frame
pcbskm::	.blkw 1		; size of save area (max size of sf)
pcbsks::	.blkw 1		; size of sf
pcbsup::	.blkw 1		; process id of superior
pcbui::		.blkw 1		; user input channel
pcbuo::		.blkw 1		; user output channel
	>,pcblen


; Stack offsets (for debugging purposes).
pskps==16		; offset of PS on process stack
pskpc==14		; offset of PC on process stack

; Process states.
%psblk==1		; blocked
%psrun==2		; running
%psstp==200		; stopped

.sbttl	Traffic controller

; TC is called by the TC wait handlers to suspend the current process
; and select another to run.  TC saves the current process' stack, and
; puts the current process onto the end of the blocked queue.  TC then
; scans the blocked queue for runnable processes and moves them to the
; run queue.  Finally TC selects the first process on the run queue
; and restarts it.  Call by IOT.


tc:	mov #30.,tquant		; give us a quantum just to prevent
				; aborted preemptions from cluttering
				; statistics
	mov #1,safety		; no preemption while in TC!
	spl 0			; can run at PR0 now
	cmp sp,#stack		; check for stack underflow
	if hi,<
	  mov sp,tunsp		; save rotten stack ptr
	  mov #stack,sp		; restore valid stack ptr
	  push #0,#0		; fake a PS and PC
	  lose %eunsk		; give stack underflow error trap
	  >
	jsr r5,save6		; save regs
	mov trun,r0		; get ptr to process' PCB (head of run queue)
	mov #stack,r2		; calculate stack size
	sub sp,r2		; ...
	asr r2			; halve to get no. of words
	cmp r2,pcbskm(r0)	; stack too big to save?
	if hi,<
	  lose %eovsk		; give stack overflow error trap
	  >
	mov r2,pcbsks(r0)	; save size in pcb
	mov pcbskp(r0),r1	; ptr to stack save area
loop <	  mov (sp)+,(r1)+	; move sf into save area
	  sorl r2		; ...
	  >

; Move process from run queue to blocked queue.

	mov (r0),trun		; remove from run queue
	clr (r0)		; clear queue link word
	dec trunql		; decrement no. of processs on runq
	bitb #%psstp,pcbsts(r0)	; process stopping itself?
	if eq,<			; no, move from runq to blockq
	  movb #%psblk,pcbsts(r0)	; change status of process to blocked
	  mov pc,r1		; get ptr to blockq
	  add #tblock-.,r1	; ...
  loop <    mov r1,r2		; find end of blocked queue
	    mov (r1),r1
	    rptl ne
	    >
	  mov r0,(r2)		; put process on end
	  inc tblkql		; increment no. of processes on blockq
	  >

; Find a new process to run.

tcloop:	mov #30.,tquant		; give us a quantum just to prevent
				; aborted preemptions from cluttering
				; statistics
.lif df  lks
	bis #100,@#lks		; make sure timer is on
.if df	swr
	tst istswr		; is there a switch register?
	if ne,<
	  bit #1,@#swr		; sw 0 up?
	  if ne,<
	    bpt			; yes, call rug
	    >
	  >
.endc
	add #1,tccnt+0		; keep tally of times around ring
	adc tccnt+2		; ...
	clr intflg		; ints will set this flag and force
				; another scan of blocked processes

; Move all runnable processes from blocked queue to run queue.

	mov pc,r1		; get ptr to head of runq
	add #trun-.,r1		; ...
loop <	  mov r1,r2		; find end of runq
	  mov (r1),r1
	  rptl ne
	  >
; Ptr to end of runq in R2.
	mov pc,r1		; get ptr to head of blockq
	add #tblock-.,r1	; ...
	call uptime		; get time to check timeouts
	pop r3,r4		; UPTIME vals: hi,lo 
loop <	  mov (r1),r0		; ptr to next pcb on blockq
	  exitl eq		; done if ptr is null
	  add pcbwt(r0),pc	; dispatch on TC wait condition
t0:	  cmp @pcbloc(r0),pcbval(r0)	; CMP-NE test
	  bne tub
	  br toff
t1:	  cmp @pcbloc(r0),pcbval(r0)	; CMP-HI test
	  bhi tub
	  br toff
t2:	  bit pcbval(r0),@pcbloc(r0)	; BIT-NE test
	  bne tub
	  br toff
t3:	  bit pcbval(r0),@pcbloc(r0)	; BIT-EQ test
	  beq tub
	  br toff
t4:	  cmp @pcbloc(r0),pcbval(r0)	; CMP-EQ test
	  beq tub
; Process is "off" (i.e. either no on condition or on condition not satisfied).
toff:	  cmp pcbth(r0),r3	; check if pcb's time has come
	  blo tub
	  if eq,<		; high order of times the same
	    cmp pcbtl(r0),r4	; so check low orders
	    blo tub
	    >
	  mov r0,r1		; save ptr to this PCB
	  rptl			; check next process
; Unblock process, i.e. move from blockq to runq.
tub:	  cmpb pcbsts(r0),#%psblk	; error check: process really blocked?
	  if ne,<
	    crash ^"Blocked process isn't"
	    >
	  add #1,tpwake+0	; increment the no. of process wakeups
	  adc tpwake+2		; ...
	  mov #177777,pcbth(r0)	; set infinite until time
	  mov #177777,pcbtl(r0)	; ...
	  mov #tub-t0,pcbwt(r0)	; no on condition anymore
	  mov (r0),(r1)		; remove from blockq
	  dec tblkql		; decrement blockq length
	  movb #%psrun,pcbsts(r0)	; change status of process to running
	  clr (r0)		; add to runq
	  mov r0,(r2)		; ...
	  mov r0,r2		; update ptr to end of runq
	  inc trunql		; increment runq length
	  rptl			; continue scanning blockq
	  >

; Run first process on run queue.

	mov trun,r0		; ptr to first process on runq
	if eq,<			; runq is empty
	  spl 7			; check INTFLG at high priority
	  tst intflg		; ints since scanned blockq?
	  bne tcloop		; yes, scan again
	  push #pr3		; no, push PS for RTT
	  jsr pc,3$		; and a PC
	  wait			; sleep until interrupt
	  br tcloop		; yawn! int, so scan blockq again
3$:	  rtt			; set pr3 and execute wait without int
	  >

; Copy stack frame from save area onto stack.

	mov pcbsks(r0),r2	; size of saved stack
	mov r2,r1		; make ptr to end of stack
	asl r1			; ...
	add pcbskp(r0),r1	; ...
loop <	  mov -(r1),-(sp)	; copy saved stack onto stack
	  sorl r2		; ...
	  >
	jsr r5,rest6		; restore regs
	mov #30.,tquant		; preemption will occur on 30th clock interrupt
	clr safety		; preemption allowable
	rti


; TPEON is called by the PEON macro to decrement the no-preemption count.
tpeon:	tst tquant		; Is preemption pending?
	if gt,<			; no
	  dec safety		; decrement safety level
	  bmi 1$		; error if level goes negative
	  return
	  >
; Preemption pending
	dec safety		; decrement safety level
	bmi 1$			; error if level goes negative
	if eq,<			; safety down to zero so preempt ourselves
	  iot			; by calling TC
	  >
	return
1$:	crash ^"PEON with preemption already on"
	return


tunsp:	.blkw 1			; SP of last stack underflow
trunql:	.blkw 1			; no. of processes on runq
tblkql:	.blkw 1			; no. of processes on blockq
tccnt:	.blkw 2			; no. of times around tcloop
tpwake:	.blkw 2			; no. of process wakeups
trun:	.blkw 1			; ptr to run queue
tblock:	.blkw 1			; ptr to blocked queue

intflg:	.blkw 1			; flag set when interrupt occurs
safety:	.blkw 1			; nonzero if preemption inhibited
tquant:	.blkw 1			; no. of time quanta remaining
timout:	.blkw 2			; no. of times processes ran over quantum
preemc:	.blkw 2			; no. of preemptions

ifSAO	<
savnxm:	.blkw 2			; saved locations 4 and 6 when we were entered
>

rugsta:	.blkw 1			; non-zero indicates we were entered from RUG
istswr:	.blkw 1			; non-zero iff there is a switch register

.sbttl	TC wait handlers

; This section handles the process-wait system calls.  Each of these calls
; causes the running process to be suspended (and another picked to run),
; waiting for some condition to be true before the process can again be
; run.  Basically, a process can wait ON a location (until that location
; changes in some way from a specified value); or a process can wait UNTIL
; or FOR a certain amount of time.  In addition, timeouts can be effected
; on a wait ON by combinin the ON and UNTIL (or ON and FOR), in which case
; the process can be run as soon as either condtion is satisfied. 

; Note that UNTIL times are 2-word absolute binary times (as returned
; by UPTIME), while FOR times are 1-word relative binary times (relative
; to now).


; FOR: wait for a certain time.  Translated into a wait UNTIL.

;	ARGS:				VALS:
; SP ->	delta-time			(none)

twfor:	mov #1,safety		; turn off preemption
	push (sp)		; create slot for 2-word absolute time
	call uptime		; get current 2-word binary time
	mov (sp)+,4(sp)		; put in hi-order time
	add (sp)+,4(sp)		; add in lo-order time to offset
	adc 2(sp)		; add carry to hi-order time
; wait FOR is now the equivilant wait UNTIL.


; UNTIL: wait until a certain time.

;	ARGS:				VALS:
; SP ->	time hi				(none)
;	time lo

twtil:	mov #1,safety		; turn off preemption
	push r0			; save reg
	mov trun,r0		; ptr to process' PCB
	mov 4(sp),pcbth(r0)	; hi order time
	mov 6(sp),pcbtl(r0)	; lo order time
	mov #toff-t0,pcbwt(r0)	; so not waiting on any locations
	pop r0,(sp),(sp)	; restore reg, remove args from stack
	iot			; call traffic controller
	return


; TSTOT: set timeout time for next WAIT ON call.

;	ARGS:				VALS:
; SP ->	time hi				(none)
;	time lo

tstot:	mov #1,safety		; turn off preemption
	push r0			; save reg
	mov trun,r0		; ptr to process' PCB
	mov 4(sp),pcbth(r0)	; hi order time
	mov 6(sp),pcbtl(r0)	; lo order time
	pop r0,(sp),(sp)	; restore reg, remove args from stack
	return


; ON-NE: wait until contents of address are different from value.

;	ARGS:				VALS:
; SP ->	value				(none)
;	address

twonne:	cmp @4(sp),2(sp)	; wait condition already satisfied?
	if ne,<			; yes, return immediately
	  pop (sp),(sp)		; remove args from stack
	  return
	  >
	push #0			; TC code for CMP-NE (offset of test from T0)
	br twon


; ON-HI: wait until contents of address are higher than value.

;	ARGS:				VALS:
; SP ->	value				(none)
;	address

twonhi:	cmp @4(sp),2(sp)	; wait condition already satisfied?
	if hi,<			; yes, return immediately
	  pop (sp),(sp)		; remove args from stack
	  return
	  >
	push #t1-t0		; TC code for CMP-HI (offset of test from T0)
	br twon


; ON-BN: wait until specified bit of address is on.

;	ARGS:				VALS:
; SP ->	bit				(none)
;	address

twonbn:	bit 2(sp),@4(sp)	; wait condition already satisfied?
	if ne,<			; yes, return immediately
	  pop (sp),(sp)		; remove args from stack
	  return
	  >
	push #t2-t0		; TC code for BIT-NE (offset of test from T0)
	br twon


; ON-BE: wait until specified bit of address is off.

;	ARGS:				VALS:
; SP ->	bit				(none)
;	address

twonbe:	bit 2(sp),@4(sp)	; wait condition already satisfied?
	if eq,<			; yes, return immediately
	  pop (sp),(sp)		; remove args from stack
	  return
	  >
	push #t3-t0		; TC code for BIT-EQ (offset of test from T0)
	br twon


; ON-EQ: wait until contents of address are same as value.

;	ARGS:				VALS:
; SP ->	value				(none)
;	address

twoneq:	cmp @4(sp),2(sp)	; wait condition already satisfied?
	if eq,<			; yes, return immediately
	  pop (sp),(sp)		; remove args from stack
	  return
	  >
	push #t4-t0		; TC code for CMP-EQ (offset of test from T0)
	br twon


; TWON is the common code for the wait-on TC calls.
twon:	mov #1,safety		; turn off preemption
	push r0			; save reg
	mov trun,r0		; ptr to this process's pcb
	mov 10(sp),pcbloc(r0)	; save location, value to
	mov 6(sp),pcbval(r0)	; wait on
	mov 2(sp),pcbwt(r0)	; set wait condtion
	pop r0,*,(sp),(sp)	; restore reg, remove TC code and args
	iot			; call trafic controller
	return


; AWAIT implements mutual exclusion using event counters.  Its argument
; is a ptr to a two word block.  The first word is the event counter
; which is incremented each time a process gives up its exclusion.  The
; second word is used to generate tickets.  AWAIT reads the current
; ticket value and then increments it.  It then waits for the event
; counter to become equal to its ticket.

;	ARGS:				VALS:
; SP ->	ptr to ec and tc		(none)

await:	push r1			; save reg
	mov 4(sp),r1		; ptr to ec and ticket counter
	peof			; turn off preemption while we get ticket
	push r1,2(r1)		; TWONEQ args: address, value
	inc 2(r1)		; took ticket, now increment ticket counter
	peon			; allow preemption again
	call twoneq		; wait for ec to equal out ticket
	pop r1			; restore reg
	return

.sbttl	Process Manipulation

; MAKEP, creates new processes given an initial PC.  The new process
; is given an initial stack of 50 words; its state is "stopped".
; A unique process id is also assigned and returned; this id may be
; converted to a PCB ptr via the PCBPTR subroutine.

;	ARGS:				VALS:
; SP ->	Initial PC		 SP ->	process id
;					error code


makep:	push (sp)		; slot for error code
	jsr r5,save6		; save regs
	mov 20(sp),r4		; initial PC
	clr 16(sp)		; return a zero process id if error
	push #pcblen/2,#2*60.	; ALOCW args: size in words, timeout
	call alocw		; allocate a pcb for process
	pop r0,20(sp)		; vals: ptr, error code
	bne 1$			; return if couldn't get storage
	push #50.,#2*60.	; ALOCW args: size in words, timeout
	call alocw		; allocate stack save area
	pop r1,20(sp)		; vals: ptr, error code
	if ne,<			; couldn't get save area, release pcb
	  push r0		; FREE arg: ptr to storage
	  call free		; free pcb storage
	  br 1$
	  >
	mov r4,pskpc(r1)	; set initial PC
	mov r1,pcbskp(r0)	; set ptr to stack save area
	mov #50.,pcbskm(r0)	; and its size
	mov #8.,pcbsks(r0)	; set sf size to 8 (six regs + pc + ps)
	mov #177777,pcbtl(r0)	; set until time infinite
	mov #177777,pcbth(r0)	; ...
	mov #tub-t0,pcbwt(r0)	; no wait condition
	mov #%psrun+%psstp,pcbsts(r0)	; set stopped running status
	call getpid		; get process id
	pop pcbsup(r0)		; val: process id (save superior's id in PCB)
	peof			; turn off preemption
	inc tpidct		; increment process id count
	mov tpidct,pcbid(r0)	; use count as process id
	mov tpidct,16(sp)	; return process id as well
	mov trun,r1		; ptr to pcb ring
	if ne,<
	  mov pcbfl(r1),pcbfl(r0)	; put new pcb into ring
	  mov r1,pcbbl(r0)
	  mov r0,pcbfl(r1)
	  mov pcbfl(r0),r1
	  mov r0,pcbbl(r1)
	  >
	else <			; no current process (i.e. creating SYSP)
	  mov r0,pcbfl(r0)	; set forward link to self
	  mov r0,pcbbl(r0)	; set backward link to self
	  bicb #%psstp,pcbsts(r0)	; clear stop bit for SYSP
	  mov r0,trun		; put PCB on runq
	  inc trunql		; increment runq length
	  >
	inc nproc		; increment no. of processes
	peon			; allow preemption again
1$:	jsr r5,rest6		; restore regs
	return

tpidct:	.blkw 1			; counter of processes


; STOPP stops a process.  The process is removed from the run or block
; queue and stopped.

;	ARGS:				VALS:
; SP ->	process id		 SP ->	error code

stopp:	jsr r5,save6		; save regs
	push 16(sp)		; PCBPTR arg: process id
	jsr r5,pcbptr		; get ptr to PCB
	pop r0,16(sp)		; vals: ptr, error code
	bne 1$
	peof			; turn off preemption
	cmp r0,trun		; stop self?
	if eq,<
	  bisb #%psstp,pcbsts(r0)	; set stop bit
	  iot			; call TC
	  br 1$			; we were continued, just return
	  >
	cmpb pcbsts(r0),#%psrun	; running?
	if eq,<
	  jsr r5,rmpq		; remove from run queue
	    trun-.		; relative ptr to runq
	  dec trunql		; decrement runq length
	  >
	cmpb pcbsts(r0),#%psblk	; blocked?
	if eq,<
	  jsr r5,rmpq		; remove from block queue
	    tblock-.		; relative ptr to blockq
	  dec tblkql		; decrement blockq length
	  >
	bisb #%psstp,pcbsts(r0)	; set stop bit
	peon			; allow preemption again
1$:	jsr r5,rest6		; restore regs
	return

rmpq:	mov r5,r1		; pick up relative ptr after call and
	add (r5)+,r1		; make absolute
loop <	  cmp (r1),r0		; this the process?
	  exitl eq
	  mov (r1),r1		; no, next
	  rptl ne
	  crash ^"Process not on queue"
	  >
	mov (r0),(r1)		; remove from queue
	rts r5


; STARTP starts a stopped process running.

;	ARGS:				VALS:
; SP ->	process id		 SP ->	error code

startp:	jsr r5,save6		; save regs
	push 16(sp)		; PCBPTR arg: process id
	jsr r5,pcbptr		; get ptr to PCB
	pop r0,16(sp)		; vals: ptr, error code
	bne 1$
	peof			; turn off preemption
	bitb #%psstp,pcbsts(r0)	; make sure process is actually stopped
	if eq,<
	  lose 0
	  >
	bicb #%psstp,pcbsts(r0)	; clear stop bit
	cmpb pcbsts(r0),#%psrun	; running or blocked?
	if eq,<
	  jsr r5,appq		; append to runq
	    trun-.
	  inc trunql		; increment runq length
	  >
	else <
	  jsr r5,appq		; append to blockq
	    tblock-.
	  inc tblkql		; increment blockq length
	  >
	peon			; allow preemption again
1$:	jsr r5,rest6		; restore regs
	return

appq:	mov r5,r1		; convert relative ptr after call
	add (r5)+,r1		; to absolute ptr
	clr (r0)		; null queue ptr in this PCB
loop <	  mov r1,r2		; search for end of queue
	  mov (r1),r1		; ...
	  rptl ne		; ...
	  >
	mov r0,(r2)		; link onto end of queue
	rts r5


; KILLP kills a process.  The PCB and stack are freed.

;	ARGS:				VALS:
; SP ->	process id		 SP ->	error code

killp:	jsr r5,save6		; save regs
	push 16(sp)		; PCBPTR arg: process id
	jsr r5,pcbptr		; convert id to ptr
	pop r0,16(sp)		; vals: ptr, error code
	bne 1$
	bitb #%psstp,pcbsts(r0)	; process stopped?
	if eq,<
	  mov #%estjb,16(sp)	; no, error
	  br 1$
	  >
	peof			; turn off preemption
	mov pcbbl(r0),r1	; ptr to previous PCB on list
	mov pcbfl(r0),r2	; ptr to next PCB on list
	mov r2,pcbfl(r1)	; link next to previous
	mov r1,pcbbl(r2)	; link previous to next
	peon			; allow preemption again
	push pcbskp(r0)		; FREE arg: ptr
	call free		; free stack
	push r0			; FREE arg: ptr
	call free		; free PCB
	dec nproc		; decrement no. of processes
1$:	jsr r5,rest6		; restore regs
	return


; SETSS sets the size of a process' stack.

;	ARGS:				VALS:
; SP ->	size in words		 SP ->	error code
;	process id

setss:	jsr r5,save6		; save regs
	mov 16(sp),r5		; get desired size
	push 20(sp)		; PCBPTR arg: process id
	jsr r5,pcbptr		; convert process id to PCB ptr
	pop r0,20(sp)		; vals: pcb ptr, error code
	bne 1$
	push r5,#2*60.		; ALOCW args: size, timeout
	call alocw		; allocate new stack
	pop r1,20(sp)		; vals: ptr, error code
	bne 1$
	cmp r0,trun		; setting stack size of current process?
	if ne,<			; no, copy stack
	  mov pcbskp(r0),r2	; ptr to old stack
	  mov r1,r3		; ptr to new stack
	  mov pcbsks(r0),r4	; size
	  cmp r4,r5		; new stack smaller than necessary?
	  if hi,<
	    mov #%eovsk,20(sp)	; stack overflow error
	    br 1$
	    >
  loop <    mov (r2)+,(r3)+	; copy
	    sorl r4
	    >
	  >
	mov pcbskp(r0),r2	; ptr to old stack
	mov r1,pcbskp(r0)	; now use new stack
	mov r5,pcbskm(r0)	; new size
	push r2			; FREE arg: ptr
	call free		; release old stack
1$:	jsr r5,rest6		; restore regs
	pop (sp)		; remove arg from stack
	return


; PCBPTR converts a process id into a PCB ptr.  A process id of 0
; gives a ptr to the current process' PCB.

;	ARGS:				VALS:
; SP ->	process id		 SP ->	PCB ptr
;					error code

pcbptr:	push (sp),r0,r1		; create result slot, save regs
	mov 10(sp),r1		; process id zero?
	if ne,<
	  mov trun,r0		; get a ptr to current process' PCB
	  clr 10(sp)		; no error yet
	  peof			; turn off preemption while scanning ring
  loop <    cmp pcbid(r0),r1	; this the one?
	    exitl eq
	    mov pcbfl(r0),r0	; get next process in ring
	    cmp r0,trun		; back to beginning?
	    rptl ne
	    mov #%ensjb,10(sp)	; PCB id not found
	    >
	  peon			; allow preemption again
	  mov r0,6(sp)		; return ptr to PCB
	  >
	else <
	  mov trun,6(sp)	; PCB ptr for current process
	  clr 10(sp)		; no error
	  >
	pop r1,r0		; restore regs
	return


; GETPID returns the process id of the currently running job.

;	ARGS:				VALS:
;	(none)			 SP ->	process id

getpid:	push (sp),r0		; make slot for return val, save reg
	mov trun,r0		; get ptr to PCB of running process
	mov pcbid(r0),4(sp)	; return process id
	pop r0			; restore reg
	return


; SETUIO sets the user input and user output channels for a process.

;	ARGS:				VALS:
; SP ->	user output ch		 SP ->	error code
;	user input ch
;	process id

setuio:	push r0			; save reg
	push 10(sp)		; PCBPTR arg: process id
	call pcbptr		; convert process id arg to PCB ptr
	pop r0,10(sp)		; vals: PCB ptr, error code
	bne 1$
	mov 6(sp),pcbui(r0)	; set user input channel
	mov 4(sp),pcbuo(r0)	; set user output channel
1$:	pop r0,(sp),(sp)	; restore reg, remove args from stack
	return


; GETUIO returns the user input and user output channels for a process.

;	ARGS:				VALS:
; SP ->	process id		 SP ->	user output channel
;					user input channel
;					error code

getuio:	push (sp),(sp),r0	; save reg, make two return value slots
	push 10(sp)		; PCBPTR arg: process id
	call pcbptr		; convert process id arg to PCB ptr
	pop r0,10(sp)		; vals: PCB ptr, error code
	bne 1$
	mov pcbui(r0),6(sp)	; return user input channel
	mov pcbuo(r0),4(sp)	; return user output channel
1$:	pop r0			; restore reg
	return


; GETUI returns the user input channel for the executing process.

;	ARGS:				VALS:
;	(none)			 SP ->	channel id

getui:	push (sp),r0		; make slot for return value, save reg
	mov trun,r0		; get ptr to executing process' PCB
	mov pcbui(r0),4(sp)	; return user input channel id
	pop r0			; restore reg
	return


; GETUO returns the user output channel for the executing process.

;	ARGS:				VALS:
;	(none)			 SP ->	channel id

getuo:	push (sp),r0		; make slot for return value, save reg
	mov trun,r0		; get ptr to executing process' PCB
	mov pcbuo(r0),4(sp)	; return user output channel id
	pop r0			; restore reg
	return

.sbttl	Storage Allocation


; ALOCW returns a ptr to a block of storage of the requested size.
; If the allocation cannot be made in the specified time the call
; fails.

;	ARGS:				VALS:
; SP ->	timeout			 SP ->	Ptr to block allocated
;	size				error code

alocw:	jsr r5,save6		; save regs
	call uptime		; get current time
	pop r4,r3		; UPTIME vals: hi, lo time
	add 16(sp),r3		; add to low order time
	adc r4			; add to hi order
loop <	  push 20(sp)		; ALLOC arg1: no. of words to alloc
	  call getpid		; ALLOC arg2: caller's id
	  mov fsmctr,r0		; get current value so can wait on it to
				; change if we can't get the memory now
	  call alloc		; try to allocate the memory
	  pop 16+2(sp),20(sp)	; vals: ptr, error code
	  if ne,<
	    push r3,r4		; TSTOT args: time lo, time hi
	    call tstot		; set timeout on next wait
	    push pc		; TWONNE arg1: location to wait on
	    add #fsmctr-.,(sp)	; ...
	    push r0		; TWONNE arg2: value to change from
	    call twonne		; wait on FSMCTR or until timeout time
	    cmp fsmctr,r0	; see if changed
	    rptl ne		; fsmctr changed, indicating someone
	    >			; freed some memory
	  >
	jsr r5,rest6		; restore regs
 	return


; ALOCL returns a ptr to a block of storage of the requested size.
; It uses the standard storage allocator with a timeout of 2 seconds
; and bombs if it can't get the memory.

;	ARGS:				VALS:
; SP ->	size			 SP ->	ptr to block

alocl:	push 2(sp),#2*60.	; ALOCW args: size, timeout
	jsr r5,alocw		; find area
	pop 2+2(sp),*		; pop ptr, test error code
	if ne,<
	  lose %enacr		; couldn't satisfy request
	  >
	return

.sbttl System process
; The system process calls various device initializers and starts
; all the processes contained in PLIST, a list of initial PC's.

sysp:	push #0,#80. 		; SETSS args: process id, size
	call setss 		; set our stack size large
	pop * 			; val: error code
	if ne,<
	  lose 0
	  >

; Call module initialization routines

	call tiinit		; time module
	call ioinit		; init IO module
	call alinit		; asynchronous line module
	call dkinit		; Disk DIM

; Call device initialization routines

	spl 5			; initialize rest of devices at PR5

	call dinit		; initialize KL, DL, DZ
.irp d,	; call RL,RK,RX,LP,DP, and DU initialization
	.lif ne n'd
	call d'init
.endm

	call ttinit		; TTY DIM

	spl 0			; ready for interrupts
	mov #30.,tquant		; set time quantum to avoid immediate
				; preemption
	clr safety		; allow preemption (though nothing else
				; to run yet!)

; Attach each terminal.  Save channel id in TTYCH array.

	mov pc,r2		; ptr to TTYCH
	add #ttych-.,r2		; ...
	clr r1			; starting terminal no. (system console)
loop <	  clr pidtb-ttych(r2)	; clear process id table too
	  clr prqtb-ttych(r2)	; clear process request table too
	  push pc		; ATTACH arg1: device name
	  add #ttyn-.,(sp)	; ...
	  push #0,r1,#%tcniwt	; ATTACH args 2,3 and 4:file name,unit #,cbits
	  call attach		; attach system console
	  pop (r2)+,r0		; vals: channel id, error code
	  if ne,<
	    crash ^"Can't attach TTY"
	    >
	  inc r1		; next TTY no.
	  cmp r1,#ntty		; attached all the TTYs?
	  rptl lo
	  >
	push ttych+0,#%tdclr	; WCHAR args: channel id, character
	call wchar		; clear screen of system console (type CRLF)

; Mount system disk

	push #0			; MOUNT arg: disk no.
	call mount		; prepare file system for use on system disk
	pop r0			; val: error code
	if ne,<
	  push r0		; IOA arg: error code
	  push ttych+0		; IOA arg: channel id
	  call ioac
	    .string ^"Can't mount system disk - ^e
"
	  >
ifMIT	<			; mount the second RL1
.if ne nrl
        clr disk1		; as far as we know the disk is there
	push #1			; MOUNT arg: disk no.
	call mount		; prepare file system for use on system disk
	pop r0			; val: error code
	if ne,<
	  mov pc,disk1		; disk not there
	  push r0		; IOA arg: error code
	  push ttych+0		; IOA arg: channel id
	  call ioac
	    .string ^"Can't mount RL1: - ^e
"
	  >
.endc
	>

; Announce system up

	mov pc,r1		; ptr to TTYCH
	add #ttych-.,r1		; ...
	mov #ntty,r0		; no. of TTY's
ifSAO <
        mov #1,r0		; only do the console terminal
	>
loop <	  push (r1)+		; WRITEC arg: channel id
	  jsr r5,tmsg
	    .string ^"in operation"
	  sorl r0
	  >
	clr sysc		; no shutdown pending!

; Now run down PLIST and create a process for each entry

.if ne  0
	mov pc,r3		; get ptr to plist
	add #plist-.,r3		; ...
loop <	  push (r3)+		; MAKEP arg: next process' initial pc
	  exitl eq		; at end of list, exit loop
	  add r3,(sp)		; make PC absolute (MAKEP arg)
	  call makep		; create this process
	  pop r1,r0		; vals: process id, error code
	  if ne,<
	    push r0		; IOA arg: error code
	    push ttych+0	; IOA arg: channel id
	    call ioac		; type nasty msg
	      .string ^"Can't create process - ^e
"
	    tst (r3)+		; skip over TTY no.
	    rptl
	    >
	  mov (r3)+,r2		; get TTY no.
	  if pl,<
	    asl r2		; times two for wording
	    add pc,r2		; for PICness
	    mov ttych-.(r2),r2	; get channel no. for TTY
	    push r1,r2,r2	; SETUIO args: process id, channel, channel
	    call setuio		; set user input and user output for process
	    pop *		; val: error code
	    if ne,<
	      lose 0		; can't set user i/o values??
	      >
	    >
	  push r1		; STARTP arg: process id
	  call startp		; start the process running
	  pop *			; val: error code
	  if ne,<
	    lose 0		; can't start process??
	    >
	  rptl			; go get next process in list
	  >
	pop *			; pop off 0 from MAKEP loop
.endc

; Wake up every half second and look for ^Z'd terminals.
sysl:	push #30.		; TWFOR arg: 60ths
	call twfor		; wait 1/2 second
	mov #ntty,r2		; no. of terminals to check
	tst sysc		; see if command for us
	bne down		; right now only system shutdown used
	mov pc,r1		; ptr to TTYCH
	add #ttych-.,r1		; ...
loop <	  tst pidtb-ttych(r1)	; already a process using TTY?
	  bne 1$		; yes
	  push (r1)		; RCHAR arg: channel id
	  call rchar		; see if any input
	  pop r0		; val: character
	  cmp r0,#'		; ^Z?
	  bne 1$		; no, try next
	  push pc		; MAKEP arg: initial PC
	  add #cp-.,(sp)	; ...
	  call makep		; create command processor process
	  pop pidtb-ttych(r1),r0	; vals: process id, error code
	  if ne,<
	    push r0		; IOA arg: error code
	    push (r1)		; IOA arg: channel id
	    call ioac		; explain we're losing
	      .string ^"Can't create process - ^e
"
	    br 1$
	    >
	  push (r1),#3,#%tcniwt	; ORDER arg: channel id, order code, order arg
	  call order		; turn off no input wait bit
	  pop *			; val: order value
	  push pidtb-ttych(r1)	; SETUIO arg: process id
	  push (r1),(r1)	; SETUIO args: user input, user output
	  call setuio		; set user input and output for process
	  pop *			; val: error code
	  if ne,<
	    lose 0		; can't set user input and output??
	    >
	  push pidtb-ttych(r1)	; STARTP arg: process id
	  call startp		; start the process we just created
	  pop *			; val: error code
	  if ne,<
	    lose 0		; can't start process??
	    >
1$:	  tst prqtb-ttych(r1)	; see if there is another service we
				; can perform for the process
	  if lt,<		; negative means the process wants to die
	    push pidtb-ttych(r1),(sp)	; get process ID twice
	    call stopp		; stop the process
	    pop *
	    call killp		; and kill it
	    pop *		; errors? should crash perhaps?
	    clr prqtb-ttych(r1)
	    clr pidtb-ttych(r1)
	    push (r1),#2,#%tcniwt	; ORDER arg: channel id, order code,
					; order arg 
	    call order		; turn on no input wait bit
	    pop *		; val: order value
	    push (r1)		; WRITEC arg: channel id
	    jsr r5,writec	; type an extra CRLF to confirm kill
	     .string ^"
"
	    >
	  tst (r1)+		; move to next TTY
	  dec r2		; too far for SOB
	  rptl ne
	  >
	br sysl


; Announce system down
down:
ifSAO <				; just print out shutting down messages
      >				; for SAO's machine
ifMIT <				; for any other system, loop
				; sending shutting down messages every
				; minute
	mov sysc,r5		; get number of minutes before shutdown
	dec r5			; make it 1 less minute (so immediate
				; shutdown is possible
	clr r4			; haven't waited anytime yet
loop <    tst sysc		; see if someone doesn't want the system down
	  beq 1$		; if 0 then keep system up
	  mov #ntty,r0		; number of TTY's
ifSAO <
          mov #1,r0		; only do console terminal
       >
	  mov pc,r1		; pointer to TTYCH
	  add #ttych-.,r1	; ....
  loop <    push r5		; IOAC arg: total number of minutes
	    sub r4,(sp)		; make it time remaining
	    push #tvn		; IOAC arg: our version number
	    push (r1)+		; IOAC arg: channel id
	    jsr r5,ioac		; print out shutdown message on terminal
.if eq sysexp
	    .string ^"TRANTOR ^d shutting down in ^d minutes.
"
.endc
.else
            .string ^"TRANTOR ^dX shutting down in ^d minutes.
"
.endc
            sorl r0		; done all NTTY yet?
	    >
	  tst sysc		; see if system not wanted down
	  beq 1$		; if 0 then keep system up
	  cmp r4,r5		; reached time to shutdown yet
	  exitl ge		; yes if R4 greater than R5
	  inc r4		; inc r4 by 1 minute
	  mov #60.,r0		; number of seconds to wait in the following
  loop <    push #60.		; TWFOR arg: 60th's to wait (1 second)
	    call twfor		; wait a minute
	    tst sysc		; stayup??
	    beq 1$		; if 0 then stayup
	    sorl r0		; else repeat
	    >
	  rptl
	  >
      >
	mov pc,r1		; ptr to TTYCH
	add #ttych-.,r1		; ...
	mov #ntty,r0		; no. of TTY's
ifSAO <
        mov #1,r0		; only tell the system console
       >
loop <	  mov pidtb-ttych(r1),r2	; get process id
	  if ne,<
	    push r2		; STOPP arg: process id
	    call stopp		; stop the process
	    pop *		; val: error code
	    push r2		; KILLP arg: process id
	    call killp		; kill the process
	    pop *		; val: error code
	    >
	  push (r1)+		; WRITEC arg: channel id
	  jsr r5,tmsg
	    .string ^"not in operation"
	  sorl r0
	  >
ifMIT <
	push #3*60.		; TWFOR arg: 60ths to wait
	call twfor		; wait for not in operation messages
       >
ifSAO <
        mov savnxm,@#4
	mov savnxm+2,@#6
      >
	.exit

; jump here to tell the users that system is staying up.
1$:    mov pc,r1		; ptr to TTYCH
       add #ttych-.,r1		; ....
       mov #ntty,r0		; get number of TTY's
loop <   push (r1)+		; WRITEC arg: channel id
         jsr r5,tmsg		; print message saying system staying up
	 .string ^"staying up"
	 sorl r0
	 >
       jmp sysl			; restart the system loop

; TMSG is used by the system process to send a clear screen, "Trantor nnn",
; some message, and finally the current time to a console.

;	ARGS:				VALS:
; SP ->	channel id			(none)

tmsg:	push 2(sp),#%tdclr	; WCHAR args: channel id, character
	call wchar		; clear screen
	push r5			; IOA arg: asciz ptr (taken from relative
	add (r5)+,(sp)		; ptr after call).
	push #tvn		; IOA arg: trantor version no.
	push 2+4(sp)		; IOAC arg: channel id
	call ioac		; print system up message

.lif eq sysexp
	  .string ^"Trantor ^d ^a  "
.lelse
          .string ^"Trantor ^dX ^a  "

	tst timsts		; time known?
	if ne,<			; yes
	  push 2(sp)			; PTIME arg: channel id
	  push #%pttime+%ptdate+%ptslsh	; PTIME arg: control bits
	  call time		; PTIME args: time hi, time lo
	  call ptime		; print current time
	  >
	push 2(sp)		; WRITEC arg: channel id
	call writec		; finish time with CRLF
	  .string ^"
"
	pop (sp)		; remove arg from stack
	rts r5


; SYSMSG is used to call IOAC with output going to the console terminal.
sysmsg: push #8			; number of ^G's to send
  loop <  push ttych+0,#%tdbel	; WCHAR args: channel id, character
	  call wchar		; send a bell
	  dec (sp)		; done??
	  rptl ne		; nope...
	  >
	pop *			; remove count
	push (sp)		; make room for channel id arg to IOAC
	mov ttych+0,2(sp)	; IOAC arg: channel id
	jmp ioac		; print msg on system console


; The following is a list of processes to start up at system
; initialization.  Each entry is an initial PC and TTY #.

plist:	.word 0			; terminator

.sbttl	Error codes and messages

.macro	error ec,emsg
nerrc==nerrc+1
ec==nerrc
	.string ^"emsg"
.endm
nerrc==0

errtab:	error %ebdda,^"Data not valid"
	error %ebdio,^"Illegal I/O operation"
	error %ebdoc,^"Bad ORDER code"
	error %ebdsc,^"Bad software TTY code"
	error %eemq,^"Empty queue"
	error %eenfi,^"End of file"
	error %efldv,^"Device full"
	error %eflq,^"Full queue"
	error %ehgdv,^"Device hung"
	error %enach,^"No channels available"
	error %enacr,^"No core available"
	error %enadv,^"Device not available"
	error %entty,^"Terminal not available"
	error %enafi,^"File locked"
	error %ensch,^"Non-existant channel"
	error %ensdi,^"No such directory"
	error %ensdv,^"No such device"
	error %ensfl,^"File not found"
	error %ensjb,^"Non-existant job"
	error %eovsk,^"Stack overflow"
	error %estjb,^"Job must be stopped"
	error %eunsk,^"Stack underflow"
	error %eivfl,^"Invalid filename"
	error %enone,^"Unknown error code"

; ERRMSG returns a ptr to an asciz error message given the error code.

;	ARGS:				VALS:

; SP ->	error code		 SP ->	ptr to asciz message

errmsg:	push r1			; save reg
	mov 4(sp),r1		; get error code
	dec r1			; make zero based
	cmp r1,#nerrc		; valid error code?
	if his,<
           push r1		; IOA arg: unknown error code
	   call sysmsg		; print error code on the System TTY
	   .string ^"Unknown Error Code = ^o
"
           mov #%enone-1,r1	; make error code unknown error code
	  >
	asl r1			; times two for wording
	add pc,r1		; PICally add ptr to table to index
	add #errtab-.,r1	; ...
	add (r1),r1		; add table entry to entry ptr to get
				; absolute ptr to error message
	mov r1,4(sp)		; return ptr to error message
	pop r1			; restore reg
	return

.sbttl	External modules

; Insert other modules for assembly (someday may assemble separately).

	.insrt pdp11;io

	.insrt pdp11;ioa

	.insrt pdp11;aline

.lif ne  asmcdc
	.insrt pdp11;sline

	.insrt pdp11;tty

.if ne  asmtek
	.insrt pdp11;tek

;;;	.insrt pdp11;memplt

;;;	.insrt pdp11;sol
.endc

.lif ne  nlp
	.insrt pdp11;lpt

	.insrt pdp11;disk

	.insrt pdp11;cp

	.insrt pdp11;spinwr

.lif ne  asmcns
	.insrt pdp11;consol

.lif ne  asmtrl
	.insrt pdp11;trollr

.lif ne  asmcdc
	.insrt pdp11;nu200

disk1:	.word 1			; zero if disk 1 is there
nobnrd: .blkw 1			; number of blocks not read from the disk
notbmp: .blkw 1			; no. of times bit-map was written out
nproc:	.blkw 1			; active process count
sysc:	.blkw 1			; system communication word
tekuse:	.word 0			; non-zero if plotter in use
ttych:	.blkw ntty		; channel ids of TTYs
pidtb:	.blkw ntty		; process ids of console controlled trees
prqtb:	.blkw ntty		; process request table

litrl:	constants		; leave room for .litrl and .string
				; constants

subrl:	linkb			; table of links to be snapped
				; (created by CALL macro)

last=.
.end go
ð
CBF@MIT-MC 05/07/79 08:14:03
To: (BUG TRANTOR) at MIT-MC
Its silly to do real things with minicomputers.

JRAT@MIT-MC 03/23/79 13:40:33
To: (BUG TRANTOR) at MIT-MC
     Dear Charles:
        It would be pleasant if the full tektronix plotting
     Things could be implemented.  You'll find the proper
     character writing codes in EAK; as they will be implemented
     at Ncar.   
						Jrat

CBF@MIT-MC 03/23/79 06:51:25 Re: Tektronix
To: (BUG TRANTOR) at MIT-MC
1) Seems to overrun its buffer.
2) Does not time out properly when Tektronix is put in a state such that
it does not respond.
3) The command should be interruptable and abortable.



CBF@MIT-MC 03/22/79 08:38:39 Re: New stty command
To: (BUG TRANTOR) at MIT-MC

stty tty N,Termtype,No Flag, Param Value ....

there are 3 types of items in the arguments to stty:

TFlag name,offset,mask
ie.   tflag "Backspace",topt,%tobs

TParam name,offset
ie.   TParam "Height",topt

TTYtyp name,value
ie.   TTYtyp "stupidbee",%tnsb

The actual table generated by these macros will look like:
       pointer to asciz string
       offset into TTY structure
       mask for flag (-1 to show whole word for Tflag, 0 for TTYtyp)
       constant (a random constant for those things that need it, ie. ttytyp)

The table should all be sequential, the last entry will be followed by
a zero word (there should never be a 0 pointer to asciz string obviously).

There will need to be a TTYOPT flag called "initialize" or something to
control whether the initiliazation sequence is done.

In addition to these entries there is an equivalence table which is also
searched which points to character string abbreviations.  Most of the
terminal types can set their other paramters like screen size this
way.  Ie.
     Tabbrev "hp2645","%tnhp,height 24,width 79"
Note there should be no recursive references since each item will be
looked up itself for abbreviations.

As these items are parsed a prototype TTY structure will be built up.
When the entire command is finished if there were no errors it will
be copied over.  Prior to the copying however, the speed variables will
be checked to see if they have changed.  If they have calls will be
executed to change the speed of the lines.  Also, the initial string
flag will be checked.  If it was set, an initialization sequence will
be sent to the terminal if there is one.

A ptty command  should be created to work off of this database.  Unfortunately,
it may print the obscure name for ttytyp instead of the obvious one.
We need a kludge here.

ð3
The structure of Asynchronous LINEs and TTY need to be changed to
be more efficient.

Memory Management needs to be implemented.

A CHAOS NCP needs to be written and incorporated into TRANTOR
after memory management is done.

DSK: PDP11; TRANTR >
01536,PALX
tvn=¶6
stack=¶692
go:¶749
go1:¶842
go2:¶913
memtop:¹226
catchn:¹442
nxmt:¹563
nxmcat=¹663
pat:¹712
powerf:±0026
poweru:±0352
pwrsp:±0803
npwrf:±0868
pcbfl:±2093
pcbbl:±2141
pcbid:±2190
pcbsts:±2223
pcbloc:±2259
pcbval:±2300
pcbwt:±2338
pcbtl:±2385
pcbth:±2421
pcbskp:±2473
pcbskm:±2527
pcbsks:±2583
pcbsup:±2615
pcbui:±2658
pcbuo:±2698
pskps=±2797
pskpc=±2841
%psblk=±2907
%psrun=±2929
%psstp=±2951
tc:±3397
tcloop:±4918
t0:±5932
t1:±6004
t2:±6076
t3:±6148
t4:±6220
toff:±6363
tub:±6663
tpeon:±8256
tunsp:±8677
trunql:±8725
tblkql:±8771
tccnt:±8818
tpwake:±8866
trun:±8908
tblock:±8946
intflg:±8990
safety:±9042
tquant:±9095
timout:±9145
preemc:±9206
savnxm:±9257
rugsta:±9328
istswr:±9393
twfor:²0354
twtil:²0782
tstot:²1236
twonne:²1613
twonhi:²1968
twonbn:²2313
twonbe:²2659
twoneq:²3013
twon:²3300
await:²4094
makep:²4815
tpidct:²6658
stopp:²6858
rmpq:²7668
startp:²8049
appq:²8711
killp:²9104
setss:²9940
pcbptr:³1110
getpid:³1895
setuio:³2252
getuio:³2782
getui:³3254
getuo:³3577
alocw:³4049
alocl:³5230
sysp:³5584
sysl:³9479
down:´1730
tmsg:´4598
sysmsg:´5457
plist:´5939
nerrc=´6030
ec=´6043
nerrc=´6082
errtab:´6095
errmsg:´7081
disk1:´8266
nobnrd:´8311
notbmp:´8372
nproc:´8429
sysc:´8469
tekuse:´8516
ttych:´8563
pidtb:´8605
prqtb:´8667
litrl:´8713
subrl:´8787
last=´8866

DSK: PDP11; DEFS >
00821,PALX
yes=±42
no=±50
mit=³91
sao=´21
lll=´51
mit44=´62
drl=´98
drk=µ34
drp=µ70
r0=´666
r1=´673
r2=´680
r3=´687
r4=´694
r5=´701
sp=´708
pc=´715
swr=µ098
ps=µ156
pr0=µ361
pr1=µ405
pr2=µ415
pr3=µ425
pr4=µ435
pr5=µ445
pr6=µ455
pr7=µ465
lks=µ496
tks=µ525
tkb=µ563
tps=µ576
tpb=µ589
rkdsr=µ619
rkerr=µ657
rkcsr=µ672
rkwcr=µ687
rkbar=µ702
rkdar=µ717
rlcsr=µ753
rlbar=µ791
rldar=µ806
rlmpr=µ821
rpcou1=µ858
rpcou2=µ874
rpcou3=µ890
rpcou4=µ906
rpdsr=µ921
rperr=µ936
rpcsr=µ951
rpwcr=µ966
rpbar=µ981
rpcar=µ996
rpdar=¶011
rpm1r=¶026
rpm2r=¶041
rpm3r=¶056
rpsucr=¶072
rpsilo=¶088
rxcs=¶124
rxdb=¶177
lps=¶248
lpb=¶261
lvs=¶274
lvb=¶287
%.m=·921
ifcnt=±1142
gncnt=±1332

DSK: PDP11; STUFF >
00198,PALX
stvn=µ3
save6:²72
rest6:µ93
mul1:±073
mul2:±980
div2:³089
dmul:³871
ddiv:´955
ddiv10:µ508
ddiv24:µ788
ddiv60:¶064
bits:¶260
dzlpar:¶867

DSK: PDP11; FSM >
00256,PALX
fsinit:²040
alloc:´385
free:·794
fssort:±1346
fslist:±2498
fslo:±2615
fshi:±2661
fssize:±2726
fsata:±2772
fsatr:±2824
fsac:±2860
fsflen:±2919
fsasl:±2958
fsarc:±3021
fsft:±3065
fsmctr:±3116

DSK: PDP11; TIME >
00402,PALX
tiinit:´41
timint:¹56
timut:±620
timsts:±648
timst:±696
tgmt:±726
uptime:±939
time:²346
timset:³124
cvbtd:´438
timmot:¶576
cvdtb:¶882
tindmt:¸574
ptime:¸817
%pttime=±1433
%ptsecs=±1466
%pt24hr=±1496
%ptdate=±1536
%ptslsh=±1570
%ptday=±1601
%ptzone=±1636
ampm:±1669
daynam:±1714
moname:±1871
cvbtf:±2256
cvftb:±3393

DSK: PDP11; IO >
00745,PALX
ioatt:²98
iodet:³39
ioordr:³81
ioread:´21
iowrit:´60
iodel:´99
ioren:µ40
iopeek:µ82
%icrea=¹78
%iupd=±037
ioinit:±283
readl:±811
rubout:µ170
chbits:¶091
%print=¶423
%alpha=¶461
%numer=¶506
chtbl:¶541
posit:·222
delete:·885
rename:¸479
attach:¹646
detach:±1385
rchar:±2009
readn:±2626
pchar:±3417
wchar:±3899
writec:±4307
writez:±4692
writen:±5319
order:±6067
iodev:±7027
iod:±7688
dnames:±8048
dskn:±8139
lptn:±8160
ttyn:±8180
bufn:±8200
dptrs:±8407
iocall:±9063
io1:±9302
iorest:±9624
chltab:±9667
ddwtab:±9710
dimtab:±9769
nioch:±9827
buf:±9896
bufatt:±9966
bufdet:²0107
bufr:²0148
bufw:²0338
bufbad:²0530

DSK: PDP11; IOA >
00319,PALX
ioacs:·65
ioach:¸12
lioab=¸57
ioabuf:¸93
ioac:±134
ioa:±396
ioal:±802
ioau:²749
ioa.u:³702
ioa.e:³811
ioa.a:³950
ioa.z:´172
ioa.d:´257
ioa.d1:´307
ioa.ud:´703
ioa.uo:µ326
ioa.o:µ409
ioa.o1:µ459
ioa.r:¶032
ioa.r1:¶390
r50asc:¶630
ioapad:¶740

DSK: PDP11; ALINE >
00631,PALX
qsize:±650
qbp:±689
qfp:±735
qrp:±775
qcc:±814
aldres:±947
almode:±997
alib:²063
aliq:²118
aloq:²151
%alxon=²201
%alstp=²304
altab:²666
altabp:³164
klno=³268
dlno=³277
dzno=³293
dinit:³389
dpwru:´141
vecset:µ970
alinit:¶385
alrebf:·584
alsmod:¹438
algmod:¹841
alread:±0329
alpeek:±1200
alwrit:±2004
alwriz:±2943
dzrint:±3396
dzric:±4065
dzrcc:±4118
dzxint:±4215
dzxic:±4782
dzxcc:±4835
dlrint:±5014
dlxint:±5538
alrint:±5934
alxint:±8202
qinit:±9011
roomq:±9533
insq:±9913
remw:²0727
remq:²1661
peekq:²2453

DSK: PDP11; SLINE >
00237,PALX
dpinit:±51
dppwru:³78
dpcsr:¸12
dpdtp:¸30
duinit:¹69
dupwru:±196
ducsr:±603
dudtp:±621
synasn:±911
syndea:²942
durint:´040
duxint:µ483
dprint:µ929
dpxint:¶545
dpuret:·238

DSK: PDP11; TTY >
02956,PALX
tty:·8
tcosw:²13
tcbits:²73
tcwtop:³35
tcwlen:³89
tcwvp:´26
tcwhp:´72
%tcio=µ49
%tcniwt=µ77
%tcnctn=¶13
tctyp:¶79
tlinen:·20
thmax:·70
tvmax:¸12
topt:¸53
thpos:¸95
tvpos:¹43
tthpos:¹90
ttvpos:±034
ispeed:±078
ospeed:±118
tbreak:±159
tmoren:±217
%tocro=±873
%toers=±934
%toovr=±991
%todis=²040
%toabs=²095
%tobs=²139
%toesc=²178
%tomor=²224
%tnech=²260
%tnxon=²312
%tnetx=²367
%tansi=²431
%tdnop=²513
%tdhom=²543
%tdhmv=²588
%tdvmv=²633
%tdmov=²676
%tdclr=²731
%tders=²761
%tdeol=²794
%tdeos=²832
%tdso0=²872
%tdso1=²914
%tdso2=²958
%tdso3=³007
%tdbel=³065
%tdff=³091
ntty=³219
%%temp=³244
ntty=³274
ttab:³353
ttab:´365
ttinit:´953
ttint:µ297
tatt:µ614
tdet:¶160
torder:¶271
to0:¶533
tordr:¶810
tords:¶869
tno:¶998
ti:·192
tipeek:·751
to:¸389
to1:¸606
to2:¹036
to3:¹404
totab:¹629
tosp:¹776
tochr:¹932
toc1:±0242
toc2:±0730
toc3:±1395
tolf:±1586
tomore:±1995
ttylf:±3306
tonxt:±4096
tdtab:±4199
tdnop:±5080
tdhom:±5134
tdvmv:±5337
tdmov:±5448
tdhmv:±5559
tdmv1:±5608
tupd:±5765
tders:±5922
tdeol:±6151
tdclr:±6252
tdeos:±6364
tdso0:±6472
tdso1:±6587
tdso2:±6707
tdso3:±6832
tdbel:±6930
tdff:±7031
ttynop:±7163
ttyin=±7180
ttyout=±7197
ttyeol=±7214
ttyeos=±7231
ttyso0=±7248
ttyso1=±7265
ttyso2=±7282
ttyso3=±7299
ttyff=±7315
ttyini:±7348
ttyers:±7490
ttybel:±7536
ttymov:±7596
vtin=±8335
vtout=±8350
vters=±8366
vtso0=±8382
vtso1=±8398
vtso2=±8414
vtso3=±8430
vtbel=±8446
vtini:±8478
vteol:±8694
vteos:±8752
vtff=±8783
vtmov:±8819
termov:±9954
vt1in=²3012
vt1ers=²3028
vt1bel=²3045
vt1ini:²3231
vt1out=²4464
vt1eol=²4506
vt1eos=²4550
vt1ff=²4567
vt1mov=²4605
vt1so0=²4651
vt1so1=²4699
vt1so2=²4752
vt1so3=²4814
vt1fll:²4834
cvd1:²5085
cvd2:²5168
hpers=²5403
hpeol=²5419
hpeos=²5434
hpbel=²5449
hpff=²5464
hpini:²5495
hpout=²5603
hpin:²5636
hpso0:²5850
hpso1:²5914
hpso2:²5983
hpso3:²6089
hpmov:²6172
sbini=²6848
sbout=²6863
sbers=²6879
sbeol=²6895
sbeos=²6910
sbbel=²6925
sbff=²6940
sbin:²6975
sbso0:²7332
sbso1:²7395
sbso2:²7496
sbso3:²7606
sbmov:²7693
trmini=²8204
trmin=²8220
trmout=²8236
trmers=²8253
trmeol=²8270
trmeos=²8287
trmso0=²8304
trmso1=²8321
trmso2=²8338
trmso3=²8355
trmbel=²8372
trmmov=²8389
trmff=²8405
la1in=²8455
la1out=²8472
la1eol=²8489
la1so0=²8506
la1so1=²8523
la1so2=²8540
la1so3=²8557
la1ini=²8574
la1ers=²8591
la1bel=²8608
la1mov=²8625
la1eos=²8642
la1ff:²8660
la8in=²8810
la8out=²8827
la8eol=²8844
la8so0=²8861
la8so1=²8878
la8so2=²8895
la8so3=²8912
la8ini=²8929
la8ers=²8946
la8bel=²8963
la8mov=²8980
la8eos=²8997
la8ff=²9013
toisc:²9103
tois:²9320
toi:²9616
tsendn:³0051

DSK: PDP11; TEK >
00507,PALX
tekrot:´31
teksiz:¸57
tekstr:±331
tekasc:±786
teklin:²137
tekmov:³193
tekdrw:³715
gsw:¶558
tekx:¶605
teky:¶642
hiy:¶678
xloy:¶694
loy:¶709
hix:¶724
lox:¶739
ohiy:¶762
oxloy:¶779
oloy:¶795
ohix:¶811
olox:¶827
teko:¶952
teklno=·154
ltekb=·188
tekbeg:·343
tekend:¸029
tekbb:¸411
teksb:¸870
tekrst:±0814
teknum:±1601
teksw:±2032
tekbuf:±2086
tekcnt:±2132
tekbp:±2180
tkrot:±2226
tksizx:±2276
tksizy:±2325

DSK: PDP11; MEMPLT >
00108,PALX
x0=´7
y0=µ6
x1=¶7
y1=·8
memplt:¹7
mpaddr:´520
mplax:µ183

DSK: PDP11; LPT >
00638,PALX
nvpts=¸9
lpt:²34
lpinit:³41
lppwru:³88
lpbusy:µ51
lhpos:·42
lvpos:·91
lbuf:¸37
lplmp:¸92
lplmc:¹42
lsemfl:¹93
vpc:±026
vr1:±064
vvpos:±104
vlasty:±152
vfree:±218
vlist:±259
vlstb:±312
spplin:±384
vbuf:±441
latt:±529
ldet:²099
lno:²384
lorder:²464
lwrite:²749
lplmsg:´241
lpout:´356
lprdy:´786
lvgo:µ432
lplot:µ684
lpct:¶381
vy1:·032
vy2:·067
vmlo:·127
vxlo:·176
vmhi:·225
vxhi:·272
vlastx:·321
vdash:·374
vgo:·421
vline:·826
vnext:·935
vproc:¸204
vhoriz:¹425
vpast:±0617
vplot:±0907
lvrdy:±2234
vstuff:±2573

DSK: PDP11; DISK >
02927,PALX
dkvn=´3
lblk=·4
nsecto=±23
ntrack=±65
mfdb=²05
bm1b=²19
nbm=²32
lstblk=²70
lblk=³06
nsecto=³55
ntrack=³97
mfdb=´36
bm1b=´49
nbm=´61
lstblk=´98
lblk=µ33
nsecto=µ82
ntrack=¶24
mfdb=¶62
bm1b=¶71
nbm=¶79
lstblk=·16
lblk=·51
nsecto=¸00
ntrack=¸42
mfdb=¸81
bm1b=¹23
nbm=¹59
lstblk=¹95
dufiln:±121
dudate:±164
dubytc:±219
dustart:±267
dulen:±309
duend:±356
duprot:±406
duuse:±442
disk:±522
dnull:±639
dctrlb:±705
ddskno:±751
ddirbp:±789
ddirep:±830
dfilbp:±871
dfilbn:±915
dfilps:±978
dkinit:²107
datt:²406
dabad4:³987
dac:´060
dabad1:¶419
dabad2:¶545
dabad3:¶655
dorder:¶764
ddet:¶881
drfus:¸183
dwrite:¸337
dread:±0071
ddel:±1415
dren:±2375
mount:±2947
dmfbp:±6094
dmfcnt:±6130
dufbn:±6183
dsktst:±6253
dsktst:±6334
dsktst:±6414
dsktst:±6494
dlook:±6723
duiclk:±7986
ddf:±9184
dgnext:²1163
dalloc:²1891
dbmtab:²4433
dfree:²4615
dgbm:²4829
drbm:²5214
dubm:²6242
dcrbm:²6700
dbmp:²6741
dbmno:²6789
ddno:²6895
dblk:²6924
duse:²6954
dwtf:²6986
dbll:²7017
dgetb:²7259
dgb1:²8550
drelb:²9236
dblist:³0730
dkread:³0914
dkread:³1038
dkread:³1153
dkread:³1278
dkwrit:³1524
dkwrit:³1639
dkwrit:³1754
dkwrit:³1876
rkopt:³2435
rkfcn1:³2469
rkecnt:³2535
rkerrw:³2582
rkfini:³2623
rkda:³2785
rkba:³2818
rkwc:³2850
rkfcn:³2882
%rkwch=³2958
rkinit:³3062
rkpwru:³3500
rkrw:³3907
rkreq:³5881
rkint:³7194
rksint:³7644
rknext:³7766
rkidle:³8026
rkrerr:³8330
rkgo:³8507
rkdone:³9965
rkrst:´0176
rkrq:´0720
rksw:´0793
rkrdc:´0847
rkwtc:´0885
rkerrc:´0925
rkereg:´0965
rpopt:´1469
rpfcn1:´1503
rpecnt:´1569
rperrw:´1616
rpfini:´1657
rpda:´1819
rpba:´1852
rpwc:´1884
rpfcn:´1916
%rpwch=´1992
rpinit:´2096
rppwru:´2534
rprw:´2941
rpreq:´4915
rpint:´6228
rpsint:´6678
rpnext:´6800
rpidle:´7060
rprerr:´7364
rpgo:´7541
rpdone:´8999
rprst:´9210
rptest:´9756
rprq:µ0314
rpsw:µ0387
rprdc:µ0441
rpwtc:µ0479
rperrc:µ0519
rpereg:µ0559
rxfini:µ1098
rxerc:µ1153
rxadd:µ1185
rxwtf:µ1234
rxcmnd:µ1276
rxtrac:µ1305
rxsect:µ1340
rxinit:µ1487
rxpwru:µ1998
rxrw:µ2309
rxreq:µ4008
rxint:µ5007
rxnext:µ5288
rxidle:µ5497
rxgo:µ5619
rxrow:µ6385
rxdone:µ8676
rxtest:µ8806
rxrq:µ8836
rxsw:µ8902
rxrdc:µ8943
rxwtc:µ8976
rxerr:µ9010
rxperr:µ9068
rxcerr:µ9124
rxserr:µ9163
rlopt:µ9656
rlcs1:µ9689
rlecnt:µ9756
rlerrw:µ9803
rlfini:µ9844
rlmp:¶0005
rlda:¶0048
rlba:¶0090
rlcs:¶0131
%rlwch=¶0222
rlinit:¶0314
rlpwru:¶0921
rlrw:¶1267
rlreq:¶3367
rlint:¶4680
rlnext:¶5003
rlidle:¶5263
rlrerr:¶5567
rlgo:¶5744
rldone:¶8561
rlrst:¶8775
rlrst1:¶8834
rltest:¶9199
rlrq:¶9757
rlsw:¶9830
rlrdc:¶9884
rlwtc:¶9922
rlerrc:¶9962
rlereg:·0002

DSK: PDP11; CP >
01398,PALX
uich:µ7
uoch:¹7
cbsize:±40
cendp:±73
cbufp:²20
lcmdb=²82
cbuf:³24
errflg:³66
uname:´08
ready:´48
diskno:´95
diskn1:µ41
filep:µ82
filnam:¶42
cp:¹31
cploop:²455
eeam:µ174
comerr:µ264
cplist:µ509
cpls1:¶074
rug:·216
login:·319
logout:¹266
messag:±0611
msgfil:±1180
shutdn:±1304
nshtdn:±1698
help:±1805
flowon:±2245
flowof:±2582
flow:±2847
getlnn:±3043
cmoron:±3522
cmorof:±3602
clistc:±3648
listc:±3820
pstime:±5133
pstim1:±5172
dyofwk:±7170
systat:±7271
stty:²3138
ttylst:²4959
moroff:²6124
moron:²6551
lu:²7027
lall:²8318
uic:²9334
ld:²9641
ld1:²9997
cd:³3094
dd:³6079
print:³8159
tpl:³8859
gettpl:³9917
tplsys:´0248
tplld:´0736
tpllu:´1194
tplla:´1644
frmfed:´2145
dfp:´2510
df:´3404
ren:´4795
move:´5236
copy:´5323
copy1:´5381
twofil:´6877
procpr:´7527
memlst:´8356
teksnd:´9754
tekplt:µ1920
tkplt1:µ2367
tploop:µ3781
tpen3:µ4786
tplm:µ4850
tpld:µ5129
tpsm:µ5414
tpsd:µ5986
tpac:µ6577
tpen1:µ6906
tpen2:µ6989
tekerr:µ7080
pltstr:µ7097
tpg2:µ7217
tpgetc:µ7499
lstx:µ8158
lsty:µ8190
quit:µ8286
crlf:µ8947
xfrchn:µ9285
rdcmdl:µ9905
rdcmdc:¶0479
rrcmdc:¶0925
arg:¶1173
sarg:¶1579
octarg:¶2243
numarg:¶2534
ncomn:¶2661
cvr50:¶3304
cvr1:¶3798
filarg:¶4763
scase:¶6217

DSK: PDP11; SPINWR >
00218,PALX
sptype:³94
spinpr:±389
printp:µ899
sendch:¶439
%bold=·442
%under=·481
%space=·522
%pfont=·564
%rfont=·615
%udral=·675
%dspce=·725
spbksl:·776
sendsp:±7583

DSK: PDP11; CONSOL >
00689,PALX
cheigh:¹1
cline:±25
cipid:±71
copid:²09
cichar:²49
cimage:³00
cvpos:³44
chpos:³93
ctopt:´40
cofch:´84
cifch:µ28
cwait:µ71
cwtchr:¶36
ceschr:¶90
ccecho:¸10
consol:¸81
cr4:²686
consi:²729
ccp:³239
ccerr:µ057
cclist:µ168
cccCR:µ708
cccCHR:µ767
csmart:µ833
cdumb:µ929
ccwait:¶027
cecho:¶137
cnecho:¶175
csend:¶209
clpt:¸331
ccerr1:¸509
crecve:¸616
cclse:¹083
clink:¹114
cbadlk:±0067
ctotty:±0263
cques:±0657
csic:±0877
ccdone:±1036
cfree:±1619
cexit:±2141
cdisp:±3056
culink:±4369
cbufrt:±4714
cposit:±5009
conso:±5709
coloop:±6064
cclose:±6541
crfiln:±6726

DSK: PDP11; TROLLR >
01625,PALX
trvn=´5
trerd:±45
evmax:²00
ehmax:²47
evpos:²96
ehpos:³43
ellen:³92
height:´42
pagep:´82
pagee:µ15
lpage=µ69
page:µ82
l..k=¶89
..K:·01
ioflg:·77
rdflg:¸73
wtflg:¹32
iofile:¹95
drch:±039
dwch:±077
curptr:±121
curend:±175
edmarg:±224
edmark:±272
edmlsv:±308
schar:±357
tablst:±396
tpagen:±441
prsflg:±493
rdispy:±545
ecpflg:±604
overwr:±660
coverw:±724
trollr:±870
comm:³781
tclist:µ395
tru200:¶465
exit:¶629
trexit:¶761
tlistc:·522
news:·772
info:·840
ird:·882
read:¸013
rea1:¸220
write:¸442
tefao:¸833
clsrd:¸907
clswt:¹114
close:¹333
clset:¹379
rdcls:¹894
wtcls:±0093
rp:±0325
rpno:±0593
wp:±0658
nxtpag:±0805
rdpage:±1359
wtpage:±2478
edlpt:±2810
peruse:±3220
cap:±3465
ovrwrt:±3583
novrwt:±3649
tabset:±3736
clear:±4188
display:±4320
cmline:±4570
edit:±5100
edloop:±5194
edpval:±5240
edmjt:±5934
insert:±6711
ichar:±6809
del:±7782
smark:±8079
ctrla:±8168
ctrlb:±8286
ctrld:±8486
ctrle:±8757
ctrlf:±8878
ctrlg:±9069
ctrlg1:±9111
ctrli:±9251
ctrlk:±9740
ctrll:²0492
ctrlm:²0807
icrlf:²0824
ctrln:²1210
ctrlo:²1540
ctrlp:²1639
ctrlq:²1925
ctrlr:²2072
ctrls:²2620
ctrlu:²3066
ctrlv:²3574
ctrlw:²3847
ctrlx:²4711
ctrly:²4937
ctrlz:²5289
darg:²5477
bol:²6188
eol:²6804
eposit:²7563
ecsize:²8247
emline:²9085
edownn:³0091
eupn:³1026
disres:³1594
dislin:³1870
opnrd:³3030
opnwt:³3478
peekc:³4092
readc:³4479
typsc:³4840
typc:³5071
hlpfil:³5236
newfil:³5293

DSK: PDP11; NU200 >
01692,PALX
u2vn=´9
usom=±07
ueom=±39
usit=±69
urea=±94
uack=²14
urej=²41
uerr=²63
uesc=²84
ue1=³10
ue2=³27
ue3=³44
utrmln:´49
udpfl:´99
ucsra:µ36
usts:µ77
ursw:¶09
ussw:¶51
umbp:¶90
ulbp:·32
urmp:·70
urcc:¸11
urcs:¸56
uxmp:¸94
uxcc:¹31
uxcs:¹72
urmc:±006
unwrit:±047
usta:±097
ucode:±150
uecode:±201
uwsta:±252
uosta:±303
uocode:±357
uoecod:±407
uhpid:±457
uscrpq:±509
ulof:±552
udof:±588
uosw:±628
ueof:±669
upbf:±706
ueif:±741
ucwt:±777
udmf:±842
urdmf:±901
ulpch:±957
ucrch:±993
ucomp:²037
%upar:²091
%ucar:²126
%ufrm:²159
%uovr:²194
ueff:²228
ucbuf:²268
ucbfln:²329
%urbsy=²400
%umsg=²453
%usndw=²513
%uint=²553
%usui=²591
%usrm=²636
u200:³101
usuer1:¶981
ulatt:·067
usuerr:·392
ucoml:·580
uidata:¸399
uclist:¹368
uother:¹949
uncar:±0062
ureadf:±0151
uwritf:±0846
ucr:±1701
ucw:±1981
uenabl:±2219
udisab:±2692
ued1:±3143
uopts:±3467
uff:±3902
uint:±4105
udial:±4180
uhang:±5145
ulistc:±5396
utroll:±5567
uexit:±5689
uex0:±6228
uex1:±6689
uex2:±6742
ucts:±8475
uxrdy:±8733
urchar:±9191
unocar:±9478
urpare:±9707
urover:±9798
urfrme:±9860
urerr:±9911
urerr1:²0154
uxmt:²0298
uxscrp:²4470
urcv:²4896
urscrp:²8788
userr4:²9006
uwrite:²9117
upollm:²9681
usrej1:³1273
urcvj:³1317
userr:³1527
usrej:³1608
usack:³1695
usrea:³1772
ureply:³1817
uschar:³2321
usstrc:³2707
usonum:³3255
uhr4:³3712
uhandl:³3770
uhloop:³4433
uhwtst:³4917
uout:³8396
ucards:³9944
upad:´1603
uactab:´1967
ucatab:´2693
partab:´3297
urfiln:´3968

P; TROLLR - DISPLAY EDITOR   -*-PALX-*-
trvn==%fnam2

.sbttl	Data bases

dsect <

	 .blkb lcs		; leave room for command structure

trerd::	 .blkw 1		; character to reread or -1 if none
evmax::	 .blkw 1		; maximum vertical position
ehmax::	 .blkw 1		; maximum horizontal position
evpos::	 .blkw 1		; current vertical position
ehpos::	 .blkw 1		; current horizontal position
ellen::	 .blkw 1		; length of current edit line
height:: .blkw 1		; no. of edit lines

pagep::	 .blkw 1		; ptr to PAGE
pagee::	 .blkw 1		; ptr to 1st character not in PAGE
lpage==2052.
page::	 .blkb lpage		; page to hold screen-full of data
	 .word 0		; to terminate page in case is full

l..k==6*80.
..K::	 .blkw 1		; length
	 .blkb l..k+2		; enuf room for 6 full lines

ioflg::	  		; RDFLG and WTFLG must occupy the same word; also
	  		; RDFLG must preceed WTFLG
rdflg::	 .blkb 1  	; read-file open (or about to be) flag
wtflg::	 .blkb 1  	; write-file open (or about to be) flag

iofile:: .blkw 1		; ptr to file name block

drch::	 .blkw 1		; disk read channel
dwch::	 .blkw 1		; disk write channel 

curptr:: .blkw 1		; ptr to current character in page
curend:: .blkw 1		; ptr to end of stuff in page
edmarg:: .blkw 1		; argument used in edit-mode
edmark:: .blkw 1		; edit mode mark
edmlsv:: .blkw 1		; last value set by ^V command
schar::	 .blkw 1		; search character
tablst:: .blkb 10.		; list of tab positions
tpagen:: .blkw 1		; keep track of page number here
prsflg:: .blkw 1		; peruse-flag, used by next-page
rdispy:: .blkw 1		; if non-zero, then redisplay necessary
ecpflg:: .blkw 1		; 1 to capitalize while in edit-mode
overwr:: .blkw 1		; -1 to overwrite characters in buffer(page)
coverw:: .blkw 1		; non-zero if next character is to be
				; inserted even if we are in overwrite mode
	>,ltdat


.sbttl	Initialization

trollr:	push #0,#80.		; SETSS args: process id, size
	call setss		; get us a large stack
	pop r0			; val: error code
	if ne,<
	  jmp comerr
	  >
	push #ltdat/2,#60.	; ALOCW args: size, timeout
	call alocw  		; allocate space for variables
	pop r1,r0  		; val: ptr
	if ne,<
	  jmp comerr
	  >
	mov #lcs/2,r0		; length of command structure
loop <	  mov (r4)+,(r1)+	; copy into trollr data area
	  sorl r0
	  >
	sub #lcs,r4		; get back ptr to command structure
	sub #lcs,r1		; ...
	push r4			; FREE arg: ptr
	call free		; free command structure
	mov r1,r4		; use Trollr's version
	mov r4,filep(r4)	; ptr to FILNAM
	add #filnam,filep(r4)	; ...
	mov r4,pagep(r4)	; get ptr to page buffer
	add #page,pagep(r4)	; ...
	mov r4,pagee(r4)		; get ptr to end of page buffer
	add #page+lpage,pagee(r4)	; ...
	mov #-1,trerd(r4)  	; no char to reread
	clr overwr(r4)		; not in overwrite mode
	push uoch(r4)		; ORDER arg: channel id
	push #10000+tvmax,#0	; ORDER args: order code, order arg
	call order		; read page height
	pop evmax(r4)		; val: page height
	bgt 1$			; ok if screen size is bigger than zero
	err ^"TROLLR only works on display terminals."
	jsr pc,exit

1$:	call moroff		; turn off more processing
	push uoch(r4)		; ORDER arg: channel id
	push #10000+thmax,#0	; ORDER args: order code, order arg
	call order		; read page height
	pop ehmax(r4)		; val: page height
	mov evmax(r4),height(r4)	; set no. of edit lines to be no. of
	sub #3-1,height(r4)		; lines minus 3
	mov r4,r0		; ptr to TABLST
	add #tablst,r0		; ...
	mov #7.+<14.*400>,(r0)+	; initialize the tab stops
	mov #21.+<28.*400>,(r0)+
	mov #35.+<42.*400>,(r0)+
	mov #49.+<56.*400>,(r0)+
	mov #63.+<70.*400>,(r0)+
	mov #77.,(r0)+
	clr prsflg(r4)
	clr ecpflg(r4)
	mov #1,tpagen(r4)	; current page number is 1
	jsr pc,clear		; clear page buffer

; fall through to COMM

.sbttl	Command processing

comm:	mov errflg(r4),r1  	; any error message to display?
	if ne,<
	  push uoch(r4)		; POSIT arg: channel id
	  push evmax(r4),#0	; POSIT args: verical, horizontal
	  call posit		; position to beginning of last line
	  jsr r5,typsc  	; display error header message
	    .litrl <
	      .byte %tdeol,%tdso3,40,0
	      >
	  push uoch(r4),r1	; WRITEZ args: channel id, ptr to asciz string
	  call writez  		; type error message
	  clr errflg(r4)  	; displayed once, now forget about it
	  jsr r5,typsc		; reset mode
	    .litrl <
	      .byte %tdso0,0
	      >
	  >
	push uoch(r4)		; POSIT arg: channel id
	push evmax(r4)		; POSIT arg: vertical
	dec (sp)		; ...
	push #0			; POSIT arg: horizontal
	call posit		; position to beginning of second last line
	jsr r5,typsc  		; prompt for command
	  .litrl <
	    .byte %tdeol,%tdso2,':,0
	    >
	call rdcmdl  		; read a line into the command buffer
	jsr r5,typsc  		; reset the mode
	  .litrl <
	    .byte %tdso0,0
	    >
	push uoch(r4)		; POSIT arg: channel id
	push evmax(r4),#0	; POSIT args: vertical, horizontal
	call posit		; position to beginning of last line
	tdtype eos		; erase any error message
	call arg		; skip over leading spaces
	pop *			; val: character
	beq comm
	call sarg		; read a string argument
				; SCASE args: ptr, length
	push pc			; SCASE arg3: ptr to list of strings
	add #tclist-.,(sp)	; ...
	call scase		; lookup command name in list
	pop r1,*		; vals: ptr to entry, error code
	if ne,<
	  err ^"Illegal command"
	  br comm
	  >
	jsr pc,@2(r1)		; call routine for this command
	br comm

tclist:	.word 4			; no. of bytes per entry
	defcom shutdn,
	defcom nshtdn,
.lif ne asmcdc
	defcom tru200,
	defcom exit,
	defcom tlistc,
	defcom info,
	defcom news,
	defcom read,
	defcom write,
	defcom rp,
	defcom wp,
	defcom nxtpag,
	defcom clswt,
	defcom clsrd,
	defcom close,
	defcom display,
	defcom clear,
	defcom edit,
.if ne  nlp
	defcom edlpt,
	defcom tpl,
.endc
	defcom cap,
	defcom ovrwrt,
	defcom novrwt,
	defcom peruse,
	defcom tabset,
	defcom ld,
	defcom df,
	defcom dfp,
	defcom ren,
	defcom copy,
	defcom move,
	defcom lall,
	defcom lu,
.lif ne  asmtek
	defcom tekplt,
	.word 0			; terminator

.sbttl	TROLLR command routines

;U200  command
.if ne  asmcdc
tru200: call trexit		; do a clean up
	tdtype clr		; clear the screen
	pop *			; remove return PC from stack
	jmp u200		; startup a U200
.endc

; EXIT command.
exit:   call trexit		; do a clean up
	pop *			; remove return PC from stack
        rts pc

;TREXIT cleans up after a TROLLR
trexit:	tst ioflg(r4)		; any files open?
	if ne,<
	  err ^"Please close your files before exiting"
	  pop r5		; restore linkage register
	  rts pc		; go back to TROLLR
	  >
	tdtype clr  		; clear screen
	push #lcs/2		; ALOCL arg: size
	call alocl		; allocate command structure
	pop r1			; val: ptr
	mov #lcs/2,r0		; no. of words in command structure
loop <	  mov (r4)+,(r1)+	; copy TROLLR's command stuff
	  sorl r0		; ...
	  >
	sub #lcs,r1		; get back ptrs to start of data blocks
	sub #lcs,r4		; ...
	push r4			; FREE arg: ptr
	call free		; free Trollr's data block
	mov r1,r4		; set command structure ptr
	mov r4,filep(r4)	; ptr to FILNAM
	add #filnam,filep(r4)	; ...
 	call moron		; turn on more processing
	return


; ? command.
tlistc:	push uoch(r4),#%tdclr	; WCHAR args: channel id, character
	call wchar		; clear screen first
	push pc			; LISTC arg: ptr to command list
	add #tclist-.,(sp)	; ...
	call listc		; typeout list of Trollr commands
	rts pc


; NEWS command.
news:	mov #newfil,r1  	; "INF;NEWS.TR"
	br ird

; INFO command.
info:	mov #hlpfil,r1  	; "INF;TROLLR.HLP"
ird:	tst ioflg(r4)  		; any file open?
	bne tefao
	mov r1,iofile(r4)
	br rea1  		; start reading the file

; READ command.
read:	tstb rdflg(r4)  	; is a read file already open?
	bne tefao  		; if so give an error
	push filep(r4)		; FILARG arg: ptr to filename buffer
	call filarg  		; set file name
	mov filep(r4),iofile(r4)
rea1:	jsr pc,opnrd  		; open read file
	pop r0			; val: error code
	if ne,<
	  jmp comerr		; handle error opening file
	  >
	jsr pc,rdpage  		; read in first page
	jmp display		; display page


; WRITE command.
write:	tstb wtflg(r4)  	; is a write flag already open?
	bne tefao  		; if so give an error
	push filep(r4)		; FILARG arg: ptr to filename buffer
	call filarg  		; set file name
	mov filep(r4),iofile(r4)
	jsr pc,opnwt  		; open write file
	pop r0			; val: error code
	if ne,<
	  jmp comerr		; handle error opening write file
	  >
	mov #1,tpagen(r4)	; start on page 1
	rts pc


tefao:	err ^"File already open"
	rts pc

; CLOSE_READ or CR command.
clsrd:	push ioflg(r4)  	; save wtflg
	clrb (sp)  		; clear rdflg on stack
	clrb wtflg(r4)  	; clear so just read-close
	br clset  		; set flag so restore ioflg on stack

;;; CLOSE_WRITE or CW command.
clswt:	push ioflg(r4)  	; save rdflg
	clrb 1(sp)  		; clear wtflg on stack.
	clrb rdflg(r4)  	; clear rdflg to simulate just
	mov #1,tpagen(r4)	; reset page number
	br clset  		; WRITE-CLOSE.

;;; CLOSE command.
close:	clr -(sp)  		; IOFLG will be set to 0
clset:	tst ioflg(r4)  		; any file open to close?
	if eq,<
	  pop ioflg(r4)		; set IOFLG to new value
	  jmp rpno
	  >
	tstb wtflg(r4)  	; write file open?
	if eq,<
	  jsr r5,rdcls  	; no write file open, just close read
	  br 1$
	  >
loop <	  jsr pc,wtpage  	; write out this page
	  tstb rdflg(r4)  	; still more to read?
	  exitl eq
	  jsr pc,rdpage  	; read next page
	  rptl
	  >
	jsr r5,wtcls  		; close write if set
1$:	err ^"File closed"
2$:	pop ioflg(r4)  		; restore ioflg
	rts pc


rdcls:	tstb rdflg(r4)  	; read file open?
	if ne,<
	  push drch(r4)  	; DETACH arg: channel id
	  call detach  		; close file
	  clrb rdflg(r4)  	; create read file open flag
	  >
	rts r5


wtcls:	tstb wtflg(r4)  	; any file open for write?
	if ne,<
	  push dwch(r4)  	; DETACH arg: channel id
	  call detach  		; close file
	  clrb wtflg(r4)  	; clear write file open flag
	  >
	rts r5

; READ_PAGE or RP command.
rp:	tstb rdflg(r4)  	; read file open?
	beq rpno  		; yes
	call numarg		; read numeric argument to read page command
	pop r0			; val: no. (default is 1)
loop <	  jsr pc,rdpage  	; read in next page
	  sorl r0
	  >
	jsr pc,display  	; display page
	rts pc

rpno:	err ^"No File Open"
	rts pc

; WRITE_PAGE or WP command.
wp:	tstb wtflg(r4)  	; write file open?
	beq rpno  		; no, abort
	jsr pc,wtpage  		; yes, write out page
	rts pc


; PAGE or P command.
nxtpag:	call numarg  		; read numeric argument to page command
	pop r2  		; val: no. (default is 1)
	tst ioflg(r4)  		; is a file opened?
	if eq,<
	  jmp rpno
	  >
1$:	jsr pc,wtpage  		; write this page out (if write set)
	jsr pc,rdpage  		; read in next page (if read set)
	sob r2,1$  		; do this arg times
	jsr pc,display  	; done, display this page
	tst prsflg(r4)
	beq 2$
	jsr pc,readc
	inc r2  		; set r2 to 1 (should be clear from loop)
	cmpb r0,#40
	beq 1$
	cmp r0,#22  		; ^R enters edit mode
	bne 2$
	jmp edit
2$:	rts pc


rdpage:	jsr r5,save6  		; save regs
	mov pagep(r4),r1	; pointer to top of page
	tstb rdflg(r4)  	; read file open?
	beq 1$  		; no, return
	mov #79.,r3  		; chars-in-line count. (counts down)
	mov height(r4),r2  	; max # of lines that will put into page
	sub #7,r2  		; leave 7 lines for editing
loop <	  push drch(r4)  	; RCHAR arg: channel id
	  call rchar  		; read next character from file
	  pop r0  		; val: character
	  rptl eq  		; ignore nulls
	  bmi 2$  		; -1 is end of file from RCHAR
	  movb r0,(r1)+  	; put char into page
	  cmp r0,#14  		; stop at form feed too
	  exitl eq
	  cmp r0,#15  		; don't stop between CR and LF
	  rptl eq
	  cmp r0,#12  		; LF?
	  if ne,<
	    sorl r3  		; have too many chars per line?
	    >
	  mov #79.,r3  		; reset character count
	  sorl r2  		; got enough lines yet?
	  >
1$:	mov r1,curend(r4)
	mov pagep(r4),curptr(r4)
	mov #-1,edmark(r4)  	; no mark yet
	jsr r5,rest6
	rts pc
2$:	clrb rdflg(r4)  	; clear read flag
	push drch(r4)  		; DETACH arg: channel id
	call detach  		; destroy the channel
	err ^"End of read file"
	br 1$


wtpage:	tstb wtflg(r4)  	; is write file open?
	if ne,<
	  push dwch(r4),pagep(r4)  	; WRITEN args: channel id, ptr
	  push curend(r4)		; WRITEN arg: no. of characters
	  sub pagep(r4),(sp)	; ...
	  call writen  		; write out page
	  inc tpagen(r4)	; another write, another page
	  >
	rts pc

.if ne  nlp
; LPT command.
edlpt:	jsr pc,gettpl		; get the TPL if possible
	pop r1,r0  		; vals: channel id, error code
	if ne,<
	  jmp comerr		; handle error attaching LPT
	  >
	push r1,pagep(r4)	; WRITEN args: channel id, ptr
	push curend(r4)		; WRITEN arg: no. of characters
	sub pagep(r4),(sp)	; ...
	call writen  		; write out page
	push r1			; DETACH args: channel id
	call detach
	rts pc
.endc

; PERUSE command.
peruse:	call numarg		; read numeric argument to PERUSE command
	pop prsflg(r4)  	; val: no. (set peruse flag to argument)
	rts pc


; CAPITALIZE or CAP command.  "CAP" causes input in edit mode to be
; capitalized.  "CAP 0" turns this off. 
cap:	call numarg		; read numeric argument to CAP command
	pop ecpflg(r4)   	; val: no. (default is 1)
	rts pc

ovrwrt: mov #-1,overwr(r4)	; put us in overwrite mode
	rts pc

novrwt:	clr overwr(r4)		; take us out of overwrite mode
	rts pc

; TABSET command.
tabset:	mov r4,r1		; get ptr to TABLST, the list of tab stops
	add #tablst,r1		; ...
	mov #9.,r2  		; maximum no. of tabs stops
loop <	  call rdcmdc		; get break char
	  pop r0  		; NULL (end of command line)?
	  exitl eq  		; yes, end list
	  call numarg		; get col. no.
	  movb (sp)+,(r1)+  	; put on list
	  sorl r2
	  dec r1
	  err ^"Too many arguments"
	  >
	clrb (r1)		; terminate list with a null
	rts pc


; CLEAR or C command.
clear:	mov pagep(r4),curptr(r4)
	mov pagep(r4),curend(r4)
	mov #-1,edmark(r4)
; fall through to DISPLAY

; DISPLAY command.
display:
	tdtype clr  		; clear screen
	push uoch(r4),pagep(r4)	; WRITEN args: channel id, ptr
	push curend(r4)		; WRITEN arg: no. of characters
	sub pagep(r4),(sp)	; ...
	call writen
; fall through to CMLINE

; Display the command mode line
cmline:	push uoch(r4)		; POSIT arg: channel id
	push evmax(r4)		; POSIT arg: vertical
	sub #2,(sp)		; ...
	push #0			; POSIT arg: horizontal
	call posit		; position cursor at beginning of mode line
	jsr r5,typsc
	  .litrl <
	    .byte %tdeos
	    .asciz "Troll-R Editor -- {Command} Page # "
	    >
	push tpagen(r4),uoch(r4)
	tstb wtflg(r4)		; write file open??
	if eq,<			; no let it be page 0
	  clr 2(sp)		; ...
	  >
	call ioac
	  .string ^"^d."
	rts pc

.sbttl	Edit Mode Initialization

; Enter Edit Mode
edit:	call emline		; display edit mode line


.sbttl	Edit Mode processing - Main loop

edloop:	mov #1,edmarg(r4)  	; reset arg to 1
edpval:	call eposit
	call bol		; see how far it is to beginning of line
	pop ellen(r4)		; val: no of chars
	call eol		; get number of chars to end of line
	add (sp)+,ellen(r4)	; val: number of chars
	jsr pc,readc  		; read next character
	cmp r0,#40  		; control-character?
	if lo,<
	  asl r0  		; times two for word indexing
	  jsr pc,@edmjt(r0)  	; jump to routine for control character
	  br edloop
	  >
	cmp r0,#177  		; rubout?
	if eq,<
	  jsr pc,del
	  br edloop
	  >
	tst ecpflg(r4)  	; should we capitalize char?
	beq 1$
	cmp r0,#'a  		; yes, lower case letter?
	blo 1$
	cmp r0,#'z
	bhi 1$
	bic #40,r0  		; convert to upper case
1$:	jsr pc,ichar
	br edloop


edmjt:	.word smark  		; ^@ (NULL)
	.word ctrla  		; ^A
	.word ctrlb  		; ^B
	.word ctrlq  		; ^C
	.word ctrld  		; ^D
	.word ctrle  		; ^E
	.word ctrlf  		; ^F
	.word ctrlg  		; ^G
	.word ctrls  		; ^H (BS)
	.word ctrli  		; ^I (TAB)
	.word ctrlg  		; ^J (LF)
	.word ctrlk  		; ^K
	.word ctrll  		; ^L
	.word ctrlm  		; ^M (CR)
	.word ctrln  		; ^N
	.word ctrlo  		; ^O
	.word ctrlp  		; ^P
	.word ctrlq  		; ^Q
	.word ctrlr  		; ^R
	.word ctrls  		; ^S
	.word ctrlg  		; ^T
	.word ctrlu  		; ^U
	.word ctrlv  		; ^V
	.word ctrlw  		; ^W
	.word ctrlx  		; ^X
	.word ctrly  		; ^Y
	.word ctrlz  		; ^Z
	.word insert  		; ^[ (ESC)
	.word ctrlg  		; ^\
	.word darg  		; ^]
	.word ctrlg  		; ^^
	.word ctrlg  		; ^_

.sbttl	Edit Mode commands

insert: mov pc,coverw(r4)	; cancel next overwrite command
	rts pc

; Self inserting characters
ichar:  push edmarg(r4)		; EDOWNN arg: no. of characters
	call edownn		; make room for  characters
	mov (sp),r1		; val: no. of characters
	beq 1$
	tst overwr(r4)		; in overwrite mode ?????
	if ne,<			; yes, now check to see if  preceded char
	  tst coverw(r4)	; previous character ???
	  if eq,<		; no, clean up room just taken
	    push r1		; EUPN arg: no. of characters
	    call eupn		; back up the chars just moved
	    >
	  else <		; if previous char was  then 
	    clr coverw(r4)	; don't let it happen next time
	    >
	  >
	mov curptr(r4),r2
loop <	  movb r0,(r2)+
	  sorl r1
	  >
	call dislin
	mov r2,curptr(r4)
	add (sp),ehpos(r4)
	cmp r0,#40
	if lo,<
	  add (sp),ehpos(r4)
	  >
1$:	cmp (sp)+,edmarg(r4)
	if ne,<
	  jmp ctrlg
	  >
	mov #-1,edmark(r4)  	; clear mark
	rts pc


; RUBOUT: Delete character to left (reject if at BOL). Display rest of
; line.  In case of TAB rubbed out, ^L is done to reset.
del:	mov #-1,edmark(r4)	; reset mark
	push edmarg(r4)
	call bol
	pop r1
	cmp (sp),r1
	if hi,<
	  mov r1,(sp)
	  >
	sub (sp),curptr(r4)
	call eupn
	call eposit
	call dislin 		; display new line
	cmp edmarg(r4),r1
	if hi,<
	  jmp ctrlg
	  >
	rts pc

; ^@: Set mark from point.
smark:	mov curptr(r4),edmark(r4)
	rts pc


; ^A: Move to beginning of current line.
ctrla:	call bol
	sub (sp)+,curptr(r4)
	rts pc


; ^B: Move left one character (reject if at beginning of line).
ctrlb:	call bol
	pop r1
	cmp edmarg(r4),r1
	if hi,<
	  sub r1,curptr(r4)
	  jmp ctrlg1
	  >
	sub edmarg(r4),curptr(r4)
	rts pc


; ^D: Delete character (reject if at end of line or page).
ctrld:	mov #-1,edmark(r4)	; reset mark
	call eol
	pop r1
	push edmarg(r4)
	cmp (sp),r1
	if hi,<
	  mov r1,(sp)
	  >
	call eupn
	call dislin 		; display new line
	cmp edmarg(r4),r1
	if hi,<
	  jmp ctrlg1
	  >
	rts pc


; ^E: Move to end of line or page.
ctrle:	call eol
	add (sp)+,curptr(r4)
	rts pc


; ^F: Move right one character (reject if at end of line or page).
ctrlf:	call eol
	pop r1
	cmp edmarg(r4),r1
	if hi,<
	  add r1,curptr(r4)
	  jmp ctrlg1
	  >
	add edmarg(r4),curptr(r4)
	rts pc


; ^G: Reset ARG to 1.  Cancels ^U or ^V settings.
ctrlg: 	mov #-1,edmark(r4)	; reset mark
ctrlg1:	mov #%tdbel,-(sp)	; beep at user
	jsr r5,typc
	rts pc


; ^I: Tab to the next tab stop.  (reject if beyond last stop on line.)
ctrli:	mov r4,r0		; ptr to TABLST
	add #tablst,r0		; ...
loop <	  movb (r0)+,r1		; end of list?
	  if eq,< 		; yes, reject request
	    jmp ctrlg1
	    >
	  sub ehpos(r4),r1 	; test for tab stop greater than current
	  dec r1		; position
	  rptl le
	  >
	mov #40,r0		; set character to space
	mov r1,edmarg(r4)	; set arg to no. of characters to next stop
	jmp ichar		; go insert

; ^K: Delete characters up to and including LF, or up to (but not including)
; end of page.
ctrlk:	mov #-1,edmark(r4)	; clear mark
	mov curptr(r4),r0
	mov r4,r1
	add #..k+2,r1
	clr ..k(r4)
	clr -(sp)  		; set up character deletion count
loop <	  cmp r0,curend(r4)
	  exitl eq
	  inc (sp)  		; count character for deletion
	  cmp (sp),#l..k  	; room left?
	  if los,<
	    movb (r0),(r1)+  	; else store in ..K
	    inc ..k(r4)  	; keep char count
	    >
	  cmpb (r0)+,#12  	; end of line?
	  rptl ne
	  dec edmarg(r4)  	; delete arg lines
	  rptl ne
	  >
	call eupn  		; delete n characters (arg on stack)
	call disres
	tst edmarg(r4)
	if gt,<
	  jmp ctrlg
	  >
	rts pc


; ^L: Clear screen, redisplay page, and position cursor.  This attempts to
; recover from any display or count errors that may have occurred.
ctrll:	tdtype clr  		; clear screen
	push uoch(r4),pagep(r4)	; WRITEN args: channel id, ptr
	push curend(r4)		; WRITEN arg: no. of characters
	sub pagep(r4),(sp)	; ...
	call writen
	call emline		; print edit mode line
	rts pc


; ^M: Insert CRLF and display rest of page.  No display if no CRLF inserted.
ctrlm:	clr r3

icrlf:	mov #-1,edmark(r4)
	push edmarg(r4)
	asl (sp)
	call edownn
	pop r1
	asr r1
	if cs,<
	  push #1
	  call eupn
	  >
	tst r1
	if ne,<
	  mov curptr(r4),r2
  loop <    movb #15,(r2)+
	    movb #12,(r2)+
	    sorl r1
	    >
	  call disres
	  tst r3
	  if eq,<
	    mov r2,curptr(r4)
	    >
	  >
	rts pc

; ^N: Move to beginning of next line, or end of page.
ctrln:	call eol
	add (sp)+,curptr(r4)
	add #2,curptr(r4)
	cmp curptr(r4),curend(r4)
	if hi,<
	  mov curend(r4),curptr(r4)
	  jmp ctrlg1
	  >
	dec edmarg(r4)
	bne ctrln
	rts pc


; ^O: Insert CRLF, but keep current ptr before the CRLF.  Use of ^O's and ^N's
; allows less redisplay.  No display if no CRLF inserted.
ctrlo:	mov #1,r3
	jmp icrlf


; ^P: Move to beginning of previous line, or beginning of page.
ctrlp:	call bol
	sub (sp)+,curptr(r4)
	sub #2,curptr(r4)
	cmp curptr(r4),pagep(r4)
	if lo,<
	  mov pagep(r4),curptr(r4)
	  jmp ctrlg1
	  >
	call bol
	sub (sp)+,curptr(r4)
	dec edmarg(r4)
	bne ctrlp
	rts pc


; ^Q quotes next character, for inputting control characters.
ctrlq:	jsr pc,readc  		; just read in the character
	jmp ichar  		; and we should just be able insert it

; ^R: Reverse character search.
; 
ctrlr:	jsr pc,readc  		; read char to search for
	cmp r0,#'
	if ne,<
	  mov r0,schar(r4)
	  >
	mov curptr(r4),r1
loop <	  cmp r1,pagep(r4)	; beginning of page?
	  if los,<
	    jmp ctrlg1		; yes, search fails
	    >
	  cmpb -(r1),schar(r4)  ; is next character it?
	  rptl ne  		; no, keep searching
	  mov r1,curptr(r4)	; set ptr to character
	  dec edmarg(r4)
	  rptl ne
	  >
	rts pc

; ^S: Read a character and search for it  times.  If not found, beep
; and don't move cursor.  If found, move to after character.
ctrls:	jsr pc,readc  		; read char to search for
	cmp r0,#10		; ^H??
	beq 1$
	cmp r0,#'
	if ne,<
	  mov r0,schar(r4)
	  >
1$:	mov curptr(r4),r1
loop <	  cmp r1,curend(r4)	; end of page?
	  if eq,<
	    jmp ctrlg1		; yes, search fails
	    >
	  cmpb (r1)+,schar(r4)  ; no, is next char it?
	  rptl ne  		; no, keep searching
	  mov r1,curptr(r4)
	  dec edmarg(r4)
	  rptl ne
	  >
	rts pc

; ^U: Multiply  by four.
ctrlu:	asl edmarg(r4)		; multiply arg by four
	asl edmarg(r4)		; ...
	clr r1
loop <	  jsr pc,readc  	; read character
	  cmp r0,#'0  		; digit?
	  exitl lo
	  cmp r0,#'9
	  exitl hi
	  sub #'0,r0
	  mul #10.,r1
	  add r0,r1
	  mov r1,edmarg(r4)  	; set last value set with ^V
	  rptl
	  >
	mov r0,trerd(r4)  	; reread terminating char
	pop *			; remove return PC from stack so can JMP back
	jmp edpval 		; to edit-mode loop, past value resetting


; ^V: Write current page, read in next.
ctrlv:	jsr pc,wtpage		; write out current page
	jsr pc,rdpage		; read in next page
	dec edmarg(r4)		; do  times
	bne ctrlv
	mov pagep(r4),curptr(r4)
	mov #-1,edmark(r4)  	; no mark
	jmp ctrll


; ^W: Wipe out text between point and mark and save in ..K
ctrlw:	mov edmark(r4),r1  	; get mark
	cmp r1,#-1  		; see if valid
	if eq,<
	  jmp ctrlg1
	  >
	cmp r1,curptr(r4)  	; get mininum of point and mark
	if lo,<
	  mov curptr(r4),-(sp)
	  mov r1,curptr(r4)
	  mov (sp)+,r1
	  >
	clr r3  		; character count
	mov r4,r2  		; address of ..K storage area
	add #..k+2,r2  		; ...
	sub curptr(r4),r1  	; no. of characters to wipe
	beq 2$  		; do nothing for zero characters
	cmp r1,#l..k
	if hi,<
	  mov #l..k,r1
	  >
	mov r1,r3
	mov curptr(r4),r0  	; ptr to text to wipe
loop <	  movb (r0)+,(r2)+  	; move to ..K
	  sorl r3
	  >
	mov r1,..k(r4)  	; length of ..k in 1st word
	push r1  		; EUPN arg: no. of chars
	call eupn  		; move up text (i.e. delete)
	call eposit		; position cursor
	call disres		; display rest of page
2$:	mov #-1,edmark(r4)
	rts pc


; ^X: Exchange mark and point.
ctrlx:	cmp edmark(r4),#-1  	; valid mark?
	if eq,<
	  jmp ctrlg1   		; no, abort command
	  >
	mov curptr(r4),-(sp)
	mov edmark(r4),curptr(r4)
	mov (sp)+,edmark(r4)
	rts pc

; ^Y: Yank in text from ..K into buffer.
ctrly:	mov ..k(r4),r2  	; get length of text in ..k
	push r2
	call edownn
	pop r2
	beq 2$
	mov r4,r1
	add #..k+2,r1
	mov curptr(r4),r3
loop <	  movb (r1)+,(r3)+  	; move
	  sorl r2
	  >
	call disres		; display rest of page
	mov r3,curptr(r4)  	; move to after inserted text
	mov #-1,edmark(r4)
2$:	rts pc


; ^Z: Exit from EDIT-MODE.
ctrlz:	pop *			; remove return PC from edit-mode loop
	jmp cmline		; return to command mode


; ^]: Read in numeric arg for next command.  No digits uses last arg
; specified via ^].
darg:	clr r1
loop <	  jsr pc,readc  	; read character
	  cmp r0,#'0  		; digit?
	  exitl lo
	  cmp r0,#'9
	  exitl hi
	  sub #'0,r0
	  mul #10.,r1
	  add r0,r1
	  mov r1,edmlsv(r4)  	; set last value set with ^]
	  rptl
	  >
	mov r0,trerd(r4)  	; reread terminating char
	mov edmlsv(r4),r1  	; into register for MUL
	mul edmarg(r4),r1  	; multiply by arg to ^]
	mov r1,edmarg(r4)  	; set arg for next command
	pop *			; remove return PC from stack so can JMP back
	jmp edpval 		; to edit-mode loop, past value resetting

.sbttl	Edit Mode subroutines

; BOL returns the no. of characters between the beginning of the line
; and point.

;	ARGS:				VALS:
;	(none)			 SP ->	no. of chars

bol:	push (sp),r1		; make room for return value, save reg
	mov curptr(r4),r1	; get current position of pointer into page
	clr 4(sp)		; no characters yet
loop <	  cmp r1,pagep(r4)	; at beginning of page????
	  exitl eq		; yes, we finished our job
	  cmpb -(r1),#12	; at beginning of line????
				; (signified by a linefeed)
	  exitl eq		; yes, finshed our job
	  inc 4(sp)		; another character
	  rptl			; mov backward through page
	  >
	pop r1			; restore reg
	return

; EOL returns the no. of characters between the end of the line and
; point.

;	ARGS:				VALS:
;	(none)			 SP ->	no. of chars

eol:	push (sp),r1		; make room for return value, save reg
	mov curptr(r4),r1	; get current position of pointer into page
	clr 4(sp)		; start off with 0 characters
loop <	  cmp r1,curend(r4)	; at end of stuff in page????
	  exitl eq		; yes, we've counted the number of characters
	  cmpb (r1)+,#15	; found the end of the line????
				; (signified by a carriage-return)
	  exitl eq		; yes, finished our job
	  inc 4(sp)		; another character counted
	  rptl			; and continue forwards
	  >
	pop r1			; restore reg
	return

; EPOSIT calculates where the horizontal and vertical position of the
; cursor and moves the cursor there.  It starts at the beginning of
; the page and stops when it reaches the location of the cursor in the
; page.

eposit:	push r0,r1		; save regs
	clr evpos(r4)		; start at line 0
	clr ehpos(r4)		; start at column 0
	mov pagep(r4),r1	; get pointer to beginning of page
loop <	  cmp r1,curptr(r4)	; at cursor location yet???
	  exitl eq		; yes, we're done.
	  movb (r1)+,r0		; no, get the next character
	  call ecsize		; and account for it's size
	  rptl			; go back for more
	  >
	push uoch(r4)			; POSIT arg: channel id
	push evpos(r4),ehpos(r4)	; POSIT args: vertical, horizontal
	call posit		; position cursor
	pop r1,r0		; restore regs
	return


; ECSIZE uses the character in R0 to determine the change in the
; horizontal and vertical position caused by that character.

ecsize:	inc r0			; hack so rubout is like control character
	cmpb r0,#40+1		; printing character
	if ge,<			; yes, normal garden variety
	  dec r0		; unhack
	  inc ehpos(r4)		; increment hpos by 1
	  br 1$
	  >
	dec r0			; unhack
	cmp r0,#11		; TAB?
	if eq,<			; yes
	  add #10,ehpos(r4)	; move to next tab stop
	  bic #7,ehpos(r4)	; ...
	  br 1$			; check for overflow
	  >
	cmp r0,#12		; LF?
	if eq,<			; yes
	  inc evpos(r4)		; move to next line
	  return
	  >
	cmp r0,#15		; CR?
	if eq,<
	  clr ehpos(r4)		; move to beginning of line
	  return
	  >
	add #2,ehpos(r4)	; random control character takes two positions
1$:	cmp ehpos(r4),ehmax(r4)	; overflowed line length?
	if his,<		; yes
	  sub ehmax(r4),ehpos(r4)	; move to next line
	  inc evpos(r4)			; ...
	  >
	return


; Type the Edit Mode line

emline:	push uoch(r4)		; POSIT arg: channel id
	push evmax(r4)		; POSIT arg: vertical
	sub #2,(sp)		; ...
	push #0			; POSIT arg: horizontal
	call posit		; position cursor at beginning of mode line
	jsr r5,typsc
	  .litrl <
	    .byte %tdeos
	    .asciz "Troll-R Editor -- {Edit ("
	    >
	tst overwr(r4)		; in overwrite mode
	if ne,<			; yes
	  jsr r5,typsc
	  .litrl <
	    .asciz "Overwrite"
	    >
	  >
	else <			; nope
	  jsr r5,typsc
	  .litrl <
	    .asciz "Insert"
	    >
	  >
	push uoch(r4)		; IOAC arg: channel id
	call ioac
	  .string ^")}"
	tstb wtflg(r4)		; write file open??
	if ne,<			; yes, display page number
	  push tpagen(r4),uoch(r4)
	  call ioac
	    .string ^" Page # ^d."
	  >
	return

; EDOWNN creates room for the number of characters passed on the
; stack. The characters between the end of the page and the cursor
; pointer are moved to allow the characters to be inserted.
;
;	ARGS:				VALS:
; SP ->	no. of chars		 SP ->	no. of chars

edownn:	push r0,r1  		; move characters from current ptr
	mov curend(r4),r0	; get pointer to end of stuff in page
	mov r0,r1		; copy pointer
	add 6(sp),r1		; figure the new end of the stuff
	cmp r1,pagee(r4)	; will it go beyond the end of page
	if hi,<			; yes, recalculate the number of characters
	  mov pagee(r4),r1	; that there are room for
	  mov r1,6(sp)
	  sub curend(r4),6(sp)
	  >
	mov r1,curend(r4)	; save the pointer to the end of stuff
				; in page
loop <	  cmp r0,curptr(r4)	; up to current location?????
	  exitl eq		; yes, we're done
	  movb -(r0),-(r1)	; no, move the character and decrement
				; the pointers
	  rptl			; back for more
	  >
	pop r1,r0		; restore regs
	return


; EUPN moves up the number of specified characters by skipping that
; number of characters before the cursor and move the rest of the
; characters in the page up.

;	ARGS:				VALS:
; SP ->	no. of chars			(none)

eupn:	push r0,r1  		; save regs
	mov curptr(r4),r0  	; get text pointer
	mov 6(sp),r1  		; get count of no. of characters to skip over
	add r0,r1  		; r1 points text to be moved up
loop <	  cmp r1,curend(r4)	; at the end of the stuff yet???
	  exitl eq		; yes, we're done
	  movb (r1)+,(r0)+	; no, transfer this character and bump
				; pointers up
	  rptl			; continue on
	  >
	mov r0,curend(r4)	; reset the end of the stuff
	pop r1,r0,(sp)  	; restore regs, remove arg
	return


.sbttl Display routines

; Display rest of page (after CURPTR).

disres:	tdtype eos
	push uoch(r4)		; WRITEN arg: channel id
	push curptr(r4)		; WRITEN arg: ptr
	push curend(r4)		; WRITEN arg: no. of characters
	sub curptr(r4),(sp)	; ...
	call writen
	call emline		; display the edit mode line
	return


; Display rest of line.

dislin:	push r0,r1,r2		; save reg
	call bol		; see how far it is to beginning of line
	pop r1			; val: no of chars
	call eol		; get number of chars to end of line
	pop r0			; val: number of chars
	add r0,r1		; see if this line will cause or revoke wrap
	mov ellen(r4),r2	; get line length from last display from
				; before the command
	cmp r1,r2		; current line longer than before
	if gt,<			; yes if greater than
	  cmp r1,ehmax(r4)	; did we go beyond the screen width?
	  if ge,<		; yes, and was last line longer
	    cmp ehmax(r4),r2	; screen?
	    bge 1$		; no, so redisplay rest of screen
	    >
	  >
	else <
	  cmp r2,ehmax(r4)	; was last line longer than width of screen
	  if ge,<		; yes
	    cmp ehmax(r4),r1	; and this line less than the width of screen
	    bge 1$		; yes, redisplay the whole screen
	    >
	  >
	tdtype eol
	push uoch(r4)		; WRITEN arg: channel id
	push curptr(r4),r0	; WRITEN args: ptr, no. of characters
	call writen
	pop r2,r1,r0		; restore regs
	return

1$:	pop r2,r1,r0		; restore registers
	br disres		; redisplay rest of screen

.sbttl File routines

; OPNRD opens a file for reading.

opnrd:	push (sp)  		; create slot for return val (error code)
	push pc			; ATTACH arg: device name
	add #dskn-.,(sp)	; ....
	push iofile(r4) 	; ATTACH arg: file name
	push diskno(r4),#0	; ATTACH arg2: disk unit number,cbits
	call attach  		; attach file for reading
	pop drch(r4),2(sp)  	; vals: channel id, error code
	if eq,<
	  movb #-1,rdflg(r4)  	; set flag to show read file open
	  >
	rts pc

; OPNWT opens a file for output.

opnwt:	push (sp)  		; create slot for return val (error code)
	push pc			; ATTACH arg: device name
	add #dskn-.,(sp)	; ....
	push iofile(r4)		; ATTACH arg: file name
	push diskno(r4),#%icrea+%iupd	; ATTACH arg2: disk unit #,cbits
	call attach  		; attach file for writing
	pop dwch(r4),2(sp)  	; vals: channel id, error code
	if eq,<
	  movb #-1,wtflg(r4)  	; set flag to show write file open
	  >
	rts pc

.sbttl	Terminal i/o

; PEEKC reads the next character from the input channel and saves that
; character as the next character to be read.  It returns the
; character in R0 to the caller.

peekc:	jsr pc,readc		; get character
	mov r0,trerd(r4)	; cause character to be reread
	rts r5

; READC checks to see if there is a character to be reread and if not
; reads the next character from the input channel.  If there is a
; character to be reread it is used.  In either case the character is
; returned in R0 to the caller and there will be no character to
; reread.

readc:	mov trerd(r4),r0  	; see if anything to reread
	bpl 1$
	push uich(r4)		; RCHAR arg: channel id
	call rchar  		; read input character
	pop r0  		; val: character
1$:	mov #-1,trerd(r4)	; flush reread
	rts pc


; TYPSC prints the string from the relative pointer after the call
; instruction.  It then outputs the string to the output channel.

typsc:	push uoch(r4)		; WRITEZ arg: channel id
	push r5			; calculate pointer to string to output
	add (r5)+,(sp)		; ....
	call writez		; print it out
	rts r5

; TYPC sends the character on the stack to the output channel.

typc:	push uoch(r4),2+2(sp)	; WCHAR args: channel id, character
	call wchar		; send it out to the world
	pop (sp)		; remove arg
	rts r5

.sbttl	Constants

hlpfil:	.rad50 "INF"
	.rad50 "TROLLR"
	.rad50 "HLP"

newfil:	.rad50 "INF"
	.rad50 "NEWS  "
	.rad50 "TR "
ðC; -*-PALX-*-

.sbttl	Terminal DIM

; Define the TTY DIM entry points
tty:	defdim tatt,tdet,torder,ti,to,tno,tno,tipeek


; TTY channel block.
dsect <
	 .blkw 1		; ptr to tty structure of terminal
tcosw::	 .blkw 1		; address of handler for next character
tcbits:: .blkw 1		; control bits from attach call
.if ne  0
tcwtop:: .blkw 1		; line no. of first line in window
tcwlen:: .blkw 1		; length of window
tcwvp::	 .blkw 1		; window vertical position
tcwhp::	 .blkw 1		; window horizontal position
.endc
	 >,ltchb

; Cbits
%tcio==1			; image ouput
%tcniwt==2			; no waiting on input
%tcnctn==4			; no line continuation


; TTY structure.
dsect <
tctyp::	 .blkw 1		; terminal type code
tlinen:: .blkw 1		; line no. to do i/o to for TTY
thmax::	 .blkw 1		; terminal line length
tvmax::	 .blkw 1		; terminal page length
topt::	 .blkw 1		; terminal option bits
thpos::	 .blkw 1		; horizontal cursor position
tvpos::	 .blkw 1		; vertical cursor position
tthpos:: .blkw 1		; terminal's actual hpos
ttvpos:: .blkw 1		; terminal's actual vpos
ispeed:: .blkw 1		; input speed in cps
ospeed:: .blkw 1		; output speed in cps
tbreak:: .blkw 1		; set if a break was typed by the user
tmoren:: .blkw 1		; screen line no. on which input was
				; last typed by the user
	 >,lttab

ifSAO <
  %tntty==0			; random printing terminal
  %tnvt==4			; VT52
  %tnla8==10			; LA180 DECprinter I
  %tnvt1==14			; VT100/VT132 terminal
  %tnaaa==20			; Ann Arbor Ambassador

.macro	tdisp name
	add (r3),pc
.irp x,
	jmp x''name
.endm
.endm

      >

ifMIT <
  %tntty==0			; random printing terminal
  %tnsb==4			; StupidBee
  %tnvt==10			; VT52
  %tnhp==14			; HP2645
  %tnla1==20			; LA120 DecWriter III
  %tnvt1==24			; VT100/VT132 terminal
  %tnaaa==30			; Ann Arbor Ambassador

.macro	tdisp name
	add (r3),pc
.irp x,
	jmp x''name
.endm
.endm

     >


%tocro==1			; terminal automatically CRLFs on line overflow
%toers==2			; terminal can selectively erase its screen
%toovr==4			; terminal can overwrite characters
%todis==10			; display terminal, i.e. can move cursor
%toabs==20			; use direct cursor addressing
%tobs==40			; terminal can backspace
%toesc==100			; last input character was ESC
%tomor==200			; do more processing
%tnech==400			; send output to terminal if not set
%tnxon==1000			; terminal wants XON/XOFF flow control
%tnetx==2000			; terminal wants ETX/ACK flow control (not yet)
%tansi==4000			; terminal uses ANSI escape sequences


; Define the %TD codes
%tdnop==200			; No operation
%tdhom==201			; Move to upper left ("home")
%tdhmv==202			; Move to horizontal position
%tdvmv==203			; Move to vertical position
%tdmov==204			; Move to vertical, horizontal position
%tdclr==205			; Clear screen
%tders==206			; Clear character
%tdeol==207			; Clear to End of Line
%tdeos==210			; Clear to End of Screen
%tdso0==211			; Standout mode 0 (normal)
%tdso1==212			; Standout mode 1 (blinking)
%tdso2==213			; Standout mode 2 (reverse video)
%tdso3==214			; Standout mode 3 (blinking reverse video)
%tdbel==215			; Ring bell
%tdff==216			; send a formfeed

.macro	term line,tctyp,pl,ll,opt,is,os
	.word %tn'tctyp,line,ll-1,pl-1,opt,0,0,0,0,is,os,0,0
ntty==ntty+1
.endm

%%temp===%todis+%toers+%tobs

ntty==0

ifMIT <

;;; line 2 is the TEK4664 plotter -- DL11-E at 775620

ttab:	term 0.,la1,0,132.,%tobs,10.,10.
				; T0 LA34 Console -- DL11-W
	term 1.,tty,0,132.,%toovr+%tobs,120.,120.
				; T1 Vadic 300 -- DL11-E at 775610
	term 3.,tty,0,132.,%toovr+%tobs,30.,30.
				; T2 Not used at 775630
	term 4.,tty,0,80.,%toovr+%tobs,480.,480.
				; T3 Not used at 775640
	term 5.,tty,0,80.,%tnxon+%toovr+%tobs,960.,960.
				; T4  TTY -- DZ11 Line 0
	term 6.,tty,0,80.,%tnxon+%toovr+%tobs,960.,960.
				; T5  TTY -- DZ11 Line 1
	term 7.,tty,0,80.,%tnxon+%toovr+%tobs,960.,960.
				; T6  TTY -- DZ11 Line 2
	term 8.,tty,0,80.,%tnxon+%toovr+%tobs,960.,960.
				; T7  TTY -- DZ11 Line 3
	term 9.,tty,0,80.,%toovr+%tobs,120.,120.
				; T8  Vadic 1200 -- DZ11 Line 5
	term 10.,tty,0,80.,%tnxon+%toovr+%tobs,120.,120.
				; T9  Spinwriter -- DZ11 Line 4
	term 11.,tty,0,80.,%toovr,240.,240.
				; T10  HP3000 -- DZ11 Line 6
	term 12.,tty,0,80.,%%temp,960.,960.
				; T11  MC -- DZ11 Line 7
     >

ifSAO <
; keep the listings in this order, depends on file # being 0.

ttab:	term 1,la8,0.,120.,%tnxon+%toovr+%tobs,120.,120.
				; T0 LA180 -- DLV11-J Line 0
	term 0,vt,24.,80.,%%temp,960.,960.
				; T1 VT100 console -- DLV11-J Line 3
	term 2,tty,0.,132.,%tnxon+%toovr+%tobs,120.,120.
				; T2 SPINWRITER -- DLV11-J Line 1
	term 3,tty,0.,132.,%toovr+%tobs,120.,120.
				; T3 Vadic 1200 -- DLV11-J Line 2
	term 4,tty,0.,132.,%toovr+%tobs,120.,120.
				; T4 Not used -- DLV11 at 775610
	term 5,tty,0.,132.,%toovr+%tobs,30.,30.
				; T5 Vadic 300 -- DLV11 at 775620
     >


; TTINIT is called at system startup to initialize the TTY module.
ttinit:	push #ntty		; number of ttys to do
	mov pc,r3		; ptr to TTAB
	add #ttab-.,r3		; ...
loop <	  call ttint		; setup this line
	  add #lttab,r3		; move ptr to next TTAB entry
	  dec (sp)
	  rptl ne		; ...
	  >
	tst (sp)+		; remove zero from stack
	return

; TTINT sets up an asynchrounous line.
; R3 -> TTAB entry for the line.
ttint:	jsr r5,1$		; do TDISP as a subroutine call
	bit #%tnxon,topt(r3)	; does this line want flow control on
	if ne,<
	  push tlinen(r3),#%alxon	; ALSMOD args: line no., mode
	  call alsmod		; set XON/XOFF mode for this line
	  >
	return
1$:	tdisp ini		; initialize terminal


; TTY DIM attach entry point
tatt:	push #ltchb/2,#2*60.	; ALOCW args: size, timeout
	call alocw		; allocate TTY channel block
	pop r4,r0		; vals: ptr, error code
	bne 1$
	mov r2,tcbits(r4)	; save control bits in channel block
	mul #lttab,r1		; set DIM data word to tty structure ptr
	add pc,r1		; ...
	add #ttab-.,r1		; ...
	mov r1,(r4)		; save tty structure ptr in channel block
	push pc			; ptr to TO1
	add #to1-.,(sp)		; ...
	pop tcosw(r4)		; set output switch to TO1
	clr r0			; return zero error code (success)
1$:	return


; TTY DIM detach entry point
tdet:	push r4			; FREE arg: ptr
	call free		; free channel block
	return


; TTY DIM order entry point
torder:	mov r3,r1		; copy order code
	mov (r4),r3		; ptr to TTAB entry
	cmp r1,#20000		; set command?
	bhis tords
	cmp r1,#10000		; read command?
	bhis tordr
	cmp r1,#3		; check for illegal order code
	bhi to0
	asl r1			; times two for wording
	add r1,pc
to0:	lose %ebdoc		; 0, illegal
	br 1$			; 1, Status request
	br 2$			; 2, BIS into cbits
	br 3$			; 3, BIC into cbits
1$:	clr r0			; STATUS request: return zero
	return
2$:	bis r2,tcbits(r4)	; BIS into cbits
	return
3$:	bic r2,tcbits(r4)	; BIC into cbits
	return

tordr:	sub #10000,r1
	add r3,r1
	mov (r1),r0
	return

tords:	sub #20000,r1
	add r3,r1
	mov r2,(r1)
	return


; TTY DIM entry point for unimplemented operations (DELETE, RENAME).
tno:	lose %ebdio
	return

.sbttl	Terminal i/o

; TI is the TTY DIM input entry point.  It is called by the I/O system.

;	ARGS:				VALS:
; R3:	ptr to channel structure  R0:	character

ti:	mov (r4),r3		; get tty structure ptr
	call tupd		; move cursor to where its supposed to be
	push tlinen(r3),#0	; ALREAD arg: line no., timeout
	bit #%tcniwt,tcbits(r4)	; no wait bit set?
	if eq,<			; no
	  dec (sp)		; change timeout to -1 (i.e. no timeout)
	  >
	call alread		; read character from line
	pop r0,*		; vals: character, error code
	bne 1$
	bic #177600,r0		; clear random bits in character
	mov tvpos(r3),tmoren(r3)	; save vertical position for more processing
	tdisp in		; dispatch to terminal specific routine
1$:	return

tipeek:
.if ne asmpek
	mov (r4),r3		; get tty structure ptr
	push tlinen(r3),#0	; ALPEEK arg: line no., timeout
	bit #%tcniwt,tcbits(r4)	; no wait bit set?
	if eq,<			; no
	  dec (sp)		; change timeout to -1 (i.e. no timeout)
	  >
	call alpeek		; read character from line
	pop r0,*		; vals: character, error code
	bne 1$
	bic #177600,r0		; clear random bits in character
	tdisp in		; dispatch to terminal specific routine
1$:	return
.endc
.else
        jmp tno
.endc

; TO is the TTY DIM's output entry point.  It is called by the I/O system.

;	ARGS:				VALS:
; R4:	ptr to channel structure	(none)
; R0:	character

to:	mov (r4),r3		; get ptr to tty structure
	bit #%tcio,tcbits(r4)	; image output?
	if ne,<
	  jmp toi		; output character in image output
	  >
	jmp @tcosw(r4)		; dispatch next character to output co-routine

to1:	bit #%tnech,topt(r3)	; sending turned off??
	if ne,<			; yes
	  return		; don't send anything
	  >
	cmpb r0,#40		; Displayable character (ASCII 40-176) ?
	if gt,<
	  jmp tochr		; type displayable character and return
	  >
	beq tosp
	if hi,<			; %TD character (200-377) ?
	  asl r0		; times two for index into word table
	  add pc,r0		; for PICness
	  add tdtab-400-.(r0),pc	; switch to routine for %TD character
to2:
	  >
; Character in R0 is some control character.  Check for various formating
; control chars.

	cmp r0,#11		; TAB?
	beq totab
	cmp r0,#12		; LF?
	beq tolf
	cmp r0,#15		; CR?
	if eq,<
	  clr thpos(r3)		; update cursor position
	  return
	  >
	cmp r0,#14		; FF?
	if eq,<
	  jmp tdff
	  >
; All the rest are control characters to be typed as ^x
to3:	push r0			; save character
	mov #'^,r0		; put ^ in R0
	call tochr		; type the ^
	pop r0			; restore character
	add #100,r0		; TOCHR arg: character
	jmp tochr		; type character and return

; TOTAB handles tabs.
totab:	call tosp		; move forward
	bit #7,thpos(r3)	; see if at a tab stop yet
	bne totab		; keep going if not
	return

; TOSP handles spaces.
tosp:	call toc1		; hack line continuation
	call toc3		; move forward
	return


; TOCHR types a displayable character.  Line continuation is handled.
tochr:	call toc1		; hack line continuation
	call toc2		; send character
	jsr r5,1$		; do tdisp as a subroutine call
	call toc3		; move forward
	return
1$:	tdisp out		; do any post character sending processing
				; which is dependent upon the terminal

; This routine hacks possible line continuation.
toc1:	cmp thpos(r3),thmax(r3)	; last position in line?
	bne 1$			; no, skip hairy last column hackery
	bit #%tcnctn,tcbits(r4)	; no overflow indication?
	bne 1$
	call tupd		; move the cursor where its supposed to be
	push r0			; save character
	mov #'!,r0		; TOCHR1 arg: character
	call toc2		; type !
	pop r0			; restore character
	clr thpos(r3)		; CR
	call tolf		; LF
1$:	return


; This routine outputs a printing character and accounts for the movement it
; produces.
toc2:	call tupd		; move the cursor where it is suppsed to be
	call toi		; send the character
	cmp tthpos(r3),thmax(r3)	; last column?
	if ne,<
	  inc tthpos(r3)	; no, simply advance by 1
	  return
	  >
	bit #%tocro,topt(r3)	; does terminal auto-CRLF in last column?
	if ne,<			; yes
	  clr tthpos(r3)	; CR
	  inc ttvpos(r3)	; LF
	  >
	return


; This routine advances the horizontal position by 1.
toc3:	cmp thpos(r3),thmax(r3)	; last column?
	if eq,<			; yes
	  clr thpos(r3)		; CR
	  br tolf		; LF
	  >
	inc thpos(r3)		; advance by 1 column
	return


; TOLF handles linefeeds.
tolf:	tst tvmax(r3)		; printing terminal?
	bmi ttylf		; yes, different hackery
	cmp tvpos(r3),tvmax(r3)	; on bottom line?
	if lo,<			; no
	  inc tvpos(r3)		; update cursor position
	  >
	else <
	  clr tvpos(r3)		; wrap to top of screen
	  >
ifMIT <
	bit #%tomor,topt(r3)	; are we hacking -more- processing
	bne tomore		; yes if bit set
      >
	jmp tdeol		; erase the line moved to

ifMIT <
tomore: push r0			; save register
	cmp tvpos(r3),tvmax(r3)	; are we on the last line now
	if eq,<
	  mov tmoren(r3),r0	; get last line on which there was input
	  add #3,r0		; increment by 3
	  cmp r0,tvmax(r3)	; were we near the end of the screen
	  if ge,<		; yes
	    mov #0,tmoren(r3)	; reset screen input line number
	    br 1$		; don't do more processing this time
	    >
	  call tupd		; update cursor
	  jsr r5,toisc		; print **more** message
	  .string ^"*-MORE-*"
	  call tdeol		; erase to end of line
	  push tlinen(r3),#-1	; ALREAD args: line no.,time-out
.lif ne asmpek
	  call alpeek		; peek at response
.lelse
          call alread		; get a character
	  pop r0,*		; VALS: character,error code
	  cmp r0,#40		; was character a space?
	  if eq,<		; yes
.if ne asmpek
	    push tlinen(r3),#-1	; ALREAD args: line no.,time-out
	    call alread		; snarf up the space
	    pop r0,*		; VALS: character,error code
.endc
	    call tdhom		; move to home position
	    br 1$		; we're all through
	    >
	  else <
	    jsr r5,toisc	; print flushed message
	    .string ^" Flushed"
	    call tdhom		; position cursor to home position
	    bis #%tnech,topt(r3)	; turn off echoing
	    >
	  >
1$:     pop r0			; restore register
	jmp tdeol		; clear to end of line
     >

ttylf:	call tupd		; move to horizontal position we're supposed
				; to be at
	push r0			; save register
	mov #12,r0		; TOI arg: character
	call toi		; send LF
	pop r0			; restore register
.if df %tntrm			; no terminets around anymore, but keep the
				; code just in case
	cmp (r3),#%tntrm	; Terminet?  (really LA180 -- see below)
	bne 1$
	mov ospeed(r3),r1	; divide output speed by 4 to get the no.
	add #3,r1		;  of characters to send for 1/4sec LF
	ash #-2,r1		;  ...

;	mov #35,r1		; gross LA180 timing
;	sub thpos(r3),r1
;	blt 1$
	push r1,#0		; TSEND args: no. of characters, character
	call tsendn		; send enough pads so previous LF wins
.endc
1$:	return


; TONXT CHANGES output switch so the next output character is passed as an
; ARGUMENT TO the caller.
tonxt:	pop tcosw(r4)		
	return



; TOTD is a table of routines to handle the various %TD codes.
tdtab:	.word tdnop-to2		; %TDNOP  no-op
	.word tdhom-to2		; %TDHOM  home
	.word tdhmv-to2		; %TDHMV  horizontal move (next byte is pos)
	.word tdvmv-to2		; %TDVMV  vertical move (next byte is pos)
	.word tdmov-to2		; %TDMOV  move (next bytes are horz and vert)
	.word tdclr-to2		; %TDCLR  clear screen
	.word tders-to2		; %TDERS  erase character above cursor
	.word tdeol-to2		; %TDEOL  clear rest of line
	.word tdeos-to2		; %TDEOS  clear rest of screen
	.word tdso0-to2		; %TDSO0  normal display mode (standout mode 0)
	.word tdso1-to2		; %TDSO1  standout mode 1 (blinking)
	.word tdso2-to2		; %TDSO2  standout mode 2 (reverse video)
	.word tdso3-to2		; %TDSO3  standout mode 3 (blinking rev video)
	.word tdbel-to2		; %TDBEL  ding bell
	.word tdff-to2		; %TDFF	  send a form feed


.macro	twrite t
	jsr r5,toisc
	  .string ^~t~
.endm


; %TDNOP - no-op
tdnop:	return


; %TDHOM - move to top of screen.
tdhom:	clr thpos(r3)		; home position has is in column zero
	tst tvmax(r3)		; printing terminal?
	bmi ttylf		; yes, LF
	clr tvpos(r3)		; update cursor position
	return


; %TDVMV - vertical move
tdvmv:	jsr pc,tonxt
	dec r0
.lif ne  0
	add tcwtop(r4),r0
	mov r0,tvpos(r3)
	br tdmv1

; %TDMOV - move
tdmov:	jsr pc,tonxt
	dec r0
.lif ne  0
	add tcwtop(r4),r0
	mov r0,tvpos(r3)

; %TDHMV - horizontal move
tdhmv:	jsr pc,tonxt
	dec r0
	mov r0,thpos(r3)
tdmv1:	mov #to1,tcosw(r4)	; reset output switch
	call tupd		; update cursor position
	return


; TUPD forces the cursor to be where its supposed to be.
tupd:	cmp thpos(r3),tthpos(r3)
	bne 1$
	cmp tvpos(r3),ttvpos(r3)
	bne 1$
	return
1$:	tdisp mov


; %TDERS - erase the character before the cursor.
tders:  tst thpos(r3)		; BS in column zero?
	if ne,<			; no
	  dec thpos(r3)		; decrement horizontal position
	  >
	call tupd		; make sure cursor is where it should be
	tdisp ers


; %TDEOL - erase the rest of the line.
tdeol:	call tupd		; make sure cursor is where it should be
	tdisp eol


; %TDCLR - Clear Screen
tdclr:	call tdhom		; move to upper left
; fall through to TDEOS


; %TDEOS - erase the rest of the screen.
tdeos:	call tupd		; make sure cursor is where it should be
	tdisp eos


; %TDSO0 - normal display mode
tdso0:	call tupd		; make sure cursor is where it should be
	tdisp so0


; %TDSO1 - standout mode 1 (blinking)
tdso1:	call tupd		; make sure cursor is where it should be
	tdisp so1


; %TDSO2 - standout mode 2 (reverse video)
tdso2:	call tupd		; make sure cursor is where it should be
	tdisp so2


; %TDSO3 - standout mode 3 (blinking rev video)
tdso3:	call tupd		; make sure cursor is where it should be
	tdisp so3


; %TDBEL - ding bell
tdbel:	call tupd		; make sure cursor is where it should be
	tdisp bel

; %TDFF - send a form feed
tdff:	tst tvmax(r3)
	if mi,<			; printing terminal
	  tdisp ff
	  >
	jmp to3

.sbttl	Printing terminals

; No operation
ttynop:	return

ttyin===ttynop
ttyout===ttynop
ttyeol===ttynop
ttyeos===ttynop
ttyso0===ttynop
ttyso1===ttynop
ttyso2===ttynop
ttyso3===ttynop
ttyff===ttynop

; Initialize
ttyini:	mov #15,r0		; TOI arg: character
	call toi		; output CR
	clr tthpos(r3)		; clear horizontal position
	return

; Erase character
ttyers:	twrite ^" "
	return

; Feep bell
ttybel:	twrite ^""
	return


; Horizontal positioning
ttymov:	mov tthpos(r3),r1	; get actual position
	mov thpos(r3),tthpos(r3)	; update it
	sub thpos(r3),r1	; find distance from current position
	if mi,<
	  neg r1		; make position
	  push r1,#40		; TSENDN args: no., character
	  call tsendn		; send n spaces
	  return
	  >
	bit #%tobs,topt(r3)	; can TTY backspace?
	if ne,<
	  cmp r1,thpos(r3)	; which is better, CR spaces or backspaces?
	  if lo,<		; CR spaces is better
	    push r1,#10		; TSENDN args: no., character
	    call tsendn		; send n backspaces
	    return
	    >
	  >
	mov #15,r0		; TOI arg: character
	call toi		; send CR
	push thpos(r3),#40	; TSENDN args: no., character
	call tsendn		; send n spaces
	return

.sbttl	VT52

; always assemble
vtin===ttyin
vtout===ttynop
vters===ttyers
vtso0===ttynop
vtso1===ttynop
vtso2===ttynop
vtso3===ttynop
vtbel===ttybel

; Initialize
vtini:	twrite ^"HJ\>G"	; home, exit hold-screen mode, exit alternate-
				; keypad mode, exit graphics mode
	clr tthpos(r3)
	clr ttvpos(r3)
	clr thpos(r3)
	clr tvpos(r3)
	return

; Erase to end of line
vteol:	twrite ^"K"
	return

; Erase to end of screen
vteos:	twrite ^"J"
	return

vtff===vteos

; Cursor movement
vtmov:	push r0,r1,r2		; save regs
	push #4			; TERMOV arg: cost of direct cursor addressing
	call termov		; see if relative move is best
	  br 1$			; return1, relative move done
	twrite ^"Y"		; send cursor position code for Vt52
	mov tvpos(r3),r0	; get vertical position
	add #40,r0		; put position into printable range
	call toi		; send vertical position
	mov thpos(r3),r0	; get horizontal position
	add #40,r0		; put position into printable range
	call toi		; send horizontal position
	mov tvpos(r3),ttvpos(r3)
	mov thpos(r3),tthpos(r3)
1$:	pop r2,r1,r0		; restore regs
	return


; TERMOV is the escape sequence terminals' relative movement subroutine.
; If direct cursor addressing is best then TERMOV outputs nothing and
; takes return2.  If relative cursor movement using CR, HOME, UP, DOWN,
; RIGHT, and LEFT commands is best then TERMOV does the cursor movement
; and takes return1.  If %TOABS is clear then relative movement is always
; done.

;	ARGS:				VALS:
; SP ->	cost of direct cursor address	(none)

; RETURN1: Relative movement has been done
; RETURN2: Direct cursor addressing is best

termov:	cmp thpos(r3),#80.	; Horizontal position beyond abs
				; addressing??
        bge 2$			; yes, do relative movement
	mov #2,-(sp)		; scratch word, init to "home and rel move"
	mov tvpos(r3),r2	; get desired vertical position
	mov thpos(r3),r1	; get desired horizontal position
	mov r1,r0		; cost of home and move is V + 2H + 2
	inc r0			; ...
	asl r0			; ...
	add r2,r0		; ...
	bit #%toabs,topt(r3)	; supposed to use direct cursor addressing?
	if ne,<			; yes
	  cmp 4(sp),r0		; direct cursor addressing better than
				; home and relative move?
	  if lo,<		; yes
	    mov 4(sp),r0	; set minimum cost so far to that of direct
	    mov #4,(sp)		; address, change to "direct cursor address"
	    >
	  >
	sub ttvpos(r3),r2	; calculate vertical difference

	if mi,<			; negative, i.e. move up
	  neg r2		; make positive
	  asl r2		; times two to get cost
	  >
	sub tthpos(r3),r1	; calculate horizontal difference
	neg r1			; make backwards difference
	if mi,<			; negative, i.e. move forward
	  neg r1		; make positive
	  asl r1		; times two to get cost
	  >
	add r1,r2		; add horizontal and vertical costs
	cmp r2,r0		; relative move better than best so far?
	if lo,<			; yes
	  mov r2,r0		; set minimum cost so far to that of rel move
	  clr (sp)		; change to "relative move"
	  >
	sub r1,r2		; get back vertical cost
	add thpos(r3),r2	; add 2H + 1 which is cost of CR and
	add thpos(r3),r2	; relative movement
	inc r2			; ...
	cmp r2,r0		; CR and relative move better than best so far?
	if lo,<			; yes
	  mov #15,r0		; TOI arg: character
	  call toi		; output CR
	  clr tthpos(r3)	; keep track of movement
	  clr (sp)		; now do "relative movement"
	  >
	add (sp)+,pc		; dispatch on best method found
	br 2$			; "relative move"
	br 1$			; "home and relative move"
				; "direct cursor address"
	pop (sp)		; remove arg from stack
	retrn2			; return2 to indicate direct cursor move
				; is best
1$:	  twrite ^"H"		; move to upper left corner of screen ("home")
	clr ttvpos(r3)		; account for home operation
	clr tthpos(r3)		; ...
2$:	cmp ttvpos(r3),tvpos(r3)	; reached desired vertical position?
	beq 3$				; yes
	if lo,<			; above desired vertical position
	  mov #12,r0		; TOI arg: character
	  call toi		; output LF to move down one line
	  inc ttvpos(r3)	; keep track of movement
	  br 2$
	  >
	twrite ^"A"		; output ESC A to move up one line
	dec ttvpos(r3)		; keep track of movement
	br 2$
3$:	cmp tthpos(r3),thpos(r3)	; reached desired horizontal position?
	beq 4$				; yes
	if hi,<			; right of desired horizontal position
	  mov #10,r0		; TOI arg: character
	  call toi		; output BS to move left one column
	  dec tthpos(r3)	; keep track of movement
	  br 3$
	  >
				; left of desired horizontal position
        twrite ^"C"		; output ESC C to move right one column
	inc tthpos(r3)		; keep track of movement
	br 3$
4$:	pop (sp)		; remove arg from stack
	retrn1			; return1 for relative move (already done)


.sbttl	Ambassador

; always assemble
aaain===ttyin
aaaout===ttynop
aaaers===ttyers
aaaso0===ttynop
aaaso1===ttynop
aaaso2===ttynop
aaaso3===ttynop
aaabel===ttybel

; Initialize
aaaini:	twrite ^"[H[J"	; home, clear screen
	push #100		; Fill count for clear screen
	call aaafll		; send fill characters
	clr tthpos(r3)
	clr ttvpos(r3)
	clr thpos(r3)
	clr tvpos(r3)
	return

; Erase to end of line
aaaeol:	twrite ^"[K"
	return

; Erase to end of screen
aaaeos:	twrite ^"[J"
	return

aaaff===aaaeos

aaafll:	cmp ospeed(r3),#120.	; 1200 baud or less???
	if le,<			; no, don't pad
	  pop (sp)		; remove arg
	  return		; and return
	  >
	push (sp)
	clr 2(sp)		; TSENDN arg: character (# of times on stack)
	jmp tsendn		; send fill characters

;;; Cursor movement
aaamov:	push r0,r1,r2		; save regs
	push #4			; TERMOV arg: cost of direct cursor addressing
	call ansmov		; see if relative move is best
	  br 1$			; return1, relative move done
	twrite ^"Y"		; send cursor position code for AAA
	mov tvpos(r3),r0	; get vertical position
	add #40,r0		; put position into printable range
	call toi		; send vertical position
	mov thpos(r3),r0	; get horizontal position
	add #40,r0		; put position into printable range
	call toi		; send horizontal position
	mov tvpos(r3),ttvpos(r3)
	mov thpos(r3),tthpos(r3)
1$:	pop r2,r1,r0		; restore regs
	return


; ANSMOV is the escape sequence terminals' relative movement subroutine.
; If direct cursor addressing is best then ANSMOV outputs nothing and
; takes return2.  If relative cursor movement using CR, HOME, UP, DOWN,
; RIGHT, and LEFT commands is best then ANSMOV does the cursor movement
; and takes return1.  If %TOABS is clear then relative movement is always
; done.

;	ARGS:				VALS:
; SP ->	cost of direct cursor address	(none)

; RETURN1: Relative movement has been done
; RETURN2: Direct cursor addressing is best

ansmov:	cmp thpos(r3),#80.	; Horizontal position beyond abs
				; addressing??
        bge 2$			; yes, do relative movement
	mov #2,-(sp)		; scratch word, init to "home and rel move"
	mov tvpos(r3),r2	; get desired vertical position
	mov thpos(r3),r1	; get desired horizontal position
	mov r1,r0		; cost of home and move is V + 2H + 2
	inc r0			; ...
	asl r0			; ...
	add r2,r0		; ...
	bit #%toabs,topt(r3)	; supposed to use direct cursor addressing?
	if ne,<			; yes
	  cmp 4(sp),r0		; direct cursor addressing better than
				; home and relative move?
	  if lo,<		; yes
	    mov 4(sp),r0	; set minimum cost so far to that of direct
	    mov #4,(sp)		; address, change to "direct cursor address"
	    >
	  >
	sub ttvpos(r3),r2	; calculate vertical difference

	if mi,<			; negative, i.e. move up
	  neg r2		; make positive
	  asl r2		; times two to get cost
	  >
	sub tthpos(r3),r1	; calculate horizontal difference
	neg r1			; make backwards difference
	if mi,<			; negative, i.e. move forward
	  neg r1		; make positive
	  asl r1		; times two to get cost
	  >
	add r1,r2		; add horizontal and vertical costs
	cmp r2,r0		; relative move better than best so far?
	if lo,<			; yes
	  mov r2,r0		; set minimum cost so far to that of rel move
	  clr (sp)		; change to "relative move"
	  >
	sub r1,r2		; get back vertical cost
	add thpos(r3),r2	; add 2H + 1 which is cost of CR and
	add thpos(r3),r2	; relative movement
	inc r2			; ...
	cmp r2,r0		; CR and relative move better than best so far?
	if lo,<			; yes
	  mov #15,r0		; TOI arg: character
	  call toi		; output CR
	  clr tthpos(r3)	; keep track of movement
	  clr (sp)		; now do "relative movement"
	  >
	add (sp)+,pc		; dispatch on best method found
	br 2$			; "relative move"
	br 1$			; "home and relative move"
				; "direct cursor address"
	pop (sp)		; remove arg from stack
	retrn2			; return2 to indicate direct cursor move
				; is best
1$:	  twrite ^"[H"		; move to upper left corner of screen ("home")
	clr ttvpos(r3)		; account for home operation
	clr tthpos(r3)		; ...
2$:	cmp ttvpos(r3),tvpos(r3)	; reached desired vertical position?
	beq 3$				; yes
	if lo,<			; above desired vertical position
	  mov #12,r0		; TOI arg: character
	  call toi		; output LF to move down one line
	  inc ttvpos(r3)	; keep track of movement
	  br 2$
	  >
	twrite ^"[A"		; output ESC A to move up one line
	dec ttvpos(r3)		; keep track of movement
	br 2$
3$:	cmp tthpos(r3),thpos(r3)	; reached desired horizontal position?
	beq 4$				; yes
	if hi,<			; right of desired horizontal position
	  mov #10,r0		; TOI arg: character
	  call toi		; output BS to move left one column
	  dec tthpos(r3)	; keep track of movement
	  br 3$
	  >
				; left of desired horizontal position
        twrite ^"[C"		; output ESC C to move right one column
	inc tthpos(r3)		; keep track of movement
	br 3$
4$:	pop (sp)		; remove arg from stack
	retrn1			; return1 for relative move (already done)




.sbttl  VT100 / VT132 terminal support

vt1in===ttyin
vt1ers===ttyers
vt1bel===ttybel


.macro	vtwrit t
	jsr r5,toisc
	  .string ^~t~
	push #1			; VT1FLL arg: number of fill characters
	jsr r5,vt1fll		; send them
.endm

; send commands to VT132
vt1ini: vtwrit ^"<"		; ANSI mode
	vtwrit ^"[0m"		; no character attributes
	vtwrit ^"[0}"		; no fields protected
	vtwrit ^"[1;2q"	; turn LEDs 1 & 2 on
	vtwrit ^"[1;24r"	; define scroll region to be the whole screen.
        vtwrit ^">"		; Numeric keypad
	vtwrit ^"[20l"		; linefeed mode
	vtwrit ^"[?4l"		; jump scroll mode
	vtwrit ^"[?5l"		; normal video
	vtwrit ^"[?6l"		; absolute origin for movement
	cmp thmax(r3),#132.-1	; 132 column mode??
	if eq,<
	  vtwrit ^"[?3h"	; 132 column mode
	>
	else <
	  vtwrit ^"[?3l"	; 80 column mode
	>
	push #126.		; VT1FLL arg: number of fill characters
	call vt1fll		; send many fill characters for column
				; mode change
        vtwrit ^"[?7l"		; Wraparound off
	vtwrit ^"[?8h"		; Auto repeat on
	vtwrit ^"[?9l"		; Interlace off
	vtwrit ^"[?10h"	; Edit off

;;; Clear all TABs, set new ones and return to HOME.

        vtwrit ^"[H"		; return to home
	vtwrit ^"[3g"		; clear all tabs
	mov #16.,r0		; number of TAB stops to set
loop <    vtwrit ^"        H"	; move over 8 spaces and set a TAB
	  sorl r0
	  >
        vtwrit ^"[H"		; return to home
	vtwrit ^"[?2l"		; enter VT52 mode
	jmp vtini

; Output to terminal post processing
vt1out===vtout

; Erase to end of line
vt1eol===vteol

; Erase to end of screen
vt1eos===vteos

vt1ff===vt1eos

; Cursor movement
vt1mov===vtmov

; Standout mode 0 - normal
vt1so0===vtso0

; Standout mode 1 - blinking
vt1so1===vtso1

; Standout mode 2 - reverse video
vt1so2===vtso2

; Standout mode 3 - blinking reverse video
vt1so3===vtso3


vt1fll:	cmp ospeed(r3),#120.	; 1200 baud or less???
	if le,<			; no, don't pad
	  pop (sp)		; remove arg
	  return		; and return
	  >
	push (sp)
	clr 2(sp)		; TSENDN arg: character (# of times on stack)
	jmp tsendn		; send fill characters



cvd1:	mov #'0,r0		; TYPEC arg: char
	call toi		; send a 0 (first digit always 0)
cvd2:	clr r0			; for DIV
	div #10.,r0		; get tens in r0, ones in r3
	add #'0,r0
	call toi		; type tens
	mov r1,r0
	add #'0,r0
	call toi		; type ones
	return

.sbttl	HP2645

.if df %tnhp			; assemble only if we have one

hpers===ttyers
hpeol===vteol
hpeos===vteos
hpbel===ttybel
hpff===vteos

; Initialize
hpini:	twrite ^"HJ"		; home
	clr tthpos(r3)
	clr ttvpos(r3)
	clr thpos(r3)
	clr tvpos(r3)
	return

hpout===vt1out

; HP2645 input
hpin:	cmp r0,#137		; underscore?
	if eq,<
	  mov #177,r0		; change to DEL
	  return
	  >
	cmp r0,#177		; DEL?
	if eq,<
	  mov #137,r0		; change to underscore
	  >
	return


; Standout mode 0 - normal
hpso0:	twrite ^"&d@"
	return

; Standout mode 1 - blinking
hpso1:	twrite ^"&dA"
	return

; Standout mode 2 - reverse video
hpso2:	twrite ^"&dB&a79C"
	mov #79.,tthpos(r3)
	return

; Standout mode 3 - blinking reverse video
hpso3:	twrite ^"&dC&a79C"
	mov #79.,tthpos(r3)
	return


; Cursor movement
hpmov:	push r0,r1,r2		; save regs
	push #9			; TERMOV arg: cost of direct cursor addressing
	call termov		; see if relative move is best
	  br 1$			; return1, relative move done
	twrite ^"&a"		; send HP screen relative cursor code
	mov tvpos(r3),r1	; get vertical position
	call cvd2		; output vpos as two digits
	mov #'r,r0
	call toi		; tell HP that was vertical coordinate
	mov thpos(r3),r1	; get horizontal position
	call cvd2		; output hpos as two digits
	mov #'C,r0
	call toi		; tell HP that was horizontal position
	mov tvpos(r3),ttvpos(r3)
	mov thpos(r3),tthpos(r3)
1$:	pop r2,r1,r0		; restore regs
	return
.endc

.sbttl	StupidBee

.if df %tnsb
sbini===hpini
sbout===ttynop
sbers===ttyers
sbeol===vteol
sbeos===vteos
sbbel===ttybel
sbff===vteos

; StupidBee input
sbin:	bit #%toesc,topt(r3)
	if ne,<
	  bic #%toesc,topt(r3)
	  cmp r0,#'C
	  if eq,<
	    mov #40,r0
	    br 1$
	    >
	  cmp r0,#'p
	  if eq,<
	    mov #33,r0
	    br 1$
	    >
	  cmp r0,#'q
	  bne 1$
	  mov #3,r0
	  br 1$
	  >
	cmp r0,#33
	if eq,<
	  bis #%toesc,topt(r3)
	  jmp ti
	  >
1$:	return


; Standout mode 0 - normal
sbso0:	twrite ^"_3"
	return

; Standout mode 1 - blinking
sbso1:	twrite ^"_0"
	inc thpos(r3)
	inc tthpos(r3)
	return

; Standout mode 2 - reverse video
sbso2:	twrite ^"_1"
	inc thpos(r3)
	inc tthpos(r3)
	return

; Standout mode 3 - blinking reverse video
sbso3:	twrite ^"_2"
	inc thpos(r3)
	inc tthpos(r3)
	return


; Cursor movement
sbmov:	push r0,r1,r2		; save regs
	push #8.		; TERMOV arg: cost of direct cursor addressing
	call termov		; see if relative move is best
	  br 1$			; return1, relative move done
	twrite ^"F"		; send SB cursor position code 
	mov thpos(r3),r1
	call cvd1		; send three digit horizontal pos
	mov tvpos(r3),r1
	call cvd1		; send three digit vertical pos
	mov tvpos(r3),ttvpos(r3)
	mov thpos(r3),tthpos(r3)
1$:	pop r2,r1,r0		; restore regs
	return


.endc

.sbttl	Terminet 1200

.if df %tntrm
trmini===ttyini
trmin===ttyin
trmout===ttyout
trmers===ttyers
trmeol===ttyeol
trmeos===ttyeos
trmso0===ttyso0
trmso1===ttyso1
trmso2===ttyso2
trmso3===ttyso3
trmbel===ttybel
trmmov===ttymov
trmff===ttyff
.endc

; LA120 DecWriter III

la1in===ttynop
la1out===ttynop
la1eol===ttynop
la1so0===ttynop
la1so1===ttynop
la1so2===ttynop
la1so3===ttynop
la1ini===ttyini
la1ers===ttyers
la1bel===ttybel
la1mov===ttymov
la1eos===ttyeos

la1ff:	mov #14,r0		; tell the LA120 to do the form feed
	call toi
	clr thpos(r3)
	clr tvpos(r3)
	return

; LA180 DECprinter1

.if df %tnla8
la8in===ttynop
la8out===ttynop
la8eol===ttynop
la8so0===ttynop
la8so1===ttynop
la8so2===ttynop
la8so3===ttynop
la8ini===ttyini
la8ers===ttyers
la8bel===ttybel
la8mov===ttymov
la8eos===ttyeos
la8ff===la1ff
.endc

; TOISC takes a relative ptr to an asciz string and outputs it.
toisc:	push r1			; save reg
	mov r5,r1		; get relative ptr to asciz string
	add (r5)+,r1		; make absolute
	call tois
	pop r1			; restore reg
	rts r5

; TOIS takes a ptr to an asciz string in R1 and outputs it.
tois:	push r0			; save reg
loop <	  movb (r1)+,r0		; TOI arg: character
	  exitl eq		; null terminates string
	  call toi		; send character
	  rptl
	  >
	pop r0			; restore reg
	return


; TOI sends the character in R0 to the line specified in the TLINEN
; entry of the tty structure.
toi:	push tlinen(r3),r0	; ALWRIT args: line no., character
	call alwrit		; send character to line
	return


; TSENDN sends the specified no. of characters.

;	ARGS:				VALS:
; SP ->	character			(none)
;	no. of characters

tsendn:	push r0			; save reg
	mov 4(sp),r0		; TOI arg: character to send
loop <	  dec 6(sp)		; decrement no. of pad characters
	  exitl mi
	  call toi		; output character
	  rptl
	  >
	pop r0,(sp),(sp)	; restore reg, remove arg from stack
	return
ða                            The User200 Protocol

     The User200 protocol is brain-damaged.  It probably doesn't even work.

Messages the master whips the slave with:     
	Write message
	Poll message
	(Alert)

Messages the slave begs forgiveness with:
	Read message
	Acknowledge
	Reject
	Error

Example:

	Master			Slave
	------			-----

	Write-E1				message to display
				ACK		acknowledge write message
	POLL					request for user typein
				REJ		nothing to send
	POLL
				REJ
	POLL
				Read-E1		send user typein
	Write-E3				start reading card data
				ACK		acknowledge write message
	POLL					request send card data
				Read-E3		send card data
	Write-E3				start reading card data
				ACK
	POLL
				REJ		card data not ready
	POLL
				Read-E3
	Write-E3
				ACK
	POLL
				Read-E3 (error)	send card data
	POLL					request resend card data
				Read-E3
	Write-E3 (error)
				ERROR		error receiving write message
	Write-E3
				ACK
	POLL (error)
				ERROR
	POLL
				Read-E3
	Write-E3
				ACK (error)
	Write-E3
				ACK
	POLL
				Read-E2		send card data and indicate
						there is no more to follow
						(i.e.end of hopper or error)
	Write-E1
				ACK
	POLL					request for user typein
				REJ		nothing to send
	POLL
				REJ
	POLL
				Read-E1 (error)	send user typein
	POLL					request resend user typein
				Read-E1		resend user typein
	Write-E2				LPT data
				ACK		acknowledge write message
	POLL					query about LPT status
				Read-E3		LPT is ready
	Write-E2				more LPT data
				ACK
	POLL
				Read-E3		LPT still ok
	Write-E2				more LPT data
				ACK
	POLL
				Read-E2		LPT hung

;;;Local Modes:
;;;Mode:Text
;;;Auto Fill Mode:1
;;;Fill Column:70
;;;End: