home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
kermit.columbia.edu
/
kermit.columbia.edu.tar
/
kermit.columbia.edu
/
test
/
pdp11
/
krtrmz.mac
< prev
next >
Wrap
Text File
|
1996-10-17
|
11KB
|
361 lines
.title krtrmz overlayed RMS11 code (V04.64)
.ident /V04.64/
.psect $code
; /E64/ 10-May-96 John Santos
;
; From K11RMZ.MAC
; use wrtall instead of print
; Creation: 24-Jan-86 14:06:18 Brian Nelson
;
; With the addition of long packet support the root is getting
; too large.
;
; Entry points:
;
; delete delete a file(s)
; rename rename a file(s)
; getmcr get mcr/ccl command line, only used ONCE
;
;
; Copyright (C) 1986 Change Software, Inc
.if ndf, KRTINC
.ift
.include /IN:KRTMAC.MAC/
.endc
.library /LB:[1,1]RMSMAC.MLB/
.mcall $compare,$fetch ,$parse ,$search,$set ,$store
.mcall fab$b ,nam$b ,$rename,$erase ,$off ,$testb
nb$nod = 400 ; Node in file or default string (FNB in NAM)
.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
.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
.sbttl the real work of rename
.psect $code
.enabl lsb
rename::save <r2,r3,r4,r5> ; 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
tst fu$def ; do we really need a default device?
beq 1$ ; no
$store #sydisk,DNA,r0 ; yes. Stuff the default system device
$store #sylen ,DNS,r0 ; name and length to the source name and
$store #sydisk,DNA,r1 ; then do the same for the new name. Put
$store #sylen ,DNS,r1 ; the def device address and length in.
1$: mov r0 ,r4 ; save the FAB1 pointer now ;RBD01--
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 <r5,r4,r3,r2> ; pop registers now
return
200$: wrtall #300$ ; /E64/
movb o$rsl(r2),r0
print o$rsa(r2),r0
wrtall #310$ ; /E64/
movb o$esl(r3),r0
print o$esa(r3),r0
wrtall #320$ ; /E64/
return
.save
.psect $PDATA ,D
.enabl lc
300$: .asciz /File /
310$: .asciz / renamed to /
320$: .byte cr,lf,0
.even
.restore
.dsabl lsb
.sbttl delete a file(s)
.enabl lsb
; 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
;
;
; 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 <r2,r3,r4> ; save registers we may overwrite
clr r3 ; files_deleted := 0
mov #rnfab1 ,r1 ; point to the fab we use ;RBD01--
tst fu$def ; do we need a default device name?
beq 1$ ; no
$store #sydisk ,DNA,r1 ; yes, please stuff the correct defs
$store #sylen ,DNS,r1 ; simple
1$: 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 #rnnam1 ,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 <r4,r3,r2> ; 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$: wrtall #300$ ; /E64/ 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 ,<o$rsa(r2),r0,2(r5)>; echo to a file that's open
br 250$
240$: print o$rsa(r2),r0 ; print the filename out to tt:
wrtall #310$ ; /E64/
250$: return
.save
.psect $PDATA ,D
300$: .asciz <cr><lf>/Files deleted:/<cr><lf>
310$: .byte cr,lf,0
.even
.restore
.dsabl lsb
.sbttl get mcr/ccl (rsts) command line and remove task name
.mcall gmcr$ ,dir$
.psect mcrbuf ,rw,d,lcl,rel,con
gmcr: gmcr$
.psect $code
; G M C R
;
; output: @r5 the command line less the task name, .asciz
; r0 the length of whats left
; NOTE: blank insertion ----+ +SSH
; V +SSH
; @takefil will parse to @ takefile... +SSH
; which allows KER @TAKEFIL to work. +SSH
getmcr::save <r1,r2,r3> ; just for kicks, save these /SSH
clr r3 ; clear the "space flag" +SSH
mov @r5 ,r2 ; point to the resultant command
clrb @r2 ; insure .asciz
dir$ #gmcr ; get the command line
movb @#$dsw ,r0 ; get the length of it
ble 90$ ; nothing
mov #gmcr+g.mcrb,r1
10$: cmpb @r1 ,#40 ; look for the space delimiting
beq 20$ ; the task name from the command
inc r1 ; line. did not find it, keep looking
sob r0 ,10$ ; keep trying
br 90$ ; nothing
20$: inc r1 ; found the space, skip past it
dec r0 ; whats left of it
ble 90$ ; nothing
clr -(sp) ; a length counter today
30$: tst r3 ; is the space flag set ? +SSH
bne 32$ ; yes, go check for " " char +SSH
cmpb (r1),#'@ ; no, check for "@" char +SSH
bne 33$ ; no @ char, just continue +SSH
inc r3 ; yes an @, so set space flag +SSH
br 33$ ; and continue with copy +SSH
32$: clr r3 ; clear the space flag +SSH
cmpb (r1),#40 ; char after @ is a space ? +SSH
beq 33$ ; yes, continue with copy +SSH
movb #40 ,(r2)+ ; no, insert a space char +SSH
inc @sp ; increment count +SSH
33$: movb (r1)+ ,(r2)+ ; copy next char to buffer
inc @sp ; length := succ( length )
sob r0 ,30$ ; next byte please
mov (sp)+ ,r0 ; return the command length
mov @r5 ,r2 ; restore pointer to the returned string
calls cvt$$ ,<r2,r0,#50> ; remove leading spaces, upper case it
add r0 ,r2 ; insure .asciz
clrb @r2 ; simple
br 100$ ; bye
90$: clr r0 ; nothing
100$: unsave <r3,r2,r1> ; pop used registers and exit
return
.end