*COMDECK /TPUTDSQ/
          TITLE     TPUT$SQ 
          CAP.RM
 TPUT$SQ  BSS       0 
          SET.RM    ZOU,PFET       SAVE FET ADDRESS FOR CLOSEM
          SAVE
          INC.RM    RC,1
 .MD      IFNE      #BETA#,0
          SX6       102B
          ON.RM     WSAB,=YERR$RM  IF WRITE FROM LCM
 .MD      ENDIF 
          RJ        CHKBUF
          SB5       MOVE
          SA4       BLANKS         PICK UP WORD OF BLANKS (SAVE)
          F.RM      ASCII,1,,,5 
          ZR        X1,NOTASCI
          SA4       ABLANKS        PICK UP WORD OF ASCII BLANKS 
NOTASCI   BSS       0 
          OFF.RM    PPT,NOPART     IF NOT PARTIAL PUT 
          F.RM      RPTL,X4        PICK UP PTL
          F.RM      RL             PICK UP RL TO DATE 
          IX6       X1+X4          ADD CURRENT PART 
          F.RM      FL             PICK UP MAX RL 
          MX7       60
          IX6       X6-X1 
          SA7       MASK           INITIALIZE MASK
          NG        X6,RLSET       IF MAX NOT HIT 
          SX6       141B+1S17      SET FATAL EXCESS DATA ERROR
          EQ        =XERR$RM
 NOPART   BSS       0 
          SET.RM    RL,0           RESET RL=0 
          SET.RM    BCC,0 
          F.RM      RRL,X4         PICK UP RL 
          OFF.RM    SBF,NOTSBF
          SET.RM    MRL,X4         SET MRL TO RL PARAMETER
 NOTSBF   BSS       0 
          F.RM      RT,X1,-#ZT#    IF NOT Z RECORDS 
          NZ        X1,RLSET       GO PUT RL CHARACTERS 
          NZ        X4,USERL       IF RL NOT ZERO 
          F.RM      FL,X4          ELSE USE FL
 USERL    BSS       0 
          BX7       X4             CONVERT TO WORDS AND UBC 
          SB5       CRET
          EQ        =XCHWR$RM 
 CRET     BSS       0 
          SB5       MOVE
          SB4       X7             SET WORD COUNT 
          AX7       18
          SB2       X7             UNUSED-BIT-COUNT 
          F.RM      WSA,2,X2,-1,5  PICK UP WSA-1
          NG     X2,EXITB          WSA NOT DEFINED,WRITE IGNORED
          SA1       X2+B4          PICK UP LAST WORD OF RECORD
          MX7       60
*         NOTE ---- A4 WAS SET NEAR NOTASCI AND IS USED HERE
          SA4       A4             PICK UP PROPER WORD OF BLANKS
          ZR        B2,ZLOOP       IF NO UBC
          SB2       B2-59 
          MX2       1              INITIALIZE MASK
          AX7       X2,-B2         FORM MASK
          BX6       X7*X1          PRESERVE VALID CHARACTERS
          BX2       -X7*X4         GET NECESSARY BLANKS 
          BX1       X2+X6          BLANK FILL WORD
          IX2       X1-X4 
          NZ        X2,COMXIT      IF NOT ALL BLANK 
          MX7       60             CLEAR MASK 
 ZLOOP    BSS       0 
          IX2       X1-X4 
          NZ        X2,COMXIT      IF NOT ALL BLANK 
          SB4       B4-B1          DECREMENT WORD COUNT 
          SA1       A1-B1          PICK UP PREVIOUS WORD
          NE        B4,B0,ZLOOP    IF NOT LAST WORD 
          SB5       BANDZ          NO NON BLANK CHAR
          SB4       B1
 COMXIT   BSS       0 
          SA7       MASK           SAVE MASK FOR EOR PROCESSING 
          SX2       B4             MULTIPLY WORD COUNT BY 10
          SX3       B4+B4          *2 
          LX2       3              *8 
          IX4       X2+X3          *10 TO GET CHARACTERS
          BX0       -X4 
 RLSET    BSS       0 
          F.RM      MRL 
          ZR        X1,MRLOK       IF MRL=0 
          SX6       9 
          IX3       X1+X6          ALLOW FOR ROUND
          IX3       X3-X4          ELSE 
          SX6       142B           SET EXCESS DATA ERROR
          NG        X3,=XERR$RM    IF RL GT MRL 
MRLOK     BSS       0 
          SET.RM    PTL,X4         STORE PTL
          BX3       X4
          INC.RM    RL,X3          INCREMENT RL 
          SA1       PFET+2
          SB2       X1             PICK UP IN 
          F.RM      ASCII,5        PICK UP NEW ASCII BITS 
          SA2       A0             SAVE FIT ADDRESS 
          F.RM   WSA,B6 
          SA0       PFET           PUT SPECIAL FET IN A0
          F.RM      ASCII          PICK UP OLD ASCII BITS 
          IX1       X1-X5 
          SB3       B5
          ZR        X1,GETA 
          SYSY      24B,R          ELSE, FLUSH BUFFER 
          SET.RM    ASCII,X5       SET NEW ASCII BITS 
GETA      SB5       GETB
          SX7       19
          IX7       X7+X4          RL ROUNDED-UP+1 W IN BUF FOR I-O 
          EQ        =XCHWR$RM      RL IN WORDS
GETB      SB5       B3             RESTORE B5 
          SX6       X7             GET RID OF UNUSED BIT COUNT
          F.RM   FIRST,3
          IX6       X6+X3          FIRST+(RL+1) 
          F.RM      LIMIT,5 
          SA0       A2             RESTORE FIT ADDRESS
          F.RM      FIB 
          SA0       PFET           RESET A0 TO SPECIAL FET
          NG        X1,CHKAL       FORCE INTERACTIVE BUFFER 
          IX6       X5-X6          (LIMIT-FIRST)-(RL+1) 
          NG        X6,CHKAL       GO CHECK FOR UNALLOCATED BUFFER
  
SYS       IFC       EQ,/"OS.NAME"/KRONOS/ 
GETBB     BSS       0 
SYS       ENDIF 
          SX3    B6                SET WSA FOR THE MOVE ROUTINE 
 GETC     BSS       0 
          F.RM      LIMIT,B3
          NE        B2,B3,NOL 
          F.RM      FIRST,B2
 NOL      BSS       0 
          SB6       PDO 
          F.RM      OUT,B4         PICK UP OUT (B4 AND X1)
          SB3       B4-B1          ALLOW FOR EMPTY WORD 
          EQ        B3,B2,NOTL     IF BUFFER FULL 
          GT        B4,B2,USEOUT   USE SPACE IN TO OUT
          F.RM      LIMIT,5,B3
          SB6       LHIT
          F.RM      FIRST,5 
          IX1       X1-X5 
          NZ        X1,USEOUT      OUT"FIRST
          SB3       B3-B1          STOP AT LIMIT = 1
          SB6       PDO            ELSE SET RETURN TO PDO 
          EQ        B3,B2,NOTL     IF BUFFER FULL 
 USEOUT   BSS       0 
          JP        B5             RETURN 
*                                  B5 = MOVE OR ADDZ
 MOVE     SX2       B3-B2          CALC SPACE FOR MOVE
          IX1       X2+X2 
          LX2       3 
          IX2       X2+X1          IN CHARACTERS
          SA0       A2
          F.RM      BCC,B5
          SA0       PFET
          SB3       B0             CLEAR SOURCE BCP 
          SX5       B2             SET DESTINATION ADDRESS
          SB4       X2             SET MOVE CHAR COUNT TO AVAILABLE 
          IX0       X2-X4 
          NG        X0,=XMOVE$RM   IF AVAIL LT RL 
          SB4       X4             SET MOVE CHAR COUNT TO RL
          SB6       XIT            SET RETURN TO EXIT 
.N        IFC       NE,/"OS.NAME"/KRONOS/ 
          SA0       A2             USER FILE
          F.RM      WSI,X1
          SA0       PFET           BACK TO CONNECTED FILE 
          ZR        X1,=XMOVE$RM
          F.RM      LIMIT 
          SX5       X1-2           SET IN TO END OF THE RECORD
          EQ        XIT 
.N        ELSE
          EQ        =XMOVE$RM      GO MOVE RECORD 
.N        ENDIF 
 LHIT     BSS       0 
*         PRESERVE A3/X3 FOR NEXT MOVE
          SA0       A2
          SET.RM    BCC,B4
          SA0       PFET
          F.RM      FIRST,B2
          SET.RM    IN,B2          RESET IN TO FIRST
          BX4       -X0            RESET RESIDUAL RL
          SB5       MOVE
          EQ        GETC           GO MOVE NEXT PIECE 
 PDO      BSS       0 
*         PRESERVE A3/X3 FOR NEXT MOVE
          SB5       MOVE
          SB2       X5
          SET.RM    IN,X5 
          F.RM      LIMIT,B3
          SB4       B2+B1 
          BX4       -X0            RESET RESIDUAL RL
          NE        B4,B3,NOTL
          F.RM      FIRST,B4
 NOTL     BSS       0 
          SA5       A0             PICK UP FET BEFORE OUT 
          F.RM      OUT,B3
          NE        B4,B3,GETC     IF OUT MOVED 
          LX5       59
          PL        X5,BUSY        IF FET BUSY
          SX1       1600B          SET ERROR MASK 
          BX1       X5*X1          MASK OFF ERROR BITS
          SX6       721B*2+1
          LX6       59
          NZ        X1,ERREX         IF ERROR 
          SET.RM    IN,B2          STORE *IN* BEFORE WRITE
          SYSY      14B            ISSUE WRITE
 BUSY     BSS       0 
          RCL.RM    A0,PERIODIC 
          EQ        NOTL
 XIT      BSS       0 
          SA0       A2             RESET A0 TEMPORARILY 
          F.RM      RT,X4,-#ZT# 
          SB2       X5             SAVE IN
          F.RM      PPT,1 
          F.RM      TRM,3 
          BX3       -X3*X1
          MI        X3,SETBCC      PARTIAL AND NOT EOR
          SB3       B4
          SB4       B0
SETBCC    BSS       0 
          SET.RM    BCC,B4,,5 
          SA0       PFET           SET A0 BACK TO PFET
          MI        X3,ENDRTA      PARTIAL AND NOT EOR
          NZ        X4,RTS         IF NOT RT=Z
          PL        X1,NOTPPT      NOT THE END OF A PUT PARTIAL SEQUENCE
          MX4       1 
          ZR        B3,INOK 
          SB2       B2+B1          SET IN AFTER PARTIAL WORD
INOK      BSS       0 
          SX7       B3
          LX7       2 
          SB3       B3+B3 
          SB3       X7+B3          USED NUMBER OF BITS
          SB3       B3-B1 
          AX7       X4,B3 
          SA7       MASK           MASK FOR BITS USED IN THE LAST WORD
NOTPPT    BSS       0 
*         NOTE ---- A4 WAS SET NEAR NOTASCI AND IS UESD HERE
          SA4       A4             PICK UP PROPER WORD OF BLANKS
          SB3       6              SET CHARACTER SHIFT
          SB4       60-6+1         SET SHIFT COUNT
          NG        X4,NOASCII     IF ASCII FLAGS NOT SET 
          SB3       12             SET CHARACTER SHIFT
          SB4       60-12+1        SET SHIFT COUNT
 NOASCII  BSS       0 
          SA1       MASK           RETRIEVE MASK
          SA3       B2-B1          PICK UP LAST WORD OF RECORD
          BX2       X3*X1          STRIP OFF GARBAGE
          BX1       -X1*X4         GET RIGHT NUMBER OF BLANKS 
          BX3       X1+X2          BLANK FILL WORD
          SX7       B1
          BX2       X3-X4          CHANGE BLANKS TO 0S
          IX7       X2-X7          CHANGE TRAILING 0S TO 1S 
          SA1       A4-B1          PICK UP MASK - 1 TOP OF EACH CHAR
          BX2       -X2*X7         PRESERVE JUST TRAILING 1S
          BX7       X2*X1          PRESERVE AS MANY 1S AS BLANKS
          LX1       X7,B4          SHIFT 1S TO BOTTOM OF CHARACTERS 
          IX2       X7-X1          CHARS ALL 1S EXCEPT TOP BIT
          BX1       X2+X7          OR IN TOP BIT - MASK COMPLETE
          SB5       BTACKON 
          ZR        X1,GETC        NO,BLANK ADD TACKON
          SB4       6 
          AX7       X1,B4          EXCLUDE FIRST TRAILING BLANK MASK
          BX6       X7-X1          MASK FOR FIRST TRAILING BLANK ONLY 
          LX6       6              MASK FOR LAST NON-BLANK ONLY 
          BX7       X6*X3          EXTRACT LAST NON-BLANK 
          NZ        X7,NOTCOLN     IF NOT COLON 
          AX1       X1,B3          EXCLUDE FIRST TRAILING BLANK MASK
 NOTCOLN  BSS       0 
          BX7       -X1*X3         MASK OFF TRAILING BLANKS LESS ONE
          AX1       12-1           IS MASK AT LEAST 12 BITS 
          SA7       A3             REWRITE WORD LESS BLANKS 
          NZ        X1,ENDRT       IF ZERO BYTE EXISTS
          SB5       ADDZ
          EQ        GETC
 ADDZ     BSS       0 
          SX7       0 
          SB2       B2+B1          INCREMENT IN 
          SA7       B2-B1          WRITE ZERO WORD
 ENDRT    BSS       0 
.M        IFC       NE,/"OS.NAME"/KRONOS/ 
          SA1       A0
          LX1       59
          PL        X1,ENDRTA      FILE BUSY
          SYSY      14B 
.M        ENDIF 
ENDRTA    BSS        0
          F.RM      LIMIT,B3
          NE        B2,B3,SETIN 
          F.RM      FIRST,B2
 SETIN    BSS       0 
          SET.RM    IN,B2 
          SA0       A2             RESTORE A0 
          SET.RM    LOP,#PU#
          SET.RM    FP,#EOR#
EXITB     BSS    0
          RESTORE 
          JP        B6             RETURN TO USER 
 BTACKON  BSS       0 
          F.RM      FIRST,B5
          SA1       B2-B1          LAST WORD OF RECORD STORED 
          SB5       A1-B5 
          GE        B5,B0,USEB2    IF TACKON NOT TO BE AT FIRST 
          F.RM      LIMIT,A1,-1 
 USEB2    BSS       0 
          MX6       54
          BX1       -X6*X1
          NZ        X1,ADDZ        IF LAST CHAR NOT COLON, NO TACKON
BANDZ     BSS       0 
          SA4       A4             PICK UP WORD OF BLANKS 
          MX1       6              SET MASK FOR 64 CHAR TERMINAL
          SB2       B2+B1          INCREMENT IN 
          NG        X4,THAR        IF 64
          AX1       6              EXTEND MASK FOR ASCII
 THAR     BSS       0 
          BX7       X4*X1          MASK OFF ONE BLANK 
          SA7       B2-B1          PUT TACKON IN BUFFER 
          EQ        ENDRT          EXIT 
 RTS      BSS       0 
          F.RM      LIMIT,B3
          NE        B2,B3,SETIN2
          F.RM      FIRST,B2
 SETIN2   BSS       0 
          SET.RM    IN,B2 
.M        IFC       NE,/"OS.NAME"/KRONOS/ 
          SYSY      24B            FORCE WRITE S RECORD 
.M        ENDIF 
          EQ         ENDRTA         EXIT
 ERREX    BSS       0 
          SA3       A0
          SA0       A2             RESTORE FIT ADDRESS
          F.RM      LFN            PICK UP REAL LFN 
          LX1       18
          SX4       X3             PICK UP CDS
          BX7       X4+X1          OR TEGETHER
          SA7       A0             PUT IN REAL FET(FIT) 
          EQ        =XERR$RM
 MASK     BSSZ      1 
USBF$RM   BSSZ      1              CURRENT USER BUFFER SELECTED FOR 
*                                  COONECTED OUTPUT 
*                                  24/0,18/FIT ADDRESS,18/BFS 
*                                  NEGATIVE IF BUFFER MUST BE REALLOCATED 
*                                  ZERO IF DEFAULT BUFFER IS USED 
TFIRST    BSSZ      2              TEMPORARY FIRST/LIMIT
  
 PFET$RM  BSS       0              DEFINE PFET TO BE EXTERNAL 
 PFET     VFD       42/0LZZZZZOU,18/15B 
          VFD       17D/0,1/1,5/0,1/1,12D/0,6/1,18D/FIRST 
          VFD       42D/0,18D/FIRST 
          VFD       42D/0,18D/FIRST 
          VFD       42D/0,18D/LIMIT 
          BSSZ      1 
*         SELECT THE NEW BUFFER FOR CONNECTED OUTPUT IF IT IS LARGER
*         THAN THE EXISTING ONE.
*         IF THE  ALLOACATION FLAG IS SET (USBF$RM NEGATIVE) REALLOCATE 
*         THE DEFAULT BUFFER FIRST. 
  
CHKBUF    BSSZ      1 
.N        IFC       NE,/"OS.NAME"/KRONOS/ 
          OFF.RM    RSI,USEBUF
          F.RM      RRL,X7
          SB5       RLWORD
          EQ        =XCHWR$RM 
RLWORD    SX4       X7+2           BFS = RL+2 
          F.RM      WSA 
          BX6       X1
          EQ        NEWBUF
USEBUF    BSS       0 
.N        ENDIF 
          F.RM      LIMIT,4 
          F.RM      FIRST 
          IX4       X4-X1          USER BUFFER SIZE 
          SA2       USBF$RM 
          PL        X2,PFETOK 
*         RESET DEFAULT BUFFER POINTERS IN PFET 
          SB2       A0
          SA0       PFET
          SX6       FIRST 
          SET.RM    FIRST,X6
          SA6       A7+B1          IN 
          SA6       A6+B1          OUT
          SX6       LIMIT 
          SET.RM    LIMIT,X6
          MX7       0 
          SA7       USBF$RM 
          SA0       B2
          MX2       0 
PFETOK    BSS       0 
  
          SX1       X2             CURRENT BFS
          NZ        X1,NODFLT 
          SX1       LIMIT-FIRST    DEFAULT BFS
  
NODFLT    IX1       X1-X4 
          PL        X1,CHKBUF      KEEP CURRENT BUFFER
          F.RM      FIRST,X6
.N        IFC       NE,/"OS.NAME"/KRONOS/ 
NEWBUF    BSS       0 
.N        ENDIF 
          SB2       A0
          SA0       PFET
          SA1       A0
          LX1       59
          NG        X1,NOIO        FILE NOT BUSY
          RCL.RM    A0,AUTO        WAIT UNTIL I-O COMPLETES 
NOIO      F.RM      IN
          F.RM      OUT,3 
          IX1       X1-X3 
          ZR        X1,EMPTY       BUFFER IS EMPTY
          SYSY      24B,R 
EMPTY     SET.RM    FIRST,X6
          SA6       A7+B1          IN 
          SA6       A6+B1          OUT
          IX6       X6+X4          FIRST+BFS
          SET.RM    LIMIT,X6
          SX7       B2
          LX7       18
          BX7       X7+X4          FIT ADDRESS+BFS
          SA0     B2
.N        IFC       NE,/"OS.NAME"/KRONOS/ 
          OFF.RM    WSI,BUFOK 
          MX7       59
BUFOK     BSS       0 
.N        ENDIF 
          SA7       USBF$RM 
          EQ        CHKBUF
  
CHKAL     SA0       A2
          IX1       X5-X3          LIMIT - FIRST = CURRENT BUFFER 
          F.RM      BFS,3 
          IX3       X1-X3           CURRENT BUFFER - BFS
SYS       IFC       NE,/"OS.NAME"/KRONOS/ 
          SX6       354B+1S17 
          PL        X3,ERREX       BUFFER TOO SMALL 
SYS       ELSE
          PL        X3,KEEPBUF
SYS       ENDIF 
          SX7       =YCMM.ALF 
SYS       IFC       NE,/"OS.NAME"/KRONOS/ 
          NG        X7,ERREX       STATIC MODE
SYS       ELSE
          NG        X7,KEEPBUF
SYS       ENDIF 
          SB3       ALBUF 
          EQ        =XRM$ABUF 
ALBUF     RESTORE 
          EQ        TPUT$SQ        TRY WITH NEW BUFFER
SYS       IFC       EQ,/"OS.NAME"/KRONOS/ 
KEEPBUF   SA0       PFET
          EQ        GETBB 
SYS       ENDIF 
* END /TPUTDSQ/ 
*#
*0        NOS REQUIRES TERMINAL OUTPUT FILE TO BE FIRST ENTRY IN
*         LIST-OF-FILES. THEREFORE THIS SECTION OF CODE (EXECUTED FOR 
*         FIRST PUT ONLY) PUTS ZZZZZOU/OUTPUT AS THE FIRST ENTRY
*         AND MOVES EXISTING FIRST ENTRY(IF ANY)TO ANOTHER PLACE IN THE 
*         TABLE. IF THE FILE BEING WRITTEN IS NOT OUTPUT, ZZZZZOU IS
*         USED. THE INTERNAL FET IS OPENED TO SET DEVICE TYPE.
*#
 PBUF     BSS 
 FIRST    BSS       0 
 SETLOF   BSS 
 DTCHK    IFC       NE,/"OS.NAME"/KRONOS/ 
          SYSTEM    CON,RCL,CONWRD,0   CONNECT ZZZZZOU FILE 
 DTCHK    ELSE
          SB3       A0             SAVE FIT ADDRESS 
          SA0       CONWRD
          SET.RM    CMPLT,1 
          SYSY      70B,R          RETURN,FILE
          SA0       B3             RESTORE FIT ADDRESS
          SYSTEM    LFM,RECALL,CONWRD,1502B   ASSIGN TELETYPE 
 DTCHK    ENDIF 
 USEOUTP  BSS       0 
          SA1       LOF$RM
          SA5       ZOU 
          SA2       X1+B1          PICK UP FIRST FILE NAME
          BX7       X5-X2 
          BX6       X5
          SA6       A2             PUT ZZZZZOU IN 1ST SLOT
          ZR        X7,JPB5        IF ZZZZZOU ALREADY FIRST IN LOF
          ZR        X2,JPB5        IF END OF LIST 
          NG        X2,JPB5        IF DEAD ENTRY
          SX6       B5
          BX5       X2             RE-INSERT FIRST ENTRY
          SA6       SAVB5 
* CALL /SETLOF/ 
*CALL /SETLOF/
          SA4       SAVB5 
          SB5       X4
 JPB5     BSS       0 
          SA3       A0             SAVE FIT ADDRESS 
          SA0       PFET
          SYSY      104B,R         OPEN ZZZZZOU TO SET THE DEVICE TYPE
          SA0       A3              RESTORE A0
          SA3       LOFJP 
          LX3       30
          BX7       X3
          SA7       A3
          JP        B5             RETURN,TO TPUT 
  
 CONWRD   VFD       42/0LZZZZZOU,18/0 
          IFC       EQ,/"OS.NAME"/KRONOS/,1 
          VFD       12/2HTT,30/,18/PBUF 
 ZOU      VFD       42/7LZZZZZOU,18/PFET
 LOFADR 
 CALLERR  EQ        =XERR$RM
 SAVB5
          IFGT      PBSZ-*+PBUF,,1
          BSS       PBSZ-*+PBUF 
 LIMIT    BSS       0 
* END /TPUTDSQ/ 
