.TITLE  SIMTAP
        .SBTTL  INTRODUCTION
;
;       PAUL D. CLAYTON   1/14/79   RMS @ NADC WARMINSTER, PA.
;
;       THIS PROGRAM INTERFACES SIMULATED TAPE FILES CREATED UNDER
;               MCF-11 WITH FORTRAN PROGRAMS RUN ON THE VS/SGF PDP
;               11/70.
;
;       THE BENIFIT OF THIS PROGRAM IS UP TO 5 SIMULATED FILES CAN
;               BE OPEN FOR READ/WRITE AT THE SAME TIME. ALL REFERANCES
;               TO EACH FILE IS DONE THROUGH A LOGICAL UNIT NO. (1-5)
;               INCLUSIVE. THE FILE NAME IS USER SPECIFIED ON ALL 5
;               FILES WITH THE DEFAULT FILE SPEC BEING:
;               "DB0:[201,201]TEMP.TAP;X" WITH X=HIGHEST VERSION NO.
;               WHEN THE FILE IS OPENED.
;
;       CALLING SEQUENCE:
;               CALL  SIMTAP(COM,LU,BUF,TYP,CNT)
;
;       PARAMETERS:
;
;               COM-  COMMAND REQUESTED
;                   0=OPEN FILE---READ ONLY
;                   1=OPEN FILE---WRITE ONLY
;                   2=READ RECORD
;                   3=WRITE RECORD
;                   4=WRITE TAPE MARK
;                   5=WRITE EOT
;                   6=CLOSE FILE--KEEP FILE
;                   7=CLOSE FILE--DELETE FILE
;		    8=BACK-UP ONE RECORD
;		    9=RETURN FILE NAME IN BUFFER
;
;               LU-   LOGICAL UNIT NO.
;                   LOGICAL UNIT NOS. ARE 1-5 INCLUSIVE
;
;               BUF-  BUFFER WHERE RECORD IS TO BE READ/WRITTEN
;                             TO/FROM
;
;               TYP-  RETURNED STATUS
;                   0=ERROR ON FILE ACCESS - FATAL
;                   1=TAPE MARK DETECTED
;                   2=DATA RECORD READ
;                   3=EOT DETECTED
;                   4=TAPE FILE OPENED
;                   5=TAPE FILE CLOSED
;                   6=TAPE WRITE SUCCESSFUL
;                   7=ILLEGAL LOGICAL UNIT
;                   8=ILLEGAL COMMAND REQUEST
;		    9=ERROR IN FILE NAME SPECIFICATION
;		   10=FILE ALREADY OPENED-NO ACTION TAKEN
;		   11=BEGINNING OF TAPE MARK (BOT)
;		   12=NON-FATAL FILE ACCESS ERROR
;		   13=FILE NAME IN BUFFER "BUF"
;
;               CNT-  NUMBER OF BYTES READ/WRITTEN
;
;
;      *NOTE-   WHEN OPENING FILES THE FILE NAME TO BE USED MUST BE
;               IN THE BUFFER SPECIFIED IN "BUF",IN PACKED FORMAT.THE
;               NAME MUST ALSO BE FOLLOWED BY AN ASCII SPACE "040"OCTAL.
;
;
;
;
;
	.PAGE
	.SBTTL	SYMBOL DEFINITIONS
;
;
;	THE FOLLOWING ARE THE DEFINITIONS FOR THE SYMBOLS USED IN THIS 
;		PROGRAM. ALL SYMBOLS ARE DEFINED LOCAL.
;
;
;
;	THE FOLLOWING ARE THE OFFSETS FROM R5 FOR THE ADDRESSES OF EACH
;		PARAMETER PASSED TO "SIMTAP"
;
COM=2.          ;OFFSET TO COMMAND REQUEST
LU=4.           ;OFFSET TO LOGICAL UNIT NO.
BUF=6.          ;OFFSET TO BUFFER ADDRESS
TYP=8.          ;OFFSET TO RETURNED STATUS
CNT=10.         ;OFFSET TO BYTE COUNT
;
;	NEXT ARE THE STATUS CODES FOR EACH CONDITION WHICH ARE
;		RETURNED IN "TYP" TO THE USER PROGRAM.
;
FACCER=0.	;ERROR ON FILE ACCESS
TMDET=1.	;TAPE MARK DETECTED ON READ
DRDET=2.	;DATA RECORD READ
EOTDET=3.	;EOT DETECTED ON TAPE
FILEOP=4.	;TAPE FILE OPENED
FILECL=5.	;TAPE FILE CLOSED
TWSUCC=6.	;TAPE WRITE SUCCESSFUL
LUERR=7.        ;ERROR CODE FOR BAD LU
COMERR=8.       ;ERROR CODE FOR BAD COMMAND
NAMERR=9.	;ERROR CODE FOR BAD FILE NAME IN "BUF"
OPERR=10.	;FILE ALREADY OPENED- NO ACTION TAKEN
BOT=11.		;BOT MARK IS READ.
NONFAT=12.	;NON-FATAL FILE ERROR
NAMEOK=13.	;FILE NAME IN BUFFER "BUF"
;
;	NEXT ARE THE MINS AND MAXS FOR BOTH LOGICAL UNIT NO. AND COMMAND 
;		REQUESTS. ANY NEW ADDITIONS TO EITHER REQUIRES THAT THESE
;		VALUES BE UPDATED AS REQUIRED.
;
MINLU=1.        ;MINIMUM  LU ALLOWED
MAXLU=5.        ;MAXIMUM  LU ALLOWED
MINCOM=0.       ;MINIMUM COMMAND ID ALLOWED
MAXCOM=9.       ;MAXIMUM COMMAND ID ALLOWED
;
;	NEXT ARE THE COMMAND REQUEST ID'S USED IN THIS PROGRAM.
;
OFILR=0.        ;OPEN FILE-READ ONLY
OFILRW=1.       ;OPEN FILE-WRITE ONLY
READR=2.        ;READ DATA RECORD
WRITER=3.       ;WRITE DATA RECORD
WRITET=4.       ;WRITE TAPE MARK
WRITEE=5.       ;WRITE EOT
CFILK=6.        ;CLOSE FILE-KEEP
CFILD=7.        ;CLOSE FILE-DELETE
SKPBCK=8.	;BACK-UP ONE RECORD
GETNAM=9.	;GET FILE NAME INTO BUFFER
;
;	NEXT ARE THE OFFSETS FROM THE BEGINNING OF THE FDB FOR ASSOCIATED
;		FDB VALUES
;
CURPTR=-8.	;OFFSET TO POINTER INTO DATA BLOCK FOR NEXT RECORD
HEDPTR=-6.	;OFFSET TO AREA CONTAINING PREVIOUS SIM. TAPE HEADER
PRCOD=-4.	;OFFSET TO FILE PROTECTION AND STATUS CODES
UICFIL=-2.	;OFFSET TO UIC OF FDB FILE
;
;	NEXT ARE THE BIT VALUES FOR FILE PROTECTION AND STATUS
;		NOTE THAT THE FILE ERROR CONDITION IS SHOWN BY BITS
;		OPEN AND CLOSE BOTH BEING ZERO.
;
CLOSED=1	;FILE CLOSED-LOGICAL UNIT AVAILABLE
OPEN=2.		;FILE OPEN- ASSIGNED
READ=4.		;FILE OPEN FOR READ ONLY
WRITE=8.	;FILE OPEN FOR WRITE
PHYEOT=16.	;PHYSICAL EOT REACHED. CLOSE ONLY OPERATION LEFT
RECSKP=32.	;SKIP TO NEW VBN ON READ RECORD
;
;	NEXT IS THE OFFSET FROM THE BEGINNING OF THE FDB MACRO TO THE 
;		"TRUE" BEGINNING. THIS SKIPS OVER POINTER STORAGE IN FRONT
;		OF EACH FDB.
;
FDBOFF=8.	;OFFSET TO FDB BEGINNING POINT
;
;	NEXT ARE THE OFFSETS USED TO ACCESS THE PARTS IN A SIMULATED
;		TAPE HEADER.
;
TH.PVB=0.	;OFFSET TO PREVIOUS VIRTUAL BLOCK NUMBER (4 BYTES)
TH.PO=4.	;OFFSET TO OFFSET WITHIN PVB (2 BYTES)
TH.RT=6.	;OFFSET TO RECORD TYPE (1 BYTE)
;	NOTE- ONE BYTE IS NOT USED
TH.RL=8.	;OFFSET TO RECORD LENGTH (4 BYTES)
TH.HZ=12.	;SIZE OF SIMULATED HEADER
;
;	SIMULATED TAPE RECORD TYPE BIT DEFINITIONS
;
ST.TM=1.	;RECORD IS A TAPE MARK (LENGTH=0)
ST.DAT=2.	;RECORD IS A DATA RECORD (LENGTH IN TH.RL)
ST.EOT=3.	;RECORD IS A END OF TAPE (LENGTH=0)
;
;	NEXT IS THE MACRO DEFINITION FOR THE COMMAND REQUEST SEQUENCE. THE
;		PRIMARY PURPOSE IS FOR ELIMINATING REPETITIVE CODEING.
;
        .MACRO  COMMND  COMMID,COMMPR   ;DEFINE COMMAND MACRO
        $IF     <@COM(R5),EQ,#COMMID>   ;IF COMMAND ID MATCHES REQUEST
        JMP     COMMPR                  ;-CALL COMMAND PROCESSOR
	$END				;END IF
        .ENDM   COMMND                  ;END OF COMMAND MACRO
;
;	NEXT IS THE MACRO FOR GENERATING EACH FDB FOR THE TAPE FILES
;		ON DISK. THERE IS ONE FDB FOR EACH LOGICAL UNIT.
;
        .MACRO  LUFDB LU,BUF,STO        ;FILE SPEC MACRO                        
	.WORD	STO+12.			;ADDR. TO CURRENT POINTER TO BLOCK
	.WORD	STO			;ADDR. OF HEADER STOR. AREA
	.WORD	1			;FILE PROT./STATUS FLAGS
        .WORD   0                       ;STORAGE OF FDB UIC                     
        FDBDF$                          ;FDB FOR 512. BYTE BLOCKS               
        FDAT$A  R.FIX,FD.BLK,512.                                               
        FDOP$A  LU                                                              
        FDRC$A  FD.RWM                                                          
        FDBK$A  BUF,512.                                                        
	.EVEN
BUF:    .BLKB   512.                                                            
STO:	.BLKB	14.			;STORAGE FOR SIMULATED TAPE HEADER
        .ENDM   LUFDB                                                           
;
;	THE NEXT MACRO PUSHES REGISTERS ONTO THE STACK
;
	.MACRO	PUSH$	ARG
	.IRP	X,<ARG>
	MOV	X,-(SP)			;PUT REG. ON THE STACK
	.ENDM
	.ENDM	PUSH$
;
;	THE NEXT MACRO POPS THE REGISTERS OFF THE STACK
;
	.MACRO	POP$	ARG
	.IRP	X,<ARG>
	MOV	(SP)+,X			;POP REG. OFF THE STACK	
	.ENDM	
	.ENDM	POP$
;
;
        .PAGE
        .SBTTL  MAIN PROCESSING LOOP
        .MCALL  $STRUC
	.MCALL	OFNB$R,OFNB$W,FDBDF$,FDAT$A,FDOP$A,FDRC$A
	.MCALL	FDBK$A
	.MCALL	CLOSE$,READ$,WRITE$,WAIT$
	.MCALL	FDOF$L
	FDOF$L				;DEFINE FDB OFFSETS LOCALLY
        $STRUC                          ;INVOKE STRUCTURED MACROS
;
;       CONTROL REMAINS HERE AT ALL TIMES. ALL COMMANDS ARE DISPATCHED
;               FROM HERE. NO COMMAND PROCESSING IS DONE AT THIS LEVEL.
;               THE ENTRY AND EXIT POINTS FOR THE PROGRAM ARE IN THIS
;               CONTROL LOOP.
SIMTAP::                                ;ENTRY POINT
        $DO	10                      ;START BLOCK
        $IF     <@LU(R5),LT,#MINLU>     ;-IF LU LESS THAN MIN. UNIT
        $ORIF   <@LU(R5),GT,#MAXLU>     ;- OR GREATER THAN MAX.
        MOV     #LUERR,@TYP(R5)         ;--PUT IN ILLEGAL LU CODE
	SEC				;--SHOW REQUEST DONE-BUT ILLEGAL
        $EXIT	10                      ;--GET OUT OF BLOCK
        $END                            ;-END IF
        $IF     <@COM(R5),LT,#MINCOM>   ;-IF COMMAND ID LESS THAN MIN.
        $ORIF   <@COM(R5),GT,#MAXCOM>   ;- OR GREATER THAN MAX.
        MOV     #COMERR,@TYP(R5)        ;--PUT IN ILLEGAL COMMAND CODE
	SEC				;--SHOW REQUEST DONE-BUT ILLEGAL
        $EXIT	10                      ;--GET OUT OF BLOCK
        $END                            ;-END IF
	CLC				;-CLEAR CARRY- LU & REQ. OK-PROCESS
	$END				;END DO
;
;	IF CARRY SET DO NOT PROCESS COMMAND REQUEST. RETURN TO USER PROGRAM
;		WITH ERROR CODE. IF CARRY CLEAR GO AHEAD AND PROCESS REQUEST
;		SENT TO US.
;
	$IF	<,CC>			;IF CARRY CLEAR
	CALL	CPROC			;-GO DISPATCH REQUEST SENT
	$END				;END IF
	RETURN				;BACK TO USER PROGRAM
;
;
	.PAGE
	.SBTTL	COMMAND REQUEST DISPATCHER
;
;	THIS MODULE DISPATCHES THE REQUEST SENT TO US THROUGH A REQUEST 
;		PROCESSOR SPECIFIC TO THE REQUEST.
;
;
;       THE FOLLOWING IS THE COMMAND CALLING SEQUENCE. EACH COMMAND
;               HAS ONE MACRO CALL.
;
;	THE STRUCTURE OF THIS TABLE IS A SEQUENCE OF JUMPS. RETURNS FROM
;		EACH COMMAND PROCESSOR PUT THE PC BACK TO THE EXEC. MODULE
;
CPROC:					;ENTRY POINT
        COMMND  OFILR,OFILE             ;OPEN FILE-READ ONLY
        COMMND  OFILRW,OFILE            ;OPEN FILE-READ/WRITE
        COMMND  READR,RRECRD            ;READ ONE RECORD
        COMMND  WRITER,WRECRD           ;WRITE ONE RECORD
        COMMND  WRITET,WMARK            ;WRITE TAPE MARK
        COMMND  WRITEE,WMARK            ;WRITE EOT
        COMMND  CFILK,CFILE             ;CLOSE FILE-KEEP
        COMMND  CFILD,CFILE             ;CLOSE FILE-DELETE
	COMMND	SKPBCK,BACKUP		;BACK-UP ONE RECORD
	COMMND	GETNAM,NAMGET		;GET FILE NAME INTO BUFFER
        .PAGE                                                                   
        .SBTTL  OPEN FILE PROCESSOR                                             
;                                                                               
;       THIS SECTION HANDLES THE COMMAND TO OPEN FILES. BOTH READ ONLY          
;               AND READ/WRITE. THE FILE SPEC IS IN AREA ADDRESSED BY           
;               THE "BUF" PARAMETER. THE DEFAULT FILE SPEC IS:                  
;               DB0:[201,201]TEMP.TAP. ANY OR ALL OF THE FILE SPEC CAN          
;               BE CHANGED. THE ENDING CHAR MUST BE AN ASCII SPACE              
;                                                                               
OFILE:                                                                          
	$DO	20			;START BLOCK
	CALL	GETLU			;-GET LOGICAL UNIT NO. IN R4
	$IF	<#CLOSED!OPEN,OFF,PRCOD(R4)>	;-IF ERROR ON FILE
	MOV	#FACCERR,@TYP(R5)	;--SHOW ERROR ON LU
	$EXIT	20			;--GET OUT OF HERE
	$END				;-END IF
	$IF	<#OPEN,ON,PRCOD(R4)>	;-IF FILE ALREADY OPEN
	MOV	#OPERR,@TYP(R5)		;--SHOW OPEN ALREADY DONE
	$EXIT	20			;--GET OUT OF HERE
	$END				;-END IF
        MOV     #DSD,R1                 ;-CLEAR OUT COMMON DSD              
        MOV     #12.,CHARKT              ;- FOR SIX WORDS TOTAL             
	MOV	#DEFAL,R2		;-PREP FOR MOVING IN VALUES
	CALL	MOVEIT			;-GO MOVE VALUES
        MOV     #100601,UICFIL(R4)      ;-PUT DEFAULT UIC IN FRONT-FDB       
        MOV     BUF(R5),R2              ;-GET ADDR. OF BUFFER W/FILENAME      
        MOV     R4,R0                   ;-PUT FDB ADDR. IN R0                 
	CLR	PRCOD(R4)		;-CLEAR FDB STATUS CODES
        CALL    PARSE                   ;-GO PARSE FILE SPEC                
	$IF	<,CS>			;-IF ERRORS IN PARSE
	MOV	#NAMERR,@TYP(R5)	;--SHOW NAME ERROR TO USER
	$EXIT	20			;--GET OUT OF HERE
	$END				;-END IF
        $IF     <@COM(R5),EQ,#OFILR>    ;-IS IT OPEN-READ ONLY?   
        OFNB$R                          ;--YES- OPEN FOR READ ONLY      
	$IF	<,CC>			;--IF NO ERRORS ON OPEN
	READ$				;---GET FIRST BLOCK
	$IF	<,CS>			;---IF ERROR ON READ
	MOV	#FACCER,@TYP(R5)	;----SHOW ERROR TO USER
	$EXIT	20			;----GET OUT OF HERE
	$END				;---END IF
	WAIT$				;---WAIT FOR I/O COMPLETE
	$IF	<,CC>			;---IF NO ERRORS ON READ
	MOV	F.BKDS+2(R0),R1		;----GET ADDRESS OF DATA BUFFER
	MOV	R1,@CURPTR(R4)		;----STORE BLOCK POINTER
	BIS	#READ,PRCOD(R4)		;----SHOW READ ONLY
	CLC				;----CLEAR CARRY TO SKIP ERROR PROC.
	$END				;---END IF
	$END				;--END IF
        $ELSE                           ;-OTHERWISE                   
        OFNB$W                          ;--OPEN FOR WRITING NEW FILE      
	$IF	<,CC>			;--IF NO ERRORS ON OPEN
	MOV	F.BKDS+2(R0),@CURPTR(R0);---PUT IN BLOCK POINTER
	CALL	MARKVB			;---SET UP HEADER FOR NEXT WRITE
	MOV	HEDPTR(R4),R1		;---GET POINTER TO HEADER
	CLR	TH.PVB+2(R1)		;---CLEAR INITIAL VBN
	BIS	#WRITE,PRCOD(R4)	;---SHOW WRITE ACCESS ONLY
	CLC				;---CLEAR CARRY TO SKIP ERROR PROC.
	$END				;--END IF
        $END                            ;-END IF                            
        $IF     <,CS>                   ;-IF ERROR ON OPEN               
        CALL    MSSG                    ;--PRINT ERROR FOR USER          
        MOV     #NONFAT,@TYP(R5)        ;--SHOW FILE ACCESS ERROR         
	BIS	#CLOSED,PRCOD(R4)	;--SET UP FOR NEXT REQUEST
        $ELSE                           ;-OTHERWISE                     
        MOV     #FILEOP,@TYP(R5)        ;--SHOW OPEN WAS OK          
	BIS	#OPEN,PRCOD(R4)		;--SHOW FILE OPEN STATUS
        $END                            ;-END IF                          
	$END	20			;END DO
        RETURN                          ;BACK TO REQUEST DISPATCH               
	.PAGE
	.SBTTL	FILE NAME PARSER
;
;
;	THE FOLLOWING MODULE PARSES A FILE NAME INTO A DSD FOR USE IN THE
;		SYSTEM SUBROUTINE ".PARSE".
;
;	INPUTS=	R2 CONTAINS THE ADDRESS OF THE BUFFER CONTAINING THE FILE
;			NAME TO BE USED
;
;		DSD IS A COMMON STORAGE AREA FOR USE IN THE .PARSE
;			ROUTINE.
;
;
;
PARSE:
	$DO	30			;START BLOCK
	$IF	<(R2),EQ,#'D,B>		;-IF DB# SPECIFIED IN RECORD
	$ANDIF	<1(R2),EQ,#'B,B>	;-  THEN SET UP DESCRIPTOR BLOCK
	$ANDIF	<3(R2),EQ,#':,B>	;-  MAKE SURE ITS A "DB" NUMBER
	MOV	R2,DSD+2		;- - STORE ADDRESS OF STRING
	$WHILE	<(R2)+,NE,#':,B>	;- - SEARCH FOR END OF STRING
	$END				;- - ENDWHILE
	PUSH$	<R2>			;- - SAVE R2
	SUB	DSD+2,R2		;- - GET LENGTH OF STRING
	$IF	<R2,GT,#4.>		;- - IF LENGTH TO BIG THAN
	MOVB	#260,F.ERR(R0)		;- - - ERROR ON COMMAND FILE
	CLRB	F.ERR+1(R0)		;-
	CALL	MSSG			;- - - OUTPUT ERROR TO USER
	POP$	<R2>			;- - - CLEAN OFF STACK
	SEC				;- - - SHOW ERROR
	$EXIT	30			;- - - GET OUT OF HERE
	$END				;- - END IF
	MOV	R2,DSD			;- - STORE LENGTH
	POP$	<R2>			;- - RESTORE R2
	$END				;-ENDIF
	$IF	<(R2),EQ,#'[,B>		;-IF UIC SPECIFIED IN RECORD
	MOV	R2,DSD+6		;- - STORE ADDRESS OF STRING
	$WHILE	<(R2)+,NE,#'],B>	;- - SEARCH FOR END OF UIC
	$END				;- - ENDWHILE
	PUSH$	<R2>			;- - SAVE R2
	SUB 	DSD+6,R2		;- - GET LENGTH OF STRING
	$IF	<R2,GT,#9.>		;- - IF LENGTH TO BIG THAN
	MOVB	#260,F.ERR(R0)		;- - - ERROR ON COMMAND FILE
	CLRB	F.ERR+1(R0)		;-
	CALL	MSSG			;- - - OUTPUT ERROR TO USER
	POP$	<R2>			;- - - CLEAN OFF STACK
	SEC				;- - - SHOW ERROR
	$EXIT	30			;- - - GET OUT OF HERE
	$END				;- - END IF
	MOV	R2,DSD+4		;- - STORE LENGTH
	PUSH$	<R0>			;- - SAVE R0
	MOV	#DSD+4,R2		;- - PUT ADDR OF UIC STRING IN R2
	MOV	R0,R3			;- - PREP FOR CONVERTING TO BINARY
	SUB	#2.,R3			;- - ADJUST TO FRONT OF FDB
	CALL	.ASCPP			;- - CONVERT UIC STRING TO BINARY
	POP$	<R0,R2>			;- - RESTORE R2 + R0
	$END				;-ENDIF
	$IF	<(R2),NE,#40,B>		;-IF NOT =SPACE THAN FILE NAME IN RECORD
	MOV	R2,DSD+10.		;- - SAVE ADDRESS OF STRING
	$WHILE	<(R2)+,NE,#40,B>	;- - SEARCH FOR END OF STRING
	$END				;- - ENDWHILE
	DEC	R2			;- - ADJUST ADDRESS TO TRUE LOCATION
	PUSH$	<R2>			;- - SAVE R2
	SUB	DSD+10.,R2		;- - GET LENGTH OF STRING
	$IF	<R2,GT,#18.>		;- - IF LENGTH TO BIG THAN
	MOVB	#260,F.ERR(R0)		;- - - ERROR ON COMMAND FILE
	CLRB	F.ERR+1(R0)		;-
	CALL	MSSG			;- - - OUTPUT ERROR TO USER
	POP$	<R2>			;- - - CLEAN OFF THE STACK
	SEC				;- - - SHOW ERROR
	$EXIT	30			;- - - GET OUT OF HERE
	$END				;- - END IF
	MOV	R2,DSD+8.		;- - STORE LENGTH
	POP$	<R2>			;- - RESTORE R2
	$END				;-ENDIF
        MOV     R0,R1			;-SET UP FOR PARSING            
        ADD     #F.FNB,R1                                                       
	CLR	R3			;-NO DEFAULT FNB
	MOV	#DSD,R2			;-ADDR. OF DATA SET DESCR. BLOCK
        CALL    .PARSE                  ;-FILL IN OLD TAP SPEC                   
	CLC				;-SHOW PARSE WORKED
	$END	30			;END BLOCK
	RETURN				;BACK TO CALLER
;
;
	.PAGE
	.SBTTL	MARK CURRENT VBN INTO HEADER
;
;	THIS MODULE TAKES CARE OF PUTTING CURRENT VBN INFO AND OFFSET
;		POINTERS INTO THE SIMULATED HEADER. THIS IS NEEDED TO 
;		BACKWARDS IN A SIMULATED FILE
;
MARKVB:
	MOV	HEDPTR(R4),R1		;GET POINTER TO HEADER STORAGE
	MOV	F.VBN(R4),(R1)+		;STORE FIRST PART OF VBN
	MOV	F.VBN+2(R4),(R1)+	;AND SECOND PART
	MOV	@CURPTR(R4),(R1)	;GET CURRENT OFFSET POINTER
	SUB	F.BKDS+2(R4),(R1)	;SUBTRACT START OF DATA BLOCK
	RETURN				;BACK TO CALLER
	.PAGE
	.SBTTL	WRITE TAPE MARK AND EOT PROCESSOR
;
;	THIS MODULE TAKES CARE OF WRITING AN EOT MARK OR A TAPE MARK
;		TO THE FILE ON REQUEST. ALL POINTERS ARE UPDATED TO 
;		ALL FURTHER PROCESSING IF THE PROGRAMMER WISHES
;
WMARK:
	$DO	40			;START BLOCK
	CALL	GETLU			;-GET THE ADDR. OF THE FDB REQUESTED
	$IF	<#CLOSED!OPEN,OFF,PRCOD(R4)>	;-IF ERROR ON FILE ACCESS
	MOV	#FACCER,@TYP(R5)	;--SHOW FILE ERROR TO USER
	$EXIT	40			;--GET OUT OF HERE
	$END				;-END IF
	$IF	<PRCOD(R4),NE,#OPEN!WRITE>	;-IF FILE NOT OPEN FOR WRITE
	MOV	#NONFAT,@TYP(R5)	;--SHOW ERROR STATUS-DO NOTHING
	$EXIT	40			;--GET OUT OF HERE
	$END				;-END IF
	MOV	HEDPTR(R4),R1		;-GET ADDRESS TO HEADER STORAGE
	$IF	<@COM(R5),EQ,#WRITET>	;-IF THE REQUEST IS TO WRITE T.MARK
	MOV	#ST.TM,TH.RT(R1)	;--PUT IN TAPE MARK ID
	$ELSE				;-OTHERWISE
	MOV	#ST.EOT,TH.RT(R1)	;--PUT IN EOT ID
	$END				;-END IF
	MOV	#0,TH.RL(R1)		;-ZERO RECORD LENGTH
	MOV	#0,TH.RL+2(R1)		;- FOR 4 BYTES
	CALL	WHEAD			;-WRITE OUT NEW HEADER
	$IF	<,CC>			;-IF NO ERRORS FROM WHEAD
	CALL	MARKVB			;--MARK NEW VBN AND OFFSET
	ADD	#TH.HZ,@CURPTR(R4)	;--POINT PAST THIS HEADER FOR NEXT TIME
	MOV	#TWSUCC,@TYP(R5)	;--PUT IN RETURN STATUS
	$END				;-END IF
	$END	40			;END BLOCK
	RETURN				;RETURN TO CALLER
	.PAGE
	.SBTTL	WRITE OUT NEW SIMULATED HEADER
;
;	THIS MODULE TAKES CARE OF WRITING OUT A NEW HEADER TO THE FILE
;		FROM THE STORAGE POINTED TO BY HEDPTR(R4).
;
WHEAD:
	$DO	50			;START BLOCK
	MOV	@CURPTR(R4),R2		;-GET CURRENT DATA BLOCK POINTER
	MOV	F.BKDS+2(R4),R3		;-GET ADDR. OF DATA BLOCK
	ADD	#512.-TH.HZ,R3		;-POINT TO TOP-HEADER SIZE
	$IF	<R2,GT,R3>		;-IF HEADER WON'T FIT IN BLOCK
	MOV	R4,R0			;--SET FDB POINTER
	WRITE$				;--WRITE CURRENT BLOCK TO DISK
	$IF	<,CS>			;--IF ERROR ON WRITE
	CALL	MSSG			;---OUTPUT ERROR TO USER
	CLR 	PRCOD(R4)		;---CLEAR FILE STATUS TO SHOW ERROR
	MOV	#FACCER,@TYP(R5)	;---PUT IN RETURN STATUS
	SEC				;---SHOW ERROR HERE
	$EXIT	50			;---GET OUT OF HERE
	$END				;--END IF
	WAIT$				;--WAIT FOR I/O TO COMPLETE
	MOV	F.BKDS+2(R4),@CURPTR(R4);--RESET CURRENT POINTER
	$END				;-END IF
	MOV	@CURPTR(R4),R2		;-GET CURRENT BLOCK POINTER
	MOV	HEDPTR(R4),R3		;-GET ADDR. OF SIM. HEADER
	MOV	#TH.HZ,R1		;-NUMBER	OF BYTES TO DO
	$LOOP				;-
	MOVB	(R3)+,(R2)+		;--PUT IN HEADER
	$SOB	<R1>			;-KEEP GOING TILL NO MORE HEADER
	CLC				;-SHOW NO ERROR IN PROCESSING
	$END	50			;END BLOCK
	RETURN				;BACK TO CALLER
	.PAGE
	.SBTTL	CLOSE FILE PROCESSOR
;
;	THE FOLLOWING MODULE HANDLES THE COMMAND TO CLOSE THE SIMULATED
;		TAPE FILES. BOTH CLOSE W/KEEP AND CLOSE W/DELETE ARE
;		HANDLED HERE.
;
CFILE:
	$DO	60			;START BLOCK
	CALL	GETLU			;-GET FDB POINTER IN R4
	$IF	<#CLOSED,ON,PRCOD(R4)>	;-IF FILE ALREADY CLOSED 
	MOV	#FILECL,@TYP(R5)	;--SHOW RETURNED STATUS
	$EXIT	60			;--GET OUT OF HERE
	$END				;-END IF
	MOV	R4,R0			;-PUT FDB ADDR. IN R0
	$IF	<#CFILK,EQ,@COM(R5)>	;-IF CLOSE & KEEP FILE
	$IF	<#WRITE,ON,PRCOD(R4)>	;--IF FILE IS BEING CREATED
	$ANDIF	<#OPEN,ON,PRCOD(R4)>	;--AND FILE IS NOT IN ERROR
	MOV	HEDPTR(R4),R1		;---PUT IN EOT MARK
	MOV	#ST.EOT,TH.RT(R1)	;---IN FILE
	CLR	TH.RL(R1)		;---CLEAR RECORD LENGTH
	CLR	TH.RL+2(R1)		;
	CALL	WHEAD			;---WRITE OUT EOT MARK
	$IF	<,CC>			;---IF NO ERRORS
	WRITE$				;----WRITE OUT LAST BLOCK
	$IF	<,CC>			;----IF NO ERROR ON WRITE
	WAIT$				;-----WAIT FOR I/O TO COMPLETE
	$END				;----END IF
	$END				;---END IF
	$END				;--END IF
	CLOSE$				;-CLOSE FILE AND KEEP IT
	$ELSE				;OTHERWISE
	CALL	.DLFNB			;-DELETE THE FILE
	$END				;END IF
	$IF	<,CS>			;-IF ERROR ON CLOSE
	CALL	MSSG			;--PRINT OUT ERROR
	MOV	#FACCER,@TYP(R5)	;--PUT IN ERROR RET. STATUS
	CLR	PRCOD(R0)		;--SHOW FILE IN ERROR STATUS
	$ELSE				;-OTHERWISE
	MOV	#FILECL,@TYP(R5)	;--SHOW CLOSE WAS OK
	CLR	PRCOD(R4)		;--RESET FILE CLOSED STATUS
	BIS	#CLOSED,PRCOD(R4)	;-- TO SHOW CLOSED
	$END				;-END IF
	$END	60			;END BLOCK
	RETURN				;BACK TO CALLER
;
;
	.PAGE
	.SBTTL	WRITE DATA RECORD PROCESSOR
;
;	THIS MODULE TAKES CARE OF WRITING OUT DATA RECORDS TO THE SIMULATED
;		TAPE FILE. THE BYTE COUNT IS IN "CNT", AND THE DATA TO BE 
;		WRITTEN IS IN "BUF".
;
WRECRD:
	$DO	70			;START BLOCK
	CALL	GETLU			;-GET THE FDB ADDR. OF THE LU
	$IF	<#OPEN!CLOSED,OFF,PRCOD(R4)>	;-IF FILE IN ERROR CONDITION
	MOV	#FACCER,@TYP(R5)	;--PUT IN ERROR STATUS
	$EXIT	70			;--GET OUT OF HERE
	$END				;-END IF
	$IF	<PRCOD(R4),NE,#OPEN!WRITE>	;-IF CAN'T WRITE TO FILE
	MOV	#NONFAT,@TYP(R5)	;--PUT IN ERROR CONDITION
	$EXIT	70			;--GET OUT OF HERE
	$END				;-END IF
	MOV	HEDPTR(R4),R1		;-GET POINTER TO SIMULATED HEADER
	MOV	#ST.DAT,TH.RT(R1)	;-PUT IN RECORD TYPE	
	MOV	CNT(R5),R2		;-GET POINTER TO BYTE COUNT
	MOV	(R2)+,TH.RL+2(R1)	;-PUT IN BYTE COUNT
	MOV	(R2),TH.RL(R1)		;- FOR 4 BYTES
	MOV	TH.RL(R1),MOVLEN	;-PUT IN FOR TOTAL MOVE ALSO
	MOV	TH.RL+2(R1),MOVLEN+2	;- FOR 4 BYTES
	CALL	WHEAD			;-WRITE OUT NEW HEADER
	$IF	<,CS>			;-IF ERROR IN PROCESSING WHEAD
	$EXIT	70			;--GET OUT OF HERE
	$END				;-END IF
	CALL	MARKVB			;-MARK NEW BLOCK AND OFFSET
	ADD	#TH.HZ,@CURPTR(R4)	;-POINT PAST HEADER
	MOV	BUF(R5),R2		;-SET UP POINTER TO DATA
	CLR	FLIP			;-SET UP INITIAL FLIP STATE
	$LOOP				;-START MAJOR LOOP
	$LOOP				;--FOR TWICE AROUND
	MOV	@CURPTR(R4),R1		;---CALCULATE NUMBER OF BYTES IN BLOCK
	MOV	F.BKDS+2(R4),R3		;---STARTING BLOCK ADDRESS
	ADD	#512.,R3		;---POINT TO TOP OF BLOCK
	SUB	R1,R3			;---GET # OF BYTES
	$IF	<R3,LE,#0>		;---IF NO BYTES LEFT IN BLOCK
	MOV	R4,R0			;----SET UP FOR WRITE
	WRITE$				;----WRITE BLOCK TO FILE
	$IF	<,CS>			;----IF ERROR ON WRITE
	CALL	MSSG			;-----OUTPUT ERROR TO USER
	CLR	PRCOD(R4)		;-----SHOW ERROR ON STATUS
	MOV	#FACCER,@TYP(R5)	;-----PUT IN RETURN STATUS
	$EXIT	70			;-----GET OUT OF HERE
	$END				;----END IF
	WAIT$				;----WAIT FOR I/O TO COMPLETE
	MOV	F.BKDS+2(R4),@CURPTR(R4);----RESET BLOCK POINTER
	MOV	@CURPTR(R4),R1		;----RESET MEMORY POINTER
	MOV	#512.,R3		;----SHOW NEW # OF BYTES IN BLOCK
	$END				;---END IF
	MOV	R3,CHARKT		;---PUT # OF BYTES TO MOVE IN COUNTER
	$IF	<MOVLEN,EQ,#0>		;---IF MOVLEN LESS THAN CHARKT
	$ANDIF	<MOVLEN+2,LE,CHARKT>	;----
	MOV	MOVLEN+2,CHARKT		;----PUT IN NEW # OF BYTES TO MOVE
	CLR	MOVLEN+2		;----CLEAR REMAINDER
	$ELSE				;---OTHERWISE
	SUB	CHARKT,MOVLEN+2		;----SUBTRACT # OF BYTES TO DO
	SBC	MOVLEN			;----FOR 4 BYTES
	$END				;---END IF
	CALL	SWAP1			;---GO MOVE DATA-SWAPPED FORM
	MOV	R1,@CURPTR(R4)		;---STORE NEW BLOCK POINTER
	$UNTIL	<MOVLEN,EQ,#0>		;--UNTIL ALL DATA IN DISK FILE
	$UNTIL	<MOVLEN+2,EQ,#0>	;-FOR STORAGE
	MOV	R1,@CURPTR(R4)		;-STORE NEW CURRENT BLOCK POINTER
	MOV	#TWSUCC,@TYP(R5)	;-SHOW WRITE WAS OK
	$END	70			;END BLOCK
	RETURN				;BACK TO CALLER
;
;
	.PAGE
	.SBTTL	READ RECORD PROCESSOR
;
;	THIS MODULE TAKES CARE OF READING A RECORD FROM A FILE AND REPORTING
;		THE RESULTS BACK TO THE USER.
;
;	IF THE TAPE IS AT THE EOT MARK, ANY FURTHER READS WILL RETURN WITH
;		A STATUS OF EOT DETECTED. THE ONLY ACTION LEFT IS TO CLOSE
;		THE FILE.
;
;	IF THE READ IS A DATA RECORD THE LENGTH OF THE DATA PUT IN THE BUFFER
;		SPECIFIED IN "BUF" IS THE SMALLER OF THE FOLLOWING 2 NO.
;			1.NUMBER SPECIFIED IN "CNT"
;			2.ACTUAL LENGTH OF DATA RECORD
;		THIS IS DONE TO CONSERVE SPACE IN THE FORTRAN PROGRAM
;		WHEN READING LARGE RECORDS AND ALL THAT IS NEEDED IS THE
;		FIRST PART.
;
;	THE MAXIMIUM DATA RECORD SIZE IS 2147483647 BYTES.
;
RRECRD:
	CALL	GETLU			;GET FDB POINTER INTO R4
	$IF	<#OPEN!CLOSED,OFF,PRCOD(R4)>	;IF FILE IN ERROR
	MOV	#FACCER,@TYP(R5)	;-RETURN FILE ERROR STATUS
	JMP	RRECND			;-SKIP OVER REST
	$END				;END IF
	$IF	<#PHYEOT,ON,PRCOD(R4)>	;IF EOT HAS BEEN REACHED
	MOV	#EOTDET,@TYP(R5)	;-SHOW EOT DETECT AGAIN
	JMP	RRECND			;-GET OUT OF HERE
	$END				;END IF
	$IF	<PRCOD(R4),NE,#OPEN!READ>;IF FILE NOT OPEN FOR READ
	MOV	#NONFAT,@TYP(R5)	;-SHOW FILE ACCESS ERROR TO USER
	JMP	RRECND			;-GET OUT OF HERE
	$END				;END IF
	MOV	@CURPTR(R4),R3		;GET CURRENT BLOCK POINTER
	MOV	F.BKDS+2(R4),R2		;GET START ADDR. OF DATA BLOCK
	ADD	#512.-TH.HZ,R2		;POINT TO TOP OF BLOCK
	MOV	R4,R0			;PUT FDB ADDR. IN R0
	$IF	<R3,GT,R2>		;IF NEXT HEADER NOT IN THIS BLOCK
	READ$				;-READ IN NEXT BLOCK
	WAIT$				;-WAIT FOR I/O COMPLETE
	$IF	<,CS>			;-IF ERROR ON READ
	MOV	#FACCER,@TYP(R5)	;--SHOW ERROR TO USER
	CLR	PRCOD(R4)		;--SAVE NEW FILE STATUS
	JMP	RRECND			;--GET OUT OF HERE
	$END				;-END IF
	MOV	F.BKDS+2(R0),R3		;-RESET BLOCK POINTER
	MOV	R3,@CURPTR(R4)		;-STORE NEW CURRENT POINTER
	$END				;END IF
	MOV	R3,R1			;PREP FOR MOVING CURRENT HEADER
	MOV	HEDPTR(R4),R2		;GET ADDR. TO STORE SIM. HEADER
	MOV	#TH.HZ,R0		;NUMBER OF BYTES TO MOVE
	$LOOP				;
	MOVB	(R1)+,(R2)+		;STORE NEW CURRENT HEADER
	$SOB	<R0>			;FOR 'TH.HZ' BYTES
;
;	THE FOLLOWING SECTION TAKES CARE OF TAPE MARKS BEING READ ON THE 
;		INPUT RECORD
;
	$IF	<TH.RT(R3),EQ,#ST.TM,B>	;IF CURRENT RECORD IS A TAPE MARK
	MOV	#TMDET,@TYP(R5)		;-SHOW T. MARK TO USER
	MOV	R1,@CURPTR(R4)		;-STORE UPDATED BLOCK POINTER
	JMP	RRECND			;-GET OUT OF HERE
	$END				;END IF
;
;	THE FOLLOWING SECTION TAKES CARE OF PHYSICAL EOT MARKS BEING
;		READ ON THE INPUT RECORD
;
	$IF	<TH.RT(R3),EQ,#ST.EOT,B>;IF CURRENT REC. IS PHYSICAL EOT
	MOV	#EOTDET,@TYP(R5)	;-SHOW EOT TO USER
	BIS	#PHYEOT,PRCOD(R4)	;-SET EOT STATUS FOR NEXT TIME
	JMP	RRECND			;-LEAVE-DO NOT UPDATE B.POINTER
	$END				;END IF
;
;	THE FOLLOWING SECTION TAKES CARE OF AN ILLEGAL VALUE FOR THE 
;		TYPE OF RECORD CURRENTLY BEING POINTED TO. ANY FURTHER
;		ACCESS TO THE FILE IS DENIED
;
	$IF	<TH.RT(R3),NE,#ST.DAT,B>;IF RECORD TYPE NOT DATA
	MOV	#FACCER,@TYP(R5)	;-SHOW FILE CORRUPTION TO USER
	CLR	PRCOD(R4)		;-SHOW ERROR IN FILE STATUS
	CLRB	F.ERR+1(R4)		;-PREP FOR PRINTING OUT ERROR
	MOVB	#260,F.ERR(R4)		;- ON FILE 
	MOV	R4,R0			;-RESET FDB POINTER
	CALL	MSSG			;-PRINT ERROR MSSG
	JMP	RRECND			;-GET OUT OF HERE
	$END				;END IF
;
;	FROM HERE ON IS THE PROCESSING TO READ DATA RECORDS FOR THE USER.
;		THE LENGTH OF THE RECORD PUT INTO THE USER BUFFER IS THE 
;		SMALLER LENGTH OF THE FOLLOWING TWO ITEMS:
;			1. LENGTH IN "CNT"
;			2. ACTUAL LENGTH OF DATA RECORD IN FILE
;	THE FILE POINTERS ARE UPDATED FOR THE NEXT READ NO MATTER WHICH
;		LENGTH IS USED.
;
	MOV	HEDPTR(R4),R1		;GET POINTER TO CURRENT HEADER
	MOV	TH.RL(R1),CHARKT	;STORE RECORD LENGTH
	MOV	TH.RL+2(R1),CHARKT+2	; FOR 4 BYTES
	MOV	CNT(R5),R2		;GET ADDR. OF 'CNT'
	SUB	(R2),CHARKT+2		;SUBTRACT CNT FROM RL
	SBC	CHARKT			;FOR 4 BYTES
	SUB	2(R2),CHARKT		;
	$IF	<#40,ON,CHARKT,B>	;IF MSB = 1 R.LENGTH IS SMALLER
	MOV	TH.RL(R1),MOVLEN	;-PUT R.LENGTH IN FOR MOVEIT
	MOV	TH.RL+2(R1),MOVLEN+2	;-FOR 4 BYTES
	MOV	CNT(R5),R2		;-GET POINTER TO BYTE COUNT
	MOV	TH.RL(R1),2(R2)		;-STORE NEW BYTE COUNT
	MOV	TH.RL+2(R1),(R2)	;- FOR 4 BYTES
	$ELSE				;OTHERWISE
	MOV	@CURPTR(R4),R1		;GET CURRENT BLOCK POINTER
	MOV	2(R2),MOVLEN		;-'CNT' IS SMALLER
	MOV	(R2),MOVLEN+2		;-PUT IT IN FOR MOVEIT
	BIS	#RECSKP,PRCOD(R4)	;-SET INDICATOR TO SHOW SIZE SMALLER
	MOV	TH.RL(R1),R2		;-THAN TRUE RECORD SIZE
	MOV	TH.RL+2(R1),R3		;-
	SUB	F.BKDS+2(R4),R1		;-SUB START ADDR. OF BLOCK
	ADD	R1,R3			;-ADD IN CURRENT  OFFSET
	ADC	R2			;-ADD IN CARRY
	ADD	#TH.HZ,R3		;-ADD IN HEADER SIZE
	DIV	#512.,R2		;-DIV. LENGTH BY 512.
	$IF	<R3,GT,#512.>		;-IF OFFSET GREATER THAN 512.
	ADD	#1.,R2			;--INCREMENT BLOCK COUNT
	SUB	#512.,R3		;--SUB. OUT ONE BLOCK=512. BYTE
	$END				;-END IF
	ADD	F.BKDS+2(R4),R3		;-ADD IN BASE OF DATA BLOCK
	MOV	R3,NOFFST		;-STORE NEW OFFSET
	MOV	F.VBN(R4),NVBN		;-STORE NEW VBN NO.
	MOV	F.VBN+2(R4),NVBN+2	;-FOR 4 BYTES
	ADD	R2,NVBN+2		;-ADD IN NEW VBN NO.
	ADC	NVBN			;-CARRY TO
	$END				;END IF
	MOV	BUF(R5),R1		;GET USER BUFFER POINTER
	MOV	@CURPTR(R4),R2		;GET CURRENT BLOCK POINTER
	ADD	#TH.HZ,R2		;POINT PAST SIM. HEADER
	MOV	#0,FLIP			;SET UP INITIAL SWAP INDICATOR
	$LOOP				;START FIRST LOOP
	$LOOP				;-START SECOND LOOP
	MOV	F.BKDS+2(R4),R3		;--GET BLOCK POINTER
	ADD	#512.,R3		;--POINT TO TOP OF BLOCK
	SUB	R2,R3			;--CALC. # OF BYTES IN BUFFER
	$IF	<R3,LE,#0>		;--IF NONE LEFT IN BUFFER
	MOV	R4,R0			;---RESET FDB POINTER
	READ$				;---GET NEXT BLOCK
	$IF	<,CS>			;---IF ERROR ON READ
	CALL	MSSG			;----OUTPUT ERROR TO USER
	CLR	PRCOD(R4)		;----SET ERROR FILE STATUS
	MOV	#FACCER,@TYP(R5)	;----PUT IN RETURN VALUE
	$END				;---END IF
	WAIT$				;---WAIT FOR I/O TO COMPLETE
	MOV	F.BKDS+2(R4),R2		;---RESET BLOCK POINTER
	MOV	#512.,R3		;---RESET NUMBER OF BYTES IN BLOCK
	$END				;--END IF
	$IF	<MOVLEN,NE,#0>		;--IF DATA SPANS BLOCKS
	$ORIF	<MOVLEN+2,GE,R3>	;---
	MOV	R3,CHARKT		;---PUT IN # OF BYTES TO MOVE
	MOV	MOVLEN+2,R3		;---GET # OF BYTES FOR NEXT TIME
	SUB	CHARKT,R3		;---
	SBC	MOVLEN			;---TAKE CARE OF CARRY
	MOV	R3,MOVLEN+2		;---STORE NEW LENGTH
	$ELSE				;--OTHERWISE
	MOV	MOVLEN+2,CHARKT		;---PUT IN # OF BYTES TO MOVE
	CLR	MOVLEN+2		;---NO MORE AFTER THIS
	$END				;--END IF
	CALL	SWAPIT			;--GO MOVE DATA IN SWAPPED FORM
	$IF	<MOVLEN,NE,#0>		;--IF MORE DATA
	$ORIF	<MOVLEN+2,NE,#0>	;---
	MOV	R4,R0			;---RESET FDB POINTER
	READ$				;---READ NEXT BLOCK
	$IF	<,CS>			;---IF ERROR ON READ
	CLR	PRCOD(R4)		;----SHOW NEW STATUS
	CALL	MSSG			;----PRINT OUT ERROR MSSG
	MOV	#FACCER,@TYP(R5)	;----SHOW ERROR TO USER
	JMP	RRECND			;----GET OUT OF HERE
	$END				;---END IF
	WAIT$				;---WAIT FOR I/O TO COMPLETE
	MOV	F.BKDS+2(R0),R2		;---RESET BLOCK POINTER
	$END				;--END IF
	$UNTIL	<MOVLEN+2,EQ,#0>	;-KEEP GOING TILL DONE
	$UNTIL	<MOVLEN,EQ,#0>		;MAKE SURE BOTH WORDS ARE ZERO
	$IF	<#RECSKP,ON,PRCOD(R4)>	;IF LENGTH OF TRANSFER LESS THEN TRUE
	$IF	<F.VBN(R4),NE,NVBN>	;-AND IF CURRENT VBN .NE. NVBN
	$ORIF	<F.VBN+2(R4),LT,NVBN+2>	;- FOR 4 BYTES
	MOV	R4,R0			;-RESTORE FDB POINTER
	$LOOP				;--LOOP TILL VBN IS WHERE IT BELONGS
	$LOOP				;---FOR 4 BYTES
	READ$				;----READ IN A BLOCK
	$IF	<,CS>			;----IF AN ERROR IN READ
	CALL	MSSG			;-----OUTPUT ERROR TO USER
	CLR	PRCOD(R4)		;-----SHOW FILE ERROR STATUS 
	MOV	#FACCER,@TYP(R5)	;-----PUT IN ERROR RETURN STATUS
	JMP	RRECND			;-----GET OUT OF HERE
	$END				;----END IF
	WAIT$				;----WAIT FOR I/O TO COMPLETE
	$UNTIL	<F.VBN(R0),EQ,NVBN>	;---UNTIL VBN IS WERE IT BELONGS
	$UNTIL	<F.VBN+2(R0),EQ,NVBN+2>	;--FOR 4 BYTES
	$END				;-END IF
	MOV	NOFFST,@CURPTR(R4)	;-STORE NEW OFFSET
	BIC	#RECSKP,PRCOD(R4)	;-CLEAR RECORD SKIP INDICATOR
	$ELSE				;OTHERWISE
	MOV	R2,@CURPTR(R4)		;-STORE NEW POINTER
	$END				;END IF
	MOV	#DRDET,@TYP(R5)		;PUT IN RETURN STATUS
RRECND:
	RETURN				;BACK TO CALLER
	.PAGE
	.SBTTL	MOVE DATA WITH A WORD SWAP 
;
;	THIS MODULE TAKES CARE OF TRANSFERING DATA TO A USER BUFFER WITH THE
;		WORDS IN SWAPPED FORM.
;
SWAPIT:
	$LOOP				;LOOP TILL CHARKT = 0
	$IF	<FLIP,EQ,#0>		;IF FIRST HALF OF WORD
	MOV	(R2)+,2(R1)		;-MOV IN FIRST HALF OF WORD
	$ELSE				;OTHERWISE
	MOV	(R2)+,(R1)		;-MOVE IN SECOND HALF OF WORD
	ADD	#4,R1			;-POINT TO NEXT GROUP OF 32 BITS
	$END				;END IF
	MOV	#1,R3			;SET UP FOR FLIP
	XOR	R3,FLIP			;GET FLIP VALUE
	DEC	CHARKT			;DECREASE # BYTES
	DEC	CHARKT			; HANDLING 2 BYTES AT A TIME
	$UNTIL	<CHARKT,EQ,#0>		;KEEP GOING TILL 0
	RETURN				;BACK TO CALLER
;
;
	.PAGE
	.SBTTL	SWAP OUTPUT FOR WRITING TO DATA FILE
;
;	THIS MODULE TAKES CARE OF PUTTING THE DATA IN THE FILE IN SWAPPED 
;		WORD FORMAT. THIS IS THE REVERSE OF THE SWAPIT ROUTINE
;		FOR READING DATA FROM A FILE.
;
SWAP1:
	$LOOP				;LOOP TILL CHARKT = 0
	$IF	<FLIP,EQ,#0>		;IF FIRST HALF OF WORD
	MOV	2(R2),(R1)+		;-MOV	IN FIRST HALF
	$ELSE				;OTHERWISE
	MOV	(R2),(R1)+		;-MOVE SECOND HALF
	ADD	#4,R2			;-POINT TO NEXT GROUP OF 32 WORDS
	$END				;END IF
	MOV	#1,R3			;SET UP FOR FLIP
	XOR	R3,FLIP			;GET FLIP VALUE
	DEC	CHARKT			;DECREASE CHARKT
	DEC	CHARKT			; BY 2 BYTES
	$UNTIL	<CHARKT,EQ,#0>		;KEEP GOING TILL ZERO
	RETURN				;BACK TO CALLER
;
;
	.PAGE
	.SBTTL	BACK-UP ONE RECORD PROCESSOR
;
;	THIS MODULE TAKES CARE OF BACKING UP ONE RECORD IN THE FILE. THE
;		FILE MUST BE OPEN FOR READ FOR THIS TO TAKE PLACE
;
BACKUP:
	$DO	100			;START BLOCK
	CALL	GETLU			;-GET FDB ADDR. INTO R4
	$IF	<#OPEN!CLOSED,OFF,PRCOD(R4)>	;-IF FILE IN ERROR CONDITION
	MOV	#FACCER,@TYP(R5)	;--SHOW ERROR TO USER PROGRAM
	$EXIT	100			;--GET OUT OF HERE
	$END				;-END IF
	$IF	<#READ,OFF,PRCOD(R4)>	;-IF THE FILE NOT OPEN FOR READ
	MOV	#NONFAT,@TYP(R5)	;--PUT IN ERROR CODE
	$EXIT	100			;--GET OUT OF HERE
	$END				;-END IF
	MOV	HEDPTR(R4),R3		;-GET POINTER TO PREVIOUS HEADER
	$IF	<TH.PVB(R3),NE,#0>	;-IF NOT AT THE BEGGINING
	$ORIF	<TH.PVB+2(R3),NE,#0>	;--FOR 4 BYTES
	MOV	TH.PVB(R3),F.VBN(R4)	;--RESET VBN TO BACK UP
	MOV	TH.PVB+2(R3),F.VBN+2(R4);-- FOR 4 BYTES
	MOV	TH.PO(R3),@CURPTR(R4)	;--RESET CURRENT BLOCK POINTER
	ADD	F.BKDS+2(R4),@CURPTR(R4);--ADD IN STARTING ADDR.
	MOV	R4,R0			;--SET UP TO READ BLOCK
	READ$				;--READ NEW BLOCK
	$IF	<,CS>			;--IF ERROR ON READ
	CALL	MSSG			;---OUTPUT ERROR TO USER
	CLR	PRCOD(R4)		;---PUT IN NEW FILE STATUS
	MOV	#FACCER,@TYP(R5)	;---PUT IN RETURN STATUS
	$EXIT	100			;---GET OUT OF HERE
	$END				;--END IF
	WAIT$				;--WAIT FOR I/O TO COMPLETE
	MOV	@CURPTR(R4),R2		;--SET UP TO GET NEW HEADER
	MOV	HEDPTR(R4),R1		;-- 
	MOV	#TH.HZ,CHARKT		;--# OF BYTES TO MOVE
	CALL	MOVEIT			;--GO MOVE IN NEW HEADER
	MOV	HEDPTR(R4),R3		;--RESET POINTER TO HEADER
	BIT	#7.,TH.RT(R3)		;--CLEAR OUT TOP BYTES
	MOV	TH.RT(R3),@TYP(R5)	;--PUT IN RETURN STATUS
	$ELSE				;-OTHERWISE
	MOV	#BOT,@TYP(R5)		;--PUT IN B.O.T. STATUS
	$END				;-END IF
	$END	100			;END BLOCK
	RETURN				;RETURN
;
;
	.PAGE
	.SBTTL	MOVEIT SUBROUTINE
;
;	THIS MODULE MOVES DATA AROUND
;
MOVEIT:
	$LOOP				;DO TILL CHARKT = 0
	MOVB	(R2)+,(R1)+		;-MOVE DATA
	DEC	CHARKT			;-DECREASE # BYTES TO MOVE
	$UNTIL	<CHARKT,EQ,#0>		;BACK IF CHARKT .NE. TO 0
	RETURN				;BACK TO CALLER
;
;
	.PAGE
	.SBTTL	GET ADDRESS OF FDB INTO R4
;
;	THIS MODULE GETS THE ADDRESS OF THE FDB ASSOCIATED WITH THE 
;		LOGICAL UNIT NUMBER INTO R4 FOR USE IN ACCESSING THE 
;		FILE ON DISK. THE LOGICAL UNIT NUMBERS GO FROM 1 TO 5
;		AND MUST BE ADJUSTED TO GO TO 0 TO 4. THE LOGICAL UNIT
;		NUMBER IS A PARAMETER PASSED TO "SIMTAP" WHEN CALLED.
;
GETLU:
        MOV     @LU(R5),R4              ;GET LOGICAL UNIT NO.                   
	DEC	R4			;ADJUST TO 0-4 NUMBER
        CLC                             ;CLEAR CARRY TO MULT BY 2               
        ROL     R4                      ;MULT BY 2- NOW TRUE OFFSET             
        ADD     #FDBPTR,R4              ;ADD IN START TBL ADDR.                 
        MOV     (R4),R4                 ;GET POINTER TO FDB                     
	RETURN				;BACK TO CALLER
	.PAGE
	.SBTTL	GET FILE NAME INTO BUFFER 
;
;		PLACE THE COMPLETE FILE SPEC. IS PLACED INTO THE BUFFER
;	"BUF" WITH THE LENGTH OF THE FILE SPEC. IN BYTES PLACED IN THE 
;	"CNT" PARAMETER. 
;
NAMGET:
	$DO	110
	CALL	GETLU			;GET THE FDB ADDR.
	$IF	<#OPEN,OFF,PRCOD(R4)>	;IF FILE NOT OPEN
	MOV	#NONFAT,@TYP(R5)	;-PUT IN ERROR CODE
	$EXIT	110			;-BLAST OUT OF HERE
	$END				;END IF
	MOV	BUF(R5),R0		;PREP FOR GETTING FILE SPEC
	MOV	R4,R1			;PUT IN FDB ADDR.
	ADD	#F.FNB,R1		;POINT TO FNB
	MOV	UICFIL(R4),R2		;GET UIC OF FILE
	CALL	FILNAM			;DEVELOPE FILE NAME
	SUB	BUF(R5),R0		;GET NUMBER OF CHARACTERS
	MOV	CNT(R5),R1		;GET POINTER TO "CNT" PARAMETER
	MOV	R0,(R1)+		;STORE BYTE COUNT
	CLR	(R1)			;CLEAR UPPER WORD ON I*4
	MOV	#NAMEOK,@TYP(R5)	;PUT IN OK STATUS
	$END	110			;END BLOCK
	RETURN
	.PAGE
	.SBTTL	CONSTANT STORAGE
;
;
;	ALL THE CONSTANTS NEEDED IN THE PROGRAM ARE STORED HERE. CARE
;		MUST BE TAKEN NOT TO MOVE ITEMS AROUND.
;
;
LU1FDB: LUFDB   7.,LU1BUF,HED1          ;FDB'S FOR SIMULATED TAPE               
LU2FDB: LUFDB   8.,LU2BUF,HED2          ; FILES. ONE FOR EACH LOGICAL           
LU3FDB: LUFDB   9.,LU3BUF,HED3          ; UNIT NO.                              
LU4FDB: LUFDB   10.,LU4BUF,HED4                                                 
LU5FDB: LUFDB   11.,LU5BUF,HED5                                                 
FDBPTR: .WORD   LU1FDB+FDBOFF,LU2FDB+FDBOFF,LU3FDB+FDBOFF  ;TABLE OF ADDR.
        .WORD   LU4FDB+FDBOFF,LU5FDB+FDBOFF                                   
DSD:    .BLKW   6.                      ;COMMON DSD FOR FILE OPEN               
NVBN:	.BLKW	2.			;STORAGE FOR NEW VIRT. BLOCK NO.
NOFFST:	.BLKW	1.			;SRORAGE FOR NEW OFFSET
CHARKT:	.BLKW	4.			;CHARACTER COUNT
MOVLEN:	.BLKW	2.			;NO. OF CHAR. TO READ IN
FLIP:	.WORD	0			;FLIP SWITCH FOR MOVE
;
;	THE FOLLOWING IS THE DEFAULT FILE NAME BLOCK USED BY .PARSE
;		DO NOT TOUCH THIS SEQUENCE!!!!!!!!!!!!!!!
;
DFNAM:	.ASCII	/TEMP.TAP;0/		;DEFAULT FILE NAME
DFNAML=.-DFNAM				;LENGTH OF STRING
DFUNT:	.ASCII	/DB0:/			;DEVICE NAME AND UNIT
DFUNTL=.-DFUNT				;LENGTH OF STRING
;
;	THE DEFAULT UIC DESCRIPTOR FOLLOWS
;
DEFUIC:
	.ASCII	/[201,201]/
UICLEN=.-DEFUIC
;
;	FOLLOWING IS THE DEFUALT DESCR. BLOCK
;
	.EVEN
DEFAL:
	.WORD	DFUNTL,DFUNT		;ADDRESS + LENGTHS
	.WORD	UICLEN,DEFUIC
	.WORD	DFNAML,DFNAM
;
;
	.PAGE
	.SBTTL	ERROR PROCESSOR
;
;
;	PAUL D. CLAYTON     15-OCT-79   RMS @ NADC WARMINSTER, PA.
;
;	WHEN CONTROL GETS HERE AN UNRECOVERABLE DISK ERROR HAS OCCURED. THE
;		VALUE OF F.ERR+1 IS PRINTED OUT FIRST. F.ERR IS THEN USED
;		AS AN INDEX INTO AN ERROR MESSAGE TABLE. THE CORRESPONDING
;		ERROR MESSAGE IS THEN PRINTED OUT TO THE TERMINAL. THE LAST
;		EVENT TO OCCUR IS THE PRINTING OUT OF THE COMPLETE FILE 
;		SPECIFICATION FOR THE OFFENDING FILE.
;
;	INPUTS::
;
;		R0 =	ADDRESS OF FDB FOR FILE THAT CAUSED THE ERROR
;
;
;
	.MCALL	EXIT$S,$STRUC,PUSH$,POP$
	.MCALL	QIOW$S,$SOB
	$STRUC				;STRUCTURED MACROS INVOKED
        .EVEN
MSSG:
	PUSH$	<R0>		;SAVE FDB ADDRESS
	MOVB	F.ERR+1(R0),R1	;GET ERROR CODE BYTE
	NEG	R1		;GET TRUE VALUE
	CLR	R2		;WIPE FLAGS TO ZERO
	MOV	#PROMPT+27.,R0	;POSITION IN OUTPUT BUFFER
	CALL	$CBDMG		;GO CONVERT BINARY TO DECIMAL ASCII
        MOV     #MSSG1,R0
        MOV     #PROMPT,R1
	$WHILE	<(R0),NE,#0,B>	;MOVE MESSAGE TILL NULL FOUNND
	MOVB    (R0)+,(R1)+       ;-MOVE IN 1ST PROMPT MESSAGE
	$END			  ;END WHILE
        QIOW$S  #IO.WLB,#5,#1,,#IOST,,<#PROMPT,#LENA,#40>    ;WRITE LINE
        MOV     #PROMPT,R0        ;CLEAR OUTPUT BUFFER
        MOV     #50.,R1
	$LOOP			  ;CLEAR FOR 50 BYTES
	MOVB    #40,(R0)+	  ;-FILL WITH SPACES
	$SOB	<R1>		  ;KEEP GOING TILL R1=0
	MOV	(SP),R0		  ;RESTORE ADDRESS OF FDB
	$IF	<F.ERR+1(R0),EQ,#0,B>	;IF FCS ERROR
	MOVB	F.ERR(R0),R2	  ;-RELOAD ERROR CODE
        NEG     R2                ;-GET TRUE VALUE
        MOV     #ERRMSG,R1         ;-PREP FOR SCANNING ERROR MSSGS.
	DEC   R2                 ;-ADJUST COUNT
	$LOOP
	$WHILE	<(R1)+,NE,#0,B>	  ;--SEARCH FOR ENDING NULL
	$END			  ;--END WHILE
	$SOB	<R2>		  ;-KEEP GOING TILL CORRECT MESSAGE FOUND
	MOV     #PROMPT,R0        ;-MOVE MESSAGE TO OUTPUT BUFFER
	$WHILE <(R1),NE,#0,B>	  ;-MOVE IN ASCII ERROR MESSAGE
	MOVB    (R1)+,(R0)+
	$END			  ;-END WHILE
        QIOW$S  #IO.WLB,#5,#1,,#IOST,,<#PROMPT,#LENB,#40> ;-WRITE 2ND LIN
	$END			  ;END IF
	POP$	<R0>		  ;CLEAN STACK POINTER
	PUSH$	<R0>		;GET FDB ADDR. AGAIN
	MOV	R0,R1		;SET UP FOR FILE NAME
	ADD	#F.FNB,R1	;ADDR. OF FNB IN R1
	MOV	-2(R0),R2	;GET UIC OF FILE
	MOV	#PROMPT,R0	;CLEAN OUTPUT BUFFER
	MOV	#70.,R3		;FOR 70. BYTES
	$LOOP
	MOVB	#40,(R0)+	;-CLEAR WITH SPACES
	$SOB	<R3>
	MOV	#PROMPT,R0	;RESET R0
	CALL	FILNAM		;GET FILE SPEC
	QIOW$S	#IO.WLB,#5,#1,,#IOST,,<#PROMPT,#LENB,#40>  ;WRITE LINE
	POP$	<R0>			;RESTORE R0
MSSGEND:			
	RETURN			;BACK TO CALLER
;
;
	.PAGE
	.SBTTL	PRINT A COMPLETE FILE SPECIFACTION
;
;
; GENERATE A COMPLETE FILE SPECIFICATION FROM AN FDB.
;
;
;
; INPUTS:
;         R0        BUFFER ADDRESS (AT LEAST 34. CHARACTERS).
;         R1        FILENAMEBLOCK ADDRESS.
;         R2        BINARY UIC FOR THE FILE.
; OUTPUTS:
;         R0        ADDRESS OF NEXT CHARACTER POSITION IN BUFFER.
;         ALL OTHER REGISTERS UNCHANGED.
;
;
;
FILNAM:
	  MOV	R1,-(SP)		;SAVE REGISTERS
	  MOV	R2,-(SP)
	  MOV	R3,-(SP)
	  MOV	R4,-(SP)
; MOVE DEVICE NAME AND UNIT NUMBER.
          MOVB      N.DVNM(R1),(R0)+
          MOVB      N.DVNM+1(R1),(R0)+
          MOV       N.UNIT(R1),R1
          CLR       R2
          CALL      $CBOSG
          MOVB      #':,(R0)+
;
; GET UFD .
          MOV       R0,R2
          MOV       4(SP),R3            ; R3=UIC (FROM SAVED R2).
          CLR       R4
          CALL      .PPASC
          MOV       R2,R0
;
; MOVE IN FILENAME, TYPE AND VERSION.
          MOV       6(SP),R3            ; GET FNB ADDRESS FROM SAVED R1.
          ADD       #N.FNAM,R3          ; R3=ADDRESS OF FILENAME RAD50.
          MOV       (R3)+,R1            ; CONVERT FILENAME TO ASCII.
          CALL      $C5TA
          MOV       (R3)+,R1
          CALL      $C5TA
          MOV       (R3)+,R1
          CALL      $C5TA
          $WHILE    <-(R0),EQ,#40,B>    ; BACKSPACE OVER BLANKS.
          $END
          INC       R0
          MOVB      #'.,(R0)+
          MOV       (R3)+,R1            ; DO FILE TYPE.
          CALL      $C5TA
          $WHILE    <-(R0),EQ,#40,B>    ; BACKSPACE OVER BLANKS.
          $END
          INC       R0
          MOVB      #';,(R0)+
          MOV       (R3),R1             ; DO VERSION NUMBER.
          CLR       R2
          CALL      $CBOSG
;
; RETURN.
;
	  MOV	(SP)+,R4
	  MOV	(SP)+,R3
	  MOV	(SP)+,R2
	  MOV	R0,R1
	  MOV	(SP)+,R1
          RETURN
        .EVEN
	.NLIST	BEX
	.PAGE
PROMPT: .BLKB   70.               ;OUTPUT BUFFER
MSSG1:  .ASCIZ  /THE VALUE OF F.ERR+1 IS -/
IOST:   .WORD   10,70.            ;QIO STATUS BLOCK
LENA=39.
LENB=70.
ERRMSG: .ASCIZ  /BAD PARAMETERS   SSC=-1/
        .ASCIZ  /INVALID FUNCTION CODE    SSC=-2/
        .ASCIZ  /DEVICE NOT READY   SSC=-3/
        .ASCIZ  /PARITY ERROR ON DEVICE  SSC=-4/
        .ASCIZ  /HARDWARE OPTION NOT PRESENT  SSC=-5/
        .ASCIZ  /ILLEGAL USER BUFFER  SSC=-6/
        .ASCIZ  /DEVICE NOT ATTACHED  SSC=-7/
        .ASCIZ  /DEVICE ALREADY ATTACHED   SSC=-8/
        .ASCIZ  /DEVICE NOT ATTACHABLE  SSC=-9/
        .ASCIZ  /END OF FILE DETECTED  SSC=-10/
        .ASCIZ  /END OF VOLUME DETECTED  SSC=-11/
        .ASCIZ  /WRITE ATTEMPTED TO LOCKED UNIT  SSC=-12/
        .ASCIZ  /DATA OVERRUN  SSC=-13/
        .ASCIZ  /SEND OR RECIEVE FAILURE   SSC=-14/
        .ASCIZ  /REQUEST TERMINATED   SSC=-15/
        .ASCIZ  /PRIVILEGE VIOLATION  SSC=-16/
        .ASCIZ  /SHAREABLE RESOURE IN USE   SSC=-17/
        .ASCIZ  /ILLEGAL OVERLAY REQUEST SSC=-18/
        .ASCIZ  /ODD BYTE COUNT OR VIRTUAL ADDRESS SSC=-19/
        .ASCIZ  /LOGICAL BLOCK NUMBER TO LARGE  SSC=-20/
        .ASCIZ  /INVALID UDC MODULE #  SSC=-21/
        .ASCIZ  /UDC CONNECT ERROR  SSC=-22/
        .ASCIZ  /CALLERS MODES EXHAUSTED  FPC=-23/
        .ASCIZ  /DEVICE FULL  FPC=-24/
        .ASCIZ  /INDEX FILE FULL  FPC=-25/
        .ASCIZ  /NO SUCH FILE  FPC=-26/
        .ASCIZ  /LOCKED FROM WRITE ACCESS  FPC=-27/
        .ASCIZ  /FILE HEADER FULL FPC=-28/
        .ASCIZ  /ACCESSED FOR WRITE  FPC=-29/
        .ASCIZ  /FILE HEADER CHECKSUM FAILURE  FPC=-30/
        .ASCIZ  /ATTRIBUTE CONTROL LIST FORMAT ERROR  FPC=-31/
        .ASCIZ  /FILE PROCESSOR DEVICE READ ERROR  FPC=-32/
        .ASCIZ  /FILE PROCESSOR DEVICE WRITE ERROR  FPC=-33/
        .ASCIZ  /FILE ALREADY ACCESSED ON LUN  FPC=-34/
        .ASCIZ  /FILE ID,FILE NUMBER CHECK  FPC=-35/
        .ASCIZ  /FILE ID,SEQUENCE NUMBER CHECK  FPC=-36/
        .ASCIZ  /NO FILE ACCESSED ON LUN  FPC=-37/
        .ASCIZ  /FILE WAS NOT PROPERLY CLOSED  FPC=-38/
        .ASCIZ  /OPEN-NO BUFFER SPACE AVAILABLE FOR FILE FCS=-39/
        .ASCIZ  /ILLEGAL RECORD SIZE  FCS=-40/
        .ASCIZ  /FILE EXCEEDS SPACE ALLOCATED,NO BLOCKS FCS=-41/
        .ASCIZ  /ILLEGAL OPERATION ON FILE DESCRIPTOR BLOCK FCS=-42/
        .ASCIZ  /BAD RECORD TYPE  FCS=-43/
        .ASCIZ  /ILLEGAL RECORD ACCESS BITS SET FCS=-44/
        .ASCIZ  /ILLEGAL RECORD ATTRIBUTES BITS SET FCS=-45/
        .ASCIZ  /ILLEGAL RECORD NUMBER-TOO LARGE FCS=-46/
        .ASCIZ  /MULTIPLE BLOCK READ OR WRITE-NOT IMPLEMENTED YET FCS=-47/
        .ASCIZ  /RENAME-2 DIFFERENT DEVICES FCS=-48/
        .ASCIZ  /RENAME-NEW FILE NAME ALREADY IN USE  FCS=-49/
        .ASCIZ  /BAD DIRECTORY FILE  FCS=-50/
        .ASCIZ  /CAN'T RENAME OLD FILE SYSTEM  FCS=-51/
        .ASCIZ  /BAD DIRECTORY SYNTAX  FCS=-52/
        .ASCIZ  /FILE ALREADY OPEN  FCS=-53/
        .ASCIZ  /BAD FILE NAME  FCS=-54/
        .ASCIZ  /BAD DEVICE NAME  FCS=-55/
        .ASCIZ  /BAD BLOCK ON DEVICE  SSC=-56/
        .ASCIZ  /ENTER-DUPLICATE ENTRY IN DIRECTORY  FPC=-57/
        .ASCIZ  /NOT ENOUGH STACK SPACE (FCS OR FCP) SSC=-58/
        .ASCIZ  /FATAL HARDWARE ERROR ON DEVICE  SSC=-59/
        .ASCIZ  /FILE ID WAS NOT SPECIFIED  FCS=-60/
        .ASCIZ  /ILLEGAL SEQUENTIAL OPERATION  FCS=-61/
        .ASCIZ  /END OF TAPE DETECTED  SSC=-62/
        .ASCIZ  /BAD VERSION NUMBER  FPC=-63/
        .ASCIZ  /BAD FILE HEADER   FPC=-64/
        .ASCIZ  /DEVICE OFF LINE   SSC=-65/
        .ASCIZ  /BLOCK CHECK OR CRC ERROR  SSC=-66/
        .ASCIZ  /NO AST SPECIFIED IN CONNECT  NACP=-67/
        .ASCIZ  /NO SUCH MODE  NACP=-68/
        .ASCIZ  /PATH LOST TO PARTNER  NACP=-69/
        .ASCIZ  /BAD LOGICAL BUFFER  NACP=-70/
        .ASCIZ  /TOO MANY OUTSTANDING MESSAGES  NACP=-71/
        .ASCIZ  /NO DYNAMIC SPACE AVAILABLE  NACP=-72/
        .ASCIZ  /CONNECTION REJECTED  NACP=-73/
        .ASCIZ  /TIMEOUT ON REQUEST  NACP=-74/
        .ASCIZ  /FILE EXPIRATION DATE NOT REACHED  FPC=-75/
        .ASCIZ  /BAD TYPE FORMAT  FPC=-76/
        .ASCIZ  /NOT ANSI 'D' FORMAT BYTE COUNT  FCS=-77/
        .ASCIZ  /NOT A NETWORK LUN   NACP=-78/
	.ASCIZ	/INVALID DATA IN DISK FILE--PROGRAM CRASH!!!!!  PDC=-79/
	.ASCIZ	/INVALID DATA IN PROGRAM   PDC=-80/
        .EVEN
          .END