*DECK S$GNPIR 
          IDENT  S$GNPIR
          TITLE  S$GNPIR  - GENERATE PUT INTERNAL RECORD CODE 
          COMMENT  GENERATE PUT INTERNAL RECORD CODE. 
  
*CALL LBLPTR
  
  
          B1=1
  
  
**        S$GNPIR  - GENERATE PUT INTERNAL RECORD CODE
* 
*     CALLING SEQUENCE- 
*         S$GNPIR(SPEC$FIXED, IRRL, OFFSET, LL, LF);
* 
*     GIVEN-
*         SPEC$FIXED = TRUE IF FIXED LENGTH RECORDS 
*         IRRL  = INTERNAL RECORD LENGTH. 
*         OFFSET = BIT OFFSET TO BEGINNING OF LENGTH FIELD
*                  (I.E. 1+1+LR+LK+LO)
*         LL = LENGTH OF LENGTH FIELD 
*              (I.E. REC$LL1 + REC$LL2) 
*         LF = LENGTH OF NON-KEY, NON-SUM PART OF RECORD
*              (I.E. REC$LF1 + REC$LF2) 
* 
*     DOES- 
*         GENERATE PUT INTERNAL RECORD CODE 
* 
*         GENERATED CODE EXPECTS- 
*         X6=WINNER TO BE WRITTEN OUT TO INTERNAL FILE
* 
*         GENERATED CODE DOES-
*         WRITE OUT WINNER (X6) TO INTERNAL FILE
*         RESET X6 FROM "RECDESC" FOR GNGRU 
* 
  
  
          ENTRY  S$GNPIR
 S$GNPIR  SUBR               ENTRY/EXIT WORD
          SB1    1           CONSTANT 1 
  
* GET AND SAVE PARAMETERS 
* 
          SA4    X1          X4=VALUE OF *SPEC$FIXED* 
          SA5    A1+B1       X5=ADDR OF *IRRL*
          SA5    X5          X5=VALUE OF *IRRL* 
          SA2    A1+2        ADDRESS OF OFFSET
          SA2    X2          VALUE OF OFFSET
          SB2    X2          B2 = OFFSET
          SA2    A1+3        ADDRESS OF LL
          SA2    X2          VALUE OF LL
          SB3    X2          B3 = LL
          SA2    A1+4        ADDRESS OF LF
          SA2    X2          VALUE OF LF
          BX6    X2 
          SA6    LF          *LF* := VALUE OF LF
* 
          GENLBL PRIENTRY 
  
* CHECK IF BIT 58 OF X6 IS SET, THEN THIS RECORD IS A SUMMED ONE
* SKIP PUTTING THIS RECORD BY JUMPING TO "PRIDONE"
  
          GEN    (BX5 X6)              *DESCRIPTOR
          GEN    (LX5 1)               *SHIFT BIT 58 TO LEFT-MOST 
          NEWLBL PRIDONE
          GEN    (MI X5,"PRIDONE")     *IF BIT 58 OF X6 SET 
* 
* IF SPEC$FIXED GENERATE THIS CODE
          IFTHEN X4"0 
            GEN    (SX2 1),X5          * #=N0 OF WORDS TO MOVE
          ELSE- 
* CALCULATE X2=N0 OF WORDS TO MOVE
            CALL   SETX2               *SET X2 = WORD LENGTH
            ENDIF.
  
          GENLBL PRIMOVE1 
  
          GEN    (SA3 2+"FET")         *IN PTR
          GEN    (SA4 A3+B1)           *OUT PTR 
          GEN    (IX5 X3-X4)           * (IN-OUT) 
          NEWLBL INAHEAD
          GEN    (PL X5,"INAHEAD")     *IF IN>=OUT
* 
* CASE IN PTR BEHIND OUT PTR
* 
          GEN    (IX0 X2+X5)           * #-(OUT-IN) 
          IFTHEN X4"0        IF SPEC$FIXED IS TRUE, 
            NEWLBL PRIMOVE5 
            GEN    (NG X0,"PRIMOVE5")  *IF ENOUGH ROOM FOR RECLEN 
          ELSE-              IF VARIABLE-LENGTH RECORDS,
            NEWLBL PRIMOVE4 
            GEN    (NG X0,"PRIMOVE4")  *IF ENOUGH ROOM FOR RECLEN 
            ENDIF.
  
          GENLBL WRITEBUF 
          GEN    (SA6 "SAVEX6")        *SAVE X6 BEFORE DO WRITE 
          GEN    (SB3 X2)              *SAVE X2 IN B3 
          GEN    (SA0 "FET")
          GENMAC (WRITE A0,RECALL)     *WRITE CIOBUF TO FILE
          GEN    (SA2 "SAVEX6")        *RESTORE X6
          GEN    (BX6 X2) 
          GEN    (SX2 B3)              *RESTORE X2 FROM B3
  
          GEN    (EQ "PRIMOVE1")       *BACK TO TEST FET PTRS 
* 
* CASE IN PTR AHEAD OF OUT PTR
* 
          GENLBL INAHEAD
          GEN    (SA1 A4+B1)           *LIMIT PTR 
          GEN    (SX1 X1)              *KEEP LO 18 BITS 
          GEN    (IX0 X1-X3)           *LIMIT-IN
          GEN    (IX0 X2-X0)           * #-(LIMIT-IN) 
          IFTHEN X4"0        IF SPEC$FIXED IS TRUE, 
            GEN    (NG X0,"PRIMOVE5")  *IF ENOUGH ROOM FOR RECLEN 
          ELSE-              IF VARIABLE-LENGTH RECORDS 
            GEN    (NG X0,"PRIMOVE4")*IF ENOUGH ROOM FOR RECLEN 
            ENDIF.
          GEN    (SA1 A3-B1)           *FIRST PTR 
          GEN    (SX1 X1)              *KEEP LO 18 BITS 
          GEN    (IX1 X4-X1)           *OUT-FIRST 
          GEN    (IX1 X0-X1)           * N-(LIMIT-IN)-(OUT-FIRST) 
          GEN    (PL X1,"WRITEBUF")    *IF NOT ENOUGH ROOM
  
          GEN    (IX0 X2-X0)           * N-(N-(LIMIT-IN))=LIMIT-IN
          GEN    (SB3 X0) 
          NEWLBL NEXT 
          GEN    (ZR B3,"NEXT")        *IF BUFFER FULL
          GEN    (SB2 B0) 
          GEN    (SA1 "SAVEAD") 
          GEN    (SA1 X1) 
  
          GENLBL PRILOOP2 
          GEN    (SA6 X3+B2)           *IN+INDEX
          GEN    (SB2 B2+B1)           *INCREMENT INDEX 
          GEN    (BX6 X1)              *PREPARE NEXT WORD 
          GEN    (SA1 A1+B1)           *GET NEXT WORD 
          GEN    (LT B2,B3,"PRILOOP2") *IF MORE WORDS,LOOP
  
          GEN    (SX7 A1)              *SAVE ADDR OF RSA
          GEN    (SA7 "SAVEAD")        *  WORD NOW IN X6
  
          GENLBL NEXT 
          GEN    (SA1 A3-B1)           *FIRST PTR 
          GEN    (SX7 X1)              *KEEP LO 18 BITS 
          GEN    (SA7 A3)              *SET IN=FIRST IN FET 
          GEN    (BX3 X7)              *  AND UPDATE IN PTR IN X3 
  
          GEN    (IX2 X2-X0)           * #-(LIMIT-IN) 
          GEN    (ZR X2,"PRIDONE")     *IF DONE WRITING RECS
  
  
          GENLBL PRIMOVE4 
          GEN    (SB3 X2)              *N0 OF WORDS TO MOVE 
          GEN    (SA1 "SAVEAD") 
          GEN    (SA1 X1) 
          GEN    (SB2 B0) 
  
          GENLBL PRILOOP4 
          GEN    (SA6 X3+B2)           *IN+INDEX
          GEN    (SB2 B2+B1)           *INCR. INDEX 
          GEN    (BX6 X1)              *PREPARE NEXT WORD 
          GEN    (SA1 A1+B1)           *GET NEXT RSA WORD 
          GEN    (LT B2,B3,"PRILOOP4") *IF MORE WORDS,LOOP
  
          GEN    (SX7 X3+B2)           *INCR IN PTR 
          GEN    (SA7 A3)              *   BY N0 OF WORDS MOVED 
          GEN    (BX3 X7) 
        IFTHEN X4"0          IF SPEC$FIXED IS TRUE, 
          GEN    (EQ "PRIDONE") 
                             *MOVE IRRL+1 WORDS 
          GENLBL PRIMOVE5 
          GEN    (SA6 X3)              *WRITE X6 TO BUFFER
          GEN    (SX3 X3+B1)           *IN=IN+1 
          SB3    X5          IRRL 
          LE     B3,B0,DONEMOVE 
          GEN    (SA1 "SAVEAD") 
          GEN    (SA1 X1) 
          GEN    (BX6 X1) 
          GEN    (SA6 X3)              *MOVE NEXT WORD
          GEN    (SX3 X3+B1)           *IN=IN+1 
                                       *MOVE 3RD THRU (IRRL+1)TH WORD 
 MOVEWORD EQ     B3,B1,DONEMOVE 
          GEN    (SA1 A1+B1)           *PREPARE NEXT WORD 
          GEN    (BX6 X1) 
          GEN    (SA6 X3)              *MOVE NEXT WORD
          GEN    (SX3 X3+B1)           *IN=IN+1 
          SB3    B3-B1
          EQ     MOVEWORD 
  
 DONEMOVE GEN    (BX7 X3)              *UPDATE IN PTR 
          GEN    (SA7 A3)              *   IN FET 
          ENDIF.
  
          GENLBL PRIDONE
* SET UP X6 FOR S$GNGRU 
          GEN    (SA5 "RECDESC")
          GEN    (BX6 X5) 
  
          EXIT
          TITLE  SETX2 -  GENERATE- SET *X2 TO WORD LENGTH OF RECORD
**        SETX2 -  GENERATE- SET *X2 TO WORD LENGTH OF RECORD 
* 
*     CALLING SEQUENCE- 
*         CALL   SETX2
* 
*     GIVEN-
*         *X6 = DESCRIPTOR
*         "SAVEAD" = ADDRESS OF FIRST WORD AFTER DESCRIPTOR 
*         B2 = OFFSET 
*         B3 = LL 
* 
*     DOES- 
*         GENERATES CODE TO SET *X2 TO WORD LENGTH
  
  
 SETX2    SUBR
          SB7    B2+B3       OFFSET + LL
          SB6    60 
          IFTHEN B7@B6      IF FIELD ENTIRELY WITHIN DESCRIPTOR 
            IFTHEN B7=B6       IF RIGHT-JUSTIFIED,
              SB5    B2              <OFFSET-WITHIN-WORD>=OFFSET
              GEN    (MX1 0),B2 
              GEN    (BX2 -X1*X6) 
            ELSE-              IF NOT RIGHT-JUSTIFIED,
              SB5    B2              <OFFSET-WITHIN-WORD>=OFFSET
              GEN    (BX2 X6) 
              SB7    B2+B3
              GEN    (LX2 0),B7 
              SB6    60 
              SB7    B6-B3
              GEN    (MX1 0),B7 
              GEN    (BX2 -X1*X2) 
              ENDIF.
          ELSE-              IF FIELD NOT ENTIRELY WITHIN DESCRIPTOR
            IFTHEN B2<B6       IF FIELD PARTLY IN DESCRIPTOR
              CALL    SETX2A
            ELSE-              IF FIELD NOT AT ALL IN DESCRIPTOR
              CALL    SETX2B
              ENDIF.
            ENDIF.
*         SET *X2 TO THE RECORD LENGTH IN (ROUNDED) WORDS.
*         THIS LENGTH WILL CHANGE WITH EVERY RECORD WE PROCESS. 
*         FIRST STEP IS TO COMPUTE THE RECORD LENGTH IN BITS. 
*         THIS IS EASY BECAUSE *X2 NOW CONTAINS THE LENGTH OF THE 
*         VARIABLE PART OF THE RECORD.
* 
*         FORMAT OF INTERNAL RECORD --
* 
*         ----------------------------------------------------------
*          OFFSET       /  LL  /  LF /    VARIABLE PART            /
*         ----------------------------------------------------------
* 
*         THE RECORD LENGTH IN BITS IS EQUAL TO : 
*          OFFSET + LL + LF + (VARIABLE PART * 6 )
*          OFFSET,LL, AND LF ARE CONSTANT FOR A GIVEN SORT. THE 
*          VALUE IN *X2 RIGHT NOW IS THE LENGTH OF THE VARIABLE 
*          PART IN BYTES, SO WE NEED TO MULTIPLY BY 6 TO GET BITS.
* 
          SB7    B2+B3       OFFSET+LL
          SA1    LF 
          SX1    X1+B7       OFFSET+LL+LF(IN BITS)
          GEN    (SX1 0),X1  *X1 = OFFSET+LL+LF(IN BITS)
* 
*         MULTIPLY *X2 BY 6 TO GET LENGTH OF VARIABLE PART IN BITS
  
          GEN    (SX0 6)
          GEN    (IX2 X2*X0)
  
*         COMPUTE RECORD LENGTH IN BITS 
  
          GEN    (IX2 X2+X1) OFFSET+LL+LF+(VARIABLE PART * 6) 
  
*         GET RECORD LENGTH IN (ROUNDED) WORDS
  
          GEN    (SX1 1S22/60+1)
          GEN    (IX2 X2*X1)
          GEN    (AX2 22)    RECORD LENGTH/60 
          GEN    (SX2 X2+1)  (RECORD LENGTH/60)+1 
          EXIT
SETX2A    EJECT 
 SETX2A   SUBR               LENGTH FIELD PARTLY IN DESCRIPTOR
          GEN    (SA3 "SAVEAD")        *ADDRESS OF FIRST WORD 
          GEN    (SA3 X3)              *FIRST WORD AFTER DESCRIPTOR 
          SB7    B2+B3       OFFSET + LL
          SB7    B7-60
          GEN    (MX4 0),B7 
          GEN    (BX3 X4*X3)
          GEN    (MX4 0),B2 
          GEN    (BX2 -X4*X6) 
          GEN    (BX2 X3+X2)
          SB7    B2+B3       OFFSET + LL
          SB7    B7-60
          GEN    (LX2 0),B7 
          SB5    B2          <OFFSET-WITHIN-WORD> 
          EXIT
SETX2B    EJECT 
 SETX2B   SUBR               LENGTH FIELD ENTIRELY BEYOND DESCRIPTOR
          GEN    (SA2 "SAVEAD") 
          SX1    B2          OFFSET 
          SX0    1S22/60+1   1/60 * 2**22 
          IX2    X0*X1       OFFSET/60 * 2**22
          AX2    22          OFFSET/60
          SB5    X2-1        WORDS NOT COUNTING DESCRIPTOR
          GEN    (SA2 X2+0),B5         *WORD WITH LEFT PART OF FIELD
          SX2    B5+B1       OFFSET/60
          SX0    60 
          IX2    X0*X2       (OFFSET/60)*60 
          SX1    B2          OFFSET 
          IX2    X1-X2       OFFSET - (OFFSET/60)*60
          SB5    X2          BIT OFFSET WITHIN *X2 OF LENGTH FIELD
          SB7    B5+B3
          SB6    60 
          IFTHEN B7@B6      IF FIELD ENTIRELY IN *X2
            IFTHEN B7<B6       IF FIELD NOT RIGHT-JUSTIFIED 
              GEN    (LX2 0),B7 
              ENDIF.
            SB6    60 
            SB7    B6-B3       60 - LL
            GEN    (MX4 0),B7 
            GEN    (BX2 -X4*X2) 
          ELSE-              IF FIELD SPANS TWO WORDS 
            GEN    (MX4 0),B5 
            GEN    (BX2 -X4*X2) 
            GEN    (SA3 A2+B1)         *NEXT WORD 
            SB7    B5+B3       BIT OFFSET + LL
            SB7    B7-60
            GEN    (MX4 0),B7 
            GEN    (BX3 X4*X3)
            GEN    (BX2 X3+X2)
            SB7    B5+B3       BIT OFFSET + LL
            SB7    B7-60
            GEN    (LX2 0),B7 
            ENDIF.
          EXIT
  
  
 LF       BSS    1           VALUE OF LF FROM CALL
  
  
          END 
