*COMDECK /PUTDS/
*#
*1CD  PUT$S 
*0D   PURPOSE 
*0        TRANSFER ALL, OR PART, OF AN S-TYPE RECORD FROM THE USER WSA
*         TO THE CIRCULAR BUFFER. 
*0D   CALL
*0               SB6          RETURN-ADDRESS
*                EQ           =XPUT$S 
*0D   PARAMETERS
*0        A0        FIT ADDRESS 
*         B1        1 
*         B6        RETURN ADDRESS
*         WSA       FWA OF USER WORKING STORAGE AREA (WHERE TO GET DATA)
*         RL        RECORD LENGTH 
*         PTL       PARTIAL TRANSFER LENGTH 
*         EX        USER ERROR EXIT ADDRESS 
*0D   ACTION
*0        FIRST CHECK THE FOLLOWING ERROR CONDITIONS: FILE NOT OPEN,
*         PROCESSING DIRECTION IS INPUT, BUFFERED OPERATION FOLLOW
*         NON-BUFFERED OPERATION. 
*         IF THE LAST OPERATION WAS AN INPUT OPERATION THEN FOR 
*             PRU DEVICES, RESET BUFFER POINTERS.  FOR S/L DEVICES, 
*             PUT THE FILE IN AUTO-RECALL, COUNT THE NUMBER OF RECORDS
*             IN THE BUFFER BUT NOT TRANSFERED TO THE USER, AND POSITION
*             THE FILE BACKWARD THAT NUMBER OF RECORDS VIA A CIO
*             REQUEST WITH AUTO-RECALL, AND RESET POINTERS. 
*         SET THE *UWD* FIELD TO THE *WSA* ADDRESS. 
*         IF FILE POSITION IS MID-RECORD AND THIS IS NOT A PARTIAL
*         TRANSFER THEN CALL THE *WRAPUP* PROCEDURE TO ENSURE THAT THE
*         PREVIOUS RECORD IS TERMINATED AND WRITTEN TO THE FILE.
*         IF WE ARE NOW ON A RECORD BOUNDARY THEN WE DO THE FOLLOWING:  
*             CHECK FOR EXCESS DATA ERROR (142).
*             CLEAR *FP* AND *RL* FIELDS. 
*             SET THE PSEUDO IN POINTER (*PIN*) EQUAL TO *IN*.
*             IF THIS IS A GETP OPERATION CLEAR *BCC* AND *UCP*.
*             IF THIS IS A PRU DEVICE AND THE FILE IS BUSY, PUT THE 
*             FILE IN AUTO-RECALL.  IF ITS AN S/L DEVICE INCREMENT THE
*             PSEUDO-IN POINTER BEYOND THE WORD TO RECEIVE THE CONTROL
*             INFORMATION.
*     P1. IF THERE IS NO ROOM IN THE BUFFER WE CAN SAFELY ASSUME THAT 
*         THE I/O IS GOING SO GO INTO PERIODIC-RECALL AND TRY AGAIN 
*         UNTIL THERE IS ROOM.
*         AT THIS POINT THE UNIT-OF-TRANSFER IS THE NUMBER OF CONTIGUOUS
*         WORDS AVAILABLE IN THE BUFFER.  IF THIS IS A PRU DEVICE,
*         THE UNIT-OF-TRANSFER WILL BE THE MINIMUM OF THE CONTIGUOUS
*         WORDS AVAILABLE AND THE PRU SIZE.  CONVERT UNIT-OF-TRANSFER TO
*         CHARACTERS.  DETERMINE THE RESIDUAL OF THE TOTAL CHARACTERS 
*         REQUESTED BY THE PUT/PUTP OPERATION.
*         IF THIS IS A PARTIAL TRANSFER, PERFORM THE FOLLOWING: 
*             SUBTRACT *BCC* FROM THE UNIT-OF-TRANSFER. 
*             DETERMINE THE RESIDUAL OF THE PARTIAL TRANSFER REQUEST. 
*             IF *RRL* IS ZERO THEN DO THE FOLLOWING: 
*                IF THIS IS NOT A PRU DEVICE
*                   THEN ISSUE EXCESS DATA ERROR WHEN *RL* + RESIDUAL 
*                        PTL EXCEEDS MLRS CHARACTERS. 
*                   ELSE SET *RL* RESIDUAL TO THE *PTL* RESIDUAL. 
*             ELSE IF *RRL* IS NON-ZERO AND THE *PTL* RESIDUAL IS LESS
*                THAN OR EQUAL TO THE *RL* RESIDUAL THEN SET THE
*                *RL* RESIDUAL EQUAL TO THE *PTL* RESIDUAL, ELSE WE HAVE
*                AN EXCESS DATA ERROR.
*         NOW WE HAVE DETERMINED HOW MUCH OF THE PUT/PUTP REQUEST 
*         REMAINS TO BE TRANSFERED.  IF IT IS LESS THAN THE 
*         UNIT OF TRANSFER THEN IT BECOMES THE UNIT-OF-TRANSFER FOR THIS
*         ITERATION OF THE PROCESS.  INCREMENT *RL* BY THE
*         UNIT-OF-TRANSFER AND ALSO *PTL* IF THIS IS A PUTP.  NOW CALL
*         *MOVE$RM* TO TRANSFER UNIT-OF-TRANSFER CHARACTERS TO THE
*         BUFFER.  UPDATE *UWD* AND *PIN*.  IF THIS IS A PUTP UPDATE
*         *BCC* AND *UCP*.  IF THIS IS A PRU DEVICE, SET *IN* EQUAL TO
*         *PIN*.  IF *RL* IS EQUAL TO *RRL* CALL *WRAPUP* TO TERMINATE
*         RECORD AND ENSURE IT IS WRITTEN TO THE FILE, THEN RETURN TO 
*         USER.  IF THE FILE IS NOT BUSY THEN DO THE FOLLOWING: 
*            CALL *ERRCHK* TO DETECT AND HANDLE ABNORMAL CONDITIONS.
*            FOR PRU DEVICES, ISSUE A CIO WRITE REQUEST IF THERE IS AT
*            LEAST 1 PRU OF DATA IN THE BUFFER. 
*         IF THIS IS A PUTP OPERATION AND *PTL* IS EQUAL TO *RPTL* THEN 
*         WE CAN RETURN TO THE USER AFTER TERMINATING THE RECORD WHERE
*         THE *TRM* FLAG IS SET.
*         NOW WE GO BACK TO P1 AND CONTINUE THE PROCESS UNTIL THE 
*         ENTIRE REQUEST IS SATISFIED.
*#
 .OS      IFC       EQ,/"OS.NAME"/KRONOS/ 
 #DESTL#  EQU       4007B          DETAIL ERROR STATUS - TRACK LIMIT
 #CSDCE#  EQU       22B            CONSULT DETAILED ERROR STATUS FIELD
 .OS      ELSE
 #CSDCE#  EQU       10B      CODE AND STATUS DEVICE-CAPACITY-EXCEEDED 
 .OS      ENDIF 
#CSEOI#   EQU      01B             CODE OF STATUS END-OF-INFORMATION
 #CSEOV#  EQU       02B      CODE AND STATUS END-OF-VOLUME
 #CSPAR#  EQU       04B      CODE AND STATUS PARITY-ERROR 
 FWRD.RM  MICRO     1,, 25
 XREG.RM  MICRO     1,, 0 
 NOSPACE  DATA      C*$NO SPACE * 
 BLNKMSG  DATA      C*        * 
 PUT$S    SPACE     4,8 
 PUT$S    CAP.RM
          SET.FOJ   P,B4,PUT.S
          NZ        B3,=XRM$ABUF   ALLOCATE BUFFER, RETURN TO WEOX
          SB3       B4
          EQ        RM$ABUF 
 PUT.S    SPACE     4,8 
          CAP.RM
 PUT.S    BSS 
          SA1       A0+"FWRD.RM"
          BX"XREG.RM" X1
          SX6       113B
          ON.RM     WSI,=YERR$RM   LAST OP NON-BUFFERED 
          SAVE
          F.RM      OUT,B3
          F.RM      IN,B2          USE *IN* 
          F.RM      FP,X3          (SAVE THIS REG. FOR TEST AT LOC. PUT)
          NZ        X3,PT0         IF NOT MID-RECORD
          F.RM      PIN,B2         USE *PIN*
          EQ        PT01                                                000740
 PT0      BSS       0 
          SET.RM    RL,0           CLEAR RL AT START OF RECORD          000760
          SET.RM    BCC,0          CLEAR BCC AT START OF RECORD 
 PT01     BSS       0                                                   000770
          ON.RM     WPN,PUT        IF LAST OPERATION NOT INPUT
          F.RM      LOP,1 
          SB4       X1-#GE# 
          SB5       X1-#SF# 
          ZR        B4,WAR         IF LAST OP = GET 
          ZR        B5,WAR         IF LAST OP = SKIPF 
          SB4       X1-#SB# 
          NZ        B4,PUT         IF LAST OP " SKIPB 
 WAR      BSS       0 
          OFF.RM    SOL,WARSC      IF SCOPE DEVICE
          RCL.RM    A0,AUTO        WAIT FOR I/O TO STOP     - 
          SB6       PTWAR 
          EQ        ERRCHK
PTWAR     BSS       0 
          EQ        B2,B3,PUT      IF PHYSICAL/LOGICAL POSITIONS AGREE
 CT       SET       6              RECORDS-IN-BUFFER COUNT
 DP       SET       4              POSITION IN BUFFER 
 DL       SET       5              LENGTH OF CURRENT RECORD 
          SB.DP     B3             BUFFER POSITION = OUT
          SB.CT     B0
 SLSKP    BSS       0 
          SA.DP     B.DP           PICK UP S/L CONTROL WORD 
          SB.DL     X.DP           EXTRACT LENGTH OF RECORD (WORDS) 
          BUFINC    B,DP,DL,DP     INCREMENT OUT POINTER
          SB.DP     X.DP
          SB.CT     B.CT+B1        INCREMENT RECORDS-IN-BUFFER COUNT
          NE        B.DP,B2,SLSKP  IF MORE RECORDS IN BUFFER
          SX1       B.CT
          SYSY      640B,RCL,1     BACKSPACE BY RECORDS IN BUFFER 
 WARSC    BSS       0 
          F.RM      FIRST,B2       RESET POINTERS 
          SET.RM    IN,B2 
          SET.RM    OUT,B2
          SB3       B2
 PUT      BSS       0 
          SET.RM    UCP,0          WSA ALWAYS STARTS ON A WORD BOUNDARY 
 .MD      IFNE      #BETA#,0
          F.RM      WSAD,2
 .MD      ELSE
          F.RM      WSA,2 
 .MD      ENDIF 
          SET.RM    UWD,X2
          NZ        X3,PT1         IF NOT MID-RECORD
          ON.RM     PPT,PT1        IF PARTIAL TRANSFER REQUEST
          SB6       PT1 
          EQ        WRAPUP         TERMINATE THE PRIVIOUS RECORD
 PT1      BSS       0 
          SB4       PT6 
          F.RM      MRL,X2
          ZR        X2,PT2
          F.RM      RRL,X5
          OFF.RM    PPT,GOTRRL
          NZ        X5,GOTRRL 
          F.RM      RPTL,X5 
          F.RM      RL,X4 
          IX5       X4+X5 
 GOTRRL   BSS       0 
          IX5       X2-X5          MRL-RRL   OR   MRL-(RPTL+RL) 
          MI        X5,EXCESS      EXCESS DATA ERROR
          ZR        X3,PTLOOP      IF MID-RECORD
  
 PT2      BSS       0 
          SET.RM    FP,0
          OFF.RM    SOL,PT4        IF SCOPE DEVICE
          BUFINC    B,2,1,2        INCREMENT IN PAST SLCW 
          SB2       X2
          SET.RM    PIN,X2
          EQ        PTLOOP         BEGIN PROCESSING REQUEST 
          SPACE     1 
 PT4      BSS       0 
          RCL.RM    A0,AUTO        WAIT TO AVOID RECORD CONCATENATION 
          SB6    PTLOOP 
          EQ        ERRCHK
 PTLOOP   BSS       0 
          SA2       A0             LOAD CODE AND STATUS 
          F.RM      OUT,B3
          SB5       B3-B2          AVAILABLE SPACE IN BUFFER
          LX2       59
          LT        B0,B5,PT5      IF *IN* @ *OUT*
          NZ        B5,PT4A        IF *IN* " *OUT*
          PL        X2,PT5B        IF FILE BUSY 
 PT4A     BSS       0 
          F.RM      FIRST,B5
          SB3       B3-B5          OUT-FIRST
          F.RM      LIMIT,B5
          ZR        B3,PT4B        GO ONLY TO LIMIT-1 IF OUT=FIRST
          SB5       B5+B1 
 PT4B     BSS       0 
          SB5       B5-B2 
 PT5      BSS       0 
          SB5       B5-B1 
          ZR        B5,PT5A        WAIT FOR SOME DATA TO LEAVE BUFFER 
          SB3       1S17/10        MOVE$RM WORD LIMIT 
          LT        B5,B3,PT5AA 
          SB5       B3
 PT5AA    BSS       0 
          JP        B4
          SPACE     1 
 PT5A     BSS       0 
          PL        X2,PT5B        I/O BUSY 
          JP        B4             I/O NOT BUSY 
 PT5B     BSS       0 
          RCL.RM    1,COUNT        WAIT FOR SOME DATA TO LEAVE THE BUF. 
          EQ        PTLOOP         GO TRY AGAIN 
          SPACE     1 
 PT6      BSS       0 
          SX4       B5
          IX5       X4+X4          *10
          LX4       3 
          IX4       X5+X4 
          F.RM      RRL,5 
          F.RM      RL,2
          IX6       X5-X2          *RRL* - *RL* 
          OFF.RM    PPT,PT9        IF NOT PARTIAL TRANSFER
          F.RM      BCC,3 
          IX4       X4-X3          SUBTRACT UNUSED CH. OF WORD ONE
          F.RM      RPTL,3
          ZR        X3,PT15A       IF POSSIBLE TERM WITH NO DATA XFER 
          F.RM      PTL,1 
          IX3       X3-X1          RPTL - PTL 
          NZ        X5,PT8         IF RECORD LENGTH SPECIFIED IN CALL 
          OFF.RM    SOL,PT7        IF SCOPE DEVICE
          F.RM      MBL,1 
          IX5       X2+X3          RL + (RPTL - PTL)
          IX2       X1-X5 
          MI        X2,EXCESS      EXCESS DATA ERROR
 PT7      BSS       0 
          BX6       X3             USE *RPTL* - *PTL* 
          EQ        PT9 
          SPACE     1 
 PT8      BSS       0 
          IX5       X6-X3          (*RRL* - *RL*) - (*RPTL* - *PTL*)
          BX6       X3             USE *RPTL* - *PTL* 
          MI        X5,EXCESS      EXCESS DATA ERROR
 PT9      BSS       0 
          IX3       X6-X4          AMOUNT TO XFER MINUS SPACE TO FILL 
          PL        X3,PT10        IF SPACE @ AMOUNT TO TRANSFER
          BX4       X6             USE AMOUNT TO TRANSFER 
 PT10     BSS       0 
          SB4       X4             SAVE X4 CONTENT
          INC.RM    RL,X4          INCREMENT RL BY AMOUNT TO BE MOVED 
          SX4       B4             RESTORE X4 CONTENT 
          OFF.RM    PPT,PT11       IF NOT A PARTIAL TRANSFER
          INC.RM    PTL,X4         INCREMENT PTL BY AMOUNT TO BE MOVED
          SX4       B4             RESTORE X4 CONTENT 
 PT11     BSS       0 
          F.RM      UWD,3          SOURCE LOCATION
 .MD      IFNE      #BETA#,0
          F.RM      WSAB,X5        1=LCM WSA, 0=SCM WSA 
          LX5       21
          BX3       X3+X5 
 .MD      ENDIF 
          F.RM      UCP,B3         SOURCE CHARACTER POSITION
          SX5       B2             DESTINATION LOCATION = *PIN* 
          F.RM      BCC,B5         DESTINATION CHARACTER POSITION 
          SB6       PT12
          EQ        =YMOVE$RM      MOVE FROM WSA TO BUFFER
 PT12     BSS       0 
          SB2       X5             NEXT DESTINATION ADDRESS 
          SET.RM    UWD,X3         NEW SOURCE ADDRESS 
          F.RM      LIMIT,B5
          NE        B2,B5,NOLIMIT 
          F.RM      FIRST,B2
 NOLIMIT  BSS       0 
          SET.RM    UCP,X4         SOURCE CHARACTER POS. FOR NEXT MOVE
          SET.RM    BCC,B4         DESTINATION CHAR. POS. FOR NEXT MOVE 
          SET.RM    PIN,B2         NEXT DESTINATION ADDRESS 
          ON.RM     SOL,PT13       IF S/L DEVICE DONT STORE *IN*
          SB4       PT12A 
          EQ        PTLOOP         ENSURE THAT *IN* " *OUT* 
 PT12A    BSS       0 
          SET.RM    IN,B2 
 PT13     BSS       0 
          F.RM      RL,1
          F.RM      RRL,2 
          ZR        X2,INFINI      RRL=0 MEANS INFINITE RL
          IX3       X2-X1 
          SB6       PT16
          ZR        X3,WRAPUP      GO TERMINATE RECORD
 INFINI   BSS       0 
          OFF.RM    CMPLT,PT15     IF FILE STILL BUSY 
          SB6       PT14
          EQ        ERRCHK         CHECK FOR ERRORS 
 PT14     BSS       0 
          F.RM      OUT,B3
          BUFSP     B,3,2,4        DETERMINE HOW MUCH DATA IS IN BUFFER 
          F.RM      PRUSIZ,1
          IX5       X4-X1 
          SX3       14B 
          OFF.RM    SOL,PT14B 
          F.RM      MBL,X7         ON S TAPE USE MBL INSTEAD OF PRUSIZE 
          SB5       PT14A 
          EQ        =YCHWR$RM      GET MBL IN WORDS 
 PT14A    BSS       0 
          SX7       X7             STRIP OFF UNUSED BIT COUNT 
          IX5       X4-X7 
          SX3       264B
PT14B     BSS       0 
          MI        X5,PT15        IF LESS THAN 1 PRU OF DATA IN BUFFER 
          SYSY      X3
 PT15     BSS       0 
          SB4       PT6 
          OFF.RM    PPT,PTLOOP     GO TRANSFER THE NEXT PIECE 
          F.RM      PTL,1 
          F.RM      RPTL,2
          IX3       X2-X1 
          NZ        X3,PTLOOP      IF PARTIAL TRANSFER INCOMPLETE 
 PT15A    BSS       0 
          SB6       PT16
          ON.RM     TRM,WRAPUP     IF TERM PARAMETER PRESENT
 PT16     BSS       0 
          BX7       X"XREG.RM"
          SA7       A0+"FWRD.RM"
          SET.RM    LOP,#PU#
          RESTORE 
          JP        B6             GO BACK TO USER
 EXCESS   BSS       0 
          SX6       142B
          EQ        =YERR$RM       EXCESS DATA ERROR
 ERRCHK   EJECT     DETECT AND HAMDLE ABNORMAL CONDITIONS 
*#
*0        *ERRCHK* IS A PROCEDURE TO DETECT AND HANDLE ABNORMAL 
*         CONDITIONS.  IF BITS 12-3 OF CODE AND STATUS ARE ZERO THEN WE 
*         HAVE A NORMAL SITUATION.  IT IS POSSIBLE THAT THE NORMAL
*         SITUATION WAS IMMEDIATELY PRECEDED BY A DEVICE-CAPACITY-
*         EXCEEDED CONDITION, SO WE SHALL FIRST CLEAR THE CONSOLE 
*         MESSAGE AND THE *NOSP* FLAG SHOULD THE FLAG BE ON, BEFORE 
*         RETURNING.  FOR ABNORMAL CONDITIONS CHECK CODE AND STATUS BITS
*         12-8 FOR THE FOLLOWING: 
*         END-OF-VOLUME --- CALL *CLSV$SQ*
*         DEVICE-CAPACITY-EXCEEDED --- IF THE *NOSP* FLAG IS OFF THEN 
*                                  SET THE FLAG AND NOTIFY THE OPERATOR 
*                                  VIA CONSOLE MESSAGE. GO INTO 
*                                  PERIODIC RECALL FOR HALF SECOND. 
*                                  RE-ISSUE THE LAST REQUEST WITH AUTO- 
*                                  RECALL AND GO BACK TO START OF 
*                                  PROCEDURE. 
*         PARITY-ERROR --- ISSUE ERROR 140. 
*#
 ERRCHK   BSS       0 
          SA2       A0             LOAD CODE AND STATUS WORD
          MX4       47
          BX1       -X4*X2
          AX1       9              ISOLATE BITS 13-9
          NZ        X1,ER2         IF SOME KIND OF ERROR IS EVIDENT 
          ON.RM     NOSP,ER1       IF WE NEED TO CLEAR CONSOLE DISPLAY
          JP        B6             RETURN 
          SPACE     1 
 ER1      BSS       0 
          SET.RM    NOSP,#NO#      CLEAR THE NO-SPACE FLAG
          MESSAGE   BLNKMSG        CLEAR THE NO-SPACE MESSAGE 
          JP        B6             RETURN 
          SPACE     1 
 ER2      BSS       0 
          SB5       X1-#CSEOI#
          NZ         B5,CHKEOV
          JP         B6            IF EOI, RETURN 
CHKEOV    BSS       0 
          SB5       X1-#CSEOV#     END-OF-VOLUME
          NZ        B5,ENDV 
          SET.RM    PIN,B2
          SAVE
          CLSV$SQ   PUT            CLOSE VOLUME 
          RESTORE 
          F.RM      PIN,B2
          EQ        ERRCHK         RECHECK FOR ERRORS DURING CLSV 
 ENDV     BSS 
          SB5       X1-#CSPAR#     PARITY ERROR 
          SX6       140B
          ZR        B5,=YERR$RM 
          SB5       X1-#CSDCE#     DEVICE-CAPACITY-EXCEEDED 
          SX6       721B+1S17 
          NZ        B5,=YERR$RM    OTHER SCOPE ERROR
 .OS      IFC       EQ,/"OS.NAME"/KRONOS/ 
          SA1       A0+6
          SB5       X1-#DESTL#
          NZ        B5,=YERR$RM    NOT TRACK LIMIT
 .OS      ENDIF 
          ON.RM     NOSP,ER3       IF NO-SPACE MESSAGE ALREADY ISSUED 
          SET.RM    NOSP,#YES#
          MESSAGE   NOSPACE        DISPLAY NO SPACE MESSAGE ON CONSOLE
 ER3      BSS       0 
          RCL.RM    A0,PERIODIC,3777B  WAIT 100 MILLISECONDS
          SA1       A0             FIRST WORD OF FET
          SX2       774B           CODE AND STATUS MASK 
          BX4       X1*X2          ISOLATE LAST CIO CODE (WRITE/WRITEN) 
          SYSY      X4,RECALL      RE-ISSUE LAST REQUEST (AUTO-RECALL)
          EQ        ERRCHK         TRY AGAIN
 WRAPUP   EJECT     TERMINATE RECORD AND KEEP THE I/O GOING 
*#
*0        *WRAPUP* IS A PROCEDURE TO TERMINATE A RECORD AND ENSURE THAT 
*         IT IS WRITTEN FROM THE BUFFER TO THE DEVICE.  FIRST SET *FP*
*         TO END-OF-RECORD AND INCREMENT *RC*.
*         IF THIS IS AN S/L DEVICE STORE THE S/L CONTROL WORD INTO THE
*             BUFFER PRECEDING THE RECORD AND SET *IN* EQUAL TO *PIN*.
*             NOW IF THE I/O HAS STOPPED CALL *ERRCHK* TO HANDLE ANY
*             ABNORMAL CONDITIONS, THEN ISSUE READN WITH PERIODIC 
*             RECALL TO START THE I/O GOING.  RETURN TO CALLER. 
*         IF THIS IS A PRU DEVICE, WAIT FOR THE I/O TO STOP, CALL 
*         *ERRCHK* TO HANDLE ANY ABNORMAL CONDITIONS, AND ISSUE A WRITER
*         WITH AUTO-RECALL TO TERMINATE THE RECORD.  RETURN TO CALLER.
*#
 WRAPUP   BSS       0 
          SAVE
          SET.RM    FP,#EOR#       END-OF-RECORD
          INC.RM    RC,1           INCREMENT RECORD COUNT 
          OFF.RM    SOL,WR3        IF SCOPE DEVICE
          F.RM      BCC,B5
          EQ        B5,B0,WRBCC0   IF BCC=0, SET B2=NEXT WD IN BUFR 
          BUFINC    B,2,1,2 
          SB2       X2
 WRBCC0   BSS       0 
          F.RM      IN,B4          THE TRUE IN POINTER
          BUFSP     B,4,2,2        RLW = PIN-IN (LENGTH OF RECORD)
          SX4       B5             BCC
          SX1       10
          MX3       59             -1 
          ZR        X4,WR1         IF CHAR. POS. ZERO, LAST WORD FULL 
          IX1       X1-X4          UNUSED CHARACTERS
          IX4       X1+X1          *6 
          LX1       2 
          IX4       X1+X4 
 WR1      BSS       0 
          OFF.RM    B8F,WR1B       CHECK FOR 8-BIT ROUNDING (DOWN)
          BX7       -X3*X2         ISOLATE WORD PAIR BIT
          AX4       2              DIVIDE UBC BY 4
          IX4       X4+X7          ADD ONE IF CHARS 8-15
          BX4       X3*X4          ROUND DOWN (TO *8) 
          IX4       X4-X7          ADD ONE IF EXCESS CHARS 1-7
          IX4       X4-X3           ..
          LX4       2              RESTORE UBC
 WR1B     LX4       24             POSITION UBC 
          BX7       X4+X2          WORD AND UNUSED BITS 
          IX7       X7+X3          SUBTRACT SLCW FROM RECORD LENGTH 
          SA7       B4+0           STORE S/L CONTROL WORD IN BUFFER 
          SB4       WR1A
          EQ        PTLOOP         ENSURE THAT *IN " *OUT*
 WR1A     BSS       0 
          SET.RM    IN,B2          IN = PIN 
          OFF.RM    CMPLT,WR7      IF I/O STILL GOING 
          SB6       WR2 
          EQ        ERRCHK         CHECK FOR ERRORS 
 WR2      BSS       0 
          SX5       264B           WRITEN CIO CODE
          EQ        WR6 
          SPACE     1 
 WR3      BSS       0 
          F.RM      BCC 
          ZR        X1,WR3A        IF BCC=0, ELSE 
          BUFINC    B,2,1,2 
          SET.RM    IN,X2          SET INTO WRITE PARTIAL WORD
 WR3A     BSS       0 
          ON.RM     CMPLT,WR4      IF NOT BUSY
          RCL.RM    A0,AUTO        WAIT FOR I/O TO STOP 
 WR4      BSS       0 
          SB6       WR5 
          EQ        ERRCHK         CHECK FOR ERRORS 
 WR5      BSS       0 
          SX5       24B            WRITER CIO CODE
 WR6      BSS       0 
          SYSY      X5             START THE I/O
 WR7      BSS       0 
          SET.RM    TRM,0          CLEAR PUTP-TERMINATE FLAG
          RESTORE 
          JP        B6             RETURN 
* END /PUTDS/ 
