; FUNOVL - CLONE INTERNAL FUNCTION OVERLAY
; LAST EDIT:	12-NOV-81
;
.TITLE	FUNOVL
;
TEXT$	ON
;
; THIS MODULE CONTAINS THE INTERNAL FUNCTION EVALUATOR FOR CLONE. INTERNAL
; FUNCTION CALLS CONSIST OF THE FUNCTION NAME OPTIONALY FOLLOWED BY AN
; ARGUMENT LIST.
;
; INPUT:	R0	FUNCTION CODE
;		R3	ARGUMENT BLOCK POINTER
;
; OUTPUT:	C CLEAR
;			R0=FUNCTION RESULT
;		C SET
;			R0=ERROR CODE
;
;		THE ARGUMENT BLOCK IS DEALLOCATED
;
;
; REGISTERS DESTROYED:	ALL
;
;
; AS THIS MODULE IS INTENDED TO BE OVERLAYED IT MUST NOT CALL ANY OF THE
; ROUTINES WHICH PERFORM A STREAM CONTEXT SWITCH, NOR MAY IT GENERATE AN
; ERROR MESSAGE DIRECTLY.
;
;
TEXT$	OFF
;
.PSECT	FUNOVL
;
DOFUN::	MOV	R3,ARGLST	;SAVE THE ARGUMENT LIST
	TST	R0		;CHECK FUNCTION IS VALID
	BMI	1$
	CMP	R0,#MAXFUN
	BLT	2$
1$:	TRAP			;CRASH
;
2$:	JMP	@FUNTB(R0)	;GO EXECUTE FUNCTION
;
FUNTB:	TBLDF$	FNUL,F.NUL,START
	TBLDF$	FLEN,F.LEN
	TBLDF$	FLOC,F.LOC
	TBLDF$	FSEG,F.SEG
	TBLDF$	FDEF,F.DEF
	TBLDF$	FNARG,F.NARG
MAXFUN=.-FUNTB
;
;
;
; FNUL - NULL FUNCTION
;
FNUL:	CLR	R0
	JMP	FUNEXT
;
;
; FLEN - FIND THE LENGTH OF A STRING
;
FLEN:	MOV	#1,R1		;GET ARGUMENT 1
	CALL	GETSTR		;AS A STRING
	BCS	BADARG		;SOME SORT OF ERROR
	MOV	R0,R2		;COPY VALUE ADDRESS
	CALL	STRLEN		;HOW LONG IS IT
	DEC	R1		;DISCOUNT ZERO BYTE
	MOV	R1,R2		;COPY LENGTH
	CALL	NUMVAL		;CREATE NUMERIC RESULT
	JMP	FUNEXT
;
;
; FLOC - LOCATE A SUBSTRING WITHIN A STRING
;
;	$LOC(STR1,STR2)
;
; RETURNS INDEX OF SUBSTRING STR1 WITHIN STR2. ZERO IF NOT FOUND
;
FLOC:	MOV	#1,R1		;GET FIRST ARGUMENT AS A STRING
	CALL	GETSTR
	BCS	BADARG
	MOV	R0,R3		;SAVE STR1 IN R3
	MOV	#2,R1		;GET SECOND ARG
	CALL	GETSTR
	BCS	BADARG
	MOV	R0,R4		;SAVE STR2 IN R4
;
1$:	MOV	R3,R1		;RESTORE STR1
	MOV	R4,R2		;RESTORE STR2
	TSTB	(R2)		;END OF STRING 2
	BEQ	11$
2$:	TSTB	(R1)		;END OF STR1 ?
	BEQ	10$		;THIS IS A MATCH
	CMPB	(R1)+,(R2)+	;COMPARE CHARACTERS
	BEQ	2$		;KEEP TESTING IF THEY MATCH
	INC	R4		;UPDATE STR2 POINTER
	BR	1$		;AND GO TRY AGAIN
;
10$:	MOV	R4,R2		;GET STR2 START
	SUB	R0,R2		;FORM OFFSET
	INC	R2		;STARTING AT 1
	BR	12$
;
11$:	CLR	R2
12$:	CALL	NUMVAL
	JMP	FUNEXT
;
;
; FSEG - CREATE A SUB-STRING FROM A STRING
;
;	$SEG(STR1,P1,P2)
;
; RETURNS SUBSTRING IN INDEX RANGE P1 TO P2 FROM STR1
;
; DEFAULT FOR P1 IS 1
; DEFAULT FOR P2 IS LENGTH OF STR1
;
FSEG:	MOV	#1,R1		;GET FIRST ARG AS A STRING
	CALL	GETSTR
	BCS	BADARG
	MOV	R0,R2		;COPY ADDRESS
	MOV	R1,R4		;AND SAVE AS DEFAULT FOR P3
	MOV	#1,R0		;DEFAULT FOR P2
	MOV	#2+DEF,R1	;GET SECOND ARG WITH DEFAULTS
	CALL	GETNUM
	BCS	BADARG
	MOV	R0,R3		;SAVE P2
	BGT	1$		;SKIP IF ITS IN RANGE
	MOV	#1,R3		;ELSE JUST SET TO DEFAULT
1$:	MOV	#32767.,R0	;GIVE AN ENORMOUS DEFAULT FOR P3
	MOV	#3+DEF,R1	;GET THIRD ARG WITH DEFAULTS
	CALL	GETNUM
	BCS	BADARG
	MOV	R0,R4		;GET P3 VALUE
	CALL	STRLEN		;GET STRING LENGTH
	DEC	R1		;WITHOUT ZERO BYTE
	CMP	R4,R1		;CHECK LENGTH IS IN RANGE
	BLE	2$
	MOV	R1,R4
2$:	DEC	R3		;FORM INDEX
	ADD	R3,R2		;OFFSET TO START OF SUB-STRING
	MOV	R4,R1		;COPY END INDEX
	SUB	R3,R1		;FORM LENGTH
	CALL	STRLIT		;CREATE A STRING LITERAL
	BR	FUNEXT
;
;
; FDEF - TEST IF A VARIABLE IS DEFINED
;
;	$DEF(VAR)
;
FDEF:	MOV	ARGLST,R0	;GET THE ARGUMENT LIST
	BEQ	2$		;ERROR IF NULL
	CMP	AB.CNT(R0),#1	;CHECK WE HAVE ONE ARGUMENT
	BNE	2$
	MOV	AB.ARG(R0),R0	;GET IT
	BEQ	2$		;ERROR IF IT IS NULL
	MOV	#1,R2		;ASSUME TRUE
	CMP	6(R0),#M.UDF	;IS VALUE UNDEFINED
	BNE	1$
	CLR	R2		;IF SO SET FALSE
1$:	CALL	BOOVAL		;CREATE A BOOLEAN RESULT
	JMP	FUNEXT
;
2$:	MOV	#E.BFA,R0	;BAD FUNCTION ARGUMENT
	BR	BADARG
;
;
; FNARG - OBTAIN NUMBER OF SUBROUTINE ARGUMENTS
;
;	$NARG
;
FNARG:	MOV	STREAM,R1	;GET THE CURRENT STREAM
	MOV	SL.CLH(R1),R1	;AND GET CONTROL DESCRIPTOR
	CLR	R2		;ASSUME NO ARGUMENTS
	MOV	CD.ARG(R1),R1	;GET ARGUMENT BLOCK
	BEQ	1$		;SKIP IF NULL
	MOV	AB.CNT(R1),R2	;ELSE GET NUMBER OF ARGUMENTS
1$:	CALL	NUMVAL		;RETURN A NUMERIC RESULT
	JMP	FUNEXT
;
;
; BADARG - EXIT WITH A BAD ARGUMENT LIST
;
BADARG:	MOV	ARGLST,R3	;GET BACK THE ARGUMENT LIST POINTER
	CALL	ENDARG		;DEALLOCATE THE ARGUMENT LIST
	SEC
	RETURN
;
;
; FUNEXT - EXIT FROM FUNCTION PROCESSING
;
FUNEXT:	MOV	ARGLST,R3		;GET BACK THE ARGUMENT LIST
	CALL	ENDARG			;DE-ALLOCATE THE ARGUMENT BLOCK
	CLC
	RETURN
;
;
; GETNUM - GET A NUMERIC ARGUMENT
;
; INPUT:	R0	DEFAULT VALUE
;		R1	LOW BYTE=ARGUMENT NUMBER
;			HIGH BYTE CONTAINS FLAGS:
;				DEF ENABLE DEFAULT VALUE
;
; OUTPUT:	C CLEAR
;			R0 CONTAINS NUMERIC VALUE
;		C SET
;			ERROR, R0 CONTAINS ERROR CODE.
;
; REGISTERS MODIFIED:	R0,R1
;
;
; DEF IS A WORD VALUE WHICH SHOULD BE ORED INTO THE ARGUMENT NUMBER TO
; ENABLE DEFAULT NUMERIC VALUES. IF DEF IS NOT SET AND AN ARGUMENT IS NULL
; AN ERROR IS GENERATED. AN UNDEFINED ARGUMENT WILL ALWAYS GENERATE AN ERROR.
;
DEF=400
; 
GETNUM:	MOV	R2,-(SP)
	MOV	R3,-(SP)
	MOV	R4,-(SP)
	MOV	#M.NUM,R4	;SET REQUIRED ARGUMENT MODE
	BR	GETARG
;
;
; GETSTR - GET AN ARGUMENT AS A STRING
;
; AS GETNUM EXCEPT THAT DEFAULTS ARE NOT PERMITTED.
;
GETSTR:	MOV	R2,-(SP)
	MOV	R3,-(SP)
	MOV	R4,-(SP)
	MOV	#M.STR,R4
;
GETARG:	MOV	ARGLST,R2	;GET THE ARGUMENT BLOCK POINTER
	BEQ	11$		;RETURN ERROR IF NULL
	MOVB	R1,R3		;GET ARGUMENT NUMBER
	CMP	R3,AB.CNT(R2)	;IS ARGUMENT PRESENT ?
	BGT	10$		;SKIP IF NOT
	DEC	R3		;OFFSET TO ARGUMENT POINTER
	ASL	R3
	ADD	R3,R2
	ADD	#AB.ARG,R2
	MOV	(R2),R3		;GET THE ARGUMENT POINTER
	BEQ	10$		;SKIP IF NULL
	CMP	6(R3),#M.UDF	;IS ARGUMENT UNDEFINED
	BNE	1$		;IF SO THATS OK
	MOV	#E.UND,R0	;UNDEFINED VARIABLE
	BR	20$
1$:	MOV	R3,R0		;COPY ITEM ADDRESS
	MOV	R4,R1		;SET THE CONVERSION MODE
	CALL	CONVRT
	MOV	R0,(R2)		;RESTORE TO ARGUMENT LIST
	ADD	#10,R0		;POINT TO START OF ITEM
	CMP	R4,#M.STR	;STRING REQUESTED ?
	BEQ	30$		;IF SO JUST RETURN
	MOV	(R0),R0		;ELSE RETURN NUMERIC VALUE
	BR	30$
;
10$:	BIT	#DEF,R1		;ARE DEFAULTS ENABLED
	BNE	30$		;IF SO JUST RETURN WITH VALUE IN R0
11$:	MOV	#E.BFA,R0	;BAD FUNCTION ARGUMENT LIST
;
20$:	SEC
	BR	31$
;
30$:	CLC
31$:	MOV	(SP)+,R4
	MOV	(SP)+,R3
	MOV	(SP)+,R2
	RETURN
;
;
ARGLST:	.WORD	0
;
;
	.END