*20
/ PIP-1600
/
/PROGRAM TO MOVE FILES AROUND ON
/LINCTAPES WITH 1600 BLOCKS OF 400
/WORDS EACH.
 
/	WRITTEN BY:
/		JOHN RAINES
/		N.U.M.S.
/		JULY, 1971
 
/ QANDA ? MAIN PROGRAM IN SEGMENT 4.
/ MILDRED [MODIFIED FOR 1600 BLOCKS] IN
/   SEGMENT 5.
/ SEGMENT 6 HAS QANDA TEXT AND SYSTEM
/   BLOCK 20 DURING "DW" OUTPUT.
/ FIELD 0 USED AS A BUFFER.
/ SEGMENT 7 HAS DIAL-MS RESTART STUFF
/   [USED VIA CTRL/D]
 
/ DEFINITIONS FOR MILDRED
	LOKUP=20
	ENTER=22
	REPLACE=24
	DELETE=26
	EJECT
	SEGMNT 4
	*10
ANSPTR,	0		/QANDA USES 1-7
MOVCTR,	0
FRPTR,	0
DWPTR,	0
	XPTR=DWPTR
WCTR,	0
WLINES,	0
PCTLT,	0
 
/ START OF PROGRAM.
	*5
	LDA I
	20
	ESF		/I/O PRESET
	LDF 7
	RDC
	6\322		/LOAD DIAL-MS I/O
	RDC
	7\323
	CLR
	IOB		/BRING UP FLAG.
	QATLS
 
START,	LDF 6
	JMP QAINIT	/RESTART HERE.
	2\STMES
	ATYPE
	JMP QARFSH
	LDH
	4\ATYPE		/CHECK OPTION/FILE TYPE
	SHD I
	2300		/"S"
	JMP TYPOK
	SHD I
	3200		/"Z"
	JMP ZINDEX	/ZAP INDX ON OUTPUT UNIT
	SHD I
	2500		/"U"
	JMP WHOLE	/COPY WHOLE UNIT
	SAE I
	2		/"B"
	JMP START	/ILLEGAL TYPE!
 
/ S ? B WORK JUST THE SAME:
TYPOK,	STC FTYPE	/SAVE FOR MILDRED
	ADD AUNIT1
	SAE I
	7404		/"D..."
	SKP
	JMP DWIN
	SET I ANSPTR
	AUNIT1
	JMP FRCALL	/SET UP FOR MILDRED
	LIF 5
	LDA I
	FUNIT
	JMP LOKUP
	JMP INGONE	/INPUT FILE NOT THERE!
	LDA
	FSTART
	STC INBLK
	ADD FUNIT
	STC RUNIT
	ADD FLEN
	COM
	STC MOVCTR
	STC FSTART
 
OUTSET,	ADD AUNIT2
	SAE I
	0427
	SKP
	JMP DWOUT
	CLR
	JMP FRCALL	/SET UP OUTPUT
	LIF 5
	LDA I
	FUNIT
	JMP ENTER
	JMP OUTIS	/ALREADY EXISTS
	JMP TAPFUL	/NO ROOM ON (BIG) TAPE!
TPF2,	LDA
	FSTART
	STC OUTBLK
	ADD FUNIT
	STC WUNIT
	JMP MOVE	/ALL IS WELL
WRITEP,	7775
READP,	7774
	EJECT
/ SUBROUTINE TO CHECK "U:FILENAME" AND
/ DO SET-UP FOR MILDRED PARAMETER LIST.
FRCALL,	LDA
	0
	STC FRCRTN
	LDF 4
	SET I FRPTR
	FNAME-4000
	LDH I ANSPTR
	BCL I
	7
	SAE I
	0060
	JMP START	/NOT OCTAL UNIT NO.
	LDH ANSPTR
	BCL I
	7770
	STC FUNIT
	LDH I ANSPTR
	SAE I
	72
	JMP START	/NO ":"
	LDH I ANSPTR	/MOVE FILENAME
	SHD I
	3400
	JMP .+10
	SHD I
	7400
	JMP .+5
	AZE I
	COM
	STH I FRPTR
	JMP .-12
 
	CLR
FRCRTN,	JMP
	EJECT
INGONE,	LDF 6		/"INPUT NOT FOUND"
	JMP QAINIT
	2\INGMES
	ATYPE
	JMP QARFSH
	JMP START
 
TAPFUL,	LDF 6		/"TAPE TOO FULL"
	JMP QAINIT
	2\FULMES
	ATYPE
	JMP QARFSH
	JMP START
 
OUTIS,	LDF 6		/"REPLACE?"
	JMP QAINIT
	2\REPMES
	AREP
	JMP QARFSH
	LDA
	AREP		/GET CHAR TYPED
	SAE I
	7422
	JMP START	/NOT AN "R"
	LIF 5		/WAS "R"--REPLACE.
	JMP REPLACE
	JMP TAPFUL
	JMP TPF2
	EJECT
ATYPE,	7400		/S OR B
AUNIT1,	7400		/UNIT NO.
ANAME,	7200		/":",NAME--UP TO
	0000		/8 CHARS.
	0000
	0000
	0074
AUNIT2,	0072
ANAME2,	0000
	0000
	0000
	0000
	3400
 
AREP,	7400
	3400
 
/ PARAMETER LIST FOR MILDRED:
FUNIT,	0		/TAPE UNIT
FNAME,	0		/FILENAME
	0
	0
	0
FTYPE,	0		/2 OR 23
FSTART,	0		/START OF FILE
FLEN,	0		/LENGTH OF FILE
	EJECT
/ WHEN WE GET HERE, DIRECTORIES ARE OK.
/ -NO. OF BLKS IS IN "MOVCTR"
/ 1ST INPUT BLK IS IN "INBLK".
/ 1ST OUTPUT BLK IS IN "OUTBLK"
/ UNIT NO.S ARE IN "RUNIT" ? "WUNIT"
MOVE,	LDA I
	7777
	STC MOVFLG
	STC RCLOC
	STC WCLOC
MOVLUP,	CLR
	ADD MOVCTR	/MORE THAN 7400 LEFT?
	ADA I
K17,	17
	APO
	JMP MOVE2	/MORE THAN 7400 LEFT
	CLR		/7400 OR LESS.
	ADD MOVCTR
	COM
	STA
	RBLKS
	STC WBLKS
	STC MOVFLG	/FLAG--WE"RE DONE!
 
	JMP MOVE3
MOVE2,	AZE I		/EXACTLY 7400 LEFT?
	JMP 0		/YES.
	STC MOVCTR
	ADD K17
	STA
	RBLKS
	STC WBLKS
MOVE3,	PDP
		  PMODE
	CDF 10
	JMS I READP
	RUNIT
	CDF 10
	JMS I WRITEP
	WUNIT
	LINC
		  LMODE
	CLR
	ADD K17
	ADD INBLK
	STC INBLK
	ADD K17
	ADD OUTBLK
	STC OUTBLK
	SRO I
MOVFLG,	0		/7777 OR 0
	JMP MOVLUP
	JMP START	/END OF TRNSFR
 
RUNIT,	0		/CALLING LISTS FOR
RCLOC,	0		/DIAL-MS I/O
INBLK,	0
RBLKS,	0
 
WUNIT,	0
WCLOC,	0
OUTBLK,	0
WBLKS,	0
 
GET20,	100		/SYSTEM DEVICE
	30		/LOC 14000
	20		/SYSTEM BLK 20.
	1		/JUST 1 BLK.
	K100=GET20
	EJECT
/ ZERO INDEX OF OUTPUT UNIT SPECIFIED:
ZINDEX,	LDA
	AUNIT2
	BCL I
	0700
	SAE I
	6072
	JMP START	/NOT "U:"--NO GO!
	LDH
	4\AUNIT1
	AZE
	JMP START	/INPUT--NO GO!
	ADD ANAME2
	AZE
	JMP START	/FILENAME--NO GO!
	ADD AUNIT2
	ROR 6
	BCL I
	7770
	STC WUNIT	/SET UP UNIT NO.
	LDA I
	346
	STC OUTBLK
	ADD K2
	STC WBLKS
	LDA I
	0026		/INDEX AT 13000
	STC WCLOC
	LDF 5
	SET I XPTR
	3000
	CLR
	STA XPTR
	XSK I XPTR
	JMP .-2
	STA XPTR
	PDP
		  PMODE
	CDF 10
	JMS I WRITEP
	WUNIT
	LINC
		  LMODE
	JMP START
	EJECT
/ DUPLICATE INPUT UNIT ONTO OUTPUT UNIT:
WHOLE,	LDA
	AUNIT1
	BCL I
	7
	SAE I
	7460
	JMP START	/NOT OCTAL--NO GO!
	LDA
	ANAME
	SAE I
	7200
	JMP START	/NO ":"--NO GO!
	LDA
	AUNIT2
	BCL I
	700
	SAE I
	6072
	JMP START	/NOT "U:"--NO GO!
	CLR
	ADD ANAME2
	AZE
	JMP START	/FILENAME--NO GO!
 
	ADD AUNIT1
	BCL I		/SYNTAX OK ...
	7770		/NOW SET UP
	STC RUNIT	/PARAMETERS FOR
	ADD AUNIT2	/"MOVE".
	BCL I
	7077
	ROR 6
	STC WUNIT
	STC INBLK
	STC OUTBLK
	LDA I
	-1600
	STC MOVCTR
	JMP MOVE
	EJECT
/SIMULATE "SP" COMMAND:
DWIN,	LDA
	AUNIT1+1
	SAE I
	2700		/"...W"
	JMP START
	LDH
	4\ATYPE
	SAE I
	23
	JMP START	/ONLY SOURCE MODE!
	LDA I
K110,	110
	STC RUNIT
	STC RCLOC
	STC INBLK
	ADD K10
	STC RBLKS	/READ 10 BLKS
DWLUP1,	PDP
		  PMODE
	TAD KM4000
	DCA DWCTR	/COUNT THE NO. OF
	CDF 10		/BLKS IN THE SOURCE.
	JMS I READP
	RUNIT
	STA		/AC=7777
	DCA DWPTR	/AUTO-INDEX REG.
	CDF 00
DWLUP2,	TAD I DWPTR	/ZERO IN HALFWORD
	LINC		/ENDS THE SOURCE.
		  LMODE
	STA I
DWWRD,	0
	LDH
	DWWRD
	AZE I
	JMP DWEND
	LDH
	4\DWWRD
	AZE I
	JMP DWEND
	CLR
	PDP
		  PMODE
	ISZ DWCTR	/END OF 10 BLKS?
	JMP DWLUP2	/NOT YET.
	LINC
		  LMODE
	ADD K10		/GET NEXT 10 BLKS.
	ADD INBLK
	STC INBLK
	JMP DWLUP1
 
		  PMODE
KM4000,	-4000
DWCTR,	0
K10,	10
		  LMODE
DWEND,	LDF 4		/WE"VE FOUND END!
	ADD DWPTR
	ROR 10		/CALC LENGTH IN
	BCL I
	7760		/BLOCKS.
	ADD INBLK
	ADA I
K1,	1		/FULFILL OUR OBLIGA-
	STA		/TIONS TO "MOVE"
	FLEN
	COM
	STC MOVCTR	/? TO "FRCALL".
	STC INBLK
	SET I ANSPTR
	AUNIT2-4000
	JMP OUTSET	/NOW PROCESS
			/OUTPUT SPECS.
	EJECT
/SIMULATE "CL","AP" SEQUENCE:
/ THIS ONE IS A LITTLE HAIRY.
DWOUT,	LDA
	AUNIT2+1
	AZE
	JMP START	/NO OUTPUT FILENAME!
	LDH
	4\ATYPE
	SAE I
	23
	JMP START	/ONLY SOURCE MODE!
	CLR
	PDP
		  PMODE
	CDF 10		/READ EDITOR"S PTR
	JMS I READP	/BLK INTO SEGMNT 6.
	GET20
	LINC
		  LMODE
	CLR
	SET I WCTR
	-101
	SET I DWPTR
	2\PCTLTA-1
	LDF 6		/ZERO CTLTAB IMAGE.
	STA I DWPTR
	XSK I WCTR
	JMP .-2
 
	ADD K110	/OUTPUT TO WORK AREA
	STC WUNIT
	STC OUTBLK
	ADD K17
	STA
	RBLKS
	STC WBLKS
	STC WLINES	/COUNTS LINE NO.S
	SET I WCTR	/COUNTS 400 WRDS/BLK
	-400
	SET I PCTLT	/PTS TO "CTLTAB" IMAGE
	2\PCTLTA-1
	EJECT
 
APLUP1,	SET I MOVCTR
	-17
	SET I DWPTR
	7777
	PDP
		  PMODE
	CDF 10		/READ 17 BLKS
	JMS I READP
	RUNIT
	LINC
		  LMODE
 
APLUP2,	PDP
		  PMODE
	CDF 00
	TAD I DWPTR	/GET 2 CHARS
	LINC
		  LMODE
	STC DWWRD	/SAVE THEM
	LDH
	DWWRD		/GET 1ST CHAR
	JMP APCHK
	LDH
	4\DWWRD
	JMP APCHK
	XSK I WCTR	/END OF A BLK?
	JMP APLUP2	/NOT YET
K1000,	LDA		/YES--OUTPUT THE
	WLINES		/LINE NO. TO PAR-
	LDF 6		/AMETER BLK.
	STA I PCTLT
	SET I WCTR
	-400
	CLR
	XSK I MOVCTR	/DONE W/ 17 BLKS?
	JMP APLUP2	/NOT YET
 
K2,	PDP		/YES--WRITE THEM.
		  PMODE
	JMS I WRITEP
	WUNIT
	LINC
		  LMODE
	CLR
	ADD K17		/BUMP BLK NO.S
	ADD INBLK
	STC INBLK
	ADD K17
	ADD OUTBLK
	STC OUTBLK
	JMP APLUP1	/GET NEXT 17 BLKS.
K7776,	7776
 
APCHK,	AZE I		/END OF SOURCE?
	JMP APEND	/NOT YET
	PDP
		  PMODE
	TAD KM43	/CR?
	SNA CLA
	ISZ WLINES	/YES--COUNT LINE
	LINC
		  LMODE
	JMP 0
		  PMODE
KM43,	-43
		  LMODE
	EJECT
APEND,	LDA		/END FOUND.
	WLINES		/NOW FIX BLK 20
	LDF 6		/PTRS FOR EDITOR
	STA I PCTLT	/RESTART.
	LDA I
	16
	ADD MOVCTR
	ADD OUTBLK
	STA I
APBLKS,	0
	ADA		/TRY TO STAVE OFF
	2\53		/VERSION CHANGES!
	ADD K1
	STA		/PTR TO CTLTAB
	2\PBETA5	/UPDATED.
	LDA I
	5\370		/NOW FIX
	ADD APBLKS	/A LOT OF
	STA
	2\PBBTBK	/TAPE
	STA
	2\PSPTBK	/BLOCK
	STA
	2\PWBTBK	/POINTERS.
	ADA I
	1001
	STA
	2\PCURTB
	STA
	2\PMAXTB
	ADD K1000
	STA
	2\PCBTBK
	STA
	2\PUNKNO
	EJECT
	CLR
	ADD WLINES	/FIX LINE
	STA
	2\PCURLN	/NUMBER
	STA
	2\PMAXLN	/COUNT.
	CLR
	ADD DWWRD	/CHAR BEFORE 00 IS A 43
	ROL I 1		/GET RIGHT OR LEFT IND
			/INTO THE LINK.
	LDA
	DWPTR
	ADD K7776
	BCL I
	7400		/FIX
	BSE I
	3000		/POINTERS
	ADD K4000
	LZE		/<RIGHT OR LEFT?>
	ADD K4000
	STA
	2\PBETA2	/TO THE
	STA
	2\PBETA3	/LAST CHAR.
	BSE I
	400
	STA
	2\PBETA4
 
	LDA I
	20		/NOW WRITE
	ADD MOVCTR
	STC WBLKS	/THE LAST
	PDP
		  PMODE
	CDF 10
	JMS I WRITEP	/BUFFER AND
	WUNIT
	CDF 10
	JMS I WRITEP	/THE POINTERS.
	GET20
	LINC
		  LMODE
	EJECT
	LDA I
	-2
	ADD OUTBLK	/NOW GET LAST 2
	ADD WBLKS
	PDP
		  PMODE
	SPA		/<1 ? 2 BLK LONGSOURCES
	IAC		/ARE SPECIAL CASES>
	LINC
		  LMODE
	STC INBLK
	ADD K110	/BLOCKS ?
	STC RUNIT
	ADD K2		/PUT THEM INTO
	STC RBLKS
	ADD K100	/PLAYGROUND FOR
	STC WUNIT
	LDA I
	15		/DIAL.
	STC OUTBLK
	ADD K2
	STC WBLKS
	PDP
		  PMODE
	CDF 10
	JMS I READP
	RUNIT
	CDF 10
	JMS I WRITEP
	WUNIT
	LINC
		  LMODE
	JMP START
K4000,	4000
	EJECT
/QANDA SUBROUTINE FOR THE
/PDP-12
/
/TO HERE TO INITIALIZE THE ROUTINE
/
QAINIT,	LDA I		/SAVE JMP RETURN
	2
	ADD 0
	STA I
QAB,	0		/JMP 	+3
	ADD QAL+3
	STC 1		/PTR TO FIRST PARAM
	LDA 1		/GET FIRST PARAM
	ADD QAQ+1	/PTR TO HALFWORD-1
	STC QAG-3
	LDA I 1
	STC QARFSH-1
	STC 6		/XR6 =0 IF NO ANS BUF
			/    =1777 IF YES
QACA,	SET 3	/XR3 TO PTR TO ANSWERS
	QARFSH-1
	SET 4		/XR4 TO PTR TO QUESTIONS
	QAG-3
/TO HERE IF 1ST TIME THRU OR FOLLOWING A CR
	SET 1
	4
	JMP QAT
	NOP		/F
	LDH I 4		/H. BUMP PTR IF H OR F
QAD,	JMP QAO
	JMP .+6		/74
	JMP QAE		/34
	SAE I		/CR?
	43
	JMP QAD		/NO
	JMP QACA+4 	/EXAMINE NEXT CHAR
			/INITIALIZE ANSWER BUFR
	STH 3		/74 TO ANSWERS
	LDH I 4		/NEXT HALFWORD
	ADA I
	-60
	COM
	STC 6
	STH I 3		/0 IN AC
	XSK I 6
	JMP .-2
	LDH I 3		/BUMP PTR TO ANSWERS
	JMP QAD
			/ANS BUFR IS INITIATED
QAE,	STH 3
	SET I 4		/XR4 =PTR TO LAST-TYPED
			/CHAR IN ANSWER BUFR
	0
/----REFRESH-----ENTRY------POINT-------
QARFSH,	LDA I		/INITIAL Y POSITION
	277
	STC QAH-1
	SET I 3		/XR3= PTR TO TEXT
	0
	SET 5		/XR5=PTR TO LAST DSPLYD
			/CHAR IN ANSWER BUFR
	QARFSH-1
QAG,	SET 1
	3
	JMP QAT
	JMP .+7		/F
	LDH I 3		/H. BUMP PTR
	LDA I		/NONE. ASSUME HALF SIZE
	BCL I
	STC QAM+2	/SET INSTR TO CLEAR
			/FF FOR HALF SIZE
	ADD QAW		/NOP IN AC
	JMP QAM
	LDH I 3		/BUMP PTR
	LDA I
	BSE I
	STC QAM+2	/SET INSTR TO SET
			/FF FOR FULL SIZE
	ADD QAW+1	/ADD 9U IN AC
QAM,	STC QAP+3
	MSC I 4		/READ CONTROL REGISTER
	BSE I		/EITHER BSE ? OR BCL
	200
	MSC 4		/AC TO CONTROL REGISTER
	SET I 1		/XR1=INITIAL X POSITION
	100
	LDA I		/Y COORDINATE MULTIPLE
	-40
	ADM I		/Y COORDINATE
	0
QAH,	LDH I 3
	JMP QAO+1
	JMP QAZ		/74 BUMP PTR TO NEXT
			/CHAR, PUT 40 IN AC
	JMP QAJ		/34
	SHD I		/NEITHER
	4300
	JMP QAG		/CR. MOVE X AND Y COORD.
	JMP QAP		/ISPLAY CHAR
	JMP QAH		/PICK UP NEXT CHAR
	JMP QAP		/TO HERE IF ANSR
	SRO I		/DSPLY CURSR SWITCH;0 OR 
	0		/IF XR4=XR5, SWITCH=7777
	JMP QAF
			/QUESTION MODE
QAI,	LDH I 5
	JMP QAO+1
	JMP QAH		/74
	JMP QAH		/34
	JMP QAI-4	/NEITHER. DISPLAY IT
QAJ,	JMP GETKBD	/TO HERE IF DSPLYD BUF
	AZE I
	JMP QAB		/NOTHING TYPED . EXIT
	SET I 2
	QAY
	SHD 2		/LF?
	JMP QAK+4	/YES. EXIT
	SHD I 2		/CR?
	JMP QAN
	XSK 6		/IS THERE AN ANSR FIELD?
	JMP QARFSH
	SHD I 2		/<?
	JMP QAL
	SHD I 2		/>?
	JMP QAK
	SHD I 2		/ALT?
	JMP QACA 	/REINITIALIZE
	SHD I 2		/BACK SLASH?
	JMP QARFSH	/IGNORE
	SHD I 2		/RUBOUT?
	JMP QAL		/IGNORE
	SHD I 2		/TAB?
	JMP QARFSH	/IGNORE
	STC .+5		/ACCEPTABLE CHAR
	JMP QAO		/TEST NEXT CHAR
	JMP QAQ		/74 BACK PTR UP BY 1
	JMP QAQ		/34 ^
	LDA I		/OK. STORE IT
	0
	STH 4
	JMP QARFSH	/REDISPLAY
QAL,	LDH 4		/TO HERE IF RUBBOUT OR <
	JMP QAO+1
	JMP QARFSH	/74 IGNORE
	-6002
	LDH 2		/TEST THE CHAR
	SAE I		/RUBOUT?
	37
	JMP QAQ		/NO. BACK PTR UP BY 1
	SET 5
	4
	SET 3
	4
	JMP .+2
	LDH I 5		/BUMP PTR
	LDH I 3		/GET NEXT CHAR
	JMP QAO+1
	NOP		/IF 74 OR 34, REPLACE
			/CURRENT CHAR WITH 0
	CLR
	STH 5
	AZE		/WAS IT 74 OR 34?
	JMP .-7		/NO. CONTINUE
	JMP QAQ		/BACK PTR UP BY 1
			/TO HERE IF CR
QAN,	XSK 6	
	JMP QAK+4	/EXIT IF NO ANSWER BUF
	JMP QAO
	JMP QARFSH	/74 MOVE PTR TO NEXT
			/QUESTION FIELD
	JMP QAE+1	/34 END OF BUFR. MOVE
			/PTR TO 1ST QUESTION
	JMP QAN+2
	
QAO,	LDH I 4		/S\R
	SHD I		/  +1 74 BEGIN FIELD
	7400		/  +2 34 END BUFR
	JMP 0		/  +3 NEITHER 74 NOR 34
	SAE I
	34
	XSK I 0
	XSK I 0
	JMP 0
			/S\R TO DISP CHAR IN AC
QAP,	ROL 1		/*2 FOR ADDRS IN TABLE
	ADD QAX+4
	STC 2		/ADDRSS OF CHAR INTO XR2
	ADD QAU		/EITHER NOP OR ADD QAU
	ADD QAU
	ADD 1		/ADD 4 TO SPACE CHAR
	STC 1
	ADD 5		/GET ADDRSS OF ANS BUFR
	COM
	ADD 4
	AZE
	CLR
	STC QAI-2	/SWITCH=0 OR 7777
	ADD QAH-1	/Y COORDINATE IN AC
	DSC 2
	DSC I 2		/DISPLAY CHAR
	JMP 0
QAQ,	LDA I		/BACK UP PTR BY 1
	-4000
	ADM
	4
	JMP QARFSH	/REDISPLAY
			/
QAT,	LDH I 1		/S\R
	SHD I		/	+1 F
	0600		/	+2 H
	JMP 0		/	+3 NEITHER
	SAE I
	10
	XSK I 0
	XSK I 0
	JMP 0
			/
QAZ,	LDH I 3
	LDA I
	40
	JMP QAI-4
			/TO HERE IF >
QAK,	LDH I 4
	AZE I		/IS CURRENT CHAR BLANK?
	JMP QAQ		/YES. IGNORE
	JMP QAX		/MOVE DOT FORWARD
			/EXIT WITH SKP
	LDA I
	1
	ADM
	QAB
	JMP QAB
			/CHARACTER PATTERNS
QAV,	0101		/ILLEGAL. USED AS MARKER
	0101
	4477		/1:A
	7744
	5177		/2:B
	2651
	4136		/3:C
	2241
	4177		/4:D
	3641
	4577		/5:E
	4145
	4477		/6:F
	4044
	4136		/7:G
	2645
	1077		/10:H
	7710
	7741		/11:I
	0041
	4142		/12:J
	4076
	1077		/13:K
	4324
	0177		/14:L
	0301
	3077		/15:M
	7730	
	3077		/16:N
	7706	
	4177		/17:O
	7741
	4477		/20:P
	3044
	4276		/21:Q
	0376
	4477		/22:R
	3146
	5121		/23:S
	4651
	4040		/24:T
	4077
	0177		/25:U
	7701	
	0176		/26:V
	7402
	0677		/27:W
	7701
	1463		/30:X
	6314
	0770		/31:Y
	7007
	4543		/32:Z
	6151
	4177		/33:/
	0000
			/34:BACKSLASH IGNORED
	0		/NOT USED
	0		/NOT USED
	0000		/35:]
	7741
			/CODES 36:ALT, 37:RUBOUT
			/NOT DISPLAYED
QAY,	4543		/LF,CR
	7476		/<,>
	3634		/ALT, BACKSLASH
	3747		/RUBOUT, TAB
	0000		/40:SPACE
	0000
	7500		/41:X!
	0000
	7000		/42:"
	0070
			/CODES 43:, 44:, 45:LF
			/NOT DISPLAYED
QAX,	JMP QAO+1
	JMP QAQ
	JMP QAQ
	JMP QARFSH
	QAV
	0		/NOT USED
	5166		/46: ?
	0526
			/CODE 47:TAB NOT DSPLYD
	0		/NOT USED
	0		/NOT USED
	3600		/50:(
	0041
	4100		/51:)
	0036
	2050		/52:*
	0050
	0404		/53:+
	0437
	0500		/54:,
	0006
	0404		/55:-
	0404
	0001		/56:.
	0000
	0601		/57:\
	4030
	4536		/60:0
	3651
	2101		/61:1
	0177
	4523		/62:2
	2151
	4122		/63:3
	2651
	2414		/64:4
	0477
	5172		/65:5
	0651
	1506		/66:6
	4225
	4443		/67:7
	6050
	5126		/70:8
	2651
	5122		/71:9
	3651
	2200		/72::
	0000
	4601		/73:;
	0000
			/CODE 74:<NOT DISPLAYED
QAU,	2		/CONSTANT
	0		/NOT USED
	1212		/75:=
	1212
			/CODE 76:> NOT DISPLAYED
QAW,	NOP
	ADD QAU
	4020		/77:?
	2055
/
QAF,	DSC I
	6000
	JMP QAI
/
			/END Q+A
/
/
/
/
/KEYBOARD INPUT ROUTINE
/
QAKRB=6036	/PDP-8 IOT KBD
QATSF=6041	/TSF
QATLS=6046	/TLS
/
GETKBD,	LDA
	0
	STC QAEXIT+6	/SAVE RETURN
	ADD 1		/SAVE XRS 1 AND 2
	STC QAEXIT+3
	ADD 2
	STC QAEXIT+5
	STC QAEXIT+1
	KST		/WAS SOMETHING TYPED?
	JMP 0		/NO: EXIT
	IOB
	QAKRB		/GET TTY CHAR, CLR FLAG
	STA I		/SAVE IT
QATY,	0
	ADA I
	-237
	APO		/BETWEEN 200 AND 237?
	JMP QACNTR	/CONTROL CHAR. CHECK FOR
			/CR,LF,TAB,^C,^D
	SET I 1		/NO
	QACHAR-1
	SET I 2
	-7
	LDA
	QATY
	SAE I 1
	JMP .+2
	JMP QAEXIT	/ILLEGAL CHAR. DONT ECHO
	XSK I 2	/CHECKED THEM ALL?
	JMP .-4
/
	ADA I
	-337
	APO		/BETWEEN 240 AND 337?
	JMP QALEGL	/YES. LEGAL CHAR
/
	SAE I 1		/NO. CHECK FURTHER.
	JMP .+7
	LDA I		/RUBOUT
	334
	JMP QATPE	/ECHO BACKSLASH
	LDA I
	37
	JMP QAEXIT+2	/LEGAL EXIT
/
	SAE I 1
	JMP QAEXIT	/ILLEGAL
			/ALT
	JMP QAEXIT+2	/EXIT, DONT ECHO
/
QALEGL,	LDA
	QATY
	JMP QATPE	/ECHO CHAR
	ADD QATY
	BCL I		/STRIP IT TO 6-BIT
	7700
	JMP QAEXIT+2
/TO HERE IF CONTROL CHAR
QACNTR,	SAE I
	7755
	JMP QACKLF
	LDA I		/CR
	43
	STC QAEXIT+1
	LDA I
	215
	JMP QATPE
	LDA I
	212
	JMP QATPE
	JMP QAEXIT
/
QACKLF,	SAE I
	7752
	JMP QCTRLD
	LDA I		/LF
	45
	JMP QACNTR+5
QATAB,	SAE I
	7751
	JMP QAEXIT	/ILLEGAL
	LDA I
	47
	JMP QAEXIT+2	/EXIT, DONT ECHO
/
QAEXIT,	LDA I		/GET 6-BIT ASCII
	0
	SET I 1		/RESTORE XRS
	0
	SET I 2
	0
	JMP		/EXIR S\R GETKBD
/*********FLICKER REDUCED*************
/S\R TO PRINT C(AC)
QATPE,	PDP
		  PMODE
	TSF
	JMP .-1
	TLS
	CLA
	LINC
		  LMODE
	JMP 0
/*************************************
/
QACHAR,	243	/HASH
	244	/DOLLAR SIGN
	245	/PER CENT
	247	/APOSTROPHE
	300	/AT SIGN
	336	/UP ARROW
	337	/BACK ARROW
	40	/RUBOUT
	36	/ALT
/END OF S\R GETKBD
/********CTRL/D RECOGNIZED**************
QCTRLD,	SAE I
	7744
	JMP QATAB
	CLR
	PDP
		  PMODE
	CDF 10		/RESTART DIAL-MS
	JMP I .+1	/VIA I/O ROUTINES.
	7777
/***************************************
	ASMIFM 2001-.
	TOO BIG-SORRY
	EJECT
		  LMODE
	SEGMNT 5
	*20
/	MILDRED -- MULTIPLE INDEX LOOKUP, DELETION, REPLACEMENT, AND ENTRY (DISK)
/	    DIRECT DESCENDENT OF:
/	FRED -- FILE REPLACEMENT, ENTRY, AND DELETION
/	29 MAY, 1970
/
/
/	BETA REGISTER DEFINITIONS
/		(3, 13, 14, AND 17 ARE UNUSED)
/
	PARAM=1
	FDV=2
	XPNT=4
	XPNT2=5
	LP1=6
	LP2=7
	MARK=10
	ENTSW=11
	NFSW=12
	RET3=15
	RET2=16
/
/	ENTRY POINTS OF MS I/O HANDLERS
/
	READ=7774
	WRITE=7775
	RWFLD=10
/
/   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 LKP000
	DJR
	JMP NTR000
	DJR
	JMP RPL000
	DJR
	JMP DEL000
	EJECT
/
/     LOOKUP - FIND NAMED FILE IN DIAL INDEX
/
/     ENTERED IN LINC MODE WITH ADDRESS OF A PARAMETER
/     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 /
/ 
LKP000,	SET I RET3	/ INDICATE EXTERNAL CALL
	7777
LKP010,	SET RET2	/ SAVE RETURN JMP
	0
/
/	GET CALLERS FIELDS AND PARAMETER LIST
/
	BSE I		/ SET BIT 0, LATER BECOMES BIT 1
	4000
	ROL I 2		/ IF-DF BIT TO LINK
	ROR 2		/ RESTORE REST
	BCL I		/ CLEAR HALF-WORD BIT
	4000
	STC PARAM	/ HOLD THE REST
	STC ENTSW	/ CLEAR ENTRY SW
	IOB		/ DO RIB IOT
	LRIB
	STA I		/ HOLD IT
SAVFLD,	0
	ROR 3		/ IF TO BITS 7-11
	BCL I		/ DROP OTHERS
	7740
	BSE I		/ BUILD LIF INST
	LIF
	STC RESTIF	/ FOR RESTORING
	ADD SAVFLD	/ GET DF BITS IN 9-11, 0-1
	ROL 2		/ NOW IN 7-11
	BCL I		/ CLEAR OTHERS
	7740
	BSE I		/ BUILD LDF INST
	LDF
	STC RESTDF	/ SAVE TO RESTORE LATER
	LZE		/ SKIP IF PARMS IN USER INST FLD
	ADD RESTDF
	LZE I		/ SKIP IF PARMS IN HIS DATA FIELD
	ADD RESTIF
	BSE I		/ MAKE AN LDF INST OF IT
	LDF
	STC SETUDF	/ HOLD FOR ADDRESSING PARAMS
/
/     RELOCATE FOR THIS SEGMENT
/
	LDA	 I	/ INIT AC 11=1
	1
	IOB
	LRIF		/ GET INSTRUCTION FIELD IN 6-10
	ROL 1		/ NOW IN 5-9, 10=1, 11=0
	STA		/ HOLD FOR READING
	XPARM+1
	ROR 2		/ FOR BUILDING LDF
	BCL I		/ DROP EXTRANEOUS
	7740
	BSE I
	LDF		/ BECOMES INSTR FOR SETTING TO THIS SEGMENT
	STA		/ HOLD FOR LATER USE
	SETMDF
	BCL I		/ GET SEGMENT BITS
	7774
	ROR 2		/ MOVE TO HIGH ORDER
	ADD PPOINT	/ COMBINE WITH PARAMETER ADDRESS
	STA
 
/********2 DEC BUGS FIXED***************
	PPNT1?1777
	STC PPNT2?1777	/...FOR INPUT AND OUTPUT
/***************************************
 
/
/	READ THE INDEX
/
	JMP SETUDF	/ SET DATA FIELD FOR USERS PARAMS
	LDA PARAM	/ GET UNIT
	BCL I		/ ONLY
	7760
	STC XPARM
	JMP SETMDF	/ SET DATA FIELD TO US FOR RETURN FROM I/O
	PDP		/ PMODE FOR READING
	PMODE
	CIF RWFLD	/ I/O IS IN FIELD 1
	JMS I	PREAD
PPNT1,	XPARM		/ PARAMETER ADDRESS
	LINC
	LMODE
	JMP SETUDF	/ GET USERS PARAMETER LIST
	SET I XPNT
	INDEX
	LDA XPNT	/ GET FIRST WORD OF INDEX
	SAE I		/ SKIP IF VALID FOR INDEX
	5757		/ FIRST WORD OF INDEX
	SKP		/ NOT AN INDEX -- BUILD ONE
	JMP LKP020	/ INDEX IS OK -- GO TO NAME SCAN
/
/     THERE IS NO INDEX -- CREATE ONE
/
	LDA I		/ GET FILLER WORD
	5757
	STA XPNT	/ STORE IN NEXT INDEX WORD
	XSK I XPNT	/ INCREMENT AND TEST FOR END
	JMP .-2		/ ZAP ANOTHER
	XSK I PARAM	/ ADJUST PARAM
	STA XPNT	/ ZAP LAST WORD
	JMP ERRTN	/ RETURN NO FIND
/
/	ADDR OF READ ROUTINE IN FIELD 1
/
PREAD,	READ
	EJECT
/
/     SCAN INDEX FOR NAME
/
LKP020,	LDA I PARAM	/ GET FIRST WORD OF NAME
	STC WORD1	/ SAVE AT COMPARE INST
LKP030,	LDA I		/ CONSTANT 7
	7
	ADM		/ ADD IT TO INDEX POINTER
	XPNT
	XSK XPNT	/ TEST FOR END OF INDEX
	SKP		/ SKIP NOT END
	JMP ERRTN	/ OTHERWISE RETURN NO SUCCESS
	LDA I XPNT	/ GET A WORD OF INDEX NAME
	SAE I		/ SKIP OUT OF LOOP IF FIRST 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
	PARAM
	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	/ LOOP TO COMPARE ENTIRE NAME
	JMP LKP050
/
/     IF WE GET HERE, WEVE FOUND THE NAME
/
	LDA I FDV	/ PICK UP SOURCE/BINARY 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 DETECTING ERROR, OR UNSUCCESSFUL FIND
/
ERRTN,	XSK RET3	/ TEST FOR INTERNAL CALL
	JMP RET2	/ RETURN NOW IF INTERNAL
	SET 0		/ MOVE IN RETURN JMP
	RET2
RESTOR=.
RESTDF,	LDF		/ MODIFIED FOR...
RESTIF,	LIF		/...USERS FIELDS
	JMP 0		/ RETURN TO CALLER
	EJECT
/
/     WEVE FOUND WHAT HE WANTS - GIVE IT HIM
/
WNTB,	XSK I XPNT2	/ CANT SKIP, BUT THIS ...
	XSK I XPNT2	/...FAKES OUT THE POINTER
WNTS,	XSK RET3	/ IF INTERNAL CALL...
	XSK I RET2	/...SETUP FOR THREE RETURNS
	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	/ RETURN ERROR IF NO FILE
	XSK RET3	/ DONT STORE RESULT IF INTERNAL
	SKP
	STA I FDV	/ RETURN NO OF BLOCKS
	XSK I RET2	/ INCREMENT JMP RETURN ADDRESS
	JMP ERRTN	/ NOT REALLY AN ERROR
/
/
/	SETUDF - SET DATA FIELD FOR USERS PARAMETER LIST
/
SETUDF,	LDF		/ INSTRUCTION OVERLAID
	JMP 0		/ RETURN
/
/
/	SETMDF - SET DATA FIELD FOR MILDRED
/
SETMDF,	LDF		/ MODIFIED
	JMP 0
/
/
PPOINT,	XPARM?777	/ LOW-ORDER BITS OF XPARM ADDR
/
/     PARAMETERS TO READ ROUTINE
/
XPARM,	0		/ UNIT
	0		/ DATA ADDRESS SHIFTED RIGHT 8 BITS
	346		/ BLOCK NUMBER
	2		/ BLOCK COUNT
	EJECT
/
/     REPLACE -- REPLACE A NAMED ENTRY IN DIAL INDEX
/
/     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 -- STOP
	XSK ENTSW	/ TEST FOR CONTINUE AFTER HALT
	JMP RPL010	/ BAD BOY -- STOP AGAIN
	JMP SETUDF	/ GET CORRECT DATA FIELD
	LDA I		/ ZAP LENGTH FIELD OF THIS 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 LKP010	/ LOOKUP NAME IN INDEX
	JMP NTR020	/ THIS NAME IS NOT IN INDEX
	JMP NTR010	/ NAME IS 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 POINTER AREA - 2
	STC MARK	/ SAVE POINTER FOR REPLACE
	SET I ENTSW	/ INDICATE 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 ADDR OF FILE POINTERS
	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		/ PICK UP SKIP-NEG INSTRUCTION
	APO I		/ MOVED TO FCF050
	STC FCF050	/ STORE IN INDEX-SCAN ROUTINE
	LDA I
	5
	ADD PARAM	/ POINT TO USERS START BLOCK FIELD
	STA 		/ HOLD FOR LATER
	LP1
	STC LP2		/ STORE POINTER
	LDA I LP2	/ PICK UP LENGTH
	APO		/ TEST FOR POSITIVE LEN REQUEST
	JMP RTRN0	/ ELSE RETURN ERROR 
	AZE I		/ SKIP IF LEN NOT ZERO
	JMP RTRN0	/ BOMB IF NULL REQUEST
	STA 		/ HOLD LENGTH HANDY
	TRYLEN
	COM
	ADA I		/ SUBTRACT LEN FROM HIGHEST BLOCK NO, LOW FILE
	270
FSP010,	AZE I		/ SKIP NOT ZERO
	CLR		/ FORCE TRUE ZERO IF RESULT IS 7777
	APO		/ SKIP IF STILL ON THE TAPE
	JMP FSP020	/ NO SPACE IN LOW FILE AREA
	STC TRY		/ HOLD TRIAL STARTING BLOCK
	JMP FCF000	/ GO FIND POSSIBLE CONFLICT
	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
/
/     WEVE FOUND NO SPACE LARGE ENOUGH IN THE LOWER FILE 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 CONSTANT (TRYEND-2*INDEX LOC)
	-716
	STC UPLIM	/ MINUS HIGHEST DESIRABLE STARTING BLOCK
FSP035,	LDA I 		/ GET SKIP-POS INSTRUCTION
	APO		/ MOVED TO FCF050
	STC FCF050	/ STORE IN INDEX SCAN ROUTINE
	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	/ SKIP IF FOUND IN LOWER AREA
	JMP RTRN0	/ RETURN BAD NEWS -- NO SPACE
	LDA		/ GET START BLOCK OF FILE IN LOWER AREA
	SVTRY
	STC TRY		/ THATS THE ONE WELL USE
/
/     THERE IS SPACE AT TRY
/
FSP060,	XSK MARK	/ WAS THERE A FILE BY THIS NAME
	JMP FSP100	/ YES - GO USE THAT ENTRY
/
/     WE MUST SEARCH FOR EMPTY INDEX SPACE
/
	SET I MARK	/ INITIALIZE MARK POINTER
	INDEX
FSP070,	LDA I 		/ BUMP INDEX INDEX
	7
	ADM
	MARK
	XSK MARK	/ TEST FOR END OF INDEX
	SKP		/ NOT END
	JMP RTRN0	/ NO SPACE IN INDEX -- RETURN ZERO
	LDA I MARK	/ FIRST WORD OF INDEX NAME
	SAE I		/ CHECK FOR EMPTY ENTRY
	5757
	JMP FSP070	/ NOT EMPTY, TRY NEXT
/
/     MARK POINTS TO AN UNUSED INDEX ENTRY
/     PUT THE NAME INTO IT
/ 
	LDA PARAM	/ FIRST WORD OF USER NAME
	STA MARK	/ PLUNK INTO INDEX
	LDA I PARAM	/ 2ND
	STA I MARK
	LDA I PARAM	/ 3RD
	STA I MARK
	LDA I PARAM	/ 4TH
	STA I MARK
	LDA I PARAM	/ TYPE CONTROL (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 STARTING BLOCK
	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
/
	XSK I RET3	/ BUMP RETURN ADDR
FSP110,	JMP SETMDF	/ SET DATA FIELD TO MILDRED
	PDP
	PMODE		/ PMODE FOR I/O
	CIF RWFLD	/ ROUTINES IN FIELD ONE
	JMS I	PWRITE
PPNT2,	XPARM		/ RELOCATED FOR THIS SEGMENT
	LINC
	LMODE
RTRN0,	SET 0		/ MOVE RETURN JMP TO 0
	RET3
	DJR
	JMP RESTOR	/ RETURN TO USER
/
/	ADDR OF WRITE ROUTINE IN FIELD 1
/
PWRITE,	WRITE
	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	/ INITIALIZE POINTER TO INDEX IN CORE
	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 FIRST 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 IS EMPTY
	XPNT
	JMP FCF010	/ TRY NEXT INDEX ENTRY
FCF030,	LDA I		/ INCREMENT BY 4
	4
	ADM		/...TO ADDRESS POINTER
	XPNT
/
/     XPNT NOW ADDRESSES A STARTING BLOCK NO
/
FCF040,	LDA XPNT	/ PICK UP STARTING BLOCK
	ADA I		/ SUBTRACT INDEX LOCATION
	-347
FCF050,	APO		/ REVERSE SENSE BIT MAY BE SET BY CALLER
	JMP FCF010	/ TRY AGAIN IF WRONG FILE AREA
	SET XPNT2	/ TEMP POINT TO LENGTH WORD
	XPNT
	LDA I XPNT2	/ PICK UP LENGTH
	APO		/ SKIP IF LENGTH POS
	JMP FCF010	/ NEG LEN -- NO FILE HERE
	EJECT
/
/     WE NOW HAVE A VALID INDEX ENTRY
/     COMPARE IT TO TRY
/
	LDA XPNT	/ STARTING BLOCK OF THIS FILE
	BCL I		/ CLEAR GARBAGE IN HIGH THREE BITS
/*************************************
	6000		/BIG TAPE!
/*************************************
	COM
	ADD TRY		/ SUBTRACT XSTART FROM TRY
	APO		/ SKIP IF TRY ABOVE XSTART
	JMP FCF060	/ JMP IF BELOW
/
/     TRY IS ABOVE THE START OF THIS FILE
/
	COM		/ MAKE DIFFERENCE NEGATIVE
	ADA XPNT2	/ SUBTRACT DIFFERENCE FROM FILE LENGTH
	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 ADDRESS
	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 LKP010	/ LOOKUP NAME IN INDEX
	JMP RTRN0	/ DIDNT FIND THE FILE
	JMP RTRN0	/ DITTO
	LDA I		/ DECREMENT XPNT2
	-1
	ADM		/...TO ADDRESS START BLOCK FIELD
	XPNT2
	LDA I		/ EMPTY AREA INDICATOR
	5757
	STA XPNT2	/ ZAP START BLOCK FIELD
	STA I XPNT2	/ DITTO LEN
	LDA 		/ GET POINTER
	XPNT2
	BCO I		/ ADDRESS OTHER TYPE LEN FIELD
	2
	STC XPNT2
	LDA XPNT2	/ PICK LENGTH OF OTHER-TYPE FILE
	APO I		/ SKIP IF OTHER-TYPE EMPTY
	JMP FSP110	/ GO RE-WRITE INDEX
	LDA I		/ BOTH TYPES EMPTY -- CLEAR NAME
	5757
	STA XPNT	/ ZAP FIRST WORD OF NAME
	STA I XPNT	/ 2ND
	STA I XPNT	/ 3RD
	STA I XPNT	/ 4TH
/
/	WAS THAT THE LAST FILE ?
/
	SET I XPNT	/ POINT TO INDEX
	INDEX-1		/...FOR SCAN
DEL010,	SAE I XPNT	/ IS THERE ANY ENTRY?
	JMP FSP110	/ YES - REWRITE INDEX
	XSK XPNT	/ HAVE WE CHECKED ALL?
	JMP DEL010	/ NO - LOOP
/
/	INDEX IS EMPTY: FILL WITH ZERO
/
	CLR
	SET I XPNT	/ RESET POINTER
	INDEX-1
	STA I XPNT	/ CLEAR NEXT WORD
	XSK XPNT	/ DONE?
	JMP .-2
	JMP FSP110	/ RE-WRITE INDEX
	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 FOR ONE FIELD.
/	IN CASE OF MINOR SIZE PROBLEMS, REMOVE 5 LINES OF CODE AT FCF040.
/	REMOVE 3 LINES AT FSP000, AND THREE LINES AT FSP035.  THIS SHOULD
/	REMOVE ALL REFERENCES TO FCF050.  ALL OTHER TAGS MUST BE RETAINED.
/
/
/
/	END OF MILDRED
/
	EJECT
	SEGMNT 6
/ DEFINITIONS OF ADDRESSES OF PARAMETERS
/ ON SYSTEM BLOCK 20 (MODIFIED BY DW OUTPUT)
	*120
PBETA2,	3000		/3 BETA REGISTER IMAGES
PBETA3,	3000		/POINT TO LAST WORD
PBETA4,	3400		/USED IN LAST BLOCK.
PBETA5,	2243		/PTR TO LAST WORD
			/USED IN CTLTAB.
	0
PBBTBK,	5\370		/POINT TO THE
PWBTBK,	5\370		/NEXT TO THE LAST
PCURTB,	6\371		/(OR LAST) TAPE
PSPTBK,	5\370		/BLOCK USED.
	0
	0
PCURLN,	1		/LAST LINE NO.
PMAXLN,	1		/IN SOURCE.
	0
	0
PMAXTB,	6\371		/POINT TO THE
PCBTBK,	7\371		/TAPE BLOCK
PUNKNO,	7\371		/USED.
	0
	0
 
	*227
PCTLTA,	0		/CTLTAB IMAGE.
	EJECT
	*1000
STMES,	TEXT "F  PIP-1600
H
H OPTION/FILE TYPE (S,B;Z;U)<1
H
H INPUT  (U:NAME)<:
H OUTPUT (U:NAME)<:\"
 
INGMES,	TEXT "F INPUT NOT FOUND\"
REPMES,	TEXT "F REPLACE?<1\"
FULMES,	TEXT "F TAPE TOO FULL\"
	EJECT