home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Columbia Kermit
/
kermit.zip
/
pdp11
/
k11sub.mac
< prev
next >
Wrap
Text File
|
2020-01-01
|
19KB
|
752 lines
.title k11sub common subroutines for all execs
.ident /8.0.01/
; Brian Nelson 01-Dec-83 13:19:14
;
; Copyright (C) 1983 Change Software, Inc.
;
;
; This software is furnished under a license and may
; be used and copied only in accordance with the
; terms of such license and with the inclusion of
; the above copyright notice. This software or any
; other copies thereof may not be provided or other-
; wise made available to any other person. No title
; to and ownership of the software is hereby trans-
; ferred.
;
; The information in this software is subject to
; change without notice and should not be construed
; as a commitment by the author.
; define macros and things we want for KERMIT-11
.if ndf, K11INC
.ift
.include /IN:K11MAC.MAC/
.endc
.iif ndf, k11inc, .error ; INCLUDE for IN:K11MAC.MAC failed
.psect $code
.enabl gbl
.sbttl cvt$$ basic+ cvt$$ function
.enabl lsb
; calls cvt$$ ,<addr(input),len(input),val(cvtbitpattern)>
;
; returns @ addr(input) trimmed string
; r0 length of whats left
;
; MASK TRIMS
; ---- -----
;
; 1 DISCARD ALL PARITY BITS
; 2 DISCARD ALL SPACES & TABS
; 4 DISCARD CR LF FF ESC RO
; 10 DISCARD LEADING SPACES & TABS
; 20 REDUCE SPACES & TABS TO A SINGLE SPACE
; 40 CONVERT LC TO UC
; 100 CONVERT [ TO ( AND ] TO )
; 200 DISCARD TRAILING SPACES & TABS
; 400 PRESERVE QUOTED SUBSTRINGS
; 1000 MODIFY 4 (IF ON) TO DISCARD ALL CHARACTERS < 40 OR =177
;
c.par = 1
c.spac = 2
c.crlf = 4
c.lspa = 10
c.sspa = 20
c.lcuc = 40
c.brac = 100
c.tspa = 200
c.quot = 400
c.prt = 1000
.asect
. = 0
pat: .blkw 1
inquo: .blkw 1
lastch: .blkw 1
saddr: .blkw 1
lsize = . + 2
.psect
.psect $code
.sbttl the real work of cvt$$
edit$::
cvt$$:: save <r1,r2,r3,r4,r5> ; the scratch registers to use.
sub #lsize ,sp ; allocate some work space
mov sp ,r4 ; point to a local work area
mov (r5)+ ,r2 ; the string address for output
mov r2 ,saddr(r4) ; and save it for a while
mov (r5)+ ,r1 ; get the string length also.
mov (r5)+ ,pat(r4) ; and finally the bit pattern.
clr inquo(r4) ; assume not in a quoted string.
clrb lastch(r4) ; no previous character please.
mov r2 ,r5 ; where to get the input string
tst r1 ; the length
beq 130$ ; nothing to do
10$: clr r3 ; avoind the movb sxt please.
bisb (r5)+ ,r3 ; get the next character .
tstb inquo(r4) ; currently in quoted string?
bne usech ; yes, skip all this junk.
bit #c.par ,pat(r4) ; Do we trim off the parity ?
beq 20$
bicb #200 ,r3 ; yes. clear bit number 7
20$: bit #c.spac!c.lspa,pat(r4) ; How about removing spaces &
bne 25$ ; tabs. if ne, yes
bit #c.sspa ,pat(r4) ; reduce imbedded ones to
beq 30$ ; a single tab/space ?
cmpb r3 ,#11 ; yes. if ch eq tab, then make
bne 21$ ; it into a space first please.
movb #40 ,r3 ; simple
21$: cmpb lastch(r4),#40 ; yes, was the last ch a space
beq 25$ ; or a tab ?
cmpb lastch(r4),#11 ; please check both out
bne 30$ ; no
25$: cmpb r3 ,#40 ; is the current character a
beq skipch ; space ?
cmpb r3 ,#9. ; not a space. try a horz tab
beq skipch ; char was a tab. Then ignore.
bic #c.lspa ,pat(r4) ; For leading spaces and tabs.
30$: bit #c.crlf ,pat(r4) ; try for ignoring form feed,
beq 50$ ; car ret,line feed,esc,null.
mov #junkch ,r0 ; Get the address of the spec
tstb r3 ; is the current ch a null ?
beq skipch ; yes, please skip it then.
40$: tstb @r0 ; anything left in the list ?
beq 50$ ; no
cmpb r3 ,(r0)+ ; see if we have a match. If
beq skipch ; so, we will skip the char.
br 40$ ; no, next check please
50$: bit #c.lcuc ,pat(r4) ; how about converting lower
beq 60$ ; case to upper case ?
cmpb r3 ,#'z!40 ; try against a lower case Z
bhi 60$
cmpb r3 ,#'a!40 ; if less than a lower z,try
blo 60$ ; for ge a lower case a
bicb #40 ,r3 ; char is in range. translate
60$: bit #c.brac ,pat(r4) ; how about convert [ to ( and
beq usech ; and convert ] to )
cmpb r3 ,#'[ ; and so on
bne 70$
movb #'( ,r3 ; convert it. fall thru to next
70$: cmpb r3 ,#']
bne usech
movb #') ,r3
br usech
skipch: br 120$ ; do not want the char, skip it.
.sbttl got a good ch, check for quoted string things
usech: bit #c.quot ,pat(r4) ; what about leaving quoted
beq 110$ ; strings alone ?
tstb inquo(r4) ; currently in a quoted string?
bne 90$ ; yes, check for the stopper.
cmpb r3 ,#'' ; a quote here ?
beq 80$ ; yes
cmpb r3 ,#'" ; alternate for a quote
bne 90$ ; no
80$: movb r3 ,inquo(r4) ; yes, save the terminator
br 110$ ; next please
90$: cmpb r3 ,inquo(r4) ; yes, is this the end of a
bne 110$ ; quoted string ?
clrb inquo(r4) ; yes, turn the flag off then.
110$: bit #c.prt ,pat(r4) ; should we skip nonprintable
beq 115$ ; characters now ?
cmpb r3 ,#40 ; yes, less than a space
blo 120$ ; yes
tstb r3 ; greater than 177 (rubout)
bmi 120$ ; yes
115$: movb r3 ,(r2)+ ; if all ok, return the char.
120$: movb r3 ,lastch(r4) ; please save the last ch
dec r1 ; and go back for some more.
bgt 10$ ; next please
130$: mov r2 ,r0 ; current pointer
sub saddr(r4),r0 ; return the length of what's
ble 160$ ; nothing left to do then.
bit #c.tspa ,pat(r4) ; remove trailing blanks ?
beq 160$ ; no
mov saddr(r4),r1 ; address of the string.
add r0 ,r1 ; point to end of string+1.
140$: cmpb -(r1) ,#40 ; Try for a space first.
beq 150$
cmpb (r1) ,#9. ; Not a space, try a tab.
bne 160$
150$: sob r0 ,140$ ; Tab or space. Check next
160$:
170$: add #lsize ,sp ; pop small work area
unsave <r5,r4,r3,r2,r1> ; pop all temps
return ; and exit
.save
.psect $Pdata,d
junkch: .byte 13.,10.,12.,27.,0,0
.restore
.dsabl lsb
.sbttl l$len get length of .asciz string
; L $ L E N
;
; input: r0 = address of .asciz string
; output: r0 = length of it
l$len:: mov r0 ,-(sp) ; save it for later.
10$: tstb (r0)+ ; look for a null character.
bne 10$ ; keep going
sub (sp)+ ,r0 ; subtract start address from
dec r0 ; current pointer less 1.
return
.sbttl write decimal
l$wrdec::
dfwidth = 6
;
; write a decimal number to KB: passed at 0(r5)
;
;
save <r1,r4,r5>
mov 2(r5) ,r1 ; field width
bgt 10$ ; good positive value.
beq 5$ ; zero, make it 6.
neg r1 ; negative means no space fill
br 10$ ; and skip this
5$: mov #dfwidth,r1 ; finally, we have the width.
10$: mov r1 ,r4 ; save for a moment
add #5 ,r1 ; make it round up to even num.
bic #1 ,r1 ; at last....
mov 2(r5) ,-(sp) ; The real field width please.
mov @r5 ,-(sp) ; And the number to print out.
mov sp ,r5 ; setup the parameter list addr
tst -(r5) ; make room for the buffer on
sub r1 ,sp ; the stack.
mov sp ,@r5 ; insert the buffer address
call l$cvtnum ; and convert the number.
.print @r5 ,r4 ; and print it out
add r1 ,sp ; and fix the stack up.
cmp (sp)+ ,(sp)+ ; rest of stack pop.
unsave <r5,r4,r1> ; thats all for now
return
; write out a decimal number at 2(r5) into the buffer
; address passed at 0(r5). All registers saved.
l$cvti::save <r5> ; call common conversion sub.
clr -(sp) ; setup paramter list first.
mov 2(r5) ,-(sp) ; calls $cvtnum,<@r5,2(r5),#0>
mov @r5 ,-(sp) ; finally the buffer address.
mov sp ,r5 ; the parameter list address.
call l$cvtnum ; convert it please.
add #6 ,sp ; pop stack parameter list.
unsave <r5> ; restore r5
return ; and exit please.
.sbttl the real conversion sub
; input: 0(r5) = buffer address
; 2(r5) = value to print
; 4(r5) = field width ( > 0 ->right, < 0 -> left )
;
; field width: if < zero, string will be left justified
; if > zero, string will be right justified
; if = zero, field will be set to 6.
;
l$cvtnum::
save <r0,r1,r2,r3,r4> ; some scratch registers saved
mov (r5) ,r2 ; the buffer address to use.
mov 4(r5) ,r3 ; the field width to use.
bgt 80$ ; nonzero, it is ok (?)
beq 70$ ; zero
neg r3 ; < 0
br 80$
70$: mov #dfwidth,r3 ; zero, use default width 6.
80$: mov r3 ,r1 ; put it here to clear buffer.
1$: movb #32. ,(r2)+ ; fill the buffer with blanks
sob r1 ,1$
mov r2 ,-(sp) ; save end of buffer here.
mov r3 ,r4 ; save buffer size also.
mov 2(r5) ,r1 ; Get the value to print out.
bpl 2$
neg r1
2$: clr r0 ; set up for the divide by 10.
div #10. ,r0 ; remainder in r1, quotient r0
add #'0 ,r1 ; convert remainder to character
cmp r2 ,@r5 ; overflowed the buffer at all?
beq 100$ ; yes, get out of here !
movb r1 ,-(r2) ; and return the character now.
mov r0 ,r1
beq 3$
sob r3 ,2$ ; go back for more
tst r1 ; something left over by chance?
bne 100$ ; Yes, that's a definite error.
3$: tst 2(r5) ; was this a negative number ?
bpl 90$ ; no, exit
cmp r2 ,@r5 ; yes, room left for a '-' sym.
beq 100$ ; no, flag an error please.
movb #'- ,-(r2) ; yes, insert a minus symbol.
;; br 90$ ; thats all.
90$: tst 4(r5) ; negative field width ?
bpl 4$ ; no, exit.
mov @r5 ,r1 ; start of the buffer here.
95$: movb (r2)+ ,(r1)+ ; move chars to front of buffer.
cmp r2 ,(sp) ; end of the buffer yet ?
bhis 97$ ; no, keep going please.
sob r4 ,95$ ; keep going please
97$: dec r4 ; anything left to zero out?
ble 4$ ; no
98$: movb #40 ,(r1)+ ; yes, zero to end of buffer.
sob r4 ,98$ ; more please
br 4$ ; finally exit this mess.
100$: movb #'* ,@r2 ; field overlfow. place '*' in
; beginning of the buffer.
4$: tst (sp)+ ; pop stack, restore temp regs
unsave <r4,r3,r2,r1,r0>
return ; thats all there is to it.
.sbttl mout print text from message macro
locmout::
tst remote
beq mout
mov (sp)+ ,@sp
return
mout:: save <r0>
mov 4(sp) ,r0
.print r0
unsave <r0>
mov (sp)+ ,@sp
return
.sbttl instr
; I N S T R simple (non-wildcard) version
; input:
;
; (r5) = address of the first string
; 2(r5) = length of the first string .
; 4(r5) = address of the second string, the one to find.
; 6(r5) = length of the second string.
;
; output:
;
; r0 = if > 0 then r0=position of second in first
; else the second is not a substring.
;
instr::
save <r1,r2,r3,r4> ; we use these here, so save.
mov (r5) ,r0 ; the address of first string
mov 4(r5) ,r1 ; the address of second one.
mov 6(r5) ,r2 ; the length of second one.
ble 6$ ; a null string ?
mov 2(r5) ,r4 ; the length of first.
ble 6$ ; a null string ?
sub r2 ,r4 ; convert to looping counter
clr r3 ; the real loop counter.
1$: cmp r3 ,r4 ; are we done yet ?
bgt 6$ ; yes, if r3 > r4 .
cmpb (r0)+ ,(r1) ; see if current character in
bne 5$ ; matches first one in second.
save <r0,r1,r2> ; found first character match.
inc r1 ; point to the next character
dec r2 ; length of pattern thats left
ble 3$ ; in case the len( pattern ) =1
2$: cmpb (r0)+ , (r1)+ ; check the rest of the pattern
bne 4$
sob r2 ,2$ ; loop for len( pattern ) - 1
3$: mov r3 ,r0 ; the current loop count
inc r0
add #6 ,sp ; fix the stack from save < >
br 7$
4$: unsave <r2,r1,r0> ; the match failed. restore the
5$: inc r3 ; pointers and go try the next
br 1$ ; character in the first string
6$: clr r0 ; complete failure if get here
7$: unsave <r4,r3,r2,r1> ; restore the registers we used
return ; and go away.
.sbttl convert rad50 word to 3 ascii bytes and back
;rdtoa
; (r5) = address of where to put ascii chars
; input 2(r5) = the value of rad 50 word
;
;
;
;procedure rd_toa( rval: integer ; var aout: array [1..3] of char ) ;
;
; type rlist = array [0..39] of char ;
; const
; r50ch = rlist(' ','A','B','C','D','E','F','G','H','I','J','K',
; 'L','M','N','O','P','Q','R','S','T','U','V','W',
; 'X','Y','Z','$','.','?','0','1','2','3','4','5',
; '6','7','8','9' );
; var i: integer ;
; begin
; aout[1] := r50ch[ rval div 3100B ]; rval := rval mod 3100B ;
; aout[2] := r50ch[ rval div 50B ] ; aout[3] := r50ch[ rval mod 50B ]
; end ;
rdtoa::
radasc: save <r0,r1,r3> ; same some registers
mov 2(r5) ,r1 ; go get the rad50 character.
mov (r5) ,r3 ; where to put the characters.
com: clr r0 ; prepare for divide
div #3100 ,r0 ; get first char
movb radchr(r0),(r3)+ ; put in buffer
clr r0 ; another divide
div #50 ,r0 ; this one gives char 2
movb radchr(r0),(r3)+ ; put this in buffer
movb radchr(r1),(r3)+ ; and also char 3
unsave <r3,r1,r0> ; restore the registers we used.
return ; bye
.save
.psect $Pdata,d
.nlist bex
radchr: .ascii / ABCDEFGHIJKLMNOPQRSTUVWXYZ$.?0123456789:/
.list bex
.even
.restore
.sbttl get decimal number value
; L $ V A L (20-Nov-80)
;
; (r5) = address of .asciz string to convert
;
; r0 = error (-1 for bad number)
; r1 == binary value of the string.
l$val:: save <r2,r3>
clr r1 ; initailize the result.
mov (r5) ,r3 ; the address of the string.
clr -(sp) ; a positive number for now.
clr r0
30$: tstb @r3 ; null. If so, exit please.
beq 5$ ; buy.
cmpb @r3 ,#space ; we will ignore spaces.
beq 50$ ; if equal, then skip.
tst r0 ; past the first space yet ?
bne 40$ ; yes, skip sign checks.
com r0 ; past all the leading spaces.
cmpb @r3 ,#'+ ; positive number ?
beq 50$ ; yes, skip over the character.
cmpb @r3 ,#'- ; negative ?
bne 40$ ; no, try for a digit then.
mov sp ,(sp) ; neg, set a useful flag up.
br 50$ ; and skip it.
40$: cmpb @r3 ,#'0 ; try comparing to '0' .
blo 70$ ; not a digit. time to go
cmpb @r3 ,#'9 ; try comparing to '9' .
bhi 70$ ; not a digit . get out.
clr -(sp) ; clr out the scratch reg.
bisb @r3 ,(sp) ; copy the character over.
sub #48. ,(sp) ; convert char to a digit.
mul #10. ,r1 ; multiply accum by 10 first
bcs 60$ ; oops
add (sp)+ ,r1 ; add on the digit to accum
bvs 70$ ; bye
50$: inc r3 ; pointer := succ( pointer );
br 30$
60$: tst (sp)+ ; came here from multiply overf
70$: clr r0 ; return 0 in case of error.
mov #-1 ,r0 ; ?Illegal number
tst (sp)+ ; pop sign flag from stack.
br 100$
5$: tst (sp)+ ; pop sign flag on tos.
beq 95$ ; positive number ?
tst r1 ; negative 0 (-32768) ?
bne 90$ ; no
bis #100000 ,r1 ; yes, set only the sign bit
br 95$ ; and go away.
90$: neg r1 ; no.
95$: clr r0
100$: unsave <r3,r2>
return ; and time to leave.
.sbttl octval return octal vaule in r1, error in r0
octval::save <r2,r3> ; save temps please
clr r0 ; assume no error
clr r1 ; value := 0
mov @r5 ,r2 ; get the buffer address
10$: movb (r2)+ ,r3 ; get the next character please
beq 100$ ; all done
cmpb r3 ,#'0 ; error if < '0' or > '7'
blo 90$ ; oops
cmpb r3 ,#'7 ; how about the upper limit
bhi 90$ ; oops
sub #'0 ,r3 ; get the value
asl r1 ; accumulated value times 8
asl r1 ; the long way
asl r1 ; r1 = r1 * 8
add r3 ,r1 ; add in the current digit
br 10$ ; next
90$: mov #-1 ,r0 ; illegal number
100$: unsave <r3,r2> ; pop registers and exit
return
.sbttl binary to octal conversion
.enabl lsb
;
; 17-Nov-80 BDN
;
; convert binary number at 2(r5) to ascii string
; at buffer address 0(r5).
;
l$otoa::save <r0,r1,r2,r3> ; save the scratch regs.
mov (r5) ,r2
mov 2(r5) ,r3
add #6 ,r2 ; do it backwards
mov #6 ,r0 ; do it 6 times
10$: mov r3 ,r1 ; get the number
bic #177770 ,r1 ; leave low order 3 bits on
movb 200$(r1),-(r2) ; move an octal digit
ash #-3 ,r3 ; shift three bytes
bic #160000 ,r3 ; zap propagated sign bits
sob r0 ,10$ ; go convert next digit
unsave <r3,r2,r1,r0>
return
.save
.psect $Pdata,D
200$: .ascii \01234567\ ; ascii/octal 200$
.even
.restore
.dsabl lsb
; (r5) = value to write to KB:
l$wroc::save <r0>
sub #10 ,sp
mov sp ,r0 ; use stack for a buffer
calls l$otoa ,<r0,(r5)>
print r0 ,#6.
add #10 ,sp
unsave <r0>
return
.sbttl copyz copyz .asciz string
; C O P Y Z $
;
; input: 6(sp) max len or zero
; 4(sp) source string address
; 2(sp) destination string address
;
; usage: copyz macro, as in copyz #oldfile,#newfile
copyz$::save <r0,r1> ; save registers we may use
tst 4+6(sp) ; see if a maxlen was passed
bne 5$ ; yes
mov #77777 ,4+6(sp) ; no, say we can have MAXINT chars
5$: mov 4+4(sp) ,r0 ; source string address
mov 4+2(sp) ,r1 ; destination string address
10$: movb (r0)+ ,(r1)+ ; copy a byte
beq 20$ ; until a null is found
dec 4+6(sp) ; or we have copied MAXLEN number
bne 10$ ; of characters over
20$: clrb -(r1) ; insure output .asciz please
unsave <r1,r0> ; pop temps
mov @sp ,6(sp) ; move return address up
add #6 ,sp ; fix the stack
return ; and exit
.sbttl formatted byte dump
; input: 4(sp) size
; 2(sp) address
dump$b::save <r0,r1,r2> ; save all please
mov <4+6>(sp),r1 ; size
beq 100$ ; nothing do to today
mov <2+6>(sp),r2 ; address to dump
10$: clr r0 ; get the next byte please
bisb (r2)+ ,r0 ; get it
decout r0 ; and print it
sob r1 ,10$ ; next please
100$: .newline ; a cr/lf
unsave <r2,r1,r0> ; pop all registers we used
mov @sp ,4(sp) ; move return address up
cmp (sp)+ ,(sp)+ ; pop two words for parameter list
return ; and exit
.sbttl strcat and strcpy
; input:
; 0(sp) return address
; 2(sp) dst address
; 4(sp) src address
; output: r0 dest address
strcpy::save <r1> ; save temp registers please
mov 2+2(sp) ,r0 ; destination address
mov 2+4(sp) ,r1 ; source .asciz address
10$: movb (r1)+ ,(r0)+ ; copy until a null
bne 10$ ; not done
mov 2+2(sp) ,r0 ; return the dst address
unsave <r1> ; pop r1 and exit
mov (sp) ,4(sp) ; move return address up now
cmp (sp)+ ,(sp)+ ; pop junk and exit
return
strcat::save <r1> ; save temp registers please
mov 2+2(sp) ,r0 ; destination address
mov 2+4(sp) ,r1 ; source .asciz address
5$: tstb (r0)+ ; look for the end of the dst string
bne 5$ ; not found yet
dec r0 ; found it, fix the pointer
10$: movb (r1)+ ,(r0)+ ; copy until a null
bne 10$ ; not done
mov 2+2(sp) ,r0 ; return the dst address
unsave <r1> ; pop r1 and exit
mov (sp) ,4(sp) ; move return address up now
cmp (sp)+ ,(sp)+ ; pop junk and exit
return
strcmp::mov 2(sp),r0 ;Pick up 'a'
mov 4(sp),r1 ;And 'b'
10$: cmpb (r0)+,(r1) ;Are they the same
bne 20$ ;No
tstb (r1)+ ;At the end of the string
bne 10$ ;No
clr r0 ;Equal return
br 100$
20$: blo 30$ ;Br if a<b
mov #1,r0 ;A>b return
br 100$
30$: mov #-1,r0 ;A<b return
100$: mov (sp) ,4(sp) ; move return address up now
cmp (sp)+ ,(sp)+ ; pop junk and exit
return
malloc::inc r0
bic #1 ,r0
mov r0 ,-(sp)
add @albuff ,(sp)
cmp (sp) ,#alsize
bhis 90$
mov albuff ,r0
add #2 ,r0
add @albuff ,r0
mov (sp)+ ,@albuff
return
90$: clr r0
tst (sp)+
return
global <albuff,alsize>
decryp::
encryp::mov (sp) ,4(sp)
cmp (sp)+ ,(sp)+
return
.end
