         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                          
*       <STORE    RTTEMP>           IF LEFT ARG MUST BE CONVERTED,              
*LOOP2  <LOAD/CNV LFARG(K)>           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           L<R, GET CONVERTED R TYPE                   
8Z3      STW,T    RSTYPE            TYPES COMPATIBLE                            
         B        1,LX              RETURN BAL+2                                
*                                                                               
TCONV    EQU      %                 ISEQ-TO-INTG CONVERT TABLE                  
         DATA,1   0,LOGL,CHAR,INTG,FLOT,INTG                                    
         BOUND    4                                                             
         PAGE                                                                   
*                                                                               
*                                                                               
*  EVALUATE INTEGER SCALAR ARG                                                  
*                                                                               
*              MAKE SURE THAT RTARG IS A SCALAR (OR 1-ELEMENT ARRAY)            
*              WITH AN INTEGER VALUE, WHICH IS RETURNED IN AI. LINK             
*              IS LZ.                                                           
*                                                                               
INTSCALR EQU      %                                                             
         LB,T    *RTARG             GET ARG TYPE                                
         LW,X     RTARG             GET ARG PNTR                                
         LI,AI    1                                                             
         LB,R    *RTARG,AI          GET ARG RANK                                
         BEZ      GSCLRVAL,T        IS ARG SCALAR?                              
2Z1      AI,X     1                 NO, MAKE SURE ALL ITS DIMENS                
         CW,AI    1,X                 ARE 1, AND LEAVE 'X' SITTING              
         BNE      ERLENGTH            TWO WORDS BELOW 1ST DATA WORD,            
         BDR,R    2Z1                 AS IT WOULD BE IN THE SCALAR CASE.        
         B        GSCLRVAL,T        GO TO JUMP TABLE                            
         PAGE                                                                   
*                                                                               
*                                                                               
*  ALLOCATE INTEGER VECTOR RESULT DATA BLOCK                                    
*                                                                               
*              CALLED WITH SIZE IN RSSIZE, IT ALLOCATES THE DB,                 
*              SETS ITS DIMEN, AND SETS UP RSTYPE AND RSRANK.                   
*              LINK IS L2. IF RSSIZE=0, IT EXITS THROUGH 'RETURN';              
*              OTHERWISE, IT RETURNS TO CALLER WITH RESULT PNTR                 
*              IN 'A' AND SIZE IN 'S'.                                          
*              'VECTORRS' IS ALTERNATE ENTRY WHICH TAKES TYPE                   
*              FROM 'T'.                                                        
*                                                                               
INTVECRS EQU      %                                                             
         LI,T     INTG                                                          
VECTORRS EQU      %                                                             
         ISEQFIX,T                  USE TYPE INTG INSTEAD OF ISEQ               
         STW,T    RSTYPE            RS TYPE = INTG                              
         LI,R     1                                                             
         STW,R    RSRANK            RS RANK = 1 (VECTOR)                        
         LW,S     RSSIZE                                                        
         BAL,L1   ALOCRS            ALLOCATE RS; PNTR TO 'A'                    
         LW,S     RSSIZE            GET SIZE                                    
         STW,S    2,A               SET RS DIMEN = SIZE                         
         BGZ     *L2                SIZE>0: 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
