*20
/ FCMSV4.5    FILE COMMANDS, V4.5 
/
/	LAP6-DIAL FILE COMMANDS ... SB,SP,AB,LI,QL,AS,PS
/
/	MAR 31, 1970
/
/	THIS ROUTINE IS A MODIFICATION OF FUNCTIONALLY EQUIVALENT
/	CODE FROM LAP6.  COMMENTS HAVE BEEN ADDED, TAGS CHANGED FROM
/	LETTER-DIGIT TO MNEMONIC NAMES, ABSOLUTE MEMORY ADDRESS REFERENCES
/	REMOVED WHERE POSSIBLE, I/O DISCIPLINE AND BUFFERING IMPOSED,
/	AND THE WHOLE CONDENSED FROM 7 BLOCKS TO 4.  WE ARE DEEPLY INDEBTED.
/
/	RESIDES IN DIAL BLOCKS 50-53
/	OCCUPIES MEMORY LOCATIONS 4000-5777
/
/	16 MBLKS (OCTAL) IN UPPER FIELD ARE USED FOR BUFFERS: 1 0000 - 1 6777
/	LOCATIONS 1 7000 TO 1 7777 MUST REMAIN INTACT.
/	    THESE LOCATIONS CONTAIN DIAL I/O ROUTINES AND BOOTSTRAP.
/
/	THE FOLLOWING AREAS IN THE LOWER PDP-8 FIELD ARE USED:
/
/	AUTO-INDEX REGISTER 10 IS USED BY SB AND AB.
/	PAGE ZERO LOCATIONS 21 AND 22 ARE ASSUMED TO CONTAIN POINTERS
/	    TO THE DIAL I/O ROUTINES IN THE UPPER FIELD.
/	2000 - 2200 ARE ASSUMED TO CONTAIN THE DIAL CHARACTER DISPLAY TABLE.
/	2371 - 2377 CONTAIN THE MC PARAMETER TABLE, E6.
/	3000 - 3777 ARE USED TO READ AND WRITE THE DIAL INDEX,
/	    AND FOR HEADERS DURING AB.
/	5400 - 5777 ARE USED FOR THE BINARY HEADER BLOCK DURING SB OPERATIONS.
/	5000 - 5777 ARE USED BY THE MAIN CODE OF PS (PRINT SOURCE).
/
/	CODE IS NOT REUSABLE
/
/
FCSA,	JMP SAVBIN	/EDITOR
	JMP ADDBIN	/CALLS
	JMP .		/ALL
	JMP SAVPRG	/FCOMS
	JMP LIORAS	/HERE
	JMP PRNPRG
	EJECT
/
/
/	SAVE BINARY ENTERS HERE
/
/
SAVBIN,	PDP		/PMODE TO READ HEADER
	PMODE
	CDF LO8FLD
	CIF HI8FLD
	JMS I READ
	HDRIO		/PARAMS FOR READING HEADER BLOCK
	LINC		/RETURN TO LINC MODE
	LMODE
	LDF DATSEG	/FORCE DATA FIELD FOR REF TO E6
	CLR		/LINC-MODE HALT TO HEADER
	STC HEADER	/IN CASE NOT LOAD AND GO
	LDA
	E6 		/EQ 0 IF NOT L?G
/  SIGN EQ 0 IF LINC; EQ 1 IF 8MODE; 8 FLD IS IN 9-11
	AZE I
	JMP SB020	/NOT L?G
	APO
	JMP PDPMOD	/8 MODE
/
/	START IN LINC MODE
/
	ROL 2		/LOW-ORDER BIT OF...
	BCL I		/...PDP-8 FIELD
	7773		/MAX OF 7 (8K)
	STH		/MODIFY LIF INSTRUCTION
	SETFLD!4000
	LDA
	E6+1		/2 LEAST SIG BITS OF IF
			/12 BIT 8 MODE ADDR
	ROL 2
	BCL I
	7774
	BSE I		/MAKE AN LIF
SETFLD,	LIF
	STC HEADER
	LDA
	E6+1		/STARTING ADDR
	BSE I		/MAKE A LINC-MODE JMP
	JMP
	STC HEADER+1
	JMP SB010	/ALL SET
	EJECT
/
/	COME HERE IF PROGRAM IS TO START IN 8-MODE
/
PDPMOD, LDA I		/SET UP FOR 8MOD START
	PDP
	STC HEADER
	LDA I
	5777		/JMP I 377
	STC HEADER+2
	LDA		/CHK FIELD
	E6
	ROL 3
	BCL I		/8K FOR THIS VERSION
	7767
	BSE I		/MAKE A CIF
	6202
	STC HEADER+1
	LDA
	E6+1		/STARTING ADDR
	STC HEADER+3
/
/	CHECK STARTING ADDR FOR VALIDITY
/	    (LT 8K AND IN A VALID BLOCK)
/
SB010,	LDA		/HIGH ORDER ADDRESS DIGIT
	E6
	ROR I 1		/MOVE LOWER/UPPER SEGMENT BIT TO LINK
	BCL I		/CLEAR NON-ADDRESS BITS
	7774
	AZE		/SKIP IF START ADD LT 8KK
	JMP SAYNO	/OTHERWISE REFUSE
	LDA		/GET LOW ORDER ADDRESS
	E6+1
	BCL I		/TRUNCATE TO START OF MBLK
	0377
	ROL I 5		/MOVE RELATIVE BLOCK NO (0-37) TO LOW ORDER
	BSE I		/INDEX THE ADD INSTRUCTION
	ADD MAP
	STC .+1		/STORE AND EXECUTE IT
	0		/FILLED BY (ADD MAP+BLK) INSTRUCTION
	SAE I		/TEST FOR VALID BLOCK
	7777
	JMP SAYNO	/INVALID -- REFUSE
	EJECT
/
/	HEADER IS NOW PROPERLY SET UP
/	    LOOK FOR SPACE FOR THE FILE
/
SB020,	ADD USENO	/NO OF BLKS USED (FROM HEADER)
	AZE I		/BOMB IF ZERO
	JMP SAYNO
	ADD P1		/PLUS ONE FOR HEADER
	COM		/FINDSP WANTS IT NEGATIVE
	STA
	F1		/HOLD FOR SPACE SCAN
	ADD P2		/TWOS COMP OF NO OF BLOCKS (WITHOUT HEADER)
	STC MBCNT	/HOLD FOR COPY
	ADD P3
	STC BUMP	/REPLACE BUMP CONSTANT IN LOOKUP
	JMP CHKIND	/READ IN THE INDEX BLK
	JMP MAKIND	/RTN FOR NO INDEX-MAKE ONE
	JMP LOOKUP	/SEARCH INDEX FOR NAME IN E6+2
	JMP SB030	/NOT FOUND
	JMP SRORBN	/CHK IF SYMBOLIC ONLY
	JMP REPLAC	/NO-DISPLAY REPLACE FOR VERIFY
	JMP SB040	/BIN ENTRY EMPTY, OR REPLACE REQUESTED
SB030,	JMP ENTER 	/PUT NAME IN INDEX
	JMP SAYNO	/NO SPACE IN THE INDEX
SB040,	SET 4  		/SAVE XR PTR
P2,	2
	JMP FINDSP	/FIND BEST SPACE, RETURN TBLK IN AC
	JMP RSTRX	/UPDATE ? WRT XR
SB100,	LDA I		/BINARY WORK UNIT...
	BWA
	STC INFIL	/...TO CONTROL INPUT
	ADD OUTFIL+2?1777 /STARTING BLOCK
	STA		/...IS HEADER TBLK...
	HDRIO+2
	ADD P1		/...PLUS 1
	STC OUTFIL+2	/...IS START OF ACTUAL BINARY
	ADD P1		/CONSTANT 1...
	STC INFIL+3	/FOR SINGLE-BLOCK INPUT
	ADD XIO		/OUTPUT UNIT
	STA		/...FOR WRITING HEADER...
	HDRIO
	STC OUTFIL	/...AND BINARY
	LDA I		/GET ADDRESS OF BLOCK MAP
	MAP-1!4000	/MAP IN LINC FIELD 2
	PDP		/ENTER PMODE FOR COPY
	PMODE
	DCA AUTO	/SETUP AUTO-INDEX REG
	EJECT
/
/	THIS IS THE COPY LOOP FOR SAVE BINARY
/	N.B.  CODE BETWEEN THIS POINT AND EDRTN MUST BE IN ONE PDP-8 PAGE.
/
SB110,	TAD I AUTO	/GET A WORD FROM MAP
	SNA CLA		/SKIP IF BLOCK USED
	JMP SB160	/NOT USED -- BUMP BLOCK NO AND LOOP
	CIF HI8FLD	/SET INST FIELD FOR READ ROUTINE
	JMS I READ	/READ ONE BINARY BLOCK
	INFIL		/...FROM BWA
	CLA IAC		/CONSTANT ONE
	ISZ MBCNT	/TEST FOR LAST BINARY BLOCK
	JMP SB120	/DONT STOP YET
/
/	WE HAVE JUST READ THE LAST BINARY BLOCK
/
	TAD MBFAD	/SUBTRACT (FIRST BUFF - 1)...
	TAD INFIL+1	/...FROM CURRENT BUFFER...
	DCA OUTFIL+3	/...FOR OUTPUT BLOCK COUNT
	JMP SB130
/
/	COME HERE AFTER READING ANY BINARY BLOCK EXCEPT THE LAST
/
SB120,	TAD INFIL+1	/INCREMENT BUFFER ADDRESS
	DCA INFIL+1
	TAD MBFEND	/BUFFER LIMIT...
	TAD INFIL+1	/...COMPARED TO BUFFER ADDRESS
	SPA CLA		/DUMP BUFFERS NOW IF FULL
	JMP SB160	/OTHERWISE BUMP INPUT BLOCK
/
/	COME HERE TO WRITE THE BUFFERS:
/	    EITHER THEY ARE FULL, OR THERE IS NO MORE TO READ.
/
SB130,	TAD HDRSW	/SWITCH TELLS WHETHER HEADER HAS BEEN WRITTEN
	SNA CLA		/SKIP IF NOT WRITTEN YET
	JMP SB140	/BUT IF ITS DONE, DONT RE-WRITE
	DCA HDRSW	/SET THE SWITCH 
	CIF HI8FLD
	JMS I WRITE	/WRITE THE HEADER
	HDRIO
SB140,	CIF HI8FLD
	JMS I WRITE	/WRITE BINARY BLOCKS
	OUTFIL
	CLA
	TAD MBCNT	/GET MINUS REMAINING COUNT
	SNA CLA		/SKIP NOT END OF SAVBIN
	JMP EDRTN+1	/RETURN TO EDITOR
/
/	COME HERE TO RE-INITIALIZE CONTROL BLOCKS
/	    IF MORE BINARY REMAINS TO BE DONE
/
	TAD BFAD	/BUFFER START ADDRESS
	DCA INFIL+1
	TAD BFLN	/BLOCKS WRITTEN...
	TAD OUTFIL+2	/...PLUS START BLOCK...
	DCA OUTFIL+2	/...IS NEW START BLOCK
SB160,	ISZ INFIL+2	/GO TO NEXT BLOCK IN BWA
	JMP SB110	/AND LOOP TO END
	EJECT
/
/
/	COPY LOOP FOR SAVE PROGRAM (SP)
/
/
SP100,	0002		/ENTER 8-MODE FOR COPY
SP110,	TAD BFLN
	TAD MBCNT	/ADD TO MINUS BLOCK COUNT
	SPA		/SKIP IF 16 OR LESS TO GO
	JMP SP120
	CLA
	TAD MBCNT	/PICK UP MINUS REMAINING COUNT
	CIA		/MAKE POSITIVE
	DCA INFIL+3	/STORE SHORT COUNT
	TAD INFIL+3	/...ALSO...
	DCA OUTFIL+3	/...OUTPUT SHORT
SP120,	DCA MBCNT	/STORE MINUS BLOCKS-TO-GO
	CIF HI8FLD	/FIELD CONTAINING I/O HANDLERS
	JMS I READ	/READ UP TO 16 BLOCKS
	INFIL
	CIF HI8FLD
	JMS I WRITE	/WRITE THEM OUT
	OUTFIL
	CLA
	TAD MBCNT	/PICK UP MINUS BLOCK COUNT
	SNA CLA		/SKIP IF MORE TO GO
	JMP EDRTN+1	/OTHERWISE GO TO EDITOR
	TAD BFLN
	TAD INFIL+2	/INCREMENT STARTING BLOCK
	DCA INFIL+2
	TAD BFLN
	TAD OUTFIL+2	/...FOR INPUT AND OUTPUT
	DCA OUTFIL+2
	JMP SP110	/LOOP
/
/     I/O CONTROL BLOCKS
/
INFIL,	SWA		/UNIT FOR INPUT
	BUFFER		/MEM ADDR=1 0000, SHIFTED RIGHT 8
	0		/START BLOCK
	BUFLEN		/NO OF BLOCKS
/
OUTFIL,	0		/UNIT FOR OUTPUT
	BUFFER		/MEM ADDR=1 0000
	0		/STARTING BLOCK
	BUFLEN		/COUNT
/
HDRIO,	BWA		/HEADER IS ON BIN WORK AREA UNIT
	13		/MEM ADDR = 5400 (3400 IF AB)
	HDRBLK		/BLOCK 47 WITHIN BWA
	1		/JUST ONE
/
MBCNT,	0
HDRSW,	7777
BFLN,	BUFLEN
BFAD,	BUFFER
MBFAD,	-BUFFER
MBFEND,	-BUFFER-BUFLEN
	EJECT
/
/     RETURN TO EDITOR
/
EDRTN,	0002		/RETURN IN 8-MODE
	CIF HI8FLD	/DIAL IS IN UPPER MEMORY FIELD
	JMP I .+1
	DRSTRT		/START OF DIAL RESTART
	LMODE
/
/
/     SAVE PROGRAM (SP) ENTER HERE
/	LAST BLOCK NO OF WORKING SOURCE IS IN AC
/	FILE NAME AND UNIT IN MC PARAMETER LIST AT E6
/
/
SAVPRG,	ADA I
	-WA-5000+2
	COM
	STA I		/- NUM OF TBLKS
F1,	0
	ADA I		/GET TWOS COMP
P1,	1
	STC MBCNT	/HOLD FOR COPY
	LDF DATSEG	/FORCE DATA FIELD FOR REF TO E6
	LDA		/CHECK FOR PARTIAL SAVE
	E6
	AZE
	JMP SAYNO	/PARTIAL SAVE ILLEGAL
	JMP CHKIND	/CHK FOR INDEX
	JMP MAKIND	/NO INDEX -- MAKE ONE
	JMP LOOKUP	/DO NAME SEARCH
	JMP SP020	/NO NAME MATCH
 	JMP SRORBN	/CHECK FOR SOURCE
	JMP REPLAC	/ASK REPLACE
	JMP SP030	/REPLACE WAS REQUESTED
SP020,	JMP ENTER	/PUT NAME IN INDEX
	JMP SAYNO	/NO ROOM IN INDEX
SP030,	SET 4
	2		/SAVE PTR TO START AND LEN FIELDS
	JMP FINDSP	/DO GAP SEARCH
	JMP RSTRX	/RE-WRITE INDEX
	ADD XIO		/OUTPUT UNIT
	STC OUTFIL	/...TO OUTPUT PARAMETERS
	JMP SP100	/GO DO THE COPY
	EJECT
/
/
/     PRINT SOURCE
/
/
PRNPRG,	LDF DATSEG
	LDH		/CHK MC PARAM
	E6+2		/TABLE
	SHD I		/FILE ENTRY
	7700		/OR WA ?
	JMP PSWA	/PRINT THE WA
	JMP CHKIND	/NAMED FILE -- READ AND CHECK THE INDEX
	JMP SAYNO	/NO INDEX
	JMP LOOKUP	/INDEX OK -- FIND THE NAME
	JMP SAYNO	/NO NAME MATCH
	JMP SRORBN	/IS THERE SOURCE?
	JMP GETPS	/YES -- LOAD PS
	JMP SAYNO	/BINARY ONLY, CANT DO IT
/
/	COME HERE IF SWA TO BE PRINTED
/
PSWA,	LDA I		/SOURCE WA PSEUDO-UNIT
	SWA
	STA		/...TO MC PARAM LIST
	E6+6		/...AS I/O UNIT
	SET I 2		/STARTING BLOCK IS ZERO
	ZERO
/
/	READ PS MAIN CODE -- BLOCKS 63, 4 ON DIAL
/
GETPS,	PDP		/PMODE FOR READ
	PMODE
	CIF HI8FLD
	JMS I READ	/READ PS AND TELETYPE INTO 5000
	PSIN
	LINC
	LMODE
	LDF DATSEG	/SET DATA FIELD FOR PS
	LDA 2		/PICK UP STARTING BLOCK NO OF DESIRED SOURCE
	JMP PSENT	/GO TO PS MAIN PROCESSING
/
/	PARAMS FOR READING PS AND TTY
/
PSIN,	DIALU		/DIAL RESIDENCE UNIT
	12		/MEM ADDR = 5000
	PSBLK		/DIAL BLOCKS 63,64 CONTAIN PS, TTY
	2		/GET EM BOTH
/
ZERO,	0		/CONSTANT ZERO TO USE AS STARTING BLOCK IF SWA PRINTED
	EJECT
/
/
/     FILE SUBROUTINES
/
/
			/CHECK SOURCE
			/OR BINARY
SRORBN,	SET 5		/POINTER TO START BLOCK
	2
	LDA I 5		/DOES NAME HAVE
	APO		/A SOURCE? (BINARY IF AB OR SB COMMAND)
	XSK I 0		/NO, ENTRY IS EMPTY
	JMP 0
/
/
/
/
			/FIX ADDRESS
ADVIND,	LDA		/TO NEXT NAME
	2		/IN INDEX
	BSE I		/EACH NAME IS
	7007		/10 WDS LONG
	STC 2
	XSK 2		/SCANNED INDEX ?
	JMP 0		/NO
	JMP 1
/
/	CHECK BOUNDS
/
H1,	LDA
	6
	ADD F1
	AZE I
	COM
	APO
	XSK I 0		/NOT OK
	JMP 0		/OK
/
/
/	RCG AND CHECK INDEX
/
CHKIND,	SET 3		/RTN JMP
	0
	LDA		/PICK UP UNIT NO FROM MC PARAMS
	E6+6
	STC XIO		/STORE IN INDEX PARAMETERS
	PDP
	PMODE
	CIF HI8FLD
	JMS I READ	/GET THE INDEX
	XIO
	LINC
	LMODE
	LDF DATSEG	/FORCE CORRECT DATA FIELD
	LDA 		/GET FIRST WORD OF INDEX
	INDEX
	SHD I		/IS THERE AN
	5700		/INDEX ?
	XSK I 3		/YES
	JMP 3		/NO
	EJECT
/
/
/	MAKE AN EMPTY INDEX
/
MAKIND,	SET 1
	0
	SET I 2		/POINTER TO INDEX
	INDEX-1
	LDA I		/FILL WITH
	5757		/5757 (//)
	STA I 2
	XSK 2		/DONE ?
	JMP .-2		/NO
	JMP 1
/
/
/	SEARCH FOR A NAME IN INDEX
/	    NAME TO FIND IS AT E6+2
/
LOOKUP,	SET 1
	0
	SET I 2		/START OF INDEX
	INDEX
	SET I 3		/LENGTH OF NAME
	-4
	SET I 4		/START OF
	E6+1		/REQUESTED NAME
	JMP ADVIND
	LDA I 2		/CHK INDEX NAME
	SAE I 4		/WITH REQ NAME
	JMP LOOKUP+4	/NO MATCH -- TRY NEXT NAME
	XSK I 3		/MATCHED ALL ?
	JMP .-4		/NO TRY NXT PAIR
	LDA I		/INCR POINTER TO ADDR STARTING TBLK
BUMP,	1		/3 IF THIS IS SB OR AB
	ADM		/ENTRY POINTER
	2
	XSK I 1
	JMP 1		/RTN
	EJECT
/
/
/	DISPLAY "REPLACE?"
/
			/ASK REPLACE
REPLAC,	SET 3
	0
	LDA I		/ENABLE FULL SIZE CHARACTERS
	0200
	ESF
	SET I 1		/SET X-COORDINATE
	234
	SET I 4		/POINT TO REPLACE TEXT STRING
	RPLSTR-4000
	LDH I 4
	SHD I		/END OF MESSAGE ?
	CR1
	JMP K2		/YES CHK KBD
	ROL 1		/ADDRESS DOUBLE-WORD DISPLAY TABLE
	ADA I
	A6		/DIAL DISPLAY CHARACTER TABLE
	STC 5
	DSC 5		/DISPLAY FIRST HALF OF CHARACTER
	DSC I 5		/...AND SECOND HALF
	LDA I
	2
	ADD 1		/INCREMENT Y-COORDINATE
	STC 1
	JMP REPLAC+11
/
/	TEST FOR KEY STRUCK
/
K2,	KST
	JMP REPLAC+5	/NO KBD -- REFRESH SCOPE
	CLR
	ESF		/RESET TO HALF SIZE
	IOB		/GET CHAR
 	6036		/KRB
	BSE I
	200
	SAE I
	362
	JMP	.+3
	LDA I
	322
	IOB
	6046		/ECHO CHAR
	SAE I
	322		/R ?
	JMP EDRTN	/NO RETURN
	SET 5		/POINT TO OLD INDEX ENTRY
	2
	LDA I		/SLASHES TO FILL OLD SPACE
	5757
	STA 5		/ZAP OLD INDEX ENTRY START BLOCK
	STA I 5		/...AND LENGTH
	JMP 3		/RETURN TO DO REPLACE
/
RPLSTR,	TEXT "REPLACE?"
	4377
	EJECT
/
/	INDEX SLOT SEARCH
/
ENTER,	SET I 4		/PTR TO
	E6+1		/REQ NAME
	SET 1		/RTN JMP
	0
	SET I 2		/PTR TO INDEX
	INDEX
	JMP ADVIND
	SET 5
	2
	LDA I 2
	SAE I		/FOUND A
	5757		/BLANK SLOT ?
	JMP ENTER+6	/NO TRY NXT SLOT
	LDA I 4		/PUT REQ NAME
	STA I 5		/IN INDEX
	SRO I		/SKP OUT AFT
	3567 		/4 PASSES 
	JMP .-4
	SET 2		/TO END OF
	5		/NAME
	JMP BUMP-1	/BUMP PTR AND EXIT
/
/
/	FIND THE BEST SPACE FOR A FILE
/
FINDSP,	SET 10		/B6 IS
	0		/DYNAMICALLY
	SET I 6		/RESET TO
	-FILE		/NEAREST TBLK
	LDA I		/SWITCH OFF
	7777		/LOWER FILE
	STC SWITCH
	JMP GAPSR	/RTN WITH B6 SET
			/TO -CLOSEST BLK
	SET 7
	6
	CLR		/SWITCH ON
	STC SWITCH	/LOWER FILE
	SET I 6
	FREE
	JMP GAPSR
	EJECT
/
/
/	FIND NEAREST SPACE OF TWO
/
G1,	LDA
P7,	7		/UPPER FILE
	COM
	ADD 6		/LOWER FILE
	ADA I
	-XBLK-XBLK
	APO		/WHICH IS BEST ?
	JMP .+3		/CHK UPPER FILE
	JMP H1		/CHK LOWER FILE
	JMP 10		/OK 1ST TBLK IN AC
	LDA I
	1000
	ADD 7
	JMP H1+2	/UPPER FILE
	JMP .+4		/OK
	JMP H1		/CHK LOWER
	JMP 10		/OK
	JMP SAYNO	/FILE AREA FULL
	LDA 
	7
	COM
	JMP 10
			/GAP SEARCH ALL
GAPSR,	SET 1		/ACTIVE ENTRIES
	0		/TO SEE IF
	SET I 2		/B6 (BEST TBLK)
	INDEX!4000	/HAS TO BE RESET
	JMP ADVIND
	LDH I 2
	SHD I		/IS THERE
	5700		/AN ENTRY ?
	JMP .-4		/NO DO SOME MORE
	XSK I 2		/ADV ENTRY TO
	XSK I 2		/TBLK INFO
	XSK I 2		/SECTOR
	JMP GETBN	/RTN P+2 IF
			/INVALID
	JMP COMPBN
	JMP GETBN
	JMP COMPBN
	JMP GAPSR+4
	EJECT
			/GET BN
GETBN,	LDA I 2		/TBLK NUM
	BCL I		/IN LOW ORDER
	7000		/9 BITS
	STA
	11
	ADA I 2		/NUM OF TBLKS
	APO
	XSK I 0		/INACTIVE ENTRY
	COM
	STA
	12
	SRO I		/FOR UPPER OR
SWITCH,	0		/LOWER FILE
	JMP 0
	SET 12
	11
	STC 11
	JMP 0
			/BN COMPARE
COMPBN,	LDA		/WITH B6
	11
	ADD 6
	AZE I
	COM
	APO
	JMP 0
	ADD F1
	APO
	AZE I
	JMP 0
	SET 6
	12
	JMP GAPSR+2
	EJECT
/
/
/    RE-WRITE THE INDEX
/     ENTERED WITH STARTING TBLK IN AC
/
RSTRX,	SET 13
	0
	STA 4		/STORE STARTING BLOCK IN INDEX
	BCL I
	7000
	STC OUTFIL+2	/START BLOCK TO PARAMETER LIST
	ADD F1		/MINUS FILE LEN
	COM
	STA I 4		/STORE LEN IN INDEX
	KST I		/LAST CHANCE TO
			/INHIBIT COMMAND
	JMP EDRTN
	PDP		/CALL WRITE IN 8-MODE
	PMODE
	CDF LO8FLD
	CIF HI8FLD
	JMS I WRITE	/RE-WRITE THE INDEX
	XIO
	LINC
	LMODE
	JMP 13
/
/	I/O PARAMETERS FOR INDEX MANIPULATION
/
XIO,	0		/UNIT NUMBER
	6		/MEM ADDR = 3000
	XBLK		/INDEX TBLK = 346
	2		/LENGTH IS 2 BLOCKS
	EJECT
/
/    LI, QL, OR AS (BY NAME) ENTER HERE
/
/
LIORAS,	CLR
	LDF DATSEG	/FORCE DATA FIELD TO ACCESS E6
	SET 17
	E6
	SAE		/SKIP IF LN2 IS ZERO
	E6+1
	JMP .+4
	SAE		/SKIP IF LN1 IS ZERO
	E6
	JMP SAYNO	/BOMB IF LN2 EQ ZERO, AND LN1 NE ZERO
	LDA		/PICK UP LN1
	E6
	COM
	ADA		/ LN2 - LN1
	E6+1
	LAM		/LN2 TO 17
	17
	LZE		/SKP IF LN2 GE LN1
	JMP SAYNO
	JMP CHKIND
	JMP SAYNO	/NO INDEX
	JMP LOOKUP	/SEARCH FOR NAME MATCH
	JMP SAYNO	/NO NAME MATCH
	JMP SRORBN	/SOURCE OR BINARY ?
	SKP		/SOURCE IS THERE, CONTINUE
	JMP SAYNO	/BINARY ONLY
	LDA
	E6+6
/
/  WARNING -- THIS CODE STORES IN THIS SEGMENT
/
	STC UNITNO
	LDA
	2000		/QL OR LI WD
	STC UNITNO-3
	LDA 2		/START BLOCK TO AC
	LIF KBDSEG
	JMP KBDOPR-1	/RTN TO EDITOR
	EJECT
/
/	COME HERE TO DISPLAY "NO"
/
NOPE,	0		/PMODE ENTRY POINT
	6141		/ENTER LINC MODE
	JMP .+1
SAYNO,	SET 10		/SAVE RETURN FOR DEBUG
	0
	LDA I		/GET FULL SIZE
	0200
	ESF
	CLR		/Y-COORDINATE ZERO (MIDDLE SCREEN)
	SET I 1		/INITIAL X-COORDINATE
	344
	DSC I
	3077		/DISPLAY N
	DSC I
	7706
	SET I 1		/ADJUST X-COORDINATE TO NEXT CHAR
	374
	DSC I
	4177		/DISPLAY O
	DSC I
	7741
	KST		/WAS A KEY STRUCK?
	JMP SAYNO+6	/LOOP UNTIL RESPONSE
	CLR
	ESF		/RESET TO HALF SIZE
	JMP EDRTN	/THEN GO TO EDITOR
	EJECT
/
/	ADD BINARY ENTERS HERE
/
ADDBIN,	LDF DATSEG	/FORCE DATA FIELD TO GET E6
	LDH		/FIRST CHAR OF NAME
	E6+2
	SHD I		/WAS NAME SPECIFIED?
	7700
	JMP SAYNO	/NO - CANT DO IT
	LDA I		/SET BUMP CONST
P3,	3
	STC BUMP	/...IN LOOKUP
	JMP CHKIND	/GET INDEX, CHECK FOR VALIDITY
	JMP SAYNO	/NO INDEX - TOO BAD
	JMP LOOKUP	/FIND THE NAME
	JMP SAYNO	/THE FILE AINT THERE
	JMP SRORBN	/IS THERE A BINARY?
	SKP		/YES - READ IT
	JMP SAYNO	/NO - TOO BAD
/
/	WHEN WE GET HERE WEVE FOUND THE FILE TO ADD
/
	LDA 2		/FIRST BLOCK OF FILE...
	STA		/...IS HEADER
	FHDRIN+2
	ADD P1		/SECOND BLOCK
	STC BINIPT+2	/...IS START OF BINARY
	LDA I 2		/LENGTH...
	ADD M1		/...MINUS ONE...
	STA		/...IS BINARY BLOCK COUNT
	BLOCKS
	COM
	ADD P1		/TWOS COMPLEMENT
	STC MBLKS	/...FOR RELOCATION CONTROL
	ADD XIO		/INDEX UNIT...
	STA		/...IS ALSO FILE UNIT
	FHDRIN
	STC BINIPT
	ADD P7		/3400 SHIFTED 8
	STC HDRIO+1	/READ HEADER AT 3400
	JMP AB000	/GO TO NEXT PAGE
/
M1,	-1
FHDRIN,	0		/UNIT FOR FILE
	6		/HEADER TO 3000
	0
	1
	EJECT
	*1200
AB000,	PDP
	PMODE
	CIF HI8FLD
	JMS I READ	/READ BINARY FILE HEADER
	FHDRIN
	JMS I PFILBF	/...AND UP TO 15 BLOCKS OF FILE
	CIF HI8FLD
	JMS I READ	/READ BWA HEADER
	HDRIO
	JMS SCANHD	/SCAN HEADER FOR STANDARD RELOCATION
	TAD I PE6A	/GET RELOCATION FIELD FROM E6
	CLL RAR		/MOVE TO LINK
	SZA		/SKIP IF FIELD 0 OR 1
	JMS I PNOPE	/OTHERWISE ERROR
	TAD I PE6	/GET RELOCATION ADDR
	SZA		/IF RELOC ADDR...
	JMP .+3
	SNL		/...AND FIELD ARE ZERO...
	JMP AB010	/...DO NOT RELOCATE
	AND P377	/ADDR WITHIN BLOCK
	DCA RELADR
	TAD I PE6
	AND P7400	/BLOCK NO - HIGH ORDER BIT IN LINC
	RTL		/  MOVE
	RTL		/  TO
	RAL		/  LOW ORDER
	DCA RELBLK	/RELOCATED BLOCK ADDR
	EJECT
/
/	NOW BEGINS THE REAL STUFF
/	    SEARCH FOR NON-ZERO IN INPUT
/
AB010,	CDF HI8FLD
AB020,	TAD I PINDAT	/GET ONE BINARY WORD
	SZA CLA		/DO WE MOVE IT?
	JMS MOVEWD	/YUP
	ISZ PINDAT	/INCR POINTER
	TAD PINDAT	/PICK IT UP
	AND P377	/TEST FOR EOB
	SZA CLA		/SKIP IF END OF BLOCK
	JMP AB020	/ELSE LOOP
/
/	END OF INPUT BLOCK
/
	CDF LO8FLD	/INDIRECTS TO THIS FIELD
	ISZ MBLKS	/ANY MORE INPUT?
	JMP NXTBLK	/YES - GO GET EM
	JMS I PWRBLK	/THATS ALL - WRITE OUT CURRENT BUFFER
AB030,	CIF HI8FLD
	JMS I WRITE	/...AND THE HEADER
	HDRIO
	JMP I .+1	/GO BACK TO EDIT
	EDRTN+1
/
/	GET NEXT INPUT BLOCK
/
NXTBLK,	CLA CLL		/ALL CLEAR
	TAD PINDAT	/INPUT DATA ADDR
	TAD BUFEND	/SET LINK IF END OF BUFFER
	SZL CLA		/SKIP IF MORE IN CORE
	JMS I PFILBF	/ELSE REFILL BUFFERS
	JMS SCANHD	/ADJUST RELOCATION POINTERS
	JMP AB010	/CONTINUE
/
/	SCAN INPUT HEADER TO FIND NEXT USED BLOCK
/
SCANHD,	0
	ISZ RELBLK	/INCR RELOCATION BLOCK NO
	ISZ PINHDR	/INCR BLOCK MAP POINTER
	TAD I PINHDR	/GET A WORD OF MAP
	SNA CLA		/IS BLOCK USED?
	JMP SCANHD+1	/NO - TRY NEXT
	JMP I SCANHD	/YES - RETURN
/
PNOPE,	NOPE		/PMODE SAYNO
PE6,	E6
PE6A,	E6+1
PINHDR,	3340		/POINTER TO INPUT FILE HEADER CONTROL WORDS
BUFEND,	-7000		/CAUTION: THIS IS SNEAKY
MBLKS,	0
PFILBF,	FILBUF
	EJECT
/
/	WEVE GOT A NON-ZERO WORD
/
MOVEWD,	0
	TAD PINDAT	/GET ADDR OF WORD
	AND P377	/BLOCK-RELATIVE ADDRESS
	TAD RELADR	/ADD RELOCATION
	DCA POUTDT	/OUTPUT DATA PTR
	TAD POUTDT
	AND P7400	/TEST FOR CARRY
	SNA CLA		/SKIP ON CARRRY
	JMP MW010
	TAD POUTDT	/BLOCK ADDR...
	AND P377	/...TRUNCATED TO 8 BITS
	DCA POUTDT
	IAC		/SET CARRY
MW010,	TAD RELBLK	/BLOCK RELOCATION
	DCA OUTBLK	/GIVES BIN BLOCK
	TAD OUTBLK
	CIA		/PREP TO COMPARE
	TAD CURBLK	/...TO CURRENT BLOCK IN BUFFER
	SNA CLA		/IN THIS BLOCK?
	JMP MOVEIT	/YES - DO THE MOVE NOW
	CDF LO8FLD	/NO - GET THE RIGHT ONE
	TAD CURBLK	/ANYTHING IN BUFFER?
	SMA CLA		/SKIP IF NOT
	JMS I PWRBLK	/ELSE OUTPUT
	TAD OUTBLK	/NEXT BLOCK OF INTEREST
	TAD M40		/IS IT LEGAL?
	SMA CLA		/SKIP IF OK
	JMP AB030	/ELSE ABORT
	TAD OUTBLK	/IF OK, IT IS...
	DCA CURBLK	/...NEW CURRENT
	TAD OUTBLK
	JMS I PGETBK	/GET BWA BLOCK INTO BUFFER
/
/	NOW, MOVE ONE WORD
/
MOVEIT,	TAD I PINDAT
	DCA I POUTDT
	JMP I MOVEWD	/AND RETURN
/
/
PGETBK,	GETBLK
PWRBLK,	WRTBLK
M40,	-40
P377,	377
P7400,	7400
PINDAT,	0
POUTDT,	0
OUTBLK,	0
CURBLK,	-1
RELADR,	0
RELBLK,	-1
	EJECT
	*5400
/
/	FILL BWA BUFFER
/
GETBLK,	0
	DCA BWAIO+2	/BLOCK WANTED
	TAD BWAIO+2
	TAD POUTHD	/ADDRESS CTL WD
	DCA TMP2
	TAD I TMP2	/GET CONTROL WD
	CLA SNA		/SKIP IF BLK USE
	JMP CLRBUF	/ELSE CLEAR BUFF
/
/	READ THE APPROPRIATE BLOCK OF BWA INTO WORKING BUFFER
/
	CIF HI8FLD
	JMS I READ	/GET IT
	BWAIO
	CDF HI8FLD	/SET UPPER FIELD FOR MOVE
	CLA
	JMP I GETBLK	/RETURN
/
/	THIS BLOCK OF BWA IS NOT USED
/	    CLEAR THE BUFFER
/
CLRBUF,	TAD M400	/SET COUNT
	DCA TMP2
	CMA		/-1 TO AC
	DCA AUTO	/SET AUTO-INDEX
	CDF HI8FLD
	DCA I AUTO
	ISZ TMP2
	JMP .-2		/LOOP TILL CLEAR
	JMP I GETBLK	/THEN RETURN
/
/	WRITE THE CURRENT BLOCK TO BWA
/
WRTBLK,	0
	CIF HI8FLD
	JMS I WRITE	/SEND IT OUT
	BWAIO
	CLA
	TAD BWAIO+2	/BLOCK NO...
	TAD POUTHD	/...PLUS HEADER ADDRESS...
	DCA TMP2	/...IS ADDR OF CONTROL WORD
	TAD I TMP2	/GET IT
	SZA CLA		/TEST FOR ALREADY USED
	JMP I WRTBLK	/YES - RETURN
	CMA		/NO - UPDATE HDR
	DCA I TMP2	/SET USED INDICATOR
	ISZ I PBUSE	/INCR BLOCKS USED COUNT
	JMP I WRTBLK	/NOW RETURN
/
TMP2,	0
M400,	-400
PBUSE,	USENO!2000
POUTHD,	MAP!2000
BWAIO,	111		/BWA UNIT
	BUFFER		/ADDR = 1 0000
	0		/BLOCK NO
	1		/ONE AT A TIME
	EJECT
/
/	FILL BUFFERS FROM THE BINARY FILE
/
FILBUF,	0
	TAD BLOCKS	/GET REMAINING COUNT
	TAD M15		/SUBTRACT BUFFER LENGTH
	SMA		/SKIP IF NOT ENOUGH TO FILL BUFFER
	JMP FB010	/ELSE READ 15
	CLA
	TAD BLOCKS	/REMAINING BLKS
	DCA BINIPT+3	/TO I/O LIST
FB010,	DCA BLOCKS	/STORE NEW REMAINING COUNT
	CIF HI8FLD
	JMS I READ	/READ UP TO 15
	BINIPT
	CLA
	TAD BINIPT+2	/ADJUST STRT BLK
	TAD BINIPT+3	/BY LENGTH
	DCA BINIPT+2
	TAD INSTRT	/START OF FIRST BLOCK READ
	DCA I PPINDT	/RESET POINTER
	JMP I FILBUF	/RETURN
/
M15,	-15
INSTRT,	400
PPINDT,	PINDAT
BLOCKS,	0
BINIPT,	0		/UNIT WITH FILE
	BUFFER+1	/ADDR = 1 0400
	0		/START BLOCK
	15		/NO TO READ
	EJECT
/
/
/     SPECIAL SYMBOLS
/
/
	WA=370
	FILE=470	/START OF UPPER FILE AREA
	E6=2371		/MC PARAMETER LIST
	UNITNO=777
	XBLK=346	/TBLK OF DIAL INDEX
	INDEX=3000	/CORE ADDR OF DIAL INDEX
	FREE=270	/END+1 OF LOWER FILE AREA
	A6=2001		/START OF DIAL CHARACTER TABLE
	HEADER=1400	/CORE ADDR OF HEADER BLOCK
	USENO=HEADER+337 /COUNT OF BLOCKS USED IN BWA
	MAP=HEADER+340	/START OF BLOCK USAGE MAP IN HEADER
	KBDOPR=1400	/GO HERE AFTER ASSEMBLY PRE-PROCESSING
	PSENT=1000	/ENTRY POINT OF PS MAIN CODE
	DRSTRT=7777	/UPPER SEGMENT DIAL RESTART ADDR
	CR1=4300
	DIALU=100	/PSEUDO-UNIT CONTAINING DIAL
	PSBLK=63	/START BLOCK OF PS MAIN CODE ON DIAL UNIT
	SWA=110		/SOURCE WORK AREA UNIT
	BWA=111		/BINARY UNIT
	HDRBLK=57	/TBLK OF HEADER IN BWA
	AUTO=10		/AUTO-INDEX REGISTER USED BY SB
	READ=21		/PAGE ZERO ADDRESSES...
	WRITE=22	/...FOR I/O HANDLERS
	BUFFER=20	/BUFFER ADDRESS (1 0000) SHIFTED RIGHT 8
	BUFLEN=16	/NO OF BLOCKS FOR BUFFER
	HI8FLD=10	/PDP-8 FIELD CONTAINING I/O AND DIAL RESTART
	LO8FLD=0	/PDP-8 FIELD CONTAINING FCOMS
	DATSEG=1	/LINC DATA SEGMENT USED BY FCOMS
	KBDSEG=3	/INSTRUCTION SEGMENT CONTAINING KBDOPR
/
	ASMIFM 6000-.
WARNING // IF THIS ROUTINE EXCEEDS 2000 WORDS OCTAL, EDITOR MUST BE MODIFIED
/ TO READ MORE BLOCKS, AND LAP6-DIAL MUST HAVE SPACE FOR THEM.
/
/
/     END OF FCOMSV4
/