*DECK S$GNPR3 
          IDENT  S$GNPR3
          TITLE  S$GNPR3 -  GENERATE- PUT RECORD, CASE 3
          COMMENT  GENERATE- PUT RECORD, CASE 3 
          B1=1               FOR (GENMAC (PUT A0))
  
*CALL LBLPTR
  
          SPACE  4
**        S$GNPR3 -  GENERATE- PUT RECORD, CASE 3 
* 
*     CALLING SEQUENCE- 
*         S$GNPR3(SPEC$OWN3, SPEC$OWN4, OREC, EXT-REC-LEN,
*             SPEC$OUTFIT,SPEC$MRL,SPEC$FASTOUT,SPEC$OWN5,SPEC$OWNT); 
* 
*     GIVEN-
*         EXT-REC-LEN = NUMBER OF WORDS FOR EXTERNAL RECORD 
*         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
*                 <NWORDS>, SPEC$OUTFIT, SPEC$MRL, <FASTIO>); 
* 
*     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. 
*         SPEC$OWNT = TRUE IF SM5 INTERFACE, FALSE IF SM4 INTERFACE.
*         OREC = WORD OFFSET WITHIN WSA$ OF EXTERNAL RECORD 
*         <NWORDS> = NUMBER OF WORDS (ROUNDED UP) IN EXTERNAL RECORD
*         SPEC$OUTFIT = 0 OR ADDRESS OF OUTPUT FIT
*         SPEC$MRL = MAXIMUM RECORD LENGTH OF ALL INPUT, OUTPUT AND 
*          OWN RECORDS. 
*         <FASTIO> > 0 IF FAST I/O IS TO BE DONE AND
*          ALL INPUT FILES ARE BT=C, RT=F, FL=<FASTIO>
*         <FASTIO> < 0 IF FAST I/O IS TO BE DONE AND
*          ALL INPUT FILES ARE BT=I, RT=W, MRL=-<FASTIO>
*         <FASTIO> = 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$GNPR3
 S$GNPR3  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
  
          NEWLBL DIFFKEY
          GEN    (NZ X7,"DIFFKEY")   *IF DIFFERENT KEYS 
  
          GEN    (SX7 "RECLAST")
          GEN    (SA7 B1+"APLIST")   *RECA ADDRESS
          GEN    (SA5 "WSA")
          GEN    (SX7 X5+0),B4       *SX7 WSA+OREC ADDRESS
          GEN    (SA7 A7+2)          *RECB ADDRESS
  
          SA4  A0+8        ADDRESS OF SPEC$OWNT 
          SA4  X4          VALUE OF SPEC$OWNT 
          IFTHEN X4"0      IF SPEC$OWNT (SM5 INTERFACE) 
            GEN    (SA1 "APLIST") 
            GEN    (MX7 0)
            GEN    (SA7 X1)          *NRA = 0 
          ELSE- 
            GEN    (SA1 B1+"APLIST")
            ENDIF.
  
          NEWLBL NEXT 
          GEN    (SX7 "NEXT") 
          GEN    (SA7 S$RTNAD)       *RETURN ADDRESS
  
          SA2    A0+7      ADDRESS OF OWN5
          SA2    X2 
          GEN    (RJ 0),X2           *RJ OWNCODE5 
          GEN    (SB0 0)
  
          IFTHEN X4"0      IF SPEC$OWNT (SM5 STYLE) 
            GEN    (SA1 "APLIST") 
            NEWLBL LABEL4 
            GEN    (EQ "LABEL4")
          ELSE- 
            GEN    (SA1 "ERROR1") 
            GEN    (RJ =XS$ERROR) 
              GEN    (SA1 "ERROR0")      *ZERO TO PRINT ERROR 
              GEN    (RJ =XS$ERROR) 
            GEN    (RJ =XS$ABT) 
            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 = APLIST ABOVE FOR FTN5 
                                       * OR SET IN FTN4 PROGRAM 
  
          IFTHEN X4"0        IF SPEC$OWNT (SM5 INTERFACE) 
            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    (SX2 X2-1)            *NRA - 1 = 0 IF DELETE 
          ELSE- 
            GEN    (SA2 A1+2) 
            ENDIF.
  
          NEWLBL NEXT 
          GEN    (ZR X2,"NEXT")        *IF DELETE RECB
  
* 
* COPY RECB (OREC) TO RECTEMP 
* COPY RECA (RECLAST) TO OREC TO BE OUTPUT .
* COPY RECTEMP TO RECLAST FOR NEXT TIME.
* 
          GEN    (SA4 "ORECLEN")
          GEN    (SA5 "LRECLEN")
          GEN    (BX6 X4) 
          GEN    (BX7 X5) 
          GEN    (SA6 A5) 
          GEN    (SA7 A4) 
          IFTHEN X4"0         IF SPEC$OWNT (SM5 INTERFACE)
            GEN    (SA2 A1+3)           *ADDRESS OF RECB
            ENDIF.
  
          GEN    (SA2 X2) 
          GEN    (SA5 "RECTEMP")
  
          GEN    (SB3 0),B5          *EXT-REC-LEN 
          NEWLBL OWN5LOOP 
  
          GENLBL OWN5LOOP 
          GEN    (BX7 X2)            *XFER RECORD IN RECB 
          GEN    (SA7 A5)            *TO RECTEMP
          GEN    (SA2 A2+B1)
          GEN    (SA5 A5+B1)
          GEN    (SB3 B3-B1)         *DECREMENT COUNT 
          GEN    (LT B0,B3,"OWN5LOOP")  *IF MORE WORDS TO COPY
  
  
          IFTHEN X4"0         IF SPEC$OWNT  (SM5 INTERFACE) 
            GEN    (SA2 A1+B1)       *ADDRESS OF RECA 
          ELSE- 
            GEN    (SA2 A1)          *ADDRESS OF RECA 
            ENDIF.
  
          GEN    (SA2 X2) 
          GEN    (SA5 "WSA")
          GEN    (SA5 X5+0),B4       *SA5 WSA+OREC ADDRESS
  
          GEN    (SB3 0),B5          *EXT-REC-LEN 
          NEWLBL OWN5LOOP 
  
          GENLBL OWN5LOOP 
          GEN    (BX7 X2)            *XFER RECORD TO BE PUT 
          GEN    (SA7 A5)            *FROM RECA TO WSA+OREC 
          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    (SA2 "RECLAST")
          GEN    (SA5 "RECTEMP")
          GEN    (SB3 0),B5          *EXT-REC-LEN 
          NEWLBL OWN5LOOP 
  
          GENLBL OWN5LOOP 
          GEN    (BX7 X5)            *XFER RECORD IN RECTEMP
          GEN    (SA7 A2)            *TO 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 "OWN3")
  
          GENLBL NEXT 
  
*         INCREMENT THE ELEMENT OF S$ARRY WHICH HOLDS THE COUNT OF
*         THE NUMBER OF RECORDS DELETED BY OWN5 
            GEN  (SA2 S$ARRY+9)        *GET COUNT OF RECS DELETED 
            GEN  (SX7 B1) 
            GEN  (IX7 X2+X7)           *INCREMENT COUNT FOR OWN5
            GEN  (SA7 A2)              *UPDATE DELETED OWN5 REC COUNT 
          IFTHEN X4"0         IF SPEC$OWNT (SM5 INTERFACE)
            GEN    (SA2 A1+B1)          *ADDRESS OF RECA
          ELSE- 
            GEN    (SA2 A1)             *ADDRESS OF RECA
            ENDIF.
  
          GEN    (SA3 A2+B1)           *ADDRESS OF RECA LENGTH
          GEN    (SA3 X3)              *RECA LENGTH 
          GEN    (BX7 X3) 
          GEN    (SA7 "LRECLEN")       *CHARACTER LENGTH OF "RECLAST" 
  
          GEN    (SA7 "ORECLEN")
* EXCHANGE OREC AND "RECLAST" 
  
  
          GEN    (SA2 X2) 
          GEN    (SA5 "RECLAST")
          GEN    (SB3 A2) 
          GEN    (SB3 A5-B3)
          GEN    (SA1 "LAST")          *CHECK IF LAST RECORD TO PUT 
          GEN    (ZR X1,"PRUEOD")      *IF LAST RECORD
          GEN    (EQ B3,"PRIDONE")     *IF SAME ADDR, DON'T MOVE DATA 
          GEN    (SB3 0),B5          *EXT-REC-LEN 
          NEWLBL OWN5LOOP 
  
          GENLBL OWN5LOOP 
          GEN    (BX7 X2)            *XFER RECORD IN RECA 
          GEN    (SA7 A5)            *TO 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    (SA1 "LAST")          *CHECK IF LAST RECORD TO PUT 
          GEN    (ZR X1,"PRUEOD")      *IF LAST RECORD
          GEN    (EQ "PRIDONE") 
  
  
          GENLBL DIFFKEY               *IF DIFFERENT KEY RECORDS
* 
* EXCHANGE RECLAST AND OREC 
* 
          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)            *XFER OREC  TO BE PUT
          GEN    (SA7 A2)              *TO RECLAST
          GEN    (BX7 X2)              *XFER RECLAST TO 
          GEN    (SA7 A5)              *TO OREC FOR PUTTING 
          GEN    (SA2 A2+B1)
          GEN    (SA5 A5+B1)
          GEN    (SB3 B3-B1)         *DECREMENT COUNT 
          GEN    (LT B0,B3,"OWN5LOOP")  *IF MORE WORDS TO COPY
  
* NOW, SWITCH ORECLEN AND LRECLEN TO MATCH THE SWAP ABOVE 
  
          GEN    (SA4 "ORECLEN")
          GEN    (SA5 "LRECLEN")
          GEN    (BX6 X4) 
          GEN    (BX7 X5) 
          GEN    (SA6 A5) 
          GEN    (SA7 A4) 
  
  
  
          GENLBL OWN3 
  
          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+8        ADDRESS OF SPEC$OWNT 
            SA4    X4          VALUE OF SPEC$OWNT 
            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 
  
            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 OR RECS DELETED 
            GEN    (SX7 B1) 
            GEN    (IX7 X2+X7)         *INCREMENT COUNT FOR OWN3
            GEN    (SA7 A2)            *UPDATE STAT ARRAY 
  
          GEN    (SA2 "LAST")          *CHECK IF LAST RECORD TO PUT 
          GEN    (ZR X2,"PRUEOD")      *IF LAST RECORD
            GEN    (EQ "PRIDONE")      *SKIP PUTTING 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 
            GEN    (BX7 X3) 
            GEN    (SA7 "ORECLEN")
  
  
            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    (SA1 "LAST")          *CHECK IF LAST RECORD TO PUT 
          GEN    (ZR X1,"PRUEOD")      *IF LAST RECORD
            GEN    (EQ "PRIDONE") 
  
            GENLBL LABEL2 
  
*         INCREMENT THE ELEMENT OF S$ARRY WHICH HOLDS THE COUNT OF
*         THE NUMBER OF RECORDSINSERTED BY OWN3 
            GEN  (SA5 S$ARRY+6)        *GET COUNT FOR RECS INSERTED 
            GEN  (SX7 B1) 
            GEN  (IX7 X5+X7)           *INCREMENT COUNT FOR OWN3
            GEN  (SA7 A5)              *UPDATE STAT. ARRAY
  
* 
* SAVE RECORD AT WSAS$OREC AT SAVEREC AREA
* 
            GEN    (SB2 10)              *NO CHAR/WORD
            GEN    (SA4 "LRECLEN")
            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 
  
  
            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 "LRECLEN")
            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    (SA1 "LAST")          *CHECK IF LAST RECORD TO PUT 
          GEN    (ZR X1,"PRUEOD")      *IF LAST RECORD
            GEN    (EQ "PRIDONE") 
  
            ENDIF.
  
          GENLBL PRUEOD 
  
* FOR SHORT CODE, X6 WILL BE 40000000000000000000B
* THEN COPY RECLAST TO OREC AND PUT LAST RECORD.
  
          GEN    (MX0 1)
          GEN    (IX0 X0-X6)
          NEWLBL NEXT 
          GEN    (NZ X0,"NEXT") 
  
          GEN    (MX6 0)               *SET X6=EOD
          GEN    (SA6 "LAST")          *MARK LAST RECORD
          GEN    (EQ "LASTREC")        *GOTO PUT LAST RECORD (S$GNPR2)
  
          GENLBL NEXT 
  
          IFTHEN B3"0        IF OWNCODE4 IS SPECIFIED 
  
            GENLBL ENTRY2 
* 
  
            SA4    A0+8        ADDRESS OF SPEC$OWNT 
            SA4    X4          VALUE OF SPEC$OWNT 
            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),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 FOR INSERTED RECS 
            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 
            NEWLBL   NEXT    FORCE UPPER FOR THIS RJ
            GENLBL   NEXT    INSTRUCTION
            ELSE-              IF RECORD MANAGER USED,
              NEWLBL NEXT 
              GEN    (SB6 "NEXT") 
 #HAVEB6      SET    1           TELL GENMAC TO NOT GENERATE SB6 *+2
            GENMAC (CLOSEM A0,DET)       *CLOSE AND DETACH
              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 
              NEWLBL NEXT    *FORCE UPPER AFTER (CALL CMM.FRF)
              GENLBL NEXT 
            ELSE-              IF RECORD MANAGER USED,
              NEWLBL NEXT 
              GEN    (SB6 "NEXT") 
 #HAVEB6      SET    1       TELL GENMAC TO NOT GENERATE SB6 *+2
            GENMAC (REWINDM A0) 
          GENLBL NEXT 
  
          NEWLBL NEXT 
          GEN    (SB6 "NEXT") 
 #HAVEB6  SET    1
            GENMAC (CLOSEM A0,DET)       *CLOSE AND DETACH
              GENLBL NEXT 
              ENDIF.
            ENDIF.
  
          GEN    (EQ "ENDSORT") 
  
          GENLBL ORECLEN
          SA1    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
  
  
  
          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$GNPR3
*         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$ARRY   EXTERNAL
 S$RTNAD  EXTERNAL
  
  
          END 
