CONTR  .  TRIAD DEFINITION
        RGS  .  DEFINE THE REGISTERS
$(1)  .
         LIT .
.      THIS SECTION RECOMPUTES THE ARGUMENTS OF THE FLD FUNCTION SO THAT
.      THEY CAN BE USED DIRECTLY IN PHASE V WITH OUT FURTHER COMPUTATION
.      THE FOUR CASES CONSIDERED ARE
.      LOAD COUNTING FROM LEFT
.        LSSC   F
.        SSL    36-N
.      LOAD COUNTING FROM RIGHT
.       SSC    F+1
.        SSL    36-N
.      STORE COUNTING FROM LEFT
.        LSSC   F<N    TT2+1
.        DSL    N      TT2
.        SSC    F      TT1
.      STORE COUNTING FROM RIGHT
.       SSC    F+1-N     TT2+1
.        DSL    N      TT2
.       SSC    35-F    TT1
N3FLD*   .
          L         A1,FNC              . CURRENT FUNCTION LEVEL
          TZ,S6     SFMSK,A1            . NON ZERO IF THIS IS TWO WORD FIELD
          J         N3DLD
          SZ,H2    POLG
        SZ     FLDSEX                                                   FLDSGN
        L       A1,F31-2,NSEQN  .  THE SECOND COMMA MUST BE
        SR,S6   R4,MINTX+056
        AND     A1,(0777700,0777777)  .  TREATED DIFFERENTLY IN THE FLD
        TNE     A2,(0102100,07)  .  FUNCTION SO THAT NO CONVERSIONS
        S,T3    R5,F31-2,NSEQN  .  WILL BE DONE ACROSS IT
        JNBL    A14,COPND1,0,S3 4 FLDA      CHECK FOR NEGATIVE SIGN
        JE     A15,COPND1,0,S1 3 FLDA     A NEGATIVE CONSTANT IS AN ERROR IN P5
        SLJ     UPSL
        MVW     COPND1 COPND2
        MVW     (070000,0) COPND1      ABS OPERATOR IS INSERTED TO
        MVW     (0102000,0102) COPER   ELIMINATE (-0) SHIFT COUNTS
        LMJ     B9,TSXFX               NUMBER OF ABS EXPRESSION
        L       A5,SUBNO
        SLJ     LWSL
        S       A5,COPND1
FLDA    JNBL    A14,COPND2,0,S3 4 FLDZ     CHECK FOR MINUS SIGN
        SZ,S3  COPND2       REMOVE MINUS SIGN                           FLDSGN
        S      R4,FLDSEX                                                FLDSGN
        JE      A15,COPND2,0,S1 3 FLDZ   A NEGATIVE CONSTANT IS AN ERROR IN P5
        SLJ     UPSL
        MVW     (070000,0) COPND1
        MVW     (0102000,0102) COPER
        LMJ     B9,TSXFX
        L       A5,SUBNO
        SLJ     LWSL
        S       A5,COPND2
FLDZ    L      A1,FNC    ONLY FLD WHICH IS UNNESTED
        AN,M   A1,1    SHOULD GENERATE CODE AS IF IT  IS
         TNZ,H2    SUBLV    .   ALL TO RIGHT IN SUBSCRIPTS
        TE,H2  A1,F31C    TO LEFT OF EQUALS
        J      FLD1
        L      A0,LSEQ    LOCATION OF EQUALS OPERATION
        L,M    A1,8
        TNE,S1  A1,F31+1,A0
        J      FLD1
        L,S2   A0,STTYA      EXPRESSION IN OUTPUT LIST
        TNE,M   A0,37     APPEAR AS IF THEY ARE TO RIGHT OF EQUALS
        J       FLD1
        S,S6   A1,COPER
FLDB   TZ,H2    COMFL
        J       FLD2       GENERATE EXPRESSIONS FROM RIGHT
          TNZ,S3   CRRELN             COMPILER (FLD=ABS)
          J        FLD8J
          SLJ      UPSL
          L         A5,COPND1
          SLJ      CHEX               GET ABS OF COPND1
          LX,H2    B1,CTRST
          S        A5,TRST-10,B1
          L        A5,TRST-9,B1
          SLJ      CHEX
          L,H2     B1,CTRST
          S        A5,TRST-9,B1
          SLJ      LWSL
FLD8J .
        LMJ     B9,TSEX
        MVW     SUBNO FLDC1
        SLJ     UPSL
        SLJ     FORMSM     FORM EXPRESSION THAT IS SUM OF 2 OPERANDS
FLD3    LMJ     B11,CHTS+1
        NOP
        SLJ     CHEX     CHECK TO SEE IF RESULT US EXPRESSION
        S       A5,COPND2
        MVW     FLDC1 COPND1
        MVW     (0102100,07777) COPER
        JNE     A15,COPND2,0,S1  5  $+6                                    CSC17
        LA      A0,COPND2
        SA      A0,FL30
        LMJ     B11,ITVSX+1                                                CSC17
        LMJ     B11,CHTS+1
        SLJ     XERV                .  CANT REDUCE TO A COMMA
        SLJ     LWSL
        L       B11,CHTS
        SZ,H2   POLG  .  CLEAR SIGN FLAG
        J       1,B11               .  RETURN TO ORIGINAL PROGRAM
FLD1    SLJ     UPSL
        SR,S6   R4,MINTX+056        SET BIT SO FLD CAN NOT BE COMMON EXP   CSC24
        SLJ     CHJ  .  CHECK FOR J FACTORS                                CSC24
        SR,H2   R4,POLG  .  FLAG NOT TO PERMUTE SIGNS IN FLO
        MVW     (030100,36) COPND1
        MVW     (0101200,0) COPER
        L,S3    A14,COPND2
        XOR,M   A14,4
        S,S3    A15,COPND2  .  MULTIPLY BY MINUS 1
        LMJ     B11,CHTS+1
        NOP
        SLJ     CHEX
        LX,H2   B1,CTRST
        S      A5,TRST-9,B1
        TNZ,H2   COMFL       TEST FOR FLD COUNTED FROM RIGHT
        J       FLD4
        L       A6,(030100,1)
        S       A6,COPND2
        L      B1,CTRST
        MVW     TRST-10,B1 COPND1  .  LAST COPND1 TO PRESENT COPND1
        SLJ     FORMSM
        LMJ     B11,CHTS+1
        NOP
        L      B1,CTRST
        S      A5,TRST-10,B1    F IS REPLACED WITH F+1
          J        FLD4J
FLD4      L        A5,TRST-10,B1
          TZ,S3    CRRELN             COMPILER (FLD=ABS)
          SLJ      CHEX
          LX,H2    B1,CTRST
          S        A5,TRST-10,B1
FLD4J     SLJ      LWSL
        SZ,H2   POLG  .  CLEAR SIGN FLAG
        L      A1,FLDSEX                                                FLDSGN
        LSSC   A1,2                                                     FLDSGN
        OR,S3  A1,COPER         SET FLAG FOR SIGN EXTENSION ONTO OPERATOFLDSGN
        S,S3   A2,COPER                                                 FLDSGN
        J       ROTS  .  CONTINUE WITH NORMAL PROCESSING
.    THE NEXT SECTION GENERATES CODE FOR FLD LEFT OF EQUALS WHEN
.       FLD      PARAMETERS ARE DETERMINED FROM RIGHT
FLD2    SLJ     UPSL
        MVW     COPND1 FLDC2   SAVE F
          TNZ,S3   CRRELN             COMPILER (FLD=ABS)
          J        FLD2J
          L        A5,COPND2
          SLJ      CHEX
          L        B1,CTRST
          S        A5,TRST-9,B1
          MVW      TRST-10,B1 COPND1  . RESTORE OPRAND
FLD2J .
        SLJ     FORMSM     FORM EXPRESSION THAT IS WUM OF 2 OPERANDS
        L,S3   A14,COPND2
        XOR,M   A14,4
        S,S3   A15,COPND2
        LMJ     B11,CHTS+1
        NOP
        S      A5,COPND1
        MVW     (030100,1) COPND2
        SLJ    FORMSM
        LMJ    B11,CHTS+1
        NOP
        SLJ    CHEX
        SLJ     LWSL
        S       A5,COPND1    REPLACE F WITH F+N
        LMJ     B9,TSEX
        SLJ     UPSL
        MVW     SUBNO FLDC1   EXP OF ',' WITH F+N AND N
        MVW     FLDC2 COPND2
        L,S3    A14,COPND2
        XOR,M   A14,4
        S,S3    A15,COPND2
        JNE     A15,COPND2,0,S1 5 $+6
        L       A0,COPND2
        S       A0,FL30
        LMJ     B11,ITVSX+1
        MVW     (0101200,0) COPER
        MVW     (030100,35) COPND1
        J       FLD3
CHJR    JNE    A15,COPER,0,S6 7 *CHJ                                    REENT
        SZ,S6   MINTX+056                                                  CSC24
        JNE     A15,COPND1,0,T1 0301 *CHJ                                  CSC24
        JNE     A14,COPND2,0,T1 0301 *CHJ                                  CSC24
        LA,T3   A15,COPND1                                                 CSC24
        TNZ,H2  COMFL
        J      $+3
        AN,M   A15,35
       LN      A15,A15
        SSC     A15,27                                                     CSC24
        L,S1    R1,COMFL
        A,T3    A15,COPND2
        L       B11,(1,0)                                                  CSC24
        A,S2    B11,COMFL   NUMBER TO SKIP
        SE,H2   A15,FLDJ,*B11
        J       *CHJ                                                       CSC24
        TNZ,S3 FLDJ-1,B11                                               FLDSGN
        J      $+3                                                      FLDSGN
        TNZ    FLDSEX        FLAG FOR SIGN EXTENSION                    FLDSGN
        J      *CHJ                                                     FLDSGN
        SR,S6   R4,MINTX+056        SET BIT SO FLD CAN NOT BE COMMON EXP   CSC24
        J       *CHJ
FJ      FORM    18,9,9                                                     CSC24
FLDJ   .  FIELD SPECIFICATIONS WHICH ARE J DESIGNATIONS
        FJ     1,0,12          THIRD WORDS ACCEPTED                     FLDSGN
        FJ     1,12,12             NEGATIVE SIGN EXTERNSION             FLDSGN
        FJ     1,24,12                                                  FLDSGN
        FJ      0,0,36                  0                                  CSC24
        FJ      0,18,18                 1                                  CSC24
        FJ      0,0,18                  2                                  CSC24
        FJ      0,30,6                  8                                  CSC24
        FJ      0,24,6                  9                                  CSC24
        FJ      0,18,6                  10                                 CSC24
        FJ      0,12,6                  11                                 CSC24
        FJ      0,6,6                   12                                 CSC24
        FJ      0,0,6                   13                                 CSC24
FLDJQ   FJ      0,0,9
        FJ      0,9,9
        FJ      0,18,9
        FJ      0,27,9
CHEXR   S      A5,COPND2                                                REENT
          L        A0,A5
          SSL      A0,30
          TNE,M    A0,3               SKIP ABS OF CONSTANT
          J        *CHEX
        MVW     (070000,0) COPND1
        MVW     (0102000,0102) COPER    ABS OPERATOR IS INSERTED TO
        IFL    FNC  1
        L      A0,FNC
        SZ,H2  COPER
        SZ     FNX,A0
        SR,S1  R4,FNX,A0
        SR,S3  R4,FNX,A0
        L      A1,(020054550100)
        S      A1,INTRX,A0
        LMJ     B11,CHTS+1
        NOP
        J       *CHEX
FORMSR  MVW    (0101200,0) COPER                                        REENT
        JNE     A15,COPND1,0,S1 5 $+6 MARK EXPRESSION AS BEING READ
        L       A0,COPND1    POLISH
        S       A0,FL30
        LMJ     B11,ITVSX+1
        JNE     A15,COPND2,0,S1 5 $+6
        L       A0,COPND2
        S       A0,FL30
        LMJ     B11,ITVSX+1
        J       *FORMSM
CHCOL* .
.   THIS SECTION PROCESSES THE COLON FOR THE SUBSTRING OPERATOR
.         SLJ       TON$
          SZ        FL30                . USED AS PARAMETER WORD TP N3ISF
          SZ        CHARG6             . HOLDS PRODUCT OF SUBSCRIPT AND LENGTH
          SZ        CHARG7             . HOLDS PRODUCT OF OFFSET AND LENGTH
          L,M       A0,1                . GET FIRST ARGUMENT
          S,T3      A0,FL30             . ARG 1 DEFINES CHARACTER IDENTIFIER
          LMJ       B11,SFDP1           . GET CHARACTER IDENTIFIER
          S         A4,CHARG1
          SZ        FL30
          L,M       A0,2
          S,T3      A0,FL30            .  ARG 2 DEFINES LOC OF CHARACTER PACKETE
          LMJ       B11,SFDP1           . GET LOC OF CHARACTER PACKETN
          S         A4,CHARG2
          SZ        FL30
          L,M       A0,3
          S,T3      A0,FL30            ARG 3 DEFINES FIRST CHARACTER POSISTIONN
          LMJ       B11,SFDP1           . GET FIRST CHARACTER POSISTION
          S         A4,CHARG3
          SZ        FL30
          L,M       A0,4
          S,T3      A0,FL30            . ARG 4 DEFINES LAST CHARACTER POA?SISTIO
          LMJ       B11,SFDP1           . GET LAST CHARACTER POSISTION
          S         A4,CHARG4           . LAST CHARACTER POSISTION
          L         B6,FNC              . LOAD CURRENT FUNCTION LEVEL
          AN,M      B6,1
          L,M       A0,4                . TOTAL NUMBER OF ARGUMENTS
          S         A0,FL30
          LMJ       B11,SFNDC           . DEASSIGN SPACE FOR ARGS
          L         A4,CHARG1           . CHARACTER IDENTIFIER
          L,S1      A0,CHARG1
          TNE,M     A0,2
          J         CHCOLA              . CHARACTER IDENT LOCATION
          TE,M      A0,5
          SLJ       XERV
          SXLOC     A3 CHARG1           . GET EXPRESSION ADDRESS
          L,S6      A0,0,A3             . OPERATION IN NODE EXPRESSION
          TNE,M     A0,020              . A CHARACTER FUNCTION ??
          J         CHCOLA
          TNE,M     A0,023              . TEST FOR OFFSET ONLY SUBSCRIPT
          J         CHCOLB              . HAVE ITEM REPRESENTING CHARACTER IDENT
          TE,M      A0,017              . TEST FOR FULL SUBSCRIPT
          SLJ       XERV                . IMPOSSIBLE
          S         A3,SVA3             . TEMPORARY SAVE OF A3
          SXLOC     A3  0,A3,T2         . LOCATION OF SUBSCRIPT EXPRESSION
          L,M       B1,CHTDFX           . LOCATION TO REFORM EXPRESSION
          S         B1,CHTFLG           . PREVENT PERMUTATION IN SIGNS
          LMJ       B10,SXT            . REFORM THE EXPRESSION
          SLJ       UPSL
          L         A4,CHTDFX+2
          S         A4,COPND1           . VALUE OF SUBSCRIPT
          L,S1      A4,CHTDFX+2
          TE,M      A4,5                . TEST FOR EXPRESSION
          J         CHCOLM
          SXLOC     A3 CHTDFX+2
          LMJ       B11,ITVSY           . SET FLAGS FOR USE OUT OF SUBSCRIPT
CHCOLM
          L         A0,CHARG2           . LOCATION OF CHARACTER PACKET
          L         A4,1,A0             . LENGTH
          S         A4,COPND2
          L         A4,(0101400,0)
          S         A4,COPER
          LMJ       B11,CHTS+1          . FORM RESULT
          NOP       .
          S         A5,CHARG6           . ITEM REPRESENTING RESULT
          S         A5,CHARG7           . IN CASE OFFSET ONLY FOR LISTING
          SLJ       LWSL
          L,S1      A0,CHTDFX+2
          TE,M      A0,5
          J         CHCOLR
          L,S1      A0,CHARG6
          TE,M      A0,5
          J         CHCOLR
          SXLOC  A0 CHTDFX+2
          SXLOC  A3 CHARG6
          L,S4      A1,3,A0             . MOVE TO DEFINITION POINT BIT
          AND,M     A1,010
          L         A1,A2
          OR,S4     A1,3,A3             . SET INTO RESULT EXPRESSION
          S,S4      A2,3,A3
CHCOLR  .
          L         A3,SVA3
          SXLOC     A3 0,A3,T1          . GET EXPRESSION NUMBER
CHCOLB  .   REFORM EXPRESSION CONTAINING OFFSET OPERATOR
          L,M       B1,CHTDFX           . LOCATION TO REFORM TRIAD
          S         B1,CHTFLG           . PREVENT PERMUTION IN SIGNS
          LMJ       B10,SXT             . DO THE REFORM
          L,S2      A0,CHTDFX           . OPERATION SUBCODE
          L,M       A1,040
          TEP,S6    A1,CHTDFX           . TEST IF OFFSET ONLY FOR LISTING
          J         CHCOLC
          TE,M      A0,023
          J         CHCOLC
          SLJ       UPSL
          L         A4,CHTDFX+1         . OFFSET ITEM
          S         A4,COPND1
          L,M       A4,3                . ID FOR CONSTANT
          S,S1      A4,COPND1           . CONVERT OFFSET TO CONSTANT_
          L         A0,CHARG2           . LOC OF CHARACTER PACKET
          L         A4,1,A0             . LENGTH
          S         A4,COPND2
          L         A4,(0101400,0)
          S         A4,COPER
          LMJ       B11,CHTS+1          . FORM PRODUCT
          NOP       .
          S         A5,CHARG7
          SLJ       LWSL
          TNZ       CHARG6              . TEST FOR SUBSCRIPT RESULT
          J         CHCOLC
          SLJ       UPSL
          L         A4,CHARG6           . PRODUCT OF LENGTH AND SUBSCRIPT
          S         A4,COPND1
          L         A4,CHARG7           . PRODUCT OF OFFSET AND LENGTH
          S         A4,COPND2
          L         A4,(0101200,0)
          S         A4,COPER
          LMJ       B11,CHTS+1          . FORM PRODUCT
          NOP       .
          S         A5,CHARG7
          SLJ       LWSL
CHCOLC
          L,S1      A4,CHARG7           . TEST FOR EXPRESSION
          TE,M      A4,5
          J         CHCOLG
          L,M       A15,2               . GEIVE EXPRESSION AN EXTRA USE TO HOLD
          SXLOC     A3 CHARG7
          SLJ       CNTJ
CHCOLG    L         A4,CHTDFX+2         . BASIC CHARACTER IDENTIFIER
          SZ        CHTFLG
CHCOLA    S         A4,CHARG5
          SLJ       UPSL
          L         A0,CHARG2          . LOC OF CHARACTER PACKET
          L,H2      A2,0,A0             . GET OFFSET FOR START OF CHARACTER STRI
          A         A2,(030100,0)       . FORM CONSTANT ITEM
          S         A2,COPND1
          L         A4,CHARG3           . FIRST CHARACTER POSISTION
          S         A4,COPND2
          L         A4,(0101200,0)      . PLUS OPERATOR
          S         A4,COPER
          LMJ       B11,CHTS+1          . CHANGE SUM TO ITEM
          NOP
          S         A5,CHARG3           . STORE CORRECTED SUM
          TNZ       CHARG7              . TEST FOR SUBSCRIPT TO ADD
          J         CHCOLE
          S         A5,COPND1
          L         A4,CHARG7
          S         A4,COPND2
          L         A4,(0101200,0)
          LMJ       B11,CHTS+1
          NOP       .
          S         A5,CHARG3
CHCOLE  .
          L         A0,CHARG2           . LOC OF CHARACTER PACKET
          L,H2      A2,0,A0             . GET OFFSET FOR START OF CHARACTER STRI
          A         A2,(030100,0)       . FORM CONSTANT ITEM
          S         A2,COPND1
          L         A4,CHARG4           . LAST CHARACTER POSITION
          S         A4,COPND2
          L         A4,(0101200,0)      . PLUS OPERATOR
          S         A4,COPER
          LMJ       B11,CHTS+1          . CHANGE SUM TO ITEM
          NOP
          S         A5,CHARG4           . STORE CORRECTED SUM
          TNZ       CHARG7
          J         CHCOLF
          S         A5,COPND1
          L         A4,CHARG7
          S         A4,COPND2
          L         A4,(0101200,0)
          S         A4,COPER
          LMJ       B11,CHTS+1
          NOP       .
          S         A5,CHARG4
CHCOLF
          L,S1      A4,CHARG7
          TE,M      A4,5
          J         CHCOLJ
          SXLOC     A3 CHARG7
          LN,M      A15,1               . REMOVE EXTRA USE
          SLJ       CNTJ
CHCOLJ    L,S1      A4,CHARG1
          TZ        CHARG7              . TEST IF ORIGINAL EXPRESSION REPLACED
          TE,M      A4,5                . TEST FOR EXPRESSION
          J         CHCOLK
          SXLOC     A3 CHARG1
          LN,M      A15,1               . REDUCE USES BY ONE
          SLJ       CNTJ
          L         A0,CHARG1
          LMJ       B11,DEL+1           . THROW AWAY EXPRESSION
CHCOLK
          MVW       CHARG3 COPND1       . FIRT CHARACTER POSISTION
          MVW       CHARG4 COPND2       . SECOND CHARACTER POSITION
          L         B6,FNC              . CURRENT FUNCTION LEVEL
          L,S6      A0,SFDPX,B6         . TYPE OF COMMA
          A         A0,(0102100,0)      . 014 LEFT OF =, 015 RIGHT
          S         A0,COPER
          LMJ       B9,TSEX             . FORM FIRST EXPRESSION
          MVW       SUBNO COPND1
          MVW       CHARG2 COPND2       . LOC OF CHARACTER PACKET
          L,M       A0,2
          S,S1      A0,COPND2           . CHANGE TYPE TO VARIABLE
          L         B6,FNC              . CURRENT FUNCTION LEVEL
          L,S6      A0,SFDPX,B6         . TYPE OF COMMA
          A         A0,(0102100,0)      . 014 LEFT OF =, O15 RIGHT
          S         A0,COPER
          S         A0,CHPXFL           . FLAG FOR CHARACTER PACKET ADDRESS
          LMJ       B9,TSEX             . FORM SECOND EXPRESSION
          SZ        CHPXFL
          MVW       SUBNO COPND1
          MVW       CHARG5 COPND2       . IDENTIFIER REPRESENTING STRING
          L         B6,FNC              . CURRENT FUNCTION LEVEL
          L,S6      A0,SFDPX,B6         . TYPE OF COMMA
          A         A0,(0102100,0) 014 LEFT OF =, 015 RIGHT
          S         A0,COPER
          LMJ       B9,TSEX
          L         A5,SUBNO
          SLJ       LWSL                . RESTORE ORIGINAL PARAMETERS
          S         A5,A0
          S         A5,COPND2
          MVW       (070000,0) COPND1   . SET NAME OF FUNCTION TO DUMMY
          J         ROTSA               . RETURN TO PICK UP MORE POLISH
$(2)
CHARG1    +0                            . NAME OF CHARACTER IDENTIFIER
CHARG2    +0        . LOC OF CHARACTER PACKET
CHARG3    +0        FIRST CHARACTER POSISTION
CHARG4    +0                            . LAST CHARACTER POSISTION
CHARG5    +0        . PRIMITIVE REPRESENTING CHARACTER IDENT
CHARG6    +0        . HOLDS PRODUCT OF SUBSCRIPT AND LENGTH
CHARG7    +0        . HOLDS PRODUCT OF OFFSET AND LENGTH
SVA3      +0        . TEMPOARARY SAVE OF A3
CHEX    J      $-$                                                      REENT
        J      CHEXR                                                    REENT
CHJ     J      $-$                                                      REENT
        J      CHJR                                                     REENT
FORMSM  J      $-$                                                      REENT
        J      FORMSR                                                   REENT
FLDC1   +0      USED FOR TEMP STORAGE
FLDC2   +0    USED FOR TEMP STORAGE
FLDSEX  +0       NON ZERO FOR SIGN EXTESNION                            SGNFLD
        END