home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Columbia Kermit
/
kermit.zip
/
pdp11
/
k11rtu.mac
< prev
next >
Wrap
Text File
|
2020-01-01
|
13KB
|
496 lines
.title K11RTU copy,rename and delete for RT11, no wildcarding
.ident /2.20/
; Copyright (C) 1984 Change Software, Inc.
;
; 18-Jul-84 16:14:46 Brian Nelson
;
; If wildcarding is added, this MUST be moved from
; the overlay it's in into the root.
.mcall .csispc ,.delete,.dstat ,.fetch ,.rename
.if ndf, K11INC
.ift
.include /IN:K11MAC.MAC/
.endc
.enabl gbl
.psect $code
.save
.psect rendat ,rw,d,lcl,rel,con
defext: .word 0,0,0,0,0
renlst: .blkw 12
rtdsta: .blkw 5
.restore
topmem = 50
errbyt = 52
star = 132500
.sbttl the real work of rename
; input: @r5 first filename, .asciz
; 2(r5) second filename, .asciz
; 4(r5) if ge 0, print a log of files renamed
rename::save <r2,r3,r4> ; save these please
clr r4 ; no files renamed as of yet
mov #renlst ,r3 ; where to build the .rename list
mov @r5 ,r0 ; string address
call docsi ; do the first one
bcs 100$ ; oops
mov 2(r5) ,r0 ; now do the second filename
call docsi ; ok
bcs 100$ ; oops
mov #renlst ,r1 ; check for wildcarding
mov @r1 ,10(r1) ; first, force same device name
mov #4*2 ,r2 ; eight words to check for wildcards
10$: cmp (r1)+ ,#star ; a wildcard today ?
beq 80$ ; yes, die
sob r2 ,10$ ; no, check the next one please
mov renlst ,r0 ; get the device name
call devload ; get device loaded if need be
bcs 100$ ; it did not work
.rename #rtwork,#lun.in,#renlst ; do the rename please
bcs 90$ ; oops
call 200$ ; log it please
mov #1 ,r4 ; one file renamed
clr r0 ; no errors
br 100$ ; and exit
80$: mov #er$wld ,r0 ; no wildcarding today
br 100$ ; exit
90$: movb @#errbyt,r0 ; map the .rename error
asl r0 ; times 2 as always
mov renerr(r0),r0 ; simple
100$: mov r4 ,r1 ; return rename count
beq 120$ ; never got any files, exit
cmp r0 ,#er$nmf ; no more files error?
beq 110$ ; yes, say no errors
cmp r0 ,#er$fnf ; same goes for file not found
bne 120$ ; exit
110$: clr r0 ; no errors
120$: unsave <r4,r3,r2> ; pop these and exit
return
.sbttl log for the rt11 rename command
200$: tst 4(r5) ; print a log of this out
bmi 210$ ; nothing to do
print @r5 ; no wildcarding simplifies things
print #290$ ; more
print 2(r5) ; next
print #295$ ;
210$: return
290$: .asciz / renamed to /
295$: .byte cr,lf,0
.even
.sbttl the real work of delete
; input: @r5 first filename, .asciz
; 2(r5) second filename, .asciz
; 4(r5) if ge 0, print a log of files renamed
delete::save <r2,r3,r4> ; save these please
clr r4 ; no files renamed as of yet
mov #renlst ,r3 ; where to build the .rename list
mov @r5 ,r0 ; string address
call docsi ; do the first one
bcs 100$ ; oops
mov #renlst ,r1 ; check for wildcarding
mov #4 ,r2 ; four words to check for wildcards
10$: cmp (r1)+ ,#star ; a wildcard today ?
beq 80$ ; yes, die
sob r2 ,10$ ; no, check the next one please
mov renlst ,r0 ; get the device name
call devload ; get device loaded if need be
bcs 100$ ; it did not work
.delete #rtwork,#lun.in,#renlst ; do the delete please
bcs 90$ ; oops
call 200$ ; log it please
mov #1 ,r4 ; one file renamed
clr r0 ; no errors
br 100$ ; and exit
80$: mov #er$wld ,r0 ; no wildcarding today
br 100$ ; exit
90$: movb @#errbyt,r0 ; map the .rename error
asl r0 ; times 2 as always
mov renerr(r0),r0 ; simple
100$: mov r4 ,r1 ; return rename count
beq 120$ ; never got any files, exit
cmp r0 ,#er$nmf ; no more files error?
beq 110$ ; yes, say no errors
cmp r0 ,#er$fnf ; same goes for file not found
bne 120$ ; exit
110$: clr r0 ; no errors
120$: unsave <r4,r3,r2> ; pop these and exit
return
200$: tst 2(r5) ; print a log of this out
bmi 210$ ; nothing to do
print @r5 ; no wildcarding simplifies things
print #290$ ; more
210$: return
290$: .asciz / deleted/<cr><lf>
.even
.sbttl parse device and filename
; parse the filename(s)
;
; input: r0 address of filename
; r3 pointer to result of parse
docsi: save <r1,r2>
sub #40.*2 ,sp ; allocate a local filename buffer
mov sp ,r1 ; and a pointer to it please
mov r0 ,r2 ; check for a ':' in the string
scan #': ,r2 ; if there is no colon then insert
tst r0 ; the defdir please
bne 310$ ; we found a colon in the string
mov #defdir ,r0 ; no device was in the string so put
305$: movb (r0)+ ,(r1)+ ; in
bne 305$ ; next please
dec r1 ; backup to the null we just copied
310$: movb (r2)+ ,(r1)+ ; copy it to the csi buffer
bne 310$ ; until a null byte is found.
movb #'= ,-1(r1) ; fake an output filespec here
clrb @r1 ; and .asciz
mov sp ,r1 ; reset pointer (also saving sp)
.csispc r1,#defext,r1 ; and try to parse the name
mov r1 ,sp ; restore from any switches
bcs 320$ ; it's ok
mov (r1)+ ,(r3)+ ; copy the device and filename
mov (r1)+ ,(r3)+ ; copy the device and filename
mov (r1)+ ,(r3)+ ; copy the device and filename
mov (r1)+ ,(r3)+ ; copy the device and filename
add #40.*2 ,sp ; restore the stack
clc ; no errors
br 330$
320$: movb @#errbyt,r0 ; get the error mapping for .csispc
asl r0 ; index to word offsets
mov csierr(r0),r0 ; simple
add #40.*2 ,sp ; restore the stack
sec ; flag the error and exit
330$: unsave <r2,r1>
return
.sbttl get device driver loaded if need be
; DEVLOAD
;
; input: r0 device name
; output: r0 error code if carry is set
devload:calls fetch ,<r0>
tst r0 ; did it work ?
bne 90$ ; no
clc ; yes
return
90$: sec ; no
return ; exit
.sbttl copy command
copy:: save <r2,r3> ; save temp registers please
clr r2 ; number of blocks = 0
mov #1000 ,r3 ;
calls open ,<@r5,#lun.in,#binary> ; get the input file
tst r0 ; did it work?
bne 110$ ; no, simple exit then
calls create ,<2(r5),#lun.out,#binary> ; create the destination
tst r0 ; did it work ?
bne 100$ ; no, close the input file now
10$: calls getc ,<#lun.in> ; get the next ch from the file
tst r0 ; did it work ?
bne 20$ ; no, check for eof condition
calls putc ,<r1,#lun.ou> ; yes, copy to output file
tst r0 ; did that work ?
bne 20$ ; no
sob r3 ,10$ ; next ch please
inc r2 ; blocks := succ( blocks )
mov #1000 ,r3 ; copy the next block now
br 10$ ; back for more now please
20$: cmp r0 ,#er$eof ; normal exit should be eof
bne 30$ ; it's not
clr r0 ; clear error codes
30$: save <r0> ; save error code
calls close ,<#lun.in> ; close input file
calls close ,<#lun.ou> ; close output file
unsave <r0> ; restore error code and exit
br 120$ ; and exit
100$: calls close ,<#lun.in> ; close input if output create failed
110$: ;
120$: mov r2 ,r1 ; return number of blocks and exit
unsave <r3,r2>
return
.sbttl ascdat convert to ascii date for RT11
.mcall .date
; input: @r5 output buffer address
; 2(r5) value of date, zero implies current
;
; I certainly could use my ASH and DIV macros, but may as
; well do it this way for future possibilities.
ascdat::save <r0,r1,r2,r3> ; save these please
mov @r5 ,r1 ; the result address
cmp 2(r5) ,#-1 ; if -1, then return 00-XXX-00
bne 5$ ; no
copyz #310$ ,r1 ; yes, then exit
br 100$ ; bye
5$: mov 2(r5) ,r0 ; get the date desired please
bne 10$ ; it's ok
.date ; zero, assume todays date then
10$: bic #100000 ,r0 ; undefined
mov r0 ,r3 ; copy the date
asr r3 ; /2
asr r3 ; /2 again
asr r3 ; ditto
asr r3 ; sigh
asr r3 ; at last
bic #^C37 ,r3 ; the date, at last
call 200$ ; convert it
mov r0 ,r3 ; get the date once again please
swab r3 ; get the month to bits 2..7
asr r3 ; /2
asr r3 ; /2 again
bic #^C17 ,r3 ; get rid of the unwanted bits now
dec r3 ; convert to 0..11
asl r3 ; convert to word offset
asl r3 ; quad offset
add #300$ ,r3 ; the address of the text
movb #'- ,(r1)+ ; copy it over please
movb (r3)+ ,(r1)+ ; three characters please
movb (r3)+ ,(r1)+ ; three characters please
movb (r3)+ ,(r1)+ ; three characters please
movb #'- ,(r1)+ ; copy it over please
mov r0 ,r3 ; copy the date
bic #^C37 ,r3 ; the year, at last
add #110 ,r3 ; plus the bias please
call 200$ ; convert
clrb @r1 ; .asciz and exit
100$: unsave <r3,r2,r1,r0>
return
200$: clr r2 ; subtract 10 a few times
210$: inc r2 ; high digit number
sub #12 ,r3 ; until we get a negative number
tst r3 ; done yet ?
bge 210$ ; no
dec r2 ; yes
add #12 ,r3 ; correct it please
add #'0 ,r2 ; and copy the day number please
add #'0 ,r3 ; simple
movb r2 ,(r1)+ ; copy it
movb r3 ,(r1)+ ; copy it
return
300$: .ascii /Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec /
310$: .asciz /00-XXX-00/
.even
.sbttl get the ascii time
.mcall .gtim
; input: @r5 buffer address for .asciz string
asctim::save <r0,r1,r2,r3> ; save all registers that we use
cmp -(sp) ,-(sp) ; allocate two word buffer
mov sp ,r3 ; and point to the small buffer
.gtim #rtwork ,r3 ; and get the time, ticks past midnite
mov (r3)+ ,r1 ; get set to divide to get seconds
mov (r3)+ ,r2 ; setup for $ddiv
mov #60.*60.,r0 ; at last
call ddiv ; double precision divide
mov r0 ,-(sp) ; save ticks since last minute
mov #60. ,r0 ; and get hours in r2, minutes in r0
call ddiv ; simple to do
mov @r5 ,r1 ; buffer address please
mov r2 ,r3 ; convert hours to ascii
call 200$ ; simple
movb #': ,(r1)+ ; a delimiter
mov r0 ,r3 ; the minutes next please
call 200$ ; simple
movb #': ,(r1)+ ; and a delimiter please
mov (sp)+ ,r2 ; now get the seconds extracted please
mov r1 ,-(sp) ; save buffer pointer please
clr r1 ; may as well use $ddiv
mov #60. ,r0 ; simple
call ddiv ; simple to do
mov (sp)+ ,r1 ; restore buffer pointer
mov r2 ,r3 ; and convert to ascii
call 200$ ; do it
clrb @r1 ; all done, make it .asciz and exit
cmp (sp)+ ,(sp)+ ; pop the two word buffer
unsave <r3,r2,r1,r0> ; pop registers we used and exit
return
200$: clr r2 ; subtract 10 a few times
210$: inc r2 ; high digit number
sub #12 ,r3 ; until we get a negative number
tst r3 ; done yet ?
bge 210$ ; no
dec r2 ; yes
add #12 ,r3 ; correct it please
add #'0 ,r2 ; and copy the day number please
add #'0 ,r3 ; simple
movb r2 ,(r1)+ ; copy it
movb r3 ,(r1)+ ; copy it
return
.sbttl double precision divide
; Double precision divide (from RSX syslib)
;
; input: r2 = low order of dividend
; r1 = high order of dividend
; r0 = divisor
;
; output: r2 = low order of quotient
; r1 = high order of quotient
; r0 = remainder
ddiv: mov r3,-(sp) ; save r3
mov #40,r3 ; set iteration count in r3
mov r0,-(sp) ; put divisor on the stack
clr r0 ; set the remainder to zero
10$: asl r2 ; shift the entire divedend
rol r1 ; ...
rol r0 ; ... to left and into remainder
cmp r0,(sp) ; is remainder greater than divisor
blo 20$ ; no, skip to iteration control
sub (sp),r0 ; yes, subtract divisor out please
inc r2 ; increment the quotient
20$: dec r3 ; repeat please
bgt 10$ ; not done
tst (sp)+ ; pop divisor
mov (sp)+,r3 ; restore r3 and exit
return ; bye
.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 132 characters to return
; the record to.
;
; We really don't need GETREC for RT11 Kermit. It was used
; in the RMS11 version (for RSXM/M+ and RSTS) only in con-
; junction with GETC to fake RMS single character i/o. The
; only two places it is called from is for the TYPE and
; HELP commands (C$TYPE and C$HELP).
; GETREC assumes text (stream ascii) file only.
.iif ndf, FF , FF = 14
.iif ndf, CR , CR = 15
.iif ndf, LF , LF = 12
getrec::save <r2,r3,r4> ; save registers we may need
clr r4 ; recordsize := 0
mov @r5 ,r3 ; the recordbuffer address
mov #132. ,r2 ; max size of a record to read
clr r1 ; nothing read as of yet
10$: cmpb r1 ,#ff ; exit if ch = form_feed
beq 30$ ;
mov 2(r5) ,r0 ; the channel number to use
call getcr0 ; read the next character now
tst r0 ; did it work ?
bne 100$ ; no
cmpb r1 ,#cr ; exit if ch = carriage_return
beq 30$ ;
cmpb r1 ,#'z&37 ; exit if ch = control_z
beq 30$ ;
cmpb r1 ,#lf ; ignore line feeds
beq 10$ ;
inc r4 ; length := succ(length)
movb r1 ,(r3)+ ; yes, stuff the character in
sob r2 ,10$ ; up until maxrec size
mov #er$rtb ,r0 ; too much data, return maxsize
br 100$ ; error
30$: cmpb r1 ,#'z&37 ; we get here on reading a record
bne 40$ ; terminator
mov #er$eof ,r0 ; control z means end of file
clr r1 ; no data is there at all
br 100$
40$: mov r4 ,r1 ; return the record length
br 100$ ; all done if ff or lf
100$: unsave <r4,r3,r2> ; pop registers we saved
return ; bye
.end
