/	BINARY PATCHES TO FOCAL

/	LAST EDIT:	15-MAY-1986	18:00:00	CJL

/	MAY BE ASSEMBLED WITH '/J' SWITCH SET.

/	THIS FILE IS A ONE-PAGE COLLECTION OF PATCHES TO FOCAL TO IMPLEMENT THREE
/	FUNCTIONS:

/	1):	FBLK(BLOCK[,WRITE-INDICATOR])
/	2):	FWRD(ADDRESS[,REPLACEMENT VALUE])
/	3):	FAND(FIRST-ARGUMENT[,SECOND-ARGUMENT])

/	DESCRIPTION OF FUNCTIONS:

/	FUNCTION "FBLK" READS (OR WRITES) A SET OF DISK BLOCKS STARTING FROM THE
/	BLOCK NUMBER EVALUATED FROM THE FIRST ARGUMENT. THE FUNCTION WILL CAUSE
/	A READ OPERATION IF ONE ARGUMENT IS GIVEN; MERELY GIVING A SECOND
/	ARGUMENT CAUSES A WRITE OPERATION (THE ARGUMENT VALUE IS UNIMPORTANT).
/	THE MEMORY AFFECTED BY THE TRANSFER IS LOCATION 0000 ONWARD IN FIELD
/	"BUFFLD." THE NUMBER OF BLOCKS TRANSFERRED IS DETERMINED BY "N." THE
/	LOGICAL I/O UNIT IS DETERMINED BY "UNIT."

/	FUNCTION "FWRD" RETURNS THE CONTENTS OF THE SPECIFIED MEMORY ADDRESS
/	EVALUATED FROM THE FIRST ARGUMENT. IF A SECOND ARGUMENT IS PASSED, THEN
/	ITS EVALUATION BECOMES THE REPLACEMENT VALUE AT THE SPECIFIED ADDRESS.
/	THE "FWRD" FUNCTION CAN BE CONDITIONALLY ASSEMBLED TO TREAT THE FIRST
/	ARGUMENT AS A TWELVE BIT ADDRESS OF A TWELVE BIT NUMBER OR AN ELEVEN BIT
/	ADDRESS OF A TWENTY-FOUR BIT NUMBER.

/	FUNCTION "FAND" RETURNS THE LOGICAL BIT-WISE AND OF THE TWO ARGUMENTS
/	PASSED TO IT. IF THE SECOND ARGUMENT IS NOT PRESENT, IT IS TREATED AS
/	ZERO AND CAUSES A ZERO RETURN VALUE.

/	ASSEMBLY INSTRUCTIONS:

/	SET "ADR" TO 0 FOR 12-BIT ADDRESSING, 1 FOR 24-BIT ADDRESSING (DEFAULT IS 0).

/	SET "BUFFLD" TO THE PROPER FIELD FOR "FBLK", "FWRD" (DEFAULT IS 40).

/	SET "N" TO THE I/O CALL LENGTH DESIRED IN "FBLK" (DEFAULT IS 00 WHICH
/	USES 40 BLOCKS).

/	SET "UNIT" TO THE DESIRED I/O UNIT (DEFAULT IS 7).
/	DEFINITIONS FROM FOCAL, 1969 (ORIGINAL PAPER-TAPE VERSION).

	BOTTOM=	0035			/FOCAL PUSHDOWN LIMIT
	CHAR=	0066			/FOCAL'S INPUT BUFFER
	EFUN3I=	0136			/FUNCTION RETURN POINTER
	EVAL=	1613			/EVALUATOR ENTRY POINT
	FLAC=	0044			/FLOATING ACCUMULATOR HERE
	FNTABF=	0374			/FUNCTION ADDRESS TABLE
	FNTABL=	2165			/HASHED FUNCTION NAME TABLE
	INTEGER=0053			/FLOATING TO FIXED CONVERSION POINTER
	POPA=	TAD I	13		/REMOVE WORD FROM STACK
	POPJ=	JMP I	141		/REMOVE AND RETURN FROM STACK
	PUSHA=	JMS I	142		/PUSH WORD ONTO STACK
	PUSHJ=	JMS I	140		/CALL WITH RETURN ON STACK
	P7600=	0104			/CONSTANT 7600
	RETURN=	JMP I	EFUN3I		/FUNCTION RETURN INSTRUCTION

/	DEFINITIONS FROM P?S/8 FOCAL OVERLAY.

	BEOFZAP=7505			/BINARY LOADER ZAP WORD
	BONCE=	3600			/OVERLAY ONCE-ONLY ADDRESS
	SYSIO=	7640			/SYSTEM I/O ENTRY POINT

/	MISCELLANEOUS DEFINITIONS.

	IFNDEF	ADR	<ADR=	1>	/USE 12-BIT ADDRESSING FOR FWRD
	IFNDEF	BUFFLD	<BUFFLD=40>	/BUFFER FIELD FOR FBLK AND FWRD
	IFNDEF	N	<N=	00>	/DO 40 BLOCK READ/WRITE CALLS FOR FBLK
	NL4000=	CLA CLL CML RAR		/SET AC TO 4000
	NSTART=	-12^ADR+4077		/PATCH ASSEMBLY ADDRESS
	IFNDEF	UNIT	<UNIT=	7>	/I/O UNIT FOR FBLK

	FIELD	0			/ENSURE FIELD ZERO

	*FNTABL+14			/PUT IN HASHED NAMES

	"B^2+"L^2+"K			/BLK
	"W^2+"R^2+"D			/WRD
	"A^2+"N^2+"D			/AND
	*NSTART				/START PATCH HERE FOR DIRECT LOADING

/	DISK I/O FUNCTION:	FBLK(BLOCK[,WRITE-INDICATOR]).

XBLK,	JMS I	INTEGER			/GET BLOCK ARGUMENT
	PUSHA				/SAVE IT
	PUSHJ				/FIND OUT IF WE WRITE
LARG1,	ARG				/**** RELOCATE ****
	NL4000				/MAKE IT A READ
	TAD	(N^100+BUFFLD+UNIT+4000)/GET OTHER FUNCTION BITS
	DCA	FUN			/PUT IN-LINE EITHER WAY
	POPA				/RESTORE BLOCK ARGUMENT
	DCA	TBLK			/PUT IN-LINE ALSO
	JMS I	PSYSIO/(SYSIO)		/CALL FOR READ OR WRITE
	0				/CORE
FUN,	.-.				/FILLED IN
TBLK,	.-.				/FILLED IN
	ION				/MAKE SURE INTERRUPTS ARE STILL ON
	RETURN				/BACK TO FOCAL

/	LOGICAL AND FUNCTION:	FAND(FIRST-ARGUMENT,SECOND-ARGUMENT)

XAND,	JMS I	INTEGER			/GET FIRST ARGUMENT
	PUSHA				/SAVE IT
	TAD	FLAC+1			/GET HIGH-ORDER
	PUSHA				/SAVE IT ALSO
	PUSHJ				/FIND OUT VALUE OF SECOND ARGUMENT
LARG2,	ARG				/**** RELOCATE ****
	JMP	NOSEC			/WASN'T ANY
	JMS I	INTEGER			/EVALUATE SECOND ARGUMENT
	CLA				/THROW IT AWAY FOR NOW
ZEROIN,	POPA				/GET FIRST HIGH-ORDER
	AND	FLAC+1			/AND WITH SECOND HIGH-ORDER
	DCA	FLAC+1			/SAVE RESULT
	POPA				/GET FIRST LOW-ORDER
	AND	FLAC+2			/AND WITH SECOND LOW-ORDER
FBLKIN,	DCA	FLAC+2			/SAVE RESULT
	TAD	(27)			/SETUP THE
	DCA	FLAC			/NEW EXPONENT
	RETURN				/RETURN TO FOCAL

NOSEC,	DCA	FLAC+1			/CLEAR
	DCA	FLAC+2			/FLAC
	JMP	ZEROIN			/CONTINUE THERE
/	MEMORY REFERENCE FUNCTION:	FWRD(ADDRESS[,NEWVALUE]).

XWRD,	JMS I	INTEGER		/GET ADDRESS ARGUMENT

	IFNZRO	ADR	<

	CLL RAL			/ADJUST TO DOUBLE-WORD ADDRESS

			>

	PUSHA			/SAVE IT
	PUSHJ			/EVALUATE SECOND IF ANY
LARG3,	ARG			/**** RELOCATE ****
	JMP	GET		/NONE, JUST GET VALUE
	POPA			/RESTORE ADDRESS
	DCA	TBLK		/SAVE AS POINTER
	JMS I	INTEGER		/GET REPLACEMENT VALUE

	IFNZRO	ADR	<

	CLA			/THROW AWAY LOW-ORDER
	TAD	FLAC+1		/GET HIGH-ORDER

			>

	CDF	BUFFLD		/GOTO BUFFER FIELD
	DCA I	TBLK		/STORE IT

	IFNZRO	ADR	<

	TAD	TBLK		/GET THE POINTER
	IAC			/BUMP TO NEXT
	DCA	FUN		/STASH IT
	TAD	FLAC+2		/GET LOW-ORDER
	DCA I	FUN		/STORE IT ALSO

			>

	JMP	GET2		/FINISH UP
GET,	POPA			/GET BACK ADDRESS
	DCA	TBLK		/SAVE IT
GET2,	CDF	BUFFLD		/GOTO BUFFER FIELD

	IFNZRO	ADR	<

	TAD I	TBLK		/GET HIGH-ORDER

			>

	DCA	FLAC+1		/STORE IT

	IFNZRO	ADR	<

	ISZ	TBLK		/BUMP TO NEXT

			>

	TAD I	TBLK		/GET VALUE
	CDF	00		/BACK TO US
	JMP	FBLKIN		/CONTINUE THERE

ARG,	TAD	CHAR		/ARGUMENT EVALUATOR
	TAD	(-",)		/GOOD TERMINATOR?
PSYSIO,	SZA CLA			/SKIP IF SO
	POPJ			/RETURN IF NOT
	PUSHJ;	EVAL-1		/EVALUATE SECOND ARGUMENT
	IAC			/INDICATE SKIP RETURN
	POPJ			/RETURN

	PAGE

	NEND=	.		/END OF RELOCATABLE PATCH CODE
/	ONCE-ONLY CODE STARTS HERE.

	*BONCE			/OVER DEFAULT ONCE-ONLY AREA

PBASE,	TAD	BOTTOM		/\
	TAD	(-200+1)	/ \ESTABLISH
	AND	P7600/[7600]	/ /BASE ADDRESS
	DCA	PBASE		//
	TAD	PBASE		/\
	TAD	(NSTART&177-1)	/ >ESTABLISH NEW LIMIT
	DCA	BOTTOM		//
	TAD	PBASE		/\
	TAD	(XBLK&177)	/ >INSERT FBLK
	DCA I	(FNTABF+14)	//
	TAD	PBASE		/\
	TAD	(XWRD&177)	/ >INSERT FWRD
	DCA I	(FNTABF+15)	//
	TAD	PBASE		/\
	TAD	(XAND&177)	/ >INSERT FAND
	DCA I	(FNTABF+16)	//
	TAD	PBASE		/\
	TAD	(ARG&177)	/ \
	DCA I	(LARG1)		/  \
	TAD I	(LARG1)		/   >FIXUP ADDRESS CONSTANTS
	DCA I	(LARG2)		/  /
	TAD I	(LARG2)		/ /
	DCA I	(LARG3)		//
	TAD	BOTTOM		/\
	IAC			/ >SETUP MOVE BASE
	DCA	PBASE		//
	TAD I	LNSTART		/\
	DCA I	PBASE		/ \
	ISZ	LNSTART		/  \MOVE DOWN PATCH TO
	ISZ	PBASE		/  /WHERE IT BELONGS
	ISZ	MOVCNT		/ /
	JMP	.-5		//
	DCA I	(BEOFZAP)	/REPAIR LOADER
	JMP I	(BEOFZAP)	/RESUME LOADING
LNSTART,NSTART			/POINTER TO NSTART
MOVCNT,	NSTART-NEND		/CODE MOVE COUNTER

	PAGE

	*BEOFZAP		/OVER LOADER

	SKP			/MAKE IT COME TO US

	$			/THAT'S ALL FOLK!

	JMS I	PDSPLAY/[DSPLAY]/DISPLAY BUFFER WHILE WAITING FOR INPUT
	FIELD	DFIELD%10	/IN (FIRST) BUFFER FIELD

	*ALPHA			/START AT THE BEGINNING

ALPHA,	.-.			/ALPHA REGISTER FOR PDP-12 VERSION
DSPBACK,-4-1			/**** OPATCH OR VT8PCH **** -2-1
DSPRETU,.-.			/BUFFERED DISPLAY CALLER RETURN ADDRESS
STKTMP,	.-.			/TEMPORARY FOR STACK OPERATIONS

/	FIX THE FLAC AND PUSH ROUTINE.

FIXPUSH,.-.			/FIX AND PUSH ROUTINE
	CIF CDF	00		/GOING TO FIELD ZERO
	JMP I	[INTPUSH]	/CONTINUE THERE

/	COMES BACK HERE WHEN THROUGH.

PUSHMOR,JMP I	FIXPUSH		/RETURN

	*10			/GET TO AUTO-INDEX AREA

XR1,	.-.			/AUTO-INDEX FOR DISPLAY
XR2,	.-.			/SECOND AUTO-INDEX FOR DISPLAY
XR3,	OUTBUFFER-1		/AUTO-INDEX FOR FDIS, ETC.
XR4,	OUTBUFFER-1		/SECOND AUTO-INDEX FOR FDIS, ETC.
DISCNT,	0			/CURRENT DISPLAY COUNT
DSPCNT,	.-.			/DISPLAY BUFFER COUNTER
X,	.-.			/"X" COORDINATE
Y,	.-.			/"Y" COORDINATE

	*20			/GET PAST AUTO-INDEX AREA

/	POP ELEMENT OFF OF STACK ROUTINE.

POPAC,	.-.			/POP INTO AC ROUTINE
	ISZ I	[PDLXR]		/BUMP STACK POINTER
	TAD I	[PDLXR]		/GET THE NEW VALUE
	DCA	STKTMP		/STASH IT
	TAD I	STKTMP		/GET THE VALUE
	JMP I	POPAC		/RETURN
/	DISPLAY BUFFER SUBROUTINE.

DISPLAY,.-.			/DISPLAY ROUTINE
	TAD	DISCNT		/GET CURRENT DISPLAY COUNT
	CMA			/INVERT FOR COUNTING
	DCA	DSPCNT		/STASH THE COUNTER
	TAD	[OUTBUFFER-1]	/POINT TO
	DCA	XR1		/DISPLAY BUFFER
	TAD	[OUTBUFFER-1]	/POINT TO
	DCA	XR2		/DISPLAY BUFFER
	IOF			/PREVENT PROBLEMS!
	JMP	DISPIN		/CONTINUE THERE

DISPLP,	CDF	DFIELD		/GOTO OUR (FIRST) FIELD
	TAD I	XR1		/GET X VALUE

	IFNZRO	AA01A	<

	DAL1			/LOAD X
	CLA			/CLEAN UP

			>

	IFNZRO	AX08	<

	DXC DXL			/LOAD X
	CLA			/CLEAN UP

			>

	IFNZRO	S34D	<

	DIXL			/LOAD X
	CLA			/CLEAN UP

			>

	IFNZRO	VC12	<

	DCA	ALPHA		/STORE X

			>

	IFNZRO	VC8E	<

	DILX			/LOAD X ON VC-8/E
	CLA			/CLEAN UP

			>
ZAP8K1,	CDF	DFIELD		/**** /2 **** CDF DFIELD+10
ZAP8K2,	TAD I	XR1		/**** /2 **** TAD I XR2

	IFNZRO	AA01A	<

	DAL2 DINT		/LOAD Y AND INTENSIFY
	CLA			/CLEAN UP
	AND I	0		/WASTE
	AND I	0		/SOME TIME

			>

	IFNZRO	AX08	<

	DYC DYL DISA		/LOAD Y AND INTENSIFY
	CLA			/CLEAN UP

			>

	IFNZRO	S34D	<

	DYS			/LOAD Y AND INTENSIFY
	CLA			/CLEAN UP

			>

	IFNZRO	VC12	<

	LINC			/GOTO L...MODE
	DIS	ALPHA		/DISPLAY THE POINT
	PDP			/BACK TO P...MODE
	CLA			/CLEAN UP

			>

	IFNZRO	VC8E	<

	DILY			/LOAD Y ON VC-8/E
	CLA			/CLEAN UP
	DISD			/WAIT FOR DONE
	JMP	.-1		/ON VC-8/E
	DIXY			/INTENSIFY POINT NOW

			>

	IFNZRO	CSW	<

	LAS			/GET CONSOLE SWITCHES
	DCA	STKTMP		/STASH AS COUNTER
	ISZ	STKTMP		/WAITED LONG ENOUGH?
	JMP	.-1		/NO, KEEP GOING

			>
/	COMES HERE AT THE END OF ONE DISPLAY CYCLE.

DISPIN,	ISZ	DSPCNT		/DONE ALL YET?
	JMP	DISPLP		/NO, KEEP GOING
	ION			/SAFE TO COME OUT NOW
	JMP I	DISPLAY		/YES, RETURN

/	COMES HERE TO FINISH THE BUFFERED DISPLAY CALL.

DSPMORE,TAD I	[DSPLAY]	/GET THE CALLER
	TAD	DSPBACKUP	/GET BACKUP FACTOR OF TWO OR FOUR AS NECESSARY

/	NOW HAVE EFFECTIVE "JMP .-4" IF "OPATCH" OR "VT8PCH" IS NOT PRESENT,
/	NOW HAVE EFFECTIVE "JMP .-2" IF "OPATCH" OR "VT8PCH" IS PRESENT.

	DCA	DSPRETURN	/STORE EFFECTIVE RETURN ADDRESS AS ABOVE
	JMS	DISPLAY		/CALL BUFFER DISPLAY ROUTINE
	CIF CDF	00		/GOTO CALLING FIELD
	JMP I	DSPRETURN	/RETURN TO CALLER

/	COMES HERE TO FINISH THE "FIO", "FDIS" FUNCTIONS.

XIOMORE,SNA			/INPUT/OUTPUT FUNCTION?
	JMP	DODISP		/NO, MUST BE DISPLAY
	AND	[177]		/JUST SEVEN-BIT
	DCA I	[FLAC+1]	/STORE IN HIGH-ORDER
	DCA I	[FLAC+2]	/CLEAR LOW-ORDER
	TAD	[13]		/GET SHIFT FACTOR
	DCA I	[FLAC]		/SET EXPONENT
DISPRET,CIF CDF	00		/GOING TO FIELD ZERO
	JMP I	[XRET]		/FINISH IT THERE

/	COMES HERE TO FINISH "FDIS" FUNCTION.

DODISP,	JMS	FIXPUSH		/FIX AND PUSH FIRST ARGUMENT
	TAD I	[CHAR]		/GET THE LATEST CHARACTER
	TAD	[-",]		/COMPARE TO ","
	SZA CLA			/SKIP IF IT MATCHES
	JMP	DISP1		/JUMP IF ONLY ONE ARGUMENT
	TAD	[EVALRETURN]	/GET OUR RETURN
	JMS	FIXPUSH		/PUSH IT ON STACK
	TAD	[EVALMORE]	/SETUP THE PROPER
	DCA	FIXPUSH		/RETURN ADDRESS
	CIF CDF	00		/GOING TO FIELD ZERO
	JMP I	[EVAL-1]	/EFFECTIVELY PUSHJ;EVAL-1 AND RETURN TO "EVALMORE"
/	COMES BACK HERE AFTER EVALUATING THE SECOND "FDIS" ARGUMENT.

EVALMOR,JMS	FIXPUSH		/FIX THE SECOND ARGUMENT AND PUSH IT
	JMS	POPAC		/GET IT BACK
	DCA	Y		/SAVE AS "Y" COORDINATE
	JMS	POPAC		/GET PREVIOUS ARGUMENT

	IFNZRO	AX08!VC12	<

	TAD	[400]		/MAKE IT SYMMETRICAL

				>

	DCA	X		/SAVE AS "X" COORDINATE
	TAD	XR3		/GET OUTPUT POINTER
	IAC			/SEE IF AT END
	SZA CLA			/SKIP IF TOO FAR
	JMP	DISPOK		/JUMP IF NOT
	TAD	[XDYS+6]	/GET ERROR ADDRESS
	CIF	00		/GOING TO FIELD ZERO
	JMP I	[ERROR5]	/GO COMPLAIN THERE

/	INSERT THE LATEST PAIR INTO THE DISPLAY BUFFER.

DISPOK,	ISZ	DISCNT		/BUMP UP DISPLAY COUNT
	CDF	DFIELD		/GOTO BUFFER FIELD
	TAD	X		/GET X VALUE
	DCA I	XR3		/PUT IT IN
ZAP8K3,	CDF	DFIELD		/**** /2 **** CDF DFIELD+10
	TAD	Y		/GET Y VALUE
ZAP8K4,	DCA I	XR3		/**** /2 **** DCA I XR4
	JMP	DISPRETURN	/FINISH IT THERE

/	COMES HERE IF "FDIS(ONE ARGUMENT)".

DISP1,	JMS	POPAC		/RETRIEVE THE ARGUMENT
	SNA CLA			/SKIP IF NON-ZERO
	JMP	WIPEOUT		/ELSE WIPE OUT THE BUFFER
	JMS	DISPLAY		/DISPLAY THE BUFFER ONCE NOW
	JMP	DISPRETURN	/FINISH IT THERE

WIPEOUT,DCA	DISCNT		/CLEAR DISPLAY COUNT
	TAD	[OUTBUFFER-1]	/RESET THE
	DCA	XR3		/BUFFER POINTER
	TAD	[OUTBUFFER-1]	/RESET THE
	DCA	XR4		/SECOND BUFFER POINTER
	JMP	DISPRETURN	/FINISH IT THERE
	PAGE

	OUTBUFF=.		/DISPLAY BUFFER HERE

	FIELD	0		/BACK TO FIELD ZERO
/	ONCE-ONLY CODE STARTS HERE.

	*BONCE				/OVER DEFAULT ONCE-ONLY AREA

BONCE,	TAD I	(SWY9)			/GET /Y-/9 SWITCHES
	AND	C200/[200]		/JUST /2 BIT
	SNA CLA				/SKIP IF SET
	JMP	LTEST			/JUMP IF NOT
	CDF	DFIELD			/GOTO OUR CODE FIELD
	TAD I	(ZAP8K1)		/GET CDF DFIELD
	TAD	(10)			/MAKE IT CDF DFIELD+10
	DCA I	(ZAP8K1)		/STORE BACK
	ISZ I	(ZAP8K2)		/MAKE IT TAD I XR2
	TAD I	(ZAP8K1)		/GET CDF DFIELD+10
	DCA I	(ZAP8K3)		/STORE OVER CDF DFIELD
	ISZ I	(ZAP8K4)		/MAKE IT DCA I XR4
	CDF	00			/BACK TO OUR FIELD
LTEST,	TAD I	(COMGO+10)		/GET CURRENT "L" COMMAND ADDRESS
	TAD	(-XINT)			/ADD ON UPPER LIMIT
	CLL				/CLEAR LINK FOR TEST
	TAD	(XINT-XDYS)		/ADD ON RANGE
	SNL CLA				/SKIP IF IN DANGER RANGE
	JMP	DSPFIX			/JUMP IF NOT
	TAD	P7600/[SBOOT]		/REVERT THE "L" COMMAND
	DCA I	(COMGO+10)		/TO ONLY SAFE VALUE
DSPFIX,	TAD I	(COUTPUT+5)		/GET POSSIBLE LOCATION
	TAD	(-TESTVALUE)		/COMPARE TO TEST VALUE
	SNA CLA				/SKIP IF NOT "OPATCH" OR "VT8PCH" VALUE
	JMP	OPRESENT		/JUMP IF ABOVE-MENTIONED OVERLAY PRESENT
	TAD I	(COUTPUT+6)		/GET NORMAL LOCATION
	TAD	(-TESTVALUE)		/COMPARE TO TEST VALUE
	SZA CLA				/SKIP IF IT MATCHES
	JMP	BADFOCAL		/JUMP IF UNKNOWN VERSION
	TAD	(JMS I	PDSPLA/[DSPLAY])/GET ZAPPING INSTRUCTION
	DCA I	(COUTPUT+6)		/STORE OVER OUTPUT ROUTINE
	JMP	LODFIX			/CONTINUE THERE

/	COMES HERE IF "OPATCH" OR "VT8PCH" HAVE CHANGED THE OUTPUT ROUTINE.

OPRESEN,TAD	(JMS I	PDSPLA/[DSPLAY])/GET ZAPPING INSTRUCTION
	DCA I	(COUTPUT+5)		/STORE OVER MODIFIED OUTPUT ROUTINE
	CDF	DFIELD			/GOTO CODE FIELD
	NL7775	/TAD	(-2-1)		/SETUP NEW
	DCA I	(DSPBACKUP)		/BACKUP FACTOR FOR MODIFIED CODE
	CDF	00			/BACK TO FIELD ZERO
LODFIX,	DCA I	(BEOFZAP)		/REPAIR LOADER
	JMP I	(BEOFZAP)		/RESUME LOADING
/	COMES HERE IF UNKNOWN COMBINATION OF FOCAL AND OVERLAYS IS PRESENT.

BADFOCA,JMS I	(OUTINITIALIZE)	/INITIALIZE OUTPUT ROUTINES
BADTALK,TAD	BMESSAGE	/GET A MESSAGE CHARACTER
	SNA			/END OF LIST?
	JMP I	P7600/[SBOOT]	/YES, GOODBYE
	JMS I	(P7CH)		/NO, SEND IT
	ISZ	BADTALK		/BUMP TO NEXT
	JMP	BADTALK		/KEEP GOING

/	COMPLAIN MESSAGE.

BMESSAG,"G&37			/<BEL>
	"M&37			/<CR>
	"J&37			/<LF>
	"F&177
	"O&177
	"C&177
	"A&177
	"L&177
	"/&177
	"O&177
	"V&177+40
	"E&177+40
	"R&177+40
	"L&177+40
	"A&177+40
	"Y&177+40
	" &177
	"C&177
	"O&177+40
	"N&177+40
	"F&177+40
	"L&177+40
	"I&177+40
	"C&177+40
	"T&177+40
	"!&177
	0			/THIS ENDS THE LIST
	PAGE

	TESTVAL=COUTPUT+3&177+JMPC	/JMP COUTPUT+3 ON ITS PAGE
/	OUTPUT ROUTINE FOR COMPLAINT MESSAGES.

P7CH,	.-.			/SEVEN-BIT PRINT ROUTINE
	DCA	P7TEMP		/STASH PASSED VALUE
P7AGN,	JMS	CHKUP		/CHECK FOR <^C>, ETC.
	TAD	P7TEMP		/GET THE VALUE
P7TSF,	TSFIOT			/**** CONSOLE **** CIF MCS+10
P7JMP,	JMP	P7AGN		/**** CONSOLE **** JMS OUTCON
P7TLS,	TLSIOT			/**** CONSOLE **** JMP P7AGN
	JMS	CHKUP		/CHECK FOR <^C>, ETC.
	JMP I	P7CH		/RETURN

CHKUP,	.-.			/CHECK FOR <^C>, ETC. ROUTINE
	JMS	CTLCTST		/CHECK FOR <^C>
	SZA			/SKIP IF NOTHING CAME IN
	TAD	(-"Q!300)	/ELSE COMPARE TO <^Q>
	SNA			/SKIP IF NEITHER CASE
	JMP	CHKCLR		/ELSE FORGET IT
	TAD	(-"S+"Q)	/COMPARE TO <^S>
	SZA CLA			/SKIP IF IT MATCHES
	JMP I	CHKUP		/ELSE RETURN
	JMS	CTLCTST		/GET ANOTHER CHARACTER
	TAD	(-"Q!300)	/COMPARE TO <^Q>
	SZA CLA			/SKIP IF IT MATCHES
	JMP	.-3		/ELSE KEEP GOING
CHKCLR,	DCA	INCHAR		/OBLITERATE <^Q>, ETC.
	JMP I	CHKUP		/RETURN

CTLCTST,.-.			/CHECK FOR <^C> ROUTINE
	CLA			/CLEAN UP
CHKKSF,	KSFIOT			/**** CONSOLE **** CIF MCS+10
CHKJMP,	JMP I	CTLCTST		/**** CONSOLE **** JMS INCON
CHKKRS,	KRSIOT/OR KRBIOT	/**** CONSOLE **** JMP I CTLCTST
	AND	P177/[177]	/JUST SEVEN BITS
	DCA	INCHAR		/STASH THE CHARACTER
	NL7775			/-3
	TAD	INCHAR		/COMPARE INPUT TO <^C>
	SNA			/SKIP IF OTHER
	ISZ I	(SCRSIZE)	/ELSE SET SOFT INDICATOR
	SPA SNA CLA		/SKIP IF <^D> OR GREATER
	JMP I	P7600/[SBOOT]	/ELSE GOODBYE
CHKKCC,	KCCIOT/OR 0000		/**** CONSOLE **** 0000
	TAD	INCHAR		/GET THE CHARACTER
	JMP I	CTLCTST		/RETURN
OUTINIT,.-.			/OUTPUT INITIALIZE ROUTINE
	TAD I	P7600/[SBOOT]	/GET BOOTSTRAP INSTRUCTION
	TAD	(-JMSSYSIO)	/COMPARE TO POSSIBLE VALUE
	SNA CLA			/SKIP IF DIFFERENT
	JMP	CHKCOVERLAY	/JUMP IF IT MATCHES
	ISZ	CHKKRS		/TURN "KRSIOT"
	ISZ	CHKKRS		/INTO "KRBIOT"
	DCA	CHKKCC		/DESTROY "KCCIOT"
CHKCOVR,NL0002			/SETUP "C" BIT MASK
	AND I	(SCRSIZE)	/GET THE "C" BIT
	SNA CLA			/SKIP IF CONSOLE OVERLAY PRESENT
	JMP I	OUTINITIALIZE	/RETURN IF NOT
	TAD I	(SCRSIZE)	/GET THE CORE SIZE WORD
	RTR;RAR			/MOVE OVER AND
	AND	(70)		/ISOLATE MCS BITS
	TAD	(CIF	10)	/TURN INTO CIF MCS+10
	DCA	P7TSF		/STORE OVER "TSFIOT"
	TAD	P7JMP		/GET "JMP P7AGN"
	DCA	P7TLS		/STORE OVER "TLSIOT"
	TAD	(JMS	OUTCON)	/GET OUTPUT CALL INSTRUCTION
	DCA	P7JMP		/STORE OVER "JMP P7AGN"
	TAD	P7TSF		/GET "CIF MCS+10" AGAIN
	DCA	CHKKSF		/STORE OVER "KSFIOT"
	TAD	CHKJMP		/GET "JMP I CTLCTST"
	DCA	CHKKRS		/STORE OVER "KRSIOT" (OR "KRBIOT")
	TAD	(JMS	INCON)	/GET INPUT CALL INSTRUCTION
	DCA	CHKJMP		/STORE OVER "JMP I CTLCTST"
	DCA	CHKKCC		/DESTROY "KCCIOT"
	JMP I	OUTINITIALIZE	/RETURN

INCHAR,	.-.			/INPUT TEMPORARY
P7TEMP,	.-.			/OUTPUT TEMPORARY

	PAGE

	*BEOFZAP		/OVER LOADER

	SKP			/MAKE IT COME TO US

	$			/THAT'S ALL FOLK!