*20
	SEGMNT 0
	*20
/FRED--FILE REPLACEMENT, ENTRY, AND DELETION
/	MAR 19, 1970
/
/
/	BETA REGISTER DEFINITIONS
/		(13 AND 14 ARE UNUSED)
/
	PARAM=1
	RDWR=2
	FDV=2
	PARM2=3
	XPNT=4
	XPNT2=5
	LP1=6
	LP2=7
	MARK=10
	ENTSW=11
	NFSW=12
	RET3=15
	RET2=16
	RETURN=17
/
/   LOAD ADDRESS OF DIAL INDEX -- DO NOT MODIFY:
/RAMIFICATIONS ARE OVERWHELMING
	INDEX=1000
/
/   PDP-8 MODE INSTRUCTIONS FOR USE AFTER IOB
/
	LRMF=6244
	LRIB=6234
	LRIF=6224
/
/
/     ENTRY POINTS FOR MAJOR ROUTINES OF FRED
/
/
	DJR
	JMP LOOKUP
	DJR
	JMP NTR000
	DJR
	JMP RPL000
	DJR
	JMP DEL000
	EJECT
/
/     READ / WRITE
/
/     ENTERED IN LINC MODE, WITH AC
/  CONTAINING POINTER TO PARAMETER LIST.
/  IF BIT 1 IS ZERO, PARAMETERS ARE IN
/  THE CALLERS INSTRUCTION FIELD.
/  IF ONE, PARAMETERS ARE IN HIS DATA FIELD.
/     PARAMETER LIST AS FOLLOWS --
/
/   0/	   FIELD (3 BITS) /     UNIT
/   1/     MEMORY ADDRESS (12 BITS)
/   2/     FIRST BLOCK NUMBER
/   3/     NUMBER OF BLOCKS
/ 
READ,	SET RETURN 	/ SAVE RETURN ADDRESS
	0
	SET I RDWR 	/ INDICATE READ
	700
	JMP COMMON 	/ TO COMMON PROCESSING
WRITE,	SET RETURN 	/ SAVE RETURN
	0
	SET I RDWR 	/ INDICATE WRITE
	704
COMMON,	SET I RET2 	/SET CODE TO USER CALL
	7777
	JMP GETFLD 	/SET TO ADDRSS PRMTRS
RWENT,	LDA PARAM 	/GET 1ST WRD OF PRMTRS
	ROR 6		/BANK NO TO RIGHT HLF
	STH		/FOR XTENDED ADDRSS
	EXT
	ROL I 6		/ RESTORE UNIT BITS
	BCL I		/2 HI BITS FOR AXO
	7774		/...LO BIT IN LINK
	BSE I
EXT,	0020		/HI UNITS FILLED IN
	AXO		/ SET TAPE XOB
	LDA I PARAM	/MEMRY ADDR PRMTR
	STC MEMADD	/ HOLD FOR TAPE USE
	ROL I 4		/ GET UNIT BIT
	BSE 		/SET TAPE READ/WRI
	RDWR
	STC CMND	/ SET READ/WRITE INSTR
	LDA I PARAM	/ GET START BLOCK NO
	STC IOBLK	/ SET APPROPRIATELY
	LDA I PARAM	/ BLOCK COUNT...
	COM		/... MADE NEGATIVE
	STC RDWR	/ STORE IN INDEX
IOLOOP,	LDA I		/ ADDRESS FOR DATA
MEMADD,	0		/ ADDRSS FOR NEXT BLK
	TMA		/ TELL THE TAPE WHERE
	ADA I		/ UPDATE ADDRESS
	400		/ BY BLOCK LENGTH
	STC MEMADD	/ STORE NEW ADDR
CMND,	RDC		/ MODIFIED FOR WRITE
IOBLK,	0		/ BLOCK NUMBER WANTED
	LDA I		/ GET CONSTANT 1
	1
	ADM		/ UPDATE BLOCK NUMBER
	IOBLK
	XSK I RDWR	/SKP IF END OF TRNSFR
	JMP IOLOOP	/ ELSE CONTINUE
	EJECT
/
/       IO IS COMPLETE -- RETURN TO CALLER
/
	XSK RET2	/ SKIP IF USER CALL
	JMP RETURN	/RTRN IF INTRNAL CALL
	IOB
	LRMF		/ RESTORE TO DESIRED STATUS
	SET 0		/ RESTORE RETURN JMP
	RETURN
	JMP 0		/ GO TO CALLER
/
/
/
/     GETFLD -- GET CALLERS FIELDS AND PARAMETRS
/
/     ENTERED IN LMODE, WITH 10-BIT PTR IN AC.
/     RETURN WITH INDIRECT POINTER IN LOCATION 1
/     TO DATA FIELD CONTAINING PARAMETERS.
/
GETFLD,	BSE I
	4000
	ROL I 2		/ BIT 1 TO LINK
	ROR 2		/ 10 BIT PTR +2000
	STC PARAM	/ HOLD AC CONTENTS
	STC ENTSW	/ CLEAR ENTSW
	IOB
	LRIB
	ROR 3		/ INST FLD TO AC 7-11
	LZE		/ SKP IF PARMS IN IF
	ROL 5		/ DF TO AC 7-11
	BCL I		/ DROP OTHER BITS
	7740
	BSE I		/ BUILD LDF INST
	LDF
	STC GTF010	/ SAVE IT
	LZE I		/ IS DF ALREADY SET?
GTF010,	LDF		/ NO - SET IT
	JMP 0		/ RETURN TO CALLER
	EJECT
/
/     LOOKUP - FIND NAMED FILE IN DIAL INDEX
/
/     ENTERED IN LMODE WITH ADDRSS OF A PRMTR
/     LIST IN AC.
/     
/   0/ UNIT NUMBER  /
/   1/ FILE NAME    /
/   2/  CONTD       /
/   3/  CONTD       /
/   4/  CONTD       /
/   5/ TYPE (S OR B)/
/   6/ STARTING BLOCK 
/   7/ NO OF BLOCKS /
/ 
LOOKUP,	SET I RET3	/ IND. EXTERNAL CALL
	7777
LKP000,	SET RET2	/ SAVE RETURN JMP
	0
	JMP GETFLD 	/ SETUP PARAMETER PTR
/
/     READ THE INDEX
/
	SET PARM2	/ PTR INTO ALT AREA
	PARAM
	LDA	 I	/ INIT AC
	1
	IOB
	LRIF		/ GET IF.
	ROL 3		/ FLD NO TO RT HALF
	STH 		/ STORE DATA ADDRESS
	XPARM+1		/FOR INDEX READ
	ROL 3		/ BANK NO TO BITS 0-2
	BCL I		/ JUST KEEP BANK NO
	0777
	BSE PARM2	/ COMBINE WITH UNIT NO
	STC XPARM	/ INTO PRMTR LIST
	SET I RDWR	/ SETUP READ CODE
	700
	SET I RETURN	/ RTRN JMP FROM READ
	JMP LKP010	/ INST MOVED FOR LATER
	SET I PARAM 	/ SETUP PRMTR PTR
	XPARM
	JMP RWENT	/ GO TO READ INDEX
LKP010,	SET I XPNT
	INDEX
	LDA XPNT	/ GET 1ST WRD OF INDEX
	SAE I		/ SKP IF VALID INDEX
	5757		/ FIRST WORD OF INDEX
	SKP		/ NO INDEX
	JMP LKP020	/ INDX OK--SCAN NAME
/
/     THERE IS NO INDEX -- CREATE ONE
/
	LDA I		/ GET FILLER WORD
	5757
	STA XPNT	/ INTO NEXT INDEX WORD
	XSK I XPNT	/ END?
	JMP .-2		/ ZAP ANOTHER
	STA XPNT	/ ZAP LAST WORD
	XSK I PARM2	/ MAKE PARM2 LOOK
			/LIKE WE SOUGHT MATCH
	JMP ERRTN	/ RETURN NO FIND
	EJECT
/     SCAN INDEX FOR NAME
/
LKP020,	LDA I PARM2	/ GET 1ST WORD OF NAME
	STC WORD1	/ SAVE AT COMPARE INST
LKP030,	LDA I
	7
	ADM		/ ADD 7 TO INDEX PTR
	XPNT
	XSK XPNT	/ END OF INDEX?
	SKP		/ SKIP NOT END
	JMP ERRTN	/ RETURN--NO SUCCESS
	LDA I XPNT	/GET WORD OF INDX NAME
	SAE I		/ SKIP OUT OF LOOP
			/ IF 1ST WORDS EQUAL
WORD1,	0
	JMP LKP030	/ LOOP IF NOT EQUAL
	SET XPNT2	/ FIRST WORDS EQUAL
	XPNT		/ START FINAL COMPARE
	SET FDV		/ POINT TEMPORARY
			/ FDV INDEX
	PARM2
	SET I LP2	/ SET LOOP COUNTER
	-3
LKP050,	LDA I FDV	/ GET NEXT TWO CHARS
	SAE I XPNT2	/ COMPARE TO THOSE IN
			/ INDEX ENTRY
	JMP LKP030	/ UNEQUAL - RETURN
			/ TO SEARCH LOOP
	XSK I LP2	/ CHK WHOLE NAME
	JMP LKP050
/
/     IF WE GET HERE, WEVE FOUND THE NAME
/
	LDA I FDV	/ PICK UP S/B CODE
	SHD I		/ IS THE CODE S?
	2300
	JMP WNTS	/ YES- GIVE HIM SOURCE
	SHD I 		/ IS THE CODE B?
	0200
	JMP WNTB	/ YES- GIVE HIM BINARY
/
/ COME HERE ON ERROR, OR UNSUCCESSFUL FIND
/
ERRTN,	XSK RET3	/ INTERNAL CALL?
	JMP RET2	/ RETURN IF INTERNAL
	SET 0		/ MOVE IN RETURN JMP
	RET2
	IOB
	LRMF
	JMP 0		/RETURN TO CALLER
	EJECT
/
/ WE"VE FOUND WHAT HE WANTS - GIVE IT HIM
/
WNTB,	XSK I XPNT2	/ CANT SKIP, BUT THIS
	XSK I XPNT2	/...FAKES OUT THE PTR
WNTS,	XSK RET3	/ IF INTERNAL CALL...
	XSK I RET2	/...SETUP FOR 3 RETRNS
	LDA I XPNT2	/ GET STARTING BLOCK
			/ NO FROM INDEX
	STA I FDV	/ STORE IN CALLERS
			/ PARAMETER LIST
	LDA I XPNT2 	/ GET NO OF BLOCKS
	APO		/ SKIP IF DESIRED
			/ DATA EXISTS
	JMP ERRTN	/ RETRN ERR IF NO FILE
	XSK RET3	/ DONT STORE RESULT
			/ IF INTERNAL
	SKP
	STA I FDV	/ RETURN NO OF BLOCKS
	XSK I RET2	/ INC JMP RTRN ADDRSS
	JMP ERRTN	/ NOT REALLY AN ERROR
/
/     PARAMETERS TO READ ROUTINE
/
XPARM,	0		/ FIELD AND UNIT
	INDEX		/ DATA ADDRESS
	346		/ BLOCK NUMBER
	2		/ BLOCK COUNT
	EJECT
/
/     REPLACE -- REPLACE A NAMED ENTRY
/
/     ENTERED IN LINC MODE AFTER CALLING ENTER.
/     MAY BE CALLED ONLY IMMEDIATELY AFTER
/ ENTER HAS RETURNED TO P+1,
/     INDICATING THAT A FILE OF THE PROPOSED
/ NAME AND TYPE ALREADY EXISTS.
/
RPL000,	SET RET3	/ SAVE RETURN
	0
	XSK I ENTSW	/ TEST FOR NAME FOUND,
			/ SET "REPLACE"
RPL010,	HLT		/ ILLEGAL SEQUENCE
	XSK ENTSW	/ TEST FOR CONTINUE
			/ AFTER HALT
	JMP RPL010	/ BAD BOY - STOP AGAIN
	JMP GTF010	/ SET CORRECT DF
	LDA I		/ ZAP LENGTH OF FILE
	5757
	STA XPNT2
	JMP FSP000	/ ALL LOOKS GOOD 
			/-- DO YOUR THING
/
/     ENTER -- ADD A NAMED ENTRY TO DIAL INDEX
/
/     ENTERED IN LINC MODE WITH AC POINTING
/ TO A PARAMETER LIST
/     IDENTICAL TO THAT FOR LOOKUP, EXCEPT
/ THAT THE FILE-LENGTH
/     FIELD IS FILLED BY THE USER.
/
/ RETURN IMMEDIATELY FOLLOWING THE JMP (P+1)
/ IF THE FILE ALREADY EXISTS.
/ RETURN TO P+2 IF THERE IS NO ROOM FOR THE FILE
/     RETURN TO P+3 IF OPERATION COMPLETE
/ (DIAL INDEX HAS BEEN UPDATED).
/
NTR000,	SET RET3	/ SAVE RETURN
	0
	JMP LKP000	/ LOOKUP NAME IN INDEX
	JMP NTR020	/ THIS NAME IS NOT
			/ IN INDEX
	JMP NTR010	/ NAME IN INDEX,BUT
			/ NOT WITH THIS TYPE
/
/     WE FOUND A FILE OF THIS NAME AND TYPE
/
	LDA I 		/ GET CONSTANT -2
	-2
	ADD XPNT2	/ POINT TO PTR AREA -2
	STC MARK	/ SAVE PTR FOR REPLACE
	SET I ENTSW	/FLG READY-FOR-REPLACE
	1776
	JMP RTRN0	/ GO HOME
/
/     FOUND THE NAME, BUT NOT TYPE
/
NTR010,	LDA I		/ CONSTANT -2
	-2
	ADD XPNT2	/ FROM POINTER INDEX
	STC MARK	/SAVE ADR OF FILE PTRS
	JMP NTR030	/ GO BEGIN SCAN FOR
			/ FILE SPACE
/
/     NOTHING FOUND IN THE LOOKUP SCAN
/
NTR020,	SET I MARK	/ INDICATE NO FIND
	7777
NTR030,	XSK I RET3	/ NO NAME CONFLICT,
			/ INCREMENT RETURN
	EJECT
/
/ FSP - FIND SPACE ON DIAL TAPE FOR NEW FILE
/
FSP000,	LDA I
	APO I		/ MOVED TO FCF050
	STC FCF050	/ INTO INDX-SCAN RTN
	LDA I
	5
	ADD PARM2	/ PTR TO USERS START
			/ BLK FIELD
	STA 		/ HOLD FOR LATER
	LP1
	STC LP2		/ STORE POINTER
	LDA I LP2	/ PICK UP LENGTH
	APO		/ POS LEN REQUEST?
	JMP RTRN0	/ ELSE RETURN ERROR 
	AZE I		/ SKIP IF LEN NOT 0
	JMP RTRN0	/ BOMB IF NULL REQUEST
	STA 		/ HOLD LENGTH HANDY
	TRYLEN
	COM
	ADA I		/ SUBTRACT LEN FROM
			/HIEST BLK NO,LO AREA
	270
FSP010,	AZE I		/ SKIP NOT ZERO
	CLR		/ FORCE TRUE ZERO
	APO		/SKP IF STILL ON TAPE
	JMP FSP020	/ NO SPACE IN LOW AREA
	STC TRY		/ HOLD TRIAL STRT BLK
	JMP FCF000	/FIND POSSBLE CONFLCT
	JMP FSP030	/ HOORAY--NO CONFLICT
	LDA		/ NOPE -- THAT TRY
			/ IS NO GOOD
	TRYLEN
	COM		/ SUBTRACT THE SEARCH
			/ LENGTH FROM...
	ADA XPNT	/... THE START BLOCK
			/ OF CONFLICT FILE...
	JMP FSP010	/...AND TRY AGAIN
/
/ WE"VE FOUND NO SPACE LARGE ENOUGH IN LOW AREA
/
FSP020,	SET I NFSW	/ SET NO-FIND SWITCH
	0
	LDA I		/ PICK UP MINUS
			/ END OF TAPE
/*********************************
	-1600		/BIG TAPE
/*********************************
	ADD TRYLEN	/ MINUS LAST FEASIBLE
			/ START BLOCK
	STC UPLIM	/ HOLD AS SCAN LIMIT
	JMP FSP035	/ ENTER UPPER SCAN
/
/     TRY POINTS TO GOOD SPACE IN LOWER AREA
/
FSP030,	SET I NFSW	/ INDICATE SPACE FOUND
	7777
	LDA		/ PICK UP OLD TRY
	TRY
	STA		/ SAVE IT
	SVTRY
	ADD TRYLEN	/ GET END BLOCK
	ADA I		/ GET COMPARE CONSTNT
			/TRYEND-2*INDEX LOC)
	-716
	STC UPLIM	/ MINUS HIGHEST DES-
			/ IRABLE STARTING BLK
FSP035,	LDA I 		/ GET SKIP-POS INST
	APO		/ MOVED TO FCF050
	STC FCF050	/ INTO INDX SCAN RTN
	LDA I 		/ INITIAL STARTING	
			/ BLOCK, UPPER FILE
	470
FSP040,	STA		/ SET NEW TRY BLOCK
	TRY
	ADD UPLIM	/ COMPARE TO MAXIMUM
	 		/ USABLE BLOCK
	APO I		/ SKIP IF STILL IN
			/ USEFUL REGION
	JMP FSP050	/NO SPACE IN THIS AREA
	JMP FCF000	/ SEARCH FOR CONFLICT
	JMP FSP060	/ WEVE FOUND SPACE
	LDA XPNT	/ THIS TRY WONT WORK
	ADA XPNT2	/...SO TRY AT END
			/ OF CONFLICT FILE
	JMP FSP040
/
/THERE WAS NO SPACE FOUND IN UPPER FILE AREA
/
FSP050,	XSK NFSW	/ FOUND IN LO AREA?
	JMP RTRN0	/ RETURN BAD NEWS
			/ -- NO SPACE
	LDA		/ GET START BLOCK OF
			/ FILE IN LOWER AREA
	SVTRY
	STC TRY		/ USE IT.
/
/     THERE IS SPACE AT TRY
/
FSP060,	XSK MARK	/ WAS THERE A FILE
			/ BY THIS NAME?
	JMP FSP100	/YES- USE THAT ENTRY
/
/     WE MUST SEARCH FOR EMPTY INDEX SPACE
/
	SET I MARK	/ INIT MARK PTR
	INDEX
FSP070,	LDA I 		/ BUMP INDEX INDEX
	7
	ADM
	MARK
	XSK MARK	/ END OF INDEX?
	SKP		/ NOT END
	JMP RTRN0	/ NO SPACE IN INDEX
			/ -- RETURN ZERO
	LDA I MARK	/ 1ST WRD OF INDX NAME
	SAE I		/ EMPTY ENTRY?
	5757
	JMP FSP070	/ NOT EMPTY, TRY NEXT
/
/     MARK POINTS TO AN UNUSED INDEX ENTRY
/     PUT THE NAME INTO IT
/ 
	LDA PARM2	/1ST WORD OF USER NAME
	STA MARK	/ PLUNK INTO INDEX
	LDA I PARM2	/ 2ND
	STA I MARK
	LDA I PARM2	/ 3RD
	STA I MARK
	LDA I PARM2	/ 4TH
	STA I MARK
	LDA I PARM2	/ GET TYPE (S OR B)
	SHD I		/ IS TYPE S
	2300
	JMP FSP080	/ YES
	SHD I		/ IS TYPE B
	0200
	JMP FSP090	/ YES
	JMP RTRN0	/ NO-- BOMB NOW
	EJECT
/
/ HE WANTS A SOURCE FILE -- SCRATCH
/ THE BINARY POINTERS
/
FSP080,	SET LP2		/ TEMP POINTER
	MARK
	XSK I LP2	/ CANT SKIP
	XSK I LP2	/ DITTO
	LDA I 		/ GET 57S...
	5757
	STA I LP2	/ STORE THEM...
	STA I LP2	/ IN BINARY POINTERS
	JMP FSP100
/
/     HE WANTS BINARY FILE
/
FSP090,	LDA I 
	5757
	STA I MARK	/ STORE 57S...
	STA I MARK	/...IN SOURCE POINTERS
/
/ MARK NOW POINTS TO POINTER AREA OF
/ DESIRED TYPE IN A NAMED INDEX ENTRY
/
FSP100,	LDA		/ PICK UP STRTING BLK
	TRY
	STA I MARK	/ STORE IN INDEX
	STA LP1		/ STORE IN USERS LIST
	LDA I LP1	/ GET LENGTH
	STA I MARK	/ STORE IN INDEX
/
/ NOW EVERYBODY IS HAPPY EXCEPT THE
/ TAPE, WHICH HASNT BEEN UPDATED
/
	SET I RDWR	/ SETUP WRITE CODE
	704
	SET I RETURN	/ SETUP RETURN JMP
	JMP FSP110	/ INST MOVED FOR
			/ LATER USE
	SET I PARAM	/ SETUP PARAMETER PTR
	XPARM
	JMP RWENT	/ GO DO THE WRITE
FSP110,	XSK I RET3	/ BUMP RETURN ADDR
RTRN0,	SET 0		/ MOVE RTRN JMP TO 0
	RET3
	IOB
	LRMF		/ RESTORE USERS FLDS
	JMP 0		/ GO TO CALLER
	EJECT
/
/FIND POSSIBLE CONFLICT BETWEEN INDEX
/ ENTRY AND TRIAL STARTING BLOCK
/
/CALLER MUST SET OR CLEAR I-BIT IN
/ FCF050 TO SELECT DESIRED FILE AREA
/
FCF000,	SET RET2	/ SAVE RETURN
	0
	SET I XPNT	/INIT PTR TO INDX
	INDEX+6
FCF010,	XSK I XPNT	/ SKIP ON END OF INDEX
	SKP
	JMP RET2	/ END OF INDEX,
			/ RETURN NO CONFLICT
	XSK I XPNT	/ INCREMENT AGAIN,
			/ NO SKIP POSSIBLE
	LDA		/ PICK UP POINTER
	XPNT
	ROR I 3		/ MOVE BIT 9 TO LINK
	LZE		/ SKIP IF NAME AREA 
			/ OF ENTRY
	JMP FCF040	/ JMP IF POINTER AREA
	LDA XPNT	/ GET 1ST WORD OF NAME
	SAE I		/ SKIP IF EMPTY ENTRY
	5757
	JMP FCF030	/ WORD IS VALID NAME
	LDA I		/ GET CONSTANT 6
	6
	ADM		/ ADDRESS NEXT ENTRY
			/ - 2, THIS ONE EMPTY
	XPNT
	JMP FCF010	/ TRY NEXT INDEX ENTRY
FCF030,	LDA I		/ INCREMENT BY 4
	4
	ADM		/...TO ADDRESS PTR
	XPNT
/
/     XPNT NOW ADDRESSES A STARTING BLOCK NO
/
FCF040,	LDA XPNT	/ PICK UP STARTING BLK
	ADA I		/SUBTRCT INDEX LOCATN
	-347
FCF050,	APO		/ REVERSE SENSE BIT
			/ MAY BE SET
	JMP FCF010	/ TRY AGAIN IF WRONG
			/ FILE AREA
	SET XPNT2	/TEMP PTR TO LENGTH
	XPNT
	LDA I XPNT2	/ PICK UP LENGTH
	APO		/ SKIP IF LENGTH POS
	JMP FCF010	/ NEG LEN -- NO FILE
	EJECT
/
/     WE NOW HAVE A VALID INDEX ENTRY
/     COMPARE IT TO TRY
/
	LDA XPNT	/STRTING BLOCK OF FILE
	BCL I		/ CLEAR GARBAGE
	6000
	COM
	ADD TRY		/XSTART - TRY
	APO		/SKP IF TRY.GT.XSTART
	JMP FCF060	/ JMP IF BELOW
/
/     TRY IS ABOVE THE START OF THIS FILE
/
	COM		/ MAKE DIFFERENCE NEG
	ADA XPNT2	/FILE LEN - DIFFRNCE
	APO		/ ZERO RESULT WILL
			/ BE NEG (7777)
	JMP FCF010	/ NO CONFLICT,
			/ TRY NEXT ENTRY
	JMP FCF070	/ CONFLICT FOUND
			/ -- RETURN
/
/THE TRY IS BELOW OR AT THE START OF THIS FILE
/
FCF060,	ADD TRYLEN	/ SUBTRACT STARTING
			/DIFF FROM LEN OF TRY
	APO		/ SKIP IF CONFLICT
	JMP FCF010	/ NO CONFLICT -
			/ TRY NEXT ENTRY
/
/WE HAVE FOUND A CONFLICT -- RETURN IT TO CALLER
/
FCF070,	XSK I RET2	/ INCREMENT RETURN ADD
	JMP RET2	/ GO BACK
/
/     WORK AREA
/
TRY,	0
TRYLEN,	0
SVTRY,	0
UPLIM,	0
	EJECT
/
/     DELETE--REMOVE A FILE FROM THE DIAL INDEX
/
/     SAME CALLING SEQUENCE AS LOOKUP, EXCEPT
/	NO ALTERNATE RETURNS
DEL000,	SET RET3	/ SAVE RETURN
	0
	JMP LKP000	/ LOOKUP NAME IN INDEX
	JMP RTRN0	/ DIDNT FIND THE FILE
	JMP RTRN0	/ DITTO
	LDA I		/ DECREMENT XPNT2
	-1
	ADM		/...TO STRT BLK FLD
	XPNT2
	LDA I		/ EMPTY AREA INDICATR
	5757
	STA XPNT2	/ ZAP START BLK FIELD
	STA I XPNT2	/ DITTO LEN
	LDA 		/ GET POINTER
	XPNT2
	BCO I		/ADDRS OTHER-TYPE LEN
	2
	STC XPNT2
	LDA XPNT2	/ LNGTH OF OTHER FILE
	APO I		/ SKIP IF OTHER EMPTY
	JMP DEL030	/ GO RE-WRITE INDEX
	LDA I		/BOTH EMPTY--ZAP NAME
	5757
	STA XPNT	/ ZAP 1ST WORD OF NAME
	STA I XPNT	/ 2ND
	STA I XPNT	/ 3RD
	STA I XPNT	/ 4TH
/
/	WAS THAT THE LAST FILE
/
	SET I XPNT	/PTR TO STRT OF INDEX
	INDEX-1
DEL010,	SAE I XPNT	/NON-EMPTY ENTRY?
	JMP DEL030	/ YES - REWRITE
	XSK XPNT	/ CHECK FOR END
	JMP DEL010	/ NOT YET - LOOP
/
/	INDEX IS EMPTY: MAKE IT A NON-INDEX
/
	CLR
	SET I XPNT	/ POINT TO INDEX
	INDEX-1
	STA I XPNT	/ ZERO ONE WORD
	XSK XPNT	/ LAST ONE ?
	JMP .-2		/ NO - LOOP
/
/     RE-WRITE INDEX
/
DEL030,	SET I RDWR	/ SET WRITE CODE
	704
	SET I RETURN	/ RETURN JUMP FOR R/W
	JMP RTRN0
	SET I PARAM
	XPARM
	JMP RWENT	/ DO THE WRITE THING,
			/AND RETURN TO CALLER
	EJECT
/
/     THIS WILL CAUSE AN ASSEMBLY ERROR
/	IF ROUTINE BECOMES SO LARGE
/     THAT INDEX WILL OVERLAY CODE WHEN
/	IT IS READ IN
	ASMIFM INDEX-.
	NAUGHTY BAD BOY - ROUTINE IS TOO BIG
/	IN CASE OF MINOR SIZE PROBLEMS,
/	REMOVE 5 LINES OF CODE AT FCF040.
/	REMOVE 3 LINES AT FSP000, AND 3
/	LINES AT FSP035.  THIS SHOULD
/	REMOVE ALL REFERENCES TO FCF050.
/	ALL OTHER TAGS MUST BE RETAINED.
/
/	END OF FRED
/
	EJECT