.TITLE FILE
/ 
/ 
/                   FIRST PRINTING, FEBRUARY 1974
/ 
/ THE INFORMATION IN THIS DOCUMENT IS SUBJECT TO 
/ CHANGE WITHOUT NOTICE AND SHOULD NOT BE CONSTRUED
/ AS A COMMITMENT BY DIGITAL EQUIPMENT CORPORATION.
/ DIGITAL EQUIPMENT CORPORATION ASSUMES NO RESPON-
/ SIBILITY FOR ANY ERRORS THAT MAY APPEAR IN THIS
/ DOCUMENT.
/ 
/ THE SOFTWARE DESCRIBED IN THIS DOCUMENT IS FUR-
/ NISHED TO THE PURCHASER UNDER A LICENSE FOR USE ON
/ A SINGLE COMPUTER SYSTEM AND CAN BE COPIED (WITH
/ INCLUSION OF DIGITAL'S COPYRIGHT NOTICE) ONLY FOR 
/ USE IN SUCH SYSTEM, EXCEPT AS MAY OTHERWISE BE PRO-
/ VIDED IN WRITING BY DIGITAL.
/ 
/ DIGITAL EQUIPMENT CORPORATION ASSUMES NO RESPONSIBILITY
/ FOR THE USE OR RELIABILITY OF ITS SOFTWARE ON EQUIP-
/ MENT THAT IS NOT SUPPLIED BY DIGITAL.
/ 
/ COPYRIGHT (C) 1974, BY DIGITAL EQUIPMENT CORPORATION
/ 
/ 
        .EJECT
/COPYRIGHT 1972,1973 DIGITAL EQUIPMENT CORP., MAYNARD, MASS. 01754
/EDIT #010   15 FEB 73  TAM**REF**(004)::WAD::(007)
/DEFINE %V5A FOR V5A SYSTEM
	.IFUND %V5A
%DOS15=0
	.ENDC
/
/
/FILE OPERATING SUBROUTINES
/	CALL FSTAT (N,A,I)
/	CALL DLETE (N,A,I)
/	CALL RENAM (N,A,B,I)
/	CALL ENTER (N,A)
/	CALL SEEK (N,A)
/	CALL CLOSE (N)
/	N = .DAT SLOT #
/	A,B = FILE ARRAY
/	I = COMPLETE SWITCH
/
	.GLOBL CLOSE,ENTER,SEEK,FSTAT,DLETE,RENAM
	.GLOBL .DA,.FH,.FC,.ER
	.GLOBL	.CHKDL		/* CHK. DELETE AND DELETE IF NEC. (FIOPS)
	.IFDEF %DOS15
	.GLOBL .FLZW,.FLTB
FLTBP	0	/FILE ENTRY PTR.
	.ENDC
	.GLOBL FILE
FILE=.
	.TITLE	ENTER
ENTER	0
	JMS* .DA		/GET ARGUMENT
	JMP .+3
EDAT	0		/ADDRESS OF SLOT # 
EFIL	0		/ADDRESS OF FIRST WORD OF FILE ARRAY
	LAC (1		/TO INSURE .INIT FOR OUTPUT
	JMS INIT
	LAC EDAT		/.DAT ADDR.
	DAC ENT		/.DAT SLOT #
	LAC EFIL
	JMS BUILD		/BUILD FILE NAME
	.IFDEF %DOS15
	LAC ENT
	JMS BUILD1	/STORE .ENTERED FILENAME IN .FLTB
	.ENDC
ENT	.ENTER 0,FILEN
	JMP* ENTER	/EXIT
	.TITLE	SEEK
SEEK	0
	JMS* .DA		/GET ARGUMENT
	JMP .+3
SDAT	0		/ADDRESS OF SLOT #
SFIL	0		/ADDRESS OF FIRST WORD OF FILE ARRAY
	CLA		/TO INSURE .INIT FOR INPUT
	JMS INIT
	LAC SDAT		/.DAT ADDR.
	DAC SEE
	LAC SFIL
	JMS BUILD		/BUILD FILE NAME
	.IFDEF %DOS15
	LAC SEE
	JMS BUILD1		/STR. .SEEKED FILENAME IN .FLTB
	.ENDC
SEE	.SEEK 0,FILEN
	JMP* SEEK
	.TITLE	BUILD1 (INTERNAL SUBROUTINE)
	.IFDEF %DOS15
/BUILD1 STORES FILE ENTRY INTO .FLTB.  THIS INCLUDES A FOUR
/WORD ENTRY PER SLOT #
/WORD0--0 IF NO FILE ACTIVE--<0 IF FILE ACTIVE FOR INPUT
/-->0 IF FILE ACTIVE FOR OUTPUT
/WORDS1-3 SIXBIT FILENAME AND EXT. SEELED OR ENTERED
BUILD1	0	/SLOT# IN AC ON ENTRY
	TAD (-1)
	CLL
	RTL	/TIMES 4
	TAD .FLTB
	DAC FLTBP	/WORD0 PTR. OF FILE ENTRY
	LAC* .FH	/SET WORD0 PER INPUP OR OUTPUT
	SNA		/INPUT--(777777)
	CLC
	DAC* FLTBP	/OUTPUT--(000001)
	ISZ FLTBP	/BUMP PTR.
	LAC FILEN	/STORE FILENAME AND EXT.
	DAC* FLTBP
	ISZ FLTBP
	LAC FILEN+1
	DAC* FLTBP
	ISZ FLTBP
	LAC FILEN+2
	DAC* FLTBP
	JMP* BUILD1
	.ENDC
	.TITLE	CLOSE
CLOSE	0
	JMS* .DA		/GET ARGUMENT
	JMP .+2
CDAT	0		/ADDRESS OF SLOT #
	LAC* CDAT		/.DAT #
	DAC CLS
	.IFDEF %DOS15
	JMS* .FLZW	/ZERO  FILE ENTRY-CLEAR FILE ACTIVE
	.ENDC
	LAC*	CDAT		/**REF**
	JMS*	.CHKDL		/CHK. AND DELETE IF NEC.
CLS	.CLOSE 0
	JMP* CLOSE
	.TITLE	FSTAT
FSTAT	0
	JMS* .DA		/GET ARGUMENT
	JMP .+4
FDAT	0		/ADDRESS OF SLOT #
FFIL	0		/ADDRESS OF FIRST WORD OF FILE ARRAY
FOK	0		/ADDRESS OF COMPLETE SWITCH
	CLA
	JMS INIT
	LAC FDAT
	XOR (3000		/FOR .FSTAT
	DAC FST
	LAC FFIL
	JMS BUILD
FST	.FSTAT 0,FILEN
	SZA		/FOUND-?
	CLA!CMA		/YES-.TRUE.
	DAC* FOK		/NO - .FALSE.
	JMP* FSTAT
	.TITLE	DLETE
DLETE	0
	JMS* .DA		/GET ARGUMENT
	JMP .+4
DDAT	0		/ADDRESS OF SLOT #
DFIL	0		/ADDRESS OF FIRST WORD OF FILE ARRAY
DOK	0		/ADDRESS OF COMPLETE SWITCH
	LAC (1
	JMS INIT		/.INIT FOR OUUTPUT
	LAC DDAT
	XOR (1000		/FOR .LETE
	DAC DEL
	LAC DFIL
	JMS BUILD
DEL	.DLETE 0,FILEN
	SZA		/COMPLETED?
	CLA!CMA		/YES-.TRUE.
	DAC* DOK		/NO-.FALSE.
	JMP* DLETE
	.TITLE	RENAM
RENAM	0
	JMS* .DA		/GET  ARGUMENT
	JMP .+5
RDAT	0		/ADDRESS OF SLOT #
RFIL	0		/ADDRESS OF FIRST WORD OF FILE ARRAY
RFILS	0		/ADDRESS OF FIRST WORD OF SECOND FILE ARRAY
ROK	0		/ADDRESS OF COMPLETE SWITCH
	CLA
	JMS INIT
	LAC RDAT
	XOR (2000	/FOR .RENAM
	DAC REN
	LAC RFILS		/BUILD 2ND .SIXBIT NAME
	JMS BUILD
	LAC FILEN		/MOVE FILE NAME
	DAC FILENS
	LAC FILEN+1
	DAC FILENS+1
	LAC FILEN+2
	DAC FILENS+2
	LAC RFIL		/NOW FOR 1ST NAME
	JMS BUILD
REN	.RENAM 0,FILEN
	SZA		/FOUND?
	CLA!CMA		/YES-.TRUE.
	DAC* ROK		/NO-.FALSE.
	JMP* RENAM
FILEN	.BLOCK 3
FILENS	.BLOCK 3
	.TITLE	INTERNAL SUBROUTINES
/BUILD ENTERS WITH ADDRESS OF FIRST WORD OF FILE NAME ARRAY
BUILD	0
	DAC GETP		/START OF FILENAME
	LAW -1
	DAC GETC		/INITIALIZE UNPACK
	DAC PUTC
	LAC (FILEN-1	/FILE NAME AREA
	DAC PUTP
	LAW -11		/9 CHARACTERS
	DAC COUNT
	JMS GET		/MAKE FILE NAME FROM
	JMS PUT		/5/7 ASCII TO SIXBT
	ISZ COUNT
	JMP .-3
	JMP* BUILD	/EXIT
COUNT	0
GET	0		/UNPACK 5/7 ASCII
	ISZ GETC
	JMP GETS		/WORD
	LAC* GETP
	ISZ GETP
	DAC GET1		/FIRST PART
	LAC* GETP
	ISZ GETP
	DAC GET2		/LAST PART
	LAW -5
	DAC GETC		/RESET 5/7 COUNTER
GETS	LAW -10
	DAC GET3		/SHIFT LOOP 7+1/2 TIMES
GETL	LAC GET2
	RAL
	ISZ GET3
	JMP .+5
	AND (177		/GOT CHARACTER
	SAD (40
	CLA		/CHANGE SPACE TO NULL
	JMP* GET		/RETURN
	DAC GET2
	LAC GET1
	RAL
	DAC GET1
	JMP GETL		/BACK TO LOOP
GET1	0
GET2	0
GET3	0
GETP	0
GETC	0
PUT	0		/SIXBIT PACK
	ISZ PUTC
	JMP PUTS		/WORD BEGUN
	DAC PUT2		/SAVE CHAR
	ISZ PUTP
	LAW -3
	DAC PUTC		/RESET 3 CHAR CT.
	DZM* PUTP		/CLEAR WORD
	LAC PUT2
PUTS	AND (77		/SIXBIT TRIMMED
	DAC PUT2
	LAC* PUTP		/OLD CHARS
	CLL
	RTL
	RTL
	RTL
	XOR PUT2		/NEW CHAR
	DAC* PUTP
	JMP* PUT		/RETURN
PUTP	0
PUTC	0
PUT2	0
/MODIFICATIONS TO SLOT INITIALIZATION DECEMBER 1968
/
/THE FIRST STEP IS TO INITIALIZE THROUGH FIOPS.
/ASSOCIATED HANDLER WILL BE INITIALIZED ONLY IF
/FIOPS RECOGNIZES A CHANGE IN TRANSFER DIRECTION
/FROM ITS LAST ACTIVATION. HERE GOES...
/
INIT	0
	DAC* .FH		/XFR FLAG (0=READ;1=WRITE)
	XCT* INIT	/GET SLOT ADDRESS
	JMS* .FC		/CALL FIOPS
	DAC IN01		/SAVE SLOT #
/
/MUST NOW PERFORM OUR OWN INITIALIZATION SINCE
/FIOPS ".INIT'S" ONLY ON DIRECTION CHANGE.
/SUCCESSIVE .INIT-S IN THE SAME DIRECTION
/TO HANDLER ARE NOT HARMFUL...
/
	LAC* .FH		/GET XFR FLAG
	SZA		/BUILD .INIT CAL
	LAC (001000)	/001XXX IF WRITE
	XOR IN01		/000XXX IF READ
	DAC .+1
	.INIT	0,0,IN02	/ *** DDS JAN69 ***
	ISZ INIT
	LAC	IN01	/ *** DDS JAN69 ***
	JMP* INIT	/RETURN
IN01	0
IN02	JMS* .ER		/HERE IF BAD SLOT NUMBER
	.DSA 10		/UNRECOVERABLE OTS 10 ERROR
	.END