;
;
;
;
	.LIST TTM,MEB
	.PSECT MOUNT
	.TITLE FTIO
;
;
;
;       PROGRAMMER: MARY ANN ESFANDIARI
;                   NASA/GODDARD SPACE FLIGHT CENTER
;                   CODE 664.0
;       DATE: 15-DEC-77
;
;
;
;
;       VERSION  01
;
;
;       MODIFICATION HISTORY:
;
;
;            MODIFIER        DATE        REASON
;          ************    ********     *********
;
;           ESFANDIARI      01-09-78      FIXED BUG IN
;                                         FREAD ROUTINE TO
;                                         RETURN 'LR'
;
;           ESFANDIARI      01-13-78      CHANGED IDEN ARGUMENT
;                                         TO MOUNT BECAUSE FPOSN
;                                         COULDN'T BE CALLED FROM
;                                         MOUNT BEFORE DCB WAS CALLED.
;
;
;
;          ESFANDIARI       01-13-78      FIXED BUG IN FPOSN ROUTINE
;                                         TO PASS CORRECT LUN TO
;                                         REWIND.
;
;
;
;          ESFANDIARI        02-22-78      FIXED PROBLEM IN FREAD 
;                                        CODE SO THAT THE RDW
;                                        DOES NOT HAVE TO BE 
;                                        INCLUDED IN THE SIZE
;                                        OF THE LRECL.
;
;
;          ESFANDIARI      02-22-78      CHANGED RETURN OF IOST
;                                       IN FREAD FROM RETURNING
;                                       ADDRESS TO RETURNING
;                                       VALUE IN REGISTER.
;
;
;
;
;
;+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
;
;
;
;          THIS PACKAGE IS A FORTRAN CALLABLE I/O PACKAGE FOR
;    THE TU16 MAGTAPE DRIVES ON THE PDP 11/70.  
;           IT PERFORMS THE FOLLOWING FUNCTIONS:
;
;              1) MCR MOUNT AND DISMOUNT WITH THE ONLY USER 
;                 INTERACTION BEING THE CONTINUE FOLLOWING
;                 THE MCR FUNCTION.
;
;              2) POSITIONING TO FILES FORWARD AND BACKWARD
;                 WITH THE OPTION OF CLOSING OUT A FILE
;                 WHEN THE PROPER ARGUMENT VALUE IS SPECIFIED.
;
;              3) READING NL OR SL TAPES.  FIXED BLOCK AS
;                 WELL AS VARIABLE BLOCK IBM 360 TAPES CAN
;                 BE READ.  UNBLOCKING OCCURS ON VB TAPES.
;                 NUMBER OF BYTES READ WILL BE RETURNED.
;
;              4) A SWAP ROUTINE IN WHICH THE BYTES ARE EXCHANGED
;                 TO BE COMPATIBLE WITH PDP WORD FORMAT.
;
;              5) A REWIND FUNCTION.
;
;              6) WRITING TAPES IN FB FORMAT ONLY.
;
;              7) A FUNCTION TO SKIP FORWARD OR BACKWARDS OVER
;                 RECORDS.
;
;              8) A FUNTION TO SKIP OVER FILES, FORWARD OR BACKWARDS.
;
;              9) EXTENSIVE ERROR REPORTING CAPABILITY.
;
;
;
;------------------------------------------------------------------------
;
;         
	.PAGE
;
;**************     DECLARATIONS     ************************************
;
;
;     GLOBAL SYMBOLS:
;                     ABORT
;                     DCB
;                     DIRERR
;                     DISMNT
;                     ENDAT
;                     FPOSN
;                     FREAD
;                     FWRITE
;                     LOCATE
;                     MOUNT
;                     REWIND
;                     SKIP
;                     SKPREC
;                     START
;                     STUFF
;                     SWABI
;                     SWAP
;                     .MOLUN
;
;
;           GLOBAL FLAGS:
;
;                          #50. CONTROLS THE READING OF PUD.
;                          IF IT IS SET, SOMEONE IS READING
;                          THE PUD AND NO ONE ELSE IS PERMITTED
;                          TO READ IT.
;
;
;                          #51. CONTROLS THE SENDING AND RECEIVING
;                          OF DATA BETWEEN THE ISOLATED TASK PUD
;                          AND THE MAIN ROUTINE PUD.
;
;                          #53. CONTROLS THE EXIT OF PUD.
;                          A SIGNIFICANT EVENT IS DECLARED ON THIS
;                          FLAG SO THAT PUD CAN EXIT WHEN THE DATA
;                          HAS BEEN RECEIVED.
;
;
;                          #52. IS USED IN THE SEND DIRECTIVE VSDA$.
;
;
;
;**************     MACROS USED     *****************************
;
;
;        1)  MACRO SET MOVES ADDRESS OF ARGUMENT TO MESSAG+M.OSTR
;
;        2)  MACRO .IRP PERFORMS PUSHES AND POPS FROM THE STACK
;
;
;****************************************************************
;
;
;
;           DIRECTIVES USED:
;
	.MCALL EXIT$S, RDEF$S, DIR$, WTSE$S, CLEF$S,GTSK$
	.MCALL QIOW$, MRKT$, RQST$, VRCD$, ALUN$,VSDA$
	.MCALL MODF$, QIOSY$,  MOUT$,SETF$S,DECL$S
	QIOSY$
	MODF$
	DSW=0
;
;
;
	.PAGE
	.SBTTL MOUNT
;*******************************************************************
;
;     	    CALL MOUNT(N,VSN,NF,LABEL,IDENS)
;
;******************************************************************
;
;
	.MACRO SET X
	MOV	#X,MESSAG+M.OSTR
	.ENDM
;
;***********
;
MOUNT::
;
;***********
;
	.IRP	X,<R0,R1,R2,R3,R4,R5>		;PUSH ON STACK
	MOV	X,-(SP)
	.ENDM
;
	CMPB	#5,(R5)				;CHECK FOR RIGHT # OF ARGS.
	BEQ	1$				;IF OK THEN TO 1$
	MOV	R5,-(SP)			;OTHERWISE ABORT  
	MOV	#ROUTE,R5
	MOV	#1,ARG1
	JSR	PC,ABORT
	MOV	(SP)+,R5
	WTSE$S	#30.,DIRERR
	EXIT$S
;
;
1$:
;
	CLEF$S	#50.,DIRERR
	CLEF$S	#51.,DIRERR
	CLEF$S	#52.,DIRERR
	CLEF$S	#53.,DIRERR
	CLR	R4				
;
;
25$:
;
	CMP	#5.,R4				;HAVE WE WAITED 30 SECONDS ?
	BNE	2$				;NO THEN TO 2$
	MOV	R5,-(SP)			;OTHERWISE ABORT
	MOV	#ROUTE,R5
	MOV	#2,ARG1
	JSR	PC,ABORT
	MOV	(SP)+,R5
	WTSE$S	#30.,DIRERR
	EXIT$S
;
;
2$:
;
	RDEF$S	#50.,DIRERR			;IS ANOTHER TASK READING PUD?
	CMP	@#DSW,#2			;IF SET, YES!!!!
	BNE	3$				;IF NOT, THEN GO ON
	DIR$	#MARK,DIRERR			;OTHERWISE MARK TIME
	INC	R4				;DO 30 ITERATIONS BEFORE ABORT
	BR	25$
;
;
3$:
;
	CLEF$S	#51.,DIRERR			;CLEAR FLAG 51 
			;FLAG 51 CONTROLS THE SENDING AND
			;RECEIVING OF DATA
	CLEF$S	#53.,DIRERR			;CLEAR FLAG 53
			;FLAG 53 CONTROLS THE EXIT OF PUD
	CLEF$S	#52.,DIRERR
	SETF$S	#50.,DIRERR			;SET FLAG 50 SO NO ONE ELSE CAN
						;READ PUD
	DIR$	#REQST,DIRERR			;REQUEST PUD IF NO ONE READING IT
	DIR$	#SND,DIRERR
	WTSE$S	#51.,DIRERR			;WAIT FOR DATA TO BE SENT
	DIR$	#RECEV,DIRERR			;THEN RECEIVE IT
	DECL$S	#53.				;PUD CAN EXIT NOW
	CLR	R3				;CLEAR A REGISTER
	TST	OFLN+4				;CHECK IF THERE ARE NO DRIVES AVAILABLE
	BEQ	5$				;IF SO THEN FALL THROUGH IMMEDIATELY
;
;
6$:
;
 	BIT	#1,OFLN+4			;TEST FIRST BIT 
	BNE	7$				;IF  SET THEN DRIVE AVAILABLE
	ASR	OFLN+4				;OTHERWISE SHIFT THE BITS
	INC	R3				;INCREMENT COUNTER
	CMP	NUMDRV, R3			;IS THIS THE LAST DRIVE TO CHECK?
	BEQ	5$				;IF YES THEN NO DRIVES AVAILABLE
	BR	6$				;OTHERWISE BRANCH TO TEST ANOTHER BIT
;
;
5$:
;
	MOV	R5,-(SP)			;ABORT BECAUSE NO DRIVES
	MOV	#ROUTE,R5
	MOV	#3,ARG1
	JSR	PC,ABORT
	MOV	(SP)+,R5
	WTSE$S	#30.,DIRERR
	EXIT$S
;
;
7$:
;
	CLR 	R4				;CLEAR A REGISTER
						;BUFFER TO R0
	MOV	#START,R2
;
;
30$:
;
	CMP	R4,R3				;HAVE WE REACHED THE DRIVE
						;WE WANT?
	BEQ	31$
	INC	R4
	ADD	#40,R2				;GO ON TO NEXT DATA BLK
	CMP	#ENDAT,R2			;AT END OF DATA BLK?
	BNE	30$
	MOV	R5,-(SP)
	MOV	#ROUTE,R5
	MOV	#4,ARG1
	JSR	PC,ABORT
	MOV	(SP)+,R5
	WTSE$S	#30.,DIRERR
	EXIT$S
;
;
31$:
;
	MOV	@2(R5),(R2)			;MOV IN LUN
	MOV	R3,20(R2)			;MOV IN UNIT NUMBER
;
;
	MOV	#0,ASSN+A.LUNU			;MOV IN UNIT NUMBER
	MOV	LUNDEV,ASSN+A.LUNA		;TO LOCATION
	MOV	@2(R5),ASSN+A.LULU		;LUN TO LOCATION
	DIR$	#ASSN,DIRERR
;
	MOV	R5,-(SP)			;PUSH R5 ON STACK
	MOV	@2(R5),R2			;SAVE LUN IN REG.
	MOV	#LINK,R5			;LINKAGE REGISTER
	MOV	R2,ILUN				;LUN TO LOCATION
	ADD	#60,R3				;FORM ASCII 0 OR 1
	MOV	#IBUF,LNK1			;SET UP ASCII STRING
	MOVB	R3,IBUF+6			;INSERT ASCII UNIT NO.
	MOV	#12.,IEFN			;FLAG FOR DONE
	JSR	PC,STUFF
	MOV	(SP)+,R5			;RESTORE R5
	WTSE$S	#12.
	TST	ISTAT+2				;TEST FOR SUCCESS OF STUFF
	BPL	13$				;IF GOOD---TO 13$
	CMP	#-1,ISTAT+2			;OTHERWISE DO ERROR STUFF
	BEQ	11$				;IF ERROR GO OUT
	CMP	#-3,ISTAT+2			;CHECK FOR OTHER ERRORS
	BEQ 	12$
;
;
11$:
;
	MOV	R5,-(SP)			;ERROR IN STUFF ROUTINE
	MOV	#ROUTE,R5
	MOV	#5,ARG1
	JSR	PC,ABORT
	MOV	(SP)+,R5
	WTSE$S	#30.,DIRERR
	EXIT$S
;
;
12$:
;
	MOV	R5,-(SP)			;ERROR IN STUFF ROUTINE
	MOV	#ROUTE,R5
	MOV	#6,ARG1
	JSR	PC,ABORT
	MOV	(SP)+,R5
	WTSE$S	#30.,DIRERR
	EXIT$S
;
;
13$:
;
	SUB	#60,R3				;RETURN TO ORIGINAL VALUE
	CLEF$S	#53.,DIRERR			;CLEAR FLAG R3
	CLEF$S	#51.,DIRERR			;CLEAR FLAG 51
	CLEF$S	#52.,DIRERR
	DIR$	#REQST,DIRERR			;ISSUE DIRECTIVE-CHECK PUD AGAIN
	DIR$	#SND,DIRERR
	WTSE$S	#51.,DIRERR			;WAIT FOR EVFL 51. TO BE SET
	DIR$	#RECEV,DIRERR			;ISSUE DIRECTIVE TO RECEV DATA
	DECL$S	#53.				;SET FLAG 53 SO PUD CAN EXIT
	CLEF$S	#50.,DIRERR			;THIS LETS ANYONE READ PUD NOW
	BIT	R3,OFLN+4			;TEST FOR ZERO---DRIVE ALLOCATED
	BEQ	14$				;
	MOV	R5,-(SP)
	MOV	#ROUTE,R5
	MOV	#40.,ARG1
	JSR	PC,ABORT
	MOV	(SP)+,R5
	WTSE$S	#30.,DIRERR
	EXIT$S
;
;
14$:
;
	MOV	4(R5),R2			;JUMP TO ABORT TO OUTPUT MESSAGE
	MOV	R2,36(R1)    ;SAVE ADDRESS OF VSN
	MOV	R5,-(SP)			;ABOUT WHICH DRIVE IS AVAILABLE.
	MOV	#ROUTE,R5
	MOV	#7,ARG1
	JSR	PC,ABORT
	MOV	(SP)+,R5
	WTSE$S #30.
	CMP	@#0,#1
	BEQ	39$
	INC	PC
;
;
39$:
;
	MOV	@2(R5),DASSN+A.LULU		;LUN TO LOC.
	DIR$	#DASSN,DIRERR
;   
	MOV	R3,ASSN+A.LUNU			;MOV IN PHYICAL DEV UNIT # 
	MOV	MMDEV,ASSN+A.LUNA
	MOV	@2(R5),ASSN+A.LULU		;MOV IN LOGICAL UNIT NUMBER
	DIR$	#ASSN,DIRERR			;ISSUE DIRECTIVE
	CMP	@#0,#1
	BEQ	34$
	INC	PC
;
;
34$:
;
;   
	CMPB	@10(R5),#116			;IS IT AN "N"?
	BEQ	44$				;IF **YES** TO 44$
	CMPB	@10(R5),#123			;IS IT AN "S"?
	BEQ	20$				;IF **YES** TO 20$
	MOV	R5,-(SP)			;OTHERWISE ABORT --BAD INPUT
	MOV	#ROUTE,R5
	MOV	#41.,ARG1
	JSR	PC,ABORT
	MOV	(SP)+,R5
	WTSE$S	#30.,DIRERR
	EXIT$S
;
;
20$:
;
	MOV	@2(R5),DENS+Q.IOLU		;MOV LOGICAL UNIT # IN
	MOV	#IO.SPF,DENS+Q.IOFN		;MOV CODE INTO FUNCTION
	MOV	#1,DENS+Q.IOPL			;PARAMTERS INTO LIST
	DIR$	#DENS,DIRERR			;ISSUE DIRECTIVE
	CMP	@#0,#1
	BEQ	44$
	INC	PC
;
;
44$:
;
	MOV	R5,-(SP)			;R5 TO STACK
	MOV	2(R5),ARG+2			;MOV ADDRESS OF LUN TO PARAMETER BLK.
	MOV	#ARG,R5				;ADDRESS TO  REGISTER
	JSR	PC,LOCATE			;JUMP TO SUBROUTINE
	MOV	(SP)+,R5			;RESTORE R5
	TST	R1				;TESTING FOR 0
	BNE	21$				;BLCK IF NOT 0
	MOV	R5,-(SP)
	MOV	#ROUTE,R5
	MOV	#10.,ARG1
	JSR	PC,ABORT
	MOV	(SP)+,R5
	WTSE$S	#30.,DIRERR
	EXIT$S
;
;
21$:
;
	CMPB	@10(R5),#116			;CHECK FOR NL
	BEQ	17$				;IF YES THEN LEAVE
						;STORAGE LOCATION ALONE
	MOV	#2,10(R1)			;MOV #2 INTO PHYSICAL FILE
;
;
17$:
	MOV	#IO.STC,DENS+Q.IOFN			;SET TAPE CHARACTERISTICS
	MOV	@2(R5),DENS+Q.IOLU		;BRING IN LUN
	CLR	DENS+Q.IOPL		;CLEAR PARAMETERS
	CMP	#800.,@12(R5)		;CHECK TAPE DENSITY
	BEQ	24$
	CMP	#1600.,@12(R5)
	BEQ	27$
	MOV	R5,-(SP)
	MOV	#ROUTE,R5
	MOV	#29.,ARG1
	JSR	PC,ABORT
	MOV	(SP)+,R5
	WTSE$S	#30.,DIRERR
	EXIT$S
;
;
27$:
;
	MOV	#4000,DENS+Q.IOPL		;MOV IN CHARAC FOR 1600
; 
;
24$:
;
	DIR$	#DENS,DIRERR
;
	MOV	@10(R5),2(R1)
	MOV	4(R5),R4
	MOV	(R4),12(R1)
	MOV	2(R4),14(R1)
	MOV	4(R4),16(R1)
	MOV	@6(R5),FLNO			;MOV FILNO TO LOCATION
	CMP	#1,FLNO				;IS IT THE FIRST FILE?
	BEQ	23$				;IF YES NO NEED TO FPOSN
;   
	MOV	R5,-(SP)			;PUSH R5 ONTO STACK
	MOV	@2(R5),LU			;MOV IN LUN
	MOV	#PNTR,R5			;POINTER TO R5
	MOVB	#122,IO				;READ OPERATION SINCE JUST SKIPPING FILES
	MOV	FLNO,NF				;ADDRESS OF FILE NO TO R2
	JSR	PC,FPOSN			;CALL FPOSN
	MOV	(SP)+,R5			;POP R5 OFF STACK
;   
;
23$:
;
	.IRP	X,<R5,R4,R3,R2,R1,R0>		;POP OFF STACK
	MOV	(SP)+,X
	.ENDM
;
	RTS PC
;
;
;
;
;
;
;
;
	.PAGE
;
;
	.SBTTL DISMNT
;
;*************************************************************************;
;
;                    CALL DISMNT(N)
;
;
;************************************************************************
;
;
;
;**************
;
DISMNT::
;
;**************
;
	.IRP	X,<R0,R1,R2,R3,R4,R5>
	MOV	X,-(SP)
	.ENDM
	CMPB	#1,(R5)				;CHECKING FOR RIGHT NUMBER OF
						;ARGUMENTS
	BEQ	1$				;OK
	MOV	R5,-(SP)
	MOV	#ROUTE,R5
	MOV	#11.,ARG1
	JSR	PC,ABORT
	MOV	(SP)+,R5
	WTSE$S	#30.,DIRERR
	EXIT$S
;
;
1$:	
;
	MOV	R5,-(SP)			;PUSH R5
	MOV	2(R5),ARG+2			;MOVE LUN TO LOCATION
	MOV	#ARG,R5				;SET UP
	JSR	PC,LOCATE			;        JUMP TO LOCATE
	MOV	(SP)+,R5			;POP R5
	TST 	R1				;TEST FOR ZERO
	BNE	2$
	MOV	R5,-(SP)			;OTHERWISE ABORT --LUN WRONG
	MOV	#ROUTE,R5
	MOV	#12.,ARG1
	JSR	PC,ABORT
	MOV	(SP)+,R5
	WTSE$S	#30.,DIRERR
	EXIT$S
;
;
2$:
;
	MOV	#IO.RWD,DENS+Q.IOFN		;CODE FOR REWIND TO ACTION
	CLR	DENS+Q.IOPL			;CLEAR PARAMETERS
	MOV	@2(R5),DENS+Q.IOLU		;MOV IN LUN
	DIR$	#DENS,DIRERR			;ISSUE DIRECTIVE
	MOV	@2(R5),DASSN+A.LULU		;MOV IN LUN
	DIR$	#DASSN,DIRERR			;ISSUE DIRECTIVE
	MOV	@2(R5),ASSN+A.LULU		;LUN TO LOCATION
	MOV	LUNDEV,ASSN+A.LUNA		;ASCII SM TO LOC
	MOV	#0,ASSN+A.LUNU			;DEVICE NUMBER TO LOC
	DIR$	#ASSN,DIRERR			;ISSUE DIRECTIVE
	MOV	R5,-(SP)			;PUSH R5
	MOV	@2(R5),R2			;SAVE LUN
	MOV	#LINK,R5			;ADDRESS OF POINTER TO R5
	MOV	R2,ILUN				;INSERT LUN
	MOV	#JBUF,LNK1
	MOV	20(R1),R4			;SAVE UNIT NUMBER IN R4
	ADD	#60,R4				;MAKE IT ASCII
	MOVB	R4,JBUF+6			;INSERT ASCII UNIT NUMBER
	MOV	#12.,IEFN			;LETS HAVE AN EVENT FLAG
	JSR	PC,STUFF			;DO STUFF COMMAND
	MOV	(SP)+,R5			;POP R5
	WTSE$S 	#12.
	TST	ISTAT+2				;TEST FOR SUCCESS
	BPL	4$				;SUCCESS! GO TO 4$
	CMP	#-1,ISTAT+2			;CHECK FOR OTHER ERRORS
	BEQ	5$
	CMP	#-3,ISTAT+2		
	BEQ	6$
5$:	
	MOV	R5,-(SP)			;ERROR IN STUFF ROUTINE
	MOV	#ROUTE,R5
	MOV	#13.,ARG1
	JSR	PC,ABORT
	MOV	(SP)+,R5
	WTSE$S	#30.,DIRERR
	EXIT$S
;
;
6$:
;
	MOV	R5,-(SP)			;ERROR IN STUFF ROUTINE
	MOV	#ROUTE,R5
	MOV	#14.,ARG1
	JSR	PC,ABORT
	MOV	(SP)+,R5
	WTSE$S	#30.,DIRERR
	EXIT$S
;
;
4$:
;
	MOV	@2(R5),DASSN+A.LULU
	DIR$	#DASSN,DIRERR			;DIRECTIVE ISSUANCE
	MOV	R5,-(SP)
	MOV	#ROUTE,R5
	MOV	#9.,ARG1
	JSR	PC,ABORT
	MOV	(SP)+,R5
	WTSE$S	#30.,DIRERR
	CLR	(R1)
	CLEF$S	#50.,DIRERR			;DO HOUSE CLEANING BEFORE LEAVING
	CLEF$S	#51.,DIRERR
	CLEF$S	#52.,DIRERR
	CLEF$S	#53.,DIRERR
;
;
;
;
	.IRP	X,<R5,R4,R3,R2,R1,R0>
	MOV	(SP)+,X
	.ENDM
	RTS	PC
;
;
;
;
;
;
;
	.PAGE
;
;
;
;
	.SBTTL FPOSN
;
;*************************************************************************;
;
;                 CALL FPOSN(IO,N,NF)
;
;
;*************************************************************************;
;
;
;**************
;
FPOSN::
;
;*************
	.IRP	X,<R0,R1,R2,R3,R4,R5>
	MOV	X,-(SP)
	.ENDM
	CMPB	#3,(R5)				;CHECK ON #OF ARGS.
	BEQ	2$
	MOV	R5,-(SP)			;OTHERWISE ABORT
	MOV	#ROUTE,R5
	MOV	#15.,ARG1
	JSR	PC,ABORT
	MOV	(SP)+,R5
	WTSE$S	#30.,DIRERR
	EXIT$S
;
;
2$:
;
	MOV	@6(R5),R4			;NF TO R4
	TST	R4				;TEST FOR INVALID
	BEQ	21$
	TST	R4
	BMI	21$
	BR	12$
;
;
21$:
;
	MOV	R5,-(SP)			;ABORT WHEN NF IS INVALID
	MOV	#ROUTE,R5
	MOV	#16.,ARG1
	JSR	PC,ABORT
	MOV	(SP)+,R5
	WTSE$S	#30.,DIRERR
	EXIT$S
;
;
12$:
;
	MOV	@4(R5),DENS+Q.IOLU		;LUN TO LOCATION
	MOV	R5,-(SP)			;R5 TO STACK
	MOV	4(R5),ARG+2
	MOV	#ARG,R5				;ADDRESS OF ARG TO R5
	JSR	PC,LOCATE			;JUMP TO LOCATE
	MOV	(SP)+,R5			;RESTORE R5
	TST	R1				;TEST FOR RETURN OF ZERO
	BNE	3$				;GO ON IF OK
	MOV	R5,-(SP)			;ABORT WHEN LUN INVALID
	MOV	#ROUTE,R5
	MOV	#17.,ARG1
	JSR	PC,ABORT
	MOV	(SP)+,R5
	WTSE$S	#30.,DIRERR
	EXIT$S
;
;
3$:
;
	CMPB	@2(R5),#127			;CHECK FOR WRITE OP
	BEQ	10$
	CMPB	@2(R5),#122			;CHECK FOR READ OP
	BEQ	4$
	MOV	R5,-(SP)			;ABORT WHEN IO IS INVALID
	MOV	#ROUTE,R5
	MOV	#18.,ARG1
	JSR	PC,ABORT
	MOV	(SP)+,R5
	WTSE$S	#30.,DIRERR
	EXIT$S
;
;
4$:
;
	MOV	#IO.SPF,DENS+Q.IOFN		;SPACE FUNCTION TO LOCATION
	MOV	@6(R5),R3				;NF TO REGISTER 2
	MOV	6(R1),R2			;LF TO REGISTER 3
	SUB	R2,R3				;SUBTRACT--NET MOVE
	CMPB	2(R1),#116			;IS IT AN NL TAPE?
	BEQ	5$				;YES TO 5$
	MUL	#3,R3				;OTHERWISE BE ABLE TO SKIP
						;OVER THE HEADER AND
						;TRAILER LABELS
;
;
5$:
;
	MOV	R3,R2
	TST	R3				;TEST FOR LE 0
	BGT	7$
	CMP	#1,@6(R5)			;IS THIS THE FIRST FILE?
	BNE	6$				;IF NOT TO 6$
	CMPB	2(R1),#116			;IF THIS IS AN NL THEN WE
						;HAVE TO GO TO REWIND WHEN
						;NF=1 BECAUSE CANT STEP 
						;BEHIND THE BOT MARK
						;DONT HAVE TO WORRY ABOUT
						;THIS FOR SL BECAUSE OF 
						;FIRST HEADER
	BNE	6$
	MOV	R5,-(SP)			;JUMP TO REWIND ROUTINE
	MOV	4(R5),ARG+2
	MOV	#ARG,R5
	JSR	PC,REWIND
	MOV	(SP)+,R5
	BR	13$
;
;
6$:
;
	DEC	R3				;MOV BEHIND FILE MARK
	MOV	R3,DENS+Q.IOPL
	DIR$	#DENS,DIRERR
	MOV	#1,DENS+Q.IOPL
	DIR$	#DENS,DIRERR
	BR	19$
;
;
7$:	
;
	MOV	R3,DENS+Q.IOPL			;FILL PARAMETERS
	DIR$	#DENS,DIRERR			;ISSUE DIRECTIVE
;
;
19$:
;
	MOV	10(R1),R4			;PF INTO R4
	ADD	R2,R4				;ADD PF TO (NF-LF)
	MOV	R4,10(R1)			;MOV IN NEW PF
	MOV	@6(R5),6(R1)			;MOV IN NEW LF
	BR	13$
;
;
10$:
;
	CMPB	2(R1),#116			;CHECK FOR NL
	BEQ	11$	
	MOV	R5,-(SP)			;ABORT WHEN WRITE OP ON SL TAPE
	MOV	#ROUTE,R5
	MOV	#19.,ARG1
	JSR	PC,ABORT
	MOV	(SP)+,R5
	WTSE$S	#30.,DIRERR
	EXIT$S
;
;
11$:
;
	CLR	DENS+Q.IOPL			;CLEAR PARAMETERS
	MOV	#IO.EOF,DENS+Q.IOFN		;EOF TO FUNCTION
	DIR$	#DENS,DIRERR			;ISSUE DIRECTIVE
;
;
13$:
;
	.IRP	X,<R5,R4,R3,R2,R1,R0>
	MOV	(SP)+,X
	.ENDM
;
	RTS	PC				;RETURN TO MAIN
;
;
;
;
	.PAGE
;
	.SBTTL FREAD
;
;
;*************************************************************************;
;
;                        CALL FREAD(A,N,LR,IOST)
;
;
;*************************************************************************;
;
;
;***************
;
FREAD::
;
;***************
;
;
	.IRP	X,<R0,R1,R2,R3,R4,R5>
	MOV	X,-(SP)
	.ENDM
;
;
	CMPB	#4,(R5)				;CHECK FOR RIGHT # OF ARGS.
	BEQ	1$			;IF OK--TO 1$
	MOV	R5,-(SP)			;OTHERWISE ABORT WITH MSG.
	MOV	#ROUTE,R5				
	MOV	#20.,ARG1
	JSR	PC,ABORT
	MOV	(SP)+,R5	
	WTSE$S	#30.,DIRERR
	EXIT$S
;
;
1$:
;
	MOV	R5,-(SP)			;JUMP TO LOCATE
	MOV	4(R5),ARG+2			;TO CHECK ON
	MOV	#ARG,R5				;LUN SPECIFICATION.
	JSR	PC,LOCATE
	MOV	(SP)+,R5
	TST	R1				;CHECK FOR ERROR
	BNE	2$				;TO 2$ IF OK
	MOV	R5,-(SP)			;OTHERWISE ABORT WITH MSG.
	MOV	#ROUTE,R5
	MOV	#21.,ARG1
	JSR	PC,ABORT
	MOV	(SP)+,R5
	WTSE$S	#30.,DIRERR
	EXIT$S
;
;
2$:
;
	CMPB	34(R1),#102			;BLOCKED?
	BNE	6$			;IF NOT--TO 6$
	MOV	@4(R5),DENS+Q.IOLU		;OTHERWISE DO QIOW.
	MOV	#IO.RLB,DENS+Q.IOFN		;MOV IN FUNCTION CODE.
	MOV	22(R1),DENS+Q.IOPL		;ALSO ADDRESS 
	MOV	26(R1),DENS+Q.IOPL+2		;AND # OF BYTES TO READ.
	DIR$	#DENS,DIRERR			;ISSUE DIRECTIVE
	MOVB	IOST,R3				;MOV STATUS TO WORD REG.
	CMP	#IE.EOF,R3			;EOF?
	BEQ	8$				;IF EOF --TO 8$
	CMP	2(R5),22(R1)		;ARE THEY THE SAME ADDRESS?
	BNE	42$
	MOV	R3,@10(R5)			;OTHERWISE RETURN STATUS
	MOV	IOST+2,@6(R5)			;AND #OF BYTES READ
	JMP	4$				;THEN BRANCH OUTSIDE
;
;
;
42$:	JMP	10$
;
8$:
;
	CMPB	2(R1),#116			;IF EOF, THEN IS IT NL?
	BNE	3$				;IF SL--THEN TO 3$
	ADD	#1,6(R1)			;OTHERWISE ADD 1 TO LF
	ADD	#1,10(R1)			;AND ADD 1 TO PF
	MOV	R3,@10(R5)			;RETURN STATUS
	MOV	IOST+2,@6(R5)			;AND # OF BYTES READ
	JMP	4$				;THEN JUMP OUTSIDE
;
;
3$:
;
	MOV	@4(R5),LON			;SL WITH EOF
	MOV	R5,-(SP)			;JUMP TO "SKIP" ROUTINE
	MOV	#LIST,R5			;TO GO BACKWARDS
	MOV	#-1,NSK				;OVER EOF
	MOV	#IOST,6(R5)				
	JSR	PC,SKIP
	MOV	(SP)+,R5
	MOV	R3,@10(R5)			;RETURN STATUS
	MOV	IOST+2,@6(R5)			;ALSO # OF BYTES READ
	JMP	4$				;THEN JUMP OUTSIDE
;
;
6$:
;
	TSTB	35(R1)				;TEST FOR DATA SET OPEN OR CLOSED.
;
;      0= OPEN DATA SET
;
;      1= CLOSED DATA SET
;
	BNE	7$				;BRANCH ON NOT OPEN TO 7$
	MOV	32(R1),R0			;MOV SAVED POINTER INTO BUFFER TO REG.
	CMPB	4(R1),#106			;ON OPEN DATA SET--FB?
	BNE	40$
	BR	13$
40$:
	JMP	11$
;
;
7$:
;
	MOV	@4(R5),DENS+Q.IOLU		;LUN TO LOC.
	MOV	#IO.RLB,DENS+Q.IOFN		;FUNCTION CODE TO LOC.
	MOV	22(R1),DENS+Q.IOPL		;ADDRESS TO LOC.
	MOV	26(R1),DENS+Q.IOPL+2		;ALSO # OF BYTES TO READ.
	DIR$	#DENS,DIRERR			;ISSUE DIRECTIVE
	MOVB	IOST,R3				;STATUS TO WORD REG.
	CMP	#IE.EOF,R3			;EOF?
	BEQ	8$				;IF EOF--TO 8$
	CMP	#IE.DAO,R3			;CHECK FOR DATA OVER RUN
	BNE	9$				;NO--TO 9$
	MOV	R5,-(SP)			;OTHERWISE ABORT
	MOV	#ROUTE,R5
	MOV	#22.,ARG1
	JSR	PC,ABORT
	MOV	(SP)+,R5
	WTSE$S	#30.,DIRERR
	EXIT$S
;
;
9$:
;
	BICB	#1,35(R1)			;OPEN DATA SET
	CMPB	4(R1),#106			;FIXED BLOCK PROCESSING?
	BNE	12$				;NO--TO 12$
	CMP	IOST+2,26(R1)			;OTHERWISE CHECK TO MAKE SURE
						;NUMBER OF BYTES READ=BLOCKSIZE SPECIFIED.
	BEQ	10$				;IF YES--TO 10$.
	CLR	R2
	MOV	IOST+2,R3			;MOV # READ TO R3
	DIV	24(R1),R2			;MAKE SURE THAT
						;WE HAVE AN EVEN
						;NUMBER TO MOVE
	TST	R3				;REMAINDER?
	BEQ	10$
	MOV	R5,-(SP)
	MOV	#ROUTE,R5
	MOV	#23.,ARG1	
	JSR	PC,ABORT
	MOV	(SP)+,R5
	WTSE$S	#30.,DIRERR
	EXIT$S
;
;
10$:
;
	MOV	22(R1),R0			;ADDRESS OF DATA AREA INTO REG.
	MOV	26(R1),30(R1)			;MOV BLKSIZE INTO COUNTER LOC.
	MOV	24(R1),R3			;MOV LRECL INTO R3
	ASR	R3				;DIVIDE # BYTES BY 2
	ASL	R3				;MULTIPLY BY 2
	CMP	R3,24(R1)			;IS THERE AN EVEN # OF BYTES?
	BEQ	13$				;YES--TO 13$
	MOV	R5,-(SP)			;OTHERWISE ABORT
	MOV	#ROUTE,R5
	MOV	#24.,ARG1
	JSR	PC,ABORT
	MOV	(SP)+,R5
	WTSE$S	#30.,DIRERR
	EXIT$S
;
;
13$:
;
	MOV	24(R1),R3
	ASR	R3				;GET BACK # OF WORDS
	MOV	2(R5),R2			;MOV ADDRESS OF OUTPUT TO R2
;
;
14$:
;
	MOV	(R0)+,(R2)+			;MOVE A WORD TO OUTPUT BUFFER.
	SOB	R3,14$				;DECREMENT #WORD AND BRANCH
	SUB	24(R1),30(R1)			;SUB LRECL FROM BLKSIZE.
	TST	30(R1)				;ARE WE AT THE END?
	BNE	15$				;NO--TO 15$
	BISB	#1,35(R1)			;OTHERWISE CLOSE DATA SET.
;
;
15$:
;
	MOV	R0,32(R1)			;SAVE POINTER INTO BUFFER.
	MOV	24(R1),@6(R5)			;RETURN LRECL
	MOVB	IOST,R3
	MOV	R3,@10(R5)
	BR 4$					;THEN BRANCH OUTSIDE.
;
;
12$:
;
	CMP	IOST+2,26(R1)			;CHECK TO MAKE SURE THAT #
						;OF BYTES READ=BLKSIZE
	BEQ	17$				;YES--TO 17$
	MOV	IOST+2,26(R1)			;OTHERWISE RETURN # READ 
;
;
17$:
;
	MOV	26(R1),30(R1)			;MOV BLKSIZE TO BLKSIZE CTR.
	MOV	R5,-(SP)			;JUMP TO SWAP ROUTINE
	MOV	22(R1),ADR+2			;TO READ 4 IBM
	MOV	#4,NMWD			;BYTES--BDW
	MOV	#ADR,R5
	JSR	PC,SWABI
	MOV	(SP)+,R5
	MOV	22(R1),R0			;MOV ADDRESS OF DATA TO REG.
	CMP	IOST+2,(R0)			;DOES # READ AGREE WITH BDW?
	BEQ	20$				;IF YES--TO 20$
	MOV	R5,-(SP)			;OTHERWISE ABORT
;WITH MSG.
	MOV	#ROUTE,R5
	MOV	#25.,ARG1
	JSR	PC,ABORT
	MOV	(SP)+,R5
	WTSE$S	#30.,DIRERR
	EXIT$S
;
;
20$:
;
	ADD	#4,R0				;INCREMENT ADDRESS TO MOV OVER BDW.
	SUB #4,	30(R1)					;ALSO SUBTRACT 4 FROM BDW 
;
;
11$:
;
	MOV	R5,-(SP)			;CALL SWAP AGAIN TO GET NEXT
						;4 BYTES--RDW
	MOV	R0,ADR+2
	MOV	#4,NMWD
	MOV	#ADR,R5
	JSR	PC,SWABI
	MOV	(SP)+,R5
	MOV	(R0),R3			;MOV RDW INTO LRECL
	SUB	R3,30(R1)		;SUBRACT OFF THIS RECORD FROM BDW
	SUB	#4,R3					;SUBTRACT OFF 4 BYTES FORM RECORD
	CMP	R3,24(R1)
	BLE	22$
	MOV	R5,-(SP)
	MOV	#ROUTE,R5
	MOV	#26.,ARG1
	JSR	PC,ABORT
	MOV	(SP)+,R5
;
;
22$:
;
	MOV	R3,@6(R5)		;RETURN LENGTH READ
	ADD	#4,R0				;JUMP OVER RDW
	MOV	2(R5),R2			;ADDRESS OF OUTPUT TO REG.
;
;
25$:
;
	MOVB	(R0)+,(R2)+			;MOV BYTES INTO BUFFER.
	SOB	R3,25$
	TST	30(R1)				;BLKSIZE CTR=0?
	BNE	27$				;IF NOT--TO 27$
	BISB	#1,35(R1)			;OTHERWISE CLOSE DATA SET.
;
;
27$:
;
	MOV	R0,32(R1)			;SAVE POINTER INTO BUFFER.
	MOV	IOST,R3
	MOV	R3,@10(R5)
;
;
4$:
;
	.IRP	X,<R5,R4,R3,R2,R1,R0>
	MOV	(SP)+,X
	.ENDM
;
;
	RTS PC
;
;
;
;
;
				
	
	.PAGE
;
;
	.SBTTL DCB
;
;*************************************************************************;
;
;                       CALL DCB(BUFF,LUN,BLKSIZ,LRECL,MODE)
;
;
;*************************************************************************;
;
;
;**************
;
DCB::
;
;**************
;
;
	.IRP	X,<R0,R1,R2,R3,R4,R5>
	MOV	X,-(SP)
	.ENDM
;
;
	CMPB	#5,(R5)				;CHECK ON RIGHT NUMBER OF ARGS.
	BEQ	1$				;IF OK--TO 1$
	MOV	R5,-(SP)			;OTHERWISE ABORT WITH MSG.
	MOV	#ROUTE,R5
	MOV	#27.,ARG1
	JSR	PC,ABORT
	MOV	(SP)+,R5
	WTSE$S	#30.,DIRERR
	EXIT$S
;
;
1$:
;
	MOV	R5,-(SP)			;JUMP TO LOCATE TO 
	MOV	4(R5),ARG+2			;CHECK ON LUN SPECIFICATION.
	MOV	#ARG,R5
	JSR	PC,LOCATE
	MOV	(SP)+,R5
	TST R1
	BNE	2$				;IF OK--TO 2$
	MOV	R5,-(SP)			;OTHERWISE ABORT WITH MSG.
	MOV	#ROUTE,R5
	MOV	#28.,ARG1
	JSR	PC,ABORT
	MOV	(SP)+,R5
	WTSE$S	#30.,DIRERR
	EXIT$S
;
;
2$:
;
;
;
	CMPB	@12(R5),#106			;CHECK ON FB SPECIFICATION.
	BEQ	5$				;YES--TO 5$
	CMPB	@12(R5),#126			;CHECK ON VB SPECIFICATION.
	BEQ	5$				;YES--TO 5$
	MOV	R5,-(SP)			;IF NEITHER--ABORT
	MOV	#ROUTE,R5
	MOV	#30.,ARG1
	JSR	PC,ABORT
	MOV	(SP)+,R5
	WTSE$S	#30.,DIRERR
	EXIT$S
;
;
5$:
;
	MOV	2(R5),22(R1)			;STORE ADDRESS OF BUFFER
				;WE WANT ADDRESS OF BUFFER
				;SO NO '@'.
	MOV	@12(R5),4(R1)			;STORE MODE
	MOV	@6(R5),26(R1)			;STORE BLKSIZE
	MOV	@10(R5),24(R1)			;STORE LRECL
	CMP	@6(R5),@10(R5)			;COMPARE BLKSIZE WITH LRECL
	BNE	6$
	MOVB	#102,34(R1)			;IF THEY ARE EQUAL--THEN TAPE IS BLOCKED.
	BR	20$				;THEN ONTO 20$
;
;
6$:
;
	CLR	R2
	MOV	@6(R5),R3			;MOV	BLKSIZE TO REG.
	DIV	@10(R5),R2			;DIVIDE LRECL BY BLKSIZE.
	TST	R3				;TEST FOR REMAINDER
	BEQ	7$				;NO REMAINDER--TO 7$
	MOVB	#125,34(R1)			;IF REMAINDER--THEN MUST BE VB.
	BR	20$
;
;
7$:
;
	CMPB	#106,4(R1)			;CHECK FOR FB
	BEQ	10$
	MOV	R5,-(SP)			;OTHERWISE ABORT IF NOT FB.
	MOV	#ROUTE,R5
	MOV	#31.,ARG1
	JSR	PC,ABORT
	MOV	(SP)+,R5
	WTSE$S	#30.,DIRERR
	EXIT$S
;
;
10$:
;
	MOVB	#125,34(R1)			;MOV IN A "U".
;
;
20$:
;
	.IRP	X,<R5,R4,R3,R2,R1,R0>
	MOV	(SP)+,X
	.ENDM
;
	RTS	PC
;
;
;
;
;
	.PAGE
  
	.SBTTL REWIND
;*************************************************************************;
;
;                    CALL REWIND(N)
;
;*************************************************************************;
;
;
;
;
;******************
;
REWIND::
;
;******************
;
;
	.IRP	X,<R0,R1,R2,R3,R4,R5>
	MOV	X,-(SP)
	.ENDM
	CMPB	#1,(R5)				;CHECK NUMBER OF ARGS
	BEQ	2$			;IF OK--TO 2$
	MOV	R5,-(SP)			;OTHERWISE ABORT WITH MSG.
	MOV	#ROUTE,R5
	MOV	#32.,ARG1
	JSR	PC,ABORT
	MOV	(SP)+,R5
	WTSE$S	#30.,DIRERR
	EXIT$S
;
;
2$:
;
	MOV	#IO.SEC,CHECK+Q.IOFN			;SET DIRECTIVE FOR REWIND
	MOV	@2(R5),CHECK+Q.IOLU
	DIR$	#CHECK,DIRERR			;ISSUE DIRECTIVE TO REWIND
	BIT	#20000,IOST+2
	BNE	5$
	MOV	R5,-(SP)			;PUSH R5
	MOV	2(R5),ARG+2
	MOV	#ARG,R5				;POINTER TO R5
	JSR	PC,LOCATE			;JUMP TO LOCATE
	MOV	(SP)+,R5
	TST	R1				;TEST FOR RETURN OF ZERO
	BNE	3$			;IF LUN OK--TO 3$
	MOV	R5,-(SP)			;OTHERWISE ABORT WITH MSG.
	MOV	#ROUTE,R5
	MOV	#33.,ARG1
	JSR	PC,ABORT
	MOV	(SP)+,R5
	WTSE$S	#30.,DIRERR
	EXIT$S
;
;
3$:
;
	MOV	#1,6(R1)			;#1 INTO LF
	MOV	#1,10(R1)			;#1 INTO PF
	MOV	@2(R5),DENS+Q.IOLU		;LUN INTO LOCATION
	MOV	#IO.RWD,DENS+Q.IOFN		;REWIND FUNCTION LOC
	DIR$	#DENS,DIRERR			;ISSUE DIRECTIVE
;
;
5$:
;
	.IRP	X,<R5,R4,R3,R2,R1,R0>
	MOV	(SP)+,X
	.ENDM
;
;
	RTS	PC			
;
;
	.PAGE
;
	.SBTTL FWRITE
;
;*************************************************************************;
;
;                     CALL FWRITE(A,NN,LEN,IERR)
;
;*************************************************************************;
;
;
;
;
;****************
;
FWRITE::
;
;****************
;
;
	.IRP	X,<R0,R1,R2,R3,R4,R5>
	MOV	X,-(SP)
	.ENDM
	CMPB	#4,(R5)				;CHECK FOR AGRUMENT NUMBER
	BEQ	10$
	MOV	R5,-(SP)
	MOV	#ROUTE,R5
	MOV	#34.,ARG1
	JSR	PC,ABORT
	MOV	(SP)+,R5
	WTSE$S	#30.,DIRERR
	EXIT$S
;
;
10$:
;
	MOV	R5,-(SP)			;JUMP TO LOCATE TO CHECK
	MOV	4(R5),ARG+2			;ON LUN SPECIFICATION
	MOV	#ARG,R5			
	JSR	PC,LOCATE
	MOV	(SP)+,R5		
	TST	R1			
	BNE	20$			;IF OK--TO 20$
	MOV	R5,-(SP)			;OTHERWISE ABORT WITH MSG.
	MOV	#ROUTE,R5
	MOV	#35.,ARG1
	JSR	PC,ABORT
	MOV	(SP)+,R5
	WTSE$S	#30.,DIRERR
	EXIT$S
;
;
20$:
;
	CMPB	2(R1),#116
	BEQ	22$
	MOV	R5,-(SP)
	MOV	#ROUTE,R5
	MOV	#36.,ARG1
	JSR	PC,ABORT
	MOV	(SP)+,R5
	WTSE$S	#30.,DIRERR
	EXIT$S
;
;
22$:
;
  
	MOV	@4(R5),DENS+Q.IOLU		;LUN TO LOCATION
	MOV	#IO.WLB,DENS+Q.IOFN		;WRITE FUNCTION
	MOV	2(R5),DENS+Q.IOPL		;ADDRESS TO LOC.
	MOV	@6(R5),DENS+Q.IOPL+2		;SIZE TO LOC.
	DIR$	#DENS,DIRERR		;ISSUE DIRECTIVE
	MOVB	IOST,R0				;STATUS TO R0
	MOV	R0,@10(R5)			;RETURN TO USER
	
;
;
;
	.IRP	X,<R5,R4,R3,R2,R1,R0>
	MOV	(SP)+,X
	.ENDM				
;
	RTS	PC
;
;
	.PAGE
;
;
	.SBTTL SKPREC
;
;*************************************************************************;
;                CALL SKPREC(N,NREC,IOST)
;
;*************************************************************************;
;
;
;********************
;
SKPREC::
;
;********************
;
	.IRP	X,<R0,R1,R2,R3,R4,R5>
	MOV	X,-(SP)
	.ENDM
	CMP	#3,(R5)
	BEQ	5$
	MOV	R5,-(SP)
	MOV	#ROUTE,R5
	MOV	#37.,ARG1
	JSR	PC,ABORT
	MOV	(SP)+,R5
	WTSE$S	#30.,DIRERR
	EXIT$S
;
;
5$:
;
	MOV	#IO.SPB,DENS+Q.IOFN
	MOV	@2(R5),DENS+Q.IOLU
	MOV	@4(R5),DENS+Q.IOPL
	DIR$	#DENS,DIRERR
	MOVB	IOST,R3
	MOV	R3,@6(R5)
;
;
	.IRP	X,<R5,R4,R3,R2,R1,R0>
	MOV	(SP)+,X
	.ENDM
;
	RTS	PC
;
;
;
;
;
	.PAGE
;
;
;
;
	.SBTTL SWABI
;
;*************************************************************************;
;               CALL SWABI(C,LBYTE)
;
;*************************************************************************;
;
;
;
;****************
;
SWABI::
;
;****************
;
;
	.IRP	X,<R1,R2>
	MOV	X,-(SP)
	.ENDM
;
;
	CMP	#2,(R5)				;CHECK FOR RIGHT # OF ARGS
	BEQ	5$
	MOV	R5,-(SP)
	MOV	#ROUTE,R5
	MOV	#45.,ARG1
	JSR	PC,ABORT
	MOV	(SP)+,R5
	WTSE$S	30.,DIRERR
	EXIT$S
;
;
5$:
;
	MOV	@4(R5),R1
	ASR	R1
	MOV	2(R5),R2
;
;
10$:
;
	SWAB	(R2)+
	SOB	R1,10$
;
;
	.IRP	X,<R2,R1>
	MOV	(SP)+,X
	.ENDM
	RTS	PC
;
;
;
;
;
;
	.PAGE
;
	.SBTTL LOCATE
;
;
;*************************************************************************;
;                 INTERNAL SUBROUTINE LOCATE(N)
;
;*************************************************************************;
;
;
;
;
;
;********************
;
LOCATE::
;
;********************
;
	.IRP	X,<R0,R2,R3,R4,R5>
	MOV	X,-(SP)
	.ENDM
;
	MOV	#START,R1
;
;
10$:
;
	CMP	@2(R5),(R1)
	BEQ	20$
	ADD	#40,R1
	CMP	#ENDAT,R1
	BNE	10$
	CLR	R1
;
;
20$:
;
	.IRP	X,<R5,R4,R3,R2,R0>
	MOV	(SP)+,X
	.ENDM
;
	RTS	PC
;
;
	.PAGE
;
;
;
	.SBTTL SKIP
;
;*************************************************************************;
;                          CALL SKIP(NFIL)
;
;*************************************************************************;
;
;
;
;******************
;
SKIP::
;
;*****************
;
	.IRP	X,<R0,R1,R2,R3,R4,R5>
	MOV	X,-(SP)
	.ENDM
;
;
	CMP	#3,(R5)			;CHECK FOR RIGHT NUMBER OF ARGUMENTS
	BEQ	15$
	MOV	R5,-(SP)			;OTHERWISE ABORT
	MOV	#ROUTE,R5
	MOV	#44.,ARG1
	JSR	PC,ABORT
	MOV	(SP)+,R5
	WTSE$S	#30.,DIRERR
	EXIT$S
;
;
;
15$:
	MOV	#IO.SPF,DENS+Q.IOFN		;SKIP FUNCTION 
	MOV	@2(R5),DENS+Q.IOLU		;LUN TO LOC
	MOV	@4(R5),DENS+Q.IOPL		;FILL PARAMTERS
	DIR$	#DENS,DIRERR				;ISSUE DIRECTIVE
	MOVB	IOST,R1
	MOV	R1,@6(R5)			;RETURN CODE TO 
						;USER
;
;
	.IRP	X,<R5,R4,R3,R2,R1,R0>
	MOV	(SP)+,X				;POP REGISTERS
	.ENDM
;
;
	RTS	PC
;
;
;	                
;
	.PAGE
;
;
;
	.SBTTL ABORT ROUTINES
;
;********************ABORT ROUTINES*********************
;
;
;
;
ABORT::
	.IRP	X,<R0,R1,R2,R3,R4,R5>
	MOV	X,-(SP)
	.ENDM
	CMP	#7, ARG1	;IS THIS THE SEVENTH MESSAGE
	BNE	MSG2		;IF NOT GO TO MSG2
	SET	FSDP7		;MOV STRING POINTER
	MOV	R2,PARM
	MOV	R3,PARM1
	MOVB	#S$USP,MESSAG+M.OACT
	JMP	CODE1
;
MSG2:
	CMP	#9.,ARG1		;IS THIS MESSAGE #9?
	BNE	MSG3		;IF NOT GO TO MESSAGE 3
	SET 	FSDP9
	MOV	R5,-(SP)
	MOV	2(R5),ARG+2
	MOV	#ARG,R5
	JSR	PC,LOCATE
	MOV	(SP)+,R5
	MOV	36(R1),PARM
	MOV	20(R1),PARM1
	MOVB	#S$USP,MESSAG+M.OACT
	JMP	CODE1
;
MSG3:
	MOV	#ARG1,R0
	MOV	(R0),PARM
	SET	FSDP
	CLEF$S	#50.,DIRERR
	JMP	CODE
CODE:
  
	MOVB	#A$BRT,MESSAG+M.OACT		;ABORT TO ACTION
  
   
CODE1:
	MOVB	#SY$STM!HE$ADR,MESSAG+M.ODST	;PRINT HEADER
	MOV	.MOLUN,MESSAG+M.OLUN		;LOGICAL UNIT #
	DIR$	#MESSAG				;ISSUE DIRECTIVE
	CMP	@#0,#1
	BEQ	27$
	INC	PC
27$:
;
;
;
	.IRP	X,<R5,R4,R3,R2,R1,R0>
	MOV	(SP)+,X
	.ENDM
;
;
	RTS	PC
  
   
  
	.PAGE
  
;**********************ERROR MESSAGES*********************************
   
   
ABRT:
	.ASCIZ/ABORT BY FTIO:**ERROR NUMBER %1O **/
	.EVEN
LENG:	.=.
FSDP:	.WORD LENG-ABRT
	.WORD ABRT
;
MESAG:
	.ASCIZ/MOUNT %6A ON DRIVE %1O****TYPE CONTINUE/
	.EVEN
LENG7:	.=.
FSDP7:	.WORD LENG7-MESAG
	.WORD MESAG
;
;
MESAG1:
	.ASCIZ/DISMOUNT %6A FROM DRIVE %1O****TYPE CONTINUE/
	.EVEN
LENG9:	.=.
FSDP9:	.WORD LENG9-MESAG1
	.WORD MESAG1
	.PAGE
  
  
;********************DATA REGION********************************
		.PSECT REGION,D,GBL,OVR
	.SBTTL DATA REGION
  
  
  
MESSAG:	MOUT$ 0,PARM,0,0,0,0,0,IOST,0
PARM:	.WORD 0
PARM1:	.WORD 0
	.EVEN
  
MARK:	MRKT$ 4,1,2 
;
REQST:	RQST$ PUDDA,,110.
;
RECEV:	VRCD$ PUDDA,OFLN,1
TASK:	.WORD 0,0
;
NUMDRV:	.WORD 2
;
	.EVEN
OFLN:	.WORD 0,0,0,0
	.EVEN
   
MMDEV:	.ASCII/MM/
	.EVEN
;
LUNDEV:	.ASCII/SM/
	.EVEN
;
ASSN:	ALUN$ 0,MM,0
SND:	VSDA$	PUDDA,TASK,2,52.,110.
;
DENS:	QIOW$ 0,0,3,0,IOST,0,<0,0,0,0,0,0>
CHECK:	QIOW$ 0,0,3,0,IOST,0
;
IOST:	.WORD 0,0
;
	.EVEN
ADR:	.BYTE 2,0
	.WORD 0
	.WORD NMWD
NMWD:	.WORD 0
TAP:	.BYTE 2,0
	.WORD 0
	.WORD NBR
NBR:	.WORD 0
ROUTE:	.BYTE 1,0
	.WORD ARG1
ARG1:	.WORD 0
	.EVEN
FLNO:	.WORD 0
	.EVEN
LINK:	.BYTE 6,0
	.WORD ILUN
LNK1:	.WORD 0
	.WORD -1
	.WORD IEFN
	.WORD -1
	.WORD ISTAT
	.EVEN
;
ILUN:	.WORD 0
	.EVEN
IBUF:	.ASCIZ*MOU MM :/CHA=[FOR]*
	.EVEN
IEFN:	.WORD 0
	.EVEN
ISTAT:	.WORD 0,0
	.EVEN
JBUF:	.ASCIZ*DMO MM :*
	.EVEN
DASSN:	ALUN$ 0
;
;
PNTR:	.BYTE 3,0
	.WORD IO
	.WORD LU
	.WORD NF
	.EVEN
;
IO:	.WORD 0
LU:	.WORD 0
NF:	.WORD 0
;
	.EVEN
;
;
;
;
ARG:	.BYTE 1,0
	.WORD 0
	.EVEN
   
LIST:	.BYTE 3,0
	.WORD LON
	.WORD NSK
	.WORD IOST
	.EVEN
LON:	.WORD 0
NSK:	.WORD 0
  
   
;****************SEPARATE PSECT FOR COMMON USAGE****************
;
;
;
	.PSECT FTIODT,D,GBL,OVR
	K=2
  
START::
	.REPT K
	.WORD 0			;LOGICAL UNIT NUMBER
	.WORD 0			;LABEL (NL OR SL)
	.WORD 0			;BLOCK (VB OR FB)
	.WORD 1			;LOGICAL FILE
	.WORD 1			;PHYSICAL FILE
	.WORD 0,0,0		;VSN 6 BYTES
	.WORD 0			;DEVICE UNIT NUMBER
	.WORD 0		;ADDRESS OF DATA AREA
	.WORD 0		;LRECL
	.WORD 0		;BLKSIZE
	.WORD 0		;BLOCK COUNTER
	.WORD 0		;POINTER INTO BUFFER
	.BYTE	0		;BLOCKED OR UNBLOCKED
	.BYTE 1		;DATA OPEN OR CLOSEDD
	.WORD 0	;ADDRESS OF VSN
	.ENDM
ENDAT::
	.END