Google
 

Trailing-Edge - PDP-10 Archives - BB-H506E-SM - cobol/source/mscgen.mac
There are 21 other files named mscgen.mac in the archive. Click here to see a list.
; UPD ID= 3504 on 4/30/81 at 3:17 PM by WRIGHT                          
TITLE	MSCGEN FOR COBOL V12C
SUBTTL	MISCELANEOUS CODE GENERATORS	AL BLACKINGTON/CAM



	SEARCH	COPYRT
	SALL

;COPYRIGHT (C) DIGITAL EQUIPMENT CORPORATION 1974, 1985
;ALL RIGHTS RESERVED.
;
;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY BE USED AND COPIED
;ONLY  IN  ACCORDANCE  WITH  THE  TERMS  OF  SUCH LICENSE.

	SEARCH	P
	XPNTST==:XPNTST
	%%P==:%%P

;EDITS
;V12*****************
;NAME	DATE		COMMENTS

;DAW	30-APR-81	[1127] INSPECT /REPLACING ITEM WITH SPACES GOT
;			?BAD LITAB CODE IF THE ITEM ENDED ON A WORD BOUNDARY.
;DMN	 1-APR-80	[1004] MAKE ASCII & EBCDIC COLLATING SEQUENCES WORK.
;DAW	13-SEP-79	[732] FIX "SET" GENERATING BAD CODE SOMETIMES IN COBOL-74

;V12A SHIPPED
;	16-SEP-78	[547] FIX EXAMINE REPLACING HIGH-VALUES BY

;V10*****************
;NAME	DATE		COMMENTS
;	6-APR-76	[421] EXAMINE REPLACE BY HIGH-VALUES
;ACK	25-MAY-75	DISPLAY-9 CODE FOR EXAMINE.
;********************

;**; EDIT 427 FIX FIELD SIZE FOR EXAMINE REPLACING.
;**; EDIT 243 IF ERROR IN SEARCH ITEM, AVOID EXTRA ERROR MSG HERE.
;**; EDIT 164 SEARCH ALL WITH DEPENDING ITEM FIX
TWOSEG
	.COPYRIGHT		;Put COPYRIGHT statement in .REL file.

RELOC	400000
SALL

IFN ANS68,<ENTRY EXAMGN	;"EXAMINE">
IFE ANS68,<ENTRY INSPGN	;"INSPECT" START
	ENTRY  INSPTG	;" INSPECT TALLYING"
	ENTRY	INSPRG	; "INSPECT REPLACING"
>;END IFE ANS68

ENTRY TRCGEN	;"TRACE"

ENTRY SRCHGN	;"SEARCH"
ENTRY SINCGN	;"SINCR"
IFN CSTATS,<
ENTRY METGEN	;"METER--JSYS"
>
ENTRY	CBPHE	;"COMPILER-BREAK-ON-PHASE.."
INTERN	GETTEM		;ROUTINE TO GET SOME LOCS IN TEMTAB
INTERN	MVAUN0		;MOVE "A" TO UNSIGNED %TEMP

MSCGEN::
SUBTTL GENERATE CODE FOR "EXAMINE"

IFN ANS68,<
EXAMGN:	SWOFF	FEOFF1		;TURN OFF FLAGS
	MOVEM	W1,OPLINE
	HRRZ	TC,EOPLOC
	ADDI	TC,1
	MOVEM	TC,CUREOP
	HRLZM	TC,OPERND

	MOVEI	LN,EBASEA	;SET UP "A" PARAMETERS
	PUSHJ	PP,SETOPN
	TSWF	FERROR		;ANY ERRORS YET?
	POPJ	PP,		;YES--QUIT

	HRRZ	TA,EMODEA
	CAIG	TA,DSMODE
	JRST	EXMGN2

;ITEM TO BE EXAMINED IS NOT DISPLAY--ERROR

	MOVEI	DW,E.211
	JRST	OPNFAT

;ITEM TO BE EXAMINED IS DISPLAY

EXMGN2:	PUSHJ	PP,SUBSCA	;CALL SUBSCRIPTOR, IF NECESSARY
	TSWF	FASUB		;IS IT SUBSCRIPTED?
	JRST	EXMGN3		;YES

	MOVE	TA,[XWD BYTLIT,2]
	PUSHJ	PP,STASHP
	PUSHJ	PP,MBYTPA
	PUSHJ	PP,POOL
	MOVE	CH,[XWD ASINC+EXAM.,AS.MSC]
	PUSHJ	PP,PUTASY
	SKIPN	CH,PLITPC
	HRRZ	CH,ELITPC
	IORI	CH,AS.LIT
	PUSHJ	PP,PUTASN
	SKIPN	PLITPC
	AOS	ELITPC
	JRST	EXMGN4

EXMGN3:	MOVE	CH,[XWD EXAM.,SXR]
	PUSHJ	PP,PUTASY
;PUT OUT THE XWD WHICH FOLLOWS THE UUO

EXMGN4:	MOVE	CH,[XWD AS.XWD,1]
	PUSHJ	PP,PUTASY

	MOVE	TA,CUREOP	;[427] GET CURRENT OPERATOR
	MOVE	TA,1(TA)	;[427] SET UP TABLE ADDRESS
	PUSHJ	PP,LNKSET	;[427] DO IT
	LDB	CH,DA.EXS	;[427] GET EXTERNAL SIZE FOR EXAMINE
	HRLZ	CH,CH		;[427] INSTEAD OF INTERNAL SIZE FROM SETOPN

	TSWF	FANUM		;IS IT NUMERIC?
	TLO	CH,1B18		;YES--SET FLAG
	HRRI	CH,AS.CNB
	LDB	TA,[POINT 4,W1,12]
	DPB	TA,[POINT 4,CH,5]
	PUSHJ	PP,PUTASN
	HRLI	CH,0
	PUSH	PP,CH		;SAVE PARAMETER
	PUSHJ	PP,EXMGN8
	DPB	TB,[POINT 9,(PP),8]
	TLNN	W1,REPLAC
	JRST	EXMGN6
	PUSHJ	PP,EXMGN8
	DPB	TB,[POINT 9,(PP),17]

EXMGN6:	POP	PP,CH		;GET PARAMETER BACK
	HRRI	CH,AS.CNB
	PUSHJ	PP,PUTASN
	TLNN	W1,TALYNG
	POPJ	PP,
	MOVE	CH,[XWD MOVEM.,TALLY.]
	JRST	PUT.EX
;LOOK AT TALLYING OR REPLACING LITERAL.
;EXIT WITH VALUE OF LITERAL IN 'TB'.

EXMGN8:	PUSHJ	PP,BMPEOP	;GO TO NEXT OPERAND
	JRST	BADOPN		;THERE WASN'T ONE--ERROR

	MOVE	TA,ETABLA	;FIND DATAB ENTRY
	PUSHJ	PP,LNKSET
	HRRZM	TA,CURDAT

	MOVE	TB,CUREOP
	HRRZ	TD,EMODEA
	MOVE	TC,0(TB)
	TLNN	TC,GNFIGC
	JRST	EXMGN9

	TLNN	TC,GNFCS!GNFCZ!GNFCQ!GNFCHV!GNFCLV
	JRST	BADLIT

	TLNE	TC,GNFCS	;SPACE?
	MOVEI	TB," "
	TLNE	TC,GNFCZ	;ZERO?
	MOVEI	TB,"0"
	TLNE	TC,GNFCQ	;QUOTE?
	MOVEI	TB,42
	TLNE	TC,GNFCLV	;LOW-VALUE?
	MOVEI	TB,0
	TLNE	TC,GNFCHV	;HIGH-VALUE?
	MOVEI	TB,177

	JRST	EXMG9A
EXMGN9:	MOVE	TA,1(TB)	;IS IT A SIZE 1 LITERAL?
	PUSHJ	PP,LNKSET
	LDB	TC,[POINT 7,(TA),6]
	CAIE	TC,1
	JRST	BADLIT		;NO--ERROR

	LDB	TB,[POINT 7,(TA),13]	;YES--PICK UP VALUE OF LITERAL

EXMG9A:	TSWF	FANUM		;IS FIELD NUMERIC?
	JRST	EXGN10		;YES
	MOVE	TA,CURDAT
	LDB	TC,DA.CLA	;NO--ALPHABETIC?
	CAIN	TC,1
	JRST	EXGN12		;YES

EXMG9B:	CAIN	TB,177		;[547] ALLOW HIGH-VALUES
	JRST	EXMG9H		;[547] GO TO HIGH-VALUES RETURN
	JUMPE	TB,CPOPJ	;[547] ALLOW LOW VALUES, GO LOW-VALUES RETURN

	CAIE	TD,D6MODE
	JRST	EXMG9I		;NOT SIXBIT, GO SEE WHAT IT IS.

	CAIGE	TB,140
	CAIGE	TB,40
	JRST	BADMOD

EXMG9C:	SUBI	TB,40
	POPJ	PP,

;"HIGH-VALUES" -- CONVERT TO HIGH-VALUES IN THE RIGHT MODE.
EXMG9H:	HLRZ	TB,HIVQOT##(TD)	;[547] GET HIGH-VALUES IN THE RIGHT MODE
	POPJ	PP,		;[547] AND RETURN.

EXMG9I:	CAIE	TD,D9MODE	;IS IT DISPLAY-9?
	POPJ	PP,		;NO, MUST BE DISPLAY-7.

	EXCH	TB,TE		;SET UP TO CONVERT TO DISPLAY-9.
	PUSHJ	PP,VLIT8.	;GO CONVERT THE CHAR.
	EXCH	TB,TE		;RESTORE THE AC'S.
	POPJ	PP,		;AND RETURN.
EXGN10:	CAIG	TB,"9"		;"A" IS NUMERIC--IS THE LITERAL?
	CAIGE	TB,"0"
	JRST	BADCLS		;NO
	JRST	EXMG9B		;YES

EXGN12:	CAIG	TB,"Z"		;"A" IS ALPHABETIC--IS THE LITERAL?
	CAIGE	TB,"A"
	CAIN	TB," "
	JRST	EXMG9B

;ERROR ROUTINES

BADCLS:	MOVEI	DW,E.211
	JRST	OPNFAT

BADMOD:	MOVEI	DW,E.210
	JRST	OPNFAT

>;END IFN ANS68, EXAMINE CODE

BADLIT:	MOVEI	DW,E.123
	JRST	OPNFAT

BADTAL:	MOVEI	DW,E.555	;"CLASS MUST BE NUMERIC"
	JRST	OPNFAT

BADTL1:	MOVEI	DW,E.556	;"CAN NOT HAVE ANY DECIMAL PLACES"
	JRST	OPNFAT

BADOPN:	MOVEI	DW,E.214
	JRST	OPFAT

;MISCELLANEOUS CONSTANTS

REPLAC==(1B12)
TALYNG==(1B13)
ASINC==1B19
SUBTTL	"INSPECT" STATEMENT

IFE ANS68,<

;MISC CONSTANTS

F.CHAR==(1B11)
AFTBFR==(3B15)
F.AFT==(1B15)
F.FIR==(1B10)
F.LEA==(1B9)
F.EIN==(1B12)

BSI.I:	POINT	2,IARG11,31	;BYTE SIZE INDICATOR OF INSPECTED ITEM
BSI.L1:	POINT	2,IOPFLG,5	;BSI'S FOR LOC.1, LOC.3, LOC.4
BSI.L3:	POINT	2,IOPFLG,7	; 0= SIXBIT, 1= ASCIZ, 2= EBCDIC
BSI.L4:	POINT	2,IOPFLG,9	;

; "START INSPECT" OPERATOR
;1 OPERAND - INSPECT OP-1  TALLYING/REPLACING...

INSPGN:	SWOFF	FEOFF1		;TURN OFF FLAGS
	MOVEM	W1,OPLINE

;RESET POINTERS AND FLAGS TO START INSPECT GENERATION FRESH
	SETZM	IARG11		;FIRST WORD OF ARG LIST
	SETZM	INARGP		;POINTER TO ARGUMENTS
	SETZM	ITLPTR		;POINTER TO TALLYING ITEMS
	SETZM	STEMPC		;SAVED TEMP PC
	SETZM	INSPTF		;"LAST ARG WAS TALLYING" FLAG

;FORGET STUFF IN TEMTAB
	MOVE	TE,TEMLOC
	AOBJN	TE,.+1		;DON'T RETURN "0"
	MOVEM	TE,TEMNXT

;LOOK AT THE OPERAND (THE INSPECTED ITEM)
	HRRZ	TC,EOPLOC
	ADDI	TC,1
	MOVEM	TC,CUREOP
	HRLZM	TC,OPERND	;LOOK AT THE OPERAND
	PUSHJ	PP,SETIED	;SETUP "A" PARAMETERS
	TSWF	FERROR		;ERRORS YET?
	 POPJ	PP,		;YES, QUIT

	HRRZ	TA,EMODEA	;GET MODE
	CAIG	TA,DSMODE	; MUST BE DISPLAY...
	 JRST	INSPG1		;OK

	MOVEI	DW,E.554	;"USAGE MUST BE DISPLAY"
	JRST	OPNFAT
INSPG1:	DPB	TA,BSI.I	;SAVE BSI OF INSPECTED ITEM

; SETUP ARG LIST FLAGS
	MOVEI	TE,1B35		;%REPLF
	TLNE	W1,REPLAC	; IF THIS IS AN "INSPECT .. REPLACING..."
	 IORM	TE,IARG11	;SET FLAG IN ARG LIST

	TSWT	FASIGN		;SKIP IF SIGNED
	 JRST	INSPG2

	LDB	TE,[POINT 2,EFLAGA,1] ;GET SIGN FLAGS (%SEPSN,%LEDSN)
	CAIN	TE,2		;SEPARATE TRAILING?
	 JRST	[SOS ESIZEA	;YES, PRETEND SIGN ISN'T THERE
		JRST INSPG2]	;AND  ITEM IS UNSIGNED
	DPB	TE,[POINT 2,IARG11,33] ;BIT 32=%SEPSN, BIT 33=%LEDSN
	MOVEI	TE,1B34		;%SIGND
	IORM	TE,IARG11

INSPG2:	HRRZ	TE,ESIZEA
	CAILE	TE,7777		;SIZE TOO BIG TO FIT IN PARAMETER WORD?
	 JRST	INSPBG		;YES, GIVE UP
	HRRZM	TE,ESIZEZ	;B1PAR LOOKS AT THIS
	SWOFF	FASIGN		; MUST TURN THIS OFF, OR B1PAR WILL SET
				; SIGN BIT (AND INSP. ROUTINE WILL THINK
				; IT'S LENGTH IS +2000 CHARACTERS)

	PUSHJ	PP,DEPTSA	;SKIP IF IT HAS A DEPENDING ITEM
	 JRST	INSG2A		;NO, JUST CONTINUE
	SETOM	ONLYEX		;FIRST MAKE SURE SUBSCRIPTS ARE IN %TEMP
	PUSHJ	PP,SUBSCA
	SETZM	ONLYEX
	MOVEI	TE,4		;SET AC4 = SIZE OF 'A'
	PUSHJ	PP,SZDPVA
	  POPJ	PP,		;ERRORS, RETURN
	SETOM	SUBINP		;TELL B1PAR TO KEEP BYTE POINTER SOMEPLACE
				; WHERE WE CAN MODIFY IT (NOT LITTAB!)
INSG2A:	PUSHJ	PP,B1PAR	;DO SUBSCRIPTING
	SETZM	SUBINP		;CLEAR FLAG (SET ABOVE IF DEPENDING VARIABLE)
	TSWF	FASUB		;IS IT REALLY SUBSCRIPTED?
	 JRST	INSPG3		;YES
	HRLI	EACC,AS.MSC	;LITNN IN RH, AS.MSC IN LH
	 CAIA			;SKIP
INSPG3:	MOVEI	EACC,12		; SUBSCRIPTING DONE, BYTE PTR IN "12"
	MOVEM	EACC,INSPSL	;STORE LOCATION OF ITS SUBSCRIPT

	PUSHJ	PP,DEPTSA	;SKIP IF 'A' HAS A DEPENDING ITEM
	 POPJ	PP,		;NO, DONE

;GENERATE A 'DPB' OF THE SIZE INTO THE PARAMETER WORD.

	MOVE	EACC,INSPSL	;WHERE IS THE SUBSCRIPT?
	PJRST	DPBDEP		;GENERATE THE "DPB" INTO THE PARAMETER
				; (CMNGEN ROUTINE..), THEN RETURN

; ITEM WAS BIGGER THAN 7777 (4096.) CHARACTERS - CAN'T DO IT!
INSPBG:	MOVEI	DW,E.726	;TOO BIG TO BE PUT IN A PARAMETER WORD
	JRST	OPNFAT
SUBTTL	"INSPECT TALLYING" OPERATOR
;SAW: ID-2 FOR ID-3 BEFORE/AFTER INITIAL ID-4
;1, 2 OR 3 OPERANDS.

INSPTG:	TSWF	FERROR		;ERRORS IN THIS INSPECT STATEMENT?
	 POPJ	PP,		;YES, FORGET IT
	MOVEM	W1,OPLINE
	SETOM	INSPTF		;SET "LAST ARG WAS TALLYING" FLAG
	SETZM	IOPFLG		;CLEAR OPERAND FLAGS

	MOVE	TE,STEMPC	;RESTORE TEMP PC COUNTER
	MOVEM	TE,ETEMPC

	PUSHJ	PP,ILINKA	;LINK THIS ARGUMENT TO THE REST

	HRRZ	TC,EOPLOC	;FIRST OPERAND = TALLYING LOC
	ADDI	TC,1
	MOVEM	TC,CUREOP
	HRLZM	TC,OPERND

	MOVEI	LN,EBASEA
	PUSHJ	PP,SETOPN	;SET A:= TALLYING ITEM
	TSWF	FERROR
	 POPJ	PP,		;RETURN IF ERRORS

	TSWT	FANUM		;MUST BE NUMERIC
	 JRST	BADTAL
	SKIPE	EDPLA		;MUST HAVE NO DECIMAL PLACES
	 JRST	BADTL1

;GET A TEMP LOCATION TO "AOS" - TALLY LOC.

	MOVEI	TE,1
	PUSHJ	PP,GETEMP
	PUSHJ	PP,STRTAL	;STORE TALLYING LOC ON LIST

	MOVE	CH,[SETZM.+ASINC,,AS.MSC]
	PUSHJ	PP,PUTASY
	MOVE	CH,EACC
	PUSHJ	PP,PUTASN

	MOVSS	EACC		;GET SET TO STORE TALLY LOC IN THIS ARG
	HRRI	EACC,AS.MSC
	HRRZ	TA,CURIRG
	ADD	TA,TEMLOC
	MOVEM	EACC,3(TA)	;STORE IT...
;GET THE SEARCH STRING, SETUP LOC.3
	TLNE	W1,F.CHAR	;TALLYING CHARACTERS?
	 JRST	INSPTC		; YES

	PUSHJ	PP,BMPEOP
	 JRST	BADOPN
	HRRZ	TC,CUREOP
	HRLZM	TC,OPERND	;SETUP AS ARG "A"
	PUSHJ	PP,STEACC	;SETUP EACC
	  POPJ	PP,		;ERRORS

	MOVE	TE,CURIRG	; STORE LOC.3
	ADD	TE,TEMLOC
	MOVEM	EACC,2(TE)
	MOVSI	TE,(1B10)	;CHECK FOR CHARACTER VALUE
	TLNN	EACC,-1
	 IORM	TE,IOPFLG	;YES, SET FLAG
	DPB	EACA,BSI.L3	;STORE BSI FOR LOC.3 STRING/CHAR
IFN ANS74,<
	TLNN	EACC,-1		;NUCLEUS 1 ALLOWS ONLY 1 CHAR
	 JRST	INSPTC		;IT'S ONE CHAR
	MOVE	TE,ESIZEZ	;SIZE MUST BE ONE
	CAIE	TE,1
	PUSHJ	PP,TST.N2##	;SEE IF FIPS FLAGGER REQUESTED
>

INSPTC:	;FOR "TALLYING CHARACTERS", NO FLAGS HAVE TO BE SET; LOC.3 = 0.
	TLNN	W1,AFTBFR	;"BEFORE" OR "AFTER" STRING?
	 JRST	INSPTN		;NO
	PUSHJ	PP,BMPEOP	;YES, GET IT
	 JRST	BADOPN

	HRRZ	TC,CUREOP
	HRLZM	TC,OPERND
	PUSHJ	PP,STLOC1	;GET SET TO SETUP LOC.1
	 POPJ	PP,		;(ERRORS)
IFN ANS74,<
	MOVE	TE,ESIZEZ	;GET SIZE OF STRING
	CAIE	TE,1		;NUCLEUS 1 ALLOWS ONLY 1 CHAR
	PUSHJ	PP,TST.N2##	;SEE IF FIPS FLAGGER REQUESTED
>
	MOVE	TE,CURIRG
	ADD	TE,TEMLOC
	MOVEM	EACC,0(TE)	;STORE LOC.1
	DPB	EACA,BSI.L1	;STORE BSI OF AFTER/BEFORE STRING
;SET OTHER OPERAND FLAGS
INSPTN:	MOVSI	TE,(1B1)
	TLNE	W1,F.LEA
	IORM	TE,IOPFLG	;"LEADING" FLAG

	MOVSI	TE,(1B2)
	TLNE	W1,F.FIR
	IORM	TE,IOPFLG	;"FIRST" FLAG

	MOVSI	TE,(1B3)
	TLNE	W1,F.AFT
	IORM	TE,IOPFLG	;"AFTER" FLAG

	PUSHJ	PP,ISETUP	; GENERATE "SETUP CODE" TO STORE OPERAND FLAGS
;BUMP ARG COUNTER
	HLRE	TE,IARG11
	SOS	TE
	HRLM	TE,IARG11

;IF THIS IS THE LAST ARG, WRITE THE INSPECT OUT AND FINISH UP
	TLNE	W1,F.EIN	;SKIP IF THIS IS THE LAST ARG
	PJRST	FINTLY		;YES, WRITE THE ARGS OUT AND RETURN
	MOVE	TE,ETEMPC	;NO, ALL DONE, SAVE TEMP PC
	MOVEM	TE,STEMPC
	POPJ	PP,
;ROUTINE TO MAKE AN ENTRY IN TEMTAB FOR THIS ARGUMENT
; CALLED FOR BOTH TALLYING AND REPLACING ARGS

ILINKA:	MOVEI	TA,5		;GET 5 LOCS IN TEMTAB
	PUSHJ	PP,GETTEM	; FOR THIS ARGUMENT
	MOVEM	TA,CURIRG	;SAVE RELATIVE LOC.

	HLRZ	TB,IARG11	;WHICH ARGUMENT IS THIS?
	JUMPE	TB,STRTLA	; FIRST ONE

;LINK IT
	HLRZ	TE,INARGP	;GET PTR TO LAST ARG.
	ADD	TE,TEMLOC
	MOVEM	TA,4(TE)	;STORE PTR IN 5TH WORD
	 SKIPA
STRTLA:	MOVEM	TA,INARGP	;RH (INARGP)= PTR TO FIRST
	PUSH	PP,TA		;SAVE IT
	MOVEI	TE,2		;GET 2 TEMP LOCS
	TLNE	W1,F.LEA	;IF "LEADING" SEARCH,
	MOVEI	TE,3		;GET 3
	PUSHJ	PP,GETEMP	;%TEMP+NN IN EACC
	POP	PP,TA
	HRRZ	TE,TA
	ADD	TA,TEMLOC
	SETZM	(TA)		;LOC.1
	MOVEM	EACC,1(TA)	;LOC.2 = 2-WORD %TEMP BLOCK
	SETZM	2(TA)		;LOC.3
	SETZM	3(TA)		;LOC.4 OR TALLY.LOC
	SETZM	4(TA)		;LINK TO NEXT ITEM
	HRLM	TE,INARGP	;LH (INARGP)= PTR TO LAST ARG.
	POPJ	PP,		;RETURN
;ROUTINE TO MAKE AN ENTRY IN THE TALLYING ITEM LINKED LIST.
; EACH ENTRY IS 3 WORDS IN TEMTAB. FIRST WORD POINTS TO THE OPERAND (FOR
; CALL TO SETOPN LATER).  2ND WORD IS AS.TMP+NN (THE "AOS" WORD).
; 3RD WORD = 0 OR RELATIVE LOCATION OF NEXT 3-WORD BLOCK IN TEMTAB.
;
; WHEN THIS ROUTINE IS CALLED, LH(OPERND) POINTS TO THE ACTUAL TALLY ITEM.
;EACC = %TEMP+NN.

STRTAL:	MOVEI	TA,3		;GET 3 LOCS IN TEMTAB.
	PUSHJ	PP,GETTEM
	HLRZ	TB,IARG11	;IS THIS IS FIRST ARG?
	JUMPE	TB,STRTLH	; JUMP IF YES

;LINK LAST ENTRY

	HLRZ	TE,ITLPTR	;LH (ITLPTR)= LAST ENTRY IN LIST
	ADD	TE,TEMLOC
	MOVEM	TA,2(TE)	;MAKE THE 3RD WORD POINT TO THIS ENTRY
	 SKIPA
STRTLH:	MOVEM	TA,ITLPTR	;RH (ITLPTR)= FIRST ENTRY IN LIST
	HRRZ	TE,TA
	ADD	TE,TEMLOC

	MOVEM	EACC,1(TE)	; 2ND WORD - %TEMP+NN
	SETZM	2(TE)		;CLEAR 3RD WORD FOR NOW
	HRLM	TA,ITLPTR	;LH (ITLPTR)= LAST ENTRY IN LIST
;
;NOW, TO STORE THE OPERAND! (WHICH MAY BE SUBSCRIPTED), WE HAVE
; TO COPY THE OPERAND WORDS TO A MORE PERMANENT HANG-OUT.
;SO WE'LL USE TEMTAB AGAIN, AND MAKE THE FIRST WORD OF THIS "TALLY"
;ENTRY POINT TO THE BLOCK OF OPERANDS IN TEMTAB.

	PUSH	PP,TA		;REMEMBER WHERE THIS ENTRY IS
	HLRZ	TC,OPERND
	MOVE	TE,1(TC)	;HOW MANY SUBSCRIPTS & STUFF TO FOLLOW?
	LDB	TA,TESUBC
	LSH	TA,1		;= THIS MANY WORDS
	ADDI	TA,2		;PLUS TWO FOR THE BASE OPERAND
	PUSH	PP,TA		;SAVE # WORDS TO COPY
	PUSHJ	PP,GETTEM

;COPY THE BLOCK
	POP	PP,TD		;TD= # WORDS TO MOVE, TA = POINTER TO FIRST
	POP	PP,TE		;TE POINTS TO THE ENTRY WHICH POINTS TO THIS
	ADD	TE,TEMLOC	;  BLOCK!
	MOVEM	TA,(TE)		;SAVE POINTER TO THE OPERAND
	ADD	TA,TEMLOC	;MAKE TA = POINTER TO FIRST WORD OF NEW BLOCK
	HLRZ	TC,OPERND	;START OF BLOCK TO COPY
STRLLP:	SOJL	TD,STRLPD
	MOVE	TB,(TC)		;GET A WORD FROM THE OPERAND BLOCK
	MOVEM	TB,(TA)		; AND STORE IT IN THE TEMTAB BLOCK
	AOJA	TC,.+1		;BUMP POINTERS
	AOJA	TA,STRLLP	; AND LOOP FOR ALL WORDS
STRLPD:	POPJ	PP,
;ROUTINE TO GENERATE "SETUP CODE" TO STORE OPERAND FLAGS
ISETUP:	MOVE	TA,CURIRG
	ADD	TA,TEMLOC
	MOVE	EACC,1(TA)	;GET %TEMP BLOCK PTR

	SKIPN	IOPFLG		;IF ALL ZERO, USE "SETZM"
	 JRST	ISTUP1

;GEN "MOVEI 0,FLAGS"
	MOVE	CH,[MOVEI.+ASINC,,AS.CNB]
	PUSHJ	PP,PUTASY
	HLRZ	CH,IOPFLG
	PUSHJ	PP,PUTASN

;"HRLM 0,%TEMP+NN"	;LH OF FIRST WORD OF TEMP BLOCK
	PUSHJ	PP,PUTASA
	MOVE	CH,[HRLM.+ASINC,,AS.MSC]
	PUSHJ	PP,PUTASY
	HRRZ	CH,EACC
	JRST	PUTASN

ISTUP1:	MOVE	CH,[SETZM.+ASINC,,AS.MSC]
	PUSHJ	PP,PUTASY
	HRRZ	CH,EACC
	JRST	PUTASN
;HERE TO WRITE OUT ALL THE TALLY ARGS. PREPARE FOR "REPLACING"

FINTLY:	PUSHJ	PP,WRTIAG	;WRITE OUT THE ARGS.

;GENERATE "ADD'S" TO INCREMENT THE TALLY ITEMS
	SKIPN	ITLPTR		;ANY TALLYING ITEMS?
	 JRST	DONATL		;NO!!!
	HRRZ	TA,ITLPTR	;GET FIRST ONE
GADNXT:	PUSH	PP,TA		;SAVE IT
	PUSHJ	PP,GENTAD	;GENERATE THE "ADD" FOR THIS ITEM
	POP	PP,TA
	TSWF	FERROR		;ERRORS?
	 POPJ	PP,		;YES, STOP

	ADD	TA,TEMLOC	;CHECK FOR MORE ITEMS
	HRRZ	TA,2(TA)
	JUMPN	TA,GADNXT	;LOOP

DONATL:	SETZM	INSPTF		;CLEAR "LAST WAS TALLYING" FLAG
	SETZM	STEMPC		;START TEMPS FRESH
	POPJ	PP,		;THEN RETURN

;ROUTINE TO GENERATE THE "ADD" FOR THIS TALLYING ITEM

GENTAD:	ADD	TA,TEMLOC
	PUSH	PP,TA		;SAVE LOC OF OPERAND FOR "SETOPB"

;FAKE "A" OPERAND

	MOVE	TB,[INSPA,,EBASEA]
	BLT	TB,EBASAX
	PUSH	PP,1(TA)	;SAVE %TEM. INCREMENT FOR A SEC..
	MOVE	CH,[MOV+ASINC,,AS.MSC]
	PUSHJ	PP,PUTASY
	POP	PP,CH
	PUSHJ	PP,PUTASN	;GEN "MOVE 0,TALLY.LOC"

;SETUP THE REAL "TALLY" ARGUMENT AS THE "B" OPERAND, THEN GENERATE THE ADD
; FROM AC.

	POP	PP,TA		;RESTORE TA (TOP OF STACK IS NOW RETURN ADDRESS)
	HRRZ	TC,(TA)
	MOVEM	TC,TEMADP	;STORE RELATIVE LOCATION OF THE OPERAND
				; FOR MATGEN
	ADD	TC,TEMLOC	;SET IT UP NOW ALSO
	HRRM	TC,OPERND
	PUSH	PP,[STOPBE]	;[732] GO HERE IF SETOPB GETS AN ERROR
	PUSHJ	PP,SETOPB	;[732] SET UP AS "B" OPERAND
	POP	PP,(PP)		;[732] NO ERRORS, CLEAR ERROR RETURN

	SETZM	EAC		;REMEMBER NUMBER IS IN AC0
	PUSHJ	PP,RESG13	;[732] GEN "ADD"
STOPBE:	SETZM	TEMADP		;[732] CLEAR RESGEN FLAG
	POPJ	PP,		;[732] END OF INSPECT CODE GENERATION
	JRST	RESG13		;GEN "ADD", THEN POPJ
; A FAKED TALLY LOC. PRETEND IT'S A 1-WORD COMP ITEM, SIZE 10,
;STORED IN AC0.

INSPA:	0		;EBASEA
	0		;EINCRA
	DEC	10	;ESIZEA
	EXP	D1MODE ;EMODEA
	EXP 0,0,0
;ROUTINE TO WRITE OUT A BUNCH OF ARGS, FOR TALLYING OR REPLACING

WRTIAG:	PUSH	PP,ELITPC	;SAVE STARTING LITERAL PC
	MOVE	TA,[XWD XWDLIT,2]	;FIRST WORD OF ARG LIST
	PUSHJ	PP,STASHP
	HLLZ	TA,IARG11	;-NUM ARGS
	HRRI	TA,AS.CNB
	PUSHJ	PP,STASHQ
	HRLZ	TA,IARG11	;RH= FLAGS
	SKIPE	TA
	HRRI	TA,AS.CNB
	PUSHJ	PP,STASHQ
	AOS	ELITPC		;UPDATE LITERAL PC

;OUTPUT EACH 2-WORD ARG.

	HRRZ	TE,INARGP	;LOOK AT FIRST ARG
	PUSH	PP,TE
	JRST	FINTL1		;OUTPUT IT

FINTL2:	POP	PP,TE
	HLRZ	TD,INARGP
	CAMN	TD,TE		;WAS THAT THE LAST ARG?
	 JRST	FINTL3		;YES
	ADD	TE,TEMLOC	;NO, FETCH NEXT ONE
	MOVE	TE,4(TE)
	PUSH	PP,TE
FINTL1:	ADD	TE,TEMLOC
	MOVEM	TE,CURIRG
	MOVE	TA,[XWD XWDLIT,2]
	PUSHJ	PP,STASHP
	MOVE	TE,CURIRG
	MOVE	TA,0(TE)	;LOC.1
	PUSHJ	PP,STASHQ
	MOVE	TE,CURIRG
	MOVE	TA,1(TE)	;LOC.2
	MOVSS	TA
	HRRI	TA,AS.MSC	;%TEMP+NN,,AS.MSC
	PUSHJ	PP,STASHQ
	AOS	ELITPC		;ANOTHER WORD IN LITAB
;"WRTIAG" ROUTINE (CONT'D) - WRITE OUT THE INSPECT ARG LIST
	MOVE	TA,[XWD XWDLIT,2]
	PUSHJ	PP,STASHP
	MOVE	TE,CURIRG
	MOVE	TA,2(TE)	;LOC.3
	PUSHJ	PP,STASHQ
	MOVE	TE,CURIRG
	MOVE	TA,3(TE)	;TALLY LOC
	PUSHJ	PP,STASHQ
	AOS	ELITPC
	JRST	FINTL2		;LOOP FOR ALL ARGS

FINTL3:	PUSHJ	PP,POOL		;POOLED ARGUMENT LIST!
	POP	PP,ELITPC	;OK, RESTORE ORIGINAL LITERAL PC
	HLRE	TE,IARG11	;HOW MANY ARGS?
	MOVMS	TE
	LSH	TE,1
	ADDI	TE,1		;TE= # LOCS IN ARG LIST
	SKIPN	EACC,PLITPC	; SET EACC TO POINT TO START OF ARG LIST
	MOVE	EACC,ELITPC
	SKIPN	PLITPC
	ADDM	TE,ELITPC	;UPDATE LITERAL PC NOW

;GEN "MOVE 12,BYTE.PTR.TO.INSPECTED.ITEM" UNLESS IT'S ALREADY THERE

	MOVE	TE,INSPSL
	CAIN	TE,12		;ALREADY THERE?
	 JRST	FINTL4		;YES, SKIP THIS

	MOVE	CH,[MOV+ASINC+SAC,,AS.MSC]
	PUSHJ	PP,PUTASY
	HRRZ	CH,INSPSL
	PUSHJ	PP,PUTASN

	MOVEI	TE,12		;REMEMBER BYTE PTR IS IN AC12 NOW
	MOVEM	TE,INSPSL

;OUTPUT "MOVEI 16,ARG.LST"
;	"PUSHJ PP,INSP."

FINTL4:	MOVE	CH,[XWD INSP.+ASINC,AS.MSC]
	PUSHJ	PP,PUTASY
	HRRZ	CH,EACC
	IORI	CH,AS.LIT
	PJRST	PUTASN
SUBTTL	"INSPECT REPLACING" OPERATOR
;SAW: ALL/LEADING/FIRST ID-5 BY ID-6 [BEFORE/AFTER ID-7]
; OR:   CHARACTERS BY ID-6 [BEFORE/AFTER ID-7]
;1, 2, OR 3 OPERANDS

INSPRG:	TSWF	FERROR		;ERRORS SEEN YET?
	 POPJ	PP,		;YES, FORGET IT
	MOVEM	W1,OPLINE
	SETZM	IOPFLG		;CLEAR OPERAND FLAGS
	SKIPN	INSPTF		;WERE WE JUST TALLYING?
	 JRST	INSPR0		;NO, SKIP THIS
	PUSHJ	PP,FINTLY	; YES, FINISH UP
	HRRZS	IARG11		;CLEAR OUT -N ARGS
	MOVEI	TE,1B35		;"REPLACING" NOW
	IORM	TE,IARG11	; SET FLAG IN ARG LIST
	SETZM	INARGP		;CLEAR PREVIOUS ARG POINTER
	MOVE	TE,TEMLOC	;ZAP OUT TEMTAB, TOO
	AOBJN	TE,.+1
	MOVEM	TE,TEMNXT
	JRST	INSPR1

INSPR0:	MOVE	TE,STEMPC	;MORE REPLACING ARGS...
	MOVEM	TE,ETEMPC

INSPR1:	PUSHJ	PP,ILINKA	;LINK THIS ARGUMENT TO THE NEXT

	HRRZ	TC,EOPLOC	;GET SET TO LOOK AT FIRST OPERAND
	ADDI	TC,1
	MOVEM	TC,CUREOP
	HRLZM	TC,OPERND
	TLNE	W1,F.CHAR	;REPLACING CHARS?
	 JRST	INSPR2		;YES, SET SEARCH STRING SIZE TO 1
				; NO OPERAND IS THERE FOR THE SEARCH STRING!

	PUSHJ	PP,STEACC	;SETUP SEARCH STRING
	 POPJ	PP,		;?ERRORS

	MOVE	TA,CURIRG	;GET SET TO STORE LOC.3
	ADD	TA,TEMLOC
	MOVEM	EACC,2(TA)
	MOVSI	TE,(1B10)	;SET "1 CHAR" FLAG IF NECESSARY
	TLNN	EACC,-1
	 IORM	TE,IOPFLG	;YEAH
	DPB	EACA,BSI.L3	;STORE BSI FOR THE STRING
	TLNE	EACC,-1		;WAS IT 1 CHAR?
	SKIPA	TE,ESIZEA	;NO, GET SIZE
	MOVEI	TE,1
	MOVEM	TE,SERSIZ	;STORE SIZE
IFN ANS74,<
	CAIE	TE,1		;NUCLEUS 1 ALLOWS ONLY 1 CHAR
	PUSHJ	PP,TST.N2##	;SEE IF FIPS FLAGGER REQUESTED
>
; DONE WITH THE SEARCH STRING...
; SETUP REPLACING STRING
	PUSHJ	PP,BMPEOP
	 JRST	BADOPN		;?MUST BE THERE
	HRRZ	TC,CUREOP
	HRLZM	TC,OPERND
	JRST	INSPR3

INSPR2:	MOVEI	TE,1		;REPLACING CHARACTERS,
	MOVEM	TE,SERSIZ	; SEARCH SIZE IS 1
INSPR3:	PUSHJ	PP,STLOC4	;SETUP LOC.4
	 POPJ	PP,		;ERRORS
IFN ANS74,<
	MOVE	TE,SERSIZ	;GET SIZE OF STRING
	CAIE	TE,1		;NUCLEUS 1 ALLOWS ONLY 1 CHAR
	PUSHJ	PP,TST.N2##	;SEE IF FIPS FLAGGER REQUESTED
>

	MOVE	TE,CURIRG
	ADD	TE,TEMLOC
	MOVEM	EACC,3(TE)	;STORE LOC.4
	DPB	EACA,BSI.L4	;AND BSI FOR IT
	MOVSI	TE,(1B11)	;SET "1 CHAR" FLAG IF NECESSARY
	TLNN	EACC,-1
	 IORM	TE,IOPFLG

;CHECK FOR AFTER/BEFORE STRING

	TLNN	W1,AFTBFR	;SKIP IF ANY
	 JRST	INSPRN		;NOPE
	PUSHJ	PP,BMPEOP
	 JRST	BADOPN		;?NOT SUPPLIED

	HRRZ	TC,CUREOP
	HRLZM	TC,OPERND
	PUSHJ	PP,STLOC1
	 POPJ	PP,		;?ERRORS SETTING IT UP
IFN ANS74,<
	MOVE	TE,ESIZEZ	;GET SIZE OF STRING
	CAIE	TE,1		;NUCLEUS 1 ALLOWS ONLY 1 CHAR
	PUSHJ	PP,TST.N2##	;SEE IF FIPS FLAGGER REQUESTED
>

	MOVE	TE,CURIRG
	ADD	TE,TEMLOC
	MOVEM	EACC,0(TE)	;STORE IN LOC.1
	DPB	EACA,BSI.L1	; AND STORE BSI
; DONE WITH THE REPLACING STRING AND BEFORE/AFTER STRING...
;SET OPERAND FLAGS

INSPRN:	MOVSI	TE,(1B1)
	TLNE	W1,F.LEA
	IORM	TE,IOPFLG	;"LEADING"

	MOVSI	TE,(1B2)
	TLNE	W1,F.FIR
	IORM	TE,IOPFLG	;"FIRST"

	MOVSI	TE,(1B3)
	TLNE	W1,F.AFT
	IORM	TE,IOPFLG	;"AFTER"

	PUSHJ	PP,ISETUP	;GENERATE "SETUP CODE" TO STORE OPERAND FLAGS

;BUMP ARG COUNTER
	HLRE	TE,IARG11
	SOS	TE
	HRLM	TE,IARG11

;IF THIS IS THE LAST ARG, WRITE THE INSPECT OUT
	TLNE	W1,F.EIN
	PJRST	WRTIAG		;WRITE OUT THE INSPECT ARGS...
				; AND RETURN
	MOVE	TE,ETEMPC	; SAVE TEMP PC FOR NEXT REPLACING ARG
	MOVEM	TE,STEMPC
	POPJ	PP,
;ROUTINE TO SETUP EACC = LOC.1, EACA= BSI. LOC.1
STLOC1:	PUSHJ	PP,STEACC
	 POPJ	PP,
	TLNE	EACC,-1
	 JRST	CPOPJ1		;OK IF AN ACTUAL STRING

;IT WAS A FIG. CONST. OR A 1-CHAR LIT. STORE THE LITERAL IN LITAB.

	MOVEI	TE,1		;ONE CHAR
	MOVEM	TE,ESIZEZ
	HRL	TA,D.LTCD(EACA)	;GET LITAB CODE
	HRRI	TA,1		;ONE WORD LITERAL
	PUSHJ	PP,STASHP
	SETZ	TA,
	DPB	EACC,[POINT 6,TA,5
			POINT 7,TA,6
			POINT 9,TA,8](EACA)
	PUSHJ	PP,POOLIT

	SKIPN	EACC,PLITPC
	MOVE	EACC,ELITPC
	SKIPN	PLITPC
	AOS	ELITPC
	IORI	EACC,AS.LIT
	PUSHJ	PP,STLTLT	;MAKE ANOTHER LITERAL, POINTING TO THAT ONE
	JRST	CPOPJ1		;RETURN NOW
;ROUTINE TO MAKE A LITERAL POINTING TO THE LITERAL WE JUST PUT OUT
; AS.LIT+NN IN EACC., SIZE IN ESIZEZ.
;MESSES UP "A"

STLTLT:	SWOFF	FASUB!FASIGN	;NOT SUBSCRIPTED, OR SIGNED
	MOVEM	EACC,EINCRA
	MOVE	TE,[44,,AS.MSC]
	MOVEM	TE,EBASEA
	PUSHJ	PP,B1PAR
	MOVSS	EACC
	HRRI	EACC,AS.MSC
	POPJ	PP,
;ROUTINE TO SETUP EACC = LOC.4, EACA= BSI.LOC.4
; IF STRING IS A FIG. CONST, MAKE A STRING OF THEM THE LENGTH OF
;THE LOC.3 STRING (LENGTH STORED IN "SERSIZ")

STLOC4:	PUSHJ	PP,STEACC
	 POPJ	PP,		;ERRORS

	TLNE	EACC,-1		;AN ACTUAL STRING
	 JRST	STLC4A		;YES, CHECK AGAINST PREVIOUS SIZE

	JUMPN	TD,STLC4F	;JUMP IF STEACC SAYS THIS IS A FIG. CONST.

	HRRZ	TE,SERSIZ	;1-CHAR LITERAL AS "REPLACING" STRING
	CAIN	TE,1		;REPLACING SEARCH STRING 1 CHAR ALSO?
	 JRST	CPOPJ1		;YES, OK

;GIVE ERROR - ITEM NOT THE RIGHT SIZE
STLC4E:	MOVEI	DW,E.725	;"ITEM MUST BE SAME SIZE AS ITEM BEING
	JRST	OPNFAT		; REPLACED"., THEN GIVE ERROR RETURN

;IT WAS A STRING. CHECK FOR SAME SIZE AS PREVIOUS STRING
STLC4A:	MOVE	TE,ESIZEA	;GET SIZE OF THIS STRING
	CAMN	TE,SERSIZ	;SAME SIZE?
	 JRST	CPOPJ1		;YES, OK
	JRST	STLC4E		;NO, COMPLAIN

; CONT'D ON NEXT PAGE
;STLOC4 ROUTINE (CONT'D)
;IT WAS A FIG. CONST. STORE LITERAL IN LITAB, UNLESS LENGTH WAS 1 CHAR.
STLC4F:	HRRZ	TE,SERSIZ	;SIZE TO MAKE IT
	CAIN	TE,1		;JUST 1 CHAR ANYWAY?
	 JRST	CPOPJ1		;YES, LEAVE IT THE WAY IT IS

	IDIV	TE,BYTE.W(EACA) ;GET TE= # WORDS IN LITAB WE NEED
	SKIPE	TD
	AOS	TE
	PUSH	PP,TE		;SAVE # WORDS IN LITERAL
	HRL	TA,D.LTCD(EACA)
	HRR	TA,TE
	PUSHJ	PP,STASHP

STLC4G:	SETZ	TA,		;START ANOTHER WORD
	MOVE	TB,[POINT 6,TA
			POINT 7,TA
			POINT 9,TA](EACA)
STLC4H:	SOSGE	SERSIZ		;MORE CHARS TO STORE?
	 JRST	STLC4J		;NO, OUTPUT LAST WORD
	IDPB	EACC,TB		;STORE BYTE
	TLNE	TB,760000	;MORE BYTES LEFT IN WORD?
	 JRST	STLC4H		;YES
	PUSHJ	PP,STASHQ	;STORE NEXT WORD OF LITERAL
	SKIPE	SERSIZ		;[1127] Did item end just now?
	 JRST	STLC4G		;[1127] No, GO ON TO NEXT WORD
	PUSHJ	PP,POOL		;[1127] Pool the literals
	JRST	STLC4K		;[1127] and finish up

STLC4J:	PUSHJ	PP,POOLIT	;OUTPUT LAST WORD
STLC4K:	POP	PP,TE		;[1127] # WORDS IN LITERAL
	SKIPN	EACC,PLITPC	;NOW GET EACC POINTING TO THE LITERAL
	MOVE	EACC,ELITPC	; WE JUST MADE
	IORI	EACC,AS.LIT
	SKIPN	PLITPC		;UNLESS POOLED..
	ADDM	TE,ELITPC	;BUMP LITERAL COUNTER
	PUSHJ	PP,STLTLT	;MAKE A LITERAL, POINTING TO THAT ONE
	JRST	CPOPJ1
;ROUTINE TO SETUP EACC = LOC.3 OR LOC.4, FROM OPERAND IN "CUREOP" AND "A".
; ALSO RETURNS EACA= BSI OF THE STRING
;	PUSHJ	PP,STEACC
;	 <RETURN HERE IF ERRORS>
;	 <HERE IF OK, EACC AND EACA SETUP>
;
; DOES SUBSCRIPTING IF NECESSARY, BUT ALWAYS LEAVES THE BYTE PTR
;IN %TEMP OR %LIT.
; IF LH(EACC)=0, THEN IT'S A 1-CHAR LITERAL OR FIG. CONST.
;			(TD= 0 IF LIT, -1 IF FIG. CONST, IN THIS CASE)

STEACC:	HRRZ	TA,CUREOP
	MOVE	TC,0(TA)	;LOOK AT OPERAND FLAGS
	TLNN	TC,GNLIT	;LIT OR FIG CONST?
	 JRST	STEAC1		;NO, SET IT UP AS "A"
	TLNN	TC,GNFIGC	;FIG CONST.?
	 JRST	STLCLT		;NO, LITERAL

	TLNN	TC,GNFCS!GNFCZ!GNFCQ!GNFCHV!GNFCLV
	 JRST	BADLIT

;  GET THE APPROPRIATE CHARACTER IN
;THE MODE OF THE INSPECTED STRING.

	LDB	EACA,BSI.I	;GET INSPECT STRING BSI
	TLNE	TC,GNFCS	;SPACE
	HRRZ	EACC,IFSPCS(EACA)
	TLNE	TC,GNFCZ	;ZERO
	HRRZ	EACC,IFZROS(EACA)
	TLNE	TC,GNFCQ	;QUOTE
	HRRZ	EACC,HIVQOT(EACA)
	TLNE	TC,GNFCLV	;LOW-VALUES
	MOVEI	EACC,0
	TLNE	TC,GNFCHV	;HIGH-VALUES
	HLRZ	EACC,HIVQOT(EACA)

	SKIPLE	COLSEQ		;[1004] PROGRAM COLLATING SEQUENCE = ALPHABET-NAME?
	TLNN	TC,GNFCLV!GNFCHV ; AND LOW-VALUES OR HIGH-VALUES?
	 CAIA			;NO
	XCT	STECOL(EACA)	;YES, GET THE SPECIAL CHARACTER VALUE
	SETO	TD,		;TD= -1 TO INDICATE FIG. CONST
	JRST	CPOPJ1		;GIVE GOOD RETURN

STECOL:	HLRZ	EACC,PRGCOL+240(EACC)	;SIXBIT
	HLRZ	EACC,PRGCOL(EACC)	;ASCII
	HRRZ	EACC,PRGCOL(EACC)	;EBCDIC

STLCLT:	MOVE	TC,CUREOP	;HAVE A LITERAL, CALL SETOPN
	MOVEI	LN,EBASEA	; TO FIND SIZE & SETUP FOR LITD.
	PUSHJ	PP,SETOPN
	TSWF	FERROR		;IF ERRORS,
	 POPJ	PP,		;TAKE THE ERROR RETURN
	MOVE	TD,ESIZEA	;WHATEVER SIZE IT IS, IS WHAT IT WILL BE
	CAIN	TD,1
	 JRST	STLCL1		;IF 1, GET THE CHAR
	MOVEM	TD,ESIZEB
	MOVEM	TD,ESIZEZ
	LDB	TC,BSI.I	; USE MODE OF INSPECTED STRING
	MOVEM	TC,EMODEB	; MAKE THE LITERAL IN THAT MODE
	SETZM	LITERR		;INCASE ERRORS CONVERTING
	PUSHJ	PP,LITD.	;MAKE THE LITERAL
	TSWF	FERROR
	 POPJ	PP,
	SKIPE	LITERR		;IF CONVERSION ERRORS,
	 JRST	STLCLE		; GO COMPLAIN
	SWOFF	FASIGN!FASUB	;NOT SIGNED, OR SUBSCRIPTED
	PUSHJ	PP,B1PAR	;GET BYTE PTR IN %TEMP
	MOVSS	EACC
	HRRI	EACC,AS.MSC	;EACC POINTS TO THE BYTE PTR IN %TEMP
	HRRZ	EACA,EMODEA	; EACA= BSI OF THE LITERAL
	JRST	CPOPJ1

STLCL1:	LDB	EACA,BSI.I	;GET MODE OF INSPECT STRING
	ILDB	TE,EBYTEA	;GET ASCII CHAR OF LITERAL
	SETZM	LITERR		;INCASE ERRORS CONVERTING
	XCT	VLIT6.(EACA)	;CONVERT
	SKIPE	LITERR		;ERRORS CONVERTING?
	 JRST	STLCLE		; YEAH, COMPLAIN
	HRRZ	EACC,TE		;RETURN WITH CHAR IN EACC
	SETZ	TD,		;TD= 0 TO INDICATE 1-CHAR LITERAL
	JRST	CPOPJ1		;GIVE GOOD RETURN

STLCLE:	SETZM	LITERR		;RESET FLAG FOR NEXT TIME
	MOVEI	DW,E.329	;"NON-SIXBIT-CHAR IN LITERAL..."
	JRST	OPNFAT

; ITEM WAS NOT A LITERAL OR FIG CONST. IT MUST BE A DISPLAY ITEM.
STEAC1:	HRRZ	TC,CUREOP
	PUSHJ	PP,SETIED	;SETUP AS "A" ITEM, MAY BE EDITED
	TSWF	FERROR
	  POPJ	PP,		;ERRORS
	HRRZ	TA,EMODEA
	CAILE	TA,DSMODE	;MUST BE DISPLAY...
	 JRST	SETLE1		;?NO, ERROR
	TSWF	FASIGN		;SIGNED?
	 JRST	[PUSHJ PP,MVAUNS ;MOVE "A" TO UNSIGNED TEMP
		TSWF	FERROR
		 POPJ	PP,	;RETURN IF ERRORS
		JRST	.+1]
	HRRZ	TE,ESIZEA
	HRRZM	TE,ESIZEZ
	MOVEI	TE,10		;SUBSCRIPT WITH AC 10
	MOVEM	TE,SUSEAC
	PUSHJ	PP,B1PAR	;GET BYTE PTR IN %LIT OR AC
	SETZM	SUSEAC
	TSWT	FASUB		;SKIP IF IN AC
	 JRST	HVEACC		;NO, IN %TEMP (OK)

; MOVE THE BYTE PTR TO A %TEMP.

	MOVEI	TE,1
	PUSHJ	PP,GETEMP

	MOVE	CH,[MOVEM.+AC10+ASINC,,AS.MSC]
	PUSHJ	PP,PUTASY
	MOVE	CH,EACC
	PUSHJ	PP,PUTASN

HVEACC:	MOVSS	EACC
	HRRI	EACC,AS.MSC
	HRRZ	EACA,EMODEA	;EACA= BSI OF THE STRING
	JRST	CPOPJ1		;GIVE GOOD RETURN

SETLE1:	MOVEI	DW,E.554	;"USAGE MUST BE DISPLAY"
	JRST	OPNFAT		;GIVE ERROR, AND ERROR RETURN
;ROUTINE TO SETUP "A" PARAMETERS, AND CHECK FOR EDITED ITEMS.
; IF EDITED, USE EXTERNAL SIZE.  IF NUMERIC EDITED, TURN OFF FASIGN.
;IF FLAG "NODEPV" IS SET TO -1, AND THE ITEM HAS A DEPENDING VARIABLE,
;  PUT OUT A FATAL DIAG AND GIVE ERROR RETURN.

SETIED:	MOVEI	LN,EBASEA
	PUSHJ	PP,SETOPN	;SETUP "A" PARAMETERS
	TSWF	FERROR		;ERRORS?
	 POPJ	PP,		;YES, RETURN RIGHT AWAY
	MOVE	TC,CUREOP	;CHECK FOR EDITED
	MOVE	TA,1(TC)
	PUSHJ	PP,LNKSET
	LDB	TE,DA.EDT
	JUMPE	TE,SETIE1	;NOT EDITED

	LDB	TE,DA.EXS	;USE EXTERNAL SIZE
	MOVEM	TE,ESIZEA
	SWOFF	FASIGN		;PRETEND IT'S UNSIGNED

SETIE1:	SKIPE	NODEPV		;SKIP IF 'A' CAN HAVE A DEPENDING VARIABLE
	PUSHJ	PP,DEPTSA	;IT CAN'T-- SKIP IF IT DOES
	 POPJ	PP,		;NO, RETURN OK
	MOVEI	DW,E.612	;"FThis item may not have a depending variable"
	PJRST	OPNFAT		;PUT OUT DIAG AND POPJ
;ROUTINE TO MOVE "A" TO AN UNSIGNED TEMP.
MVAUNS:	LDB	TE,BSI.I	;TAKE THIS OPPORTUNITY TO CONVERT THE
				; STRING TO INSPECT STRING MODE
	JRST	MVAUN0		;MOVE "A" TO UNSIGNED %TEMP
>;END IFE ANS68 AND "INSPECT" STATEMENT CODE GEN.

;ENTER HERE WITH TE= BSI TO CONVERT THE NUMERIC ITEM TO.
MVAUN0:	MOVEM	TE,EMODEB
	MOVE	TC,ESIZEA
	MOVEM	TC,ESIZEB	;SAME SIZE
IFN ANS74,<
	SKIPGE	EFLAGA		;SEPARATE SIGN?
	SOS	TC,ESIZEB	; YES, ADJUST SIZE
>
	ADD	TC,BYTE.W(TE)	;FIND OUT HOW MANY WORDS IN %TEMP WE NEED
	SUBI	TC,1
	IDIV	TC,BYTE.W(TE)

	HRRZ	TE,TC
	PUSHJ	PP,GETEMP
	MOVEM	EACC,EINCRB	;SET "B" INCREMENT

	MOVE	TA,[XWD ^D36,AS.MSC]
	MOVEM	TA,EBASEB
	SETZM	EDPLB
	SETZM	EFLAGB
	SWON	FBNUM
	SWOFF	FBSUB!FBSIGN	;"B" IS UNSIGNED, NOT SUBSCRIPTED

	MOVE	TA,[XWD EBASEB,ESAVEA]
	BLT	TA,ESAVAX	;SAVE "B" PARAMETERS
	TSWT	FASUB		;IF "A" SUBSCRIPTED,
	 JRST	MVAUS1		; SKIP THIS
	MOVEI	TE,10		;USE AC10 FOR SUBSCRIPTING
	MOVEM	TE,SUSEAC
	PUSHJ	PP,MXX.		;MOVE THE ITEM
	SETZM	SUSEAC		;AND THEN CLEAR SUSEAC
	JRST	MVAUS2
MVAUS1:	PUSHJ	PP,MXX.		; MOVE THE ITEM
MVAUS2:	MOVE	TA,[XWD ESAVEA,EBASEA]
	BLT	TA,EBASAX	;RESTORE "A" ITEM
	SWOFF	FASUB!FASIGN	;NEW "A" IS NEITHER SUBSCRIPTED NOR SIGNED

	POPJ	PP,
;ROUTINE TO GET SOME LOCS IN TEMTAB
; CALL: TA/ # LOCS TO GET
;	PUSHJ PP,GETTEM
;	  (RETURN HERE WITH TA= RELATIVE TEMTAB ADDRESS OF THE FIRST LOC)

GETTEM:
IFN XPNTST,<
	PUSH	PP,TA		;SAVE TA
	PUSHJ	PP,XP1TEM##	;ALWAYS EXPAND BY 1 WORD
	POP	PP,TA		;RESTORE TA
>
	HRRZ	CH,TA		;GET # LOCS
	HRL	CH,CH		;N,,N
	ADD	CH,TEMNXT	; HIGHEST POSSIBLE TEMLOC
	JUMPL	CH,GETEM1	; JUMP IF STILL ROOM
	PUSH	PP,TA		;NO, SAVE TA
	PUSHJ	PP,XPNTEM	;GO EXPAND TEMTAB
	POP	PP,TA		;RESTORE ARG TO THIS ROUTINE..
	JRST	GETTEM		; AND TRY AGAIN

GETEM1:	HRRZ	TA,TEMNXT	;FIGURE OUT WHERE WE ARE PUTTING IT
	MOVEM	CH,TEMNXT	;STORE NEW TEMNXT
	HRRZ	CH,TEMLOC
	SUB	TA,CH		;RETURN REL. LOC
	POPJ	PP,
SUBTTL	GENERATE "TRACE ON/OFF" COMMAND

TRCGEN:	SKIPE	PRODSW		;IF '/P' TYPED,
	POPJ	PP,		;  NO CODE

	MOVE	CH,[XWD SETOM.,PTFLG.]
	TLNN	W1,(<1B9>)
	HRLI	CH,SETZM.
	JRST	PUT.EX		;WRITE OUT CODE
SUBTTL	GENERATE "METER--JSYS" COMMAND

IFN CSTATS,<
METGEN:	HRRZ	TC,EOPLOC
	HRRZ	CH,2(TC)	;PICK UP THE NUMBER
	HRLI	CH,MOVEI.+AC16	;"MOVEI 16,NUMBER"
	PUSHJ	PP,PUTASY
	MOVE	CH,[EPJPP,,METER.]	;"PUSHJ PP,METER."
	PJRST	PUT.EX		;DONE

>;END IFN CSTATS
SUBTTL	GENERATE 'SEARCH' OPERATOR

;THE 'SEARCH' GENERATOR GENERATES THE FOLLOWING CODE.
;IN THE EXAMPLE, THE KEY IS ASSUMED TO BE COMP; APPROPRIATE
;CODE IS GENERATED FOR OTHER USAGES.

;SEARCH ALL:

;	SETZM	INDEX
;	MOVE	0,[POWER OF 2 GREATER THAN TABLE SIZE]
;	MOVEM	0,%PARAM
;
; %I:	MOVE	0,%PARAM
;	IDIVI	0,2
;	JUMPE	0,%AE+1
;	MOVEM	0,%PARAM
;	ADDM	0,INDEX
;	JRST	%T
;
; %D:	MOVE	0,%PARAM
;	IDIVI	0,2
;	JUMPE	0,%AE+1
;	MOVEM	0,%PARAM
;	MOVN	0,0
;	ADDM	0,INDEX
;
; %T:	CAMG	0,DEPENDING-ITEM  ;IF 'DEPENDING' CLAUSE PRESENT
;	CAILE	0,TABLE-SIZE
;	JRST	%D
; %AE:
;	JRST	%X		;PUT OUT BY 'SPIF'
;	<AT-END CODE>		;PUT OUT BY OTHER GENERATORS
;
; %X:	<KEY COMPARISON>	;SEE BELOW
;	     .
;	     .
;	<KEY COMPARISON>


;THE 'KEY COMPARISON' IS AS FOLLOWS:
;
;	MOVE	0,KEY
;	CAMN	0,CONDITION-ITEM
;	JRST	%E
;	CAML	0,CONDITION-ITEM	;'CAMG' IF DESCENDING KEY
;	JRST	%D
;	JRST	%I
; %E:

;SEARCH OTHER THAN 'ALL'
;
; %L:	MOVE	0,INDEX		;IF VARYING ITEM IS
;	MOVEM	0,VARYING-ITEM	;  OTHER THAN THE INDEX
;	MOVE	0,INDEX
;	JUMPLE	0,%AE+1
;	CAIG	0,TABLE-SIZE
; %AE:
;	JRST	%X		;PUT OUT BY 'SPIF'
;	<AT-END CODE>		;PUT OUT BY OTHER GENERATORS
;
; %X:	<'WHEN' CODE>		;PUT OUT BY 'IF'
;	     .
;	     .
;	<'WHEN' CODE>
;
;	AOS	INDEX
;	JRST	%L

;NOTE THAT, IF A 'DEPENDING' CLAUSE IS INVOLVED, THE 'CAIG' CODE ABOVE IS
;	REPLACED BY:
;
;	CAMG	0,DEPENDING-ITEM
;	CAILE	0,TABLE-SIZE
;	SKIPA
SRCHGN:	MOVEM	W1,OPLINE	;SAVE W1
	SETZM	SRCFST		;CLEAR
	MOVE	TE,[XWD SRCFST,SRCFST+1];  WORK
	BLT	TE,SRCLST	;AREA
	MOVE	EACA,EOPNXT
	CAMN	EACA,EOPLOC	;IF NO OPERANDS,
	POPJ	PP,		;  FORGET IT

	TLO	W2,AS.TAG	;BE SURE 'W2' HAS TAG
	HRRZ	TC,EOPLOC	;GET TO
	MOVEI	TC,1(TC)	;  FIRST OPERAND
	MOVSM	TC,OPERND
	MOVEM	TC,CUREOP

	MOVE	TA,1(TC)	;SAVE
	HRRZM	TA,SRCIDN	;  SEARCH IDENTIFIER
	PUSHJ	PP,LNKSET	;CONVERT TO ADDRESS
	LDB	TE,DA.ERR	; SEARCH ITEM IS IN ERROR [243]
	JUMPN	TE,SRCERR	; YES ERROR [243]
	LDB	TE,DA.NOC	;IF THIS HAS
	JUMPE	TE,NOIDX	;  NO 'OCCURS', TROUBLE
	MOVEM	TE,SRCNOC	;SAVE NUMBER OF OCCURENCES
	LDB	TE,DA.XBY	;GET 'INDEXED BY' ITEM
	PUSHJ	PP,SRCG60	;FIND THE CORRECT INDEX
	HRRZM	TE,SRCIDX	;SAVE IT
	JUMPE	TE,NOIDX	;IF ZERO--TROUBLE
	MOVE	TC,CUREOP
	MOVEM	TE,1(TC)	;REPLACE LINK IN FIRST OPERAND

	PUSHJ	PP,GETTAG	;GET TAG FOR
	HRRZM	CH,SRCAE	;  'AT END' PATH LESS 1

	TLNE	W1,IFALL	;IF 'AL' SEARCH,
	JRST	SRCG01		;  WE DON'T NEED TAG
	PUSHJ	PP,GETTAG	;GET TAG FOR
	HRRZM	CH,SRCLUP	;  THE LOOP
	PUSHJ	PP,PUTTAG	;GIVE IT TO ASSEMBLER

SRCG01:	PUSHJ	PP,BMPEOP	;STEP TO NEXT OPERAND
	JRST	SRCG03		;THERE IS NONE--SO NO 'VARYING'

	HRRZ	TC,CUREOP	;REMEMBER
	HRRM	TC,OPERND	;  OPERAND ADDRESS
	HRRZ	TE,1(TC)	;IS IT THE
	CAMN	TE,SRCIDX	;  SEARCH INDEX?
	JRST	SRCG03		;YES--NO CODE NEEDED

	HLRZ	TC,OPERND
	PUSHJ	PP,SETOPA	;SET UP 'A' TO BE 'INDEXED BY' ITEM
	HRRZ	TC,OPERND
	PUSHJ	PP,SETOPB	;SET UP 'B' TO BE 'VARYING' ITEM
	TSWT	FBNUM		;IF 'B' IS NOT NUMERIC,
	JRST	NOTNUM		;  ERROR

	PUSHJ	PP,MXX.		;MOVE 'A' TO 'B'
;ANY 'VARYING' HAS BEEN DONE

SRCG03:	HLRZ	TC,OPERND	;GET BACK TO
	MOVEM	TC,CUREOP	;  'INDEXED BY' ITEM

	TLNE	W1,IFALL	;IF IT IS 'SEARCH ALL',
	JRST	SRCG10		;  GO A DIFFERENT ROUTE

;IT IS NOT 'SEARCH ALL'

	PUSHJ	PP,SETOPA	;MAKE FISRT OPERAND BE 'A'
	SETZM	EAC		;USE AC'S 0&1
	PUSHJ	PP,MXAC.	;PICK UP 'A'
	SWON	FAINAC		;SET FLAG

	MOVSI	CH,ASINC+JMPLE.	;GENERATE
	HRR	CH,SRCAE	;  <JUMPLE %AE+1>
	LDB	TA,[POINT 15,CH,35] ;TAG NUMBER
	PUSHJ	PP,REFTAG	;REFERENCE IT
	PUSHJ	PP,PUTASN
	HRRZI	CH,1
	PUSHJ	PP,PUTASY

	MOVE	TA,SRCIDN	;GET LINK TO OCCURRENCE ITEM
	PUSHJ	PP,LNKSET
	LDB	CH,DA.DEP	;ANY 'DEPENDING' VARIABLE?
	JUMPE	CH,SRCG05	;NO, IF JUMP

;OCCURENCE HAS 'DEPENDING' ITEM

IFN ANS74,<
	LDB	CH,DA.DCR	;NEED TO CONVERT
	JUMPE	CH,SRCG04	;NO
	HRLI	CH,EPJPP
	IORI	CH,AS.TAG	;PUSHJ PP,%NNN
	PUSHJ	PP,PUTASY
	MOVE	CH,[CAMG.+ASINC,,AS.MSC]
	PUSHJ	PP,PUTASN
	MOVEI	CH,AS.PAR	;CAMG 0,%PARAM
	JRST	SRCG07		;OUTPUT COMPARE

SRCG04:	LDB	CH,DA.DEP	;REGET IT
>
	ANDI	CH,TM.DAT	;CHANGE
	IORI	CH,AS.DAT	;  CODE
	HRLI	CH,CAMG.	;GENERATE
SRCG07:
	PUSHJ	PP,PUTASY	;  <CAMG 0,DEP-VARIABLE>
	MOVE	CH,[XWD CAILE.,AS.CNB]	;GENERATE
	PUSHJ	PP,PUTASN	;  <CAILE 0,OCCURS>
	MOVE	TA,SRCIDN
	PUSHJ	PP,LNKSET
	LDB	CH,DA.NOC
	PUSHJ	PP,PUTASY
	MOVSI	CH,SKIPA.
	PUSHJ	PP,PUTASY
	JRST	SRCG06

;OCCURENCE HAS NO 'DEPENDING' ITEM

SRCG05:	MOVE	CH,[XWD CAIG.,AS.CNB]	;GENERATE
	PUSHJ	PP,PUTASN	;  <CAIG 2,TABLE-SIZE>
	MOVE	CH,SRCNOC
	PUSHJ	PP,PUTASY

SRCG06:	HRRZ	CH,SRCAE	;DEFINE TAG FOR
	JRST	PUTTAG		;  'AT END' PATH, THEN LEAVE
;SEARCH HAS 'ALL' OPTION

SRCG10:	SETOM	SRCALL		;SET FLAG FOR 'SINCR'

	HRRZ	TA,SRCIDN	;GET ADDRESS OF DATAB ENTRY FOR
	PUSHJ	PP,LNKSET	;  SEARCHED ITEM
	LDB	TE,DA.KEY	;GET AND
	MOVEM	TE,SRCKYN	;  SAVE NUMBER OF KEYS
	JUMPE	TE,NOKEYS	;IF ZERO--ERROR

	HRRZ	CH,SRCIDX	;GENERATE
	ANDI	CH,TM.DAT	;  <SETZM INDEX>
	IORI	CH,AS.DAT
	HRLI	CH,SETZM.
	PUSHJ	PP,PUTASY

	MOVEI	TC,2		;COMPUTE
	SKIPA	TE,SRCNOC	;  POWER
SRCG11:	LSH	TC,1		;  OF TWO
	CAIG	TC,(TE)		;  GREATER THAN
	JRST	SRCG11		;  TABLE SIZE

	SETZM	EAC		;GENERATE
	MOVSI	CH,MOV		;  <MOVE 0,[POWER OF TWO]>
	PUSHJ	PP,PUT.LA

	MOVE	CH,[XWD MOVEM.,AS.MSC];GENERATE
	PUSHJ	PP,PUTASN	;  <MOVEM %PARAM>
	HRRZ	CH,EAS1PC
	IORI	CH,AS.PAR
	MOVEM	CH,SRCPAR
	PUSHJ	PP,PUTASY
	AOS	EAS1PC
	MOVE	CH,[XWD AS.OCT,1]	;PUT OUT <OCT 0> ON AS1FIL
	PUSHJ	PP,PUTAS1
	MOVEI	CH,0
	PUSHJ	PP,PUTAS1


	PUSHJ	PP,GETTAG	;GET TAG
	HRRZM	CH,SRC%I	;  FOR 'INCREMENT' CODE
	PUSHJ	PP,PUTTAG

	MOVE	CH,[XWD SKIPA.+AC1+ASINC,AS.MSC]
	PUSHJ	PP,PUTASN
	MOVE	CH,SRCPAR
	PUSHJ	PP,PUTASY

	MOVE	CH,[XWD AC1+ASINC+MOVN.,AS.MSC]
	PUSHJ	PP,PUTASN
	MOVE	CH,SRCPAR
	PUSHJ	PP,PUTASY

;SEARCH HAS 'ALL' OPTION (CONT'D)

	MOVE	CH,[XWD AC1+IDIVI.,2]	;<IDIVI 1,2>
	PUSHJ	PP,PUTASY

	HRRZ	CH,SRCAE	;<JUMPE 1,AT-END>
	HRLI	CH,AC1+ASINC+JUMPE.
	LDB	TA,[POINT 15,CH,35] ;TAG NUMBER
	PUSHJ	PP,REFTAG	;REFERENCE IT
	PUSHJ	PP,PUTASN
	HRRZI	CH,1
	PUSHJ	PP,PUTASY

	MOVE	CH,[XWD AC1+ASINC+MOVMM.,AS.MSC]	;<MOVMM 1,%PARAM>
	PUSHJ	PP,PUTASN
	MOVE	CH,SRCPAR
	PUSHJ	PP,PUTASY

	MOVE	CH,SRCIDX	;<ADDB 1,INDEX>
	ANDI	CH,TM.DAT
	IORI	CH,AS.DAT
	HRLI	CH,AC1+ADDB.
	PUSHJ	PP,PUTASY

	MOVE	TA,SRCIDN	;GET
	PUSHJ	PP,LNKSET	;  TABLE ADDRESS
	LDB	CH,DA.DEP	;ANY 'DEPENDING' ITEM?
	JUMPE	CH,SRCG13	;NO, IF JUMP
IFN ANS74,<
	LDB	CH,DA.DCR	;NEED TO CONVERT
	JUMPE	CH,SRCG12	;NO
	HRLI	CH,EPJPP
	IORI	CH,AS.TAG	;PUSHJ PP,%NNN
	PUSHJ	PP,PUTASY
	MOVE	CH,[CAMG.+AC1+ASINC,,AS.MSC]
	PUSHJ	PP,PUTASN
	MOVEI	CH,AS.PAR	;CAMG 1,%PARAM
	JRST	SRCG15		;OUTPUT COMPARE

SRCG12:	LDB	CH,DA.DEP	;REGET IT
>
	ANDI	CH,TM.DAT	;YES
	IORI	CH,AS.DAT	;GENERATE
	HRLI	CH,AC1+CAMG.	;  <CAMG 1,DEPENDING-ITEM>
SRCG15:	PUSHJ	PP,PUTASY	; PUT INTO ASY FILE AND GO ON [164]

SRCG13:	MOVE	CH,[XWD AC1+CAILE.,AS.CNB]	;GENERATE
	PUSHJ	PP,PUTASN	;  <CAILE 1,TABLE-SIZE>
	MOVE	CH,SRCNOC

SRCG14:	PUSHJ	PP,PUTASY

	MOVE	CH,SRC%I	;GENERATE
	HRLI	CH,ASINC+JRST.	;  <JRST %I+1>
	LDB	TA,[POINT 15,CH,35] ;TAG NUMBER
	PUSHJ	PP,REFTAG	;REFERENCE IT
	PUSHJ	PP,PUTASN
	MOVEI	CH,1
	PUSHJ	PP,PUTASY

	JRST	SRCG06

;THERE WAS NO 'INDEXED BY' OPTION

NOIDX:	MOVEI	DW,E.381
	JRST	NOKYS1

;THERE WERE NO KEYS

NOKEYS:	MOVEI	DW,E.386
	SETZM	SRCIDX
NOKYS1:	SETZM	SRCIDN
	JRST	OPNFAT

SRCERR:	SETZM	SRCIDN		; CLEAR SEARCH ITEM [243]
	SWON	ERROR.		; SET ERROR SWITCH [243]
	POPJ	PP,		;[243]
;FIND THE CORRECT INDEX.
;ENTER WITH HLDTAB LINK TO FIRST ITEM OF 'INDEXED BY' CLAUSE IN 'TE'.
;EXIT WITH DATAB LINK TO INDEX IN 'TE' (ZERO IF ERROR).

SRCG60:	ANDI	TE,LMASKS	;THROW AWAY ANY CODE IN LINK
	JUMPE	TE,SRCG67	;IF ZERO, NO LINK
	MOVE	TA,TE		;GET
	ADD	TA,HLDLOC	;  ADDRESS
	HRRZM	TA,CURHLD

	LDB	TD,HL.LNK	;DOES THIS
	CAME	TD,SRCIDN	;  ITEM POINT TO THE TABLE?
	JRST	SRCG66		;NO--TROUBLE

	PUSH	PP,CUREOP	;SAVE CUREOP
	PUSHJ	PP,BMPEOP	;ANY OTHER OPERAND?
	JRST	SRCG63		;NO--THEREFORE NO 'VARYING'

	HRRZ	TC,CUREOP	;YES--SAVE ADDRESS OF THAT OPERAND
	POP	PP,CUREOP	;RESTORE CUREOP
	HRRZ	TC,1(TC)	;GET LINK TO VARYING ITEM

SRCG62:	LDB	TE,HL.NAM	;IS THIS THE DESIRED INDEX?
	IORI	TE,TC.DAT
	CAIN	TE,(TC)
	POPJ	PP,		;YES

	ADDI	TA,2		;NO--STEP DOWN TO NEXT HLDTAB ITEM
	HRRZ	TD,HLDNXT	;ARE WE
	CAIL	TA,(TD)		;  OUT OF HLDTAB?
	JRST	SRCG64		;YES--USE FIRST INDEX

	LDB	TD,HL.COD	;NO--IS THIS
	TRZ	TD,700		;*** TEMP, CLEAN UP AFTER CLEANC ***
	CAIE	TD,HL.XBY	;  'INDEXED BY' ITEM?
	JRST	SRCG64		;NO--USE FIRST INDEX

	LDB	TD,HL.LNK	;IS IT POINTING
	CAMN	TD,SRCIDN	;  TO THE TABLE?
	JRST	SRCG62		;YES--LOOP

	JRST	SRCG64		;NO--USE FIRST INDEX

;THE FIRST INDEX IS TO BE USED

SRCG63:	POP	PP,CUREOP	;RESTORE CUREOP

SRCG64:	MOVE	TA,CURHLD
	LDB	TE,HL.NAM
	IORI	TE,TC.DAT
	POPJ	PP,

;FIND CORRECT INDEX (CONT'D).

;ERROR--RETURN ZERO IN TE

SRCG66:	MOVEI	TE,0
SRCG67:	POPJ	PP,
SUBTTL	GENERATE 'SINCR' OPERATOR

SINCGN:	MOVEM	W1,OPLINE	;SAVE W1
	SKIPE	SRCALL		;WAS SEARCH AN 'ALL'?
	JRST	SINC10		;YES

	SKIPN	CH,SRCIDX	;GET INDEX-NAME
	POPJ	PP,		;IF ZERO--QUIT
	ANDI	CH,TM.DAT
	IORI	CH,AS.DAT
	HRLI	CH,AOS.
	PUSHJ	PP,PUTASY

	SKIPN	CH,SRCLUP	;GET TAG FOR LOOP
	POPJ	PP,		;IF NONE, FORGET IT
	HRLI	CH,JRST.
	LDB	TA,[POINT 15,CH,35] ;GET TAG NUMBER
	PUSHJ	PP,REFTAG	;REFERENCE IT
	JRST	PUTASY		;  <JRST LOOPTAG>

;SEARCH WAS 'ALL'

SINC10:	MOVE	EACA,EOPNXT
	CAMN	EACA,EOPLOC	;IF NO OPERANDS,
	POPJ	PP,		;  QUIT

	SKIPE	TA,SRCIDN	;IF TROUBLE WITH
	SKIPN	SRCKYN		;  SEARCH
	POPJ	PP,		;  QUIT

	PUSHJ	PP,LNKSET	;SET 'TA'
	ADDI	TA,DA.RKL	;  TO BE
	HRRZM	TA,SRCKYL	;  ADDRESS OF FIRST ENTRY
	SETZM	SRCFLG

;COUNT THE OPERANDS.
;ONE MAY BE IN AC'S.

	MOVE	TC,EOPLOC
	MOVEI	TC,1(TC)
	HRRZM	TC,CUREOP
	MOVEI	TB,1
SINC12:	MOVE	TD,1(TC)
	TLNN	TD,GNNOTD
	JRST	SNC12A
	HRRZ	TD,0(TC)
	CAILE	TD,17
	JRST	SNC12A
	PUSHJ	PP,PUTEMP
	HRRM	EACC,0(TC)

SNC12A:	PUSHJ	PP,BMPEOP
	JRST	SNC12C
	AOS	TC,CUREOP
	AOJA	TB,SINC12
SNC12C:	MOVEM	TB,SRCOPN	;SAVE IT
SINC13:	MOVE	TC,EOPLOC	;START AT TOP
	MOVEI	TC,1(TC)	;  OF EOPTAB
	HRRZM	TC,CUREOP
	SWOFF	FEOFF1
	JRST	SINC15

SINC14:	PUSHJ	PP,BMPEOP	;STEP DOWN TO NEXT OPERAND
	JRST	SINC16		;NO MORE--SOME KIND OF ERROR
	AOS	TC,CUREOP
SINC15:	SKIPN	(TC)		;WAS THAT OPERAND DONE BEFORE?
	JRST	SINC14		;YES--TRY NEXT
	MOVSM	TC,OPERND	;NO--SAVE THE LOCATION
	HRRZ	TA,1(TC)	;IS IT
	LDB	TE,LNKCOD	;  A
	CAIN	TE,TB.CON	;  CONDITION-NAME?
	JRST	SINC18		;YES

	HRRZ	TE,@SRCKYL	;NO--IS IT
	CAIN	TE,(TA)		;  THE CURRENT KEY?
	JRST	SINC26		;YES

	PUSHJ	PP,BMPEOP	;NO--STEP TO SECOND OF CONDITION PAIR
	JRST	BADEOP		;NONE--ERROR FROM PHASE D
	AOS	TC,CUREOP	;IS THAT
	HRRZ	TA,1(TC)	;  THE
	HRRZ	TE,@SRCKYL	;  CURRENT
	CAIE	TE,(TA)		;  KEY?
	JRST	SINC14		;NO--STEP TO NEXT OPERAND
	JRST	SINC27		;YES

;WE HAVE LOOKED THROUGH ALL OPERANDS AND HAVEN'T FOUND THE KEY

SINC16:	AOS	SRCFLG		;BUMP ERROR FLAG
SINC17:	SOSG	SRCKYN		;ANY MORE KEYS?
	JRST	SINC20		;NO
	AOS	SRCKYL		;YES--STEP TO NEXT KEY
	JRST	SINC13		;  AND LOOK FOR THAT

;WE FOUND A CONDITION NAME

SINC18:	PUSHJ	PP,LNKSET	;GET ADDRESS
	LDB	TE,CO.DAT	;GET ASSOCIATED DATA-NAME
	HRRZ	TD,@SRCKYL	;IS IT THE
	CAIE	TE,(TD)		;  CURRENT KEY?
	JRST	SINC14		;NO

	SKIPN	SRCFLG		;YES--ANY HIGHER KEYS NOT MENTIONED?
	JRST	SINC33		;NO--OK
SINC19:	MOVEI	DW,E.382	;YES--PUT OUT DIAG
	PUSHJ	PP,OPNFAT
	JRST	SINC34

;NO MORE KEYS -- PUT OUT DIAG FOR EACH REMAINING CONDITION

SINC20:	MOVE	TC,EOPLOC
	MOVEI	TC,1(TC)
	MOVEM	TC,CUREOP

SINC21:	SETZM	OPERND
	SKIPN	0(TC)		;HAS OPERAND BEEN USED?
	JRST	SINC24		;YES
	MOVE	TA,1(TC)	;NO--
	LDB	TE,LNKCOD	;  IS IT
	CAIE	TE,TB.CON	;  CONDITION-NAME?
	JRST	SINC22		;NO
	MOVEI	DW,E.384	;YES
	PUSHJ	PP,OPNFAT
	JRST	SINC24

SINC22:	TLNN	TA,GNNOTD
	MOVEM	TC,OPERND
	PUSHJ	PP,BMPEOP	;STEP DOWN TO SECOND OPERAND
	JRST	BADEOP		;OOPS!
	AOS	TC,CUREOP
	MOVE	TE,1(TC)
	TLNN	TE,GNNOTD
	MOVEM	TC,OPERND
	MOVEI	DW,E.383
	SKIPN	TC,OPERND
	JRST	SINC23
	PUSH	PP,CUREOP
	MOVEM	TC,CUREOP
	PUSHJ	PP,OPNFAT
	POP	PP,CUREOP
	JRST	SINC24

SINC23:	PUSHJ	PP,OPFAT
SINC24:	PUSHJ	PP,BMPEOP	;IF NO MORE OPERANDS,
	POPJ	PP,		;  WE ARE DONE
	AOS	TC,CUREOP	;LOOP THROUGH
	JRST	SINC21		;  ALL OPERANDS

;FIRST OPERAND OF A PAIR IS CURRENT KEY

SINC26:	PUSHJ	PP,BMPEOP	;GET SECOND ONE
	JRST	BADEOP		;NONE--PHASE D ERROR
	AOS	TC,CUREOP
	HRRM	TC,OPERND
	JRST	SINC28

;SECOND OPERAND OF A PAIR IS CURRENT KEY

SINC27:	HRRM	TC,OPERND
	MOVSS	OPERND

SINC28:	SWOFF	FEOFF1		;CLEAR FLAGS
	HLRZ	TC,OPERND
	MOVEM	TC,CUREOP
	SKIPE	SRCFLG		;IF MORE MAJOR KEYS NOT MENTIONED,
	JRST	SINC31		;  ERROR

	MOVEI	LN,EBASEA
	PUSHJ	PP,SETOPN
	HRRZ	TC,OPERND
	MOVEI	LN,EBASEB
	PUSHJ	PP,SETOPN

	TSWT	FERROR
	PUSHJ	PP,SINC50	;GENERATE COMPARISONS

SINC30:	HLRZ	TD,OPERND
	SETZM	(TD)
	HRRZ	TD,OPERND
	SETZM	(TD)

	MOVNI	TD,2
	ADDB	TD,SRCOPN
	JUMPG	TD,SINC17
	POPJ	PP,

SINC31:	MOVEI	DW,E.382
	PUSHJ	PP,OPNFAT
	JRST	SINC30

;PRODUCE CODE FOR CONDITION-NAME TEST

SINC33:	HRRM	TD,1(TC)	;PUT DATAB LINK IN OPERAND
	HRRZM	TA,CURCON	;SAVE ADDRESS OF CONTAB ENTRY

	LDB	TE,CO.NVL	;GET NUMBER OF VALUES
	JUMPE	TE,SINC34	;IF NONE, FORGET IT
	MOVE	TD,2(TA)	;IF
	TLNN	TD,1B18		;  RANGE
	CAIE	TE,1		;  OR MORE THAN ONE VALUE
	JRST	SINC35		;  ERROR

	MOVEI	LN,EBASEA
	PUSHJ	PP,SETOPN

	MOVE	TA,CURCON	;IS VALUE
	MOVE	TE,2(TA)	;  A FIGURATIVE
	TRNE	TE,1B19		;  CONSTANT?
	JRST	SINC37		;YES

	MOVE	TE,[XWD EBASEA,EBASEB]
	BLT	TE,EBASBX
	HLRZ	TE,2(TA)
	ANDI	TE,77777
	IORI	TE,AS.TAG
	HRLI	TE,^D36
	MOVEM	TE,EBASEB
	SETZM	EINCRB

	TSWF	FANUM		;IF 'A' IS NUMERIC,
	SWONS	FBNUM!FBSIGN	;  THEN 'B' IS SIGNED NUMERIC
	SWOFF	FBSIGN!FBNUM
	SWOFF	FBSUB

SNC33A:	TSWT	FERROR		;IF WE HAVEN'T HAD TROUBLE,
	PUSHJ	PP,SINC50	;  GENERATE COMPARISONS

SINC34:	HLRZ	TE,OPERND
	SETZM	(TE)

	SOS	TD,SRCOPN
	JUMPG	TD,SINC17
	POPJ	PP,

;ONLY ONE VALUE ALLOWED FOR CONDITION NAME

SINC35:	MOVEI	DW,E.385
	PUSHJ	PP,OPNFAT
	JRST	SINC34

;IT IS CONDITION-NAME WITH VALUE OF FIG. CONST.

SINC37:	HLRZ	TC,OPERND	;SET BOTH OPERANDS TO BE
	HRRM	TC,OPERND	;  IN SAME PLACE
	LDB	TE,[POINT 6,2(TA),7];GET FIG. CONST. FLAGS
	LSH	TE,1		;LEAVE ROOM FOR 'ALL' FLAG
	TRZE	TE,1B29		;WAS IT 'ALL'?
	TRO	TE,1		;YES
	TRO	TE,1B20!1B21!1B22
	DPB	TE,[POINT 16,(TC),15]
	MOVEI	LN,EBASEB
	PUSHJ	PP,SETOPN
	JRST	SNC33A

;PUT OUT COMPARISON CODE

SINC50:	MOVE	TE,[XWD EBASEA,ESAVSC]	;SAVE PARAMETERS
	BLT	TE,ESVSCX

;SAVE "A" AND "B" ABS. LOCATIONS FOR EBYTEX, INCASE TABLES EXPAND
	HRRZ	TE,EBYTEA
	HRRZ	TD,VALLOC##
	SUB	TE,TD
	PUSH	PP,TE		;SAVE "A"
	HRRZ	TE,EBYTEB##
	SUB	TE,TD
	PUSH	PP,TE		;SAVE "B"

	TLZ	W1,777774	;CREATE
	TLO	W1,IFNEQ	;  'IF NOT EQUAL'
	PUSHJ	PP,GETTAG	;GET TAG FOR 'EQUAL' PATH
	MOVEM	CH,SRC%E
	HRL	W2,CH

	PUSH	PP,SW
	PUSH	PP,OPERND
	PUSHJ	PP,IFGNZC	;GENERATE 'IF NOT EQUAL'
	POP	PP,OPERND
	POP	PP,SW

	MOVS	TE,[XWD EBASEA,ESAVSC];RESTORE
	BLT	TE,EBASBX	;  PARAMETERS

;RESTORE "A" AND "B" ABS. LOC OF EBYTEX
	POP	PP,TE		;"B"
	ADD	TE,VALLOC##	
	HRRM	TE,EBYTEB
	POP	PP,TE		;"A"
	ADD	TE,VALLOC
	HRRM	TE,EBYTEA

	TLZ	W1,777774	;CREATE
	SKIPGE	@SRCKYL		;  EITHER
	TLOA	W1,IFLESS	;  'IF LESS' OR
	TLO	W1,IFGRT	;  'IF GREATER'
	HRL	W2,SRC%I
	PUSHJ	PP,IFGNZC	;GENERATE 'IF LESS' OR 'IF GREATER'

	MOVE	CH,SRC%I	;GENERATE
	HRLI	CH,JRST.+ASINC	;  <JRST <DECREMENT CODE>>
	LDB	TA,[POINT 15,CH,35]
	PUSHJ	PP,REFTAG	;REFERENCE THE TAG
	PUSHJ	PP,PUTASN
	MOVEI	CH,1
	PUSHJ	PP,PUTASY

	MOVE	CH,SRC%E	;DEFINE
	JRST	PUTTAG		;  'EQUAL' TAG AND LEAVE
SUBTTL	COMPILER-BREAK-ON-PHASE "X" (X=E,G, OR O)
CBPHE:
IFN DEBUG,<
	HRRZ	TC,EOPLOC	;FIRST OPERAND
	ADDI	TC,1		;POINT TO IT
	MOVEM	TC,CUREOP	;STORE IN CUREOP
	PUSHJ	PP,SETOPA	;SETUP AS OPERAND "A", DON'T RETURN IF ERRORS
	ILDB	TA,EBYTEA	;WHICH PHASE?
	CAIN	TA,"E"
	 JRST	GOCBE		;E
	OUTSTR	[ASCIZ/?COMPILER-BREAK-IN-PHASE "G" or "O" not implemented
/]
	POPJ	PP,		;IGNORE

GOCBE:	OUTSTR	[ASCIZ/[$CBE]
/]
$CBE::	POPJ	PP,		;RETURN
>;END IFN DEBUG

IFLESS==1B27	;'LESS' FLAG FOR 'IF' OPERATOR
IFGRT==1B28	;'GREATER' FLAG FOR 'IF' OPERATOR
IFNEQ==3B28	;'NOT EQUAL' FLAG FOR 'IF' OPERATOR
IFALL=1B27	;'ALL' FLAG IN SEARCH OPERATOR

EXTERN	AS.CNB,AS.MSC,AS.LIT,AS.PAR,AS.TAG,AS.XWD,AS.DAT,AS.OCT
EXTERN	TM.DAT,TC.DAT
EXTERN	GETTAG,PUTTAG,REFTAG
EXTERN	BMPEOP,CUREOP,BADEOP,EBASEA,EINCRA,EOPLOC,EOPNXT,CURDAT
EXTERN	LNKSET,OPERND,OPLINE,OPNFAT,OPFAT,PUTASN,PUTASY,PUTASA,PUT.EX,PUT.LA
EXTERN	SETOPA,SETOPB,SETOPN,NOTNUM,LNKCOD
EXTERN	D6MODE,D7MODE,D9MODE,DSMODE,D1MODE
EXTERN	ESIZEA,EBYTEA,EMODEA,EDPLA,EFLAGA,ESIZEB,EDPLB,EMODEB,EFLAGB
EXTERN	EBASEB,EINCRB,EBASBX,EBASAX,ESAVEA,ESAVAX
EXTERN	EPJPP,POOL,ELITPC,PLITPC,XWDLIT,BYTLIT,STASHP,STASHQ,POOLIT
EXTERN	PRODSW,PTFLG.,EAC,NODEPV,SUBINP
IFN CSTATS,<
EXTERN	METER.
>;END IFN CSTATS
EXTERN	ESIZEZ,ETABLA
EXTERN	DA.ERR,DA.XBY,DA.NOC,DA.EXS,DA.EDT,DA.CLA,DA.DEP,DA.DCR,DA.KEY,DA.RKL
EXTERN	HIVQOT,D.LTCD,BYTE.W,IFSPCS,IFZROS
EXTERN	MBYTPA,VLIT8.,VLIT6.,LITERR,LITD.
EXTERN	SUBSCA
EXTERN	SUSEAC			;WHERE TO PUT SUBSCRIPTED BYTE PTR
EXTERN	MXX.,MXAC.
IFN ANS68,<
EXTERN	EXAM.,TALLY.
>;END IFN ANS68
EXTERN	TEMLOC,TEMNXT,XPNTEM
IFN ANS74,<
EXTERN	INSP.
EXTERN	IARG11,IOPFLG,INARGP,ITLPTR,CURIRG,INSPTF,INSPSL,TEMADP,SERSIZ
EXTERN	STEMPC,ETEMPC
EXTERN	DEPTSA,ONLYEX,B1PAR,SZDPVA,DPBDEP
EXTERN	TESUBC
EXTERN	COLSEQ,PRGCOL
EXTERN	RESG13		;ROUTINE IN MATGEN TO STORE RESULT
>;END IFN ANS74
EXTERN	MOV,MOVEM.,SETZM.,MOVEI.,HRLM.,SETOM.,JMPLE.,CAMG.,CAILE.,CAIG.,SKIPA.
EXTERN	IDIVI.,MOVN.,JUMPE.,MOVMM.,ADDB.,JRST.,AOS.,DPB.
EXTERN	CPOPJ,CPOPJ1
EXTERN	PUTAS1,EAS1PC
EXTERN	PUTEMP,GETEMP
EXTERN	SRCFST,SRCLST,SRCIDN,SRCNOC,SRCIDX,SRCLUP,SRCAE,SRCALL,SRCKYN,SRCPAR
EXTERN	SRCFLG,SRCKYL,SRCOPN,SRC%I,SRC%E
EXTERN	HL.LNK,HL.COD,HL.XBY,HL.NAM
EXTERN	LMASKS,HLDLOC,HLDNXT,CURHLD
EXTERN	TB.CON,CURCON,CO.DAT,CO.NVL
EXTERN	ESAVSC,ESVSCX
EXTERN	IFGNZC

	END