home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Columbia Kermit
/
kermit.zip
/
archives
/
kermit11.tar.gz
/
kermit11.tar
/
k11cvt.mac
< prev
next >
Wrap
Text File
|
1989-06-13
|
15KB
|
535 lines
.title k11cvt misc data/filename conversions for Kermit-11
.ident /1.0.01/
; 20-Mar-84 11:31:06 Brian Nelson
;
; Copyright (C) 1984 Change Software, Inc.
;
;
; Attempt to parse filespecifications that may include DECNET
; remote node name and directories in a manner compatible
; with RSTS, RSX and RT11.
;
; This was first implemented using the host executives file
; name parsing services, ie for RSTS using the .FSS directive
; and for RSX using CSI and .PARSE to get the
; filespecification converted into rad50 and then converting
; back to ascii. The problem with doing it that way, apart
; from being a hack, is that we could not process DECNET node
; file specifications as the format of remote file names can
; never be expected to be compatible with the host system.
; Bob Denny wrote a new one for RSX which avoided this
; problem, and this version should work on all PDP11
; operating systems.
;
; This is implemented using a transition state table driver
; thus allowing simple modification to accomodate the various
; types of node filenames that may come up in the future.
;
;
; For the time being, this routine will be placed in the over-
; lay region ERRDVR, since as of now it is only called from
; K11PAK and then only once for each file send to the remote
; system or micro.
.if ndf, K11INC
.ift
.include /IN:K11MAC.MAC/
.endc
.iif ndf, k11inc, .error ; missing INCLUDE for IN:K11MAC.MAC
.sbttl generate character class table for filename state parsing
.psect
.macro chtype ch ,val
.save
.if ndf ,chtype
.ift
.psect chtype ,ro,d,lcl,rel,ovr
chtype: .rept 128.
.byte 0
.endr
.endc
.psect chtype
. = chtype + ch
.byte val
.restore
.endm chtype
chtype 0 ,1 ; exit on null
chtype 15 ,1 ; exit on <cr>
chtype 73 ,1 ; exit on ';'
chtype '[ ,2 ; start of a directory or uic
chtype '( ,2 ; start of a rsts style ppn
chtype '< ,2 ; start of a TOPS-20 directory
chtype '] ,3 ; end of a directory
chtype ') ,3 ; end of a ppn
chtype '> ,3 ; end of a tops-20 directory
chtype ': ,4 ; end of a device or node
chtype '. ,5 ; part of a filename or directory
chtype 54 ,6 ; part of a uic or ppn (',')
chtype 40 ,7 ; spaces can be anywhere
chtype '# ,0 ; ignore rsts equivalent for [1,0]
chtype '$ ,0 ; ignore rsts/rsx equivalent for system
chtype '! ,0 ; ignore rsts equivalent for [1,3]
chtype '% ,0 ; ignore rsts equivalent for [1,4]
chtype '& ,0 ; ignore rsts equivalent for [1,5]
chtype '@ ,0 ; ignore rsts equivalent for assign ppn
chtype '0 ,7 ; digits are ok most anywhere
chtype '1 ,7
chtype '2 ,7
chtype '3 ,7
chtype '4 ,7
chtype '5 ,7
chtype '6 ,7
chtype '7 ,7
chtype '8 ,7
chtype '9 ,7
$ch = 'A&137 ; letters also please
.rept 32
chtype $ch ,7
$ch = $ch + 1
.endr
$ch = 'a!40
.rept 32
chtype $ch ,7
$ch = $ch + 1
.endr
.sbttl state transition table
.psect $pdata
ptable:
; note: '<' , '(' are mapped the same as '['
; '>' , ')' are mapped the same as ']'
; all characters that map to zero are ignored by the parser
;
; char other ,null ,'[ ,'] ,': ,'. ,', ,Let/Dig
.byte 1 ,30. ,2 ,-1 ,11. ,21. ,-1 ,21. ; init
.byte 2 ,30. ,-1 ,3 ,-1 ,2 ,2 ,2 ; [ ]
.byte 3 ,30. ,-1 ,-1 ,14. ,23. ,3 ,23. ; [ ]xxx
.byte 4 ,30. ,30. ,-1 ,-1 ,24. ,-1 ,24. ; xx.xx
.even
paction:.word null ,init ,copy ,fin
.psect $code
.sbttl namcvt parse filename to get only filename.type
; input: @r5 address of source filespecification
; 2(r5) resultant string address
; output: r0 error code, if any
;
;
; internal register usage
;
; r0 = action index
; r1 = current state
; r2 = input string pointer
; r4 --> resultant string
namcvt::save <r1,r2,r3,r4> ; save these in case we use them
mov @r5 ,r2 ; point to the input string
mov 2(r5) ,r4 ; point to the output string
clrb @r4 ; init output to be .asciz
mov #1 ,r1 ; initialize current state
tst rawfil ; /54/ Really string stuff?
beq 10$ ; /54/ Yes
STRCPY r4 ,r2 ; /54/ No, copy as is.
clr r0 ; /54/ No errors
br 100$ ; /54/ And exit
10$: tst r1 ; current state is zero ?
beq 80$ ; yes, exit then
clr r3 ; get the next ch please
bisb (r2)+ ,r3 ; simple
bic #^C177 ,r3 ; insure in range 0..127
dec r1 ; use previous state to get the
mul #10 ,r1 ; index into the state table
movb chtype(r3),r0
add r0 ,r1 ; add in the character class
movb ptable(r1),r1 ; and get the new state of system
beq 80$ ; all done if new state is zero
bmi 90$ ; error exit if < 0
clr r0 ; now mask off the action index from
div #10. ,r0 ; the new state
asl r0 ; action index times 2 for addressing
jsr pc ,@paction(r0) ; simple
br 10$ ; next please
80$: clr r0 ; no errors
clrb @r4 ; .asciz for output
br 100$ ; bye
90$: mov #-1 ,r0 ; error, bye
100$: unsave <r4,r3,r2,r1> ; pop registers and exit
return
.sbttl action routines for the filename parser
null: return
init: mov 2(r5) ,r4 ; re-init the output string address
return
copy: movb r3 ,(r4)+ ; copy a byte
clrb @r4 ; terminate the string
return ; next please
fin: save <r0,r3> ; all done, look for a '.'
mov 2(r5) ,r0 ; if there isn't any, add one at
10$: tstb @r0 ; end of the line yet ?
beq 20$ ; yes
cmpb @r0 ,#'. ; a dot hanging around today?
beq 30$ ; yes, exit
inc r0 ; no, try again please
br 10$
20$: movb #'. ,r3 ; no dot, stuff one in please
call copy ; simple
30$: unsave <r3,r0> ; pop temps and exit
return
.sbttl check_extension check filetype to presume binary file
; C H K E X T
;
; input: @r5 filename
; output: r0 = 0 assume not a binary file
; r0 <> 0 assume it's a binary file
;
; side effects: call to NAMCVT to get Kermit 'normal' filename
.enabl lsb
chkext::save <r1,r2,r3,r4> ; save scratch registers we will use
sub #100 ,sp ; allocate a temp buffer for the
mov sp ,r1 ; parsed filename and point to it.
calls namcvt ,<@r5,r1> ; convert host name to normal name.
strlen r1 ; how much is left ?
tst r0 ; if nothing, then presume not binary
beq 290$ ; nothing to do, exit
add r0 ,r1 ; point to the end of the filename
210$: cmpb -(r1) ,#'. ; look for a dot which will delimit the
beq 220$ ; filetype
sob r0 ,210$ ; not found, try again please
br 290$ ; never found a '.' (can't happen)
220$: strlen r1 ; how many chars are in the filetype?
cmp r0 ,#4 ; must be exactly four to match?
bne 290$ ; no, exit without binary mode
mov bintyp ,r2 ; ok, get listhead of filetypes
230$: mov r2 ,r3 ; get next filetype address
tstb @r3 ; end of the list ?
beq 290$ ; if null, then all done
mov r1 ,r4 ; not done, get pointer to passed type
call 310$ ; convert to upper case please
cmpb r0 ,(r3)+ ; look for match on filetype
bne 240$ ; not today
call 310$ ; convert to upper case please
cmpb r0 ,(r3)+ ; again please
bne 240$ ; not bloody likely
call 310$ ; convert to upper case please
cmpb r0 ,(r3)+ ; and so on
bne 240$ ; you know
call 310$ ; convert to upper case please
cmpb r0 ,(r3)+ ; one more time
beq 280$ ; a match, return (BINARY)
240$: add #4 ,r2 ; get the next one please
br 230$ ; no match, try the next one
280$: mov #1 ,r0 ; return (BINARY)
br 300$ ; and exit
290$: clr r0 ; not binary
300$: add #100 ,sp ; pop local buffer and exit
unsave <r4,r3,r2,r1> ; pop registers that we used
return ; and exit
310$: movb (r4)+ ,r0 ; get the next character and convert to
cmpb r0 ,#'A!40 ; upper case
blo 320$ ; no
cmpb r0 ,#'Z!40 ; well......?
bhi 320$ ; not lower case
bicb #40 ,r0 ; lower, convert to upper
320$: return
.dsabl lsb
.sbttl filetypes that are likely to be binary
binini::strcpy bintyp ,#binl
return
global <bintyp>
; list of filetypes that will almost always be binary for all exec's
.save
.psect $pdata
.dsabl lc
binl: .ascii /.TSK/ ; rsx/ias/rsts tasks
420$: .ascii /.SAV/ ; rt11/rsts save images
430$: .ascii /.OBJ/ ; compiler/mac output
440$: .ascii /.STB/ ; tkb/link symbol tables
450$: .ascii /.CRF/ ; tkb/link cross reference files
460$: .ascii /.TSD/ ; 'time shared dibol' for rt11
470$: .ascii /.BAC/ ; rsts basic+ 'compiled' files
480$: .ascii /.OLB/ ; rsx/ias/rsts object libraries
490$: .ascii /.MLB/ ; rsx/ias/rsts macro libraries
500$: .ascii /.RTS/ ; rsts/e run time systems
510$: .ascii /.EXE/ ; vms executable
530$: .ascii /.BIN/ ; xxdp+ and perhaps micros and others?
540$: .ascii /.SML/ ; system macro libs
550$: .ascii /.ULB/ ; rsts/rsx universal libs
560$: .ascii /.HLB/ ; help libs ala VMS style ?
570$: .ascii /.SYS/ ; RT11 drivers
580$: .ascii /.LIB/ ; RSTS/E reslibs
600$: .byte 0,0,0,0 ; end of it all
.even
.restore
.sbttl fixfilename convert bad filename chars to something else
; FIXFILE (srcstring,dststring)
;
; Convert invalid characters to something reasonable, like 'X'
;
; Input: 0(r5) source string, .asciz
; 2(r5) destination string, .asciz at end
; Output: R0 zero if nothing, else nonzero (for warnings)
;
; The main reason for this is to protect ourselves against the
; filenaming conventions used for TOPS20 and VMS V4 so we can
; not die on a bad filename.
.save
.psect $pdata
defchr::.byte 'X&137
.restore
fixfil::save <r1,r2,r3> ; save whatever we may use
mov @r5 ,r1 ; src string
mov 2(r5) ,r2 ; dst string
clr r3 ; assume no mods made to filename
10$: tstb @r1 ; end of the src filename ?
beq 35$ ; yes, exit
scan @r1 ,#okchr ; check for invalid characters
tst r0 ; did we find one yet
bne 20$ ; no (we checked for legit chars)
mov sp ,r3 ; flag that we found a bad character
movb defchr ,@r2 ; and insert the fixup character
br 30$ ; exit
20$: movb @r1 ,@r2 ; character is ok, stuff it in
30$: inc r1 ; advance to next src char
inc r2 ; advance to next dst char
br 10$ ; next char in filename please
; Following for RT11 added /51/
35$: call getsys ; Check if RT11
cmpb r0 ,#SY$RT ; If RT11, then truncate names
bne 100$ ; Not RT, just take simple exit
;
sub #FILSIZ ,sp ; RT11, allocate a buffer
mov sp ,r1 ; And get a temporary copy
mov 2(r5) ,r2 ; The destination string
STRCPY r1 ,r2 ; Copy the formatted string
mov #6 ,r0 ; Setup to truncate FILENAME
;
40$: cmpb (r1) ,#'. ; End of FILENAME field?
beq 70$ ; Yes, skip to FILETYPE Copy.
movb (r1)+ ,(r2)+ ; Copy the character
beq 90$ ; And exit on a NULL
50$: sob r0 ,40$ ; Next please
;
60$: tstb (r1) ; Loop for looking for NULL or '.'
beq 90$ ; Null, end of string then.
cmpb (r1) ,#'. ; We may have truncated the name
beq 70$ ; So look for a DOT for FILETYPE
mov sp ,r3 ; And flag that we altered name
inc r1 ; Next please
br 60$ ; Go to it
;
70$: mov #4 ,r0 ; At most 4 characters in FILETYPE
80$: movb (r1)+ ,(r2)+ ; Finish off with the filetype
sob r0 ,80$ ; Next please
;
90$: clrb (r2)+ ; Insure .asciz
add #FILSIZ ,sp ; Pop local buffer
; End of RT11 filename truncation.
;
100$: mov r3 ,r0 ; return status
clrb @r2 ; insure .asciz return
unsave <r3,r2,r1> ; pop registers and exit
return
.save
.psect $pdata
.even
.enabl lc
okchr: .ascii /0123456789./
.ascii /abcdefghijklmnopqrstuvwxyz/
.ascii /ABCDEFGHIJKLMNOPQRSTUVWXYZ/
.byte 0
.even
.restore
.sbttl PRSARG
; Convert strings of form abcde<15> or abcde\015
; to binary format.
prsarg::save <r1,r2,r3,r4> ; /45/ Save regs
mov argbuf ,r3 ; /41/ Argbuf address
mov r0 ,r4 ; /41/ Where to return parsed string
10$: movb (r3)+ ,r2 ; /41/ While ( *argbuf )
beq 100$ ; /41/ Exit with success
cmpb r2 ,#'\ ; /45/ "C" style notation?
beq 50$ ; /45/ Yes
cmpb r2 ,#'< ; /41/ Start of an octal sequence?
bne 40$ ; /41/ No.
clr r1 ; /41/ Init accumulator
20$: movb (r3)+ ,r2 ; /41/ While ( *argbuf++ )
beq 90$ ; /41/ Error, No terminator
cmpb r2 ,#'> ; /41/ Octal number terminator?
beq 30$ ; /41/ Yes, exit loop
cmpb r2 ,#'0 ; /41/ Check for legitimate value
blo 90$ ; /41/ Not an octal digit, error
cmpb r2 ,#'7 ; /41/ Check again please
bhi 90$ ; /41/ Not legit, error
sub #'0 ,r2 ; /41/ Yes, convert to octal until '>'
asl r1 ; /41/ Shift over a bit
asl r1 ; /41/ ..shift
asl r1 ; /41/ ....shift, total of 3 bits
add r2 ,r1 ; /41/ Add in current digit
br 20$ ; /41/ No
30$: mov r1 ,r2 ; /41/ Yes, get set to insert value
40$: movb r2 ,(r4)+ ; /41/ Place current char or value in
br 10$ ; /41/ Next please
50$: clr r1 ; /45/ "C" style notation
clr -(sp) ; /45/ Trip counter
60$: movb (r3) ,r2 ; /45/ Copy a character
beq 70$ ; /45/ EOS, exit next time
cmpb r2 ,#'0 ; /45/ Octal characters?
blo 70$ ; /45/ No, exit this loop
cmpb r2 ,#'7 ; /45/ ...
bhi 70$ ; /45/ Copy the character
inc (sp) ; /45/ Been here at least once
sub #'0 ,r2 ; /45/ Yes, convert to octal
asl r1 ; /45/ Shift over a bit
asl r1 ; /45/ ..shift
asl r1 ; /45/ ....shift, total of 3 bits
add r2 ,r1 ; /45/ Add in current digit
inc r3 ; /45/ Next please
br 60$ ; /45/ Do it
70$: tst (sp)+ ; /45/ Did we really get a number?
beq 75$ ; /45/ No, ignore then
movb r1 ,(r4)+ ; /45/ Done, copy the data
br 80$ ; /45/ And get next please
75$: tstb r2 ; /45/ No number, perhaps "\\" or
beq 80$ ; /45/ or "\<" was present?
movb r2 ,(r4)+ ; /45/ Must have had "\x"
inc r3 ; /45/ Point to NEXT please
80$: br 10$ ; /45/ Next please
90$: mov #-1 ,r0 ; /41/ Failed
br 110$ ; /41/ exit
100$: clr r0 ; /41/ Success
110$: clrb @r4 ; /41/ Insure LOGSTR is .asciz
unsave <r4,r3,r2,r1> ; /45/ Pop
return
.sbttl Unfmts Inverse of PRSARG
.Save
.psect UDATA,RW,D,LCL,REL,CON
ubuf: .blkb 80.
.Restore
Unfmts::Save <r1,r2,r3,r4,r5> ; Save registers please
mov r0 ,r5 ; Copy the address of the data
mov #ubuf ,r4 ; Target buffer
10$: movb (r5)+ ,r1 ; Get the data
beq 100$ ; All done
cmpb r1 ,#40 ; Control character?
blo 20$ ; Yes
movb r1 ,(r4)+ ; No, just copy as is
br 40$ ; And do the next one
20$: movb #'\ ,(r4)+ ; Control character, insert '\'
clr r0 ; Get setup for conversion
div #10 ,r0 ; Got it
movb r1 ,r2 ; Save the LSB
mov r0 ,r1 ; And get the last two out
clr r0 ; ....
div #10 ,r0 ; Do it
add #'0 ,r0 ; Convert to ascii
add #'0 ,r1 ; ..Ditto
add #'0 ,r2 ; ....Ditto
movb r0 ,(r4)+ ; Insert the data
movb r1 ,(r4)+ ; Insert the data
movb r2 ,(r4)+ ; Insert the data
40$: br 10$ ; Next please
100$: clrb @r4 ; Insure .ASCIZ
mov #ubuf ,r0 ; Return a buffer address
Unsave <r5,r4,r3,r2,r1> ; Pop registers and exit
return ; Bye
.end