.PAGE
;
; MY APPOLOGIES FOR THE CODE, THE BULK OF TI WAS WRITTEN
; WHILE I WAS STILL A NOVICE
;
	.SBTTL	MACRO DEFINITIONS
;
; SYTEM MACROS USED
;
	.MCALL	QIOW$S,GLUN$S,ALUN$S,EXIT$S,QIO$
	.MCALL	WTSE$,QIOW$,DIR$,SPND$S
;
; DEFINE MACROS USED IN SUBROUTINES
;
; QMSG MACRO -- THIS MACRO SIMPLY INSERTS THE ADDRESS 
; OF THE BLOCK OF TEXT TO BE PRINTED IN R0 AND CALLS
; THE PRINT SUBROUTINE "TPMSG"
;
	.MACRO	QMSG,MSGNO,REGNO,START
	.IF	NB,REGNO
	MOV	TXDEV1(REGNO),MSGNO+START
	MOV	TXDEV2(REGNO),MSGNO+START+2
	.ENDC
	MOV	#MSGNO,R0
	CALL	TPMSG
	.ENDM
;
; TAPEIO MACRO -- THIS MACRO INSERTS THE FUNCTION CODE,
; THE LOGICAL UNIT NUMBER, THE EVENT FLAG INTO THE
; QIO BLOCK AND EXECUTES THE I/O REQUEST.
;
	.MACRO	TAPEIO,FUNCT,LUN,EFLG,IOSB,BUFFER,LEN
	MOV	#FUNCT,TAPEW+Q.IOFN
	.IF NB,LUN
	MOV	LUN,TAPEW+Q.IOLU
	.ENDC
	.IF NB,EFLG
	MOVB	EFLG,TAPEW+Q.IOEF
	.ENDC
	.IF NB,IOSB
	MOV	IOSB,TAPEW+Q.IOSB
	.ENDC
	.IF NB,BUFFER
	MOV	BUFFER,TAPEW+Q.IOPL
	.ENDC
	.IF NB,LEN
	MOV	LEN,TAPEW+Q.IOPL+2
	.ENDC
	CALL	TSIO
	.ENDM
;
; READTI MACRO -- THIS ROUTINE READS A BLOCK OF TEXT FROM THE
; USERS TERMINAL INTO THE INDICATED BUFFER
;
	.MACRO	READTI,BUFFER,LENGTH
	MOV	#IO.RVB,TERM+Q.IOFN
	MOV	BUFFER,TERM+Q.IOPL
	MOV	LENGTH,TERM+Q.IOPL+2
	DIR$	#TERM,TPERRS
	MOV	#IO.CCO,TERM+Q.IOFN
	.ENDM
;
; LABEL MACRO -- THIS MACRO SETS UP FOR THE CALL
; TO THE TAPE LABELLING SUBROUTINE "TLABEL"
;
	.MACRO	LABEL,FLAG
	MOV	FLAG,R0
	CALL 	TLABEL
	.ENDM
; 
; GETARG MACRO -- USED BY MACROS COPY AND CLEAR TO DETERMINE
; ADDRESSING TYPE OF ARGUMENTS
;
	.MACRO	GETARG,DEST,ARG1,ARG2
	MOV	ARG1,DEST
	.IF NB,ARG2
	ADD	ARG2,DEST
	.ENDC
	.ENDM
;
; COPY MACRO -- USED TO COPY A STRING FROM ONE PLACE
; TO ANOTHER, ARGUMENTS ARE ADDRESS OF FIRST STRING,
; ADDRESS OF SECOND STRING,LENGTH IN BYTES TO BE MOVED
; ALTERNATIVLY, IF THE ADDRESS OF THE FIRST OR SECOND STRING
; IS IN A REGISTER INDEX TABLE,
; THE ADDRESS WILL BE CALCULATED BY THE ROUTINE AS FOLLOWS
; ADDRESS=REGISTER CONTENTS + INDEX VALUE
; EXAMPLE     COPY #STR1,#STR2,#10.
; COPY STRING ONE TO STRING 2, TEN CHARACTERS
; EXAMPLE     COPY <R3,#20>,<R4,#2>,#5
; COPY THE STRING WHOSE ADDRESS IS POINTED TO
; BY R3+20 TO THE STRING WHOSE ADDRESS IS R4+2
; 5 BYTES IN LENGTH
; COPY DESTROYS REGISTERS 0,1,2
;
	.MACRO	COPY,STR1,STR2,LEN,?LABEL
	GETARG	R0,STR1
	GETARG	R1,STR2
	MOV	LEN,R2
LABEL:	MOVB	(R0)+,(R1)+
	SOB	R2,LABEL
	.ENDM
;
; CLEAR MACRO -- USED TO CLEAR A BYTE STRING TO A SPECIFIED
; CHARACTER.
; EXAMPLE: CLEAR  #STR1,#5.,#040
; CLEAR THE STRING WHOSE ADDRESS IS STR1 TO BLANKS FOR 5 CHARACTERS
; EXAMPLE: CLEAR  <R3,#4>,#6,#000
; CLEAR THE STRING WHOSE ADDRESS IS R3+4 TO NULLS FOR 6 BYTES
;
	.MACRO	CLEAR,STR,LEN,CHAR,?LABEL
	GETARG	R0,STR
	MOV	LEN,R1
LABEL:	MOVB	CHAR,(R0)+
	SOB	R1,LABEL
	.ENDM
;
; FORARG MACRO -- TAKES SPECIFIED ACTION IF ARGUMENT IS MISSING
; OR IS NULL
;
	.MACRO	FORARG,ARGNO,LABEL
	CMPB	#ARGNO,(R5)
	BGT	LABEL
	ZZZZZZ=ARGNO+ARGNO
	CMP	#-1.,ZZZZZZ(R5)
	BEQ	LABEL
	.ENDM
;
; ENCODE MACRO -- USED TO CONVERT A WORD OF BINNARY DATA TO ASCII
; TAKES 3 ARGUMENTS, THE ADDRESS OF THE 5 BYTE OUTPUT BUFFER,
; THE WORD TO BE ENCODED, AND OPTIONALLY A VALUE THAT IF NON-ZERO
; CAUSES NO ZERO SUPPRESSION OF THE OUTPUT DATA. IF THIS ARGUMENT
; IS ZERO OR MISSING, THEN ZEROS ARE SUPPRESSED
;
	.MACRO	ENCODE,BUFFER,NUMBER,ZERO
	MOV	BUFFER,R0
	MOV	NUMBER,R1
	.IF NB	ZERO
	MOV	ZERO,R2
	.IFF
	CLR	R2
	.ENDC
	CALL	$CBDSG
	.ENDM
	.PAGE
	.SBTTL	LOCAL SYMBOLIC OFFSET DEFINITIONS
;
; THE FOLLOWING SYMBOLS ARE LOCAL OFFSETS INTO THE
; DATA STRUCTURE MAINTAINED FOR EACH OPEN TAPE UNIT.
;
TXLUN=0		; LUN
TXBADD=2	; BUFFER ADDRESS
TXBLEN=4	; BUFFER LENGTH
TXRADD=6	; RECORD ADDRESS
TXRLEN=10	; RECORD LENGTH
TXEADD=12	; ERROR SEMAPHORE ADDRESS
TXIOS1=14	; I/O STATUS WORD 1
TXIOS2=16	; I/O STATUS WORD 2
TXBCNT=16	; ACTUAL BYTE IN BLOCK COUNT FOR TWRITE
TXNXTB=20	; ADDRESS ON NEXT BYTE IN BUFFER
TXEFLG=22	; EVENT FLAG (LOW ORDER BYTE)
TXBITS=22	; DATA BITS (SEE NEXT SECTION)
TXDEV1=24	; DEVICE NAME PART 1
TXDEV2=26	; DEVICE NAME PART 2
TXFILE=30	; FILE NUMBER
TXFLNM=32	; FILE NAME (USED WITH SL TAPES)
TXVOL=54	; VOLUME SERIAL NUMBER OF FIRST TAPE IN SET
TXBLCT=62	; BLOCK COUNT
TXVCNT=64	; VOLUME COUNT
;
TABLEN=54.	; TABLE IS 54 BYTES LONG FOR ONE ENTRY
;
; THE FOLLOWING SYMBOLS ARE THE VALUES FOR THE DATA BITS
; USED ABOVE IN "TXBITS"
;
TXTRAN=400	; TRANSLATE NEEDED ON I/O IF SET
TXXHOP=1000	; UNIT OPEN FOR READ IF NOT SET, WRITE IF SET
TXXLTM=2000	; LABELS OR LEADING TAPE MARKS IF SET ON INPUT
		; LABELS IF SET ON OUTPUT
TXXRRD=4000	; THE REREAD OPTION IS IN EFFECT ON INPUT
TX1600=10000	; THE DENSITY IS 1600 BPI IF SET
TXXIOC=100000	; A PHYSICAL I/O HAS JUST BEEN DONE ON THIS UNIT IF SET
;
	.NLIST	BEX
	.PAGE
	.SBTTL	TPTABL -- TAPE TABLE DEFINITION
;+
; TPTABL - THIS TABLE REPRESENTS THE COMMON STORAGE
;  AREA USED BY THE RSX TREAD/TWRITE TAPE ROUTINES
;
; THE STRUCTURE OF THE TABLE IS AS FOLLOWS:
;       1. N STORAGE AREAS OF TABLEN BYTES EACH, WHERE N IS THE NUMBER OF
;          TAPE DRIVES ON THE HOST SYSTEM.
;       2. A QIO BLOCK FOR TERMINAL I/O. NOTE THAT THE TERMINAL I/O
;          EVENT FLAG USED BY DEFAULT IS A FUNCTION OF BOTH THE
;               NUMBER OF TAPE DRIVES AND THE FIRST DEFAULT EVENT FLAG
;          FOR TAPE I/O. TO CHANGE THE DEFAULT VALUE FOR THE EVENT FLAG
;          REPLACE THE LINE BEGINNING "TIEVF=" IN THE USER DEFINED
;          SYMBOL SECTION WITH 'TIEVF=<YOUR VALUE>'
;       3. A QIO BLOCK FOR ASYNCHRONUS TAPE OPERATIONS
;       4. A QIO BLOCK FOR SYNCHRONUS TAPE OPERATIONS
;	5. A 2 WORD TMP. I/O STATUS BLOCK
;	6. A 1 WORD FLAG INDICATING WHICH ROUTINE WAS SELECTED
;	7. A 4 WORD LONG FORTRAN CALL SITE USED WITH EBTOAS, ASTOEB
;	8. A 2 WORD LONG WAIT FOR EVENT FLAG BLOCK
;
; THE TOTAL LENGTH OF THIS TABLE IS TABLEN BYTES * THE # OF TAPE UNITS
; PLUS 45. WORDS.
;
; THE STRUCTURE OF THE N STORAGE AREAS ASSOCIATED WITH EACH TAPE DRIVE
; IS AS FOLLOWS:
;
; WORD 1:       LOGICAL UNIT NUMBER FOR THIS ENTRY
; WORD 2:       BUFFER ADDRESS FOR THIS ENTRY
; WORD 3:       BUFFER LENGTH AS DECLARED IN TRINIT/TWINIT CALL
; WORD 4:       RECORD ADDRESS
; WORD 5:       RECORD LENGTH AS DECLARED IN TRINIT/TWINIT CALL
; WORD 6:       ADDRESS OF ERROR VARIABLE SUPPLIED BY USER
; WORD 7:       TAPE I/O STATUS RETURN BLOCK, WORD 1
; WORD 8:       I/O STATUS BLOCK, WORD 2
;               ON RETURN FROM A TAPE READ, THIS WORD CONTAINS THE #
;               OF BYTES IN THE BLOCK READ IN. THIS VALUE IS THEN
;               USED AS A COUNTER OF THE NUMBER OF BYTES REMAINING
;               TO BE READ IN THE BLOCK
;               FOR TAPE WRITES, THIS VALUE IS CLEARED INITIALY AND
;               THEN USED TO COUNT THE NUMBER OF BYTES PLACED IN THE
;               BLOCK BY TWRITE
; WORD 9:       ADDRESS OF NEXT AVAILABLE BYTE IN BLOCK BUFFER
; WORD 10:      BITS 0-7 CONTAIN EVENT FLAG NUMBER FOR THIS UNIT
;               BIT 8:   TRANSLATE REQUIRED IF THIS BIT IS SET
;               BIT 9:  UNIT OPEN FOR WRITE IF SET, READ IF NOT
;               BIT 10: LEADING TAPE MARKS ON INPUT TAPES
;		BIT 11: REREAD TAPE AT EOF (INSTEAD OF NEXT TAPE)
;               BIT 15: PHYSICAL I/O JUST COMPLETED IF SET
; WORD 11,12:   DEVICE NAME, NUMBER (ASCII)
; WORD 13:	FILE NUMBER WHICH IS OPEN
; WORDS 14-22:	FILE NAME (USED WITH SL TAPES)
; WORDS 23-25:	VOLSER OF FIRST TAPE IN SET ( USED WITH SL TAPES)
; WORD 26:	BLOCK COUNT OF PRESENT REEL OF TAPE
; WORD 27:	VOLUME MOUNTED WITHIN THE DATA SET
;
;-
TPTABL: .REPT   TABLEN*TPUNIT
        .BYTE   0
        .ENDR
TERM:   QIOW$   IO.CCO,5,TIEVF
TAPE:   QIO$    IO.RWU
TAPEW:  QIOW$   IO.RWU
IOS:
STATUS:	.WORD	0,0
TROW:
SHUTUP:	.WORD	0
FCALL:	.WORD	2,0,FCALL+6,0
WAIT:	WTSE$	1
;
	.PAGE
	.SBTTL	TRINIT - TWINIT -- INITIALIZATION ROUTINES
; TPINIT - RSX11M VERSION 3.2  FM   12/78 MODIFIED TO 3.2A 7/81
; FOR DECUS DISTRIBUTION
;
; ROUTINES TO READ AND WRITE LARGE BLOCKS OF DATA FROM
; MAGTAPE. DATA IS ASSUMED TO BE IBM FIXED LENGTH BLOCKED RECORDS.
; DATA MAY BE INPUT/OUTPUT AS EITHER ASCII OR EBCDIC.
;
	.GLOBL	TRINIT,TWINIT
;
; SET UP LOCAL STORAGE AREAS.
;
CTBITS: .WORD 0
TIBUF:
LUNBUF:	.WORD	0,0,0,0,0,0	; BUFFER FOR LUN CHARACTERISTICS
OUTNAM:
	.IF DF CHI
	.ASCII	/CHI.OUTPUT        /
	.IFF
	.ASCII	/TWRITE.OUTPUT     /
	.ENDC
	.EVEN
;
; NOTE: MESSAGE CONSTANTS ARE AT END OF THIS ROUTINE.
;
TRINIT: CLR     TROW            ; SET ROUTINE INDICATOR TO READ
        BR      ISTART
TWINIT: MOV     #1,TROW         ; SET ROUTINE INDICATOR TO WRITE
ISTART: MOV     #TPTABL,R0      ; SET ADDRESS OF TABLE
        MOV     R0,R3           ; SAVE R0
        MOV     #TPUNIT,R1      ; GET NUMBER OF TAPE DRIVES ON SYSTEM
        MOV     R1,R4           ; SAVE R1 TEMPERARILY
;
1$:     CMP     @2(R5),(R0)     ; CHECK THAT LUN NOT ALREADY USED
        BNE     2$              ; GO CHECK NEXT LUN IN TABLE
	QMSG	IMSG2		; SEND ERROR MESSAGE
        JMP     IEXIT           ; STOP THE PROGRAM
2$:     ADD     #TABLEN,R0      ; R0 NOW HAS NEXT ADDRESS IN LUN TABLE
        SOB     R1,1$           ; GO CHECK NEXT TABLE ENTRY
;
3$:     TST     (R3)            ; SEE IF ENTRY IS AVAILABLE ?
        BEQ     4$              ; IT IS, GO ENTER THE LUN
        ADD     #TABLEN,R3      ; R4 NOW HAS ADDRESS OF NEXT POS.
        SOB     R4,3$           ; IN LUN TABLE, SO GO CHECK IT
	QMSG	IMSG1		; MAXIMUM NUMBER OF UNITS IN USE
        JMP     IEXIT           ; SEND MESSAGE AND STOP PROGRAM
;
4$:	CLEAR	R3,#TABLEN,#000	; CLEAR TABLE TO NULLS
        MOV     @2(R5),(R3)     ; MOVE LUN INTO TABLE
	MOV	4(R5),TXBADD(R3)	; MOV BUFFER ADDR IN
	MOV	@6(R5),TXBLEN(R3)	; MOV BUFFER LENGTH IN
	BGE	IRECRD			; IS BUFFER LEN , 0
	MOV	@4(R5),TXBADD(R3)	; BUFFER ADDR CONTAINS BUF ADDR
	NEG	TXBLEN(R3)		; BUF LEN = -BUF LEN
;
IRECRD:	MOV	10(R5),TXRADD(R3)	; MOV RECORD ADDR IN
	MOV	@12(R5),TXRLEN(R3)	; MOV RECORD LENGTH IN
	BGE	IERD			; BUFFER LENGTH >= 0
	MOV	@10(R5),TXRADD(R3)	; REC ADDR CONTAINS REC ADDR
	NEG	TXRLEN(R3)		; REC LEN - - REC LEN
;
IERD:	MOV	14(R5),TXEADD(R3)	; GET ERROR WORD ADDR
;
IDFALT:	ADD	#DEFEVF,R4		; CALC DEFAULT EVENT FLAG
	MOVB	R4,TXEFLG(R3)		; MOV INTO TABLE
	MOV	#1,TXVCNT(R3)		; INDICATE FIRST VOLUME
	CLR	CTBITS			; CLEAR TAPE CHARACTERISTICS
	COPY	#OUTNAM,<R3,#TXFLNM>,#18. ; COPY IN DEF. FILE NAME
;
IFLNM:	FORARG	13.,IEFLGS	; SEE IF FILENAME ARGUMENT
	MOV	@34(R5),R4		; GET USER LENGTH
	BLE	IEFLGS			; <0. NO FILENAME
	CMP	#18.,R4			; CAN'T BE > 18.
	BGE	1$			; <= 18
	MOV	#18.,R4			; SET LENGTH TO 18
1$:	CLEAR	<R3,#TXFLNM>,#18.,#040	; CLEAR FILENAME TO BLANKS
	COPY	32(R5),<R3,#TXFLNM>,R4	 ; COPY IN FILENAME
;
IEFLGS:	FORARG	12.,IREWND	; SEE IF EVENT FLAG ARG
	MOVB	@30(R5),TXEFLG(R3)	; MOV IN EVENT FLAG
;
IREWND:	FORARG	11.,ILTMS		; SEE IF REREAD OPTION
	TST	@26(R5)			; SEE IF NON ZERO
	BEQ	ILTMS			; IF NOT, TAKE DEFAULT
	BIS	#TXXRRD,TXBITS(R3)	; SET REREAD BIT
;
ILTMS:	FORARG	10.,IFILES		; SEE IF LTM OPTION
	TST	@24(R5)			; NOT SELECTED IF ZERO
	BEQ	IFILES			; DITTO
	BIS	#TXXLTM,TXBITS(R3)	; SET LTM BIT
;
IFILES:	FORARG	9.,IDENS		; SEE IF FILE #
	MOV	@22(R5),TXFILE(R3)	; STORE FILE #
	DEC	TXFILE(R3)		; SET = TO FILE-1
	BLE	IDENS			; IF ,= 0, NO ACTION NEEDED
	BIT	#TXXLTM,TXBITS(R3)	; SEE IF LABEL SELECTED
	BEQ	IDENS			; NO, OKAY
	TST	TROW			; SEE IF TWRITE
	BEQ	IDENS			; NO, OKAY
	QMSG	IMSG14		; SEND ERROR MESSAGE
	JMP	IEXIT			; STOP PROGRAM
;
IDENS:	FORARG	8.,ITRANS		; SEE IF DENSITY OPTION
	CMP	#1600.,@20(R5)		; SEE IF 1600 SPECIFIED
	BNE	ITRANS			; DEFAULT TO 800
	BIS	#4000,CTBITS		; SET TAPE CHARACTERISTIC
	BIS	#TX1600,TXBITS(R3)	; SET DENSITY BIT
;
ITRANS:	FORARG	7.,ICHECK		; SEE IF TRANSLATION OPTION
	TST	@16(R5)			; NO IF ZERO
	BEQ	ICHECK			; DITTO
	BIS	#TXTRAN,TXBITS(R3)	; SET TRANSLATION BIT
;
;
; NOW CHECK THAT # BYTES IN BLOCK IS EVEN AND BLOCKSIZE
; IS GREATER THAN RECORD SIZE. ALSO, CHECK THAT THE
; SPECIFIED LUN IS NOT THAT ASSIGNED TO THE TERMINAL.
;
ICHECK: CMP     TXBLEN(R3),TXRLEN(R3)    ; COMPARE STATED BLOCK, RECORD SIZE
        BGE     1$              ; OKAY
        QMSG    IMSG11          ; PRINT 'INVALID BLOCK SIZE MESSAGE
        JMP     IEXIT           ; HALT
1$:     BIT     #1,TXBLEN(R3)	; SEE IF ODD # BYTES
        BEQ     2$              ; EVEN - OKAY
        QMSG    IMSG12          ; PRINT INVALID BLOCK SIZE MESSAGE
        JMP     IEXIT           ; HALT PROGRAM
2$:	CMP	(R3),TERM+Q.IOLU ; COMPARE TO TERMINAL LUN
	BNE	IDENT		; NOT THE SAME, OKAY
	QMSG	IMSG15		; INFORM USER OF ERROR
	JMP	IEXIT		; AND EXIT
;
; TABLE IS SET UP AT THIS POINT, NOW PRINT TRINIT,TWINIT
; IDENTIFICATION MESSAGES, REQUEST INFO
;
IDENT:  TST     TROW            ; CHECK FOR ROUTINE AS R/W
        BEQ     1$
	QMSG	IMSG3		; TWINIT MESSAGE
        BIS     #TXXHOP,TXBITS(R3)    ; SET WRITE BIT IN TABLE
        BIT     #TXTRAN,TXBITS(R3)	; SEE IF TRANSLATION
        BEQ     ITI             ; NO IF EQ
	QMSG	IMSG4		; TRANSLATION EBCDIC-ASCII
        BR      ITI             ; WRITE TRANSLATION MSG AND BR
1$:	QMSG	IMSG5		; WRITE TRINIT MESSAGE
	BIS	#100,CTBITS	; SET SOFTWARE WRITE LOCK THROUGH DRIVER
        BIT     #TXTRAN,TXBITS(R3)	; SEE IF TRANSLATION
        BEQ     ITI             ; GO TO 12$ IF NOT
	QMSG	IMSG6		; EBCDIC-ASCII
;
; NOW GET PHYSICAL DEVICE INFO FROM TI:
;
ITI:	ENCODE	#IMSG7A,(R3)	; CONVERT LUN TO ASCII
1$:	CLEAR	#TIBUF,#6,#0	; CLEAR TIBUF TO NULLS
   	QMSG	IMSG7		; GET TAPE DEV:UNIT
	READTI	#TIBUF,#6	; READ FROM TERMINAL
	TSTB	TIBUF		; SEE IF NULL REPLY
	BEQ	1$		; IF NULL, REPEATE REQUEST
        CMPB    #' ,TIBUF       ; SEE IF BLANK REPLY
        BEQ     1$              ; IF BLANK, REPEAT REQUEST
2$:     MOV     #TIBUF+2,R0     ; SET UP FOR CALL TO COTB
        CALL    $COTB           ; GET PHYSICAL UNIT NO.
        MOV     TIBUF,TXDEV1(R3); MOVE DEVICE NAME INTO TABLE
        MOV     TIBUF+2,TXDEV2(R3)	; DITTO
	ALUN$S	(R3),TIBUF,R1,TPERRS	; ASSIGN THE LUN
	GLUN$S	(R3),#LUNBUF,TPERRS	; GET LUN CHARACTERISTICS
	BITB	#36,LUNBUF+G.LUCW	; CHECK TO SEE IF VALID DEVICE
	BEQ	IOPEN		; IT IS, GO ATTACH
	QMSG	IMSG13		; SEND ERROR MESSAGE
	BR	ITI		; REQUEST ANOTHER DEVICE
;
; NOW SET UP AND OPEN THE FILE
;
IOPEN:	TAPEIO	IO.ATT,(R3),TXEFLG(R3)	; ATTACH TO DRIVE
	TAPEIO	IO.STC,,,,CTBITS	; SET TAPE CHARACTERISTICS
	TAPEIO	IO.RWD		; INSURE TAPE IS AT LOAD POINT
;
; SEE IF LEADING TAPEMARKS OR LABELS
; SPACE OVER THEM IF SO.
;
	TST	TROW		; SEE IF R OR W
	BEQ	IROW		; ROUTINE IS READ
	LABEL	#0		; CALL LABEL ROUTINE FOR OUTPUT
	CALL	TSPACE		; SPACE FILES IF NECC
	MOV	TXBADD(R3),TXNXTB(R3) ; SET TABLE UP FOR WRITE
	BR	IRET		; READY FOR RETURN
IROW:	CALL	TPLTM			; SKIP LABELS IF NECC
	CALL	TSPACE		; SPACE FILES IF NECC.
	CALL	TPREAD		; INITIATE ASYNC. READ
;
	.IF NDF 	FORTRN
IRET:   RETURN                  ; RETURN TO CALLER
	.ENDC
	.IF DF	FORTRN		; IF FORTRAN SUPPORT IS IN SYSTEM
IRET:	MOV	#LUNBUF,R5	; THEN SET UP THE ROUTINE
	MOV	#1,LUNBUF	; TPSTOP TO AUTOMATICALLY CLOSE
	MOV	#TPSTOP,LUNBUF+2 ; ALL OPEN TREAD, TWRITE UNITS
	CALL	USEREX		; WHEN A STOP STATEMENT IN A FORTRAN
	RETURN				; IS ENCOUNTERED. LUNBUF AREA IS
				; USED FOR ARGUMENT TRANSMITION
				; TO THE FORTRAN SYSTEM SUBROUTINE
				; "USEREX".
	.ENDC
;
IEXIT:  EXIT$S
;
;
; MESSAGE CONSTANTS FOR TRINIT, TWINIT MESSAGES
;
IMSG1:	.WORD	43.
        .ASCII  <15><12><12>
        .ASCII/[TPINIT]: MAXIMUM # LOGICAL UNITS IN USE/
        .EVEN
IMSG2:	.WORD	49.
        .ASCII <15><12><12>
        .ASCII/[TPINIT]: INIT ALREADY DONE FOR LOGICAL UNIT #/
        .EVEN
IMSG3:  .WORD   19.
        .ASCII <15><12><12>
        .ASCII/[TWINIT: V03.02]/
        .EVEN
IMSG4:  .WORD   39.
        .ASCII <15><12>
        .ASCII/OUTPUT TRANSLATION: ASCII TO EBCDIC/<15><12>
        .EVEN
IMSG5:  .WORD   19.
        .ASCII <15><12><12>
        .ASCII/[TRINIT: V03.02]/
        .EVEN
IMSG6:  .WORD   38.
        .ASCII  <15><12>
        .ASCII/INPUT TRANSLATION: EBCDIC TO ASCII/<15><12>
         .EVEN
IMSG7:  .WORD   55.
        .ASCII   <15><12>
        .ASCII/LOGICAL UNIT /
IMSG7A: .ASCII/      /
        .ASCII/PLEASE ENTER THE TAPE DEV-UNIT:   /
        .EVEN
IMSG11: .WORD   41.
        .ASCII <15><12><12>
        .ASCII/TRINIT-TWINIT: BLOCKSIZE < RECORD SIZE/
        .EVEN
IMSG12: .WORD   59.
        .ASCII  <15><12><12>
        .ASCII/TRINIT-TWINIT: BLOCKSIZE MUST CONTAIN AN EVEN # OF /
        .ASCII/BYTES/
;
        .EVEN
IMSG13:.WORD	46.
	.ASCII	<15><12><12>
	.ASCII/TRINIT-TWINIT: DEVICE MUST BE TAPE, REENTER/
	.EVEN
IMSG14:	.WORD	46.
	.ASCII	<15><12>/[TWINIT]: LABELS ONLY SUPPORTED FOR FILE 1/
	.ASCII	<15><12>
	.EVEN
IMSG15:	.WORD	55.
	.ASCII	<15><12>/[TPINIT]: SPECIFIED LUN CONFLICTS /
	.ASCII	/WITH TERMINAL LUN/<15><12>
	.EVEN
;
	.IF DF	FORTRN
	.PAGE
	.SBTTL  TPSTOP -- AUTOMATIC CLEANUP ROUTINE
; IF FORTRAN SUPPORT IS IN SYSTEM THEN THE FOLLOWING ROUTINE
; IS USED TO AUTOMATICALLY CLOSE ALL OPEN TREAD/TWRITE TAPE
; FILES WHEN A STOP STATEMENT IS ENCOUNTERED
;
TPSTOP:	MOV	#TPUNIT,R0	; NUMBER OF POS. OPEN UNITS
	MOV	#TPTABL,R1	; UNIT TABLE ADDRESS
1$:	MOV	#SITE,R5	; CALL SITE ADDRESS IN R5
	MOV	R0,-(SP)	; SAVE R0
	MOV	R1,-(SP)	; SAVE R1
	MOV	(R1),SITE+4	; GET LUN NUMBER IF OPEN
	BLE	3$		; IF LE THEN NOT OPEN
	BIT	#TXXHOP,22(R1)	; IF BIT 1000 ON, THEN WRITE
	BEQ	2$		; IF OFF, READ
	CALL 	WCLOSE		; CLOSE THE UNIT
	BR	3$		; GO GET NEXT LUN
2$:	CALL 	RCLOSE		; CLOSE THE UNIT
3$:	MOV	(SP)+,R1	; RESTORE R1
	MOV	(SP)+,R0	; RESTORE R0
	ADD	#TABLEN,R1	; GET ADDRESS OF NEXT LUN
	SOB	R0,1$		; GO DO IT AGAIN
	RETURN			; RETURN TO FORTRAN STOP ROUTINE
SITE:	.WORD	1
	.WORD	SITE+4
	.WORD	0
	.ENDC
	.PAGE
	.SBTTL	TSPACE -- SEARCHES TAPE FOR A SPECIFIED FILE
; TSPACE -- THIS ROUTINE IS USED TO SPACE INTO
; A TAPE IF A WRITE LOCK CONDITION EXISTS ON OUTPUT
; OR WHEN A TAPE IS FIRST OPENED FOR INPUT OR OUTPUT
;
TSPACE: TST     TXFILE(R3)	; SEE IF SPACE FILES NEEDED
	BLE	1$		; NO
	CMP	#1,TXVCNT(R3)	; SEE IF FIRST TAPE
	BNE	1$		; NO
	TAPEIO	IO.SPF,(R3),TXEFLG(R3),#STATUS,TXFILE(R3) ; SPACE FORWARD
        CMPB    #IS.SUC,STATUS  ; SEE IF SUCCESS
        BEQ     1$              ; OK, GO TO 1$
	QMSG	SMSG1,R3,20.	; INFORM USER OF ERROR
        CMPB    #IE.EOV,STATUS  ; OPEN  AT EOV ?
        BNE     2$              ; NO, THEN EOT ERROR
	QMSG	SMSG2		; INFORM USER THAT TAPE AT EOV
1$:	RETURN			; RETURN TO MAIN
2$:	QMSG	SMSG3		; BAD LUCK, FILE NOT
	EXIT$S			; FOUND, EXIT PROGRAM
;
; MESSAGE CONSTANTS FOR TSPACE
;
SMSG1:  .WORD   24.
        .ASCII  <15><12>
		        .ASCII/[TPINIT]: UNIT  /
	.ASCII/      /
        .EVEN
SMSG2:  .WORD   13.
        .ASCII/OPEN AT EOV/<15><12>
        .EVEN
SMSG3:  .WORD   19.
        .ASCII/FILE SEARCH FAILURE/
        .EVEN
	.PAGE
	.SBTTL	TPAUSE -- USED TO SUSPEND SUBROUTINES
;
; TPAUSE -- THIS SUBROUTINE IS USED TO SEND THE MESSAGE
; "TYPE RES [TASKNAME] TO RESUME" TO THE USER AND
; SUSPEND THE PROGRAM.
;
TPAUSE:	QMSG	PMSG1	; SEND RESUME INSTRUCTION TO USER
	SPND$S		; SUSPEND PROGRAM
	RETURN		; RETURN
;
PMSG1:	.WORD	35.
	.ASCII	<15><12>/TYPE "RES [TASKNAME]" TO RESUME/<15><12>
	.EVEN
	.PAGE
        .SBTTL  TREAD -- ROUTINE DOES LOGICAL TAPE READS
	.GLOBL	TREAD,RCLOSE,REWIND
;
; LOCAL STORAGE SECTION
;
YN:     .ASCII/      /          ; REPLY BUFFER
        .EVEN
NOPE:   .ASCII/NO/
YEAH:   .ASCII/YES /
        .EVEN
;
; MAIN SECTION
; FIRST, CHECK FOR VALID UNIT, ETC., IN CALL
;
REWIND:	MOV	#-1.,SHUTUP	; ROUTINE OPEN TO REWIND TAPE
	BR	RSTART		; BRANCH TO MAIN LOGIC
RCLOSE: MOV     #1,SHUTUP       ; ROUTINE OPEN TO READ CLOSE
        BR      RSTART
TREAD:  CLR     SHUTUP          ; ROUTINE OPEN TO READ
RSTART: MOV     @2(R5),R1       ; GET LUN FROM CALL
        MOV     #TPTABL,R3      ; R3 CONTAINS ADDRESS OF TABLE ENTRY
        MOV     #TPUNIT,R2      ; R2 HAS TOTAL NUMBER OF TAPE DRIVES
1$:     CMP     R1,(R3)         ; SEE IF LUN IS IN TABLE
        BEQ     2$              ; YES
        ADD     #TABLEN,R3      ; SET UP TO CHECK NEXT ENTRY
        SOB     R2,1$           ; CHECK NEXT ENTRY
        CLR     R0              ; SET UP FOR CALL TO ERROR ROUTINE
        CALL    TPERRP          ; PRINT INVALID LUN MESSAGE AND STOP
;
; CHECK TO MAKE SURE OF READ ACCESS
;
2$:     BIT     #TXXHOP,TXBITS(R3) ; MAKE SURE READ ACCESS SET
        BEQ     3$              ; OK - 3$
        MOV     #2,R0           ; SET UP FOR CALL TO ERROR ROUTINE
        CALL TPERRP             ; PRINT ERROR AND EXIT
3$:     CLR     @TXEADD(R3)     ; CLEAR ERROR VARIABLE
        TST     SHUTUP          ; SEE IF ROUTINE IS READ OR CLOSE
        BEQ     6$              ; ROUTINE IS READ
	BPL	5$    		; ROUTINE IS CLOSE
	TAPEIO	IO.KIL,(R3),TXEFLG(R3) ; ROUTINE IS REWIND, KILL IO, AND
	CMP	#1,TXVCNT(R3)	; SEE IF FIRST TAPE VOLUME
	BEQ	4$		; YES, GO REWIND TAPE AND START OVER
	TAPEIO	IO.RWU		; NO, FIRST TAPE MUST BE REMOUNTED
	QMSG	RMSG10,R3,42.	; SEND REMOUNT MESSAGE
	CALL	TPAUSE		; PAUSE PROGRAM
	MOV	#1,TXVCNT(R3)	; RESET VOLUME COUNT TO FIRST VOLUME
4$:	JMP	REWND		; GO REWIND THE TAPE
5$:	JMP	RKLOSE		; ROUTINE IS CLOSE
6$:     TST     TXBITS(R3)      ; SEE IF PHYSICAL READ JUST COMPLETE
        BMI     RWAIT           ; YES , GO TO 20
        JMP     RDEBLK          ; NO, GO DE-BLOCK A RECORD
;
; WAIT FOR I/O TO COMPLETE
;
RWAIT:  MOVB    TXEFLG(R3),WAIT+W.TSEF; SET UP EVENT FLAG FOR WAIT
        DIR$    #WAIT,TPERRS ; WAIT FOR IO TO COMPLETE
	.IIF GT,RETRY	MOV	#RETRY,R4	; SET RETRY COUNT
;
; NOW CHECK IO STATUS
;
RCIOS:  MOV     TXIOS1(R3),R2   ; GET I/O STATUS
        CMPB    #IS.SUC,R2      ; SEE IF SUCCESS
        BNE     1$              ; NO
        JMP     RTRAN           ; YES - GO TRANSLATE/DEBLOCK
1$:	CMPB	#IS.PND,R2	; NOTE: UNDER SOME SPURIOUS CONDITIONS
	BEQ	RCIOS		; IS.PND IS RETURNED ON REWIND SUBROUTINE.
				; THE ABOVE TWO LINES COMPENSATE
	.IF NDF RSXV32 ; VERSIONS BEFORE 3.2 RETURN EOT ON READ
        CMPB    #IE.EOT,R2      ; SEE IF EOT
        BNE     3$              ; NO
	TAPEIO	IO.SEC,(R3),TXEFLG(R3),#IOS; SENCE TAPE CHARACTERISTICS
        BIT     #40,IOS+2       ; SEE IF EOF ENCOUNTERED
        BEQ     2$              ; NO
        JMP     RNOTHR          ; YES, SEE IF ANOTHER REEL
2$:     JMP     RTRAN           ; NO, ASSUME FULL BLOCK READ
	.ENDC
3$:     CMPB    #IE.EOF,R2      ; CHECK FOR EOF
        BNE     4$              ; NO
        JMP     RNOTHR          ; GO SEE IF ANOTHER REEL
	.IF	GT,RETRY
4$:	TST	R4		; ERROR, SEE IF WE HAVE RETRIED
	BEQ	8$		; RETRIES EXHAUSED
	TAPEIO	IO.SPB,(R3),TXEFLG(R3),,#-1 ; BACKUP A BLOCK
	MOV	R3,R0		; CALCULATE I/O STATUS AREA ADD.
	ADD	#TXIOS1,R0	; DITTO
	TAPEIO	IO.RLB,,,R0,TXBADD(R3),TXBLEN(R3) ; REREAD BLOCK
	DEC	R4		; DECREMENT RETRY COUNT
	BR	RCIOS		; GO CHECK I/O STATUS
8$:	QMSG	RMSG5,R3,14	; PRINT TREAD ERROR IDENTIFICATION
	.IFF
4$:	QMSG	RMSG5,R3,14	; NO RETRIES, PRINT TREAD ERROR ID.
	.ENDC
        CMPB    #IE.BBE,R2      ; SEE IF BAD BLOCK ERROR
        BEQ     5$              ; IT IS, PRINT MESSAGE
        CMPB    #IE.VER,R2      ; SEE IF CRC ERROR
        BEQ     5$              ; IT IS, PRINT MESSAGE
        CMPB    #IE.DAO,R2      ; SEE IF LONG BLOCK
        BNE     7$              ; IT ISN'T, UNRECOVERABLE ERROR
        QMSG    RMSG8           ; PRINT LONG BLOCK ERROR MESSAGE
        BR      6$              ; GO PRINT ", BLOCK SKIPPED"
5$:     QMSG    RMSG7           ; PRINT "BAD BLOCK ERROR"
6$:     QMSG    RMSG9           ; PRINT ", BLOCK SKIPPED"
        CALL    TPREAD          ; READ NEXT BLOCK
        JMP     RWAIT           ; AND GO WAIT FOR COMPLETION
;
; ERROR IS NON-RECOVERABLE, PRINT ERROR IDENTIFICATION AND STOP
;
7$:     MOV     #1,R0           ; SET UP FOR CALL TO ERROR PRINT
        MOVB    R2,R1           ; SET ERROR CODE IN R1
        CALL    TPERRP          ; PRINT ERROR AND EXIT
;
; NEXT SECTION REQUEST THE USER TO SPECIFY IF ANOTHER INPUT TAPE EXITS
; AND IF SO HE IS REQUESTED TO MOUNT IT
;
RNOTHR:	BIT	#TXXRRD,TXBITS(R3); IF REREAD SWITCH IS SET
	BEQ	RQUERY		; NOT SET, ASK IF ANOTHER REEL
REWND:	TAPEIO	IO.RWD,(R3),TXEFLG(R3) ; REWIND TAPE UNIT
	MOV	#3,@TXEADD(R3)	; SEND A 3. TO USER
	CALL	TPLTM		; SPACE OVER LABELS IF NECC.
	CALL	TSPACE		; SKIP ANY FILES NOT WANTED
	CALL 	TPREAD		; READ FIRST BLOCK ON TAPE
	TST	SHUTUP		; SEE IF ROUTINE IS READ OR REWIND
	BGE	1$    		; IF READ THEN WE MUST RETURN A RECORD
	RETURN			; ELSE WE CAN RETURN
1$:	JMP	RWAIT		; GO WAIT FOR I/O TO COMPLETE
;
RQUERY: TAPEIO  IO.RWU,(R3),TXEFLG(R3) ; REWIND AND UNLOAD TAPE
1$:	CLEAR	#YN,#6,#040	; CLEAR RESPONSE BUFFER TO BLANKS
        QMSG    RMSG1,R3,16     ; PRINT 'ANOTHER TAPE ?'
	READTI	#YN,#6		; READ RESPONSE
        CMP     YN,NOPE         ; TEST FOR "NO"
        BEQ     RNO             ; "NO" FOUND
2$:     CMP     YN,YEAH         ; CHECK FIRST 2 CHARACTERS
        BNE     3$              ; NOT "YE", CANT BE "YES"
        CMPB    YN+2,YEAH+2     ; CHECK FOR "S"
        BEQ     RYES            ; "YES" FOUND
;
3$:     QMSG    RMSG2           ; PRINT 'INVALID REPLY' MESSAGE
        BR      1$              ; GO TRY AGAIN
;
; NO MORE INPUT, CLOSE OUT THE UNIT TABLE, SET EOF FLAG, DETACH UNIT
; AND RETURN TO USER
;
RKLOSE: TAPEIO  IO.KIL,(R3),TXEFLG(R3) ; KILL OUTSTANDING I/O
	TAPEIO	IO.RWU		; REWIND, UNLOAD TAPE
RNO:	QMSG	RMSG3,R3,4	; PRINT "INPUT TERMINATED"
	TAPEIO	IO.DET		; DETACH TAPE UNIT
        ALUN$S  (R3),#"SY,#0    ; SET LUN BACK TO USERS DEVICE
        BCC     1$              ; NO ERROR, SO CONTINUE
        CALL    TPERRS          ; ERROR, PRINT MESSAGE, STOP
1$:     MOV     #1,@TXEADD(R3)  ; RETURN EOF FLAG = 1
	CLEAR	R3,#TABLEN,#000	; CLEAR TABLE
	RETURN			; RETURN TO USER
;
; YES THERE IS ANOTHER INPUT REEL, SO REQUEST MOUNT, INITIATE READ
; THEN GO BACK AND WAIT
;
RYES:	QMSG	RMSG4,R3,36	; PRINT MOUNT MESSAGE
	CALL	TPAUSE		; SUSPEND PROGRAM
	INC	TXVCNT(R3)	; INCREMENT CURRENT VOLUME COUNTER
        MOV     #2,@TXEADD(R3)  ; SET ERROR FLAG TO INDICATE NEW TAPE
	TAPEIO	IO.RWD		; REWIND TAPETO LOAD POINT
	CALL	TPLTM		; SKIP LEADING TAPE MARK IF NECC.
        CALL    TPREAD          ; INITIATE
        JMP     RWAIT           ; NOW GO WAIT FOR READ TO COMPLETE
;
; PHYSICAL READ JUST SUCCESFULLY ACCOMPLISHED, CLEAR I/O DONE BIT
; AND TRANSLATE DATA IF NECESSARY
;
RTRAN:	BIC	#TXXIOC,TXBITS(R3) ; RESET I/O BIT
	MOV	TXBADD(R3),TXNXTB(R3) ; MOVE STARTING ADDRESS (RESET)
	BIT	#TXTRAN,TXBITS(R3) ; TRANSLATE NEEDED?
        BEQ     RDEBLK          ; NO, GO GET A RECORD
	MOV     #FCALL,R5	; SET UP R5
        MOV     TXBADD(R3),2(R5) ; DITTO - BUFFER
        MOV     TXBCNT(R3),FCALL+6 ; DITTO - LENGTH
        CALL EBTOAS             ; TRANSLATE
;
; DEBLOCK A RECORD
;
RDEBLK:	MOV	TXNXTB(R3),R0	; STARTING ADDR. IN BLOCK
        MOV     TXRADD(R3),R1   ; RECORD ADDRESS
        MOV     TXRLEN(R3),R2   ; RECORD LENGTH
        MOV     R2,R4           ; SAVE RECORD LENGTH
        CMP     R2,TXBCNT(R3)   ; MAKE SURE WE HAVENT OVERRUN RECORD
        BGT     3$              ; OVERRAN, PRINT MESSAGE
;
1$:     MOVB    (R0)+,(R1)+     ; MOVE A CHARACTER
        SOB     R2,1$           ; DITTO
        ADD     R4,TXNXTB(R3)   ; SET CURRENT ADDRESS UP
        SUB     R4,TXBCNT(R3)   ; SET # BYTES REMAINING DOWN
        BGT     2$              ; ALL OKAY, RETURN
        BLT     3$              ; WE OVERRAN BLOCK, PRINT MESSAGE
        CALL TPREAD             ; NEW BLOCK NEEDED
2$:     RETURN
;
3$:	QMSG	RMSG5,R3,14	; SEND "[TREAD]: DDNN"
        QMSG    RMSG6           ; "STRANGE BLOCK ERROR"
	CALL	TPREAD		; INITIATE READ OF NEXT BLOCK
	JMP	RWAIT		; GO WAIT FOR I/O TO COMPLETE
;
; MESSAGE CONSTATNTS USED BY TREAD, RCLOSE, REWIND
;
RMSG1:	.WORD	68.
        .ASCII <7><7><7><7><7><7><7><7><7><15><12><12>
        .ASCII  /     EOF-EOT ON INPUT/
        .ASCII  <15><12>/IS THERE ANOTHER INPUT REEL ?:   /
        .EVEN
RMSG2:  .WORD   37.
        .ASCII  <15><12>
        .ASCII  /REENTER RESPONSE - 'YES' OR 'NO' : /
        .EVEN
RMSG3:  .WORD   25.
        .ASCII  <15><12>
        .ASCII  /     INPUT TERMINATED/<15><12>
        .EVEN
RMSG4:  .WORD   32.
        .ASCII  <0><15><12>
        .ASCII  /MOUNT NEXT INPUT REEL ON     /
        .EVEN
RMSG5:  .WORD   15.
        .ASCII  <15><12>/[TREAD]:     /
        .EVEN
RMSG6:  .WORD   41.
        .ASCII  /STRANGE BLOCK LENGTH, SOME DATA SKIPPED/<15><12>
        .EVEN
RMSG7:  .WORD   9.
        .ASCII  /BAD BLOCK/
        .EVEN
RMSG8:  .WORD   10.
        .ASCII  /LONG BLOCK/
        .EVEN
RMSG9:  .WORD   11.
        .ASCII  /, SKIPPED/<15><12>
	.EVEN
RMSG10:	.WORD	44.
	.ASCII	<15><12>/[REWIND]:REMOUNT FIRST TAPE VOLUME ON/
	.ASCII	/     /
	.EVEN
;
	.PAGE
	.SBTTL	TPLTM -- SPACES PAST LABELS AND LEADING TAPEMARKS
;
; TPLTM -- THIS ROUTINE IS USED BY TREAD TO SKIP TAPE LABELS
; ANS LEADING TAPEMARKS IF THAT OPTION IS IN EFFECT
;
TPLTM:	BIT	#TXXLTM,TXBITS(R3) ; SEE IF LEADING TAPEMARK BIT SET
	BEQ	1$		; IF NOT, RETURN
	TAPEIO	IO.RLB,(R3),TXEFLG(R3),#IOS,TXBADD(R3),TXBLEN(R3)
	; ABOVE LINE READS ONE BLOCK
	CMPB	#IE.EOF,IOS	; SEE IF END OF FILE
	BEQ	1$		; IF EQUAL, END OF FILE FOUND
	TAPEIO	IO.SPF,,,,#1	; ELSE LOOK FOR FIRST EOF
1$:	RETURN			; RETURN TO CALLING ROUTINE
	.PAGE
        .SBTTL  TWRITE -- ROUTINE DOES LOGICAL TAPE WRITES
	.GLOBL	TWRITE,WCLOSE
;
; MAIN SECTION, CHECK TO SEE IF UNIT # IS VALID, AND IF
;       UNIT IS OPEN FOR WRITE ACCESS
;
WCLOSE:	MOV	#1,SHUTUP	; ROUTINE OPEN AS TAPE CLOSE
        BR      WSTART          ;
TWRITE: CLR     SHUTUP          ; ROUTINE OPEN AS WRITE
WSTART: MOV     @2(R5),R1       ; GET LUN FROM CALL
        MOV     #TPTABL,R3      ; R3 HAS ADDRESS OF LUN TABLE
        MOV     #TPUNIT,R2      ; R2 HAS NUMBER OF TAPE DRIVES
1$:     CMP     R1,(R3)         ; CHECK TO SEE IF LUN IN TABLE
        BEQ     2$              ; IF IT IS, GO TO 2$
        ADD     #TABLEN,R3      ; R3 HAS ADDRESS OF NEXT LUN
        SOB     R2,1$           ; GO CHECK NEXT TABLE ENTRY
        MOV     #3,R0           ; SET UP FOR CALL TO ERROR ROUTINE
        CALL    TPERRP          ; PRINT INVALID LUN AND STOP
;
; CHECK FOR WRITE ACCESS ALLOWED
;
2$:     BIT     #TXXHOP,TXBITS(R3) ; MAKE SURE WRITE ACCESS BIT SET
        BNE     3$              ; OK - 3$
        MOV     #4,R0           ; SET UP FOR CALL TO ERROR
        CALL    TPERRP          ; PRINT ERROR AND HALT
;
; SEE IF A PHYSICAL WRITE HAS JUST OCCURED
;
3$:     CLR     @TXEADD(R3)     ; CLEAR ERROR FLAG
        TST     SHUTUP          ; SEE IF CLOSE OR WRITE
        BNE     WKLOSE          ; CLOSE
        TST     TXBITS(R3)      ; CHECK I/O BIT
        BPL     WENBLK          ; I/O HASNT OCCURED, GO PUT
        CALL    WTPSUC          ; WAIT FOR COMPLETION
;
; PUT A RECORD
;
WENBLK:	MOV	TXNXTB(R3),R0	; STARTING ADDR. IN BLOCK
        MOV     TXRADD(R3),R1   ; RECORD ADDRESS
        MOV     TXRLEN(R3),R2   ; RECORD LENGTH
        MOV     R2,R4           ; SAVE RECORD LENGTH
1$:     MOVB    (R1)+,(R0)+     ; MOVE A CHARACTER
        SOB     R2,1$           ; DITTO
        ADD     R4,TXNXTB(R3)   ; SET CURRENT ADDRESS UP
        ADD     R4,TXBCNT(R3)   ; SET # BYTES IN BLOCK UP
        MOV     TXBCNT(R3),R0   ; STORE NO BYTES IN BLOCK
        ADD     R4,R0           ; SEE IF LRECL PLUS # IN BLOCK
        CMP     R0,TXBLEN(R3)   ; NOW IS > THAN BLOCK LENGTH
        BLE     2$              ; NO - RETURN
        CALL    TPWRIT          ; WRITE
2$:     RETURN                  ; RETURN TO USER
;
; THIS SECTION CLOSES (WRITES LAST BLOCK) TO TAPE
;
WKLOSE: TST     TXBITS(R3)      ; SEE IF PHYSICAL WRITE JUST DONE
        BMI     1$              ; YES - GO WAIT
        TST     TXBCNT(R3)      ; SEE IF ANY RECORDS EVER WRITTEN
        BLE     2$              ; IF NOT, JUST WRITE EOF
        CALL    TPWRIT          ; WRITE OUT LAST BLOCK
;
; WAIT FOR I/O TO COMPLETE, REWIND, UNLOAD,DETACH, CLEAR UNIT
;
1$:     CALL    WTPSUC          ; WAIT  FOR SUCCESS
2$:	LABEL	#-2.		; LABEL ROUTINE HANDLES TAPEMARKS
	TAPEIO	IO.RWU,(R3),TXEFLG(R3) ; REWIND TAPE AND SET OFFLINE
	TAPEIO	IO.DET		; DETACH TAPE DRIVE
        QMSG    WMSG1,R3,4      ; WRITE "OUTPUT TERMINATED"
        ALUN$S  (R3),#"SY,#0    ; SET LUN BACK TO USERS DEVICE
        BCC     3$              ; IF NO ERROR, PROCEED
        CALL    TPERRS          ; IF ERROR, STOP
3$:     MOV     #1,@TXEADD(R3)  ; SET ERROR FLAG
	CLEAR	R3,#TABLEN,#0	; FREE UP TABLE AREA
        RETURN                  ; RETURN TO USER
;
; WAIT SUBROUTINE, SEE IF I/O COMPLETES SUCCESFULLY
;
WTPSUC: MOVB    TXEFLG(R3),WAIT+W.TSEF ; SET UP EVENT FLAG FOR WAIT
        DIR$    #WAIT,TPERRS    ; WAIT FOR I/O TO COMPLETE
;
; CHECK TO SEE IF OPERATION COMPLETED SUCESSFULLY
;
        MOV     TXIOS1(R3),R2   ; GET I/O STATUS
        CMPB    #IS.SUC,R2      ; SEE IF SUCCESS
        BNE     1$              ; NO
        JMP     WOKAY           ; YES - GO PUT A RECORD
1$:	CMPB	#IE.WLK,R2	; SEE IF UNIT WRITE LOCKED
	BNE	WEOT		; IF NOT, THEN SOME OTHER ERROR
	TAPEIO	IO.RWU,(R3),22(R3) ; REWIND TAPE AND OFFLINE
	QMSG	WMSG4,R3,12	; SEND EOT MESSAGE TO USER
	MOV	TXNXTB(R3),TXBCNT(R3) ; BLOCK LENGTH WAS DESTROYED
				; BY IE.WLK, HOWEVER, LENGTH IS SAVED
				; BY TPWRIT ON EVERY WRITE IN 20(R3)
				; SO WE RESTORE IT HERE
	BR	WSPND		; NOW GO SUSPEND PROGRAM
;
WEOT:   CMPB    #IE.EOT,R2      ; SEE IF EOT ON WRITE
        BNE     WERROR          ; IF NOT, WE HAVE A PROBLEM
;
; EOT FOUND, BACK UP ONE BLOCK, WRITE EOF, REWIND UNLOAD
;
	TAPEIO	IO.SPB,(R3),TXEFLG(R3),,#-1. ; SPACE BACK ONE BLOCK
	LABEL	#-1		; LABEL ROUTINE HANDLES TAPEMARKS
	TAPEIO	IO.RWU,(R3),TXEFLG(R3) ; REWIND, UNLOAD TAPE
        MOV     #2,@TXEADD(R3)  ; SET FLAG TO USER INDICATING NEW TAPE
	CLR	TXBLCT(R3)	; SET BLOCK CNT TO 0 FOR NEW TAPE
	INC	TXVCNT(R3)	; SET TAPE VOL. NO. UP BY ONE
;
; PRINT MESSAGE TO MOUNT NEW TAPE
;
        QMSG    WMSG2,R3,50     ; WRITE 'MOUNT NEXT INPUT REEL'
WSPND:	CALL	TPAUSE		; SUSPEND PROGRAM
	TAPEIO	IO.RWD		; INSURE NEW TAPE AT LOAD POINT
	LABEL	#0		; WRITE VOL1 LABELS IF NECC.
	CALL	TSPACE		; SPACE FORWARD (IF VOL=1 + IE.WLK)
        CALL    TPREWT          ; REWRITE THE BLOCK (DONT TRANSLATE)
        JMP     WTPSUC          ; GO WAIT FOR DONE
;
; WE HAD A PROBLEM ON I/O
;
WERROR:	QMSG	WMSG3,R3,24	; SEND FIRST PART OF ERROR MESSAGE
        MOVB    R2,R1           ; SET UP TO CALL TPERRP
        MOV     #1,R0           ; TO PRINT ERROR CAUSE
        CALL TPERRP             ; PRINT ERROR AND STOP
;
WOKAY:	BIC	#TXXIOC,TXBITS(R3) ; RESET I/O BIT
        CLR     TXBCNT(R3)      ; RESET NO BYTES TO WRITE
        MOV     TXBADD(R3),TXNXTB(R3) ; RESET BLOCK STARTING ADDRESS
	INC	TXBLCT(R3)	; SET UP BLOCK COUNT ON SUCCESFUL OP.
        RETURN                  ; RETURN
;
; MESSAGE CONSTANTS
;
WMSG1:  .WORD   22.
        .ASCII<15><12>/     END OF OUTPUT/<15><12>
	.EVEN
WMSG2:  .WORD   42.
        .ASCII  <7><7><7><7><7><7><7><7><7><15><12><12>
        .ASCII  /MOUNT NEXT OUTPUT REEL ON     /
        .EVEN
WMSG3:  .WORD   23.
        .ASCII  <15><12>/[TWRITE-WCLOSE]:     /
	.EVEN
WMSG4:	.WORD	49.
	.ASCII	<7><7><7><7><7><7><15><12>
	.ASCII	/     OUTPUT TAPE IS WRITE LOCKED, REMOUNT/
	.EVEN
;
	.PAGE
        .SBTTL  TPRDWT -- DOES PHYSICAL I/O FOR TREAD, TWRITE
;
; TPREAD
;
TPREAD: MOV     #IO.RLB,TAPE+Q.IOFN ; SET UP FOR READ
        MOV     TXBLEN(R3),TAPE+Q.IOPL+2 ; SET BUFFER LENGTH FOR READ
;
; NEXT SECTION COMMON TO BOTH ROUTINES
;
PGO:    MOV     R3,R0           ; CALCULATE THE ADDRESS OF THE
        ADD     #TXIOS1,R0      ; I/O STATUS BUFFER
        MOV     (R3),TAPE+Q.IOLU ; MOVE IN LUN
        MOVB    TXEFLG(R3),TAPE+Q.IOEF ; MOVE IN EVENT FLAG
        MOV     R0,TAPE+Q.IOSB  ; MOVE IN ADDRESS OF STATUS BUFFER
        MOV     TXBADD(R3),TAPE+Q.IOPL ; MOVE IN ADDRESS OF BUFFER
        DIR$    #TAPE,TPERRS    ; GO DO IT
        BIS     #TXXIOC,TXBITS(R3) ; SET PHYSICAL I/O DONE BIT
        RETURN                  ; RETURN
;
; NEXT PART OF ROUTINE FOR WRITE
;
TPWRIT: BIT     #TXTRAN,TXBITS(R3) ; SEE IF BLOCK NEEDS TRANSLATION
        BEQ     TPREWT          ; NO
        MOV     #FCALL,R5       ; SET UP FOR CALL
        MOV     TXBADD(R3),2(R5) ; TO THE ASCII TO EBCDIC
        MOV     TXBCNT(R3),FCALL+6 ; CONVERSION ROUTINE
        CALL    ASTOEB          ; TRANSLATE
TPREWT: MOV     #IO.WLB,TAPE+Q.IOFN ; SET UP FOR WRITE
        MOV     TXBCNT(R3),TAPE+Q.IOPL+2 ; SET UP NUMBER OF BYTES TO WRITE
	MOV	TXBCNT(R3),TXNXTB(R3) ; SAVE BLOCK LENGTH TEMP. IN 20(R3)
				; AS IT WILL BE DESTROYED IN 16(R3)
				; IF A WRITE LOCK ERROR OCCURS
        BR      PGO             ; FINISH OUT DPB AND GO
;
; TSIO -- DOES SYNC I/O FOR ALL TAPEIO MACROS
;
TSIO:	DIR$	#TAPEW,TPERRS	; EXECUTE DIRECTIVE
	RETURN
;
	.PAGE
        .SBTTL  TPDIAG -- DIAGNOSTIC PRINT ROUTINES
	.GLOBL	TPTT
;
; LOCAL STORAGE
;
DISPCH: .WORD   DMSG2,DMSG3,DMSG4,DMSG5,DMSG7
BUFL:   .WORD   6
BUF:    .ASCII/      /
;
; TPMSG - THIS ROUTINE PRINTS MESSAGES FROM ALL OTHER
; SUBROUTINES IN THIS SYSTEM
;
TPMSG:  MOV     #TERM+Q.IOPL+4,R1 ; R1 HAS ADDRESS OF DEVICE SPECIFIC
        MOV     (R0)+,-(R1)     ; MOV IN NUMBER OF CHARACTERS
        MOV     R0,-(R1)        ; MOV IN ADDRESS OFMESSAGE
        DIR$    #TERM,TPERRS    ; PRINT MESSAGE
        RETURN
;
; TPERRS - DIRECTIVE ERROR PRINT ROUTINE
;
TPERRS:	ENCODE	#BUF,$DSW	; CONVERT ERROR CODE TO ASCII
        MOV     #BUF,R0         ; R0 HAS ADDRESS OF BUF
        MOV     (R0)+,DMSG1+106 ; MOVE INTO ERROR MESSAGE
        MOV     (R0)+,DMSG1+110 ; DITTO
        MOV     (R0)+,DMSG1+112 ; DITTO
        MOV     #IO.CCO,TERM+Q.IOFN ; INSURE THAT WE ARE SET FOR WRITE
        MOV     #DMSG1,TERM+Q.IOPL ; SET UP BUFFER ADDRESS
        MOV     #76.,TERM+Q.IOPL+2 ; LENGTH OF MESSAGE
        MOV     #60,TERM+Q.IOPL+4 ; CARRIAGE CONTROL
;
; ONE LAST TRY AT PRINTING A MESSAGE, WE WILL USE
; EVENT FLAG 1 SINCE PROGRAM WILL BE STOPPING
;
        DIR$    #TERM           ; TRY TO PRINT
        EXIT$S                  ; STOP THE PROGRAM
;
; TPERRP - PRINTS OTHER MISC. MESSAGES FOR TREAD/TWRITE
;
TPERRP: ASL     R0              ; MULTIPLY ERROR NUMBER BY 2
        MOV     R1,R4           ; SAVE R1 AS CALL TO TPMSG DESROYS R1
        MOV     DISPCH(R0),R0   ; R0 CONTAINS ADDRESS OF MESSAGE
        CALL    TPMSG           ; CALL COMMON MESSAGE PRINT ROUTINE
	ENCODE	#BUF,R4		;CONVERT ERROR CODE TO ASCII
        QMSG    BUFL            ; SEND UNIT NUMBER MESSAGE
        EXIT$S                  ; EXIT PROGRAM
;
TPTT:   MOV     @2(R5),TERM+Q.IOLU ; MOVE IN NEW LUN
        CMP     #2,(R5)         ; SEE IF 2 ARGUMENTS
        BNE     1$              ; IF NOT , RETURN
        MOV     @4(R5),TERM+Q.IOEF ; MOVE IN NEW EVENT FLAG
1$:     RETURN                  ; RETURN
;
DMSG1:  .ASCII  /TASK TERMINATING DUE TO RDTAPE-WRTAPE/
        .ASCII  / DIRECTIVE STATUS ERROR CODE OF        /
        .EVEN
DMSG2:  .WORD   42.
        .ASCII  <15><12>
        .ASCII  /TREAD-RCLOSE: INVALID LOGICAL UNIT # OF /
; TREAD OR TWRITE IDENTIFICATION FOR THE NEXT MESSAGE IS PROVIDED BY
; THE CALLING ROUTINE. THE CALLING ROUTINE ALSO SUPPLIES THE UNIT
; WHERE THE ERROR OCCURED
        .EVEN
DMSG3:  .WORD   16.
        .ASCII/MAGTAPE ERROR # /
        .EVEN
DMSG4:  .WORD   47.
        .ASCII  <15><12>
        .ASCII  /TREAD-RCLOSE:  UNIT NOT OPEN FOR READ, UNIT: /
        .EVEN
DMSG5:  .WORD   43.
        .ASCII  <12><15>
        .ASCII  /TWRITE-WCLOSE: INVALID LOGICAL UNIT # OF /
        .EVEN
DMSG7:  .WORD   48.
        .ASCII  <15><12>
        .ASCII  /TWRITE-WCLOSE: UNIT NOT OPEN FOR WRITE, UNIT: /
        .EVEN
	.PAGE
	.SBTTL	TLABEL -- ROUTINE HANDLES TAPE LABELS ON OUTPUT
;
; THIS SUBROUTINE HANDLES THE FORMATION AND WRITTING OF TAPE
; LABELS FOR THE TWRITE SUBROUTINES.
;
; REGARDING ARGUMENTS.
;	THE SUBROUTINE REQUIRES 2 ARGUMENTS AS FOLLOWS
;	REGISTER 0 (R0) CONTAINS A FLAG INDICATING HOW THE ROUTINE
;	HAS BEEN CALLED. (SEE BELOW FOR DETAILS)
;	REGISTER 3 (R3) HAS THE ADDRESS OF THE INTERNAL TAPE
;	TABLE AS PER THE CONVENTION FOR ALL ROUTINES IN THIS SYSTEM
; THE VALUE OF THE FLAG IS AS FOLLOWS:
;	0=VOL1 LABEL
;	-1=EOV LABELS
;	-2=EOF LABELS
;
; MAIN SUBROUTINE SECTION
;
TLABEL:	MOV	R0,LFLAG	; SAVE R0 IN LFLAG
	BIT	#TXXLTM,TXBITS(R3) ; SEE IF LABELS NEEDED ON TAPE
	BNE	1$		; YES
	JMP	L2EOF		; NO, THEN GO PUT TAPEMARKS IF EOT
1$:	TST	LFLAG		; SEE IF VOL1 LABEL NEEDED
	BLT	LFEOV		; NOT NEEDED, SET UP FOR EOV/EOF LABELS
;
; GET VOLSER OF TAPE FROM TI:
;
2$:	CLEAR	#LBUF,#8.,#040	; CLEAR VOLSER BUFFER TO BLANKS
	QMSG	LMSG1,R3,4	; SEND MESSAGE REQUESTING VOL-SER.
	READTI	#LBUF,#8.	; READ INFO FROM TERMINAL
	CMPB	#' ,LBUF	; INSURE NOT BLANK
	BEQ	2$		; IF BLANK, REPEAT REQUEST
;
; NOW SET UP TO FORM VOL1 LABEL
;
	COPY	#LBUF,#LVOL1+4,#6 ; COPY VOLSER INTO VOL1 LABEL
	CMP	#1,TXVCNT(R3)	; IS THIS FIRST VOLUME ?
	BNE	3$		; IF IT IS, THEN COPY THE VOLSER
	COPY	#LBUF,<#TXVOL,R3>,#6 ; INTO THE INTERNAL TAPE TABLE
3$:	MOV	#LVOL1,R4	; SET UP FOR CALL TO LSEND
	CALL	LSEND		; PUT LABEL ON TAPE
;
; SET UP TO PUT HDR1/HDR2 LABELS SINCE WE ARE AT THE BEGINING
; OF THE TAPE
;
	MOV	#"HD,LHDR1	; INSERT "HDR1" INTO HDR1 LABEL
	MOV	#"R1,LHDR1+2	; DITTO
	MOV	#"HD,LHDR2	; INSERT "HDR2" INTO HDR2 LABEL
	MOV	#"R2,LHDR2+2	; DITTO
	BR	LFHDR1		; GO FORM REST OF HDR1 LABEL
;
; IF WE ARE HERE, WE WISH TO WRITE EOV/EOF LABELS
; THIS CODE INSERT EOV1/EOV2 OR EOF1/EOF2 INTO THE
; LABEL AREAS FOR THE HDR1/HDR2 LABELS SINCE THE
; EOV1, EOV2, OR EOF1/EOF2 LABELS ARE IDENTICAL WITH
; THE HDR1/HDR2 LABELS IN EVERY OTHER RESPECT
;
LFEOV:	TAPEIO	IO.EOF,(R3),TXEFLG(R3) ; FIRST PUT TAPEMARK AFTER DATASET
	MOV	#"EO,LHDR1	; MOVE "EOV1" INTO HDR1 LABEL
	MOV	#"V1,LHDR1+2	; DITTO
	MOV	#"EO,LHDR2	; MOVE "EOV2" INTO HDR2 LABEL
	MOV	#"V2,LHDR2+2	; DITTO
	CMP	#-2,LFLAG	; SEE IF ROUTINE CALLED FOR EOF LABELS
	BNE	LFHDR1		; IF NOT THEN WE ARE READY TO LABEL
	MOVB	#'F,LHDR1+2	; TURN "EOV1" INTO "EOF1" LABEL
	MOVB	#'F,LHDR2+2	; TURN "EOV2" INTO "EOF2" LABEL
;
; THE FOLLOWING SECTION FORMS THE BODY OF THE HDR1/EOV1/EOF1
; LABELS.
;
LFHDR1:	COPY	<#TXFLNM,R3>,#LHDR1+4,#17. ; COPY FILE NAME TO LABEL
	COPY	<#TXVOL,R3>,#LHDR1+21.,#6 ; COPY VOLSER TO LABEL
	ENCODE	#LBUF,TXVCNT(R3),#1 ; ENCODE VOL-CNT INTO LBUF
	COPY	#LBUF+1,#LHDR1+27.,#4 ; COPY LOW 4 BYTES INTO LABEL
	ENCODE	#LHDR1+55.,TXBLCT(R3),#1 ; COPY # BLKS WRITTEN IN
	MOV	#LHDR1,R4		; SET UP TO CALL LSEND
	CALL	LSEND			; PUT LABEL ON TAPE
;
; THE NEXT SECTION FORMS THE HDR2/EOV2/EOF2 LABELS
;
LFHDR2:	ENCODE	#LHDR2+5,TXBLEN(R3),#1 ; ENCODE THE BLOCK LENGTH
	ENCODE 	#LHDR2+10.,TXRLEN(R3),#1 ; ENCODE THE RECORD LENGTH
	MOVB	#'2,LHDR2+15.	; SET DENSITY BYTE TO "2" (800 BPI)
	BIT	#TX1600,TXBITS(R3) ; SEE IF DENSITY REALLY IS 1600
	BEQ	1$		; NO, ALL OKAY
	MOVB	#'3,LHDR2+15.	; SET DENSITY BYTE TO "3" (1600 BPI)
1$:	MOVB	#'0,LHDR2+16.	; SET VOLUME SWITCH TO HASN'T OCCURED
	CMP	#1,TXVCNT(R3)	; SEE IF FIRST VOLUME
	BEQ	2$		; IF SO, VOLUME SWITCH HASN'T OCCURED
	MOVB	#'1,LHDR2+16.	; SET VOLUME SWITCH TO HAS OCCURED
2$:	MOV	#LHDR2,R4	; SET UP TO CALL LSEND
	CALL	LSEND		; PUT LABEL ON TAPE
;
LEOF:	TAPEIO	IO.EOF,(R3),TXEFLG(R3) ; PUT END OF FILE MARK
	CMP	#-2,LFLAG	; IF CALLED FOR EOF, WE NEED 2 EOF MARKS
	BNE	LRET		; ONLY ONE NEEDED FOR EOV/HDR LABELS
	TAPEIO	IO.EOF		; PUT SECOND EOF MARK
LRET:	RETURN			; RETURN TO CALLING ROUTINE
;
; TAPE HAS NO LABELS, SET LFLAG TO -2 TO FORCE 2 TAPEMARKS
; TO BE WRITTEN. FIRST TEST TO SEE IF THE ROUTINE HAS
; BEEN ENTERED AT THE BEGINNING OR END OF TAPE.
; IF AT THE BEGINNING, NO TAPEMARKS ARE NEEDED
;
L2EOF:	TST	LFLAG		; SEE HOW ROUTINE CALLED
	BEQ	LRET		; IF ZERO, NO TAPEMARKS NEEDED
	MOV	#-2,LFLAG	; SET LFLAG TO -2 AND BRANCH
	BR	LEOF		; TO TAPEMARK CODE
;
; SUBROUTINE LSEND -- THIS SUBROUTINE IS RESPONSIBLE FOR
; SETTING UP THE I/O FOR THE TAPE LABELS AND DOING ALL
; ERROR TESTING REQUIRED
;
LSEND:	MOV	#FCALL,R5	; SET UP FORTRAN EQUIVALENT CALL
	MOV	R4,2(R5)	; ADDRESS OF LABEL
	MOV	#80.,@4(R5)	; LENGTH OF LABEL
	MOV	R4,-(SP)	; SAVE ADDRESS OF LABEL
	CALL	ASTOEB		; TRANSLATE LABEL TO EBCDIC
	MOV	(SP)+,R4	; WE NEED ADDRESS OF LABEL, RETREIVE
1$:	TAPEIO	IO.WLB,(R3),TXEFLG(R3),#IOS,R4,#80. ; WRITE LABEL
	CMPB	#IS.SUC,IOS	; SEE IF SUCCESS
	BEQ	3$		; YES
	CMPB	#IE.EOT,IOS	; SEE IF END OF VOLUME
	BEQ	3$		; ASSUME SUCCESS
	CMPB	#IE.WLK,IOS	; IS UNIT WRITE LOCKED ?
	BNE	2$		; NO, ERROR
	TAPEIO	IO.RWU		; REWIND, OFFLINE THE TAPE
	QMSG	LMSG2,R3,12	; SEND REMOUNT MESSAGE
	CALL	TPAUSE		; SUSPEND PROGRAM
	TAPEIO	IO.RWD		; REWIND THE TAPE
	BR	1$		; REPEATE LABEL FUNCTION
;
2$:	QMSG	LMSG3,R3,12.	; SEND FATAL ERROR MESSAGE
	MOV	#1,R0		; SET UP TO CALL TPERRP TO PRINT
	MOV	IOS,R1		; MAGTAPE ERROR #N MESSAGE
	CALL	TPERRP		; CALL AND EXIT PROGRAM.
;
3$:	MOV	#FCALL,R5	; WE NEED PARTS OF THE LABEL AGAIN
	CALL	EBTOAS		; SO TRANSLATE IT BACK TO ASCII
	RETURN			; RETURN
;
; DATA STRUCTURES NEEDED BY TLABEL
;
LFLAG:	.WORD	0
LBUF:	.ASCII	/        /
	.EVEN
LVOL1:	.ASCII	/VOL1      0          /
	.ASCII	/                    /
	.IF DF CHI
	.ASCII	/CHI INC.  /
	.IFF
	.ASCII	/          /
	.ENDC
	.ASCII	/                             /
	.EVEN
LHDR1:	.ASCII	/HDR1                 /
	.ASCII	/      00010001       80001 99365/
	.ASCII	/0000000/
	.BYTE	0,0,0,0,0,0,0,0,0,0,0,0,0
	.ASCII	/       /
	.EVEN
LHDR2:	.ASCII	/HDR2F000000000020/
	.ASCII	"        /        "
	.ASCII	/    B         /
	.ASCII	/                                /
	.EVEN
	.IF NE .-LVOL1-240.
	.ERROR LABEL DATA AREA HAS BEEN CORRUPTED, EXCEEDS 240 BYTES
	.ENDC
;
; MESSAGE CONSTANTS USED BY TLABEL
;
LMSG1:	.WORD	38.
	.ASCII	<15><12>/     PLEASE ENTER THE VOL-SER NO.:  /
	.EVEN
LMSG2:	.WORD	49.
	.ASCII	<7><7><7><7><7><7><15><12>/     /
	.ASCII 	/OUTPUT TAPE IS WRITE LOCKED, REMOUNT/
	.EVEN
LMSG3:	.WORD	14.
	.ASCII	<15><12>/[LABEL]:    /
	.EVEN
	.END