Trailing-Edge
-
PDP-10 Archives
-
decuslib10-10
-
43,50517/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