          IDENT  DSMLTI
          TITLE  DSMLTI - COMMON IO ROUTINES FOR BINARY LABELLED TAPE.
         COMMENT COMMON IO ROUTINES FOR BINARY LABELLED TAPE SUPPORT.
          SYSCOM
          ENTRY  PXIOOLT
          ENTRY  PX#TRTS
          ENTRY  BI#OLT
          ENTRY  BI#PUTT
          ENTRY  BI#WEFT
          EXT    DSV#DEN
          EXT    DSV#VSN
          SPACE  2
*** THIS MODULE CONTAINS VARIOUS 170 ASSEMBLY LANGUAGE ROUTINES TO PROVIDE
* THE INTERFACES FOR WRITING S LABELLED TAPES FROM CYBIL.  THESE ROUTINES
* WERE TAKEN FROM THE STANDARD CYBIL IO ROUTINES AND MODIFIED TO WRITE S
* TAPES.  THE ONLY SUPPORT PROVIDED IS TO OPEN THE TAPE, REWIND IT AND
* WRITE ON IT.  THE CYBIL_CC INTERFACES THAT SHOULD BE USED FOR WRITING S
* TAPES ARE THE FOLLOWING:
*         BI#OLT             * OPEN LABELLED S TAPE.
*         BI#PUT_TAPE        * WRITE DATA TO TAPE.
*         BI#WEOF_TAPE       * FLUSHES THE BUFFER AND WRITES EOF.
*         BI#CLOSE
*
          SPACE  2
*COPYC ZIOCOMM
C.WRITEN  EQU    264B        * WRITE NONSTOP ON S TAPE.
          SPACE  4
*** PXIOOLT - COMMON OPEN LABELLED TAPE BINARY FILE ROUTINE
*          PXIOOLT DOES THE FOLLOWING FOR BINARY FILE TYPES -
*   1)  CHECK LOGICAL FILE NAME
*   2)  CHECK IF OPEN FUNCTION LEGAL
*   3)  BUILD STANDARD 16-WORD FET
*   4)  REQUEST CIO BUFFER SPACE
*   5)  ISSUE *LFM* LABELLED TAPE REQUEST.
*   6)  ISSUE CIO OPEN FILE CALL
*
*   ANY ERROR CONDITION CAUSES JOB TO BE ABORTED.
*
*   ENTRY CONDITIONS
*     B1   1
*     B2   POINTER TO CURRENT STACK FRAME
*     B3   STACK LIMIT
*     X1   ADDRESS OF ADDRESS OF FILE DESCRIPTOR
*     X2   FILE STATUS (0 = NEW, 1 = OLD)
*     X3   FILE MODE (0 = IN, 1 = OUT, 2 = IN AND OUT)
*     X4   FILE POSITION (0 = FIRST, 1 = ASIS, 2 = LAST, 3 = NULL)
*     B5   POINTER TO LOCAL FILE NAME STRING POINTER
*     B4   ADDRESS OF CONTROL WORD AND OPEN CODE TABLE
*     DSV#DEN - VARIABLE CONTAINING TAPE DENSITY.
*     DSV#VSN - VARIABLE CONTAINING TAPE VSN.
*
*   EXIT CONDITIONS     (IF FILE NAME IS NOT NULL$)
*     B1   AS ON ENTRY
*     B2   AS ON ENTRY
*     B3   AS ON ENTRY
*     X1   ADDRESS OF FILE DESCRIPTOR
*     PX#TRTS - TAPE REQUEST STATUS, = 0 IMPLIES NORMAL AND
*          NOT EQUAL 0 IMPLIES ABNORMAL.
*
*   EXIT CONDITIONS     (IF FILE NAME IS NULL$)
*     B1   AS ON ENTRY
*     B2   POINTER TO CALLER'S STACK FRAME
*     B3   STACK LIMIT
*     X1   PROCEDURE LINKAGE WORD
*     PX#TRTS - TAPE REQUEST STATUS, = 0 IMPLIES NORMAL AND
*          NOT EQUAL 0 IMPLIES ABNORMAL.
*
*   NOTE
*          RETURN IS DIRECTLY TO THE CALLER OF THE
*          'FILE TYPE SPECIFIC' OPEN ROUTINE WITH THE
*          FILE POINTER VARIABLE SET TO NIL.
*          THIS ROUTINE WAS TAKEN FROM THE CYBIL IO ROUTINES AND
*          MADE TO WORK FOR WRITING *S* FORMAT LABELLED TAPES IN
*          BINARY MODE ONLY.
*
          SPACE  4
NULL$     VFD    18/0,42/5LNULL$
          SPACE  4
PXIOOLT   EQ     *+1S17      * ENTRY/EXIT

* EQUATE FILE POSITION = 3 TO 1

          SX4    X4-3        * DECREMENT FP BY THREE
          NZ     X4,FPORDOK  * IF NOT ZERO JUST RESTORE
          SX4    -2          * OTHERWISE CHANGE TO NEG TWO
FPORDOK   BSS    0
          SX4    X4+3        * RESTORE TO ORG VALUE, MOSTLY

          SA5    B4+X3       * GET FILE CONTROL WORD
          BX6    X5          *   AND STORE IT IN
          SA6    B2+B1       *   WORD 1 OF STACK FRAME
          BX5    X2          * COMPUTE INDEX OF OPEN CODE WORD
          LX2    3           *   = (STATUS*9)+(MODE*3)+POSITION
          IX6    X2+X5       *
          LX5    X3,B1       *
          IX5    X3+X5       *
          IX6    X6+X5       *
          IX6    X6+X4       *
          SX6    X6+B4       * GET OPEN CODE WORD
          SA5    X6+3        *
          SX6    X1          * SAVE ADDR OF ADDR OF FILE DESCRIPTOR
          BX7    X5          * SAVE OPEN CODE WORD
          SA6    A6+B1       *   WORD 2 OF STACK FRAME
          SA7    A6+B1       *   WORD 3 OF STACK FRAME

* CONVERT LOGICAL FILE NAME STRING TO DISPLAY CODE
          SX1    A7+B1       * RETURN NAME IN WORD 4 OF STACK FRAME
          CALL   =XZUTPSFN   *
          SA4    B2+4        * GET DISPLAY CODE FILE NAME
          SX2    B1
          NZ,X4  NOERR1
          CALL   =XPXIOERR   * BAD (EMPTY) FILE NAME   ERROR
NOERR1    BSS    0
          SA5    NULL$       * CHECK FOR SPECIAL FILE NAME
          BX5    X4-X5       *
          ZR,X5  NULLFILE    * BRANCH IF FILE NAME IS NULL$
          SX1    B2+4-FD.LFN * FAKE FILE ADDRESS
          LX4    18          * ALIGN LOGICAL FILE NAME
          SX3    3           * SET BINARY MODE, COMPLETION BITS
          BX6    X4+X3
          SA6    A4          * SAVE LOGICAL FILE NAME/FUNCTION WORD
          SA5    A4-B1       * RESTORE OPEN CODE WORD
          SX2    B1+B1       * CHECK FOR ILLEGAL (-1) OPEN FUNCTION
          SX7    X5          *
          ZR,X7  NOERR2
          PL,X7  NOERR2
          CALL   =XPXIOERR   *   ERROR EXIT FOR ILLEGAL OPEN REQUEST
NOERR2    BSS    0

* ALLOCATE FILE DESCRIPTOR
          SX2    FD.END+1    * SET DESCRIPTOR LENGTH
          MX3    0           * NO MEMORY GROUP
          RJ     =XCIL#ALF   * ALLOCATE MEMORY
          SX7    X1          * FWA OF DESCRIPTOR ALLOCATED
          MX2    0           * ERR CODE - NOT ENOUGH MEMORY FOR DESC.
          SX1    B2+4-FD.LFN * FAKE FILE ADDRESS
          SX4    X7-NIL
          NZ,X4  NOERR3
          CALL   =XPXIOERR   * DESCRIPTOR COULD NOT BE ALLOCATED
NOERR3    BSS    0
          SA3    B2+B1       * RESTORE FILE CONTROL WORD
          SA1    A3+B1       * RESTORE ADDR OF ADDR OF FILE DESCRIPTOR
          SA7    X1          * STORE ADDRESS OF FILE DESCRIPTOR
          SX1    X7
          SA4    B2+4        * GET LOGICAL FILE NAME/FUNCTION WORD
          BX7    X3
          BX6    X4
          SA7    X1          * STORE CONTROL WORD IN 1ST WORD OF DESC.
          SA6    X1+B1       * STORE IN FET+0

          SA0    A6          * SAVE POINTER TO FET

* ALLOCATE BUFFER AND STORE BUFFER DESCRIPTION INTO FET
          SA2    PX#IOBS     * GET CIO BUFFER SIZE
          MX3    0           * NO MEMORY GROUP
          RJ     =XCIL#ALF   * ALLOCATE MEMORY
          SX7    X1          * FWA OF BUFFER SPACE ALLOCATED
          MX2    0           * ERR CODE - NOT ENOUGH MEMORY FOR BUFFER
          SX1    A0-B1       * RESTORE FILE ADDRESS
          SX4    X7-NIL
          NZ,X4  NOERR4
          CALL   =XPXIOERR   * BUFFER COULD NOT BE ALLOCATED
NOERR4    BSS    0
          SX6    10B
          LX6    18          * MAKE IT 16B WORD FET
*IF ($string($name(wev$target_operating_system))='NOS')
          MX2    1
          BX7    X7+X6
          LX2    44+1        * SET ERROR PROCESSING BIT FOR *LFM*
          BX7    X7+X2
*ELSE
          BX7    X7+X6
*IFEND
          SA7    A0+B1       * STORE FIRST POINTER

          SX7    X7
          SA7    A7+B1       * STORE IN POINTER
          SA7    A7+B1       * STORE OUT POINTER
          SA2    PX#IOBS     * CALCULATE LIMIT
          IX7    X7+X2
          SA7    A7+B1       * STORE LIMIT

* CLEAR REMAINDER OF FILE DESCRIPTOR
          MX7    0           * SET ZERO
          DUP    FD.END-FD.LAST,1
          SA7    A7+B1       * STORE INTO NEXT DESCRIPTOR WORD
*IF ($string($name(wev$target_operating_system))='NOS')

* SET UP *FET* TO REQUEST LABELLED TAPE USING *LFM* FUNCTION.

          SA4    DSV#DEN     * DUMP TAPE DENSITY
          SA2    FET10       * SET WORD 10B OF FET
          LX4    51
          BX7    X2+X4       * MERGE DUMP TAPE DENSITY
          SA7    A0+10B
          SA2    DSV#VSN      * SET *VSN* IN FET
          MX7    36
          BX7    X7*X2       * *VSN* ONLY
          SX2    A0          * FET ADDRESS
          SA7    A7+B1
          SX7    24B         * LABEL FUNCTION CODE FOR *LFM*
          RJ     =XLFM=      * ISSUE *LFM* REQUEST FOR LABELLED TAPE
          SA2    A0          * CHECK TERMINATION STATUS
          MX7    60-8
          AX2    9+1         * RIGHT JUSTIFY TERMINATION STATUS
          BX7    -X7*X2      * TERMINATION STATUS
          SA2    A0+B1       * WORD 1 OF *FET*
          MX6    1
          SA7    PX#TRTS
          LX6    44+1
          NZ     X7,PXIOOLT  * IF ABNORMAL TERMINATION STATUS
          BX7    -X6*X2      * CLEAR ERROR PROCESSING BIT
          SX6    TPPRUSZ     * SET MAXIMUM LOGICAL RECORD SIZE
          SA7    A2          * UPDATE FET
          SA6    A0+6
*ELSE

* SET UP TAPE REQUEST USING THE REQUEST MACRO

          SA2    A0          * GET FILE NAME FROM *FET*
          MX0    42          * 7 CHAR NAME MASK
          BX7    X2*X0       * MASK OUT 7 CHAR FILE NAME
          SA7    REQBLK      * SAVE FILE NAME IN REQUEST BLOCK
          SA2    DSV#VSN     * GET VSN
          MX0    36
          BX7    X2*X0       * STRIP OUT 6 CHAR VSN

* RIGHT JUSTIFY VSN BY REMOVING TRAILING BLANKS AND INSERT DISPLAY CODE ZEROS
* ON THE LEFT.

          MX0    60-6
          SX2    1R
          LX0    24
          MX6    6           * INITIALIZE MASK TO CLEAR LEFT MOST CHARACTERS
          SB4    B0          * INITIALIZE TRAILING BLANK COUNT
          LX2    24
AVSN      BSS    0
          BX4    -X0*X7      * RIGHT MOST CHARACTER
          BX4    X4-X2
          NZ     X4,AVSN5    * IF NOT A BLANK
          BX7    X0*X7       * REMOVE TRAILING BLANK
          SB4    B4+B1       * INCREMENT TRAILING BLANK COUNT
          AX7    6
          GT     B4,B1,AVSN  * IF FIRST TRAILING BLANK
          AX6    6           * EXTEND MASK TO CLEAR LEFT MOST CHARACTER
          JP     AVSN        * CHECK NEXT CHARACTER

AVSN5     BSS    0
          EQ     B4,B0,AVSN15  * IF NO TRAILING BLANKS

* ADD DISPLAY CODE ZEROS ON LEFT SIDE OF VSN.

          SX4    1R0
          BX7    -X6*X7      * VSN
          LX4    54
AVSN10    BSS    0
          SB4    B4-B1       * DECREMENT TRAILING BLANK COUNT
          BX7    X4+X7       * ADD DISPLAY CODE ZERO
          LX4    54
          GT     B4,B0,AVSN10  * IF NOT DISPLAY CODE ZERO FILLED
AVSN15    BSS    0
          SA7    REQBLK+2    * SAVE VSN IN REQUEST BLOCK
          SA4    DSV#DEN     * TAPE DENSITY
          SA2    A7-B1       * REQUEST BLOCK + 1
          BX7    X4+X2       * SET TAPE DENSITY IN REQUEST BLOCK
          SA7    A2
          REQUEST  REQBLK    * MAKE TAPE REQUEST
          SA2    REQBLK      * GET WORD WITH ERROR CODE
          MX7    60-9        * ERROR CODE MASK
          AX2    9           * POSITION ERROR CODE
          BX7    -X7*X2      * STRIP OUT ERROR CODE
          SA7    PX#TRTS     * SAVE ERROR CODE
          NZ     X7,PXIOOLT  * EXIT IF ERROR OCCURRED
          SB4    4           * NUM OF REQ BLK WORDS TO COPY TO THE *FET*
          SB6    A0+11B      * STARTING *FET* POSITION TO COPY TAPE INFO
CLI       BSS    0
          SA2    REQBLK+4    * GET REQUEST BLOCK WORD TO COPY
          BX7    X2
          SA7    B6+B4       * SAVE WORD INTO FET
          SB4    B4-B1       * DECREMENT LOOP COUNTER
          NE     B4,CLI      * MORE TO COPY
          SX6    TPPRUSZ     * SET MAXIMUM LOGICAL RECORD SIZE
          SA6    A0+6        * STORE INTO *FET*
*IFEND

* CALL CIO TO OPEN FILE AND POSITION FILE AT BEGINNING.

          SX7    X5          * SET FUNCTION CODE
          SX2    A0          * SET FET ADDRESS
          BX7    -X7         * COMPLEMENT FUNCTION CODE FOR RECALL
          RJ     =XCIO=      * OPEN FILE

          SX1    A0-B1       * RESTORE FILE DESCRIPTOR ADDR
          EQ     PXIOOLT     * EXIT

*IF ($string($name(wev$target_operating_system))='NOS')
 FET10    VFD    1/0         * DO NOT WRITE LABEL
          VFD    1/1         * LABELLED TAPE
          VFD    1/0
          VFD    1/1         * NINE TRACK TAPE
          VFD    2/0         * UNUSED
          VFD    3/0         * DENSITY (SET AT RUN TIME)
          VFD    3/0         * CONVERSION MODE

* PROCESSING OPTIONS.

          VFD    3/1         * WRITE TRAILER SEQUENCE
          VFD    1/0         * UNUSED
          VFD    1/0         * USE INSTALLATION DEFAULT
          VFD    1/0         * USE INSTALLATION DEFAULT
          VFD    1/1         * DO NOT UNLOAD TAPE AT END
          VFD    2/2         * WRITE RING REQUIRED
          VFD    1/0         * ALLOW ERROR PROCESSING
          VFD    2/0         * ABORT ON UNRECOVERED WRITE ERROR

* END OF PROCESSING OPTIONS.

          VFD    6/3         * S FORMAT
          VFD    6/0         * DEFAULT NOISE SIZE
          VFD    24/TPPRUSZ  * MAXIMUM BLOCK SIZE
*ELSE
REQBLK    VFD    60/0        * NAME/STATUS WORD
          VFD    6/0         * NOT USED
          VFD    1/0         * NORING (SET TO FALSE)
          VFD    1/1         * RING (SET TO TRUE)
          VFD    2/0         * NOT USED
          VFD    1/0         * EXTENDED LABEL (SET TO FALSE)
          VFD    1/1         * WORDS 5-9 CONTAIN LABEL
          VFD    12/0        * NOT USED
          VFD    9/0         * NOT USED
          VFD    1/0         * 2 MAG TAPE REQUEST (SET TO FALSE)
          VFD    1/1         * VSN IN WORD 3
          VFD    1/0         * USE EXISTING LABEL (SET TO FALSE)
          VFD    12/0        * NOT USED
          VFD    6/41B       * NINE TRACK TAPE
          VFD    2/2         * S DATA FORMAT
          VFD    2/1         * SI STANDARD U LABEL
          VFD    2/0         * DENSITY (SET AT RUN TIME)

* THE VSN IS RIGHT JUSTIFIED WITH DISPLAY CODE ZERO FILL.

          VFD    36/0        * VSN (RIGHT JUSTIFIED WITH DISPLAY CODE ZERO FILL)
          VFD    24/0
          VFD    60/0        * NOT USED
          VFD    60/0        * MAG TAPE FILE HEADER LABEL WORD 1
          VFD    60/0        * MAG TAPE FILE HEADER LABEL WORD 2
          VFD    60/0        * MAG TAPE FILE HEADER LABEL WORD 3
          VFD    60/0        * MAG TAPE FILE HEADER LABEL WORD 4
          VFD    60/0        * MAG TAPE FILE HEADER LABEL WORD 5
CMUR      CON    0           * SET NO COMPARE MOVE UNIT FOR *WTW=*
*IFEND
          SPACE  4
* SINCE THE FILE NAME IS NULL$, SET THE FILE DESCRIPTOR POINTER
* VARIABLE TO NIL AND RETURN TO THE CALLER OF THE 'FILE TYPE
* SPECIFIC' OPEN ROUTINE.

NULLFILE  BSS    0
          SA1    B2+2        * RESTORE ADDR OF ADDR OF FILE DESCRIPTOR
          SX6    NIL
          SA6    X1
          DONE
          EJECT
*** PX#IOBS - INTEGER CONTAINING CIO BUFFER SIZE
*          PX#IOBS INITIALLY CONTAINS THE SIZE (IN WORDS)
*   FOR CIO BUFFERS REQUESTED FOR TAPE FILES WHEN THEY ARE OPENED.
*

TPPRUSZ   EQU    1000B       * PRU SIZE FOR TAPE.
PX#IOBS   CON    TPPRUSZ*5+5+1 * BUFFER SIZE.

*** PX#TRTS - INTEGER CONTAINING *LFM* TAPE REQUEST STATUS.  THIS
*   VARIABLE CAN BE CHECKED BY THE CALLER TO DETERMINE IF THE TAPE
*   REQUEST TERMINATED NORMALLY.  A VALUE OF ZERO IMPLIES NORMAL
*   TERMINATION.
*

PX#TRTS   CON    0

          SPACE  4
*** BI#OLT - OPEN LABELLED TAPE BINARY FILE.  THIS PROCEDURE CLAIMS
*          TO SUPPORT VARIOUS FILE STATUSES, MODES AND POSITIONS BUT
*          NONE OF THESE HAVE BEEN CHECKED OUT.  THIS PROCEDURE HAS
*          BEEN CHECKED OUT WITH *NEW*, *OUTPUT* AND *FIRST*.
*
*   ENTRY CONDITIONS
*     B1   1
*     B2   POINTER TO CALLER'S STACK FRAME / TOS
*     B3   STACK LIMIT
*     X7   PROCEDURE LINKAGE WORD
*     X1   ADDRESS OF ADDRESS OF FILE DESCRIPTOR
*     X2   FILE STATUS (0 = NEW, 1 = OLD), ALWAYS NEW.
*     X3   FILE MODE (0 = IN, 1 = OUT, 2 = IN AND OUT), ALWAYS OUT.
*     X4   FILE POSITION (0 = FIRST, 1 = ASIS, 2 = LAST, 3 = NULL), ALWAYS FIRST.
*     B5   POINTER TO LOCAL FILE NAME STRING POINTER
*
*   EXIT CONDITIONS
*     B1   AS ON ENTRY
*     B2   AS ON ENTRY
*     B3   AS ON ENTRY
*     X1   AS X7 ON ENTRY
*
          SPACE  4
BI#OLT    ENTR

* EQUATE FILE POSITION = 3 TO 1

          SX4    X4-3        * DECREMENT FP BY THREE
          NZ     X4,BIOLT5   * IF NOT ZERO JUST RESTORE
          SX4    -2          * OTHERWISE CHANGE TO NEG TWO
BIOLT5    BSS    0
          SX4    X4+3        * RESTORE TO ORG VALUE, MOSTLY

* SET POINTER TO CONTROL WORD AND OPEN CODE WORD TABLE AND CALL
* LABELLED TAPE OPEN ROUTINE.

          SB4    W.CWORD
          RJ     =XPXIOOLT
          DONE

* TABLE OF CONTROL WORDS
 W.CWORD  BSS    0
          VFD    3/0,2/2,4/2,3/4,2/0,2/2,44/0
          VFD    3/7,2/1,4/2,3/4,2/0,2/1,44/0
          VFD    3/0,2/3,4/2,3/4,2/0,2/3,44/0

* TABLE OF CIO FUNCTION CODES
 W.OCODE  BSS    0
          VFD    60/-1       * ILLEGAL
          VFD    60/-1       * ILLEGAL
          VFD    60/-1       * ILLEGAL
          VFD    60/C.OWTR   * WRITE/REWIND
          VFD    60/C.OWTR   * WRITE/REWIND
          VFD    60/C.OWTR   * WRITE/REWIND
          VFD    60/C.OAR    * ALTER/REWIND
          VFD    60/C.OAR    * ALTER/REWIND
          VFD    60/C.OAR    * ALTER/REWIND
          VFD    60/C.ORDR   * READ/REWIND
          VFD    60/C.ORDNR  * READ/NO REWIND
          VFD    1/1,59/C.ORDNR * READ/NO REWIND/SKIP TO EOI
          VFD    60/C.OWTR   * WRITE/REWIND
          VFD    60/C.OWTNR  * WRITE/NO REWIND
          VFD    1/1,59/C.OWTNR * WRITE/NO REWIND/SKIP TO EOI
          VFD    60/C.OAR    * ALTER/REWIND
          VFD    60/C.OANR   * ALTER/NO REWIND
          VFD    1/1,59/C.OANR * ALTER/NO REWIND/SKIP TO EOI
WRIF$     SET    0           * REISSUE FUNCTION CODE IN FET
OPL       XTEXT  COMCWTW
          SPACE  4
*** BPT - PUT ON BINARY TAPE FILE.  THIS ENTRY POINT IS EXTERNALIZED
*         AS *BI#PUTT*.
*
*   ENTRY CONDITIONS
*     B1   1
*     B2   POINTER TO CALLER'S STACK FRAME / TOS
*     B3   STACK LIMIT
*     X7   PROCEDURE LINKAGE WORD
*     X1   ADDRESS OF FILE DESCRIPTOR
*     X2   ADDRESS OF SOURCE, FIRST WORD IS FOR TAPE BLOCK HEADER.
*          REAL DATA STARTS AT ADDRESS+1.
*     X3   LENGTH OF SOURCE (DOES NOT INCLUDE TAPE BLOCK HEADER WORD).
*
*   EXIT CONDITIONS
*     B1   AS ON ENTRY
*     B2   AS ON ENTRY
*     B3   AS ON ENTRY
*     X1   AS X7 ON ENTRY
*
*   NOTE
*          THE CALLER MUST BE AWARE THAT THE FIRST WORD AT SOURCE
*          ADDRESS IS FOR THE TAPE BLOCK HEADER.  A TAPE BLOCK
*          HEADER IS STORED THERE IN ANY CASE.  REAL DATA TO BE
*          WRITTEN SHOULD BEGIN AT ADDRESS+1.  THE LENGTH OF DATA
*          TO BE WRITTEN DOES NOT INCLUDE THE WORD FOR THE TAPE
*          BLOCK HEADER.
*
          SPACE  4
BPT       ENTR
BI#PUTT   EQU    BPT         * EXTERNALIZED ENTRY POINT NAME
          RJ     =XPXIOCOW   * INSURE FILE IS OPEN FOR WRITE

* CHECK FOR INITIAL WRITE FLAG.
          MX6    -FDC.TLTH   * MASK FOR TRANSFER LENGTH
          BX6    X6*X5       * MASK OUT PREVIOUS TRANSFER LENGTH
          BX6    X6+X3       * MERGE IN NEW TRANSFER LENGTH
          SX4    B1
          LX4    FDC.IW      * MASK INITIAL WRITE FLAG BIT
          BX7    X4*X6       * SELECT INITIAL WRITE FLAG BIT
          BX6    -X4*X5      * CLEAR INITIAL WRITE FLAG
          SA6    A5          * UPDATE CONTROL WORD
          ZR,X7  BPT5        * NOT FIRST WRITE

* PLUG CIO WRITE REQUEST CODE INTO FET
          SA4    A5+B1       * LOAD FET WORD 0
          SX6    774B
          BX6    -X6*X4      * CLEAR CIO FUNCTION CODE
          SX4    C.WRITEN    * SET WRITE NONSTOP FUNCTION CODE
          BX6    X6+X4       * INSERT WRITE FUNCTION CODE
          SA6    A4          * UPDATE FET WORD 0

* TRANSFER DATA FROM SOURCE TO FILE
BPT5      BSS    0
          SB6    X2          * OBTAIN SOURCE ADDRESS
          SB7    X3+B1       * OBTAIN SOURCE LENGTH (INCLUDE BLOCK HEADER)
          SX2    A5+B1       * OBTAIN FET ADDRESS

* CALL SYSTEM PROCESSOR TO TRANSMIT DATA. SINCE IT DESTROYS ALL B REGS
* WE FIRST SAVE THE PASCAL-X STACK REGS INTO X5 AND RESTORE THEM LATER.
* DURING THIS SAVE OPERATION WE RELY ON B2,B3>=0 (IF THAT IS WRONG WE
* ARE IN SERIOUS TROBLE ANYWAY).  SET BLOCK HEADER IN FIRST WORD OF
* BUFFER.

          SX4    B3
          SX5    B2
          LX4    18
          BX5    X5+X4
          LX5    18
BPT10     BSS    0
          SB3    1001B
          SX6    B7-B1       * BLOCK SIZE.
          SX4    B0          * REMAINING TRANSFER COUNT
          LE     B7,B3,BPT15 * IF TRANSFER COUNT .LE. PRU SIZE
          SX6    B3-B1       * BLOCK SIZE
          SX4    B7-B3       * REMAINING TRANSFER COUNT
          SB7    B3          * TRANSFER SIZE
BPT15     BSS    0
          SA6    B6          * SET BLOCK HEADER
          BX5    X5+X4       * SAVE REMAINING TRANSFER COUNT
          RJ     WTW=        * WRITE FROM SOURCE
          SB7    X5+B1       * REMAINING TRANSFER COUNT + 1
          MX6    60-18
          SB6    B6-B1       * ADDRESS FOR BLOCK HEADER
          BX5    X6*X5       * CLEAR REMAINING TRANSFER COUNT
          NE     B7,B1,BPT10 * IF TRANSFER NOT COMPLETE

* RESTORE SAVED CONTENTS OF B2 AND B3.

          AX5    18
          SB2    X5
          AX5    18
          SB3    X5

          DONE
          SPACE  4
*** BI#WEFT - WRITE EOF ON TAPE.  ALL DATA IN BUFFER IS FLUSHED FIRST.
*     WRITE THE END OF FILE MARKER ON THE ARGUMENT FILE.
*
*   ENTRY CONDITIONS
*     B1   1
*     B2   POINTER TO CALLER'S STACK FRAME / TOS
*     B3   STACK LIMIT
*     X7   PROCEDURE LINKAGE WORD
*     X1   ADDRESS OF FILE DESCRIPTOR
*
*   EXIT CONDITIONS
*     B1   AS ON ENTRY
*     B2   AS ON ENTRY
*     B3   AS ON ENTRY
*     X1   AS X7 ON ENTRY
*
          SPACE  4
* FLUSH THE BUFFER.
BI#WEFT   ENTR
          SX7    C.WRITEN    * CIO REQUEST CODE TO FLUSH BUFFER

          RJ     =XPXIOCOW   * INSURE FILE IS OPEN FOR WRITE

* SET INITIAL WRITE FLAG IN CONTROL WORD
          SX6    B1
          LX6    FDC.IW
          SX2    X1+FD.LFN   * GET FET ADDRESS
          BX6    X6+X5       * UPDATE FILE CONTROL WORD
          SA6    A5          * RESTORE CONTROL WORD IN DESCRIPTOR

* CALL CIO TO FLUSH BUFFER.
          RJ     =XCIO=

* WRITE EOF
          SX7    -C.WRITEF   * CIO REQUEST CODE FOR WRITE EOF

* CALL CIO TO WRITE END OF FILE AND RETURN.
          RJ     =XCIO=

          DONE

          END
