	.TITLE	DEFINE
/ 
/ 
/                   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 1971,1973 DIGITAL EQUIPMENT CORP., MAYNARD, MASS.
/
/EDIT # 017  13 AUG 73   TAM*TAM*REF*WAD*
/
/ 018  24-NOV-75  KENT BLACKETT	CHANGE LENGTH OF ASCII RECORDS
/					FROM 628 MAX. TO 629, DUE TO THE FACT
/					THAT THERE IS NO LONGER A CARRIAGE
/					CONTROL CHARACTER AT FRONT.  NOTE
/					THAT IF 'MSCC' IS DEFINED, THE MAX.
/					LENGTH WILL BE THE OLD (628) NUMBER.
/
/ 019  24-NOV-75  KENT BLACKETT	RSX ONLY CHANGE.  NEED TO STRIP UNIT NUMBER
/					FROM HINF WORD PRIOR TO PUTING
/					DEVICE CODE IN  .PRMTB ENTRY.
/
/ 020  24-NOV-75  KENT BLACKETT	GET EDIT NUMBERS IN STEP WITH RSX AND DOS.
/
/
/OBJECT-TIME SYSTEM ROUTINE WHICH MUST PRECEED
/  ALL RANDOM ACCESS OPERATIONS ON A GIVEN FILE.
/  DEFINE HAS FOUR POSSIBLE PURPOSES:
/    1. TO INIT. AN EXISTING FILE FOR RANDOM ACCESS
/    2. TO CREATE A FILE WITH A SPECIFIED NAME
/    3. TO CREATE A (POSSIBLY) TEMPORARY FILE WITH A DEFAULT NAME
/    4. TO ADJUST THE SIZE OF A FILE.
/  IN ALL CASES, DEFINE ENDS BY INITIALIZING THE PROPER
/    FILE FOR RANDOM ACCESS (VIA .INIT AND .RAND).
/
/ASSEMBLY PARAMETERS,
/
/DEFINE RSX FOR RSX SYSTEMS.
/RSX UNDEFINED FOR DOS15 SYSTEM.
/  THE PARAMETER '%TBSIZ' SHOULD BE DEFINED TO EQUAL
/    THE NUMBER OF RANDOM ACCESS FILES ALLOWED OPEN
/    SIMULTANEOUSLY - DEFAULT SIZE IS FOUR.
/DEFINE 'MSCC' TO ENABLE CARRIAGE CONTROL CHARACTERS ON MASS-STORAGE FILES.
/  SEE BCDIO FOR A COMPLETE DISCUSSION.
/
/
/ROY FOLK
/
/  INTERNAL GLOBALS--
	.GLOBL	.PRMTB		/PARAMETER TABLE
	.GLOBL	.ENDTB		/LOCATION AFTER LAST IN PARAM. TAB.
	.GLOBL	DEFINE
/  EXTERNAL GLOBALS--
	.GLOBL	.FN		/LINE BUFFER (FIOPS)
	.GLOBL	.FH		/RD./WRT. FLAG:=1,WR.;=0,RD.(FIOPS)
	.GLOBL	.FQ		/TRANSFER LINE BUFFER (FIOPS)
	.GLOBL	.FC		/.INIT AND STATUS TABLE ENTRY (FIOPS)
	.GLOBL	.STADD		/ADDR. OF ENTRY IN STATUS TABLE (FIOPS)
	.GLOBL	.ER		/ERROR ROUTINE (OTSER)
	.GLOBL	.DA		/GET ARGS. (.DA)
	.GLOBL	.ADDC		/ADDR. OF DLCL (FIOPS)
/
/CONSTANTS
S00004	4
S00001	1
S00002	2
S00012	12
W00000	400000
K00251	-373
C00251	373
S00003	3
S02000	2000
	.IFDEF	MSCC		/(RKB-018)
K00628	-1164			/(RKB-018)
	.ENDC			/(RKB-018)
	.IFUND	MSCC		/(RKB-018)
MAXLEN	-1165			/(RKB-018)
	.ENDC			/(RKB-018)
S00376	376
S00777	777
S00077	77
S00040	40
S03000	3000
S01000	1000
S05000	5000
S01005	1005
K00010	-12
T77000	177000
Y06060	606060
ADDLCL	.DSA	DLCL
ADPTR	.DSA	.PRMTB
ADEND	.DSA	.ENDTB
ADSBFN	.DSA	SBFN
ADTFN	.DSA	TEMPFN
SPACES	.ASCII	'     '
CRTN	020032
	.IFDEF	RSX
X10=10			/AUTO INCR. REG. 10.
	.ENDC
/WORKING STORAGE
DSLOT	0		/HOLDS SLOT NUM. OF R.A. FILE
TEMP	0		/TEMP. STORAGE
TABPTR	0		/TABLE PTR.
DRSW	0		/DUMMY RCD. SW.: =0, CREATE FILE; =1, ADJ. FILE
CALMOD	0		/CAL MODE: =0, BIN.; =2000, ASCII
RCBLK	0		/RCDS. PER BLK.
HDR0	0		/HDR. WD. 0
IDADR	0		/ADDR. OF I.D. WD.
BLRCD	0		/BLKS. PER RECORD (BIN. RCDS. ONLY)
RFCNT	0		/RCDS. PER FILE COUNTER
BLFIL	0		/BLKS. PER FILE
ADFN	0		/ADDR. OF FIRST ELEM. OF ARRAY FOR FILE NAME
MONEAD	0		/ADDR. OF .DAT -1
DSLADR	0		/ADDR., IN .DAT TB., OF SLOT
DUNCNT	0		/DONE CNT.
CHCNT	0		/CHAR. CNT.
SBCNT	0		/SIXBIT CNT.
WD1	0
WD2	0
BITCNT	0		/BIT CNT.
CCHAR	0		/CURR. CHAR.
LINCNT	0		/LINE CNT.
BUFPTR	0		/BUFFER PTR.
FDIG	0
SDIG	0
	.IFUND RSX
PAIRSR=SIZE		/WD. PAIRS PER RCD.
	.ENDC
	.IFDEF RSX
PAIRSR	0		/WD. PAIRS PER RCD.
	.ENDC
TEMPFN	.SIXBT	'..TEMPOTS'	/ORDER OF THESE 8 WDS. MUST BE PRESERVED!!!
SBFN	.BLOCK	3		    / "
DFNWD1	.SIXBT	'.TM'		    / "
DFNWD2	.SIXBT	'OTS'		    /"
	.EJECT
DEFINE	0
/CONDITIONALIZED CODE
	.IFUND	RSX
	.IFUND	%TBSIZ
TABSPC=20		/FOUR FOUR-WORD ENTRIES
	.ENDC
	.IFDEF	%TBSIZ
TABSPC=%TBSIZ*4
	.ENDC
	.ENDC
	.IFDEF	RSX
	.IFUND	%TBSIZ
TABSPC=30			/FOUR SIX WORD ENTRIES.
	.ENDC
	.IFDEF	%TBSIZ
TABSPC=%TBSIZ*6
	.ENDC
	.ENDC
/
	JMS*	.DA		/GET ARGS.
	JMP	ARND
DAT	0			/.DAT SLOT
SIZE	0			/RECORD SIZE - .DATA WORDS (BIN.) OR
/				    /CHARS. (ASCII) PER RECORD
RCSFIL	0			/RECORDS PER FILE
NAM	0			/ARRAY VAR. HOLDING FILE NAME - =0
/				    /IF UNSPECIFIED
AVAR	0			/ASSOCIATED VARIABLE
MODE	0			/MODE:=0 (BIN.); NOT EQUAL 0 (ASCII)
ADJ	0			/ADJUST: =0, NO ADJ.; =SOME .DAT SLOT,
/				    /ADJUST SIZE
DLT	0		/DELETE: =0, NO; UNEQ. 0, DELETE
	.IFDEF	RSX
EV	0		/EV ADDRESS.  (OPTIONAL).
	.ENDC
/MUST PUT 'DLCL' INTO .ADDC IN FIOPS TO ALLOW JMS INTO DEFINE
ARND	LAC	ADDLCL
	DAC*	.ADDC
	LAC	.FN
	TAD	S00002
	DAC	IDADR		/ADDR. OF I.D. WD.
	LAC	DAT		/ADDR. OF 'DAT' SLOT
/.FC CHECKS SLOT, MAKES ENTRY IN STATUS TABLE, AND RTNS. SLOT
/  NUMBER IN AC
	JMS*	.FC
	AND	S00777
	DAC	DAT
	DAC	DSLOT
/CHK. NAM - IF =0, BUILD DEFAULT FILE NAME; ELSE, CONVERT ASCII
/  TO SIXBIT FILE NAME AT SBFN
	LAC*	NAM
	SZA			/SKP IF DEFAULT
	JMP	NMSPC		/ASCII TO SIXBIT AT SBFN
	LAC	DSLOT
	JMS	BDFN		/BUILD DEFAULT FILE NAME
	.IFUND	RSX
/INIT. SYS. MACROS W/ ADDR. OF FILE NAME
ISM	LAC	ADSBFN
	DAC	FRD2
	DAC	SKENT2
/FIND PROPER .PRMTB ENTRY
	DZM	TEMP
	.ENDC
	.IFDEF	RSX
ISM	DZM	TEMP
	.ENDC
	LAC	ADPTR		/ADDR. OF 1ST WORD OF TABLE TO AC
NXENT	DAC	TABPTR
	LAC*	TABPTR
	SPA			/SKP. IF NOT ACTIVE
	JMP	ACT		/ACTIVE ENTRY
	LAC	TABPTR
	DAC	TEMP		/SAVES LAST INACT. ENTRY ADDR.
BMPPTR	LAC	TABPTR
	.IFUND	RSX
	TAD	S00004		/BUMP PTR. TO NXT. ENTRY
	.ENDC
	.IFDEF	RSX
	AAC	+6
	.ENDC
	SAD	ADEND		/ADDRESS OF .ENDTB
	JMP	DUN1		/END OF TABLE REACHED
	JMP	NXENT		/TRY NEXT ENTRY
ACT	AND	S00077		/MASK OFF .DAT SLOT BITS
	SAD	DSLOT		/SKP IF WRONG ENTRY
	JMP	DUN2		/IF ENTRY FOUND
	JMP	BMPPTR		/BUMP TO NEXT ENTRY
DUN1	LAC	TEMP		/SEE IF INACTIVE ENTRY EXISTS
	SZA			/SKP IF NO INACTIVE ENTRY
	JMP	DOWN1
	JMS*	.ER
	26			/TOO MANY RANDOM FILES OPEN
DOWN1	DAC	TABPTR
/AT DUN2, TABPTR HOLDS ADDR. OF ENTRY FOR CURRENT FILE
DUN2	DZM	DRSW		/DUMMY RCD. SWITCH
	.EJECT
/.PRMTB	ENTRY
/  FIRST WORD
	DZM	BLRCD		/BLKS. PER RCD.
	LAC*	MODE
	SZA!CLA			/SKP IF BINARY
	JMP	FW1		/ASCII
	DZM	CALMOD
	LAC*	SIZE
	SPA!SNA			/MUST HAVE: 0 .LT. SIZE .LE. 377777(8)
	JMP	ERR22		/ILLEGAL SIZE
/    INTEGER DIVIDE TO FIND NUM. OF BLKS. PER RCD. AND NUM. OF
/      WDS. IN LAST BLK.
FW2	TAD	K00251		/-251(10)
	ISZ	BLRCD
	SMA!SZA
	JMP	FW2		/MORE
	TAD	C00251		/251(10) - AC=NUM. OF WDS. IN BLOCK
	RCR			/NUM. OF DATA WDS. MUST BE ODD,
	STL			    /IF NOT, INCREMENT TO
	RAL			    /NEXT LARGEST ODD NUM.
	TAD	S00003		/HDR. + I.D. WDS.
	RCR			/(SIZE+3)/2=PAIRS PER LAST BLK. OF RCD.
	DAC	PAIRSR
	.IFDEF RSX		/FOR LONG RECORDS, EACH BLOCK WILL BE
	LAC	BLRCD		/WRITTEN TO MAX LENGTH, EVEN THE LAST
	SAD	S00001		/THIS SAVES LATER DECISIONS ON WHAT LENGTH
	JMP	FW1+1		/TO USE.  BLRCD IS 2 OR GREATER FOR THIS
	LAC	(177)		/CASE.
	DAC	PAIRSR
	.ENDC
	SKP
FW1	ISZ	BLRCD		/ALWAYS ONE BLK. PER ASCII RCD.
	LAC	BLRCD
	CLL!RTL
	RTL
	RTL
	TAD	DSLOT
	XOR	W00000		/BIT #0=1: ACTIVE FILE
	DAC*	TABPTR
/  SECOND WORD
	ISZ	TABPTR
	LAC*	MODE
	SZA			/SKP IF BIN.
	JMP	ASCMD		/ASCII MODE
	LAC	BLRCD
	SAD	S00001		/IF ONLY ONE BLK. PER RCD., MAY
	JMP	GETRB		    /BE .GT. ONE RCD. PER BLK.
	DZM	RCBLK		/INDICATES  .GT. ONE BLK. PER RCD.
	JMP	SW1
ASCMD	LAC	S02000
	DAC	CALMOD
	LAC*	SIZE
	SNA
	JMP	ERR22		/TOO SMALL
	TAD	MAXLEN		/(RKB-018) EITHER -628 OR -629
	SZA!SMA
	JMP	ERR22		/TOO LARGE
	LAC*	SIZE		/CALC. PAIRS PER RCD.
	TAD	S00002		/FOR FORMS CONTROL CHAR. AND CR
	DZM	PAIRSR
	ISZ	PAIRSR
CALC1	TAD	K00005		/-5
	ISZ	PAIRSR
	SZA!SMA			/SKP IF DONE
	JMP	CALC1
/    GET RECORDS PER BLOCK
GETRB	LAC	PAIRSR
	RCL			/TIMES 2
	CMA
	TAD	S00001
	DAC	TEMP		/MINUS WDS. PER RCD.
	LAW	-1
	DAC	RCBLK		/RCDS. PER BLK.
	LAC	S00376		/MAX. RCD. SIZE
GETRB1	TAD	TEMP		/WORDS-WDS. PER RCD.
	ISZ	RCBLK
	NOP
	SMA
	JMP	GETRB1
/    BUILD ENTRY WORD AND LOAD
SW1	LAC	CALMOD		/=2000 IF ASCII
	RCL			/=4000 IF ASCII
	XOR	PAIRSR
	RTL
	RTL
	RTL
	XOR	RCBLK
	DAC*	TABPTR
/  THIRD WORD
	ISZ	TABPTR
	LAC*	RCSFIL
	SMA!SZA			/IF BIT #0=1, TOO MANY RCDS.
	JMP	THDWD1
	JMS*	.ER		/0 OR TOO MANY RCDS. PER FILE SPECIFIED
	24
THDWD1	DAC*	TABPTR
	CMA
	TAD	S00001
	DAC	RFCNT		/RCDS. PER FILE COUNTER
/  FOURTH WORD
	ISZ	TABPTR
	LAC	AVAR		
	DAC*	TABPTR
/CALCULATE BLKS. PER FILE:  BLFIL=(RCSFIL)/(RCBLK)
/  OR, IF RCBLK=0, BLFIL=(RCSFIL)*(BLRCD)
	DZM	BLFIL
	LAC	RCBLK
	SZA			/SKP IF RCD. LENGTH .GT. 1 BLK.
	JMP	CB1		/RCD. .LT. 1 BLK.
	LAC	RFCNT		/-RCSFIL
	DAC	TEMP
	CLA
CB2	TAD	BLRCD
	ISZ	TEMP
	JMP	CB2		/MORE
	DAC	BLFIL
	JMP	STB		/CALCULATION COMPLETE
CB1	LAC	RFCNT
CLCBF	TAD	RCBLK		/RCBLK-RCSFIL
	ISZ	BLFIL
	SPA
	JMP	CLCBF
	.EJECT
/IN FIOPS' STATUS TAB. SET R.A. BIT AND SET DELETE BIT IF:
/  1) FILE NAME PARAM. IS 0 (INDICATES DEFAULT NAME)
/  2) DELETE PARAM. IS NOT 0
STB	LAC*	DLT		/NON-0, DELETE; =0, NO
	SNA
	JMP	DLT1		/NO DELETE
	LAW	-1		/SET FOR ISZ TEST LATER
	TAD*	NAM		/SUM =-1 IF DELETE
DLT1	DAC	DLT
	LAC*	.STADD		/ADDR. OF ENTRY INTO AC
	DAC	TEMP
	LAC*	TEMP		/ENTRY INTO AC
	RTL			/R.A. BIT TO LINK
	STL			/SET R.A. BIT
	RAL			/DELETE BIT TO LINK
	STL			/SET IT
	ISZ	DLT		/SKP IF DELETION SPEC'ED
	CLL			/NO - CLR. DELETE FLG.
	RAR
	RTR
	DAC*	TEMP
	.IFUND	RSX
/IF FILE WITH SPECIFIED NAME DOES NOT EXIST, CREATE IT;
/  IF IT DOES EXIST, ADJUST SIZE OR INIT. IT
	LAC	DSLOT
	XOR	S03000		/.FSTAT
	JMS	FRDM
	SZA			/SKP IF FILE NOT FOUND
	JMP	ADJTST		/FOUND - TEST FOR ADJUST
	.EJECT
/CREATE FILE
	LAC	DSLOT
	XOR	S01000		/OUTPUT
	JMS	INITM
	LAC	S00001
	DAC*	.FH		/SET FOR .ENTER AND .WRITE
	LAC	DSLOT
	JMS	SKENTM		/.ENTER
	DZM	DRSW		/SET DUMMY RCD. SW. TO CREATE FILE
ENTB	LAC	PAIRSR		/PAIRS PER RECORD
	RCL
	DAC	LINCNT
	RTL
	RTL
	RTL
	RTL
	DAC	HDR0
	LAC	IDADR		/ADDR. OF FIRST DATA WD. (ALSO I.D. WD.)
	DAC	BUFPTR		/TO FIRST DATA WORD
	LAC	LINCNT
	CMA
	TAD	S00003		/TOTAL WDS. - 2 (HDR.) = DATA WDS.
	DAC	LINCNT		/NOW HOLDS -(NUM. DATA WDS.)
	LAC	CALMOD
	SZA			/SKP IF BIN.
	JMP	ASCMD2
	LAC	HDR0
	DAC*	.FN		/HDR. WD. 0
	LAC	W00000		/400000
	DAC*	IDADR		/I.D.WD.
	LAC	K00251		/-251(10)
	DAC	LINCNT		/MUST CLEAR WHOLE BUFFER DATA SPACE
	CLA
FILL1	ISZ	BUFPTR
	DAC*	BUFPTR
	ISZ	LINCNT		/SKP IF LAST LINE FILLED
	JMP	FILL1
	JMP	WRIT
ASCMD2	LAC	S00002
	XOR	HDR0
	DAC*	.FN		/WDR. WD 0
	SKP
FILL2	ISZ	BUFPTR
	LAC	SPACES		/PAD ASCII RCDS. WITH SPACES
	DAC*	BUFPTR
	ISZ	BUFPTR
	LAC	SPACES+1
	DAC*	BUFPTR
	ISZ	LINCNT
	ISZ	LINCNT		/SKP WHEN LAST LINE FILLED
	JMP	FILL2
	LAC	CRTN
	DAC*	BUFPTR		/WRITE CR OVER LAST WORD
/  WRITE DUMMY RCDS.
WRIT	LAW	-2
	TAD	BLRCD		/AC=: -1,ASCII OR BIN. .LT. 1 BLK.;
	SPA			    /0 OR +K, BIN.  .GT. 1 BLK.
	JMP	WR3
	CMA
	DAC	TEMP		/-(BLRCD-1)
	LAC	T77000		/177000
	DAC*	.FN		/HDR. WD. 0
	DZM*	IDADR		/0 INTO I.D.WD.
	SKP
WR1	ISZ*	IDADR		/INCREM. I.D. WD.
	LAC	DSLOT
	JMS*	.FQ		/.WRITE BIN.
	ISZ	TEMP		/SKP IF ALL BUT LAST BLK. OF RCD. WRIT.
	JMP	WR1		/  ELSE WRITE MORE OF SAME
	LAC	HDR0		/LAST BLK. OF RCD. NOT NECESSARILY
	DAC*	.FN		    /FULL BLK., SO CHANGE HDR. TO
	ISZ*	IDADR		    /PR. CNT. NEEDED AND SET I.D.
	LAC*	IDADR		    /WD. FOR LAST BLK.
	XOR	W00000		/400000
	DAC*	IDADR
WR3	LAC	DSLOT
	XOR	CALMOD
	JMS*	.FQ		/.WRITE
	ISZ	RFCNT		/RCDS. PER FILE CNT.
	JMP	WRIT
	LAC	DRSW		/DUMMY RCD. SWITCH
	SZA			/SKP IF CREATING FILE
	JMP	EXB		/IF ADJUSTING SIZE
	LAC	DSLOT
	JMS	CLOSEM
/INIT. FILE FOR R.A. VIA .INIT AND .RAND
RANDFL	LAC	S00001
	DAC*	AVAR		/SET ASSOC. VAR. = 1
INTLZ	LAC	DAT
	JMS	INITM		/.INIT
	LAC	DAT
	DAC	WT0		/.WAIT CAL
	XOR	S05000
	DAC	RAND0
RAND0	XX			/.RAND
	2
	SBFN			/ADDR. OF FILE NAME
RAND3	0			/NUM. OF BLKS IN FILE RETURNED
WT0	XX			/.WAIT
	12
	LAC	RAND3		/ACTUAL NUMBER OF BLKS. IN FILE
	CMA
	TAD	S00001
	TAD	BLFIL		/SPECIFIED NUMBER OF BLOCKS PER FILE
	SPA!SNA
	JMP*	DEFINE		/RTN.
	JMS*	.ER
	24			/TOO MANY RCDS. PER FILE SPECIFIED
	.ENDC
	.EJECT
	.IFDEF	RSX
/ALLOCATE DISK SPACE FOR RANDOM ACESS FILE.
/.PRMTB ENTRY FORMAT:
/WORD 0	BIT 0 =1 IF ACTIVE ENTRY.
/	BITS 2-11 - BLKS PER RECORD.
/	BITS 12-17 = LOGICAL UNIT NO. (LUN).
/WORD 1	BIT 0 = 1 IF ASCII,=0 IF BINARY.
/	BITS 5-11 = WD. PAIRS/REC.
/	BITS 12-17 =RCDS/BLK (=0 FOR LOGICAL BINARY RECDS. OCCUPYING
/		MORE THAN ONE BLK.).
/WORD 2	BITS 1-17 - RCDS/FILE
/WORD 3	BITS 3-17 = ADDR. OF ASSOC. VAR.
/WORD 4		=PLATTER #.
/WORD 5		= BASE ADDR. OF FILE (0-777777).
/
	CLA!IAC		/INIT. USER ASSOC. VAR. TO 1.
	DAC*	AVAR
	LAC	EV	/USER EV. SPECIFIED/
	SNA
	LAC	(EV)	/NO.
	DAC	CRCPB1	/SET CREATE CPB TO USER(OR OTS) EV.
	DAC	WFCPB1	/SET WAITFOR EV.
	DAC	HINF1	/SET HINF EV.
	LAC	DSLOT	/START SETUP OF CREATE REQ. (LUN).
	DAC	HINF2	/SET HINF LUN
	JMS	XSCAL	/SETUP CREATE CAL.
	LAC	BLFIL	/BLKS. PER FILE TO SIZE PARAM.
	DAC	CRCTB3
	LAC*	RCSFIL	/SET UP ACCT. INFO. - # OF RECORDS.
	DAC	CRCTB4
	LAC*	MODE	/IF ASCII(N.E. TO 0), STORE RECORD SZ + 400000(8).
	SZA
	LAC	W00000		/400000(8).
	XOR*	SIZE	/RECORD SIZE
	DAC	CRCTB5
	CAL	CRCAL	/CREATE I/O REQUEST.
	CAL	WFCAL	/WAITFOR.
	LAC*	CRCPB1	/GET EV. SETTING.  IF ERROR, DECLARE .PRMTB
	SMA		/ENTRY INACTIVE.
	JMP	XDFEXT	/SUCESSFUL FILE DEFINITION.
NEGEV	LAC	TABPTR	/BACKUP PTR.
	AAC	-3
	DAC	TABPTR
	DZM*	TABPTR	/ZERO ENTRY WORD FOR INACTIVE.
	LAC*	.STADD	/ZERO FIOPS ST. TAB. ENTRY. (EFF. ENDFILE)
	DAC	TEMP	/ADDR. OF ENTRY.
	DZM*	TEMP	/CLEAR ENTRY.
	DZM	EV	/REINIT OTS. EV INCASE USER DID NOT SPEC.
			/ALSO SERVES TO REINIT. ARG. LIST.
	JMP*	DEFINE	/EXIT.
XDFEXT	DZM	EV	/REINIT. OPT. PARAM. AND OTS EV.
	CAL	HINF	/DO HINF TO GET DEVICE TYPE AND UNIT NUMBER.
	CAL	WFCAL
	LAC*	HINF1	/GET EV, CHECK IF IS POSITIVE
	SPA
	JMP	NEGEV
	ALSS	11	/LEFT ADJUST DEVICE CODE (6 BITS, 3:8)
	AND	(077000)	/(RKB-019) STRIP UNIT NUMBER FROM 0:2
				/(RKB-019) ( UNIT NUMBER IS IN CNTRL TBL)
	XOR	CRCTB7	/IMPOSE PLATTER NUMBER
	ISZ	TABPTR	/BUMP TO WORD 4 AND SAVE BASE INFO
	DAC*	TABPTR
	ISZ	TABPTR
	LAC	CRCTBA	/BASE ADDRE. OF FILE.
	DAC*	TABPTR
	DZM	EV	/REINITIALIZE OPTIONAL PARAMETER
	JMP*	DEFINE	/EXIT.
	.EJECT
/SUBR. TO SET LUN AND FILENAMES FOR CREATE AND DELETE REQ.
/CALLING SEQ.:
/		LAC	LUN	/LOG. UNIT #.
/		JMS	XSCAL	/ASSUMES ADSBFN PTR TO FLNM BLK.
/		NEXT INSTR.	/SUBR. RETRN.
/
XSCAL	0
	DAC	DLCPB2
	DAC	CRCPB2		/LUN.
	LAC	ADSBFN		/PTR. TO FILENAME BLK.
	DAC*	(X10)		/SETUP AUTO-INCR. REG. 10.
	LAC*	ADSBFN		/FOR FIRST WORD.
	DAC	DLCPB3
	DAC	CRCTB0
	LAC*	X10
	DAC	DLCPB4
	DAC	CRCTB1
	LAC*	X10
	DAC	DLCPB5
	DAC	CRCTB2
	JMP*	XSCAL
/
	.EJECT
/CAL PARAM. BLOCKS AND CONTROL TABLES:
/
/CREATE
/
CRCAL	1600		/FUNCT. CODE.
CRCPB1	0		/EV.
CRCPB2	0		/LUN.
CRCPB3	.+1		/CTB PTR.
CRCTB0	0		/FILE NAME (SIXBIT)
CRCTB1	0
CRCTB2	0		/FILE NAME EXT. (SIXBIT)
CRCTB3	0		/SIZE (256(10)) BLOCKS)
CRCTB4	0		/ACCT. INFO. (# OF RECORDS)
CRCTB5	0		/ACCT. INFO. (WDS/RCD  -WDS/RCD IF ASCII)
CRCTB6	0		/UPDATE SW.  (ALWAYS 0).
CRCTB7	0		/PLATTER # (RETURNED)
CRCTBA	0		/FIRST WORD ADDRESS. OF FILE.
/
/DELETE
/
DLCAL	3500		/FUNCT. CODE.
DLCPB1	0		/EV
DLCPB2	0		/LUN
DLCPB3	0		/FILE NAME (SIXBIT)
DLCPB4	0
DLCPB5	0		/FILE NAME EXT. (SIXBIT.)
/
/WAITFOR
/
WFCAL	20
WFCPB1	0		/EV.
/
EV1	0		/OTS EV.
/
HINF	3600
HINF1	0		/EV ADDRESS
HINF2	0		/LUN
	.ENDC
	.EJECT
/UNPACK 5/7 ASCII FILE NAME-PACK INTO SIXBIT AT SBFN
NMSPC	LAC	NAM		/ADDR OF ARRAY CONTAINING NAME SPECIFIED
	DAC	ADFN		/ADDR. OF FIRST ELEMENT
	LAW	-2
	DAC	DUNCNT		/DONE CNT.
K00005	LAW	-5
	DAC	CHCNT		/CHAR. CNT.
	LAW	-3
	DAC	SBCNT		/SIXBIT CNT.
	DZM	SBFN		/SIXBIT FILE NAME
	LAC	ADSBFN
	DAC	TEMP
	LAC*	ADFN
	DAC	WD1
	ISZ	ADFN
	LAC*	ADFN
	DAC	WD2
	LAW	-7
	DAC	BITCNT		/BIT CNT.
/  ROTATE CHARACTER INTO CCHAR
PACK1	CLA
PACK2	DAC	CCHAR
	LAC	WD2
	RAL			/LOAD LINK WITH LFT-MST BIT
	DAC	WD2
	LAC	WD1
	RAL			/DEPOSIT LINK AND LOAD LINK
	DAC	WD1
	LAC	CCHAR
	RAL			/DEPOSIT LINK INTO CCHAR
	ISZ	BITCNT		/SKP IF 7 BITS TRANSFERRED
	JMP	PACK2
/  LOAD AND CHECK SIXBIT FILE NAME WORD
	AND	S00077		/KEEP SIX BITS
	SAD	S00040		/SKP IF NOT 'SPACE' CHARACTER
	CLA			/'SPACE' TO 'NULL'
	XOR*	TEMP		/XOR PREVIOUS CHARS.
	ISZ	SBCNT		/SKP. IF 3RD SIXBIT CHAR. REACHED
	JMP	PACK3
	DAC*	TEMP
	LAW	-3
	DAC	SBCNT		/RESET CNTR.
	ISZ	TEMP		/INCREMENT TO NEXT NO. IF SIXBIT FILE NAME
	LAC	TEMP		/ADDR. OF CUR. SIXBIT FILE NAME WD.
	SAD	(DFNWD1		/ADDR. OF 1ST DEFAULT FILE NAME WD.
	SKP
	DZM*	TEMP
	JMP	PACK4
PACK3	CLL!RTL			/SHIFT ONE SIXBIT CHAR.
	RTL			    /POSITION LEFT
	RTL
	DAC*	TEMP
/  RESET CNTRS. AND BRING IN NEXT ELEMENT OF ARRAY IF NECESSARY
PACK4	LAW	-7
	DAC	BITCNT
	ISZ	CHCNT		/SKP IF 5/7 ASCII WD. PR. EXHAUSTED
	JMP	PACK1
	ISZ	DUNCNT		/SKP IF PACKING COMPLETE
	SKP
	JMP	.ENDTB
	LAW	-4
	DAC	CHCNT		/SET CHAR. CNTR. FOR REMAINING 4 CHARS.
	ISZ	ADFN		/LOAD WD1 AND WD2
	LAC*	ADFN		    /WITH SECOND WORD PAIR
	DAC	WD1
	ISZ	ADFN
	LAC*	ADFN
	DAC	WD2
	JMP	PACK1
	.EJECT
/PARAMETER TABLE
	.REPT	TABSPC
.PRMTB	0
.ENDTB	JMP	ISM		/INIT. SYS. MACROS
/
ERR22	JMS*	.ER
	22			/ILLEGAL RECORD SIZE
	.EJECT
	.IFUND	RSX
/SPECIFIED FILE EXISTS - TEST FOR ADJUST OR INIT.
ADJTST	LAC*	ADJ
	SNA			/SKP IF ADJUSTMENT
	JMP	RANDFL		/INIT. FILE FOR R.A.
/ADJUST FILE SIZE
/  FIRST, SET UP .DAT -1 WITH SAME DEV. HANDLER ADDR. AND UIC
/    AS DSLOT FOR USE IN WRITING OUT ADJUSTED FILE
	LAW	-1
	TAD*	(123		/.SCOM+23 IS .DAT TB. ADDR.
	DAC	MONEAD		/HOLDS ADDR. IN .DAT TB. OF SLOT -1
	LAC	DAT
	TAD*	(123		/
	DAC	DSLADR		/ADDR. IN .DAT TB. OF DSLOT
	LAC*	DSLADR		/ADDR. OF DSLOT HANDLER
	DAC*	MONEAD
	LAW	-1
	TAD*	(125		/.SCOM+25 IS UIC TB. ADDR.
	DAC	MONEAD		/ADDR. IN UIC TB. OF SLOT -1
	LAC	DAT
	TAD*	(125
	DAC	DSLADR		/ADDR. IN UIC TB. OF DSLOT
	LAC*	DSLADR		/DSLOT UIC
	DAC*	MONEAD		/    INTO -1
/  NOW, .READ AND .WRITE
	DZM*	.FH		/SET UP FOR .SEEK
	LAC	DAT
	JMS	INITM		/.INIT D, INPUT
	LAC	DAT
	JMS	SKENTM		/.SEEK D, SBNM
	LAC	S00001
	DAC*	.FH		/SET UP FOR .ENTER
	LAC	ADTFN		/ADDR. OF TEMP. FILE NAME
	DAC	SKENT2		/INIT. .ENTER
	LAC	S00777		/SLOT -1
	DAC	DSLOT		/FOR POSS. JMP TO ENTB
	XOR	S01000
	JMS	INITM		/.INIT -1, OUT
	LAC	S00777
	JMS	SKENTM		/.ENTER -1, TEMPFN
/  READ FROM SPECIFIED FILE AND WRITE INTO TEMPFN
RDWRT	DZM*	.FH		/FOR .READ
	LAC	DAT
	XOR	CALMOD
	JMS*	.FQ		/.READ D, MODE, .FN, 254
	LAC*	.FN
	SAD	S01005		/EOF
	JMP	LNGTHN		/LENGTHEN
	LAC	S00001
	DAC*	.FH		/FOR .WRITE
	LAC	S00777
	XOR	CALMOD
	JMS*	.FQ		/.WRITE -1, MODE, .FN, 254
	LAC	CALMOD
	SZA			/SKP IF BIN.
	JMP	RW1
	LAC*	IDADR		/GET I.D. WD.
	SMA			/SKP IF LAST BLK. OF RCD.
	JMP	RDWRT		/  ELSE DON'T INCREM. RFCNT
RW1	ISZ	RFCNT		/RCDS. PER FILE - SKP IF DONE
	JMP	RDWRT
	LAC	S00001		/SHORTEN OR SAME
	DAC*	AVAR		/ASSOC. VAR. =1
EXB	LAC	DAT		/RTN AFTER ADDING DUMMY RCDS.
	JMS	CLOSEM		/.CLOSE D
	LAC	S00777		
	JMS	CLOSEM		/.CLOSE -1
	LAC	ADSBFN
	DAC	FRD2
	LAC	DAT
	XOR	S01000
	JMS	FRDM		/.DELETE D,SBFN
	LAC	ADTFN
	DAC	FRD2		/LOAD TEMPFN FOR .RENAM
	LAC	S00777
	XOR	S02000		/.RENAM
	JMS	FRDM		/.RENAM -1,(TEMP TO SBFN)
	JMP	INTLZ		/.INIT, .RAND
LNGTHN	LAC	S00001
	DAC	DRSW		/DUMMY RCD. SWITCH
	TAD*	RCSFIL		/(RCSFIL) - (RCDS. FROM OLD FILE)+1
	TAD	RFCNT		    /POINTS TO FIRST NEW RCD. OF
	DAC*	AVAR		     /NEW FILE
	LAC	S00001	
	DAC*	.FH		/FOR WRITE
	JMP	ENTB		/FILL REMAIN. OF FILE WITH DUMMY RCDS.
	.EJECT
/.INIT MACRO
/CALLING SEQUENCE --
/	LAC	SLOT
/	XOR	(1000		/IF OUTPUT
/	JMS	INITM
INITM	0
	DAC	INIT0
INIT0	XX
	1
	.DSA	DEFINE
	XX			/RTNS. BUFFER SIZE
	JMP*	INITM
	.EJECT
/.FSTAT,.RENAM,.DLETE MACROS
/CALLING SEQUENCE --
/	LAC	ADFLNM		/ADDR. OF FILE NAME
/	DAC	FRD2
/	LAC	SLOT
/	XOR	(1000		/.DLETE
/(OR)	XOR	(2000		/.RENAM
/(OR)	XOR	(3000		/.FSTAT
/	JMS	FRDM
FRDM	0
	DAC	FRD0
FRD0	XX
	2
FRD2	XX
	JMP*	FRDM
	.EJECT
/.SEEK, .ENTER MACROS
/CALLING SEQUENCE --
/	LAC	ADFLNM		/ADDR. OF FILE NAME
/	DAC	SKENT2
/	DZM*	.FH		/.SEEK
/(OR)	LAC	(1
/	DAC*	.FH		/.ENTER
/	LAC	SLOT
/	JMS	SKENTM
SKENTM	0
	DAC	SKENT0
	LAC*	.FH		/=1, .ENTER; =0, .SEEK
	TAD	S00003
	DAC	SKENT1
SKENT0	XX			/.DAT SLOT
SKENT1	XX			/OPERATION CODE
SKENT2	XX			/NAME
	JMP*	SKENTM
	.EJECT
/.CLOSE MACRO
/CALLING SEQUENCE --
/	LAC	SLOT
/	JMS	CLOSEM
CLOSEM	0
	DAC	CLWT0
	DAC	CLOSE0
CLOSE0	XX
	6
CLWT0	XX		/.WAIT
	12
	JMP*	CLOSEM
	.EJECT
	.ENDC
/DELETE DEFAULT FILE AND CLEAR .PRMTB ENTRY
/CALLING SEQUENCE --
/	(ROTATE DELETE BIT (#2) FROM ST. TAB. ENTRY INTO LINK)
/	LAC	SLOT
/	JMS*	.ADDC	/ADDR. OF DLCL    (IN FIOPS)
DLCL	0
	DAC	DSLOT
	SNL			/SKP IF DELETE
	JMP	CLPRMT		/CLR. .PRMTB
	JMS	BDFN		/BUILD DEFAULT FILE NME.
	.IFUND	RSX
	LAC	ADSBFN
	DAC	FRD2
	LAC	DSLOT
	XOR	S01000
	JMS	FRDM		/.DLETE
	.ENDC
	.IFDEF	RSX
	LAC	(EV1)		/SET EV TO DELETE AND WAITFOR REQS.
	DAC	DLCPB1
	DAC	WFCPB1
	LAC	DSLOT		/LUN FOR XSCAL CALL.
	JMS	XSCAL		/SETUP DELETE REQ.
	CAL	DLCAL		/DELETE REQ.
	CAL	WFCAL		/WAITFOR EV SETTING.
	DZM	EV1		/IGNORE ERRORS ON DELETE.
	.ENDC
CLPRMT	LAC	ADPTR
CL1	DAC	TEMP
	LAC*	TEMP
	SPA			/SKP IF INACTIVE
	JMP	ACTF
CL2	LAC	TEMP
	.IFUND RSX
	TAD	S00004		/INCREM. ADDR.
	.ENDC
	.IFDEF RSX
	AAC	+6		/BUMP TO NEXT ENTRY.
	.ENDC
	SAD	ADEND		/SKP IF ADDR. W/IN TAB.
	JMP*	DLCL		/END OF TAB. REACHED
	JMP	CL1		/CHK. ENTRY AT NEW ADDR.
ACTF	AND	S00077		/MASK SLOT NUM.
	SAD	DSLOT
	SKP
	JMP	CL2		/NO MATCH - BUMP PTR.
	DZM*	TEMP		/CLR. ENTRY
	JMP*	DLCL
	.EJECT
/BUILD DEFAULT FILE NAME
/CALLING SEQUENCE --
/	LAC	SLOT
/	JMS	BDFN
BDFN	0
	DZM	FDIG	/FIRST DIGIT
BF1	TAD	K00010	/-12(8)
	SPA
	JMP	BF2
	ISZ	FDIG
	JMP	BF1
BF2	TAD	S00012	/12(8)
	DAC	SDIG	/SECOND DIGIT
	LAC	FDIG
	CLL!RTL
	RTL
	RTL
	XOR	SDIG
	XOR	Y06060	/606060
	DAC	SBFN+1	/SECOND WORD OF DEFAULT FILE NAME
	LAC	DFNWD1
	DAC	SBFN
	LAC	DFNWD2
	DAC	SBFN+2
	JMP*	BDFN
	.END	DEFINE
