.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