*COMDECK /PUTDEK/ 
 PUT$E    TITLE     BT=E  END-OF-BLOCK CHECK
*#
*0        PUT$E (BT=E). BEFORE A RECORD IS STARTED, SEE IF THE LAST BLK 
*     SHOULD BE FLUSHED.  IF THE NUMBER OF CHARACTERS TO BE WRITTEN 
*     (MVL) IS GREATER THAN THE SPACE REMAINING IN THE BLOCK (MBL-BL),
*     THEN FLUSH THE BLOCK.  (IN THE CASE OF RT=Z, WHEN THE LAST WORD 
*     HAS 9 OR 10 CHARS, AN EXTRA WORD WILL HAVE TO BE ADDED TO 
*     ACCOMODATE THE ZERO-BYTE SO USE MVL+10 IN THE CHECK.) 
*     BEFORE FLUSHING (AT *FLBLOCK*) PUT THE RETURN ADDRESS (*EFL*) 
*     IN THE B6 STACK BECAUSE *FLBLOCK* WILL JUMP TO *PTKG$SQ*
*     IN *PUT$SQ* TO ISSUE THE CIO REQUEST AND *PTKG$SQ* WILL DO A
*     RESTORE AND   JP  B6   WHICH WILL THEN JUMP TO *EFL*. 
*#
 PUT$EK   CAP.RM    ,NOENTRY
 PUT$E    BSS       0 
          F.RM      MBL 
          SX3       10             SLCW COUNTED IN BL BUT ITS NOT ON DEV
          F.RM      BL,4
          IX4       X4-X3            --REMOVE IT FOR END-OF-BLOCK CHECK 
          IX3       X1-X4          MBL-BL 
          SX1       X2+10          MVL+10 FOR RT=Z
          IX7       X3-X1          (MBL-BL) - (MVL+10)
          PL        X7,=YPTCM$SQ   JUMP IF RECORD FITS REMAINING SPACE
          F.RM      RT,B2,-#ZT# 
          EQ        B2,B0,EFLUSH
*     RT NOT Z..  RETEST USING MVL
          IX3       X3-X2          (MBL-BL) - MVL 
          PL        X3,=YPTCM$SQ   JUMP IF RECORD FITS REMAINING SPACE
 EFLUSH   BSS       0 
          S"ERRREG" 170B
          ZR        X4,=YERR$RM    BLOCK EMPTY = ERROR
          SET.RM    MVL,X2         SAVE MVL 
          SB6       EFL            FLBLOCK GOES TO KGTRY WHICH DOES A 
          SAVE                     RESTORE SO SAVE RETURN ADDRESS 
          EQ        FLBLOCK        GO FLUSH 
 EFL      BSS       0 
          F.RM      MVL,2          RESTORE MVL FOR PUT$SQ 
          EQ        =YPTCM$SQ 
 PUT$K    TITLE     BT=K  END-OF-BLOCK CHECK
*#
*0        PUT$K (BT=K). RECORD HAS BEEN PUT INTO THE BUFFER-DECREMENT 
*     KRN (COUNTS FROM RB TO ZERO = NUMBER OF RECORDS TO PUT IN CURRENT 
*     K-BLOCK) AND IF ZERO, GO TO *FLBLOCK* TO FLUSH THE CURRENT
*     K-BLOCK.
*#
          CAP.RM
 PUT$K    BSS       0 
          F.RM      KRN,X2,-1 
          ZR        X2,KFLUSH 
          SET.RM    KRN,X2
          EQ        =YPTIO$SQ 
 KFLUSH   F.RM      RB,X2                                           K 
          SET.RM    KRN,X2                                          K 
          F.RM      BL,4
          SX7       10
          IX4       X4-X7          ALLOW FOR S/L CONTROL WORD 
 FLBLOCK  TITLE     FLUSH BLOCK (K OR E)
*#
*0        FLBLOCK. FLBLOCK HANDLES FLUSHING K AND E BLOCKS. BLOCK 
*     NUMBER IS INCREMENTED AND PADDING IS ADDED IF THE BLOCK IS SHORTER
*     THAN MNB OR IF THE BLOCK IS GREATER THAN MNB BUT MNB IS NOT A 
*     MULTIPLE OF MUL.  (NOTE THAT IF BL<MNB, PADDING IS ADDED TO MNB,
*     I.E. THIS ASSUMES THAT MNB IS A MULTIPLE OF MUL.) 
*             INPUT..  B1,A0,A2,B3=PIN
*                      RETURN ADDRESS IS IN STACK 
*#
 FLBLOCK  BSS       0                                               KES 
          INC.RM    BN,1                                            KES 
          F.RM      MNB                                             KES 
          IX2       X4-X1          NEGATIVE OF PADDING NEEDED       KES 
          NG        X2,DOPAD                                        KES 
          F.RM      MUL,X2         FETCH MULTIPLE 
          ZR        X2,NOPAD
          PX1       X2
          PX4       X4                                              PAD 
          NX2       X1                                              PAD 
          FX7       X4/X2          BLKSZ/MUL                        PAD 
          UX2       X7,B2                                           PAD 
          LX3       X2,B2                                           PAD 
          PX3       X3                                              PAD 
          DX7       X1*X3          MUL*[BLKSZ/MUL]                  PAD 
          IX2       X4-X7                                           PAD 
          ZR        X2,NOPAD       BLKSZ = MUL * N                  PAD 
          UX1       X1                                              PAD 
          IX2       X2-X1                                           PAD 
 DOPAD    BSS       0              PAD WITH -X2 CHARACTERS          PAD 
*#
*         THE PADDING ALGORITHM IS BASED ON A SUBROUTINE AND A LOOP, AND
*     EACH CONTAINS A LOOP WITHIN IT.  THE SUBROUTINE (PCSTUFF) PUTS PC 
*     INTO X7 BEGINNING AT THE BOTTOM.  ITS FIRST USE IS TO FILL OUT THE
*     INCOMPLETE WORD, IF ANY.  THE MAJOR LOOP ADDS A WORD OF PADDING 
*     CHARACTERS AT A TIME TO THE BUFFER.  PCSTUFF BUILDS THE WORD AND
*     GET1.SQ FINDS ROOM IN THE BUFFER.  THE INNER LOOP STORES AS MUCH
*     AS ONE CALL TO GET1 ALLOWS.  THE LAST WORD IS FULLY PADDED, BUT 
*     BCC IS SET PROPERLY.
*#
          BX2       -X2                                             PAD 
          BX3       X2
          F.RM      BCC,B5                                          PAD 
          ZR        B5,PCGET                                        PAD 
          SA1       B3             FIRST WORD TO PAD                PAD 
          SX2       X2+B5                                           PAD 
          BX7       X1                                              PAD 
          BX4       0              FOR LOOP END AT PCWL 
 PCSTUFF  SB2       10             CHAR PER WORD                    PAD 
          F.RM      PC,,,,6        PADDING CHARACTER
          MX6       54
 PCLOOP   BX7       X6*X7          STRIP OFF OLD CHARACTER
          LX6       6 
          SB5       B5+B1          COUNT TO 10                      PAD 
          BX7       X7+X1          PUT IN PC
          LX1       6 
          LT        B5,B2,PCLOOP                                    PAD 
          NG        X2,PCWORD      CONTINUE VS. RETURN              PAD 
*     END SUBROUTINE PCSTUFF
          SA7       B3                                              PAD 
          SB5       X2                                              PAD 
          SB3       B3+B1          PIN                              PAD 
          LE        B5,B2,PCEND                                     PAD 
          SX2       B5-B2          X2 <- X2-(10-BCC)                PAD 
 PCGET    SET.RM    EMG,X2         DOUBLE DUTY FOR MVL              PAD 
          IX2       X3-X2          AMOUNT COMPLETED 
          INC.RM    BL,X2 
          GET1.SQ   OWM            GET SOME ROOM (B3 TO B4)         PAD 
          DEC.RM    BL,10 
          SB5       B0             WANT TO PAD A FULL WORD          PAD 
          MX2       1              TO GET PCSTUFF TO RETURN HERE    PAD 
          EQ        PCSTUFF                                         PAD 
 PCWORD   F.RM      EMG,X3         AMOUNT LEFT
          SB5       X3
          SX4       X4-10          REDUCE ONE EXTRA TIME
 PCWL     SA7       B3-B1          STORE FULL WORD OF PC-S          PAD 
          LE        B5,B2,PCEND    NEED@10                          PAD 
          SB3       B3+B1                                           PAD 
          SB5       B5-B2          DECREMENT NEED                   PAD 
          SX4       X4-10 
          PL        X4,PCWL        LOOP UNTIL FILL COMPLETE 
          SX2       B5                                              PAD 
          SB3       B3-B1                                           PAD 
          EQ        PCGET          GO GET MORE ROOM                 PAD 
 PCEND    INC.RM    BL,X3 
          NE        B5,B2,PCMID    NOT ON WORD BOUNDARY 
          SB5       B0                                              PAD 
          SB3       B3+B1                                           PAD 
 PCMID    SET.RM    BCC,B5                                          PAD 
          SB3       B3-B1                                           PAD 
 NOPAD    BSS       0                                               KES 
          F.RM      LIMIT,B2                                        KES 
          NE        B2,B3,PINOKB                                    KES 
          F.RM      FIRST,B3                                        KES 
*#
*         CONVERT BLOCK LENGTH (MINUS S/L CONTROL WORD) TO WORDS
*         AND UNUSED BITS, INCREMENT PIN IF BCC"0 AND CLEAR BCC,
*         STORE S/L CONTROL WORD IN THE BUFFER, INITIALIZE BLOCK
*         LENGTH=10 (FOR S/L CONTROL WORD SINCE K/E BLOCKS MUST BE
*         ON S/L DEVICE), SET CIO FUNCTION CODE TO 264B AND RETURN
*         TO PUT$SQ VIA   EQ =YKGTRY. 
*#
 PINOKB   BSS       0                                               SES 
          F.RM      BL,2           NO. CHARS IN CURRENT BLOCK 
          SX7       10
          IX7       X2-X7          SLCW NOT COUNTED IN SLCW ON TAPE 
          SB5       KCHWR          RETURN ADDRESS 
          EQ        =YCHWR$RM      CONVERT CHARS TO WORDS 
 KCHWR    BSS       0 
          SX4       X7
          AX7       18
          LX7       24
          BX2       X7+X4 
          F.RM      BCC                                             SOL 
          ZR        X1,ZROBCC                                       SOL 
          SET.RM    BCC,0                                           SOL 
          BUFINC    B,3,1,3                                         SCP 
          SB3       X3                                              SCP 
 ZROBCC   BSS       0                                               SOL 
          F.RM      IN                                              SOL 
          BX7       X2                                              SOL 
          SA7       X1                                              SOL 
          SET.RM    IN,B3                                           SOL 
          SET.RM    BL,0           START NEW BLOCK
          SET.RM    STM,0 
          GET1.SQ   OWM                                             SOL 
          SET.RM    KIA,0          KICK CIO AT END OF RECORD
          EQ        =XPTIO$SQ 
* END /PUTDKE/
