/3 Q-OVERLAY TO TECO

/ 08-APR-79	ADDED ELSE SUPPORT
/ 10-APR-79	FIXED BUG HAVING TO DO WITH Y<...>
/			SINCE < WASN'T TESTING NFLG PROPERLY

	.ENABLE 7BIT

	.MACRO	.ERROR	ERNUM
	.GLOBAL ERR'ERNUM
ERR'ERNUM:	ERR
	.ENDM

	.MACRO	.SORT	ARG1,ARG2
	SORT;	ARG1;	ARG2-ARG1
	.ENDM

	MTWO=CLL STA RAL
	.EXTERNAL IOVRLC,EOVRLC,XOVRLC,FOVRLC
	.EXTERNAL SORT,PUSHJ,TESTD,ERR,SORTA1
	.ZTERNAL SCANP,NFLG,ITRST,QUOTE,QBASE,QP,MQ,CAAM,ZIREST
	.EXTERNAL QSKP,SKPSET,GETQ,QUOTST,ENTRCE,NOTRCE,SCANUP,SCAN
	.ZTERNAL SCHAR,Z77,NLINK,ITRCNT,N,LASTC
	.EXTERNAL TESTA,TSTSEP,NCHK,GETNUM,POPJ,RESORT,NCHK,ZRON
	.EXTERNAL PUSHL,ZROSPN,POPL,IREST

	.GLOBAL QOVRLY,CHR.O,CDBQ,CSEM,CHGT,CHLT,SETSKP,VBARE

	.ASECT	TECOVQ

	*5600

	RELOC 3200

	IOVRLC
QOVRLY,	0
	EOVRLC
	XOVRLC
	FOVRLC

	.SBTTL	Cmd O

CHR.O,
/+	TAD	QFLG
/+	SZA CLA
/+	IAC		/ONE MORE IF QUOTED
	TAD	SCANP	/O COMMAND
	DCA	COOQ	/SAVE CURRENT SCAN POINTER
	DCA	NFLG
	QSKP		/CHECK THAT THERE IS REALLY A STRING HERE
			/BECAUSE WE WILL NOT USE "SCAN" TO GET CHARACTERS
			/FROM THIS STRING IN THE SEARCH LOOP.
/+	STA
/+	TAD	SCANP
/+	CIA
/+	DCA	ENDO
	TAD	ITRST	/"O" ONLY SCANS FROM THE BEGINNING OF THE
	DCA	SCANP	/CURRENT ITERATION LOOP.
			/(JUMPS BACKWARD OUT OF ITERATIONS ARE VERBOTEN)
	SKPSET
41$:		41	/SEARCH FOR !
	TAD	41$
	DCA	QUOTE	/SET QUOTE CHAR TO !
/+	QCHK
	TAD	COOQ
	TAD	QBASE
	DCA	QP	/SET UP PTR TO ACCESS GOTO STRING
1$:	TAD	QP
	GETQ		/GET CHAR FROM GOTO STRING
	CIA
	DCA	MQ	/SAVE IT
	QUOTST		/GET CHAR FROM LABEL
	JMP	2$	/LABEL EXHAUSTED
	TAD	MQ
	SZA CLA		/MATCH?
	JMP	CSMQ	/NO - REJOIN SEARCH ROUTINE FOR ANOTHER !
	ISZ	QP
	JMP	1$
2$:
/+	TAD	QP
/+	TAD	ENDO
/+	ABOVE TWO LINES REPLACE NEXT TWO LINES
	TAD	MQ
	TAD	CAAM	/IS GOTO STRING EXHAUSTED TOO?
	SZA CLA
	JMP	CSMQ1	/NO - REJOIN ! SEARCH ROUTINE
	ENTRCE		/RE-ENABLE TRACE
	JMP I	ZIREST
COOQ,	0
/+ENDO,	0		/NEG OF END OF GOTO STRING

/+	THESE LINES REPRESENT (BUGGY) CODE TO ALLOW @O

/ROUTINE TO SKIP COMMANDS UP TO A CHARACTER

SETSKP,	0		/SET UP TO SKIP COMMANDS
	TAD I	SETSKP
	DCA	SKPLST	/CHAR TO TRAP ON
	NOTRCE		/DISABLE TRACE MODE
CSML1,	DCA	BRACKS	/INITIALIZE BRACKET LEVEL
CSML,	SCANUP		/GET A COMMAND CHAR
CSML2,	.SORT	SKPLST,SKPTAB
	JMP	CSML	/NOTHING SPECIAL - KEEP GOING
CSMD,	SCAN		/CLEAR OUT MODIFIER
	JMP	CSML

CSMU,	SCAN		/SKIP ^U COMMAND
	SKP CLA		/GET RID OF Q-REG NUMBER
CSMFS,	QSKP		/FS COMMAND - SKIP FIRST STRING
CSMQ,	QSKP		/SKIP OVER A QUOTED STRING
CSMQ1,	PUSHJ
		IREST	/FIX UP QUOTE CHAR
	JMP	CSML	/KEEP GOING

CSMY,	TAD	SCHAR	/SKIP ROUTINE FOR ^A AND !
	DCA	QUOTE	/WE MUST SCAN UNTIL WE FIND
	JMP	CSMQ	/A COPY OF THE COMMAND CHARACTER.

	/SORT LIST FOR " COMMAND

CNDLSA,	"A
	"D
	"N
	"E
	"C
	"G
	"L
	"T		/=L
	"F		/=E

/	PARALLEL LIST 'CNDLSB' IS ON NEXT PAGE

CSME,	SCANUP		/FOUND E COMMAND
	.SORT	ESKLST,ESKTAB	/LOOK FOR ER, EW, EG, AND EB (USE CSMQ TO SKIP)
	JMP	CSML	/NO STRING

CSMI,	ISZ	BRACKS	/INCREMENT BRACKET LEVEL
	JMP	CSML

CSMO,	STA
	TAD	BRACKS	/DECREMENT BRACKET LEVEL
	SPA
	JMS I	(POPITR	/IF WE EXIT <> POP OFF ITERATION VALUES
	JMP	CSML1

CSMB,	TAD	LASTC	/GET CHARACTER BEFORE IT WAS TRANSLATED TO UPPER CASE
	TAD	(-"|	/SEE IF IT WAS A VERTICAL BAR
	SNA CLA		/IF NOT, IT WAS A \ AND JUST SCAN PAST IT
	TAD	SKPLST	/IF SO, IT  IS PROBABLY THE ELSE CLAUSE
	TAD	(-"'
	SZA CLA
	JMP	CSML
SKPRTN,	TAD	BRACKS	/WE HAVE FOUND THE DESIRED CHARACTER
	SZA CLA		/BUT IF THE BRACKET LEVEL IS NON-ZERO,
	JMP I	(SORTA1	/WE CANNOT ACCEPT IT - KEEP SORTING
			/WE MUST USE SORTA1 RATHER THAN RESORT IN CASE OF >
	JMP I	SETSKP	/EVERYTHING IS OK - RETURN

BRACKS,	0

/SORT LIST FOR SKIPPING OVER COMMANDS

SKPLST,	0	/TRAP CHAR
	41	/!
	76	/>
	74	/<
	42	/"
	136	/^
	100	/@
	1	/^A
	11	/TAB
	25	/^U
	36	/^^
	105	/E
	106	/F
	111	/I
	116	/N
	117	/O
	123	/S
	137	/_
	121	/Q
	125	/U
	130	/X
	107	/G
	115	/M
	45	/%
	134	/\ or |

CSMF,	SCAN		/F COMMAND - BETTER BE FOLLOWED BY S,N, OR _
	CLA
	JMP	CSMFS	/SCAN OFF TWO STRINGS

CSMA,	STA		/LIST TERMINATOR
	JMP	CSMQ1	/FOUND @ - SET QUOTE FLAG AND CONTINUE

CSMC,	SCANUP		/GET NEXT CHARACTER IN UPPER CASE
	AND	Z77	/MAKE IT A CONTROL CHARACTER
	JMP	CSML2	/SUBSTITUTE IT FOR THE UPARROW

/TSTW,	0		/TEST FOR UPPER CASE ALPHABETIC
/	TAD	(-101
/	CLL
/	TAD	(-26.
/	SNL CLA
/	ISZ	TSTW
/	JMP I	TSTW
	PAGE

/DISPATCH TABLE FOR SKIPPING OVER COMMANDS:

SKPTAB,	SKPRTN	/DESIRED CHARACTER - RETURN
	CSMY	/!
	CSMO	/>
	CSMI	/<
	CNDI	/"
	CSMC	/^
	CSMA	/@
	CSMY	/^A
	CSMQ	/TAB
	CSMU	/^U
	CSMD	/^^
	CSME	/E
	CSMF	/F
ESKTAB,	CSMQ	/I OR ER
	CSMQ	/N OR EW
	CSMQ	/O OR EB
	CSMQ	/S OR EG
	CSMQ	/_
	CSMD	/Q
	CSMD	/U
	CSMD	/X
	CSMD	/G
	CSMD	/M
	CSMD	/%
	CSMB	/|

CNDI,	SCAN		/HIT ANOTHER "
	CLA
	TAD I	(BRACKS
	SNA CLA
	STA		/SO SKIP MATCHING '
	TAD	SKIP
	DCA	SKIP
	RESORT		/GO BACK TO CSML

	.SBTTL	Cmd ;

CSEM,	TAD	ITRST	/COMMAND ; - ALSO HERE ON FAILING NON-COLON SEARCH
	SNA CLA
	.ERROR	09	/IF NOT IN ITERATION
	TAD	NLINK
	SNA CLA
	NCHK		/SKIP IF NUMBER
	JMP I	(ZRON	/NO NUMBER - IGNORE IT, WE DID IT ALREADY
			/FALL INTO SEMO AND SEARCH FOR >
SEMO,	SKPSET		/PLOD THRU
		76	/LOOKING FOR >
	ENTRCE		/IT'S THE RIGHT ONE, TURN TRACE BACK ON
	JMP	CGSG

/	SKIP LIST FOR E'S
ESKLST,	"R		/R
	"W		/W
	"B		/B
	"G		/G

/ENTRIES MUST BE NEGATIVE:

CNDTAB,	TESTA		/A	ALPHABETIC
	TESTD		/D	DIGIT
/	TSTW		/W	UPPER CASE ALPHABETIC
	SNA CLA		/N	NE 0
CNDTB2,	SZA CLA		/E =	EQ 0
	TSTSEP		/C R	SYMBOL CONSTITUENT
	SZL SNA CLA	/G >	GT 0
	SNL CLA		/L <	LT 0
	SNL CLA		/T S	TRUE
	SZA CLA		/F U	FALSE

/THIS TABLE PRESUPPOSES 1000000000000 IS ILLEGAL

	.SBTTL	Cmd "

CDBQ,	NCHK		/COMMAND "
	.ERROR	23	/NO NUMBER TO TEST
	SCANUP
	.SORT	CNDLSA,CNDTAB
	SPA
	JMP	B$
	.SORT	CNDLSB,CNDTB2
	SMA		/CHECK THAT CHAR WAS TRANSLATED
	.ERROR	20	/NO - NO SUCH TEST
B$:	DCA	SKIP	/STORE TEST INSTRUCTION
	GETNUM		/PERFORM THE TEST
SKIP,	HLT		/TEST SKIPS IF TRUE
	JMP	VBARE	/AC MAY BE NON-0
	CLA		/FROM CALL TO TESTA
	POPJ		/CONDITION SATISFIED

	.SBTTL	Cmd |

VBARE,	STA		/NOT SATISFIED
	DCA	SKIP	/BEGINNING SKIPPING COMMANDS
	SKPSET		/CALL SKIPPING ROUTINE
		47	/FIND A '
	ISZ	SKIP	/FOUND A '
	RESORT		/NEED ANOTHER: BACK TO CSML
	ENTRCE		/RE-ENABLE TRACE
	JMP I	ZIREST	/COMMAND ' NO ACTION TO TAKE

	.SBTTL	Cmd >

CHGT,	TAD	ITRCNT
	SNA CLA
	JMP	CGTC	/0 MEANS INFINITY
	ISZ	ITRCNT	/LOOK FOR COUNT EXHAUSTED
	JMP	CGTC	/NO, CONTINUE
CGSG,	JMS	POPITR	/POP UP OLD ITERATION PARAMETERS
	JMP I	ZIREST
CGTC,	TAD	ITRST
	SNA
	.ERROR	10	/IF NOT IN ITERATION
	JMP I	(ZROSPN	/BACK TO ROOT

POPITR,	0
	CLA IAC		/** AC NOT NECESSARILY 0 ON ENTRY
	POPL
		ITRCNT
		ITRST
	JMP I	POPITR

CNDLSB,
/	"W		/UPPER CASE ALPHABETIC
	"=		/=E
	"R		/=C
	">		/=G
	"<		/=L
	"S		/=T
	"U		/=F

	.SBTTL	Cmd <

CHLT,	MTWO		/COMMAND <
	PUSHL
		ITRST
		ITRCNT
	NCHK		/WAS A NUMBER SPECIFIED?
	JMP	1$	/NO, ASSUME INFINITY
	TAD	NLINK	/YES
	SNA CLA
	TAD	N
	SNA
	JMP	SEMO	/0 OR NEGATIVE MEANS SKIP ITERATION
	CIA		/MAKE NEGATIVE
1$:	DCA	ITRCNT	/SET UP TERMINATION
	TAD	SCANP	/SAVE CURRENT SCAN PNTR
	DCA	ITRST	/ALWAYS .GE. 1 IN ITERATION
	DCA	NFLG	/CLEAR NUMBER FLAG
	POPJ
	PAGE
	RELOC