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] ; <> ; ; %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] ; <> ; ; %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 POP PP,OPRTR+2 ; [325] restore MOVE CH,[XWD SUBI.##+AC1,AS.CNS+1]; [325] 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] PUSHJ PP,PUTASY ; [325] output it .LOK5B: MOVE CH,[XWD MOVEM.+AC1+ASINC,AS.MSC] ; [325] PUSHJ PP,PUTASY ; [325] 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 .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 MOVE CH,[XWD MOVEM.+AC0+ASINC,AS.MSC] PUSHJ PP,PUTASY ; OUTPUT 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 PUSHJ PP,PTRAC1## ; [325] generate 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 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 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 MOVE CH,[XWD ADDB.+AC0+ASINC,AS.MSC] PUSHJ PP,PUTASY ; OUTPUT 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 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 PUSHJ PP,PUTASY ; OUTPUT IT MOVE CH,[XWD SUBSCR+AC0+ASINC,AS.MSC] PUSHJ PP,PUTASY ; OUTPUT 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 MOVE CH,[XWD TLO.+AC0,AS.CNS] ADD CH,OP1SIZ## ; GET SIZE OF TABLE PUSHJ PP,PUTASY ; OUTPUT 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 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 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 MOVE CH,LK%D ; NO - WE WANT 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 MOVE CH,LK%D ; YES - WE WANT 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 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 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 MOVEI CH,AS.TMP+2 ; GET ADDRESS PUSHJ PP,PUTASN ; OUTPUT IT MOVE CH,[XWD COMP%+ASINC,AS.MSC] PUSHJ PP,PUTASY ; OUTPUT 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 MOVEI CH,AS.TMP+1 ; %TEMP = TMP+1 PUSHJ PP,PUTASN ; OUTPUT MOVE CH,[XWD IDIVI.+AC0,AS.CNS+2] PUSHJ PP,PUTASY ; OUTPUT 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 MOVE CH,[XWD MOVEM.+AC0+ASINC,AS.MSC] PUSHJ PP,PUTASY ; OUTPUT 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 MOVEI CH,AS.TMP ; INDEX = %TEMP PUSHJ PP,PUTASN ; OUTPUT IT MOVE CH,[XWD MOV+ASINC,AS.MSC] PUSHJ PP,PUTASY ; OUTPUT MOVEI CH,AS.TMP ; INDEX = %TEMP PUSHJ PP,PUTASN ; OUTPUT MOVE CH,[XWD CAILE.+AC0+ASINC,AS.CNB]; [323] PUSHJ PP,PUTASY ; [323] output 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 PUSHJ PP,PUTASY ; [323] output it MOVE CH,[XWD SUBSCR+AC0+ASINC,AS.MSC] ; [323] PUSHJ PP,PUTASY ; [323] output 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 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 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 THEN EXIT ;.LOKHA GENERATE CODE TO INCREMENT INDEX AND CHECK FOR VALIDITY ; .LOKHA: MOVE CH,[XWD AOS.+ASINC,AS.MSC] PUSHJ PP,PUTASY ; GENERATE 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 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 PJRST PUTASY ; OUTPUT AND EXIT .LOKH2: MOVE CH,[XWD MOV+AC0+ASINC,AS.MSC] ; [372] PUSHJ PP,PUTASY ; [372] generate a 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 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 MOVEI CH,AS.TMP ; [325] PUSHJ PP,PUTASN ; [325] PUSHJ PP,PTRAC1## ; [325] generate 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 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 MOVEI CH,AS.TMP ; GET INDEX PUSHJ PP,PUTASN ; OUTPUT ADDRESS MOVE CH,[XWD MOVEM.+AC0+ASINC,AS.MSC] PUSHJ PP,PUTASY ; OUTPUT 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 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 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