.title rstsio .ident /009/ ; Copyright (C) 1979 1980 1981 Brian Nelson ; ; ; ; This software is furnished in an as-is ; condition, with no committments of sup- ; port or updates. This software may NOT ; be sold for profit nor can it be includ- ; ed in any package to be sold for profit ; without the written consent of the au- ; thor. This software may be used only ; within the above conditions of use. ; ; The information in contained herein is ; subject to change or revision at any ; time without notice. ; ; ; ; p.s. If that sounds a little heavy, you ; ARE getting this for free. It is the ; system editor at Toledo, and in use at ; several other sites. We have an average ; access count of 200,000 each quarter here ; for it. ; .globl getc ,retc .sbttl get a line from disk/tape/keyboard ect.... .if ne ,rsx11m .ift .enabl gbl .endc ; edits ; ; 05-oct-82 bdn fix for null records from f77 created files section $edio .sbttl open,close,create files ;$open 0(r5) = the filename address, null terminated ; 2(r5) = channel number to use ; on exit: ; bufpnt(2*chan) = bufsiz+1 ; iostat(2*chan) = RSTS 'STATUS' word, as in BASIC ; blknum(2*chan) = 0 questr = 2 + 4 + 40 + 100 ; A '*' or '?' in filespec illnam = 2 ; ? Illegal filename err num .globl rmswrn ,suspend $open:: call ope ; try the open out for size cmpb @#errsav,#32. ; Run out of small buffers. bne 10$ ; no, all may be well (?) call suspend ; wait a second please. call ope ; and try one more time. 10$: return ; bye..... ope: save ;- calls $fscan ,<@r5> ; Load the firqb and then open call $fscan ; iferr 1$ bit #questr ,@#xrb+10 bne 2$ clr @#opnprot clr @#opnsize mov 2(r5) ,r0 ; the channel number to open. asl r0 ; convert to RSTS channel * 2 movb r0 ,@#firqb+fqfil ; load firqb with the channel movb #opnfq ,@#firqb+fqfun ; we want to 'OPEN FOR INPUT' .priv calfip movb @#firqb+iosts,@#errsav ; copy the error to save area bne 1$ cmpb #dkhnd ,@#firqb+fqflag bne 5$ movb @#firqb+fqprot,@#opnprot mov @#firqb+fqsiz,@#opnsize ; save size and prot 5$: mov @#firqb+fqflag,iostat(r0) mov @#bufsiz,bufpnt(r0) inc bufpnt(r0) clr blknum(r0) clr rd$siz(r0) clr rm$siz(r0) clr mx$siz(r0) cmpb iostat(r0),#dkhnd ; Must be a disk device bne 1$ ; go away if it isn't. mov #firqb+fqfun,r1 ; An address in the firqb movb #-25. ,(r1)+ ; UUO subfunction code movb 2(r5) ,(r1)+ ; channel number 10$: clrb (r1)+ cmp r1 ,#firqb+fqent+1 blo 10$ .priv .uuo mov #firqb+6,r1 ; address of record format clr rc$fmt(r0) clr la$byt(r0) clr la$blk(r0) movb @#firqb+iosts,@#errsav ; Check for errors. bne 1$ tst @r1 ; read anything at all ? beq 1$ ; If zero, then no bit #4 ,@r1 ; or perhaps stream attribute bne 1$ ; yep, exit now mov (r1)+ ,rc$fmt(r0) ; record format mov @r1 ,mx$siz(r0) ; max record size .print #rmswrn ; print warning message mov @#firqb+20,la$blk(r0) ; Yes. Copy eof junk out. mov @#firqb+22,la$byt(r0) 1$: unsave return 2$: movb #illnam ,@#firqb+iosts movb #illnam ,@#errsav br 1$ .sbttl close a file for TED routine $close ; (r5) = channel number ; ; output: iostat(2*chan) = 0 ; bufpnt(2*chan) = 0 ; save mov (r5) ,r0 ; the channel number to open. asl r0 ; convert to RSTS channel * 2 movb r0 ,@#firqb+fqfil ; load firqb with the channel movb #clsfq ,@#firqb+fqfun ; we want to 'OPEN FOR INPUT' .priv calfip movb @#firqb+iosts,@#errsav ; copy the error to save area clr iostat(r0) mov bufpnt(r0),r1 clr bufpnt(r0) clr rd$siz(r0) mov blknum(r0),@#lstblk ; save the end of the file ; clr r0 ; div #512. ,r0 ; add r0 ,@#lstblk unsave return .sbttl create temp file (for RSTS) cretmp::call getprv ; get temp privs mov #100$ ,r0 ; default tempdev bit #sw$dev ,$inswi ; user override tempdev? beq 5$ ; no mov #tmpdev ,r0 ; yes, use theirs please 5$: calls $fscan , ; tranlate edrt: logical movb firqb+2 ,r1 asrb r1 clr r0 ; set up to convert job num div #10. ,r0 ; into a radix 50 string . add #30. ,r0 ; digits are mapped 30.-39. add #30. ,r1 ; in radix fifty. add on, mov r1 ,r3 ; save the last rad 50 char. mov r0 ,r1 ; the second radix 50 char. mul #50 ,r1 ; convert it, and then set add r1 ,r3 ; the bits for that char in add #50*50*30.,r3 ; the dest. add '?' at the mov #firqb+fqfun,r0 ; point to firqb for params movb #crefq ,(r0)+ ; create temp file call next movb #tmplun*2,(r0)+ ; channel number times 2 clrb (r0)+ ; clear the rest of firqb tst (r0)+ ; skip over ppn field mov #^REDI ,(r0)+ ; generate EDI0nn.TMP mov r3 ,(r0)+ ; jobnumber field mov #^RTMP ,(r0)+ ; extension mov #40 ,(r0)+ ; initial size of the file mov #100000!40,firqb+fqmode ; tentative please mov #firqb+fqclus,r0 ; set clustersize in next clr (r0)+ ; clear it clr @r0 ; clear device clusternumber bit #df$32 ,$flags ; use /cl:32 ? beq 20$ ; no mov #40 ,-(r0) ; yes, stuff clustersize in 20$: .priv calfip ; do it movb firqb ,errsav ; copy errors and exit call drpprv ; no privs needed return ; bye global global 100$: .asciz #EDRT:# .even .sbttl create file .globl bakext ; 0(r5) = address of filespec, null terminated ; 2(r5) = channel number to use ; on exit: ; bufpnt(2*chan) = 0 ; iostat(2*chan) = RSTS 'STATUS' word, as in BASIC ; blknum(2*chan) = 0 ; questr = 2 + 4 + 40 + 100 ; Wildcard name or extension illnam = 2 ; ? Illegal filename err num. e$crea:: $creat::call cre ; try to create it ! cmpb @#errsav,#32. ; but we ran out of buffers? bne 10$ ; no, maybe ok, maybe error. call suspend ; sleep a while call cre ; and try once again please. 10$: return ; bye now. .globl suspend ; is somewhere else me thinks cre: call $fscan ; initial check on the filename iferr 40$ ; oops bit #questr ,@#xrb+10 ; Check for star or ques mark bne 50$ ; no good then save ; save all temps please clr r0 ; and get input files prot code bisb @#inprot,r0 ; set it in there now call $fscan ; assume @r5 has address tstb @#firqb+fqprot ; Did they give a prot code ? beq 30$ ; no, so skip it clr r0 ; yes, set users protection code bisb @#firqb+fqprot,r0 ; copy user specified prot code 30$: movb #crefq ,@#firqb+fqfun ; we want to 'OPEN FOR OUTPUT' movb r0 ,@#firqb+fqprot ; Copy the old protection beq 34$ ; no explicit code given. movb #377 ,@#firqb+fqprot-1 bicb #2 ,@#firqb+fqprot ; no sense in write protection 34$: tst @#firqb+fqmode ; mode passed at all ? bmi 35$ ; yes, force it to be 'real'. bis #100040 ,@#firqb+fqmode ; create tentative file please 35$: mov 2(r5) ,r0 ; the channel number to open. asl r0 ; convert to RSTS channel * 2 movb r0 ,@#firqb+fqfil ; load firqb with the channel mov @#outsiz,@#firqb+fqsiz ; perhaps pre-extend the file .priv calfip mov @#firqb+fqflag,iostat(r0) 36$: movb @#firqb+iosts,@#errsav ; copy the error to save area clr bufpnt(r0) clr blknum(r0) unsave 40$: return 50$: movb #illnam ,errsav ; Fake illegal filename err return ; and exit .sbttl delete a file routine $delete ;- calls $fscan ,<@r5> ; Load the firqb first and call $fscan ; assume @r5 has address iferr 1$ ; check for any errors . movb #delfq ,@#firqb+fqfun ; Set the firqb up for the .priv ; delete a file FIP sub-fun calfip movb @#firqb+iosts,@#errsav 1$: return .sbttl rename a disk file, extension only ; input: 0(r5) = address of old filespecification ; 2(r5) = new extension, in RAD50 routine $rename save ;- calls $fscan ,<@r5> ; Set up the firqb for RENFQ call $fscan ; assume @r5 has address iferr 10$ ; exit if there were any errors cmpb #dkhnd ,@#firqb+fqflag ; Must be a disk, else ignore bne 10$ mov #firqb+fqnam1,r0 ; address of parsed filename mov #firqb+fqnam2,r1 ; the new file name offset mov (r0)+ ,(r1)+ ; Set up the new file to be the mov (r0)+ ,(r1)+ ; same as the old, but use new mov 2(r5) ,(r1)+ ; new extension. clr @#firqb+fqprot-1 ; use the old protection code mov #-1 ,@#firqb+fqsiz ; Tell RSTS to delete existing. movb #renfq ,@#firqb+fqfun ; FIP code to rename a file. .priv calfip movb @#firqb+iosts,@#errsav ; return any error codes beq 10$ cmpb #ed.fnd ,@#errsav ; If the error was file not fnd bne 10$ ; then ignore the error. clrb @#errsav 10$: unsave return ; byebye .sbttl check horizontal position of keyboard routine $pos clr @#xrb+xrci ; The channel number * 2 to do .priv .postn ; get RSTS to post some things mov @#xrb+2 ,r0 return .sbttl return current terminal width setting routine $width clrb @#xrb+xrci .priv .postn clr r0 bisb @#xrb+0 ,r0 return .sbttl reset echo and control - o routine recho .priv .ttech .priv .ttrst return .sbttl file name string scan ; ; call up RSTS (FIP) to do a terminating filename string ; scan. The string MUST be null terminated. Called as in: ; ; calls $fscan , ; routine $fscan save mov (r5) ,r0 ; address of the string clr r1 ; initial length of file name 1$: tstb (r0)+ ; terminated with a null (0) ? beq 2$ ; r1=r1+1 while mid(str$,r1,1) inc r1 ; increment length count br 1$ 2$: mov #xrb ,r0 ; set up for the .fss mov r1 ,(r0)+ mov r1 ,(r0)+ ; len to xrlen and xrbc mov (r5) ,(r0)+ ; move address to xrloc clr (r0)+ ; chan 0, msb of block=0 clr (r0)+ ; lsw of block = 0 clr (r0)+ ; clear xrtime ; same as mov #asgprt,@#xrb+12 ; mov #44 ,@#xrb+10 mov #firqb ,r0 mov #fqbsiz ,r1 ; set up to zero the firqb first 3$: clrb (r0)+ sob r1 ,3$ .priv ; call up the rsts monitor .fss ; to do file name string scan movb @#firqb+iosts,@#errsav ; save any errors encountered unsave return .sbttl flush buffer routine $flush ; (r5) = buffer address ; 2(r5) = channel number ; e$flus::save mov (r5) ,r0 ; The buffer address first and mov 2(r5) ,r1 ; next get the channel number. asl r1 ; Change chan to channel# * 2. mov @#bufsiz,r3 cmp bufpnt(r1),r3 ; See if we have a full buffer bge 3$ clr r2 ; setup for div div #512. ,r2 ; get buffer count in r2 mov #512. ,r3 ; and fugure out how much to do. 100$: cmp bufpnt(r1),r3 ; compare to multiples of 512 beq 3$ ; exactly a block mulitple blt 110$ ; fit yet ? asl r3 ; no sob r2 ,100$ asr r3 110$: save mov r3 ,r2 ; Partial buffer. fill rest of add bufpnt(r1),r0 ; buffer with null characters. sub bufpnt(r1),r2 ; How much to zero out of buff ble 2$ ; better have someting there. 1$: clrb (r0)+ sob r2 ,1$ 2$: unsave 3$: mov r1 ,r2 asr r2 ; get the channel number back inc blknum(r1) calls $putbl , clr r2 ; fix the block number to be div #512. ,r2 ; corrected by the buffer size. dec r2 ; ble 4$ add r2 ,blknum(r1) 4$: unsave return .sbttl check for file being acceptable org ; input: (r5) = channel number to use ; ; output: r0 = 0 if file is stream ascii ; r0 = -1 if file is not stream ascii uu.atr = -25. strasc = 4 $catr:: clr -(sp) movb @r5 ,r0 ; get the channel number beq 100$ ; KB: asl r0 ; make it channel * 2 cmpb iostat(r0),#dkhnd ; Must be a disk device bne 100$ ; go away if it isn't. bit #20!40 ,rc$fmt(r0) ; indexed or relative? beq 100$ mov sp ,@sp ; yes, that's a nono 100$: mov (sp)+ ,r0 return .sbttl zap firqb, get/drop privs for RSTS routine $zapfqb save mov #firqb ,r1 mov #40/2 ,r0 1$: clr (r1)+ sob r0 ,1$ unsave return routine drpprv mov #jfsys ,@#xrb+0 .priv .clear return routine getprv mov #jfsys ,@#xrb+0 .priv .set return .sbttl same tty i/o for RSX and RSTS but called ; ttio0 0 is .asciz print, ttio1 has length on stack ; ; ttio0: 0(sp) = return address ; 2(sp) = string address to print ; ; ttio1: 0(sp) = return address ; 2(sp) = string address to print ; 4(sp) = length of the string ttio0:: mov r5 ,-(sp) ; save a temp tst -(sp) mov sp ,r5 ; emt 376, shuffle saved r5 and mov 2(sp) ,(r5)+ ; 0(sp) = 2(sp) (saved r5) mov 4(sp) ,(r5)+ ; 2(sp) = 4(sp) (saved return) mov 6(sp) ,(r5)+ ; 4(sp) = 6(sp) (string address) clr @r5 ; 6(sp) = 0 br ttioc ttio1:: mov r5 ,-(sp) ; save a temp ttioc: mov sp ,r5 ; set up the pointers add #4 ,r5 ; point to the string address. callg $ttyout ; call the TTYOUT subroutine. mov (sp)+ ,r5 ; restore the register mov (sp) ,4(sp) ; and pop the stack of the add #4 ,sp ; arguement list return .sbttl printer spooling for RSTS .iif ndf, uu.spl, uu.spl = -28. .iif ndf, uu.sys, uu.sys = 26. ; defaults for the GOLD Q command, patchable by ONLPAT ; ; q.priv offset 0 unit number for users whose project ; number is less than q.ppn ; q.nopr offset 0 unit number for users whose project ; number is greater than q.ppn ; q.ppn offset 0 see above q.priv::.byte 0 ; local printer (lp0) q.ppn:: .byte 7 ; max prog # for local printer q.nopr::.byte 2 ; remote printer(lp2) .even ; Q S P O O L ; ; calls QSPOOL , ; ; returns: r0 := rsts error code (if any) ; ; side effects: temporary privledges, if on, are dropped qspool::save call getprv ; spooling call may be priv mov #firqb+fqfun,r1 ; get project number first now movb #uu.sys ,(r1)+ ; look up our job clr (r1)+ ; current job number, function .priv .uuo ; easy to do mov firqb+26,r0 ; save ppn for a moment calls $fscan ,<@r5> ; let .FSS stuff the filename movb errsav ,r0 ; errors ? bne 100$ ; yes, please exit mov #firqb+16,r1 ; stuff the rest of the params mov #"LP ,(r1)+ ; LP of course movb q.priv ,(r1)+ ; assume LP0 for a moment swab r0 ; shift project and prog fields cmpb r0 ,q.ppn ; should we use the remote LP? blos 20$ ; no movb q.nopr ,-1(r1) ; yes 20$: movb #377 ,(r1)+ ; unit is real for sure clr (r1)+ ; must be zero mov #4!40 ,(r1)+ ; /delete/noheader movb #uu.spl ,firqb+fqfun .priv .uuo ; simple to do movb firqb ,r0 ; return any error codes 100$: call drpprv ; drop temp privs please unsave return global <$fscan ,getprv ,drpprv> .end