.title diskio i/o modeled after VMS i/o, taken from Kermit-11 .ident /1.0.01/ .library /lb:[1,1]rmsmac.mlb/ ; 20-Jun-85 16:38:04 Brian Nelson ; ; For proper documentation, see DISKIO.MAR (the VMS version) ; for detailed explanations of functions. .macro strcat dst,src mov src ,-(sp) mov dst ,-(sp) jsr pc ,strcat .globl strcat .endm strcat .macro strcpy dst,src mov src ,-(sp) mov dst ,-(sp) jsr pc ,strcpy .globl strcpy .endm strcpy .macro indexm reg ; check for auto increment/decrement .ntype $$$0 ,reg ; modes for macro's that can't have .if ne ,$$$0-27 ; always allow pc autoincrement $$$0 = <$$$0 & 177770>/10 ; these modes in their arg list. .ift ; .if ge ,$$$0-2 ; get the mode into 0..7 .ift ; if mode >= 2 and mode <= 5 then error .iif ge ,5-$$$0, .error ; can't use auto inc/dec mode here .endc ; .endc ; .endm indexm ; end of indexm macro .macro push reg mov reg ,-(sp) .endm push .macro pop reg mov (sp)+ ,reg .endm pop .macro scan ch,str mov str ,-(sp) clr -(sp) bisb ch ,@sp call scanch .globl scanch .endm scan .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 .macro print s,l .print s,l .endm print .MACRO GLOBAL LIST .GLOBL LIST .ENDM GLOBAL .MACRO .ASSUME ARG1,COND,ARG2 .IF COND - .IFF .ERROR ARG1 ;"COND ARG2" FAILS .ENDC .ENDM .ASSUME .macro .chksp arg .ntype $$5 ,arg .iif eq,<$$5 & 7>-6, .error arg ; Illegal use of SP(r6) in call .endm .chksp ; CALLS macro ; ; subroutine call with arguements passed in an area ; pointed to by R5 (similiar to F4 and BP2). All args ; are pushed onto the stack, with the first args at ; the lower address and the last ones at the higher ; addresses. R5 will point to the SP before the call. ; R5 is saved and restored. .macro calls name,arglst,gbl ; standard call macro using ; the hardware stack (%6) for .if b, gbl .ift .globl name .iff .iif dif, 'gbl ,nogbl, .globl name .iif dif, 'gbl ,NOGBL, .globl name .endc $$ = 0 ; arguement transmission with .irp x , ; r5 passed as a pointer to $$ = $$ + 1 ; to the arguement list. The .endr ; called name is declared globl .if eq ,$$ ; No args present ? If so, gen .ift ; a simple jsr pc call to sub. jsr pc ,name ; No argument list given. .iff push r5 ; At least one arg in .if eq , $$ - 1 ; One arguement in the list .ift mov arglst ,-(sp) ; One arg. Generate less code .chksp arglst ; Check for SP modes on param. mov sp ,r5 ; Set pointer to argument list jsr pc ,name ; call the subroutine tst (sp)+ ; pop parameter list from stack pop r5 ; restore r5 pointer .iff ; argcount > 1 $$2 = $$ ; more than 1 arguement. Thus .rept $$ ; extract the args in reverse $$1 = 0 ; order so that we might save .irp x , ; a little core (4 words). $$1 = $$1 + 1 ; Scan the arg list until we .if eq , $$2 - $$1 ; we come to the last one we .ift ; before the one we just did. .chksp x ; Check for SP addressing mode. mov x ,-(sp) ; Push it, and exit the .irp. .mexit ; exit .endc .endr $$2 = $$2 - 1 ; backwards to previous arg. .endr mov sp ,r5 ; Set up the argument lst ptr. jsr pc ,name ; and go to the routine. .if ne , $$ - 2 ; Gen 'Add 2*argnum, sp' ? .ift ; yes, else gen CMP (sp)+,(sp)+ add #$$*2 ,sp ; fix the stack up, restore r5 .iff cmp (sp)+ ,(sp)+ .endc unsave ; restore r5 pointer .endc .endc .endm calls ; thats all cr = 15 lf = 12 ff = 14 soh = 1 nb$nod = 400 ; Node in file or default string (FNB in NAM) .enabl gbl .save .globl $vexta .psect $$vex1 ,rw,d,gbl,rel,ovr .vex1: .word termtype .word systyp .word ttinit .restore .psect rmscod ,ro,i,lcl,rel,con .psect rmsdat ,rw,d,lcl,rel,con systyp::.word 0 ttinit: .word 0 .mcall fabof$ .mcall rabof$ .mcall xabof$ fabof$ RMS$L rabof$ RMS$L xabof$ RMS$L .mcall fab$b ,fab$e ,rab$b ,rab$e .mcall xab$b ,xab$e .mcall nam$b ,nam$e .mcall $initif ,org$ .mcall pool$b ,pool$e ,p$bdb ,p$fab .mcall p$rabx ,p$idx ,p$buf .mcall $compar ,$fetch ,$store ,$rewin .mcall $close ,$creat ,$erase ,$open .mcall $connec ,$delet ,$discon,$find .mcall $get ,$put ,$updat ,$flush .mcall $read ,$write ,$off ,$set .mcall $testbit,$parse .psect rmsdat ,rw,d,lcl,rel,con org$ SEQ, .psect rmsdat ,rw,d,lcl,rel,con ; task extension or to use rmsbuf::pool$b ; static pools p$rab 8. ; plenty of record streams p$bdb 7 ; same goes for block buffers p$fab 7 ; up to 2 fabs (needed for search) p$buf 1024. ; for 1 files and directory i/o pool$e ; end of static pool .psect rmsdat ,rw,d,lcl,rel,con .sbttl rms file access blocks facc = fb$get ! fb$put nowin: .asciz /Dynamic region creation failed %d/<12> .even tmpnam: .ascii /SY:EDIT.TMP/ tmplen = 13 .even fab$work:: fab$b f$alq 40. ; initial allocation of 40 blocks f$deq 5 ; Extend size f$fac fb$rea!fb$wri ; allowed i/o operations f$fna tmpnam ; name of the file f$fns tmplen ; length of the filename f$fop fb$tmp!fb$sup!fb$mkd ; supercede old versions f$lch 1 ; channel number to use f$mrs 1024. ; maximum recordsize f$org fb$seq ; seq f$rat 0 ; implied carriage control f$rfm fb$fix ; variable length records f$shr FB$NIL ; No sharing fab$e fab$scwork:: fab$b f$alq 8. ; initial allocation of 8 blocks f$deq 5 ; Extend size f$fac fb$rea!fb$wri ; allowed i/o operations f$fna tmpnam ; name of the file f$fns tmplen ; length of the filename f$fop fb$tmp!fb$sup!fb$mkd ; supercede old versions f$lch 2 ; channel number to use f$mrs 512. ; maximum recordsize f$org fb$seq ; seq f$rat 0 ; implied carriage control f$rfm fb$fix ; variable length records f$shr FB$NIL ; No sharing fab$e fab$c1:: fab$b f$alq 8. ; initial allocation of 8 blocks f$deq 5 ; Extend size f$fac fb$rea!fb$wri ; allowed i/o operations f$fna tmpnam ; name of the file f$fns tmplen ; length of the filename f$fop fb$tmp!fb$sup!fb$mkd ; supercede old versions f$lch 3 ; channel number to use f$mrs 512. ; maximum recordsize f$org fb$seq ; seq f$rat 0 ; implied carriage control f$rfm fb$fix ; variable length records f$shr FB$NIL ; No sharing fab$e fab$c2:: fab$b f$alq 8. ; initial allocation of 8 blocks f$deq 5 ; Extend size f$fac fb$rea!fb$wri ; allowed i/o operations f$fna tmpnam ; name of the file f$fns tmplen ; length of the filename f$fop fb$tmp!fb$sup!fb$mkd ; supercede old versions f$lch 4 ; channel number to use f$mrs 512. ; maximum recordsize f$org fb$seq ; seq f$rat 0 ; implied carriage control f$rfm fb$fix ; variable length records f$shr FB$NIL ; No sharing fab$e fab$file:: fab$b f$alq 0 ; initial allocation of 10 blocks f$fac facc ; allowed i/o operations f$fns 0 ; length of the filename f$fop fb$sup ; supercede old versions f$lch 6 ; channel number to use f$org fb$seq ; seq f$rat fb$cr ; implied carriage control f$rfm fb$var ; variable length records fab$e fab$ind:: fab$b f$alq 0 ; initial allocation of 10 blocks f$fac fb$get ; allowed i/o operations f$fns 0 ; length of the filename f$fop fb$sup ; supercede old versions f$lch 7 ; channel number to use f$org fb$seq ; seq f$rat fb$cr ; implied carriage control f$rfm fb$var ; variable length records fab$e fab$hl:: fab$b f$fac fb$rea ; allowed i/o operations f$lch 8 ; channel number to use f$mrs 512. ; maximum recordsize f$org fb$seq ; seq f$rat 0 ; implied carriage control f$rfm fb$fix ; variable length records fab$e fab$nex:: fab$b f$alq 0 ; initial allocation of 10 blocks f$fac fb$get!fb$put ; allowed i/o operations f$fop fb$sup ; supercede old versions f$lch 9 ; channel number to use f$nam nam$nex fab$e fab$sea:: fab$b f$alq 0 ; initial allocation of 10 blocks f$fac fb$get!fb$put ; allowed i/o operations f$fop fb$sup ; supercede old versions f$lch 9 ; channel number to use f$nam nam$sea fab$e nam$sea:: nam$b n$esa expnam n$ess 64. n$rsa resnam n$rss 64. nam$e nam$nex:: nam$b n$esa expnam n$ess 64. n$rsa resnam n$rss 64. nam$e nxtwdi::.word 0 nxtwcc::.word 0 oldwdi::.word 0 oldwcc::.word 0 oldidx::.word 0 expnam: .blkb 100 resnam: .blkb 100 sydisk::.ascii /SY:/ sylen == . - sydisk .even sydska == sydisk sydskl == sylen cwork = 0 cwork1 = 1 ccut1 = 2 ccut2 = 3 cfile == 4 cind == 5 fablst::.word fab$work,fab$scwork,fab$c1,fab$c2,fab$file,fab$ind,0,0,0,0,0,0 rablst::.word rab1 ,rab2 ,rab3 ,rab4 ,rab5 ,rab$ind,0,0,0,0,0,0 cutmap::.word ccut1 ,ccut2 ,0 ,0 ,0 ,0 cutope::.word 0 ,0 ,0 ,0 ,0 ,0 tempma::.word cwork ,cwork1 ,0 ,0 ,0 ,0 rab1:: rab$b ; define record access block r$fab fab$work ; associate a fab with this rab rab$e ; end of record access block rab2:: rab$b ; define record access block r$fab fab$scwork ; associate a fab with this rab rab$e ; end of record access block rab3: rab$b ; define record access block r$fab fab$c1 ; associate a fab with this rab rab$e ; end of record access block rab4: rab$b ; define record access block r$fab fab$c2 ; associate a fab with this rab rab$e ; end of record access block rab$fi:: rab5: rab$b r$fab fab$file rab$e rab$in::rab$b r$fab fab$ind rab$e rab$hl::rab$b r$fab fab$hl rab$e proxab::xab$b XB$PRO x$nxt 0 x$pro 0 xab$e proset: .word 0 inpro: .word 0 inprg: .word 0 inprj: .word 0 inrat: .word 0 inrfm: .word 0 rwfunc: .word 0 tedsyserror:: .word 0,0 markast:.word 0 .psect rmscod reterr::mov tedsyserror,r0 return .sbttl read/write blocks for workfiles ; GETTBLOCK(buffer_address,size,vbn,window) ; PUTTBLOCK(buffer_address,size,vbn,window) ; ; Decus C conventions: ; ; Passed: ; 2(sp) buffer address ; 4(sp) size ; 6(sp) vbn ; 10(sp) window ; ; Return: r0 zero for error, one for success ; $nsave = 6 gettblock:: cmpb systype ,#4 ; RSTS/E ? bne 10$ ; No jmp rstsge ; Yes, goto reslib 10$: clr rwfunc br reawri puttblock:: cmpb systype ,#4 ; RSTS/E ? bne 10$ ; No jmp rstspu ; Yes, goto reslib 10$: mov sp ,rwfunc br reawri reawri: save ; save temp registers please mov 10+$nsave(sp),r3 ; copy the window number over asl r3 ; word addressing mov tempmap(r3),r3 ; get the map into internal lun asl r3 ; word addressing mov rablst(r3),r2 ; get the record access block address mov 6+$nsave(sp),o$bkt(r2) ; stuff the desired vbn to read/write clr o$bkt+2(r2) ; never use the high vnb word tst rwfunc ; read or write today? bne 10$ ; write clr o$rsz(r2) ; ???? mov 2+$nsave(sp),o$ubf(r2) ; stuff the user buffer address mov 4+$nsave(sp),o$usz(r2) ; and the user buffer size $read r2 ; read br 20$ ; exit 10$: mov 2+$nsave(sp),o$rbf(r2) ; the user record buffer address mov 4+$nsave(sp),o$rsz(r2) ; and size $write r2 ; 20$: mov o$sts(r2),tedsyserror ; get the io status bmi 30$ ; success mov #1 ,r0 ; return(1) br 100$ ; and exit 30$: mov o$stv(r2),-(sp) ; System error code mov o$sts(r2),-(sp) ; Dump error text mov #200$ ,-(sp) ; Formatting string call xprintf add #6 ,sp clr r0 ; return(0) 100$: unsave ; pop registers and exit return 200$: .asciz /RMS error: %d, STV is %d/<12> .sbttl read from file/terminal ; getline(tedlun,&buffer,&sizeofread) ; ; 2(sp) internal lun ; 4(sp) buffer address ; 6(sp) address of returned record size ; r0 1 for success getlin::save ; save registers that we mauy use mov sp ,r3 ; get pointer to arg list add #4*2 ,r3 ; backup over regs and ret address mov #cfile ,r2 ; assume disk input today cmpb @r3 ,inlun ; check to make sure beq 10$ ; no mov #cind ,r2 ; assume indirect now cmpb @r3 ,indlun ; indirect file ? beq 10$ ; yes calls td$ttr ,<2(r3),maxlen> ; get a line from terminal mov r0 ,@4(r3) ; return size beq 90$ ; oops br 80$ 10$: calls td$grec ,<2(r3),maxlen,r2> tst r0 ; did it work ok ? bmi 90$ ; no mov r1 ,@4(r3) ; return size of the read 80$: mov #1 ,r0 ; success br 100$ 90$: mov eoferr ,r0 ; return eof error 100$: unsave ; pop registers and exit return getprm::save ; read with prompt from tt call clrdlm ; clear delimiter mask for RSTS/E mov sp ,r2 ; an arglist pointer cmp (r2)+ ,(r2)+ ; back up clr -(sp) mov 4(r2) ,-(sp) call putbin cmp (sp)+ ,(sp)+ calls td$ttr ,<2(r2),6(r2)> ; read the line tst ttinit beq 100$ call setdlm 100$: unsave return ; getyesno(&prompt,&default) getyesno:: save ; as always, save them mov sp ,r2 ; an arglist pointer cmp (r2)+ ,(r2)+ ; backup sub #20 ,sp ; allocate a small buffer mov sp ,r1 ; and a pointer to it mov #20 ,-(sp) mov 2(r2) ,-(sp) mov r1 ,-(sp) call getprm add #3*2 ,sp tst r0 ; did we get anything ? beq 90$ ; no cmpb @r1 ,#CR ; just a crlf response ? bne 10$ ; no movb @4(r2) ,@r1 ; yes, insert default 10$: cmpb @r1 ,#'Y&137 ; check for Y and y beq 20$ ; success, return(1) cmpb @r1 ,#'y!40 ; lower case check bne 30$ ; no good 20$: mov #1 ,r0 ; success br 100$ ; exit 30$: clr r0 ; return(failure) br 100$ 90$: mov #-1 ,r0 ; return(-1) on read error 100$: add #20 ,sp unsave return .sbttl putline ; putlin(lun,&buffer,len) putlin::save ; save registers we zap mov sp ,r3 ; point to arglist add #4*2 ,r3 ; backup over regs and ret addr mov #cfile*2,r2 ; get index for file i/o cmpb @r3 ,outlun ; write to disk today? beq 10$ ; yes mov 4(r3) ,-(sp) ; no, just dump to terminal mov 2(r3) ,-(sp) ; push length and buffer address call putbin ; dump cmp (sp)+ ,(sp)+ ; pop arg list and exit br 80$ 10$: mov 4(r3) ,r1 ; get record size cmp r1 ,#2 ; if the linelength > 1 blo 20$ ; then check for a CRLF pair mov r1 ,r0 ; at the end of the line. If add 2(r3) ,r0 ; so, get rid of them as RMS cmpb -(r0) ,#LF ; will be creating implied bne 20$ ; carriage return files. cmpb -(r0) ,#CR ; a line feed after the CR? bne 20$ ; no dec r1 ; yes, fix the recordsize up dec r1 ; ... 20$: mov rablst(r2),r2 ; writing to a disk file $store 2(r3),RBF,r2 ; store the buffer address $store r1,RSZ,r2 ; stuff the size of the write $put r2 ; and do it $fetch r0,STS,r2 ; get the i/o status bmi 90$ ; and exit on error 80$: mov #1 ,r0 br 100$ 90$: mov r0 ,tedsyserror clr r0 100$: unsave return .sbttl read/write records td$grec:save mov 4(r5) ,r2 ; get internal lun asl r2 ; times two for indexing mov rablst(r2),r2 ; the rab address for get $store #0,RSZ,r2 ; must be zero for rms11 v2 $store @r5,UBF,r2 ; user buffer address mov 2(r5) ,r0 ; get user buffer maxsize sub #3 ,r0 ; insure room for cr/lf/null bmi 90$ ; no room $store r0,USZ,r2 ; maximum record size to read $get r2 ; simple to read $fetch r0,STS,r2 ; get the status of the op bmi 90$ ; failed $fetch r1,RSZ,r2 ; get the size of the read mov r1 ,r3 ; save it please add @r5 ,r3 ; point to the end of buffer cmpb -1(r3) ,#FF ; if form feed exit beq 10$ ; ok movb #CR ,(r3)+ ; stuff a cr/lf movb #LF ,(r3)+ ; and a line feed add #2 ,r1 ; save size of the read 10$: clrb @r3 ; insure .asciz br 100$ ; exit 90$: clr r1 ; no data on error 100$: unsave return .sbttl terminal i/o CR = 15 FF = 14 LF = 12 EF.TT = 10 ; A few of RSTSism's here. Since the only RSTS/E specific code ; is that for single character terminal reads and for control C ; trapping, we will brnch at run time based on the system type. .iif ndf, .SPEC , .SPEC = EMT + 14 .iif ndf, TTYHND, TTYHND = 2 .iif ndf, XRB , XRB = 442 .iif ndf, FIRQB , FIRQB = 402 .iif ndf, FQFUN , FQFUN = 3 .iif ndf, FQFIL , FQFIL = 4 .iif ndf, FQDEV , FQDEV = 30 .iif ndf, CALFIP, CALFIP = EMT + 0 .iif ndf, OPNFQ, OPNFQ = 2 .iif ndf, CLSFQ, CLSFQ = 0 .iif ndf, .WRITE, .WRITE = EMT + 4 .iif ndf, .READ, .READ = EMT + 2 .iif ndf, .TTECH, .TTECH = EMT + 20 .iif ndf, .TTNCH, .TTNCH = EMT + 22 .iif ndf, .TTRST, .TTRST = EMT + 26 .iif ndf, .UUO , .UUO = EMT + 66 .iif ndf, UU.TRM, UU.TRM = 20 .iif ndf, .SET , .SET = EMT + 36 .iif ndf, .CLEAR, .CLEAR = EMT + 56 .iif ndf, JFSYS , JFSYS = 4000 .iif ndf, .SLEEP, .SLEEP = EMT + 10 ; End of RSTS/E specific definitions .mcall alun$s ,astx$s ,qiow$s ,exit$s ,gtsk$s xinit:: sub #40 ,sp ; get system type mov sp ,r1 ; simple gtsk$s r1 ; ask for it movb g.tssy(r1),systype ; save it add #40 ,sp ; pop buffer alun$s #5,#"TI,#0 ; Assign command term. call setcc ; enable ^C asts call crewin ; create the private region cmp r0 ,#1 ; successful ? bne 90$ ; no call unmapcache ; insure cache is currently unmapped br 100$ ; exit 90$: mov r0 ,-(sp) mov #nowin ,-(sp) call xprintf exit$s 100$: call drpprv return resumeo:: checkterminal:: noecho:: mov #1 ,r0 return .iif ndf, .FSS ,.FSS = EMT + 64 .iif ndf, RENFQ ,RENFQ = 10 .iif ndf, FQNAM1,FQNAM1 = 10 .iif ndf, FQNAM2,FQNAM2 = 20 ; Rename input file , RSTS/E only backup::cmpb systyp ,#4 ; This takes a lot less code bne 100$ ; than doing it with RMS, and mov 2(sp) ,r0 ; we may be able to squeeze it 10$: tstb (r0)+ ; into the root also. bne 10$ ; Get the string length sub 2(sp) ,r0 ; ... dec r0 ; ... mov #FIRQB ,r1 ; Clear the FIRQB and the XRB 20$: clr (r1)+ ; ... cmp r1 ,#XRB+14 ; Done yet blos 20$ ; No mov #XRB ,r1 ; Yes, setup for a .FSS mov r0 ,(r1)+ ; Length mov r0 ,(r1)+ ; Ditto mov 2(sp) ,(r1)+ ; Buffer address .FSS ; Parse filename tstb FIRQB ; Success? bne 100$ ; No, exit mov FIRQB+FQNAM1+0,FIRQB+FQNAM2+0 ; Yes, setup for rename mov FIRQB+FQNAM1+2,FIRQB+FQNAM2+2 ; ... mov #^RBAK ,FIRQB+FQNAM2+4 ; ... movb #RENFQ ,FIRQB+FQFUN ; ... mov #-1 ,FIRQB+16 ; Delete any existing file. CALFIP ; Do it and exit 100$: return ; Bye drpprv::cmpb systyp ,#4 ; RSTS/E ? bne 100$ ; No mov #JFSYS ,XRB+0 ; Yes, we may have needed INSTAL .CLEAR ; priv to create the region. But 100$: return ; since we don't need privs now... .sbttl control C trapping routines setcc:: cmpb systyp ,#4 bne 10$ mov #cctrap ,@#24 br 20$ 10$: qiow$s #io.ata,#5,#ef.tt,,#kbiost,,<,,#cctrap> 20$: clr cctyped return cctrap::call setcc cmpb systyp ,#4 bne 10$ .TTRST tst ttinit bne 5$ .TTECH 5$: inc cctyped rti 10$: cmpb (sp) ,#'c&37 bne 100$ inc cctyped 100$: tst (sp)+ astx$s testcc::mov cctyped ,r0 clr cctyped return .save .psect rwdata ,rw,d,lcl,rel,con cctype::.word 0 linef: .byte 12,0 kbiost: .word 0,0 .restore .sbttl timer routines ; suspend(seconds) timeref = 2 .mcall astx$s ,cmkt$s ,mrkt$s ,wtse$s suspen::mov 2(sp) ,r0 cmpb systype ,#4 ; RSTS/E ? bne 10$ ; No, must be P/OS or M+ mov r0 ,XRB+0 ; RSTS/E, have to do a .SLEEP .SLEEP ; as MARKTIME does not work br 100$ ; Exit 10$: mrkt$s #timeref,r0,#2 ; sleep integral # of seconds wtse$s #timeref 100$: return waitte::mrkt$s #timeref,#6,#1 ; set a ast for 1/10 sec wtse$s #timeref ; now wait for the ef return settim::mov sp ,r0 mov 4(r0) ,markast mrkt$s #timeref,2(r0),#2,#mast ; setup an ast for 2(sp) seconds mov #1 ,r0 return cantim::cmkt$s #timeref mov #1 ,r0 return mast: mov r0 ,-(sp) mov r1 ,-(sp) mov r2 ,-(sp) mov r5 ,-(sp) call @markast mov (sp)+ ,r5 mov (sp)+ ,r2 mov (sp)+ ,r1 mov (sp)+ ,r0 tst (sp)+ astx$s .sbttl misc string routines strcpy::save mov 2+4(sp) ,r2 mov 4+4(sp) ,r1 10$: movb (r1)+ ,(r2)+ bne 10$ unsave mov 2(sp) ,r0 return blkmov::save mov 2+4(sp) ,r2 mov 4+4(sp) ,r1 mov #1000/10,r0 bit #1 ,r1 bne 10$ bit #1 ,r2 beq 20$ 10$: movb (r1)+ ,(r2)+ movb (r1)+ ,(r2)+ movb (r1)+ ,(r2)+ movb (r1)+ ,(r2)+ movb (r1)+ ,(r2)+ movb (r1)+ ,(r2)+ movb (r1)+ ,(r2)+ movb (r1)+ ,(r2)+ sob r0 ,10$ br 100$ 20$: asr r0 30$: mov (r1)+ ,(r2)+ mov (r1)+ ,(r2)+ mov (r1)+ ,(r2)+ mov (r1)+ ,(r2)+ mov (r1)+ ,(r2)+ mov (r1)+ ,(r2)+ mov (r1)+ ,(r2)+ mov (r1)+ ,(r2)+ sob r0 ,30$ 100$: unsave return scopy:: save mov 2+4(sp) ,r2 mov 4+4(sp) ,r1 mov 6+4(sp) ,r0 beq 20$ 10$: movb (r1)+ ,(r2)+ sob r0 ,10$ 20$: unsave return strlen::save mov 2+2(sp) ,r1 clr r0 10$: tstb (r1)+ beq 20$ inc r0 br 10$ 20$: unsave return strcmp::mov 2(sp),r0 ;Pick up 'a' mov 4(sp),r1 ;And 'b' 10$: cmpb (r0)+,(r1) ;Are they the same bne 20$ ;No tstb (r1)+ ;At the end of the string bne 10$ ;No clr r0 ;Equal return return 20$: blo 30$ ;Br if ab return return 30$: mov #-1,r0 ;A mov #tempf ,r0 mov 4(sp) ,r1 10$: movb (r0)+ ,(r1)+ bne 10$ unsave return .save .psect rwdata tempf: .asciz /TEMP.DAT/ .even .restore .sbttl Vanilla read from command terminal ; TD$TTREAD(&buffer,buffer_size) ; ; Read a line from the command terminal ; ; Passed: ; 2(sp) buffer address ; 4(sp) buffer size ; ; Returns: ; r0 # characters read (success) else zero (failure) ; ; Echoes a on completion to counter Dave Cutler's old ; FORTRAN record processing view of the world. td$ttr: save mov 4(sp) ,r1 ; buffer address clrb @r1 ; .asciz mov 6(sp) ,r0 ; buffer size sub #3 ,r0 ; allow for terminators and a null ble 90$ ; no room qiow$s #io.rvb,#5,#ef.tt,,#kbiost,, mov kbiost+2,r0 ; get set to return length add r0 ,r1 ; get pointer to eol cmpb kbiost ,#is.cr ; cr/lf at end desired ? bne 10$ ; no movb #CR ,(r1)+ ; *buffer++ = CR movb #LF ,(r1)+ ; *buffer++ = LF clrb @r1 ; .asciz add #2 ,r0 ; length += 2 10$: cmpb kbiost ,#is.suc ; successful read ? beq 100$ ; yes 90$: clr r0 ; no, return(0) 100$: qiow$s #io.wvb,#5,#ef.tt,,#kbiost,,<#linef,#1> unsave return .sbttl terminal read/write binary mode ; putbin(buffer,len) ; ; Passed: ; 2(sp) buffer address ; 4(sp) buffer length putbin::save ; save temp registers mov 6(sp) ,r0 ; get the passed length please bne 20$ ; something real to print mov 4(sp) ,r1 ; null length, asssume .asciz 10$: tstb (r1)+ ; find the end of the string beq 20$ ; found it inc r0 ; not ye, len++ br 10$ ; go back for next one 20$: mov 4(sp) ,r1 ; get the pointer to the string cmpb systyp ,#4 ; RSTS/E ? bne 30$ ; no mov #XRB ,r1 ; yes, do straight .writes mov r0 ,(r1)+ ; size of the write mov r0 ,(r1)+ ; size of the write, again mov 4(sp) ,(r1)+ ; buffer address clr (r1)+ ; channel zero clr (r1)+ ; unused clr (r1)+ ; unused also mov #4096. ,(r1)+ ; io.wal .WRITE br 40$ ; exit 30$: qiow$s #io.wal,#5,#ef.tt,,#kbiost,, ; and dump it 40$: clr r0 ; assume no errors and exit unsave ; pop register return ; ; Since the RSX ttdrv is not emualated on RSTS/E very well, we ; have to drop back to direct RSTS exec calls to do tt reads. getbin::clr -(sp) ; allocate single character buffer mov sp ,r0 ; and a pointer in r0 for it cmpb systyp ,#4 ; RSTS/E ? bne 10$ ; no, use normal IO.RAL!TF.RNE mov #xrb ,r1 ; RSTS, setup for 1 character read mov #1 ,(r1)+ ; on channel 14 (8). We opened the clr (r1)+ ; terminal on that channel earlier. mov r0 ,(r1)+ ; buffer address mov #14*2 ,(r1)+ ; channel number times 2 clr (r1)+ ; unused clr (r1)+ ; ...ditto clr (r1)+ ; ....... .READ ; do the read tstb firqb ; if failure, then insure that we beq 20$ ; return a NULL please .TTNCH qiow$s #io.ral,#5,,,,, .TTECH br 20$ 10$: qiow$s #io.ral!tf.rne,#5,#ef.tt,,#kbiost,, 20$: mov (sp)+ ,r0 return crlfout:: mov #2 ,-(sp) mov #crlf ,-(sp) call putbin cmp (sp)+ ,(sp)+ return .save .psect rwdata crlf: .byte CR,LF,0 .even .restore .mcall tlon$s ,clon$s .save .psect lognam ,ro,d,lcl,rel,con homdir: .asciz /SYS$LOGIN:/ homedl = . - homdir - 1 lastfi: .asciz /TED$LAST$FILE$EDITED/ lastfl = . - lastfi - 1 .psect logdat ,rw,d,lcl,rel,con retv: .word 0,0 .even .restore .iif ndf, IN.USR, IN.USR = 1 .iif ndf, IN.SES, IN.SES = 20 .iif ndf, IN.GRP, IN.GRP = 4 .iif ndf, IN.SYS, IN.SYS = 10 .iif ndf, LT.SES, LT.SES = 4 savefi::mov 2(sp) ,r1 ; Get the string address sub #110 ,sp ; Allocate a buffer mov sp ,r0 ; And a pointer to it mov r1 ,-(sp) ; Now setup a call to PRSNAM mov r0 ,-(sp) ; The destination address call prsnam ; Parse it cmp (sp)+ ,(sp)+ ; Pop parameter list tst r0 ; Successfull? beq 90$ ; No, exit mov sp ,r1 ; Point to the expanded name string mov r1 ,-(sp) ; Get string length call strlen ; Get string length tst (sp)+ ; Pop arg CLON$S #0,#LT.SES,#lastfi,#lastfl,r1,r0 bcs 90$ ; Oops cmpb @#$DSW ,#IS.SUC ; Successful? beq 100$ ; Yes, exit cmpb @#$DSW ,#IS.SUP ; Superseded? beq 100$ ; Yes 90$: clr r0 ; Otherwise error br 110$ ; Exit 100$: mov #1 ,r0 ; Success 110$: add #110 ,sp ; Pop local buffer return ; Exit rstfil::mov 2(sp) ,r1 ; Returned string buffer TLON$S #0,#,#0,#lastfi,#lastfl,r1,#77,#retv,#retv+2 bcs 90$ ; It failed cmpb @#$DSW ,#IS.SUC ; Successful? bne 90$ ; No add retv ,r1 ; Success, insure .ASCIZ clrb @r1 ; Simple mov #1 ,r0 ; Success return ; Exit 90$: clr r0 ; Failure return ; Exit dclinpast:: clrinpast:: delspawn:: dombx:: clr r0 return gsyserror:: mov tedsyserror,r0 return geterr::mov r5 ,-(sp) mov 4(sp) ,r0 mov r0 ,-(sp) mov #tedsys ,-(sp) mov #2 ,-(sp) mov sp ,r5 call rmserr add #3*2 ,sp mov (sp)+ ,r5 return .sbttl save/restore filename and filename savepr::mov #proxab ,r0 $fetch inpro,PRO,r0 ; get last opened file protection $fetch inprg,PRG,r0 ; and owner please $fetch inprj,PRJ,r0 ; both words mov #fab$file,r0 $fetch inrat,RAT,r0 $fetch inrfm,RFM,r0 clr O$XAB(r0) mov #1 ,r0 mov r0 ,proset ; say we did it return setpro::mov #proxab ,r0 ; get address of proxab tst proset ; Ever do it? beq 100$ ; No $store inpro,PRO,r0 ; and stuff the saved crap in $store inprg,PRG,r0 ; protection and owner please $store inprj,PRJ,r0 ; two words mov #fab$file,r0 $store inrat,RAT,r0 $store inrfm,RFM,r0 $store #proxab,XAB,r0 clr proset ; Don't reuse this 100$: mov #1 ,r0 return gethom::mov 2(sp) ,r0 clrb @r0 return quefil::clr r0 return div$li::mov 2(sp) ,r0 mov 4(sp) ,r1 div 6(sp) ,r0 mov r0 ,r1 return .sbttl epts to convert (sp) arglist to (r5) arglist to get into reslib gettim::mov r5 ,-(sp) mov sp ,r5 cmp (r5)+ ,(r5)+ call rgetti mov (sp)+ ,r5 return finstr::mov r5 ,-(sp) mov sp ,r5 cmp (r5)+ ,(r5)+ call $finstr mov (sp)+ ,r5 return instr:: mov r5 ,-(sp) mov sp ,r5 cmp (r5)+ ,(r5)+ call $instr mov (sp)+ ,r5 return chkrmt::clr r0 return inista:: accsta:: disbuf:: enabuf:: qiosta::mov #1 ,r0 return .sbttl csv$ C register save and restore ;+ ; ; ; Index C register save and restore ; Index C program execution environment ; ; Usage ; ; jsr r5,csv$ ; ... ; jmp cret$ ; ; Description ; ; C program Run-time Environment ; ; Each C subroutine starts with a call to CSV$ and exits by ; jumping to CRET$. Upon exit, the stack need not be equal ; to its value on entrance. ; ; During the execution of all C subroutines, register R5 ; points to the current "environment." Within a subroutine, ; it appears as follows: ; ; _______________ ; | | ; SP -> | 1st loc. var. | -10(R5) C$AUTO-2(R5) ; |_______________| ; | | ; | Saved R2 | -6(R5) ; |_______________| ; | | ; | Saved R3 | -4(R5) ; |_______________| ; | | ; | Saved R4 | -2(R5) ; |_______________| ; | | ; R5 -> | Saved R5 | ; |_______________| ; | | ; | Return add. | +2(R5) ; |_______________| ; | | ; | First arg. | +4(R5) C$PMTR+0(R5) ; |_______________| ; | | ; | Second arg. | +6(R5) C$PMTR+2(R5) ; |_______________| ; ; Within a subroutine, Registers R0-R4 and the top of the ; stack, (sp) are available for use. Registers R0 and R1 ; are not preserved by subroutines and may be used to pass ; a return value. ; ; R5 must not be modified by a subroutine. All variable ; addressing must be done by offsets to R5. Subroutine ; arguments must be accessed by reference to C$PMTR. ; Subroutine local variables must be accessed by reference ; to C$AUTO. This permits modification of calling sequences ; without rewriting all subroutines. ; ; CSV$ refers to global symbol $$main to call the run-time startup ; program from the (RSX) library. ; ; Internal ; ; The global symbols needed for the Whitesmith's C compiler ; are also included. ; ; Bugs ; ;- ; ; Edit history ; 01 JMT Original ; 02 MM Documentation ; 03 MM Fix bug in CRET$ and define C$PMTR, C$AUTO ; 04 MM Bum one word and name $$main ; 05 MM C$PMTR/C$AUTO are now defined in RSX.MAC and RT11.MAC ; 06 MM Added C$SAV, C$RET and C$RETS entries for Whitesmith's ; ; ; If C$PMTR/C$AUTO are undefined, just define them ;05+ ; .iif ndf C$PMTR C$PMTR = 4 ;formal[n] @ c$pmtr+(r5) .iif ndf C$AUTO C$AUTO = -6 ;local[n] @ c$auto-(r5) .globl C$PMTR, C$AUTO .iif ne C$PMTR-4 .error Bad definition of C$PMTR .iif ne C$AUTO+6 .error Bad definition of C$AUTO ; ; By defining C$PMTR and C$AUTO as local symbols, the task ; builder need not do so much work ;05- .GLOBL $$MAIN ;Call start from the library ;04 .psect c$code ; ; save R4-R2 and make a one-word temp slot on the stack. ; C$SAV:: ;06 CSV$:: MOV R5, R0 MOV SP, R5 MOV R4, -(SP) MOV R3, -(SP) MOV R2, -(SP) JSR PC,(R0) ;TST -(SP) JMP (R0) ;04 ; ; pop R2-R4 and restore stack linkage registers. ; C$RET:: ;06 CRET$:: MOV R5, R2 ;03 + MOV -(R2), R4 MOV -(R2), R3 MOV -(R2), R2 ;03 - C$RETS:: ;Funny Whitesmith's entry ;06 MOV R5, SP MOV (SP)+, R5 RTS PC .psect rmscod ,ro,i .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 .sbttl pattern matching ; FINSTR ; INSTR ; ; input: ; ; (r5) = address of the first string ; 2(r5) = length of the first string . ; 4(r5) = address of the second string, the one to find. ; 6(r5) = length of the second string. ; ; output: ; ; r0 = if > 0 then r0=position of second in first ; else the second is not a substring. ; ; edits: ; ; ; 01-mar-82 do not convert ctl's to letters bug ; 22-Aug-85 mod for use in C TED into the reslib $finst::mov sp ,r0 ; ignore case of letter br x ; and off to common code $instr::clr r0 ; flag normal case match x: save ; we use these here, so save. mov 4(r5) ,r1 ; the address of second one. mov 6(r5) ,r2 ; the length of second one. ble 60$ ; a null string ? mov 2(r5) ,r4 ; the length of first. ble 60$ ; a null string ? sub r2 ,r4 ; convert to looping counter clr r3 ; the real loop counter. mov @r5 ,r5 ; stuff address into r5 please 10$: cmp r3 ,r4 ; are we done yet ? bgt 60$ ; yes, if r3 > r4 . ; cmpb @r5 ,@r1 ; speed things up a little by ; beq 15$ ; placing the obvious test in line call mch ; check for a character match bcs 50$ ; c bit set is match failure. 15$: save ; found first character match. inc r5 inc r1 ; point to the next character dec r2 ; length of pattern thats left ble 30$ ; in case the len( pattern ) =1 20$: call mch ; characters match ? bcs 40$ ; no match inc r5 ; and bump up to the next chars inc r1 ; this one please sob r2 ,20$ ; loop for len( pattern ) - 1 30$: mov r3 ,r0 ; the current loop count inc r0 add #6 ,sp ; fix the stack from save < > br 70$ 40$: unsave ; the match failed. restore the 50$: inc r3 ; pointers and go try the next inc r5 br 10$ ; character in the first string 60$: clr r0 ; complete failure if get here 70$: unsave ; restore the registers we used return ; and go away. .sbttl check for character match .enabl lsb mch: cmpb @r5 ,@r1 ; see if the characters match beq 50$ ; yes mchx: cmpb @r1 ,#192. ; see if special match control? bhis 70$ ; yes tst r0 ; no match, ignore letter case? beq 40$ ; no, set carry and exit mov r2 ,-(sp) ; get a temp register to use. movb @r1 ,r2 ; get the pattern character bicb #40 ,r2 ; if a letter, force upper case cmpb r2 ,#'a&137 ; less than an uppercase 'a' ? blo 10$ ; yes, exit with failure set. cmpb r2 ,#'z&137 ; greater than uppercase 'z' ? bhi 10$ ; yes, exit with failure. movb @r5 ,r2 ; ok, first char is a letter. bicb #40 ,r2 ; but is this one a character? cmpb r2 ,#'a&137 ; we are avoiding calling 'islet' blo 10$ ; to make this code much faster. cmpb r2 ,#'z&137 ; if not a letter exit with carry bhi 10$ ; complete failure movb @r1 ,-(sp) ; both characters to compare are bicb #40 ,@sp ; letters, force both to upcase cmpb r2 ,(sp)+ ; and compare beq 20$ ; a match! (case insensitive) 10$: mov (sp)+ ,r2 ; failure exit, pop r2 and exit br 40$ ; bye 20$: mov (sp)+ ,r2 ; a match, pop r2 and exit br 50$ ; bye 40$: sec ; exit with failure return 50$: clc ; exit with success return ; bye ; come here for checking meta characters out ; ie, ^E? (compiled to codes > 191 (10) ) 70$: mov r4 ,-(sp) mov #mlist ,r4 ; look for a match in special 80$: tstb @r4 ; end of the table yet ? beq 100$ ; yes cmpb @r1 ,(r4)+ ; no, so look for a match! bne 80$ ; the end dec r4 ; fix the pointer up please sub #mlist ,r4 ; convert to 0..end asl r4 ; times two for jsr jsr pc ,@mdsp(r4) ; and call the correct matcher 90$: mov (sp)+ ,r4 ; pop temp register please return 100$: sec ; could not find the match char br 90$ ; exit with failure 'c' bit set .dsabl lsb .sbttl dispatch on match character code .enabl lsb 100$: br x.succ ; ^X any character will do 120$: call 180$ ; ^S not a letter or digit bcs x.succ ; simply swap the 'success' br x.fail ; exit 140$: br x.fail ; not implemented 160$: call islet ; (^E)A match any letter return 180$: call islet ; (^E)C match letter,digit,$ bcc x.succ ; did it call isdig ; try for a digit next bcc x.succ ; made it cmpb @r5 ,#'$ ; try dollar symbol beq x.succ ; a dollar cahr cmpb @r5 ,#'. ; last thing is a dot beq x.succ ; found a '.' br x.fail ; no 200$: call isdig ; (^E)D match any digit return ; exit 220$: ; (^E)Gq 240$: br x.fail ; (^E)L 260$: call isuc ; (^E)R match digit or upper bcc 270$ ; case letter call isdig ; 270$: return ; bye 280$: cmpb @r5 ,#40 ; (^E)s match a space or tab beq x.succ ; space matches cmpb @r5 ,#11 ; try a tab next please beq x.succ ; match br x.fail ; no match 300$: call islc ; (^E)v lower case letters return ; bye 320$: call isuc ; (^E)w upper case letters return ; bye x.succ: clc ; yes, clear carry and exit return ; bye x.fail: sec ; no match, set carry bit return .sbttl special match control characters ; ; case ord(match_char) of ; ; 1..128: match := ch = match_char ; ; 192: match := true ; ; 193: match := not ( ch in digits ) or ( ch in letters ) ; 194: error(not_implemented) ; ; 195: match := ( ch in letters ) ; ; 196: match := ( ch in letters ) or ( ch in digits ) ; or ( ch in ['$','.'] ) ; ; 197: match := ( ch in digits ) ; ; 198: error(not_implemented) ; ; 199: error(not_implemented) ; ; 200: match := ( ch in digits ) or ( ch in big_letters ); ; 201: match := ( ch = tab ) or ( ch = space ) ; ; 202: match := ( ch in small_letters ) ; ; 203: match := ( ch in big_letters ) ; ; ; end ; .blkb 46 ;****?????**** .save .psect insdsp ,ro,d,lcl,rel,con mlist: .byte 192.,193.,194.,195.,196.,197.,198.,199. .byte 200.,201.,202.,203.,0 .even mdsp: .word 100$,120$,140$,160$,180$,200$,220$,240$ .word 260$,280$,300$,320$ .restore .dsabl lsb .enabl lsb .dsabl lc isdig: cmpb @r5 ,#'0 ; digit match? blo 10$ ; no cmpb @r5 ,#'9 ; next part please bhi 10$ ; no 5$: clc ; yes return 10$: sec ; not a digit return ; bye islet: call isuc ; try for upper case bcc 20$ ; yep call islc ; try for lower case 20$: return ; bye isuc: cmpb @r5 ,#'A ; try for a letter blo 10$ ; no a letter for sure cmpb @r5 ,#'Z ; might be a letter blos 5$ ; yep br 10$ ; exit islc: cmpb @r5 ,#'A!40 ; try lower case blo 10$ ; no cmpb @r5 ,#'Z!40 ; maybe blos 5$ ; no br 10$ ; yes .dsabl lsb .sbttl dummy main ept .mcall exit$s $$main::cmp resver ,#..resv beq 10$ clr -(sp) mov #badver ,-(sp) call putbin exit$s 10$: call main exit$s .save .psect rwdata ,d badver: .asciz /Wrong version of EDRESL/<15><12> .even .restore .globl resver,..resv .end $$main