.TITLE	UTILITY
	.IDENT	"V1.2"
;
;   Author:	D. Mischler	10-JUN-87
;
;   This module contains utility routines for string
;   operations, etc.
;
	.MCALL	EXTK$S

	.ASECT
;
;   Keyword dispatch table entry format.
;
	.=0
K.NAME:	.BLKW	1	; Address of keyword text.
K.DISP:	.BLKW	1	; Dispatch address.
	.PAGE
	.PSECT	CODE,I,RO
;
;   Subroutine to buffer an address as preface to a line of data.
;   On entry:	R5 contains address to be displayed.
;   On exit:	R0 points after buffered address.
;
U$ADDR::
	JSR	R5,.SAVR1	; Save R1 - R5.
	MOV	R0,R4		; Copy incoming output pointer.
	MOV	R5,R1		; Copy address.
	CALL	C$VALU		; Buffer address.
	MOVB	#':,(R0)+	; Buffer delimiter.
	MOV	NCFLGS,R1	; Get numeric conversion flags.
	ASH	#-11.,R1	; Position field width.
	BIC	#^C<37>,R1	; Mask to field width.
	ADD	#3,R1		; Adjust spacing.
	CMP	#C$SYMB,CNMODE	; Is symbolic mode enabled?
	BNE	10$		; No, current spacing will suffice.
	ADD	#7,R1		; Adjust for symbol name and plus sign.
10$:	ADD	R4,R1		; Add incoming buffer address.
	SUB	R0,R1		; Calculate number of blanks to buffer.
20$:	MOVB	#' ,(R0)+	; Buffer all required blanks.
	SOB	R1,20$
	RETURN
	.PAGE
;
;   Subroutine to "fix" a null-terminated string. Whitespace is
;   compressed and unquoted alphabetics are forced to upper case.
;   On entry:	R0 points to string.
;   On exit:	R1 points to end of string.
;
U$CLFX::
	JSR	R5,$SAVRG	; Save registers R3 - R5.
	MOV	R0,R1		; Copy buffer address
	MOV	R0,R4		;  a couple of times.
	MOV	SP,R5		; Set whitespace flag.
10$:	MOVB	(R1)+,R3	; Get a character, terminator?
	BEQ	100$		; Yup, check results.
	CMPB	#HT,R3		; Is it a horizontal tab?
	BEQ	15$		; Yes, treat as whitespace.
	CMPB	#' ,R3		; Is it a blank?
	BNE	20$		; No, check for lower case.
;   Process whitespace.
15$:	TST	R5		; Was last character whitespace?
	BNE	10$		; Yes, ignore consecutive whitespace.
	DEC	R5		; Set whitespace flag.
	MOVB	#' ,(R0)+	; Buffer a blank.
	BR	10$		; Get next character.
;   Convert lower case alphabetics to upper case.
20$:	CMPB	R3,#'a		; Is the character too low for lowercase?
	BLO	30$		; Yes, just pass it through.
	CMPB	R3,#'z		; Is it too high for lowercase?
	BHI	30$		; Yes, just pass it through.
	BIC	#'a-'A,R3	; Convert to upper case.
30$:	MOVB	R3,(R0)+	; Buffer character.
	CLR	R5		; Character is not whitespace.
	CMPB	#'",R3		; Is character a double quote?
	BEQ	40$		; Yes, don't compress or change case.
	CMPB	#'',R3		; Is character a single quote?
	BNE	10$		; No, get next character.
	INC	R5		; Set character counter.
	BR	50$		; Process quoted character.
;   Handle two quoted characters.
40$:	MOV	#2,R5		; Set up character counter.
50$:	MOVB	(R1)+,(R0)+	; Buffer a character, terminator?
	BEQ	110$		; Yes, just end it.
	SOB	R5,50$		; Stay down for the count.
	BR	10$		; Get next character.
;   Hit end of buffer.
100$:	CALL	U$RMTB		; Get rid of trailing blanks.
	CLRB	(R0)		; Terminate buffer.
110$:	MOV	R0,R1		; Copy end pointer.
	MOV	R4,R0		; Restore original input pointer.
	RETURN
	.PAGE
;
;   Subroutine to look up a command component in a keyword table.
;   The command component terminator will be found by U$FTRM.
;   If any error is detected then the carry will be set on exit and
;   R1 will point to a null-terminated error message.
;
;   On entry:	R0 points to command line component.
;		R1 points to keyword dispatch table.
;
;   On exit:	R1 is destroyed.
;		R2 points to keyword dispatch routine.
;
U$DCOD::
	JSR	R5,$SAVRG	; Save supposedly non-volatile registers.
	MOV	R0,R5		; Save command line component address.
	CALL	U$FTRM		; Find command element terminator.
	MOV	R0,R4		; Save terminator address for later.
	CLR	R2		; Indicate no keyword match yet.
10$:	MOV	(R1)+,R3	; Get keyword entry string address, zero?
	BEQ	60$		; Yes, end of table.
	MOV	R5,R0		; Get command element address.
20$:	CMP	R0,R4		; End of command element string?
	BEQ	40$		; Yes, table entry matches.
	TSTB	(R3)		; Keyword string terminator?
	BEQ	30$		; Yes, table entry does not match.
	CMPB	(R0)+,(R3)+	; Does this character match?
	BEQ	20$		; Yes, keep checking.
;   Keyword table entry doesn't match.
30$:	TST	(R1)+		; Skip over dispatch address.
	BR	10$		; Keep looking.
;   Matching table entry found.
40$:	TST	R2		; Is command element ambiguous?
	BNE	50$		; Yes, complain.
	MOV	(R1)+,R2	; Pick up keyword dispatch address.
	BR	10$		; Make sure keyword is not ambiguous.
;   Command element is ambiguous.
50$:	MOV	#E.AMBG,R1	; Point to ambiguous command element message.
	BR	65$		; Take error exit.
;   End of table reached.
60$:	TST	R2		; Was a matching keyword found?
	BNE	70$		; Yes, return with a clear carry.
	MOV	#E.KWNF,R1	; Point to keyword not found message.
65$:	SEC			; Indicate failure.
70$:	MOV	R5,R0		; Restore command element pointer.
	RETURN
	.PAGE
;
;   Subroutine to find the start of the next command element.
;   On entry:	R0 points to current command element.
;   On exit:	R0 points to next command element.
;		The carry will be set if there are no more command elements.
;
U$FNXT::
	CALL	U$FTRM		; Find terminator of current element.
	TSTB	(R0)+		; End of command line?
	BNE	10$		; No, return with carry clear.
	DEC	R0		; Point to command line terminator.
	SEC			; Indicate failure.
10$:	RETURN

;
;   Subroutine to find the terminator for a command element.
;   On entry:	R0 points to command element.
;   On exit:	R0 points to terminator.
;
U$FTRM::
	CMPB	#' ,(R0)	; Is character a blank?
	BEQ	10$		; Yes, it's a terminator.
	CMPB	#'/,(R0)	; Is character a slash?
	BEQ	10$		; Yes, it's sort of a terminator.
	TSTB	(R0)+		; Null byte?
	BNE	U$FTRM		; No, keep looking.
	DEC	R0		; Fix up pointer.
10$:	RETURN

;
;   Subroutine to remove trailing blanks from a string.
;   The string must contain at least one non-blank character.
;   On entry:	R0 points after string.
;
U$RMTB::
	CMPB	#' ,-(R0)	; Is last character a blank?
	BEQ	U$RMTB		; Yes, do that trick again.
	INC	R0		; Fix string pointer.
	RETURN
	.PAGE
;
;   Subroutine to pack a symbol name into R2, R3.
;   On entry:	R0 points to symbol name.
;   On exit:	R0 points past symbol name, R2 & R3 contain name.
;		The carry will be set if no symbol is found.
;
U$SYMN::
	MOV	#6,R2		; Get maximum allowed symbol length.
	SUB	R2,SP		; Allocate a symbol name area.
	MOV	SP,R1		; Point to symbol name area.
10$:	MOVB	(R0)+,R3	; Get a character, high bit set?
	BMI	30$		; Yes, it's obviously illegal.
	TSTB	SYMCHR(R3)	; Is character a legal symbol constituent?
	BPL	30$		; No, found symbol terminator.
	MOVB	R3,(R1)+	; Buffer character.
	SOB	R2,10$		; Continue up to maximum length.
;   Symbol is longer than maximum length. Ignore the excess.
20$:	MOVB	(R0)+,R3	; Get a character, high bit set?
	BMI	30$		; Yes, it's obviously illegal.
	TSTB	SYMCHR(R3)	; Is character a legal symbol constituent?
	BMI	20$		; Yes, keep scanning.
;   Symbol terminator has been located.
30$:	DEC	R0		; Point back at terminator.
	CMP	R1,SP		; Any legal characters buffered?
	BEQ	100$		; No, complain.
	TST	R2		; Any blanks needed?
	BEQ	50$		; No, just encode symbol name.
40$:	MOVB	#' ,(R1)+	; Buffer a pad character.
	SOB	R2,40$		; Continue to maximum symbol length.
;   Encode symbol name into RAD50.
50$:	MOV	SP,R1		; Point to symbol name.
	MOV	R0,-(SP)	; Save scan pointer.
	MOV	R1,R0		; Put name pointer where it belongs.
	MOV	#1,R1		; Accept periods.
	CALL	$CAT5B		; Convert first three characters to RAD50.
	MOV	R1,-(SP)	; Save result.
	MOV	#1,R1		; Accept periods.
	CALL	$CAT5B		; Convert the remainder.
	MOV	(SP)+,R2	; Position RAD50 name appropriately.
	MOV	R1,R3
	MOV	(SP)+,R0	; Recover scan pointer.
	ADD	#6,SP		; Clean up stack.
	RETURN
;   Symbol name required but not found.
100$:	ADD	#6,SP		; Clean up stack.
	MOV	#E.SNRQ,R1	; Point to error message.
	SEC			; Indicate failure.
	RETURN
	.PAGE
;
;   Subroutine to allocate a block of memory.
;
;   On entry:	R0 contains desired block size.
;
;   On exit:	R0 points to allocated block.
;		The carry will be set if allocation fails.
;
U$RQCB::
	MOV	R2,-(SP)	; Save volatile registers.
	MOV	R1,-(SP)
	MOV	R0,-(SP)	; Save desired allocation size.
10$:	MOV	#FREMEM,R0	; Point to free memory list header.
	MOV	(SP),R1		; Get desired allocation size.
	CALL	$RQCB		; Is a suitable block available?
	BCC	40$		; Yes, return with it.
;   Allocation failed: attempt task extension.
	MOV	#FREMEM,R0	; Point back to free memory list head.
	MOV	2(R0),R2	; Has extension already failed?
	BEQ	30$		; Yes, give it up.
	EXTK$S	#4		; Extend task by 256 bytes, OK?
	BCS	20$		; No, forget it.
	MOV	#256.,R1	; Get size of new area.
	ADD	R1,2(R0)	; Indicate new highest address.
	CALL	$RLCB		; Make new area available.
	BR	10$		; Retry allocation.
;   Task extension failed.
20$:	CLR	2(R0)		; Don't try further extensions.
30$:	SEC			; Indicate failure.
;   Exit with or without desired block.
40$:	ROR	R0		; Save carry bit.
	TST	(SP)+		; Pop desired allocation size.
	MOV	(SP)+,R1	; Rcover volatile registers.
	MOV	(SP)+,R2
	ASL	R0		; Restore carry bit.
	RETURN
	.PAGE
;
;   Subroutine to convert a RAD50 word to ASCII.
;   On entry:	R0 points to buffer, R1 contains RAD50 word.
;   On exit:	R0 points after characters, R1 & R2 are destroyed.
;
$C5TA::	MOV	R0,R2		; Save buffer pointer.
	CLR	R0		; Zero-extend RAD50 word to 32 bits.
	DIV	#50,R0		; Get last RAD50 character in R1.
	MOV	R1,-(SP)	; Save it.
	MOV	R0,R1		; Position quotient.
	CLR	R0		; Zero-extend it.
	DIV	#50,R0		; Get middle RAD50 character in R1.
	MOVB	R50TBL(R0),(R2)+; Buffer first RAD50 character.
	MOV	R2,R0		; Put buffer pointer where it belongs.
	MOVB	R50TBL(R1),(R0)+; Buffer second RAD50 character.
	MOV	(SP)+,R1	; Recover final RAD50 character.
	MOVB	R50TBL(R1),(R0)+; Buffer it.
	RETURN

	.SAVE
	.PSECT	RODATA,D,RO
;
;   Table of RAD50 characters.
;
R50TBL:	.ASCII	" ABCDEFGHIJKLMNOPQRSTUVWXYZ$.?0123456789"
	.RESTORE
	.PAGE
;
;   Subroutine to perform unsigned division.
;   On entry:	R0 contains dividend, R1 contains divisor.
;   On exit:	R0 contains quotient, R1 contains remainder.
;
$DIV::	MOV	R1,-(SP)	; Save divisor.
	MOV	R0,R1		; Put dividend in place.
	CLR	R0		; Zero-extend it to 32 bits.
	CMP	(SP),#1		; Will DIV instruction work right?
	BLE	10$		; No, handle the perverse cases.
	DIV	(SP)+,R0	; Perform signed division.
	RETURN
;   Here if divisor would cause problems for the DIV instruction.
10$:	TST	(SP)		; Is the divisor >= 32768?
	BPL	30$		; No, handle trivial cases.
20$:	CMP	R1,(SP)		; Is remainder >= divisor?
	BLO	40$		; No, clean up stack and exit.
	SUB	(SP),R1		; Subtract divisor.
	INC	R0		; Count subtraction in quotient.
	BR	40$		; Clean up the stack and exit.
;   Here for divisors of 0 and 1.
30$:	MOV	R1,R0		; Return dividend as quotient.
	CLR	R1		; Zero remainder.
40$:	TST	(SP)+		; Clean up the stack.
	RETURN

;
;   Subroutine to perform unsigned multiplication.
;   On entry:	R0 contains the multiplicand, R1 contains multiplier.
;   On exit:	R0 and R1 contain product.
;
$MUL::	MOV	R0,-(SP)	; Copy multiplicand.
	BIS	R1,(SP)+	; Are both factors <= 32767?
	BMI	10$		; No, do it the hard way.
	MUL	R1,R0		; Perform signed multiplication.
	RETURN
;   At least one factor is >= 32768.
10$:	MOV	R3,-(SP)	; Free up a couple of registers.
	MOV	R2,-(SP)
	MOV	R0,R2		; Copy multiplicand.
	MOV	#17.,R3		; Set up shift counter.
	CLR	R0		; Zero-extend the multiplier (clears carry).
20$:	ROR	R0		; Shift down multiplier (pick up carry).
	ROR	R1		; Should multiplicand be added?
	BCC	30$		; No, count shift and loop.
	ADD	R2,R0		; Add multiplicand.
30$:	SOB	R3,20$		; Perform all shifts.
	MOV	(SP)+,R2	; Pop saved registers.
	MOV	(SP)+,R3
	RETURN
	
	.END