thru the 3 ccl commands ; ; exit on end of commands ('0' at end of cmdblk:) ; ; use rsts channel number 11 and 12 (decimal) ; ; no time limit ; ; cmdblk: .word 10$,20$,30$,0 ; 10$: .asciz #PIP DB1:/L:S# ; 20$: .asciz #FOR JUNK=JUNK# ; 30$: .asciz #SY/N# ; .even ; ; calls $runjob ,<#cmdblk,#4,#11.,#0> ; tst r0 ; ; ; stack usage requirement: ; ; all internal vars and buffers need 170 decimal bytes ; of stack available ; ; internal register usage: ; ; r0 scratch, error return, single parameter passing ; r1 scratch, never saved on call/exit ; r2 address of next .asciz command ; r3 --> FIRQB+0 always ; r4 --> local data block (which is on the stack) ; r5 --> XRB+0 always ; .sbttl local data definitions .dsabl gbl .iif ndf ,edrt ,edrt = 0 .if ne ,edrt ; .priv is a null macro .ift ; for ted .macro .priv ; .endm .iff .globl .priv .endc ; for ted .macro $sleep t mov t ,xrb+0 .priv .sleep .endm $sleep .macro .print a,l ; perhaps minitab is here .if b, l ; or we are using this from .ift ; fortran or bp2 clr -(sp) ; no length, assume .asciz .iff ; length passed mov l ,-(sp) ; stuff it please .endc ; if b, len mov a ,-(sp) ; stuff string address call lprint ; and do it .endm .macro callr0 name ,arg mov arg ,r0 call name .endm callr0 CR = 15 FF = 14 LF = 12 NULL = 0 .macro iferr lab tst r0 bne lab .endm iferr .macro .newline ; print crlf on channel 0 (KB:) call l$pcrlf .globl l$pcrlf .endm .newline .macro save list .if b , .ift save .iff .irp x, mov x,-(sp) .endr .endc .endm save .macro unsave list .if b , .ift unsave .iff .irp x, mov (sp)+,x .endr .endc .endm unsave nodevc = 6 notavl = 10 eof = 13 daterr = 15 detkey = 33 corcom = 460 .asect ; define offsets from r4 for local vars . = 0 ; offsets start at zerp buflen = 150. ; size of the pk buffer buffer: .blkb buflen ; the pk buffer, at 0(r4) rcount: .blkw ; size of last kb or pk read kbddb: .blkw ; address controlling job's ddb for KB: pkddb: .blkw ; address of the pk's ddb pkjob2: .blkw ; job number times two for the pk job pkkbn: .blkw ; kb number of the PK: in use urts: .blkw 2 ; the controlling job's default RTS uppn: .blkw ; the controlling job's PPN upriv: .blkw ; <> 0 if controlling job is in (1,*) ujob2: .blkw ; the controlling job's job number * 2 cmds: .blkw ; copy of command block address abortf: .blkw ; copy of the termination flag pklun2: .blkw ; channel number times two for PK kblun2: .blkw ; channel number times two for KB timout: .blkw ; copy of elapsed time flag newppn: .blkw ; if switching ppn's inf: .blkw ; input file if given inbfa: .blkw ; input file buffer address outf: .blkw ; output file if given outbfa: .blkw ; output file buffer address influn: .blkw ; disk input file lun * 2 outflu: .blkw ; disk output file lun * 2 infpnt: .blkw ; disk input buffer pointer outfpn: .blkw ; disk output buffer pointer timini: .blkw ; initial time at entry here. cyc: .blkw lastch: .blkw ; last char of preceeding pk read kbintf: .blkw ; interface type for controlling job js.kb = 2 ; bit in JBWAIT for KB wait state .if ne ,edrt .ift stim = 1 .iff stim = 3 ; sleep time in main loop .endc swait = < << 60./stim >+1 > * stim> / 2 .iif le ,swait ,swait = 1 locsiz = . + 2 ; size of the local data .assume buffer eq 0 .psect $code ; bits defined in abortf(r4) f$ctld = 1 f$kmon = 2 f$eot = 4 f$nech = 10 f$nbin = 20 f$nppn = 40 f$nopr = 100 f$nopk = 200 str.cr: .byte 0,0 plogin: .rad50 /LOGIN / .word -1 crfail: .asciz /?Can't start job/ nopk: .asciz /?no PK's/ fatbug: .asciz /?bug in openpk/ .even .sbttl fortran/bp2 entry point .if eq ,edrtPDPPK MAC[.050036]PDPPK .MAC[.050036]    X14|H [4;Ik(&'( k ߫H&P` \RrPP2PPzPP{PPPPP2P~\$\\TD 0D \~ hi) +\ ^( n ^( np\^txY\^ˀ\!kVk<\F˰<˴ˬ\VVkˤ1`@lP ABCDEFGHIJKLMNOPQRSTUVWXYZ$.?0123456789<@<SЬTЬ UQS>?\\\\\\\\\`:#@'="\abcdefghi\\\\\\\jklmnopqr\\\\\\\~stuvwxyz\\\\\\\\\\\\\\\\\\\\\\{ABCDEFGHI\\\\\\}JKLMNOPQR\\\\\\\\STUVWXYZ\\\\\\0123456789\\\\\  !"#$%&'()*+,-./0123456789:;<=>?@ABCDEFGHIJKLMNOPQRSTUVWXYZ[\]^_`ABCDEFGHIJKLMNOPQRSTUVWXYZ{|}~@ggh<i|o<m<4p<p<k|Zn<l fr rwx<x<x<x޺<w@]@@fjnr]Ze@@|> | |v<H|  |  |xz|  |zt f r   < &^ @&@'*/V,"?Lh:hmBmz|z{x`y~|fN|@@|@͂|@ ݃ƃ<ns<|Ŏ |️|ep|u|-@率|<ﾲ2ֻr||ZRM | ntB|xyvZw|J=|R>|J? nnaa|bddf ; and exit 100$: .asciz /starting - / 110$: .byte cr,lf .even .endc ; not included for ted .sbttl main control loop .psect $code $runjo::clr -(sp) clr -(sp) clr -(sp) mov 6(r5) ,-(sp) mov 4(r5) ,-(sp) mov 2(r5) ,-(sp) mov @r5 ,-(sp) mov sp ,r5 call $$runj add #7*2 ,sp return $$runj: mov #jfsys ,xrb+0 ; get privs back if possible .priv ; prefix, if required. .set ; set keyword bit call to exec save ; should do this. sub #locsiz ,sp ; allocate space for us. mov sp ,r4 ; r4 will point to work area call init ; initial junk for startup bcs 100$ ; oops ! call openfi bcs 100$ ; oops ! call login ; login pk bcs 100$ ; oops call pkjobn ; get the pk job number * 2 call record ; record time-sharing session 100$: die: call clsout add #locsiz ,sp ; pop our work area from stack mov #firqb+fqfil,r3 ; useful address call $zapfqb movb #clsfq ,firqb+fqfun ; close the channels we used movb pklun2(r4),@r3 ; channels here .priv ; prefix as usual calfip call $zapfqb movb #clsfq ,firqb+fqfun ; close the channels we used movb kblun2(r4),@r3 ; channels here .priv ; prefix as usual calfip unsave mov #jfsys ,xrb+0 ; drop privs at exit .priv ; .clear ; drop bits in keyword call return .sbttl initial stuff .assume uppn eq .assume upriv eq .assume ujob2 eq .assume cmds eq .assume abortf eq .assume pklun2 eq .assume kblun2 eq .assume timout eq .assume newppn eq .assume inf eq .assume inbfa eq .assume outf eq .assume outbfa eq .assume influn eq .assume outflu eq init: call $zapfqb ; zap the firqb first please mov r4 ,r1 ; clear out the local vars mov #locsiz-2,r0 ; which we allocated on the 5$: clrb (r1)+ ; stack sob r0 ,5$ ; all of it please movb #uu.sys ,firqb+fqfun ; systat sys call with subfun .priv ; zero to get default user .uuo ; runtime system. mov firqb+12,timini(r4) ; save user's connect mov #swait ,cyc(r4) ; stuff control for time check mov r4 ,r3 ; Base address of impure area. add #urts ,r3 ; we will start here. mov firqb+30,(r3)+ ; copy two rad50 words for mov firqb+32,(r3)+ ; user's default rts mov firqb+26,(r3)+ ; and the ppn for our user. clr (r3)+ ; set the user is (1,*) flag cmpb #1 ,(r4) ; perm privs here ? bne 10$ ; nop mov sp ,-2(r3) ; yes, set a flag then 10$: movb firqb+fqjob,(r3)+ ; job number times 2 clrb (r3)+ ; to be sure, get high byte out mov (r5)+ ,(r3)+ ; save command string address mov (r5)+ ,(r3)+ ; save the abort flag mov (r5)+ ,r0 ; starting lun to use for the ble 100$ ; pk and for the kb. Must be asl r0 ; > 0 mov r0 ,(r3)+ ; pk lun is the first one add #2 ,r0 ; kblun2 = pklun2 + 2 mov r0 ,(r3)+ ; thats all mov (r5)+ ,(r3)+ ; job elapsed time parameter. mov (r5)+ ,(r3)+ ; alternate ppn bit #f$nppn ,abortf(r4) ; really do this bne 20$ ; yes clr -2(r3) ; no 20$: mov (r5)+ ,r0 ; get input file block beq 30$ ; a null parameter there mov 2(r0) ,inbfa(r4) ; save input buffer address mov @r0 ,r0 ; get filename address now. tstb @r0 ; anything there ? beq 30$ ; no, leave name address eq 0 mov r0 ,inf(r4) ; yes, save address mov kblun2(r4),influn(r4) ; also allocate a channel add #2 ,influn(r4) 30$: mov (r5)+ ,r0 ; get output file block beq 40$ ; a null parameter there mov 2(r0) ,outbfa(r4) ; save output buffer address mov @r0 ,r0 ; get filename address now. tstb @r0 ; anything there ? beq 40$ ; no, leave name address eq 0 mov r0 ,outf(r4) ; yes, save address mov kblun2(r4),outflu(r4) ; also allocate a channel add #4 ,outflu(r4) 40$: 100$: clr r0 mov #520. ,xrb+0 ; get the controlling job's .priv ; kbddb as: .peek ; peek(peek(peek(520.))) .priv PDPPK MAC[.050036]PDPPK .MAC[.050036]    X14|H [4;Ik(&'( k ߫H&P` \RrPP2PPzPP{PPPPP2P~\$\\TD 0D \~ hi) +\ ^( n ^( np\^txY\^ˀ\!kVk<\F˰<˴ˬ\VVkˤ1`@lP ABCDEFGHIJKLMNOPQRSTUVWXYZ$.?0123456789<@<SЬTЬ UQS>?\\\\\\\\\`:#@'="\abcdefghi\\\\\\\jklmnopqr\\\\\\\~stuvwxyz\\\\\\\\\\\\\\\\\\\\\\{ABCDEFGHI\\\\\\}JKLMNOPQR\\\\\\\\STUVWXYZ\\\\\\0123456789\\\\\  !"#$%&'()*+,-./0123456789:;<=>?@ABCDEFGHIJKLMNOPQRSTUVWXYZ[\]^_`ABCDEFGHIJKLMNOPQRSTUVWXYZ{|}~@ggh<i|o<m<4p<p<k|Zn<l fr rwx<x<x<x޺<w@]@@fjnr]Ze@@|> | |v<H|  |  |xz|  |zt f r   < &^ @&@'*/V,"?Lh:hmBmz|z{x`y~|fN|@@|@͂|@ ݃ƃ<ns<|Ŏ |️|ep|u|-@率|<ﾲ2ֻr||ZRM | ntB|xyvZw|J=|R>|J? nnaa|bddf firqb+12,-(sp) ; save this for a moment. movb #uu.tb1 ,firqb+fqfun ; get tables part 1 for the .priv ; devptr .uuo ; rsts does it again ! mov firqb+10,@r5 ; @r5 := devptr add (sp)+ ,@r5 ; plus devokb .priv ; now get devtbl as .peek ; peek( devtbl+edvokb ) mov r0 ,-(sp) ; add in the kbnumber times 2 asl (sp) ; to get the ddb of the tty. add (sp)+ ,@r5 ; all set now. .priv ; prefix if needed. .peek ; and peek at it. mov @r5 ,r0 ; return kbddb in r0. clc ; no errors return ccstate:call $zapfqb ; see if job is in KB ^C wait movb #uu.sys ,firqb+fqfun ; do a job systat part 2 incb firqb+5 ; movb pkjob2(r4),firqb+4 ; where the job number goes asrb firqb+4 ; not times two for .uuo .priv ; of course .uuo ; get rsts cmp firqb+14,#js.kb ; jbwait show a kb wait ? clc ; restore possible c bit set bne 10$ ; no, time to leave now. mov firqb+32,@r5 ; stuff JDB address for a peek add #6 ,@r5 ; we need address of jdwork .priv ; of course .peek ; sneak a look at the exec add #10. ,@r5 ; finally where to look at in .priv ; the job's work block. .peek ; and so on ....... tst @r5 ; < 0 bpl 10$ ; no, exit with no wait sec ; yes, flag as ^C(0) wait. 10$: return .sbttl check out the pk's status ttyou: mov r0 ,@r5 ; see if pk is doing tt output add #10. ,@r5 ; check buffer chains .priv ; you know .peek ; only a privledged few can do mov @r5 ,-(sp) ; this, you know. mov r0 ,@r5 ; one more time please add #12. ,@r5 ; and so on .priv ; .peek ; and get the peeker cmp (sp)+ ,@r5 ; empty yet ? bne 10$ ; no clc ; yes return 10$: sec return ; note: following code from ATPK (with minor mods) pksts: save call pkjobn ; get the job number for PKn: clr r0 ; are we the same job number ? mov pkjob2(r4),r1 ; save it here cmpb r1 ,ujob2(r4) ; if so, then login is not done bne 10$ ; ok com r0 ; no, we are the same job. 10$: tstb r1 ; a real job there yet ? beq 20$ ; no call $zapfqb ; yes, get the job's ppn movb #uu.sys ,firqb+fqfun ; use the uu.sys instead of movb r1 ,firqb+4 ; of a bunch of peeking at asrb firqb+4 ; rsts. .priv ; you know .uuo ; get job stats function 0 mov firqb+26,r1 ; and stuff ppn into r1. 20$: tst upriv(r4) ; running in (1,*) ? bne 30$ ; yes, status is ok for now tst r1 ; try ppn (or jobnun times 2) bne 30$ ; real ppn or job number mov #-2 ,r0 ; set bad status up 30$: tst r0 ; bad status by now ? bne 100$ ; yes, time to go for now. call $zapxrb ; ok so far, is the PK in a mov #str.cr ,xrb+xrloc ; condition to accept stuff inc xrb+xrlen ; buffer size of 1 inc xrb+xrbc ; same thing goes here movb pklun2(r4),xrb+xrci ; channel number times 2 mov #6 ,xrb+xrmod ; basic+ 'record' modifier if kb .priv ; once again .write ; finally ! movb @r3 ,r0 ; errors ? 100$: tst r0 ; errors ? beq 110$ sec ; tst does a clc,'mov' leaves it 110$: unsave ; pop regs, retain status and return ; exit .sbttl openpk - open 'pk?:' as file 2 openpk: mov #-1,r1 ; init pk at -1 10$: inc r1 ; next pk call $zapfqb ; clean firqb movb pklun2(r4),@#firqb+fqfil ; channel 2 mov #buflen,@#firqb+fqbufl ; buffer length mov #"PK,@#firqb+fqdev ; 'pk?:' movb r1,@#firqb+fqdevn ; pk number movb #-1,@#firqb+fqdevn+1 ; unit is real movb #opnfq,@#firqb+fqfun ; open function .priv ; have rsts calfip ; open the pk movb @r3 ,r0 ; any problems? beq 30$ ; no, go return cmpb #notavl,@r3 ; not available ? beq 10$ ; yes, try for another cmpb #nodevc,@r3 ; not valid device ? bne 50$ ; unknown RSTS error happened .print #nopk br 50$ ; bye 30$: call $zapfqb ; zap firqb movb #uu.fcb,@#firqb+fqfun ; fcb function movb pklun2(r4),@#firqb+fqfil ; channel 2 asrb firqb+fqfil ; not times two here .priv ; have rsts .uuo ; return fcb info movb @r3PDPPK MAC[.050036]PDPPK .MAC[.050036]    X14|H [4;Ik(&'( k ߫H&P` \RrPP2PPzPP{PPPPP2P~\$\\TD 0D \~ hi) +\ ^( n ^( np\^txY\^ˀ\!kVk<\F˰<˴ˬ\VVkˤ1`@lP ABCDEFGHIJKLMNOPQRSTUVWXYZ$.?0123456789<@<SЬTЬ UQS>?\\\\\\\\\`:#@'="\abcdefghi\\\\\\\jklmnopqr\\\\\\\~stuvwxyz\\\\\\\\\\\\\\\\\\\\\\{ABCDEFGHI\\\\\\}JKLMNOPQR\\\\\\\\STUVWXYZ\\\\\\0123456789\\\\\  !"#$%&'()*+,-./0123456789:;<=>?@ABCDEFGHIJKLMNOPQRSTUVWXYZ[\]^_`ABCDEFGHIJKLMNOPQRSTUVWXYZ{|}~@ggh<i|o<m<4p<p<k|Zn<l fr rwx<x<x<x޺<w@]@@fjnr]Ze@@|> | |v<H|  |  |xz|  |zt f r   < &^ @&@'*/V,"?Lh:hmBmz|z{x`y~|fN|@@|@͂|@ ݃ƃ<ns<|Ŏ |️|ep|u|-@率|<ﾲ2ֻr||ZRM | ntB|xyvZw|J=|R>|J? nnaa|bddfl openkb ; open it mode 1 10$: bit #f$nopr ,abortf(r4) ; kill on logout? beq 15$ ; no mov pkddb(r4),xrb+0 ; get ddb address add #2 ,xrb+0 ; need to look at the jobnumber .priv ; times 2 .peek ; if no job number then the tstb xrb+0 ; pk has logged out beq 60$ ; if so, abort and return 15$: call getkb ; get kb data cmp #1,rcount(r4) ; recount = 1 bne 20$ ; no, continue movb @r4,r0 ; take first byte bicb #200,r0 ; trim parity cmpb r0,#'D-100 ; is it term character ? bne 20$ ; yes, go return bit #f$ctld ,abortf(r4) ; really exit on control D ? bne 60$ ; yep 20$: cmpb #daterr,@r3 ; nothing there ? beq 30$ ; yes, try pk cmpb #detkey ,@r3 ; controling job detach ? beq 60$ ; no callr0 putpk ,r4 ; put out to the pk br 35$ 30$: call pksts ; Is the job ready for a bcs 35$ ; a command yet ? callr0 ttyou ,pkddb(r4) ; currently printing on PK: bcs 35$ ; yep callr0 ttyou ,kbddb(r4) ; check tty out bcs 35$ ; TTY is still busy then tst (r2) ; next command ? beq 31$ ; all done folks call docmd ; do a command br 35$ 31$: call jstop ; End of comamnds, see if we bcs 60$ ; should quit now. 35$: call getpk ; get pk data cmpb #eof,@r3 ; pk say anything ? bne 40$ ; yes, continue $sleep #stim ; take a quick nap here br 55$ ; and try later 40$: call errchk ; scan for a '?' as first char bcc 50$ ; no, all is well tst abortf(r4) ; keep going on error (<0) ? bmi 50$ ; yep call putkb ; a problem, print error out call putout mov #-1 ,r0 ; and exit br 70$ 50$: call putkb ; tell the kb call putout 55$: call timchk ; job elapsed time run out yet? bcs 70$ ; yep, so exit now. br 10$ 60$: clr r0 ; a normal exit 70$: return .sbttl stop check for termination yet jstop: bit #f$eot ,abortf(r4) ; stop on end of the command bne 100$ ; yes, bye bit #f$kmon ,abortf(r4) ; stop on control c wait(0) beq 90$ ; no call ccstate ; check for ^C state bcs 100$ ; exit if cc wait 90$: clc return 100$: sec return docmd: mov @r2 ,r0 ; compute command line length 10$: tstb (r0)+ ; end of .asciz string ? bne 10$ ; no sub @r2 ,r0 ; yes, get length now dec r0 ; off by one mov r0 ,rcount(r4) ; put it there for putpk callr0 putpk ,(r2)+ ; and do it 100$: return .if eq ,edrt ; normal mode .ift timchk: dec cyc(r4) ; check job time yet ? bgt 100$ ; no, just exit. mov #swait ,cyc(r4) ; check, so reset cycle count. tst timout(r4) ; but should we check at all ? ble 100$ ; no, so just exit. ;- call $zapfqb ; clear out firqb for uu.sys ;- movb #uu.sys ,firqb+fqfun ; set uuo function (job systat) ;- movb pkjob2(r4),firqb+fqfun+1; insert job number here ;- asrb firqb+fqfun+1 ; not times two please. ;- .priv ; just in case (is global sym) ;- .uuo ; get job stats back in firqb ;- sub timini(r4),firqb+12 ; get total time controlling pk ;- cmp firqb+12,timout(r4) ; time to abort job yet ? .priv ; the pk job stats only seem to .time ; get updated whenever there is sub timini(r4),xrb+2 ; some activity on the job's pk cmp xrb+2 ,timout(r4) ; so use controlling jobs time. blt 100$ ; If lt, do not kill pkjob yet. mov #-3 ,r0 ; set return status code. sec ; yes, also set carry. Now exit return ; for job time exceeded. 100$: clc return .iff ; skip this for inclusion into ; ted. timchk: clc ; return all is well for TED. return .endc ; .if eq, edrt .sbttl getkb - get data from kb getkb: call $zapxrb ; clean xrb mov #buflen,@#xrb+xrlen ; buffer length mov r4,@#xrb+xrloc ; buffer location movb kblun2(r4),@#xrb+xrci ; channel 1 mov #8192.,@#xrb+xrmod ; record 8192% .priv ; have rsts .read ; read from kb mov @#xrb+xrbc,rcount(r4) ; save rcount return ; back to work... .sbttl putkb - put data to kb putkb: call $zapxrb ; clean xrb mov #buflen,@#xrb+xrlen ; buffer length mov PDPPK MAC[.050036]PDPPK .MAC[.050036]    X14|H [4;Ik(&'( k ߫H&P` \RrPP2PPzPP{PPPPP2P~\$\\TD 0D \~ hi) +\ ^( n ^( np\^txY\^ˀ\!kVk<\F˰<˴ˬ\VVkˤ1`@lP ABCDEFGHIJKLMNOPQRSTUVWXYZ$.?0123456789<@<SЬTЬ UQS>?\\\\\\\\\`:#@'="\abcdefghi\\\\\\\jklmnopqr\\\\\\\~stuvwxyz\\\\\\\\\\\\\\\\\\\\\\{ABCDEFGHI\\\\\\}JKLMNOPQR\\\\\\\\STUVWXYZ\\\\\\0123456789\\\\\  !"#$%&'()*+,-./0123456789:;<=>?@ABCDEFGHIJKLMNOPQRSTUVWXYZ[\]^_`ABCDEFGHIJKLMNOPQRSTUVWXYZ{|}~@ggh<i|o<m<4p<p<k|Zn<l fr rwx<x<x<x޺<w@]@@fjnr]Ze@@|> | |v<H|  |  |xz|  |zt f r   < &^ @&@'*/V,"?Lh:hmBmz|z{x`y~|fN|@@|@͂|@ ݃ƃ<ns<|Ŏ |️|ep|u|-@率|<ﾲ2ֻr||ZRM | ntB|xyvZw|J=|R>|J? nnaa|bddft(r4),#1000 ; buffer full yet ? blo 30$ ; no call wrtout ; yes, dump buffer out to disk clr outfpnt(r4) ; and init the buffer pointer save ; now clear the buffer out mov #1000 ,r0 ; 1000 bytes to clear 20$: clrb (r1)+ ; r1 already had the buffer addres sob r0 ,20$ ; next byte please unsave ; pop these back 30$: add outfpnt(r4),r1 ; point to next free byte in buffer movb (r2)+ ,@r1 ; next byte please inc outfpnt(r4) ; get set for next byte sob r0 ,10$ ; next please 100$: unsave return wrtout: save call $zapxrb mov #xrb ,r0 ; pointer to xrb mov #1000 ,(r0)+ ; xrb.xrlen := 1000 (8) mov #1000 ,(r0)+ ; xrb.xrbc := 1000 mov outbfa(r4),(r0)+ ; xrb.xrloc := buffer_address movb outflu(r4),@r0 ; channel number times 2 .priv ; rt11.rts prefix needed? .write ; simple unsave return .iff ; if edrt <> 1 then dummy call putout: wrtout: return .endc ; if eq, edrt .sbttl error checking on the PK .if eq ,edrt ; leave out for ted, else in .ift ; not ted errchk: save mov r4 ,r2 ; address of text to check mov rcount(r4),r1 ; initial length 10$: clr r0 ; position in the string mov r2 ,-(sp) ; replace instr call please mov r1 ,-(sp) ; save pointer and length ble 25$ ; no text in the string ? 20$: inc r0 ; pos := succ(pos) cmpb (r2)+ ,#'? ; find a possible error msg? beq 25$ ; perhaps sob r1 ,20$ ; no, try the next one clr r0 ; no match, set position to 0 25$: mov (sp)+ ,r1 mov (sp)+ ,r2 cmp r0 ,#1 ; by a line terminator like blt 100$ ; a cr,lf or ff. bgt 30$ ; Not at start of the line cmp r2 ,r4 ; at the start of the record? bne 30$ ; no, nothing special to do. cmpb lastch(r4),#cr ; Was first char of record, look bhi 40$ ; at the last char of prev rec. br 110$ ; fatal error, exit with 'c' 30$: mov r2 ,-(sp) ; Check preceeding char for add r0 ,(sp) ; a line terminator here. dec (sp) ; peek at the previous char dec (sp) ; peek at the previous char cmpb @(sp)+ ,#cr ; well ? blos 110$ ; bye 40$: add r0 ,r2 ; No error, skip past the '?' sub r0 ,r1 ; and adjust the line length. bgt 10$ ; and try once again 100$: clc ; no error, exit ok br 120$ ; pop registers and leave. 110$: sec 120$: unsave return 200$: .asciz /?/ .iff ; for ted, save the space errchk: clc ; no error return ; and exit .endc errmsg: movb firqb ,firqb+4 ; pass error number to fip movb #errfq ,firqb+fqfun ; fip function .priv ; rt emu perhaps ? calfip ; simple to do clrb firqb+37 ; insure .asciz please .print #firqb+4 ; print the .asciz string return .sbttl zero firqb out .if eq ,edrt ; if not in TED, include this .ift $zapfqb: mov r0 ,-(sp) mov r1 ,-(sp) mov #firqb ,r1 mov #40/2 ,r0 1$: clr (r1)+ sob r0 ,1$ mov (sp)+ ,r1 mov (sp)+ ,r0 return .iff global <$zapfqb> .endc $zapxrb:mov r0 ,-(sp) mov #xrb ,r0 10$: clr (r0)+ cmp r0 ,#xrb+xrmod ble 10$ mov (sp)+ ,r0 return lprint: mov r0 ,-(sp) ; .asciz string printer. put mov 6(sp) ,r0 ; it here to avoid global refs bne 20$ ; a real length was passed mov 4(sp) ,r0 ; zero length, assume .asciz 10$: tstb (r0)+ ; and find the length of it bne 10$ ; no, keep going sub 4(sp) ,r0 ; subtract string address from dec r0 ; current pointer + 1. 20$: call $zapxrb ; clear xrb out mov 4(sp) ,xrb+xrloc ; stuff buffer address for RSTS mov r0 ,xrb+xrlen ; and the length twice mov r0 ,xrb+xrbc ; again .priv ; rt perhaps? emt 4 ; do a .write mov (sp)+ ,r0 ; pop the register we used mov (sp) ,4(sp) ; bubble return address up cmp (sp)+ ,(sp)+ ; pop parameter list at last return ; bye .end PDPPK MAC[.050036]PDPPK .MAC[.050036]   X14|H [4;Ik(&'( k ߫H&P` \RrPP2PPzPP{PPPPP2P~\$\\TD 0D \~ hi) +\ ^( n ^( np\^txY\^ˀ\!kVk<\F˰<˴ˬ\VVkˤ1`@lP ABCDEFGHIJKLMNOPQRSTUVWXYZ$.?0123456789<@<SЬTЬ UQS>