; CL1SYN - CLONE SYNTAX MODULE
; LAST EDIT:	12-NOV-81
.NLIST
.LIST	TTM
.NLIST	BEX
.TITLE	CL1SYN
.LIST
;
; THIS MODULE CONTAINS THE ENTRY VALEXP WHICH IS THE CLONE LANGUAGE PARSER
;
.PSECT	CL1SYN
;
;
;
; DEFINE OPERATION CODES AND THEIR PARSING PRIORITY
; THE CODES ARE ASSOCIATED WITH THEIR SYMBOLS IN CL1LEX
; AND WITH THEIR PROCESSING ROUTINES IN DOOP IN CL1FUN
;
; OPDEF - MACRO TO SET CODES AND DEFINE PRIORITY TABLES.
.MACRO	OPDEF	CODE,LPRI,RPRI
	CODE==..OPP
	..OPP=..OPP+2
	.BYTE	LPRI
	.BYTE	RPRI
.ENDM
;
LPRI=.		;LEFT PRIORITIES ARE WORD INDEXED FROM HERE
RPRI=.+1	;AND RIGHT PRIORITIES FROM HERE
..OPP=0		;OPCODES INCREMENT BY TWO FROM ZERO
;
; FIRST 4 SPECIAL OPERATORS
OPDEF	O.VOID,0,0	;VALEXP CODE FOR VOID, POSSIBLY NULL EXPRESSIONS
OPDEF	O.VALU,0,0	;VALEXP CODE FOR VALUED, POSSIBLY NULL EXPRS.
OPDEF	O.BIND,0,0	;VALEXP CODE FOR VOID NON-NULL EXPRS.
OPDEF	O.VAL2,0,0	;VALEXP CODE FOR VALUED, NON-NULL EXPRS.
;
OPDEF	O.ASS,100,0	;ASSIGNMENT
OPDEF	O.ADD,4,5	;ADDITION
OPDEF	O.SUB,4,5	;SUBTRACTION
OPDEF	O.MUL,6,7	;MULTIPLICATION
OPDEF	O.DIV,6,7	;DIVISION
OPDEF	O.PLUS,0,100	;PREFIX PLUS
OPDEF	O.NEG,0,100	;PREFIX NEGATION
OPDEF	O.CON,4,5	;STRING CONCATENATION
OPDEF	O.EQ,2,3	;EQUALITY
OPDEF	O.NEQ,2,3	;INEQUALITY
OPDEF	O.GT,2,3	;GREAER THAN
OPDEF	O.GEQ,2,3	;GREATER THAN OR EQUAL TO
OPDEF	O.LT,2,3	;LESS THAN
OPDEF	O.LEQ,2,3	;LESS THAN OR EQUAL TO
OPDEF	O.NOT,0,1	;LOGICAL COMPLIMENT
OPDEF	O.OR,1,2	;LOGICAL OR
OPDEF	O.AND,1,2	;LOGICAL AND
OPDEF	O.IDEN,2,3	;STRING IDENTITY
OPTBLN==.-LPRI
;
;
.PAGE
; VALEXP - EXPRESSION EVALUATOR
;
; THIS ROUTINE IS A RECURSIVE EXPRESSION EVALUATOR DRIVEN
; BY OPERATOR PRECEDENCE.
; INPUT:	R1=CODE OF OPERATOR SEEKING A RIGHT OPERAND
; OUTPUT:	R0=RESULT OF RIGHT OPERAND EXPRESSION
;		   OR NULL IF VOID.
;
; REGISTERS DESTROYED:	R1,R4,R5
;
; THE ROUTINE DOOP IS CALLED TO PERFORM THE ACTUAL OPERATIONS.
;
;
VALEXP::CALL	STKCHK		;CHECK FOR STACK OVERFLOW
	BCC	1$
	CLR	R0		;IF LIMIT RETURN
	RETURN
;
1$:	MOV	R2,-(SP)	;SAVE REGISTERS
	MOV	R3,-(SP)
;
	MOV	R1,-(SP)	;SAVE CONTEXT
	PAUSE$	#TS.RUN		;PERMIT AN INTERRUPT
;
;	(SP) -	CONTEXT IN WHICH THIS EXPRESSION IS TO BE PARSED
;
GVAL:	CALL	GETSYM		;READ NEXT VALUE
	CMP	R1,#LEXOPP	;IS IT AN OPERATOR
	BNE	3$
	TSTB	LPRI(R0)	;IF SO IT MUST BE PREFIX
	BEQ	2$		;ZERO LPRI SO IT IS
	CMP	R0,#O.ADD	;ELSE IT COULD BE '+'
	BNE	1$
	MOV	#O.PLUS,R0	;CHANGE TO UNARY FORM
	BR	2$
1$:	CMP	R0,#O.SUB	;OR IT COULD BE '-'
	BNE	11$		;IF NOT THERES TROUBLE: ERROR
	MOV	#O.NEG,R0
2$:	MOV	R0,R2		;SAVE OP-CODE
	MOV	R0,R1		;SET CONTEXT
	CALL	VALEXP		;EVALUATE OPERAND
	MOV	R0,R1		;SET RIGHT OPERAND
	MOV	#1,R0		;SET DUMMY LEFT OPERAND
	CALL	DOOP		;EVALUATE PREFIX OPERATION
	BR	10$		;GO GET NEXT OPERATOR
;
3$:	CMP	R1,#LEXVAL	;CHECK WEVE GOT A VALUE
	BEQ	10$		;IF SO GET OPERATOR
	CMP	R1,#LEXCMD	;COMMAND SYMBOL ?
	BNE	4$
	MOV	(SP),R1		;SET CONTEXT FOR PRSCMD
	CALL	PRSCMD
	BR	10$
;
4$:	CMP	R1,#LEXMAC	;MACRO NAME ?
	BNE	12$
	MOV	(SP),R1		;CONTEXT FOR MACRO PARSE
	CALL	CALLIT
	BR	10$
;
12$:	CMP	R1,#LEXFUN	;CLONE INTRINSIC FUNCTION ?
	BNE	13$		;SKIP IF NOT
	CALL	PRSFUN		;GO PARSE IT
	BR	10$		;AND GO GET AN OPERATOR
;
13$:	CMP	R1,#LEXSUB
	BNE	5$
	CALL	DOSUB
	BR	10$
;
5$:	CMP	R1,#LEXSEP	;SEPARATOR ?
	BNE	11$		;IF NOT: ERROR
	CMP	R0,#LEXEOL	;IS IT END OF LINE
	BNE	6$
	TST	(SP)		;ARE WE BINDING SOMETHING ?
	BEQ	7$		;IF NOT RETURN NULL
	CMP	(SP),#O.VALU	;WEAK BINDING OPERATOR ?
	BEQ	7$		;AGAIN RETURN NULL
	BR	GVAL		;ELSE PARSE ANOTHER VALUE
;
; OTHER TERMINATORS ARE ONLY VALID IN TOTALY VOID CONTEXT
6$:	CALL	PTBACK		;PUT SEPARATOR BACK FOR LATER
	TST	(SP)		;AND SEE IF TERMINATION HERE IS VALID
	BNE	11$		;IF NOT: ERROR
;
7$:	CLR	R0		;RETURN NULL
	TST	(SP)+		;POP CONTEXT
	BR	EXPDON		;AND EXIT
;
10$:	MOV	(SP)+,R3	;POP THE CONTEXT VALUE
	BR	GOP		;GO GET THE OPERATOR
;
11$:	TST	(SP)+		;POP CONTEXT
	BR	EXPERR		;GO REPORT SYNTAX ERROR
;
;
; VALUES SAVED DURING PARSEING ARE STORED AS STB ADDRESSES RATHER THAN
; VALUE POINTERS. THIS PERMITS MODIFICATION OF A VALUE BY CODE HIGHER
; UP ON THE STACK. TEMPORARY VALUES DO NOT HAVE A STB ENTRY, HOWEVER
; AS THEIR FIRST WORD CONTAINS ITS OWN ADDRESS THIS MAY BE USED IN THE
; SAME WAY. TEMPORARY VALUES CANNOT BE REFERANCED TWICE AND THUS DO NOT 
; REQUIRE THIS EXTRA LEVEL OF INDIRECTION.
;
;	R3 -	CONTEXT OF PREVIOUS OPERATOR
;
GOP:	TST	EXEC		;ARE WE STILL INTERPRETING CODE
	BMI	EXPDON		;IF NOT RETURN
	MOV	R0,R2		;COPY ITEM ADDRESS
	BEQ	1$		;SKIP IF NULL
	TST	4(R2)		;IS ITEM PERMENANT
	BEQ	1$		;SKIP IF NOT
	MOV	4(R2),R2	;ELSE CREATE INDIRECTION
1$:	CALL	GETSYM		;READ AN OPERATOR
	CMP	R1,#LEXOPP	;CHECK IT WAS
	BNE	3$		;IF NOT WEVE FINISHED
	TSTB	LPRI(R0)	;CHECK ITS BINARY
	BEQ	EXPERR		;IF NOT THATS AN ERROR
	CMPB	RPRI(R3),LPRI(R0)
	BGT	3$
	MOV	R0,-(SP)	;SAVE OPERATION CODE
	MOV	R0,R1		;SET CONTEXT FOR VALEXP
	CALL	VALEXP		;CONTINUE
	MOV	R0,R1		;SET RIGHT OPERAND
	MOV	R2,R0		;GET BACK INDIRECT LEFT VALUE POINTER
	BEQ	2$		;SKIP IF NULL
	MOV	(R0),R0		;ELSE DE-REFERANCE
2$:	MOV	(SP)+,R2	;RESTORE OPCODE
	CALL	DOOP		;PERFORM OPERATION
	BR	GOP		;KEEP GOING
;
3$:	CALL	PTBACK		;PUT BACK EXPRESSION TERMINATOR
	MOV	R2,R0		;RETURN INDIRECT VALUE
	BEQ	EXPDON		;SKIP IF NULL
	MOV	(R0),R0		;ELSE DEREFERANCE
;
EXPDON:	TST	EXEC		;RETURN ZERO IF DUMMY EXECUTION
	BEQ	1$
	CLR	R0
1$:	MOV	(SP)+,R3
	MOV	(SP)+,R2
	RETURN
;
EXPERR:	ERROR$	#E.SYN	
	BR	EXPDON
;
.PAGE
; PRSCMD - PARSE A CLONE COMMAND
;
; PRSCMD INTERPRETS THOSE COMMANDS WHICH DO NOT CONFORM
; TO OPERATOR PRECEDENCE.
; INPUT:	R0=COMMAND CODE
;		R1=CONTEXT
; OUTPUT:	R0=RESULTING VALUE OR ZERO
;
; REGISTERS DESTROYED:	ALL
;
; PRSCMD CAN MANIPULATE THE JOBS EXECUTION STATUS WORD:-EXEC
; ANY VALUE GREATER THAN ZERO WILL CAUSE DUMMY EXECUTION OF THE CODE
; -VE VALUES RESULT IN A DESCENT OF THE STACK UNTIL SOME EVENT
; RESTORES AN EXECUTION STATUS.
; EXEC CODES ARE AS FOLLOWS:
EX.RUN==0	;EXECUTION IN PROGRESS
EX.FIF==1	;FALSE CONTEXT OF AN IF STATEMENT
EX.BRK==2	;BREAKING FROM A LOOP
EX.ERR==3	;DUMMY EXECUTION AFTER SYNTAX ERROR
EX.FOR==4	;DUMMY EXECUTION OF 'FOR' LIST
EX.DEF==5	;DUMMY EXECUTION OF SUBROUTINE DEFINITION
EX.LOP==-1	;UNSTACKING DOWN LOOP
EX.STP==-2	;EXECUTION STOPPED
EX.RTN==-3	;RETURN FROM SUBROUTINE
EX.FER==-4	;STREAM TERMINATION AFTER FATAL ERROR
EX.RBI==-5	;RESUME FROM BREAKIN COMMAND
;
;
PRSCMD:	CMP	R0,#MAXCMD	;CHECK CODE
	BGE	CMDERR
	JMP	@CMDTAB(R0)	;DISPATCH TO COMMAND PROCESSOR
;
CMDERR:	TRAP
;
;
CMDTAB:	TBLDF$	CMDERR,C.ERR,START	;INTERNAL ERRORS
	TBLDF$	REPLY,C.RPLY	;REPLY
	TBLDF$	PRINT,C.PRNT	;PRINT
	TBLDF$	BLOCK,C.BEG	;BLOCK PARSING
	TBLDF$	BLEND,C.END	;END OF BLOCK
	TBLDF$	IF,C.IF		;IF STATEMENT
	TBLDF$	UNLESS,C.UNL	;UNLESS STATEMENT
	TBLDF$	THEN,C.THEN	;THEN
	TBLDF$	ELSE,C.ELSE	;ELSE
	TBLDF$	REPEAT,C.RPT	;REPEAT
	TBLDF$	BREAK,C.BRK	;BREAK FROM LOOP
	TBLDF$	LOOP,C.LOOP	;LOOP TO TOP OF LOOP
	TBLDF$	STOP,C.STOP	;STOP EXECUTION
	TBLDF$	REQUST,C.RQST	;REQUEST INPUT
	TBLDF$	CALSUB,C.CALL	;CALL A SUBROUTINE
	TBLDF$	RTNSUB,C.RTN	;RETURN FROM SUBROUTINE
	TBLDF$	SUSPND,C.SUS	;SUSPEND STREAM EXECUTION
	TBLDF$	RESUME,C.RES	;RESUME FROM BREAKIN
	TBLDF$	RUNCMD,C.RUN	;RUN A TASK
	TBLDF$	SYSCMD,C.SYS	;LIST SYSTEM INFORMATION
	TBLDF$	TRACE,C.TRA	;ENABLE TRACING
	TBLDF$	NOTRCE,C.NTRA	;DISABLE TRACING
	TBLDF$	LOG,C.LOG	;ENABLE LOGGING
	TBLDF$	NOLOG,C.NLOG	;DISABLE LOGGING
	TBLDF$	TEXT,C.TXT	;ENABLE TEXT MODE
	TBLDF$	NOTEXT,C.NTXT	;DISABLE TEXT MODE
	TBLDF$	ENACMD,C.ENA	;GENERALIZED ENABLE FUNCTION
	TBLDF$	DISCMD,C.DIS	;GENERALIZED DISABLE FUNCTION
	TBLDF$	ASKCMD,C.ASK	;ASK FOR INPUT
	TBLDF$	ASKNCM,C.ASKN	;ASK FOR A NUMBER
	TBLDF$	UPDATE,C.UPD	;REBUILD SYSTEM MACRO TABLE
	TBLDF$	GETCMD,C.GET	;GET A RECORDED VALUE
	TBLDF$	GTFCMD,C.GTF	;GET A RECORDED VALUE IF ANY
	TBLDF$	DOCMD,C.DO	;DO LOOP
	TBLDF$	FORCMD,C.FOR	;FOR LOOP
	TBLDF$	MCRCMD,C.MCR	;REPLY TO MCR
	TBLDF$	INDCMD,C.IND	;INDIRECT FILE
	TBLDF$	EOFCMD,C.EOF	;END-OF-FILE
	TBLDF$	LITCMD,C.LIT	;ENABLE LITERAL MODE
	TBLDF$	CL1CMD,C.CL1	;ENABLE CLONE MODE
	TBLDF$	PASCMD,C.PASS	;PASS OVER NEXT N QUESTIONS
	TBLDF$	STKCMD,C.STAC	;LIST STACKED SYMBOL TABLE
	TBLDF$	RPYGET,C.SQB	;SUBSTITUTE VALUE FROM TASK
	TBLDF$	SQKCMD,C.SQK	;RIGHT SQUARE BRACKET
	TBLDF$	LOCAL,C.LOC	;LOCAL DECLARATION
	TBLDF$	SUBCMD,C.SUB	;SUBROUTINE DECALRATION
	TBLDF$	ARGCMD,C.ARG	;SUBROUTINE ARGUMENT DECLARATION
;
MAXCMD=.-CMDTAB
;
;
;
; REPLY - REPLY A VALUE TO A LOWER STREAM
;
;	REPLY <EXPRESSION>
;
;
REPLY:	CALL	TVOID		;CHECK CONTEXT
	MOV	#O.VAL2,R1	;BIND A VALUED EXPRESSION
	CALL	VALEXP		;EVALUATE REPLY ARGUMENT
	CALL	RPLY		;DO THE ACTUAL REPLY
	JMP	VOID
;
;
; PRINT - PRINT VALUES ON TI: CONSOLE
;
;	PRINT [VAL1][,VAL2]...
; IF THE SEPARATING CHARACTER IN A LIST IS ',' VALUES ARE SEPARATED BY TAB
;		"			   ';'		"	SPACE
;		"			   ':' VALUES ARE CONCATENATED.
;
;
PRINT:	CALL	TVOID		;CHECK CONTEXT
	TST	EXEC		;DO WE REALY PRINT ANYTHING ?
	BNE	1$
	MOV	#LF,R2
	CALL	OUT0		;OUTPUT A NEWLINE
	MOV	#O.VALU,R1	;SET WEAK BINDING
1$:	CALL	VALEXP		;READ A VALUE
	TST	EXEC
	BNE	3$
	TST	R0		;ANY RESULT
	BEQ	3$
	MOV	#M.STR,R1	;SET MODE REQUIRED
	CALL	CONVRT		;DO ANY CONVERSION
	BCS	2$
	MOV	R0,R2		
	ADD	#10,R2		;SKIP HEADER
	CALL	OUT0		;PRINT STRING
2$:	CALL	VOIDSP
3$:	CALL	GETSYM		;READ TERMINATOR
	CMP	R1,#LEXSEP
	BNE	10$		;END OF PRINT LIST
	CMP	R0,#LEXEOL
	BEQ	10$		;STOP AT END OF LINE
	CMP	R0,#LEXCOM	;TERMINATED BY COMMA ?
	BNE	5$
	MOV	#TAB,R2		;IF SO INSERT TAB
	BR	6$
5$:	CMP	#LEXSEM,R0	;SEMICOLON ?
	BNE	7$		;IF NOT JUST CONCATENTE
	MOV	#SPACE,R2	;OTHERWISE INSERT SPACE
6$:	TST	EXEC
	BNE	7$
	CALL	OUT0		;OUTPUT SEPARATING CHARACTER
7$:	MOV	#O.BIND,R1	;MUST BIND SOMETHING AFTER SEPARATOR
	BR	1$
;
10$:	CALL	PTBACK		;PUT BACK FINAL TERMINATOR
	TST	EXEC		;END OF PRINT STATEMENT
	BNE	11$
	MOV	#CR,R2
	CALL	OUT0
11$:	JMP	VOID
;
CR:	.WORD	15
LF:	.WORD	12
TAB:	.WORD	11
SPACE:	.WORD	40
;
;
; BLOCK - PARSE A CLONE BLOCK
;
;	( <EXPRESSION> <EXPRESSION> ..... )
;
; VALUED EXPRESSIONS WITHIN A VOID BLOCK ARE IMPLICIT REPLIES.
; WITHIN A VALUED BLOCK ONLY ONE VALUED EXPRESSION IS PERMITTED
; THIS BING THE BLOCK VALUE.
;
; A STACKFRAME IS ASSOCIATED WITH EACH NESTED BLOCK
; STACKFRAME OFFSETS ARE:
; SF.BKW	;PREVIOUS FRAME POINTER
; SF.STB	;SYMBOL TABLE POINTER FOR RANGE
; SF.VAL	;VALUE OF CURRENT BLOCK
; SF.CTX	;BLOCK VALUE CONTEXT
;
;
BLOCK:	CALL	BEGIN		;CREATE A STACK FRAME
	CALL	PRSBLK		;PARSE THE BLOCK
	JMP	VALUED		;AND QUIT
;
;
; PRSBLK - BLOCK PARSING ROUTINE
;
; 	THIS ROUTINE IS CALLED WITH A STACKFRAME ALREADY ESTABLISHED 
; TO PARSE A BLOCK UP TO THE BLOCK TERMINATOR AND RETURN ANY 
; VALUE IN R0.
; 	IF THE BLOCK CONTEXT IS VALUED THEN THE FIRST
; VALUED EXPRESSION DETERMINES THE BLOCK VALUE AND FURTHER
; VALUED EXPRESSIONS ARE ILLEGAL. 
; 	IF THE BLOCK CONTEXT IS VOID THEN VALUED EXPRESSIONS
; ARE IMPLICIT REPLIES EXCEPT THAT THE LAST EXPRESSION OF THE
; BLOCK IF VALUED AND IMMEDIATLY  FOLLOWED BY ')' WITH NO 
; INTERVENING SEPERATORS DETERMINES THE BLOCK VALUE.
;
; INPUT:	R1 -	BLOCK CONTEXT
;		R5 -	STACK FRAME POINTER
;
; OUTPUT:	R0 -	BLOCK VALUE (IF ANY)
;
;
; ALL REGISTERS OTHER THAN R0 DESTROYED
;
PRSBLK:	TST	R1		;VOID CONTEXT ?
	BEQ	PRS1		;SKIP IF SO
	CMP	R1,#O.BIND
	BEQ	PRS1
	MOV	#O.VALU,SF.CTX(R5) ;SET VALUED CONTEXT FOR BLOCK
PRS1:	CALL	GETSYM		;CHECK FOR END OF BLOCK
	CMP	R1,#LEXSEP	;IGNORE SEPERATORS
	BEQ	PRS1
	CMP	R1,#LEXCMD	;CHECK FOR END
	BNE	PRS2
	CMP	R0,#C.END
	BEQ	BLKDON		;GO TO END OF BLOCK ROUTINE
PRS2:	CALL	PTBACK		;UNREAD THE TERMINATOR
	CLR	R1		;INIT EXPRESSION CONTEXT
	CALL	VALEXP		;AND PARSE A STATEMENT
	MOV	BLOCKP,R5	;GET STACK FRAME POINTER
	TST	EXEC		;ARE WE STILL RUNNING
	BNE	4$
	TST	R0		;ANY RESULT
	BEQ	4$		;IF NOT SKIP
	TST	4(R0)		;TEMPORARY VALUE
	BEQ	1$		;SKIP IF SO
	CALL	CPYITM		;ELSE CREATE A COPY
	CLR	4(R0)		;TO AVOID UP-STACK REFERENCES
1$:	TST	SF.CTX(R5)	;IN VALUED CONTEXT ?
	BGT	2$		;IF SO BLOCK IS NOW VALUED
	BEQ	3$		;IF NOT JUST SAVE VALUE
	ERROR$	#E.SYN		;ELSE BLOCK HAS ALREADY BEEN DE-VALUED
	CALL	VOIDSP		;RELEASE VALUE
	BR	4$
2$:	MOV	#-1,SF.CTX(R5)	;FLAG BLOCK VALUED
3$:	MOV	R0,SF.VAL(R5)	;STORE VALUE
;
4$:	TST	EXEC		;ARE WE UNSTACKING ?
	BMI	BLKDON		;BREAK FROM BLOCK IF SO
	CALL	GETSYM		;READ EXPRESSION TERMINATOR
	CMP	R1,#LEXCMD	;CHECK FOR END OF BLOCK
	BNE	5$
	CMP	R0,#C.END	;END OF BLOCK
	BEQ	BLKDON		;IF SO GO END
5$:	CALL	PTBACK		;PUT BACK TERMINATOR
6$:	TST	SF.CTX(R5)	;VOID BLOCK ?
	BNE	7$
	MOV	SF.VAL(R5),R0	;ANYTHING TO REPLY
	BEQ	7$
	CALL	RPLY
	MOV	BLOCKP,R5	;RESTORE STACK FRAME
	CLR	SF.VAL(R5)
7$:	BR	PRS1		;AND KEEP PARSING BLOCK
;
; END OF BLOCK. UNSTACK AND RETURN
BLKDON:	MOV	(SP)+,R2	;POP OUR RETURN ADDRESS
	CALL	END		;REMOVE STACKFRAME
	TST	R1		;TEST THE CONTEXT
	BLE	11$		;VOID OR VALUED AND VALID
	TST	EXEC		;BUT ARE WE STILL RUNNING
	BNE	11$		;IF NOT VOID RESULT IS LEGAL
	ERROR$	#E.VDB		;VOID BLOCK ERROR
11$:	JMP	(R2)		;RETURN
;
;
; BLEND - UNMATCHED END
;
BLEND:	ERROR$	#E.END	
	JMP	VOID
;
;
; IF - CLONE IF STATEMENT
; UNLESS - UNLESS STATEMENT
;
;	IF <EXPRESSION> [THEN] <EXPRESSION> [ELSE <EXPRESSION>]
;	UNLESS <EXPRESSION> [THEN] <EXPRESSION> [ELSE <EXPRESSION>]
;
;
IF:	CLR	-(SP)		;INIT VALUE SAVE LOCATION
	BR	IF1
;
UNLESS:	MOV	#1,-(SP)	;INIT WITH COMPLIMENT FLAG
IF1:	CMP	R1,#O.VOID	;SET CONTEXT
	BEQ	1$
	CMP	R1,#O.VALU
	BEQ	2$
	CMP	R1,#O.BIND
	BEQ	1$
2$:	MOV	#O.VAL2,-(SP)	;RESULTS ARE VALUED
	BR	3$
1$:	MOV	#O.BIND,-(SP)	;RESULTS ARE VOID
3$:	MOV	#O.VAL2,R1	;PARSE EXPRESSION
	CALL	VALEXP
	MOV	R0,-(SP)	;SAVE RESULT
	TST	EXEC		;ARE WE ON THE AIR
	BNE	4$		;IF NOT SKIP
	MOV	#M.BOO,R1	;CONVERT RESULT
	CALL	CONVRT
	TST	R0		;SUCCEDED ?
	BNE	5$
	MOV	(SP),R0
	CALL	VOIDSP		;DE-ALLOCATE THE BUM ITEM
	ERROR$	#E.BOO		;INVALID BOOLEAN
4$:	CLR	(SP)		;STACK DUMMY RESULT
	BR	6$
5$:	MOV	10(R0),(SP)	;STACK BOOLEAN RESULT
	CALL	VOIDSP		;AND FREE THE SPACE
	TST	4(SP)		;TEST COMPLIMENT FLAG
	BEQ	6$
	NEG	(SP)		;0->1, 1->0
	INC	(SP)
	CLR	4(SP)		;RESET COMPLIMENT FLAG
6$:	CALL	GETSYM		;NOW READ THE TERMINATOR
	CMP	R1,#LEXCMD
	BNE	IFERR
	CMP	R0,#C.THEN
	BEQ	IFBODY
	CALL	PTBACK		;PUT BACK COMMAND OTHER THAN 'THEN'
;
; NOW EVALUATE THE IF BODY
IFBODY:	MOV	EXEC,-(SP)	;SAVE CURRENT STATUS
;
; STACK IS NOW:	(SP)	EXEC	;SAVED EXECUTION STATUS
;		2(SP)	IF CONDITION 0=FALSE !=0=TRUE
;		4(SP)	EXPRESSION CONTEXT
;		6(SP)	LOCATION FOR RESULT POINTER
;
	BNE	1$		;SKIP IF OFF-LINE
	TST	2(SP)		;CHECK CONDITION
	BNE	2$		;IF TRUE GO EXECUTE
	MOV	#EX.FIF,EXEC	;OTHERWISE FALSE 'THEN' CLAUSE
1$:	MOV	4(SP),R1	;SET CONTEXT
	CALL	VALEXP
	MOV	(SP),EXEC	;RESTORE EXECUTION STATUS
	BR	3$		;AND GO LOOK FOR 'THEN' CLAUSE
;
; EXECUTE A TRUE 'THEN' CLAUSE
2$:	MOV	4(SP),R1	;SET PARSER CONTEXT
	CALL	VALEXP
	MOV	R0,6(SP)	;RETURN RESULT
	MOV	EXEC,(SP)	;COMMAND MAY HAVE CHANGED STATUS
	BMI	IFDONE		;UNSTACK IF -VE
;
3$:	CALL	GETSYM		;NOW READ TERMINATOR
	CMP	R1,#LEXSEP	;IGNORE SEPARATORS
	BEQ	3$
	CMP	R1,#LEXCMD
	BNE	4$
	CMP	R0,#C.ELSE	;WAS IT ELSE
	BEQ	5$		;IF SO IGNORE
4$:	CALL	PTBACK		;PUT BACK ANYTHING ELSE
	BR	IFDONE		;NO ELSE PART
;
; NOW THE 'ELSE' CLAUSE
5$:	TST	(SP)		;ARE WE ACTIVE
	BNE	6$		;IF NOT SKIP
	TST	2(SP)		;WAS FIRST HALF EXECUTED ?
	BEQ	7$		;IF NOT GO DO SECOND
	MOV	#EX.FIF,EXEC	;TURN OFF EXECUTION
6$:	MOV	4(SP),R1	;AND DUMMY EXECUTE 'ELSE' CLAUSE
	CALL	VALEXP
	BR	IFDONE
;
7$:	CLR	EXEC		;EXECUTE 'ELSE' CLAUSE
	MOV	4(SP),R1
	CALL	VALEXP
	MOV	R0,6(SP)	;SAVE RESULT
	MOV	EXEC,(SP)	;SAVE ANY CHANGE IN EXEC STATUS
;
IFDONE:	MOV	(SP)+,EXEC	;RESTORE STATUS
	ADD	#2,SP		;POP CONDITION
	MOV	(SP)+,R1	;RESTORE CONTEXT VALUE
	MOV	(SP)+,R0	;AND POP RESULT (IF ANY)
	JMP	VALUED
;
IFERR:	ERROR$	#E.SYN	
	ADD	#6,SP
	JMP	VOID
;
ELSE:	ERROR$	#E.ELSE	
	JMP	VOID
;
THEN:	ERROR$	#E.THEN	
	JMP	VOID
;
;
; REPEAT - REPEAT CLAUSE PARSER
;
;	REPEAT <EXPRESSION>
;
;
REPEAT:	CALL	TVOID		;CHECK CONTEXT
	MOV	EXEC,-(SP)	;SAVE CURRENT STATUS
	CALL	SAVPNT		;SAVE CONTROL POINTERS
	MOV	R0,-(SP)	;SAVE THE COPY
REP2:	MOV	#O.BIND,R1	;BIND AN EXPRESSION
	CALL	VALEXP
	CALL	RPLY		;REPLY ANY VALUE
1$:	TST	EXEC		;ARE WE STILL RUNNING ?
	BNE	4$
2$:	MOV	(SP),R0
	CALL	RSTPNT		;RESTORE CONTROL POINTERS
	CLR	EXEC		;IN CASE IT WAS LOOP
	BR	REP2
;
4$:	CMP	EXEC,#EX.LOP	;LOOP ?
	BEQ	2$		;BACK TO TOP IF SO
	CMP	EXEC,#EX.BRK	;BREAK ?
	BNE	5$
	TST	2(SP)		;CHECK PREVIOUS STATUS
	BNE	5$		;SKIP UNLESS THAT WAS RUN
	CLR	EXEC		;BACK TO NORMAL
5$:	MOV	(SP)+,R0	;POP SAVED STRP
	CALL	FREESP
	ADD	#2,SP		;AND POP EXEC STATUS
	CLR	R0
	RETURN
;
;
; DOCMD - PARSE A DO LOOP
;
;	DO <VARIABLE>=<EXP1>,<EXP2>[,<EXP3>] 
;		<STATEMENT>
;
; STATEMENT IS NEVER EVALUATED IF <EXP1> < <EXP2>*SIGN(<EXP3>) ON ENTRY.
;
;
DOCMD:	CALL	TVOID		;CHECK CONTEXT
	MOV	EXEC,-(SP)	;SAVE EXECUTION STATUS
	CALL	GETSYM		;GET THE LOOP VARIABLE
	CMP	R1,#LEXVAL	;CHECK WE GOT A VARIABLE
	BNE	1$
	TST	EXEC		;SKIP IF DUMMY
	BNE	2$
	MOV	4(R0),R0	;GET SYMBOL TABLE POINTER
	BNE	2$		;NOT A TEMPORARY VALUE
1$:	ERROR$	#E.SYN		;ELSE ITS AN ERROR
2$:	MOV	R0,-(SP)	;SAVE STB POINTER ON STACK
	CALL	PTBACK		;UNREAD THE LOOP VARIABLE
	MOV	#O.VOID,R1	;AND PARSE 'I=N'
	CALL	VALEXP
	TST	EXEC		;STILL RUNNING ?
	BNE	3$		;SKIP IF NOT
	MOV	@(SP),R0	;GET LOOP CONTROL ITEM
	CALL	INTGER		;FORCE CONVERSION
3$:	CALL	GETSYM		;READ COMMA
	CMP	R1,#LEXSEP	;CHECK IT WAS
	BNE	4$
	CMP	R0,#LEXCOM
	BEQ	10$
4$:	ERROR$	#E.SYN
	CALL	PTBACK		;PUT BACK WHATEVER IT WAS
;
10$:	MOV	#O.VAL2,R1	;READ FINAL LIMIT EXPRESSION
	CALL	VALEXP
	CALL	INTGER		;FORCE NUMERIC RESULT
	TST	EXEC
	BNE	12$
	MOV	10(R0),-(SP)	;SAVE VALUE
	CALL	VOIDSP		;RELEASE ITEM IF TEMPORARY
	BR	20$
12$:	CLR	-(SP)		;SAVE DUMMY VALE
;
20$:	MOV	#1,-(SP)	;SET DEFAULT LOOP INCREMENT
	CALL	GETSYM		;IS THERE AN INCREMENT SPECIFIED
	CMP	R1,#LEXSEP
	BNE	21$
	CMP	R0,#LEXCOM
	BEQ	22$		;IF SO GO GET IT
21$:	CALL	PTBACK		;ELSE PUT BACK WHATEVER IT WAS
	BR	30$
22$:	MOV	#O.VAL2,R1	;PARSE INCREMENT EXPRESSSION
	CALL	VALEXP
	CALL	INTGER		;CONVERT RESULT
	TST	EXEC		;SKIP IF WE GOT AN ERROR
	BNE	30$
	MOV	10(R0),(SP)	;SAVE INCREMENT VALUE
;
30$:	CALL	SAVPNT		;SAVE POSITION
	MOV	R0,-(SP)
;
; AT THIS POINT STACK IS:
;	10(SP)	SAVED EXEC
;	6(SP)	LOOP VARIABLE POINTER (STB ADDRESS)
;	4(SP)	UPPER LIMIT. BINARY VALUE
;	2(SP)	INCREMENT. BINARY VALUE
;	(SP)	POSITION SAVE BLOCK POINTER
;
; THE LIMIT CONDITION IS EVALUATED BEFORE EACH EXECUTION OF
; THE LOOP AND THE LOOP VARIABLE UPDATED AT THE END OF EACH
; EXECUTION. THUS IF THE LIMIT IS INITIALY ALREADY PAST THE
; LOOP IS NEVER EXECUTED.
;
;
DO2:	TST	EXEC		;ARE WE ACTIVE ?
	BNE	3$		;IF NOT SKIP LOOP CONTROL STUFF
	MOV	@6(SP),R0	;GET VALUE OF LOOP VARIABLE
	TST	2(SP)		;CHECK LOOP DIRECTION
	BGE	1$
	CMP	4(SP),10(R0)	;AND CHECK FOR LIMIT
	BR	2$
1$:	CMP	10(R0),4(SP)
2$:	BLE	3$		;SKIP IF STILL RUNNING
	MOV	#EX.BRK,EXEC	;ELSE SET FOR DUMMY EXECUTION
3$:	MOV	#O.BIND,R1	;PARSE LOOP BODY
	CALL	VALEXP
	CALL	RPLY		;RETURN ANY RESULT
	TST	EXEC		;STILL ACTIVE ?
	BEQ	4$		;SKIP IF SO
	CMP	EXEC,#EX.LOP	;ELSE ARE WE LOOPING ?
	BNE	10$		;IF NOT BREAK
	MOV	10(SP),EXEC	;BACK IN RUN
4$:	MOV	@6(SP),R0	;GET CONTROL VARIABLE POINTER
	CALL	INTGER		;IN CASE IT GOT CHANGED
	TST	EXEC		;WHICH COULD GIVE AN ERROR
	BNE	10$
	ADD	2(SP),10(R0)	;UPDATE LOOP VARIABLE
	BVS	11$		;BREAK ON OVERFLOW (I=X,32767)
	MOV	(SP),R0		;AND BACK TO TOP OF LOOP
	CALL	RSTPNT
	BR	DO2
;
10$:	CMP	EXEC,#EX.BRK	;'BREAK' COMMAND EXECUTED ?
	BNE	11$		;IF NOT LEAVE EXECUTION STATUS
	MOV	10(SP),EXEC	;ELSE BACK IN RUN
11$:	MOV	(SP)+,R0	;POP STRP
	BEQ	12$
	CALL	FREESP		;AND DE-ALLOCATE
12$:	ADD	#10,SP		;POP ALL THE LOOP CONTROL STUFF
	JMP	VOID
;
;
; FORCMD - PARSE A FOR STATEMENT
;
;	FOR I=V1,V2,V3.....
;		STATEMENT
;
FORCMD:	CALL	TVOID		;CHECK CONTEXT
	MOV	EXEC,-(SP)	;SAVE EXECUTION STATUS
	CLR	-(SP)		;INIT LOOP COMPLETION FLAG
	CALL	GETSYM		;GET THE LOOP VARIABLE
	CMP	R1,#LEXVAL	;CHECK WE GOT A VARIABLE
	BNE	1$
	TST	EXEC		;SKIP IF DUMMY
	BNE	2$
	MOV	4(R0),R0	;GET OWNER
	BNE	2$		;NOT A TEMPORARY VALUE
1$:	ERROR$	#E.SYN		;ELSE ITS AN ERROR
2$:	MOV	R0,-(SP)	;SAVE STB ADDRESS ON STACK
	CALL	GETSYM		;NOW READ '='
	CMP	R1,#LEXOPP	;AND CHECK IT WAS
	BNE	3$
	CMP	R0,#O.ASS
	BEQ	4$
3$:	ERROR$	#E.SYN
4$:	CLR	-(SP)		;OPEN A LOCATION FOR POSITION POINTER
;
; STACK IS NOW:
;	6(SP)	SAVED EXEC
;	4(SP)	COMPLETION FLAG. !=0 FOR LAST EXECUTION
;	2(SP)	LOOP VARIABLE STB ADDRESS
;	(SP)	NEXT LIST ITEM POINTER
;
FOR2:	TST	EXEC		;ARE WE ACTIVE ?
	BNE	1$
	TST	4(SP)		;HAVE WE FINISHED ?
	BEQ	1$
	MOV	#EX.BRK,EXEC	;DUMMY EXECUTE REST OF STATEMENT
1$:	MOV	#O.VAL2,R1	;PARSE VALUE
	CALL	VALEXP
	TST	EXEC
	BNE	2$
	MOV	R0,R1		;GET READY TO ASSIGN
	MOV	@2(SP),R0
	MOV	#O.ASS,R2
	CALL	DOOP		;PERFORM ASSIGNMENT
;
; SET LIST POINTER AND CHECK FOR END OF LIST
2$:	CLR	(SP)		;NO POINTER SAVED YET
	MOV	#EX.FOR,EXEC	;DUMMY EXECUTION
;
3$:	CALL	GETSYM		;READ LAST ITEM TERMINATOR
	CMP	R1,#LEXSEP	;IF ITS A COMMA LIST CONTINUES
	BNE	5$		;ELSE BREAK
	CMP	R0,#LEXCOM	;IF COMMA THERES ANOTHER ITEM
	BNE	5$		;END OF LIST
	TST	(SP)		;HAVE WE ALREADY SAVED SOMETHING
	BNE	4$		;SKIP IF SO
	CALL	SAVPNT		;ELSE SAVE POSITION
	MOV	R0,(SP)
4$:	MOV	#O.VAL2,R1	;PARSE NEXT LIST ITEM
	CALL	VALEXP
	BR	3$		;AND GO SEE IF LIST CONTINUES
;
5$:	CALL	PTBACK		;UNREAD LIST TERMINATOR
	TST	(SP)		;HAVE WE ALREADY SAVED A LIST POINTER ?
	BNE	6$
	CALL	SAVPNT		;ELSE SAVE HEAD OF FOR BODY
	MOV	R0,(SP)
	INC	4(SP)		;AND FLAG END OF LIST
6$:	CMP	EXEC,#EX.FOR	;DID STATUS CHANGE
	BNE	10$
	MOV	6(SP),EXEC	;IF NOT RESTORE PREVIOUS STATUS
;
10$:	MOV	#O.BIND,R1	;PARSE LOOP BODY
	CALL	VALEXP
	CALL	RPLY		;REPLY ANY RESULT
	TST	EXEC		;STILL RUNNING ?
	BEQ	11$
	CMP	EXEC,#EX.BRK	;BROKEN
	BEQ	20$		;BREAK FROM LOOP
	CMP	EXEC,#EX.LOP	;LOOPED
	BNE	21$		;SOME OTHER STATUS
	MOV	6(SP),EXEC	;RESTORE ORIGINAL STATUS
	BR	12$		;LOOP BACK TO TOP
11$:	TST	4(SP)		;CHECK FOR LOOP TERMINATION
	BNE	20$		;AND BREAK IF FINISHED
12$:	MOV	(SP),R0		;GET NEXT LIST ITEM POINTER
	CALL	RSTPNT		;UPDATE POINTERS
	MOV	(SP),R0		;AND FREE POINTER ITEM
	CALL	FREESP		;DONT NEED THAT AGAIN
	BR	FOR2		;AND BACK FOR MORE
;
20$:	MOV	6(SP),EXEC	;CONTINUE AFTER 'BREAK'
21$:	MOV	(SP)+,R0	;POP LIST POINTER
	CALL	FREESP
	ADD	#6,SP		;POP LOOP VARIABLE POINTER AND EXEC
	JMP	VOID		;AND QUIT
;
;
; EOFCMD - PROCESS AN END OF FILE
;
; THIS COMMAND PROCESSOR IS CALLED WHEN AN INPUT REQUEST
; RETURNS END-OF-FILE. IN NORMAL MODE EOF EFFECTS A RETURN 
; WHILST IN BREAKIN MODE IT RETURNS TO THE INTERRUPTED CODE.
;
;
EOFCMD:	MOV	STREAM,R0
	BIT	#FG.BRK,SL.FLG(R0) ;ARE WE IN BREAKIN MODE ?
	BEQ	1$		;SKIP IF NOT
	JMP	RESUME		;ELSE TREAT AS RESUME
1$:	CALL	TVOID
	TST	EXEC		;ARE WE EXECUTING OR UNSTACKING
	BLE	2$		;IF SO TREAT AS RETURN
	CMP	EXEC,#EX.ERR	;JUST SCANNING AFTER AN ERROR ?
	BEQ	2$
	ERROR$	#E.EOF,FATAL	;UNEXPECTED END OF FILE
	BR	3$
2$:	MOV	#EX.RTN,EXEC
3$:	JMP	VOID
;
; BREAK,LOOP,STOP,RETURN - UPDATE THE EXECUTION STATUS
;
; IF EXECUTED AS A BREAKIN COMMAND OF A SUSPENDED STREAM A RESUME
; IS PERFORMED.
;
BREAK:	MOV	#EX.BRK,R0
	BR	SETEX
;
LOOP:	MOV	#EX.LOP,R0
	BR	SETEX
;
STOP:	MOV	#EX.STP,R0
	BR	SETEX
;
RTNSUB:	MOV	#EX.RTN,R0
	BR	SETEX
;
;
SETEX:	CALL	TVOID		;CHECK CONTEXT
	TST	EXEC
	BNE	1$
	MOV	R0,EXEC
	JMP	RESUM2		;GO RESUME STREAM INCASE SUSPENDED
1$:	JMP	VOID
;
;
; ASK,ASKN,REQUEST - REQUEST DATA FROM TERMINAL
;
;	V=ASK 'PROMPT'		OBTAIN A TEXT VALUE
;	V=REQUEST 'PROMPT'		"
;	N=ASKN 'PROMPT'		OBTAIN A NUMBER
;
;
ASK0:	MOV	#O.VALU,R1	;READ THE PROMPT STRING OR NULL
	CALL	VALEXP
	TST	EXEC
	BNE	1$
	TST	R0
	BEQ	2$		;NULL PROMPT
	MOV	#M.STR,R1
	CALL	CONVRT
	TST	EXEC
	BNE	1$
	MOV	R0,R2		;POINT TO TEXT
	ADD	#10,R2
	RETURN
;
1$:	TST	(SP)+		;POP RETURN ADDRESS
	JMP	VALUED
;
2$:	MOV	#DPRMPT,R2	;DEFAULT PROMPT
	RETURN
;
;
ASKCMD:
REQUST:	CALL	ASK0		;PARSE THE PROMPT STRING
	MOV	R0,-(SP)	;SAVE PROMPT ITEM
	MOV	#M.STR,R0	;SET ITEM TYPE
	CLR	R1		;NO NAME
	CALL	RQST		;DO THE INPUT
ASKDON:	MOV	R0,R1		;SAVE RESULT
	MOV	(SP)+,R0	;GET BACK PROMPT VALUE
	CALL	VOIDSP		;AND RELEASE IT
	MOV	R1,R0
	JMP	VALUED		;RETURN THE VALUE
;
;
ASKNCM:	CALL	ASK0		;GET PROMPT
	MOV	R0,-(SP)	;AND SAVE ITEM
	MOV	R2,-(SP)	;AND STRING ADDRESS
1$:	CLR	R1		;NULL NAME
	MOV	#M.STR,R0	;SET REQUEST TYPE
	CALL	RQST		;DO THE INPUT
	TST	EXEC		;ANYTHING HAPPENING ?
	BNE	2$
	MOV	#M.NUM,R1	;REQUEST AN INTEGER
	CALL	CONVRT		;CONVERT IT
	BCC	2$		;RETURN IF WE GET IT
	MOV	#ASKM1,R2	;OUTPUT MESSAGE
	CALL	OUT
	MOV	STREAM,R1	;ENABLE SPECIAL MODE
	BIS	#FG.SRQ,SL.FLG(R1)
	MOV	(SP),R2		;RESTORE STRING ADDRESS
	BR	1$
2$:	TST	(SP)+		;POP STRING ADDRESS
	BR	ASKDON		;AND QUIT
;
DPRMPT:	.ASCIZ	/? /
ASKM1:	.ASCII	<12>/** INTEGER VALUE REQUIRED **/<12>
	.EVEN
;
;
; PASS - SKIP THE NEXT N REQUESTS
;
;	PASS [N]
;	@<SPACE>[N] IS A SYNONYM
;
PASCMD:	CALL	TVOID
	MOV	#O.VALU,R1	;TRY TO PARSE A VALUE
	CALL	VALEXP
	TST	EXEC		;ANYTHING HAPPENING ?
	BNE	10$		;JUST QUIT IF NOT
	TST	R0		;IS ARGUMENT NULL ?
	BNE	1$		;IF NOT SKIP
	CLR	R1
	JMP	SUSPND		;SUSPEND INDEFINATLY
;
1$:	CALL	INTGER
	TST	R0		;CHECK ARGUMENT WAS VALID
	BEQ	10$		;SKIP IF NOT
	MOV	10(R0),R2	;GET INTEGER VALUE
	CALL	VOIDSP		;AND DE-ALLOCATE VALUE
	TST	R2		;IS NUMBER <=0
	BLE	10$		;IF SO DO NOTHING
	MOV	STREAM,R1	;GET STREAM ADDRESS
	MOV	PROC,R0		;AND PROCESS
	ADD	#PL.SLH,R0	;FORM STREAM LISTHEAD
	CMP	SL.FWD(R1),R0	;ARE WE THE BOTTOM STREAM ?
	BEQ	10$		;IF SO JUST SKIP
	MOV	R2,SL.RQD(R1)	;SET BYPASS COUNT
	PAUSE$	#TS.PAS		;ENTER PASS STATE
10$:	JMP	VOID		;AND QUIT
;
;
; STKCMD - PRINT STACK TRACE
;
;	STACK
;
STKCMD:	CALL	TVOID
	CALL	STKLST		;CALL LIST ROUTINE
	JMP	VOID
;
;
; SUSPEND - SUSPEND STREAM EXECUTION
;
;	SUSPEND
;
; THE ISSUING STREAM SUSPENDS UNTIL A RESUME COMMAND IS
; EXECUTED IN BREAKIN MODE. ALL REQUESTS FROM LOWER STREAM
; BYPASS THE SUSPENDED STREAM.
; A SUSPEND COMMAND WILL TERMINATE BREAKIN MODE.
;
SUSPND:	CALL	TVOID
	TST	EXEC
	BNE	2$
	MOV	STREAM,R1
	BIT	#FG.BRK,SL.FLG(R1) ;ARE WE IN A BREAKIN COMMAND
	BEQ	1$		;SKIP IF NOT
	MOV	#TS.SPD,SL.BST(R1) ;SET SAVED STATUS
	MOV	#EX.RBI,EXEC	;RETURN FROM BREAKIN
	BR	2$
;
1$:	PAUSE$	#TS.SPD		;ELSE JUST PAUSE
2$:	JMP	VOID
;
;
;
; PRSFUN - PARSE AN INTRINSIC FUNCTION
;
;	$FUN(ARGUMENT LIST)
;
PRSFUN:	CALL	PRSARG		;PARSE THE ARGUMENT LIST (IF ANY)
	TST	EXEC		;ARE WE REALY ACTIVE
	BNE	1$		;SKIP IF NOT
	CALL	DOFUN		;EVALUATE FUNCTION
	BCC	1$		;SKIP IF EVALUATION WAS OK
	ERROR$	R0		;ELSE REPORT THE ERROR
1$:	JMP	VALUED		;RETURN FUNCTION RESULT
;
;
; CALSUB - CALL A MACRO SUBROUTINE
;
; THERE ARE THREE MAIN FORMS OF THE CALL COMMAND:
;	1)	CALL <MACRO NAME>
;	2)	@<FILE NAME> OR @<MACRO NAME>
;	3)	<MACRO NAME>
;
; 1 AND 3 ARE EQUIVALENT EXCEPT THAT THE CALL STATEMENT IS VOID AND PERFORMS
; AN EXPLICIT CHECK THAT THE NAME REFERS TO A CLONE MACRO.
; FORM 2 ENABLES THE SPECIFICATION OF ANY FILE AS A MACRO. IF NO FILE IS
; FOUND OF THE SPECIFIED NAME, THE MACRO IS LOOKED UP AS A CLONE MACRO AND
; IF FOUND IS EXECUTED AS IN CASE 3.
;
; ALL THREE FORMS MAY TAKE AN ARGUMENT LIST FOR TRANSMISSION TO THE MACRO.
;
;
; 1)	CALL <MACRO NAME> (OPTIONAL ARGUMENT LIST)
;
CALSUB:	CALL	TVOID		;CHECK VOID CONTEXT
	CALL	GETSYM		;READ THE CALL ARGUMENT
	CMP	R1,#LEXMAC	;IS IT A MACRO NAME ?
	BEQ	1$
	CMP	R1,#LEXSUB	;IS IT A LOCAL SUBROUTINE
	BEQ	2$
	ERROR$	#E.IMAC	
1$:	CLR	R1		;INIT CONTEXT
	BR	CALLIT		;EXECUTE THE MACRO AND RETURN
2$:	CLR	R1
	BR	DOSUB
;
;
; DOSUB - CALL A LOCAL SUBROUTINE
;
DOSUB:	CALL	PRSARG		;PARSE THE ARGUMENT LIST
	TST	EXEC
	BEQ	1$
	JMP	VALUED
1$:	MOV	R0,-(SP)	;SAVE ROUTINE NAME POINTER
	ADD	#2,(SP)		;SKIPPING OVER VALUE POINTER
	MOV	R1,-(SP)	;SAVE CONTEXT
	MOV	(R0),R0		;POINT TO CONTROL DESCRIPTOR ITEM
	CALL	CPYITM		;DUPLICATE IT
	MOV	R0,R2		;COPY DESCRIPTOR ADDRESS
	MOV	R3,-(SP)	;SAVE ARGUMENT BLOCK
	MOV	STREAM,R3	;POINT TO CONTROL LISTHEAD
	ADD	#SL.CLH,R3
	CALL	LINKB		;LINK IN DESCRIPTOR
	MOV	(SP)+,R3
	BR	CALL2		;GO EXECUTE CALL
;
;
; 2)	@FILENAME (OPTIONAL ARGUMENT LIST)
;
; FOR REASONS OF COMPATIBILITY WITH EXISTING SOFTWARE THE FORM:
;	@<SPACE>N	IS EQUIVALENT TO:	PASS N
;
;
INDCMD:	CALL	GETPNT		;GET LINE POINTER
	CMPB	(R0),#' 	;LEADING SPACE OR EOL IS A 'PASS'
	BHI	1$
	JMP	PASCMD		;AND PROCESS AS PASS
;
1$:	MOV	R0,-(SP)	;SAVE STRING ADDRESS
	MOV	R1,-(SP)	;SAVE CONTEXT
	MOV	R0,R2		;COPY STRING ADDRESS
	CALL	PRSFNM		;GET LENGTH OF FILE NAME
	CALL	PUTPNT		;AND UPDATE POINTER
	CALL	PRSARG		;PARSE AN ARGUMENT LIST IF ANY
	TST	EXEC		;ARE WE REALY ACTIVE ?
	BNE	CALERR		;SKIP IF NOT
	CALL	PRSFIL		;FIND FILE AND INIT CONTROL DESCRIPTOR
	BCC	CALL2		;SKIP IF NO PROBLEMS
	TST	R0		;WAS ERROR SIMPLY FILE NOT FOUND ?
	BEQ	IND1		;IF SO TRY FOR A SYSTEM MACRO NAME
	ERROR$	#E.BFS		;ELSE REPORT BAD FILE SPECIFICATION
	BR	CALERR		;QUIT AFTER ERROR
;
IND1:	MOV	2(SP),R0	;RESTORE NAME STRING, LENGTH IS STILL IN R1
	MOV	MACSTB,R2	;GET MACRO SYMBOL TABLE ADDRESS
	CALL	LOOKUP		;LOOK UP NAME IN SYSTEM MACRO TABLE
	BCS	1$		;SKIP IF LOOKUP GIVES AN ERROR
	MOV	R2,R0		;COPY MACRO TABLE ADDRESS
	BR	CALL1		;AND GO INIT CONTROL DESCRIPTOR
1$:	ERROR$	#E.NSF		;NO SUCH FILE
	BR	CALERR
;
;
; CALLIT - CALL A MACRO
;
; 3)	<MACRO NAME> (OPTIONAL ARGUMENT LIST)
;
; INPUT:	R0=MACRO SYMBOL TABLE POINTER
;		R1=PARSER CONTEXT
;
CALLIT:	MOV	R0,-(SP)	;PUSH THE MACRO TABLE POINTER
	ADD	#2,(SP)		;SKIP TO MACRO NAME
	MOV	R1,-(SP)	;SAVE CONTEXT
	CALL	PRSARG		;PARSE THE ARGUMENT LIST
	TST	EXEC		;ARE WE DOING ANYTHING ?
	BNE	CALERR		;IF NOT GO CLEAN UP
;
CALL1:	CALL	NEWCTL		;ALLOCATE NEW CONTROL DESCRIPTOR
	BCS	CALERR		;SKIP IF ALLOCATION FAILS
	MOV	(R0),R0		;GET ADDRESS OF ID
	MOV	(R0)+,CD.FID(R2)
	MOV	(R0)+,CD.FID+2(R2)
	MOV	(R0)+,CD.FID+4(R2)
	MOV	#1,CD.PNT(R2)	;SET VIRTUAL BLOCK 1
	CLR	CD.PNT+2(R2)	;ZERO BYTE OFFSET
	BR	CALL2
;
CALERR:	CALL	ENDARG		;DEALLOCATE ARGUMENT BLOCK
	ADD	#4,SP		;POP CONTEXT AND MACRO NAME POINTER
	JMP	VALUED		;AND QUIT
;
; AT THIS POINT:
;	R2=CONTROL DESCRIPTOR INITIALISED FOR MACRO TO CALL
;	R3=ARGUMENT LIST POINTER
;	2(SP) ADDRESS OF MACRO NAME STRING
;	(SP) CALLING CONTEXT
;
CALL2:	MOV	R3,CD.ARG(R2)	;SAVE ARGUMENT DESCRIPTOR BLOCK
	MOV	(SP)+,R1	;RESTORE CALLING CONTEXT
	MOV	(SP),R2		;GET BACK NAME ADDRESS
	CALL	LOGCAL		;LOG THE CALL
	CALL	GETLIN		;UPDATE CONTROL POINTERS TO START OF MACRO
	CALL	BEGIN		;START A NEW STACK-FRAME
	CALL	PRSBLK		;PARSE THE SUBROUTINE BODY
	CALL	ENDCTL		;DEALLOCATE THE CONTROL DESCRIPTOR
	MOV	(SP)+,R2	;RESTORE MACRO NAME POINTER
	CMP	EXEC,#EX.RTN	;WAS A RETURN EXECTUED ?
	BNE	1$		;SKIP IF NOT
	MOV	#EX.RUN,EXEC	;IF SO BACK TO RUN
	CALL	LOGRTN		;LOG RETURN FROM MACRO
1$:	JMP	VALUED		;AND RETURN
;
;
; SUBCMD - DEFINE A LOCAL SUBROUTINE
;
;	SUBROUTINE <NAME> (ROUTINE BODY)
;
; AN ENTRY IS CREATED IN THE STREAMS LOCAL MACRO TABLE. THE ENTRY IS PERMENANT
; UNTIL THE STREAM EXITS. THE VALUE ITEM STORED IS A COPY OF THE CONTROL 
; DESCRIPTOR FOR THE SUBROUTINE ENTRY. THE ROUTINE BODY MUST BE ENCLOSED IN ().
; TO PREVENT THE SAVING OF POINTERS TO NON-EXISTANT BUFFERS, SUBROUTINE
; DEFINITION IS ILLEGAL IN BREAKIN MODE.
;
SUBCMD:	CALL	TVOID
	CALL	NEXSYM		;GET THE SUBROUTINE NAME
	CMP	R2,#LEXNAM	;WHICH HAD BETTER BE A NAME
	BEQ	2$
1$:	ERROR$	#E.SYN
	JMP	VOID
;
2$:	MOV	R0,-(SP)	;SAVE THE NAME POINTER AND LENGTH
	MOV	R1,-(SP)
	CALL	NEXSYM		;THE NEXT SYMBOL MUST BE (
	MOV	(SP)+,R1
	MOV	(SP)+,R0
	CMP	R2,#LEXCMD	;ERROR IF NOT
	BNE	1$
	CMP	R3,#C.BEG
	BNE	1$
;
	TST	EXEC		;ANYTHING HAPPENING
	BNE	3$		;IF NOT SKIP LOOKUPS
	MOV	STREAM,R2	;GET THE STREAM POINTER
	BIT	#FG.BRK,SL.FLG(R2) ;CHECK STREAM IS NOT IN BREAKIN
	BNE	1$		;ERROR IF SO
	MOV	SL.LMT(R2),R2	;POINT TO MACRO TABLE
	CALL	LOOKUP		;DOES NAME ALREADY EXIST
	BCC	3$		;IF SO SKIP
	MOV	STREAM,R2	;ELSE GET BACK STREAM
	ADD	#SL.LMT,R2	;POINT TO LOCAL MACRO TABLE LISTHEAD
	CALL	ENTER		;ENTER THE NAME
	CALL	SAVPNT		;SAVE POSITION
	MOV	R0,(R2)		;AND ENTER IN SYMBOL TABLE
3$:	MOV	EXEC,-(SP)	;SAVE EXECUTION STATUS
	MOV	#EX.DEF,EXEC	;SET DEFINITION STATUS
	CLR	R1		;NULL CONTEXT
	CALL	BEGIN		;START A STACK FRAME
	CALL	PRSBLK		;PARSE THE ROUTINE BODY
	MOV	(SP)+,R0	;RETURN OLD EXECUTION STATUS
	CMP	EXEC,#EX.DEF	;ANY ERRORS ?
	BNE	4$
	MOV	R0,EXEC		;IF NOT RESTORE EXECUTION
4$:	JMP	VOID		;AND RETURN
;
;
; ARGCMD - ASSIGN DUMMY ARGUMENTS IN A SUBROUTINE
;
;	ARGUMENTS <NAME1>,<NAME2>,<NAME3>....
;
; THE SPECIFIED NAMES ARE ENTERED IN THE CURRENT LEVEL OF THE SYMBOL TABLE.
; THE TABLE VALUE POINTER IS SET ACCORDING TO THE CORRESPONDING FIELD OF
; THE SUBROUTINE ARGUMENT BLOCK:
; 1)	TEMPORARY VALUES:	POINTER IS SET TO VALUE ITEM ADDRESS
;				ARGUMENT BLOCK POINTER IS CLEARED.
; 2)	DEFINED VALUES:		POINTER IS SET TO STB ADDRESS OF VALUE
;				VALUE IS ACCESSED BE DEREFERANCING
; 3)	NULL ARGUMENTS:		ARE ENTERED AS UNDEFINED LOCAL VARIABLES
;
; THIS IS AN EXECUTABLE STATEMENT. SUCCESSIVE EXECUTIONS MAY BE USED TO
; ACCESS SUCCESSIVE SUBROUTINE ARGUMENTS. THE POINTER AT AB.PNT INDICATES
; THE NEXT ARGUMENT TO ASSIGN.
;
ARGCMD:	CALL	TVOID
1$:	CLR	-(SP)		;INIT WITH NULL REAL ARGUMENT
	TST	EXEC		;ANYTHING HAPPENING
	BMI	20$		;QUIT IF THINGS ARE THAT BAD
	BNE	4$		;ELSE SKIP IF NOT RUNNING
	MOV	STREAM,R0	;GET OUR STREAM ITEM
	MOV	SL.CLH(R0),R0	;GET THE CONTROL DESCRIPTOR
	MOV	CD.ARG(R0),R0	;GET THE ARGUMENT BLOCK POINTER
	BEQ	4$		;SKIP IF NULL
	MOV	AB.PNT(R0),R1	;GET CURRENT BLOCK POINTER
	SUB	R0,R1		;FORM OFFSET
	SUB	#AB.ARG,R1	;COMPUTE ARGUMENT INDEX
	ASR	R1		;IN WORDS
	CMP	R1,AB.CNT(R0)	;PAST END OF BLOCK ?
	BGT	4$		;IF SO LEAVE ARGUMENT NULL
	MOV	@AB.PNT(R0),(SP);GET ARGUMENT POINTER
	CLR	@AB.PNT(R0)	;ZERO THE POINTER AS WE DONT NEED IT AGAIN
	ADD	#2,AB.PNT(R0)	;GO ON TO NEXT ARGUMENT
;
4$:	CALL	NEXSYM		;GET THE NEXT SYMBOL
	CMP	R2,#LEXNAM	;CHECK THAT ITS A NAME
	BEQ	10$		;AND SKIP IF IT IS
	CMP	R2,#LEXSEP	;ELSE IS IT A SEPERATOR
	BNE	5$		;IF NOT ITS AN ERROR
	CMP	R3,#LEXEOL	;ELSE IT HAD BETTER BE EOL
	BEQ	4$		;AND IF SO IGNORE IT
5$:	ERROR$	#E.SYN
;
10$:	TST	EXEC		;ANYTHING HAPPENING ?
	BNE	20$		;SKIP IF NOT
	MOV	STREAM,R3	;GET STREAM POINTER
	MOV	SL.STB+4(R3),R2	;GET CURRENT STB POINTER
	MOV	BLOCKP,R3	;GET OUR STACKFRAME POINTER
	MOV	SF.STB(R3),R3	;GET END OF OUR STACK RANGE
	CALL	LOOK1		;LOOKUP SYMBOL AT OUR LEVEL
	BCC	14$		;AND GO ASSIGN IF WE FIND IT
;
; HERE WE ARE CREATING A NEW LOCAL VARIABLE
11$:	TST	(SP)		;DO WE HAVE A REAL ARGUMENT
	BNE	12$		;SKIP IF WE DO
	CALL	NEWVAL		;ELSE JUST CREATE AN UNDEFINED VALUE
	BR	20$		;AND THATS IT
;
12$:	MOV	STREAM,R2	;POINT TO STREAM
	ADD	#SL.STB,R2	;OFFSET TO STB LISTHEAD
	CALL	ENTER		;ENTER NEW NAME IN STB
	MOV	(SP),R0		;GET THE REAL ARGUMENT
	TST	4(R0)		;IS IT A TEMPORARY VALUE
	BNE	13$		;SKIP IF NOT
	MOV	R0,(R2)		;SET ITEM IN SYMBOL TABLE
	MOV	R2,4(R0)	;AND SET STB POINTER IN ITEM
	BR	20$		;AND THATS IT AGAIN
;
13$:	MOV	4(R0),(R2)	;SET INDIRECT REFERANCE POINTER
	BR	20$
;
; HERE THE NAME IS ALREADY DEFINED AT OUT STACK LEVEL
14$:	MOV	(R2),R0		;GET THE VALUE POINTER
	CALL	DEREF		;DEREFARANCE
	MOV	(SP),R1		;GET THE REAL ARGUMENT
	BNE	15$		;IF ITS DEFINED GO ASSIGN IT
	CMP	6(R0),#M.UDF	;IS VALUE ALREADY UNDEFINED
	BEQ	20$		;IF SO DO NOTHING
	MOV	R0,-(SP)	;SAVE L-VALUE POINTER
	CALL	UDFVAL		;ALLOCATE AN UNDEFINED VALUE
	MOV	R0,R1
	MOV	(SP),R0
;
15$:	MOV	4(R0),R2	;GET OWNER OLD VALUE
	CALL	FREESP		;DEALLOCATE THE OLD VALUE
	MOV	R1,(R2)		;SET NEW POINTER IN STB
	MOV	R2,4(R1)	;AND STB POINTER IN VALUE
;
20$:	TST	(SP)+		;POP THE REAL ARGUMENT
	CALL	GETSYM		;GET THE NEXT SYMBOL
	CMP	R1,#LEXSEP	;IS IT A SEPERATOR
	BNE	21$		;PUT IT BACK IF NOT
	CMP	R0,#LEXCOM	;MAKE SURE ITS A COMMA
	BEQ	1$		;GO AND GET NEXT DUMMY ARGUMENT
21$:	CALL	PTBACK		;ELSE PUT WHATEVER IT WAS BACK
	JMP	VOID		;AND QUIT
;
;
; RESUME - RESUME A STREAM AFTER SUSPEND OR BREAKIN
;
.ENABLE LSB
;
RESUME:	CALL	TVOID		;CHECK CONTEXT
	TST	EXEC
	BNE	1$
	MOV	#EX.RBI,EXEC	;RETURN FROM BREAKIN
;
; WE ARRIVE HERE AFTER ANY FUNCTION WHICH MAY BE ISSUED FROM A BREAKIN
; OF A SUSPENDED STREAM, AND WHICH IS TO RESUME SUCH A STREAM.
;
RESUM2:	MOV	STREAM,R1
	CMP	SL.BST(R1),#TS.SPD ;STREAM SUSPENDED ?
	BNE	1$
	MOV	#TS.RUN,SL.BST(R1) ;IF SO PUT IT BACK IN RUN
1$:	JMP	VOID
;
.DSABL LSB
;
; RUNCMD - START A VAL TASK UNDER CLONE
;
;	RUN <TASK NAME> <EXPRESSION>
;
;
RUNCMD:	CALL	TVOID		;CHECK CONTEXT
	CALL	NEXSYM
	CMP	R2,#LEXNAM
	BEQ	1$
	ERROR$	#E.RUN	
1$:	MOV	EXEC,-(SP)	;SAVE EXECUTION STATUS
	BNE	RUNBLK		;IF DUMMY JUST PARSE RUN BLOCK
	SUB	#10,SP		;BUFFER NAME ON STACK
	MOV	SP,R2
	CMP	R1,#6		;NAME TOO LONG
	BLE	2$
	MOV	#6,R1
2$:	MOVB	(R0)+,(R2)+
	SOB	R1,2$
	CLRB	(R2)
3$:	MOV	SP,R2		;POINT BACK TO NAME BUFFER
	CALL	STRTSK		;GO START TASK
	BCC	5$		;SKIP IF NO PROBLEMS
	TST	EXEC		;DID THAT CREATE A FATAL ERROR
	BNE	4$		;IF SO OUTPUT MESSAGE
	PAUSE$	#TS.RUN		;OTHERWISE WAIT
	BR	3$		;AND GO TRY AGAIN
4$:	ERROR$	#E.RUN		;REPORT RUN ERROR
5$:	ADD	#10,SP		;POP TASK NAME
	MOV	EXEC,(SP)
;
; RUNBLK - PARSE A RUN BLOCK
;	(SP) CONTAINS EXEC PRIOR TO RUN-BLOCK PARSING
;
RUNBLK:	CLR	R1		;SET CONTEXT
	CALL 	VALEXP		;PARSE A RUN BLOCK
	CALL	RPLY		;RETURN RESULT TO TASK
	TST	(SP)		;ARE WE ACTIVE ?
	BNE	1$		;IF NOT NOTHING TO WAIT FOR
	CMP	EXEC,#EX.ERR	;ANY ERRORS
	BEQ	1$		;IF SO EXIT IMMEDIATLY
	CMP	EXEC,#EX.FER	;OR FATAL ERRORS
	BEQ	1$
	CMP	EXEC,#EX.STP	;OR HAVE WE STOPPED
	BEQ	1$
	PAUSE$	#TS.EOJ		;ELSE WAIT FOR TASK TO FINISH
;
1$:	TST	(SP)+		;POP EXECUTION STATUS
	JMP	VOID
;
;
;
; SYSCMD - LIST CLONE SYSTEM STATUS
;
;	SYS
;
;
SYSCMD:	CALL	TVOID		;CHECK CONTEXT
	CALL	SYSLST		;LIST SYSTEM STATUS
	JMP	VOID
;
;
; ENABLE/DISABLE - SET AND CLEAR FUNCTION CONTROL BITS
;
;	ENABLE	<FUNCTION>
;	DISABLE <FUNCTION>
;
; IN ADDITION THE FOLLOWING CLONE COMMANDS PERFORM ENABLE/DISABLE FUNCTIONS:
; ENABLE:	TRACE, LOG, TEXT, LITERAL
; DISABLE:	NOTRACE, NOLOG, NOTEXT, CLONE
;
; FUNCTION NAMES ARE DEFINED HERE, THEY ARE QUITE INDEPENDANT OF OTHER
; CLONE KEYWORDS AND HAVE NO SIGNIFICANCE OUTSIDE THE ENABLE/DISABLE
; STATEMENT.
;
; THE MACRO EDFDEF DEFINES THE NAMES, THE LIST CODE AND THE BIT MASK.
; NOTE THAT ONLY BITS 0-13 CAN BE SUPPORTED AS FUNCTION CONTROL BITS.
; BITS 14 AND 15 CONTAIN THE LIST FLAGS WORD IDENTIFIER:
;		0 - PROCESS LIST
;		1 - STREAM FLAGS WORD
;		2 - CONTROL DESCRIPTOR FLAGS WORD
;
.MACRO	EDFDEF	STR,LIST,FLAG
.IIF	IDN	LIST,PL		.WORD	FLAG
.IIF	IDN	LIST,SL		.WORD	40000+FLAG
.IIF	IDN	LIST,CD		.WORD	100000+FLAG
.ASCIZ	/STR/
.EVEN
.ENDM
;
EDFTAB:	EDFDEF	LOG,PL,PF.LOG		;LOG TRANSACTIONS
	EDFDEF	TRACE,PL,PF.TRA		;TRACE CLONE COMMANDS
	EDFDEF	TEXT,SL,FG.TXT		;PRINT REPLIES AS TEXT
	EDFDEF	LITERAL,CD,CF.LIT	;LITERAL MODE
	EDFDEF	SUBSTITUTION,CD,CF.SUB	;STRING SUBSTITUTION MODE
	.WORD	0
;
;
ENACMD:	CALL	TVOID
	CLR	-(SP)		;INIT SET/CLEAR MODE TO SET
	BR	ED1		;GO TO COMMON CODE
;
DISCMD:	CALL	TVOID
	MOV	#-1,-(SP)
;
ED1:	CALL	NEXSYM		;READ THE FUNCTION NAME
	CMP	R2,#LEXNAM	;CHECK ITS A NAME
	BNE	EDERR		;ERROR IF NOT
	MOV	#EDFTAB,R2	;GET THE TABLE ADDRESS
	CALL	LOOKUP		;LOOKUP THE VALUE
	BCS	EDERR		;ERROR IF NOT FOUND
	MOV	(R2),R1		;GET THE BIT MASK
	BIC	#140000,R1	;MASK THE LIST SELECT BITS
	MOV	(R2),R0		;GET THE LIST SELECT VALUE
	CLC			;MOVE FROM BITS 14 AND 15
	ROL	R0		;TO BITS 0 AND 1
	ROL	R0
	ROL	R0
	BIC	#177774,R0
	TST	R0		;PROCESS LIST ?
	BNE	ED3
;
EDPROC:	MOV	PROC,R0		;POINT TO PROCESS LIST FLAGS
	ADD	#PL.FLG,R0
	BR	ED10
;
ED3:	CMP	R0,#1		;STREAM LIST
	BNE	ED4
;
EDSTRM:	MOV	STREAM,R0	;POINT TO STREAM LIST FLAGS
	ADD	#SL.FLG,R0
	BR	ED10
;
ED4:	CMP	R0,#2		;CONTROL DESCRIPTOR LIST
	BNE	EDERR
;
EDCTRL:	MOV	STREAM,R0	;POINT TO CONTROL FLAGS
	MOV	SL.CLH(R0),R0
	ADD	#CD.FLG,R0
;
ED10:	TST	(SP)+
	BNE	1$
	BIS	R1,(R0)		;ENABLE THE FUNCTION
	BR	2$
;
1$:	BIC	R1,(R0)
2$:	JMP	VOID
;
;
EDERR:	TST	(SP)+
	ERROR$	#E.SYN
	JMP	VOID
;
;
;
; TRACE,NOTRACE,LOG,NOLOG,TEXT,NOTEXT,LITERAL,CLONE
;
.ENABLE LSB
;
TRACE:	CALL	TVOID
	CLR	-(SP)
	BR	1$
;
NOTRCE:	CALL	TVOID
	MOV	#-1,-(SP)
1$:	MOV	#PF.TRA,R1
	BR	EDPROC
;
LOG:	CALL	TVOID
	CLR	-(SP)
	BR	2$
;
NOLOG:	CALL	TVOID
	MOV	#-1,-(SP)
2$:	MOV	#PF.LOG,R1
	BR	EDPROC
;
TEXT:	CALL	TVOID
	CLR	-(SP)
	BR	3$
;
NOTEXT:	CALL	TVOID
	MOV	#-1,-(SP)
3$:	MOV	#FG.TXT,R1
	BR	EDSTRM
;
;
LITCMD:	CALL	TVOID
	CLR	-(SP)
	BR	4$
;
CL1CMD:	CALL	TVOID
	MOV	#-1,-(SP)
4$:	MOV	#CF.LIT,R1
	BR	EDCTRL
;
.DSABL	LSB
;
;
;
; UPDATE - PERFORM A LOOKUP FOR NEW MACROS
;
UPDATE:	CALL	TVOID
	CALL	FIND
	JMP	VOID
;
;
; GETCMD - GET A VALUE RECORDED BY A LOWER TASK STREAM
;
;	I=GET		WAITS FOR A RECORD AND ASSIGNS THE VALUE TO I
;	GETIF		VOIDS ANY CURRENTLY RECORDED VALUE
;
;
GETCMD:	CLR	R2		;FLAG 'GET' ENTRY
	BR	GET
;
GTFCMD:	CALL	TVOID
	MOV	#1,R2		;FLAG GETIF ENTRY
;
GET:	TST	EXEC		;ANYTHING HAPPENING ?
	BNE	2$
	MOV	STREAM,R1	;GET OUR STREAM POINTER
	MOV	SL.FWD(R1),R1	;GO TO NEXT ONE DOWN
	MOV	PROC,R0
	ADD	#PL.SLH,R0	;GET STREAM LIST HEAD
	CMP	R1,R0		;BOTTOM OF STREAM LIST ?
	BEQ	1$		;IF SO - ERROR
	CMP	SL.STA(R1),#TS.EXT;STREAM EXITED ?
	BNE	3$		;SKIP IF NOT
1$:	ERROR$	#E.GET		;GET IS INVALID
2$:	JMP	VOID
;
3$:	MOV	SL.RLH(R1),R0	;GET RECORDED ITEM IF ANY
	BEQ	4$		;SKIP IF NULL
	CLR	SL.RLH(R1)	;RESET RECORD POINTER
	TST	R2
	BEQ	35$
	CALL	VOIDSP
	JMP	VOID
35$:	JMP	VALUED		;ELSE RETURN THE VALUE
;
4$:	TST	R2		;DO WE HAVE TO WAIT ?
	BEQ	5$		;SKIP IF SO
	JMP	VOID		;ELSE JUST RETURN
;
5$:	PAUSE$	#TS.GET		;NOTHING THERE YET SO PAUSE
	BR	GETCMD
;
;
; RPYGET - REPLY A VALUE AND PERFORM A GET
;
;	A=[<EXPRESSION>]
; HAS THE SAME EFFECT AS:	REPLY <EXPRESSION>   A=GET
;
; THIS FUNCTION IS INTENDED AS A MEANS OF INTERROGATING A PROGRAM
; TO OBTAIN PARAMETERS.
;
RPYGET:	MOV	#O.VALU,R1	;SET CONTEXT FOR ARGUMENT
	CALL	VALEXP		;AND PARSE IT
	CALL	RPLY		;REPLY RESULT
	CALL	GETSYM		;READ TERMINATOR
	CMP	R1,#LEXCMD
	BNE	1$
	CMP	R0,#C.SQK	;CHECK ITS ']'
	BNE	1$
	MOV	#O.VALU,R1	;SET VALUED CONTEXT
	CALLR	GETCMD		;GO DO GET
;
1$:	CALL	PTBACK		;UN-READ TERMINATOR
	ERROR$	#E.SYN
	JMP	VALUED
;
;
; SQKCMD - ILLEGAL RIGHT ']'
;
SQKCMD:	ERROR$	#E.SYN
	JMP	VOID
;
;
; MCRCMD - PARSE AN MCR BLOCK
;
;	MCR <EXPRESSION>
;
; STRING EXPRESSION IS REPLIED TO MCR
;
;
MCRCMD:	CALL	TVOID
	MOV	STREAM,R1
	MOV	SL.FLG(R1),-(SP) ;SAVE OLD STREAM FLAGS
	BIS	#FG.MCR,SL.FLG(R1) ;ENABLE MCR MODE
	MOV	#O.BIND,R1	;PARSE THE MCR STRING
	CALL	VALEXP
	CALL	RPLY
	BIT	#FG.MCR,(SP)+	;WERE WE ALREADY IN MCR MODE ?
	BNE	1$
	MOV	STREAM,R1
	BIC	#FG.MCR,SL.FLG(R1); DISABLE MCR MODE
1$:	BR	VOID
;
;
;
; LOCAL - LOCAL VARIABLE DECLARATION
;
; 	LOCAL A[,B,C...]
; OR	LOCAL A=<EXP>,B=<EXP>...
;
;
LOCAL:	CALL	TVOID		;CHECK VOID CONTEXT
1$:	CALL	GETPNT		;POINT TO ARGUMENT
	CALL	PRSSYM		;AND PARSE IT
	CMP	R2,#LEXNAM	;CHECK ITS A NAME
	BEQ	3$		;SKIP IF SO
	CMP	R2,#LEXSEP	;IS IT A SEPARATOR
	BNE	2$		;ERROR IF NOT
	CMP	R3,#LEXEOL	;IF SO IT HAD BETTER BE END OF LINE
	BNE	2$		;IF NOT THATS TOO BAD
	CALL	PUTPNT		;UPDATE POINTER
	BR	1$		;AND SKIP IT
2$:	ERROR$	#E.SYN		;ELSE ITS AN ERROR
	JMP	VOID
;
3$:	TST	EXEC		;ANYTHING HAPPENING ?
	BNE	5$		;SKIP IF NOT
	MOV	STREAM,R3	;GET CURRENT STREAM
	MOV	SL.STB+4(R3),R2	;GET CURRENT SYMBOL TABLE POINTER
	MOV	BLOCKP,R3	;GET OUR STACK FRAME POINTER
	MOV	SF.STB(R3),R3	;GET END OF OUR STACK RANGE
	CALL	LOOK1		;LOOK UP THE NAME AT THIS LEVEL
	BCC	5$		;SKIP IF WE FIND IT
;
	CALL	NEWVAL		;CREATE THE NEW VARIABLE
;
5$:	CLR	R1		;INIT CONTEXT
	CALL	VALEXP		;PARSE THE INITIALIZATION
	CALL	VOIDSP		;RELEASE ANY RESULT
	CALL	GETSYM		;GET THE EXPRESSION TERMINATOR
	CMP	R1,#LEXSEP	;IS IT A SEPERATOR ?
	BNE	6$		;SKIP IF NOT
	CMP	R0,#LEXEOL	;END OF LINE ?
	BEQ	7$		;END OF STATEMENT
	BR	1$		;GO GET NEXT TERM
;
6$:	CALL	PTBACK		;PUT BACK NON-SEPERATING TERMINATOR
7$:	JMP	VOID
;
;
;
;
; VOID - EXIT FROM PRSCMD WITH NO RESULT
;
VOID:	CLR	R0
	RETURN
;
;
; VALUED - EXIT FROM PRSCMD WITH A RESULT
;
VALUED:	TST	EXEC		;RESULT VALID ?
	BEQ	1$
	CLR	R0
1$:	RETURN
;
;
; TVOID - CHECK THAT CONTEXT IS VOID
;
TVOID:	TST	R1
	BEQ	1$
	CMP	R1,#O.BIND
	BEQ	1$
	ERROR$	#E.SYN
1$:	RETURN
.PAGE
;+
; PRSARG - PARSE A FUNCTION ARGUMENT LIST
;
; ARGUMENT LIST SYNTAX:	(EXP1,EXP2,...EXPN)
;
; IF THE FIRST SYMBOL IS NOT '(' THE LIST IS DEEMED NULL.
; UP TO 16 ARGUMENTS ARE PERMITTED, ANY ONE OF WHICH MAY BE INDICATED NULL
; BY TWO CONSECUTIVE COMMAS.
;
; INPUT:	STREAM CONTEXT, USER STACK
;
; OUTPUT:	R3	ADDRESS OF ARGUMENT BLOCK
;			OR ZERO IF NO ARGUMENTS.
; REGISTERS MODIFIED: R3,R4,R5
;
;
; THE ARGUMENT BLOCK FORMAT IS:
AMAX=16.
AB.CNT==4	;NUMBER OF ARGUMENTS (# COMMAS MINUS ONE)
AB.PNT==6	;CURRENT POINTER IN LIST
AB.ARG==10	;START OF ARGUMENT POINTERS
		;ONE WORD PER ARGUMENT POINTS TO THE VALUE ITEM
		;NULL ARGUMENTS HAVE ZERO POINTERS.
AB.SIZ==AMAX+<AB.ARG/2>
;
;-
;
PRSARG::MOV	R0,-(SP)
	MOV	R1,-(SP)
	MOV	R2,-(SP)
	CLR	-(SP)		;INIT RESULT
	CALL	GETSYM		;GET THE NEXT SYMBOL
	CMP	R1,#LEXCMD	;IS IT A COMMAND ?
	BNE	1$		;SKIP IF NOT
	CMP	R0,#C.BEG	;IS IT '('
	BEQ	2$
1$:	CALL	PTBACK		;UNREAD WHATEVER IT WAS
	BR	20$		;AND QUIT
;
2$:	TST	EXEC		;ARE WE DOING ANYTHING
	BNE	10$		;SKIP IF NOT
	MOV	#AB.SIZ,R1	;ALLOCATE AN ARGUMENT BLOCK ITEM
	CALL	GETSPA
	BCS	20$		;SKIP IF ALLOCATION FAILS
	MOV	R0,(SP)		;SAVE ARGUMENT BLOCK POINTER
	MOV	R0,R1		;COPY POINTER
	ADD	#AB.ARG,R1	;OFFSET TO START OF LIST
	MOV	R1,AB.PNT(R0)	;INIT LIST POINTER
;
10$:	TST	EXEC		;HOW DO THINGS LOOK
	BMI	20$		;IF THEY ARE THAT BAD BREAK
	CALL	GETSYM		;GET THE NEXT SYMBOL
	CMP	R1,#LEXCMD	;CHECK FOR ')'
	BNE	11$
	CMP	R0,#C.END
	BEQ	20$
11$:	CMP	R1,#LEXSEP	;DO WE HAVE A SEPERATOR ?
	BNE	13$		;IF NOT SKIP
	CMP	R0,#LEXEOL	;END OF LINE ?
	BEQ	10$		;IF SO SKIP IT
	CLR	R0		;ITS A NULL ARGUMENT
	BR	14$		;NO EXPRESSION TO PARSE
13$:	CALL	PTBACK		;REPLACE WHATEVER IT WAS
	MOV	#O.VAL2,R1	;CONTEXT FOR A VALUED EXPRESSION
	CALL	VALEXP		;PARSE THE ARGUMENT VALUE
14$:	MOV	(SP),R2		;GET BACK THE ARGUMENT BLOCK
	BEQ	15$		;SKIP IF NULL
	CMP	AB.CNT(R2),#AMAX;ANY ROOM IN BLOCK ?
	BLT	17$		;SKIP IF SO
	ERROR$	#E.TMFA		;TOO MANY FUNCTION ARGUMENTS
	BR	15$
17$:	MOV	R0,@AB.PNT(R2)	;RETURN VALUE POINTER
	INC	AB.CNT(R2)	;COUNT THE VALUE
	ADD	#2,AB.PNT(R2)	;AND BUMP POINTER
15$:	CALL	GETSYM		;CLEAR TRAILING SEPERATORS
	CMP	R1,#LEXSEP	;WHAT TERMINATED THE ARGUMENT ?
	BNE	16$		;IF NOT A SEPERATOR PUT IT BACK
	CMP	R0,#LEXEOL	;END OF LINE ?
	BEQ	15$		;IF SO IGNORE IT
	BR	10$		;ELSE SKIP SEPERATOR
16$:	CALL	PTBACK		;BUT PUT ANYTHING ELSE BACK
	BR	10$
;
20$:	MOV	(SP)+,R3	;RESTORE ARGUMENT ITEM
	BEQ	21$		;SKIP IF ITS NULL
	MOV	R3,AB.PNT(R3)	;RESET LIST POINTER
	ADD	#AB.ARG,AB.PNT(R3)
21$:	MOV	(SP)+,R2
	MOV	(SP)+,R1
	MOV	(SP)+,R0
	TST	EXEC		;CLEAN UP AFTER AN ERROR
	BNE	ENDARG		;BY UNDOING WHAT WE JUST DID
	RETURN
;
;
;
; ENDARG - DEALLOCATE AN ARGUMENT LIST
;
; INPUT:	R3	ARGUMENT LIST POINTER
;
; OUTPUT:	THE ARGUMENT ITEM AND ANY ASSOCIATED VALUES ARE DEALLOCATED
;		R3=0
;
; REGISTERS MODIFIED:	R3
;
ENDARG::TST	R3		;ANYTHING TO DO ?
	BEQ	10$		;IF NOT JUST QUIT
	MOV	R0,-(SP)	;SAVE R0
	MOV	R3,-(SP)	;SAVE ARGUMENT LIST POINTER
	MOV	AB.CNT(R3),-(SP);PUSH ARGUMENT COUNTER
	ADD	#AB.ARG,R3	;OFFSET TO FIRST ARGUMENT
;
1$:	DEC	(SP)		;ONE LESS ARGUMENT
	BMI	2$		;BREAK IF NO MORE
	MOV	(R3)+,R0	;GET NEXT ARGUMENT ITEM
	CALL	VOIDSP		;DEALLOCATE ITEM IF TEMPORARY
	BR	1$
;
2$:	TST	(SP)+		;POP THE COUNTER
	MOV	(SP)+,R0	;GET BACK ARGUMENT ITEM ADDRESS
	CALL	FREESP		;DEALLOCATE ARGUMENT BLOCK
	MOV	(SP)+,R0	;RESTORE R0
10$:	CLR	R3
	RETURN
.PAGE
; THIS IS THE PERMENANT NAME TABLE
;
.PSECT	SYMTBL
;
PSTAB::	STBDF$	"REPLY",C.RPLY
	STBDF$	"PRINT",C.PRNT
	STBDF$	"BEGIN",C.BEG
	STBDF$	"END",C.END
	STBDF$	"IF",C.IF
	STBDF$	"THEN",C.THEN
	STBDF$	"ELSE",C.ELSE
	STBDF$	"REPEAT",C.RPT
	STBDF$	"BREAK",C.BRK
	STBDF$	"LOOP",C.LOOP
	STBDF$	"NEXT",C.LOOP
	STBDF$	"STOP",C.STOP
	STBDF$	"REQUEST",C.ASK
	STBDF$	"ASK",C.ASK
	STBDF$	"ASKN",C.ASKN
	STBDF$	"CALL",C.CALL
	STBDF$	"RETURN",C.RTN
	STBDF$	"SUSPEND",C.SUS
	STBDF$	"RESUME",C.RES
	STBDF$	"RUN",C.RUN
	STBDF$	"SYS",C.SYS
	STBDF$	"TRACE",C.TRA
	STBDF$	"NOTRACE",C.NTRA
	STBDF$	"LOG",C.LOG
	STBDF$	"NOLOG",C.NLOG
	STBDF$	"TEXT",C.TXT
	STBDF$	"NOTEXT",C.NTXT
	STBDF$	"UPDATE",C.UPD
	STBDF$	"GET",C.GET
	STBDF$	"GETIF",C.GTF
	STBDF$	"DO",C.DO
	STBDF$	"FOR",C.FOR
	STBDF$	"MCR",C.MCR
	STBDF$	"LITERAL",C.LIT
	STBDF$	"CLONE",C.CL1
	STBDF$	"PASS",C.PASS
	STBDF$	"UNLESS",C.UNL
	STBDF$	"STACK",C.STAC
	STBDF$	"LOCAL",C.LOC
	STBDF$	"ENABLE",C.ENA
	STBDF$	"DISABLE",C.DIS
	STBDF$	"SUBROUTINE",C.SUB
	STBDF$	"ARGUMENTS",C.ARG
	.WORD	0
;
; NOW DEFINE THE INTERNAL FUNCTIONS
; FUNCTION CODES ARE DEFINED IN MODULE: FUNOVL
;
FUNTAB::STBDF$	"$LEN",F.LEN
	STBDF$	"$LOC",F.LOC
	STBDF$	"$SEG",F.SEG
	STBDF$	"$DEF",F.DEF
	STBDF$	"$NARG",F.NARG
	.WORD	0
;
;
	.END