m$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 $testbits 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 f$xab datxb1 ; Date info 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 f$xab datxb2 ; Date info 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 f$xab datxb3 ; Date info 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 f$xab datxb4 ; Date info fab$e sydisk::.ascii /SY:/ sylen == . - sydisk .even sydska == sydisk sydskl == sylen ; ;RBD01-- ; 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 itsopen:.word 0 ,0 ,0 ,0 ,0 filsiz == 110. BINLSIZ == 30*4 defdir::.blkb filsiz+2 ; default directory for send and rec srcnam::.blkb filsiz+2 ; original send filespec filnam::.blkb filsiz+2 ; output from directory lookup routine asname::.blkb filsiz+2 ; for SEND file [as] file $cmdbu::.blkb 120 $argbu::.blkb 120 bintyp::.word 10$ 10$: .rept BINLSIZE .byte 0 .endr totp.r::.word 10$ 10$: .rept 34 .word 0,0 .endr totp.s:K11RMSMAC[.050032]K11RMS.MAC[.050032]    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|bddfen:: calls fopen ,<@r5,2(r5),4(r5),#0> return create::calls fcreate ,<@r5,2(r5),4(r5),#0> return append::calls fapnd ,<@r5,2(r5),4(r5),#0> return fopen:: save ; save registers call drpprv ; insure no privs are up now +MJG clr -(sp) ; flag for open not create br 5$ ; and try to do it fapnd:: save ; save registers +SSH call drpprv ; insure no privs +SSH mov #1,-(sp) ; flag for open / append +SSH br 5$ ; and try to do it +SSH fcreat::save ; save registers call drpprv ; insure no privs are up now +MJG tcreat: 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 ,itsopen+0 ; flag it as having been initted 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 ; pass create/open/append flag /SSH call settyp ; setup the FAB now mov r0 ,r2 ; save the channel number*2 tst @sp ; create or open or append /SSH bmi 30$ ; if negative then create /SSH $open r1 ; try to open existing file /SSH tst @sp ; opening for append ? +SSH beq 28$ ; no, go setup for read +SSH mov sp ,mode(r2) ; indicate open for writing +SSH clr bufp(r2) ; clear single char i/o pointer +SSH br 40$ ; continue with status check +SSH 28$: ; +SSH 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 130$ ; error if less than zero /SSH mov 2(r5) ,r0 ; connect access up now asl r0 ; flag also that we are open mov sp ,itsopen(r0) ; simple asr r0 ; restore r0 now mov 6(r5) ,r1 ; and the multiblock count also mov (sp) ,r2 ; and the create/open/append opt +SSH 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 125$: unsave ; pop registers we saved return ; and exit 130$: tst (sp)+ ; if error on open for append +SSH ble 125$ ; no, return with error +SSH br tcreat ; yes, try creating the file +SSH global ; +MJG .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 #fb$get,FAC,r1 ; insure readonly please tst fu$def ; do we require a default device beq 1$ ; no $store #sydisk,DNA,r1 ; yes, stuff the correct def dev in $store #sylen ,DNS,r1 ; and the length of it also please 1$: tst r2 ; if creating or appending the file /SSH beq 5$ ; no /SSH $store #,FAC,r1 K11RMSMAC[.050032]K11RMS.MAC[.050032]    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 return error in r0, size in r1 asl r1 ; lun times 2 mov fablst(r1),r1 ; fab for this file mov (r1),r1 ; get the size please clr r0 ; no errors return ; exit ; Getcdt Return time/date of creation, system (ie, RMS vs RT) dep. ; ; Passed: 2(r5) Channel number file is open on ; Return: R0 Zero if failure (internal error) else address of ; 64 byte Smithsonian date format Getcdt::mov @r5 ,r0 ; Channel beq 100$ ; Oops asl r0 ; Word offsets mov FABLST(r0),r0 ; Get the fab beq 100$ ; Impossible mov O$XAB(r0),r0 ; XAB address beq 100$ ; Nothing add #O$CDT ,r0 ; Point to 4word creation dat/tim 100$: return ; Exit Putcdt::mov @r5 ,r0 ; Channel beq 100$ ; Oops asl r0 ; Word offsets mov FABLST(r0),r0 ; Get the fab beq 100$ ; Impossible mov O$XAB(r0),r0 ; XAB address beq 100$ ; Nothing add #O$CDT ,r0 ; Point to 4word creation dat/tim mov 2(r5) ,r1 ; Data mov (r1)+ ,(r0)+ ; Copy it mov (r1)+ ,(r0)+ ; .Copy it mov (r1)+ ,(r0)+ ; ..Copy it mov (r1)+ ,(r0)+ ; ...Copy it 100$: return ; Exit getatr::save ; save these please mov @r5 ,r1 ; the channel number please asl r1 ; times two please mov fablst(r1),r1 ; simple mov o$ifi(r1),r1 ; and now we are at the ifab mov 2(r5) ,r2 ; where to copy the attributes to movb f$ratt(r1),(r2)+ ; stuff the input record attributes movb f$forg(r1),(r2)+ ; also stuff the input file org in mov f$rsiz(r1),(r2)+ ; and the input record size please mov f$hvbn(r1),(r2)+ ; and the input eof markers mov f$lvbn(r1),(r2)+ ; like hi and low virtual block mov f$heof(r1),(r2)+ ; and the high and low eof block mov f$leof(r1),(r2)+ ; numbers also mov f$ffby(r1),(r2)+ ; and, at last, the first free byte movb f$hdsz(r1),(r2)+ ; VFC header size next movb f$bksz(r1),(r2)+ ; and largest bucket size mov f$mrs(r1) ,(r2)+ ; the maximum record size mov f$deq(r1) ,(r2)+ ; and the default extenstion size mov f$rtde(r1),(r2)+ ; and the run time extentsion size 100$: unsave ; all done clr r0 ; say it worked ok return putatr::save ; save these please mov @r5 ,r1 ; the channel number please asl r1 ; times two please mov fablst(r1),r1 ; simple mov o$ifi(r1),r1 ; and now we are at the ifab mov 2(r5) ,r2 ; where to get the attributes from movb (r2)+ ,f$ratt(r1) ; stuff the input record attributes movb (r2)+ ,f$forg(r1) ; also stuff the input file org in mov (r2)+ ,f$rsiz(r1) ; and the input record size please mov (r2)+ ,f$hvbn(r1) ; and the input eof markers mov (r2)+ ,f$lvbn(r1) ; like hi and low virtual block mov (r2)+ ,f$heof(r1) ; and the high and low eof block mov (r2)+ ,f$leof(r1) ; numbers also mov (r2)+ ,f$ffby(r1) ; and, at last, the first free byte movb (r2)+ ,f$hdsz(r1) ; VFC header size next movb (r2)+ ,f$bksz(r1) ; and largest bucket size mov (r2)+ ,f$mrs(r1) ; the maximum record size mov (r2)+ ,f$deq(r1) ; and the default extenstion size mov (r2)+ ,f$rtde(r1) ; and the run time extentsion size 100$: unsave ; all done clr r0 ; say it worked ok 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 ; r1 multiblock count ; r2 create/open/append option flag +SSH ; output: r0 rms sts ; ; Connect a record access block to a file access block. ; Called only from OPEN and CREATE rmscon: mov r1 ,-(sp) ; the block count size 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 $store (sp)+,MBC,r1 ; the block buffer count $store #0,ROP,r1 ; assume no processing options +SSH tst r2 ; if appending to existing file +SSH ble 7$ ; no, leave options alone +SSH $store #rb$eof,ROP,r1 ; yes, set position to EOF option +SSH 7$: ; +SSH $conne r1 ; try hard to connect access up $fetch r0,sts,r1 ; get status back out please tst r0 ;K11RMSMAC[.050032]K11RMS.MAC[.050032]    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|bddfbinary ; 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 .mcall $off $testbits ;RBD01 .psect $pdata fab: fab$b ; argument fab f$nam nam ; link to nam ;RBD01-- 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 K11RMSMAC[.050032]K11RMS.MAC[.050032]    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|bddfH 1 ; Channel 1 (a dummy, filled in later) FAB$E RNNAM1::NAM$B ; NAM definition NAM$E RNFAB2::FAB$B ; New file name F$NAM RNNAM2 ; Link to RNNAM2 ;RBD01-- F$LCH 1 ; a dummy channel FAB$E RNNAM2::NAM$B ; NAM definition NAM$E .restore .sbttl fparse parse filename and fill in with defaults .mcall $compar ,$fetch ,$off ,$parse ,$store .mcall tlog$s 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 tlog:: save ; /46/ Save registers sub #200 ,sp ; /46/ Allocate a buffer mov sp ,r3 ; /46/ And a pointer to it please call getsys ; /46/ Is this RSTS/E ? cmpb r0 ,#SY$RSTS ; /46/ If so, don't try TLOG$S out beq 100$ ; /46/ Skip, must be RSTS/E strlen (r5) ; /46/ Get length of input string TLOG$S #0,ln$mk1,#0,(r5),r0,r3,#77,#tlogda,#tlogda+2 cmpb @#$DSW,#IS.SUC ; /46/ Did we get a translation? bne 100$ ; /46/ No, exit this mov r3 ,r2 ; /46/ Setup to make it asciz add tlogda ,r3 ; /46/ Add the translated string length clrb (r3) ; /46/ in and insure it's .asciz strcpy (r5) ,r2 ; /46/ Copy new name over and exit 100$: add #200 ,sp ; /46/ Pop local buffer unsave ; /46/ Exit clr r0 ; /46/ No errors return ; /46/ Exit .save .psect $PDATA tlogda: .word 0,0 ; /46/ Returned data ln$mk1::.word 0 .restore fparse::save ; /46/ save registers we may overwrite mov @r5 ,r4 ; /46/ Assume input from source call getsys ; /46/ Is this RSTS/E ? cmpb r0 ,#SY$RSTS ; /46/ If so, don't try TLOG$S out beq 2$ ; /46/ Skip, must be RSTS/E mov 2(r5) ,r3 ; /46/ Address of a buffer to use strlen r4 ; /46/ Get length of input string TLOG$S #0,ln$mk1,#0,r4,r0,r3,#77,#tlogda,#tlogda+2 cmpb @#$DSW,#IS.SUC ; /46/ Did we get a translation? bne 2$ ; /46/ No, exit this mov r3 ,r4 ; /46/ We did, set a new source address add tlogda ,r3 ; /46/ Add the translated string length clrb (r3) ; /46/ in and insure it's .asciz 2$: mov #parfab ,r1 ; point to the fab we use ;RBD01-- $store #0,DNS,r1 ; /42/ PLEASE clear this OUT! tst fu$def ; do we need a defualt device string? beq 3$ ; no $store #sydisk,DNA,r1 ; yes, please put it where we need it $store #sylen ,DNS,r1 ; also, the length also 3$: strlen #defdir ; get the default directory spec tst r0 ; was anything there ? beq 4$ ; no $store #defdir,DNA,r1 ; yes, stuff that in for the default $store r0 ,DNS,r1 ; name string, and stuff the length. 4$: $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 r4 ; /46/ 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 r4,FNA,r1 ; /46/ stuff the filename address $parse r1 ; try to parse the filename now $compar #ER$UIN,sts,r1 ; Maybe a remote file spec? ;RBD01+ bne 5$ ; (no) $testb #,fnb,r2 ; Anything wild? bne 90$ ; (wild remote files no good) $testb #nb$nod,fnb,r2 ; Remote file? beq 90$ ; (ER$UIN with no node???) $off #nb$wch,fnb,r2 ; Make succeeding $search's act nice br 7$ ; Go ahead with it ;RBD01- 5$: $compar #0 ,STS,r1 ; did the parse of the name work ? blt 90$ ; no, exit and return STS in r0 7$: mov 2(r5) ,r1 ; where we willK11RMSMAC[.050032]K11RMS.MAC[.050032]    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|bddfto 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 .mcall extk$s ,gtsk$s GSAINI: Mov R0,-(SP) ; R0-2 will be used to Mov R1,-(SP) ; communicate with $INIDM Mov R2,-(SP) ; NOTE: $INIDM uses EXTSK. mov r0 ,-(sp) ; save r0 sub #40 ,sp ; check for 512 boundary mov sp ,r0 ; get the current task size and see gtsk$s r0 ; if we are at a boundary. if so, then mov g.tsts(r0),r0 ; extend a little bit to get INIDM to add #40 ,sp ; behave itself bic #^c777 ,r0 ; strip all the high crap cmp r0 ,#776 ; should we extend a little bit? blo 10$ ; no extk$s #1 ; yes, get 64 more bytes please 10$: mov (sp)+ ,r0 ; restore r0 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 allocK11RMSMAC[.050032]K11RMS.MAC[.050032]    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|bddfated. 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