*DECK GMOVSUB 
          IDENT  GMOVSUB
          TITLE  GMOVSUB -  SUBROUTINES FOR GMOVE AND GANMOVE 
  
          MACHINE  ANY,I
          SST 
          COMMENT  SUBROUTINES FOR GMOVE AND GANMOVE
          SPACE  4
**        GMOVSUB -  SUBROUTINES FOR GMOVE AND GANMOVE
* 
*         CONTAINS: 
*                CGADSPC   - APPEND 0-9 SPACES TO A FIELD 
*                CGGTSPC   - LOAD 0-10 SPACES IN A FIELD
*                CGLOAD1   - LOAD FIELD FROM 1 WORD 
*                CGSETB4   - SET B-REGISTER VREGX TO CONSTANT 
*                CGSETXW   - SET X-REGISTER TO A CONSTANT 
*                CGSTOR1     STORE FIELD INTO 1 WORD
*                CGLOAD2   - LOAD FIELD FROM NEXT WORD
*                STORC4     STORE COMPUTATIONAL-4 ITEM
*                CGLOAD4   - LOAD COMP-4 ITEM 
*                CGSTOR2   - STORE FIELD INTO NEXT WORD 
*                CGMVWRD   - MOVE FULL WORDS WITHOUT SHIFTING 
*                CGSTBLK   - STORE WORDS OF BLANKS
*                CGAPBLK   - APPEND BLANKS ONTO END OF FIELD
*                CGHILO1   - LOAD 1ST FIELD OF HI OR LO VALUES
*                CGHILO2   - LOAD NEXT FIELD OF HI OR LO VALUES 
*                CGMHILO   - MOVE FULL WORDS OF HI OR LO VALUES 
*                CGGTSPL   - GET A FIELD OF LEFT JUSTIFIED SPACES 
*                CGGTSPR   - GET A FIELD OF RIGHT JUSTIFIED SPACES
  
  
  
*      COMDECKS 
  
  
  
  
  
 CONTROL  OPSYN  NIL
  
  
  
*CALL CCT 
  
          EJECT 
 GMOVSUB  MODULE
  
  
*      REGTABLE EQUATES 
  
 MOVEREGA EQU    REGB 
 MOVEREGB EQU    REGC 
 MOVEREGM EQU    REGM 
 MOVEREGX EQU    REGT7
 MOVEREGY EQU    REGT8
  
*      VIRTUAL REGISTER EQUATES 
  
 VREGA    EQU    VREG1
 VREGB    EQU    VREG2
 VREGC    EQU    VREG3
 VREGU    EQU    VREG16 
 VREGV    EQU    VREG17 
 VREGW    EQU    VREG18 
 VREGX    EQU    VREG4
 VREGY    EQU    VREG19 
 VREGZ    EQU    VREG20 
  
*      FIXED TABLE EQUATES
  
 SHIFTCT  EQU    T1 
 LABLNM2  EQU    T19
 LABLNUM  EQU    T16
 ZEROFLG  EQU    T18
 LABELS1  EQU    P7 
  
  
*      MISCELLANEOUS EQUATES
  
  
*      LINKAGE FROM CALLING ROUTINES IN OTHER MODULES 
  
 ADDSPCS  KNIL   CGADSPC
 GETSPCS  KNIL   CGGTSPC
 GETSZVG  KNIL   CGGTSZV
 GMOVSZ1  KNIL   CGMVSZ1
 GMOVSZ3  KNIL   CGMVSZ3
 GTADBCP  KNIL   CGGTABP
 LOADC1C2 KNIL   CGLOADC
 STORC4   KNIL   STORC4 
 LOADC4   KNIL   CGLOAD4
 LOADIT1  KNIL   CGLOAD1
 SETBREG  KNIL   CGSETB4
 STORC1C2 KNIL   CGSTORC
 SETXREG  KNIL   CGSETXW
 SETBXPK  KNIL   CGSBXPK
 SETXXPK  KNIL   CGSXXPK
 STORIT1  KNIL   CGSTOR1
 LOADIT2  KNIL   CGLOAD2
 STORIT2  KNIL   CGSTOR2
 LDHILO1  KNIL   CGHILO1
 LDHILO2  KNIL   CGHILO2
 MOVHILO  KNIL   CGMHILO
 MOVWORD  KNIL   CGMVWRD
 STRBLNK  KNIL   CGSTBLK
 SPCFLRT  KNIL   CGAPBLK
 GTSPCLF  KNIL   CGGTSPL
 GTSPCRT  KNIL   CGGTSPR
  
 OP.BDP   IFEQ   OP.BDP,OP.YES
  
 MOVCHAR  KNIL   CGMOVCH
 SPCFILL  KNIL   CGSPCFL
  
 OP.BDP   ENDIF 
  
*      LINKAGE TO CALLED ROUTINES IN OTHER MODULES
  
 REGMOVE  EXECUTE  CGREGMV
          RETURN
 CLITPOOL EXECUTE  LITPOOL
          RETURN
  
 ADNAT    LINK   ADNAT
 ADPDNAT  LINK   ADPDNAT
 MOVES    LINK   MOVES       INTERNAL MOVE, NO SIZE ERROR POSSIBLE
 SCLOAD   LINK   SCLOAD 
 GCONMUL  LINK   GCONMUL     * TO GCONMUL 
 SUBLOAD  LINK   SUBLOAD     * TO GSUBSC
 SCSTORE  LINK   SCSTORE
 SUBDNAT  LINK   SUBDNAT
  
*      SYMBOLIC PARAMETER DEFINITIONS 
  
 FWASOURC SETSY  (FWA$OF,REGB)
 SRCADDR  SETSY  (FWA$OF,MOVEREGA),ADOFSET
 RECADDR  SETSY  (FWA$OF,MOVEREGB)
 RCVADDR  SETSY  (FWA$OF,MOVEREGB),RECOFST
 BLANKS   SETSY  (EXT$OF,C.BLANK) 
 LOCLABL  SETSY  (LOCAL$OF,LABLNUM) 
 LOCLABS1 SETSY  (LOCAL$OF,LABELS1) 
 CBSIZER  SETSY  (EXT$OF,C.SIZER) 
 CBZEROS  SETSY  (EXT$OF,C.ZEROS) 
 LOCLBLE  SETSY  (LOCAL$OF,LABLNM2) 
 LOVALADR SETSY  (EXT$OF,C.LOVAL),HILOFLG 
 CMUBLOCK SETSY  (USETB$OF,USECMU)
 CODBLOCK SETSY  (USETB$OF,USECODE) 
          TITLE  ADDSPCS - ADD SPACES TO A FIELD
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 
*                                                                     * 
** NAME-  ADDSPCS SUBROUTINE (INTERPRETIVE)                           * 
*                                                                     * 
** PURPOSE-                                                           * 
*      GENERATE CODE TO APPEND 0 TO 9 SPACES TO A FIELD               * 
*      GENERATE CODE TO APPEND 0 TO 9 DISPLAY ZEROS TO A FIELD
*      *****
*             NOTE - IN THE COMMENTS WHICH FOLLOW, THE WORD "SPACES"
*                    SHOULD BE REPLACED BY "SPACES OR DISPLAY ZEROS". 
*      *****
* 
*                                                                     * 
** DESCRIPTION-                                                       * 
*      IF NO SPACES ARE TO BE APPENDED- RETURN                        * 
*      IF 1 TO 2 SPACES ARE TO BE APPENDED- GENERATE CODE TO SET AN   * 
*      X-REGISTER TO THE PROPER VALUE (55B OR 5555B), SHIFT IT (IF    * 
*      NECESSARY) AND ADD IT TO THE FIELD IN VREGA                    * 
*      IF 3 TO 9 SPACES ARE TO BE ADDED CALL SUBROUTINE FILLTIX TO    * 
*      CALCULATE THE INDEX OF THE PROPER WORD IN C.FILLT TO PICKUP AND* 
*      GENERATE CODE TO ADD THIS WORD TO THE FIELD IN VREGA           * 
*                                                                     * 
** INPUT                                                              * 
*      FIXED CELL P6 CONTAINS THE BCP OF THE FIELD OF SPACES          * 
*      FIXED CELL P5 CONTAINS THE NUMBER OF SPACES TO ADD             * 
*      (VIRTUAL) X-REG VREGA CONTAINS THE FIELD TO APPEND SPACES TO   * 
*                                                                     * 
** OUTPUT-                                                            * 
*      (VIRTUAL) X-REG VREGA CONTAINS THE FIELD WITH APPENDED SPACES  * 
*                                                                     * 
** SUBROUTINES CALLED-  FILLTIX                                       * 
*                                                                     * 
** MACROS USED- NONE                                                  * 
*                                                                     * 
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 
  
 ADDSPCS  EGO    3
          IFZ    (P5,EQ,K0),RETURN
          IFZ    (P5,GT,2),ADDSP70
  
*      GENERATE CODE TO ADD 1 OR 2 SPACES- SHIFT COUNT=60-6*(P6+P5) 
  
*                  ARITH4: 5555B/100B**(2-FIXED)
*                  ARITH7: 60-6*FIXED 
*                  ARITH4N: 3333B/100B**(2-FIXED) 
          NOTE   ADDSPCS
          IFTHEN  ((TYPEOF,MOVEREGB),EQ,COMP) 
            ANDIF ((TYPEOF,MOVEREGA),NE,GROUP)
            GEN  SXBPK,(VREGOF,VREGZ),,(ARITH4N,P5) 
          ELSEZ 
            GEN  SXBPK,(VREGOF,VREGZ),,(ARITH4,P5)
          ENDIFZ
          ADDZ   P6,P5,SHIFTCT
          IFTHEN (SHIFTCT,NE,10)
            GEN    SHL,VREGZ,(ARITH7,SHIFTCT) 
          ENDIFZ
          GEN    IADD,(VREGOF,VREGA),VREGA,VREGZ
          RETURN
  
*      GENERATE CODE TO APPEND 3 TO 9 SPACES
  
 ADDSP70  LABEL 
          NOTE   ADDSP70
          CALLZ  FILLTIX
          IFTHEN  ((TYPEOF,MOVEREGB),EQ,COMP) 
            ANDIF ((TYPEOF,MOVEREGA),NE,GROUP)
            GEN  SLRBPK,(VREGOF,VREGZ),,((EXT$OF,C.FILL0),P7) 
          ELSEZ 
            GEN  SLRBPK,(VREGOF,VREGZ),,((EXT$OF,C.FILLT),P7) 
          ENDIFZ
          GEN    IADD,(VREGOF,VREGA),VREGZ,VREGA
  
 RETURN     LABEL 
          RETURN
          TITLE  FILLTIX - CALCULATE INDEX INTO C.FILLT TABLE 
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 
*                                                                     * 
** NAME-  FILLTIX SUBROUTINE (INTERPRETIVE)                           * 
*                                                                     * 
** PURPOSE-                                                           * 
*      CALCULATE INDEX INTO C.FILLT OR C.FILL0 TABLE
*                                                                     * 
** DESCRIPTION-                                                       * 
*      INDEX=(10-P5)+P6(15-P6)/2                                      * 
*                                                                     * 
** INPUT                                                              * 
*      FIXED CELL P5 CONTAINS THE NUMBER OF SPACES OR DISPLAY ZEROS 
*      FIXED CELL P6 CONTAINS THE BCP                                 * 
*                                                                     * 
** OUTPUT                                                             * 
*      INDEX IS RETURNED IN FIXED CELL P7                              *
*                                                                     * 
** SUBROUTINES CALLED- NONE                                           * 
*                                                                     * 
** MACROS CALLED- NONE                                                * 
*                                                                     * 
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 
  
 FILLTIX  EGO    3
          SUBZ   15,P6,P7 
          MULTZ  P7,P6,P7 
          QUOTZ  P7,2,P7
          ADDZ   P7,10,P7 
          SUBZ   P7,P5,P7 
          RETURN
          TITLE  GETSPCS - LOAD A FIELD OF SPACES 
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 
*                                                                     * 
** NAME-  GETSPCS SUBROUTINE  (INTERPRETIVE)
*                                                                     * 
** PURPOSE-                                                           * 
*      GENERATE CODE TO LOAD A FIELD OF 0 TO 10 SPACES                * 
*      GENERATE CODE TO LOAD A FIELD OF 0 TO 10 DISPLAY ZEROS 
*      *****
*             NOTE - IN THE COMMENTS WHICH FOLLOW, THE WORD "SPACES"
*                    SHOULD BE REPLACED BY "SPACES OR DISPLAY ZEROS". 
*      *****
* 
*                                                                     * 
** DESCRIPTION-                                                       * 
*      IF NO SPACES ARE TO BE LOADED- RETURN                          * 
*      IF 1 OR 2 SPACES ARE TO BE LOADED GENERATE CODE TO SET AN X    * 
*      REGISTER TO 55B OR 5555B AND SHIFT IF NECESSARY                * 
*      IF 3 TO 9 SPACES ARE TO BE LOADED USE SUBROUTINE FILLTIX TO    * 
*      CALCULATE THE INDEX OF THE FIELD IN C.FILLT THEN GENERATE A    * 
*      LOAD                                                           * 
*      IF 10 SPACES ARE TO BE LOADED GENERATE A SAI   C.BLANK         * 
*      (NOTE- THIS IS DONE SO THAT IF A FULL WORD OF BLANKS WAS LOADED* 
*      PREVIOUSLY OR WILL BE LOADED SUBSEQUENTLY THE ASSEMBLER WILL   * 
*      BE ABLE TO "OPTIMIZE OUT" THIS INSTRUCTION                     * 
*                                                                     * 
** INPUT                                                              * 
*      FIXED CELL P5 CONTAINS THE NUMBER OF SPACES TO LOAD            * 
*      FIXED CELL P6 CONTAINS THE BCP OF THE SPACES FIELD             * 
*                                                                     * 
** OUTPUT                                                             * 
*      (VIRTUAL) X-REG VREGA CONTAINS THE FIELD OF SPACES             * 
*                                                                     * 
** SUBROUTINES CALLED-  FILLTIX                                       * 
*                                                                     * 
** MACROS USED- NONE                                                  * 
*                                                                     * 
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 
  
 GETSPCS  EGO    3
          IFZ    (P5,EQ,K0),RETURN
          IFTHEN  ((LEVELOF,MOVEREGA),EQ,LITLEVL) 
            MOVEZ  (ZEROSOF,MOVEREGA),ZEROFLG 
          ELSEZ 
            MOVEZ  0,ZEROFLG
          ENDIFZ
          IFZ    (P5,EQ,10),GETSP70 
          IFZ    (P5,GT,2),GETSP50
  
*      GENERATE CODE TO SET AN X-REG TO 1 OR 2 SPACES AND SHIFT 
*      SHIFT COUNT=60-6*(P5+P6) 
  
*                  ARITH4: 5555B/100B**(2-FIXED)
*                  ARITH7: 60-6*FIXED 
*                  ARITH4N: 3333B/100B**(2-FIXED) 
          NOTE   GETSPCS
          IFTHEN  (ZEROFLG,NE,0)
            GEN  SXBPK,(VREGOF,VREGA),,(ARITH4N,P5) 
            BRANCH  GETSP1
          ENDIFZ
          IFTHEN  ((TYPEOF,MOVEREGB),EQ,COMP) 
            ANDIF ((TYPEOF,MOVEREGA),NE,GROUP)
            GEN  SXBPK,(VREGOF,VREGA),,(ARITH4N,P5) 
          ELSEZ 
            GEN  SXBPK,(VREGOF,VREGA),,(ARITH4,P5)
          ENDIFZ
 GETSP1   LABEL 
          ADDZ   P5,P6,SHIFTCT
          IFTHEN (SHIFTCT,NE,10)
            GEN    SHL,VREGA,(ARITH7,SHIFTCT) 
          ENDIFZ
          RETURN
  
*      GENERATE CODE TO PICK UP A FIELD OF 3 TO 9 SPACES
  
 GETSP50  LABEL 
          NOTE   GETSP50
          CALLZ  FILLTIX
          IFTHEN  (ZEROFLG,NE,0)
            GEN  SLRBPK,(VREGOF,VREGA),,((EXT$OF,C.FILL0),P7) 
            RETURN
          ENDIFZ
          IFTHEN  ((TYPEOF,MOVEREGB),EQ,COMP) 
            ANDIF ((TYPEOF,MOVEREGA),NE,GROUP)
            GEN  SLRBPK,(VREGOF,VREGA),,((EXT$OF,C.FILL0),P7) 
          ELSEZ 
            GEN  SLRBPK,(VREGOF,VREGA),,((EXT$OF,C.FILLT),P7) 
          ENDIFZ
          RETURN
  
*      GENERATE CODE TO PICK UP A FULL WORD OF SPACES 
  
 GETSP70  LABEL 
          NOTE   GETSP70
          IFTHEN  (ZEROFLG,NE,0)
            GEN  SLRBPK,(VREGOF,VREGA),,CBZEROS 
            RETURN
          ENDIFZ
          IFTHEN  ((TYPEOF,MOVEREGB),EQ,COMP) 
            ANDIF ((TYPEOF,MOVEREGA),NE,GROUP)
            GEN  SLRBPK,(VREGOF,VREGA),,CBZEROS 
          ELSEZ 
            GEN  SLRBPK,(VREGOF,VREGA),,BLANKS
          ENDIFZ
          MOVEZ  VREGA,VREGB
          RETURN
          TITLE  GETSZVG - GET SIZE OF VARIABLE-SIZE GROUP
************************************************************************
*                                                                      *
** NAME-  GETSZVG SUBROUTINE                                           *
*                                                                      *
** PURPOSE-                                                            *
*      GENERATE CODE TO CALCULATE THE SIZE OF A VARIABLE-SIZE GROUP    *
*                                                                      *
** DESCRIPTION-                                                        *
*      GMOVE IS CALLED TO GENERATE CODE TO LOAD THE OCCURS DEPENDING ON*
*      ITEM INTO A TEMP REG                                            *
*      CODE IS GENERATED TO MULTIPLY THIS BY THE OCCURENCE LENGTH OF   *
*      THE ITEM CONTAINING THE OCCURS DEPENDING ON CLAUSE AND ADD THIS *
*      TO THE ROOT LENGTH (= THE SIZE OF THE GROUP MINUS THE MAXIMUM   *
*      SIZE OF THE ITEM CONTAINING THE OCCURS DEPENDING ON CLAUSE) OF  *
*      THE GROUP                                                       *
*                                                                      *
** INPUT-                                                              *
*      MOVEREGM CONTAINS INFORMATION ABOUT THE VARGROUP                *
*                                                                      *
** OUTPUT-                                                             *
*      P1 CONTAINS THE NUMBER OF THE VIRTUAL X-REG WHICH CONTAINS THE  *
*      SIZE OF THE GROUP                                               *
*                                                                      *
************************************************************************
  
 GETSZVG  EGO    3
  
*      SAVE MOVEREGA AND MOVEREGB AROUND THE GMOVE CALL 
  
          MOVEZ  MOVEREGA,INSTREGA
          MOVEZ  MOVEREGB,INSTREGB
  
*      THE FIRST THING WE HAVE TO DO IS GENERATE CODE TO PICK UP THE
*      OCCURS DEPENDING ON ITEM.  TO DO THIS WE WILL CALL GMOVER. 
*      GMOVER REQUIRES AS INPUT:  
*         1 A DESCRIPTION OF THE SOURCE FIELD (THE OCCURS DEPENDING ON
*           ITEM) CONTAINING A POINTER TO ITS DNAT IN REGB (MOVEREGA) 
*         2 A DESCRIPTION TO THE RECEIVING FIELD (A TEMP COMP-1 REGISTER
*           IN REGC (MOVEREGB)
  
*      SET UP A REGTABLE ENTRY TO DESCRIBE THE OCCURS DEPENDING ON ITEM 
*      AND PUT THE POINTER TO THE CORRECT DNAT ENTRY IN THE REG TABLE 
  
          MOVEZ  0,P1 
          MOVEZ  MOVEREGX,P2
          CALLZ  REGMOVE
          MOVEZ  GDATAREF,(GCODEOF,MOVEREGX)
          MOVEZ  (DEPNAMOF,MOVEREGM),(GPTROF,MOVEREGX)
          MOVEZ  (EQUALS,MOVEREGX),MOVEREGA 
  
*      SET UP A REGTABLE ENTRY AND A DNAT TO DESCRIBE THE COMP-1 TEMP 
*      RECEIVING FIELD
  
          MOVEZ  (EQUALS,MOVEREGY),REGT 
          CALLZ  ADNAT
          MOVEZ  COMP1,(TYPEOF,REGT)
          MOVEZ  0,(POINTOF,REGT) 
          MINZ   8,(NUMLENOF,MOVEREGA),(NUMLENOF,REGT)
          MOVEZ  REGT,MOVEREGB
  
*      GENERATE CODE TO MOVE OCCURS DEPENDING ON ITEM TO TEMP REGISTER
  
          CALLZ  MOVES
  
*      GENERATE CODE TO CALCULATE THE NUMBER OF CHARS OF THE GROUP TO 
*      MOVE 
  
          NOTE   GETSZVG
  
          MOVEZ  (SUBOCCLN,MOVEREGM),P1 
          MOVEZ  (TREGOF,MOVEREGB),P2 
          CALLZ  GCONMUL
          MOVEZ  P3,VREGV 
          MOVEZ  (ROOTLNOF,MOVEREGM),P1 
          CALLZ  SETXXPK
          MOVEZ  VREGV,P1 
  
*      RETURN TEMP DNAT 
  
          CALLZ  SUBDNAT
  
*      RETURN MOVEREGA AND MOVEREGB TO THEIR ORIGINAL USE 
  
          MOVEZ  INSTREGA,MOVEREGA
          MOVEZ  INSTREGB,MOVEREGB
  
          RETURN
          TITLE  GMOVSZ1 - CHECK FOR ON SIZE ERROR CODE 
************************************************************************
*                                                                      *
** NAME   GMOVSZ1 SUBROUTINE                                           *
*                                                                      *
** PURPOSE-                                                            *
*      CHECK TO SEE IF ON SIZE ERROR CODE IS WANTED AND IF SO CALL     *
*      SUBROUTINE GMOVSZ2 TO GENERATE CODE.                            *
*                                                                      *
** DESCRIPTION-                                                        *
*      IF SIZE ERROR CODE IS WANTED-                                   *
*         IF RECEIVING FIELD IS NOT A TEMP- GENERATE A LOCAL LABEL     *
*         NUMBER AND CALL GMOVSZ2. (IF THERE IS A SIZE ERROR, GMOVSZ2  *
*         WILL GENERATE A JUMP TO THIS LOCAL LABEL WHICH WILL BE       *
*         GENERATED AFTER THE MOVE BY GMOVSZ3).                        *
*         IF RECEIVING FIELD IS A TEMP- GIVE THE LOCAL LABEL NUMBER    *
*         IN SZRLABL TO GMOVSZ2.  (IF THERE IS A SIZE ERROR, GMOVSZ    *
*         WILL GENERATE A JUMP TO THIS LABEL WHICH WILL BE GENERATED   *
*         BY THE SIZE-END VERB PROCESSOR).                             *
*                                                                      *
** INPUT-                                                              *
*      FIXED CELL SIZESW IS NON-ZERO IF SIZE ERROR CODE IS WANTED FOR  *
*      NON-TEMP RECEIVING FIELDS.                                      *
*      FIXED CELL MOVESIZE IS NON-ZERO IF SIZE ERROR CODE IS WANTED FOR*
*      TEMP RECEIVING FIELDS                                           *
*                                                                      *
** OUTPUT-                                                             *
*      FIXED CELL LABELS1 CONTAINS A LOCAL LABEL NUMBER FOR GMOVSZ3    *
*                                                                      *
************************************************************************
  
 GMOVSZ1  EGO    3
          MOVEZ  0,SIZELABL 
          IFZ    ((LEVELOF,MOVEREGB),EQ,TEMPLEVL),GMOVSZ1T
          IFZ    (SIZESW,EQ,0),RETURN 
  
*      SIZE ERROR CODE IS WANTED FOR A NON-TEMPORARY RECEIVING FIELD
  
          NOTE   GMOVSZ1
          MOVEZ  (LOCLAB,LABELS1),LABELS1 
          CALLZ  GMOVSZ2
          RETURN
          SPACE  4
*      CHECK TO SEE IF SIZE ERROR CODE IS WANTED FOR A TEMPORARY
*      RECEIVING FIELD
  
 GMOVSZ1T LABEL 
          IFZ    (MOVESIZE,EQ,0),RETURN 
  
*      SIZE ERROR CODE IS WANTED
  
          NOTE   GMOVSZ1T 
          MOVEZ  (LOCLAB,LABELS1),LABELS1 
          CALLZ  GMOVSZ2
          MOVEZ  (LOCLAB,T1),T1 
          GEN    EQ$,,,((LOCAL$OF,T1))
          GEN    LABEL$,LOCLABS1
          GEN    SXBPB,(VREGOF,VREG3),R1,R0 
          GEN    SSRBPK,VREG3,,((EXT$OF,C.SIZER)) 
          GEN    EQ$,,,((LOCAL$OF,SZRLABL)) 
          GEN    LABEL$,((LOCAL$OF,T1)) 
          RETURN
          TITLE  GMOVSZ2 -  GENERATE CHECK FOR SIZE ERROR 
**        GMOVSZ2 -  GENERATE CHECK FOR SIZE ERROR
* 
*         REGB = REGTABL INDEX TO SOURCE REGISTER OR ITEM 
*         REGC = REGTABL INDEX TO DESTINATION ITEM OR REGISTER
*         LOCLABS1 = LABEL TO JUMP TO IF SIZE ERROR 
* 
*         CALLZ  GMOVSZ2
* 
*         IF NECESSARY, GENERATES CODE TO CHECK FOR SIZE ERROR
*           AND JUMP TO *LOCLABS1*. 
*         IF CODE WAS GENERATED AND DESTINATION IS NOT A REGISTER,
*           SETS SIZELABL = 1,
*         ELSE
*           SETS SIZELABL = 0.
* 
*         IF REGB POINTS TO AN ITEM INSTEAD OF A REGISTER,
*           GMOVE WILL BE CALLED PSEUDO-RECURSIVELY.
*           THE CONDITION CAUSING SIZE ERROR PROCESSING WILL BE TURNED
*           OFF TO AVOID INFINITE RECURSION.
* 
  
  
 GMOVSZ2  EGO    3
          MOVEZ  0,SIZELABL 
          IFZ    ((TYPEOF,REGB),EQ,COMP2),GMOVSZ20
          IFZ    ((TYPEOF,REGB),EQ,DPCOMP2),GMOVSZ20
          IFZ    ((INTLENOF,REGB),LE,(INTLENOF,REGC)),RETURN
 GMOVSZ20 LABEL 
  
          IFTHEN ((LEVELOF,REGC),NE,TEMPLEVL) 
            MOVEZ  1,SIZELABL 
            ENDIFZ
  
*      SET REGT = REGTABL INDEX OF SOURCE REGISTER
  
          IFTHEN ((LEVELOF,REGB),EQ,TEMPLEVL) 
            MOVEZ  REGB,REGT
          ELSEZ 
            MOVEZ  REGU5,REGT 
            CALLZ  ADNAT
            MOVEZ  (NUMLENOF,REGB),(NUMLENOF,REGU5) 
            MOVEZ  (POINTOF,REGB),(POINTOF,REGU5) 
            MOVEZ  0,(SIGNOF,REGU5) 
***** 
            MOVEZ  0,SIZESW 
            MOVEZ  (TYPEOF,REGB),(TYPEOF,REGT)
            PUSH   REGC 
            MOVEZ  REGT,REGC
          CALLZ  MOVES
            POP    REGC 
            MOVEZ  1,SIZESW 
            MOVEZ  REGU5,REGT 
            ENDIFZ
  
          GOTOCASE  (TYPEOF,REGB) 
            CASE    COMP,GMOVSZ21 
            CASE    COMP1,GMOVSZ23
            CASE    COMP2,GMOVSZ25
            CASE    DPCOMP2,GMOVSZ26
            ENDCASE 
          ERROR 
          RETURN
  
  
*                            SOURCE IS REGISTER NUMERIC 
 GMOVSZ21 LABEL 
          IFZ    ((TYPEOF,REGC),EQ,COMP2),RETURN
          MOVEZ  (TREGOF,REGT),VREG1
          MOVEZ  (TREGP1OF,REGT),VREG2
          MOVEZ  (NUMLENOF,REGT),T1 
          IFZ    ((SIGNOF,REGT),EQ,0),GMOVSZ22   IF SOURCE SIGNED 
  
          NOTE   GMOVSZ21 
          IFTHEN (T1,LE,9)                       IF 1 REGISTER
            GEN    XMIT,(VREGOF,VREG3),VREG1
            GEN    SHR,VREG3,59 
            GEN    LXOR,(VREGOF,VREG1),VREG1,VREG3
            ENDIFZ
  
          IFTHEN (T1,EQ,10)                      IF 1 REGISTER WITH SIGN
            GEN    SHR,VREG1,59 
            GEN    LXOR,(VREGOF,VREG1),VREG2,VREG1
            ENDIFZ
  
          IFTHEN (T1,GT,10)                      IF 2 REGISTERS 
            GEN    XMIT,(VREGOF,VREG3),VREG1
            GEN    SHR,VREG3,59 
            GEN    LXOR,(VREGOF,VREG1),VREG1,VREG3
            GEN    LXOR,(VREGOF,VREG2),VREG2,VREG3
            ENDIFZ
  
*                            SOURCE IS NUMERIC DISPLAY REGISTER 
*                            SOURCE IS UNSIGNED IN VREG1, VREG2 
*                            T1 = NUMLENOF SOURCE 
 GMOVSZ22 LABEL 
          NOTE   GMOVSZ22 
  
          ADDZ   (POINTOF,REGB),(INTLENOF,REGC),T2
          IFZ    (T2,LE,0),GMOVSZ28              IF (E.G.) 9V9 TO P99 
          IFTHEN (T2,GT,10)            2 REG SOURCE INTERESTING DIGITS
*                                      UPPER PART 
            GEN    SLRBPK,(VREGOF,VREG4),,CBZEROS 
            SUBZ   T2,10,T3 
            GEN    MASK,(VREGOF,VREG3),(ARITH7,T3)
            GEN    LXOR,(VREGOF,VREG4),VREG4,VREG1
            GEN    LAND,(VREGOF,VREG4),VREG4,VREG3
            GEN    NZ$,VREG4,LOCLABS1 
          ENDIFZ
          IFTHEN (T2,LE,10) 
            ANDIF  (T1,GT,10)          2 REG SOURCE INTERESTING DIGITS
*                                      IN LOWER PART
            GEN    SLRBPK,(VREGOF,VREG3),,CBZEROS 
            GEN    LXOR,(VREGOF,VREG4),VREG1,VREG3
            GEN    NZ$,VREG4,LOCLABS1 
            GEN    MASK,(VREGOF,VREG4),(ARITH7,T2)
            GEN    LXOR,(VREGOF,VREG3),VREG3,VREG2
            GEN    LAND,(VREGOF,VREG3),VREG3,VREG4
            GEN    NZ$,VREG3,LOCLABS1 
          ENDIFZ
          IFTHEN (T2,LE,10) 
            ANDIF  (T1,LE,10)          1 REG SOURCE 
            GEN    SLRBPK,(VREGOF,VREG3),,CBZEROS 
            GEN    MASK,(VREGOF,VREG4),(ARITH7,T2)
            GEN    LXOR,(VREGOF,VREG3),VREG3,VREG1
            GEN    LAND,(VREGOF,VREG3),VREG3,VREG4
            GEN    NZ$,VREG3,LOCLABS1 
          ENDIFZ
  
          IFTHEN ((LEVELOF,REGB),NE,TEMPLEVL)    IF USED TEMP DNAT
            CALLZ  SUBDNAT                         DELETE REGU5 DNAT
            ENDIFZ
  
          RETURN
  
  
*                            SOURCE IS COMP-1 
 GMOVSZ23 LABEL 
          ADDZ   (POINTOF,REGB),(INTLENOF,REGC),T2
          IFZ    (T2,LE,0),GMOVSZ29              IF (E.G.) 999 TO V99 
          NOTE   GMOVSZ23 
          IFZ    ((TYPEOF,REGC),EQ,COMP2),RETURN
          IFTHEN ((SIGNOF,REGT),EQ,1)            IF SOURCE IS SIGNED
            GEN    XMIT,(VREGOF,VREG3),(TREGOF,REGT)
            GEN    SHR,VREG3,59 
            GEN    LXOR,(VREGOF,VREG1),(TREGOF,REGT),VREG3
          ELSEZ 
            MOVEZ  (TREGOF,REGT),VREG1
            ENDIFZ
  
          IFTHEN ((LEVELOF,REGB),NE,TEMPLEVL)    IF USED TEMP DNAT
            CALLZ  SUBDNAT                         DELETE REGU5 DNAT
            ENDIFZ
  
          MOVEZ  REGU5,REGT 
          CALLZ  ADPDNAT                         CREATE PERMANENT DNAT
          MOVEZ  0,(BCPOF,REGU5)
          MOVEZ  10,(BYTLENOF,REGU5)
          MOVEZ  1,P2 
          ADDZ   (POINTOF,REGB),(INTLENOF,REGC),T2
 GMOVSZ24 LABEL 
          MULTZ  P2,10,P2 
          SUBZ   T2,1,T2
          IFZ    (T2,NE,0),GMOVSZ24 
          MOVEZ  0,P1                            P2 = VALUE, NOT ADDRESS
          EXECUTE  LITPOOL                       ((FWA$OF,REGT)) _ LIT. 
          GEN    SLRBPK,(VREGOF,VREG4),((FWA$OF,REGT))
          GEN    ISUB,(VREGOF,VREG3),VREG1,VREG4
          GEN    PL$,VREG3,LOCLABS1 
          RETURN
  
  
*                            SOURCE IS COMP-2 
 GMOVSZ25 LABEL 
          IFZ    ((TYPEOF,REGC),EQ,COMP2),GMOVSZ27
          IFZ    ((TYPEOF,REGC),EQ,DPCOMP2),GMOVSZ27
          NOTE   GMOVSZ25 
  
          IFTHEN ((SIGNOF,REGT),EQ,1)            IF SOURCE SIGNED 
            GEN    XMIT,(VREGOF,VREG3),(TREGOF,REGT)
            GEN    SHR,VREG3,59 
            GEN    LXOR,(VREGOF,VREG1),(TREGOF,REGT),VREG3
          ELSEZ 
            MOVEZ  (TREGOF,REGT),VREG1
            ENDIFZ
  
          IFTHEN ((LEVELOF,REGB),NE,TEMPLEVL)    IF USED TEMP DNAT
            CALLZ  SUBDNAT                         DELETE REGU5 DNAT
            ENDIFZ
  
          MOVEZ  REGU5,REGT 
          CALLZ  ADPDNAT                         CREATE PERMANENT DNAT
          MOVEZ  0,(BCPOF,REGU5)
          MOVEZ  10,(BYTLENOF,REGU5)
          ADDZ   (INTLENOF,REGC),(POINTOF,REGB),P1
          EXECUTE  MAXR2VAL  (P1,P2)             P2 = MAX. COMP-2 VALUE 
          MOVEZ  0,P1                            P2 = VALUE, NOT ADDRESS
          EXECUTE  LITPOOL                       ((FWA$OF,REGT)) _ LIT. 
  
          GEN    ID$,VREG1,LOCLABS1 
*         NOTICE THAT AN OUT-OF-RANGE VALUE WILL FAIL THE SUBTRACT
          GEN    SLRBPK,(VREGOF,VREG4),,((FWA$OF,REGT)) 
          GEN    ISUB,(VREGOF,VREG3),VREG4,VREG1
          GEN    NG$,VREG3,LOCLABS1 
          RETURN
  
  
*                            SOURCE IS D.P. COMP-2
 GMOVSZ26 LABEL 
          IFZ    ((TYPEOF,REGC),EQ,COMP2),GMOVSZ27
          IFZ    ((TYPEOF,REGC),EQ,DPCOMP2),GMOVSZ27
          NOTE   GMOVSZ26 
  
          IFTHEN  ((POINTOF,REGB),NE,0) 
*                            SCALE BEFORE CONSTRUCTING LITERAL
            MULTZ  (POINTOF,REGB),2,T1
            GEN    SLRBPK,(VREGOF,VREG4),,((EXT$OF,C.DTENS),T1) 
            GEN    SLRAPB,(VREGOF,VREG5),VREG4,VREGB1 
            GENM    MULTDDD 
              REGP (TREGOF,REGB),(TREGP1OF,REGB),VREG4,VREG5,(VREGOF,VRE
,G1),(VREGOF,VREG2) 
            ENDM
            MOVEZ  VREG1,(TREGOF,REGB)
            MOVEZ  0,(POINTOF,REGB) 
          ENDIFZ
          IFTHEN ((SIGNOF,REGT),EQ,1)            IF SOURCE SIGNED 
            GEN    XMIT,(VREGOF,VREG3),(TREGOF,REGT)
            GEN    SHR,VREG3,59 
            GEN    LXOR,(VREGOF,VREG1),(TREGOF,REGT),VREG3
            GEN    LXOR,(VREGOF,VREG2),(TREGP1OF,REGT),VREG3
          ELSEZ                                  IF SOURCE UNSIGNED 
            MOVEZ  (TREGOF,REGT),VREG1
            MOVEZ  (TREGP1OF,REGT),VREG2
            ENDIFZ
  
          IFTHEN ((LEVELOF,REGB),NE,TEMPLEVL)    IF USED TEMP DNAT
            CALLZ  SUBDNAT                         DELETE REGU5 DNAT
            ENDIFZ
  
          MOVEZ  REGU5,REGT 
          CALLZ  ADPDNAT                         CREATE PERMANENT DNAT
          MOVEZ  0,(BCPOF,REGU5)
          MOVEZ  20,(BYTLENOF,REGU5)
          ADDZ   (POINTOF,REGB),(INTLENOF,REGC),P1    INDICATE MAX. VAL 
          EXECUTE  MAXR4VAL (P1,P2,P3)           P2,P3 = MAX. DPCOMP2 
          MOVEZ  0,P1                            P2,P3 = VALUE, " ADDR. 
          EXECUTE  LITPOOL                       ((FWA$OF,REGT)) _ LIT. 
  
          GEN    ID$,VREG1,LOCLABS1 
*         NOTICE THAT AN OUT-OF-RANGE VALUE WILL FAIL THE SUBTRACT
          GEN    SLRBPK,(VREGOF,VREG4),,((FWA$OF,REGT)) 
          GEN    ISUB,(VREGOF,VREG3),VREG4,VREG1
          GEN    NG$,VREG3,LOCLABS1 
          MOVEZ  (LOCLAB,T1),T1 
          GEN    NZ$,VREG3,((LOCAL$OF,T1))
          GEN    SLRAPB,(VREGOF,VREG5),VREG4,VREGB1 
          GEN    ISUB,(VREGOF,VREG3),VREG5,VREG2
          GEN    NG$,VREG3,LOCLABS1 
          GEN    LABEL$,((LOCAL$OF,T1)) 
          RETURN
          SPACE  3
 GMOVSZ27 LABEL 
          NOTE   GMOVSZ27 
          GEN    ID$,(TREGOF,REGT),,LOCLABS1
          GEN    OR$,(TREGOF,REGT),,LOCLABS1
          IFTHEN ((LEVELOF,REGB),NE,TEMPLEVL) 
            CALLZ  SUBDNAT
          ENDIFZ
          RETURN
  
  
*                            SOURCE IS NUMERIC DISPLAY
*                            NOTHING OF SOURCE IS MOVED TO DESTINATION
*                            E.G.  9(6)PPP TO 99. 
*                            T1 = (NUMLENOF,REGB) 
*                            VREG1 = (MOST) SIGNIFICANT UNSIGNED
*                                      SOURCE DIGITS. 
*                            VREG2 = (IF T1 > 10), LEAST SIGNIFICANT
*                                      UNSIGNED SOURCE DIGITS.
 GMOVSZ28 LABEL 
          NOTE   GMOVSZ28 
          GEN    SLRBPK,(VREGOF,VREG4),,((EXT$OF,C.ZEROS))
          GEN    ISUB,(VREGOF,VREG3),VREG1,VREG4
          GEN    NZ$,VREG3,LOCLABS1 
          IFZ    (T1,LE,10),RETURN               IF 1-REGISTER SOURCE 
          GEN    ISUB,(VREGOF,VREG3),VREG2,VREG4
          GEN    NZ$,VREG3,LOCLABS1 
          RETURN
  
  
*                            SOURCE IS COMP-1 
*                            NOTHING OF SOURCE IS MOVED TO DESTINATION
*                            E.G. 9(14)V9(2) TO P(2)9(8)
 GMOVSZ29 LABEL 
          NOTE   GMOVSZ29 
          GEN    NZ$,(TREGOF,REGT),LOCLABS1 
          RETURN
          TITLE  GMOVSZ3 - GENERATE LABEL FOR ON SIZE ERROR PROCESSING
************************************************************************
*                                                                      *
** NAME-  GMOVSZ3 SUBROUTINE                                           *
*                                                                      *
** PURPOSE-                                                            *
*      SET C.SIZER IF SIZE ERROR CODE WAS EXECUTED                     *
*                                                                      *
** DESCRIPTION                                                         *
*      IF SIZE ERROR CODE HAS BEEN GENERATED-                          *
*         1) GENERATE A JUMP AROUND FOLLOWING CODE FOR CASES WHICH DONT*
*            HAVE A SIZE ERROR                                         *
*         2) GENERATE A LABEL FOR SIZE ERROR CODE TO BRANCH TO         *
*         3) SET C.SIZER NON-ZERO                                      *
*                                                                      *
** INPUT-                                                              *
*      FIXED CELL SIZELABL IS NON-ZERO IF A LABEL IS WANTED            *
*      FIXED CELL LABELS1 CONTAINS THE LOCAL LABEL NUMBER              *
*                                                                      *
** OUTPUT-                                                             *
*                                                                      *
************************************************************************
  
 GMOVSZ3  EGO    3
          IFZ    (SIZELABL,EQ,0),RETURN 
          NOTE   GMOVSZ3
          MOVEZ  (LOCLAB,LABLNUM),LABLNUM 
          GEN    EQ$,,,LOCLABL
          GEN    LABEL$,LOCLABS1
          GEN    SXBPB,(VREGOF,VREGA),,VREGB1 
          GEN    SSRBPK,VREGA,,CBSIZER
          GEN    LABEL$,LOCLABL 
          RETURN
          TITLE  GTADBCP - GET ADDRESS AND BCP OF SUBSCRIPTED ITEM
************************************************************************
*                                                                      *
** NAME-  GTADBCP SUBROUTINE                                           *
*                                                                      *
** PURPOSE-                                                            *
*      GENERATE CODE TO CALCULATE THE FWA AND BCP OF A SUBSCRUPTED ITEM*
*                                                                      *
** DESCRIPTION-                                                        *
*      THE CHAR OFFSET OF THE ITEM IS CALCULATED BY ADDING THE BCP OF  *
*      THE "0-TH" OCCURRENCE OF THE ITEM TO THE OFFSET * OCC LEN       *
*      THEN FWA = CHAR OFFSET / 10 + FWA OF "O-TH" OCCURRENCE OF ITEM  *
*      AND BCP = (CHAR OFFSET) MOD 10                                  *
*                                                                      *
** INPUT-                                                              *
*      P1 = GSCODE FIELD OF REG                                        *
*      P2 = BCP OF "0-TH" OCCURRENCE OF ITEM                           *
*      VREG4 = X-REG CONTAINING FWA OF "0-TH" OCCURRENCE OF ITEM       *
*                                                                      *
** OUTPUT-                                                             *
*      VREG4 = FWA OF ITEM                                             *
*      VREG5 = BCP OF ITEM                                             *
*                                                                      *
************************************************************************
  
 GTADBCP  EGO    3
          CALLZ  SUBLOAD
          GEN    SHR,P1,30                            OFFSET * OCC LEN
          MOVEZ  P1,VREGV 
          MOVEZ  P2,P1
          CALLZ  SETXXPK
          GEN    SXBPK,(VREGOF,VREGY),,314632B        (1/10) * 2**20
          GEN    IMUL,(VREGOF,VREGZ),VREGY,VREGV      (N/10) * 2**20
          GEN    SHR,VREGZ,20                         N/10
          GEN    IADD,(VREGOF,VREG4),VREGZ,VREG4      FWA 
          GEN    IADD,(VREGOF,VREGY),VREGZ,VREGZ      2*(N/10)
          GEN    SHL,VREGZ,3                          8*(N/10)
          GEN    IADD,(VREGOF,VREGZ),VREGZ,VREGY      10*(N/10) 
          GEN    ISUB,(VREGOF,VREG5),VREGV,VREGZ      BCP 
          RETURN
          TITLE  GTSPCLF - GET A FIELD OF LEFT-JUSTIFIED SPACES 
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 
*                                                                     * 
** NAME-  GTSPCLF SUBROUTINE                                          * 
*                                                                     * 
*      *****
*             NOTE - IN THE COMMENTS WHICH FOLLOW, THE WORD "SPACES"
*                    SHOULD BE REPLACED BY "SPACES OR DISPLAY ZEROS". 
*      *****
* 
** PURPOSE-                                                           * 
*      GENERATE CODE TO GET A FIELD OF LEFT-JUSTIFIED SPACES FOR      * 
*      MOVES OF LITERALS WHOSE VALUE IS SPACES.                       * 
*                                                                     * 
** DESCRIPTION-                                                       * 
*      IF 10 SPACES ARE TO BE LOADED GENERATE  SAI  C.BLANK           * 
*                                          OR 
*                                              SAI   C.ZERO 
*      ELSE GENERATE  SAJ   C.BLANK                                   * 
*                 OR
*                     SAJ   C.ZERO
*                     MXK   6*A                                       * 
*                     BXI   XK*XJ                                     * 
*                                                                     * 
** INPUT                                                              * 
*      FIXED CELL P6 CONTAINS THE NUMBER OF SPACES TO LOAD (=A)       * 
*                                                                     * 
** OUTPUT                                                             * 
*      (VIRTUAL) X-REG VREGA CONTAINS THE FIELD OF SPACES             * 
*                                                                     * 
** NOTES-                                                             * 
*      THIS ROUTINE EXISTS FOR OPTIMIZING MOVES OF LITERALS WHOSE     * 
*      VALUE IS SPACES.  THE LOAD OF C.BLANK WILL BE THROWN OUT BY THE* 
*      ASSEMBLER SINCE IT HAS BEEN DONE PREVIOUSLY.  THE MASK         * 
*      INSTRUCTION WILL BE REPEATED (AND HENCE THROWN OUT) WHEN THIS  * 
*      FIELD IS STORED BY STORIT2. HENCE THE LOAD BECOMES A LAND      * 
*                                                                     * 
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 
  
 GTSPCLF  EGO    3
          IFZ    (P6,NE,10),GTSPL50 
  
*      GENERATE CODE TO LOAD 10 SPACES
  
          NOTE   GTSPCLF
          IFTHEN  ((TYPEOF,MOVEREGB),EQ,COMP) 
            GEN  SLRBPK,(VREGOF,VREGA),,CBZEROS 
          ELSEZ 
            GEN  SLRBPK,(VREGOF,VREGA),,BLANKS
          ENDIFZ
          MOVEZ  VREGA,VREGB       (FOR STORIT2)
          RETURN
          SPACE  4
*      GENERATE CODE TO LOAD 1 TO 9 SPACES
  
 GTSPL50  LABEL 
          NOTE   GTSPL50
          IFTHEN  ((TYPEOF,MOVEREGB),EQ,COMP) 
            GEN  SLRBPK,(VREGOF,VREGB),,CBZEROS 
          ELSEZ 
            GEN  SLRBPK,(VREGOF,VREGB),,BLANKS
          ENDIFZ
          GEN    MASK,(VREGOF,VREGZ),(ARITH8,P6)
          GEN    LAND,(VREGOF,VREGA),VREGZ,VREGB
          RETURN
          TITLE  GTSPCRT - GET A FIELD OF RIGHT JUSTIFIED SPACES
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 
*                                                                     * 
** NAME-  GTSPCRT SUBROUTINE                                          * 
*                                                                     * 
*      *****
*             NOTE - IN THE COMMENTS WHICH FOLLOW, THE WORD "SPACES"
*                    SHOULD BE REPLACED BY "SPACES OR DISPLAY ZEROS". 
*      *****
* 
** PURPOSE-                                                           * 
*      GENERATE CODE TO GET A FIELD OF RIGHT-JUSTIFIED SPACES FOR     * 
*      MOVES OF LITERALS WHOSE VALUE IS SPACES                        * 
*                                                                     * 
** DESCRIPTION-                                                       * 
*      IF 10 SPACES ARE TO BE LOADED GENERATE  SAI   C.BLANK          * 
*                                          OR 
*                                              SAI   C.ZERO 
*      ELSE GENERATE  SAJ    C.BLANK                                  * 
*                 OR
*                     SAJ    C.ZERO 
*                     MXK    6*(10-A)                                 * 
*                     BXI    -XK*XI                                   * 
*                                                                     * 
** INPUT-                                                             * 
*      FIXED CELL P5 CONTAINS THE NUMBER OF SPACES TO LOAD (=A)       * 
*                                                                     * 
** OUTPUT-                                                            * 
*      (VIRTUAL) X-REG VREGA CONTAINS THE FIELD OF SPACES             * 
*                                                                     * 
** NOTES-                                                             * 
*      THIS ROUTINE EXISTS FOR OPTIMIZING MOVES OF LITERALS WHOSE     * 
*      VALUE IS SPACES.  IT IS USED IN CASES WHERE MORE THAN ONE LOAD * 
*      IS NECESSARY HENCE ALL FOLLOWING LOADS OF C.BLANK ARE THROWN   * 
*      OUT BY THE ASSEMBLER.                                          * 
*                                                                     * 
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 
  
 GTSPCRT  EGO    3
          IFZ    (P5,NE,10),GTSPR50 
  
*      GENERATE CODE TO LOAD 10 SPACES
  
          NOTE   GTSPCRT
          IFTHEN  ((TYPEOF,MOVEREGB),EQ,COMP) 
            GEN  SLRBPK,(VREGOF,VREGA),,CBZEROS 
          ELSEZ 
            GEN  SLRBPK,(VREGOF,VREGA),,BLANKS
          ENDIFZ
          MOVEZ  VREGA,VREGB       (FOR STORIT2)
          RETURN
          SPACE  4
*      GENERATE CODE TO LOAD 1 TO 9 SPACES
  
*                  ARITH7: 60-6*FIXED 
 GTSPR50  LABEL 
          NOTE   GTSPR50
          IFTHEN  ((TYPEOF,MOVEREGB),EQ,COMP) 
            GEN  SLRBPK,(VREGOF,VREGB),,CBZEROS 
          ELSEZ 
            GEN  SLRBPK,(VREGOF,VREGB),,BLANKS
          ENDIFZ
          GEN    MASK,(VREGOF,VREGZ),(ARITH7,P5)
          GEN    LIMP,(VREGOF,VREGA),VREGB,VREGZ
          RETURN
          TITLE  LDHILO1 - LOAD FIRST WORD OF HIGH-VALUES OR LOW-VALUES 
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 
*                                                                     * 
** NAME-  LDHILO1 SUBROUTINE                                           *
*                                                                     * 
** PURPOSE-                                                           * 
*         LOAD THE FIRST FIELD OF A HIGH-VALUES OR LOW-VALUES SOURCE   *
*         ITEM                                                         *
*                                                                     * 
** DESCRIPTION-                                                       * 
*         IF THE FIELD IS A FULL WORD GENERATE                         *
*                SAJ   KL+HILOFLG                                      *
*         IF THE FIELD IS NOT A FULL WORD BUT BEGINS ON A WORD BOUNDARY*
*         USE MACRO LDLFT TO GENERATE                                  *
*                SAJ   LK+HILOFLG                                      *
*                MXO   6*B                                             *
*                BXI   XO*XJ                                           *
*         IF THE FIELD IS NOT A FULL WORD BUT ENDS ON A WORD BOUNDARY  *
*         USE MACRO LDRGT TO GENERATE                                  *
*                SAJ   KL+HILOFLG                                      *
*                MXO   6*A                                             *
*                BXI   -XO*XJ                                          *
*         OTHERWISE USE MACRO LDMID TO GENERATE                        *
*                SAJ   KL+HILOFLG                                      *
*                MXO   6*B                                             *
*                LXO   60-6*A                                          *
*                BXI   XO*XJ                                           *
*                                                                     * 
** INPUT                                                              * 
*         FIXED CELL P1= BCP OF FIELD (=A)                             *
*         FIXED CELL P2= NUMBER OF CHARS TO LOAD  (=B)                 *
*         HILOFLG= 0 IF LOW-VALUES                                     *
*                = 1 IF HIGH-VALUES                                    *
*                                                                     * 
** OUTPUT                                                             * 
*         (VIRTUAL) X-REG VREGA CONTAINS THE FIELD                     *
*         (VIRTUAL) X-REG VREGB CONTAINS 10 HIGH-VALUES OR 10          *
*         LOW-VALUES. 
*                                                                     * 
** SUBROUTINES CALLED- NONE                                           * 
*                                                                     * 
** MACROS CALLED-  LDLFT,LDRGT,LDM10
*                                                                     * 
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 
  
 LDHILO1  EGO    3
          IFZ    (P1,NE,0),LDHL120
  
*      SOURCE FIELD BEGINS ON A WORD BOUNDARY 
  
          IFZ    (P2,NE,0),LDHL110
  
*      GENERATE CODE TO LOAD A FULL WORD OF HIGH-VALUES OR LOW-VALUES 
  
          NOTE   LDHILO1
          GEN    SLRBPK,(VREGOF,VREGA),,LOVALADR
          MOVEZ  VREGA,VREGB
          RETURN
          SPACE  4
*      GENERATE CODE TO LOAD LESS THAN 10 CHARS OF HIGH-VALUES OR 
*      LOW-VALUES BEGINNING ON A WORD BOUNDARY
  
*                  ARITH8: 6*FIXED
 LDHL110  LABEL 
          NOTE   LDHL110
          GENM   LDLFT
            SYMP   LOVALADR 
            REGP   (VREGOF,VREGA),(VREGOF,VREGB)
            CONP   (ARITH8,P2)
          ENDG
          RETURN
          SPACE  4
*      PROCESS SOURCE FIELD NOT STARTING ON A WORD BOUNDARY 
  
 LDHL120  LABEL 
          ADDZ   P1,P2,T1 
          IFZ    (T1,NE,10),LDHL160 
  
*      GENERATE CODE TO LOAD A FIELD OF LESS THAN 10 HIGH-VALUES OR 
*      LOW-VALUES WHICH END ON A WORD BOUNDARY
  
*                  ARITH8: 6*FIXED
          NOTE   LDHL120
          GENM   LDRGT
            SYMP   LOVALADR 
            REGP   (VREGOF,VREGA),(VREGOF,VREGB)
            CONP   (ARITH8,P1)
          ENDG
          RETURN
          SPACE  4
*      GENERATE CODE TO LOAD A FIELD OF LESS THAN 20 CHARS OF 
*      HIGH-VALUES OR LOW-VALUES WHICH NEITHER BEGIN NOR END ON A WORD
*      BOUNDARY 
  
*                  ARITH7: 60-6*FIXED 
*                  ARITH8: 6*FIXED
 LDHL160  LABEL 
          NOTE   LDHL160
          GENM   LDMID
            SYMP   LOVALADR 
            REGP   (VREGOF,VREGA),(VREGOF,VREGB)
            CONP   (ARITH8,P2),(ARITH7,P1)
          ENDG
          RETURN
          TITLE  LDHILO2 - LOAD NEXT FIELD OF HIGH-VALUES OR LOW-VALUES 
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 
*                                                                     * 
** NAME-  LDHILO2 SUBROUTINE                                           *
*                                                                     * 
** PURPOSE-                                                           * 
*         LOAD THE NEXT FIELD OF HIGH-VALUES OR LOW-VALUES             *
*                                                                     * 
** DESCRIPTION-                                                       * 
*         IF THE FIELD IS A FULL WORD                                  *
*         SET VREGA=VREGB 
*         ELSE GENERATE                                                *
*                MXO   6*A                                             *
*                BXK   X0*XA                                           *
*                                                                     * 
** INPUT                                                              * 
*         (VIRTUAL) X-REG VREGB CONTAINS 10 HIGH-VALUES OR LOW-VALUES  *
*         FIXED CELL P6 CONTAINS THE NUMBER OF CHARS TO LOAD  (=A)     *
*                                                                     * 
** OUTPUT                                                             * 
*         (VIRTUAL) X-REG VREGA CONTAINS THE FIELD
*                                                                     * 
** SUBROUTINES CALLED- NONE                                           * 
*                                                                     * 
** MACROS CALLED- NONE                                                * 
*                                                                     * 
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 
  
 LDHILO2  EGO    3
          IFZ    (P6,NE,10),LDHL250 
  
*      GENERATE CODE TO LOAD A FULL WORD OF HIGH-VALUES OR LOW-VALUES 
*      (SINCE VREGB ALREADY CONTAINS THIS THERE IS NO CODE GENERATED) 
  
          NOTE   LDHILO2
          MOVEZ  VREGB,VREGA
          RETURN
          SPACE  4
*      GENERATE CODE TO LOAD A PARTIAL WORD OF HIGH-VALUES OR LOW-VALUES
  
*                  ARITH8: 6*FIXED
 LDHL250  LABEL 
          NOTE   LDHL250
          GEN    MASK,(VREGOF,VREGZ),(ARITH8,P6)
          GEN    LAND,(VREGOF,VREGA),VREGZ,VREGB
          RETURN
          TITLE  LOADC1C2 -  LOAD COMP-1 OR COMP-2 ITEM INTO VREG1
**        LOADC1C2 -  LOAD  COMP-1 OR COMP-2 ITEM INTO VREG1
* 
* LOADC1C2 LINK  CGLOADC
* 
*         CALLZ  LOADC1C2 
* 
*         GENERATES CODE TO LOAD  A (POSSIBLY SUBSCRIPTED)
*         COMP-1 OR COMP-2 ITEM DESCRIBED  BY THE REGB DNAT 
*         INTO REGISTER VREG1.
* 
*         USES-  P1, P2, P3, P4 
  
  
 LOADC1C2 EGO    3
          IFZ    ((GSCODEOF,REGB),NE,0),LODC1C21 IF SUBSCRIPTED 
  
          NOTE   LOADC1C2 
          GEN    SLRBPK,(VREGOF,VREG1),,FWASOURC
          IFTHEN ((CCTBIT,UNPACKC1),NE,0) 
          ANDIF  ((TYPEOF,REGB),EQ,COMP1) 
            GEN    UNP,(VREGOF,VREG1),(VREGOF,VREG2),VREG1
          ENDIFZ
          RETURN
  
  
*                            SOURCE IS SUBSCRIPTED
 LODC1C21 LABEL 
          NOTE   LODC1C21 
  
          IFTHEN ((SUBSCOF,REGB),EQ,0)           IF NO SPECIAL CASING,
            MOVEZ  (GSCODEOF,REGB),P1 
            CALLZ  SUBLOAD
            GEN    SHL,P1,30
            GEN    SXXPK,(VREGOF,VREG2),P1,(BCPOF,REGB) 
            GENM   LDSUB
              SYMP   ((FWA$OF,REGB))
              REGP    VREG2,(VREGOF,VREG1)
            ENDG
          ELSEZ 
  
          MOVEZ  REGB,P1                         SOURCE DNAT
          MOVEZ  1,P2                            RIGHT-JUSTIFIED
          MOVEZ  0,P3                            NO FILL
          CALLZ  SCLOAD                          LOAD INTO REGISTER P4
  
          GEN    XMIT,(VREGOF,VREG1),P4          PUT INTO REGISTER VREG1
          ENDIFZ
          IFTHEN ((CCTBIT,UNPACKC1),NE,0) 
          ANDIF  ((TYPEOF,REGB),EQ,COMP1) 
            GEN    UNP,(VREGOF,VREG1),(VREGOF,VREG2),VREG1
          ENDIFZ
  
          RETURN
          TITLE  LOADC4 -  LOAD COMP-4 ITEM 
**        LOADC4 -  LOAD COMP-4 ITEM
* 
*LOADC4   LINK   CGLOAD4     * TO GMOVSUB 
* 
*         CALLZ  LOADC4 
* 
* 
*         REGT = REGTABL/DNAT INDEX THAT WILL HOLD RESULT 
*         GENERATES CODE TO LOAD A POSSIBLY SUBSCRIPTED COMP-4 ITEM 
*         DESCRIBED BY REGB, AND THEN DESCRIBES IT CREATING A TEMPORARY 
*         REGTABL/DNAT VIA REGT AND COPYING APPROPRIATE FIELDS. 
  
  
 LOADC4   EGO    3
          IFZ    ((GSCODEOF,REGB),NE,0),LOADC42  IF SUBSCRIPTED 
          IFZ    ((ARITH1,REGB),GT,10),LOADC41   IF ITEM IS IN TWO WORDS
  
*      UNSUBSCRIPTED, CONTAINED IN ONLY ONE WORD
          NOTE   LOADC4 
          GEN    SLRBPK,(VREGOF,VREG1),,((FWA$OF,REGB))  LOAD FIRST WORD
          GEN    SHL,VREG1,(ARITH2,REGB)                   6*BCP
          MOVEZ  (BYTLENOF,REGB),T1 
          GEN    SHR,VREG1,(ARITH7,T1)                     60-6*T1
          IFTHEN ((SIGNOF,REGB),EQ,0) 
          GEN    MASK,(VREGOF,VREG2),(ARITH7,T1)
          GEN    LIMP,(VREGOF,VREG1),VREG1,VREG2
          ENDIFZ
          RETURN
  
  
*      UNSUBSCRIPTED, CONTAINED IN TWO WORDS
 LOADC41  LABEL 
          NOTE   LOADC41
          GEN    SLRBPK,(VREGOF,VREG1),,((FWA$OF,REGB)) 
          GEN    SLRAPB,(VREGOF,VREG2),VREG1,VREGB1 
          MOVEZ  (ARITH12,REGB),T1                         BCP+LEN-10 
          GEN    MASK,(VREGOF,VREG3),(ARITH8,T1)           6*T1 
          GEN    LIMP,(VREGOF,VREG1),VREG1,VREG3
          GEN    LAND,(VREGOF,VREG2),VREG2,VREG3
          GEN    LOR,(VREGOF,VREG1),VREG1,VREG2 
          GEN    SHL,VREG1,(ARITH2,REGB)                   REGB 
          MOVEZ  (BYTLENOF,REGB),T1 
          GEN    SHR,VREG1,(ARITH7,T1)                     60-6*T1
          IFTHEN ((SIGNOF,REGB),EQ,0) 
          GEN    MASK,(VREGOF,VREG2),(ARITH7,T1)
          GEN    LIMP,(VREGOF,VREG1),VREG1,VREG2
          ENDIFZ
          RETURN
  
  
*      SOURCE IS SUBSCRIPTED
 LOADC42  LABEL 
          NOTE   LOADC42
*      LOADC4 - CASE WHERE SOURCE IS SUBSCRIPTED
          MOVEZ  (GSCODEOF,REGB),P1 
          CALLZ  SUBLOAD
          GEN    SHR,P1,30
          MOVEZ  P1,VREGV 
          MOVEZ  (BCPOF,REGB),P1
          CALLZ  SETXXPK
          MOVEZ  VREGV,VREG2
          GEN    SBBPK,(VREGOF,VREG1),,((FWA$OF,REGB))
          GEN    SBBPK,(VREGOF,VREG3),,(BYTLENOF,REGB)
          GEN    SLRBPK,(VREGOF,VREG4),,((EXT$OF,C.ZEROS))
          GENOBJ N=C.N12RN,I=(VREG1,VREG2,VREG3,VREG4),O=((VREGOF,VREG1)
,)
          MOVEZ  (BYTLENOF,REGB),T1 
          IFTHEN ((SIGNOF,REGB),EQ,0) 
          GEN    MASK,(VREGOF,VREG2),(ARITH7,T1)   *60 - 6*ITL
          GEN    LIMP,(VREGOF,VREG1),VREG1,VREG2   UPPER BITS TO ZERO 
          ELSEZ 
          GEN    SHL,VREG1,(ARITH7,T1)                     60-L*ITL 
          GEN    SHR,VREG1,(ARITH7,T1)           EXTEND SIGN
          ENDIFZ
          RETURN
 A        EJECT 
          TITLE  LOADIT1 - LOAD 1ST WORD OF SOURCE FIELD
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 
*                                                                     * 
** NAME-  LOADIT1 SUBROUTINE (INTERPRETIVE)                           * 
*                                                                     * 
** PURPOSE-                                                           * 
*      GENERATE CODE TO LOAD A DATA FIELD CONTAINED ENTIRELY WITHIN   * 
*      ONE WORD OR THE FIRST WORD OF A MULTIPLE PRECISION ITEM OR A   * 
*      LITERAL                                                        * 
*      IRRELEVENT CHARACTERS ARE ZEROED                               * 
*      RESULT LEFT AS IS- NOT ALIGNED IN REGISTER.                    * 
*                                                                     * 
** DESCRIPTION-                                                       * 
*      IF THE FIELD IS A LITERAL- 
*         A)  IF IT IS POOLED GENERATE A FULL WORD LOAD               * 
*         B)  ELSE GENERATE A SXI  LIT  SINCE IT IS A SHORT LITERAL   * 
*      IF THE FIELD IS A FULL WORD GENERATE AN SAI   K                * 
*      IF THE FIELD BEGINS ON A WORD BOUNDARY BUT IS NOT A FULL WORD  * 
*      USE LDLFT TO GENERATE CODE.                                     *
*      IF THE FIELD ENDS ON A WORD BOUNDARY USE LDRGT TO GENERATE CODE* 
*      OTHERWISE USE LDMID TO GENERATE CODE                           * 
*                                                                     * 
** INPUT                                                              * 
*      FIXED CELL P2 CONTAINS THE SIZE OF THE FIELD IN CHARACTERS     * 
*      FIXED CELL P1 CONTAINS A SHIFT COUNT (USUALLY BCP)             * 
*      FIXED CELL LITFLG IS NONZERO IF THE FIELD IS A LITERAL         * 
*      FIXED CELL POOLFLG IS NONZERO IF THE FIELD IS A POOLED LITERAL * 
*      VIRTUAL REG MOVEREGA (POINTS TO A REAL REG WHICH) CONTAINS     * 
*      ADDRESS OF FIELD                                               * 
*                                                                     * 
** OUTPUT                                                             * 
*      (VIRTUAL) X-REG VREGA CONTAINS THE FIELD                       * 
*      (VIRTUAL) A-REG VREGB CONTAINS THE ADDRESS OF THE FIELD        * 
*                                                                     * 
** SUBROUTINES CALLED- NONE                                           * 
*                                                                     * 
** MACROS USED-                                                        *
*      LDLFT- LOAD (PARTIAL WORD) FIELD FROM LEFT SIDE OF WORD (BCP=0)* 
*      LDRGT- LOAD (PARTIAL WORD)  FIELD FROM RIGHT SIDE OF WORD       *
*      LDMID- LOAD (PARTIAL WORD)  FIELD FROM MIDDLE OF WORD.          *
*                                                                     * 
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 
  
 LOADIT1  EGO    3
          IFZ    (LITFLG,EQ,0),LOAD100
  
*      FIELD IS A LITERAL 
  
          IFZ    (POOLFLG,NE,0),LOAD100 
  
*      FIELD IS AN UNPOOLED LITERAL - 
*      GENERATE CODE TO LOAD A SHORT LITERAL (@2 CHARS OR 3 IF FIRST
*      <40B)
  
          NOTE   LOADIT1
          GEN    SXBPK,(VREGOF,VREGA),,(SHOLITOF,MOVEREGA)
          SUBZ    (BYTLENOF,MOVEREGA),P2,T1 
          IFTHEN   (T1,GT,0)
            GEN     SHR,VREGA,(ARITH8,T1) 
          GEN     SHL,VREGA,(ARITH8,T1) 
          ENDIFZ
          RETURN
          SPACE  4
*      PROCESS DATA-NAME SOURCE FIELD 
  
 LOAD100  LABEL 
          IFZ    (P1,NE,K0),LOAD300 
  
*      FIELD BEGINS ON A WORD BOUNDARY
  
          IFZ    (P2,NE,10),LOAD200 
  
*      GENERATE A FULL WORD LOAD
  
 LOAD150  LABEL 
          NOTE   LOAD150
          GEN    SLRBPK,(VREGOF,VREGA),,SRCADDR 
          MOVEZ  VREGA,VREGB
          RETURN
          SPACE  4
*      GENERATE CODE TO LOAD A FIELD THAT BEGINS ON A WORD BOUNDARY BUT 
*      IS NOT A FULL WORD 
  
*                  ARITH8: 6*FIXED
 LOAD200  LABEL 
          NOTE   LOAD200
          GENM   LDLFT
            SYMP   SRCADDR
            REGP   (VREGOF,VREGA),(VREGOF,VREGB)
            CONP   (ARITH8,P2)
          ENDG
          RETURN
          SPACE  4
*      PROCESS FIELD NOT STARTING ON A WORD BOUNDARY
  
 LOAD300    LABEL 
          ADDZ   P1,P2,T1 
          IFZ    (T1,NE,10),LOAD400 
  
*      GENERATE CODE TO LOAD FIELD THAT ENDS ON A WORD BOUNDARY 
  
*                  ARITH8: 6*FIXED
          NOTE   LOAD300
          GENM   LDRGT
          SYMP   SRCADDR
          REGP   (VREGOF,VREGA),(VREGOF,VREGB)
          CONP   (ARITH8,P1)
          ENDG
          RETURN
  
*      GENERATE CODE TO LOAD FIELD THAT DOESNT END ON A WORD BOUNDARY 
  
*                  ARITH8: 6*FIXED
*                  ARITH7: 60-6*FIXED 
 LOAD400    LABEL 
          NOTE   LOAD400
          GENM   LDMID
          SYMP   SRCADDR
          REGP   (VREGOF,VREGA),(VREGOF,VREGB)
            CONP   (ARITH8,P2),(ARITH7,P1)
          ENDG
          RETURN
  
          TITLE  LOADIT2 - LOAD NEXT WORD OF SOURCE FIELD 
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 
*                                                                     * 
** NAME-  LOADIT2 SUBROUTINE (INTERPRETIVE)                           * 
*                                                                     * 
** PURPOSE-                                                           * 
*      GENERATE CODE TO LOAD SECOND WORD OF DOUBLE PRECISION ITEM OR  * 
*      NEXT WORD OF A MULTIPLE PRECISION ITEM                         * 
*      IRRELEVENT CHARACTERS ARE ZEROED                               * 
*      RESULT LEFT AS IS- NOT ALIGNED IN REGISTER.                    * 
*                                                                     * 
** DESCRIPTION-                                                       * 
*      IF THE FIELD IS A FULL WORD GENERATE AN SAK  AJ+B1             * 
*      OTHERWISE USE MACRO LDLFT2 TO GENERATE CODE                    * 
*                                                                     * 
** INPUT                                                              * 
*      (VIRTUAL) A-REG VREGB CONTAINS THE ADDRESS OF THE PREVIOUS WORD* 
*      LOADED                                                         * 
*      FIXED CELL P6 CONTAINS THE ECP OF THE FIELD (BCP ALWAYS = 0)   * 
*                                                                     * 
** OUTPUT-                                                            * 
*      (VIRTUAL) X-REG VREGA CONTAINS THE FIELD                       * 
*      (VIRTUAL) A-REG VREGB CONTAINS THE ADDRESS OF THE FIELD        * 
*                                                                     * 
** SUBROUTINES CALLED- NONE                                           * 
*                                                                     * 
** MACROS USED-  LDLFT2                                               * 
*                                                                     * 
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 
  
 LOADIT2  EGO    3
          IFZ    (P6,NE,K10),LOAD700
  
*      GENERATE A FULL WORD LOAD
  
          NOTE   LOADIT2
          GEN    SLRAPB,(VREGOF,VREGA),(VREFOF,VREGB),VREGB1
          MOVEZ  VREGA,VREGB
          RETURN
  
*      GENERATE CODE TO LOAD FIELD NOT ENDING ON A WORD BOUNDARY
  
*                  ARITH8: 6*FIXED
 LOAD700    LABEL 
          NOTE   LOAD700
          GENM   LDLFT2 
          REGP   (VREFOF,VREGB),(VREGOF,VREGA),(VREGOF,VREGB) 
          CONP   (ARITH8,P6)
          ENDG
          RETURN
  
          TITLE  MAXR2VAL -  GET MAXIMUM R2 VALUE 
**        MAXR2VAL -  GET MAXIMUM R2 VALUE
* 
*         P1 = (INTLENOF,ITEM)
*                (E.G. PIC PP999 _ -2)
*         EXECUTE  MAXR2VAL (P1,P2) 
* 
*         SETS P2 = MAXIMUM REGISTER COMP-2 VALUE 
*                (E.G. PIC PP999 _ 0.999999999999999999E-2) 
  
  
 MAXR2VAL CON    *
          SA5    X1          P1 = (INTLENOF,ITEM) 
          SA4    MAXR2TBL+X5 MAXIMUM VALUE
          BX6    X4 
          SA2    A1+1        ADDRESS OF P2
          SA6    X2+0        STORE VALUE
          EQ     MAXR2VAL    EXIT 
  
  
          DATA   0.999999999999999999E-17 
          DATA   0.999999999999999999E-16 
          DATA   0.999999999999999999E-15 
          DATA   0.999999999999999999E-14 
          DATA   0.999999999999999999E-13 
          DATA   0.999999999999999999E-12 
          DATA   0.999999999999999999E-11 
          DATA   0.999999999999999999E-10 
          DATA   0.999999999999999999E-09 
          DATA   0.999999999999999999E-08 
          DATA   0.999999999999999999E-07 
          DATA   0.999999999999999999E-06 
          DATA   0.999999999999999999E-05 
          DATA   0.999999999999999999E-04 
          DATA   0.999999999999999999E-03 
          DATA   0.999999999999999999E-02 
          DATA   0.999999999999999999E-01 
 MAXR2TBL DATA   0.999999999999999999E+00 
          DATA   0.999999999999999999E+01 
          DATA   0.999999999999999999E+02 
          DATA   0.999999999999999999E+03 
          DATA   0.999999999999999999E+04 
          DATA   0.999999999999999999E+05 
          DATA   0.999999999999999999E+06 
          DATA   0.999999999999999999E+07 
          DATA   0.999999999999999999E+08 
          DATA   0.999999999999999999E+09 
          DATA   0.999999999999999999E+10 
          DATA   0.999999999999999999E+11 
          DATA   0.999999999999999999E+12 
          DATA   0.999999999999999999E+13 
          DATA   0.999999999999999999E+14 
          DATA   0.999999999999999999E+15 
          DATA   0.999999999999999999E+16 
          DATA   0.999999999999999999E+17 
          DATA   0.999999999999999999E+18 
          TITLE  MAXR4VAL -  GET MAXIMUM R4 VALUE 
**        MAXR4VAL -  GET MAXIMUM R4 VALUE
* 
*         P1 = (INTLENOF,ITEM)
*                (E.G. PIC 999V99 _ 3)
*         EXECUTE  MAXR4VAL (P1,P2) 
* 
*         SETS P2 = MOST SIGNIFICANT PART OF D.P. COMP-2 VALUE
*         SETS P3 = LEAST SIGNIFICANT PART OF D.P. COMP-2 VALUE.
  
  
 MAXR4VAL CON    *           ENTRY/EXIT WORD
          SA5    X1          P1 = (INTLENOF,ITEM) 
          LX5    1           TABLE ENTRIES ARE 2 WORDS
          SA3    MAXR4TBL+X5 MOST SIG. PART OF MAXIMUM VALUE
          BX6    X3 
          SA4    A3+1 
          BX7    X4 
          SA2    A1+1        ADDRESS OF P2
          SA6    X2          STORE MOST SIG. INTO P2
          SA2    A1+2        ADDRESS OF P3
          SA7    X2          STORE LEAST SIG. INTO P3 
          EQ     MAXR4VAL    EXIT 
  
  
          DATA   0.999999999999999999EE-17
          DATA   0.999999999999999999EE-16
          DATA   0.999999999999999999EE-15
          DATA   0.999999999999999999EE-14
          DATA   0.999999999999999999EE-13
          DATA   0.999999999999999999EE-12
          DATA   0.999999999999999999EE-11
          DATA   0.999999999999999999EE-10
          DATA   0.999999999999999999EE-09
          DATA   0.999999999999999999EE-08
          DATA   0.999999999999999999EE-07
          DATA   0.999999999999999999EE-06
          DATA   0.999999999999999999EE-05
          DATA   0.999999999999999999EE-04
          DATA   0.999999999999999999EE-03
          DATA   0.999999999999999999EE-02
          DATA   0.999999999999999999EE-01
 MAXR4TBL DATA   0.999999999999999999EE+00
          DATA   0.999999999999999999EE+01
          DATA   0.999999999999999999EE+02
          DATA   0.999999999999999999EE+03
          DATA   0.999999999999999999EE+04
          DATA   0.999999999999999999EE+05
          DATA   0.999999999999999999EE+06
          DATA   0.999999999999999999EE+07
          DATA   0.999999999999999999EE+08
          DATA   0.999999999999999999EE+09
          DATA   0.999999999999999999EE+10
          DATA   0.999999999999999999EE+11
          DATA   0.999999999999999999EE+12
          DATA   0.999999999999999999EE+13
          DATA   0.999999999999999999EE+14
          DATA   0.999999999999999999EE+15
          DATA   0.999999999999999999EE+16
          DATA   0.999999999999999999EE+17
          DATA   0.999999999999999999EE+18
          SPACE  4
 OP.BDP   IFEQ   OP.BDP,OP.YES
          TITLE  MOVCHAR - MOVE CHARS VIA CMU 
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 
*                                                                     * 
** NAME - MOVCHAR SUBROUTINE                                          * 
*                                                                     * 
** PURPOSE-                                                           * 
*      GENERATE CMU CODE TO MOVE CHARS                                * 
*                                                                     * 
** DESCRIPTION-                                                       * 
*      IF THE FIELD IS SHORT (SIZE@127) GENERATE A DIRECT MOVE ELSE   * 
*      GENERATE AN INDIRECT MOVE DESCRIPTOR WORD AND AN INDIRECT MOVE * 
*                                                                     * 
** INPUT                                                              * 
*      P1= SIZE OF SOURCE FIELD                                       * 
*      P2= BCP OF SOURCE FIELD                                        * 
*      P3= BCP OF RECEIVING FIELD                                     * 
*                                                                     * 
** OUTPUT-                                                            * 
*      RECOFST, THE RECEIVING FIELD ADDRESS OFFSET, IS UPDATED SO THAT* 
*      RECADDR POINTS TO THE LAST WORD STORED INTO IN THIS ROUTINE    * 
*      P3 IS UPDATED TO POINT TO THE CHAR FOLLOWING THE LAST CHAR     * 
*      STORED INTO IN THIS ROUTINE                                    * 
*                                                                     * 
** SUBROUTINES CALLED- NONE                                           * 
*                                                                     * 
** MACROS CALLED- NONE                                                * 
*                                                                     * 
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 
  
 MOVCHAR  EGO    3
 C819     CONSTANT 819
 C8190    CONSTANT 8190 
          MOVEZ  P1,T1
          PUSH    RECOFST 
          IFZ    (T1,GT,127),MOVCHAR3 
  
*      GENERATE A DIRECT MOVE 
  
 MOVCHAR2 LABEL 
          NOTE   MOVCHAR2 
          GEN    DM$,T1,SRCADDR,P2,RCVADDR,P3 
          BRANCH MOVCHAR7 
          SPACE  4
*      GENERATE INDIRECT MOVES
  
 MOVCHAR3 LABEL 
          IFZ    (T1,LT,C8190),MOVCHAR5 
  
          MOVEZ  (LOCLAB,LABLNUM),LABLNUM 
          GEN    USE$,CMUBLOCK
          GEN    PLIST
          GEN    LABEL$,LOCLABL 
          GEN    MD$,C8190,SRCADDR,P2,RCVADDR,P3
          GEN    ENDPL
          GEN    USE$,CODBLOCK
          GEN    IM$,,,LOCLABL
          SUBZ   T1,C8190,T1
          ADDZ   RECOFST,C819,RECOFST 
          ADDZ   ADOFSET,C819,ADOFSET 
          BRANCH MOVCHAR3 
  
  
 MOVCHAR5 LABEL 
          IFZ    (T1,LT,128),MOVCHAR2 
          NOTE   MOVCHAR5 
          MOVEZ  (LOCLAB,LABLNUM),LABLNUM 
          GEN    USE$,CMUBLOCK
          GEN    PLIST
          GEN    LABEL$,LOCLABL 
          GEN    MD$,T1,SRCADDR,P2,RCVADDR,P3 
          GEN    ENDPL
          GEN    USE$,CODBLOCK
          GEN    IM$,,,LOCLABL
  
*      UPDATE P3 AND RECOFST
  
 MOVCHAR7 LABEL 
          POP    RECOFST
          ADDZ   P3,P1,T1 
          REMZ   T1,10,P3 
          QUOTZ  T1,10,T1 
          ADDZ   T1,RECOFST,RECOFST 
          RETURN
          SPACE  4
 OP.BDP   ENDIF 
          TITLE  MOVHILO - MOVE FULL WORDS OF HIGH-VALUES OR LOW-VALUES 
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 
*                                                                     * 
** NAME-  MOVHILO SUBROUTINE                                           *
*                                                                     * 
** PURPOSE-                                                           * 
*      MOVE FULL WORDS OF HIGH-VALUES OR LOW-VALUES TO INTERIOR WORDS 
*      OF EP RECEIVING FIELD
*                                                                     * 
** DESCRIPTION-                                                       * 
*      IF LESS THAN 5 WORDS ARE TO BE MOVED GENERATE
*         BXK    XJ 
*         SAK    AK+1        REPEATED A TIMES 
*      ELSE GENERATE
*                BXK   XJ 
*                SBM   A
*         LOOP   BSS   0
*                SAK   AK+1 
*                SBM   BM-B1
*                NE    BM,LOOP
*                                                                     * 
** INPUT                                                              * 
*      (VIRTUAL) X-REG VREGB CONTAINS 10 HIGH-VALUES OR 10 LOW-VALUES  *
*      FIXED CELL P5 CONTAINS THE NUMBER OF CHARS TO LOAD              *
*      (VIRTUAL) A-REG VREGC CONTAINS THE ADDRESS OF THE LAST WORD     *
*      STORED INTO.                                                    *
*                                                                     * 
** OUTPUT                                                             * 
*      (VIRTUAL) A-REG VREGC CONTAINS THE ADDRESS OF THE LAST WORD THIS*
*      ROUTINE STORES INTO.                                            *
*                                                                     * 
** SUBROUTINES CALLED- NONE                                           * 
*                                                                     * 
** MACROS CALLED- NONE                                                * 
*                                                                     * 
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 
  
 MOVHILO  EGO    3
          IFZ    (P5,GT,4),MVHL300
  
*      GENERATE CODE TO MOVE LESS THAN 5 WORDS OF HIGH-VALUES OR
*      LOW-VALUES 
  
          NOTE   MOVHILO
          MOVEZ  P5,T1
          GEN    XMIT,VREGC,VREGB 
          GENLP  VREGC
 MVHL100  LABEL 
          GEN    SSRAPB,VREGC,VREGC,VREGB1
          SUBZ T1,1,T1
          IFZ    (T1,GT,0),MVHL100
          GEN    ENDL 
          RETURN
          SPACE  4
*      GENERATE CODE TO MOVE MORE THAN 4 WORDS OF HIGH-VALUES OR
*      LOW-VALUES 
  
 MVHL300  LABEL 
          NOTE   MVHL300
          GEN    SBBPK,(VREGOF,VREGZ),,P5 
          MOVEZ  (LOCLAB,LABLNUM),LABLNUM 
          GENLP  VREGC,VREGZ
          GEN    SXXPB,VREGC,VREGB
          GEN    LABEL$,LOCLABL 
          GEN    SSRAPB,VREGC,VREGC,VREGB1
          GEN    SBBMB,VREGZ,VREGZ,VREGB1 
          GEN    NE$,VREGZ,,LOCLABL 
          GEN    ENDL 
          RETURN
          TITLE  MOVWORD - MOVE FULL WORDS WITH NO SHIFTING 
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 
*                                                                     * 
** NAME-  MOVWORD SUBROUTINE                                           *
*                                                                     * 
** PURPOSE-                                                           * 
*      GENERATE CODE TO MOVE FULL (INTERIOR) WORDS WITH NO SHIFTING    *
*                                                                     * 
** DESCRIPTION-                                                       * 
*      IF LESS THAN 4 WORDS ARE TO BE MOVED, GENERATE                 * 
*         SAI    AI+B1                                                 *
*         BXJ    XI                                                    *
*         SAJ    AJ+B1                                                 *
*      REPEATING AS MANY TIMES AS NECESSARY                            *
*      ELSE GENERATE                                                   *
*                SBM   A                                               *
*         LOOP   BSS   0                                               *
*                SAI   AI+B1                                           *
*                BXJ   XI                                              *
*                SAJ   AJ+B1                                           *
*                SBM   BM-B1                                           *
*                NE    BM,LOOP                                         *
*                                                                     * 
** INPUT                                                              * 
*      FIXED CELL P5 CONTAINS THE NUMBER OF WORDS TO MOVE (=A)         *
*      (VIRTUAL) A-REG VREGA CONTAINS THE ADDRESS OF THE LAST WORD     *
*      LOADED (=AI)                                                    *
*      (VIRTUAL) A-REG VREGC CONTAINS THE ADDRESS OF THE LAST WORD     *
*      STORED INTO (=AJ)                                               *
*                                                                     * 
** OUTPUT                                                             * 
*      (VIRTUAL) A-REG VREGB CONTAINS THE ADDRESS OF THE LAST WORD     *
*      LOADED BY THIS ROUTINE (=AI)                                    *
*      (VIRTUAL) A-REG VREGC CONTAINS THE ADDRESS OF THE LAST WORD     *
*      THIS ROUTINE STORES INTO.                                       *
*                                                                     * 
** SUBROUTINES CALLED- NONE                                           * 
*                                                                     * 
** MACROS CALLED- NONE                                                * 
*                                                                     * 
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 
  
 MOVWORD  EGO    3
          IFZ    (P5,GT,3),MVWD200
  
*      GENERATE CODE TO MOVE LESS THAN 4 WORDS
  
          NOTE   MOVWORD
          MOVEZ  P5,T1
          GENLP  VREGB,VREGC
 MVWD100  LABEL 
          GEN    SLRAPB,VREGB,VREGB,VREGB1
          GEN    XMIT,VREGC,VREGB 
          GEN    SSRAPB,VREGC,VREGC,VREGB1
          SUBZ   T1,1,T1
          IFZ    (T1,GT,0),MVWD100
          GEN    ENDL 
          RETURN
          SPACE  4
*      GENERATE CODE TO MOVE MORE THAN 3 WORDS
  
 MVWD200  LABEL 
          NOTE   MVWD200
          GEN    SBBPK,(VREGOF,VREGZ),,P5 
          GENLP  VREGZ,VREGB,VREGC
          MOVEZ  (LOCLAB,LABLNUM),LABLNUM 
          GEN    LABEL$,LOCLABL 
          GEN    SLRAPB,VREGB,VREGB,VREGB1
          GEN    XMIT,VREGC,VREGB 
          GEN    SSRAPB,VREGC,VREGC,VREGB1
          GEN    SBBMB,VREGZ,VREGZ,VREGB1 
          GEN    NE$,VREGZ,LOCLABL
          GEN    ENDL 
          RETURN
          SPACE  4
          TITLE  SETBREG -  SET B-REGISTER VREGX TO CONSTANT P1 
**        SETBREG -  SET B-REGISTER VREGX TO CONSTANT P1
* 
*         P1 = INTEGER VALUE
* 
*         CALLZ  SETBREG
* 
*         GENERATES CODE TO SET THE B-REGISTER INDICATED BY 
*           (VREGOF,VREGX) EQUAL TO P1.  A 15-BIT INSTRUCTION IS USED 
*           IF POSSIBLE.
  
 SETBREG  EGO    3
          ADDZ   P1,1,T1
          GOTOCASE  T1
            CASE    0,SETBREG1                   P1 = -1
            CASE    1,SETBREG2                   P1 = 0 
            CASE    2,SETBREG3                   P1 = 1 
            CASE    3,SETBREG4                   P1 = 2 
            ENDCASE 
  
*                            P1 IS NOT A SPECIAL CASE 
          NOTE SETBREG
          GEN    SBBPK,(VREGOF,VREGX),,P1 
          RETURN
  
  
*                            P1 = -1
 SETBREG1 LABEL 
          NOTE   SETBREG1 
          GEN    SBBMB,(VREGOF,VREGX),,VREGB1 
          RETURN
  
  
*                            P1 = 0 
 SETBREG2 LABEL 
          NOTE   SETBREG2 
          GEN    SBBPB,(VREGOF,VREGX) 
          RETURN
  
  
*                            P1 = 1 
 SETBREG3 LABEL 
          NOTE   SETBREG3 
          GEN    SBBPB,(VREGOF,VREGX),,VREGB1 
          RETURN
  
  
*                            P1 = 2 
 SETBREG4 LABEL 
          NOTE   SETBREG4 
          GEN    SBBPB,(VREGOF,VREGX),VREGB1,VREGB1 
          RETURN
          TITLE  SETXREG - SET X-REGISTER VREGW TO CONSTANT P1
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 
*                                                                     * 
** NAME-  SETXREG SUBROUTINE                                          * 
*                                                                     * 
** PURPOSE-                                                           * 
*      GENERATE CODE TO SET X-REG VREGW TO CONSTANT P1                * 
*                                                                     * 
** DESCRIPTION-                                                       * 
*      IF P1=-1  GENERATE   SXI   B0-B1                               * 
*      IF P1=0   GENERATE   MXI   0                                   * 
*      IF P1=1   GENERATE   SXI   B1                                  * 
*      IF P1=2   GENERATE   SXI   B1+B1                               * 
*      OTHERWISE GENERATE   SXI   P1                                  * 
*                                                                     * 
** INPUT                                                              * 
*      FIXED CELL P1 CONTAINS THE CONSTANT                            * 
*                                                                     * 
** OUTPUT                                                             * 
*      (VIRTUAL) X-REGISTER VREGW IS SET TO THE VALUE OF P1           * 
*                                                                     * 
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 
  
 SETXREG  EGO    3
          ADDZ   P1,1,T1
          GOTOCASE T1 
            CASE   0,SETXREG1          P1=-1
            CASE   1,SETXREG2          P1=0 
            CASE   2,SETXREG3          P1=1 
            CASE   3,SETXREG4          P1=2 
          ENDCASE 
  
*      P1 IS NOT A SPECIAL CASE 
  
          NOTE   SETXREG
          GEN    SXBPK,(VREGOF,VREGW),,P1 
          RETURN
  
*      P1= -1 
  
 SETXREG1 LABEL 
          NOTE   SETXREG1 
          GEN    SXBMB,(VREGOF,VREGW),,VREGB1 
          RETURN
  
*      P1=0 
  
 SETXREG2 LABEL 
          NOTE   SETXREG2 
          GEN    MASK,(VREGOF,VREGW)
          RETURN
  
*      P1=1 
  
 SETXREG3 LABEL 
          NOTE   SETXREG3 
          GEN    SXBPB,(VREGOF,VREGW),,VREGB1 
          RETURN
          SPACE  4
*      P1=2 
  
 SETXREG4 LABEL 
          NOTE   SETXREG4 
          GEN    SXBPB,(VREGOF,VREGW),VREGB1,VREGB1 
          RETURN
          TITLE  SETBXPK - SET B-REG VREGU TO X-REG VREGU + CONSTANT P1 
************************************************************************
*                                                                      *
** NAME-  SETBXPK SUBROUTINE                                           *
*                                                                      *
** PURPOSE-                                                            *
*      GENERATE CODE TO SET B-REG VREGU TO X-REG VREGU + CONSTANT P1   *
*                                                                      *
** INPUT-                                                              *
*      VREGU CONTAINS A VIRTUAL X-REGISTER NUMBER                      *
*      P1 CONTAINS A CONSTANT                                          *
*                                                                      *
** OUTPUT-                                                             *
*      VIRTUAL B-REGISTER VREGU IS SET TO THE VALUE OF X-REGISTER VREGU*
*      + P1 USING A 15-BIT INSTRUCTION IF POSSIBLE                     *
*                                                                      *
************************************************************************
  
 SETBXPK  EGO    3
          GOTOCASE P1 
            CASE   0,SETBXP0
            CASE   1,SETBXP1
          ENDCASE 
  
*      P1 IS NOT A SPECIAL CASE- MUST GENERATE A 30-BIT INSTRUCTION 
  
          NOTE   SETBXPK
          GEN    SBXPK,(VREGOF,VREGU),VREGU,P1
          RETURN
          SPACE  4
*      P1 = 0 
  
 SETBXP0  LABEL 
          NOTE   SETBXP0
          GEN    SBXPB,(VREGOF,VREGU),VREGU 
          RETURN
          SPACE  4
*      P1 = 1 
  
 SETBXP1  LABEL 
          NOTE   SETBXP1
          GEN    SBXPB,(VREGOF,VREGU),VREGU,VREGB1
          RETURN
          TITLE  SETXXPK - SET X-REG VREGV TO X-REG VREGV + CONSTANT P1 
************************************************************************
*                                                                      *
** NAME-  SETXXPK SUBROUTINE                                           *
*                                                                      *
** PURPOSE-                                                            *
*      GENERATE CODE TO SET X-REG VREGV TO X-REG VREGV + CONSTANT P1   *
*                                                                      *
** INPUT-                                                              *
*      VREGV CONTAINS A VIRTUAL X-REGISTER NUMBER                      *
*      P1 CONTAINS A CONSTANT                                          *
*                                                                      *
** OUTPUT-                                                             *
*      VIRTUAL X-REGISTER VREGV IS SET TO THE VALUE OF X-REGISTER VREGV*
*      + P1 USING A 15-BIT INSTRUCTION IF POSSIBLE                     *
*                                                                      *
************************************************************************
  
 SETXXPK  EGO    3
          GOTOCASE P1 
            CASE   0,SETXXP0
            CASE   1,SETXXP1
          ENDCASE 
  
*      P1 IS NOT A SPECIAL CASE- MUST GENERATE A 30-BIT INSTRUCTION 
  
          NOTE   SETXXPK
          GEN    SXXPK,(VREGOF,VREGV),VREGV,P1
          RETURN
          SPACE  4
*      P1 = 0 
  
 SETXXP0  LABEL 
          NOTE   SETXXP0
          GEN    SXXPB,(VREGOF,VREGV),VREGV 
          RETURN
          SPACE  4
*      P1 = 1 
  
 SETXXP1  LABEL 
          NOTE   SETXXP1
          GEN    SXXPB,(VREGOF,VREGV),VREGV,VREGB1
          RETURN
          SPACE  4
 OP.BDP   IFEQ   OP.BDP,OP.YES
          TITLE  SPCFILL - BLANK FILL FIELD VIA CMU INSTRUCTIONS
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 
*                                                                     * 
** NAME- SPCFILL SUBROUTINE                                           * 
*                                                                     * 
** PURPOSE-                                                           * 
*      GENERATE CMU CODE TO BLANK FILL OR DISPLAY ZERO FILL A FIELD    *
* 
*      *****
*             NOTE - IN THE COMMENTS WHICH FOLLOW, THE WORD "SPACES"
*                    SHOULD BE REPLACED BY "SPACES OR DISPLAY ZEROS". 
*      *****
*                                                                     * 
** DESCRIPTION-                                                       * 
*      IF N (=NUMBER OF CHARS TO MOVE) <127 GENERATE A DIRECT MOVE    * 
*      OF N CHARS FROM C.BLANK                                        * 
*      ELSE IF N @150 GENERATE AN INDIRECT MOVE DESCRIPTOR WORD AND   * 
*      AN INDIRECT MOVE OF N CHARS FROM C.BLANK                       * 
*      ELSE GENERATE M INDIRECT MOVE DESCRIPTOR WORDS DESCRIBING A    * 
*      MOVE OF 150 CHARS FROM C.BLANK AND 1 INDIRECT MOVE DESCRIPTOR  * 
*      WORD DESCRIBING A MOVE OF P CHARS FROM C.BLANK AND GENERATE    * 
*      A LOOP OF M+1 INDIRECT MOVES REFERENCING EACH OF THE M+1       * 
*      DESCRIPTOR WORDS ONCE                                          * 
*      (N=150*M+P)                                                    * 
*                                                                     * 
** INPUT                                                              * 
*      P4=NUMBER OF CHARS TO MOVE (=N)                                * 
*      P3= BCP OF RECEIVING FIELD                                     * 
*                                                                     * 
** OUTPUT                                                             * 
*      RECOFST, THE RECEIVING FIELD ADDRESS OFFSET, IS UPDATED SO THAT* 
*      RECADDR POINTS TO THE LAST WORD STORED INTO IN THIS ROUTINE    * 
*      P3 IS UPDATED TO POINT TO THE CHAR FOLLOWING THE LAST CHAR     * 
*      STORED INTO IN THIS ROUTINE                                    * 
*                                                                     * 
** SUBROUTINES CALLED- NONE                                           * 
*                                                                     * 
** MACROS CALLED- NONE                                                * 
*                                                                     * 
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 
  
 SPCFILL  EGO    3
       IFZ       (P4,GT,127),SPCFILL3 
  
*      GENERATE A DIRECT MOVE 
  
          NOTE   SPCFILL
          IFTHEN  ((TYPEOF,MOVEREGB),EQ,COMP) 
          ANDIF  ((TYPEOF,MOVEREGA),NE,GROUP) 
            GEN  DM$,P4,CBZEROS,0,RCVADDR,P3
          ELSEZ 
            GEN  DM$,P4,BLANKS,0,RCVADDR,P3 
          ENDIFZ
          BRANCH SPCFILL5 
          SPACE  4
*      TOO MANY CHARS FOR A DIRECT MOVE 
  
 SPCFILL3 LABEL 
          IFZ    (P4,GT,150),SPCFILL6 
  
*      GENERATE AN INDIRECT MOVE FOR N SPACES ( 127<N@150)
  
          NOTE   SPCFILL3 
          MOVEZ  (LOCLAB,LABLNUM),LABLNUM 
          GEN    USE$,CMUBLOCK
          GEN    PLIST
          GEN    LABEL$,LOCLABL 
          IFTHEN  ((TYPEOF,MOVEREGB),EQ,COMP) 
          ANDIF  ((TYPEOF,MOVEREGA),NE,GROUP) 
            GEN  MD$,P4,CBZEROS,0,RCVADDR,P3
          ELSEZ 
            GEN  MD$,P4,BLANKS,0,RCVADDR,P3 
          ENDIFZ
          GEN    ENDPL
          GEN    USE$,CODBLOCK
          GEN    IM$,,,LOCLABL
  
*      UPDATE P3 AND RECOFST
  
 SPCFILL5 LABEL 
          ADDZ   P3,P4,T1 
          REMZ   T1,10,P3 
          QUOTZ  T1,10,T1 
          ADDZ   T1,RECOFST,RECOFST 
          RETURN
          SPACE  4
*      GENERATE AN INDIRECT MOVE LOOP FOR >150 SPACES 
  
 SPCFILL6 LABEL 
  
*      INITIAL SETUP FOR GENERATING INDIRECT MOVE DESCRIPTOR WORDS
  
          NOTE   SPCFILL6 
          MOVEZ  P4,T1
          MOVEZ  0,T2 
          MOVEZ  (LOCLAB,LABLNUM),LABLNUM 
          GEN    USE$,CMUBLOCK
          GEN    LABEL$,LOCLABL 
 SPCFILL7 LABEL 
          IFTHEN  ((TYPEOF,MOVEREGB),EQ,COMP) 
          ANDIF  ((TYPEOF,MOVEREGA),NE,GROUP) 
            GEN  MD$,150,CBZEROS,0,RCVADDR,P3 
          ELSEZ 
            GEN  MD$,150,BLANKS,0,RCVADDR,P3
          ENDIFZ
          ADDZ   T2,1,T2
          SUBZ   T1,150,T1
          ADDZ   RECOFST,15,RECOFST 
          IFZ    (T1,GE,150),SPCFILL7 
          IFTHEN  ((TYPEOF,MOVEREGB),EQ,COMP) 
          ANDIF  ((TYPEOF,MOVEREGA),NE,GROUP) 
            GEN  MD$,T1,CBZEROS,0,RCVADDR,P3
          ELSEZ 
            GEN  MD$,T1,BLANKS,0,RCVADDR,P3 
          ENDIFZ
          GEN    ENDPL
          GEN    USE$,CODBLOCK
  
*      DONE GENERATING M (=T2+1) DESCRIPTOR WORDS 
*      UPDATE P3 AND RECOFST
  
          ADDZ   P3,T1,T1 
          REMZ   T1,10,P3 
          ADDZ   T1,1,T1
          QUOTZ  T1,10,T1 
          ADDZ   T1,RECOFST,RECOFST 
  
*      GENERATE CODE TO LOOP THROUGH DESCRIPTOR WORDS 
  
          MOVEZ  T2,P1
          CALLZ  SETBREG
          GENLP  VREGX
          MOVEZ  (LOCLAB,LABLNM2),LABLNM2 
          GEN    LABEL$,LOCLBLE 
          GEN    IM$,,VREGX,LOCLABL 
          GEN    SBBMB,VREGX,VREGX,VREGB1 
          GEN    GE$,VREGX,,LOCLBLE 
          GEN    ENDL 
          RETURN
          SPACE  4
 OP.BDP   ENDIF 
          TITLE  SPCFLRT - APPEND BLANKS ONTO END OF FIELD
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 
*                                                                     * 
** NAME- SPCFLRT SUBROUTINE                                           * 
*                                                                     * 
** PURPOSE-                                                           * 
*      GENERATE CODE TO STORE N WORDS OF BLANKS FOLLOWED BY A PARTIAL * 
*      WORD OF M CHARS OF BLANKS INTO A FIELD                         * 
*                                                                     * 
** DESCRIPTION-                                                       * 
*      IF M=10 CALL SUBROUTINE STRBLNK TO STORE (N+1) WORDS OF BLANKS * 
*      AND RETURN                                                     * 
*      IF N=0 CALL SUBROUTINE GETSPCS TO LOAD THE APPROPRIATE WORD    * 
*      FROM C.FILLT AND CALL STORIT2 TO STORE IT                      * 
*      OTHERWISE CALL SUBROUTINE STRBLNK TO STORE N WORDS OF BLANKS   * 
*      GENERATE A MASK OF M CHARS AND USE THIS TO PUT M BLANKS IN A   * 
*      REGISTER                                                       * 
*      CALL SUBROUTINE STORIT2 TO STORE THE M BLANKS                  * 
*                                                                     * 
** INPUT                                                              * 
*      FIXED CELL P5 CONTAINS THE NUMBER OF WORDS OF BLANKS (=N)      * 
*      FIXED CELL P6 CONTAINS THE NUMBER OF CHARS (=M)                * 
*      (VIRTUAL) A-REG VREGC CONTAINS THE ADDRESS OF THE LAST WORD    * 
*      STORED INTO                                                    * 
*                                                                     * 
** OUTPUT                                                             * 
*      (VIRTUAL) A-REG VREGC CONTAINS THE ADDRESS OF THE LAST WORD    * 
*      OF THE RECEIVING FIELD                                         * 
*                                                                     * 
** NOTES-                                                             * 
*      THE REASON FOR THE ROUTINE IS CODE OPTIMIZATION.  THE SAME     * 
*      FUNCTION COULD BE PERFORMED BY A CALL TO STRBLNK FOLLOWED BY   * 
*      A CALL TO GETSPCS AND STORITZ IN ALL CASES.                    * 
*      OPTIMIZATION OCCURS AS FOLLOWS:                                * 
*         1. IF M=10 THE PARTIAL WORD IS A FULL WORD AND CAN BE STORED* 
*            IN THE NORMAL STRBLNK LOOP                               * 
*         2.  IF M .NE. 10 AND                                        * 
*            IF N =0 WE CALL GETSPCS AND STORIT2 SINCE NO OPTIMAZION  * 
*            OVER THIS IS POSSIBLE                                    * 
*            IF N .NE. 0  IT IS CHEAPER TO PICK UP C.BLANK AND MASK IT* 
*            THAN TO PICK UP A WORD FROM C.FILLT BECAUSE THE ASSEMBLER* 
*            WILL THROW THE LOAD OF C.BLANK OUT (IT WAS LOADED IN     * 
*            STRBLNK) AND THE MASK WOULD HAVE BEEN GENERATED IN       * 
*            STORIT2 ANYWAY (MORE PRECISELY- THE MASK WILL BE         * 
*            GENERATED IN STORIT2  BUT THE ASSEMBLER WILL THROW IT    * 
*            OUT).  THUS THE LOAD FROM C.FILLT WHICH WOULD OCCUR IF   * 
*            GETSPCS WERE CALLED IS REPLACED BY A LAND.               * 
*                                                                     * 
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 
  
 SPCFLRT  EGO    3
          IFZ    (P6,NE,10),SPCFLRT5
  
*      GENERATE CODE TO STORE (N+1) WORDS OF BLANKS 
  
          NOTE   SPCFLRT
          ADDZ   P5,1,P5
          CALLZ  STRBLNK   P5,VREGC 
          RETURN
          SPACE  4
*      THE PARTIAL WORD OF BLANKS IS INDEED A PARTIAL WORD
  
 SPCFLRT5 LABEL 
          IFZ    (P5,NE,0),SPCFLRT7 
  
*      GENERATE CODE TO STORE A WORD OF M BLANK CHARS 
  
          NOTE   SPCFLRT5 
          MOVEZ  P6,P5
          MOVEZ  0,P6 
          CALLZ  GETSPCS   P5,0;VREGA 
          MOVEZ  P5,P6
          CALLZ  STORIT2   VREGC,P6,VREGA;VREGC 
          RETURN
          SPACE  4
*      GENERATE CODE TO STORE N WORDS OF BLANKS AND M BLANK CHARS 
*      NOTICE ON EXITING FROM STRBLNK, VIRTUAL X-REG VREGC CONTAINS 
*      10 BLANKS
  
*                  ARITH8: 6*FIXED
 SPCFLRT7 LABEL 
          NOTE   SPCFLRT7 
          CALLZ  STRBLNK   P5,VREGC 
          GEN    MASK,(VREGOF,VREGZ),(ARITH8,P6)
          GEN    LAND,(VREGOF,VREGA),VREGZ,VREGC
          CALLZ  STORIT2   VREGC,P6,VREGA;VREGC 
          RETURN
          TITLE  STORC1C2 -  STORE  INTO COMP-1  OR COMP-2 ITEM 
**        STORC1C2 -  STORE INTO COMP-1 OR COMP-2 ITEM
* 
* STORC1C2 LINK  CGSTORC
* 
*         P1 = VIRTUAL REGISTER  NUMBER OF REGISTER CONTAINING VALUE. 
*         REGC = POINTER TO DESTINATION DNAT. 
*         CALLZ  STORC1C2 
* 
*         GENERATES CODE TO STORE THE REGISTER INDICATED BY P1
*         INTO THE (POSSIBLY SUBSCRIPTED) ITEM DESCRIBED BY REGC. 
* 
*         USES-  P1, P2, P3, P4 
  
  
 STORC1C2 EGO    3
          IFZ    ((GSCODEOF,REGC),NE,0),STRC1C21 IF DEST. IS SUBSCRIPTED
  
          NOTE   STORC1C2 
          GEN    XMIT,(VREGOF,VREG1),P1 
          GEN    SSRBPK,VREG1,,RECADDR
          RETURN
  
  
*                            DESTINATION IS  SUBSCRIPTED
 STRC1C21 LABEL 
          NOTE   STRC1C21 
  
          IFTHEN ((SUBSCOF,REGC),EQ,0)           IF NO SPECIAL CASING 
            MOVEZ  (GSCODEOF,REGC),P1 
            CALLZ  SUBLOAD
            GEN    SHL,P1,30
            GEN    SXXPK,(VREGOF,VREG2),P1,(BCPOF,REGC) 
            GENM   STSUB
              SYMP   ((FWA$OF,REGC))
              REGP   VREG2,VREG1
            ENDG
            RETURN
            ENDIFZ
  
          GEN    XMIT,(VREGOF,VREG1),P1 
          MOVEZ  VREG1,P4              SOURCE REGISTER
          MOVEZ  REGC,P1                         DESTINATION DNAT 
          MOVEZ  1,P2                            RIGHT-JUSTIFIED
          MOVEZ  0,P3                            NO FILL
          CALLZ  SCSTORE
  
          RETURN
          TITLE  STORC4 - STORE COMP-4 ITEM 
*         STORC4     STORE COMP-1 REGISTER INTO COMP-4 ITEM 
* STORC4  LINK
* 
*         P1  =  VIRTUAL REGISTER NUMBER OF REGISTER CONTAINING 
*                THE VALUE TO STORE 
*         REGC = POINTER TO DESTINATION DNAT
* 
*         CALLZ  STORC4 
* 
*         GENERATES CODE TO STORE THE REGISTER INDICATED BY P1
*         INTO THE POSSIBILY SUBSCRIPTED ITEM DESCRIBED BY REGC 
* 
 STORC4   EGO    3
          IFZ    ((GSCODEOF,REGC),NE,0),STORC42 IF SUBSCRIPTED ITEM 
* 
          NOTE   STORC4 
          IFZ    ((ARITH1,REGC),GT,10),STORC41   IF MORE THAN ONE WORD
                                                           BCP+ITMLG
*         RECEIVING FIELD ON ONE WORD ONLY
          GEN    XMIT,(VREGOF,VREG1),P1          LOAD REGISTER
          GEN    SLRBPK,(VREGOF,VREG2),,((FWA$OF,REGC)) LOAD FIRST WORD 
          GEN    MASK,(VREGOF,VREG3),(ARITH3,REGC)         6*ITMLG
          MOVEZ  (BCPOF,REGC),T1
          GEN    SHL,VREG3,(ARITH7,T1)                     60-6*BCP 
          GEN    LIMP,(VREGOF,VREG4),VREG2,VREG3
          MOVEZ  (ARITH10,REGC),T1                         6*(BCP+LG) 
          GEN    SHL,VREG1,(ARITH11,T1)                    60-T1
          GEN    LAND,(VREGOF,VREG1),VREG3,VREG1
          GEN    LOR,(VREGOF,VREG4),VREG4,VREG1 
          GEN    SSRAPB,VREG4,VREG2,VREGB0       STORE RESULT 
          RETURN
*         RECEIVING FIELD IS ON TWO WORDS 
 STORC41  LABEL 
          GEN    XMIT,(VREGOF,VREG1),P1          LOAD SENDING FIELD 
          MOVEZ  (ARITH12,REGC),T1                         BCP+ -10 
          GEN    SHL,VREG1,(ARITH7,T1)                     60-6*T1
*         FIRST WORD
          GEN    SLRBPK,(VREGOF,VREG2),,((FWA$OF,REGC)) LOAD FIRST WORD 
          MOVEZ  (ARITH6,REGC),T2                          10-BCP 
          GEN    MASK,(VREGOF,VREG3),(ARITH8,T2)           T2*6 
          GEN    SHL,VREG3,(ARITH8,T2)                     T2*6 
          GEN    LIMP,(VREGOF,VREG4),VREG2,VREG3 EXTRACT USEFUL PART
          GEN    LAND,(VREGOF,VREG5),VREG3,VREG1 EXTRACT GOOD FIELD 
          GEN    LOR,(VREGOF,VREG6),VREG4,VREG5 
          GEN    SSRAPB,VREG6,VREG2,VREGB0       STORE FIRST WORD 
*         CONSTITUTION OF SECOND WORD 
          GEN    SLRAPB,(VREGOF,VREG2),VREG2,VREGB1  LOAD SECOND WORD 
          MOVEZ  (ARITH12,REGC),T1                         BCP+ -10 
          GEN    MASK,(VREGOF,VREG3),(ARITH8,T1)           6*T1 
          GEN    LIMP,(VREGOF,VREG4),VREG2,VREG3 EXTRACT FIX PART 
          GEN    LAND,(VREGOF,VREG5),VREG3,VREG1 EXTRACT SEND. FIELD
          GEN    LOR,(VREGOF,VREG6),VREG4,VREG5 
          GEN    SSRAPB,VREG6,VREG2,VREGB0       STORE 2ND WORD 
          RETURN
*                DESTINATION IS SUBSCRIPTED 
 STORC42  LABEL 
          NOTE   STORC42
*      BUILDING  DESCRIPTOR FOR NO SHIFTING AND NO SIGN 
          MOVEZ  1,T1 
          LSHIFT T1,9 
          ADDZ   T1,(BYTLENOF,REGB),T1
          LSHIFT T1,8 
          ADDZ   T1,(BYTLENOF,REGC),T1
          GEN    SXBPK,(VREGOF,VREG2),,T1 
*      LOAD  SOURCE 
          GEN    XMIT,(VREGOF,VREG4),P1 
*      LOAD  CHARACTER OFFSET  FOR DESTINATION
          MOVEZ  RECSUBS,P1 
          CALLZ  SUBLOAD
          GEN    SHR,P1,30
          MOVEZ  P1,VREGV 
          MOVEZ  (BCPOF,REGC),P1
          CALLZ  SETXXPK
          MOVEZ  VREGV,VREG3
*     LOAD  DESTINATION  ADDRES 
          GEN    SBBPK,(VREGOF,VREG1),,((FWA$OF,REGC))
             GENOBJ N=C.RN1ND,I=(VREG2,VREG4,VREG3,VREG1) 
          RETURN
          TITLE  STORIT1- STORE FIRST WORD OF SOURCE FIELD
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 
*                                                                     * 
** NAME-  STORIT1 SUBROUTINE (INTERPRETIVE)                           * 
*                                                                     * 
** PURPOSE-                                                           * 
*      GENERATE CODE TO STORE A DATA FIELD CONTAINED ENTIRELY WITHIN  * 
*      ONE WORD, OR THE FIRST WORD OF A MULTIPLE PRECISION ITEM       * 
*      RETAIN BACKGROUND CHARACTERS IN RESULT WORD                    * 
*      SOURCE FIELD STORED AS IS- NOT ALIGNED IN THE REGISTER         * 
*                                                                     * 
** DESCRIPTION-                                                       * 
*      IF THE FIELD IS A FULL WORD OR THE RECEIVING FIELD IS
*      SYNCHRONIZED GENERATE
*      BXJ   XI              (IF NECESSARY)                           * 
*      SAJ   K                                                        * 
*      IF THE FIELD BEGINS ON A WORD BOUNDARY USE STLFT TO GENERATE   * 
*      CODE                                                           * 
*      IF THE FIELD ENDS ON A WORD BOUNDARY USE STRGT TO GENERATE CODE* 
*      OTHERWISE USE STMID TO GENERATE CODE                           * 
*                                                                     * 
** INPUT                                                              * 
*      FIXED CELL P4 CONTAINS THE SIZE OF THE RECEIVING FIELD IN CHARS* 
*      FIXED CELL P3 CONTAINS A SHIFT COUNT FOR P4                    * 
*      VIRTUAL REG MOVEREGB (POINTS TO A REAL REG WHICH) CONTAINS THE * 
*      ADDRESS OF THE RECEIVING FIELD                                 * 
*      (VIRTUAL) X-REG VREGA CONTAINS THE FIELD TO STORE              * 
*                                                                     * 
** OUTPUT                                                             * 
*      (VIRTUAL) A-REG VREGC CONTAINS THE WORD ADDRESS OF THE         * 
*      RECEIVING FIELD                                                * 
*                                                                     * 
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 
  
 STORIT1  EGO    3
          IFZ    ((SYNCHOF,MOVEREGB),NE,0),STORE100 
          IFZ    (P3,NE,0),STORE400 
  
*      FIELD BEGINS ON A WORD BOUNDARY
  
          IFZ    (P4,LT,10),STORE300
  
*      GENERATE FULL WORD STORE 
  
 STORE100 LABEL 
          NOTE   STORE100 
          GEN    XMIT,(VREGOF,VREGC),VREGA
          GEN    SSRBPK,VREGC,,RECADDR
          RETURN
          SPACE  4
*      GENERATE CODE  TO STORE FIELD THAT BEGINS ON A WORD BOUNDARY 
  
*                  ARITH8: 6*FIXED
 STORE300 LABEL 
          NOTE   STORE300 
          GENM   STLFT
            SYMP   RECADDR
            REGP   VREGA,(VREGOF,VREGC) 
            CONP   (ARITH8,P4)
          ENDG
          RETURN
          SPACE  4
*      RECEIVING FIELD DOES NOT START ON A WORD BOUNDARY
  
 STORE400 LABEL 
          ADDZ   P3,P4,T1 
          IFZ    (T1,NE,10),STORE500
  
*      GENERATE CODE TO STORE INTO FIELD THAT ENDS ON A WORD BOUNDARY 
  
*                  ARITH8: 6*FIXED
          NOTE   STORE400 
          GENM   STRGT
          SYMP   RECADDR
          REGP   (VREFOF,VREGA),(VREGOF,VREGC)
          CONP   (ARITH8,P3)
          ENDG
          RETURN
          SPACE  4
*      GENERATE CODE TO STORE INTO A FIELD THAT NEITHER BEGINS NOR ENDS 
*      ON A WORD BOUNDARY 
  
*                  ARITH8: 6*FIXED
*                  ARITH7: 60-6*FIXED 
 STORE500 LABEL 
          NOTE   STORE500 
          GENM   STMID
          SYMP   RECADDR
          REGP   (VREFOF,VREGA),(VREGOF,VREGC)
            CONP   (ARITH8,P4),(ARITH7,P3)
          ENDG
          RETURN
  
          TITLE  STORIT2- STORE NEXT WORD  OF SOURCE FIELD
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 
*                                                                     * 
** NAME-  STORIT2 SUBROUTINE (INTERPRETIVE)                           * 
*                                                                     * 
** PURPOSE-                                                           * 
*      GENERATE CODE TO STORE SECOND WORD OF DOUBLE PRECISION ITEM OR * 
*      NEXT WORD OF A MULTIPLE PRECISION ITEM                         * 
*      RETAIN BACKGROUND CHARACTERS IN RESULT WORD                    * 
*      SOURCE FIELD STORED AS IS- NOT ALIGNED IN THE REGISTER         * 
*                                                                     * 
** DESCRIPTION-                                                       * 
*      IF THE FIELD IS A FULL WORD OR IF IT IS SYNCHRONIZED GENERATE  * 
*      BXI   XJ              (IF NECESSARY)                           * 
*      SAI   AS+B1       (B1=1)                                       * 
*      OTHERWISE USE MACRO STLFT2 TO GENERATE CODE                    * 
*                                                                     * 
** INPUT                                                              * 
*      FIXED CELL P6 CONTAINS THE NUMBER OF CHARS TO STORE             *
*      (VIRTUAL) A-REG VREGC CONTAINS THE ADDRESS OF THE WORD         * 
*      PREVIOUSLY STORED INTO                                         * 
*      (VIRTUAL) X-REG VREGA CONTAINS THE FIELD TO STORE              * 
*                                                                     * 
** OUTPUT                                                             * 
*      (VIRTUAL) A-REG VREGC CONTAINS THE ADDRESS OF THE RECEIVING    * 
*      FIELD                                                          * 
*                                                                     * 
** SUBROUTINES CALLED- NONE                                           * 
*                                                                     * 
** MACROS USED- STLFT2                                                * 
*                                                                     * 
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 
  
 STORIT2  EGO    3
          IFTHEN ((SYNCHOF,MOVEREGB),EQ,0)
            ANDIF  (P6,NE,10) 
              BRANCH STORE700 
          ENDIFZ
  
*      GENERATE FULL WORD STORE 
            GEN    XMIT,(VREGOF,VREGZ),VREGA
            GEN    SSRAPB,VREGZ,VREGC,VREGB1
            MOVEZ  VREGZ,VREGC
          RETURN
  
*      GENERATE CODE TO STORE INTO FIELD THAT DOESN"T END ON A WORD 
*      BOUNDARY 
  
*                  ARITH8: 6*FIXED
 STORE700   LABEL 
          NOTE   STORE700 
          GENM   STLFT2 
          REGP   (VREFOF,VREGC),(VREFOF,VREGA),(VREGOF,VREGC) 
          CONP   (ARITH8,P6)
          ENDG
          RETURN
          TITLE  STRBLNK - STORE FULL WORDS OF BLANKS 
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 
*                                                                     * 
** NAME-  STRBLNK SUBROUTINE                                           *
*                                                                     * 
** PURPOSE-                                                           * 
*      GENERATE CODE TO STORE WORDS OF BLANKS OR ZEROS
*                                                                     * 
** DESCRIPTION-                                                       * 
*      IF NO WORDS ARE TO BE STORED- RETURN                            *
*      IF 1@A@9 GENERATE                                              * 
*         SAK   C.BLANK  OR  C.ZERO 
*         BXJ   XK                                                     *
*         SAJ   AJ+B1                                                  *
*      REPEATING THE STORE A TIMES                                     *
*      IF A>9 GENERATE                                                * 
*                SAK   C.BLANK  OR  C.ZERO
*                SBL   A
*                BXJ   XK                                             * 
*         LOOP   BSS   0                                               *
*                SAJ   AJ+B1                                           *
*                SBL   BL+B1                                           *
*                NE    BL,LOOP                                         *
*                                                                     * 
** INPUT                                                              * 
*      FIXED CELL P5 CONTAINS THE NUMBER OF WORDS TO STORE (=A)        *
*      (VIRTUAL) A-REG VREGC CONTAINS THE ADDRESS OF THE LAST WORD     *
*      STORED INTO.                                                    *
*                                                                     * 
** OUTPUT                                                             * 
*      (VIRTUAL) A-REG VREGC CONTAINS THE ADDRESS OF THE LAST WORD THIS*
*      ROUTINE STORES INTO                                             *
*                                                                     * 
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 
  
 STRBLNK  EGO    3
          IFZ    (P5,EQ,0),RETURN 
          IFZ    (P5,GT,9),STRBLNK5 
  
*      GENERATE CODE TO STORE LESS THAN 10 WORDS OF BLANKS OR ZEROS 
  
          NOTE   STRBLNK
          MOVEZ  P5,T1
          IFTHEN  ((TYPEOF,MOVEREGB),EQ,COMP) 
            GEN  SLRBPK,(VREGOF,VREGZ),,CBZEROS 
          ELSEZ 
            GEN  SLRBPK,(VREGOF,VREGZ),,BLANKS
          ENDIFZ
          GENLP  VREGC
          GEN    XMIT,VREGC,VREGZ 
 STRBLNK3 LABEL 
          GEN    SSRAPB,VREGC,VREGC,VREGB1
          SUBZ   T1,1,T1
          IFZ    (T1,GT,0),STRBLNK3 
          GEN    ENDL 
          RETURN
          SPACE  4
*      GENERATE CODE TO STORE MORE THAN 9 WORDS OF BLANKS OR ZEROS
  
 STRBLNK5 LABEL 
          NOTE   STRBLNK5 
          MOVEZ  (LOCLAB,LABLNUM),LABLNUM 
          IFTHEN  ((TYPEOF,MOVEREGB),EQ,COMP) 
            GEN  SLRBPK,(VREGOF,VREGZ),,CBZEROS 
          ELSEZ 
            GEN  SLRBPK,(VREGOF,VREGZ),,BLANKS
          ENDIFZ
          GEN    SBBPK,(VREGOF,VREGY),,P5 
          GENLP  VREGC,VREGY
          GEN    XMIT,VREGC,VREGZ 
          GEN    LABEL$,LOCLABL 
          GEN    SSRAPB,VREGC,VREGC,VREGB1
          GEN    SBBMB,VREGY,VREGY,VREGB1 
          GEN    NE$,VREGY,LOCLABL
          GEN    ENDL 
          RETURN
          END 
