*DECK S$GNPR1 
          IDENT  S$GNPR1
          TITLE  S$GNPR1 -  GENERATE- PUT RECORD, CASE 1
          COMMENT  GENERATE- PUT RECORD, CASE 1 
          B1=1               FOR (GENMAC (PUT A0))
  
*CALL LBLPTR
  
          SPACE  4
**        S$GNPR1 -  GENERATE- PUT RECORD, CASE 1 
* 
*     CALLING SEQUENCE- 
*         S$GNPR1(SPEC$OWN3, SPEC$OWN4, OREC, EXT-REC-LEN,
*             SPEC$OUTFIT, SPEC$MRL, SPEC$FASTOUT, SPEC$OWNT);
* 
*     GIVEN-
*         SPEC$OWN3 = 0 OR ADDRESS OF OWN3 PROCEDURE
*         SPEC$OWN4 = 0 OR ADDRESS OF OWN4 PROCEDURE
*         OREC = WORD OFFSET WITHIN WSA$ OF EXTERNAL RECORD 
*         EXT-REC-LEN = NUMBER OF WORDS FOR EXTERNAL RECORDS. 
*         SPEC$OUTFIT = 0 OR ADDRESS OF OUTPUT FIT
*         SPEC$MRL = MAXIMUM RECORD LENGTH OF ALL INPUT, OUTPUT AND 
*          OWN RECORDS. 
*         SPEC$FASTOUT < 0 IF FAST I/O TO BE DONE, AND
*                          OUTPUT FILE IS RT=W, MRL=-SPEC$FASTOUT 
*                      > 0 IF FAST I/O TO BE DONE, AND
*                          OUTPUT FILE IS RT=F, FL=SPEC$FASTOUT 
*                      = 0 IF FAST I/O IS NOT TO BE DONE
* 
* 
*     DOES- 
*         GENERATES CODE. 
* 
*     GENERATED CODE DOES-
*         WRITES OUT RECORD AT WSAF$OREC OR WSAS$OREC.
*         RESETS B2 FROM "WSA". 
*         RESETS X6 FROM "SAVEX6".
  
  
          ENTRY  S$GNPR1
 S$GNPR1  SUBR
          SB1    1           B1 = CONSTANT 1  (FOR *GEN*) 
* 
* GATHER PARAMETERS 
* 
          SA0    A1 
          SA2    X1          VALUE OF SPEC$OWN3 
          SB2    X2          B2 = ADDRESS OF OWNCODE3 OR 0
          SA2    A1+B1       ADDRESS OF SPEC$OWN4 
          SA2    X2          VALUE OF SPEC$OWN4 
          SB3    X2          B3 = ADDRESS OF OWNCODE4 OR 0
          SA2    A1+2        ADDRESS OF OREC
          SA2    X2          VALUE OF OREC
          SB4    X2          B4 = OREC
          SA2    A1+3        ADDRESS OF NOWORDS-IN-EXT-REC
          SA2    X2          VALUE OF NOWORDS-IN-EXT-REC
          SB5    X2          B5 = NOWORDS-IN-EXT-REC
          SA5    A1+4        ADDRESS OF SPEC$OUTFIT 
          SA5    X5          X5 = ADDRESS OF OUTPUT FIT OR 0
          SA2    A1+5        ADDRESS OF SPEC$MRL
          SA2    X2          VALUE OF SPEC$MRL
          BX6    X2 
          SA6    MRL         MRL = SPEC$MRL 
          SA2    A1+6        ADDRESS OF SPEC$FASTOUT
          SA2    X2          VALUE OF SPEC$FASTOUT
          BX6    X2 
          SA6    FASTOUT
  
          GEN    (ZR X6,"PRUEOD")      *IF END-OF-DATA,CLOSE FILE 
  
          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 
  
  
          SB7    B2+B3       NON-ZERO IFF OWN3 AND/OR OWN4 SPECIFIED
          IFTHEN B7"0        IF OWN3 AND/OR OWN4, 
            NEWLBL NEXT 
            GEN    (EQ "NEXT")
  
  
            GENLBL APLIST                *APLIST
            GEN    (PS) 
            NEWLBL RTNCODE
            GEN    (PS "RTNCODE")        *ADDR OF RETURN CODE NRA 
            GENMAC (DATA 0)              *ADDR OF WSA$OREC
            GEN    (PS) 
            GEN    (PS "ORECLEN") 
            GENMAC (DATA 0) 
            GENLBL SRECLEN
            GENMAC (DATA 0) 
            GENLBL RTNCODE               *FTN RETURN CODE NRA 
            GENMAC (DATA 0) 
  
            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              *CALLING SMRTN FROM FTN5 
            GENMAC (DATA 154)            * (E$154)
  
            GENLBL ERROR155 
            GENMAC (DATA 155) 
  
            GENLBL NEXT 
            ENDIF.
  
          IFTHEN B2"0        IF OWN3 PROC EXISTS
            GENLBL ENTRY1 
            GEN    (SA5 "WSA")
            GEN    (SX7 X5+0),B4         *SX7 WSA+OREC
            GEN    (SA7 B1+"APLIST")     *SET WSAS$OREC AT APLIST+1 
  
          SA4    A0+7        ADDR OF SPEC$OWNT
          SA4    X4 
          IFTHEN X4"0        IF SPEC$OWNT (SM5 INTERFACE) 
              GEN    (SA1 "APLIST")      *APLIST = NRA,RECADDR,RECLEN 
              GEN    (MX7 0)
              GEN    (SA7 X1)            *ZERO OUT NRA
            ELSE- 
              GEN    (SA1 A7)            *APLIST = RECADDR,RECLEN 
              ENDIF.
  
  
            NEWLBL NEXT 
            GEN    (SX7 "NEXT")          *RETURN ADDR FROM SMRTN
            GEN    (SA7 S$RTNAD)
            GEN    (RJ 0),B2             *RJ OWNCODE3 
            GEN    (SB0 0)
  
* 
* USER GOT HERE WITH NORMAL RETURN, ONLY OK WITH FTN5 INTERFACE 
* 
          IFTHEN X4"0        IF SPEC$OWNT (SM5 INTERFACE) 
              GEN    (SA1 "APLIST")        *USE SAME APLIST FOR FTN5
              NEWLBL LABEL4 
              GEN    (EQ "LABEL4")
            ELSE- 
  
              GEN    (SA1 "ERROR1")      * (E$152)
              GEN    (RJ =XS$ERROR)      *CALL ERROR ROUTINE
              GEN    (SA1 "ERROR0")      *ZERO TO PRINT ERROR 
              GEN    (RJ =XS$ERROR) 
              GEN    (RJ =XS$ABT)           *CALL SORT5 ABORT ROUTINE 
  
            ENDIF.
  
  
  
            GENLBL NEXT                  *RETURN HERE FROM SMRTN
  
          IFTHEN X4"0        IF SPEC$OWNT (SM5 INTERFACE) 
              GEN    (SA1 "ERROR2")      * (E$154)
              GEN    (RJ =XS$ERROR)      *CALL ERROR ROUTINE
                  GEN    (SA1 "ERROR0")      *ZERO TO PRINT ERROR 
                  GEN    (RJ =XS$ERROR) 
              GEN    (RJ =XS$ABT)        *SORT5 ABORT ROUTINE 
  
              GENLBL LABEL4 
              ENDIF.
  
            GEN    (SB1 1)               *CONSTANT 1
                                         * A1 SET TO APLIST ABOVE FOR FTN5
                                         * OR SET IN FTN4 PROGRAM 
            GEN    (SA2 X1)              *X2 = NRA
            NEWLBL NEXT 
            GEN    (PL X2,"NEXT")        *IF NRA IS POSITIVE
  
            GEN    (SA1 "ERROR3")         * E$155 
            GEN    (RJ =XS$ERROR) 
            GEN    (SA1 "ERROR0")      * ZERO TO PRINT ERROR
            GEN    (RJ =XS$ERROR) 
            GEN    (RJ =XS$ABT)          *SORT5 ABORT ROUTINE 
  
            GENLBL NEXT 
            NEWLBL NEXT 
            GEN    (SX0 X2-4) 
            GEN    (MI X0,"NEXT")        *IF NRA LE 3 
  
            GEN    (SA1 "ERROR3")         * E$155 
            GEN    (RJ =XS$ERROR) 
            GEN    (SA1 "ERROR0")      * ZERO TO PRINT ERROR
            GEN    (RJ =XS$ERROR) 
            GEN    (RJ =XS$ABT)          *SORT5 ABORT ROUTINE 
  
            GENLBL NEXT 
            GEN    (SX0 X2) 
            GEN    (SB5 X0-1)            *TEST FOR DELETE 
*         INCREMENT THE ELEMENT OF S$ARRY WHICH HOLDS THE COUNT OF
*         THE NUMBER OF RECORDS DELETED BY OWN3 
            NEWLBL NEXT 
            GEN    (NE B5,"NEXT") 
            GEN    (SA2 S$ARRY+5)      *GET COUNT OF REC.S DELETED
            GEN    (SX7 B1) 
            GEN    (IX7 X2+X7)         *INCREMENT COUNT FOR OWN3
            GEN    (SA7 A2)            *UPDATE COUNT
            GEN    (EQ "PRIDONE")      *SKIP PRINTING THIS RECORD 
  
            GENLBL NEXT 
            GEN    (SB5 X0-3)            *TEST FOR TERMINATE
            GEN    (EQ B5,"PRUEOD")      *IF NRA=3(TERMINATE) 
  
            GEN    (SA2 A1+B1)           *ADDR OF OUTARR1 
            GEN    (SA2 X2)              *VALUE OF OUTARR1
            GEN    (SA3 A1+2)            *ADDR OF OUTRL1
            GEN    (SA3 X3)              *VALUE OF OUTRL1 
  
            GEN    (SB5 X0-2)            *TEST FOR INSERT 
            NEWLBL LABEL2 
            GEN    (EQ B5,"LABEL2") 
  
                                         *SUBSTITUTE RECORD 
  
* 
* SUBSTITUTE OREC WITH RECORD AT ADDR OUTARR1 ( LENGTH IN OUTRL1 )
* 
            GEN    (SA5 "WSA")
            GEN    (SX5 X5+0),B4         *SX5 WSA+OREC ADDR 
  
  
            GEN    (SB2 A2) 
            GEN    (SB3 X5) 
            NEWLBL NEXT 
            GEN    (EQ B2,B3,"NEXT")     *IF SAME ADDR TO MOVE
  
            GEN    (SB2 10)              *NO CHAR/WORD
            GEN    (SB3 X3)              *VALUE OF OUTRL1 
  
  
            GENLBL PRILOOP1 
            GEN    (BX7 X2) 
            GEN    (SA7 X5)              *COPY TO 1ST WORD OF WSAS$OREC 
            GEN    (SA2 A2+B1)           *NEXT WORD 
            GEN    (SX5 X5+B1)
            GEN    (SB3 B3-B2)           *DECREMENT CHAR COUNT
            GEN    (LT B0,B3,"PRILOOP1") *IF MORE WORDS TO MOVE 
  
* 
            GENLBL NEXT 
  
            IFTHEN X5"0        IF SPEC$OUTFIT VALID 
              SA1    FASTOUT
              IFTHEN X1=0        IF FAST I/O IS NOT TO BE DONE
                CALL   PUTRM       PUT RECORD VIA RECORD MANAGER
              ELSE-              IF FAST I/O IS TO BE DONE
                CALL   PUTFAST     PUT RECORD VIA FAST CIO CALLS
                ENDIF.
              ENDIF.
  
            GEN    (EQ "PRIDONE") 
  
            GENLBL LABEL2 
  
*         INCREMENT THE ELEMENT OF S$ARRY WHICH HOLDS THE COUNT OF
*         THE NUMBER OF RECORDS INSERTED BY OWN3
            GEN  (SA5 S$ARRY+6)        *GET COUNT OF REC.S INSERTED 
            GEN  (SX7 B1) 
            GEN  (IX7 X5+X7)           *INCREMENT COUNT FOR OWN3
            GEN  (SA7 A5)              *UPDATE STAT. ARRAY ELEMENT
  
* 
* SAVE RECORD AT WSAS$OREC AT SAVEREC AREA
* 
            GEN    (SB2 10)              *NO CHAR/WORD
            GEN    (SA4 "ORECLEN")
            GEN    (BX7 X4) 
            GEN    (SA7 "SRECLEN")
            GEN    (SB3 X4)              *RECORD LENGTH 
            GEN    (SA4 "WSA")
            GEN    (SA4 X4+0),B4         *SA4 WSAS$OREC 
            NEWLBL SAVEREC
            GEN    (SA5 "SAVEREC")
  
            GENLBL PRILOOP2 
            GEN    (BX7 X4) 
            GEN    (SA7 A5)              *COPY EACH WORD FROM OREC
            GEN    (SA4 A4+B1)           *  TO SAVEREC
            GEN    (SA5 A5+B1)
            GEN    (SB3 B3-B2)           *DECREMENT CHAR COUNT
            GEN    (LT B0,B3,"PRILOOP2")  *IF MORE WORDS,LOOP 
  
* 
* COPY RECORD FROM OWN3 TO OREC (INSERT)
* 
            GEN    (SA5 "WSA")
            GEN    (SX5 X5+0),B4         *SX5 WSAS$OREC 
  
  
            GEN    (SB2 A2) 
            GEN    (SB3 X5) 
            NEWLBL NEXT 
            GEN    (EQ B2,B3,"NEXT")     *IF SAME ADDR TO MOVE
  
            GEN    (SB2 10)              *NO CHAR/WORD
            GEN    (SB3 X3)              *VALUE OF OUTRL1 
            GEN    (BX7 X3) 
            GEN    (SA7 "ORECLEN")
  
  
            GENLBL PRILOOP3 
            GEN    (BX7 X2) 
            GEN    (SA7 X5) 
            GEN    (SA2 A2+B1)
            GEN    (SX5 X5+B1)
            GEN    (SB3 B3-B2)           *DECREMENT CHAR COUNT
            GEN    (LT B0,B3,"PRILOOP3")  *IF MORE WORDS TO MOVE
  
  
            GENLBL NEXT 
  
            IFTHEN X5"0        IF SPEC$OUTFIT VALID 
              SA1    FASTOUT
              IFTHEN X1=0        IF FAST I/O NOT TO BE DONE 
                CALL   PUTRM       PUT RECORD VIA RECORD MANAGER
              ELSE-              IF FAST I/O IS TO BE DONE
                CALL   PUTFAST     PUT RECORD VIA FAST CIO CALLS
                ENDIF.
              ENDIF.
  
  
* 
* MOVE RECORD AT SAVEREC TO OREC
* 
            GEN    (SA2 "SAVEREC")
  
            GEN    (SB2 10)              *NO CHAR/WORD
            GEN    (SA5 "SRECLEN")
            GEN    (BX7 X5) 
            GEN    (SA7 "ORECLEN")
            GEN    (SB3 X5)             *RECORD LENGTH
            GEN    (SA5 "WSA")
            GEN    (SX5 X5+0),B4         *SX5 WSA+OREC
  
            GENLBL PRILOOP4 
            GEN    (BX7 X2) 
            GEN    (SA7 X5)              *COPY TO 1ST WORD OF WSAS$OREC 
            GEN    (SA2 A2+B1)           *NEXT WORD 
            GEN    (SX5 X5+B1)
            GEN    (SB3 B3-B2)           *DECREMENT CHAR COUNT
            GEN    (LT B0,B3,"PRILOOP4")  *IF MORE WORDS TO MOVE
  
  
            GEN    (EQ "ENTRY1")
  
          ELSE- 
  
            SA1    FASTOUT
            IFTHEN X1=0        IF FAST I/O IS NOT TO BE DONE
              CALL   PUTRM       PUT RECORD VIA RECORD MANAGER
            ELSE-              IF FAST I/O IS TO BE DONE
              CALL   PUTFAST     PUT RECORD VIA FAST CIO CALLS
              ENDIF.
            GEN    (EQ "PRIDONE") 
  
            ENDIF.
  
          GENLBL PRUEOD 
  
          IFTHEN B3"0        IF OWNCODE4 IS SPECIFIED 
  
            GENLBL ENTRY2 
* 
  
          SA4    A0+7        ADDR OF SPEC$OWNT
          SA4    X4 
          IFTHEN X4"0        IF SPEC$OWNT (SM5 INTERFACE) 
              GEN    (SA1 "APLIST")      *APLIST = NRA,RECADDR,RECLEN 
              GEN    (MX7 0)
              GEN    (SA7 X1)            *ZERO OUT NRA
              GEN    (SA7 "ORECLEN")   *ZERO OUT RECLEN 
            ELSE- 
              GEN    (SA1 A7)            *APLIST = RECADDR,RECLEN 
              ENDIF.
  
            NEWLBL NEXT 
            GEN    (SX7 "NEXT")        *RETURN ADDR FROM SMRTN
            GEN    (SA7 S$RTNAD)
  
            GEN    (RJ 0),B3           *RJ OWNCODE4 
            GEN    (SB0 0)
  
* 
* USER GOT HERE WITH NORMAL RETURN, ONLY OK WITH FTN5 INTERFACE 
* 
          IFTHEN X4"0        IF SPEC$OWNT (SM5 INTERFACE) 
              GEN    (SA1 "APLIST")        *USE SAME APLIST FOR FTN5
              NEWLBL LABEL5 
              GEN    (EQ "LABEL5")
            ELSE- 
  
              GEN    (SA1 "ERROR1")      * (E$152)
              GEN    (RJ =XS$ERROR)      *CALL ERROR ROUTINE
              GEN    (SA1 "ERROR0")      *ZERO TO PRINT ERROR 
              GEN    (RJ =XS$ERROR) 
              GEN    (RJ =XS$ABT)           *CALL SORT5 ABORT ROUTINE 
  
            ENDIF.
  
  
  
            GENLBL NEXT                *RETURN HERE FROM SMRTN
  
          IFTHEN X4"0        IF SPEC$OWNT (SM5 INTERFACE) 
              GEN    (SA1 "ERROR2")      * (E$154)
              GEN    (RJ =XS$ERROR)      *CALL ERROR ROUTINE
              GEN    (SA1 "ERROR0")      *ZERO TO PRINT ERROR 
              GEN    (RJ =XS$ERROR) 
              GEN    (RJ =XS$ABT)        *SORT5 ABORT ROUTINE 
  
              GENLBL LABEL5 
              ENDIF.
  
            GEN    (SB1 1)             *CONSTANT 1
                                         * A1 SET TO APLIST ABOVE FOR FTN5
                                         * OR SET IN FTN4 PROGRAM 
            GEN    (SA2 X1)            *X2 = NRA
            NEWLBL NEXT 
            GEN    (PL X2,"NEXT")        *IF NRA IS POSITIVE
  
            GEN    (SA1 "ERROR3")         * E$155 
            GEN    (RJ =XS$ERROR) 
            GEN    (SA1 "ERROR0")      * ZERO TO PRINT ERROR
            GEN    (RJ =XS$ERROR) 
            GEN    (RJ =XS$ABT)          *SORT5 ABORT ROUTINE 
  
            GENLBL NEXT 
            NEWLBL NEXT 
            GEN    (SX0 X2-4) 
            GEN    (MI X0,"NEXT")        *IF NRA LE 3 
  
            GEN    (SA1 "ERROR3")         * E$155 
            GEN    (RJ =XS$ERROR) 
            GEN    (SA1 "ERROR0")      * ZERO TO PRINT ERROR
            GEN    (RJ =XS$ERROR) 
            GEN    (RJ =XS$ABT)          *SORT5 ABORT ROUTINE 
  
            GENLBL NEXT 
            GEN    (SX0 X2) 
            NEWLBL GRILBL2
            GEN    (ZR X2,"GRILBL2")     *IF EOF FROM OWNCODE4
  
  
*         INCREMENT THE ELEMENT OF S$ARRY WHICH HOLDS THE COUNT OF
*         THE NUMBER OF RECORDS INSERTED BY OWN4
            GEN  (SA2 S$ARRY+7)        *GET COUNT OF RECS INSERTED
            GEN  (SX7 B1) 
            GEN  (IX7 X2+X7)           *INCREMENT COUNT FOR OWN4
            GEN  (SA7 A2)              *UPDATE STAT. ARRAY
  
            GEN    (SA2 A1+B1)         *ADDRESS OF OUTARR1
            GEN    (SA2 X2)            *VALUE OF OUTARR1
            GEN    (SA3 A1+2)          *ADDRESS OF OUTRL1 
            GEN    (SA3 X3)            *VALUE OF OUTRL1 
* 
* MOVE RECORD AT ADDR OUTARR1 WITH LENGTH IN OUTRL1 TO OREC 
* 
            GEN    (SA5 "WSA")
            GEN    (SX5 X5+0),B4       *SX5 WSA+OREC ADDR 
  
  
            GEN    (SB2 A2) 
            GEN    (SB3 X5) 
            NEWLBL NEXT 
            GEN    (EQ B2,B3,"NEXT")     *IF SAME ADDR TO MOVE
  
            GEN    (SB2 10)              *NO CHAR/WORD
            GEN    (SB3 X3)              *VALUE OF OUTRL1 
            GEN    (BX7 X3) 
            GEN    (SA7 "ORECLEN")
  
  
            GENLBL PRILOOP5 
            GEN    (BX7 X2) 
            GEN    (SA7 X5)            *COPY TO 1ST WORD OF WSAS$OREC 
            GEN    (SA2 A2+B1)           *NEXT WORD 
            GEN    (SX5 X5+B1)
            GEN    (SB3 B3-B2)         *DECREMENT CHAR COUNT
            GEN    (LT B0,B3,"PRILOOP5") *IF MORE WORDS TO MOVE 
  
            GENLBL NEXT 
  
            IFTHEN X5"0        IF SPEC$OUTFIT VALID 
              SA1    FASTOUT
              IFTHEN X1=0        IF FAST I/O NOT TO BE DONE 
                CALL   PUTRM       PUT RECORD VIA RECORD MANAGAR
              ELSE-              IF FAST I/O IS TO BE DONE
                CALL   PUTFAST     PUT RECORD VIA FAST CIO CALLS
                ENDIF.
              ENDIF.
            GEN    (EQ "ENTRY2")
  
            GENLBL GRILBL2
  
            ENDIF.
  
          NEWLBL ENDSORT
  
          IFTHEN X5"0        IF SPEC$OUTFIT VALID 
                                       *CHECK IF FILE IS *OUTPUT* 
                                       *  CLOSE W/O REWIND
                                       *ELSE
                                       *  CLOSE W/ REWIND 
            GEN    (SA0 0),X5            *A0 = OUTFIT ADDR
            GENMAC (FETCH A0,LFN,X0)
            NEWLBL LABEL3 
            GEN    (SA5 "LABEL3")        *OUTPUT    * 
            GEN    (IX0 X0-X5)
            NEWLBL LABEL1 
            GEN    (NZ X0,"LABEL1")      *IF FILE IS NOT *OUTPUT* 
  
  
                                       *FILE IS *OUTPUT*
            SA1    FASTOUT
            IFTHEN X1"0        IF FAST OUTPUT DONE, 
              IFTHEN X1\0        IF RT=F, 
                GEN    (SA1 "FASTPOS")
                NEWLBL NEXT 
                GEN    (ZR X1,"NEXT") 
                GEN    (SA1 A0+2)      *IN
                GEN    (SX6 X1+B1)
                GEN    (SA6 A1) 
                GENLBL NEXT 
                ENDIF.
              GENMAC (WRITER A0,RECALL) 
              GENMAC (FETCH A0,FWB,X1)  @*X1 = ADDRESS OF BUFFER
              GEN    (CALL CMM.FRF)    *FREE THE BLOCK
                     *SAVES AX0,X5,B2-3 
            ELSE-              IF RECORD MANAGER USED,
              GENMAC (FETCH A0,CF,X6)  *FETCH CLOSE-FLAG
              NEWLBL CF 
              GEN    (SA6 "CF") 
              GEN    (SX1 X6-1) #R# 
              NEWLBL NEXT 
              GEN    (NZ X1,"NEXT")    *SKIP IF CF"REWIND 
              GEN    (SB6 "NEXT") 
#HAVEB6       SET    1           TELL GENMAC TO NOT GENERATE SB6 *+2
              GENMAC (REWINDM A0) 
              GENLBL NEXT 
            GEN    (SA1 "CF") 
            GEN    (SX1 X1-2) 
            NEWLBL NEXT 
            GEN    (NZ X1,"NEXT")      *IF CF"NONE, SKIP
            GEN    (SB6 "NEXT") 
#HAVEB6     SET    1           TELL GENMAC TO NOT GENERATE SB6 *+2
            GENMAC (ENDFILE A0) 
            GENLBL NEXT 
              NEWLBL NEXT 
              GEN    (SB6 "NEXT") 
 #HAVEB6      SET    1           TELL GENMAC TO NOT GENERATE SB6 *+2
              GENMAC (CLOSEM A0,DET)   *CLOSE AND DETACH
              GENLBL NEXT 
              GEN    (SA1 "CF") 
              GEN    (SX1 X1-3) #U# 
              NEWLBL NEXT 
              GEN    (NZ X1,"NEXT")    *IF ORIGINAL CF WAS *UNLOAD*,
              GENMAC (UNLOAD A0,RECALL)  *THEN UNLOAD THE FILE. 
              GENLBL NEXT 
              ENDIF.
            GEN    (EQ "ENDSORT")        *GOTO S$GNFM4 OR S$GNSH3 
  
            GENLBL LABEL1 
            SA1    FASTOUT
            IFTHEN X1"0        IF FAST OUTPUT DONE, 
              IFTHEN X1\0        IF RT=F
                GEN    (SA1 "FASTPOS")
                NEWLBL NEXT 
                GEN    (ZR X1,"NEXT") 
                GEN    (SA1 A0+2)      *IN
                GEN    (SX6 X1+B1)
                GEN    (SA6 A1) 
                GENLBL NEXT 
                ENDIF.
              IFTHEN X1<0    IF BT=I, RT=W
                CALL   GENTERM         *WRITE BLOCK TERMINATOR
                ENDIF.
              GENMAC (WRITER A0,RECALL) 
              GENMAC (REWIND A0,RECALL) 
              GENMAC (FETCH A0,FWB,X1)  @*X1 = ADDRESS OF BUFFER
              GEN    (CALL CMM.FRF)    *FREE THE BLOCK
                     *SAVES AX0,X5,B2-3 
            ELSE-              IF RECORD MANAGER USED,
              GENMAC (FETCH A0,CF,X6)  *FETCH CLOSE-FLAG
              GEN    (SA6 "CF") 
              GEN    (SX1 X6-1) #R# 
              NEWLBL NEXT 
              GEN    (NZ X1,"NEXT")    *SKIP IF CF"REWIND 
              GEN    (SB6 "NEXT") 
#HAVEB6       SET    1           TELL GENMAC TO NOT GENERATE SB6 *+2
              GENMAC (REWINDM A0) 
              GENLBL NEXT 
              GEN    (SA1 "CF") 
              GEN    (SX1 X1-2) 
              NEWLBL NEXT 
              GEN    (NZ X1,"NEXT")    *IF CF"NONE, SKIP
              GEN    (SB6 "NEXT") 
#HAVEB6       SET    1       TELL GENMAC TO NOT GENERATE SB6 *+2
              GENMAC (ENDFILE A0) 
              GENLBL NEXT 
              NEWLBL NEXT 
              GEN    (SB6 "NEXT") 
 #HAVEB6      SET    1
              GENMAC (CLOSEM A0,DET)      *CLOSE W/ DETACH
              GENLBL NEXT 
              GEN    (SA1 "CF") 
              GEN    (SX1 X1-3) #U# 
              NEWLBL NEXT 
              GEN    (NZ X1,"NEXT")    *IF ORIGINAL CF WAS NOT UNLOAD,
              GENMAC (CLOSE A0,UNLOAD,R)   *UNLOAD THE FILE 
              GENLBL NEXT 
              ENDIF.
            ENDIF.
  
          GEN    (EQ "ENDSORT") 
  
          SA1    FASTOUT
          IFTHEN X5"0        IF SPEC$OUTFIT VALID 
           ANDIF X1=0        AND IF RECORD MANAGER USED,
            GENLBL CF 
            GENMAC (DATA -0)
            ENDIF.
  
          GENLBL ORECLEN
          SA1    MRL         SPEC$MRL 
          GENWD  X1                    *FULL WORD WITH SPEC$MRL 
  
          GENLBL LABEL3 
          GENMAC (DATA 6LOUTPUT)
  
  
*     GENERATE-  "SAVEREC": SPACE TO SAVE A RECORD FROM OWN3
*                           IN CASE OF INSERT (SPEC$MRL*-1)/10 +1 WORDS LONG
* 
  
          IFTHEN B2"0       IF OWNCODE3 IS SPECIFIED
            GENLBL SAVEREC
  
 GENWORD    GENMAC (DATA 0) 
            SB5    B5-B1        DECREMENT NOWORDS IN-EXT-REC
            GT B5,GENWORD       IF NOT ENOUGH SPACE 
  
            ENDIF.
  
* 
*     GENERATE-   "PRIDONE":  
  
          GENLBL PRIDONE
  
          GEN    (SA1 "WSA")
          GEN    (SB2 X1) 
  
          EXIT
 S$ARRY   EXTERNAL
 S$CALLR  EXTERNAL
          TITLE  GENFTBL -  GENERATE- FAST I/O TABLES 
**        GENFTBL -  GENERATE- FAST I/O TABLES
* 
  
  
 GENFTBL  SUBR
          NEWLBL NEXT 
          GEN    (EQ "NEXT")
          NEWLBL FASTPOS
          GENLBL FASTPOS
          GENMAC (DATA 0) 
          NEWLBL FASTM
          GENLBL FASTM
          SA4    FASTOUT     FL FOR OUTPUT RECORDS
          SX0    6
          IX4    X0*X4       LENGTH := 6*FL 
          MX5    0           OFFSET := 0
 GENFTBL1 IFTHEN X5=0        IF MASK TO BE ALL 0
            GENMAC (DATA 0) 
          ELSE-              IF NEED TO COMPUTE MASK
            SB7    X5-1 
            MX0    1
            AX0    X0,B7
            GENWD  X0 
            ENDIF.
          IX5    X5+X4       OFFSET := OFFSET + LENGTH
          SX0    1S21/60+1   1/60 * 2**21 
          IX1    X0*X5       OFFSET/60 * 2**21
          AX1    21          OFFSET/60
          SX0    60 
          IX1    X0*X1       (OFFSET/60)*60 
          IX5    X5-X1       OFFSET := OFFSET MOD 60
          NZ     X5,GENFTBL1 IF MORE TO DO, LOOP
  
*     GENERATE "FASTS" TABLE: 
*         2/1, 10/<SHIFT>, 30/<IN OFFSET>, 18/<NEXT INDEX>
  
                             X4 = 6*FL
          NEWLBL FASTS
          GENLBL FASTS
          MX5    0           OFFSET := 0
          SA0    B0          <NEXT INDEX> := 0
 GENFTBL2 SA0    A0+B1       <NEXT INDEX> := <NEXT INDEX> + 1 
          SX6    A0          42/0, 18/<NEXT INDEX>
          SB7    X5          <SHIFT>
          SB6    60          PREPARE <SHIFT> FOR LEFT-SHIFT 
          SB7    B6-B7
          PX6    B7,X6       2/1, 10/<SHIFT>, 30/0, 18/<NEXT INDEX> 
          BX7    X5          OLD-OFFSET := OFFSET 
          IX5    X5+X4       OFFSET := OFFSET + LENGTH
          SX0    1S22/60+1   1/60 * 2**22 
          IX1    X5*X0       OFFSET/60 * 2**22
          AX1    22          OFFSET/60
          SX0    60 
          IX1    X1*X0       (OFFSET/60)*60 
          IX5    X5-X1       OFFSET := OFFSET MOD 60
          IX0    X7-X5       OLD-OFFSET VS. OFFSET
          IFTHEN X0\0        IF OLD-OFFSET .GE. OFFSET, 
            SX1    B1 
            LX1    18 
            BX6    X6+X1               *ADD 1 TO IN 
            ENDIF.
          IFTHEN X5=0        IF NEXT CHAR IS NEXT WORD
            MX0    -18
            BX6    X0*X6       <NEXT INDEX> := 0
            ENDIF.
          GENWD  X6 
         *USES   AX1-2,AX6,B6-7 
          NZ     X5,GENFTBL2 IF MORE ENTRIES TO CREATE, LOOP
  
          GENLBL NEXT 
          EXIT
          TITLE  PUTFAST -  GENERATE- PUT RECORD VIA FAST I/O 
**        PUTFAST -  GENERATE- PUT RECORD VIA FAST I/O
* 
*     CALLING SEQUENCE- 
*         CALL   PUTFAST
* 
*     GIVEN-
*         FASTOUT = SPEC$FASTOUT, DESCRIBED IN HEADER OF S$GNPR1
*         B4 = WORD OFFSET IN WSA$ TO EXTERNAL RECORD AREA
* 
*     DOES- 
*         GENERATES CODE. 
* 
*     GENERATED CODE EXPECTS- 
*         A0 = ADDRESS OF FIT.
*         WSA$+OREC = STARTING ADDRESS OF EXTERNAL RECORD.
* 
*     GENERATED CODE DOES-
*         WRITES EXTERNAL RECORD TO FILE VIA FAST CIO CALLS.
* 
*         PUTFAST PRESERVES X5. 
  
  
 PUTFAST  SUBR
*         INCREMENT THE ELEMENT OF S$ARRY WHICH HOLDS THE COUNT OF
*         THE NUMBER OF RECORDS WRITTEN TO OUTPUT 
            GEN  (SA3 S$ARRY+11)       * GET COUNT OF RECS OUTPUTED 
            GEN  (SX7 B1) 
            GEN  (IX7 X3+X7)           * INCREMENT COUNT OF OUTPUT
            GEN  (SA7 A3)              * UPDATE COUNT 
  
          GEN    (SA0 0),X5            *A0 = OUTPUT FILE FIT
          BX6    X5 
          SA6    SAVEX5 
          SA5    FASTOUT
          IFTHEN X5\0        IF BT=C, RT=F, FL=<FASTOUT>
            CALL   GENFTBL             *SET "FASTM", "FASTPOS", "FASTS" 
            GEN    (SA3 A0+2)          *IN
            GEN    (SA5 A0+4)          *LIMIT 
            GEN    (SX5 X5-1)          *LIMIT - 1 
            GEN    (IX0 X3-X5)         *IN VS. LIMIT - 1
            NEWLBL NEXT 
            GEN    (NZ X0,"NEXT")      *IF ENOUGH ROOM IN BUFFER
            GEN    (SA1 "FASTPOS")
            GEN    (NZ X1,"NEXT")      *(IN CASE FL < 10) 
            GENMAC (WRITE A0,RECALL)
            GEN    (SA3 A0+B1)         *FIRST 
            GEN    (SX6 X3) 
            GEN    (SA6 A3+B1)         *IN
            GEN    (SA6 A6+B1)         *OUT 
            GENLBL NEXT 
            GEN    (SA2 "FASTPOS")     *INDEX TO STUFF FOR THIS POS 
            GEN    (SA1 X2+"FASTS")    *2/1,10/SHIFT,30/INOFF,18/NEXT 
            GEN    (SX6 X1)            *SET INDEX FOR NEXT RECORD 
            GEN    (SA6 A2) 
            GEN    (SA2 X2+"FASTM")    *MASK
            GEN    (UX7 B7,X1)         *SHIFT 
            GEN    (AX1 18)            *INOFF 
            GEN    (SB6 X1)            *B6 = INOFF
            GEN    (SA5 "WSA")
            GEN    (SA5 X5+0),B4       *SA5 WSA$OREC
            GEN    (LX5 X5,B7)         *ALIGN FIRST WORD TO FIT IN BUFFER 
            GEN    (SA1 X3)            *PARTLY-FILLED WORD FROM BUFFER
            GEN    (BX6 -X2*X5)        *KEEP FIRST (RIGHT) PART OF WORD 
            GEN    (BX3 X2*X1)         *KEEP LAST (LEFT) PART FROM BUFFR
            GEN    (BX6 X6+X3)         *COMBINE PARTS 
            GEN    (SA6 A1)            *PUT BACK IN BUFFER
            SA5    FASTOUT     FASTOUT
 PUTFAST1   SX5    X5-10       DECREMENT NUMBER OF CHARACTERS TO MOVE 
            ZR     X5,PUTFAST2 IF DONE, SKIP
            NG     X5,PUTFAST2         IF DONE, SKIP
            GEN    (BX6 X2*X5)         *KEEP LAST (LEFT) PART OF WORD 
            GEN    (SA5 A5+B1)         *GET NEW WORD FROM OREC
            GEN    (LX5 X5,B7)         *ALIGN WORD TO FIT IN BUFFER 
            GEN    (BX3 -X2*X5)        *KEEP FIRST (RIGHT) PART OF NEW WORD 
            GEN    (BX6 X6+X3)         *COMBINE PARTS 
            GEN    (SA6 A6+B1)         *STORE IN BUFFER 
            EQ     PUTFAST1    GO FOR NEXT WORD 
 PUTFAST2   GEN    (BX6 X2*X5)         *KEEP LAST (LEFT) PART OF NEW WORD 
            GEN    (SA6 A6+B1)         *STORE IN BUFFER 
            GEN    (SB6 B6-B1)
            GEN    (SX6 A6+B6)
            GEN    (SA6 A0+2)          *SET NEW *IN*
          ELSE-              IF BT=I, RT=W, MRL=-<FASTOUT>
*           IF BUFFER IS EMPTY, 
*               SET UP BLOCK CONTROL WORD 
*               IN := FIRST + 1 
*               <PREV> AT IN := 1 
            GEN    (SA4 "ORECLEN")     *X4 = RECLEN(CHARS)
            GEN    (SA1 A0+2)          *IN
            GEN    (SA2 A1+B1)         *OUT 
            GEN    (IX6 X1-X2)         *IN VS. OUT
            NEWLBL NEXT 
            GEN    (NZ X6,"NEXT")      *IF NOT EMPTY, SKIP
            NEWLBL FASTBLOK 
            GEN    (SA3 "FASTBLOK")    *PREVIOUS BLOCK NUMBER 
            GEN    (SX7 B1) 
            GEN    (IX6 X3+X7)         *INCREMENT BLOCK NUMBER
            GEN    (SA6 A3) 
            GEN    (MX5 -12)           *MODULUS 4096
            GEN    (BX6 -X5*X6) 
            GEN    (LX6 42)            *6/0, 12/BLOCK ORD, 24/0, 18/0 
            NEWLBL FASTREC
            GEN    (SA3 "FASTREC")     *RECORD NUMBER 
            GEN    (MX5 -24)           *MODULUS 2**24 
            GEN    (BX3 -X5*X3) 
            GEN    (LX3 18)            *18/0, 24/REC NUM, 18/0
            GEN    (BX6 X6+X3)         *6/0, 12/BLOCK ORD, 24/REC NUM, 18/0 
            GEN    (BX6 X6+X7)         *6/0, 12/BLOCK ORD, 24/REC NUM, 18/OFFSET
            GEN    (SA2 A0+B1)         *FIRST 
            GEN    (SA6 X2)            *(FIRST) := BLOCK CONTROL WORD 
                                       *(STILL NEEDS PARITY AND 
                                       * (IF NO RECORD) DELETE REC STUFF
            GEN    (SX6 X2+B1)         *IN := FIRST + 1 
            GEN    (SA6 A1) 
            GEN    (BX1 X6)            *UPDATE REGISTER, TOO
            GEN    (MX6 0)             *<PREV> AT IN := 0 
            GEN    (SA6 X1) 
            GENLBL NEXT 
*           N := SPACELEFT - 1
*           WCR := 1
*           IF RECLEN(WORDS) .LE. SPACELEFT - 1,
*               N := RECLEN(WORDS)
*               WCR := 0
                                       *X4 = RECLEN(CHARS)
            GEN    (SX2 1S20/10+1)     *1/10 * 2**20
            GEN    (SX6 X4+9)          *NCHARS + 9
            GEN    (IX5 X6*X2)         *(NCHARS + 9)/10 * 2**20 
            GEN    (AX5 20)            *(NCHARS + 9)/10 
                                       *X5 = RECLEN(WORDS)
            GEN    (SA3 A0+4)          *LIMIT 
            GEN    (IX3 X3-X1)         *LIMIT - IN
            GEN    (SX3 X3-2)          *N := SPACELEFT - 1
            GEN    (SX7 10) 
            GEN    (IX2 X7*X5)         10*RECLEN(WORDS) 
            GEN    (IX2 X2-X4)         10*RECLEN(WORDS) - RECLEN(CHARS) 
                                       * OR <UNUSED CHARS>
            GEN    (LX7 X2,B1)         *2*<UNUSED CHARS>
            GEN    (LX2 2)             *4*<UNUSED CHARS>
            GEN    (IX2 X2+X7)         *6*<UNUSED CHARS>
            GEN    (SB5 X2)            *B5 = <UNUSED BITS>
            GEN    (MX7 0)             *<UNUSED BITS> := 0
            GEN    (SX0 B1)            *WCR := 1
            GEN    (IX6 X3-X5)         *SPACELEFT - 1 VS. RECLEN(WORDS) 
            NEWLBL NEXT 
            GEN    (NG X6,"NEXT")      *IF SPACELEFT < RECLEN(WORDS), JUMP
            GEN    (BX3 X5)            *N := RECLEN(WORDS)
            GEN    (SX7 B5)            *NOTE <UNUSED BITS>
            GEN    (MX0 0)             *WCR := 0
            GENLBL NEXT                *HERE WITH X0 = WCR, X1=IN,
                                       * X3=N, X5=RECLEN(WORDS) 
                                       * X4=RECLEN(CHARS) 
*           SET RECORD CONTROL WORD AT (IN) 
            GEN    (SA2 X1)            *18/0, 18/PREV SIZE, 24/0
            GEN    (LX0 18+24)         *16/0, 2/WCR, 42/0 
            GEN    (BX6 X2+X0)         *16/0, 2/WCR, 18/PREV, 24/0
            GEN    (BX6 X6+X5)         *16/0, 2/WCR, 18/PREV, 6/0, 18/WORDS 
            GEN    (LX7 18)            *36/0, 6/UNUSED, 18/0
            GEN    (BX6 X6+X7)         *16/0, 2/WCR, 18/PREV, 6/UNUSED, 18/WORDS
            GEN    (CX4 X6)            *COUNT BITS IN X6
            GEN    (LX4 -1)            *SIGN BIT = 0 => EVEN PARITY 
            GEN    (MX2 1)             *MASK FOR SIGN BIT 
            GEN    (BX4 -X4*X2)        *EVEN PARITY => 1, ELSE 0
            GEN    (BX6 X4+X6)         *ENSURE ODD PARITY 
            GEN    (SA6 A2)            *STORE RECORD CONTROL WORD 
*           COPY  N  WORDS
            SB7    B4-B1
            GEN    (SB3 B2+0),B7       *B3 = OREC-1 
            GEN    (SB7 B1)            *INITIALIZE INDEX
            GEN    (SB6 X5)            *LAST INDEX := WORDS IN RECORD 
            NEWLBL NEXT 
            GENLBL NEXT 
            GEN    (SA4 B3+B7)         *GET WORD FROM OREC
            GEN    (BX6 X4) 
            GEN    (SA6 X1+B7)         *COPY TO BUFFER
            GEN    (SB7 B7+B1)         *INCREMENT INDEX 
            GEN    (LE B7,B6,"NEXT")   *IF NOT DONE, LOOP 
*           IN := IN + N + 1
            GEN    (SX6 A6+B1)         *IN + N + 1
            GEN    (SA6 A1)            *IN := IN + N + 1
*           IF BUFFER NOT FULL, 
*               <PREV> AT IN := N + 1 
            GEN    (SA2 A0+4)          *LIMIT 
            GEN    (SA1 A0+2)          *IN
            GEN    (SX6 X1+B1)         *IN + 1
            GEN    (IX6 X2-X6)         *LIMIT VS. IN + 1
            NEWLBL FAST1
            GEN    (ZR X6,"FAST1")     *IF BUFFER IS FULL, SKIP 
            GEN    (SX6 X3+B1)         *(IN) := N + 1   (PREVIOUS SIZE) 
            GEN    (LX6 24)            *18/0, 18/PREV, 24/0 
            GEN    (SA6 X1) 
            NEWLBL FAST2
            GEN    (EQ "FAST2")        *SKIP =ELSE= 
*           ELSE
*               SET PARITY IN BLOCK CONTROL WORD
*               WRITE BUFFER
*               SET BLOCK CONTROL WORD
*               IN := FIRST + 1 
*               <PREV> AT IN := N + 1 
*               IF WCR = 1, 
*                   ADVANCE POINTER TO OREC 
*                   N := RECLEN(WORDS) - N
*                   SET CONTROL WORD WITH WCR=3 
*                   COPY  N  WORDS
            GENLBL FAST1
            GEN    (SA2 A0+B1)         *FIRST 
            GEN    (SA4 X2)            *BLOCK CONTROL WORD
            GEN    (CX6 X4)            *COUNT BITS IN CONTROL WORD
            GEN    (LX6 -1)            *SIGN BIT = 0 => EVEN PARITY 
            GEN    (MX7 1)             *MASK FOR SIGN BIT 
            GEN    (BX6 -X6*X7)        *EVEN PARITY => 1, ELSE 0
            GEN    (BX6 X6+X4)         *ENSURE ODD PARITY 
            GEN    (SA6 A4)            *STORE BLOCK CONTROL WORD
            CALL   GENTERM             *GENERATE BLOCK TERMINATOR 
            GENMAC (WRITE A0,RECALL)   *WRITE BUFFER
                                       **USES AX1,X2,X4,AX6,X7
            GEN    (SA4 A0+B1)         *FIRST 
            GEN    (SX6 X4) 
            GEN    (SA6 A0+3)          *OUT := FIRST
            GEN    (SX6 X6+B1)
            GEN    (SA6 A6-B1)         *IN := FIRST + 1 
            GEN    (SA4 "FASTBLOK")    *PREVIOUS BLOCK NUMBER 
            GEN    (SX7 B1) 
            GEN    (IX6 X4+X7)         *INCREMENT BLOCK NUMBER
            GEN    (SA6 A4) 
            GEN    (MX2 -12)           *MODULUS 4096
            GEN    (BX6 -X2*X6) 
            GEN    (LX6 42)            *6/0, 12/BLOCK ORD, 24/0,18/0
            GEN    (SA4 "FASTREC")     *RECORD NUMBER 
            GEN    (MX2 -24)           *MODULUS 2**24 
            GEN    (BX4 -X2*X4) 
            GEN    (LX4 18)            *18/0, 24/REC NUM, 18/0
            GEN    (BX6 X6+X4)         *6/0, 12/BLOCK ORD, 24/REC NUM, 18/0 
            GEN    (SX7 X3+2)          *OFFSET := N + 2 
            GEN    (BX6 X6+X7)         *6/0, 12/BLOCK ORD, 24/REC NUM, 18/OFFSET
            GEN    (SA2 A0+B1)         *FIRST 
            GEN    (CX4 X6)            *COUNT BITS IN CONTROL WORD
            GEN    (LX4 -1)            *SIGN BIT = 0 => EVEN PARITY 
            GEN    (MX7 1)             *MASK FOR SIGN BIT 
            GEN    (BX7 -X4*X7         *EVEN PARITY => 1, ELSE 0
            GEN    (BX6 X7+X6)         *ENSURE ODD PARITY 
            GEN    (SA6 X2)            *(FIRST) := BLOCK CONTROL WORD 
                                       * (NEEDS RECORD STUFF DELETED IF NO MORE)
            GEN    (SX7 X3+B1)         *N + 1 
            GEN    (LX7 6+18)          *PREVIOUS SIZE := N + 1
            GEN    (SA1 A0+2)          *IN
            GEN    (SA7 X2)            *PREVIOUS AT (IN) := N + 1 
            NEWLBL FAST3
            GEN    (ZR X0,"FAST3")     *IF WCR = 0, SKIP
            GEN    (SB3 B3+X3)         *OREC BASE := OREC BASE + N
            GEN    (IX3 X5-X3)         *N := RECLEN(WORDS) - N
            GEN    (SA4 X1)            *18/0, 18/PREV SIZE, 24/0
            GEN    (SX7 3)             *USE WCR = 3   (LAST PIECE)
            GEN    (LX7 18+24)         *16/0, 2/WCR, 18/0, 24/0 
            GEN    (BX6 X7+X4)         *16/0, 2/WCR, 18/PREV, 24/0
            GEN    (SX2 1S20/10+1)     *1/10 * 2**20
            GEN    (SX4 X3+9)          *(N + 9) 
            GEN    (IX4 X2*X4)         *(N + 9)/10 * 2**20
            GEN    (AX4 20)            *(N + 9)/10
            GEN    (BX6 X6+X4)         *16/0, 2/WCR, 18/PREV, 6/0, 18/WORDS 
            GEN    (SX4 B5)            *<UNUSED BITS> 
            GEN    (LX4 18)            36/0, 6/UNUSED, 18/0 
            GEN    (BX6 X6+X4)         *16/0, 2/WCR, 18/PREV, 6/UNUSED, 18/WORDS
            GEN    (CX4 X6)            *COUNT BITS IN X6
            GEN    (LX4 -1)            *SIGN BIT = 0 => EVEN PARITY 
            GEN    (MX2 1)             *MASK FOR SIGN BIT 
            GEN    (BX4 -X4*X2)        *EVEN PARITY => 1, ELSE 0
            GEN    (BX6 X4+X6)         *ENSURE ODD PARITY 
            GEN    (SA6 X2)            *STORE RECORD CONTROL WORD 
*           COPY  N  WORDS
            GEN    (SB7 B1)            *INITIALIZE INDEX
            GEN    (SB6 X3)            *LAST := N 
            NEWLBL NEXT 
            GENLBL NEXT 
            GEN    (SA4 B3+B7)         *GET WORD FROM OREC
            GEN    (BX6 X4) 
            GEN    (SA6 X1+B7)         *COPY TO BUFFER
            GEN    (SB7 B7+B1)         *INCREMENT INDEX 
            GEN    (LE B7,B6,"NEXT")   *IF NOT DONE, LOOP 
            GEN    (SX6 X1+B1)         *IN + 1
            GEN    (IX6 X6+X3)         *IN + 1 + N
            GEN    (SA6 A1)            *IN := IN + 1 + N
            GEN    (SA4 "FASTREC")     *INCREMENT RECORD NUMBER 
            GEN    (SX6 B1) 
            GEN    (IX6 X4+X6)
            GEN    (SA6 A4) 
            GEN    (EQ "FAST2") 
            GENLBL FASTBLOK 
            GENMAC (DATA 0) 
            GENLBL FASTREC
            GENMAC (DATA 1) 
            GENLBL FAST2
            ENDIF.
          SA5    SAVEX5 
          EXIT
  
  
 SAVEX5   BSS    1           TO PRESERVE ORIGINAL X5
          TITLE  GENTERM -  GENERATE- WRITE I-BLOCK TERMINATOR
 GENTERM  SUBR
          GEN    (SA1 A0+2)            *IN
          GEN    (SA2 X1)              *18/0, 18/PREV, 24/0 
          GEN    (SX6 11B)
          GEN    (LX6 -3)              *1/0, 2/*DELETE*, 15/0, 18/0, 24/1 
          GEN    (BX6 X6+X2)           *1/0, 2/*DELETE*, 15/0, 18/PREV, 24/1
          GEN    (CX4 X6)              *COUNT BITS IN X6
          GEN    (LX4 -1)              *SIGN BIT = 0 => EVEN PARITY 
          GEN    (MX2 1)               *MASK FOR SIGN BIT 
          GEN    (BX4 -X4*X2)          *EVEN PARITY => 1, ELSE 0
          GEN    (BX6 X4+X6)           *ENSURE ODD PARITY 
          GEN    (SA6 A2)              *STORE RECORD CONTROL WORD 
          GEN    (SA2 A0+3)            *OUT 
          GEN    (IX6 X1-X2)           *IN - OUT
          GEN    (SX6 X6+2)            *LENGTH OF BLOCK 
          GEN    (SA6 A6+B1)           *STORE LENGTH IN BUFFER
          GEN    (SX6 5)
          GEN    (LX6 -3)              *1/0, 2/*DELETE*, 57/0 
          GEN    (SX2 B1+B1)           *LENGTH OF PREVIOUS RECORD 
          GEN    (LX2 24)              *18/0, 18/PREV, 24/0 
          GEN    (BX6 X6+X2)           *1/0, 2/*DELETE*, 15/0, 18/PREV, 24/0
          GEN    (SA6 A6+B1)           *STORE RECORD CONTROL WORD 
          GEN    (SX6 A6+B1)           *IN := IN + 3
          GEN    (SA6 A1) 
          EXIT
          TITLE  PUTRM -    GENERATE- PUT RECORD VIA RECORD MANAGER 
**        PUTRM -  GENERATE- PUT RECORD VIA RECORD MANAGER
* 
  
  
 PUTRM    SUBR
*         INCREMENT THE ELEMENT OF S$ARRY WHICH HOLDS THE COUNT OF
*         THE NUMBER OF RECORDS WRITTEN TO OUTPUT 
            GEN  (SA3 S$ARRY+11)       * GET COUNT OF RECS OUTPUTED 
            GEN  (SX7 B1) 
            GEN  (IX7 X3+X7)           * INCREMENT COUNT OF OUTPUT
            GEN  (SA7 A3)              * UPDATE COUNT 
  
          GEN    (SA1 "ORECLEN")
          GEN    (SA0 0),X5            *OUTPUT FILE FIT 
          GENMAC (STORE A0,RL=X1,,7,0)
          NEWLBL NEXT 
          GEN    (SB6 "NEXT") 
 #HAVEB6  SET    1           TELL *GENMAC* TO NOT GENERATE SB6 *+2
          GENMAC (PUT A0)              *WITH WSA=WSA$+OREC
          GENLBL NEXT 
          EXIT
  
  
 FASTOUT  BSS    1           > 0 FOR BT=C, RT=F, FL=FASTOUT AND FAST I/O
  
 MRL      BSS    1           SPEC$MRL 
  
 S$RTNAD  EXTERNAL
  
  
          END 
