/	PLOTTER OVERLAY FOR P?S/8 FOCAL

/	LAST EDIT:	03-NOV-1986	18:00:00	CJL

/	P?S/8 FOCAL OVERLAY FOR SUPPORT OF CALCOMP 563 PLOTTER.

/	THIS OVERLAY PROVIDES A PLOTTING FUNCTION TO P?S/8 FOCAL TO ALLOW INCREMENTAL
/	PLOTTER OUTPUT TO THE 30" CALCOMP 563 PLOTTER. IT CAN BE ADAPTED FOR OTHER
/	INCREMENTAL PLOTTERS, BUT WILL CURRENTLY ONLY RUN ON THE 563.

/	THE PLOTTER CAN BE ACCESSED BY SEVERAL RELATED FUNCTION CALLS:

/	FPL(0)			INITIALIZE PLOTTER BY RAISING THE PEN, RECALIBRATING
/				THE PEN CARRIAGE AND POSITIONING IT AT THE CENTER
/				OF HORIZONTAL TRAVEL. THIS DEFINES THE CARTESIAN
/				COORDINATE SYSTEM ORIGIN AT (0, 0). THIS SEQUENCE
/				OF OPERATIONS IS AUTOMATICALLY PERFORMED WHEN THE
/				OVERLAY IS LOADED IF THE OPTION SWITCH '/R' IS
/				INVOKED. (SEE USAGE OF FPL(X,Y,NON-ZERO) FOR FURTHER
/				INITIAL POSITIONING METHODS.)

/	FPL(NON-ZERO)		SET "NEARNESS" CRITERION VALUE TO THE PASSED
/				ARGUMENT. THIS VALUE WILL BE USED TO DETERMINE IF
/				A LINE COORDINATE PAIR PASSED FOR THE PURPOSES OF
/				PLOTTING A LINE SEGMENT CONNECTS A PLOTTED LINE
/				TO THE PREVIOUS LINE COORDINATE, OR JUST STARTS
/				A NEW LINE SEGMENT (CAUSING THE PEN TO MOVE TO THE
/				NEW POSITION WITH PEN UP). THE FORMULA USED IS:

/					ABS(X1-X0)+ABS(Y1-Y0)<NEAR

/					X0:	CURRENT PEN X-POSITION
/					Y0:	CURRENT PEN Y-POSITION
/					X1:	FINAL PEN X-POSITION
/					Y1:	FINAL PEN Y-POSITION
/					NEAR:	NEARNESS CRITERION

/				IF THE INEQUALITY IS SATISFIED, THEN A LINE SEGMENT
/				WILL BE PLOTTED, ELSE THE PEN WILL BE RAISED WHILE
/				THE PEN IS REPOSITIONED TO THE REQUESTED COORDINATES.
/				EXCESSIVELY LARGE VALUES OF THE "NEARNESS" CRITERION
/				WILL YIELD PLOTTER MOTION WITHOUT PLOTTING!
/	FPL(X,Y)		PLOT A "BEST" STRAIGHT LINE FROM THE CURRENT POSITION
/				TO THE REQUESTED (X, Y) POSITION. THE "NEARNESS"
/				CRITERION MUST BE MET TO MAINTAIN THE PEN DOWN,
/				ELSE PLOTTER MOTION WITHOUT PLOT WILL OCCUR. WHEN
/				PLOTTING LINE SEGMENTS (ESPECIALLY NON-LINEAR LINES
/				OR CURVES), IT IS RECOMMENDED THAT FPL(X,Y) BE
/				INVOKED "FREQUENTLY" FOR ALL RELEVANT SCALED-UP
/				VALUES OF THE USER'S DATA, AS THE PLOTTER'S SPACE
/				REPRESENTS A RELATIVELY LARGE PLOTTING AREA, ROUGHLY
/				-2900 TO +2900 ON THE X-AXIS, AND +/- SEVERAL
/				MILLION ON THE Y-AXIS, DEPENDING ON CHOSEN DRUM
/				POSITION. ALL INTERMEDIATE VALUES OF THE USER'S
/				DATA SHOULD BE EVALUATED AND PASSED AS COORDINATES,
/				AS STRAIGHT LINE SEGMENTS BETWEEN SPARSELY GIVEN
/				FUNCTION CALL DATA MAY NOT REASONABLY REPRESENT THE
/				INTENDED PLOT. CALLS RESULTING IN NO POSITIONAL
/				CHANGE WILL EFFECTIVELY BE IGNORED, THUS THE USER
/				MAY GENERALLY OVER-SCALE CONTINUOUS FUNCTION DATA
/				WITH NO DETRIMENTAL EFFECT ON THE PLOTTED RESULT
/				(OTHER THAN LOSS OF REAL TIME!).

/	FPL(X,Y,0)		PLOT AN OCTAL CROSS AT (X, Y). THIS USAGE IS FOR
/				INDIVIDUAL POINTS ONLY. NO INTERACTION OCCURS
/				BETWEEN THIS USAGE AND THE LINE-ORIENTED USAGE.
/				PLOTTER OVERHEAD MAY OCCUR IF THIS USAGE IS INVOKED
/				DURING A LINE-ORIENTED CONNECTED SEQUENCE, BUT
/				ONLY THE PEN-UP (EXTRA) MOTION WILL OCCUR; THE
/				LINE-ORIENTED SEQUENCE WILL MAINTAIN ITS INTEGRITY.

/	FPL(X,Y,NON-ZERO)	MOVE PEN TO (X, Y) WITH PEN UP AND THEN RESET THIS
/				NEW LOCATION AS THE ORIGIN (0, 0). THIS IS USED TO
/				RELOCATE (SMALLER) PLOTS WITHOUT CHANGING COORDINATE
/				CALCULATIONS. THE USER MUST ALWAYS ENSURE THAT ALL
/				ACTUAL PLOT COORDINATES ARE VALID. FPL(0,0,NON-ZERO)
/				CAN BE INVOKED TO ALLOW PEN CHANGING WITHOUT
/				DISTURBING THE COORDINATE SYSTEM, AS THE PEN WILL
/				BE RAISED AND CENTERED UNTIL AN ADDITIONAL COMMAND
/				IS GIVEN.
/	ASSEMBLY INSTRUCTIONS:

/	SET "PLTFLD" TO THE PROPER FIELD FOR THE PLOTTER ROUTINES (DEFAULT IS 30).

/	ASSEMBLY PARAMETERS.

/	SET PLOTTER FIELD.

/	PLTFLD=	30		/PLOTTER CODE AND BUFFER FIELD

/	SET EAE TYPE.

/	EAETYP=	0		/USE PDP-8/I TYPE EAE

/	SET PLOT COMMAND BUFFERING.

/	BUFF=	1		/BUFFER PLOT COMMANDS

/	SET BUFFER SIZE (ONLY USED IF BUFF=1).

/	BUFSIZE=4000		/USE 2048 WORD PLOT COMMAND BUFFER
/	DEFAULT PARAMETERS.

	IFNDEF	BUFF	<BUFF=	1>	/BUFFER PLOT COMMANDS
	IFNDEF	BUFSIZE	<BUFSIZE=4000>	/USE 2048 WORD PLOT COMMAND BUFFER
	IFNDEF	EAETYP	<EAETYP=0>	/USE PDP-8/I-TYPE EAE
	IFNDEF	PLTFLD	<PLTFLD=30>	/USE FIELD THREE FOR PLOTTER CODE AND BUFFER

/	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
	INTXIT=	2711			/HOOK PLOTTER INTERRUPTS HERE
	SWMX=	7605			/M-/X SWITCHES

/	MISCELLANEOUS DEFINITIONS.

	JMPIC=	JMP I	.		/CURRENT PAGE INDIRECT JUMP
	NL4000=	CLA CLL CML RAR		/LOAD AC WITH 4000
	NL7775=	CLA CLL CMA RTL		/LOAD AC WITH 7775
	NL7777=	CLA CMA			/LOAD AC WITH 7777
	NSTART=	4011			/PATCH ASSEMBLY ADDRESS
	PLTHAF=	5574			/HALF-WIDTH OF PLOTTER

	FIELD	0			/ENSURE FIELD ZERO

	*FNTABL+16			/OVER AVAILABLE TABLE ENTRY

	"P^2+"L				/ENTER FPL FUNCTION HASHED NAME
	*NSTART			/START PATCH HERE FOR DIRECT LOADING

/	DEFINITIONS FOR THIS PAGE.

	XLIST	OFF
	IFNDEF	MOVE	<MOVE=	0>
	XLIST	ON
	MOVE=	JMS	XMOVE	/MOVE ROUTINE

/	PLOTTER FUNCTION:	FPL(FIRST-ARGUMENT,SECOND-ARGUMENT,THIRD-ARGUMENT).

XPLT,	JMS I	INTEGER		/GET FIRST ARGUMENT (LOW-ORDER)
	PUSHA			/SAVE IT
	TAD	FLAC+1		/GET HIGH-ORDER PORTION
	PUSHA			/SAVE IT
	PUSHJ			/FIND OUT IF ANOTHER ARGUMENT
LARG1,	ARG			/**** RELOCATE ****
	JMP	ONEARGUMENT	/JUMP IF ONLY ONE ARGUMENT
	JMS I	INTEGER		/GET SECOND ARGUMENT (LOW-ORDER)
	PUSHA			/SAVE IT
	TAD	FLAC+1		/GET HIGH-ORDER PORTION
	PUSHA			/SAVE IT
	PUSHJ			/FIND OUT IF ANOTHER ARGUMENT
LARG2,	ARG			/**** RELOCATE ****
	JMP	PLOTLINE	/WASN'T ANY, GO PLOT (X, Y)
	JMS I	INTEGER		/GET THIRD ARGUMENT
	SNA CLA			/SKIP IF NON-ZERO THIRD ARGUMENT
	JMP	PLOTPOINT	/JUMP IF ZERO THIRD ARGUMENT

/	USAGE WAS FPL(X,Y,NON-ZERO), SO RELOCATE PLOTTER AT NEW ORIGIN.

	CIF	PLTFLD		/GOTO PLOT FIELD
	JMS I	(SETARGS)	/SETUP PASSED ARGUMENTS FOR PEN TRAVEL
	NL7777			/INDICATE PEN UP
	CIF CDF	PLTFLD		/GOTO PLOT FIELD
	JMS I	(LINPLT)	/GO PLOT A LINE TO DESIRED LOCATION
INITENT,MOVE;	ZERO;	CURX	/CLEAR CURRENT X-POSITION
	MOVE;	ZERO;	CURY	/CLEAR CURRENT Y-POSITION
	NL7777			/INDICATE THERE IS
	DCA	FPSW		/NO INITIAL END POINT
	DCA	LASTOP		/INDICATE LAST OPERATION AS LINE, NOT POINT
	RETURN			/RETURN TO FOCAL
/	USAGE WAS FPL(X,Y,0), SO PLOT AN ENHANCED POINT AT (X, Y).

PLOTPOI,TAD	LASTOP		/GET PREVIOUS OPERATION
	SZA CLA			/SKIP IF IT WAS A LINE OPERATION
	JMP	NOSAVE		/JUMP IF NOT

/	WE MUST SAVE THE CURRENT POSITION IN CASE WE INTERRUPTED A LINE SEGMENT.

	MOVE;	CURX;	OLDX	/SAVE X-POSITION
	MOVE;	CURY;	OLDY	/SAVE Y-POSITION
NOSAVE,	CIF	PLTFLD		/GOTO PLOT FIELD
	JMS I	(SETARGS)	/SETUP PASSED ARGUMENTS FOR PEN TRAVEL
	NL7777			/INDICATE PEN UP
	CIF CDF	PLTFLD		/GOTO PLOT FIELD
	JMS I	(LINPLT)	/GO PLOT A LINE TO DESIGNATED POSITION
	CIF CDF	PLTFLD		/GOTO PLOT FIELD
	JMS I	(PNTPLOT)	/GO PLOT ENHANCED POINT
	NL4000			/INDICATE LAST OPERATION WAS A POINT
LINENTR,DCA	LASTOP		/SAVE LAST OPERATION
	MOVE;	X;	CURX	/SAVE CURRENT X-POSITION
	MOVE;	Y;	CURY	/SAVE CURRENT Y-POSITION
	RETURN			/RETURN TO FOCAL
/	USAGE WAS FPL(X,Y), SO PLOT A LINE SEGMENT FROM CURRENT POSITION TO (X, Y).

PLOTLIN,TAD	LASTOP		/GET PREVIOUS OPERATION
	SNA CLA			/SKIP IF IT WASN'T A LINE OPERATION
	JMP	NORESTORE	/JUMP IF IT WAS

/	PRIOR POSITION WAS STORED BY (POINT) HANDLER, SO RESTORE IT NOW.

	MOVE;	CURX;	X0	/SETUP CURRENT X-POSITION
	MOVE;	CURY;	Y0	/SETUP CURRENT Y-POSITION
	MOVE;	OLDX;	X1	/SETUP FINAL X-POSITION
	MOVE;	OLDY;	Y1	/SETUP FINAL Y-POSITION
	NL7777			/INDICATE PEN UP
	CIF CDF	PLTFLD		/GOTO PLOT FIELD
	JMS I	(LINPLT)	/RESTORE PRIOR PEN POSITION
	MOVE;	OLDX;	CURX	/RESTORE CURRENT X-POSITION
	MOVE;	OLDY;	CURY	/RESTORE CURRENT Y-POSITION
NORESTO,CIF	PLTFLD		/GOTO PLOT FIELD
	JMS I	(SETARGS)	/SETUP PASSED ARGUMENTS FOR PEN TRAVEL
	TAD	FPSW		/GET FIRST-POINT SWITCH
	CIF CDF	PLTFLD		/GOTO PLOT FIELD
	JMS I	(LINPLT)	/GO PLOT A LINE SEGMENT (NEAR COULD BE IN EFFECT)
	DCA	FPSW		/INDICATE AN END POINT NOW EXISTS
	JMP	LINENTRY	/CONTINUE THERE

/	ONE ARGUMENT WAS GIVEN, CHECK WHETHER ZERO.

ONEARGU,CIF	PLTFLD		/GOTO PLOT FIELD
	JMS I	(GETARG)	/GET THE ARGUMENT SETUP AND RETURN IT
	SNA CLA			/SKIP IF NON-ZERO
	JMP	PLOTINITIALIZE	/JUMP IF BOTH ZERO
	MOVE;	X;	NEAR	/STORE ARGUMENT AS NEARNESS CRITERION
	RETURN			/RETURN TO FOCAL

/	ZERO ARGUMENTS INDICATES PLOTTER INITIALIZATION.

PLOTINI,CIF CDF	PLTFLD		/GOTO PLOT FIELD
	JMS I	(INITPLT)	/INITIALIZE THE PLOTTER
	JMP	INITENTRY	/CONTINUE THERE
/	SUPPORT ROUTINES.

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

XMOVE,	.-.			/MOVE ROUTINE
	CIF	PLTFLD		/GOTO PLOT FIELD
	JMS I	(XMOVE2)	/CONTINUE THERE

FPSW,	-1			/FIRST POINT (ON LINE) SWITCH; -1=NO PREVIOUS POINT
LASTOP,	0			/PREVIOUS OPERATION; 0=LINE, 4000=ENHANCED POINT

	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	(XPLT&177)		/ >INSERT FPL
	DCA I	(FNTABF+16)		//
	TAD	PBASE			/\
	TAD	(ARG&177)		/ \
	DCA I	(LARG1)			/  >FIXUP ADDRESS CONSTANTS
	TAD I	(LARG1)			/ /
	DCA I	(LARG2)			//
	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
	PLCF				/CLEAR PLOTTER FLAG NOW
	PLPU				/RAISE PEN UP NOW
	PLSF				/FLAG UP YET?
	JMP	.-1			/NO, WAIT FOR IT
	PLCF				/CLEAR PLOTTER FLAG NOW
	TAD I	(SWMX)			/GET /M-/X SWITCHES
	AND	(100)			/JUST /R SWITCH
	SNA CLA				/SKIP IF /R SET
	JMP	NOINIT			/JUMP IF /R NOT SET
	TAD	(-310)			/GET EXTRA INCH VALUE
	JMS	MOVPEN			/MOVE THE PEN LEFT
	JMS	MOVPEN			/MOVE THE PEN LEFT
	TAD	(PLPR)			/CHANGE TO
	DCA	PENDIRECTION		/RIGHT-HAND DIRECTION
	JMS	MOVPEN			/MOVE THE PEN RIGHT TO CENTER IT
NOINIT,	TAD	(CIF CDF PLTFLD)	/GET FIELD INSTRUCTION
	DCA I	(INTXIT+2)		/PATCH INTERRUPT HANDLER
	TAD	(INTXIT+4&177+JMPIC)	/GET JUMP INSTRUCTION
	DCA I	(INTXIT+3)		/PATCH INTERRUPT HANDLER
	TAD	(PLTINT)		/GET INTERRUPT ADDRESS
	DCA I	(INTXIT+4)		/PATCH INTERRUPT HANDLER
	JMP I	(BEOFZAP)		/RESUME LOADING
MOVPEN,	.-.			/PEN MOVE ROUTINE
	TAD	(-PLTHAF)	/SETUP THE
	DCA	PENCNT		/PEN COUNTER
PENDIRE,PLPL			/PEN DIRECTION; BECOMES PLPR
	PLSF			/FLAG UP?
	JMP	.-1		/NO, WAIT FOR IT
	PLCF			/YES, CLEAR THE FLAG
	ISZ	PENCNT		/DONE YET?
	JMP	PENDIRECTION	/NO, KEEP GOING
	JMP I	MOVPEN		/RETURN

LNSTART,NSTART			/POINTER TO NSTART
MOVCNT,	NSTART-NEND		/CODE MOVE COUNTER
PENCNT,	.-.			/PEN LEFT (OR RIGHT) COUNTER

	PAGE

	*BEOFZAP		/OVER LOADER

	SKP			/MAKE IT COME TO US
/	LINE PLOT ROUTINE

/	LAST EDIT:	06-OCT-1986	20:00:00	CJL

/	PLOTS AN INCREMENTAL LINE FROM (X0, Y0) TO (X1, Y1) WHERE CURRENT PEN
/	POSITION IS (X0, Y0) AND FINAL PEN POSITION IS (X1, Y1).

/	THIS ROUTINE CALCULATES THE "BEST" STRAIGHT LINE BETWEEN (X0, Y0) AND
/	(X1, Y1) VIA INCREMENTAL STEPS IN THE EIGHT POSSIBLE PLOT DIRECTIONS.

/	FORMULAS USED IN THE CALCULATION:

/	LOOP:	DO I=1 TO MAX(ABS(X1-X0),ABS(Y1-Y0));

/		PX=SIGN(REMX+ABS(X1-X0) DIV MAX(ABS(X1-X0),ABS(Y1-Y0)));

/		REMX=REMX+ABS(X1-X0) MOD MAX(ABS(X1-X0),ABS(Y1-Y0));

/		PY=SIGN(REMY+ABS(Y1-Y0) DIV MAX(ABS(X1-X0),ABS(Y1-Y0)));

/		REMY=REMY+ABS(Y1-Y0) MOD MAX(ABS(X1-X0),ABS(Y1-Y0));

/		END LOOP;

/	PX AND PY FORM A SET OF THE EIGHT POSSIBLE DIRECTIONS (PLUS THE NINTH VALUE
/	OF NO ADVANCEMENT WHICH DOESN'T OCCUR) WHICH ARE THEN APPLIED TO THE PLOTTER
/	HARDWARE INTERFACE.

/	CALLING CONVENTIONS:

/	SET RELEVANT VARIABLES:

/	X0:	CURRENT PEN X-POSITION
/	Y0:	CURRENT PEN Y-POSITION
/	X1:	FINAL PEN X-POSITION
/	Y1:	FINAL PEN Y-POSITION
/	NEAR:	NEARNESS CRITERION

/	SET AC TO ONE OF THE FOLLOWING:

/	ZERO AC:	CALCULATION OF HOW "NEAR" (X1, Y1) IS TO (X0, Y0) WILL
/			DETERMINE WHETHER THE PEN IS RAISED OR LOWERED DURING THE
/			PLOT OF THE LINE. FOR THE PEN TO REMAIN DOWN, THE FOLLOWING
/			INEQUALITY MUST BE SATISFIED: ABS(X1-X0)+ABS(Y1-Y0)<NEAR.

/	PLUS AC:	ENSURE PEN DOWN ("NEAR" IS IGNORED).

/	MINUS AC:	ENSURE PEN UP ("NEAR" IS IGNORED).

/	CIF CDF	PLTFLD		/GOTO PLOT FIELD; CALLER IS IN FIELD ZERO
/	JMS I	(LINPLT)	/CALL ROUTINE

/	RETURNS HERE WITH PEN MOVED TO (X1, Y1).
/	FIELD DEFINITION.

	IFNDEF	PLTFLD	<PLTFLD=20>	/DEFAULT IS FIELD TWO FOR PLOTTING ROUTINES

	FIELD	PLTFLD%10		/SET OUR FIELD NOW

	*200				/START AT THE BEGINNING

/	ARITHMETIC DEFINITIONS.

	XLIST	OFF
	IFNDEF	DIV24	<DIV24=	0>
	XLIST	ON
	DIV24=	JMS I	(DUBDIVIDE)	/DOUBLE-PRECISION DIVIDE
	XLIST	OFF
	IFZERO	EAETYP	<EAETYP=0>
	XLIST	ON
	XLIST	OFF
	IFZERO	EAETYP	<
	XLIST	ON

/	EAE DEFINITIONS FOR THIS PAGE.

	DAD=	JMS I	(DADD)		/DOUBLE-PRECISION ADD
	DCM=	JMS I	(DCOM)		/DOUBLE-PRECISION COMPLEMENT
	DLD=	JMS I	(DLOAD)		/DOUBLE-PRECISION LOAD
	DST=	JMS I	(DSTORE)	/DOUBLE-PRECISION STORE
	XLIST	OFF	>
	XLIST	ON

/	PLOTTER INSTRUCTIONS.

	PLIOT=	6500			/PLOTTER BASE IOT
	PLSF=	6501			/SKIP ON PLOTTER DONE FLAG
	PLCF=	6502			/CLEAR PLOTTER DONE FLAG
	PLPU=	6504			/PEN UP
	PLPR=	6511			/PEN RIGHT
	PLDU=	6512			/DRUM UP
	PLDD=	6514			/DRUM DOWN
	PLPL=	6521			/PEN LEFT
	PLUD=	6522			/DRUM UP (REDUNDANT)
	PLPD=	6524			/PEN DOWN

/	NUMERIC LOAD INSTRUCTIONS.

	NL0001=	CLA IAC			/LOAD AC WITH 0001
LINPLT,	.-.			/LINE PLOT ROUTINE
	DCA	PENINDICATOR	/SAVE INDICATOR FOR NOW
	DLD;	X0		/GET X0
	DCM			/-X0
	DAD;	X1		/X1-X0
	DST;	SIGNX		/SAVE ORIGINAL SIGN
	SPA			/SKIP IF ALREADY POSITIVE
	DCM			/ELSE MAKE IT SO
	DST;	DX		/STORE ABS(X1-X0)
	DLD;	Y0		/GET Y0
	DCM			/-Y0
	DAD;	Y1		/Y1-Y0
	DST;	SIGNY		/SAVE ORIGINAL SIGN
	SPA			/SKIP IF ALREADY POSITIVE
	DCM			/ELSE MAKE IT SO
	DST;	DY		/STORE ABS(Y1-Y0)
	DST;	DBIG		/ASSUME DY IS LARGER
	DCM			/-DY
	DAD;	DX		/DX-DY
	SPA			/SKIP IF DX IS LARGER
	JMP	DBCOMMON	/JUMP IF DY WAS LARGER
	DLD;	DX		/GET DX
	DST;	DBIG		/USE AS DBIG
DBCOMMO,NL0001			/SET INCREMENT
	MQL			/TO LOW-ORDER
	DAD;	DBIG		/DBIG+1
	DCM			/-DBIG-1
	DST;	PLCOUNT		/STORE ONE'S COMPLEMENT COUNT
	CAM			/CLEAN UP
	DST;	REMX		/INITIALIZE
	DST;	REMY		/REMAINDERS
/	DETERMINE WHETHER WE SHOULD CALCULATE NEARNESS CRITERION OR JUST FORCE THE
/	PEN POSITION FROM THE CALLER'S AC VALUE.

	TAD	PENINDICATOR	/GET PEN INDICATOR
	SZA			/SKIP IF DECISION CALL
	JMP	PENDECIDE	/JUMP IF PREDETERMINED
	DLD;	DX		/GET DX
	DAD;	DY		/DX+DY
	DCM			/-(DX+DY)
	DAD;	NEAR		/NEAR-(DX+DY)
PENDECI,JMS I	(PENSET)	/SET PEN UP OR DOWN PER AC[0]
	JMP	PLTEST		/CONTINUE THERE

PLTLUP,	DLD;	DX		/GET DX
	DAD;	REMX		/DX+REMX
	DIV24;	DBIG		/(DX+REMX)/DBIG
	DST;	PX		/STORE QUOTIENT
	DLD;	REM		/GET THE REMAINDER
	DST;	REMX		/STASH IT
	DLD;	DY		/GET DY
	DAD;	REMY		/DY+REMY
	DIV24;	DBIG		/(DY+REMY)/DBIG
	DST;	PY		/STORE QUOTIENT
	DLD;	REM		/GET THE REMAINDER
	DST;	REMY		/STASH IT
	JMS I	(PLTPNT)	/GO PLOT THE LATEST POINT
PLTEST,	ISZ	PLCOUNT		/DONE ENOUGH?
	SKP			/SKIP IF NOT
	ISZ	PLCOUNT+1	/DONE YET?
	JMP	PLTLUP		/NO, KEEP GOING
	CAM			/CLEAN UP
	CIF CDF	00		/GOING TO FIELD ZERO
	JMP I	LINPLT		/RETURN

PENINDI,.-.			/PEN DISPOSITION INDICATOR
PLCOUNT,ZBLOCK	2		/PLOT COUNTER
	PAGE
	XLIST	OFF
	IFZERO	EAETYP	<
	XLIST	ON
/	EAE DEFINITIONS FOR THIS PAGE.

	DLD=	JMS I	(DLOAD)	/DOUBLE-PRECISION LOAD

	XLIST	OFF	>
	XLIST	ON
/	SUPPORT ROUTINES.

PLTPNT,	.-.			/PLOT A POINT ROUTINE
	DLD;	PX		/GET HORIZONTAL INCREMENT
	SZA			/BETTER BE SINGLE-PRECISION
	HLT			/ELSE COMPLAIN
	MQA			/GET LOW-ORDER
	CLL RAR			/MOVE BINARY BIT TO LINK
	SZA			/ALL OTHER BITS BETTER BE ZERO
	HLT			/ELSE COMPLAIN
	TAD	SIGNX+1		/GET SIGN BIT
	RAL			/TO LINK
	CLA MQA			/GET INCREMENT
	SZL			/SKIP IF POSITIVE
	CIA			/ELSE MAKE IT NEGATIVE
	TAD	(XTABLE+1)	/POINT AT TABLE ELEMENT
	DCA	PTEMP		/STASH THE POINTER
	TAD I	PTEMP		/GET THE IOT
	DCA I	(XINST)		/STORE IN-LINE
	DLD;	PY		/GET VERTICAL INCREMENT
	SZA			/GETTER BE SINGLE-PRECISION
	HLT			/ELSE COMPLAIN
	MQA			/GET LOW-ORDER
	CLL RAR			/MOVE BINARY BIT TO LINK
	SZA			/ALL OTHER BITS BETTER BE ZERO
	HLT			/ELSE COMPLAIN
	TAD	SIGNY+1		/GET SIGN BIT
	RAL			/TO LINK
	CLA MQA			/GET INCREMENT
	SZL			/SKIP IF POSITIVE
	CIA			/ELSE MAKE IT NEGATIVE
	TAD	(YTABLE+1)	/POINT AT TABLE ELEMENT
	DCA	PTEMP		/STASH THE POINTER
	TAD I	PTEMP		/GET THE IOT
	DCA I	(YINST)		/STORE IN-LINE
	TAD	(NOP)		/DESTROY THE
	DCA I	(PENINST)	/PEN INSTRUCTION
	JMS	PLOTIO		/CALL PLOT I/O ROUTINES
	JMP I	PLTPNT		/RETURN

PTEMP,	.-.			/TEMPORARY
PENSET,	.-.			/PEN UP OR DOWN ROUTINE
	RAL			/MOVE SIGN TO LINK
	SNL CLA			/SKIP IF PEN UP
	TAD	(PLPD-PLPU)	/ELSE MAKE IT PEN DOWN
	TAD	(PLPU)		/GET BASIC IOT
	DCA I	(PENINST)	/STORE IN-LINE
	TAD	PSTATUS		/GET CURRENT PEN STATUS
	SMA CLA			/SKIP IF PEN CURRENTLY UP
	JMP	PDWNCHK		/JUMP IF PEN CURRENTLY DOWN
	SZL			/SKIP IF PEN SHOULD GO DOWN
	JMP I	PENSET		/RETURN IF PEN STAYS UP
PENGO,	RAR			/GET NEW PEN STATUS
	DCA	PSTATUS		/STORE IT
	TAD	(NOP)		/\
	DCA I	(XINST)		/ \ELIMINATE OTHER
	TAD	(NOP)		/ /PEN OPERATIONS
	DCA I	(YINST)		//
	JMS	PLOTIO		/CALL PLOT I/O ROUTINE
	JMP I	PENSET		/RETURN

/	PEN IS CURRENTLY DOWN, SO CHECK FURTHER.

PDWNCHK,SNL			/SKIP IF PEN SHOULD GO UP
	JMP I	PENSET		/RETURN IF PEN STAYS DOWN

/	PEN MUST BE RAISED.

	JMP	PENGO		/CONTINUE THERE WITH LINK SET

/	PLOTTER I/O ROUTINE.

PLOTIO,	.-.			/PLOTTER I/O ROUTINE
	CLA			/CLEAN UP
	TAD I	(XINST)		/GET X INSTRUCTION
	TAD I	(YINST)		/ADD Y INSTRUCTION
	TAD I	(PENINST)	/ADD PEN INSTRUCTION
	AND	(777)		/JUST IMPORTANT BITS
	SZA CLA			/SKIP IF WE IGNORE THIS
	JMS I	(PLBUFFER)	/BUFFER THE PLOT COMMAND
	JMP I	PLOTIO		/RETURN
/	PLOTTER IOT TABLES.

/	TABLE FOR X CHANGES.

XTABLE,	PLPL			/-1
	NOP			/0
	PLPR			/+1

/	TABLE FOR Y CHANGES.

YTABLE,	PLDU			/-1
	NOP			/0
	PLDD			/+1

/	PEN STATUS.

PSTATUS,4000			/4000=PEN UP, 0000=PEN DOWN

/	DOUBLE-PRECISION STORAGE.

DBIG,	ZBLOCK	2		/LARGER OF DX, DY
DX,	ZBLOCK	2		/ABS(X1-X0)
DY,	ZBLOCK	2		/ABS(Y1-Y0)
NEAR,	ZBLOCK	2		/NEARNESS CRITERION
PX,	ZBLOCK	2		/PLOTTER X
PY,	ZBLOCK	2		/PLOTTER Y
REMX,	ZBLOCK	2		/X REMAINDER
REMY,	ZBLOCK	2		/Y REMAINDER
SIGNX,	ZBLOCK	2		/PX SIGN
SIGNY,	ZBLOCK	2		/PY SIGN
X0,	ZBLOCK	2		/INITIAL X POSITION
X1,	ZBLOCK	2		/FINAL X POSITION
Y0,	ZBLOCK	2		/INITIAL Y POSITION
Y1,	ZBLOCK	2		/FINAL Y POSITION

	PAGE
	XLIST	OFF
	IFZERO	EAETYP	<
	XLIST	ON
/	EAE DEFINITIONS FOR THIS PAGE.

	DLD=	JMS I	(DLOAD)	/DOUBLE-PRECISION LOAD
	DST=	JMS I	(DSTORE)/DOUBLE-PRECISION STORE

	XLIST	OFF	>
	XLIST	ON
/	CONTINUATION OF MOVE ROUTINE.

XMOVE2,	.-.			/REST OF MOVE ROUTINE
	NL7775			/BACKUP THREE
	TAD	XMOVE2		/GET OUR CALLER
	DCA	XMOVE2		/STASH THE POINTER
	TAD I	XMOVE2		/GET MOVE'S CALLER
	DCA	XMOVE2		/STASH THE CALLER
	TAD I	XMOVE2		/GET THE SOURCE POINTER
	DCA	FROM		/STASH IT
	ISZ	XMOVE2		/BUMP TO NEXT
	TAD I	XMOVE2		/GET THE DESTINATION POINTER
	DCA	TO		/STASH IT
	ISZ	XMOVE2		/BUMP PAST ARGUMENTS
	CDF	PLTFLD		/GOTO OUR FIELD
	TAD I	FROM		/GET LOW-ORDER
	DCA I	TO		/STORE IT
	ISZ	FROM		/BUMP SOURCE POINTER
	ISZ	TO		/BUMP DESTINATION POINTER
	TAD I	FROM		/GET HIGH-ORDER
	DCA I	TO		/STORE IT
	CIF CDF	00		/BACK TO FIELD ZERO
	JMP I	XMOVE2		/RETURN

/	SETUP ONE ARGUMENT ROUTINE.

GETARG,	.-.			/SETUP ONE ARGUMENT ROUTINE
	TAD I	(POPA&17)	/GET FOCAL'S INDEX
	DCA	POPA&17		/MAKE IT OURS
	POPA			/GET HIGH-ORDER ARGUMENT
	DCA	X+1		/STASH IT
	POPA			/GET LOW-ORDER ARGUMENT
	DCA	X		/STASH IT
	TAD	POPA&17		/GET OUR INDEX
	DCA I	(POPA&17)	/GIVE IT BACK TO FOCAL
	TAD	X		/GET LOW-ORDER
	SNA			/SKIP IF SET
	TAD	X+1		/ELSE GET HIGH-ORDER
	CIF	00		/BACK TO FIELD ZERO
	JMP I	GETARG		/RETURN
/	(X, Y) ARGUMENT SETUP ROUTINE.

SETARGS,.-.			/SET ARGUMENTS ROUTINE
	TAD I	(POPA&17)	/GET FOCAL'S INDEX
	DCA	POPA&17		/MAKE IT OURS
	POPA			/GET SECOND ARGUMENT - HIGH-ORDER
	DCA	Y+1		/STASH IT
	POPA			/GET SECOND ARGUMENT - LOW-ORDER
	DCA	Y		/STASH IT
	POPA			/GET FIRST ARGUMENT - HIGH-ORDER
	DCA	X+1		/STASH IT
	POPA			/GET FIRST ARGUMENT - LOW-ORDER
	DCA	X		/STASH IT
	TAD	POPA&17		/GET OUR INDEX
	DCA I	(POPA&17)	/GIVE IT BACK TO FOCAL
	CDF	PLTFLD		/GOTO OUR FIELD
	DLD;	CURX		/GET CURRENT X-POSITION
	DST;	X0		/USE AS INITIAL X-POSITION
	DLD;	CURY		/GET CURRENT Y-POSITION
	DST;	Y0		/USE AS INITIAL Y-POSITION
	DLD;	X		/GET X-ARGUMENT
	DST;	X1		/USE AS FINAL X-POSITION
	DLD;	Y		/GET Y-ARGUMENT
	DST;	Y1		/USE AS FINAL Y-POSITION
	CAM			/CLEAN UP
	CIF CDF	00		/BACK TO FIELD ZERO
	JMP I	SETARGS		/RETURN

FROM,	.-.			/SOURCE POINTER
TO,	.-.			/DESTINATION POINTER

/	PLOT CONSTANTS AND VARIABLES.

CURX,	ZBLOCK	2		/CURRENT X-POSITION
CURY,	ZBLOCK	2		/CURRENT Y-POSITION
OLDX,	ZBLOCK	2		/PREVIOUS X-POSITION
OLDY,	ZBLOCK	2		/PREVIOUS Y-POSITION
X,	ZBLOCK	2		/X-ARGUMENT
Y,	ZBLOCK	2		/Y-ARGUMENT
ZERO,	0;	0		/CONSTANT 0000, 0000

	PAGE
/	PLOT BUFFERING ROUTINE.

PLBUFFE,.-.			/PLOT BUFFERING ROUTINE
	XLIST	OFF
	IFZERO	BUFF	<
	XLIST	ON
	TAD	DONFLG		/FLAG UP?
	SZA CLA			/SKIP IF SO
	JMP	.-2		/ELSE WAIT FOR IT
XINST,	.-.			/MIGHT BE PEN LEFT OR RIGHT
YINST,	.-.			/MIGHT BE DRUP UP OR DOWN
PENINST,.-.			/MIGHT BE PEN UP OR DOWN
	ISZ	DONFLG		/INDICATE I/O IN PROGRESS
	JMP I	PLBUFFER	/RETURN
	XLIST	OFF	>
	IFNZRO	BUFF	<
	XLIST	ON
PLWAIT,	ION			/ENSURE INTERRUPT IS ON
	NOP			/GIVE SOME TIME
	NOP			/FOR INTERRUPTS
	IOF			/PREVENT PROBLEMS (GUESS WHAT KIND?)
	TAD	OUT		/GET OUTPUT POINTER
	CIA			/INVERT FOR TESTING
	TAD	IN		/COMPARE TO INPUT POINTER
	AND	(BUFSIZE-1)	/JUST GOOD BITS
	SNA			/SKIP IF DIFFERENT
	JMP	XINST		/JUMP IF SAME

/	BUFFER IS NOT EMPTY, SO (TRY TO) PUT THE COMMAND INTO IT.

	IAC			/COMPARE TO FULL BUFFER VALUE
	AND	(BUFSIZE-1)	/JUST GOOD BITS
	SNA CLA			/SKIP IF BUFFER NOT FULL
	JMP	PLWAIT		/JUMP IF BUFFER FULL
	TAD	XINST		/GET X-INSTRUCTION
	TAD	(-PLIOT)	/REMOVE BASE
	AND	(37)		/IN CASE NOP
	CLL RTL;RTL;RTL		/MOVE UP
	DCA	PLTEMP		/SAVE FOR NOW
	TAD	YINST		/GET Y-INSTRUCTION
	TAD	(-PLIOT)	/REMOVE BASE
	AND	(37)		/IN CASE NOP
	TAD	PLTEMP		/ADD ON X-INSTRUCTION
	DCA	PLTEMP		/SAFE COMPOSITE
	TAD	PENINST		/GET PEN-INSTRUCTION
	AND	(1000)		/GET DETERMINING BIT
	CLL RTL			/MOVE NOP BIT TO AC[0]
	TAD	PLTEMP		/ADD ON COMPOSITE
	DCA	PLTEMP		/STORE BACK
	TAD	PENINST		/GET PEN-INSTRUCTION AGAIN
	AND	(20)		/JUST DIRECTION BIT
	CLL RAL			/MOVE UP
	TAD	PLTEMP		/ADD ON COMPOSITE
PLBEXIT,DCA	PLTEMP		/STORE BACK
	NL0001			/SET INCREMENT
	TAD	IN		/GET INSERTION POINTER
	AND	(BUFSIZE-1)	/JUST GOOD BITS
	TAD	(PLOTBUFFER)	/POINT AT BUFFER ELEMENT
	DCA	OUT		/STASH THE POINTER
	TAD	PLTEMP		/GET COMPOSITE
	DCA I	IN		/STORE IN THE BUFFER
	ION			/SAFE TO COME OUT NOW
	JMP I	PLBUFFER	/RETURN
/	BUFFER IS EMPTY, WE MUST START IT UP.

XINST,	.-.			/MIGHT BE PEN LEFT OR RIGHT
YINST,	.-.			/MIGHT BE DRUM UP OR DOWN
PENINST,.-.			/MIGHT BE PEN UP OR DOWN
	JMP	PLBEXIT		/CONTINUE THERE
	XLIST	OFF	>
	XLIST	ON

/	INTERRUPT HANDLER.

PLTINT,	PLSF			/PLOTTER FLAG UP?
	JMP	PLTEXIT		/NO, FORGET IT
	PLCF			/YES, CLEAR THE FLAG
	XLIST	OFF
	IFZERO	BUFF	<
	XLIST	ON
	DCA	DONFLG		/CLEAR I/O FLAG
	XLIST	OFF	>
	IFNZRO	BUFF	<
	XLIST	ON
PLTNEXT,TAD	IN		/GET INPUT POINTER
	CIA			/INVERT FOR TESTING
	TAD	OUT		/COMPARE TO OUTPUT POINTER
	AND	(BUFSIZE-1)	/JUST GOOD BITS
	SNA CLA			/SKIP IF BUFFER NOT EMPTY
	JMP	PLTEXIT		/ELSE FORGET IT
	NL0001			/SET INCREMENT
	TAD	OUT		/GET REMOVAL POINTER
	AND	(BUFSIZE-1)	/JUST GOOD BITS
	TAD	(PLOTBUFFER)	/POINT AT BUFFER ELEMENT
	DCA	OUT		/STASH THE POINTER
	TAD I	OUT		/GET THE BUFFER ELEMENT
	SNA			/SKIP IF NOT DUMMY
	JMP	PLTNEXT		/ELSE IGNORE IT
	RTR;RTR;RTR		/MOVE DOWN
	AND	(37)		/JUST X-INSTRUCTION BITS
	SNA			/SKIP IF NOT NOP
	TAD	(NOP-PLIOT)	/ELSE MAKE IT SO
	TAD	(PLIOT)		/RESTORE FULL INSTRUCTION
	DCA	OUTX		/STORE IN-LINE
	TAD I	OUT		/GET THE BUFFER ELEMENT AGAIN
	AND	(37)		/JUST Y-INSTRUCTION BITS
	SNA			/SKIP IF NOT NOP
	TAD	(NOP-PLIOT)	/ELSE MAKE IT SO
	TAD	(PLIOT)		/RESTORE FULL INSTRUCTION
	DCA	OUTY		/STORE IN-LINE
	TAD I	OUT		/GET THE BUFFER ELEMENT AGAIN
	SPA CLA			/SKIP IF ACTUAL IOT
	JMP	NOPEN		/JUMP IF IT WAS A NOP
	TAD I	OUT		/GET THE BUFFER ELEMENT AGAIN
	AND	(40)		/JUST DIRECTION BIT
	CLL RAR			/MOVE TO AC[7]
	TAD	(PLPU)		/ADD ON BASE INSTRUCTION
	SKP			/DON'T USE NOP
NOPEN,	TAD	(NOP)		/GET A NOP
	DCA	OUTPEN		/STORE IN-LINE
OUTX,	.-.			/WILL BE PLPL OR PLPR OR NOP
OUTY,	.-.			/WILL BE PLDU OR PLDD OR NOP
OUTPEN,	.-.			/WILL BE PLPU OR PLPD OR NOP
	XLIST	OFF	>
	XLIST	ON
PLTEXIT,CIF CDF	00		/BACK TO FIELD ZERO
	JMP I	(INTXIT+5)	/CONTINUE THERE
	XLIST	OFF
	IFNZRO	BUFF	<
	XLIST	ON
IN,	PLOTBUFFER-1		/INSERTION POINTER
OUT,	PLOTBUFFER-1		/REMOVAL POINTER
PLTEMP,	.-.			/TEMPORARY
	XLIST	OFF	>
	IFZERO	BUFF	<
	XLIST	ON

DONFLG,	0			/I/O FLAG
	XLIST	OFF	>
	XLIST	ON

	PAGE
/	PLOTTER INITIALIZE ROUTINE.

INITPLT,.-.			/PLOTTER INITIALIZE ROUTINE
	NL7777			/INDICATE PEN UP
	JMS I	(PENSET)	/INITIALIZE THE PEN UPWARD
	TAD	(PLPL)		/MAKE PLOTTER GO LEFT FIRST
	DCA I	(XINST)		/FOR RECALIBRATION PURPOSES
	TAD	(NOP)		/PREVENT ANY
	DCA I	(YINST)		/DRUM MOTION
	TAD	(NOP)		/MAKE IT NOT DO
	DCA I	(PENINST)	/PEN UP OR DOWN ANY MORE
	TAD	(-310)		/GET EXTRA INCH VALUE
	JMS	HALFMOVE	/MOVE THE LEN LEFT
	JMS	HALFMOVE	/MOVE THE PEN LEFT
	TAD	(PLPR)		/MAKE PLOTTER GO RIGHT THIS TIME
	DCA I	(XINST)		/FOR CENTERING PURPOSES
	JMS	HALFMOVE	/MOVE THE PEN RIGHT
	CIF CDF	00		/GOING TO FIELD ZERO
	JMP I	INITPLT		/RETURN

/	ENHANCED POINT PLOT ROUTINE.

PNTPLOT,.-.			/POINT PLOT ROUTINE
	DCA	PNTCNTR		/CLEAR POINT COUNTER
	TAD	(PNTCOMMANDS)	/POINT AT
	DCA	PNTPNTR		/OUR LIST
PNTLOOP,ISZ	PNTCNTR		/BUMP TO NEXT STATE
	TAD	PNTCNTR		/GET CURRENT STATE
	RTR;RAR			/MOVE TO AC[0]
	JMS I	(PENSET)	/PUT PEN DOWN OR UP
	TAD	(NOP)		/MAKE IT DO THAT
	DCA I	(PENINST)	/NO FURTHER TIMES
	TAD I	PNTPNTR		/GET A WORD
	SNA			/END OF LIST?
	JMP	PNTEXIT		/YES, LEAVE HERE
	DCA I	(XINST)		/NO, STORE IN-LINE
	ISZ	PNTPNTR		/BUMP TO NEXT
	TAD I	PNTPNTR		/GET REST OF COMMAND
	DCA I	(YINST)		/STORE IN-LINE
	ISZ	PNTPNTR		/BUMP TO NEXT
	TAD	(-5)		/SETUP THE
	DCA	PNTRPTR		/POINT REPEATER
	JMS I	(PLOTIO)	/GO DO OUR LATEST COMMAND
	ISZ	PNTRPTR		/DONE ENOUGH OF LATEST COMMAND?
	JMP	.-2		/NO, GO DO IT AGAIN
	JMP	PNTLOOP		/GO DO ANOTHER ONE

/	COMES HERE AT END OF LIST.

PNTEXIT,CIF CDF	00		/GOING TO FIELD ZERO
	JMP I	PNTPLOT		/RETURN
HALFMOV,.-.			/MOVE HALF WAY ROUTINE
	TAD	(-PLTHAF)	/SETUP THE
	DCA	HALFCNT		/PLOT COUNTER
HALFLUP,JMS I	(PLOTIO)	/GO MOVE THE PEN
	ISZ	HALFCNT		/ENOUGH TIMES?
	JMP	HALFLUP		/NO, KEEP GOING
	JMP I	HALFMOVE	/YES, RETURN

HALFCNT,.-.			/PLOT COUNTER
PNTCNTR,.-.			/POINT PLOT LIST COUNTER
PNTPNTR,.-.			/POINT PLOT LIST POINTER
PNTRPTR,.-.			/POINT PLOT REPEATER

/	POINT PLOT COMMAND LIST.

PNTCOMM,PLPL;	NOP		/W
	PLPR;	NOP		/E
	PLPR;	NOP		/E
	PLPL;	NOP		/W
	NOP;	PLDU		/S
	NOP;	PLDD		/N
	NOP;	PLDD		/N
	NOP;	PLDU		/S
	PLPL;	PLDU		/SW
	PLPR;	PLDD		/NE
	PLPR;	PLDD		/NE
	PLPL;	PLDU		/SW
	PLPR;	PLDU		/SE
	PLPL;	PLDD		/NW
	PLPL;	PLDD		/NW
	PLPR;	PLDU		/SE
	0			/THIS ENDS THE LIST
	PAGE
/	DOUBLE-PRECISION DIVIDE ROUTINE

/	LAST EDIT:	03-OCT-1986	02:00:00	CJL

/	CALLING CONVENTIONS:

/	DLD;	DIVIDEND		/AC, MQ CONTAIN DIVIDEND
/	JMS I	(DUBDIVIDE)		/CALL ROUTINE
/	DIVISOR				/=> DIVISOR

/	QUOTIENT NOW IN AC, MQ AND QUO+1, QUO
/	REMAINDER NOW IN REM+1, REM

/	ALL OPERANDS ARE ASSUMED TO BE IN DOUBLE-PRECISION EAE FORMAT.

/	THE CURRENT EAE MODE ("A" OR "B") MUST BE CONSISTENT WITH THE PREVAILING
/	VALUE OF "EAETYP" WITHIN THIS ASSEMBLY.

/	ASSEMBLY INSTRUCTIONS.

/	SETTING EAETYP=0 CREATES A VERSION FOR MODE "A" USE (PDP-8/I EAE).
/	SETTING EAETYP=1 CREATES A VERSION FOR MODE "B" USE (PDP-8/E ONLY).

	IFNDEF	EAETYP	<EAETYP=0>	/ASSUME MODE "A" EAE OPERATION

/	RESTRICTIONS:

/	NO DATA FIELD CONSIDERATIONS ARE USED IN THIS ROUTINE. ALL OPERANDS MUST
/	BE IN THE INSTRUCTION FIELD.

/	DIVIDING ANY DIVIDEND BY ZERO YIELDS AN INDETERMINATE QUOTIENT (AND
/	REMAINDER) AND SETS THE LINK (ALL OTHER DIVISIONS CLEAR THE LINK).

/	DIVIDING ZERO BY ANY DIVISOR (OTHER THAN ZERO) YIELDS A QUOTIENT (AND
/	REMAINDER) OF ZERO.

/	IF EAETYP=0, DOUBLE-PRECISION SIMULATION ROUTINES WILL BE GENERATED FOR
/	DAD, DCM, DLD, DST.

/	EAE DEFINITIONS.

	XLIST	OFF
	IFNDEF	OFF	<OFF=	1>
	IFNDEF	ON	<ON=	0>
	XLIST	ON
	CAM=	CLA MQL			/CLEAR AC, MQ
	XLIST	OFF
	IFZERO	EAETYP			<
	IFNDEF	DAD	<DAD=	0>
	XLIST	ON
	DAD=	JMS I	(DADD)		/DOUBLE-PRECISION ADD
	XLIST	OFF			>
	IFNZRO	EAETYP			<
	DAD=	7443			/DOUBLE-PRECISION ADD
	XLIST	OFF			>
	XLIST	ON
	XLIST	OFF
	IFZERO	EAETYP			<
	IFNDEF	DCM	<DCM=	0>
	XLIST	ON
	DCM=	JMS I	(DCOM)		/DOUBLE-PRECISION COMPLEMENT
	XLIST	OFF			>
	IFNZRO	EAETYP			<
	DCM=	7575			/DOUBLE-PRECISION COMPLEMENT
	XLIST	OFF			>
	XLIST	ON
	XLIST	OFF
	IFZERO	EAETYP			<
	IFNDEF	DLD	<DLD=	0>
	XLIST	ON
	DLD=	JMS I	(DLOAD)		/DOUBLE-PRECISION LOAD
	XLIST	OFF			>
	IFNZRO	EAETYP			<
	DLD=	7663			/DOUBLE-PRECISION LOAD
	XLIST	OFF			>
	XLIST	ON
	XLIST	OFF
	IFZERO	EAETYP			<
	IFNDEF	DST	<DST=	0>
	XLIST	ON
	DST=	JMS I	(DSTORE)	/DOUBLE-PRECISION STORE
	XLIST	OFF			>
	IFNZRO	EAETYP			<
	DST=	7445			/DOUBLE-PRECISION STORE
	XLIST	OFF			>
	XLIST	ON
	DVI=	7407			/DIVIDE
	MUY=	7405			/MULTIPLY

/	MISCELLANEOUS DEFINITIONS.

	NL0001=	CLA IAC			/LOAD AC WITH 0001
	NL7777=	CLA CMA			/LOAD AC WITH 7777
DUBDIVI,.-.			/DOUBLE-PRECISION DIVIDE ROUTINE
	DST;	LO		/SAVE DIVIDEND
	NL0001			/SET INCREMENT
	TAD I	DUBDIVIDE	/POINT TO HIGH-ORDER DIVISOR
	DCA	DIVSHI		/STASH THE POINTER
	TAD I	DUBDIVIDE	/POINT TO LOW-ORDER DIVISOR
	DCA	DIVSLO		/STASH THE POINTER
	ISZ	DUBDIVIDE	/BUMP PAST ARGUMENT

/	TEST FOR ZERO-DIVIDE.

	TAD I	DIVSHI		/GET HIGH-ORDER DIVISOR
	SNA			/SKIP IF NON-ZERO
	TAD I	DIVSLO		/ELSE GET LOW-ORDER DIVISOR
	SZA CLA			/SKIP IF BOTH ARE ZERO
	JMP	NORMDIVIDE	/JUMP IF NOT
ZERODIV,STL			/INDICATE ZERO-DIVIDE
	JMP I	DUBDIVIDE	/RETURN WITH ERROR INDICATED

NORMDIV,TAD	HI		/RESTORE HIGH-ORDER DIVIDEND

/	TEST IF HIGH-ORDER DIVIDEND IS ZERO.

	SZA CLA			/SKIP IF HIGH-ORDER DIVIDEND IS ZERO
	JMP	TESTTT		/JUMP IF NOT

/	TEST FOR ZERO DIVIDEND TO PREVENT LOOPING LATER.

	MQA			/GET LOW-ORDER DIVIDEND
	SZA CLA			/SKIP IF DIVIDEND IS 0000, 0000
	JMP	TEST0X		/JUMP IF DIVIDEND IS 0000, XXXX
REMSET,	DST;	REM		/STORE (CLEAR) REMAINDER
	CAM			/CLEAN UP FOR SOME PURPOSES
QUOSET,	DST;	QUO		/STORE (CLEAR) QUOTIENT
RETADR,	CLL			/CLEAR LINK FOR GOOD RETURN
	JMP I	DUBDIVIDE	/RETURN TO CALLER

/	DIVIDEND IS SINGLE-PRECISION; CHECK PRECISION OF DIVISOR.

TEST0X,	TAD I	DIVSHI		/GET HIGH-ORDER DIVISOR
	SZA CLA			/SKIP IF (0000, XXXX)/(0000, YYYY)
	JMP	REMSET		/JUMP IF (0000, XXXX)/(ZZZZ, YYYY)
	JMS	GETLO		/GET LOW-ORDER DIVISOR ARGUMENT
SINGHI,	DCA	DIVARG		/STORE IN-LINE
	DVI;	DIVARG,	.-.	/DO SINGLE-PRECISION DIVIDE
	SZL			/SKIP IF DIVIDE WAS OK
	JMP	ZERODIVIDE	/JUMP IF NOT
	DCA	REM		/STORE REMAINDER
	DCA	REM+1		/CLEAR HIGH-ORDER REMAINDER
	JMP	QUOSET		/FINISH IT THERE
/	COMES HERE TO TEST FOR (XXXX, 0000)/(YYYY, 0000) CASE.

TESTTT,	TAD I	DIVSLO		/GET LOW-ORDER DIVISOR
	SNA			/SKIP IF ALREADY NON-ZERO
	TAD	LO		/ELSE GET LOW-ORDER DIVIDEND
	SZA CLA			/SKIP IF BOTH ZERO
	JMP	TEST24		/JUMP IF NOT
	TAD	HI		/GET HIGH-ORDER DIVIDEND
	MQL			/MOVE TO LOW-ORDER
	JMS	GETHI		/GET HIGH-ORDER DIVISOR ARGUMENT
	JMP	SINGHI		/CONTINUE THERE

/	COMES HERE TO TEST FOR (XXXX, YYYY)/(0000, ZZZZ) CASE.

TEST24,	TAD I	DIVSHI		/GET HIGH-ORDER DIVISOR
	SZA CLA			/SKIP IF SIMPLER CASE
	JMP	TESTLESS	/JUMP IF NOT
	JMS	GETLO		/GET LOW-ORDER DIVISOR ARGUMENT
	DCA	DVARG1		/STORE IN-LINE
	TAD	DVARG1		/GET IT BACK
	DCA	DVARG2		/STORE IN-LINE
	TAD	HI		/GET HIGH-ORDER DIVIDEND
	MQL DVI;DVARG1,	.-.	/DIVIDE BY LOW-ORDER DIVISOR
	SWP			/GET QUOTIENT
	DCA	QUO+1		/STORE AS HIGH-ORDER QUOTIENT
	TAD	LO		/GET LOW-ORDER DIVIDEND
	SWP			/PUT BACK
	DVI;	DVARG2,	.-.	/DIVIDE BY LOW-ORDER DIVISOR
	DCA	REM		/STORE LOW-ORDER REMAINDER
	DCA	REM+1		/CLEAR HIGH-ORDER REMAINDER
	TAD	QUO+1		/RESTORE HIGH-ORDER QUOTIENT
	JMP	QUOSET		/FINISH IT THERE

/	COMES HERE TO TEST IF DIVIDEND LESS THAN DIVISOR.

TESTLES,DLD;	DIVSLO,	.-.	/GET DIVISOR
	DCM			/-DIVISOR
	DAD;	LO		/DIVIDEND-DIVISOR
	SZL			/SKIP IF DIVISOR IS LARGER
	JMP	TESTEQUALS	/JUMP IF NOT
	DLD;	LO		/USE DIVIDEND AS REMAINDER
	JMP	REMSET		/CLEAR QUOTIENT AND FINISH THERE
/	COMES HERE TO TEST FOR EQUAL DIVIDEND AND DIVISOR.

TESTEQU,SNA			/SKIP IF HIGH-ORDER NON-ZERO
	MQA			/ELSE CHECK IF LOW-ORDER IS ZERO
	SZA CLA			/SKIP IF DIVIDEND=DIVISOR
	JMP	BIGDIVIDE	/JUMP IF NOT
	DST;	REM		/CLEAR REMAINDER
	NL0001			/GET QUOTIENT VALUE
	MQL			/TO LOW-ORDER
	JMP	QUOSET		/FINISH IT THERE

BIGDIVI,JMS	GETHI		/GET HIGH-ORDER DIVISOR ARGUMENT
	DCA	BDARG		/STORE IN-LINE

/	DO TRIAL DIVIDE, WHICH MIGHT YIELD EXCESSIVELY LARGE QUOTIENT.

	TAD	HI		/GET HIGH-ORDER DIVIDEND
	MQL DVI;BDARG,	.-.	/(HIGH-DIVIDEND)/(HIGH-DIVISOR)
	CLA MQA			/GET QUOTIENT
	DCA	QUO		/SAVE AS LOW-ORDER TRIAL QUOTIENT
	DCA	QUO+1		/CLEAR HIGH-ORDER TRIAL QUOTIENT
	JMS	GETLO		/GET LOW-ORDER DIVISOR ARGUMENT
	DCA I	(MUARG1)	/STORE IN-LINE
	JMS	GETHI		/GET HIGH-ORDER DIVISOR ARGUMENT
	DCA I	(MUARG2)	/STORE IN-LINE
	JMP I	(MUYAGN)	/CONTINUE THERE

/	EAE ARGUMENT ROUTINES.

GETLO,	.-.			/GET LOW-ORDER DIVISOR FOR EAE CALLERS
	XLIST	OFF
	IFZERO	EAETYP	<
	XLIST	ON
	TAD I	DIVSLO		/GET LOW-ORDER DIVISOR
	XLIST	OFF	>
	IFNZRO	EAETYP	<
	XLIST	ON
	TAD	DIVSLO		/GET LOW-ORDER DIVISOR POINTER
	XLIST	OFF	>
	XLIST	ON
	JMP I	GETLO		/RETURN

GETHI,	.-.			/GET HIGH-ORDER DIVISOR FOR EAE CALLERS
	XLIST	OFF
	IFZERO	EAETYP	<
	XLIST	ON
	TAD I	DIVSHI		/GET HIGH-ORDER DIVISOR
	XLIST	OFF	>
	IFNZRO	EAETYP	<
	XLIST	ON
	TAD	DIVSHI		/GET HIGH-ORDER DIVISOR POINTER
	XLIST	OFF	>
	XLIST	ON
	JMP I	GETHI		/RETURN

/	TEMPORARIES.

DIVSHI,	.-.			/HIGH-ORDER DIVISOR POINTER

/	DOUBLE-PRECISION TEMPORARIES AND CONSTANTS.

LO,	.-.			/DIVIDEND - LOW-ORDER
HI,	.-.			/DIVIDEND - HIGH-ORDER
QUO,	ZBLOCK	2		/QUOTIENT
REM,	ZBLOCK	2		/REMAINDER
	PAGE
	XLIST	OFF
	IFZERO	EAETYP	<
	XLIST	ON
/	EAE DEFINITIONS FOR THIS PAGE.

	DAD=	JMS	DADD	/DOUBLE-PRECISION ADD
	DCM=	JMS	DCOM	/DOUBLE-PRECISION COMPLEMENT
	DLD=	JMS	DLOAD	/DOUBLE-PRECISION LOAD
	DST=	JMS	DSTORE	/DOUBLE-PRECISION STORE

	XLIST	OFF	>
	XLIST	ON
/	CALCULATE TRIAL PRODUCT OF QUOTIENT*DIVISOR WHICH MUST BE ADJUSTED UNTIL
/	IT IS DOUBLE-PRECISION SIGNIFICANT ONLY. SINCE THE HIGH-ORDER QUOTIENT IS
/	ZERO, THE PRODUCT COULD BE TRIPLE-PRECISION (NOT QUADRUPLE-PRECISION)
/	SIGNIFICANT. THE HIGH-ORDER 12 BITS MIGHT BE SIGNIFICANT, BUT THE VALUE
/	WILL BECOME DOUBLE-PRECISION RAPIDLY WHEN THE QUOTIENT IS DECREMENTED AND
/	THE PRODUCT IS RECALCULATED.

MUYAGN,	TAD I	PQUO/(QUO)	/GET LOW-ORDER QUOTIENT
	MQL MUY;MUARG1,	.-.	/(LOW-ORDER QUOTIENT)*(LOW-ORDER DIVISOR)
	DST;	MLO		/SAVE LOWER PRODUCT TERMS
	CAM			/CLEAN UP
	DCA	MHI+1		/CLEAR HIGH-ORDER FOR NOW
	TAD I	PQUO/(QUO)	/GET LOW-ORDER QUOTIENT
	MQL MUY;MUARG2,	.-.	/(LOW-ORDER QUOTIENT)*(HIGH-ORDER DIVISOR)
	DAD;	MHI		/ADD ON SAVED TERM
	DST;	MHI		/SAVE HIGHER TERM
	SNA			/SKIP IF SIGNIFICANT
	JMP	DIVOK		/JUMP IF NOT

/	WE MUST REDUCE THE QUOTIENT AND TRY AGAIN.

DROP,	NL7777			/-1
	TAD I	PQUO/(QUO)	/BACKUP THE QUOTIENT
	SNA			/SKIP IF STILL OK
	HLT			/ELSE BARF
	DCA I	PQUO/(QUO)	/STORE BACK
	JMP	MUYAGN		/TRY AGAIN

/	COMES HERE IF PRODUCT IS DOUBLE-PRECISION; CHECK IF ALSO SMALL ENOUGH.

DIVOK,	DLD;	MLO		/GET PRODUCT
	DCM			/INVERT FOR TESTING
	DAD;	LO		/COMPARE TO ORIGINAL DIVIDEND
	SNL			/SKIP IF VALID PRODUCT
	JMP	DROP		/JUMP IF TOO LARGE
	DST;	REM		/STORE REMAINDER
	DLD;	PQUO,	QUO	/LOAD QUOTIENT
	JMP I	(RETADR)	/RETURN TO CALLER
	XLIST	OFF
	IFZERO	EAETYP	<
	XLIST	ON
/	DOUBLE-PRECISION SIMULATOR ROUTINES.

DCOM,	.-.			/COMPLEMENT ROUTINE
	SWP			/GET LOW-ORDER FIRST
	CLL CIA			/INVERT IT
	SWP			/PUT IT BACK
	CMA			/INVERT HIGH-ORDER
	SZL			/CARRY?
	IAC			/YES, SO INCREMENT
	JMP I	DCOM		/RETURN

DLOAD,	.-.			/LOAD ROUTINE
	CAM			/CLEAN UP
	TAD	DLOAD		/GET OUR CALLER
	DCA	DADD		/MAKE IT THEIRS
	SKP			/AND DON'T EXECUTE ADDRESS!
DADD,	.-.			/ADD ROUTINE
	DCA	DCOM		/SAVE HIGH-ORDER
	TAD I	DADD		/GET ARGUMENT
	DCA	DLOAD		/STASH IT
	MQA			/GET LOW-ORDER
	CLL			/INITIALIZE CARRY
	TAD I	DLOAD		/ADD ON LOW-ORDER ARGUMENT
	MQL			/PUT INTO MQ
	ISZ	DADD		/BUMP PAST ARGUMENT
	ISZ	DLOAD		/BUMP TO HIGH-ORDER
	RAL			/GET CARRY
	TAD	DCOM		/RESTORE AC
	TAD I	DLOAD		/ADD ON HIGH-ORDER ARGUMENT
	JMP I	DADD		/RETURN

DSTORE,	.-.			/STORE ROUTINE
	DCA	DCOM		/SAVE AC
	TAD I	DSTORE		/GET ARGUMENT
	DCA	DLOAD		/STASH IT
	MQA			/GET LOW-ORDER
	DCA I	DLOAD		/STORE IT
	ISZ	DSTORE		/BUMP PAST ARGUMENT
	ISZ	DLOAD		/BUMP TO HIGH-ORDER
	TAD	DCOM		/RESTORE AC
	DCA I	DLOAD		/STORE IT
	TAD	DCOM		/RESTORE AC AGAIN
	JMP I	DSTORE		/RETURN
	XLIST	OFF	>
	XLIST	ON

/	DOUBLE-PRECISION TEMPORARIES.

MLO,	.-.			/LOW-ORDER PRODUCT
MHI,	ZBLOCK	2		/HIGH-ORDER PRODUCT

	PAGE
	PLOTBUF=.		/PLOT BUFFER

	NOPUNCH			/TURN OFF BINARY

	ZBLOCK	BUFSIZE		/PLOT BUFFER

	ENPUNCH			/RESTORE BINARY

	PLOTEND=.		/END OF PLOT BUFFER

	$			/THAT'S ALL FOLK!