; CL1SUB - CLONE GENERAL SUBROUTINES
; LAST EDIT:	11-NOV-81
.NLIST
.LIST	TTM
.NLIST	BEX
.TITLE	CL1SUB
.LIST
;
.PSECT	CL1SUB
;
;
;
; 
CR=15
LF=12
SPACH=40	;ASCII SPACE
LOWN=156
LOWY=171	;LOWER CASE Y
;
;
;
; LOOKUP - LOOKUP VALUE IN NAME/VALUE TABLE
;
; INPUT:	R0=NAME SYMBOL TEXT
;		R1=LENGTH
;		   ZERO BYTE WILL TERMINATE COMPARISON
;		   IRRESPECTIVE OF R1
;		R2=ADDRESS OF START OF SYMBOL TABLE
;
; OUTPUT:	C - CLEAR
;		   R2 POINTS TO VALUE WORD
;		C - SET
;		   NOT FOUND. R2=0
;
; OTHER REGISTERS DESTROYED:	NONE
;
;
; ALTERNATIVE ENTRY-POINT LOOK1 TERMINATES THE SEARCH AT THE TABLE
; ADDRESS CONTAINED IN R3
;
;
;
; SYMBOL TABLE STRUCTURE IS:
;			SEG1:	.WORD	VALUE
;				.ASCIZ	"NAME"
;				.EVEN
;				......
;				.WORD	-1
;				.WORD	SEG2
;
;			SEG2:	......
;				.WORD	0
;
; THUS TABLES MAY BE COMPOSED OF ANY NUMBER OF NON-
; CONTIGUOUS SEGMENTS. NOTE THAT 0 AND -1 ARE NOT
; VALID 'VALUES' IN SUCH A STRUCTURE.
;
; MULTI-SEGMENT TABLES WILL GENERALY BE CONTAINED WITHIN
; A LIST IN DYNAMIC MEMORY.
;
;
LOOKUP::MOV	R0,-(SP)	;SAVE NAME STRING
	MOV	R1,-(SP)
	MOV	R3,-(SP)
	CLR	R3
	BR	LOOK
;
LOOK1::	MOV	R0,-(SP)
	MOV	R1,-(SP)
	MOV	R3,-(SP)
LOOK:	TST	R2		;NULL TABLE ?
	BEQ	6$
	TST	(R2)		;END OF TABLE ?
	BEQ	6$		;IF SO QUIT
	CMP	R2,R3		;END OF RANGE ?
	BEQ	6$
	CMP	(R2),#-1	;LINK TO ANOTHER SEGMENT ?
	BNE	7$
	MOV	2(R2),R2	;GET NEXT SEGMENT ADDRESS
	BR	LOOK		;AND TRY AGAIN
7$:	MOV	R2,-(SP)	;SAVE VALUE POINTER
	ADD	#2,R2		;SKIP VALUE
5$:	CMPB	(R0)+,(R2)+	;COMPARE CHARS
	BNE	3$
	DEC	R1		;DEC LENGTH
	BEQ	2$		;END OF STRING ?
	TSTB	(R0)		;END OF STRING ?
	BEQ	2$
	TSTB	(R2)		;END OF TABLE ENTRY ?
	BNE	5$		;IF NOT KEEP COMPARING
	BR	3$		;ELSE NO MATCH
2$:	TSTB	(R2)		;MUST BE SAME LENGTH
	BNE	3$		;IF NOT ONTO NEXT
	MOV	(SP)+,R2	;GET BACK ADDRESS OF VALUE
	CLC
	BR	4$		;OK WE'VE GOT IT
3$:	TSTB	(R2)+		;CLEAR REST OF TABLE ENTRY
	BNE	3$
	ADD	#2,SP		;POP THAT ENTRY ADDRESS
	INC	R2		;ROUND UP POINTER
	BIC	#1,R2
	MOV	4(SP),R0	;GET BACK STRING
	MOV	2(SP),R1
	BR	LOOK		;GO ROUND AGAIN
6$:	CLR	R2		;NO MATCH
	SEC
4$:	MOV	(SP)+,R3
	MOV	(SP)+,R1
	MOV	(SP)+,R0
	RETURN
;
;
; ENTER - ENTER A NAME IN A SYMBOL TABLE, MAYBE ADD NEW SEGMENT.
; INPUT:	R0=NAME STRING ADDRESS
;		R1=NAME STRING LENGTH
;		R2=TABLE DESCRIPTOR POINTER
;			.WORD	FIRST
;			.WORD	LAST
;			.WORD	POINTER
; OUTPUT:	R2=ADDRESS OF SYMBOL TABLE VALUE WORD.
;
; REGISTERS DESTROYED:	NONE
;
ENTER::	MOV	R0,-(SP)
	MOV	R1,-(SP)
	MOV	R3,-(SP)
	MOV	R4,-(SP)
	TST	(R2)		;ANYTHING IN LIST ?
	BEQ	1$		;IF NOT START NEW SEGMENT
	ADD	#4,R1		;CALCULATE LENGTH REQUIRED
	BIC	#1,R1
	MOV	4(R2),R0	;GET CURRENT POINTER
	SUB	(R2),R0		;GET SPACE AVAILABLE
	SUB	#10,R0		;ALLOW FOR HEADER
	CMP	R0,R1
	BGE	2$		;YES THERES ENOUGH ROOM
;
1$:	MOV	#SEGSIZ,R1	;ALLOCATE A NEW SEGMENT
	CALL	GETSP
	MOV	R2,R3		;COPY LISTHEAD ADDRESS
	MOV	R0,R2		;SET ITEM TO LINK
	CALL	LINKB		;LINK AT BEGINNING OF LIST
	MOV	R3,R2		;RESTORE LISTHEAD TO R2
	ADD	#SEGSIZ*2,R0	;POINT TO END OF NEW ITEM
	MOV	4(R2),-(R0)	;SET FORWARD SEGMENT LINKAGE
	MOV	#-1,-(R0)	;SET LINKAGE FLAG
	MOV	R0,4(R2)	;SET NEW TABLE POINTER
;
2$:	MOV	6(SP),R0	;RESTORE NAME
	MOV	4(SP),R1
	MOV	4(R2),R3	;GET TABLE POINTER
	CLRB	-(R3)		;ZERO BYTE TO TERMINATE NAME
	BIT	#1,R1		;NEED AN EXTRA FILL BYTE ?
	BNE	5$		;NO NEED IF ODD
	CLRB	-(R3)
5$:	ADD	R1,R0		;END OF INPUT STRING
4$:	MOVB	-(R0),-(R3)	;COPY NAME
	SOB	R1,4$
	CLR	-(R3)		;INIT VALUE LOCATION
	MOV	R3,4(R2)	;UPDATE POINTER
	MOV	R3,R2		;AND RETURN POINTER ADDRESS
	MOV	(SP)+,R4
	MOV	(SP)+,R3
	MOV	(SP)+,R1
	MOV	(SP)+,R0
	RETURN
;
;
; REMNAM - REMOVES THE TOP ENTRY FROM A TABLE
;
; INPUT:	R2=SYMBOL TABLE LISTHEAD
; OUTPUT:	R0=NEW SYMBOL TABLE POINTER
;
; REGISTERS DESTROYED:	NONE
;
;
REMNAM::MOV	R2,-(SP)
	MOV	R3,-(SP)
	MOV	R4,-(SP)
	MOV	4(R2),R0	;GET POINTER
	BEQ	2$		;SKIP IF TABLE NULL
	ADD	#2,R0		;SKIP VALUE LOCATION
1$:	TSTB	(R0)+		;SKIP UP NAME
	BNE	1$
	INC	R0		;ROUND UP TO WORD
	BIC	#1,R0
	MOV	R0,4(R2)	;SAVE POINTER
	CMP	(R0),#-1	;SEGMENT EMPTY ?
	BNE	2$
	MOV	2(R0),4(R2)	;UPDATE POINTER
	MOV	R2,R3		;UNLINK SEGMENT
	MOV	(R3),R2		;FROM BEGINNING OF LIST
	CALL	UNLINK
	MOV	R2,R0		;AND DE-ALLOCATE
	CALL	FREESP
2$:	MOV	(SP)+,R4
	MOV	(SP)+,R3
	MOV	(SP)+,R2
	MOV	4(R2),R0	;RETURN POINTER
	RETURN
;
;
;
; NEWVAL - CREATE A NEW VARIABLE
;
; INPUT:	R0 -	ADDRESS OF NAME STRING
;		R1 -	LENGTH OF NAME STRING
;
; OUTPUT:	R0 -	ADDRESS OF VALUE ITEM CREATED
;		R2 -	ADDRESS OF SYMBOL TABLE ENTRY
;
; OTHER REGISTERS DESTROYED:	R1
;
NEWVAL::MOV	STREAM,R2	;GET CURRENT STREAM ITEM
	ADD	#SL.STB,R2	;POINT TO SYMBOL TABLE LISTHEAD
	CALL	ENTER		;CREATE SYMBOL TABLE ENTRY
	CALL	UDFVAL		;ALLOCATE AN UNDEFINED ITEM
	MOV	R2,4(R0)	;SET OWNER WORD
	MOV	R0,(R2)		;ENTER VALUE IN SYMBOL TABLE
	RETURN
;
;
;
; STRLEN - COMPUTE THE LENGTH OF A ZERO TERMINATED STRING
;
; INPUT:	R2 -	ADDRESS OF STRING
; OUTPUT:	R1 -	STRING LENGTH INCLUDING ZERO BYTE
;
; REGISTERS MODIFIED:	R1
;
STRLEN::MOV	R2,R1
1$:	TSTB	(R1)+
	BNE	1$
	SUB	R2,R1
	RETURN
;
;
; PRSFNM - PARSE AN RSX FILE NAME STRING
;
; INPUT:	R2	ADDRESS OF NAME STRING
; OUTPUT:	R1	LENGTH OF NAME STRING
;
; REGISTERS MODIFIED:	R1
;
; THIS ROUTINE DETERMINES THE LENGTH OF A FILE SPECIFICATION STRING.
; THE STRING IS TERMINATED BY ANY OF: SPACE, TAB, EOL, ( )
;
PRSFNM::MOV	R2,R1		;COPY STRING ADDRESS
1$:	CMPB	(R1),#SPACH	;ANYTHING <= SPACE IS A TERMINATOR
	BLOS	2$
	CMPB	(R1),#'(
	BEQ	2$
	CMPB	(R1),#')
	BEQ	2$
	INC	R1		;ON TO NEXT CHAR
	BR	1$
2$:	SUB	R2,R1		;GET LENGTH
	RETURN
;
;
; UDFVAL - CREATE AN UNDEFINED VALUE
;
; OUTPUT:	R0 -	ADDRESS OF ITEM MODE=UNDEFINED
;
; REGISTERS DESTROYED:	R1
;
UDFVAL::MOV	#4,R1		;SET ITEM LENGTH
	CALL	GETSP		;ALLOCATE ITEM
	MOV	#M.UDF,6(R0)	;SET MODE
	RETURN
;
;
; STRVAL - CREATE A STRING VALUE
;
; INPUT:	R1 -	LENGTH OF STRING
;		R2 -	ADDRESS OF STRING
; OUTPUT:	R0 -	ADDRESS OF STRING ITEM
;
; REGISTERS DESTROYED:	R1,R2
;
STRVAL::
STRLIT::MOV	R3,-(SP)
	MOV	R1,-(SP)	;SAVE STRING LENGTH
	ADD	#12,R1		;COMPUTE ITEM LENGTH
	ASR	R1		;IN WORDS
	CALL	GETSP		;ALLOCATE ITEM
	MOV	R0,R3		;COPY ITEM ADDRESS
	ADD	#4,R3		;SKIP HEADER
	CLR	(R3)+		;NO ITEM OWNER
	MOV	#M.STR,(R3)+	;STRING ITEM MODE
	MOV	(SP)+,R1	;GET BACK LENGTH
	BEQ	2$		;JUST IN CASE
1$:	MOVB	(R2)+,(R3)+	;COPY STRING
	SOB	R1,1$
2$:	MOV	(SP)+,R3
	RETURN
;
;
; NUMVAL - CREATE A NUMERIC VALUE ITEM
;
; INPUT:	R2 -	INTEGER VALUE FOR VALUE ITEM
;
; OUTPUT:	R0 -	VALUE ITEM ADDRESS
;		ITEM IS INITIALIZED WITH VALUE
;
; REGISTERS DESTROYED:	NONE
;
; THIS ROUTINE MAY RETURN WITH C SET AND R0=0 IF
; THE SPACE ALLOCATION FAILS.
;
NUMVAL::MOV	R1,-(SP)
	MOV	#6,R1		;ITEM SIZE IN WORDS
	CALL	GETSPA		;ATTEMPT TO ALLOCATE SPACE
	BCS	1$		;SKIP IF WE FAIL
	CLR	4(R0)		;NO OWNER
	MOV	#M.NUM,6(R0)	;SET MODE
	MOV	R2,10(R0)	;SET VALUE
1$:	MOV	(SP)+,R1
	RETURN
;
;
; BOOVAL - CREATE A BOOLEAN VALUE ITEM
;
; INPUT:	R2 -	BOOLEAN VALUE FOR VALUE ITEM
;
; OUTPUT:	R0 -	VALUE ITEM ADDRESS
;		ITEM IS INITIALIZED WITH VALUE
;
; REGISTERS DESTROYED:	NONE
;
; THIS ROUTINE MAY RETURN WITH C SET AND R0=0 IF
; THE SPACE ALLOCATION FAILS.
;
BOOVAL::CALL	NUMVAL		;ALLOCATE AS NUMERIC VALUE
	BCS	1$		;SKIP ON ALLOCATION FAIL
	MOV	#M.BOO,6(R0)	;CHANGE MODE TO BOOLEAN
1$:	RETURN
;
;
; CBT2OD - CONVERT A BINARY NUMBER TO 2 OCTAL DIGITS
; INPUT:	R0 -	ADDRESS OF CONVERSION BUFFER
;		R1 -	BINARY VALUE 0<=R1<=77
;
; REGISTERS MODIFIED:	R1
;
CBT2OD::MOV	R1,-(SP)
	BIC	#177770,R1
	ADD	#'0,R1
	MOVB	R1,1(R0)
	MOV	(SP)+,R1
	BIC	#177707,R1
	ASR	R1
	ASR	R1
	ASR	R1
	ADD	#'0,R1
	MOVB	R1,(R0)
	RETURN
.PAGE
; SUBSTR - SUBSTITUTE CLONE VARIABLES INTO A STRING
;
;	I=3 "FILE'I'"     GIVES: FILE3
;
; INPUT:	R0	STRING ITEM TO PROCESS
; OUTPUT:	R0	STRING ITEM WITH SUBSTITUTIONS
;
; IF THE INPUT ITEM IS TEMPORARY IT IS DELETED.
; SUBSTITUTION IS CONDITIONAL ON THE CF.SUB BIT IN THE CONTROL
; DESCRIPTOR FLAGS WORD.
;
; REGISTERS DESTROYED:	NONE
;
SUBSTR::MOV	R1,-(SP)
	MOV	STREAM,R1	;CHECK IF SUBSTITUTION IS ENABLED
	MOV	SL.CLH(R1),R1
	BIT	#CF.SUB,CD.FLG(R1)
	BNE	1$
	MOV	(SP)+,R1
	RETURN
;
1$:	MOV	R2,-(SP)
	MOV	R3,-(SP)
	MOV	R4,-(SP)
SUB1:	MOV	R0,-(SP)	;SAVE INPUT STRING
	ADD	#10,R0		;SKIP HEADER
	MOV	R0,R2		;COPY POINTER
	CALL	STRLEN		;GET THE STRING LENGTH
	MOV	R1,R3		;AND SAVE IT
1$:	TSTB	(R0)		;END OF STRING ?
	BEQ	20$		;NO MORE SUBSTITUTIONS
	CMPB	(R0)+,#''	;LOOK FOR SINGLE QUOTE
	BNE	1$		;AND KEEP LOOKING
	MOV	R0,R1		;COPY POINTER
2$:	TSTB	(R1)		;CHECK FOR END OF STRING
	BEQ	30$		;ERROR IF WE GET IT
	CMPB	(R1)+,#''	;SEARCH FOR MATCHING QUOTE
	BNE	2$
	MOV	R1,R4		;SAVE REST OF STRING POINTER
	SUB	R0,R1		;GET LENGTH OF SUBSTITUTION STRING
	DEC	R1		;LESS THE SECOND QUOTE
	BEQ	30$		;ERROR ON NULL STRING
	SUB	R1,R3		;REMOVE FROM INPUT STRING LENGTH
	SUB	#2,R3		;LESS BOTH QUOTES
	MOV	STREAM,R2	;GET STREAM POINTER
	MOV	SL.STB+4(R2),R2	;GET SYMBOL TABLE POINTER
	CALL	LOOKUP		;LOOKUP VARIABLE NAME
	BCS	40$		;SKIP IF UNDEFINED
	MOV	(R2),R0		;GET THE ITEM POINTER
	CALL	DEREF		;FOLLOW ANY INDIRECTION
	CMP	6(R0),#M.UDF	;CHECK ITEM IS DEFINED
	BEQ	40$		;IF NOT STRING BECOMES UNDEFINED
	MOV	#M.STR,R1	;SET MODE REQUIRED
	CALL	CONVRT
	MOV	R0,-(SP)	;SAVE ITEM
	MOV	R0,R2
	ADD	#10,R2		;POINT TO TEXT
	CALL	STRLEN		;GET ITS LENGTH
	ADD	R3,R1		;INCLUDE REST OF LENGTH
	ADD	#11,R1		;AND HEADER
	ASR	R1		;CONVERT TO WORDS
	CALL	GETSPA		;ALLOCATE THE NEW ITEM
	BCS	37$		;SKIP ON ALLOCATION FAIL
	MOV	R0,R1		;COPY ITEM ADDRESS
	ADD	#4,R0		;SKIP ITEM HEADER
	CLR	(R0)+		;NO OWNER
	MOV	#M.STR,(R0)+	;STRING MODE
	MOV	2(SP),R2	;GET BACK INITIAL STRING
	ADD	#10,R2
4$:	CMPB	(R2),#''	;COPY PART PRIOR TO SUBSTITUTION
	BEQ	5$
	MOVB	(R2)+,(R0)+
	BR	4$
5$:	MOV	(SP),R2		;GET NEW STRING
	ADD	#10,R2
6$:	MOVB	(R2)+,(R0)+	;COPY NEW STRING
	BNE	6$
	DEC	R0		;BACKSPACE OVER ZERO BYTE
7$:	MOVB	(R4)+,(R0)+	;COPY REST OF STRING
	BNE	7$
	MOV	(SP)+,R0	;RESTORE SUBSTITUTION ITEM
	CALL	VOIDSP		;AND RELEASE IT
	MOV	(SP)+,R0	;RESTORE INPUT ITEM
	CALL	VOIDSP		;AND RELEASE THAT
	MOV	R1,R0
	BR	SUB1		;AND TRY FOR MORE SUBSTITUTIONS
;
20$:	MOV	(SP)+,R0
	MOV	(SP)+,R4
	MOV	(SP)+,R3
	MOV	(SP)+,R2
	MOV	(SP)+,R1
	RETURN
;
;
30$:	ERROR$	#E.BSS		;REPORT BAD STRING SUBSTITUTION
	BR	20$
;
37$:	MOV	(SP)+,R0	;GET BACK CONVERTED ITEM
	CALL	VOIDSP		;AND DE-ALLOCATE IT
;
40$:	MOV	(SP),R0		;GET BACK INPUT ITEM
	MOV	#M.UDF,6(R0)	;FLAG IT UNDEFINED
	BR	20$		;AND QUIT
;
;
.PAGE
; DOOP - EVALUATE AN OPERATION
;
; INPUT:	R0=LEFT OPERAND VALUE POINTER
;		R1=RIGHT OPERAND POINTER
;		R2=OPERATION CODE
; OUTPUT:	R0=RESULT ITEM POINTER
;		IF EITHER OPERAND IS NULL THE OPERATION IS
;		AUTOMATICALY NULL. FOR MONADIC OPERATIONS THE
;		UNUSED POINTER SHOULD CONTAIN THE VALUE 1.
;		TEMPORARY OPERANDS ARE DE-ALLOCATED AFTER
;		EVALUATION.
;
;
;
DOOP::	MOV	R3,-(SP)
	MOV	R0,-(SP)	;SAVE OPERANDS
	MOV	R1,-(SP)
;
; TOP OF STACK IS NOW:
;	2(SP)	LEFT HAND VALUE
;	(SP)	RIGHT HAND VALUE
;
	TST	EXEC		;ARE WE REALY WORKING ?
	BNE	11$
	TST	R0		;CHECK WEVE GOT ARGUMENTS
	BEQ	11$
	TST	R1
	BEQ	11$
;
; CHECK THAT BOTH ARGUMENTS ARE DEFINED
	CMP	R1,#1		;CHECK RIGHT OPERAND
	BEQ	1$		;SKIP IF NO RIGHT OPERAND
	CMP	6(R1),#M.UDF	;IS IT UNDEFINED ?
	BEQ	10$		;IF SO EXIT WITH ERROR
1$:	CMP	R0,#1		;DO WE HAVE A LEFT OPERAND
	BEQ	2$		;SKIP IF NOT
	CMP	R2,#O.ASS	;IS OPERATION ASSIGNMENT ?
	BEQ	2$		;IF SO IT MAY BE UNDEFINED
	CMP	6(R0),#M.UDF	;IS IT UNDEFINED
	BEQ	10$
2$:	CMP	R2,#OPTBLN	;CHECK VALIDITY OF OPCODE
	BGT	3$		;PAST END OF TABLE
	TST	OPTAB(R2)
	BEQ	3$		;NULL ENTRY
	CLR	R3		;INIT BOOLEAN RESULT TO FALSE
	JMP	@OPTAB(R2)	;DISPATCH ON OPCODE
;
3$:	MOV	#INVMES,R2
	CALL	OUT
	CALL	ABORT
;
10$:	ERROR$	#E.UND		;UNDEFINED VARIABLE
;
11$:	CLR	R0		;EXIT WITH NO RESULT
	JMP	OPDONE
;
INVMES:	.ASCIZ	/CLONE -- INVALID OPCODE/
	.EVEN
;
;
;
;
; THIS IS THE OPERATOR JUMP TABLE
; IT MUST CORRESPOND TO THE DEFINITION LIST IN CL1SYN.
;
;
OPTAB:	.WORD	0,0,0,0		;4 DUMMY OPS USED AS FLAGS BY THE PARSER
	.WORD	ASSIGN
	.WORD	OPADD
	.WORD	OPSUB
	.WORD	OPMUL
	.WORD	OPDIV
	.WORD	OPPLUS
	.WORD	OPNEG
	.WORD	OPCON
	.WORD	EQUAL
	.WORD	NEQUAL
	.WORD	GTHAN
	.WORD	GTHEQ
	.WORD	LTHAN
	.WORD	LTHEQ
	.WORD	OPNOT
	.WORD	OPOR
	.WORD	OPAND
	.WORD	OPIDEN
;
OPTBLN==.-OPTAB			;CHECK WITH DEFINITION IN CL1SYN
;
;
; ASSIGNMENT
;
ASSIGN:	TST	R1		;VALID RVALUE ?
	BEQ	4$
	MOV	4(R0),R3	;GET OWNER ADDRESS
	BNE	1$		;MUST BE PERMENANT
	ERROR$	#E.SYN
	BR	4$
1$:	CALL	FREESP		;DE-ALLOCATE OLD VALUE
	TST	4(R1)		;IS NEW VALUE TEMPORARY ?
	BEQ	3$		;IF SO WE CAN USE IT
	MOV	R1,R0		;ELSE WE HAVE TO COPY IT
	CALL	CPYITM
	MOV	R0,R1
3$:	MOV	R3,4(R1)	;SET NEW OWNER
	MOV	R1,(R3)		;SET VALUE POINTER
4$:	CLR	R0		;VOID RESULT
	ADD	#4,SP		;POP ARGUMENTS
	MOV	(SP)+,R3
	RETURN
;
; ADDITION HAS 2 VALID RESULT MODES
; 1) NUMBER AND 2) STRING (CONCATENATION)
; IF EITHER ARGUMENT IS NON NUMERIC, STRING CONCATENATION OCCURES
; 
OPADD:	CALL	NUM2		;TRY FOR NUMERIC ARGS
	BCS	OPCON		;IF FAILS GET STRING
	ADD	R1,R0		;ADD TWO ARGS
	BVS	1$
	JMP	NUMBER		;GO FORM RESULT ITEM
1$:	JMP	OVFLO		;16 BIT OVERFLOW
;
OPCON:	CALL	STR2		;GET 2 STRING ARGS
	MOV	2(SP),R0
	MOV	2(R0),R1	;GET LENGTHS
	MOV	(SP),R0
	ADD	2(R0),R1
	SUB	#4,R1		;ALLOW FOR HEADER
	CALL	GETSPA
	BCS	4$		;SKIP ON ALLOCATION FAIL
	CLR	4(R0)		;CLEAR OWNER WORD
	MOV	#M.STR,6(R0)	;SET MODE
	MOV	R0,R2		;COPY ITEM POINTER
	ADD	#10,R2		;SKIP OVER HEADER
	MOV	2(SP),R1	;FIRST STRING
	ADD	#10,R1
1$:	TSTB	(R1)
	BEQ	2$
	MOVB	(R1)+,(R2)+
	BR	1$
2$:	MOV	(SP),R1		;SECOND STRING
	ADD	#10,R1
3$:	MOVB	(R1)+,(R2)+
	BNE	3$
4$:	JMP	OPDONE
;
;
OPPLUS:	CALL	NUM2
	BCC	1$
	JMP	TERROR
1$:	MOV	R1,R0		;RIGHT OPERAND VALUE
	BR	NUMBER
;
OPSUB:	CALL	NUM2
	BCC	1$
	JMP	TERROR
1$:	SUB	R1,R0
	BVS	OVFLO
	BR	NUMBER
;
OPNEG:	CALL	NUM2
	BCC	1$
	JMP	TERROR
1$:	NEG	R1
	BVS	OVFLO
	MOV	R1,R0
	BR	NUMBER
;
OPMUL:	CALL	NUM2
	BCC	1$
	JMP	TERROR
1$:	MUL	R0,R1
	MOV	R1,R0
	BCS	OVFLO
	BR	NUMBER
;
OPDIV:	CALL	NUM2
	BCC	1$
	JMP	TERROR
1$:	MOV	R1,R2		;SAVE DIVISOR
	BEQ	2$		;TRAP DIVISION BY ZERO
	MOV	R0,R1		;SET DIVIDEND
	CLR	R0		;AND HIGH ORDER DIVIDEND
	TST	R1		;GET THE SIGN BIT
	SXT	R0		;AND EXTEND IT
	DIV	R2,R0
	BR	NUMBER
;
2$:	MOV	#MDIV0,R2
	CALL	OUT
	CLR	R0
	BR	NUMBER
;
;
; THESE ARE THE COMPARISON OPERATIONS
; BASIC OPERATIONS ARE == > <  RESULT IS COMPLEMENTED FOR != <= >=
;
; EQUALITY MAY BE 1) NUMERIC OR 2) STRING
;
NEQUAL:	MOV	#1,R3
EQUAL:	CALL	NUM2		;TRY FOR A NUMBER
	BCS	CMPRS		;IF FAIL DO STRING COMPARE
	CMP	R0,R1		;NUMERIC COMAPRISON
	BEQ	TRUE
	BR	FALSE
;
CMPRS:	CALL	STR2		;GET STRING ARGS
1$:	TSTB	(R0)		;END OF STRING 1
	BEQ	TRUE		;MATCH TO EOS
	CMPB	(R0)+,(R1)+	;COMPARE CHARS
	BEQ	1$		;KEEP GOING
	BR	FALSE		;NO MATCH SO FAIL
;
;
LTHEQ:	MOV	#1,R3
GTHAN:	CALL	NUM2
	BCC	1$
	JMP	TERROR
1$:	CMP	R0,R1
	BGT	TRUE
	BR	FALSE
;
;
GTHEQ:	MOV	#1,R3
LTHAN:	CALL	NUM2
	BCC	1$
	JMP	TERROR
1$:	CMP	R0,R1
	BLT	TRUE
	BR	FALSE
;
;
;
OPNOT:	CALL	BOO2		;GET BOOLEAN ARGUMENT
	BCC	1$
	JMP	TERROR
1$:	MOV	R1,R3		;GET VALUE
	BR	TRUE		;COMPLIMENT
;
;
OPOR:	CALL	BOO2		;GET BOOLEAN ARGUMENTS
	BCC	1$
	JMP	TERROR
1$:	TST	R0		;COMPUTE OR
	BNE	TRUE
	TST	R1
	BNE	TRUE
	BR	FALSE
;
;
OPAND:	CALL	BOO2		;GET BOOLEAN ARGUMENTS
	BCC	1$
	JMP	TERROR
1$:	TST	R0		;LEFT ARG
	BEQ	FALSE
	TST	R1		;RIGHT ARG
	BEQ	FALSE
	BR	TRUE
;
;
; COMPARE STRINGS FOR IDENTITY
;
OPIDEN:	CALL	STR2		;GET TWO STRINGS
1$:	CMPB	(R0),(R1)+
	BNE	FALSE
	TSTB	(R0)+
	BEQ	TRUE
	BR	1$
;
;
; REPORT A 16 BIT INTEGER OVERFLOW
;
OVFLO:	MOV	#MOVFLO,R2
	CALL	OUT
	TST	R0		;SET RESULT TO + OR =- MAXINT
	BPL	1$
	MOV	#32767.,R0
	BR	NUMBER
1$:	MOV	#-32768.,R0
	BR	NUMBER
;
;
; HERE WE EXIT WITH A NUMERIC RESULT
; INPUT:	R0=NUMERIC VALUE
; OUTPUT:	R0=VALUE ITEM ADDRESS
;
;
NUMBER:	MOV	R0,R2		;COPY VALUE
	CALL	NUMVAL		;ALLOCATE NUMERIC VALUE ITEM
	BR	OPDONE		;WEVE FINISHED
;
;
;
; HERE WE EXIT WITH A BOOLEAN RESULT
; R3 SHOULD CONTAIN A BOOLEAN VALUE WHICH WILL BE
; COMPLIMENTED AT TRUE AND UNTOUCHED AT FALSE.
;
;
TRUE:	NEG	R3		;0->1  1->0
	INC	R3
FALSE:	MOV	R3,R2		;COPY VALUE
	CALL	BOOVAL		;ALLOCATE BOOLEAN VALUE ITEM
	JMP	OPDONE
;
; HERE WE COULDNT GET THE RIGHT ARGUMENT MODES
;
TERROR:	ERROR$	#E.ITC	
	CLR	R0
	JMP	OPDONE
;
; DE-ALOCATE ARGUMENT SPACE AND RETURN
;
OPDONE:	MOV	R0,R1		;SAVE RESULT
	CALL	POPARG		;POP R2 VALUE FROM STACK
	CALL	POPARG		;POP R1 VALUE FROM STACK
	MOV	R1,R0		;UNSAVE RESULT
	MOV	(SP)+,R3
	CLR	R2
	CLR	R1
	RETURN
;
POPARG:	MOV	(SP)+,R3	;SAVE RETURN ADDRESS
	MOV	(SP)+,R0	;POP OPERAND POINTER
	BEQ	1$		;QUIT IF NULL
	BIT	#1,R0		;IS IT ODD ?
	BNE	1$
	CALL	VOIDSP		;FREE UP THE SPACE
1$:	JMP	(R3)		;RETURN ON SAVED ADDRESS
;
;
; THE FOLLOWING ROUTINES CALL THE MODE CONVERSION
; MODULE TO CONVERT OPERANDS TO THE REQUIRED MODES.
;
; NUM2,STR2,BOO2 - OBTAIN OPERATION ARGUMENTS
; INPUT:	2(SP)	LEFT OPERAND VALUE POINTER
;		(SP)	RIGHT OPERAND VALUE POINTER
; OUTPUT:	C CLEAR	CONVERSION SUCCESSFUL
; 		2(SP)	CONVERTED LEFT OPERAND POINTER
;		R0	CONVERTED LEFT OPERAND VALUE
;		(SP)	CONVERTED RIGHT OPERAND POINTER
;		R1	CONVERTED RIGHT OPERAND VALUE
;
;		C SET	CONVERSION FAILED
;		2(SP)	UNMODIFIED
;		(SP)	UNMODIFIED
;		R0,R1	UNDEFINED
;
; FOR NUMERIC AND BOOLEAN VALUES THE RESULTS IN R0,R1 ARE THE
; BINARY REPRESENTATIONS OF THE VALUES. FOR STRING VALUES THESE
; REGISTERS CONTAIN THE STRING ADDRESS.
;
; 
;
NUM2:	MOV	#M.NUM,R1	;SELECT MODE FOR CONVRT
	BR	NUMBOO
;
BOO2:	MOV	#M.BOO,R1
;
NUMBOO:	CALL	CNV2
	BCS	2$		;SKIP IF CONVERT FAILS
	CMP	R0,#1		;LEFT ARG NULL ?
	BEQ	1$
	MOV	10(R0),R0
1$:	CMP	R1,#1		;RIGHT ARG NULL ?
	BEQ	2$
	MOV	10(R1),R1
2$:	RETURN
;
;
STR2:	MOV	#M.STR,R1	;SELECT MODE FOR CONVRT
	CALL	CNV2
	BCS	2$		;SKIP IF CONVERT FAILS
	CMP	R0,#1		;LEFT ARG NULL ?
	BEQ	1$
	ADD	#10,R0		;FORM LEFT STRING ADDRESS
1$:	CMP	R1,#1		;RIGHT ARG NULL ?
	BEQ	2$
	ADD	#10,R1		;FORM RIGHT STRING ADDRESS
2$:	RETURN
;
;
; CNV2 - CONVERT 2 STACKED OPERANDS
; INPUT:	R1	MODE FOR CONVERSION
;	 	(SP)	RETURN ADDRESS
;		2(SP)	CALLER RETURN ADDRESS
;		4(SP)	RIGHT OPERAND ADRRESS (OR 1)
;		6(SP)	LEFT OPERAND ADDRESS (OR 1)
;
CNV2:	MOV	6(SP),R0	;GET LEFT OPERAND
	CMP	R0,#1		;IS IT NULL
	BEQ	1$
	CALL	CONVRT
	BCS	3$
	MOV	R0,6(SP)	;REPLACE CONVERTED LEFT OPERAND
1$:	MOV	4(SP),R0	;GET RIGHT OPERAND
	CMP	R0,#1		;IS IT NULL
	BEQ	2$
	CALL	CONVRT
	BCS	3$
	MOV	R0,4(SP)	;REPLACE CONVERTED RIGHT OPERAND
2$:	MOV	6(SP),R0	;GET LEFT ARGUMENT ADDRESS
	MOV	4(SP),R1	;GET RIGHT OPERAND ADDRESS
3$:	RETURN
;
;
MDIV0:	.ASCII	<CR>/CLONE -- DIVISION BY ZERO/<LF><0>
MOVFLO:	.ASCII	<CR>/CLONE -- INTEGER OVERFLOW/<LF><0>
	.EVEN
;
.PAGE
; BEGIN AND END - CREATE AND DELETE STACK FRAMES.
;
; THE STACK IS A LINKED LIST OF STACK-FRAME ITEMS
; ALLOCATED ON THE STACK.
; FRAME OFFSETS ARE:
SF.BKW==6	;PREVIOUS FRAME POINTER
SF.STB==4	;END OF SYMBOL TABLE FOR THIS RANGE
SF.VAL==2	;VALUE OF CURRENT BLOCK
SF.CTX==0	;VALUE CONTEXT OF CURRENT BLOCK
SF.SIZ==10	;SIZE OF FRAME IN BYTES
;
; BEGIN - CREATE A STACK FRAME
; ON RETURN R5=ADDRESS OF FRAME
;	SF.BFW,SF.STB ARE INITIALISED
;	SF.VAL,SF.CTX ARE CLEARED
;
BEGIN::	SUB	#SF.SIZ,SP	;CLAIM THE STACK SPACE
	MOV	SF.SIZ(SP),(SP)	;COPY RETURN ADDRESS UP
	MOV	SP,R5		;GET FRAME ADDRESS
	TST	(R5)+		;'POP' RETURN ADDRESS
	MOV	R1,-(SP)
	MOV	STREAM,R1	;GET STREAM ADDRESS
	MOV	BLOCKP,SF.BKW(R5);SET REVERSE POINTER
	MOV	SL.STB+4(R1),SF.STB(R5);SET END OF SYMBOL RANGE
	MOV	R5,BLOCKP	;AND SET CURRENT FRAME
	CLR	SF.VAL(R5)	;CLEAR VALUE LOCATION
	CLR	SF.CTX(R5)	;AND CONTEXT LOCATION
	INC	SL.LEV(R1)	;BUMP LEXICAL LEVEL
	MOV	(SP)+,R1
	RETURN
;
;
;
; END - REMOVE A STACK FRAME
; ON RETURN:	R0=BLOCK VALUE
;		R1=BLOCK CONTEXT
;
END::	MOV	R2,-(SP)
	MOV	R5,-(SP)
	MOV	STREAM,R1	;GET CURRENT STREAM ADDRESS
	DEC	SL.LEV(R1)	;DECREMENT LEXICAL LEVEL
	MOV	BLOCKP,R5	;GET CURRENT STACK FRAME
	MOV	SF.BKW(R5),BLOCKP;RESET POINTER TO PREVIOUS
	MOV	R1,R2		;FORM STB LISTHEAD
	ADD	#SL.STB,R2
	MOV	4(R2),R0	;GET STB POINTER
1$:	CMP	R0,SF.STB(R5)	;END OF THIS RANGE ?
	BEQ	3$
	MOV	(R0),R0		;GET VALUE ITEM
	CMP	(R0),R0		;CHECK FOR INDIRECT REFERANCE
	BNE	2$		;DO NOT DEALLOCATE IF IT IS
	CALL	FREESP		;DEALLOCATE
2$:	CALL	REMNAM		;DELETE ENTRY
	BR	1$
3$:	MOV	SF.VAL(R5),R0	;RETURN BLOCK VALUE
	MOV	SF.CTX(R5),R1	;AND CONTEXT FLAG
	MOV	(SP)+,R5
	MOV	(SP)+,R2
	MOV	(SP),SF.SIZ(SP);SHIFT DOWN RETURN ADDRESS
	ADD	#SF.SIZ,SP	;POP THE FRAME
	RETURN
;
;
; STKCHK - CHECK FOR STACK OVERFLOW
;
; INPUT:	SP=USER STACK POINTER
;		SL.STK=USER STACK LIMIT
;
; OUTPUT:	IF WITHIN 30. WORD OF THE LIMIT
;		REPORT AN ERROR AND STOP PROGRAM
;
STKCHK::MOV	R0,-(SP)
	MOV	STREAM,R0
	MOV	SL.STK(R0),R0	;GET STACK ITEM POINTER
	ADD	#64.,R0		;ALLOW A MARGINE OF ERROR
	CMP	SP,R0		;ARE WE STILL ABOVE LIMIT ?
	BHI	1$		;YES WE ARE
	ERROR$	#E.STAK,FATAL
	SEC
	BR	2$
1$:	CLC
2$:	MOV	(SP)+,R0
	RETURN
;
;
; STKUSE - RETURN WORDS OF STACK IN USE
;
; OUTPUT:	R3	WORDS OF USER STACK IN USE
;
; REGISTERS DESTROYED:	R1
;
STKUSE::MOV	STREAM,R1
	MOV	SL.STK(R1),R1	;GET STACK ITEM
	MOV	2(R1),R3	;GET LENGTH IN WORDS
	ASL	R3		;CONVERT TO BYTES
	ADD	R1,R3		;POINT TO BASE OF STACK
	SUB	SP,R3		;GET WHATS IN USE
	ASR	R3		;IN WORDS
	RETURN
;
;
;
; THE FOLLOWING ROUTINES LOG TRANSACTIONS CONDITIONALY ON
; THE STATE OF THE PF.LOG BIT IN THE PROCESS FLAGS WORD.
; THE ACTUAL LOGING ROUTINES ARE CONTAINED IN OVERLAY
; SEGMENT LOGOVL.
;
; LOGRPY - LOG A REPLY TRANSACTION
; INPUT:	R0=ITEM BEING REPLIED
;		R2=REQUEST DESCRIPTOR
; ALL REGISTERS PRESERVED
;
LOGRPY::CALL	LOGIT
	CALLR	LGRPY
;
;
; LOGCAL - LOG A SUBROUTINE CALL
; INPUT:	R2=MACRO NAME STRING POINTER
;
LOGCAL::CALL	LOGIT
	CALLR	LGCAL
;
; LOGRTN - LOG RETURN FROM SUBROUTINE
; INPUT:	R2=MACRO NAME STRING POINTER
;
LOGRTN::CALL	LOGIT
	CALLR	LGRTN
;
;
; LOGMCR - LOG A REPLY TO MCR
; INPUT:	R2=REPLY TEXT ADDRESS
;
LOGMCR::CALL	LOGIT
	CALLR	LGMCR
;
;
; LOGREC - LOG A RECORD REQUEST
; INPUT:	R0=RECORD ITEM
;		R1=NAME STRING ADDRESS
;
LOGREC::CALL	LOGIT
	CALLR	LGREC
;
;
; INTERNAL ROUTINE TO TEST FOR LOG ENABLE.
; RETURN OCCURES ONLY IF LOG IS ENABLED FOR PROCESS.
;
LOGIT:	MOV	R0,-(SP)
	MOV	PROC,R0		;GET CURRENT PROCESS
	BIT	#PF.LOG,PL.FLG(R0) ;TEST FOR LOG ENABLED
	BNE	1$		;SKIP IF LOG ENABLED
	MOV	(SP)+,R0	;ELSE RETORE R0
	TST	(SP)+		;POP RETURN ADDRESS
	RETURN			;RETURN TO TRANSACTON PROCESSOR
;
1$:	MOV	(SP)+,R0	;RESTORE R0
	RETURN
;
.PAGE
; CONVRT - MODE CONVERSION ROUTINE
;
; INPUT:	R0=VALUE POINTER TO CONVERT
;		R1=TARGET MODE
;
; OUTPUT:	R0=NEW VALUE POINTER,OR ZERO IF CONVERSION FAILS
;		C=0 IF CONVERSION SUCCEDES ELSE C=1
;		A TEMPORARY VALUE SPECIFIED ON INPUT
;		IS DE-ALLOCATED BY THE CONVERSION PROCESS.
;		IF A CONVERSION ERROR OCCURES THE INPUT IS
;		NOT DE-ALLOCATED.
;		PERMENANT VALUES ON INPUT ARE NEVER DE-ALLOCATED.
; REGISTERS R2,R3,R4,R5 PRESERVED
;
; MODES SUPPORTED ARE:	M.UDF	UNDEFINED VALUE
;			M.STR	STRING
;			M.INT	INTEGER (BINARY) VALUE
;			M.BOO	BOOLEAN (BINARY) VALUE
;
; THE CONVERSION TABLE CNVTAB PROVIDES THE ADDRESS OF
; A ROUTINE TO CONVERT THE COLUMN TYPE TO THE ROW TYPE.
;
;		UDF	STR	INT	BOO	ASK
CNVTAB:	.WORD	CERROR,	CERROR,	CERROR,	CERROR,	CERROR	;UDF
	.WORD	CUDEF,	CSAME,	CNUSTR,	CBOSTR,	CERROR	;STR
	.WORD	CUDEF,	CSTNUM,	CSAME,	CERROR,	CERROR	;INT
	.WORD	CUDEF,	CSTBOO,	CNUBOO,	CSAME,	CERROR	;BOO
CNVLEN=.-CNVTAB
;
;
;
CONVRT::TST	R0		;IS VALUE TO CONVERT NULL
	BEQ	CNVDON		;IF SO QUIT
	CMP	R0,(R0)		;CHECK ARGUMENT VALIDITY
	BEQ	1$
	ERROR$	#E.ITC,FATAL	;CRASH THE STREAM
	BR	CNVERR
1$:	CMP	6(R0),R1	;CONVERSION REQUIRED ?
	BEQ	CNVDON		;QUIT IF NOT
	MOV	R0,-(SP)	;SAVE ARGS
	MOV	R1,-(SP)
	MUL	#5.,R1		;INDEX TABLE
	ADD	6(R0),R1
	ASL	R1
	BMI	2$		;CHECK INDEX RANGE
	CMP	R1,#CNVLEN
	BLE	CNV
;
2$:	ADD	#4,SP
	ERROR$	#E.ITC,FATAL
	BR	CNVERR
;
CNV:	CALL	@CNVTAB(R1)	;GO CONVERT
	TST	R0		;SUCCESS ?
	BNE	CNV1		;IF SO FORGET PREVIOUS VALUE
	MOV	(SP)+,R1	;RESTORE MODE REQUIRED
	MOV	(SP)+,R0	;AND INPUT VALUE
CNVERR:	CLR	R0		;ELSE CONVERSION FAILED
	SEC
	RETURN
;
CNV1:	MOV	R0,R1		;SAVE RESULT
	MOV	2(SP),R0	;GET BACK INPUT ARGUMENT
	CALL	VOIDSP		;AND RELEASE IT
	MOV	R1,R0		;RESTORE RESULT
	MOV	(SP)+,R1	;AND TARGET MODE
	TST	(SP)+		;POP INPUT ARG
	BR	CONVRT		;AND GO SEE IF CONVERSION IS COMPLETE
;
CNVDON:	CLC			;FLAG SUCCESS
	RETURN
;
;
; NOTHING TO DO
CSAME:	RETURN
;
; CONVERT AN 'ASK'
CASSTR:
CASNUM:
CASBOO:	MOV	R2,-(SP)
	MOV	R0,R2		;FORM PROMPT POINTER
	ADD	#10,R2
	CLR	R1		;NO NAME
	MOV	#M.STR,R0	;SET MODE
	CALL	RQST		;DO INPUT
	MOV	R0,R1		;SAVE NEW VALUE
	MOV	6(SP),R0	;GET BACK ASK ITEM
	TST	2(R0)		;IS IT PERMENANT ?
	BEQ	1$		;IF NOT THINGS ARE EASY
	MOV	R1,@4(R0)	;ELSE UPDATE SYMBOL TABLE
	MOV	4(R0),4(R1)	;AND OWNER POINTER
	CLR	4(R0)		;RELEASE IT
1$:	MOV	R1,R0		;RESTORE RESULT
	MOV	(SP)+,R2
	RETURN
;
;
CERROR:	ERROR$	#E.ITC	
	CLR	R0
	RETURN
;
CUDEF:	ERROR$	#E.UND	
	CLR	R0
	RETURN
;
;
; NOW THE ACTUAL CONVERSIONS
;
; CONVERT A STRING TO A NUMBER (INTEGER)
;
;
CSTNUM:	MOV	R1,-(SP)
	MOV	R2,-(SP)
	ADD	#10,R0		;POINT TO STRING
1$:	CMPB	(R0)+,#SPACH	;STRIP LEADING SPACES
	BEQ	1$
	DEC	R0
	MOV	#1,-(SP)	;PUSH SIGN FLAG
	CMPB	(R0),#'+	;AND TEST SIGN
	BEQ	2$
	CMPB	(R0),#'-
	BNE	3$
	NEG	(SP)		;SET VALUE NEGATIVE
2$:	INC	R0		;SKIP SIGN CHARACTER
;
3$:	CLR	R1		;INIT ACCUMULATOR
;
10$:	TSTB	(R0)		;END OF STRING ?
	BEQ	20$		;IF SO QUIT
	CMPB	(R0),#SPACH
	BEQ	20$
	CMPB	(R0),#'.	;ALLOW DECIMAL POINT AS TERMINATOR
	BEQ	20$
	MOVB	(R0)+,R2
	SUB	#'0,R2
	BLT	19$		;ILLEGAL CHARACTER
	CMP	R2,#9.
	BGT	19$
	MUL	#10.,R1
	BCS	19$		;OVERFLOW
	ADD	R2,R1
	BVS	19$		;OVERFLOW
	BR	10$		;AND BACK FOR MORE
;
19$:	CLR	R0		;HERE STRING WAS NOT A VALID NUMBER
	BR	30$
;
20$:	TST	(SP)		;SET SIGN OF VALUE
	BPL	21$
	NEG	R1
21$:	MOV	R1,R2		;COPY VALUE
	CALL	NUMVAL		;ALLOCATE A NUMERIC ITEM
30$:	TST	(SP)+		;POP SIGN FLAG
	MOV	(SP)+,R2
	MOV	(SP)+,R1
	RETURN
;
;
; CONVERT NUMBER TO STRING
;
CNUSTR:	MOV	R1,-(SP)
	MOV	R2,-(SP)
	MOV	10(R0),R1	;GET BINARY VALUE
	MOV	#NBUF,R0	;POINT TO CONVERSION BUFFER
	CLR	R2		;LEADING ZERO SUPRESSION FLAG
	CALL	$CBDSG		;CONVERT BINARY TO DECIMAL SIGNED
	CLRB	(R0)+		;TERMINATE STRING
	MOV	#NBUF,R2	;RESET BUFFER POINTER
	CALL	STRLEN		;GET LENGTH
	CALL	STRLIT		;CREATE A NEW STRING ITEM
	MOV	(SP)+,R2
	MOV	(SP)+,R1
	RETURN
;
NBUF:	.BLKW	4
;
;
; CONVERT NUMBER TO BOOLEAN
;	0	->FALSE
;	!=0	->TRUE
;
CNUBOO:	MOV	R2,-(SP)
	MOV	10(R0),R2	;GET NUMERIC VALUE
	BEQ	1$		;SKIP IF FALSE
	MOV	#1,R2		;ELSE SET TRUE
1$:	CALL	BOOVAL		;ALLOCATE A BOOLEAN VALUE
	MOV	(SP)+,R2
	RETURN
;
;
; CONVERT BOOLEAN TO STRING
;
CBOSTR:	MOV	R2,-(SP)
	MOV	#2,R1		;ASSUME 'NO'
	MOV	#NOSTR,R2
	TST	10(R0)		;TEST BOOLEAN
	BEQ	1$		;SKIP IF FALSE
	INC	R1		;CHANGE TO 'YES'
	MOV	#YESSTR,R2
1$:	CALL	STRVAL
	MOV	(SP)+,R2
	RETURN
;
NOSTR:	.ASCII	/NO/
YESSTR:	.ASCII	/YES/
	.EVEN
;
;
; CONVERT STRING TO BOOLEAN
; ANY TEXT STARTING WITH 'Y' IS TRUE.
; A NULL STRING OR TEXT STARTING WITH 'N' IS FALSE.
; NUMERIC VALUES ARE PASSED TO CNUBOO.
;
CSTBOO:	MOV	#M.NUM,R1	;TRY FOR A NUMBER
	CALL	CONVRT
	BCS	1$		;SKIP IF THAT FAILS
	MOV	R0,4(SP)	;SAVE NUMERIC VALUE
	BR	CNUBOO		;AND GO CONVERT THAT
;
1$:	MOV	4(SP),R0	;RESTORE THE STRING ITEM
	MOV	R2,-(SP)
	MOVB	10(R0),R1	;GET FIRST CHARACTER
	CMPB	R1,#LOWY	;TRY FOR 'YES'
	BEQ	10$
	CMPB	R1,#'Y
	BEQ	10$
	CMPB	R1,#LOWN	;TRY FOR 'NO'
	BEQ	20$
	CMPB	R1,#'N
	BEQ	20$
	TSTB	R1		;OR NULL STRING
	BEQ	20$
	CLR	R0		;ELSE ITS AN ERROR
	BR	31$
10$:	MOV	#1,R2		;INIT RESULT TO TRUE
	BR	30$
20$:	CLR	R2
30$:	CALL	BOOVAL		;ALLOCATE A BOOLEAN VALUE ITEM
31$:	MOV	(SP)+,R2
	RETURN
;
;
;+
;
; INTGER - FORCE A VARIABLE TO BE INTEGER
; INPUT:	R0	- VALUE ITEM POINTER
; OUTPUT:	R0	- VALUE ITEM POINTER (MAYBE UPDATED)
;
; IF A PERMENANT ITEM IS CONVERTED ITS VALUE ITEM IS REPLACED
; WITH THE NEW INTEGER ITEM.
;
; REGISTERS DESTROYED:	NONE
;
;-
INTGER::TST	R0		;IGNORE NULL INPUT
	BEQ	5$
	TST	EXEC		;OR DUMMY EXECUTION
	BNE	5$
	MOV	R1,-(SP)
	MOV	4(R0),-(SP)	;SAVE ITEM STB ADDRESS
	MOV	#M.NUM,R1
	CALL	CONVRT		;DO THE CONVERSION
	BCS	10$
	MOV	(SP)+,R1	;GET BACK STB POINTER
	BEQ	2$		;SKIP IF TEMPORARY ITEM
	CMP	(R1),R0		;RE-ALLOCATED ITEM ?
	BEQ	2$		;NO
	MOV	R0,-(SP)	;SAVE NEW ITEM
	MOV	(R1),R0		;GET OLD VALUE ITEM
	CALL	FREESP		;DE-ALLOCATE
	MOV	(SP)+,R0	;RESTORE NEW ITEM
	MOV	R0,(R1)		;SET NEW ITEM ADDRESS
	MOV	R1,4(R0)	;AND SET OWNER POINTER
2$:	MOV	(SP)+,R1
5$:	RETURN
;
10$:	ERROR$	#E.IIV
	CLR	R0
	TST	(SP)+
	BR	2$
;
;
	.END