*DECK S$GNPR2 
          IDENT  S$GNPR2
          TITLE  S$GNPR2 -  GENERATE- PUT RECORD, PART 2
          COMMENT  GENERATE- PUT RECORD, PART 2 
          B1=1               FOR (GENMAC (PUT A0))
  
*CALL LBLPTR
  
          SPACE  4
**        S$GNPR2 -  GENERATE- PUT RECORD, PART 2 
* 
*     CALLING SEQUENCE- 
*         S$GNPR2(SPEC$OWN3, SPEC$OWN4, SPEC$OWN5, SPEC$MRL,
*                    OREC, RECLENWRD, REC$LK1, REC$LK2);
*     GIVEN-
*         SPEC$OWN3 = 0 OR ADDRESS OF OWN3 PROCEDURE. 
*         SPEC$OWN4 = 0 OR ADDRESS OF OWN4 PROCEDURE. 
*         SPEC$OWN5 = 0 OR ADDRESS OF OWN5 PROCEDURE. 
*         OREC = WORD OFFSET WITHIN WSA$ OF EXTERNAL RECORD 
*         EXT-REC-LEN = NUMBER OF WORDS FOR EXTERNAL RECORD 
* 
*     DOES- 
*         GENERATES CODE. 
* 
*     GENERATED CODE DOES-
*         CHECK FOR END-OF-DATA (X6=0), GOTO ONEMORE. 
*         CHECK IF SUM-DELETE-BIT SET, SKIP PUTTING RECORD. 
*         IF OWNCODE5 SPECIFIED,
*           IF FIRST RECORD TO BE PUT, THEN 
*               SAVE DESCRIPTOR ST SAVEDESC AND RECORD AT RECLAST.
*           ELSE
*               SET A4 TO SAVEDESC FOR COMPARE CODE FOLLOWED. 
* 
  
  
          ENTRY  S$GNPR2
 S$GNPR2  SUBR
          SB1    1           B1 = CONSTANT 1  (FOR *GEN*) 
* 
* GATHER PARAMETERS 
* 
          SA2    X1          VALUE OF SPEC$OWN3 
          SB2    X2          B2 = ADDRESS OF OWNCODE3 OR 0
          SA4    A1+B1       ADDRESS OF SPEC$OWN4 
          SA4    X4          VALUE OF SPEC$OWN4 
          SA5    A1+2        ADDRESS OF SPEC$OWN5 
          SA5    X5          X5 = 0 OR ADDRESS OF OWN5
          SA2    A1+3        ADDRESS OF SPEC$MRL
          SA2    X2          VALUE OF SPEC$MRL
          SB3    X2          B3 = SPEC$MRL
          SA2    A1+4        ADDRESS OF OREC
          SA2    X2          VALUE OF OREC
          SB4    X2          B4 = OREC
          SA2    A1+5        ADDRESS OF NOWORDS-IN-EXT-REC
          SA2    X2          VALUE OF NOWORDS-IN-EXT-REC
          SB5    X2          B5 = NOWORDS-IN-EXT-REC
          SA2    A1+6        ADDRESS OF REC$LK1 
          SA2    X2          VALUE OF REC$LK1 
          BX7    X2 
          SA7    HOLDLK1
          SA2    A1+7        ADDRESS OF REC$LK2 
          SA2    X2          VALUE OF REC$LK2 
          BX7    X2 
          SA7    HOLDLK2
  
  
  
          NEWLBL PRIDONE
  
* 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 
          GEN    (MI X5,"PRIDONE")     *IF BIT 58 OF X6 SET 
  
* IF END-OF-DATA, COPY THE RECORD AT "RECLAST" TO OREC
  
          NEWLBL NEXT 
          GEN    (NZ X6,"NEXT")        *IF NOT EOD
  
          GENLBL LASTREC
  
          GEN    (SA2 "LRECLEN")       *CHARACTER LENGTH OF "RECLAST" 
          GEN    (BX7 X2) 
          GEN    (SA7 "ORECLEN")       *CHARACTER LENGTH OF OREC
          GEN    (SA5 "WSA")
          GEN    (SA5 X5+0),B4         *WSA+OREC ADDRESS
          NEWLBL RECLAST
          GEN    (SA2 "RECLAST")
          GEN    (SB3 0),B5            *EXT-REC-LEN 
          NEWLBL OWN5LOOP 
  
          GENLBL OWN5LOOP 
          GEN    (BX7 X2)              *XFER RECORD AT RECLAST
          GEN    (SA7 A5)              *TO OREC 
          GEN    (SA2 A2+B1)
          GEN    (SA5 A5+B1)
          GEN    (SB3 B3-B1)
          GEN    (LT B0,B3,"OWN5LOOP") *IF NOT WHOLE RECORD COPIED
  
          NEWLBL OWN3 
          GEN    (EQ "OWN3")
  
          GENLBL NEXT 
  
* IF FIRST RECORD, COPY THE RECORD AT OREC TO "RECLAST" 
  
          NEWLBL FIRST
          GEN    (SA5 "FIRST")       *CHECK IF FIRST RECORD TO BE PUT 
          NEWLBL NEXT 
          GEN    (ZR X5,"NEXT")      *IF NOT FIRST RECORD 
          GEN    (MX7 0)
          GEN    (SA7 "FIRST")       *NOTE NOT FIRST TIME ANYMORE 
  
*   TRANSFER THE KEYS OF THE CURRENT WINNER TO -OLDDESC-
  
          NEWLBL OLDDESC
***** 
* 
*  FIRST, MOVE KEYS FROM THE DESCRIPTOR TO WORD 1 OF -OLDDESC-
* 
***** 
          SA4    S$LR           FOR EXAMPLE, 12 BITS
          SX4    X4+2           TWO BITS AT LEFT ARE NOT KEYS 
*                               SO RESULT IS NOW 14 
          GEN    (MX4 0),X4     MX4 LR+2
          GEN    (BX3 -X4*X6)   *X6 = CURRENT DESCRIPTOR
*                               *X3 = KEYS AND DATA NOW 
          SA5    HOLDLK1
          IX4    X4+X5          X4=16 BITS FOR RN + KEY BITS
          GEN    (MX4 0),X4     *MX4 NUMBER OF KEY BITS IN *X6
          GEN    (BX7 X3*X4)    *X7 = KEYS ONLY NOW 
          GEN    (SA7 "OLDDESC")  SAVE THE KEYS IN WORD 1 
***** 
* 
*  NOW, MOVE ANY KEY BITS IN THE REMAINING WORDS
* 
***** 
  
          SA1    HOLDLK2     NO.OF KEY BITS BEYOND DESCRIPTOR 
          SB7    X1 
  
          IFTHEN  B7>B0 
            SA2    S$ORSA      X2 = ORSA
            SB7    X2          B7 = ORSA
  
            SA2    S$IRRL      X2 = IRRL
            SB6    X2          B6 = IRRL
            SB3    B7-B6       B3 = ORSA-IRRL 
  
            SA4    S$LR        X4 = LR
            BX5    -X4         X5 = -LR 
  
            GEN    (SX2 0),B6            (*X2 = IRRL) 
            GEN    (MX4 60),X5           (*X4 = MASK 60-LR) 
  
*         OBTAIN ADDRESS OF FIRST RSA WORD OF CURRENT RECORD
  
            GEN    (LX6 1+1),X4          *X6 = DESCR.OF CURR. RECORD
            GEN    (BX6 -X4*X6)          (*X6 = RECORD NUMBER)
            GEN    (IX6 X2*X6)           (*X6 = RN*IRRL)
            IFTHEN B3\0        IF ORSA >= IRRL
              GEN    (SX6 X6+0),B3        *SX6 X6+(ORSA-IRRL) 
              ELSE- 
              GEN    (SX6 X6-0),B3        *SX6 X6-(IRRL-ORSA) 
              ENDIF.
            GEN    (SB6 B2+X6)            (*B6 = ADDRESS) 
            SA1    HOLDLK2
            SB3    X1 
            GEN    (SA1 B6-B1)      *GET READY TO LOOP
            GEN    (MX2 60)         *X2 = NORMALLY COMPLETE MASK
LBL2        GEN    (SA1 A1+B1)      *GET (ANOTHER) WORD 
            SB3    B3-60            *WE ARE MOVING 60 MORE BITS 
            IFTHEN    B3<B0 
              SB2    B3+60          B2 = NUMBER OF GOOD BITS IN *X1 
              GEN    (MX2 0),B2 
              ENDIF.
            GEN    (BX7 X1*X2)        *TRANSFER KEY BITS TO *X7 
            GEN    (SA7 A7+B1)        *STORE IN -OLDESC-
            IFTHEN    B3>B0           IF MORE KEY BITS TO MOVE
              EQ LBL2 
              ENDIF.
            ENDIF.
  
          GEN    (SA2 "ORECLEN")       *CHARACTER LENGTH OF OREC
          GEN    (BX7 X2) 
          GEN    (SA7 "LRECLEN")       *CHARACTER LENGTH OF "RECLAST" 
          GEN    (SA5 "WSA")
          GEN    (SA5 X5+0),B4       *SA5 WSA+OREC ADDRESS
  
          GEN    (SA2 "RECLAST")
          GEN    (SB3 0),B5          *EXT-REC-LEN 
          NEWLBL OWN5LOOP 
  
          GENLBL OWN5LOOP 
          GEN    (BX7 X5)            *SAVE FIRST RECORD TO BE PUT 
          GEN    (SA7 A2)            *AT RECLAST
          GEN    (SA2 A2+B1)
          GEN    (SA5 A5+B1)
          GEN    (SB3 B3-B1)         *DECREMENT COUNT 
          GEN    (LT B0,B3,"OWN5LOOP")  *IF MORE WORDS TO COPY
  
          GEN    (EQ "PRIDONE")      *SKIP PUTTING THIS FIRST RECORD
  
  
  
          GENLBL FIRST                 * =1 IF FIRST REC PROCESSED
          GENMAC (DATA 1) 
  
          GENLBL LAST                  * =0 IF LAST REC (X6=0)
          GENMAC (DATA 1) 
  
          GENLBL OLDDESC
          GENMAC (DATA 0) 
          SA1    HOLDLK2
          SB3    X1 
          IFTHEN B3>B0
 LBLA       GENMAC (DATA 0) 
            SB3    B3-60
            IFTHEN B3>B0
              EQ LBLA 
              ENDIF.
            ENDIF.
  
          SB4    B5 
          GENLBL RECLAST
 GENWRD   GENMAC (DATA 0)              *RESERVE SPACE EXT-REC-LEN LONG
          SB4    B4-B1
          GT     B4,GENWRD
  
          GENLBL RECTEMP
 GENWRD2  GENMAC (DATA 0) 
          SB5    B5-B1
          GT     B5,GENWRD2 
  
          GENLBL ERROR1 
          GEN    (PS) 
          NEWLBL ERROR152 
          GEN    (PS "ERROR152")
          GENMAC (DATA 0)                *ZERO TERMINATOR 
  
  
          GENLBL ERROR2 
          GEN    (PS) 
          NEWLBL ERROR154 
          GEN    (PS "ERROR154")
          GENMAC (DATA 0)                *ZERO TERMINATOR 
  
          GENLBL ERROR3 
          GEN    (PS) 
          NEWLBL ERROR155 
          GEN    (PS "ERROR155")
          GENMAC (DATA 0)              *ZERO TERMINATOR 
  
          GENLBL ERROR0 
          GEN    (PS) 
          GEN    (PS 1+"ERROR1")         *ZERO WORD PARAMETER 
          GENMAC (DATA 0)                *ZERO TERMINATOR 
  
  
          GENLBL ERROR152              *RETURN FROM FTN4 W/O SMRTN
          GENMAC (DATA 152)            * E$152
          GENLBL ERROR154 
          GENMAC (DATA 154)            *CALL SMRTN FROM FTN5
          GENLBL ERROR155 
          GENMAC (DATA 155) 
  
          GENLBL APLIST                *APLIST
          GEN    (PS) 
          NEWLBL RTNCODE
          GEN    (PS "RTNCODE")        *RETURN CODE FROM FTN
          GENMAC (DATA 0)              *RECA ADDRESS   ("RECLAST")
          GEN    (PS) 
  
          GEN    (PS "LRECLEN")        *ADDRESS OF RECA LENGTH
          GENMAC (DATA 0)              *RECB ADDRESS  (OREC)
          GEN    (PS 0) 
  
          GEN    (PS "ORECLEN")        *ADDRESS OF RECB LENGTH
          GENMAC (DATA 0)              *TERMINATOR
  
          GENLBL LRECLEN               *RECA LENGTH   ("RECLAST") 
          GENMAC (DATA 0) 
          GENLBL RTNCODE
          GENMAC (DATA 0)            *NRA RETURN CODE FROM NRA
  
  
          GENLBL NEXT 
  
          EXIT
  
 HOLDLK1  BSSZ   1
 HOLDLK2  BSSZ   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 INFORMATION 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 
