.title k11rms rms i/o for KERMIT-11 .ident /8.0.01/ ; Brian Nelson 30-Nov-83 09:53:49 ; ; Copyright (C) 1983 Change Software, Inc. ; define macros and things we want for KERMIT-11 .include /IN:K11MAC.MAC/ .iif ndf, k11inc, .error ; INCLUDE for IN:K11MAC.MAC failed ; This is K11RMS.MAC, the RMS11 version 2 i/o interface for ; Kermit on RSTS version 8, RSX11M+ v2.1 and RSX11M v4.1. It ; is, without a doubt, the worst part of Kermit due RMS11, ; but it's strong points are future uses and the RSX / RSTS ; transportability. ; ; ; open ( %loc filename, %val channel_number ,%val type ) ; create( %loc filename, %val channel_number ,%val type ) ; getrec( %loc buffer , %val channel_number ) { returns RSZ in R1} ; putrec( %loc buffer , %val record_size ,%val channel_number ) ; close ( %val channel_number ) ; putc ( %val char , %val channel_number ) ; getc ( %val channel_number ) cr = 15 lf = 12 ff = 14 soh = 1 maxsiz = 132. .enabl gbl .psect $code ,ro,i,lcl,rel,con .psect rmssup ,rw,d,lcl,rel,con .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 org$ SEQ, .if ne ,0 ; Decide whether or not to use .ift ; dynamic space allocation by ; task extension or to use rmsbuf: pool$b ; static pools p$rab 5 ; plenty of record streams p$bdb 5 ; same goes for block buffers p$fab 4 ; up to 3 fabs (needed for search) p$buf 2048. ; for 2 files and directory i/o pool$e ; end of static pool .iff ; use task extension for space ; routine modifed from GSA example .mcall gsa$ ; from RMS v2.0 distribution. gsa$ gsa ; set our GSA address .globl gsa ; it may be global .endc ; to decide on pool allocation .sbttl rms file access blocks facc = fb$get ! fb$put fab1: fab$b f$alq 0 ; initial allocation of 10 blocks f$fac facc ; allowed i/o operations f$fna nam1 ; name of the file f$fns 0 ; length of the filename f$fop fb$sup ; supercede old versions f$lch lun1 ; channel number to use f$mrs maxsiz ; maximum recordsize f$org fb$seq ; seq f$rat fb$cr ; implied carriage control f$rfm fb$var ; variable length records fab$e fab1en: fab2: fab$b f$alq 0 ; initial allocation of 10 blocks f$fac facc ; allowed i/o operations f$fna nam2 ; name of the file f$fns 0 ; length of the filename f$fop fb$sup ; supercede old versions f$lch lun2 ; channel number to use f$mrs maxsiz ; maximum recordsize f$org fb$seq ; seq f$rat fb$cr ; implied carriage control f$rfm fb$var ; variable length records fab$e fab2en: fab3: fab$b f$alq 0 ; initial allocation of 10 blocks f$fac facc ; allowed i/o operations f$fna nam3 ; name of the file f$fns 0 ; length of the filename f$fop fb$sup ; supercede old versions f$lch lun3 ; channel number to use f$mrs maxsiz ; maximum recordsize f$org fb$seq ; seq f$rat fb$cr ; implied carriage control f$rfm fb$var ; variable length records fab$e fab3en: fab4: fab$b f$alq 0 ; initial allocation of 10 blocks f$fac facc ; allowed i/o operations f$fna nam4 ; name of the file f$fns 0 ; length of the filename f$fop fb$sup ; supercede old versions f$lch lun4 ; channel number to use f$mrs maxsiz ; maximum recordsize f$org fb$seq ; seq f$rat fb$cr ; implied carriage control f$rfm fb$var ; variable length records fab$e sydska::.ascii "SY:" ; a default disk to use sydskl == . - sydska .even ; pointers to buffer and fabs ; ; While none of this is really needed since all this info is ; available in the FAB and RAB, I find it cleaner to do it ; this way and thus avoid having to look at the RMS control ; structures. fablst::.word 0 ,fab1 ,fab2 ,fab3 ,fab4 namlst::.word 0 ,nam1 ,nam2 ,nam3 ,nam4 namlen::.word 0 ,0 ,0 ,0 ,0 rablst::.word 0 ,rab1 ,rab2 ,rab3 ,rab4 buflst: .word ttbuf ,buf1 ,buf2 ,buf3 ,buf4 bufdef: .word ttbuf ,buf1 ,buf2 ,buf3 ,buf4 bufsiz: .word ttbsiz ,maxsiz ,maxsiz ,maxsiz ,maxsiz bigbuf: .word bufx ,bufx ,bufx ,bufx ,bufx filtyp: .word terminal,text ,text ,text ,text bufp: .word 0 ,0 ,0 ,0 ,0 bufs: .word 0 ,0 ,0 ,0 ,0 mode: .word 1 ,0 ,0 ,0 ,0 blknum: .word 0 ,0 ,0 ,0 ,0 ; this sets the default for creating text files df$rat::.word fb$cr df$rfm::.word fb$var namln1 = namlen+2 namln2 = namlen+4 namln3 = namlen+6 namln4 = namlen+10 nam1: .rept 100 .byte 0 .endr nam2: .rept 100 .byte 0 .endr nam3: .rept 100 .byte 0 .endr nam4: .rept 100 .byte 0 .endr ttbsiz = 40 ttbuf: .blkb ttbsiz+2 buf1: .blkb maxsiz+2 ; record buffer for GETC channel 1 buf2: .blkb maxsiz+2 ; record buffer for GETC channel 2 buf3: .blkb maxsiz+2 ; record buffer for GETC channel 3 buf4: .blkb maxsiz+2 ; record buffer for GETC channel 4 bufx: .blkb 1002 ; one large buffer to share lun1 = 1 lun2 = 2 lun3 = 3 lun4 = 4 maxlun = lun4 .sbttl rms record access blocks rab1: rab$b ; define record access block r$fab fab1 ; associate a fab with this rab r$rac rb$seq ; access by keys r$rbf buf1 ; where to return the data r$ubf buf1 ; where to return the data r$usz maxsiz ; size of myrec (maximum size) rab$e ; end of record access block rab2: rab$b ; define record access block r$fab fab2 ; associate a fab with this rab r$rac rb$seq ; access by keys r$rbf buf2 ; where to return the data r$ubf buf2 ; where to return the data r$usz maxsiz ; size of myrec (maximum size) rab$e ; end of record access block rab3: rab$b ; define record access block r$fab fab3 ; associate a fab with this rab r$rac rb$seq ; access by keys r$rbf buf3 ; where to return the data r$ubf buf3 ; where to return the data r$usz maxsiz ; size of myrec (maximum size) rab$e ; end of record access block rab4: rab$b ; define record access block r$fab fab4 ; associate a fab with this rab r$rac rb$seq ; access by keys r$rbf buf4 ; where to return the data r$ubf buf4 ; where to return the data r$usz maxsiz ; size of myrec (maximum size) rab$e ; end of record access block sumxab: xab$b XB$SUM x$nxt proxab xab$e proxab: xab$b XB$PRO ; file protection xab x$nxt datxab ; link to date attribute block x$pro 60. ; normal protection of <60> xab$e ; end of file protection xab datxab: xab$b XB$DAT ; date attributes next x$nxt 0 ; no links to further xabs xab$e ; end of date xab .psect .psect $code .sbttl create sequential file .psect $code .even ; C R E A T E and OPEN ; ; create( %loc filename; %val channel_number, %val type ) ; open ( %loc filename; %val channel_number, %val type ) ; ; input: @r5 filename address ; 2(r5) channel number ; 4(r5) val 'binary' or 'text' or 0 ; ; output: r0 rms error code ; ; Create a variable length sequential implied carriage control ; disk file. If 'type' is 'binary' then use read/write access ; to write a fixed 512 byte image file. If channel number is ; zero (0), then initialize buffer single character terminal ; output. It is always assumed that channel '0' implies writes ; to the attached console terminal. .enabl lsb open:: save ; save registers clr -(sp) ; flag for open not create br 5$ ; and try to do it create::save ; save registers mov #-1 ,-(sp) ; flag for create 5$: $initif ; initialize rms i/o system if needed mov 2(r5) ,r0 ; get channel number please bne 10$ ; not channel zero, do it normally mov sp ,mode+0 ; psuedo writing to the terminal clr bufp+0 ; initialize the terminal's buffer br 120$ ; pointer and exit 10$: asl r0 ; times 2 mov r0 ,r2 ; save it please mov namlst(r2),r1 ; get address of name block calls fparse ,<@r5,r1> ; parse and fill in defaults tst r0 ; did the parse succeed ? bne 120$ ; no, exit with RMS error in r0 strlen r1 ; get the expanded filename length mov r0 ,namlen(r2) ; and save the length mov r2 ,r0 ; get r0 back again please mov fablst(r0),r1 ; get the file access block mov @sp ,r2 ; also pass create/open flag call settyp ; setup the FAB now mov r0 ,r2 ; save the channel number*2 tst @sp ; create or open bne 30$ ; if ne then create $open r1 ; if eq then open existing file mov #-1 ,bufp(r2) ; init for buffer needing a read clr mode(r2) ; no writing please br 40$ ; check RMS status out now 30$: $creat r1 ; try hard to create the file mov sp ,mode(r2) ; open for writing clr bufp(r2) ; clear single character i/o pointer 40$: $fetch r0,sts,r1 ; get status back out please tst r0 ; if status > 0 then status = 0 bmi 120$ ; error if less than zero mov 2(r5) ,r0 ; connect access up now call rmscon ; connect record stream up tst r0 ; if error > 0 then error = 0 bmi 120$ ; yep clr r0 ; error = 0 120$: tst (sp)+ ; pop open/create flag unsave ; pop registers we saved return ; and exit .dsabl lsb .sbttl setup things for open/create in the FAB ; S E T T Y P ; ; input: r0 channel number times 2 ; r2 <> 0 implies create ; r5 --> open/create parameter list ; fbrw = fb$rea ! fb$wri settyp::mov fablst(r0),r1 clr blknum(r0) ; in case of read/write mode mov #maxsiz ,bufsiz(r0) ; default for the buffer size mov #text ,filtyp(r0) ; assume ascii text files for now mov bufdef(r0),buflst(r0) ; set a default record buffer also clr bufs(r0) ; clear single character i/o recsiz $store namlen(r0),FNS,r1 $store #fb$seq,ORG,r1 ; insure sequential by default $store df$rat ,RAT,r1 ; implied carriage control $store df$rfm ,RFM,r1 ; and also variable length records $store #sydska,DNA,r1 ; stuff a default for SY: $store #sydskl,DNS,r1 ; and the size $store #fb$get,FAC,r1 ; insure readonly please tst r2 ; but are we creating the file beq 5$ ; no $store #fb$put,FAC,r1 ; yes, say we want seq puts 5$: cmp 4(r5) ,#binary ; is this a binary file ? bne 100$ ; no, just exit mov #1000 ,bufsiz(r0) ; yes, fix it up for that mov bigbuf(r0),buflst(r0) ; setup a large i/o buffer please mov #binary ,filtyp(r0) ; please $store #0 ,RAT,r1 ; no cr/lf implied please $store #fb$fix ,RFM,r1 ; fixed length also $store #fbrw ,FAC,r1 ; read/write mode needed ? save ; zero out the big buffer mov buflst(r0),r2 ; get the buffer address mov #1000 ,r3 ; 1000 (8) bytes please 10$: clrb (r2)+ ; simple sob r3 ,10$ ; next please unsave ; pop registers we just used 100$: $store bufsiz(r0),MRS,r1 ; stuff max recordsize in please return .sbttl close a file close:: save ; save registers we may have call flush ; dump out any remaining buffer mov @r5 ,r0 ; then disconnect the access stream beq 10$ ; terminal call rmsdis ; by doing a $disconnect mov @r5 ,r1 ; get the FAB for the file open on asl r1 ; the passed channel mov fablst(r1),r1 ; $close r1 ; try hard to close the file $fetch r0,sts,r1 ; get status back out please tst r0 ; if status > 0 then status = 0 blt 10$ ; error if less than zero clr r0 ; make > 0 status eq 0 10$: unsave return rewind::mov @r5 ,r0 beq 100$ asl r0 mov rablst(r0),r0 $rewind r0 100$: clr r0 return .sbttl connect record access block to file access block ; C O N N E C T ; ; connect( %val channel_number ) ; ; input: r0 channel number ; output: r0 rms sts ; ; Connect a record access block to a file access block. ; Called only from OPEN and CREATE rmscon: mov r0 ,r1 ; get address of record access block asl r1 ; channel number times 2 mov rablst(r1),r1 ; address of a rab to use $conne r1 ; try hard to connect access up $fetch r0,sts,r1 ; get status back out please tst r0 ; if status > 0 then status = 0 blt 10$ ; error if less than zero clr r0 ; make > 0 status eq 0 10$: return .sbttl disconnect record access block from file access block ; R M S D I S ; ; input: r0 channel number ; r0 error sts ; rmsdis: mov r0 ,r1 asl r1 mov rablst(r1),r1 $discon r1 ; disconnect access stream from file $fetch r0,sts,r1 ; get status back out please tst r0 ; if status > 0 then status = 0 blt 10$ ; error if less than zero clr r0 ; make > 0 status eq 0 10$: return .sbttl read a record from a sequential file ; G E T R E C ; ; getrec( %loc buffer, %val channel_number ) ; ; input: @r5 address of user buffer, at least 80 bytes ; 2(r5) channel number ; ; output: r0 rms sts ; r1 record size ; ; Read the next record from a disk file. Assumes that the ; user has supplied a buffer of 80 characters to return ; the record to. getrec::mov 2(r5) ,r0 ; get the channel number asl r0 ; times 2 to index into table mov rablst(r0),r1 ; get the record access buffer $store #0 ,RSZ,r1 $store @r5 ,UBF,r1 ; stuff a record buffer in $store bufsiz(r0),USZ,r1 ; and a maximum record size cmp filtyp(r0),#binary ; a binary file today ? bne 10$ ; no, use normal get$ clr o$bkt+0(r1) ; use sequential mode please clr o$bkt+2(r1) ; both words are to have zero $read r1 ; get next virtual block please br 20$ ; get error code out now 10$: $get r1 ; read a record now 20$: $fetch r0,STS,r1 ; get the return STATUS field tst r0 ; did it work ? blt 100$ ; no clr r0 ; say no errors $fetch r1,RSZ,r1 ; get the record size now 100$: return global .sbttl put a record to an rms sequential file ; P U T R E C ; ; putrec( %loc buffer, %val record_size, %val channel_number ) ; ; input: @r5 address of user buffer ; 2(r5) record size ; 4(r5) channel number ; ; output: r0 rms sts ; ; Write the next record to a disk file. putrec::mov r1 ,-(sp) mov 4(r5) ,r0 ; get the channel number bne 5$ ; if zero then assume TI: print @r5 ,2(r5) ; dump the buffer to ti: then br 100$ ; and exit 5$: asl r0 ; times 2 to index into table mov rablst(r0),r1 ; get the record access buffer $store @r5 ,RBF,r1 ; stuff a record buffer in $store 2(r5),RSZ,r1 ; and a current record size cmp filtyp(r0),#binary ; image mode today ? bne 10$ ; no $store #1000,RSZ,r1 ; yes, insure block write clr o$bkt+0(r1) ; yes, clear the VBN fields clr o$bkt+2(r1) ; yes, clear the VBN fields $write r1 ; simple br 20$ ; get the status and exit 10$: $put r1 ; read a record now 20$: $fetch r0,STS,r1 ; get the return STATUS field tst r0 ; did it work ? blt 100$ ; no clr r0 ; say no errors 100$: mov (sp)+ ,r1 return .sbttl getc get one character from an input file ; G E T C ; ; getc(%val channel_number) ; ; input: @r5 channel_number ; output: r0 rms error status ; r1 the character just read getc:: mov @r5 ,r0 call getcr0 return getcr0::save ; save temps mov r0 ,r2 ; channel number please asl r2 ; times 2 cmp bufp(r2),#-1 ; need to initialize the buffer? bne 10$ ; no calls getrec ,; yes, load it please tst r0 ; did the read work ? bne 100$ ; no, return rms error code clr bufp(r2) ; it worked. clear current pointer mov r1 ,bufs(r2) ; and save the record size br 30$ ; and goto common code 10$: cmp bufp(r2),#-2 ; flag to return ? bne 20$ ; no movb #cr ,r1 ; yes, return it in r1 mov #-3 ,bufp(r2) ; and setup for a nexttime clr r0 ; no error br 100$ ; bye 20$: cmp bufp(r2),#-3 ; flag to return a ? bne 30$ ; no movb #lf ,r1 ; yes, return in r1 mov #-1 ,bufp(r2) ; flag buffer reload next time clr r0 ; no error br 100$ 30$: tst bufs(r2) ; anything left to get in record? bne 40$ ; yes mov #-2 ,bufp(r2) ; no, flag for a next cmp filtyp(r2),#binary ; a binary file today ? bne 35$ ; yes, need data as is please mov #-1 ,bufp(r2) ; yes, flag for a read next 35$: mov r2 ,r0 ; channel number please asr r0 ; NOT times two call getcr0 ; call ourselves to do it br 100$ ; and exit 40$: mov buflst(r2),r3 ; get the address of the buffer add bufp(r2),r3 ; and point to the next character clr r1 ; to be returned in r1 bisb @r3 ,r1 ; simple inc bufp(r2) ; buffer.pointer := succ(buffer.pointer) dec bufs(r2) ; amountleft := pred( amountleft ) clr r0 ; no errors please 100$: unsave return .sbttl putc put a single character to an rms file ; P U T C ; ; input: @r5 the character to put ; 2(r5) the channel number to use ; ; Buffer single character i/o to internal disk buffer. ; Buffer is dumped if internal buffer is full or, for ; FB$VAR records (default for TEXT), a carraige return ; is found. For FB$VAR with FB$CR format, all carraige ; returns and line feeds are flushed as this record ; format will have them put back later. ; The local buffers are allocated in CREATE and OPEN. putc:: save ; simply save r1 and call putcr0 mov 2(r5) ,r1 ; to do it. putcr0 will be somewhat clr r0 ; faster to call directly due to the bisb @r5 ,r0 ; overhead involved in setting up an call putcr0 ; argument list. unsave ; pop saved r1 and exit return ; bye putcr0::save ; save registers we use mov r1 ,r2 ; channel number asl r2 ; times 2 of course cmp filtyp(r2),#binary ; is this a binary file today ? beq 5$ ; yes, don't dump buffer on cmpb r0 ,#cr ; end of line time today ? beq 10$ ; yes, dump the record out 5$: cmp bufp(r2),bufsiz(r2) ; is the buffer full ? blo 20$ ; no, store some more characters in it 10$: movb r0 ,r3 ; yes, save the input character r0 calls putrec , ; yes, dump the buffer please clr bufp(r2) ; pointer := 0 tst r0 ; did it work ? bne 100$ ; no, die mov buflst(r2),r4 ; it worked. zero the buffer now mov bufsiz(r2),r0 ; get the buffer address and size 15$: clrb (r4)+ ; for i := 1 to bufsiz sob r0 ,15$ ; do buffer[i] := chr(0) movb r3 ,r0 ; ok, restore the old character 20$: cmp filtyp(r2),#binary ; once again, is this a binary file ? beq 30$ ; yes, ignore checks for and ^Z. cmp filtyp(r2),#terminal ; terminal file today ? beq 30$ ; yes, we want cr's and lf's cmpb r0 ,#lf ; we simply like to ignore line feeds beq 90$ ; bye cmpb r0 ,#'Z&37 ; control Z ? beq 90$ ; yes, ignore the control Z's please cmpb r0 ,#cr ; carraige return today ? beq 90$ ; yes, ignore it 30$: mov bufp(r2),r1 ; get the current buffer pointer add buflst(r2),r1 ; and point to a new home for the movb r0 ,@r1 ; the input character in r0 inc bufp(r2) ; pointer := succ( pointer ) 90$: clr r0 ; no errors 100$: unsave return .sbttl flush flush: mov @r5 ,r0 ; get the internal channel number asl r0 ; times 2 for indexing tst bufp(r0) ; anything in the buffer beq 100$ ; no tst mode(r0) ; writing today ? beq 100$ ; no calls putrec , ; yes, dump it return 100$: clr r0 return .sbttl lookup do a filename lookup, wildcarding supported .enabl gbl ; L O O K U P ; ; input: @r5 arg count (DEC standard Fortran convention) ; 2(r5) address of input string ; @4(r5) flag word for initializing with a $PARSE ; 6(r5) address of output string ; ; output: r0 RMS error code ; ; ; clr index ;10$: calls lookup ,<#3,#inbuf,#index,#outbuf> ; tst r0 ; bne 100$ ; do something ; br 10$ .mcall $parse ,$search,$store ,$fetch ,$compare .mcall fab$b ,fab$e ,nam$b ,nam$e .psect $pdata fab: fab$b ; argument fab f$dna sydska ; if no device, sy: f$dns sydskl ; should be used f$nam nam ; link to nam f$lch 1 ; a dummy channel for the i/o op fab$e nam: nam$b ; nam definition n$esa expstr ; exp str address n$ess 64. ; exp str length n$rsa resstr ; res str address n$rss 64. ; res str length nam$e expstr: .blkb 64. ; context must be preserved here resstr: .blkb 64. ; a temp place for the result .psect ; no more r/w data .sbttl the real work of lookup .psect $code lookup::save mov #fab ,r1 ; map the target fab $store #sydska ,DNA,r1 ; stuff SY: as the default device $store #sydskl ,DNS,r1 ; and the size of that string strlen #defdir ; anything in the Kermit default dir? tst r0 ; if <> then use it beq 10$ ; nothing there to use, use SY: $store #defdir ,DNA,r1 ; something was there, stuff it in $store r0 ,DNS,r1 ; and the length of the default 10$: mov r1 ,r0 ; save it for later mov #nam ,r3 ; map the target nam tst @4(r5) ; first time thru needs a parse bne 40$ ; not the first time clrb expstr ; clear the expanded name and clrb resstr ; the resultant string mov 2(r5) ,r4 ; point to the filename passed mov r4 ,r1 ; and save the pointer 20$: tstb (r1)+ ; and get the length of the name bne 20$ ; for an .asciz string sub r4 ,r1 ; compute the length of the string dec r1 ; which is off by one $store #lun.sr,lch,r0 ; channel number please $store r1,fns,r0 ; stuff the filename length $store r4,fna,r0 ; and the filename address $parse r0 ; parse the strings $fetch r4,sts,r0 ; get error codes tst r4 ; < 0 ? bmi 90$ ; yes, error 40$: $search r0 ; get a matching file $fetch r4,sts,r0 ; get error codes tst r4 ; < 0 ? bmi 90$ ; yes, error $fetch r0,rsl,r3 ; get the string length $fetch r2,rsa,r3 ; get the string address mov 6(r5) ,r1 ; where to return the string 50$: movb (r2)+ ,(r1)+ ; copy it over sob r0 ,50$ ; for however the long it is clrb @r1 ; insure .asciz please clr r0 ; no errors inc @4(r5) ; say we have at least one file br 100$ ; and exit 90$: mov r4 ,r0 ; error, return it please br 100$ ; exit 100$: unsave return .sbttl rename ; R E N A M E ; ; input: @r5 old filename address ; 2(r5) new filename address ; 4(r5) flag, lt 0 don't print the results else print a log ; ; output: r0 error code, zero if at least one file found ; r1 number of files renamed .psect rendat ,rw,d,lcl,con,lcl .mcall $compare,$fetch ,$parse ,$search,$set ,$store .mcall fab$b ,nam$b ,$rename RNFAB1::FAB$B ; Old file name F$DNA SYDSKA ; Default to SY: F$DNS SYDSKL F$NAM RNNAM1 ; Link to RNNAM1 F$LCH 1 ; Channel 1 (a dummy, filled in later) FAB$E RNNAM1::NAM$B ; NAM definition NAM$E RNFAB2::FAB$B ; New file name F$DNA SYDSKA ; Default to SY: F$DNS SYDSKL F$NAM RNNAM2 ; Link to RNNAM2 F$LCH 1 ; a dummy channel FAB$E RNNAM2::NAM$B ; NAM definition NAM$E .sbttl the real work of rename .psect $code rename::save ; save temps please mov #rnfab1 ,r0 ; point to the old name FAB mov #rnfab2 ,r1 ; point to the new name FAB mov #rnnam1 ,r2 ; point to the old name's NAMEBLOCK mov #rnnam2 ,r3 ; point to the new name's NAMEBLOCK $store #sydska ,DNA,r0 ; stuff SY: as the default device $store #sydskl ,DNS,r0 ; and the size of that string $store #sydska ,DNA,r1 ; stuff SY: as the default device $store #sydskl ,DNS,r1 ; and the size of that string mov r0 ,r4 ; save the FAB1 pointer now strlen #defdir ; anything in the Kermit default dir? tst r0 ; if <> then use it beq 5$ ; nothing there to use, use SY: $store #defdir ,DNA,r1 ; something was there, stuff it in $store r0 ,DNS,r1 ; and the length of the default $store #defdir ,DNA,r4 ; something was there, stuff it in $store r0 ,DNS,r4 ; and the length of the default 5$: mov r4 ,r0 ; restore FAB1 pointer now $store #lun.sr ,LCH,r0 ; stuff a logical unit number $store #lun.sr ,LCH,r1 ; stuff a logical unit number sub #100 ,sp ; allocate an ESA for old name $store sp ,ESA,r2 ; and stuff the address in $store #100,ESS,r2 ; and the length of it please sub #100 ,sp ; next is the resultant string $store sp ,RSA,r2 ; buffer for the old filename $store #100,RSS,r2 ; and the size of it please sub #100 ,sp ; the new filename buffer $store sp ,ESA,r3 ; stuff address of the buffer $store #100,ESS,r3 ; and the size of it please clr -(sp) ; a count of the files done so far mov #rnfab1 ,r1 ; point to the old name FAB mov #rnfab2 ,r2 ; point to the new name FAB strlen @r5 ; get the .asciz length of old $store @r5 ,FNA,r1 ; store the old filename address $store r0 ,FNS,r1 ; stuff the length of the old name mov #rnfab1 ,r0 ; point to the old name FAB $parse r0 ; parse the old name please $compar #0 ,STS,r0 ; did the parse work out ok ? blt 90$ ; no, exit strlen 2(r5) ; get the length of the new name $store 2(r5),FNA,r2 ; stuff the new name into FNS field $store r0 ,FNS,r2 ; and the size of it please 10$: mov #rnfab1 ,r0 ; point to the old name FAB mov #rnfab2 ,r1 ; point to the new name FAB mov #rnnam1 ,r2 ; point to the old name's NAMEBLOCK mov #rnnam2 ,r3 ; point to the new name's NAMEBLOCK $set #fb$fid,FOP,r0 ; set explicit search please $search r0 ; do a directory lookup please $compar #0 ,STS,r0 ; did the lookup work ? blt 90$ ; oops, it didn't work $fetch r4 ,RSA,r2 ; get the resultant address $store r4 ,DNA,r1 ; set this as default $fetch r4 ,RSL,r2 ; get the resultant length $store r4 ,DNS,r1 ; set the default length $rename r0,,,r1 ; rename input as output $compar #0 ,sts,r0 ; error? blt 90$ ; yes, exit please inc @sp ; no errors, count that file tst 4(r5) ; should we print the results ? bmi 10$ ; no call 200$ ; yes br 10$ ; go back for more please 90$: mov @sp ,r1 ; return # files renamed dec (sp)+ ; did we get any work done ? bge 100$ ; yes $fetch r0 ,STS,r0 ; no, get the error code cmp r0 ,#ER$NMF ; no files, was it NO MORE FILES ? bne 110$ ; no mov #ER$FNF ,r0 ; yes, change it to FILE NOT FOUND br 110$ ; and exit 100$: clr r0 ; success exit, no errors 110$: add #3*100 ,sp ; pop the buffers unsave ; pop registers now return 200$: print #300$ movb o$rsl(r2),r0 print o$rsa(r2),r0 print #310$ movb o$esl(r3),r0 print o$esa(r3),r0 print #320$ return .enabl lc 300$: .asciz /File / 310$: .asciz / renamed to / 320$: .byte cr,lf,0 .even .sbttl delete a file(s) ; input: @r5 address of filename spec ; 2(r5) if eq -1, don't print the results out ; 0, print on terminal ; >0, write to lun in 2(r5) ; ; output: r0 RMS error code ; r1 number of files renamed delfab = rnfab1 ; reuse the rename fab delnam = rnnam1 ; reuse the rename name block ; internal register usage ; ; r0 RMS error STS ; r1 pointer to the FAB for this operation ; r2 pointer to the NAM block for this operation ; r3 number of files deleted ; r5 pointer to the argument list delete::save ; save registers we may overwrite clr r3 ; files_deleted := 0 mov #delfab ,r1 ; point to the fab we use $store #sydska ,DNA,r1 ; stuff SY: as the default device $store #sydskl ,DNS,r1 ; and the size of that string strlen #defdir ; anything in the Kermit default dir? tst r0 ; if <> then use it beq 5$ ; nothing there to use, use SY: $store #defdir ,DNA,r1 ; something was there, stuff it in $store r0 ,DNS,r1 ; and the length of the default 5$: $store #lun.sr,LCH,r1 ; a channel number to use for delete $off #fb$fid,FOP,r1 ; we want an implicit $SEARCH mov #delnam ,r2 ; also point to the NAME block sub #200 ,sp ; allocate result name string $store sp ,RSA,r2 ; set up the pointer to name string $store #200,RSS,r2 ; and set the size of the string sub #200 ,sp ; allocate result expanded name string $store sp ,ESA,r2 ; set up the pointer to expanded name $store #200,ESS,r2 ; and set the size of the string $store #ER$FNM ,STS,r1 ; preset a bad filename error strlen @r5 ; get the length of the filename tst r0 ; anything left at all ? beq 90$ ; no, fake a bad filename please $store r0 ,FNS,r1 ; stuff the filename size in please $store @r5 ,FNA,r1 ; stuff the filename address into FAB $parse r1 ; try to parse the filename now $compar #0 ,STS,r1 ; did the parse of the name work ? blt 90$ ; no, exit and return STS in r0 10$: $erase r1 ; parse worked, try to delete it $compar #0 ,STS,r1 ; did the erase work out ok ? blt 90$ ; no inc r3 ; count the file as being deleted call 200$ ; do any echoing now please br 10$ ; next please 90$: $fetch r0 ,STS,r1 ; get the error code out please mov r3 ,r1 ; return the # of files deleted cmp r0 ,#ER$NMF ; error is no more files ? bne 95$ ; no mov #ER$FNF ,r0 ; yes, make it into file not found tst r3 ; ever delete any files at all ? beq 100$ ; no, leave the error as FNF clr r0 ; yes, at least one file deleted br 100$ ; bye 95$: tst r0 ; error code > 0 bmi 100$ ; no clr r0 ; yes, make the error STS zero then 100$: add #200*2 ,sp ; pop local buffers please unsave ; pop temps and exit return .sbttl printing routines for DELETE 180$: tst 2(r5) ; print out an initial header beq 190$ ; yes, but to the terminal bmi 195$ ; not at all, please strlen #300$ ; no, put it out to disk please calls putrec ,<#300$,r0,2(r5)>; dump the record to disk br 195$ ; and exit 190$: print #300$ ; dump the header to the terminal 195$: return ; bye 200$: cmp r3 ,#1 ; deleted anything as of yet ? bne 210$ ; yes call 180$ ; no, dump a header out please 210$: clr r0 ; get set to get the string length bisb o$rsl(r2),r0 ; get the string length beq 250$ ; nothing was there to print ????? tst 2(r5) ; echo files deleted to terminal ? beq 240$ ; yes, echo to tt: bmi 250$ ; no, don't echo at all calls putrec ,; echo to a file that's open br 250$ 240$: print o$rsa(r2),r0 ; print the filename out to tt: print #310$ 250$: return 300$: .asciz /Files deleted:/ 310$: .byte cr,lf,0 .even .sbttl fparse parse filename and fill in with defaults .mcall $compar ,$fetch ,$off ,$parse ,$store parfab = rnfab1 parnam = rnnam1 ; F P A R S E ; ; input: @r5 input filename, .asciz ; defdir the default directory name string to use ; ; output: 2(r5) expanded filename, .asciz, maximum length 63 bytes ; r0 error codes fparse::save ; save registers we may overwrite mov #parfab ,r1 ; point to the fab we use $store #sydska,DNA,r1 ; stuff the default name string $store #sydskl,DNS,r1 ; stuff the default name size in FAB strlen #defdir ; get the default directory spec tst r0 ; was anything there ? beq 5$ ; no $store #defdir,DNA,r1 ; yes, stuff that in for the default $store r0 ,DNS,r1 ; name string, and stuff the length. 5$: $store #lun.sr,LCH,r1 ; a channel number to use for $PARSE $off #fb$fid,FOP,r1 ; we want an implicit $SEARCH mov #parnam ,r2 ; also point to the NAME block sub #100 ,sp ; allocate result name string $store sp ,RSA,r2 ; set up the pointer to name string $store #100,RSS,r2 ; and set the size of the string sub #100 ,sp ; allocate result expanded name string $store sp ,ESA,r2 ; set up the pointer to expanded name $store #100,ESS,r2 ; and set the size of the string $store #ER$FNM ,STS,r1 ; preset a bad filename error strlen @r5 ; get the length of the filename tst r0 ; anything left at all ? beq 90$ ; no, fake a bad filename please $store r0 ,FNS,r1 ; stuff the filename size in please $store @r5 ,FNA,r1 ; stuff the filename address into FAB $parse r1 ; try to parse the filename now $compar #0 ,STS,r1 ; did the parse of the name work ? blt 90$ ; no, exit and return STS in r0 mov 2(r5) ,r1 ; where we will copy the name to movb o$esl(r2),r0 ; the length of the new name beq 30$ ; can't happen unless you fubar cmp r0 ,#77 ; truncate names that are too long blos 10$ ; it's ok mov #77 ,r0 ; too long, please set it to 63 (10) 10$: mov o$esa(r2),r2 ; where the name is coming from 20$: movb (r2)+ ,(r1)+ ; copy a byte at a time please sob r0 ,20$ ; next please 30$: clrb @r1 ; insure .asciz please clr r0 ; no errors please br 100$ ; bye 90$: $fetch r0,STS,r1 ; error from parse, return in r0 100$: add #200 ,sp ; pop local nameblock buffers unsave ; pop registers return ; bye global .sbttl return current task size and return exec .mcall gtsk$s ; G E T S I Z ; ; output: r0 current task size getsiz::sub #40 ,sp ; use the stack for a buffer mov sp ,r0 ; and point to it please gtsk$s r0 ; simple mov g.tsts(r0),r0 ; return current size add #40 ,sp ; pop buffer and exit return ; bye ; G E T S Y S ; ; output: r0 operating system ; ; sy$11m (1) for rsx11m ; sy$ias (3) for ias ; sy$rsts (4) for rsts ; sy$mpl (6) for m+ ; sy$rt (7) for rt11 ???? getsys::sub #40 ,sp ; use the stack for a buffer mov sp ,r0 ; and point to it please gtsk$s r0 ; simple mov g.tssy(r0),r0 ; return exec add #40 ,sp ; pop buffer and exit return ; bye .sbttl gsa get space for i/o buffers ; Modified from sample GSA from RMS v2 distribution ; by Brian Nelson 05-Jan-84 10:22:06 ; ; ; Interface: ; Request space: ; R0 -> RMS/user Pool list head (maintained by RL/CQB) ; R1 := Amount of space requested (bytes) ; R2 := 0 (differentiates between request and release) ; ; Release space: ; R0 -> RMS Pool list head (maintained by RL/CQB) ; R1 := Amount of space to be released (bytes) ; R2 -> Base address (for release) ; ; ; Returns: ; C-Bit "set" if an error has occurred (failure) ; C-Bit "clear" if no error has occurred (success) ; .Mcall Extk$S .Sbttl Control block definitions .Psect GSA$$D,RW,D ; ; GSA internal data: ; ; GSABAS - Base address for the next memory allocation. ; Initially set to zero, it will be assigned ; the first address outside of the task's ; current address limits. ; GSAMIN - Decimal value reflecting the minimum size ; (in bytes) to extend the task in order to ; provide space to the pool. ; GSAREQ - Requested pool block number. If a request ; for the 'GSAMIN' fails, then the original ; allocation size will be attempted. If that ; fails, then there is no more memory left. ; GSABAS:: ; GSA base address .Word 000000 ; (for next allocation) GSAMIN:: ; Minimum allocation .Word 512./64. ; (in 32-word blocks) GSAREQ:: ; Size of this request .Word 000000 ; (if 'GSAMIN' extends fail) .Sbttl GSA Initialization code .Psect GSA$$I,RO,I GSAINI: Mov R0,-(SP) ; R0-2 will be used to Mov R1,-(SP) ; communicate with $INIDM Mov R2,-(SP) ; NOTE: $INIDM uses EXTSK. Call $INIDM ; Initialize dynamic memory Mov R1,GSABAS ; Setup the "free" address Mov (SP)+,R2 ; Restore the registers Mov (SP)+,R1 ; Mov (SP)+,R0 ; Return ; And return to GSA .Sbttl GSA Mainline code .Psect GSA$$M,RO,I ; ; GSA Mainline ; ; Entry point is "GSA", with registers 0-2 loaded as ; described above. ; GSA:: gsax: ; ; First, determine if dynamic memory has been initialized. ; GSABAS (initially set to zero) will be non-zero if $INIDM ; has been called and the memory list initialized. On RSX ; based systems it is possible to install tasks with an ; extension (/INCREMENT). $INIDM will detect this and setup ; the first memory entry in the pool list. ; ; A point to note: If the RSX task has been installed with ; the non-checkpointable (/-CP) flag, then EXTKs will not ; return success. If it is necessary to install the task ; non-checkpointable, then the task should be installed with ; and increment value. ; Tst GSABAS ; Dynamic memory initialized? Bne 10$ ; Yes if NE, proceed Call GSAINI ; Otherwise, initialize pool 10$: Tst R1 ; Real memory? Bne 20$ ; Yes if NE, then process it Return ; Otherwise return with success 20$: Tst R2 ; Address specified? (release) Beq 30$ ; No if EQ, then it's a request Jmp $RLCB ; Otherwise it's a release; do it 30$: Mov R0,-(SP) ; save pool list head Mov R1,-(SP) ; save size of request Mov R2,-(SP) ; save entry flag Call $RQCB ; Try the allocation Bcc 70$ ; CC signifies success Mov 2(SP),R1 ; Obtain the request size Add #63.,R1 ; Round the request Asr R1 ; to a 32-word boundary Asr R1 ; Then convert the value Asr R1 ; to the number of Asr R1 ; 32-word blocks. Asr R1 Asr R1 Mov R1,GSAREQ ; Save the real size Cmp R1,GSAMIN ; Smaller than minimum? Bhi 40$ ; No if HI, use it as is Mov GSAMIN,R1 ; Otherwise use GSAMIN 40$: Extk$S R1 ; Extend the task Bcc 60$ ; CC if successful Cmp R1,GSAREQ ; Is this request? Blos 50$ ; Yes if LOS, the end Mov GSAREQ,R1 ; Otherwise try to use Br 40$ ; the actual request 50$: Sec ; Mark failure Br 70$ ; And exit 60$: Mov 4(SP),R0 ; Setup the PLH Asl R1 ; Convert the real Asl R1 ; size to the actual Asl R1 ; 16-bit size that Asl R1 ; was allocated. Asl R1 ; The virtual address Asl R1 ; should be after the Mov GSABAS,R2 ; task (which is now Add R1,GSABAS ; part of the task) Call GSAX ; Call ourself to release Mov (SP)+,R2 ; Restore our registers Mov (SP)+,R1 ; to the initial state Mov (SP)+,R0 ; upon entry, and reenter Br GSAX ; as if it's a new request 70$: Inc (SP)+ ; These won't alter the Bit (SP)+,(SP)+ ; C-bit, so status remains Return ; unchanged upon return .end