         SYSTEM   SIG7FDP
*        SUBROUTINE TO READ EXPRESSION CLUSTERS FROM CRF.
*        THIS ROUTINE USED AFTER THE FIRST OPERAND OF THE EXPRESSION
*        ALREADY HAS BEEN READ (AND IS POINTED TO BY R4,R5).
*          LINKAGE
*          R3   HA OF NEXT AVAILABLE WORK STORAGE
*          R2   HA OF NEXT CLUSTER (NOT YET READ)
*        AT ALTERNATE ENTRY:
*          IF 0 - READ NEXT CLUSTER
*          IF NOT EQUAL TO 0 MOVE DATA FROM R2
*          R4   HA OF CURRENT CLUSTER (ALREADY READ)
*        NON EXISTANT ON ALTERNATE ENTRY
*          R5 IS R4-1
*        NON EXISTANT ON ALTERNATE ENTRY
*          BAL,11   ADE00      (FOR COMPUTE)      ADEX2 (FOR IF)
*          +1 INVALID DATA OR INVALID EXPRESSION
*          +2 VALID DATA,NUMBER,OR EXPRESSION
*
*
*        EXPOUT     ROUTINE TO OUTPUT THE TRIPLETS BELONGING TO AN
*        EXPRESSION. EACH OPERATION IS OUTPUT ON MCF AS A SERIES OF
*        THREE CLUSTERS, THE OP1 CLUSTER, THE OP2 CLUSTER, AND THE
*        INTERMEDIATE RESULT CLUSTER. THE OPERATION APPEARS WITHIN THE
*        INTERMEDIATE RESULT CLUSTER.
*        THE CONTROL BYTE (SECOND BYTE OF EACH CLUSTER) IS CODED
*             BITS 1-4   8-  =  DATA ITEM
*                        9-  =  NUMERIC LITERAL
*                        A-  =  INTERMEDIATE RESULT IN REGISTER OR
*                               TEMPORARY STORAGE (INDICATED BY NON ZERO
*                               DISPLACEMENT)
*                        B-  =  FINAL RESULT (IN REGISTER) AND LAST
*                               CLUSTER OF EXPRESSION
*
*             FIFTH BIT  -0  =  INTERMEDIATE RESULT CLUSTER (LAST
*             (WHEN FIRST       CLUSTER OF TRIPLET-ALSO CONTAINS THE
*              4 BITS = A       OPERATION - PRECEDED BY OP1 AND OP2
*              ONLY)            CLUSTERS)
*                        -8  =  AN OPERAND (INTERMEDIATE RESULT OF A
*                               PREVIOUS ARITHMETIC OPERATION) RATHER
*                               THAN AN INTERMEDIATE RESULT CLUSTER
*        A 1 BIT AS THE HIGH ORDER BIT OF BYTE 3 INDICATES CHANGE
*        SIGN WHEN USED AS AN OPERAND
*
*             BITS 6-8   -0  =  PACKED DECIMAL
*                        -5  =  BINARY INTEGER
*                        -6  =  FLOATING SINGLE
*                        -7  =  FLOATING DOUBLE
*        LINKAGE - R3 POINTS TO HA OF AVAILABLE WORK STORAGE + 1
*                  R5 POINTS TO THE RESULT CLUSTER (WHICH IN TURN LINKS
*                               TO THE START OF THE EXPRESSIONS)
*                 BAL,11  EXPOUT
*
*
         DEF      ADEX2,EXPOUT
         DEF      ADE00
         DEF      PRIMODE
         DEF      OP1                                                   COBOL41M
         REF      MTPLRST
         REF    ADI00,AAC00,PDBP,PH41E,DIAG,JADAT
JDECP    EQU      JADAT+4
         REF      WRMCF,GTMP,RUSAG
         REF      ADV00
DTBA     EQU      144
*
*        ALT ENTRY:
ADE00    STW,11   ADEXIT
*        THE ENTRY POINT ADE00 IS USED FOR THE COMPUTE VERB. THE CLUSTER
*        REPRESENTING = HAS JUST BEEN READ, BUT NO ATTEMPT HAS BEEN MADE
*        TO READ ANY OF THE ELEMENTS OF THE EXPRESSION. JDECP CONTAINS THE
*        NUMBER OF DECIMAL POSITIONS DESIRED IN THE RESULT. IT IS EQUIVALENT
*        TO IBM'S DMAX. ADE00 WILL READ ONE CLUSTER USING ADI00 IN ORDER TO
*        PLACE THIS ENTRY POINT ON EQUIVALENT BASIS TO ADEX2 WHICH ASSUMES
*        THAT ONE OPERAND HAS ALREADY BEEN READ.
         LW,10    JDECP
         STW,10   DMAX
         LW,10    RUSAG
         STW,10   RRUSAG
         LI,10    0
         STW,10   ERRORS
         LI,11    ONEREAD
READ     STW,11   SCANXIT
         LI,10    X'80008'
         BAL,11   ADI00
*        INVALID DATA.  FORMULA DELETED
         B        IDFD
         B        *SCANXIT
*        MNEMONIC OR CONDITION NAME IS FOUND. FORMULA DELETED.
         LI,1     193
BALERR   BAL,11   ERR
SKIPBA   LH,13    0,2
         AND,13   BIT80
         BCS,2    *ADEXIT
         LI,2     0
         BAL,11   AAC00
         B        SKIPBA
IDFD     LI,1     192
         B        BALERR
ADEX2    STW,11   ADEXIT
*        THE ENTRY POINT ADEX2 IS USED FOR ARITHMETIC EXPRESSIONS IN THE
*        CONDITIONAL STATEMENTS IF, WHEN, AND PERFORM. IT IS ASSUMED THAT
*        THE FIRST OPERAND OF THE EXPRESSION HAS ALREADY BEEN READ, AND IT
*        IS POINTED TO BY A HALF-WORD ADDRESS IN REGISTER 4, AND THAT REGISTER
*        5 CONTAINS REGISTER 4-1. DMAX IS SET TO -1000 TO CREATE THE SAME
*        EFFECT AS IF NO DECIMAL POINT POSITION WERE GIVEN FOR THE RESULT.
         LI,11    -1000
         STW,11   DMAX
         LI,11    0
*    ZERO IS STORED IN RRUSAG  BECAUSE THIS STORAGE WORD IS USED        COBOL41M
*    BY COMPUTE TO FORCE A USAGE AND IT IS NOT RESET TO ZERO. IT IS     COBOL41M
*    NEVER DESIRED TO FORCE A USAGE IN THE CONDITIONAL STATEMENTS.      COBOL41M
         STW,11   RRUSAG                                                COBOL41M
         STW,11   ERRORS
ONEREAD  LI,11    0
*        THE FOLLOWING FIELDS ARE INITIALIZED EACH TIME THE EXPRESSION
*        ANALYSIS ROUTINE IS ENTERED. SIZER, WHICH INDICATES WHETHER OR NOT
*        AN ON-SIZE-ERROR STATEMENT EXISTS FOR THE EXPRESSION. ERRORS,
*        WHICH INDICATES WHETHER OR NOT THE EXPRESSION SO FAR IS CLEAN SO
*        THAT MULTIPLE ERROR COMMENTS ARE AVOIDED AFTER THE FIRST ERROR
*        COMMENT. OPRATRS IS A COUNT OF THE NUMBER OF ARITHMETIC OPERATORS
*        EXCLUDING UNARY OPERATORS. IF THE EXPRESSION IS CORRECT, THERE
*        WILL AT ALL TIMES DURING THE EXPRESSION ANALYSIS BE FEWER OPERATORS
*        THAN OPERANDS, AND AT THE END OF THE EXPRESSION ANALYSIS THE DIFFERENCE
*        WILL BE ONE. ENDFLAG, IF SET NON-ZERO, INDICATES THAT A CLUSTER
*        INDICATING IT IS THE LAST OPERAND IN A STATEMENT HAS BEEN RECEIVED.
*        AFTER THIS CLUSTER, ONLY ARITHMETIC OPERATORS ARE ALLOWED.
*        EXSTRNG IS A POINTER TO THE FIRST OPERAND OF AN EXPRESSION. ALL OF
*        THE ELEMENTS OF AN EXPRESSION ARE STRUNG TOGETHER USING HALF-WORD
*        DISPLACEMENTS TO DO THE LINKING. THE END OF AN EXPRESSION IS
*        INDICATED BY A 2 HALF-WORD CLUSTER CONTAINING ZERO WHERE THE
*        ARITHMETIC OPERATOR WOULD APPEAR. IT IS NECESSARY TO SAVE THE
*        LOCATION OF THE FIRST ELEMENT SO THAT A RESCAN LATER OF THE
*        EXPRESSION MAY BE ACCOMPLISHED. OPRANDS IS A COUNT OF THE NUMBER OF
*        OPERANDS COMPOSING THE ARITHMETIC EXPRESSION. AN OPERAND IS EITHER
*        A NUMERIC LITERAL OR A DATA ITEM.
         STW,11   SIZER
         STW,11   OPRATRS
         STW,11   ENDFLAG
         STW,5    EXSTRNG
         STW,11   OPRANDS
         LH,13    0,2
         LS,13    LOBYTE            GET STATEMENT TYPE
*        A CHECK IS MADE AT THIS POINT TO DETERMINE THAT THE ARITHMETIC
*        EXPRESSION ANALYZER IS PROCESSING ONLY CLUSTERS OF A STATEMENT TYPE
*        WHICH MAY LEGITIMATELY CONTAIN ARITHMETIC EXPRESSIONS. THE
*        STATEMENT TYPE BEING PROCESSED IS REMEMBERED IN STTYPE SO THAT
*        AS SOON AS A NEW STATEMENT APPEARS, AS SIGNIFIED BY A DIFFERENT
*        STATEMENT TYPE OR AT LEAST THE ADDITION OF A LEAD BIT TO THE
*        STATEMENT TYPE, THE PROCESSING MAY BE CONCLUDED. OF SIGNIFICANCE
*        IS THE EXCEPTIONAL CASE WHERE A COMPUTE STATEMENT IS FOLLOWED BY
*        AN ON-SIZE-ERROR STATEMENT. IN THIS CASE THE STATEMENT TYPE, 54,
*        DOES NOT CHANGE, BUT THE STATEMENT OPTION INDICATES THE END OF THE
*        EXPRESSION.
         STW,13   STTYPE
         CI,13    X'54'
         BCS,3    CI5C
         BAL,11   L1F2
         LH,15    0,1
         SAS,15   -12
         CI,15    X'FFFFE'
         BCS,3    TSTNXT
         STW,15   SIZER
         B        STTT
CI5C     CI,13    X'5C'
         BCR,3    TSTNXT            IF STATEMENT
         CI,13    X'61'
         BCR,3    TSTNXT            PERFORM STATEMENT
         CI,13    X'71'
         BCR,3    TSTNXT               WHEN
STTT     STW,2    STTYPE
         LW,13    OPRANDS
         BCR,3    TSTNXT2
GOBACK   LI,1     1
         B        *ADEXIT,1
TSTNXT2  LI,2     HA(TSTNXT2)
*        TSTNXT IS THE BEGINNING OF THE MAIN LOOP IN THIS PROGRAM. LASTOP
*        IS MADE TO CONTAIN THE LOCATION OF THE PREVIOUS STORED CLUSTER
*        SO THAT LATER ON A LINK MAY BE PLACED IN THE ADDRESS INDICATED BY
*        LASTOP. EACH TIME THROUGH THE LOOP THE CONTROL BYTE IS CHECKED,
*        FIRST TO SEE IF A NEW STATEMENT TYPE IS ENCOUNTERED, AND SECOND
*        TO SEE IF THE STATEMENT OPTION IS INDEED AN ARITHMETIC OPERATOR.
*        IF THE STATEMENT OPTION INDICATES A RELATIONAL OPERATOR OR A
*        LOGICAL CONNECTOR, THE ARITHMETIC EXPRESSION IS TERMINATED AND
*        IS ASSUMED TO BE PART OF A RELATIONAL OR LOGICAL EXPRESSION.
TSTNXT   STW,5    LASTOP            SAVE FOR LOC OF PREVIOUS OPERAND
         BAL,11   L1F2
         LH,13    0,2               LOAD CONTROL BYTE
         LS,13    LOBYTE
         BCR,3    LINNO             LINE NUMBER CLUSTER
         CW,13    STTYPE
         BCS,3    NEWSTMT           CLUSTER HAS DIVVERENT CONTROL BYTE
*                                   OR IN NEW STATEMENT
         LH,15        0,1
         SAS,15   -12
         CI,15    1
*        THE ROUTINE BRANCHES AT THIS POINT BASED ON WHETHER AN ARITHMETIC
*        OPERATOR OR AN OPERAND HAS BEEN ENCOUNTERED.
         BCR,3    OPRTOR            OPERATOR
         CI,15    X'FFFF9'
         BCR,3    OPRAND            DATA OPERAND
         CI,15    X'FFFFC'
         BCR,3    OPRAND
         CI,15     X'FFFFE'
         BCR,3    SIZER2
         LW,15    STTYPE
         CI,15    X'54'
         BCS,3    NEWSTM2
*        INVALID DATA. FORMULA DELETED
         LI,1     192
         BAL,11   ERR
         B        *ADEXIT
SIZER2   STW,15   SIZER
         B        NEWSTM2
OPRAND   RES      0
*        THE NUMBER OF OPERANDS IS COUNTED IN ORDER TO MAKE CERTAIN THAT
*        THE EXPRESSION IS LEGITIMATE IN STRUCTURE.
         MTW,1    OPRANDS
*        SEE IF 'NO MORE OPERANDS' FLAG IS SET.
         LW,15    ENDFLAG
*        THE LAST OPERAND FLAG IS DETECTED ALSO TO MAKE CERTAIN THE
*        EXPRESSION IS LEGITIMATE IN FORM.
         BCR,3    LH15
         LI,1     194
         BAL,11   ERR
*        PREMATURE LAST DATA REF. FORMULA DELETED
LH15     LH,15    0,1
         LS,15    LASTOPB
         STW,15   ENDFLAG           SET 'NO MORE OPERANDS'
*        READ THE NEXT OPERAND TO THE STRING STORAGE
*        THE PROGRAM USING REGISTER 2 HAS JUST LOOKED AHEAD AT THE NEXT
*        CLUSTER AND DETERMINED THAT IT IS AN OPERAND CLUSTER. A CALL
*        WILL NOW BE MADE TO READ WHICH USES ADI00 IN ORDER TO BRING THAT
*        CLUSTER INTO CORE MEMORY WHERE IT CAN BE SAVED. THEN CONTROL
*        WILL GO TO LINK2 SO THAT THE PREVIOUS CLUSTER IN THE EXPRESSION STRING
*        MAY BE LINKED TO THE NEW CLUSTER. AFTER THIS CONTROL RETURNS TO
*        TSTNXT TO REPEAT THE PROCESS ON THE NEXT OPERAND OR OPERATOR.
READOP   LI,11    LINK2
         B        READ
LINK2    LI,11    TSTNXT
LINK     LW,1     LASTOP            LOC OF PREVIOUS OPERAND
         LCW,15   1
         AW,15    5
         STH,15   0,1               SET LINK IN PREVIOUS OPERAND
         B        *11
OPRTOR   LH,14    0,1
         SLS,14   -8
*        A TEST IS MADE HERE TO DETERMINE THAT THE NUMBER OF OPERANDS SO
*        FAR PROCESSED IS GREATER THAN THE NUMBER OF OPERATORS WITH THE
*        EXCLUSION OF UNARY OPERATORS.
         CI,14    X'15'             UNARY MINUS
         BCR,3    DONTADD
         MTW,1    OPRATRS
DONTADD  LW,15    OPRANDS
         CW,15    OPRATRS
         BCR,1    BALID
         LI,1     195
         BAL,11   ERR
*        MORE OPERATORS THAN OPERANDS. FORMULA DELETED.
BALID    BAL,10   STOP
*        THE ROUTINE STOP, MEANING STORE OPERATOR CLUSTER, COMPOSES A
*        CLUSTER REPRESENTING THE ARITHMETIC OPERATOR AND LINKS IT INTO
*        THE EXPRESSION STRING. THEN AT BALAAC, THE INPUT CLUSTER REPRESENTING
*        THE ARITHMETIC OPERATION IS PASSED OVER IN ORDER TO GET AT THE NEXT
*        TERM OF THE EXPRESSION.
BALAAC   LI,2     0
         BAL,11   AAC00
         B        TSTNXT
*        THE FOLLOWING 7 LINES OF CODE ARE HERE TO INTERCEPT A LINE NUMBER
*        CLUSTER IF IT SHOULD APPEAR. IT IS MY UNDERSTANDING THAT THE LINE
*        NUMBER CLUSTER WILL NOT BE VISIBLE VIA THE READ ROUTINES USED, AND
*        POSSIBLY THIS CODE MAY BE ELIMINATED.
LINNO    LH,15    1,2
         STW,15   LINENUM
         AI,2     1
         LH,15    0,2
         STH,15   LINENUM
         B        BALAAC
*        THE CODE BEGINNING AT NEWSTMT IS ENTERED WHEN THE END OF AN
*        EXPRESSION IS DETECTED. CHECKS ARE FIRST MADE TO VERIFY THE
*        LEGITIMACY OF THE EXPRESSION FORMAT. AT NEWSTM2, A CHECK IS MADE TO
*        DETERMINE IF THE EXPRESSION CONSISTS OF ONLY ONE OPERAND IN WHICH IT
*        IS EQUIVALENT IN A COMPUTE STATEMENT TO A MOVE OPERATION. IN THIS
*        CASE, AN ARTIFICIAL UNARY OPERATOR, 16, REPRESENTING UNARY +, IS
*        CREATED. AT NEWSTM4, THE END OF EXPRESSION CLUSTER IS ADDED TO
*        THE EXPRESSION STRING.
NEWSTMT  CI,2     HA(TSTNXT2)
         BCS,3    NEWSTM3
         LW,2     STTYPE
         B        NEWSTM2
NEWSTM3  LW,13    LASTOPB
         BCR,3    ERROR1
NEWSTM2  LW,13    OPRATRS
         BCS,3    NEWSTM4
         LI,14    X'16'
         BAL,10   STOP
         STW,5    LASTOP
NEWSTM4  CW,13    OPRANDS
         BCR,3    SSV2
ERROR1   LI,1     195
         BAL,11   ERR
         B        *ADEXIT
*        MORE OPERATORS THAN OPERANDS. FORMULA DELETED.
SSV2     STW,2    SVR2
         LI,14    0
         BAL,10   STOP
*        CREATE RESULT CLUSTER AND RETURN
*        THE ROUTINE SCANX IS NOW CALLED. SCANX GOES THROUGH ALL OF THE
*        PROCESSING WHICH WOULD BE REQUIRED TO DETERMINE THE SIZE, POINT
*        LOCATION, AND USAGE OF EACH OF THE INTERMEDIATE RESULTS IN ORDER
*        TO FINALLY ARRIVE AT THE SIZE, DECIMAL POINT, AND USAGE OF THE FINAL
*        RESULT. DURING THIS PROCESSING, ONLY THE ACTUAL WRITING OF THE CODE
*        GENERATION CLUSTERS ON THE OUTPUT FILE MCF IS SUPPRESSED.
         BAL,11   SCANX
*        AT THIS POINT, THE RESULT CLUSTER IS COMPOSED SO THAT IT MAY BE
*        PRESENTED TO THE CALLING ROUTINE FOR FURTHER ANALYSIS. CERTAIN
*        INFORMATION MUST BE PRESERVED WITHIN THIS RESULT CLUSTER SO THAT AFTER
*        THE CALLING ROUTINE HAS DETERMINED WHAT IT WISHES TO DO WITH THE
*        EXPRESSION, THE EXPRESSION MAY BE REANALYZED, THIS TIME PRODUCING
*        THE GENERATED CODE.
         LW,4     3
         LW,5     4
         AI,5     -1
*        EXSTRNG MUST BE PRESERVED SO THAT THE BEGINNING OF THE EXPRESSION
*        STRING MAY BE FOUND WHEN ENTRY IS MADE TO EXPOUT.
         LW,15    EXSTRNG
         SW,15    5
         STH,15   5,5               STORE LINK TO EXPRESSION STRING
*        LINENUM WAS PRESERVED FOR DIAGNOSTIC PURPOSES, BUT I BELIEVE THE
*        LINE NUMBER IS NEVER PICKED UP, AND THEREFORE THIS FIELD IS VOID.
         LH,15    LINENUM
         STH,15   5,4
         LI,1     1
         LW,15    LINENUM
         STH,15   6,5
*        THE SIZE ERROR INDICATOR IS USED SO THAT IT MAY BE KNOWN WHETHER
*        OR NOT SIZE ERROR TESTS MUST BE MADE WHEN THE EXPRESSION IS
*        GENERATED.
         LW,15    SIZER
         STH,15   6,4
*        DMAX AS USED BY THE EXPRESSION THE FIRST TIME THROUGH IS PRESERVED
*        SO THAT THE SAME VALUE MAY BE USED IN STARTING THE ANALYSIS THE SECOND
*        TIME THE EXPRESSION IS ANALYZED.
         LW,15    DMAX
         STH,15   7,5
         AI,3     16
         LH,7     0,4
         LS,7     LO4
         LB,6     PRIORT,7
         LB,6     RR6,6
         S,6      16
         LH,7     0,4
         LS,7     AMASK
         OR,6     7
         LH,7     0,5
         LH,8     4,5
         LH,9     3,5
         LW,2     SVR2
         LW,15    ERRORS
         BCS,3    *ADEXIT
         B        *ADEXIT,1
STOP     LW,5     3
         AI,3     +1
         STH,14   0,3
         AI,3     +1
         BAL,11   LINK
         B        *10
L1F2     LI,1     1
         AW,1     2
         B        *11
*        ROUTINE TO STEP THROUGH THE EXPRESSION, SELECTING OPERANDS
*        AND ARITHMETIC OPERATORS IN THE ORDER THAT WILL BE
*        REQUIRED IN THE OBJECT PROGRAM.
*
*        ROUTINE EXPOUT RESCANS THE OPERANDS AND OPERATORS IN THE EXPRESSION
*        STRING WHICH ARE IN REVERSE POLISH NOTATION, CREATING A PUSHDOWN
*        STACK OF THE OPERANDS AS THEY ARE RECEIVED. EVERY TIME AN
*        ARITHMETIC OPERATOR IS RECEIVED, THE LAST 2 OPERANDS IN THE PUSHDOWN
*        STACK ARE USED AS OPERAND 1 AND OPERAND 2 IN A SIMPLE ARITHMETIC
*        EXPRESSION TO CREATE AN INTERMEDIATE RESULT. THE INTERMEDIATE
*        RESULT IS THEN PLACED IN THE PUSHDOWN LIST IN PLACE OF THE 2 OPERANDS
*        TAKEN FROM IT. THE INTERMEDIATE RESULT THUS MAY ACT AS ONE OF THE
*        OPERANDS OF A SUCCEEDING OPERATION.
EXPOUT   RES      0
         STW,11   SCANXIT
         STW,2    SAVV2
         LI,4     32
*        GTMP CONTAINS THE NUMBER OF BYTES SO FAR ASSIGNED BY THE COMPILER
*        FOR TEMPORARY STORAGE. THE OPERATION ANALYZER RESERVES SPACE
*        FOR STORAGE OF THE DECIMAL ACCUMULATOR TWICE, CREATING INITIALLY
*        2 TEMPORARY STORAGE LOCATIONS. PART OF THE DESIGN OF EXPOUT IS TO
*        DETERMINE WHETHER AN INTERMEDIATE RESULT MAY REMAIN IN THE REGISTERS
*        OR MUST BE SAVED IN TEMPORARY STORAGE. SOMETIMES THIS PREDICTION
*        IS NOT CORRECT, AND THE OUTPUT ROUTINE EXOUT WHICH IS DESIGNED TO
*        BE FOOLPROOF DETERMINES THAT IT MUST SAVE A RESULT IN ONE OR BOTH
*        OF THESE TEMPORARY LOCATIONS BEFORE IT CAN ACCOMPLISH CORRECTLY
*        ITS CODE GENERATION.
         CW,4     GTMP
         BCR,2    TOK
         STW,4    GTMP
TOK      LW,4     5
         AI,4     1
         LH,7     7,5
*        THE DECIMAL POINT DESIRED IN THE RESULT IS PICKED UP FROM THE RESULT
*        OF EXPRESSION CLUSTER PRESENTED TO EXPOUT SO THAT THIS TIME, THE
*        SECOND TIME THROUGH THE EXPRESSION ANALYSIS, THE SAME VALUE MAY
*        BE USED DURING THE INITIAL EXPRESSION ANALYSIS AT SCANX.
         STW,7    DMAX
*        THE RESULT OF EXPRESSION CLUSTER IS OUTPUT TO THE MCF FILE, TO
*        SERVE TO INTRODUCE THE EXPRESSION GENERATION AND ALSO TO INDICATE
*        THE DISPOSITION OF THE RESULT COMPUTED BY THE EXPRESSION GENERATION.
         BAL,10   OUT5
         AH,5     5,5
*        AT THIS POINT, THE BEGINNING OF THE SAVED ELEMENTS OF THE EXPRESSION
*        STRING IS RESTORED. IT IS EXPECTED THAT THESE SAVED ELEMENTS ARE
*        STILL IN MEMORY UNDISTURBED.
         STW,5    EXSTRNG
         LI,10    0
*        REGISTER 10 IS ZEROED TO INDICATE THAT THIS TIME THE OUTPUT IS TO
*        BE PRODUCED AND WRITTEN ON MCF.
         B        SCANX2
SCANX    STW,11   SCANXIT
SCANX2   STW,10   OUTFLG
         LW,0     RRUSAG
         STH,0    RRUSAG
         LI,0     0
*        THIS ROUTINE, BESIDES DETERMINING THE ELEMENTARY EXPRESSIONS
*        REQUIRED TO BUILD UP AN EXPRESSION, ALSO DETERMINES WHETHER OR
*        NOT INTERMEDIATE RESULTS REQUIRE TEMPORARY STORAGE. TO DO THIS,
*        THE ROUTINE MUST LOOK AHEAD AT THE NEXT ELEMENTARY EXPRESSION.
*        CONSEQUENTLY, THERE IS A LAG IN THE OUTPUT OF THE GENERATED CODE.
*        TFLAG, IF NONZERO, INDICATES THAT THERE IS AN ELEMENTARY OPERATION
*        WAITING BUT NOT YET OUTPUT. WHEN TFLAG IS NONZERO, IT CONTAINS A
*        HALF-WORD ADDRESS POINTER TO THE INTERMEDIATE RESULT. OP1 AND
*        OP2 CONTAIN HALF-WORD ADDRESS POINTERS TO THE OPERANDS, AND OPN
*        INDICATES THE ARITHMETIC EXPRESSION. ONCE THE CODE GENERATION HAS BEEN
*        OUTPUT TO MCF, TFLAG IS ZEROED.
         STW,0    TFLAG
         LI,5     DTBA+32
*        LASTEMP CONTAINS THE CURRENTLY ASSIGNED TEMPORARY STORAGE LOCATION.
*        IT IS INITIALIZED EACH TIME EXPOUT IS ENTERED TO THE FIRST LOCATION
*        BEYOND THOSE RESERVED AT LINE 227. AS TEMPORARY LOCATIONS ARE
*        ASSIGNED, LASTEMP IS INCREMENTED, AND AS TEMPORARY LOCATIONS ARE
*        RETURNED TO THE POOL, LASTEMP IS DECREMENTED. LASTEMP ALWAYS
*        POINTS TO A DOUBLE-WORD BOUNDARY. EACH TIME LASTEMP IS INCREMENTED,
*        A TEST IS MADE AGAINST GTMP TO DETERMINE IF MORE TEMPORARY SPACE
*        MUST BE RESERVED.
         STW,5    LASTEMP
         LW,5     EXSTRNG           HEAD OF OPERAND STRING (HA)
*        R3       POINTS WORK AREA
         AI,3     2
         SLS,3    -1
*        STEPOPR IS THE BEGINNING OF THE MAIN LOOP IN THIS PROGRAM. REGISTER 5
*        INITIALLY POINTS TO THE CLUSTER REPRESENTING THE FIRST ELEMENT IN
*        THE EXPRESSION IN REVERSE POLISH NOTATION. THE PUSHDOWN LIST OF
*        OPERANDS IS KEPT BY REGISTER 3. THE PUSHDOWN LIST CONTAINS ONLY A
*        HALF-WORD ADDRESS POINTING TO THE CLUSTER IF THE OPERAND IS A
*        LITERAL OR DATA ITEM. ON THE OTHER HAND, IF THE OPERAND IS AN
*        INTERMEDIATE RESULT, IT IS PLACED DIRECTLY IN THE PUSHDOWN LIST.
STEPOPR  LW,7     5
         S,7      1
         AI,7     3
         LB,1     0,7               CONTROL BYTE
*        THE CONTROL BYTE IS TESTED AND CONTROL BRANCHES DEPENDING UPON WHETHER
*        THE CONTROL BYTE INDICATES END OF EXPRESSION, ARITHMETIC OPERATOR,
*        OR AN OPERAND.
         BCS,3    SKOPRA
         BAL,12   STDOWN
         S,3      1                 END OF EXPRESSION
         BAL,10   XOUT
         LW,2     SAVV2
         B        *SCANXIT
*        SKIP THE NUMBER OF OPERANDS INDICATED BY R15 (COULD BE ZERO)
SKOPRA   CI,1     X'16'
         BCR,2    ARITH             EQUAL OR LESS
         LI,0     0
         STH,0    1,5
         LH,4     0,5
         AW,4     5
         S,4      1
         AI,4     3
         LB,4     0,4
         CI,4     X'15'
*        WHILE THE MAIN PURPOSE OF THIS BRANCH IS TO STACK THE OPERANDS IN
*        THE PUSHDOWN LIST, IT IS ALSO POSSIBLE TO DETERMINE AT THIS POINT THE
*        NEXT ELEMENTARY OPERATION REQUIRED IN THE EXPRESSION IF THE NEXT
*        ITEM IN THE REVERSE POLISH STRING, REGISTER 5, POINTS TO AN OPERAND,
*        THEN IT IS KNOWN THAT THE PREVIOUS INTERMEDIATE RESULT CANNOT
*        PARTICIPATE IN THE NEW ELEMENTARY OPERATION. THEREFORE, IT MUST
*        BE STORED IN TEMPORARY STORAGE. THE BRANCH IS TAKEN TO TRTMP2 TO
*        CAUSE ASSIGNMENT OF TEMPORARY STORAGE.
         BCS,2    TRTMP2
         LW,4     5
         AI,4     1
*        IF THE NEXT ELEMENT IS AN ARITHMETIC OPERATOR, THEN THE NEXT
*        ELEMENTARY OPERATION USES THE PREVIOUS INTERMEDIATE RESULT AS OP1.
*        THEREFORE, THE PREVIOUS INTERMEDIATE RESULT CAN REMAIN IN THE
*        REGISTERS PROVIDED THAT THE USAGE OF THE NEXT INTERMEDIATE RESULT
*        IS NOT DIFFERENT. THEREFORE, A TEST IS MADE OF THE USAGES OF THE
*        OPERANDS TO BE USED IN THE NEXT OPERATION. IF THEY ARE COMPATIBLE,
*        THEN RETURN FROM CCLASS SKIPS ONE INSTRUCTION, THUS AVOIDING THE
*        ASSIGNMENT OF TEMPORARY STORAGE.
         BAL,7    CCLASS
TRTMP2   BAL,9    TRTMP
*        THE ROUTINE XOUT OUTPUTS THE PREVIOUS ELEMENTARY OPERATION,
*        PROVIDED TFLAG IS NONZERO.
NOTEMP2  BAL,10   XOUT
*        THE NEXT 5 LINES ADD THE CURRENT OPERAND TO THE PUSHDOWN LIST AND
*        THEN STEP TO THE NEXT ELEMENT IN THE EXPRESSION INPUT.
NOTEMP   STW,5    0,3
         MTW,1    0,3
         AI,3     1
INCRX5   AH,5     0,5
         B        STEPOPR
TRTMP  LW,4    TFLAG
         BCR,3    *9
MAKTEMP  LH,7     0,4               CHANGE CONTROL BYTE FROM REG TO STOR
*        IF THERE IS A SERIES OF ADD OR SUBTRACT OPERATIONS, THE NUMBER OF
*        INTEGER POSITIONS OF THE LARGEST OPERAND IN THE SERIES IS KEPT IN
*        STMXADD SO THAT THE SIZE OF THE INTERMEDIATE RESULT CAN BE
*        OBTAINED FROM THIS AND THE NUMBER OF OVERFLOW DIGITS DETERMINED
*        FROM CARRY.
         LW,6     LASTEMP
       STH,6   2,4
         AI,6     8
*        EITHER 2 OR 4 WORDS ARE ASSIGNED FOR TEMPORARY STORAGE, DEPENDING
*        ON WHETHER OR NOT THE RESULT IS DECIMAL.
         LS,7     LO3
         BCS,3    SLAST
         AI,6     8
SLAST    STW,6    LASTEMP
         AI,6     -DTBA
*        A TEST IS MADE TO DETERMINE IF THE AMOUNT OF TEMPORARY STORAGE
*        AVAILABLE MUST BE INCREASED.
         CW,6     GTMP
         BCR,2    SLAST22
         STW,6    GTMP
SLAST22  LW,6     4
         LI,0     0
         STH,0    1,4
         AI,6     1
*        THE BASE REGISTER 6 INDICATES TEMPORARY STORAGE.
         LI,7     X'0600'
         STH,7    1,6
         B        *9
*        TFLAG POINTS TO IR
*        R4 POINTS TO OTHER OPERAND
*        THIS ROUTINE TESTS THE USAGES OF THE 2 OPERANDS TO BE USED IN THE
*        NEXT ELEMENTARY OPERATION. IF ONE OF THE OPERANDS USES A NUMERIC
*        LITERAL, THE OPERANDS AUTOMATICALLY ARE ASSUMED TO HAVE EQUAL
*        USAGES. IF THE USAGE IS DISPLAY NUMERIC, A RETURN IS MADE AS IF THE
*        USAGES WERE NOT EQUAL. THIS IS BECAUSE AT OBJECT TIME THE DISPLAY
*        NUMERIC FIELDS WOULD NEED TO BE LOADED AND CONVERTED BEFORE
*        THEY ARE USABLE FOR ARITHMETIC.
CCLASS   LW,6     TFLAG
         LH,11    0,4
         LS,11    HI4
         LH,13    0,4
         CI,11    X'90'
         BCS,3    CCL2
         LH,13    0,6
CCL2     LS,13    LO4
         LH,11    0,6
         LS,11    HI4
         CI,11    X'90'
         BCS,3    CCL3
         LH,11    0,4
         B        CCL4
CCL3     LH,11    0,6
CCL4     LS,11    LO4
         CW,11    13
         BCS,3    0,7
         CI,11    8
         BCS,1    0,7
         B        1,7
*        THIS BRANCH IS ENTERED WHEN AN ARITHMETIC OPERATOR IS ENCOUNTERED.
*        THE ARITHMETIC OPERATOR WILL USE AS OPERANDS THE LAST 2 CLUSTERS
*        IN THE PUSHDOWN STACK, BUT BEFORE WORKING ON THE NEW OPERATION,
*        IT IS NECESSARY TO DETERMINE WHETHER OR NOT TEMPORARY STORAGE
*        MUST BE ASSIGNED TO THE PREVIOUS OPERATION IF TFLAG IS STILL NONZERO.
*        THEREFORE, REGISTER 7 IS POINTED TO THE LAST OPERAND IN THE PUSHDOWN
*        LIST, REGISTER 4 IS POINTED TO THE NEXT LAST OPERAND.
ARITH    LW,6     3
         AI,6     -1
         LB,15    *6
         BCR,3    NOT6
         LW,15    *6
         LS,15    AMASK
         SW,6     15
         LW,7     6
        S,7       1
         B        NOT5
NOT6     LW,7     *6
NOT5     CI,1     X'15'
*        IF THE OPERATOR IS UNARY, ONLY ONE OPERAND IS NEEDED; THEREFORE
*        THIS BRANCH.
         BCR,1    NOT2
         LW,4     6
         AI,4     -1
         LB,15    *4
         BCR,3    NOT3
         LW,15    *4
         LS,15    AMASK
         SW,4     15
         S,4      1
         B        NOT2
NOT3     LW,4     *4
NOT2     CI,1     X'15'
         BCS,3    NOT4
*        AT THIS POINT, A UNARY - IS NO LONGER TREATED AS A SEPARATE OPERATION.
*        INSTEAD, A SINGLE BIT IS PLACED ON THE OPERAND TO INFORM THE CODE
*        GENERATION PROGRAMS IN XOUT THAT THE OPERAND IS TO BE PICKED UP
*        NEGATIVE.
         S,7      1
         AI,7     3
         LB,15    0,7
         EOR,15   LASTOPB
         STB,15   0,7
         B        INCRX5
NOT4     CI,1     X'13'
*        THE DIVIDE OPERATION REQUIRES SPECIAL TREATMENT BECAUSE AT CODE
*        GENERATION TIME IT IS POSSIBLE TO INTERCHANGE THE FIRST AND SECOND
*        OPERANDS.
         BCR,3    MKTMP
         CI,1     X'16'
         BCR,3    NOT
         BAL,7    CCLASS
MKTMP    BAL,9    TRTMP
NOT      BAL,10   XOUT
*        AT THIS POINT THE PREVIOUS OPERATION HAS BEEN OUTPUT SO THAT IT IS
*        POSSIBLE TO PROCEED WITH THE NEW OPERATION. THE ROUTINE STDOWN WILL
*        AGAIN DETERMINE THE LOCATION OF THE LAST OPERAND. IF THE LAST
*        OPERAND WAS AN INTERMEDIATE RESULT, IT IS SAVED BY SAVOP IN A
*        SEPARATE LOCATION SO THAT IT WILL NOT BE WIPED OUT BY A SUBSEQUENT
*        INTERMEDIATE RESULT. STDOWN ALSO WILL RETURN ANY TEMPORARY
*        STORAGE WHICH IT IS NOW THROUGH USING.
NOIR   BAL,12  STDOWN
         LI,11    OP22
         BAL,12   SAVOP
         STW,2    OP2
         STW,1    OPN
         CI,1     X'16'
*        THE UNARY + WHICH IS USED AS AN OPERATOR FOR SINGLE OPERAND EXPRESSIONS
*        REQUIRES ONLY ONE OPERAND. THEREFORE, THIS BRANCH SKIPS THE SECOND
*        OPERAND AND GOES IMMEDIATELY TO IR.
         BCR,3    GOIR              UNARY OPERAND REQUIRES ONLY ONE
*                                   ARGUMENT.
         BAL,12   STDOWN
         LI,11    OP11
         BAL,12   SAVOP
         STW,2    OP1
*        IR COMPUTES THE SIZE, POINT LOCATION, AND USAGE OF THE INTERMEDIATE
*        RESULT KNOWING THE SIZE, POINT LOCATION, AND USAGE OF THE OPERANDS
*        AND THE ARITHMETIC OPERATION WHICH IS TO BE PERFORMED.
GOIR     BAL,11   IR                PRODUCE INTERMEDIATE RESULT DESCRIPTO
         LW,2     3
         S,2      1
         STW,2    TFLAG
*        R AND MOVE IT TO WHERE R3 POINTS
*                                   INCREMENT 3
*        THE NEXT 4 INSTRUCTIONS SET UP THE INTERMEDIATE RESULT IN THE
*        PUSHDOWN STACK.
         AI,3     6
         LW,15    BACKSTP
         STW,15   -1,3
         B        INCRX5
OUT      LW,4     2
OUT3   LW,11   OUTFLG
         BCS,3    *10
OUT5     S,4      1
         BAL,11   WRMCF
         B        *10
*        THE SUBROUTINE SAVOP COPIES A CLUSTER REPRESENTING THE INTERMEDIATE
*        RESULT FROM THE PUSHDOWN STACK TO ANOTHER AREA SO THAT THE
*        CLUSTER WILL BE AVAILABLE AT THE TIME XOUT GENERATES CODE. IF THIS
*        WERE NOT DONE, THE NEXT INTERMEDIATE RESULT MAY ALREADY HAVE BEEN
*        OBLITERATED.
SAVOP    LH,7     0,2
         AND,7    HI4
         CI,7     X'A0'
         BCS,3    *12
         LW,2     11
         LW,7     0,3
         STW,7    0,2
         LW,7     1,3
         STW,7    1,2
         LW,7     2,3
         STW,7    2,2
         LW,7     3,3
         STW,7    3,2
         LW,7     4,3
         STW,7    4,2
         SLS,2    1
         B        *12
STDOWN   AI,3     -1
         LW,2     *3
         LB,15    *3
         BCR,3    OUT2
         LW,15    *3
         LS,15    AMASK
         SW,3     15
         LW,2     3
         S,2      1
         LW,1     1
*        THE ROUTINE STDOWN IS ALSO USED TO MAKE AVAILABLE THE FINAL RESULT.
*        THE BRANCH TO RSULT CHANGES THE CONTROL BYTE IN THAT CASE TO A B.
         BCR,3    RSULT
RETEMP   LH,6     1,2
         BCS,3    NOTMMP
         LW,6     LASTEMP
         AI,6     -8
         LH,7     0,2
         LS,7     LO3
*        EITHER 2 OR 4 WORDS ARE RETURNED TO TEMPORARY, DEPENDING UPON THE
*        USAGE OF THE DATA IN TEMPORARY.
         BCS,3    SLAST2
         AI,6     -8
SLAST2   STW,6    LASTEMP
NOTMMP   RES      0
OUT2     RES      0
         B        *12
RSULT    LH,15    0,2
         AI,15    X'0510'
         STH,15   0,2
         B        OUT2
*
*        IR       INTERMEDIATE RESULT ANALYZER
*        THIS ROUTINE DETERMINES THE SIZE, DECIMAL POSITION, AND USAGE
*        OF THE INTERMEDIATE RESULT, ACCORDING TO THE CHARACTERISTICS
*        OF THETWO OPERANDS POINTED TO BY OP1 AND OP2 AND THE NEEDS OF
*        THE OPERATION STORED IN R1.
*
*        LINKAGE  OP1 AND OP2 CONTAINS POINTERS
*                 R1 CONTAINS THE ARITHMETIC OPERATION
*                 R3 AND R5 MUST BE PRESERVED
*                 BAL,11     IR
*
*        THIS ROUTINE TAKES THE SIZE, POINT LOCATION, AND USAGE OF THE OPERANDS
*        OF AN INTERMEDIATE ARITHMETIC OPERATION AND FROM THEM COMPUTES
*        THE SIZE, POINT LOCATION, AND USAGE OF THE INTERMEDIATE RESULT.
IR       STW,11   IREXIT
         LCW,15   CARRY             COUNT THE NUMBER OF SUCCESSIVE
         CI,1     X'11'             ADD OPERATIONS IN CARRY.
         BCS,2    CCARRY
         LI,15    1
*        CARRY ACCUMULATES THE NUMBER OF SUCCESSIVE ADD OR SUBTRACT
*        OPERATIONS SO THAT IT IS KNOWN HOW MANY DIGITS MUST BE ALLOWED FOR
*        OVERFLOW.
CCARRY   AWM,15   CARRY
         AI,1     -16
         LW,6     3
         S,6      1
         AI,6     1
         LW,4     OP1
*        IN CASE ONE OF THE OPERANDS IS THE FIGURATIVE CONSTANT ZERO,
*        TZRLIT CREATES A NUMERIC LITERAL OF ZERO WITH SIZE = 1, POINT
*        LOCATION ZERO. SINCE THE ONLY REASONABLE USE OF THE FIGURATIVE
*        CONSTANT ZERO IS IN THE DEGENERATE EXPRESSION RESULT = ZERO, THIS
*        TREATMENT IS ENTIRELY SATISFACTORY.
         BAL,11   TZRLIT
         STW,4    OP1
         LW,2     OP1
         AI,2     1
         LW,4     OP2
         BAL,11   TZRLIT
         STW,4    OP2
         AI,4     1
*        AT THIS POINT THE ROUTINE BRANCHES DEPENDING UPON THE ARITHMETIC
*        OPERATION WHICH IS HELD IN REGISTER 1. EACH OF THE BRANCHES USES
*        R2 FOR OP1, R4 FOR OP2, AND PLACES THE NEW SIZE IN R14 AND THE NEW
*        DECIMAL POSITION IN R15.
         B        CMPSIZE,1
CMPSIZE  B        ADDSIZE           ADD
         B        ADDSIZE           SUBTRACT
         B        MULTSIZ           MULTIPLY
         B        DIVSIZE           DIVIDE
         B        EXPONEN           EXPONENTIATION
         B        UNARYMN           UNARY MINUS
         B        UNARYMN              EXPRESSION WITH ONE OPERAND
ADDSIZE  LH,14    2,2               I1 + D1
         SH,14    3,2               -D1
         LW,7     2
         BAL,13   TQ
         AI,14    -1
         LH,15    2,4               I2 + D2
         SH,15    3,4               -D2
         LW,7     4
         BAL,13   TQ
         AI,15    -1
         CW,14    15
         BCR,1    CKCARRY
         LW,14    15
CKCARRY  LW,13    CARRY             SEE IF THIS IS FIRST ADD
         CI,13    1
         BCR,3    STMXADD
NOTFADD  CW,14    MAXADD            NOT FIRST ADD-SAVE MAX I
         BCR,1    STMXADD
         LW,14    MAXADD
STMXADD  STW,14   MAXADD
         AI,14    1                 ADD ONE CARRY POSITION
         CI,13    10
         BCS,1    DP
         AI,14    1                 ADD SECOND CARRY POSITION
DP       LH,15    3,2
         CH,15    3,4
         BCR,1    MAXOK
*        D=MAX D1,D2.
         LH,15    3,4               D      OF RESULT
MAXOK    AW,14    15                I+D OF RESULT
*        I+D=D+STMXADD+1+1(IF CARRY IS GREATER THAN 9).
FINISH   BAL,11   TRUNCRL           TEST TRUNCATION RULES
FINISH2  BAL,11   USAGE             DETERMINE USAGE OF RESULT
FINISH3  STH,14   2,6               SIZE
*        THE FOLLOWING 13 LINES CREATE A CLUSTER REPRESENTING THE INTERMEDIATE
*        RESULT AND PLACES THE SIZE AND DECIMAL POSITION AND USAGE IN THAT
*        CLUSTER.
         STH,15   3,6               DECP
         LI,0     0
         STH,0    0,6
         LI,0     0
         STH,0    1,6
         AI,6     -1
         STH,10   1,6               REGISTER
         STH,12   3,6               NEW BYTE SIZE
         AI,13    X'0A00'
         STH,13   0,6               NEW USAGE
         STH,0    2,6               CLEAR
         STH,1    4,6               STORE OPERATION
         B        *IREXIT
MULTSIZ  LH,14    2,2               I1+D1
         AH,14    2,4               I1+D1+I2+D2=RESULT SIZE
         LH,15    3,2               D1
         AH,15    3,4               D1+D2=RESULT DEC POSITION
         B        FINISH
DIVSIZE  LH,14    2,2               I1+D1
         SH,14    3,2               -D1=I1
         AH,14    3,4               +D2=IRESULT
         LH,15    3,2               D1
         SH,15    3,4               D1-D2
         CH,15    3,2               D1
         BCS,2    G
         LH,15    3,2
G        CH,15    3,4               D2
         BCS,2    H
         LH,15    3,4               MAX(D1-D2),D1,D2
H        CW,15    DMAX
         BCS,2    ASIZ
         LW,15    DMAX
ASIZ     AW,14    15                SIZE
         B        FINISH
EXPONEN  LI,7     HA(FORCFL2)       FORCE FLOATING LONG
         LW,12    RRUSAG                                                COBOL41M
         AND,12   LO4                                                   COBOL41M
         CI,12    X'E'              SEE IF RESULT IS COMP-1             COBOL41M
         BNE      EXPON             NO                                  COBOL41M
         LI,12    X'F'              FORCE CODE TO BE FLOAT LONG         COBOL41M
         STH,12   RRUSAG                                                COBOL41M
EXPON    EQU      %                                                     COBOL41M
         BAL,11   USAGE7            BY POINTING OP1 TO FLOATING
*        EXPONENTIATION IS ALWAYS ACCOMPLISHED IN THIS COMPILER USING THE
*        FORTRAN DOUBLE PRECISION LOG AND DOUBLE PRECISION EXPONENTIATION
*        ROUTINES. THEREFORE THE USAGE IS FORCED TO DOUBLE PRECISION.
         B        FINISH3
UNARYMN  RES      0
*        FOR THE UNARY OPERATION, THE INTERMEDIATE RESULT, WHICH AS A MATTER
*        OF FACT BECOMES THE FINAL RESULT, RECEIVES THE SAME SIZE AND POINT
*        LOCATION AS THE OPERAND.
         LW,15    OP2
         STW,15   OP1
         LH,15    3,4
         LH,14    2,4
         B        FINISH
*        THE ROUTINE TZRLIT CREATES A NUMERIC LITERAL 0 TO SUBSTITUTE FOR THE
*        FIGURATIVE CONSTANT ZERO.
TZRLIT   LH,14    0,4
         AND,14   LOBYTE
         CI,14    X'94'
         BCS,1    *11
         CI,14    X'95'
         BCS,2    *11
         LW,4     ZRLIT0
         STW,4    ZRLIT
         LI,4     HA(ZRLIT)
         B        *11
ZRLIT0   DATA     X'09990000'
ZRLIT    DATA     X'09990000'
         DATA     X'00000800'
         DATA     X'00000001'
         DATA     X'7E180000'
         DATA     X'0C090000'
TQ       AI,7     -1
         LH,12    4,7
         LH,7     0,7
         AND,7    HI4
         CI,7     X'A0'
         BCS,3    RT2
         CI,12    1
         BCR,2    *13
RT2      AI,13    1
         B        *13
*        SUBROUTINE TO MODIFY SIZE AND DEC POSITION IF THEY EXCEED
*        THE CAPABILITY OF SIGMA 7 ARITHMETIC.
*        R14      IS I+D OF RESULT
*        R15      IS D
*        BAL,11   TRUNCRL
*        R14      IS NEW I+D
*        R15      IS NEW D
*        IN CASE THE RESULT EXCEEDS 30 DIGITS, THE CAPACITY OF THE DECIMAL
*        ACCUMULATOR, EITHER THE LEFT OR THE RIGHT END OF THE RESULT IS
*        TRUNCATED, OR IN ONE CASE, BOTH ENDS ARE TRUNCATED. THE DECISION
*        AS TO WHICH END TO TRUNCATE DEPENDS ON DMAX.
TRUNCRL  CI,14    30
         BCR,2    *11
         CI,15    DMAX
         BCS,2    A
B        LI,14    30                TRUNCATE I
         B        *11
A        LW,13    14
         SW,13    15
         AW,13    DMAX              I+DMAX
         CI,13    30
         BCS,2    C
         SW,14    15                I
         LI,15    30
         SW,15    14
         B        B
C        LW,15    DMAX
         B        B
*
*        USAGE    SUBROUTINE TO DETERMINE USAGE OF RESULT.
*        THE USAGES ARE GIVEN PRIORITY IN THE FOLLOWING ORDER:
*        FLOATING POINT LONG, FLOATING POINT SINGLE, PACKED DECIMAL,
*        BINARY INTEGER
*        THE USAGE OF THE RESULT IS THE HIGHER PRIORITY
*        OF THE USAGES OF THE TWO OPERANDS.
*        OP1 POINTS TO THE FIRST OPERAND.
*        OP2 POINTS TO SECOND OPERAND
*        BAL,11   USAGE
*        R13      RECEIVES NEW USAGE
*
USAGE    LW,7     OP1
USAGE7   LH,7     0,7
         LH,12    RRUSAG
         BCR,3    RNORM
         LH,7     RRUSAG
         LI,12    0
         STH,12   RRUSAG
RNORM    LW,12    7
         LS,7     LO4
         LB,13    PRIORT,7
*        A NUMERIC LITERAL IS ASSUMED TO HAVE THE SAME USAGE AS THE OTHER
*        OPERAND, SINCE AT GENERATION TIME IT MAY BE GENERATED IN ANY OF
*        THE REQUIRED FORMATS. THEREFORE REGISTER 13 IS LOADED WITH A 0
*        SO THAT THE OTHER OPERAND WILL TAKE PRECEDENCE.
         AND,12   HI4
         CI,12    X'90'
         BCS,3    USE2
         LH,13    3,2
         BCR,3    USE2
         LI,13    2
USE2     LW,7     OP2
         LH,7     0,7
         LW,12    7
         LS,7     LO4
         LB,7     PRIORT,7
         AND,12   HI4
         CI,12    X'90'
         BCS,3    USE3
         LH,7     3,4
         BCR,3    USE3
         LI,7     2
USE3     CW,7     13
         BCS,2    D
         CI,13    2                 FLOAT USAGE
         BG       D-1               YES
         LW,12    MTPLRST
         CI,12    1                 MULTIPLE RESULTS ?
         BLE      SINGLE
         LW,12    PRIMODE
         CI,12    3                 BIN MODE ?
         BG       D-1
         CI,12    2
         BGE      FLOAT             TO FLOAT RESULT MODE
SINGLE   LW,12    DMAX      ANY DECP
         BLEZ     D-1               NO, USE OP1 USAGE
         B        D+4               SET USAGE = DEC
         LW,7     13                USE OP1 USAGE
D        CI,7     2                 FLOAT USAGE
         BG       %+4               YES
         LW,12    DMAX              ANY DECP
         BLEZ     %+2               NO, PICK RESULT TYPE
         LI,7     2                 USE DEC OPRTN
GET      LB,13    USAGG,7           PICK UP RESULT TYPE
         B        CONTIN
PRIMODE  DATA     4
FLOAT    LI,7     4
         B        GET
CONTIN   RES      0
         LW,12    15                COMPUTE BYTE SIZE
         AI,12    2
         SLS,12   -1                DIVIDE BY 2
         CI,7     2
         BCR,3    RR
         LI,12    4
         CI,7     2
         BCR,1    E
*        IF THE USAGE OF THE RESULT IS FIXED POINT BINARY, SIZE IS SET TO 108
*        DECIMAL POSITION TO X'7FFF', AND BYTE SIZE TO 4. IF THE USAGE IS
*        FLOATING POINT SINGLE, SIZE IS SET TO 30, POINT LOCATION TO X'7FFF',
*        BYTE SIZE TO 4. IF THE USAGE IS FLOATING POINT DOUBLE, SIZE IS SET TO
*        30, POINT LOCATION TO X'7FFF', BYTE SIZE TO 8.
         LI,14    10                BINARY
         B        RR
E        LI,14    30
         LI,15    X'7FFF'
         CI,7     3
         BCR,3    RR
         LI,12    8
*        REGISTER 13 IS LOADED FROM USAGE WITH A INDICATING INTERMEDIATE
*        RESULT AND A DIGIT REPRESENTING THE USAGE OF THE INTERMEDIATE RESULT.
*        REGISTER 10 IS LOADED FROM REGISTR WITH THE REGISTER IN WHICH THE
*        ARITHMETIC IS TO BE PERFORMED OR IN THE CASE OF DECIMAL ARITHMETIC
*        WITH A REGISTER INTO WHICH THE NUMBER MAY BE LOADED BEFORE IT IS
*        CONVERTED AND PLACED IN THE DECIMAL ACCUMULATOR.
RR       LB,10    REGISTR,7
         B        *11
OP11     RES      5
OP22     RES      5
OPN      DATA     0
RR6      DATA     X'00040003'
         DATA     X'02000000'
SVR2     DATA     0
TFLAG    DATA     0
OUTFLG   DATA     0
BIT8     DATA     X'8'
HI4    DATA    X'F0'
LASTEMP  DATA     0
CARRY    DATA     0
MAXADD   DATA     0
DMAX     DATA     0
LO4      DATA     15
PRIORT   DATA     X'02000000'
         DATA     X'00000202'
         DATA     X'02020202'
         DATA     X'01010304'
USAGG    DATA     X'A8ADA8AE'
         DATA     X'AF000000'
REGISTR  DATA     X'00090808'
         DATA     X'08000000'
FORCFL2  DATA     X'000F0000'
RRUSAG   DATA     0
IREXIT   DATA     0
SAVV2    DATA     0
OP1      DATA     0
OP2      DATA     0
AMASK    DATA     X'0FFFF'
SCANXIT  DATA     0
ADEXIT   DATA     0
BACKSTP  DATA     X'77000005'
OPRANDS  DATA     0
OPRATRS  DATA     0
ENDFLAG  DATA     0
EXSTRNG  DATA     0                 POINTER TO FIRST OPERAND OF EXPRESSIO
LOBYTE   DATA     X'FF'
STTYPE   DATA     0                 STATEMENT TYPE
LASTOPB  DATA     X'80'
LASTOP   DATA     0
LINENUM  DATA     0
SIZER    DATA     0
*        XOUT DETERMINES WHAT CODE IS TO BE GENERATED FOR THE ELEMENTARY
*        OPERATION REPRESENTED BY AN OPERATION IN OPN, 2 OPERANDS IN OP1
*        AND OP2, AND AN INTERMEDIATE RESULT IN TFLAG. XOUT IS WRITTEN SO
*        THAT EVEN IF THE TEMPORARY STORAGE ASSIGNMENTS MADE BY EXPOUT
*        ARE INCORRECT, TEMPORARY STORES AND LOADS WILL BE GENERATED SO
*        AS TO PRODUCE THE CORRECT ANSWER.
XOUT     LW,7     TFLAG
*        IF TFLAG IS ZERO THE OPERATION HAS ALREADY BEEN OUTPUT AND XOUT IS
*        SKIPPED.
         BCR,3    *10
         STW,10   XOUTXT
         LW,11    OUTFLG
*        IF OUTFLG IS NONZERO, SCANX IS IN CONTROL RATHER THAN EXPOUT.
*        OUTPUT IS NOT BEING PLACED ON THE MCF; THEREFORE XOUT IS SKIPPED.
         BCS,3    ZTFLAGX
*        THE CODE BETWEEN THIS POINT AND XOUT22 IS FOR DIAGNOSTIC PURPOSES
*        ONLY. IT PLACES CLUSTERS ON THE MCF DESCRIBING OP1 AND OP2 AND THE
*        INTERMEDIATE RESULT. THESE CLUSTERS ARE IN SUCH FORM THAT THEY
*        ARE IGNORED BY PHASE 4.2. THEY SERVE TO DEFINE THE OPERATION FOR
*        WHICH THE SUCCEEDING CODE IS GENERATED.
         AI,0     0
         LW,11    OPN
         CI,11    X'16'
         BCR,3    XOUT2
         LW,4     OP1
         S,4      1
         BAL,11   WRMCF
XOUT2    LW,4     OP2
         S,4      1
         BAL,11   WRMCF
         LW,4     TFLAG
         S,4      1
         BAL,11   WRMCF
XOUT22   STW,1    SAV11
         STW,2    SAV22
         STW,3    SAV33
         STW,5    SAV55
*        THE PURPOSE OF THE SUCCEEDING CODE IS TO TEST WHETHER OR NOT A
*        REGISTER IS ALREADY LOADED WITH ONE OF THE OPERANDS. IF A REGISTER
*        IS ALREADY LOADED, IT IS CONVERTED TO THE SAME USAGE AS THE RESULT
*        IF NECESSARY, AND IF THE UNARY - INDICATOR IS ON, ITS SIGN IS CHANGED.
*        IF THE OPERATION IS/OR**AND IT IS OP2 THAT IS IN THE REGISTERS BY
*        SOME OVERSIGHT IN EXPOUT, OP2 IS SAVED IN TEMPORARY STORAGE. FOR
*        THE +, -, OR* OPERATIONS, THE OPERATIONS CAN BE INTERCHANGED, BUT
*        FOR THE/OR**OPERATIONS, THEY MUST BE TAKEN IN THE CORRECT ORDER
*        IF A REGISTER IS NOT ALREADY LOADED, THE OTHER BRANCH STARTING WITH
*        TOP3 IS TAKEN TO DETERMINE WHICH OPERAND SHOULD FIRST BE LOADED INTO
*        THE REGISTERS. TO DETERMINE THIS, OP2 IS TESTED. IF IT IS EITHER A
*        LITERAL, WHICH CAN BE GENERATED IN ANY USAGE OR HAPPENS TO BE THE
*        SAME USAGE AS THE INTERMEDIATE RESULT, THEN OP1 WILL BE LOADED FIRST.
*        THIS IS BECAUSE NO EXTRA OPERATIONS WILL BE REQUIRED UNDER THESE
*        CONDITIONS TO PROCESS OP2. IF THESE CONDITIONS ARE NOT MET AND THE
*        OPERATION IS +, -, OR*WHICH DO PERMIT INTERCHANGE OF OP1AND OP2,
*        THEY ARE INTERCHANGED. CODE IS THEN GENERATED TO CAUSE THE NEW
*        OP1 TO BE LOADED INTO A REGISTER. IF THE UNARY - BIT IS ON, THEN
*        OP1 EITHER IS LOADED NEGATIVE INITIALLY OR ITS SIGN IS CHANGED AFTER
*        LOADING.
         LW,11    OPN
         CI,11    X'16'
         BCR,3    UNP
         LW,2     OP1               IS EITHER OP1 OR OP2 ALREADY
         BAL,12   REGQ
         B        TOP2
*        THE REGISTER IS ALREADY LOADED WITH OP19
         B        OPIREG
TOP2     LW,2     OP2
         BAL,12   REGQ
         B        TOP3
*        THE REGISTER IS ALREADY LOADED WITH OP2.
         B        XX4
*        THE EXPRESSION IS DEGENERATE CONSISTING OF BUT A SINGLE OPERAND.
*        THEREFORE OP1 AND OP2 ARE BOTH SET TO POINT TO THIS OPERAND SO THAT
*        IT WILL BE LOADED.
UNP      LW,2     OP2
         STW,2    OP1
TOP3     BAL,12   LITQ
         B        TOP4
*        THE REGISTERS ARE NOT LOADED AND OP2 IS A LITERAL.
         B        XX3
TOP4     RES      0
         LH,0     0,2               OR IS OP2 SAME USAGE AS RESULT
         AND,0    LO4
         LW,7     TFLAG
         LH,1     0,7
         AND,1    LO4
         LW,2     OP1
         CW,1     0
*        THE REGISTERS ARE NOT LOADED AND OP2 HAS THE SAME USAGE AS THE
*        INTERMEDIATE RESULT.
         BCR,3    XX3                  OP2 HAS SAME USAGE
         LW,1     OPN
         CI,1     X'12'
*        THE OPERATION IS/OR**SO OP1 AND OP2 CANNOT BE INTERCHANGED.
         BCS,2    XX3
         XW,2     OP2               INTERCHANGE OP1 WITH OP2
         STW,2    OP1
*        IF THE OPERANDS WERE INTERCHANGED AND THE OPERATION WAS SUBTRACT,
*        THE SIGN OF THE OPERAND IS CHANGED AND THE OPERATION IS CHANGED
*        TO ADD.
         BAL,14   CKMIN
XX3      LW,2     OP1
*        IF THE DATA IS A NUMERIC LITERAL, IT IS GENERATED WITH THE SAME USAGE
*        AS THE INTERMEDIATE RESULT AND THEN CODE IS GENERATED TO LOAD THE
*        LITERAL AT OBJECT TIME INTO THE REGISTERS.
         BAL,14   LITQGL
         B        LOP1
         B        OP1SAME
*        IF THE OPERAND IS A DATA ITEM, CODE IS GENERATED TO LOAD IT EITHER
*        POSITIVE OR NEGATIVE INTO THE REGISTERS.
LOP1     BAL,14   DATQL
         B        LOP2
         B        OP1SAME
*        IF THE DATA IS AN INTERMEDIATE RESULT, IT IS LOADED BY A SINGLE
*        INSTRUCTION SINCE IT WAS STORED BY A SINGLE INSTRUCTION. IF THE USAGE
*        HAS CHANGED REGMV2 WILL CONVERT TO THE NEW USAGE. IF THE SIGN
*        MUST BE CHANGED REGCHS WILL CHANGE THE SIGN.
LOP2     BAL,14   TMPQL
         DATA     0
         B        OP1SAME
*        THE REGISTER WAS FOUND TO BE ALREADY LOADED WITH OP2, BUT THE
*        OPERATION WAS/OR**AND OP1 MUST BE THERE FIRST. THEREFORE OP2
*        IF NECESSARY IS CONVERTED TO THE SAME USAGE AS THE INTERMEDIATE
*        RESULT, THEN STORED AT STT2 IN TEMPORARY.
BB       BAL,15   REGMV2
         BAL,12   STT2
         B        XX3
*        THE SUBROUTINE STT2 GENERATES A STORE OF THE REGISTER TO TEMPORARY AND
*        CHANGES THE CLUSTER TO INDICATE THE OPERAND IS NOW IN TEMPORARY
*        STORAGE.
STT2     LI,13    DTBA+16
STT3     LI,9     X'0600'
         LW,1     2
         LI,0     0
         STH,0    1,1
         STH,13   2,1
         AI,1     -1
         STH,9    2,1
         LW,7     TFLAG
         LH,6     0,7
V        AND,6    LO3
         SLS,6    1
         LH,6     SINSTR,6
         LI,4     X'05ED'
         BAL,10   EOUT
         LH,4     0,2
         AND,4    ZLO8
         AI,4     X'A0'
         LH,5     0,7
         AND,5    LO4
         OR,4     5
         STH,4    0,2
         B        *12
XX4      LW,1     OPN
         CI,1     X'12'
*        OP2 IS ALREADY LOADED, BUT THE OPERATION IS/OR**.
         BCS,2    BB
         LW,2     OP1
         XW,2     OP2
         STW,2    OP1
         BAL,14   CKMIN
OPIREG   LW,2     OP1
*        IF THE REGISTER IS LOADED BUT THE USAGE MUST BE CHANGED TO THE USAGE
*        OF THE INTERMEDIATE RESULT, THIS IS DONE AT REGMV2.
         BAL,15   REGMV2
OP1SAM   LW,2     OP1
         BAL,12   REGCHS
*        THIS IS THE MIDPOINT OF THE ROUTINE XOUT. AT THIS POINT OP1 HAS BEEN
*        LOADED INTO A REGISTER WITH THE CORRECT USAGE AND SIGN SO THAT NOW
*        CONSIDERATION MAY BE GIVEN TO OP2 AND GENERATION OF THE OPERATION
*        ITSELF. IF THE OPERATION IS UNARY + INDICATING A DEGENERATE EXPRESSION,
*        THE WORK IS FINISHED AND CONTROL IS GIVEN TO FINL WHICH MIGHT CHANGE
*        THE SIGN IF THE FINAL RESULT IS MARKED NEGATIVE. IF THE USAGE IS
*        PACKED DECIMAL, A BRANCH IS MADE TO KERRY SINCE DECIMAL ARITHMETIC
*        IS TREATED BY ITS OWN SET OF SPECIAL ROUTINES IN PHASE 4.2 AND
*        REQUIRES DIFFERENT TREATMENT. IF THE OPERATION IS**THE LOG OF
*        OP1 IS OBTAINED AND THEN THE OPERATION IS TREATED AS A * UNTIL THE
*        INTERMEDIATE RESULT IS OBTAINED, WHEREUPON A CALL IS MADE TO THE
*        **ROUTINE TO OBTAIN THE INTERMEDIATE RESULT. IF DESPITE ALL THE
*        PRECAUTIONS TAKEN IN EXPOUT AND THE FIRST HALF OF XOUT, OP2 STILL
*        DOES NOT HAVE THE SAME USAGE AS THE INTERMEDIATE RESULT, THE CODE
*        BEGINNING AT OP2SAMQ WILL STORE OP1, LOAD AND CONVERT OP2, STORE
*        OP2 WITH PROPER USAGE, AND RELOAD OP1. IF, ON THE OTHER HAND, THE
*        USAGE OF OP2 IS CORRECT, A SIMPLE ARITHMETIC INSTRUCTION MAY BE
*        GENERATED. THIS IS DONE BY A TABLE LOOKUP PICKING UP A SINGLE
*        INSTRUCTION
*        AND SENDING IT ON TO PHASE 4.2 TO BECOME PART OF THE OBJECT CODE.
*        IF OP2 IS INDICATED TO BE PICKED UP NEGATIVE AND THE OPERATION IS *
*        OR/, THE SIGN OF OP1 IS CHANGED. IF OP2 IS INDICATED TO BE PICKED UP
*        NEGATIVE AND THE OPERATION WAS ADD, IT IS CHANGED TO SUBTRACT.
*        IF IT WAS SUBTRACT, IT IS CHANGED TO ADD.
OP1SAME  LW,1     OPN
         CI,1     X'16'
*        THE EXPRESSION CONSISTS OF A SINGLE OPERAND.
         BCR,3    FINL
         LW,7     TFLAG
         LH,6     0,7
         AND,6    LO4
         CI,6     X'C'
*        THE INTERMEDIATE RESULT IS PACKED DECIMAL.
         BCS,1    KERRY
         LW,1     OPN
GEXP2    LW,2     OP2
         BAL,13   LITQG
         B        OP2SAMQ
         LI,4     X'05EC'
         B        LITARTH
*        THE SUBROUTINE CKMIN, IF THE OPERATION WAS SUBTRACT, WILL CHANGE IT
*        TO ADD AND WILL REVERSE THE IMPLIED SIGN OF THE OPERAND.
CKMIN    CI,1     X'11'
         BCS,3    *14
         LI,0     X'10'
         STW,0    OPN
         AI,2     -1
         LH,0     1,2
         EOR,0    BIT80
         STH,0    1,2
         B        *14
EX4      BAL,11   WRMCF
         B        *12
OP2SAMQ  RES      0
         LH,6     0,7               R2 POINTS TO OP2
         AND,6    LO4
         LW,2     OP2
         LH,1     0,2
         AND,1    LO4               USAGE OF OP2
         CW,1     6
*        OP2 IS THE SAME USAGE AS THE RESULT; THEREFORE THE WAY IS CLEAR
*        TO GENERATE THE ARITHMETIC INSTRUCTION.
         BCR,3    GENR2
*        OP2 IS NOT THE SAME USAGE AS THE RESULT. THEREFORE OP1 MUST BE
*        SAVED IN TEMPORARY WHILE OP2 IS CONVERTED TO THE CORRECT RESULT
*        AND PLACED IN TEMPORARY.
STT1     LI,13    DTBA
         LW,2     OP1
         BAL,12   STT3
         LW,2     OP2
         BAL,14   TMPQL
         B        TOP7
         B        TEXP
GENR2    BAL,12   TMPQ
         B        GENARTH
GENR3    LI,4     X'05ED'
         B        LITARTH
TOP7     BAL,14   DATQL
         DATA     0
TEXP     BAL,12   STT2
         LW,2     OP1
         BAL,14   TMPQL
         DATA     0
         B        GENR3
GENARTH  LW,2     OP2
*        A DESCRIPTION OF OP2 IS OUTPUT TO MCF SO THAT PHASE 4.2 CAN GENERATE
*        THE CODE TO LOAD ANY SUBSCRIPTS REQUIRED AND ALSO CAN PICK UP THE
*        BASE AND OFFSET PERTAINING TO THE OPERAND.
         BAL,10   KLUSOUT
         LH,5     0,2
         AND,5    LO4
         LI,6     0
         CI,5     8
         BCS,3    DECAFUL
         LI,6     4
DECAFUL  LI,9     2
         LI,4     X'04E5'
         BAL,10   EOUT
         LI,4     X'05EC'
LITARTH  LW,1     OPN
         CI,1     X'11'
         BCR,2    LITAR2
         CI,1     X'14'             IS OPN EXPOINTIATION
         BE       LITAR2            YES
*        THE OPERAND IS * OR/. IF THE SIGN MUST BE CHANGED IT IS DONE BY REGCHS.
         LW,2     OP2
         STW,4    SAVX4
         BAL,12   REGCHS
         LW,4     SAVX4
LITAR2   LH,6     0,7
         AND,6    LO4
         SLS,6    2
         AW,6     OPN
         SLS,6    1
*        REGISTER 6 NOW CONTAINS AN OFFSET TO PICK UP THE ARITHMETIC
*        INSTRUCTION WHICH WILL BE GENERATED.
         LW,1     OP2
         AI,1     -1
         LH,9     1,1
         AND,9    BIT80
         BCR,3    LITAR3
         LW,1     OPN
         CI,1     X'14'             IS OPN EXPOINTIATION
         BNE      CHKADSUB          NO--GO CHECK ADD/SUB
         AI,6     2                 SET TO GET COMPLEMENT
CHKADSUB RES      0
         CI,1     X'10'
         BCS,3    LITAR4
*        THE OPERATION WAS ADD BUT THE OPERAND WAS UNARY - ; THEREFORE THE
*        OPERATION IS CHANGED TO SUBTRACT.
         AI,6     2
         B        LITAR3
LITAR4   CI,1     X'11'
         BCS,3    LITAR3
*        THE OPERATION WAS SUBTRACT BUT THE OPERAND WAS INDICATED UNARY -;
*        THEREFORE THE OPERATION IS CHANGED TO ADD.
         AI,6     -2
LITAR3   LW,1     OPN
*   THERE HAS BEEN A CHANGE TO  THE  CODE GENERATED FOR EXPOENTATION    COBOL41M
*   CURRENTLY  OP2  WILL BE  LOADED INTO REG 12 & 13                    COBOL41M
*   SEE  FOLLOWING NOTE.                                                COBOL41M
GTINST   LH,6     INSTR-68,6
         LW,2     OP2
         LH,13    2,2               GET BASE AND OFFSET
         AI,2     -1
         LH,9     2,2
         AI,2     1
*        EOUT PLACES THE ARITHMETIC OPERATION ON MCF.
         BAL,10   EOUT
         CI,1     X'14'
         BCS,3    NEGQ
*        THE OPERATION WAS **; THEREFORE A CALL IS MADE TO THE FORTRAN**
*        ROUTINE TO PRODUCE THE INTERMEDIATE RESULT.
*   REG 6 AND 7  CONTAIN  OP1    REGS 12 & 13  CONTAIN OPN2             COBOL41M
*   THE  RESULT  IS RETURN IN  REGS6 AND 7.                             COBOL41M
         LI,4     BA(EXP)
         BAL,12   EX4
NEGQ     LW,7     TFLAG
         LH,13    2,7
         AI,7     -1
         LH,9     2,7
         CI,9     X'0600'
         BCS,3    FINL
*        THE INTERMEDIATE RESULT MUST BE STORED IN TEMPORARY STORAGE.
*        THIS IS DONE AT STT3.
         LW,2     TFLAG
         BAL,12   STT3
ZTFLAGG  LW,1     SAV11
         LW,2     SAV22
         LW,3     SAV33
         LW,5     SAV55
ZTFLAGX  LI,0     0
*        TFLAG IS ZEROED TO INDICATE THE CODE GENERATION FOR THIS OPERATION
*        IS COMPLETE.
         STW,0    TFLAG
         B        *XOUTXT
FINL     LW,7     TFLAG
         LH,1     0,7
         AND,1    HI4
         CI,1     X'B0'
         BCS,3    ZTFLAGG
*        IF THE FINAL RESULT MUST HAVE ITS SIGN CHANGED IT IS DONE HERE AT
*        REGCHS.
         LW,2     TFLAG
         BAL,12   REGCHS
END      LI,4     X'05EF'
*        A CLUSTER IS GENERATED INDICATING END OF EXPRESSION.
         BAL,10   EOUT
         B        ZTFLAGG
*        SUBROUTINE TO TEST AN  OPERAND CLUSTER
*        IF IT IS IN TEMP - LOAD TO REGISTER
*          R2     IS HA OF CANDIDATE
*          R7     IS HA OF RESULT
*          BAL,14 TMPQL
*                 NOT LOADED
*                 LOADED AND USAGE
TMPQL    BAL,12   TMPQ
         B        *14
         LH,4     0,2
         AND,4    LO3
         SLS,4    1
         LH,6     LINSTR,4
         LW,4     4
         BCR,3    PLSLD
         LW,1     2
         AI,1     -1
         LH,8     1,1
         AND,8    BIT80
         BCR,3    PLSLD
         LH,8     1,1
         EOR,8    BIT80
         STH,8    1,1
         LH,6     NLINSTR,4
PLSLD    LH,9     2,1
         LH,13    2,2
         LI,4     X'05ED'
         BAL,10   EOUT
         BAL,15   REGMV2
         BAL,12   REGCHS
         B        GG
*        SUBROUTINE TO MOVE (IF NECESSARY) A REGISTER INTERMEDIATE
*        RESULT TO ANOTHER REGISTER - CONVERTING TO
*        NEW USAGE AND CHANGING SIGN IF NECESSARY
*          R2     HA CANDIDATE
*          R7     HA RESULT
*                 BAL,13 REGMV
*                 NOT IN REG
*                 IN REG
*
REGMV2   LW,7     TFLAG
         LH,6     0,7
         AND,6    LO4
         LH,1     0,2
         AND,1    LO4
         CW,1     6
         BCR,3    *15
         LW,1     2
RG2      LB,6     RECR,6
         LH,1     0,1
         AND,1    LO4
         LB,13    RECR,1
         LW,1     7
         LH,4     0,7
         AND,4    LO4
         CI,4     8
         BCR,3    LRR2
         LW,1     2
         AI,1     -1
         LH,9     4,1
         B        LRROUT
LRR2     AI,1     -1
         LH,9     4,1
*  CONVERT TO TARGET MODE
         LH,4     3,2               SIZE OP1 + DECPT
         AW,4     9
         STH,4    3,2
         AI,2     -1
         LH,4     4,2               DECP OP1 + DECPT
         AW,4     9
         STH,4    4,2
         AI,2     1
LRROUT   LI,4     X'05E4'
         BAL,10   EOUT
         LH,4     0,2
         AND,4    ZLO4
         LH,5     0,7
         AND,5    LO4
         OR,4     5
         STH,4    0,2
         B        *15
REGCHS   LW,1     2
         AI,1     -1
         LH,9     1,1
         AND,9    BIT80
         BCR,3    *12
         LH,9     1,1
         EOR,9    BIT80
         STH,9    1,1
         LH,6     0,2
         AND,6    LO3
REGCHS1  RES      0                                                     COBOL41M
         LW,9     CHS,6
         LW,6     CHS,6
         SLS,6    -16
         LI,4     X'04EB'
         BAL,10   EOUT
         B        *12
CHS      AI,15    -1                                                    COBOL41M
         DATA     0
         DATA     0
         DATA     0
         LCW,9    9
         LCW,9    9
         LCW,8    8
         LCD,8    8
*        SUBROUTINE TO TEST IF AN OPERAND IS
*        AN INTERMEDIATE RESULT IN REGISTERS
*          R2     IS HA OF CANDIDATE
*          R7     IS HA OF RESULT
*          BAL,12 REGQ
*
*
REGQ     LH,0     0,2
         AND,0    HI4
         CI,0     X'A0'
         BCS,3    *12
         LW,1     2
         AI,1     -1
         LH,9     2,1
         CI,9     X'0600'
         BCR,3    *12
         B        Q2
*        SUBROUTINE TO TEST IF AN OPERAND CLUSTER
*        IS IT INTERMEDIATE RESULT IN TEMP
*          R2     IS HA OF CANDIDATE
*          BAL,12 TMPQ
*
TMPQ     LH,0     0,2
         AND,0    HI4
         CI,0     X'A0'
         BCS,3    *12
         LW,1     2
         AI,1     -1
         LH,9     2,1
         CI,9     X'0600'
         B        Q
*        SUBROUTINE TO TEST A CLUSTER
*        IF IT IS CORE DATA - GENERATE A LOAD
*          R2     IS HA OF CANDIDATE CLUSTER
*          R7     IS HA OF RESULT CLUSTER
*          BAL,14  DATQL
*                 DATA NOT LOADED
*                 DATA LOADED
*
DATQL    BAL,12   DATQ
         B        *14
         BAL,10   KLUSOUT
         B        LOD
*        SUBROUTINE TO TEST A CLUSTER IF IT IS CORE DATA
*          R2     IS HA OF THE CANDIDATE CLUSTER
*          BAL,12 DATQ
*                 IT'S NOT CORE DATA
*                 IT IS
*
DATQ     LH,0     0,2
         AND,0    HI4
         CI,0     X'80'
         B        Q
*        SUBROUTINE TO TEST A CLUSTER
*        IF IT IS A LITERAL - GENERATE THE LITERAL
*        AND LOAD IT INTO A REGISTER
*          R2     IS HA OF CANDIDATE CLUSTER
*          R7     IS HA OF RESULT CLUSTER
*          BAL,14 LITQGL
*                 LITERAL NOT GENERATED
*                 LITERAL LOADED
*
LITQGL   BAL,13   LITQG
         B        *14
LOD      LW,1     7
         AI,1     -1
         LH,6     0,7
         AND,6    LO4
         LB,6     RECR,6
         LI,4     X'05E3'
         LW,1     2
         AI,1     -1
         LH,9     4,1
         LH,10    1,1
         AND,10   BIT80
         BCS,3    MNLIT
         LI,4     X'05E2'
MNLIT2   BAL,10   EOUT
GG       AI,14    1
         B        *14
MNLIT    LH,10    1,1
         EOR,10   BIT80
         STH,10   1,1
         B        MNLIT2
*        SUBROUTINE TO TEST A CLUSTER
*        IF IT IS A LITERAL - GENERATE THE LITERAL
*          R2 IS HA OF THE CANDIDATE CLUSTER
*          R7 IS HA OF THE RESULT CLUSTER
*          BAL,13 LITQG
*                 LITERAL NOT GENERATED
*                 LITERAL GENERATED
*
LITQG    BAL,12   LITQ
         B        *13
         BAL,10   KLUSOUT
         LH,6     0,7
         AND,6    LO4
         LW,1     7
         AI,1     -1
         LH,9     4,1
        LI,4      X'05E1'
         BAL,10   EOUT
L        AI,13    1
         B        *13
*        SUBROUTINE TO TEST A CLUSTER IF IT IS A LITERAL
*          R2     IS HA OF THE CANDIDATE CLUSTER
*          BAL,12 LITQ
*                 IT'S NOT A LITERAL
*                 IT IS
LITQ     LH,0     0,2
         AND,0    HI4
         CI,0     X'90'
Q        BCS,3    *12
Q2       AI,12    1
         B        *12
KLUSOUT  AI,2     1
         LH,4     0,2
         OR,4     OPBIT
         STH,4    0,2
         AI,2     -1
         LW,4     2
         SLS,4    1
         BAL,11   ADV00             RESOLVE VAR PARAM
         BAL,11   WRMCF
         B        *10
*        THE FOLLOWING CODE CAUSES DECIMAL ARITHMETIC TO BE GENERATED BY
*        PHASE 4.2.
KERRY    LW,2     OP2
         LW,1     OPN
         CI,1     X'11'
         BCR,2    KAR2
*        THE OPERATION WAS/OR*. IF OP1 MUST HAVE ITS SIGN CHANGED IT IS DONE
*        BY REGCHS.
*   THIS PIECE OF CODE IS ADDED BECAUSE IT IS INCORRECT TO HAVE         COBOL41M
*   REGCHS CHANGE THE SIGN OF OP1. OP1 IS ALWAYS DECIMAL (AT THIS POINT)COBOL41M
*   REGARDLESS OF OP2.  THE CORRECT INDEX SETTING FOR R6 IS 0.          COBOL41M
         LW,1     2                 *                                   COBOL41M
         AI,1     -1                *                                   COBOL41M
         LH,9     1,1               *    TEST                           COBOL41M
         AND,9    BIT80             *       SIGN  SWITCH                COBOL41M
         BCR,3    KAR3              *                                   COBOL41M
         LH,9     1,1               *   RESET                           COBOL41M
         EOR,9    BIT80             *        SIGN                       COBOL41M
         STH,9    1,1               *            SWITCH                 COBOL41M
         LI,6     0                 *  SET INDEX                        COBOL41M
         BAL,12   REGCHS1           *      OUTPUT COMPLEMENT OPERATION  COBOL41M
         B        KAR3
KAR2     LW,6     OP2
         AI,6     -1
         LH,9     1,6
         AND,9    BIT80
         BCR,3    KAR3
*        IF THE OPERATION WAS + OR-AND OP2 IS UNARY -, + IS CHANGED TO - AND
*        - TO +.
         EOR,1    WUN
         STW,1    OPN
KAR3     BAL,13   LITQG
         B        KRY2
*        IF OP2 IS A LITERAL, IT IS GENERATED AND CONTROL IS GIVEN TO KRY3.
         B        KRY3
KRY2     BAL,12   TMPQ
         B        KRY22
*        IF OP2 IS IN TEMPORARY STORAGE, THE BYTE SIZE OF THE OPERAND IS SET
*        TO 0 SO THAT KERRY WILL KNOW THAT THE FULL DECA CAN BE LOADED.
         LI,0     0
         STH,0    3,2
*        A CLUSTER DESCRIBING OP2 IS OUTPUT SO THAT PHASE 4.2 MAY GENERATE
*        SUBSCRIPTS AND OBTAIN THE BASE AND OFFSET LOCATIONS.
KRY22    BAL,10   KLUSOUT
KRY3     LW,6     OPN
         LW,7     TFLAG
         AI,7     -1
         AI,6     -16
         LW,1     OP1
         AI,1     -1
         LH,9     3,1
         LH,13    4,1
*        R6 NOW CONTAINS THE DECIMAL OPERATION R9, AND THE SIZE OF THE
*        OPERAND, OP1, CURRENTLY IN DECA. R13 CONTAINS THE POINT LOCATION
*        OF THE OPERAND CURRENTLY IN DECA.
         LI,0     0
         STW,0    E3
         LW,2     OP2
         AI,2     -1
         LI,15    15
         CH,15    3,2
         BCS,2    KL
         STW,15   E3
KL       LH,14    4,2
         LH,12    4,7
         SH,12    4,1
         CI,6     2
         BCS,1    KK
         BCS,3    KD
*        IF THE OPERATION WAS/OR * THE SUCCEEDING CODE COMPUTES THE
*        AMOUNT OF LEFT OR RIGHT SHIFT REQUIRED SO THAT THE FINAL RESULT
*        IS PROPERLY POSITIONED. ALSO SINCE THE DECA CAN ONLY HANDLE 15
*        DIGIT OPERANDS ON A * OR A 15 DIGIT QUOTIENT ON A/, THE INDICATOR
*        DUBL IS SET NONZERO IF DOUBLE PRECISION ARITHMETIC IS REQUIRED.
         SW,14    12
         LH,12    3,1
         B        KM
KD       AW,14    12
         LH,12    3,7
KM       CW,15    12
         BCS,2    KN
         STW,15   E3
KN       LW,14    14
         BCS,1    KK
         STH,14   E3
KK       LI,4     X'07E6'
         BAL,10   EOUT
         B        NEGQ
*        SUBROUTINE TO OUTPUT E CLUSTER
*        R6       IS VALUE WANTED IN R6
*        R9       IS VALUE WANTED IN R9
*        R13      IS VALUE WANTED IN R13
*        R4       IS COUNT, CONTROL BYTE
*        BAL,10   EOUT
EOUT     STH,9    E1+1
         STH,4    E1
         LI,4     HA(E1)+1
         STH,6    0,4
         STH,13   1,4
         LI,4     BA(E1)
         BAL,11   WRMCF
         B        *10
RRR1     DATA     0
RRR2     DATA     0
RRR3     DATA     0
OPBIT    DATA     X'0800'
SAV11    DATA     0
SAV22    DATA     0
SAV33    DATA     0
SAV55    DATA     0
LO3      DATA     7
ZLO4     DATA     X'FFF0'
ZLO8     DATA     X'FF00'
BIT80    DATA     X'80'
EXP      DATA     X'05EE05C3'
         DATA     X'7AC5E7D7'
         DATA     X'40404040'
         DATA     X'40404040'
SAVX4    AW,7     0
WUN      DATA     1
ERRORS   DATA     0
E1       DATA     0
         DATA     0
E3       DATA     0
         DATA     0
RECR     DATA     X'00000000'
         DATA     X'00008888'
         DATA     X'88888888'
         DATA     X'9D9D8E8F'
XOUTXT   DATA     0
INSTR    AW,9     0                 INSTRUCTION
         SW,9     0
         MW,9     0
         DW,9     0
         FAS,8    0
         FSS,8    0
         FMS,8    0
         FDS,8    0
         FAL,8    0
         FSL,8    0
         FML,8    0
         FDL,8    0
         LD,12    0                                                     COBOL41M
         LCD,12   0
SINSTR   DST,0    0
         DATA     0
         DATA     0
         DATA     0
         STW,9    0
         STW,9    0
         STW,8    0
         STD,8    0
LINSTR   DL,0     0
         DATA     0
         DATA     0
         DATA     0
         LW,9     0
         LW,9     0
         LW,8     0
         LD,8     0
NLINSTR  DL,0     0
         DATA     0
         DATA     0
         DATA     0
         LCW,9    0
         LCW,9    0
         LCW,8    0
         LCD,8    0
ERR      LW,0     ERRORS
         BCS,3    *11
         MTW,1    ERRORS
         B        DIAG
          END
