Google
 

Trailing-Edge - PDP-10 Archives - decuslib20-06 - decus/20-153/lookup.mac
There are 52 other files named lookup.mac in the archive. Click here to see a list.
	TITLE	LOOKUP FOR RPGII %1
	SUBTTL	GENERATE CODE FOR LOOKUP VERB

;
;	LOOKUP		LOOKUP CODE GENERATOR FOR PHASE E OF RPGII
;
;	THIS MODULE IS USED TO GENERATE THE CODE FOR THE LOOKUP
;	VERB. USED BY PHASE E.
;
;	BOB CURRIER	FEBRUARY 20, 1976 19:04:42
;
;	ALL RIGHTS RESERVED, BOB CURRIER
;

	TWOSEG
	RELOC	400000

	ENTRY	.LOKUP
	ENTRY	LKTAG
;THIS MODULE GENERATES THE FOLLOWING CODE FOR AN ORDERED SEARCH. IT IS
;ASSUMED THAT THE SEARCH ITEM IS NUMERIC AND THE TABLE IS IN ASCENDING
;ORDER FOR THIS EXAMPLE.
;
;	INDC.
;	JRST	%AE
;	SETZM	INDEX
;	MOVE	0,[POWER OF TWO GREATER THAN TABLE-SIZE]
;	MOVEM	0,%TEMP
;	SETOF.	[INDICATORS]
;	<<CODE TO GET SEARCH ITEM INTO AC3>>
;
; %I:	MOVE	0,%TEMP
;	IDIVI	0,2
;	JUMPE	0,%NI
;	MOVEM	0,%TEMP
;	ADDB	0,INDEX
;	JRST	%T
;
; %D:	MOVE	0,%TEMP
;	IDIVI	0,2
;	JUMPE	0,%NI
;	MOVEM	0,%TEMP
;	MOVN	0,0
;	ADDB	0,INDEX
;
; %T:	CAILE	0,TABLE-SIZE
;	JRST	%D
;	SUBSCR	0,[BYTE POINTER TO TABLE]
;	TLZ	0,3777
;	TLO	0,ENTRY-SIZE
;	GD6.	1,0
;	CMP%11	3
;	JRST	%E
;	JRST	%I
;	JRST	%D		;REVERSE THIS AND LAST LINE FOR DESCENDING
;
; IF WE WANT HIGH ,<
;
; %NI:	AOS	0,INDEX		; SOS IF DESCENDING TABLE
;	CAILE	0,TABLE-SIZE
;	JRST	%AE

; %ND:	SETON.	[INDICATORS]
;	MOVE	0,INDEX
;	MOVEM	0,TABLE-STASH-AREA
;	JRST	%AE
;	>
;
; IF WE WANT LOW,<
;
; %NI:	SETON.	[INDICATORS]
;	MOVE	0,INDEX
;	MOVEM	0,TABLE-STASH-AREA
;	JRST	%AE
;
; %ND:	SOS	0,INDEX
;	JUMPE	0,%AE
;	JRST	%NI
;	>
;
; IF WE WANT EQUAL,<
;
; %NI:
; %ND:	JRST	%AE
;	>
;
; IF WE WANT HIGH,<
;
; %E:	AOS	0,INDEX
;	CAILE	0,TABLE-SIZE
;	JRST	%AE
;	SETON.	[INDICATORS]
;	MOVE	0,INDEX
;	MOVEM	0,TABLE-STASH-AREA
;	>
;
; IF WE WANT LOW,<
;
; %E:	SOS	0,INDEX
;	JUMPE	0,%AE
;	SETON.	[INDICATORS]
;	MOVE	0,INDEX
;	MOVEM	0,TABLE-STASH-AREA
;	>
;
; IF WE WANT EQUAL,<
;
; %E:	SETON.	[INDICATORS]
;	MOVE	0,INDEX
;	MOVEM	0,TABLE-STASH-AREA
;	>
;
; %AE:
;

;IF ALPHANUMERIC INSTEAD OF NUMERIC, REPLACE GD6. SEQUENCE WITH:
;
;	MOVEM	0,%TEMP+3
;	MOVE	0,[BYTE POINTER TO SEARCH ITEM]
;	MOVEM	0,%TEMP+2
;
;THIS MODULE GENERATES THE FOLLOWING CODE FOR A LINEAR SEARCH. IT IS
;ASSUMED THAT THE SEARCH ITEM IS NUMERIC.
;
;	INDC.
;	JRST	%AE
;	SETZM	INDEX
;	SETOF.	[INDICATORS]
;	<<CODE TO GET SEARCH ITEM INTO AC3>>
;
; %I:	AOS	INDEX
;	MOVE	0,INDEX
;	CAILE	0,TABLE-SIZE
;	JRST	%AE
;	SUBSCR	0,[BYTE POINTER TO TABLE]
;	TLZ	0,3777
;	TLO	0,ENTRY-SIZE
;	GD6.	1,0
;	CMP.11	3
;	JRST	%E
;	JRST	%I
;	JRST	%I
;
; %E:	MOVE	0,INDEX
;	MOVEM	0,TABLE-STASH-AREA
;	SETON.	[INDICATORS]
;
; %AE:
;
;THIS MODULE EXPECTS THE GENFIL DATA TO BE SET AS FOLLOWS:
;
;OPRTR		OPLKUP	BIT9 = 1 IF TABLE
;OPRTR+1	INDTAB POINTER
;OPRTR+2	DATAB LINK TO TABLE/ARRAY
;OPRTR+3	DATAB LINK TO SEARCH ITEM
;OPRTR+4	0,,INDTAB-LINK
;OPRTR+5	DATAB link to related table item
;
;AT TAG .LOK14 THE DATA IS REARRANGED TO BE AS FOLLOWS:
;
;OPRTR+2	0,,INDTAB-LINK
;OPRTR+3	DATAB LINK TO TABLE/ARRAY
;OPRTR+4	DATAB LINK TO SEARCH ITEM
;OPRTR+5	DATAB link to related table item
;
;ENTER HERE THE GATES OF DELERIUM
;
;

.LOKUP:	SWOFF	FLKNUM!FASCEN!FLKLIN;	; TURN OFF RESIDUAL FLAGS
	GETLN;				; get line number for any error messages
	MOVE	TB,OPRTR##+3		; GET SEARCH ITEM DATA
	TLNE	TB,1B20			; NUMERIC LITERAL?
	  JRST	.LOK01			; YES -
	TLNE	TB,1B19			; ALPHA LITERAL?
	  JRST	.LOK02			; YES -
	MOVEI	TB,3			; SEARCH ITEM INDEX
	PUSHJ	PP,GTFLD##		; GET FIELD DATA
	PUSH	PP,TA			; SAVE THE TABLE LINK
	PUSH	PP,TC			; save field type
	MOVEI	TB,2			; get index
	PUSHJ	PP,GTFLD		; get the field
	MOVE	TB,TC			; get field type for this one
	POP	PP,TC			; and restore the other
	LDB	TB,DA.FLD##		; GET THE FIELD TYPE
	CAME	TB,TC			; IS IT THE SAME AS SEARCH ITEM?
	  JRST	.LOK03			; NO - ERROR
	JUMPE	TB,.+2			; IS TABLE NUMERIC?
	  SWON	FLKNUM;			; YES - FLAG IT AS SUCH
	LDB	TB,DA.FMT##		; GET FORMAT
	LDB	TC,DA.SIZ##		; GET SIZE
	POP	PP,TA			; GET BACK SEARCH ITEM POINTER
	LDB	TD,DA.FMT		; GET THAT FORMAT
	CAME	TB,TD			; SAME AS TABLE?
	  JRST	.LOK3B			; NO - ERROR
	LDB	TD,DA.SIZ		; GET SIZE
	CAME	TC,TD			; IS THAT THE SAME?
	  JRST	.LOK04			; NO - ERROR
	JRST	.LOK05			; YES - GO GENERATE SOME CODE

.LOK01:	SWON	FLKNUM;			; WE KNOW IT'S NUMERIC
	MOVEI	TB,2			; get index
	PUSHJ	PP,GTFLD		; get the field
	JUMPE	TC,.LOK03		; JUMP IF NOT NUMERIC
	JRST	.LOK05			; ALL'S WELL

.LOK02:	MOVEI	TB,2			; get the index
	PUSHJ	PP,GTFLD		; get the field type
	JUMPE	TC,.LOK05		; LEAP IF OKAY -

.LOK3B:	WARN	206;			; not same data type
	POPJ	PP,			; exit

.LOK03:	WARN	206;			; NOT SAME DATA TYPE
	POP	PP,TB			; pop off garbage on the stack
	POPJ	PP,			; EXIT

.LOK04:	WARN	195;			; NOT SAME LENGTH
	POPJ	PP,
;START GENERATING CODE
;

.LOK05:	PUSHJ	PP,INDCHK##		; GENERATE INDICATOR CHECK
	HLRZ	TB,OPRTR+1		; GET INDICATOR LINK
	SKIPN	TB			; DO WE HAVE ONE?
	  PUSHJ	PP,BLDTAG		; NO - MUST BUILD TAG NOW SINCE INDCHK DIDN'T
	MOVE	TB,TAGNUM##		; GET TAG WE JUST PUT OUT
	MOVEM	TB,LK%AE##		; STORE FOR LATER REFERENCE
	HRRZ	TA,OPRTR+2		; [344] get table/array operand
	PUSHJ	PP,LNKSET		; [344] set up DATAB link
	LDB	TB,DA.INP		; [344] get index pointer
	SKIPE	TB			; [344] is it subscripted?
	  SWON	FLKLIN;			; [344] yes - use linear search technique
	MOVEI	TB,2			; [311] get OPRTR index
	PUSHJ	PP,GTFLD##		; [311] get pointer
	LDB	TB,DA.SEQ##		; GET SEQUENCE ENTRY
	JUMPN	TB,.+2			; SKIP IF ORDERED
	  SWON	FLKLIN;			; UNORDERED - USE LINEAR SEARCH MECHANISM
	CAIE	TB,2			; ASCENDING?
	  SWON	FASCEN;			; YES - FLAG AS SUCH
	LDB	TB,DA.DEC##		; GET DECIMAL PLACES
	MOVEM	TB,RESDEC##		; STASH
	MOVE	TB,ETEMAX##		; GET MAXIMUM TEMP SIZE
	CAIGE	TB,2			; BIG ENOUGH FOR OUR NEEDS?
	  MOVEI	TB,2			; NO - GET SIZE WE WANT
	MOVEM	TB,ETEMAX		; REPLACE OLD OR NEW AS CASE MAY BE
	TSWT	FLKLIN;			; [325] linear search?
	  JRST	.LOK5C			; [325] no -
;[325] This section generates code to initialize the subscript (if one exists)
	PUSH	PP,TA			; [325] save the ac
	MOVE	TA,OPRTR+2		; [325] establish pointer to DATAB
	PUSHJ	PP,LNKSET		; [325] entry for this LOKUP.
	LDB	TB,DA.INP##		; [325] is it indexed?
	JUMPN	TB,.+3			; [325] yes -
	POP	PP,TA			; [325] no - restore old DATAB pointer
	JRST	.LOK5C			; [325] and continue on our merry way
	LDB	TC,DA.IMD##		; [325] immediate index?
	JUMPN	TC,.LOK5A		; [325] yes -
	PUSH	PP,OPRTR+2		; [325] save the GENFIL operator
	MOVEM	TB,OPRTR+2		; [325] and set up index pointer instead
	PUSHJ	PP,GT1AC1##		; [325] generate <GD?. 1,INDEX>
	POP	PP,OPRTR+2		; [325] restore
	MOVE	CH,[XWD SUBI.##+AC1,AS.CNS+1]; [325] <SUBI 1,1>
	PUSHJ	PP,PUTASY##		; [325] output it
	JRST	.LOK5B			; [325] now store index in TEMP

.LOK5A:	MOVE	CH,[XWD MOVEI.+AC1,AS.CNS]; [325]
	ADDI	CH,-1(TB)		; [325] <MOVEI 1,IMMED-INDEX - 1>
	PUSHJ	PP,PUTASY		; [325] output it

.LOK5B:	MOVE	CH,[XWD MOVEM.+AC1+ASINC,AS.MSC] ; [325]
	PUSHJ	PP,PUTASY		; [325] <MOVEM 1,%TEMP>
	POP	PP,TA			; [325] bring back old DATAB pointer
	JRST	.LOK5D			; [325] put out %TEMP

.LOK5C:	MOVE	CH,[XWD SETZM.+ASINC,AS.MSC] ; [325]
	PUSHJ	PP,PUTASY##		; GENERATE <SETZM INDEX>

.LOK5D:	MOVEI	CH,AS.TMP		; [325] INDEX = %TEMP
	PUSHJ	PP,PUTASN##		; OUTPUT IT
	LDB	TB,DA.OCC##		; GET NUMBER OF OCCURANCES
	MOVEM	TB,LKOCC##		; STASH TMP'LY
	TSWF	FLKLIN;			; LINEAR SEARCH?
	  JRST	.LOK6B			; YES - NO NEED FOR 2**X
	MOVEI	TC,2			; GET SET TO GENERATE POWER OF TWO
	SKIPA	TE,LKOCC		;    LARGER THAN TABLE SIZE
.LOK06:	LSH	TC,1			; 40 LSH'S
	CAIG	TC,(TE)			; DONE YET?
	  JRST	.LOK06			; NOPE - LOOP
	MOVE	CH,[XWD MOVEI.+AC0,AS.CNS]
	ADD	CH,TC			; ADD IN POWER OF TWO
	PUSHJ	PP,PUTASY		; OUTPUT <MOVEI 5,POWER-OF-TWO>
	MOVE	CH,[XWD MOVEM.+AC0+ASINC,AS.MSC]
	PUSHJ	PP,PUTASY		; OUTPUT <MOVEM 5,%TEMP+1>
	MOVEI	CH,AS.TMP+1		; GET THE %TEMP+1
	PUSHJ	PP,PUTASN		; OUTPUT IT
;CONTINUE GENERATING START CODE
;

.LOK6A:	MOVE	CH,[XWD SETOF.##+ASINC,AS.MSC]
	PUSHJ	PP,PUTASY		; OUTPUT IT
	MOVE	CH,ELITPC		; GET A LITAB WORD
	TRO	CH,AS.LIT		; IDENTIFY IT AS SUCH
	PUSHJ	PP,PUTASN		; OUTPUT IT
	HRRZ	TA,OPRTR+4		; [305] get indicator link
	PUSHJ	PP,LNKSET##		; SET IT UP
	MOVE	CH,[XWD OCTLIT,1]	; 1 OCTAL CONSTANT TO LITAB
	PUSHJ	PP,STASHC		; OUTPUT HEADER
	MOVE	CH,(TA)			; GET THOSE INDICATORS
	PUSHJ	PP,STASHC		; OUTPUT
	AOS	ELITPC			; BUMP PC
	TSWT	FLKNUM;			; NUMERIC SEARCH?
	  JRST	.LOK07			; NO -
	PUSHJ	PP,GT2AC3##		; YES - GENERATE CODE TO GET SEARCH ITEM
	MOVE	TC,RESDEC		;    INTO AC3+AC4 AND SHIFT IT
	PUSHJ	PP,SH2AC3##		;    TO MATCH THE TABLE ITEMS.
	JRST	.LOK07			; [325]

;[325] The following section generates code to set the index to
;[325] 1 in the event the LOKUP fails.

.LOK6B:	MOVE	TA,OPRTR+2		; [325] establish the pointer to
	PUSHJ	PP,LNKSET		; [325]    DATAB entry for this LOKUP.
	LDB	TB,DA.INP		; [325] indexed?
	JUMPE	TB,.LOK6A		; [325] naw, forget it
	LDB	TC,DA.IMD		; [325] immediate index?
	JUMPN	TC,.LOK6A		; [325] yes - back to mainstream code
	PUSH	PP,OPRTR+4		; [325] stash operator tmp'ly
	PUSH	PP,OPRTR+1		; [325] ditto
	MOVEM	TB,OPRTR+4		; [325] DATAB entry for index goes here
	SETZM	OPRTR+1			; [325] we need this zero for PTRAC1
	MOVE	CH,[XWD MOVEI.+AC1,AS.CNS+1] ; [325]
	PUSHJ	PP,PUTASY		; [325] output <MOVEI 1,1>
	PUSHJ	PP,PTRAC1##		; [325] generate <PD?. 1,INDEX>
	POP	PP,OPRTR+1		; [325] restore operators
	POP	PP,OPRTR+4		; [325]
	JRST	.LOK6A			; [325] and get on with it
;CONTINUE GENERATING CODE
;

.LOK07:	AOS	TB,TAGNUM		; GET NEXT TAG
	MOVEM	TB,LK%I##		; STASH FOR FUTURE REFERENCE
	PUSHJ	PP,BLDTAG##		; CREATE PROTAB ENTRY FOR TAG
	PUSHJ	PP,FNDTAG##		; OUTPUT TAG TO ASYFIL
	TSWF	FLKLIN;			; LINEAR SEARCH?
	  JRST	.LOKLN			; YES - GENERATE SOME SPECIAL CODE
	MOVE	TB,TAGNUM		; GET A TAG
	MOVEM	TB,LK%NI##		; STASH FOR LATER
	PUSHJ	PP,BLDTAG		; SET UP A PROTAB ENTRY
	AOS	TB,TAGNUM		; GET THE NEXT TAG
	MOVEM	TB,LK%ND##		; STASH THIS TOO
	PUSHJ	PP,BLDTAG		; AND BUILD ANOTHER PROTAB ENTRY
	PUSHJ	PP,.LOK08		; NO - GENERATE COMMON CODE
	EXP	LK%NI			; DATA WORD
	MOVE	CH,[XWD ADDB.+AC0+ASINC,AS.MSC]
	PUSHJ	PP,PUTASY		; GENERATE <ADDB 5,INDEX>
	MOVEI	CH,AS.TMP		; INDEX = %TEMP
	PUSHJ	PP,PUTASN		; OUTPUT IT
	AOS	TB,TAGNUM		; GET ANOTHER TAG
	MOVEM	TB,LK%T##		; STORE AS %T TAG
	PUSHJ	PP,BLDTAG		; MAKE A PROTAB ENTRY
	MOVE	CH,CURPRO		; GET THAT ENTRY
	SUB	CH,PROLOC		; MAKE INTO RELATIVE LOC
	HRRZS	CH			; CLEAN OUT THE GARBAGE
	ADD	CH,[XWD JRST.,AS.PRO]	; GENERATE <JRST %T>
	PUSHJ	PP,PUTASY		; OUTPUT IT
	AOS 	TB,TAGNUM		; GET NEXT TAG
	MOVEM	TB,LK%D##		; STASH
	PUSHJ	PP,BLDTAG		; MAKE PROTAB ENTRY
	PUSHJ	PP,FNDTAG		; OUTPUT %D: TO ASYFIL
	PUSHJ	PP,.LOK08		; OUTPUT COMMON CODE
	EXP	LK%ND			; DATA WORD
	MOVE	CH,[XWD MOVN.+AC0,AS.CNS+0]
	PUSHJ	PP,PUTASY		; OUTPUT <MOVN 5,5>
	MOVE	CH,[XWD ADDB.+AC0+ASINC,AS.MSC]
	PUSHJ	PP,PUTASY		; OUTPUT <ADDB 5,INDEX>
	MOVEI	CH,AS.TMP		; INDEX = %TEMP
	PUSHJ	PP,PUTASN		; OUTPUT SECOND WORD
	PUSH	PP,TAGNUM		; STASH FOR SAFE KEEPING
	MOVE	TB,LK%T			; GET %T
	MOVEM	TB,TAGNUM		; STORE AS NEW TAG NUMBER
	PUSHJ	PP,FNDTAG		; OUTPUT %T:
	POP	PP,TAGNUM		; RESTORE VALUE
.LOK7A:	MOVE	CH,[XWD CAILE.+AC0+ASINC,AS.CNB]
	PUSHJ	PP,PUTASY		; OUTPUT <CAILE 5,TABLE-SIZE>
	MOVE	CH,LKOCC		; GET TABLE SIZE
	PUSHJ	PP,PUTASN		; OUTPUT IT
	MOVE	CH,LK%D			; [307] get %D
	PUSHJ	PP,LKTAG		; GET POINTER TO IT
	ADD	CH,[XWD JRST.,AS.PRO]	; MAKE A <JRST %AE>
	PUSHJ	PP,PUTASY		; OUTPUT IT
	MOVE	CH,[XWD SUBSCR+AC0+ASINC,AS.MSC]
	PUSHJ	PP,PUTASY		; OUTPUT <SUBSCR 5,[BYTE POINTER]>
	MOVE	CH,ELITPC##		; GET LITAB PC
	TRO	CH,AS.LIT		; IDENTIFY
	PUSHJ	PP,PUTASN		; OUTPUT IT
;.LOK14		CONTINUE GENERATING CODE
;

.LOK14:	MOVE	TB,OPRTR+4		; REARRANGE STACKS
	EXCH	TB,OPRTR+2		; SEE THE START OF THIS MODULE
	EXCH	TB,OPRTR+3		;   FOR NEW ORDERING OF STACK
	MOVEM	TB,OPRTR+4		; ALL DONE
	MOVEI	TB,3			; [311] get index
	PUSHJ	PP,GTFLD		; [311] go get pointer
	PUSHJ	PP,PUTPT2##		; [256] output LITAB pointer with no imbedded size
	MOVE	CH,[XWD XWDLIT,2]	; GET LITAB HEADER
	PUSHJ	PP,STASHC		; OUTPUT IT
	LDB	CH,DA.OCC		; GET NUMBER OF OCCURS
	PUSHJ	PP,STASHC		; OUTPUT AS LH
	LDB	CH,DA.SIZ		; GET SIZE OF ENTRY
	PUSHJ	PP,STASHC		; OUTPUT AS RH
	AOS	ELITPC			; BUMP LITAB PC
	LDB	TC,DA.SIZ		; GET THE SIZE
	MOVEM	TC,OP1SIZ		; STORE FOR OTHERS

.LOK09:	MOVE	CH,[XWD TLZ.+AC0,AS.CNS+3777]
	PUSHJ	PP,PUTASY		; OUTPUT <TLZ 5,3777>
	MOVE	CH,[XWD TLO.+AC0,AS.CNS]
	ADD	CH,OP1SIZ##		; GET SIZE OF TABLE
	PUSHJ	PP,PUTASY		; OUTPUT <TLO 5,SIZE OF TABLE>
	TSWT	FLKNUM;			; IS SEARCH NUMERIC?
	  JRST	.LOK12			; NO - GENERATE ALPHA COMP
	LDB	CH,DA.FMT##		; GET FORMAT OF TABLE
	MOVE	CH,LKTB1(CH)		; GET GD INSTRUCTION TO USE
	PUSHJ	PP,PUTASY		; GENERATE <GD? 1,5>
	MOVEI	LN,6			; GET PROPER INDEX
	PUSHJ	PP,CH.12##		; GENERATE COMPARISON INSTRUCTION
;.LOK10		GENERATE FINAL CODE FOR LOOKUP
;

.LOK10:	MOVE	TB,TAGNUM		; GET A TAG
	MOVEM	TB,LK%E##		; STASH AS %E
	PUSHJ	PP,BLDTAG		; GENERATE PROTAB ENTRY
	MOVE	CH,CURPRO##		; GET PROTAB ENTRY
	SUB	CH,PROLOC##		; MAKE A RELATIVE POINTER
	HRRZS	CH			; GET GOOD HALF
	ADD	CH,[XWD JRST.,AS.PRO]	; MAKE A <JRST %E>
	PUSHJ	PP,PUTASY		; OUTPUT IT
	AOS	TAGNUM			; GIVE NEXT GUY A CHANCE
	TSWF	FLKLIN;			; [367] LINEAR SEARCH?
	  JRST	[	MOVE	TB,TAGNUM	; [367] YES - GET CURRENT TAG
			MOVEM	TB,LK%ND	; [367] STASH AS TAG TO USE
			PUSHJ	PP,BLDTAG	; [367] GET A PROTAB ENTRY
			AOS	TAGNUM		; [367] INCREMENT
	  		HRRZ	TA,OPRTR+2	; [367] GET POINTER
			PUSHJ	PP,LNKSET	; [367] SET LINKS
			LDB	CH,[POINT 16,(TA),15]
			JUMPE	CH,.+2		; [367] SKIP IF NO HI/LO
			 TSWF	FASCEN;		; [367] ASCENDING?
			  SKIPA	CH,LK%ND	; [367] YES - USE %ND:
			   MOVE	CH,LK%I		; [367] NO - USE %I:
			 JRST	.+4 ]		; [367] CONTINUE
	TSWF	FASCEN;			; ASCENDING SEQUENCE?
	  SKIPA	CH,LK%I			; YES - WE WANT <JRST %I>
	MOVE	CH,LK%D			; NO - WE WANT <JRST %D>
	PUSHJ	PP,LKTAG		; GET TAG
	ADD	CH,[XWD JRST.,AS.PRO]	; MAKE INTO INSTRUCTION
	PUSHJ	PP,PUTASY		; OUTPUT AS SUCH
	TSWF	FLKLIN;			; [367] LINEAR?
	  JRST	[	TSWT	FASCEN;		; [367] ASCENDING SEQ?
			 SKIPA	CH,LK%ND	; [367] YES - USE %ND
			  MOVE	CH,LK%I		; [367] NO - USE %I
			JRST	.+4 ]		; [367] CONTINUE
	TSWT	FASCEN;			; ASCENDING SEARCH?
	  SKIPA	CH,LK%I			; NO - WE WANT <JRST %I>
	MOVE	CH,LK%D			; YES - WE WANT <JRST %D>
	PUSHJ	PP,LKTAG		; GET POINTER
	ADD	CH,[XWD JRST.,AS.PRO]	; MAKE A REAL ITEM
	PUSHJ	PP,PUTASY		; OUTPUT
	PUSH	PP,TAGNUM		; STASH FOR SAFEKEEPING
	TSWT	FLKLIN;			; LINEAR SEARCH?
	  PUSHJ	PP,.LOKHL		; NO - GENERATE %NI & %ND
	MOVE	TB,LK%E			; WE WANT %E
	MOVEM	TB,TAGNUM		; STICK
	PUSHJ	PP,FNDTAG		; OUTPUT %E:
	POP	PP,TAGNUM		; RESTORE
	HRRZ	TA,OPRTR+2		; GET INDICATOR LINK
	PUSHJ	PP,LNKSET		; SET UP THE LINK
	LDB	TB,[POINT 8,(TA),23]	; GET EQUAL INDICATOR
	PUSH	PP,TA			; [367] SAVE TA ON STACK
	SKIPN	TB			; [372] do we have an equal indicator?
	  PUSHJ	PP,.LK10C		; [372] no - decide what to do
	PUSHJ	PP,.LOKCM		; [367] OUTPUT EQUAL CODE
	TSWF	FLKLIN;			; [367] LINEAR?
	  JRST	[	PUSH	PP,TAGNUM	; [367] YES - SAVE TAGNUM
			MOVE	TB,LK%ND	; [367] GET %ND:
			MOVEM	TB,TAGNUM	; [367] SAVE IT
			PUSHJ	PP,FNDTAG	; [367] OUTPUT %ND:
			POP	PP,TAGNUM	; [367] RESTORE TAGNUM
			JRST	.+1 ]		; [367] CONTINUE
	POP	PP,TA			; [367] RESTORE TA
	LDB	TB,[POINT 8,(TA),7]	; GET HIGH INDICATOR
	JUMPN	TB,.LK10B		; IF ONE, GENERATE HIGH CODE
	LDB	TB,[POINT 8,(TA),15]	; IF NOT - USE LOW
	JUMPE	TB,.LOK11		; [367] EXIT IF NONE
	TSWF	FASCEN;			; ASCENDING?
	  PUSHJ	PP,.LOKLS		; YES -

.LK10A:	PUSHJ	PP,.LOKCM		; GENERATE COMMON CODE
	JRST	.LOK11			; CONTINUE

.LK10B:	TSWT	FASCEN;			;
	  PUSHJ	PP,.LOKLS		; IF DESCENDING
	JRST	.LK10A			; GO FINISH UP

.LK10C:	LDB	TB,[POINT 8,(TA),7]	; [372] get high indicator
	JUMPN	TB,.LK10D		; [372] jump if we get one
	LDB	TB,[POINT 8,(TA),15]	; [372] else get low indicator
	JUMPE	TB,.LK10E		; [372] ignore error condition of no indicator
	TSWF	FASCEN;			; [372] ascending table?
	  PUSHJ	PP,.LOKLS		; [372] yes - generate SUB code
	TSWT	FASCEN;			; [372] otherwise....
	  PUSHJ	PP,.LOKHA		; [372] generate ADD code
.LK10E:	POPJ	PP,			; [372] then return

.LK10D:	TSWT	FASCEN;			; [372] ascending?
	  PUSHJ	PP,.LOKLS		; [372] no -
	TSWF	FASCEN;			; [372]
	  PUSHJ	PP,.LOKHA		; [372] yes -
	POPJ	PP,			; [372] return
;.LOK11		FINISH UP
;

.LOK11:	PUSH	PP,TAGNUM		; SAVE TAGNUM
	MOVE	TB,LK%AE		; FINALLY USE %AE
	MOVEM	TB,TAGNUM		; STASH
	PUSHJ	PP,FNDTAG		; OUTPUT %AE:
	POP	PP,TAGNUM		; RESTORE TAGNUM
	SWOFF	FINDON;			; WE RESOLVED EVERYTHING
	POPJ	PP,			; ALL DONE (WHEW!)
;.LOK12		GENERATE SPECIAL CODE FOR ALPHA COMPARE
;

.LOK12:	MOVEI	TB,2			; NEED TWO MORE TEMP WORDS
	MOVE	TC,ETEMAX		; GET SIZE
	CAIGE	TC,4			; MUST BE FOUR OR GREATER
	  ADDM	TB,ETEMAX		; IS'NT - MAKE IT SO
	MOVE	CH,[XWD MOVEM.+AC0+ASINC,AS.MSC]
	PUSHJ	PP,PUTASY		; OUTPUT <MOVEM 5,%TEMP+3>
	MOVEI	CH,AS.TMP+3		; GET ADDRESS
	PUSHJ	PP,PUTASN		; OUTPUT IT
	PUSHJ	PP,STBYT2##		; SET UP BYTE POINTER TO SEARCH ITEM
	MOVE	CH,[XWD MOV+AC0+ASINC,AS.MSC]
	PUSHJ	PP,PUTASY		; OUTPUT <MOVE 5,[BYTE POINTER TO SEARCH-ITEM]>
	MOVE	CH,ELITPC		; GET LITAB PC
	TRO	CH,AS.LIT		; IDENTIFY AS SUCH
	PUSHJ	PP,PUTASN		; OUTPUT IT
	MOVE	CH,[XWD BYTLIT,2]	; LITAB HEADER WORD
	PUSHJ	PP,STASHC##		; OUTPUT TO LITAB
	MOVE	CH,[XWD AS.BYT,AS.MSC]	; ASYFIL HEADER WORD
	PUSHJ	PP,STASHC		; THAT GOES IN LITAB TOO
	MOVE	CH,OP2BYT##		; AT LAST GET THE BYTE POINTER
	PUSHJ	PP,STASHC		; OUTPUT IT
	AOS	ELITPC			; BUMP PC
	MOVE	CH,[XWD MOVEM.+AC0+ASINC,AS.MSC]
	PUSHJ	PP,PUTASY		; OUTPUT <MOVEM 5,%TEMP+2>
	MOVEI	CH,AS.TMP+2		; GET ADDRESS
	PUSHJ	PP,PUTASN		; OUTPUT IT
	MOVE	CH,[XWD COMP%+ASINC,AS.MSC]
	PUSHJ	PP,PUTASY		; OUTPUT <COMP% %TEMP+2>
	MOVEI	CH,AS.TMP+2		; GET ADDRESS
	PUSHJ	PP,PUTASN		; OUT WITH IT
	JRST	.LOK10			; OUTPUT REST OF CODE
;.LOK08		OUTPUT COMMON PORTION OF INDEX MANIPULATING CODE
;
;THIS ROUTINE GENERATES THE FOLLOWING CODE:
;
;	MOVE	5,%TEMP
;	IDIVI	5,2
;	JUMPE	5,%AE
;	MOVEM	5,%TEMP
;

.LOK08:	MOVE	CH,[XWD MOV+AC0+ASINC,AS.MSC]
	PUSHJ	PP,PUTASY		; OUTPUT <MOVE 5,%TEMP>
	MOVEI	CH,AS.TMP+1		; %TEMP = TMP+1
	PUSHJ	PP,PUTASN		; OUTPUT
	MOVE	CH,[XWD IDIVI.+AC0,AS.CNS+2]
	PUSHJ	PP,PUTASY		; OUTPUT <IDIVI 5,2>
	MOVE	CH,@(PP)		; GET THE TAG
	MOVE	CH,(CH)			; ONE MORE TRY
	PUSHJ	PP,LKTAG		; GET POINTER
	ADD	CH,[XWD JUMPE.+AC0,AS.PRO]
	PUSHJ	PP,PUTASY		; OUTPUT <JUMPE 5,%AE>
	MOVE	CH,[XWD MOVEM.+AC0+ASINC,AS.MSC]
	PUSHJ	PP,PUTASY		; OUTPUT <MOVEM 5,%TEMP>
	MOVEI	CH,AS.TMP+1		; %TEMP = TMP+1
	AOS	(PP)			; SKIP OVER DATA WORD
	PJRST	PUTASN			; OUTPUT AND EXIT
;.LOKLN		GENERATE CODE FOR LINEAR SEARCH
;
;GENERATE:
;
;	AOS	INDEX
;	MOVE	5,INDEX
;

.LOKLN:	MOVE	CH,[XWD AOS.+ASINC,AS.MSC]
	PUSHJ	PP,PUTASY		; OUTPUT <AOS INDEX>
	MOVEI	CH,AS.TMP		; INDEX = %TEMP
	PUSHJ	PP,PUTASN		; OUTPUT IT
	MOVE	CH,[XWD MOV+ASINC,AS.MSC]
	PUSHJ	PP,PUTASY		; OUTPUT <MOVE 5,INDEX>
	MOVEI	CH,AS.TMP		; INDEX = %TEMP
	PUSHJ	PP,PUTASN		; OUTPUT
	MOVE	CH,[XWD CAILE.+AC0+ASINC,AS.CNB]; [323]
	PUSHJ	PP,PUTASY		; [323] output <CAILE 0,TABLE-SIZE>
	MOVE	CH,LKOCC		; [323] get table size
	PUSHJ	PP,PUTASN		; [323] output that as RH of instruction
	MOVE	CH,LK%AE		; [323] get %AE location
	PUSHJ	PP,LKTAG		; [323] lookup pointer to it
	ADD	CH,[XWD JRST.,AS.PRO]	; [323] make it into <JRST %AE>
	PUSHJ	PP,PUTASY		; [323] output it
	MOVE	CH,[XWD SUBSCR+AC0+ASINC,AS.MSC] ; [323]
	PUSHJ	PP,PUTASY		; [323] output <SUBSCR 0,[BYTE-POINTER]>
	MOVE	CH,ELITPC		; [323] get literal location
	TRO	CH,AS.LIT		; [323] mark as literal
	PUSHJ	PP,PUTASN		; [323] output location of byte pointer
	JRST	.LOK14			; [323] continue with rest of code generation
;LKTAG		ROUTINE TO GET RELATIVE PROTAB POINTER TO TAG IN CH
;

LKTAG:	PUSH	PP,TAGNUM		; SAVE TAGNUM
	PUSH	PP,TB			; [372] save TB
	MOVEM	CH,TAGNUM		; STASH NEW TAG
	PUSHJ	PP,MAKTAG##		; MAKE A NAMWRD ENTRY
	PUSHJ	PP,TRYNAM##		; LOOKUP IN NAMTAB
	  JRST	LKTAGX			; NO GOOD
	MOVEI	TB,CD.PRO		; GET PROTAB ID
	MOVSS	TA			; WORK WITH RELATIVE LINK
	PUSHJ	PP,FNDLNK##		; LOOKUP NAMTAB LINK
	  JRST	LKTAGX			; ERROR...ERROR...EROR...ERR...ER...E.......
	HRRZ	CH,PROLOC		; GET PROTAB LOCATION
	SUB	TB,CH			; MAKE RELATIVE POINTER
	MOVE	CH,TB			; MOVE IT
	POP	PP,TB			; [372] restore TB
	POP	PP,TAGNUM		; RESTORE TAGNUM
	POPJ	PP,			; EXIT

LKTAGX:	MSG	<?Tag lost in LKTAG, is NAMTAB smashed?
>
	JRST	KILL##			; DIE YOU MISERABLE CREATURE
;.LOKHL		ROUTINE TO OUTPUT CODE FOR ROUTINE %NI AND %ND
;

.LOKHL:	PUSH	PP,TAGNUM		; STASH TAGNUM
	MOVE	TB,LK%NI		; GET %NI:
	MOVEM	TB,TAGNUM		; STASH AS TAG
	PUSHJ	PP,FNDTAG		; OUTPUT TAG
	POP	PP,TAGNUM		; RESTORE TAGNUM
	HRRZ	TA,OPRTR+2		; GET INDTAB LINK
	PUSHJ	PP,LNKSET		; SET IT UP
	LDB	TB,[POINT 8,(TA),15]	; GET LOW INDICATOR
	JUMPE	TB,.LOKHI		; NONE - MUST WANT HIGH OR NONE
	PUSHJ	PP,.LOKCM		; GENERATE COMMON CODE
	PUSH	PP,TAGNUM		; SAVE TAGNUM
	MOVE	TB,LK%ND		; GET %ND:
	MOVEM	TB,TAGNUM		; STORE AS TAG
	PUSHJ	PP,FNDTAG		; TO OUTPUT
	POP	PP,TAGNUM		; RESTORE TAGNUM
	TSWT	FASCEN;			; ASCENDING?
	  PUSHJ	PP,.LOKHA		; NO - OUTPUT INCREMENT CODE
	TSWF	FASCEN;
	  PUSHJ	PP,.LOKLS		; YES - OUTPUT DECREMENT CODE
	MOVE	CH,LK%ND		; GET %ND:
	PUSHJ	PP,LKTAG		; GET PROTAB INDEX
	ADD	CH,[XWD JRST.,AS.PRO]	; CONVERT TO AN INSTRUCTION
	PJRST	PUTASY			; WHICH WE OUTPUT, THEN EXIT

.LOKHI:	LDB	TB,[POINT 8,(TA),7]	; GET HIGH INDICATOR
	JUMPE	TB,.LOKNO		; IS EQUAL - NO CODE NEED BE GENERATED
	PUSH	PP,TB			; SAVE INDICATOR
	TSWT	FASCEN;			;
	  PUSHJ	PP,.LOKLS		; IF DESCENDING GENERATE DECREMENT
	TSWF	FASCEN;			;
	  PUSHJ	PP,.LOKHA		; IF ASCENDING GENERATE INCREMENT
	PUSH	PP,TAGNUM		; STASH TAGNUM
	MOVE	TB,LK%ND		; GET %ND:
	MOVEM	TB,TAGNUM		; STASH
	PUSHJ	PP,FNDTAG		; GENERATE %ND:
	POP	PP,TAGNUM		; RESTORE TAGNUM
	POP	PP,TB			; GET INDICATOR WE SAVED
	PJRST	.LOKCM			; GENERATE COMMON CODE THEN EXIT
;.LOKLS		GENERATE CODE TO DECREMENT INDEX AND CHECK FOR VALIDITY
;

.LOKLS:	MOVE	CH,[XWD SOS.+ASINC,AS.MSC]
	PUSHJ	PP,PUTASY		; GENERATE <SOS 0,INDEX>
	MOVEI	CH,AS.TMP		; GET INDEX
	PUSHJ	PP,PUTASN		; OUTPUT ADDRESS FIELD
	PUSHJ	PP,.LOKH2		; [372] output move code
	MOVE	CH,LK%AE		; GET %AE:
	PUSHJ	PP,LKTAG		; GET PROTAB INDEX
	ADD	CH,[XWD JUMPE.+AC0,AS.PRO]
	PJRST	PUTASY			; OUTPUT <JUMPE 0,%AE> THEN EXIT


;.LOKHA		GENERATE CODE TO INCREMENT INDEX AND CHECK FOR VALIDITY
;

.LOKHA:	MOVE	CH,[XWD AOS.+ASINC,AS.MSC]
	PUSHJ	PP,PUTASY		; GENERATE <AOS 0,INDEX>
	MOVEI	CH,AS.TMP		; INDEX = %TEMP
	PUSHJ	PP,PUTASN		; OUTPUT AS ADDRESS
	PUSHJ	PP,.LOKH2		; [372] output move code
	MOVE	CH,[XWD CAILE.+AC0+ASINC,AS.CNB]
	PUSHJ	PP,PUTASN		; OUTPUT <CAILE 0,TABLE-SIZE>
	MOVE	CH,LKOCC		; GET TABLE SIZE
	PUSHJ	PP,PUTASY		; OUTPUT IT
	MOVE	CH,LK%AE		; GET %AE:
	PUSHJ	PP,LKTAG		; GET PROTAB ENTRY
	ADD	CH,[XWD JRST.,AS.PRO]	; GENERATE <JRST %AE>
	PJRST	PUTASY			; OUTPUT AND EXIT

.LOKH2:	MOVE	CH,[XWD MOV+AC0+ASINC,AS.MSC] ; [372]
	PUSHJ	PP,PUTASY		; [372] generate a <MOVE 0,%TEMP>
	MOVEI	CH,AS.TMP		; [372] since AOS and SOS won't transfer
	PJRST	PUTASN			; [372] with AC=0
;.LOKNO		GENERATE %NI AND %ND CODE FOR EQUAL ONLY CHECK
;

.LOKNO:	PUSH	PP,TAGNUM		; STASH TAGNUM
	MOVE	TB,LK%ND		; GET %ND:
	MOVEM	TB,TAGNUM		; STASH AS TAG NUMBER TO USE
	PUSHJ	PP,FNDTAG		; WHEN WE CALL TAG GENERATOR
	POP	PP,TAGNUM		; RESTORE TAGNUM
	MOVE	CH,LK%AE		; GET %AE:
	PUSHJ	PP,LKTAG		; SET UP PROTAB LINK
	ADD	CH,[XWD JRST.,AS.PRO]	; GENERATE <JRST %AE>
	PJRST	PUTASY			; OUTPUT AND EXIT

;.LOKCM		GENERATE COMMON CODE FOR INDEX MODIFYING ROUTINES
;

.LOKCM:	TSWT	FLKLIN;			; [325] linear search?
	  JRST	.LOKCB			; [325] nope -

;[325] The following section generates code to save the value of the index
;[325] after a successful LOKUP if the array being searched had a field
;[325] name (rather than a literal) for an index.

	PUSH	PP,TA			; [325] save off current DATAB pointer
	PUSH	PP,TB			; [325] and resulting indicator pointer
	MOVE	TA,OPRTR+3		; [325] DATAB link for factor 2
	PUSHJ	PP,LNKSET		; [325]
	LDB	TB,DA.INP		; [325] indexed?
	JUMPE	TB,.LOKCA		; [325] no -
	LDB	TC,DA.IMD		; [325] immediate index?
	JUMPN	TC,.LOKCA		; [325] yes - git out
	PUSH	PP,OPRTR+4		; [325] save operator tmp'ly
	PUSH	PP,OPRTR+1		; [325] zero for PTRAC1 to work right for us
	MOVEM	TB,OPRTR+4		; [325] put index link there
	SETZM	OPRTR+1			; [325] make PTRAC1 work for us
	MOVE	CH,[XWD MOV+AC1+ASINC,AS.MSC] ; [325]
	PUSHJ	PP,PUTASY		; [325] output <MOVE 1,%TEMP>
	MOVEI	CH,AS.TMP		; [325]
	PUSHJ	PP,PUTASN		; [325]
	PUSHJ	PP,PTRAC1##		; [325] generate <PD?. 1,INDEX>
	POP	PP,OPRTR+1		; [325] restore operators
	POP	PP,OPRTR+4		; [325]

.LOKCA:	POP	PP,TB			; [325] restore resulting indicator pointer
	POP	PP,TA			; [325] bring back old DATAB link

.LOKCB:	JUMPE	TB,.LOKCC		; [367] SKIP OVE CODE IF NO INDICATOR
	MOVE	CH,[XWD SETON.##+ASINC,AS.MSC] ; [325]
	PUSHJ	PP,PUTASY		; OUTPUT IT
	MOVE	CH,ELITPC		; GET LITAB PC
	TRO	CH,AS.LIT		; IDENTIFY AS LITAB ENTRY
	PUSHJ	PP,PUTASN		; OUTPUT IT
	MOVE	CH,[XWD OCTLIT,1]	; GET LITAB HEADER
	PUSHJ	PP,STASHC		; OUTPUT IT
	SETZ	CH,			; ZAP ANY RESIDUE
	DPB	TB,[POINT 8,CH,7]	; STASH INDICATOR
	PUSHJ	PP,STASHC		; OUTPUT <INDICATORS>
	AOS	ELITPC			; BUMP PC

.LOKCC:	MOVE	TB,OPRTR		; GET HEADER WORD
	TLNN	TB,(1B9)		; IS TABLE?
	  JRST	.LOKC0			; NO - MUST BE ARRAY
	MOVE	CH,[XWD MOV+AC0+ASINC,AS.MSC]
	PUSHJ	PP,PUTASY		; OUTPUT <MOVE 5,INDEX>
	MOVEI	CH,AS.TMP		; GET INDEX
	PUSHJ	PP,PUTASN		; OUTPUT ADDRESS
	MOVE	CH,[XWD MOVEM.+AC0+ASINC,AS.MSC]
	PUSHJ	PP,PUTASY		; OUTPUT <MOVEM 5,143>
	HRRZ	TA,OPRTR+3		; get link
	PUSHJ	PP,LNKSET		; set it up
	LDB	CH,DA.COR##		; get assigned core location
	MOVEI	CH,AS.DAT##-1(CH)	; identify and decrement
	PUSHJ	PP,PUTASN		; output address field
;[315]	LDB	TA,DA.ALL##		; [262] get alternate table link
	HRRZ	TA,OPRTR+5		; [315] get related table link
	JUMPE	TA,.LOKC0		; [262] no code if no alternate
	MOVE	CH,[XWD MOVEM.+AC0+ASINC,AS.MSC]
	PUSHJ	PP,PUTASY		; [262] output <MOVEM 0,table-start>
	PUSHJ	PP,LNKSET		; [262] set up DATAB pointer
	LDB	CH,DA.COR		; [262] get assigned core location
	MOVEI	CH,AS.DAT-1(CH)		; [262] identify and decrement
	PUSHJ	PP,PUTASN		; [262] output address field

.LOKC0:	MOVE	CH,LK%AE		; GET %AE:
	PUSHJ	PP,LKTAG		; SET UP PROTAB LINK
	ADD	CH,[XWD JRST.,AS.PRO]	; GENERATE <JRST %AE>
	PJRST	PUTASY			; OUTPUT THEN EXIT
;MISC TABLES USED FOR GENERATION
;

LKTB1:	XWD	GD6.+AC1,AS.CNS+0
	XWD	GD7.+AC1,AS.CNS+0
	XWD	0,0			; EBCDIC NOT IMPLEMENTED
;DEFINE EXTERNALS
;

EXTERNAL AS.MSC,AS.TMP,AS.CNS,AS.PRO,AS.CNB,AS.LIT,AS.BYT,AS.OCT

EXTERNAL BYTLIT, OCTLIT, XWDLIT

EXTERNAL GD6.,GD7.,COMP%,SETZM.,MOV,MOVEM.,IDIVI.,JUMPE.,MOVN.
EXTERNAL ADDM.,ADDB.,CAILE.,JRST.,SUBSCR,TLZ.,TLO.,MOVEI.,AOS.,SOS.





	END