*DECK S$GNAPN 
          IDENT  S$GNAPN
          TITLE  S$GNAPN -  GENERATE- APPEND VALUE TO INTERNAL RECORD 
          COMMENT  APPEND VALUE TO INTERNAL RECORD
  
*CALL LBLPTR
  
          SPACE  4
**        S$GNAPN -  GENERATE- APPEND VALUE TO INTERNAL RECORD
* 
*     CALLING SEQUENCE- 
*         CALL   S$GNAPN
* 
*     GIVEN-
*         B5 = OFFSET OF FIELD WITHIN GENERATED-CODE REGISTER X4 (*X4). 
*         B7 = LENGTH OF FIELD WITHIN GENERATED-CODE REGISTER X4 (*X4). 
*         S$LK = NUMBER OF BITS OF INFORMATION THAT HAVE BEEN 
*                 PREVIOUSLY APPENDED.
*         S$LR = NUMBER OF BITS RESERVED FOR RECORD NUMBER  (REC$LR). 
*         S$ORSA = WORD OFFSET WITHIN WSA$ OF RECORD STORAGE AREA.
* 
*     DOES- 
*         GENERATES CODE. 
*         INCREMENTS S$LK BY LENGTH OF FIELD (B3).
* 
*     GENERATED CODE EXPECTS- 
*         "RECDESC" = DESCRIPTOR FOR THIS RECORD, CONTAINING THE
*                      RECORD NUMBER. 
*         "WSA" = ADDRESS OF WORKING STORAGE AREA  (WSA$).
*         (IF S$LK " 0,)
*             *X6 = CURRENT VALUE OF KEY, 
*                    WHOSE (1 + 1 + S$LR + S$LK MOD 60) BITS ARE USED 
*                    (EXCEPT 0 MEANS 60). 
*         *X4 = REGISTER CONTAINING FIELD.
* 
*     GENERATED CODE DOES-
*         (IF S$LK=0,)
*             SETS *X6 = "RECDESC". 
*         SETS THE REMAINDER OF *X4 TO ZERO.
*         ALIGNS *X4 WITH *X6.
*         (IF *X6 IS FULL,) 
*             STORES *X6 APPROPRIATELY- 
*              INTO "RECDESC", OR 
*              INTO FIRST WORD OF SLOT IN RECORD STORAGE AREA, OR 
*              INTO *A6+*B1.
*         (IF FIELD IN *X4 CAN FIT INTO *X6,) 
*             INSERTS *X4 INTO *X6
*         (ELSE)
*             FILLS REMAINDER OF *X6 WITH *X4 
*             SETS UP NEW *X6 WITH EXCESS FROM *X4. 
*         (INCREMENTS S$LK BY LENGTH OF FIELD  (B3).) 
* 
*     NOTE- 
*         THE ABOVE PHRASES ENCLOSED IN PARENTHESES INDICATE
*         DECISIONS OR ACTIONS DONE AT CODE GENERATION TIME RATHER
*         THAN EXECUTION TIME.
* 
*     GENERATED CODE USES-
*         *B    * - - - - - -          *B1=1
*         *X  - - - 3 4 - 6 - 
*         *A  - - - 3 - - 6 - 
* 
*     S$GNAPN USES- 
*          B    - - - - 5 6 7 
*          X  0 1 2 3 - - 6 - 
*          A  - 1 2 3 - - 6 - 
          ENTRY  S$GNAPN
 S$GNAPN  SUBR
          SX6    B3 
          SA6    SAVEB3 
          SB3    B7 
  
*     ENSURE THAT THE REST OF *X4 IS ZERO 
  
          SB7    B5+B3
          SB6    60 
          IFTHEN B5=0        IF LEFT-JUSTIFIED
            IFTHEN B7"B6       IF NOT-RIGHT-JUSTIFIED 
              GEN    (MX3 0),B3 
             *USES   B6,B7,X0,AX1-3,AX6 
              GEN    (BX4 X3*X4)
            ELSE-              IF FULL WORD 
              ENDIF.
          ELSE-              IF NOT LEFT-JUSTIFIED
            IFTHEN B7"B6       IF NOT RIGHT-JUSTIFIED 
              GEN    (MX3 0),B3        *MX3 <LENGTH>
              GEN    (LX4 0),B5        *LX4 <OFFSET>
              SB5    0           NOTE NEW OFFSET
              GEN    (BX4 X3*X4)
            ELSE-              IF RIGHT-JUSTIFIED 
            GEN    (MX3 0),B5        *MX3 <OFFSET>
              GEN    (BX4 -X3*X4) 
              ENDIF.
            ENDIF.
  
*     (IF S$LK = 0,)
*         SET *X6 = "RECDESC" 
  
          SA1    S$LK 
          IFTHEN X1=0 
            GEN    (SA3 "RECDESC")
            SA1    S$LR 
            GEN    (MX6 0),X1          *MX6 LR
            GEN    (LX6 60-1-1) 
            GEN    (BX6 X6*X3)
            ENDIF.
  
*     COMPUTE NUMBER OF AVAILABLE BITS IN X6
*         (I.E. 1+1+S$LR+S$LK MOD 60) 
          SA1    S$LR 
          SA2    S$LK 
          IX1    X1+X2
          SX1    X1+1+1 
          SX0    1S22/60+1
          IX2    X1*X0       (1+1+LR+LK)/60 * 2*22
          AX2    22          (1+1+LR+LK)/60 
          SX0    60 
          IX2    X2*X0       ((1+1+LR+LK)/60)*60
          IX2    X1-X2       (1+1+LR+LK) - ((1+1+LR+LK)/60)*60
                             X2 = 1+1+LR+LK MOD 60
  
*     ALIGN *X4 WITH *X6
  
                             B5 = OFFSET OF FIELD IN *X4
          SB7    X2 
          SB7    B5-B7
          IFTHEN B7<0 
            SB7    B7+60
            ENDIF.
          SB5    X2          PRESERVE (1+1+LR+LK MOD 60) IN B5
          IFTHEN B7"0 
            GEN    (LX4 0),B7 
            ENDIF.
  
          SB6    60 
  
*     IF *X6 IS FULL, STORE IT AND SET UP *X4 AS *X6
*     ELSE, IF ROOM IN *X6, APPEND *X4 TO *X6 
*           ELSE, FILL *X6 FROM *X4 AND SET UP REST OF *X4 AS *X6 
  
          IFTHEN B5=0        IF *X6 IS FULL,
            CALL   STOREX6     STORE IT 
            GEN    (BX6 X4)    AND SET UP *X4 AS *X6
          ELSE-              IF *X6 IS NOT FULL,
            SB6    60 
            SB7    B6-B5       NUMBER OF UNUSED BITS IN *X6 
            IFTHEN B7\B3       IF ENOUGH ROOM IN *X6
              GEN    (BX6 X6+X4)
            ELSE-              IF NOT ENOUGH ROOM IN *X6
              GEN    (MX3 0),B5        *MX3 <NO. USED BITS IN *X6>
              GEN    (BX3 -X3*X4) 
              GEN    (BX6 X6+X3)
              CALL   STOREX6
              GEN    (MX3 0),B5        *MX3 <NO. USED BITS IN *X6>
              GEN    (BX6 X3*X4)
              ENDIF.
            ENDIF.
  
*     INCREMENT S$LK BY WIDTH OF FIELD
  
          SA1    S$LK 
          SX6    X1+B3
          SA6    S$LK 
  
          SA1    SAVEB3 
          SB3    X1 
          EXIT
STOREX6   EJECT 
 STOREX6  SUBR
          SA1    S$LR 
          SA2    S$LK 
          IX1    X1+X2
          SB7    X1+1+1 
          SB6    60 
          IFTHEN B7@B6
            GEN    (SA6 "RECDESC")
          ELSE- 
            SB6    120
            IFTHEN B7@B6
              GEN    (SA3 "RECDESC")
              SA1    S$LR 
              GEN    (LX3 1+1),X1 
              SA1    S$LR 
              BX1    -X1
              GEN    (MX1 60-0),X1
              GEN    (BX3 -X1*X3)          *X3 = RECORD NUMBER
              SA1    S$IRRL 
              ZR     X1,ERROR 
              GEN    (SX1 0),X1 
              GEN    (IX3 X3*X1)           * RN*IRRL
              SA1    S$ORSA 
              SA2    S$IRRL 
              IX1    X1-X2                 ORSA-IRRL
  
              IFTHEN X1\0        IF POSITIVE MODIFIER 
                GEN    (SX3 X3+0),X1       * (RN*IRRL)+(ORSA-IRRL)
              ELSE- 
                MX0    -17         MASK ALL EXCEPT LO 17 BITS 
                BX1    -X0*X1      SO THAT A NEGATIVE MODIFIER
                                   DOES NOT PROPAGATE THE SIGN BIT
                                   INTO OP CODE FIELD OF GEN CODE 
                GEN    (SX3 X3+400000B),X1   * (RN*IRRL)+(ORSA-IRRL)
                ENDIF.
  
              GEN    (SA1 "WSA")
              GEN    (IX3 X3+X1)
              GEN    (SA6 X3) 
            ELSE- 
              GEN    (SA6 A6+B1)
              ENDIF.
            ENDIF.
          EXIT
 ERROR    SX1    =10HS$GNAPN-1
          CALL   S$ABORT
  
 SAVEB3   BSS    1
  
 S$IRRL   EXTERNAL           NUMBER OF WORDS PER SLOT IN THE RECORD 
                              STORAGE AREA  (I.E. REC$IRRL) 
 S$LK     EXTERNAL           NUMBER OF BITS OF INFORMATIN THAT HAVE 
                              BEEN PREVIOUSLY APPENDED
 S$LR     EXTERNAL           NUMBER OF BITS RESERVED FOR RECORD NUMBER
                              (REC$LR)
 S$ORSA   EXTERNAL           WORD OFFSET WITHIN WSA$ OF RECORD
                              STORAGE AREA  (WSAS$ORSA) 
  
          END 
