TITLE 'MIX-B00,10/12/73,DWG702985' PAGE * * * E X T E R N A L C O M M U N I C A T I O N * * * DEFINITIONS * DEF CLOADLNK DERAIL LINK FOR GXSEGDL DEF COPTRIG COMPOSITE OP TRIGGER DEF CSETLNK DERAIL LINK FOR DSETUP DEF CSTORLNK DERAIL LINK FOR GXSTEXEC DEF CTYPELNK DERAIL LINK FOR DTYPEIF DEF DDEAL DYADIC DEAL OP ROUTINE DEF DDECODE DYADIC DECODE OP ROUTINE DEF DENCODE DYADIC ENCODE OP ROUTINE DEF DINDEXOF DYADIC INDEX-OF OP ROUTINE DEF DMEMBER DYADIC MEMBERSHIP OP ROUTINE DEF DRESHAPE DYADIC RESHAPE OP ROUTINE DEF INNER INNER PRODUCT EXECUTION DRIVER DEF MDIMEN MONADIC DIMENSION OP ROUTINE DEF MGRADEDN MONADIC GRADE DOWN OP ROUTINE DEF MGRADEUP MONADIC GRADE UP OP ROUTINE DEF MINDEX MONADIC INDEX GENERATOR OP ROUTINE DEF MIX@ START OF PROCEDURE DEF MRAVEL MONADIC RAVEL OP ROUTINE DEF OUTER OUTER PRODUCT EXECUTION DRIVER DEF REDUCE REDUCTION EXECUTION DRIVER DEF RETURN RETURN ADR CELL DEF SCAN SCAN EXECUTION DRIVER U09-0004 DEF SETUPARG SET UP ARG PARAMS DEF TYCOMPAT TYPE COMPATIBILITY CHECK DEF VECTORRS ALOC VECTOR RESULT * * REFERENCES * REF ALOCHNW ALLOCATE HEADER AND N WORDS REF ALOCRS ALLOCATE RESULT DATA BLOCK REF BALCOMP 'BAL,LX FFCOMPAR' INSTRUCTION REF BASEADR BASE ADR FOR SHORT ADR OFFSETS REF CHAREQ CHARACTER EQ/NEQ REF COMPINST COMPARE INST TABLE REF CONVTABL TYPE CONVERSION CODE TABLE REF COORDK K'TH COORDINATE SPEC REF DBUFEND DIMENSION BUFFER END REF DREF DE-REF REF DTYPEIF INTG/FLOT TYPE SETUP REF DTYPEIF1 * (ALT. ENTRY) REF DTYPEIF2 * (ALT. ENTRY) REF DXRETURN DYADIC EXEC DRIVER RETURN REF DXTABLE DYADIC OP ROUTINE ENTRY TABLE REF DYNBOUND UPPER BOUND OF DYNAMIC MEMORY REF ERDOMAIN DOMAIN ERROR REF ERINDEX INDEX RANGE ERROR REF ERLENGTH LENGTH ERROR REF ERRANK RANK ERROR REF EXCHLUPS EXCHANGE MIDDLE/INNER LOOPS REF EXECUTE EXECUTE XSEG REF FFRESIDU FLOT RESIUDE EVALUATOR REF FLOTINF FLOATING POINT INFINITY REF FLOT0 FLOATING POINT 0.0 REF FLOT01 FLOATING POINT 0.0, 1.0 REF FLOT1 FLOATING POINT 1.0 REF FREETOTL NR WORDS FREE IN DYNAMIC MEMORY REF F2I CONVERT F TO I REF GENLOAD GEN LOAD BY RSTYPE REF GENLOADT GEN LOAD TO TEMP REF GIVEBACK GIVE BACK PART OF DATA BLOCK REF GSCLRVAL GET SCALAR INTEGER VALUE REF GXSEGDL1 GEN DYADIC LOAD (ALT. ENTRY) REF GXSEGINI GEN XSEG INITIALIZATION REF GXSEGML GEN MONADIC LOAD REF GXSTEXC1 GEN STORE/EXECUTE (ALT. ENTRY) REF GXSTEXEC GEN XSEG STORE; EXECUTE XSEG REF IIRESIDU INTG RESIDUE EVALUATOR REF INDXLDLR INDEXED LOAD LOGICAL RIGHT REF INERCNT INNER LOOP COUNT REF INERSTEP INNER LOOP STEP SIZE REF INTGOVFL INTEGER OVERFLOW (DOMAIN CHANGE) REF IROLL INTEGER ROLL FUNCTION EVALUATOR REF LFADR LEFT ARG ADDRESS REF LFARG LEFT ARG PNTR REF LFLGLADR LEFT LOGICAL ADDRESS REF LFRANK LEFT ARG RANK REF LFSIZE LEFT ARG SIZE REF LFTEMP LEFT ARG VALUE TEMP REF LFTYPE LEFT ARG TYPE REF LOADINST LOAD INSTRUCTION TABLE, BY TYPE REF LODBINST LOAD 2ND ACCUM INST TABLE REF LOOPLOC LOOP LOCATION REF MAXDIMEN MAXIMUM NUMBER OF DIMENSIONS REF MBUFDIMS MOVE BUFFER DIMENSIONS TO RESULT REF MIDLCNT MIDDLE LOOP COUNT REF MIDLSAVE MIDDLE LOOP SAVE TEMP REF MIDLSTEP MIDDLE LOOP STEP SIZE REF MIXTEMPS TEMPS ARE IN WINDOW IN APLUTSI U09-0006 REF MNOP MONADIC NO OP ROUTINE REF MRTDIMS COPY RTARG DIMENS TO RESULT REF MXRETURN MONADIC EXEC DRIVER RETURN REF NILCK 'NIL CHECK' = SCRIPT LIST PNTR SCRIPT EQU NILCK SUBSCRIPT LIST POINTER REF OPBREAK OP BREAK HANDLER REF OPER OPERATOR WORDS REF ORGADJ ORIGIN ADJUSTED (1-ORIGIN) REF ORIGIN INDEX ORIGIN VALUE (0 OR 1) REF OUTRCNT OUTER LOOP COUNT REF OUTRSAVE OUTER LOOP SAVE TEMP REF OUTRSTEP OUTER LOOP STEP SIZE REF RANDOM RANDOM SEED REF RESULT RESULT DATA BLOCK POINTER REF RSADR RESULT ADDRESS REF RSLIKRT1 ALOC RESULT LIKE RTARG REF RSLIKRT2 ALOC RESULT LIKE RTARG U09-0008 REF RSRANK RESULT RANK REF RSSIZE RESULT SIZE REF RSTYPE RESULT TYPE REF RTADR RIGHT ARG ADDRESS REF RTARG RIGHT ARG PNTR REF RTRANK RIGHT ARG RANK REF RTSIZE RIGHT ARG SIZE REF RTTEMP RIGHT ARG VALUE TEMP REF RTTYPE RIGHT ARG TYPE REF SETADR SET ARG ADR CELL REF SETADRS1 SET UP ADDRESS(ES), SEQUENTIAL REF SETSPEC1 SPECIAL ADR SETUP ROUTINE REF SETSPEC2 SPECIAL ADR SETUP ROUTINE REF STCCSEQ STORE CC CODE SEQ REF STMPINST STORE IN TEMP INST TABLE REF STORINST STORE INSTRUCTION TABLE REF ST3LUPSN SET LOOP PARAMS; NO ALOC REF SXRETURN SUBSCRIPTED EXP EXEC DRIVER RETURN REF SYSTERR SYSTEM ERROR REF TOPOSTAK LOWER BOUND OF STACK MEMORY REF TYPETEMP TYPE TEMP U09-0010 REF XSEGBASE BASE OF XSEG AREA REF XSEGBRK XSEG BREAK FLAG REF XSETUP SET UP ADR FOR INDEXED ACCESS PAGE * * * A S S E M B L Y P A R A M E T E R S * * SYSTEM SIG5F PROGSECT CSECT 1 MIX@ RES 0 START OF PROCEDURE * * REGISTERS * IX EQU 0 INTERPRET REG PAIR IX1 EQU 1 * X EQU 1 SCRIPT POINTER N EQU 1 XSEG EXECUTION REG T EQU 2 TYPE REG K EQU 2 XSEG EXECUTION REG XL EQU 3 XSEG LOC REG K1 EQU 4 XSEG EXECUTION REG N1 EQU 4 XSEG EXECUTION REG N2 EQU 11 XSEG EXECUTION REG N3 EQU 10 XSEG EXECUTION REG A EQU 4 ARG ADR/INDEX LZ EQU 4 INDEX LINK REG LX EQU 5 INDEX LINK REG OP EQU 6 OP CODE REG AF EQU 6 ACCUM FOR FLOT VALUES LX7 EQU 7 INDEX LINK REG AI EQU 7 ACCUM FOR LOGL/CHAR/INTG VALUES BUF EQU 7 BUFFER FOR MOVING DATA/CODE GROUPS R EQU 8 GENERAL WORK REG BF EQU 8 2ND ACCUM FOR FLOT VALUES BI EQU 9 2ND ACCUM FOR L/C/I VALUES S EQU 11 SIZE L3 EQU 12 LINK REG L2 EQU 13 LINK REG L1 EQU 14 LINK REG * * ARG TYPE CODES * WORDLOGL EQU 0 WORD LOGICAL (WORD) LOGL EQU 1 LOGICAL (BIT) CHAR EQU 2 CHARACTER (BYTE) INTG EQU 3 INTEGER (WORD) FLOT EQU 4 FLOATING (DOUBLEWORD) ISEQ EQU 5 INDEX SEQUENCE VECTOR LIST EQU 6 LIST * * CODESTRING DESIGNATIONS * MOPGRDUP EQU 75 MONADIC GRADE UP DOPADD EQU 91 DYADIC ADD DOPLESS EQU 102 DYADIC LESS DOPNEQ EQU 106 DYADIC NOT EQUAL DOPEQUAL EQU 107 DYADIC EQUAL DOPAND EQU 108 DYADIC AND DOPNOR EQU 111 DYADIC NOR DOPMEMBR EQU 120 DYADIC MEMBERSHIP PAGE * * * P R O C S * * TLOC SET 0 U09-0012 * TEMP CNAME 1 DTEMP CNAME 2 PROC DO1 NAME=2 TLOC SET TLOC+(TLOC&1) U09-0015 DISP TLOC U09-0016 LF EQU MIXTEMPS+TLOC U09-0017 TLOC SET TLOC+NAME U09-0018 PEND * * EVEN CNAME 0 ODD CNAME 1 PROC LF EQU % ERROR,1,(CF(2)+NAME)&1 'REGISTER HAS WRONG PARITY' PEND * * EQUAL CNAME PROC LF EQU % ERROR,1,1-(CF(2)=CF(3)) 'REGISTERS MUST BE EQUAL' PEND * * EXCHANGE CNAME OPEN I,K,GROUP GROUP EQU LFARG,LFTYPE,LFSIZE,LFRANK,LFADR PROC LF EQU % I DO NUM(AF) K SET SCOR(AF(I),ARGS,TYPES,SIZES,RANKS,ADRS) ERROR,1,K=0 'UNKNOWN GROUP INDICATOR' LW,R GROUP(K) XW,R GROUP(K)+1 STW,R GROUP(K) FIN PEND CLOSE I,K,GROUP * * NB CNAME X'680' NBGE CNAME X'681' NBLE CNAME X'682' NBE CNAME X'683' NBL CNAME X'691' NBG CNAME X'692' NBNE CNAME X'693' PROC ERROR,1,(AF>=0)+(NUM(AF)>1) 'AF MUST BE NEG CONST ADR' LF GEN,12,20 NAME-1,AF PEND * * ISEQFIX CNAME PROC LF CI,CF(2) ISEQ BNE %+2 LI,CF(2) INTG PEND PAGE * * * XSEG GEN PROCS * * CODE CNAME PROC DO CF(2)>0 LF GEN,4,12,16 CF(2),CF(2),AF(1)-BASEADR ELSE LF GEN,32 0 FIN PEND * * GENX CNAME PROC LF INT,IX AF BCR,15 %+4 LM,BUF BASEADR,IX1 STM,BUF 0,XL AW,XL IX PEND * * OPEN GEN GEN CNAME OPEN M,N,MN,I PROC LF EQU % ERROR,1,1-(NUM(CF)=3) 'WRONG NUMBER OF CF ARGS' M SET CF(2) N SET CF(3) MN SET M+N ERROR,1,1-(NUM(AF)=(M>0)+(N>0)) 'WRONG NUMBER OF AF ARGS' DO M>0 I DO N LW,AF(1)+M+I-1 AF(2)+I-1 FIN I DO MN*(MN<3) STW,AF(1)+I-1 I-1,XL ELSE LCI MN STM,AF(1) 0,XL FIN ELSE I DO MN*(MN<3) LW,BUF AF(1)+I-1 STW,BUF I-1,XL ELSE LCI N LM,BUF AF(1) STM,BUF 0,XL FIN FIN AI,XL MN PEND CLOSE M,N,MN,I PAGE * * * TABLE BUILDING PROCS * * TABLE CNAME OPEN T,N PROC T SET %-AF(1) LF EQU T DISP T PEND * * ITEM CNAME PROC N SET T+AF(1)-% ERROR,1,N<0 'ITEM OUT OF SEQUENCE' RES N*(N>0) DISP AF(1) PEND CLOSE T,N PAGE * * * M O N A D I C M I X E D O P R O U T I N E S * * USECT PROGSECT * * MDIMEN EQU % MONADIC DIMENSION LI,X 1 LB,S *RTARG,X GET ARG RANK (= RESULT SIZE) STW,S RSSIZE AI,S 1 ADD ONE FOR RESULT RANK BAL,LX7 ALOCHNW ALLOCATE RESULT DB STW,A RESULT COPY RESULT POINTER LI,R INTG**8+1 SET TYPE/RANK FOR INTEGER VECTOR STH,R *RESULT LW,X RSSIZE SET SIZE = NUMBER OF DIMENS STW,X 2,A BEZ *RETURN IF THERE ARE NO DIMENS, WE'RE DONE MTW,1 RTARG POINT TO WORD BEFORE 1ST DIMEN MTW,2 RESULT POINT TO WORD BEFORE 1ST DATA WORD 1Z1 LW,R *RTARG,X MOVE A DIMEN STW,R *RESULT,X BDR,X 1Z1 MOVE 'EM ALL MTW,-1 RTARG RESTORE POINTERS TO NORMALCY MTW,-2 RESULT B *RETURN EXIT * * MINDEX EQU % MONADIC INDEX GENERATOR LI,S 3 BAL,LX7 ALOCHNW ALLOCATE RESULT DB STW,A RESULT COPY RESULT PNTR LI,R ISEQ**8+1 SET TYPE/RANK = 'INDEX SEQUENCE STH,R *RESULT VECTOR'. BAL,LZ INTSCALR GET (INTEGER SCALAR) ARG VALUE (N) AI,AI 0 BLZ ERDOMAIN WE REQUIRE N>=0 LCW,AI+1 ORGADJ SET: LI,AI+2 1 SIZE = N LW,A RESULT LCI 3 BASE = ORIGIN-1 STM,AI 2,A STEP = 1 B *RETURN EXIT * * MRAVEL EQU % MONADIC RAVEL LI,A 1 IF ARG RANK =1, CB,A *RTARG,A RESULT = ARG. BE MNOP STW,A RSRANK SET RESULT RANK =1 BAL,LX SETUPARG SET (RT) ARG RANK/SIZE/TYPE LW,S RTSIZE STW,S RSSIZE RESULT SIZE = ARG SIZE LW,T RTTYPE ISEQFIX,T USE TYPE INTG INSTEAD OF ISEQ STW,T RSTYPE RESULT TYPE = ARG TYPE BAL,L1 ALOCRS ALLOCATE RESULT DB LW,S RSSIZE SET RESULT'S ONE DIMENSION STW,S 2,A = RESULT SIZE. LI,X -2 SET UP ARG/RESULT ADR CELLS BAL,L2 SETADRS1 BAL,LX GXSEGINI INIT XSEG; EXIT IF RESULT NULL LI,A 1 BAL,L1 GENLOAD GEN LOAD OF ARG B GXSTEXEC GEN STORE, LOOP; EXEC XSEG PAGE * * MGRADEUP EQU % MONADIC GRADE UP MGRADEDN EQU % MONADIC GRADE DOWN LB,T *RTARG GET ARG TYPE LI,X 1 CB,X *RTARG,X CHECK ARG RANK: BE 6Z1-LOGL,T =1 (VECTOR), GO TO JUMP TABLE; BL ERRANK >1 (ARRAY), NOT ALLOWED; LI,S 1 =0 (SCALAR), SET SIZE=1 AND B 6Z3 TREAT AS 1-ELEMENT VECTOR. 6Z1 B 6Z2 LOGL VECTOR: OK B ERDOMAIN CHAR VECTOR: NOT ALLOWED B 6Z2 INTG VECTOR: OK B 6Z2 FLOT VECTOR: OK B 6Z12 ISEQ: ALREADY SORTED B ERDOMAIN LIST: NOT ALLOWED 6Z2 LW,A RTARG L/I/F VECTOR: GET SIZE LW,S 2,A 6Z3 STW,S RSSIZE RESULT SIZE = VECTOR LENGTH BAL,L2 INTVECRS ALOC INTG VECTOR RESULT DB CI,S 1 CHECK SIZE: BG 6Z4 >1, TYPICAL; LW,AI ORIGIN =1, SET RESULT'S SOLE DATUM STW,AI 3,A TO ORIGIN VALUE. B *RETURN 6Z4 LB,T *RTARG GET ARG TYPE CI,T LOGL IF IT'S INTG OR FLOT, BNE FASTGRAD USE THE FAST ALGORITHM. LI,A 1 SET UP RTADR FOR INDICIAL ACCESS BAL,LX XSETUP LI,X -1 SET UP RSADR FOR SEQUENTIAL ACCESS BAL,LX SETADR LI,XL XSEGBASE PREPARE TO GEN XSEG LW,A GRADINS4 LOGL VECTOR: GEN XSEG TO SWEEP LW,A+1 OPTBL3,OP LW,A+2 GRADINS5 THROUGH ARG, MARKING IN RESULT AW,A+2 RSADR THE K-INDECES OF ALL 0 (1) VALUES. GEN,3,6 A,GRADINS6 LCW,N RSSIZE INIT RESULT INDEX 6Z10 LI,K 0 INIT ARG INDEX. BAL,L1 EXECUTE EXECUTE XSEG: MARK ALL 0'S (1'S) LW,OP OPER RESTORE OP CODE LW,R OPTBL4,OP NOW MODIFY XSEG TO MARK STW,R XSEGBASE+1 ALL 1'S (0'S), AND EXECUTE B 6Z10 IT ONCE AGAIN. WHEN DONE, IT * RETURNS HERE: APPLYORG LW,AI ORIGIN IF ORIGIN NONZERO, BEZ *RETURN LCW,N RSSIZE ADD IT TO ALL RESULT DATA. 6Z11 AWM,AI *RSADR,N BIR,N 6Z11 B *RETURN * 6Z12 LI,S 3 ISEQ ARG: IT'S ALREADY MONOTONIC, BAL,LX7 ALOCHNW ALL WE HAVE TO DO IS BUILD AN STW,A RESULT ISEQ RESULT DEFINING VALUES LI,R ISEQ**8+1 (1,2,...,SIZE) OR (SIZE,...,2,1). STH,R *RESULT LW,X RTARG LW,R 2,X GET SIZE EXU OPTBL5,OP GET STEP (-STEP, FOR GRADE DOWN) BGEZ 6Z13 LW,R+1 2,X STEP<0: RESULT BASE=SIZE (0-ORIGIN) LI,R+2 -1 AND RESULT STEP = -1; DEFINES B 6Z14 (SIZE-1,...,1,0). 6Z13 LI,R+1 -1 STEP>=0: RESULT BASE=-1, STEP=1; LI,R+2 +1 DEFINES (0,1,...,SIZE-1). 6Z14 AW,R+1 ORIGIN APPLY ORIGIN TO BASE VALUE LCI 3 STM,R 2,A STORE RESULT SIZE/BASE/STEP B *RETURN RETURN * * * LOGL GRADE UP/DOWN XSEG CODE: * GRADINS4 BAL,LX INDXLDLR 0 * BLZ/BEZ %+4 1 GRADINS5 STW,K 0 (RESULT(N)) 2 GRADINS6 BIR,N XSEGBASE+5 (%+2) 3 B APPLYORG 4 AI,K 1 5 CW,K RSSIZE 6 BL XSEGBASE+0 (%-7) 7 B *L1 8 * * OPTBL3 TABLE MOPGRDUP TABLE FOL LOGL SWEEP 0(1) INST OPTBL4 EQU OPTBL3+1 TABLE FOR LOGL SWEEP 1(0) INST BLZ XSEGBASE+5 TBL3: UP BEZ XSEGBASE+5 TBL3: DOWN TBL4: UP BLZ XSEGBASE+5 TBL4: DOWN * OPTBL5 TABLE MOPGRDUP TABLE FOR ISEQ STEP FETCH LW,R+2 4,X GRADE UP LCW,R+2 4,X GRADE DOWN PAGE * * * FAST INTEGER/FLOATING GRADE UP/DOWN * * THIS ALGORITHM BUILDS THE RESULT BY PERFORMING BINARY * MERGES OF SUCCESSIVELY LONGER SORTED STRINGS OF ARG * ELEMENTS. AT THE K'TH STAGE (K=0,...,CEILING(LOG2(N))), * WE HAVE FLOOR(N/2**K) STRINGS OF LENGTH 2**K, AND ONE * OF LENGTH MOD(N,2**K). IN PASSING TO THE NEXT STAGE, WE * MERGE ADJACENT PAIRS OF THESE STRINGS INTO NEW STRINGS * OF DOUBLED LENGTH. THE STRINGS ARE REPRESENTED BY ARG * INDEXES MAINTAINED IN ONE OF TWO HALFWORD TABLES IN THE * RESULT DATA BLOCK. INITIALLY, THE LOWER TABLE IS SET TO * (ORIGIN,...,ORIGIN+N-1), THE IDENTITY PERMUTATION OF * ARG ELEMENTS (N STRINGS OF LENGTH 1). EACH SET OF MERGES * COPIES THE INDEXES FROM ONE TABLE TO THE OTHER; AFTER THE * LAST MERGE, THE FINAL HALFWORD TABLE IS EXPANDED * OUT INTO THE ENTIRE RESULT AS WORD VALUES. ARG ELEMENTS * ARE INDEXED AS WORDS OR DOUBLEWORDS, RELATIVE TO THE INDEX * ORIGIN; RESULT ELEMENTS ARE INDEXED AS HALFWORDS, * RELATIVE TO ORIGIN-0. * * THIS ROUTINE IS ENTERED WITH OP CODE IN 'OP' AND * ARG TYPE IN 'T'. RESULT DATA BLOCK HAS ALREADY BEEN * ALLOCATED. * * * NEW REGISTERS * OPEN IX IA EQU 1 LEFT SOURCE ADR JA EQU 3 RIGHT SOURCE ADR KA EQU 5 DESTINATION ADR IX EQU 4 LEFT SOURCE ARG INDEX JX EQU 7 RIGHT SOURCE ARG INDEX IN EQU 12 LEFT COUNT JN EQU 13 RIGHT COUNT * * FASTGRAD EQU % LI,A OPBREAK ALLOW BREAKS DURING EXECUTION STW,A XSEGBRK LCW,A ORIGIN SET RTADR = EXU STBL,T -2*ORIGIN + ... AW,A RTARG ADR OF 1ST ARG AW,A T ELEMENT (NOTE: WE ARE ADDING STW,A RTADR 3 FOR INTG, 4 FOR FLOT). LW,A RESULT SET RSADR = ADR OF 1ST RESULT AI,A 3 ELEMENT. STW,A RSADR SLS,A 1 HALFWORD ADR OF LOWER TABLE STW,A SORCBASE INITIALLY, SOURCE IS LOWER TABLE AW,A RSSIZE HALFWORD ADR OF UPPER TABLE STW,A DESTBASE INITIALLY, DEST IS UPPER TABLE STW,A SORCEND SOURCE END = END OF LOWER TABLE LW,R RSSIZE INITITALIZE 1ST SOURCE TABLE AW,R ORIGIN TO (ORG,...,ORG+N-1). CI,R X'8000' SINCE THESE ARE HALFWORDS AND BG ERLENGTH 'LH' DOES SIGN EXTENSION, WE * MUST NOT ALLOW ANY VALUE TO * BE >=2**15. LW,N RSSIZE 16Z1 STH,R *RSADR,N AI,R -1 BDR,N 16Z1 STH,R *RSADR LI,A 1 INIT STRING SIZE TO 1 STW,A STRSIZE * NXTPASS LW,IA SORCBASE INIT LEFT SOURCE TO 1ST STRING LW,JA SORCBASE AW,JA STRSIZE INIT RIGHT SOURCE TO 2ND STRING LW,KA DESTBASE INIT DESTINATION ADR TO OTHER TABLE NXTMERGE LW,JN SORCEND COMPUTE LENGTH OF RIGHT STRING SW,JN JA BGZ 16Z7 JUMP IF NOT EMPTY LW,IN SORCEND RIGHT STRING EMPTY: COMPUTE SW,IN IA LENGTH OF LEFT STRING BGZ FINLEFT JUMP IF NOT EMPTY LW,A SORCBASE BOTH EMPTY: THIS PASS IS DONE XW,A DESTBASE SWAP ADDRESSES OF SOURCE AND STW,A SORCBASE DESTINATION TABLES. AW,A RSSIZE UPDATE 'END OF SOURCE' ADR STW,A SORCEND LW,R STRSIZE DOUBLE STRING SIZE SLS,R 1 STW,R STRSIZE CW,R RSSIZE IF NEW STRING SIZE >= N, BL NXTPASS WE'RE DONE. CW,A DESTBASE DONE: WHICH TABLE IS RESULT IN ? BG 16Z5 UPPER LW,N RSSIZE LOWER: EXPAND RESULT UPWARDS, AI,N -1 STARTING AT THE LAST ELEMENT. 16Z4 LH,R *RSADR,N STW,R *RSADR,N BDR,N 16Z4 LH,R *RSADR STW,R *RSADR B *RETURN EXIT 16Z5 LW,A RSSIZE UPPER: EXPAND RESULT DOWNWARDS, AWM,A RSADR STARTING WITH 1ST ELEMENT. LCW,N RSSIZE 16Z6 LH,R *RSADR,N STW,R *RSADR,N BIR,N 16Z6 B *RETURN EXIT * 16Z7 LW,IN STRSIZE RIGHT STRING NONEMPTY, SET * LEFT STRING COUNT = 2**K. CW,JN STRSIZE SET RIGHT STRING COUNT BLE 16Z8 = MIN(WORDS LEFT, 2**K). LW,JN STRSIZE 16Z8 LH,JX 0,JA GET 1ST INDEX FROM RIGHT STRING AI,JA 1 NEWLEFT LH,IX 0,IA GET NEW INDEX FROM LEFT STRING AI,IA 1 EXU LTBL,T (LX,BX *RTADR,IX) GET CORRESPONDING ARG VALUE COMPARE EXU CTBL,T (CX,BX *RTADR,JX) COMPARE W/RIGHT STRING VAL EXU BTBL,OP (BG/BL RIGHT) JUMP IF TO USE RIGHT STRING LEFT STH,IX 0,KA PLACE LEFT STRING INDEX AI,KA 1 IN DESTINATION STRING. BDR,IN NEWLEFT IF MORE LEFT VALUES, USE NEXT ONE B FINRIGT1 LEFT STRING EMPTIED, COPY RIGHT FINRIGHT LH,JX 0,JA GET NEXT RIGHT STRING INDEX AI,JA 1 FINRIGT1 STH,JX 0,KA COPY TO DESTINATION STRING AI,KA 1 BDR,JN FINRIGHT CONTINUE UNTIL THEY'RE ALL GONE B 16Z9 RIGHT STH,JX 0,KA PLACE RIGHT STRING INDEX AI,KA 1 IN DESTINATION STRING. BDR,JN NEWRIGHT IF MORE RIGHT VALUES, USE NEXT ONE B FINLEFT1 RIGHT STRING EMPTIED, COPY LEFT NEWRIGHT LH,JX 0,JA GET NEW RIGHT STRING INDEX AI,JA 1 B COMPARE COMPARE LEFT/RIGHT STRING ELMTS FINLEFT LH,IX 0,IA GET NEXT LEFT STRING INDEX AI,IA 1 FINLEFT1 STH,IX 0,KA COPY TO DESTINATION STRING AI,KA 1 BDR,IN FINLEFT CONTINUE UNTIL THEY'RE ALL GONE 16Z9 AW,IA STRSIZE END OF MERGE; BUMP BOTH STRING PNTRS AW,JA STRSIZE OVER ONE STRING. B NXTMERGE * * SORCBASE TEMP HALFWORD ADR OF 1ST SOURCE STRING DESTBASE TEMP HALFWORD ADR OF 1ST DEST STRING SORCEND TEMP HALFWORD ADR OF SOURCE TBL END STRSIZE TEMP STRING SIZE STW,A RSADR * * STBL TABLE INTG SHIFT TABLE NOP INTG SLS,A 1 FLOT * LTBL TABLE INTG LOAD ARG ELMT TABLE LW,BI *RTADR,IX INTG LD,BF *RTADR,IX FLOT * CTBL TABLE INTG COMPARE INST TABLE CW,BI *RTADR,JX INTG CD,BF *RTADR,JX FLOT * BTBL TABLE MOPGRDUP BRANCH TABLE BG RIGHT GRADE UP BL RIGHT GRADE DOWN PAGE * * * D Y A D I C M I X E D O P R O U T I N E S * * DRESHAPE EQU % DYADIC RESHAPE LI,A 0 SET UP LEFT RANK, SIZE, BAL,LX SETUPARG AND TYPE CELLS. LI,R 1 STW,R RSSIZE INIT RESULT SIZE TO 1 CW,R LFRANK MAKE SURE LEFT ARG IS SCALAR/VECTOR BL ERRANK LW,R LFSIZE IF IT'S NULL, SKIP THE 1ST BEZ 3Z1 XSEG GEN/RUN. CI,R MAXDIMEN IF NOT NULL, MAKE SURE IT BG ERLENGTH ISN'T TOO BIG. * * GEN 1ST XSEG WHICH, WHEN RUN, COPIES (AND CONVERTS * TO INTG, IF NECESSARY) LEFT ARG VALUES (RESULT DIMENS) * TO BUFFER (FRONT END OF XSEG AREA) AND ACCUMULATES * RESULT SIZE IN 'RSSIZE'. * LI,X -3 BAL,LX SETADR SET LEFT ADR CELL LI,XL DBUFEND START GENNING XSEG ABOVE DIMEN BUF GEN,0,1 RSHPINS1 GEN: LCW,N LFSIZE LI,T INTG SET RSTYPE TO INTG SO THAT GENLOAD STW,T RSTYPE WILL GEN CONVERSION TO INTG. LI,A 0 BAL,L1 GENLOAD GEN LOAD/CONVERT OF LEFT ARG VAL GEN,0,6 RSHPINS2 GEN CODE TO STORE DIMEN, MULTIPLY * IT INTO RSSIZE, LOOP, AND EXIT. BAL,L1 DBUFEND EXECUTE 1ST XSEG * * ALLOCATE AND SET UP RESULT; SET UP RIGHT ARG. * 3Z1 LI,A 1 SET UP RIGHT SIZE, RANK, BAL,LX SETUPARG AND TYPE CELLS. LW,T RTTYPE ISEQFIX,T USE TYPE INTG INSTEAD OF ISEQ STW,T RSTYPE RESULT TYPE = RIGHT TYPE LW,R LFSIZE STW,R RSRANK RESULT RANK = LEFT SIZE LW,S RSSIZE RESULT SIZE WAS SET BY 1ST XSEG BAL,L1 ALOCRS ALLOCATE RESULT DB; SET 'RESULT' BAL,LX MBUFDIMS MOVE DIMENS FROM BUFFER TO RS * * NOW BUILD AND EXECUTE THE SECOND XSEG, WHICH MOVES * THE DATA FROM RIGHT ARG DB TO RESULT DB. * BAL,LX GXSEGINI INIT XSEG; EXIT DRIVER IF RSLT NULL. LW,R RTSIZE RESULT NOT NULL; MAKE SURE THERE BEZ ERLENGTH IS SOME DATA TO FILL IT. AI,R -1 GEN ALTERNATE XSEG IF RIGHT U09-0022 BEZ 3Z2 ARG IS 1-ELEMENT. U09-0023 LI,X -1 MULTI-ELMT: SET UP RSADR U09-0024 BAL,LX SETADR FOR SEQUENTIAL STORE. U09-0025 GEN,0,1 RSHPINS3 GEN: LI,K 0 STW,XL LOOPLOC LOOP LOCATION IS HERE LI,A 1 COMPUTE ADDRESS OF RIGHT ARG BAL,LX XSETUP FOR INDEXED (0-ORIGIN) ACCESS. BAL,L1 GENLOAD GEN INDEXED LOAD OF RIGHT ARG * GEN MODULAR (WRAP-AROUND) INCREMENT GEN,0,4 RSHPINS4 OF RIGHT ARG INDEX. AWM,XL -2,XL FILL IN ADR B GXSTEXEC GEN STORE/LOOP INST; EXEC XSEG. 3Z2 LI,T LOGL IF RT ARG IS LOGL SCALAR, CHANGE U09-0027 CW,T RTTYPE TO 'WORD LOGL' SO THAT WE'LL U09-0028 BNE 3Z3 COPY 32 ELEMENTS AT A TIME. U09-0029 MTW,WORDLOGL-LOGL RTTYPE U09-0030 3Z3 LI,X -2 SET RTADR AND RSADR FOR U09-0031 BAL,L2 SETADRS1 SEQUENTIAL ADDRESSING. U09-0032 LI,A 1 U09-0033 BAL,L1 GENLOAD GEN LOAD OF RT ARG U09-0034 STW,XL LOOPLOC LOOP RETURNS TO STORE INST U09-0035 B GXSTEXEC GEN STORE/LOOP CODE; EXECUTE XSEG U09-0036 * * XSEG 1 CODE: * RSHPINS1 LCW,N LFSIZE INIT INDEX TO MOVE DIMENS * LOAD/CONVERT LFADR(N) RSHPINS2 STW,AI DBUFEND,N COPY DIMEN TO BUFFER MW,AI RSSIZE MULTIPLY DIMEN INTO RSSIZE BCS,5 ERDOMAIN ERR IF SIZE OVFL, OR DIMEN<0 STW,AI RSSIZE BIR,N DBUFEND+1 LOOP B *L1 EXIT * * XSEG 2 CODE FOR MULTI-ELEMENT RIGHT ARG U09-0038 * * LCW,N RSSIZE INIT RESULT INDEX RSHPINS3 LI,K 0 INIT RIGHT ARG INDEX *LOOPLOC LOAD RTADR(K) RSHPINS4 AI,K 1 BUMP RIGHT ARG INDEX CW,K RTSIZE IT GOES THRU 0,1,...,RTSIZE-1, BL 0 (%+2) THEN RESETS TO 0. LI,K 0 * STORE RSADR(N) * BIR,N *LOOPLOC * B *RETURN * U09-0040 * XSEG 2 CODE FOR 1-ELEMENT RIGHT ARG U09-0041 * U09-0042 * LCW,N RSSIZE INIT RESULT ADR U09-0043 * LOAD RTADR LOAD SCALAR RT ARG VALUE U09-0044 *LOOPLOC STORE RSADR(N) STORE IN RESULT U09-0045 * BIR,N LOOPLOC LOOP U09-0046 * B *RETURN EXIT U09-0047 PAGE * * DDEAL EQU % DYADIC DEAL BAL,LZ INTSCALR GET INTG SCALAR VALUE OF RT ARG, Y STW,AI RTTEMP SAVE IT EXCHANGE ARGS BAL,LZ INTSCALR GET INTG SCALAR VALUE OF LF ARG, X STW,AI LFTEMP SAVE IT AI,AI 0 MAKE SURE 0<=X<=Y BLZ ERDOMAIN CW,AI RTTEMP BG ERDOMAIN * * PICK THE ALGORITHM TO USE * LI,OP 2 LW,R TOPOSTAK COMPUTE AVAILABLE MEMORY = SW,R DYNBOUND SPACE BETWEEN STACK & DYNAMIC AW,R FREETOTL MEM + FREE DYNAMIC WORDS AI,R -8 - CREDIBILITY GAP. CW,R RTTEMP IF SUFFICIENT MEMORY FOR ENTIRE BGE 7Z0 UNIVERSE SET, USE ALGORITHM 'B'. LI,OP 3 OTHERWISE, USE ALGORITHM 'C' 7Z0 EXU DEALSZTB,OP SIZE OF RESULT = X (ALG 'C'), STW,S RSSIZE OR Y (ALG 'B'). BAL,L2 INTVECRS ALLOCATE INTG VECTOR FOR RESULT; * IF SIZE=0, EXIT FROM OP DRIVER. AI,A 2 POINT TO 1ST DATA WORD -1 STW,A RSADR LI,A OPBREAK SET XSEG BREAK FLAG TO SAY, STW,A XSEGBRK 'BREAK IS NOW OK'. B DEALALG,OP DO THE SELECTED ALGORITHM * * ALGORITHM 'C' - MEMORY USED = SUBSET SIZE, NO BOUND ON NUMBER * OF RANDOM NUMBER SELECTIONS REQUIRED. * DEALC EQU % LI,N 1 INIT COUNT TO 1 STW,N COUNT LW,AI RTTEMP GET 1ST RANDOM VALUE FROM SET: BAL,LX IROLL ORIGIN,...,ORIGIN+Y-1. B 7Z4 GO INTO LOOP 7Z1 LW,N COUNT REJECTED: SET N TO SEARCH AGAIN 7Z2 LW,AI RTTEMP GET A NEW RANDOM VALUE IN RANGE BAL,LX IROLL ORIGIN <= (AI) <= ORIGIN+Y-1. 7Z3 CW,AI *RSADR,N SEARCH FOR IT AMONG ALL THE RESULT BE 7Z1 VALUES WE HAVE CURRENTY; IF WE BDR,N 7Z3 ALREADY HAVE IT, REJECT IT. MTW,1 COUNT ACCEPTED: BUMP THE RESULT COUNT LW,N COUNT 7Z4 STW,AI *RSADR,N STORE NEW VALUE INTO RESULT CW,N RSSIZE SEE IF WE'VE GOT THEM ALL, YET BL 7Z2 NO, GET ANOTHER B *RETURN YES, RETURN * * ALGORITHM 'B' - MEMORY USED = UNIVERSE SIZE, NUMBER OF RANDOM * HITS = SUBSET SIZE. * DEALB EQU % LW,R RTTEMP INITIALIZE RESULT TO SW,R ORGADJ ORIGIN,ORIGIN+1,..., LW,N RTTEMP ...,ORIGIN+(UNIVERSE SIZE)-1. 7Z5 STW,R *RSADR,N AI,R -1 BDR,N 7Z5 LI,K 1 LW,N LFTEMP SET TO PICK (SUBSET SIZE) NUMBERS 7Z6 LW,AI RANDOM UPDATE RANDOM SEED MI,AI 65539 AND,AI =X'7FFFFFFF' STW,AI RANDOM MW,AI-1 RTTEMP PICK RANDOM NR FROM 0 TO Y-1 SLD,AI-1 -31 AW,AI K PUT IT IN RANGE K TO K+Y-1 LW,R *RSADR,AI EXCHANGE RANDOMLY SELECTED ELMT XW,R *RSADR,K WITH K'TH ELMT. STW,R *RSADR,AI AI,K 1 INCR K MTW,-1 RTTEMP DECREASE Y BDR,N 7Z6 SELECT NEXT NUMBER STW,N XSEGBRK DON'T ALLOW BREAKS DURING * 'GIVE BACK' OPERATION. LW,A RESULT GET RESULT DB POINTER LW,S LFTEMP CHANGE RESULT SIZE TO SUBSET XW,S 2,A SIZE, AND COMPUTE NUMBER OF SW,S 2,A WORDS TO GIVE BACK. BAL,LX7 GIVEBACK GIVE THEM BACK B *RETURN EXIT * COUNT TEMP RESULT COUNT TEMP * * DEALSZTB TABLE 2 DEAL: RESULT SIZE EXU TABLE LW,S RTTEMP ALG B: UNIVERSE SIZE LW,S LFTEMP ALG C: SUBSET SIZE * DEALALG TABLE 2 DEAL ALGORITHM BRANCH TABLE B DEALB ALG B B DEALC ALG C PAGE * * DINDEXOF EQU % DYADIC INDEX OF LI,X 1 CB,X *LFARG,X MAKE SURE THAT LEFT ARG BNE ERRANK IS A VECTOR; LI,OP DOPMEMBR+1 MAKE IT LOOK MORE LIKE ... B MIXOP1 DMEMBER EQU % DYADIC MEMBERSHIP EXCHANGE ARGS SWAP ARGS MIXOP1 EQU % LI,A 0 BAL,LX SETUPARG SET LEFT RANK/SIZE/TYPE LI,A 1 BAL,LX SETUPARG SET RIGHT RANK/SIZE/TYPE LW,T OPTBL1,OP RESULT TYPE = LOGL (MEMBERSHIP) STW,T RSTYPE OR INTG (INDEX OF) BAL,L1 RSLIKRT1 ALOC RESULT LIKE RIGHT ARG BAL,LX MRTDIMS COPY RTARG DIMENSIONS TO RESULT LI,X -2 RIGHT ARG AND RESULT ARE TO BE BAL,L2 SETADRS1 ACCESSED NORMALLY (SEQ). LI,A 0 LEFT ARG IS TO BE ACCESSED BAL,LX XSETUP INDICIALLY. BAL,LX TYCOMPAT IF BOTH ARGS ARE CHAR, OR BOTH B 5Z4 NUMERIC, AND IF THE LEFT ARG * IS NON-NULL, THEN WE MAY GO * AHEAD ON IT. * IF THE ARGS ARE OF CONFLICTING * KINDS, OR THE LEFT ARG IS NULL, * THE RESULT WILL CONSIST ENTIRELY LW,S LFSIZE OF ZEROS (MEMBERSHIP) OR BNEZ 5Z7 LFSIZE+ORIGIN (INDEX OF). 5Z4 LW,X RSSIZE CREATE SPECIAL RESULT (IF IT'S TO BEZ *RETURN BE NON-NULL): LW,A RESULT AW,A RSRANK CREATE PNTR TO 1ST DATA WORD -1; AI,A 1 CI,OP DOPMEMBR BNE 5Z5 AI,X 31 FOR MEMBERSHIP, CHANGE SIZE SLS,X -5 FROM BITS TO WORDS, AND LI,AI 0 SET RESULT DATA = 0'S; B 5Z6 5Z5 LW,AI LFSIZE FOR INDEX-OF, SET RESULT DATA AW,AI ORIGIN = SIZE+ORIGIN; 5Z6 STW,AI *A,X STORE RESULT DATA; BDR,X 5Z6 B *RETURN RETURN. 5Z7 BAL,LX GXSEGINI GEN XSEG INIT; EXIT IF RESULT NULL GEN,0,1 KLUPINIT GEN K-LOOP (LOOP2) INIT INST LW,T RSTYPE CI,T LOGL WE MUST USE 'INTG' IF BOTH BNE 5Z9 ARGS ARE LOGL ('CAUSE LOGL ARGS LI,T INTG AREN'T DIRECTLY ADDRESSABLE). STW,T RSTYPE CI,OP DOPMEMBR IF IT'S 'INDEX OF' WITH BOTH BNE LGINDXOF ARGS LOGL, HANDLE SPECIALLY. 5Z9 LI,A 1 SET UP TO GEN LOAD OF RIGHT ARG CW,T LFTYPE MUST THE LEFT ARG BE CONVERTED ? BE 5Z10 BAL,L2 GENLOADT YES: GEN LOAD/CONVERT RIGHT ARG STW,XL LOOP2LOC TO TEMP OUTSIDE LOOP2; GEN LI,A 0 LOAD/CONVERT LEFT ARG TO REG BAL,L1 GENLOAD INSIDE LOOP2; LW,R RTADR COMPARE ADR = RIGHT TEMP. B 5Z11 5Z10 BAL,L1 GENLOADX NO: GEN LOAD/CONVERT OF RIGHT ARG STW,XL LOOP2LOC TO REG OUTSIDE OF LOOP2; LW,R LFADR COMPARE ADR = LEFT ARG. 5Z11 LW,T RSTYPE CI,T FLOT BNE 5Z8 IF FLOATING RESULT, AW,R LODBINST+FLOT LOAD BOTH ARGS TO REGS, AND GEN,1,1 R,BALCOMP APLLY FUZZ TO ARGS. LI,R BF ADR 2ND REG FOR COMPARISON 5Z8 AW,R COMPINST,T GEN COMPARE INST, AND INDEX LW,X XL CONTROL FOR LOOP2. GEN,1,4 R,KLUPCONT CI,OP DOPMEMBR BNE 5Z12 GEN,0,3 STCCSEQ FOR MEMBERSHIP, GENERATE LW,R RSADR LOGICAL STORE AW,R STORINST+LOGL U09-0049 GEN,1,0 R U09-0050 AWM,XL -3,XL OF 0 OR 1. B 5Z13 5Z12 GEN,0,2 INDOFSEQ FOR INDEX-OF, GEN STORE OF LW,R RSADR ORIGIN+INDEX VALUE. AWM,R -1,XL 5Z13 AWM,XL 1,X FILL IN BRANCH ADDRESSES LW,R LOOP2LOC AWM,R 4,X GEN,0,2 NLUPCONT GEN N-LOOP (LOOP1) CONTROL/RETURN B EXECUTE GO EXECUTE XSEG AND RETURN * * GENLOADX EQU % SPECIAL GEN LOAD CI,T CHAR SPECIAL ONLY BNE GENLOAD FOR CHARACTER ARGS LW,R RTSIZE WHEN SIZE IS NOT A MULTIPLE SW,R RSSIZE OF FOUR. BEZ GENLOAD STW,R DELTA DELTA = 1, 2, OR 3 GEN,0,3 DELCODE GEN: SW,N DELTA LW,R RTADR LB,AI RTARG(N) AWM,R -2,XL AW,N DELTA B *L1 RETURN * * DELCODE SW,N DELTA FIX INDEX TO START WITH 1ST CHAR LB,AI 0 RTARG(N) LOAD SELECTED CHAR AW,N DELTA RESTORE INDEX * DELTA TEMP DELTA (1,2,3) * * OPTBL1 TABLE DOPMEMBR RESULT TYPE TBL FOR OPS ... PZE LOGL MEMBERSHIP: LOGL RESULT PZE INTG INDEX OF: INTG RESULT * * * XSEG CODE: * * LCW,N RSSIZE 0 INIT RESULT COUNT KLUPINIT LI,K 0 1 K-LOOP INITIALIZATION INST * LOAD/CNV RTARG(N) GET RIGHT ARG ELMT * IF LEFT ARG MUST BE CONVERTED, *LOOP2 SAVE RIGHT ARG & LOAD LFARG. * COMPARE RTTEMP/LFARG(K) COMPARE LF/RT ARG ELEMENTS KLUPCONT NBE -2 (FOUND) K-LOOP CONTROL SEQUENCE AI,K 1 CW,K LFSIZE BL 0 (LOOP2) * * FOR 'INDEX OF' ... * *FOUND EQU % INDOFSEQ AW,K ORIGIN INDEX STORE SEQUENCE STW,K 0 RESULT(N) * * FOR 'MEMBERSHIP' ... * * LI,AI 0 NOT FOUND, RS ELMT =0 * B %+2 *FOUND LI,AI -1 FOUND: RS ELMT =1 * BAL,LX STLOGLRS STORE LOGICAL RS ELEMENT * * --- * NLUPCONT BIR,N XSEGBASE+1 N-LOOP CONTROL SEQUENCE B *RETURN * LOOP2LOC TEMP LOOP 2 (INNER LOOP) BRANCH LOC PAGE * * * SPECIAL CASE HANDLING FOR 'INDEX OF' WITH BOTH * ARGS LOGICAL. * LGINDXOF EQU % LW,A LFARG SET UP LOGL WORD PNTR AW,A LFRANK LW,R ORIGIN = INDEX OF 1ST BIT LI,X -1 LW,AI 2,A IF 1ST BIT IS 0 (1), BLZ 18Z1 SET X TO SKIP WORDS LI,X 0 CONTAINING ALL 0'S (1'S). 18Z1 STW,R INDXOF01,X STORE INDEX OF 1ST 0 OR 1 STW,X XTEMP INITIALIZE XTEMP LCW,R LFSIZE INIT BIT COUNT 18Z2 CW,X 2,A IS ENTIRE WORD LIKE 1ST BIT? BNE 18Z3 NO - GO LOCATE DIFFERING BIT AI,A 1 YES - SKIP OVER THIS WORD AI,R 32 COUNT 32 BITS AT A TIME BLZ 18Z2 ..UNTIL DONE. B 18Z5 DONE: OTHER BIT ABSENT FROM DATA 18Z3 STW,X XTEMP FOUND WORD CONTAINING OTHER BIT: EOR,X 2,A SAVE ITS VALUE, SEARCH FOR IT (EOR 18Z4 AI,R 1 MAKES IT A 1-BIT WE'RE SEEKING). SLS,X 1 BEV 18Z4 AI,R -1 GOT IT: R= INDEX-LFSIZE BLZ 18Z6 IF IT'S NOT WITHIN ACTUAL ARG DATA, 18Z5 LI,R 0 SET INDEX = LFSIZE. 18Z6 AW,R LFSIZE SET R = INDEX (0-ORIGIN) AW,R ORIGIN R = INDEX OF DIFFERING BIT LCW,X XTEMP REMEMBER WHICH BIT IT WAS STW,R INDXOF01-1,X STORE INDEX * AI,XL -1 DISCARD LAST INST GEN'D BY 'INDEXOF' LD,R CODE9 AW,R RTADR GEN,2,0 R GEN LOGL LOAD, LOAD OF 0/1 BIT INDEX B GXSTEXEC GEN STORE/LOOP CONTROL; EXECUTE XSEG. * * * XSEG CODE: * * * LCW,N RSSIZE 0 INIT COUNT = SIZE BOUND 8 CODE9 BAL,LX 0 (LDLOGLRT) 1 LOAD BIT FROM RIGHT ARG LW,AI INDXOF01,AI 2 GET INDEX OF THAT BIT * STW,AI RESULT(N) 3 STORE IN RESULT * BIR,N (CODE9) 4 LOOP * B *RETURN 5 EXIT * * XTEMP EQU DELTA TEMP IN WHICH TO SAVE X INDXOF01 EQU LFTEMP+1 INDEX OF 0/1 BIT IN ARG DATA PAGE * * DENCODE EQU % DYADIC ENCODE BAL,LX DTYPEIF CHECK ARG TYPES; SET RESULT NOP TYPE = INTG/FLOT. BAL,L2 SETOUTER SET UP RESULT FOR ENCODE LI,S 1 COMPUTE 2 LOOP COUNTS: CW,S LFSIZE INNER COUNT = LFARG'S FIRST BE 11Z1 DIMEN (=1, IF SCALAR); LW,X LFARG LW,S 2,X 11Z1 STW,S INERCNT LW,S LFSIZE MIDDLE COUNT = PRODUCT OF DW,S INERCNT ALL OTHER LFARG DIMENS. STW,S MIDLCNT MW,S RTSIZE RESULT STEP FOR INNER LOOP: STW,S RSSTEP ALL BUT 1ST RESULT DIMENS. BAL,LX GXSEGINI INIT XSEG CODE; EXIT IF RS NULL MTW,-1 XSEGBASE CHANGE 'RSSIZE' TO 'RTSIZE' GEN,0,4 CODE10 GEN LOOP INIT CODE, LI,A 1 BAL,L2 GENLOADT LOAD/CONVERT/STORE OF RTARG, STW,XL LOOPLOC MIDDLE LOOP LOC, SW,R =X'03000000' LOAD RTARG VAL, GEN,1,5 R,CODE11 INNER LOOP INIT, LW,R STORINST,T AI,R BTEMP INNER LOOP CODE, GEN,1,0 R LI,A 0 BAL,L2 GENLOADT LW,A XL GENX CODETBL5,T LW,R RSADR AWM,R -6,XL AWM,A -5,XL GEN,0,1 CODE14 AND FINAL LOOP CONTROL CODE. LW,R LOOPLOC AWM,R -1,XL FILL IN BRANCH ADDRESSES B EXECUTE EXECUTE XSEG * * CODETBL5 TABLE INTG CODE,8 CODE13I INTG CODE,8 CODE13F FLOT * * * XSEG CODE: * * LCW,N RTSIZE 0 INIT RTARG INDEX/OUTER LOOP COUNT CODE10 LW,K RSSIZE 1 INIT RESULT INDEX LW,K1 LFSIZE 2 INIT LFARG INDEX (OUTR LOOP HERE) LW,N2 MIDLCNT 3 INIT MIDDLE LOOP COUNT STW,K OUTRSAVE 4 REMEMBER RS INDEX VALUE * LOAD/CNV RTARG(N) 5 GET RTARG ELMT * STORE RTTEMP SAVE IT *LOOPLOC LOAD RTTEMP RE-INIT RTARG VAL (MIDL LOOP HERE) CODE11 LW,N3 INERCNT INIT INNER LOOP COUNT STW,K MIDLSAVE REMEMBER RS INDX FOR MIDL LOOP STW,K1 K1TEMP REMEMBER LF INDX FOR MIDL LOOP SW,K RSSTEP BUMP RS INDEX (INER LOOP HERE) SW,K1 MIDLCNT BUMP LF INDEX * STORE BTEMP SAVE PREVIOUS QUOTIENT * LOAD/CNV LFARG(K1) GET NEXT WEIGHT FROM LFARG * STORE LFTEMP SAVE IT * * FOR FLOT RESULT - * CODE13F LD,BF BTEMP BAL,LX FFRESIDU COMPUTE NEW REMAINDER STD,AF 0 RESULT(K) STORE IT AS NEXT RESULT ELMT BDR,N3 5 (%+2) COUNT INNER LOOP B CODE15 LCD,AF AF FAL,AF BTEMP MAKE FOLLOWING DIVISION EXACT FDL,AF LFTEMP COMPUTE NEW QUOTIENT * * FOR INTG RESULT - * CODE13I LW,BI BTEMP (SEE ABOVE) BAL,LX IIRESIDU * STW,AI 0 RESULT(K) * BDR,N3 5 (%+2) COUNT INNER LOOP B CODE15 LCW,AI AI * AW,AI BTEMP * DW,AI LFTEMP * * * --- * CODE14 B 4 +LOOPLOC CONTINUE INNER LOOP CODE15 LW,K1 K1TEMP * RESTORE MIDL LOOP LF INDX AI,K1 1 * BUMP IT LW,K MIDLSAVE * RESTORE MIDL LOOP RS INDX AW,K RTSIZE * BUMP IT BDR,N2 *LOOPLOC * COUNT MIDDLE LOOP LW,K OUTRSAVE * RESTORE AND AI,K 1 * BUMP RESULT INDEX. BIR,N XSEGBASE+2 * COUNT OUTER LOOP B *RETURN * EXIT * * BTEMP DTEMP K1TEMP TEMP RSSTEP TEMP PAGE * * DDECODE EQU % DYADIC DECODE BAL,LX DTYPEIF CHECK ARG TYPES; SET RESULT NOP TYPE = INTG/FLOT. BAL,L2 SETINNER SET UP RESULT/PARAMS FOR DECODE BAL,LX GXSEGINI GEN XSEG INIT; EXIT IF RS NULL GEN,0,8 CODE1 GEN OUTER/MIDDLE LOOP INIT CODE, LW,T RSTYPE GENX CODETBL1,T INNER LOOP INIT, LI,A 1 BAL,L1 GENLOAD RTARG LOAD/CONVERT, LI,S 1 CW,S RTCOMDIM BE 12Z1 GEN,0,1 CODE3 BUMP OF RTARG INDEX, 12Z1 LW,T RSTYPE GENX CODETBL2,T MULTIPLY/ADD, LI,A 0 BAL,L1 GENLOAD LFARG LOAD/CONVERT, LW,T RSTYPE GENX CODETBL3,T MULTIPLY TO WEIGHT, LI,S 1 CW,S LFCOMDIM BE 12Z2 GEN,0,1 CODE6 BUMP OF LFARG INDEX, 12Z2 GENX CODETBL4,T RESULT STORE, AND INER LOOP LW,R RSADR CONTROL CODE. AWM,R -3,XL B EXECUTE EXECUTE XSEG * * CODETBL1 TABLE INTG CODE,4 CODE2I INTG CODE,4 CODE2F FLOT * CODETBL2 TABLE INTG CODE,4 CODE4I INTG CODE,3 CODE4F FLOT * CODETBL3 TABLE INTG CODE,3 CODE5I INTG CODE,2 CODE5F FLOT * CODETBL4 TABLE INTG CODE,5 CODE7I INTG CODE,5 CODE7F FLOT * * * XSEG CODE: * * LCW,N RSSIZE 0 INIT STORE INDX / OUTER LOOP COUNT CODE1 LW,K1 LFCOMDIM 1 INIT LFARG INDX AI,K1 -1 2 LW,K RTSIZE 3 INIT RTARG INDX SW,K MIDLCNT 4 OFFSET RTARG INDX(OUTER LOOP HERE) STW,K1 OUTRSAVE 5 SAVE LFARG INDX LW,N2 MIDLCNT 6 INIT MIDDLE LOOP COUNT STW,K MIDLSAVE 7 SAVE RTARG INDX (MIDDLE LOOP HERE) LW,N3 INERCNT 8 INIT INNER LOOP COUNT * * FOR FLOT RESULT - * CODE2F LD,AF FLOT1 9 INIT WEIGHT FACTOR = 1 STD,AF WEIGHT 10 LD,AF FLOT0 11 INIT SUM = 0 STD,AF SUM 12 * LOAD/CNV RTARG(K) 13 LOAD NEW RT VAL (INNER LOOP HERE) CODE3 SW,K MIDLCNT (CONDITIONALLY GEN'D) BUMP RT INDX CODE4F FML,AF WEIGHT APPLY WEIGHT FACTOR FAL,AF SUM ACCUMULATE INTO SUM STD,AF SUM * LOAD/CNV LFARG(K1) LOAD NEW MULTIPLIER CODE5F FML,AF WEIGHT UPDATE WEIGHT STD,AF WEIGHT CODE6 AI,K1 -1 (COND. GEN'D) BUMP LF INDX CODE7F BDR,N3 XSEGBASE+13 COUNT INNER LOOP LD,AF SUM STORE SUM AS NEXT RESULT ELMT STD,AF 0 RESULT(N) BIR,N CODE8 COUNT RESULT B *RETURN EXIT WHEN FILLED * * INTG RESULT - * CODE2I LI,AI 1 9 INIT WEIGHT FACTOR = 1 STW,AI WEIGHT 10 LI,AI 0 11 INIT SUM = 0 STW,AI SUM 12 * LOAD/CNV RTARG(K) 13 LOAD NEW RT VAL (INNER LOOP HERE) * SW,K MIDLCNT (COND. GEN'D) BUMP RT INDEX CODE4I MW,AI WEIGHT APPLY WEIGHT FACTOR BOV INTGOVFL AWM,AI SUM ACCUMULATE INTO SUM BOV INTGOVFL * LOAD/CNV LFARG(K1) LOAD NEW MULTIPLIER CODE5I MW,AI WEIGHT UPDATE WEIGHT BOV INTGOVFL STW,AI WEIGHT * AI,K1 -1 (COND. GEN'D) BUMP LF INDEX CODE7I BDR,N3 XSEGBASE+13 COUNT INNER LOOP LW,AI SUM STORE SUM AS NEXT RESULT ELMT STW,AI 0 RESULT(N) CODE16 BIR,N CODE8 COUNT RESULT B *RETURN EXIT WHEN FILLED * * --- * CODE8 LW,K1 OUTRSAVE * RESTORE LF INDEX LW,K MIDLSAVE * AND RT INDEX. AI,K 1 * BUMP RT INDEX BDR,N2 XSEGBASE+7 * COUNT MIDDLE LOOP AW,K1 LFCOMDIM * BUMP LF INDEX B XSEGBASE+4 * COUNT OUTER LOOP * * WEIGHT EQU LFTEMP SUM EQU RTTEMP LFCOMDIM TEMP RTCOMDIM TEMP PAGE * * * C O M P O S I T E O P E X E C U T I O N D R I V E R S * * * SPECIAL EFFECTS DEPARTMENT: * * EACH OF THE COMPOSITE OP ROUTINES (REDUCTION, SCAN, U09-0052 * INNER/OUTER PRODUCT) GENERATES ITS OWN BRAND OF U09-0053 * LOOP CONTROL, LOAD, AND STORE CODE; TO GENERATE * OP EVALUATION CODE, THE APPROPRIATE DYADIC SCALAR * OP ROUTINE(S) IS (ARE) INVOKED. COMMUNICATION BETWEEN * THE SCALAR AND COMPOSITE OP ROUTINES IS ESTABLISHED * VIA DETOURS ENCOUNTERED IN THE SUBROUTINES LISTED * BELOW; AS EACH OF THESE SUBR'S IS CALLED, FINDING * THE COMPOSITE OP TRIG 'COPTRIG' SET, IT DETOURS VIA * THE CORRESPONDING LINK, INSTEAD OF PERFORMING ITS * USUAL FUNCTION. * * SUBR: DETOUR LINK: FUNCTION PERFORMED: * * DTYPEIF CTYPELNK TYPE CHECKING/SETUP * DSETUP CSETLNK CONFORMANCE CHECK, ALOC RS U09-0055 * GXSEGDL CLOADLNK GEN ARG LOADS/CONVERTS * GXSTEXEC CSTORLNK GEN STORE; EXECUTE XSEG * * NOTE: 'GXSEGDL' INVOKES 'GXSEGINI' BEFORE DETOURING; * THE OTHERS DETOUR IMMEDIATELY. PAGE * * * REDUCTION: * * OP/(K) ARG * REDUCE EQU % (MONADIC) REDUCTION BAL,LX SETLINKS SET DETOUR LINKS; ENTER DYADIC * SCALAR OP ROUTINE. PZE *MXRETURN RETURN ADR / COPTRIG PZE REDTYPE CTYPELNK FOR REDUCTION PZE REDSET CSETLNK FOR REDUCTION PZE REDLOAD CLOADLNK FOR REDUCTION PZE REDSTOR CSTORLNK FOR REDUCTION * * REDTYPE EQU % SUBSTITUTE FOR DTYPEIF LB,T *RTARG DO JUST WHAT DTYPEIF WOULD DO, CI,T CHAR BNE DTYPEIF2 GIVEN IDENTICAL ARGS. TESTEQ CLM,OP COMPAROP EXCEPT, ALLOW CHAR ARG FOR BCR,9 CHAREQ EQUAL AND NOT EQUAL OPS. B ERDOMAIN * * REDSET EQU % SUBSTITUTE FOR DSETUP U09-0057 STW,L2 CLINKTMP SAVE LINK BAL,L2 ST3LUPSN SET LOOP PARAMS (USE COORD SPEC) BAL,LX EXCHLUPS EXCHANGE MIDDLE/INNER LOOPS MTW,-1 INERCNT SET INNER LOOP COUNT = D(K)-1 BGZ 13Z3 D(K)>1: GENERAL CASE: USE RSTYPE BLZ 13Z1 D(K)=0: RESULT = IDENTITY ELMT(S) LW,T RTTYPE D(K)=1: RESULT DATA = ARG DATA, ISEQFIX,T USE TYPE INTG INSTEAD OF ISEQ B 13Z2 RSTYPE = ARG TYPE. 13Z1 LW,OP OPER LB,X IDENTBL,OP D(K)=0: GET IDENTITY VALUE CODE CI,X 4 BE ERLENGTH ERROR IF NO IDENTITY VALUE LB,T IDTYPTBL,X GET IDENTITY TYPE (USUALLY LOGL) 13Z2 STW,T RSTYPE CHANGE RSTYPE FOR SPECIAL CASE 13Z3 LW,R RTRANK BDR,R 13Z4 LI,R 0 RSRANK = 13Z4 STW,R RSRANK MAX(RTRANK-1, 0) LW,S OUTRCNT MW,S MIDLCNT RSSIZE = STW,S RSSIZE D(1)*...*D(K-1)*D(K+1)*...*D(N) BAL,L1 ALOCRS ALLOCATE RESULT DATA BLOCK AW,A RSRANK SET RESULT DIMENS LW,X RTRANK = D(1),...,D(K-1),D(K+1),...,D(N) BEZ 13Z7 MTW,1 RTARG 13Z5 CW,X COORDK COPY ALL EXCEPT K'TH ARG BE 13Z6 DIMEN TO RESULT DIMENS. LW,R *RTARG,X STW,R 1,A AI,A -1 13Z6 BDR,X 13Z5 MTW,-1 RTARG 13Z7 LW,S INERCNT TEST FOR SPECIAL CASES BGZ 13Z10 D(K)>1: GENERAL CASE BLZ 13Z9 D(K)=0: RESULT = IDENT LI,T LOGL D(K)=1: RESULT = ARG CW,T RTTYPE IF ARG LOGL, CHANGE TO WORD-LOGL, BNE 13Z8 TO COPY DATA 32 BITS AT A TIME. MTW,WORDLOGL-LOGL RTTYPE 13Z8 LI,X -2 SET RTADR AND RSADR BAL,L2 SETADRS1 FOR SEQUENTIAL ACCESS. BAL,L1 GXSEGML GEN LOAD B GXSTEXC1 GEN STORE, LOOP CODE; EXECUTE * 09-00003 FILIDENT EQU % FILL RESULT WITH IDENT ELMTS 09-00004 * 09-00005 13Z9 LI,X -1 D(K)=0: RESULT = IDENTITY BAL,LX SETADR SET RSADR FOR SEQUENTIAL STORE BAL,LX GXSEGINI INIT XSEG LB,X IDENTBL,OP GET IDENT VALUE CODE LW,R LODIDTBL,X GEN LOAD OF IDENT VALUE GEN,1,0 R B GXSTEXC1 GEN STORE, LOOP CODE; EXECUTE 13Z10 LI,A 1 D(K)>1: GENERAL CASE BAL,LX XSETUP SET ARG FOR INDEXED LOAD LI,X -1 BAL,LX SETADR SET RESULT FOR SEQ STORE B *CLINKTMP RETURN TO SCALAR OP ROUTINE * * REDLOAD EQU % SUBSTITUTE FOR GXSEGDL STW,L3 CLINKTMP (GEN CLOBS L3) GEN,0,6 CODE20 GEN LOOP SETUP CODE, LI,A 1 BAL,L1 GENLOAD LOAD/CONVERT OF LAST ARG ELMT, REDSCN1 EQU % COMMON CODE FOR REDUCTION/SCAN U09-0059 STW,XL LOOPLOC (INNER LOOP START), LW,T RSTYPE LW,R STMPINST,T STORE TO 'ACCUM', AI,R ACCUM GEN,1,1 R,CODE21 LI,A 1 BAL,L1 GENLOAD LOAD/CONVERT OF J'TH ARG ELMT. LI,R ACCUM LEFT ARG IS IN REG, RIGHT ARG STW,R RTADR IN 'ACCUM'. B *CLINKTMP RETURN TO SCALAR OR ROUTINE, WHICH * NOW GENS CODE TO EVAL THE OP. * * REDSTOR EQU % SUBSTITUTE FOR 'GXSTEXEC' LW,T RSTYPE LW,R CODE22 GEN INNER LOOP CODE, LW,R+1 STORINST,T STORE TO RESULT, AW,R+1 RSADR GEN,2,2 R,CODE23 AND STORE INDEX CODE. CLM,OP RELATOP IF OP IS RELATIONAL (THE ONLY ONES BCS,9 14Z1 WHICH HAVE RS TYPE DIFFERENT THAN AWM,XL -4,XL ARG CONVERSION TYPE), LW,T RTTYPE INSERT CONVERSION FROM RESULT LW,R CODETBL6,T TYPE TO ARG TYPE. GEN,1,1 R,CODE24 AI,XL 3 14Z1 LW,R LOOPLOC FILL IN ADR OF INNER LOOP AWM,R -4,XL B EXECUTE EXECUTE XSEG * * BOUND 8 RELATOP DATA DOPLESS,DOPEQUAL RELATIONAL OPS - OP CODE RANGE COMPAROP DATA DOPNEQ,DOPEQUAL COMPARISON OPS - OP CODE RANGE ANDNOROP DATA DOPAND,DOPNOR AND-TO-NOR OP CODE RANGE * OPEN ERR,PINF,MINF PINF EQU 2 IDENTITY = +INFINITY MINF EQU 3 IDENTITY = -INFINITY ERR EQU 4 NO IDENTITY VALUE IDENTBL TABLE DOPADD/4 IDENTITY VALUE TABLE - BY OP CODE: RES,1 DOPADD&3 DATA,1 0,0,1,1,1 ADD, SUB, MUL, DIV, POWER DATA,1 ERR,ERR,MINF,PINF LOG, CIRCULAR, MAX, MIN DATA,1 0,1 RESIDUE, COMBINATORIAL DATA,1 0,1,0,1,0,1 RELATIONALS: <, <=, >, >=, /=, = DATA,1 1,0,ERR,ERR AND, OR, NAND, NOR BOUND 4 CLOSE ERR,PINF,MINF * IDTYPTBL TABLE 0 IDENTITY VALUE TYPE TABLE DATA,1 LOGL 0 DATA,1 LOGL 1 DATA,1 FLOT +INF DATA,1 FLOT -INF BOUND 4 * * LODIDTBL TABLE 0 LOAD IDENT INSTRUCTION TABLE LI,AI 0 0 LI,AI -1 1 LD,AF FLOTINF +INF LCD,AF FLOTINF -INF * * CLINKTMP TEMP COMPOSITE OP LINK TEMP ACCUM EQU LFTEMP TEMP TO ACCUMULATE REDUCTION VALUE * * * XSEG CODE: * * LCW,N RSSIZE 0 INIT STORE INDEX CODE20 LW,K OUTRSTEP 1 INIT LOAD INDEX STW,K OUTRSAVE 2 OUTER LOOP: SAVE LOAD INDEX LW,N2 MIDLCNT 3 INIT MIDDLE LOOP COUNT STW,K MIDLSAVE 4 MIDDLE LOOP: SAVE LOAD INDEX LW,N3 INERCNT 5 INIT INNER LOOP COUNT SW,K INERSTEP 6 BUMP LOAD INDEX ALONG K'TH COORD * LOAD/CNV RTARG(K) 7 LOAD LAST (N'TH) VALUE TO INIT LOOP *LOOPLOC STORE ACCUM INNER LOOP: SAVE PREVIOUS RESULT CODE21 SW,K INERSTEP BUMP TO NEXT (EARLIER) ARG ELMT * LOAD/CNV RTARG(K) LOAD IT; USE IT AS LFARG, AND PREV * OP ACCUM RESULT AS RTARG IN DOING 'OP'. CODE22 BDR,N3 0 (LOOPLOC/CONVRS) COUNT INNER LOOP * STORE RESULT(N) STORE ACCUM'D VALUE IN RESULT CODE23 BIR,N CODE25 COUNT RESULT B *RETURN EXIT WHEN RESULT FILLED *CONVRS CONVERT RESULT TYPE TO ARG TYPE (ONLY NEED FOR CODE24 B 0 (LOOPLOC) RELATIONAL OPS). CODE25 LW,K MIDLSAVE * RESTORE INDEX SAVED BY MIDDLE LOOP AW,K MIDLSTEP * BUMP IT BDR,N2 XSEGBASE+4 * COUNT MIDDLE LOOP LW,K OUTRSAVE * RESTORE INDEX SAVED BY OUTER LOOP AW,K OUTRSTEP * BUMP IT B XSEGBASE+2 * CONTINUE OUTER LOOP * * CODETBL6 TABLE LOGL CONVERSION FROM RESULT TO ARG TYPE LCW,AI AI L TO I (LOGL ARG DONE IN INTG MODE) LI,AI -1 L TO C (-1 WONT MATCH ANY CHAR) LCW,AI AI L TO I LD,AF FLOT01,AI L TO F LCW,AI AI L TO I (ISEQ) PAGE U09-0061 * U09-0062 * U09-0063 * SCAN: U09-0064 * U09-0065 * OP:(K) ARG U09-0066 * U09-0067 SCAN EQU % (MONADIC) SCAN U09-0068 BAL,LX SETLINKS SET DETOUR LINKS, ENTER DYADIC U09-0071 * SCALAR OP ROUTINE U09-0072 PZE *MXRETURN RETURN ADR / COPTRIG U09-0073 PZE SCANTYPE CTYPELNK FOR SCAN U09-0074 PZE SCANSET CSETLNK FOR SCAN U09-0075 PZE SCANLOAD CLOADLNK FOR SCAN U09-0076 PZE SCANSTOR CSTORLNK FOR SCAN U09-0077 * U09-0078 * U09-0079 SCANTYPE EQU REDTYPE SUBSTITUTE FOR DTYPEIF U09-0080 * U09-0081 * U09-0082 SCANSET EQU % SUBSTITUTE FOR DSETUP U09-0083 STW,L2 CLINKTMP SAVE LINK U09-0084 BAL,L2 ST3LUPSN SET LOOP PARAMS USING COORD SPEC U09-0085 LW,A MIDLCNT U09-0086 AI,A -1 IF D(K)=1, THEN RESULT = ARG U09-0087 BEZ MNOP U09-0088 CLM,OP RELATOP HANDLE RELATIONAL OP SPECIALLY: U09-0089 BCS,9 17Z1 RESULT TYPE = COMPARE TYPE INSTEADU09-0090 LW,T TYPETEMP OF 'LOGL' (BECAUSE R(1)=B(1)); U09-0091 STW,T RSTYPE U09-0092 AI,T -CHAR 'CHAR' ARG NOT ALLOWED FOR D(K)>1.U09-0093 BEZ ERDOMAIN U09-0094 17Z1 BAL,L1 RSLIKRT2 ALLOCATE RS WITH SAME RANK AND U09-0095 * SIZE AS ARG. U09-0096 BAL,LX MRTDIMS COPY ARG DIMENS TO RESULT U09-0097 LI,A 1 U09-0098 BAL,LX XSETUP SET RTADR FOR INDEXED LOAD U09-0099 LI,A 2 U09-0100 BAL,LX XSETUP SET RSADR FOR INDEXED STORE U09-0101 B *CLINKTMP RETURN TO DYADIC OP ROUTINE U09-0102 * U09-0103 * U09-0104 SCANLOAD EQU % SUBSTITUTE FOR GXSEGDL U09-0105 STW,L3 CLINKTMP SAVE LINK U09-0106 LI,XL XSEGBASE DISCARD CODE GENED BY GXSEGINI U09-0107 LW,A OPER GET UNMODIFIED OP LB,R ASSOCTBL,A CHECK IF ASSOCIATIVE BNEZ ASCNLOAD YES, DO SPECIAL LOAD/STORE GEN,0,8 CODE40 GEN LOOP SETUP CODE, U09-0108 LI,A 1 U09-0109 BAL,L1 GENLOAD LOAD/CONVERT OF ARG ELEMENT, U09-0110 GEN,0,3 CODE41 AND 1ST-ELEMENT TEST CODE. U09-0111 AWM,XL -2,XL U09-0112 B REDSCN1 FINISH AS FOR REDUCTION: THIS GIVES U09-0113 * CORRECT XSEG CODE EXCEPT FOR ONE U09-0114 * ITEM: AN 'INERSTEP' ADR THAT HAS U09-0115 * TO BE CHANGED TO 'MIDLSTEP'. THIS U09-0116 * IS DONE BY SCANSTOR BELOW ... U09-0117 * U09-0118 * U09-0119 SCANSTOR EQU % SUBSTITUTE FOR GXSTEXEC U09-0120 CLM,OP RELATOP FOR A RELATIONAL OP, U09-0121 BCS,9 17Z3 GEN CODE TO CONVERT LOGL VALUE U09-0122 LW,T TYPETEMP TO COMPARISON TYPE. U09-0123 STW,T RSTYPE U09-0124 GENX CONVTABL+4*LOGL,T U09-0125 17Z3 GEN,0,2 CODE43 GEN LOOP CONTROL CODE U09-0126 LW,X LOOPLOC CHANGE 'INERSTEP' TO 'MIDLSTEP' U09-0127 MTW,3 1,X AS MENTIONED ABOVE. U09-0128 AWM,X -2,XL U09-0129 AWM,XL -1,X U09-0130 LW,T RSTYPE U09-0131 LW,R STORINST,T GEN STORE, U09-0132 AW,R RSADR U09-0133 GEN,1,5 R,CODE44 AND FINAL LOOP CONTROL CODE. U09-0134 B EXECUTE EXECUTE XSEG U09-0135 * U09-0136 * U09-0137 * XSEG CODE: U09-0138 * U09-0139 CODE40 LI,K 0 0 INIT INDEX TO 1ST ELEMENT U09-0140 LW,N1 OUTRCNT 1 INIT OUTER LOOP COUNT U09-0141 LW,N2 MIDLCNT 2 OUTER LOOP: INIT MIDDLE LOOP COUNT U09-0142 LI,R 0 3 U09-0143 STW,R COUNT 4 INIT 1ST-TIME COUNTER U09-0144 LW,N3 INERCNT 5 MIDDLE LOOP: INIT INNER LOOP COUNT U09-0145 MTW,1 COUNT 6 BUMP 1ST-TIME COUNTER U09-0146 STW,K KTEMP 7 INNER LOOP: REMEMBER ARG/RS INDEX U09-0147 * LOAD/CNV RTARG(K) 8 GET CORRESPONDING ARG ELMT U09-0148 CODE41 LW,N COUNT IF THIS IS THE FIRST TIME IN THE U09-0149 BDR,N 0 (%+2) MIDDLE LOOP, WE'VE GOT THE RESULT U09-0150 B 0 (STORE RS) ELMT; OTHERWISE, USING OUR U09-0151 *LOOPLOC STORE ACCUM VALUE AS RT ARG OF 'OP', PICK U09-0152 * SW,K MIDLSTEP LF ARG VALUES FROM SUCCESSIVELY U09-0153 * LOAD/CNV RTARG(K) EARLIER ARG ELMTS MOVING ALONG U09-0154 * OP ACCUM K'TH COORD; APPLY 'OP' EACH TIME. U09-0155 * (CONVERT LOGL TO RS TYPE) (RELATIONAL OPS ONLY) U09-0156 CODE43 BDR,N 0 (LOOPLOC) CONTINUE 'TIL WE'VE USED LEFTMOST U09-0157 LW,K KTEMP ELMT ON K'TH COORD; RESTORE K. U09-0158 * STORE RESULT(K) STORE RESULT ELEMENT U09-0159 CODE44 AW,K INERSTEP BUMP ARG/RS INDEX U09-0160 BDR,N3 XSEGBASE+7 COUNT INNER LOOP U09-0161 BDR,N2 XSEGBASE+5 COUNT MIDDLE LOOP U09-0162 BDR,N1 XSEGBASE+2 COUNT OUTER LOOP U09-0163 B *RETURN EXIT U09-0164 * U09-0165 * U09-0166 KTEMP EQU K1TEMP U09-0167 PAGE * * SPECIAL CASE OF 'SCAN' FOR ASSOCIATIVE OPS: * THE TIME REQUIRED TO PROCESS AN N-ELEMENT VECTOR * IS PROPORTIONAL TO N, INSTEAD OF THE N*N/2 * NORMALLY REQUIRED. * OPS INCLUDED ARE: * STRAIGHT - ADD, MULTIPLY, MIN, MAX, * AND, OR, NAND, NOR. * ALTERNATING - SUBTRACT, DIVIDE. * ASCNLOAD EQU % SCANLOAD FOR ASSOCIATIVE OPS BAL,LX EXCHLUPS EXCHANGE INNER/MIDDLE LOOP PARAMS GEN,0,6 CODE50 GEN LOOP INIT CODE LI,A 1 BAL,L1 GENLOAD GEN LOAD/CONVERT OF ARG ELMT STW,XL LOOPLOC SAVE ADR OF 'B ...' GEN,0,2 CODE51 GEN BRANCH AND INDEX-INCR LW,T RSTYPE IF ARG TYPE DIFFERS FROM CLM,OP ANDNOROP RESULT TYPE OR IF OP IS BCR,9 ASCNL1 -AND-OR-NAND-NOR CW,T RTTYPE WE MUST GEN CODE TO BE 17Z4 SAVE ACCUM, LOAD & CONVERT ASCNL1 LW,LX STMPINST,T ARG ELEMENT,SAVE THAT IN AI,LX ACCUM A TEMP, THEN RESTORE ACCUM VALUE. GEN,1,0 LX LI,A 1 BAL,L2 GENLOADT SW,LX =X'03000000' (CHANGE STW/STD TO LW/LD) GEN,1,0 LX 17Z4 LW,R RTADR GET ADR OF ARG ELMT FOR OP ROUTINE STW,XL XSADRTMP SAVE ADR OF MAIN INST LI,A ASCNSTOR CHANGE STORE DETOUR ADDRESS STW,A COPLINKS+4 TO SPECIAL ROUTINE FOR ASSOC OPS. B *CLINKTMP EXIT FROM LOAD ROUTINE: GEN OP * * ASCNSTOR EQU % SCANSTOR FOR ASSOCIATIVE OPS AWM,XL *LOOPLOC FILL IN BRANCH ADR MTW,1 LOOPLOC MAKE LOOPLOC POINT TO 'AW,K ...' LW,T RSTYPE LW,R STORINST,T GEN STORE AW,R RSADR GEN,1,2 R,CODE53 GEN 1ST BDR LB,R ASSOCTBL,OP IS OP ALSO COMMUTATIVE? BDR,R 17Z5 BRANCH IF SO LW,X XL NON-COMMUTATIVE: GEN AN EXTRA SW,X LOOPLOC COPY OF 'OP ARG(K)' CODE. SCS,X -4 LB,XL-1 ALTEROP,OP CHANGE SUBTRACT (DIVIDE) OP LC X LM,XL+1 *LOOPLOC STM,XL+1 0,XL STB,XL-1 *XSADRTMP TO ADD (MULTIPLY) IN 1ST COPY. AWM,XL -2,XL FILL IN PREV BDR ADR TO JUMP HERE SLS,XL 1 UPDATE XL TO INCLUDE NEW CODE SW,XL LOOPLOC LI,R X'E0000' SET MASK FOR COMPARISON AND,R -5,XL STRIP ADDRESS FROM INSTRUCTION CW,R BCR40 CHECK IF SUSPECT INSTRUCTION * IS INTEGER OVERFLOW TEST. BNE 17Z5 NO. AW,R XL YES,FORM CORRECTED ADDRESS AI,R -3 STW,R -5,XL AND RESTORE IN XSEG. 17Z5 LW,R LOOPLOC AWM,R -2,XL FILL IN LAST BDR ADR TO GO BACK B EXECUTE EXECUTE THE XSEG BCR40 BCR,4 0 (USED IN COMPARISON) * * DOPIADD EQU DOPADD-3 INTG ADD OP INDEX ASSOCTBL TABLE DOPIADD/4 ASSOCIATIVE OP TABLE RES,1 DOPIADD&3 0=ORD, 1=ASSOC, 2=ASSCO&COMMUT DATA,1 2,1,2 INTG ADD, INTG SUB, INTG MUL DATA,1 2,1,2,1,0 ADD, SUB, MUL, DIV, POWER DATA,1 0,0,2,2 LOG, CIRCULAR, MAX, MIN DATA,1 0,0 RESIDUE, COMBINATORIAL DATA,1 0,0,0,0,0,0 < <= > >= /= = DATA,1 2,2,0,0 AND,OR,NAND,NOR BOUND 4 * * ALTEROP TABLE DOPIADD/4 ALTERNATE OP TABLE RES,1 DOPIADD&3 DATA,1 0,X'30' INTG SUB: CHANGE SW TO AW DATA,1 0,0,X'1D' FLOT SUB: CHANGE FSL TO FAL DATA,1 0,X'1F' FLOT DIV: CHANGE FDL TO FML BOUND 4 * * * XSEG CODE FOR SCAN W/ASSOCIATIVE OPS: * * CODE50 LI,K 0 0 INIT INDEX LW,N1 OUTRCNT 1 INIT OUTER LOOP COUNT STW,K OUTRSAVE 2 OUTER LOOP: SAVE INDEX LW,N2 MIDLCNT 3 INIT MIDDLE LOOP COUNT STW,K MIDLSAVE 4 MIDDLE LOOP: SAVE INDEX LW,N3 INERCNT 5 INIT INNER LOOP COUNT * LOAD/CNV RTARG(K) 6 GET 1ST ELMT (ON K'TH COORD) CODE51 B 0 (TO STORE) STORE 1ST, PROCESS FOLLOWING ELMTS AW,K INERSTEP INNER LOOP: BUMP INDEX * OP RTARG(K) INCLUDE NEXT ARG ELMT * STORE RESULT(K) STORE AS NEXT RESULT ELMT CODE53 BDR,N3 0 (TO AW,K...) GO DO NEXT ELMT B CODE54 END INNER LOOP * * ADDITIONAL CODE INCLUDED ONLY FOR ALTERNATING OPS * (SUBTRACT/DIVIDE): * * AW,K INERSTEP (ALMOST THE SAME AS ABOVE, * OP RTARG(K) EXCEPT FOR MAIN OP: * STORE RESULT(K) HERE IT'S SUBTRACT OR * BDR,N3 0 (1ST AW,K...) DIVIDE; ABOVE IT WAS CHANGED * B CODE54 TO ADD OR MULTIPLY.) * * CODE54 LW,K MIDLSAVE * END OF INNER LOOP: RESTORE MIDDLE AW,K MIDLSTEP * LOOP INDEX VAL, BUMP IT. BDR,N2 XSEGBASE+4 * COUNT MIDDLE LOOP LW,K OUTRSAVE * END OF MIDDLE LOOP: RESTORE OUTER AW,K OUTRSTEP * LOOP INDEX VAL, BUMP IT. BDR,N1 XSEGBASE+2 * COUNT OUTER LOOP B *RETURN * END OF OUTER LOOP: EXIT PAGE * * * OUTER PRODUCT: * * LFARG CIRCLE.OP RTARG * OUTER EQU % (DYADIC) OUTER PRODUCT BAL,LX SETLINKS SET DETOUR LINKS; ENTER DYADIC * SCALAR OP ROUTINE. PZE *DXRETURN RETURN ADR / COPTRIG PZE OUTRTYP CTYPELNK FOR OUTER PRODUCT PZE SETOUTER CSETLNK FOR OUTER PRODUCT PZE OUTRLOAD CLOADLNK FOR OUTER PRODUCT PZE OUTRSTOR CSTORLNK FOR OUTER PRODUCT * * OUTRTYP EQU % SUBSTITUTE FOR 'DTYPEIF' LI,T CHAR CB,T *LFARG IF EITHER ARG IS CHAR, BE TESTEQ SPECIAL CASE FOR EQUAL/ CB,T *RTARG NOTEQUAL OPS. BE TESTEQ B DTYPEIF1 OTHERWISE, USE 'DTYPEIF'. * * OUTRLOAD EQU % SUBSTITUTE FOR GXSEGDL MTW,-1 XSEGBASE CHANGE 'RSSIZE' TO 'RTSIZE' GEN,0,2 CODE30 GEN OUTER LOOP INIT, LI,A 1 LOAD/CONVERT OF RTARG, BAL,L2 GENLOADT STORE TO RTTEMP, GEN,0,3 CODE31 INNER LOOP INIT, STW,XL LOOPLOC LI,A 0 LOAD/CNV LEFT ARG. BAL,L1 GENLOAD LW,R RTADR WITH LFARG IN REG, GEN CODE TO B *L3 EVAL OP USING RTTEMP. * * OUTRSTOR EQU % SUBSTITUTE FOR GXSTEXEC LW,T RSTYPE GEN STORE IN RESULT, LW,R STORINST,T AW,R RSADR GEN,1,2 R,CODE32 INNER LOOP CONTROL CODE, GEN,0,6 CODE36 AND OUTER LOOP CONTROL CODE. LW,R LOOPLOC AWM,R -6,XL FILL IN INNER LOOP ADR LW,S RSSIZE RECOMPUTE RTSIZE (SETING RTADR DW,S LFSIZE LOUSES IT UP IF RTARG IS CHAR; STW,S RTSIZE1 BUT LFSIZE IS OK - XSETUP DOESN'T * CHANGE LFSIZE). B EXECUTE EXECUTE XSEG * * * XSEG CODE: * * LCW,N RTSIZE 0 INIT RTARG INDEX CODE30 LI,K 0 1 INIT STORE INDEX STW,K OUTRSAVE 2 OUTER LOOP: SAVE STORE INDEX * LOAD/CNV RTARG(N) 3 LOAD LFARG ELEMENT * STORE RTTEMP STORE IN TEMP CODE31 AI,N 1 BUMP RT INDEX LI,K1 0 INIT LFARG INDEX LW,N2 LFSIZE INIT INNER LOOP COUNT *LOOPLOC LOAD/CNV LFARG(K1) INNER LOOP: FETCH LFARG TO REG * OP RTTEMP EVAL OP, USING RTARG IN RTTEMP * STORE RESULT(K) STORE ANSWER IN RESULT CODE32 AW,K RTSIZE1 BUMP STORE INDEX AI,K1 1 BUMP LFARG INDEX CODE36 BDR,N2 0 (LOOPLOC) COUNT INNER LOOP LW,K OUTRSAVE RESTORE STORE INDEX OUTER LOOP SAVED AI,K 1 BUMP IT CW,K RTSIZE1 BL XSEGBASE+2 COUNT OUTER LOOP B *RETURN EXIT WHEN DONE * RTSIZE1 EQU MIDLSAVE PAGE * * * INNER PRODUCT: * * LFARG OP2.OP1 RTARG * INNER EQU % (DYADIC) INNER PRODUCT SLS,OP -8 AND,OP =X'FF' ISOLATE OUTER OP CODE (OP2) STW,OP OTHEROP SAVE IT LW,OP OPER RESTORE OP BAL,LX SETLINKS SET DETOUR LINKS; PUT INNER OP CODE * (OP1) IN OPER; ENTER SCALAR * OP ROUTINE. INR2LNKS EQU % PZE *DXRETURN RETURN ADR / COPTRIG PZE INRTYPE1 CTYPELNK FOR INNER PRODUCT (OP1) PZE INRSET1 CSETLNK FOR INNER PRODUCT (OP1) PZE INRLOAD1 CLOADLNK FOR INNER PRODUCT (OP1) PZE INRSTOR1 CSTORLNK FOR INNER PRODUCT (OP1) * * INRTYPE1 EQU OUTRTYP SUBSTITUTE FOR 'DTYPEIF' * * INRSET1 EQU % SUBSTITUTE FOR DSETUP STW,L2 CLINKTMP SAVE LINK LW,X OTHEROP TYPE BY WHICH TO ALOC RESULT IS LB,T RSTYPTBL,X DETERMINED BY OUTER OP (OP2). BNEZ 15Z1 IF OP2 IS IN INTG/FLOT GROUP, LW,T RSTYPE RESULT TYPE IS MAX (T, INTG), CI,T LOGL WHERE T = OP2'S ARG TYPE, BNE 15Z1 = OP1'S RESULT TYPE. LI,T INTG 15Z1 STW,T OUTRTYPE REMEMBER OP2'S RESULT TYPE XW,T RSTYPE USE IT TO ALOC RESULT STW,T INERTYPE REMEMBER OP1'S RESULT TYPE BAL,L2 SETINNER CHECK CONFORM; ALOC RS; SET LOOPS LW,T INERTYPE RESTORE OP1'S TYPE STW,T RSTYPE B *CLINKTMP RETURN TO SCALAR OP ROUTINE * * INRLOAD1 EQU % SUBSTITUTE FOR GXSEGDL STW,L3 CLINKTMP (GEN CLOBS L3) GEN,0,9 CODE1 GEN LOOP INIT CODE (THIS SEQUENCE LW,L3 CLINKTMP * IS ACTUALLY ONLY 8 WORDS LONG, * THE 9'TH WORD IS RESERVED FOR * A STORE INST, TO BE FILLED IN * LATER). B GXSEGDL1 MAKE RTARG ADDRESSABLE, LOAD LFARG; * RETURN TO SCALAR OP ROUTINE * TO GEN OP1 EVAL CODE. * * INRSTOR1 EQU % SUBSTITUTE FOR GXSTEXEC LI,OP 1 CW,OP RTCOMDIM BE 15Z2 IF D(1)>1, GEN,0,1 CODE3 GEN RTARG INDEX BUMP CODE. 15Z2 CW,OP LFCOMDIM BE 15Z3 IF C(M)>1, GEN,0,1 CODE6 GEN LFARG INDEX BUMP CODE. 15Z3 CW,OP INERCNT IF C(M)=D(1)=1, BE KILLOP2 DONT BOTHER GEN'ING OP2 CODE (OP * HAS BEEN CLOBBERED BECAUSE OF * KILLOP2'S OP TEST, TO FAIL IT). STW,XL XSADRTMP SAVE XSEG LOC LW,OP OPER SAVE INNER OP XW,OP OTHEROP SET UP TO DO OUTER OP (OP2) BAL,LX SETLINKS CHANGE DETOUR LINKS; ENTER DYADIC * SCALAR OP ROUTINE FOR OP2. PZE *DXRETURN RETURN ADR / COPTRIG PZE INRTYPE2 CTYPELNK FOR INNER PRODUCT (OP2) PZE INRSET2 CSETLNK FOR INNER PRODUCT (OP2) PZE INRLOAD2 CLOADLNK FOR INNER PRODUCT (OP2) PZE INRSTOR2 CSTORLNK FOR INNER PRODUCT (OP2) * * INRTYPE2 EQU % SUBSTITUTE FOR DTYPEIF LW,T INERTYPE OP1'S RESULT TYPE BECOMES STW,T LFTYPE OP2'S ARG TYPES. STW,T RTTYPE STW,T RSTYPE SET OP'S RESULT TYPE B %+1-LOGL,T WHAT IS RS TYPE? MTW,INTG-LOGL RSTYPE LOGL: SET RS TO INTG NOP CHAR: (CAN'T BE THIS TYPE) B 0,LX INTG OR LOGL: TAKE INTG EXIT B 1,LX FLOT: TAKE FLOT EXIT * * INRSET2 EQU % SUBSTITUTE FOR DSETUP B *L2 THE SETUP HAS ALREADY BEEN DONE * * INRLOAD2 EQU % SUBSTITUTE FOR GXSEGDL LW,XL XSADRTMP RESTORE XSEG ADR LW,T RSTYPE = THE TYPE TO WHICH OP2'S LW,R STMPINST,T ARGS ARE TO BE CONVERTED. AI,R ACCUM FILL IN THAT STORE INST FOR WHICH STW,R XSEGBASE+9 SPACE WAS RESERVED. LW,T INERTYPE SLS,T 2 AW,T RSTYPE GEN CONVERSION OF OP1'S RESULT GENX CONVTABL,T TO OP2'S ARG CONV MODE. GEN,0,4 CODE33 GEN FIRST-TIME TEST AWM,XL -3,XL STW,XL LOOPLOC SAVE OP2 LOC LI,R ACCUM SET RTADR = ACCUM STW,R RTADR B *L3 GO GEN CODE TO EVAL OP2 * * INRSTOR2 EQU % SUBSTITUTE FOR GXSTEXEC LW,R OTHEROP PUT OPS BACK THE WAY THEY WERE XW,R OPER DURING INRTYPE1, SO THAT STW,R OTHEROP 'INTGOVFL' WILL WORK OK IF CALLED. LCI 3 RESTORE SETUP/LOAD/STORE LINKS LM,R INR2LNKS+2 AS THEY WERE FOR OP1, SO THAT STM,R COPLINKS+2 'INTGOVFL' WILL WORK RIGHT. GEN,0,1 CODE34 GEN INNER LOOP CONTROL LW,X LOOPLOC AWM,XL -1,X FILL IN BRANCH ADR KILLOP2 LW,T RSTYPE LW,R STORINST,T GEN STORE IN RESULT, AW,R RSADR GEN,1,2 R,CODE16 AND STORE-INDEX CONTROL CODE. CLM,OP RELATOP IF OP2 IS RELATIONAL, BCS,9 EXECUTE INSERT CODE TO CONVERT ITS AW,XL BDRN3INS LOGL RESULT TO ITS ARG CONVERSION STW,XL -4,XL MODE. LW,T RSTYPE LW,R CODETBL6,T GEN,1,1 R,CODE35 B EXECUTE EXECUTE XSEG * * RSTYPTBL TABLE DOPADD/4 RESULT TYPE TABLE - BY OP: RES,1 DOPADD&3 DATA,1 0,0,0,FLOT,0 ADD, SUB, MUL, DIV, POWER DATA,1 FLOT,FLOT,0,0 LOG, CIRCULAR, MAX, MIN DATA,1 0,0 RESIDUE, COMBINATORIAL DATA,1 LOGL,LOGL,LOGL RELATIONAL OPS: <, <=, >, DATA,1 LOGL,LOGL,LOGL >=, /=, =. DATA,1 LOGL,LOGL AND, OR DATA,1 LOGL,LOGL NAND, NOR BOUND 4 * BDRN3INS BDR,N3 0 * OTHEROP TEMP OP1/OP2 ARE KEPT HERE AND IN OPER XSADRTMP TEMP XSEG ADR SAVE TEMP INERTYPE TEMP OP1 RESULT TYPE OUTRTYPE TEMP OP2 RESULT TYPE * * * XSEG CODE: * * LCW,N RSSIZE 0 INIT STORE INDEX *CODE1 LW,K1 LFCOMDIM 1 INIT LFARG INDEX * AI,K1 -1 2 * LW,K RTSIZE 3 INIT RTARG INDEX * SW,K MIDLCNT 4 OUTER LOOP: BUMP RTARG INDEX * STW,K1 OUTRSAVE 5 SAVE LFARG INDEX * LW,N2 MIDLCNT 6 INIT MIDDLE LOOP COUNT * STW,K MIDLSAVE 7 MIDDLE LOOP: SAVE RTARG INDEX * LW,N3 INERCNT 8 INIT INNER LOOP COUNT * STORE ACCUM 9 INNER LOOP: STORE PREVIOUS OP2 RS * LOAD/CNV RTARG(K) LOAD NEW RTARG ELMT * STORE RTTEMP SAVE IT IN TEMP * LOAD/CNV LFARG(K1) LOAD NEW LFARG ELMT * OP1 RTARG(K)/RTTEMP DO OP1 *CODE3 SW,K MIDLCNT (CONDITIONALLY GEN'D) BUMP RT INDEX *CODE6 AI,K1 -1 (CONDITIONALLY GEN'D) BUMP LF INDEX * CONVERT OP1 RESULT TO OP2 ARG TYPE CODE33 CW,N3 INERCNT BNE 0 (%+3) IF IT'S THE 1ST TIME IN INNER LOOP, BDR,N3 XSEGBASE+9 DON'T DO OP2 (REG=RESULT). B 0 (%+3) *LOOPLOC OP2 ACCUM NOT 1ST TIME: DO OP2 CODE34 BDR,N3 XSEGBASE+9 /CONVRS COUNT INNER LOOP (MAYBE CONV) * STORE RESULT(N) STORE ACCUM'D VALUE IN RESULT *CODE16 BIR,N CODE8 COUNT RESULT * B *RETURN EXIT WHEN RESULT FILLED *CONVRS CONVERT OP2 RESULT TO OP2 ARG TYPE (RELATIONAL OPS ONLY) CODE35 B XSEGBASE+9 *CODE8 LW,K1 OUTRSAVE * RESTORE RTARG * LW,K MIDLSAVE * AND LFARG INDECES. * AI,K 1 * BUMP RTARG INDEX * BDR,N2 XSEGBASE+7 * COUNT MIDDLE LOOP * AW,K1 LFCOMDIM * BUMP LFARG INDEX * B XSEGBASE+4 * CONTINUE OUTER LOOP PAGE * * * S E T U P R O U T I N E S F O R C O M P O S I T E O P S * * * SET DETOUR LINKS * * SETS THE COMPOSITE OP DETOUR LINKS TO THE VALUES * GIVEN IN BAL+1,...,BAL+5; SETS OP AND OPER TO RIGHT * OP; ENTERS CORRESPONDING DYADIC SCALAR OP ROUTINE. * LINK IS LX. * SETLINKS EQU % AND,OP =X'FF' CLEAN UP OP STW,OP OPER COPY TO OPER LCI 5 LM,BUF 0,LX COPY GIVEN DETOUR LINKS STM,BUF COPLINKS AND COPTRIG VALUE. B DXTABLE,OP ENTER DYADIC SCALAR OP ROUTINE * * COPLINKS EQU COPTRIG COMP OP LINK TABLE ADR RETURN EQU COPTRIG RETURN ADR / COPTRIG CELL COPTRIG TEMP COMP OP TRIG CTYPELNK TEMP DETOUR LINK FOR DTYPEIF CSETLNK TEMP DETOUR LINK FOR DSETUP CLOADLNK TEMP DETOUR LINK FOR GXSEGDL CSTORLNK TEMP DETOUR LINK FOR GXSTEXEC PAGE * * * SET UP FOR OUTER PRODUCT / ENCODE * * 1. SETS UP LF/RT/RS RANK/SIZE * 2. ALLOCATES RESULT * 3. ESTABLISHES RESULT DIMENS * 4. SETS UP LFADR FOR INDEXED LOAD USING K1, * RTADR FOR SEQUENCIAL LOAD USING N, * AND RSADR FOR INDEXED STORE USING K. * LINK IS L2. * SETOUTER EQU % LI,A 0 BAL,LX SETUPARG SET UP ARG PARAMS LI,A 1 BAL,LX SETUPARG * LW,R LFRANK AW,R RTRANK RESULT RANK = SUM OF ARG RANKS STW,R RSRANK LW,S LFSIZE MW,S RTSIZE RESULT SIZE = PRODUCT OF ARG SIZES STW,S RSSIZE BAL,L1 ALOCRS ALOCATE RESULT DB AW,A RSRANK POINT TO LAST DIMEN -1 LW,X RTRANK BEZ 9Z2 MTW,1 RTARG 9Z1 LW,R *RTARG,X COPY RTARG DIMENS STW,R 1,A TO RESULT DIMENS. AI,A -1 BDR,X 9Z1 MTW,-1 RTARG 9Z2 LW,X LFRANK BEZ 9Z4 MTW,1 LFARG 9Z3 LW,R *LFARG,X COPY LFARG DIMENS STW,R 1,A TO RESULT DIMENS. AI,A -1 BDR,X 9Z3 MTW,-1 LFARG 9Z4 LI,A 2 BAL,LX XSETUP SET RSADR FOR INDX STORE USING K LI,X -2 BAL,LX SETADR SET RTADR FOR SEQ LOAD USING N LI,A 0 BAL,LX XSETUP SET LFADR FOR INDEXED LOAD, BAL,L1 SETSPEC2 USING K1. B *L2 PAGE * * * SET UP FOR INNER PRODUCT / DECODE * * 1. SETS UP LF/RT/RS RANK/SIZE * 2. CHECKS CONFORMABILITY * 3. SETS THE FOLLOWING LOOP CONTROL PARAMS: * LFCOMDIM = C(M) (LFARG'S LAST DIMEN) * RTCOMDIM = D(1) (RTARG'S FIRST DIMEN) * INERCNT = MAX(C(M),D(1)) * MIDLCNT = D(2)*...*D(N) * OUTRCNT = C(1)*...*C(M-1) * 4. ALLOCATES RESULT * 5. ESTABLISHES RESULT DIMENS * 6. SETS UP LFADR FOR INDEXED LOAD USING K1, * RTADR FOR INDEXED LOAD USING K, * AND RSADR FOR SEQUENCIAL STORE USING N. * THIS ROUTINE AUTOMATICALLY HANDLES THE CASES 09-00007 * WHERE C(M)=0 OR D(1)=0: IT FILLS THE RESULT WITH 09-00008 * THE APPROPRIATE IDENTITY ELEMENTS, AND 09-00009 * DOES NOT RETURN TO THE CALLER. IF IT 09-00010 * DOES RETURN, INERCNT>0. 09-00011 * LINK IS L2. * SETINNER EQU % LI,A 0 BAL,LX SETUPARG SET UP ARG PARAMS LI,A 1 BAL,LX SETUPARG * LI,S 1 CW,S LFSIZE SET 'LEFT COMBINING DIMEN' BE 10Z1 TO 1 (IF LFARG IS SCALAR OR LW,X LFRANK 1-ELMT THING), OR C(M) (LFARG'S AI,X 1 LAST DIMEN). LW,S *LFARG,X 10Z1 STW,S LFCOMDIM LI,S 1 CW,S RTSIZE SET 'RIGHT COMBINING DIMEN' BE 10Z2 TO 1 (IF RTARG IS SCALAR OR LI,X 2 1-ELMT THING), OR D(1) (RTARG'S LW,S *RTARG,X FIRST DIMEN). 10Z2 STW,S RTCOMDIM CW,S LFCOMDIM DENOTING THE COMBINING DIMENS BE 10Z4 BY L AND R, CI,S 1 WE MUST HAVE FOR CONFORMABILITY: BNE 10Z3 L=R, OR L=1, OR R=1 LW,S LFCOMDIM B 10Z4 10Z3 LI,R 1 CW,R LFCOMDIM BNE ERLENGTH 10Z4 STW,S INERCNT INNER LOOP COUNT = MAX(L,R) BDR,S 10Z41 AI,S 1 INERCNT = 0 OR 1 09-00015 BGZ 10Z405 BRANCH IF 1 09-00016 LI,OP DOPADD INERCNT = 0: SET UP TYPE 09-00017 LW,X COPTRIG OF IDENTITY ELEMENT 09-00018 BGEZ 10Z404 09-00019 LW,OP OTHEROP (LEFT OP FOR INNER PRODUCT, 09-00020 10Z404 LB,X IDENTBL,OP '+' FOR DECODE) 09-00021 LB,T IDTYPTBL,X 09-00022 B 10Z409 09-00023 10Z405 EQU % INERCNT = 1 09-00024 LW,S COPTRIG IF INERCNT=1 ON INNER PRODUCT, BGEZ 10Z41 LW,T INERTYPE RESULT TYPE IS INNER OP TYPE, * NOT OUTER OP TYPE. 09-00026 10Z409 STW,T RSTYPE 09-00027 10Z41 LW,R LFRANK BDR,R 10Z5 LI,R 0 10Z5 LW,S RTRANK RESULT RANK = BDR,S 10Z6 MAX(LFRANK-1,0) + MAX(RTRANK-1,0). LI,S 0 10Z6 AW,R S STW,R RSRANK LW,S LFSIZE DW,S LFCOMDIM OUTER LOOP COUNT = BNOV 10Z63 C(1)*C(2)*...*C(M-1). 09-00029 LI,S 1 C(M)=0: COMPUTE OUTERCNT 09-00030 MTW,1 LFARG THE HARD WAY. 09-00031 LW,X LFRANK 09-00032 B 10Z62 09-00033 10Z61 MW,S *LFARG,X 09-00034 BOV ERLENGTH 09-00035 10Z62 BDR,X 10Z61 09-00036 MTW,-1 LFARG 09-00037 10Z63 EQU % 09-00038 STW,S OUTRCNT C(1)*C(2)*...*C(M-1). LW,S RTSIZE DW,S RTCOMDIM MIDDLE LOOP COUNT = BNOV 10Z66 D(2)*D(3)*...*D(N). 09-00040 LI,S 1 D(1)=0: COMPUTE MIDLCNT 09-00041 MTW,2 RTARG THE HARD WAY. 09-00042 LW,X RTRANK 09-00043 B 10Z65 09-00044 10Z64 MW,S *RTARG,X 09-00045 BOV ERLENGTH 09-00046 10Z65 BDR,X 10Z64 09-00047 MTW,-2 RTARG 09-00048 10Z66 EQU % 09-00049 STW,S MIDLCNT D(2)*D(3)*...*D(N). MW,S OUTRCNT RESULT SIZE = STW,S RSSIZE C(1)*...*C(M-1)*D(2)*...*D(N). BAL,L1 ALOCRS ALLOCATE RESULT DATA BLOCK AW,A RSRANK POINT TO LAST RS DIMEN -1 MTW,2 RTARG LW,X RTRANK MOVE D(2),...,D(N) TO RS DIMENS, B 10Z8 IF N>=2. 10Z7 LW,R *RTARG,X STW,R 1,A AI,A -1 10Z8 BDR,X 10Z7 MTW,-2 RTARG MTW,1 LFARG LW,X LFRANK MOVE C(1),...,C(M-1) TO RS DIMENS, B 10Z10 IF M>=2. 10Z9 LW,R *LFARG,X STW,R 1,A AI,A -1 10Z10 BDR,X 10Z9 MTW,-1 LFARG LW,X INERCNT 09-00051 BEZ FILIDENT HANDLE INERCNT=0 CASE SPECIALLY 09-00052 LI,A 0 BAL,LX XSETUP SET LFADR FOR INDX LOAD (K1), BAL,L1 SETSPEC1 RTADR FOR INDX (K), RSADR SEQ (N). B *L2 RETURN PAGE * * * M I X E D O P S E T U P R O U T I N E S * * * SET UP ARG PARAMETERS * * SETS UP RANK, SIZE AND TYPE CELLS FOR LEFT (A=0) * OR RIGHT (A=1) ARG. LINK IS LX. * SETUPARG EQU % LW,X LFARG,A GET ARG PNTR LB,T *X GET ARG TYPE CODE CI,T LIST CHECK FOR LIST OR OTHER BGE ERDOMAIN ILLEGAL ARG TYPES. STW,T LFTYPE,A COPY LI,AI 1 INIT SIZE = 1 LB,R *X,AI GET ARG RANK STW,R LFRANK,A COPY BEZ 4Z2 IF RANK>0, 4Z1 MW,AI 2,X SIZE = PRODUCT OF DIMENS. AI,X 1 BDR,R 4Z1 4Z2 STW,AI LFSIZE,A COPY B 0,LX RETURN PAGE * * * TYPE COMPATIBILITY CHECK * * CALLED WITH ARG TYPES IN LFTYPE/RTTYPE. IF BOTH * ARE CHAR OR BOTH NUMERIC, IT RETURNS BAL+2 WITH * HIGHEST TYPE IN RSTYPE AND T REG; IF ONE TYPE IS * CHAR AND THE OTHER NUMERIC, IT RETURNS TO BAL+1. * LINK IS LX. * IF HIGHEST TYPE IS 'ISEQ', TYPE 'INTG' IS SUBSTITUTED. * TYCOMPAT EQU % LI,T CHAR CW,T LFTYPE BNE 8Z1 CW,T RTTYPE L=CHAR: TEST R BE 8Z3 L=R=CHAR: SET RS=CHAR, RTN BAL+2 B 0,LX L=CHAR, R=NUMER: RETURN BAL+1 8Z1 CW,T RTTYPE L=NUMER: TEST R BNE 8Z2 B 0,LX L=NUMER, R=CHAR: RETURN BAL+1 8Z2 LW,T LFTYPE L=R=NUMER: SET RS=MAX(L,R) LB,T TCONV,T SUBSTITUTE INTG FOR ISEQ LW,X RTTYPE CB,T TCONV,X COMPARE (CONVERTED) TYPES BGE 8Z3 LB,T TCONV,X L0: RETURN TO CALLER B *RETURN SIZE=0: EXIT DRIVER * ERROR,X'F',TLOC>28 'TOO MANY TEMPS' U09-0169 NTEMPS SET TLOC U09-0170 18Z END U09-0171