/SPCWAR  BY  D.E. WREGE
VC8E=1
DK8EA=1
M1703=1
EAE=0
/
/		VERSION 3
/
/
/
/
/
/
/
/COPYRIGHT  (C)  1974 BY D.E. WREGE & ASSOC.
/
/
/
/
/
/
/
/
/
/
/THE INFORMATION IN THIS DOCUMENT IS SUBJECT TO CHANGE WITHOUT NOTICE
/AND SHOULD NOT BE CONSTRUED AS A COMMITMENT BY D.E. WREGE & ASSOCIATES.
/D.E. WREGE & ASSOCIATES ASSUME NO RESPONSIBILITY
/FOR ANY ERRORS THAT MAY APPEAR IN THIS DOCUMENT.
/
/THE SOFTWARE DESCRIBED IN THIS DOCUMENT IS FURNISHED TO GEORGIA TECH.
/UNDER A LICENSE FOR USE ON A SINGLE COMPUTER SYSTEM AND CAN BE COPIED
/(WITH INCLUSION OF THIS COPYRIGHT NOTICE) ONLY FOR USE IN SUCH
/SYSTEM, EXCEPT AS MAY OTHERWISE BE PROVIDED IN WRITING BY D.E. WREGE
/AND ASSOC.
/
/D.E. WREGE AND ASSOC. ASSUME NO RESPONSIBILITY FOR THE USE
/OR RELIABILITY OF ITS SOFTWARE ON EQUIPMENT THAT IS NOT SUPPLIED BY
/DIGITAL.
/
/
/
/
/
/
/
/
/
/
/SPACE WAR. V3

/D.E. WREGE
/ ADDED VC8I SUPPORT - CHD


/CONDITIONAL ASSEMBLY PARAMETERS
	IFNDEF EAE <EAE=0>

/FOR AX08 TYPE DISPLAY DEFINE AX08=1
	IFNDEF AX08 <AX08=0>
/FOR TYPE 30G DISPLAY DEFINE T30G=1
	IFNDEF T30G <T30G=0>
/FOR PDP-8/I OR POSIBUS VC8I DISPLAY VC8I=1
	IFNDEF VC8I <VC8I=0>
/FOR PDP-8/E VC8E DISPLAY VC8E=1
	IFNDEF VC8E <VC8E=0>
/PDP-12 - VR12 IS DEFAULT
	IFZERO VC8E+VC8I+T30G+AX08 <PDP12=1>
	IFNDEF PDP12 <PDP12=0>

/CONDITIONAL ASSEMBLIES FOR CLOCK
/FOR DK8-EA (60 CYCLE) DK8EA=1
	IFNDEF DK8EA <DK8EA=0>
/FOR DK8-EP PROGRAMABLE DK8EP=1
	IFNDEF DK8EP <DK8EP=0>
/FOR FRED DYER'S FUNNY CLOCK FCLOCK=1
	IFNDEF FCLOCK <FCLOCK=0>
/DEFAULT IS PDP-12 KW12-A
	IFNZRO PDP12 <
	IFZERO DK8EA+AX08+DK8EP+FCLOCK <
	IFNDEF KW12 <KW12=1>>>
	IFNDEF KW12 <KW12=0>


/DEFS

	IFNZRO PDP12 <
DIS=	140	/DISPLAY A POINT LINC MODE
LINC=	6141	/GO TO LINC MODE
PDP=	0002	/GO TO 8-MODE>

IFNZRO EAE <
MUY=	7405	/EAE MULTIPLY
DVI=	7407	/EAE DIVIDE
NMI=	7411	/EAE NORMALIZE
SHL=	7413	/EAE SHIFT LEFT
ASR=	7415	/ARITHMETIC SHIFT RIGHT
LSR=	7417	/LOGICAL SHIFT RIGHT
MQL=	7421	/LOAD MQ;CLEAR AC
SCL=	7403	/STEP COUNTER LOAD FROM MEMORY
SCA=	7441	/STEP COUNTER TO ACCUMULATOR
MQA=	7501	/READ MQ
CAM=	CLA MQL
>


D=	10	/DISPLAY BUFFER FIELD
DISBUF=4000	/ADDRESS OF DISPLAY BUFFER


/PAGE ZERO CONSTANTS AND VARIABLES

*1
	JMP I .+1
	INTRPT

*6
QBETA,	0		/FOR PDP-12
QALPHA, 0		/ALPHA REG USED FOR DISPLAY

QXR1,	0		/RESERVED XR'S
QXR2,	0
QDISXR, 0		/FOR DISPLAY ROUTINE ONLY
QXR3,	0		/MUST BE USED WITH IOF

*20
/VARIABLES RESERVED

QR,	0		/SHIP POSITION RADIAL
ALIVE,	0		/=0 WHEN SHIP BLOWN UP
			/NON-ZERO OTHERWISE
QXPOS,	0		/X COORD.
QYPOS,	0		/Y COORD.
QVX,	0		/X COMPONENT VELOCITY
QVY,	0		/Y COMPONENT VELOCITY
QPH,	0		/SHIP ANGLE (NOT POSITION DEPENDENT)
QPHDOT, 0		/SHIP ANGULAR VELOCITY
QPHR,	0		/PRECISION QPH

SHIELD, 0		/NON-ZERO WHEN SHIELDS ARE UP.
			/WHEN SHIELDS ARE UP NO MISSELS
			/AND NO ACCELLERATION ALLOWED.
HYPERS, 0		/NON-ZERO WHEN IN HYPERSPACE
MISCNT, 1		/-# MISSLES LEFT
ARMED,	0		/INCREMENTS TO 0 BEFORE SHIP
			/CAN FIRE
QSHIP,	0		/POINT TO SHIP PICTURE
QSHIPN, 0		/# POINTS TO BE DISPLAYED IN SHIP
QSINPH, 0		/SIN(QPH)
QCOSPH, 0		/COS(QPH)
	SHIPSZ=.-QR	/#ENTRIES/SHIP


QTIME,	3777		/TIME SCALING FACTOR
/TEMPS AND VARIABLES

QSINTH, 0		/SIN(QTH)
QCOSTH, 0		/COS(QTH)
BREAKU, 0		/NON-ZERO WHEN SHIP BREAKING UP.
DBUFP,	0		/POINTS TO NEXT POS IN DISP BUFF.
QTHR,	0		/NON-ZERO WHEN MAIN ROCKETS ON
QTHA,	0		/NON-ZERO WHEN ANGULAR THRUST ON
CONSER, 0		/NON-ZERO IF CONSERVING ANGULAR
			 /MOMENTUM
NUMMIS, 0		/# MISSELS IN MISTBL
NNUMMI, 0		/TEMPORORY FOR UPDATING MISSLES

MAXMIS, -7777		/NUMBER OF ALLOWABLE MISSELS
QTM1,	0		/GENERAL TEMPORARYS
QTM2,	0
QCNT1,	0
QCNT2,	0
QCNT3,	0		/MUST BE USED WITH IOF

/CONSTANTS

QTHRUS, 10		/THRUST
QGRAV,	1000		/GRAVITY
QRET,	4		/THRUST ANGULAR RETRO'S
QTHROC, 1000		/MUSSEL VELOCITY OF ROCKETS


/THE FOLLOWING ARE POINTERS & FLAGS

PSAUCP, SAUC		/POINTER TO SAUCER SHIP GENERATOR
MISPNT, MISTBL		/POINTS TO WHERE NEXT MISSEL SHOULD
			/GO IN MISSEL TABLE
BOUNCX, NULL
BOUNCY, NULL

/NEW INSTRUCTIONS

	MULT=JMS I .
	XMULT
	DIVIDE=JMS I .
	XDIVID
	DISPLAY=JMS I .
	XDISPL
	COS=JMS I .	/COSINE LOOKUP
	XCOSIN
	SIN=JMS I .	/SINE LOOKUP
	XSINE
	GGRAV=JMS I .
	XGGRAV
	RANDOM=JMS I .
	XRANDOM
	ONDECK=JMS I .
	XONDECK
	OFDECK=JMS I .
	XOFDECK
	DRAW=JMS I .
	CALPNT
	NXTPOS=JMS I .
	NEWPOS
	NXTANG=JMS I .
	ANGLES
	FLAME=JMS I .
	DFLAME
	DSTARS=JMS I .
	SUN
	DSUN=JMS I .
	POLARS
	FIRE=JMS I .
	FIRONE

/THESE DEFS ARE ONLY FOR INTERMEDIATE
/STAGES OF DEVELOPMENT.

	IFDEF XXXXXX <	/OR IFPASS2
	IFNDEF XONDECK <XONDECK=NULL1>
	IFNDEF XOFDECK <XOFDECK=NULL1>
	IFNDEF CALPNT <CALPNT=NULL1>
	IFNDEF NEWPOS <NEWPOS=NULL1>
	IFNDEF ANGLES <ANGLES=NULL1>
	IFNDEF DFLAME <DFLAME=NULL1>
	IFNDEF SUN <SUN=NULL1>
	IFNDEF FIRONE <FIRONE=NULL1>
	IFNDEF SAUC <SAUC=NULL1>
	IFNDEF XGGRAV <XGGRAV=NULL1>
	IFNDEF BOUNX <BOUNX=NULL1>
	IFNDEF BOUNY <BOUNY=NULL1>
	IFNDEF MISTBL <MISTBL=.>
	IFNDEF SPCWAR <SPCWAR=.>>
	XXXXXX=.
	HLT

	PAGE
/SO WE HAVE START AT 200

	JMP I .+1
	SPCWAR

/SIGNED MULTIPLY ROUTINE.
/THIS ROUTINE DOES A INTEGER MULTIPLY OF
/TWO SIGNED NUMBERS (11 BITS OF SIGNIF).
/RESULT IS A SINGLE 12-BIT SIGNED NUMBER.
/CALL:	TAD (MLTCAND
/	JMS MULT
/	 MLTPLR

XMULT,	0
	CLL		/WILL SAVE IN LINK
	SPA		/MULTIPLICAND POSITIVE?
	CMA CML IAC	/NO: MAKE POS. REMEMBER SIGN IN LINK
	MQL		/LOAD MULTIPLICAND INTO MQ
	TAD I XMULT	/PICK UP MULTIPLIER
	ISZ XMULT	/POINT TO RETURN
	SPA		/POSITIVE??
	CMA CML IAC	/NO: MAKE POS AND REMEMBER SIGN
	DCA XMULT1	/FOR THE MULTIPLY
	CMA RAL		/AC=-1 IF NEG;-2 IF POS.
	DCA XMULTS	/SAVE IT FOR LATER
	MUY		/EAE MULTIPLY
XMULT1,  0		/MULTIPLYER GOES HERE
	SHL		/WANT CORRECT NORMALIZATION
	 0		/ONE SHIFT ONLY
	DCA XMULT1	/REMEMBER HIGH ORDER
	MQA		/READ LOW ORDER
	SPA CLA		/SKIP IF NO ROUND UP
	IAC		/ROUND UP ONE
	TAD XMULT1	/MAKE ROUNDED RESULT
	ISZ XMULTS	/WILL SKIP IF NEG SIGN
	JMP I XMULT	/DONE: AC=RESULT
	CIA		/NEGATE
	JMP I XMULT	/AND RETURN

XMULTS, 0		/SAVES SIGN OF RESULT


/DIVISION OF SIGNED DIVIDEND BY UNSIGNED DIVISOR.
/EXIT WITH 12-BIT SIGNED RESULT.
/DIVIDE OVERFLOW ONLY OCCURS WHEN DIVISOR=0
/CALL:	TAD (DIVIDEND
/	DIVIDE
/	 DIVISOR
/	ERROR		/DIVISION BY 0
/	NORMAL RET.	/AC=SIGNED RESULT

XDIVID, 0
	CLL		/FOR SIGN
	SPA		/IS IT POSITIVE?
	CIA CML		/NO:MAKE POS.
	MQL		/PUT IN LOW ORDER
	CMA RAL		/AC=-1 IF NEG.
	DCA XMULTS	/SAVE SIGN
	TAD I XDIVID	/GET DIVISOR
	ISZ XDIVID	/POINT TO ERROR EXIT
	SNA		/SKIP IF NOT ZERO
	JMP I XDIVID	/TAKE DIV BY 0 RETURN
	ISZ XDIVID	/POINT TO NORMAL RETURN
	DCA .+2		/STORE DIVISOR
	DVI		/DO THE DIVISION
	 0		/HOLDS THE DIVISOR
	CLA;MQA		/GET RESULT
	ISZ XMULTS	/SKIP IF NEG
	JMP I XDIVID	/POS=RETURN
	CIA		/NEG=NEGATE
	JMP I XDIVID	/AND RETURN


/DISPLAY ROUTINE. REFRESHES OUT OF BUFFER IN FIELD D.
/THIS IS FOR PDP-12 DISPLAY. USES QALPHA FOR REGISTER.
/CALL:	TAD (ADDR-1	/ADDR=ADDRESS OF BUFFER IN FIELD D
/	DISPLA		/OF X,Y PAIRS.
/	 -# POINTS

XDISPL, 0
	DCA QDISXR	/ADDRESS INTO XR
	TAD I XDISPL	/PICK UP # X,Y PAIRS
	ISZ XDISPL	/POINT TO RETURN
	SNA		/IF ZERO POINTS THEN EXIT
	JMP I XDISPL
	STL RAR		//2 FOR POINT PAIRS
	DCA QCNT1	/STASH FOR COUNT
	CDF D		/TO DISPLAY BUFFER FIELD
	IOF		/FOR LINK MODE
	IFNZRO PDP12 <
XDISL,	TAD I QDISXR	/GET THE X
	TAD (400	/0 IS CENTER OF SCREEN
	DCA QALPHA	/STICK IN ALPHA REGISTER
	TAD I QDISXR	/GET Y-POSITION
	LINC
	DIS QALPHA	/DISPLAY THE POINT
	PDP		/BACK TO 8-MODE
	CLA CLL		/GET RID OF THE Y
	>
	IFNZRO T30G <
	TAD (3		/MAX INTENSITY
	6074		/SET MAX INTENSITY
	CLA CLL
XDISL,	TAD I QDISXR	/GET X
	CLL RAL		/512 RESOLUTION
	TAD (1000	/TO CENTER OF SCREEN
	6053		/CLEAR AND LOAD  X
	CLA CLL
	TAD I QDISXR	/GET Y
	CLL RAL		/512 RESOLUTION
	TAD (1000	/TO CENTER OF SCREEN
	6067		/CLEAR AND LOAD Y;DISPLAY
	CLA CLL
	6161		/WAIT TILL DONE
	JMP .-1>

	IFNZRO VC8E <
	6050		/CLEAR ALL FLAGS
XDISL,	TAD I QDISXR	/GET X
	CLL RAL		/512 RESOLUTION
	6053		/CLEAR AND LOAD  X
	CLA CLL
	TAD I QDISXR	/GET Y
	CLL RAL		/512 RESOLUTION
	6054		/CLEAR AND LOAD Y
	CLA CLL
	6052		/WAIT TILL DONE
	JMP .-1
	6055		/INTENSIFY
	>
	IFNZRO VC8I <
	6077		/MAX INTENSITY
	CLA CLL
XDISL,	TAD I QDISXR	/GET X
	CLL RAL		/512 RESOLUTION
	TAD (1000	/TO CENTER OF SCREEN
	6052		/LOAD X
	CLA CLL
	TAD I QDISXR	/GET Y
	CLL RAL		/512 RESOLUTION
	TAD (1000	/TO CENTER OF SCREEN
	6066		/LOAD Y; DISPLAY
	CLA CLL>
	IFNZRO AX08 <
XDISL,	TAD I QDISXR
	TAD (400
	6303		/LOAD X
	CLA CLL
	TAD I QDISXR	/GET Y
	6317		/LOAD Y AND INTENS.
	CLA CLL
	>

	ISZ QCNT1	/SKIP WHEN DONE
	JMP XDISL	/LOOP
	CDF 0		/BACK TO THIS FIELD
	JMP I XDISPL	/AND RETURN


/SINE LOOKUP ROUTINE.  ANGLES ARE IN
/FRACTIONS OF A CIRCLE. I.E. IN 256THS OF A CIRCL.
/THUS PI RADIANS=200(8)
/THE RESULT IS A SIGNED NUMBER -2048<SIN<2048.
/NOTE THE NORMALIZATION.
/CALL:	TAD (ANGLE
/	SINE

XSINE,	0
	DCA QTM1	/REMEMBER ANGLE
	TAD QTM1	/GET BACK
	AND (177	/INDEX INTO TABLE
	TAD (SINTAB	/BY ADDING OFSET
	DCA QTM2	/FOR INDIRECT
	TAD QTM1	/NOW TO FIGURE OUT SIGN
	AND (200	/BIT 4 INDICATES HEMISPHERE
	CLL		/FOR HEMISPHERE INDICATOR
	SZA CLA		/SKIP IF POS RESULT
	STL		/NEG RESULT: INDICATE IN LINK
	TAD I QTM2	/PICK UP VALUE
	SZL		/SKIP IF POS.
	CIA		/NEGATIVE SIGN
	JMP I XSINE

/DO THE SAME FOR COSINES

XCOSIN, 0
	TAD (100	/OFFSET SO WE CAN USE SINE ROUTINE
	JMS XSINE
	JMP I XCOSIN	/AND RETURN

/RANDOM NUMBER GENERATOR.
/USES R(N+1)=(2^11+3)R(N-1) MODULO 24.
/COULD BE LESS INTELEGENT FOR SPEED.
/RESULT IS 12 BIT RANDOM NUMBER IN AC.
XRANDO, 0
	TAD RANUML	/GET LOW ORDER
	MQL		/MULTIPLICAND
	MUY		/*2^11+3
	 4003
	DCA RANUMT	/HIGH ORDER CARRY
	MQA		/GET LOW ORDER
	DCA RANUML	/STASH AS IS
	TAD RANUMH	/GET HIGH ORDER
	MQL
	MUY		/*(2^11+3)
	 4003
	CLA		/THROW AWAY HIGH ORDER
	MQA		/READ MIDDLE ORDER
	TAD RANUMT	/ADD OTHER PART
	DCA RANUMH	/NEW HIGH ORDER
	TAD RANUMH	/HIGH ORDER IS GOOD ONE
	JMP I XRANDOM

RANUMT, 0
RANUMH, 0
RANUML, 1

	PAGE
	DECIMAL
SINTAB, 0;50;101;151;201;251;301;350;400;449
498;546;595;643;690;737;784;830;876;921
0966;1010;1053;1096;1138;1179;1220;1260;1299;1338
1375;1412;1448;1483;1518;1551;1583;1615;1645;1675
1703;1730;1757;1782;1806;1829;1851;1872;1892;1911
1928;1945;1960;1974;1987;1998;2009;2018;2026;2033
2038;2043;2046;2047;2047;2047;2046;2043;2038;2033
2026;2018;2009;1998;1987;1974;1960;1945;1928;1911
1892;1872;1851;1829;1806;1782;1757;1730;1703;1675
1645;1615;1583;1551;1518;1483;1448;1412;1375;1338
1299;1260;1220;1179;1138;1096;1053;1010;0966;0921
0876;0830;0784;0737;0690;0643;0595;0546;0498;0449
0400;0350;0301;0251;0201;0151;0101;0050

	OCTAL
GRVTBL, 0
*.+177			/RESERVED FOR GRAVITY TABLE

/A LITTLE DO NOTHING SUBROUTINE

NULL1,	0
	CLA CLL
	JMP I NULL

/WE NEED TWO OF THEM?????

NULL,	0
	JMP I NULL
/ROCKET FLAME TABLE
	DECIMAL
FLAMEX, 
-10;0; -12;0; -14;0; -16;0; -20;0; -18;0; -20;0; -22;0

/SHIP OUTLINES
/SHIP 1   KLINGON BATTLE CRUISER (STAR TREK)
SHIP1C,
1;0; 3;0; 5;0; 7;0; 9;0; 10;1; 12;1; 13;1; 14;0
0;0; 0;1; -2;1; -3;2; -4;3; -5;4; -6;5; -7;6
-9;6; -11;6; -12;6; -11;5; -9;3; -7;1; -8;1
	SHIP1E=.
 13;-1
12;-1; 10;-1; -8;-1; -7;-1; -9;-3; -11;-5; -12;-6; -11;-6
-9;-6; -7;-6; -6;-5; -5;-4; -4;-3; -3;-2; -2;-1; 0;-1
1;0; 3;0; 5;0; 7;0; 9;0; 0;0
/SHIP1E=.

SAUC1,	9;0; 10;0; 11;0; 3;0; -3;0; 0;3; 0;-3
	SAUC1E=.

/SHIP 2  FLASH GORDON
SHIP2C,
14;0; 12;1; 10;2; 8;2; 6;2; 4;2; 2;2; 0;2; -2;2; -4;2; -6;2; -8;2; -8;0
4;4; 2;6; 0;8; -3;8; -2;7; 0;5; 0;3
	SHIP2E=.
12;-1; 10;-2; 8;-2; 6;-2; 4;-2; 2;-2; 0;-2; -2;-2; -4;-2; -6;-2; -8;-2;
4;-4; 2;-6; 0;-8; -3;-8; -2;-7; 0;-5; 0;-3
/SHIP2E=.

/SAUCER CANNON
SAUC2, 9;0; 10;0; 11;0
	SAUC2E=.

/SAUCERS COMMON OUTLINE
BSHIP,	
0;112; 1;110; 2;106; 3;100; 4;91; 5;79
6;66; 6;51; 7;35; 7;18; 7;0
	BSHIPE=.

	OCTAL


/SHIP DEPENDENT STUFF FOR PAGE ZERO LOAD

SHIP1,	ZBLOCK QSHIP-QR
	SAUC2
	SAUC2E-SAUC2
	XXX=.-SHIP1
	ZBLOCK SHIPSZ-XXX

	SHIP1X=SHIP1+QXPOS-QR
	SHIP1Y=SHIP1+QYPOS-QR

SHIP2,	ZBLOCK QSHIP-QR
	SAUC2
	SAUC2E-SAUC2
	XXX=.-SHIP2
	ZBLOCK SHIPSZ-XXX

	SHIP2X=SHIP2+QXPOS-QR
	SHIP2Y=SHIP2+QYPOS-QR

	/PAGE
/ONDECK ROUTINE.
/THIS ROUTINE PUTS SHIP DEPENDENT STUFF
/IN PAGE ZERO FOR COMMON CALCULATIONAL
/ROUTINES.  ENTER WITH TABLE ADD-1 IN AC.
/COPIES "SHIPSZ" LOCATIONS.

/CALL:	TAD (SHIPST-1
/	ONDECK
/	RETURN

XONDEC, 0
	DCA QXR2	/ADDRESS OF SHIP STUFF
	TAD (QR-1	/START OF PAGE ZERO LOCS.
	DCA QXR1	/STICK IN OTHER XR
	JMS SWITCH	/PUT IT THERE
	JMP I XONDECK

/TAKE STUFF FROM XR2 AND PUT IN XR1

SWITCH, 0
	TAD (-SHIPSZ	/NUMBER OF ENTRIES
	DCA QCNT1
	TAD I QXR2	/SOURCE
	DCA I QXR1	/DESTINATION
	ISZ QCNT1	/DONE?
	JMP .-3		/NOT YET
	JMP I SWITCH

/OFDECK ROUTINE.
/COPY STUFF OUT. (INVERSE OF ONDECK)
/CALL:	TAD (SHIPST-1
/	OFDECK
/	 RETURN

XOFDEC, 0
	DCA QXR1	/DESTINATION XR
	TAD (QR-1	/START OF PAGE ZERO STUFF
	DCA QXR2	/SOURCE XR
	JMS SWITCH	/COPY IT OUT
	JMP I XOFDECK	/AND RETURN

	PAGE
/ROUTINE TO CALCULATE THE SHIP OUTLINE FROM CENTRAL
/COORDINATES AND OUTLINE.  REQIRES THE FOLLOWING PAGE 0'S
/BE PREVIOUSLY SET UP:
/	QXPOS	X-CORD CENTER OF SHIP
/	QYPOS	Y-CORD CENTER OF SHIP
/	QSINPH	SINE OF SHIP ANGLE FROM X AXIS
/	QCOSPH	COS  OF SHIP ANGLE FROM X AXIS
/	QSHIP	POINTS TO START OF SHIP OUTLINE TABLE
/	QSHIPN	NUMBER OF POINTS IN SHIP OUTLINE
/	QTIME	OUTLINE SCALE FACTOR

/IF SHIP IS NOT ALIVE OR IN HYPERSPACE THEN FAST EXIT.
/COSINES AND SIGNS MUST ALLREADY BE AVAILABLE.
/ALGORITHM:
/	X=QXPOS + XS*COS(PH) - YS*SIN(PH)
/	Y=QYPOS + XS*SIN(PH) + YS*COS(PH)
/WHERE XS AND YS ARE POINTS ON SHIP OUTLINE FROM QSHIP TABLE.
/THIS ROUTINE MAKES USE OF SYMMETRY

CALPNT, 0
	TAD HYPERS	/GET HYPERSPACE FLAG
	SZA CLA		/SKIP IF VISIBLE
	JMP I CALPNT	/CAN'T SEE HIM
	TAD ALIVE	/NOW SEE IF ALIVE
	SNA CLA		/SKIP IF ALIVE AND WELL
	JMP I CALPNT	/HAS BIT THE DUST
	TAD QSHIPN	/NUMBER OF POINTS IN SHIP
	CIA STL		/NEGATE
	RAR		/POINT PAIRS
	DCA QCNT1	/-# POINT PAIRS.
	STA		/SINCE USING XR
	TAD QSHIP	/WANT START-1
	DCA QXR1	/STASH IN XR
	TAD QTIME	/GET THE TIME SCALER
	DCA T1		/SET IT UP FOR A MULT
	TAD QCOSPH	/GET COS
	MULT		/SCALE IT
T1,	0
	DCA CALPX1	/SET IT UP FOR OUTLINE CALC
	TAD QTIME	/DO THE SAME FOR -SIN
	DCA T2
	TAD QSINPH
	CIA
	MULT
T2,	0
	DCA CALPY1
	TAD QSINPH
	SPA
	CIA
	DCA CALPY3
	TAD QXPOS	/MUST SCALE X RIGHT
	ASR		/TWO TO THE RIGHT
	 2
	DCA CALPTX	/STORE FOR LATER
	TAD QYPOS	/AND THE SAME FOR Y
	ASR
	 2
	DCA CALPTY
	TAD QTIME	/SCALE SINE AND COS FOR THE
	DCA T3		/Y COMPONENT OF SHIP OUTLINE
	TAD QSINPH
	MULT
T3,	0
	DCA CALPX2
	TAD QTIME
	DCA T4
	TAD QCOSPH
	MULT
T4,	0
	DCA CALPY2
CALPL,	TAD I QXR1	/GET X POINT
	DCA CALPX	/AND STASH
	TAD I QXR1	/GET Y POINT
	DCA CALPY	/AND STASH
	TAD CALPX	/GET X
	MULT		/MULTIPLY
CALPX1,   0
	DCA CALPT	/STORE TILL LATER
	TAD CALPY	/GET Y
	MULT
CALPY1,  0		/-XY*SIN(PH)
	DCA CALPY4	/SAVE IT FOR SYM CALC
	TAD CALPY4	/AND GET IT BACK
	TAD CALPT	/XS*COS(PH)-YS*SIN(PH)
	TAD CALPTX	/AND IN CENTER OF SHIP
	CDF D		/TO DISPLAY FIELD
	DCA I DBUFP	/INTO DISPLAY BUFFER
	ISZ DBUFP
	CDF 0
	TAD CALPX
	MULT
CALPX2,  0		/XS*SIN(PH)
	DCA CALPT2	/STASH
	TAD CALPY	/GET Y VALUE
	MULT
CALPY2,  0		/YS*COS(PH)
	DCA CALPY5	/SAVE IT FOR SYM CALC
	TAD CALPY5	/AND GET IT BACK
	TAD CALPT2	/XS*SIN(PH)+YS*COS(PH)
PSAUC2, NOP		/OR JMP .+3 FOR SHIPS
	MULT
CALPY3,  0
	TAD CALPTY	/YPOS+XS*SIN(PH)+YS*COS(PH)
	CDF D		/TO DISPLAY FIELD
	DCA I DBUFP	/STICK IN BUFFER
	ISZ DBUFP	/NEXT POSITION
	CDF 0		/BACK TO THIS FIELD
	TAD CALPY4	/GET -Y*SIN(PH)
	CIA		/NEGATE IT
	TAD CALPT	/ADD XS*COS(PH)
	TAD CALPTX	/ADD CENTER OF SHIP
	CDF D		/CHANGE TO DISPLAY FIELD
	DCA I DBUFP	/AND DEPOSIT IT
	ISZ DBUFP
	CDF 0		/RESTORE DATA FIELD
	TAD CALPY5	/GET YS*COS(PH)
	CIA		/AND NEGATE IT
	TAD CALPT2	/ADD TO IT XS*SIN(PH)
	TAD CALPTY	/ADD ON SHIP CENTER
	CDF D		/CHANGEO DISPLAY FIELD
	DCA I DBUFP	/AND DEPOSIT T
	ISZ DBUFP
	CDF 0
	ISZ QCNT1	/CHECK FR COMPLETION
	JMP CALPL	/LOOP
	JMP I CALPNT

CALPX,	0
CALPY,	0
CALPT,	0
CALPTX, 0
CALPTY, 0
CALPT2, 0
CALPY4, 0
CALPY5, 0

	PAGE
/THIS IS FOR SHIPS BEING SAUCERS
/REPLACES CALPNT WHEN USING SAUCERS.

SAUC,	0
	TAD HYPERS	/DON'T DO IT IF
	SZA CLA		/IN HYPERSPACE
	JMP I SAUC
	TAD (BSHIP-1	/INDEX INTO SAUCER TABLE
	DCA QXR1
	TAD QTIME	/FOR CURVED SPACE
	DCA .+3		/WE SCALE DOWN ANGLES
	TAD QSINPH	/GET ANGLE
	MULT
	 0		/SCALE IT DOWN
	DCA SALPN1	/FOR MULTIPLY
	TAD (BSHIP-BSHIPE /LENGTH
	STL RAR		/ DIVIDE BY 2
	DCA QCNT1	/NUMBER OF LOOPS
	TAD QXPOS	/SHIFT OVER NOW
	ASR;2		/TO FIT ON SCREEN
	DCA SALPTX
	TAD QYPOS	/AND THE SAME FOR Y
	ASR;2
	DCA SALPTY
	TAD QTIME
	DCA SALPN2	/FOR OTHER SCALE DOWN
SALPNL, TAD I QXR1	/GET AN X
	MULT
SALPN2,  0		/SCALE DOWN
	DCA SALPX	/STORE
	TAD I QXR1	/GET Y
	MULT
SALPN1,  0
	ASR;3
	DCA SALPY
	CDF D
	TAD SALPX
	TAD SALPTX
	DCA I DBUFP
	ISZ DBUFP
	TAD SALPY
	TAD SALPTY
	DCA I DBUFP
	ISZ DBUFP
	TAD SALPX
	TAD SALPTX
	DCA I DBUFP
	ISZ DBUFP
	TAD SALPY
	CIA
	TAD SALPTY
	DCA I DBUFP
	ISZ DBUFP
	TAD SALPX
	CIA
	TAD SALPTX
	DCA I DBUFP
	ISZ DBUFP
	TAD SALPY
	TAD SALPTY
	DCA I DBUFP
	ISZ DBUFP
	TAD SALPX
	CIA
	TAD SALPTX
	DCA I DBUFP
	ISZ DBUFP
	TAD SALPY
	CIA
	TAD SALPTY
	DCA I DBUFP
	ISZ DBUFP
	CDF 0
	ISZ QCNT1
	JMP SALPNL
	JMP I SAUC

SALPTX, 0
SALPTY, 0
SALPX,	0
SALPY,	0
/ROUTINE TO ADD TWO NUMBERS(REALLY!!!)
/CHECKING FOR SCOPE WRAP AROUND.
/TAKES TWO RETURNS DEPENDING ON WHETHER WRAP OCCURS
/FROM 3777 TO 4000 AND 4000 TO 3777.
/ALGORITHM:
/	1. ONLY HAVE TROUBLE IF ADDING NUMBERS OF SAME SIGN
/	2. IF SAME SIGN ARE OK IF LINK OVERFLOW MATCHES
/	   SIGN BIT.

/CALL:	TAD NUMB1	/MAIN NUMBER
/	JMS I (XADDD
/	 NUMB2		/INCREMENT
/	RET1		/RETURN IF WRAP AROUND
/	RET2		/NO WRAP.
/BOTH RETURNS ARE WITH AC=NUMB1+NUMB2

XADDD,	0
	DCA XADDD1	/STASH NUMB1
	TAD XADDD1	/GET BACK
	RAL		/SIGN BIT IN LINK
	CLA		/TO GET NUMB2
	TAD I XADDD	/GET NUMB2
	SPA		/SKIP IF NUMB2 POS
	CML		/NUMB2 NEG SO COMPLEMT LINK
	SZL		/SKIP IF SIGNS NOT THE SAME
	JMP XADDD2	/ALL OK.
	TAD XADDD1	/AC=NUMB1+NUMB2
	SPA		/SKIP IF RESULT POSITIVE
	CML		/RESULT NEG COMP LINK FOR TEST
	SNL		/SKIP IF WRAP OCCURRED
	ISZ XADDD	/TAKE SECOND RETURN
	ISZ XADDD	/UPDATE RETURN
	JMP I XADDD

XADDD2, TAD XADDD1
	ISZ XADDD
	ISZ XADDD
	JMP I XADDD

XADDD1, 0


/ROUTINE TO BOUNCE X

BOUNX,	0
	CLA CLL		/GET RID OF THE BAD QXPOS
	TAD QVX
	CIA
	DCA QVX
	ISZ BOUNX	/PAST DCA QXPOS
	JMP I BOUNX

/AND Y

BOUNY,	0
	CLA CLL		/GET RID OF THE BAD QYPOS
	TAD QVY
	CIA
	DCA QVY
	ISZ BOUNY	/PAST DCA QYPOS
	JMP I BOUNY

	PAGE
/TIME SCALE FACTOR LOOKUP ROUTINE
       
LOOKUP, 0
	SPA		/IF NEGATIVE,MAKE IT POSITIVE
	CIA
	LSR		/TAKE THE SPACE POINT
	4		/AND SCALE IT TO FIT
	TAD (TABLE	/INDEX INTO TABLE
	DCA OFFSET
	TAD I OFFSET
	JMP I LOOKUP
	OFFSET,0
   
   
/CURVED SPACE TABLE, 64 POINTS (HALF SCREEN)
  
	DECIMAL
TABLE,	2047;2047;2047;2047
	2047;2047;2047;2047
	2047;2047;2047;2047	/FLAT IN THE
	2047;2047;2047;2047	/CENTER
	2044;2040;2025;2010
	2000;1990;1970;1950;
	1925;1900;1875;1850;
	1820;1790;1750;1710
	1660;1610;1550;1500
	1387;1325;1212;1100
	1000;900;800;700
	625;550;500;450
	400;350;287;225
	185;150;125;100
	75;50;47;46		/IT LEVELS OUT
	45;45;45;45		/NEAR INFINITY
	45;45;45;45
	OCTAL

	PAGE
/THIS ROUTINE IS TO CALCULATE THE NEW POSITIONS
/AND VELOCITIES OF A POINT ON SCREEN UNDER THE
/INFLUENCE OF A THRUST AND GRAVITY.
/THE ALGORITHM IS WIERD, MAINLY BECAUSE I PROBABLY
/HAVE NOT FIGURED OUT THE GOOD WAY TO DO IT BUT, HERE
/IS HOW THE CALCULATION PROCEEDS:
/  1.	ACCELLERATION DUE TO GRAVITY IS CALCULATED VIA
/	THE ROUTINE GGRAV.  THIS ROUTINE SETS UP
/	QSINTH_SIN(TH)/R
/	QCOSTH_COS(TH)/R
/	AC_-QGRAV/R FROM LOOKUP TABLE
/	WHERE TH=ANGLE WITH SUN AND R=SQROOT(X^2+Y^2)
/  2.	NEW VALUES FOR THE COMPONENTS OF VELOCITY IS COMPUTED
/	FROM QVX_QVX+QTHR*COS(PH)-GRAV*SIN(TH)
/	     QVY_QVY+QTHR*SIN(PH)-GRAV*COS(TH)
/  3.	NEW VALUES OF X,Y ARE COMPUTED
/	QXPOS_QXPOS+QVX*(SCALE FACTOR)
/	QYPOS_QYPOS+QVY*(SCALE FACTOR)
/ALSO DOES WRAP-AROUND CHECKS AND BOUNCE IF ON.

NEWPOS, 0
	GGRAV		/GET GRAVITY VALUE
	DCA NEWPO1
	TAD NEWPO1
	DCA NEWPO2
	TAD QCOSTH
	MULT		/WE ARE DOING 1/R GRAVITY
NEWPO1,  0
	DCA NEWPO1
	TAD QTHR	/THRUST ON
	SNA		/SKIP IF ON
	JMP NEWPO3+1	/NO: DON'T CALCULATE
	DCA NEWPO3
	TAD QCOSPH
	MULT
NEWPO3,  0		/T*COS(PH)
	TAD NEWPO1	/T*COS(PH)+GRAVX
	TAD QVX		/+OLD VELOCITY COMP.
	DCA QVX
NEWPO6, TAD QSINTH
	MULT
NEWPO2,  0
	DCA NEWPO2
	TAD QTHR	/GET ROCKET THRUST
	SNA		/SKIP IF ON
	JMP NEWPO4+1	/NOT ON: SAVE TIME
	DCA NEWPO4
	TAD QSINPH
	MULT		/T*SIN(PH)
NEWPO4,  0
	TAD NEWPO2	/T*SIN(PH)+GRAVY
	TAD QVY		/+OLD VELOCITY COMPONENT
	DCA QVY		/SAVE.

	/NOW TO CALCULATE NEW X,Y

	SC=JMS SCALE	/OPTIONAL FLAT OR CURVED
	SC1=JMS I (SCALE1
	SC2=JMS I (SCALE2
NEWPO7, TAD QVX
	JMS SCALE	/SCALE IF REQUIRED
	DCA .+3		/FOR WRAP CHECK
	TAD QXPOS	/ADD OLD POSITION
	JMS I (XADDD	/ADD THEM
	 0
	JMS I BOUNCX	/BOUNCE X IF IMPLEMENTED
	DCA QXPOS	/UPDATE TO NEW POSITION
	TAD QVY		/GET Y VELOCITY
	JMS SCALE	/SCALE IF REQUIRED
	DCA .+3
	TAD QYPOS	/ADD OLD POSITION
	JMS I (XADDD
	 0
	JMS I BOUNCY	/BOUNCE IF IMPLEMENTED
	DCA QYPOS	/UPDATE POSITION.
	JMP I NEWPOS	/RETURN

	/AND NEW ANGLE PHI

ANGLES, 0
	TAD CONSER	/CHECK IF CONSERVING ANGULAR MOMENTUM
	SNA CLA		/SKIP IF YES
	JMP NEWPO5	/NO:
	TAD QTHA
	TAD QPHDOT
	JMP NEWPO8
NEWPO5, CAM		 /CLEAR MQ
	TAD QTHA
	SHL
	 3
NEWPO8, DCA QPHDOT
	TAD QPHDOT
	TAD QPHR
	DCA QPHR
	TAD QPHR
	ASR
	 3
	AND (377	/ALL THAT MATTERS
	DCA QPH		/TO NEW VALUE

	TAD QPH		/MAKE SINE AND COS
	SIN
	DCA QSINPH	/SAVE SINE
	TAD QPH
	COS
	DCA QCOSPH	/AND COS
	JMP I ANGLES	/AND RETURN


/ROUTINE TO SCALE VELOCITY

SCALE,	0
	DIVIDE
	 16
	NOP
	JMP I SCALE
  
  
	PAGE
/CURVED VELOCITY SCALER ROUTINES
/THE TIME SCALE FACTOR IS LOOKED UP AS
/A FUNCTION OF THE LARGER COMPONENT OF
/DISTANCE TO THE CENTER OF THE SHIP FROM
/MID-SCREEN.  X AND Y VELOCITY COMPONENTS
/ARE THEN SCALED BY HIS FACTOR.
   
SCALE1, 0		
	CLA CLL
	TAD QXPOS	/GET THE CENTER OFHE SHIP
	SPA		/IF NEGATIVE, MAKE IT POSITIVE
	CIA
	DCA COMPAR	/SAVE IT
	TAD QYPOS	/GET THE Y COMPONENT
	SMA		/MAKE SURE IT'S NEGATIVE
	CIA
	TAD COMPAR	/COMPARE IT WITH THE X COMP
	SNL CLA
	JMP .+4
	CLA		/IF QXPOS IS THE LARGER COMP
	TAD QXPOS	/THEN PUT IT IN HE AC
	JMP .+3		/AND JMP TO LOOKUP
	CLA		/OTHERWISE, PUT QYPOS IN AC
	TAD QYPOS
	JMS I (LOOKUP	/AMD JMP TO LOOKUP
	DCA QTIME	/SAVE THE TIME SCALE FACTOR
	TAD QTIME
	DCA TX		/SET IT UP FOR A MULT
	TAD QVX
	MULT		/MULTIPLY VELOCITY BY QTIME
TX,	0
	DIVIDE		/SCALE IT DOWN
	16
	NOP
	JMP I SCALE1
	COMPAR,0
   
SCALE2, 0
	CLA
	TAD QTIME	/GET THE SCALE FACTOR
	DCA TY
	TAD QVY		/GET THE Y VELOCITY
	MULT		/MULTIPLY IT BY QTIME
TY,	0
	DIVIDE		/SCALE IT DOWN
	16
	NOP
	JMP I SCALE2

/ROUTINE TO GET GRAVITY CONSTANT FOR CURRENT X,Y POSITION.
/IS TABLE LOOKUP ON X^2+Y^2 IN GRVTBL.

XGGRAV, 0
	JMS I (NEWPOL	/GET SIN(TH)/R ETC.
	TAD QR		/GET R^2
	LSR		/SCALE DOWN A LITTLE
	 2
	TAD (GRVTBL	/INDEX INTO TABLE
	DCA XSQUAR	/STORE FOR INDIRECT
	TAD I XSQUAR	/GET VALUE
	JMP I XGGRAV	/AND RETURN
XSQUAR, 0

/THIS ROUTINE IS TO CALCULATE THE GRAVITY TABLE
/TO BE USED BY XGGRAV.	THE LOOKUP IS VIA (X^2+Y^2)
/TO INDEX INTO THE TABLE.  THEREFORE THE TABLE
/IS STORED BY R^2 VALUE (128 POSITIONS BIG)

SETGRV, 0
	TAD (GRVTBL-1	/SET XR TO GRAVITY TABLE
	DCA QXR3	/FOR STORING
	DCA SETGR1	/IS R-SQUARE
	TAD (-177	/THIS MANY POINTS
	DCA QCNT3
	DCA I QXR3	/AS FIRST IS 0
SETGRL, ISZ SETGR1	/NEXT R-SQUARE
	TAD SETGR1
	JMS I (ROOT	/TAKE SQUARE ROOT
	DCA SETGRX	/FOR DIVIDE
	TAD QGRAV	/GET GRAVITY CONSTANT
	DIVIDE
SETGRX,  0
	NOP		/CAN'T GET DIVIDE BY 0
	CIA		/STORE NEGATIVE VALUES
	DCA I QXR3	/STASH IN TABLE
	ISZ QCNT3	/DONE?
	JMP SETGRL	/NO: CONTINUE
	JMP I SETGRV

SETGR1, 0

	PAGE
/THIS ROUTINE LOADS UP QSINTH AND QCOSTH
/WITH NUMBERS PROPORTIONAL TO SIN(TH)/R
/AND COS(TH)/R.  COUPLED WITH "GGRAV"
/WHICH LOOKS UP A VALUE PROPORTIONAL TO
/QGRAV/R RESULTS IN THE GRAVITY COMPONENTS
/THE CALCULATION USES EXTENDED PRESISION

NEWPOL, 0
	TAD QXPOS
	SPA
	CIA		/ABS VALUE OF X
	DCA NEWPL1
	TAD NEWPL1	/CALC X^2
	MQL		/LOAD MULTIPLICAND
	MUY		/USE EAE DIRECTLY
NEWPL1,  0
	DCA NEWPLH	/STASH HIGH ORDER X^2
	MQA		/GET LOW ORDER
	DCA NEWPLL	/SAVE FOR NOW
	TAD QYPOS	/GET Y
	SPA
	CIA		/TAKE ABS. VALUE
	DCA NEWPL6	/TO CALCULATE
	TAD NEWPL6	/Y^2
	MQL		/LOAD MULTIPLICAND
	MUY		/DO IT.
NEWPL6,  0
	TAD NEWPLH	/HAVE R^2 HIGH ORDER
	DCA NEWPLH
	CLL		/FOR CARRY
	MQA		/GET LOW ORDER
	TAD NEWPLL	/ADD LOW ORDER X^2
	MQL		/LOAD MQ FOR NORMALIZE
	RAL CLA		/CARRY BIT OVER
	TAD NEWPLH	/HIGH ORDER O.K.
	DCA QR		/SAVE FOR GGRAV
	TAD QR
	NMI		/NORMALIZE
	DCA NEWPL2	/STASH DIVISOR
	SCA		/GET STEP COUNTER
	TAD NEWPLS	/PLUS SCALE FACTOR
	DCA NEWPL4	/STASH FOR ASR
	MQL		/CLEAR MQ
	TAD NEWPL1	/NOW CALC SIN/R
	DVI
NEWPL2,  0
	CLA		/GET RID OF THE REMAINDER
	SHL		/SCALE DOWN
NEWPL4,  0
	DCA QCOSTH	/STASH SIN(TH)/R
	TAD QXPOS	/HOW ABOUT SIGN
	SMA CLA		/SKIP IF NEED TO NEGATE
	JMP .+4		/NOPE
	TAD QCOSTH	/YES:NEGATE
	CIA
	DCA QCOSTH
	TAD NEWPL2
	DCA NEWPL3	/COPY DIVISOR
	TAD NEWPL4
	DCA NEWPL5	/COPY SCALE FACTOR
	MQL		/CLEAR MQ
	TAD NEWPL6	/AND COS(TH)/R
	DVI
NEWPL3,  0
	CLA
	SHL		/AND SCALE UP
NEWPL5,  0
	DCA QSINTH
	TAD QYPOS	/WHAT ABOUT SIGN
	SMA CLA		/SKIP IF NEEDS NEGATING
	JMP I NEWPOL	/DONE
	TAD QSINTH
	CIA
	DCA QSINTH	/NEGATE IT
	JMP I NEWPOL

NEWPLH, 0
NEWPLL, 0
NEWPLS, 3

/TAKE SQUARE ROOT OF AC.
/MUST BE POSITIVE AND LESS THAN 200(8)
/INTEGER NEWTON'S METHOD

ROOT,	0
	CLL RAL;CLL RAL /SCALE FOR MORE PRECISION
	DCA ROOTN2	/SAVE SQUARE
	TAD (-4		/FOUR PASSES
	DCA ROOTT	/WILL HOME IN
	IAC		/START WITH A 1
	DCA ROOTL1	/FOR INITIAL GUESS
ROOTL,	TAD ROOTL1	/COPY ITTERATION FOR COMPARE
	DCA ROOTI	/IS LAST TRY
	TAD ROOTN2	/NOW TO CALCULATE
	DIVIDE		/X^2/XI
ROOTL1,  0
	NOP		/DIV BY ZERO
	TAD ROOTL1	/XI+X^2/XI
	CLL RAR		/1/2(XI+X^2/XI)
	DCA ROOTL1	/IS NEW VALUE
	ISZ ROOTT	/DO IT 4 TIMES
	JMP ROOTL
	TAD ROOTL1	/LATEST GUESS
	CLL RAR		/SCALE BACK DOWN
	SNA
	IAC		/NO ZERO'S
	JMP I ROOT

ROOTN2, 0
ROOTI,	0
ROOTT,	0

/ROUTINE TO PUT IN FLAME
/FOR NOW DISPLAY GENERATOR DOES NOT
/IF IN HYPERSPACE OR DEAD.

DFLAME, 0
	TAD QTHR	/TO SEE IF ON
	SNA CLA		/SKIP IF ON
	JMP I DFLAME
	TAD (FLAMEX
	DCA QSHIP	/FOR CALPNT
	RANDOM		/RANDOM LENGTH FLAME
	AND (16
	IAC;IAC		/ALWAYS DISP ONE
	DCA QSHIPN	/LENGTH
	DRAW	/PUT IN BUFFER
	JMP I DFLAME

	PAGE
/ROUTINE TO DISPLAY THE SUN

SUN,	0
	ISZ SUNCNT	/COUNTER FOR WHERE WE ARE
	NOP		/IN THE DISPLAY
	CAM		/CLEAR MQ
	TAD SUNCNT
	SHL
	 4		/MAX=32
	ASR		/PRESERVE SIGN
	 4
	DCA SUNCNT	/PRESERV FOR NEXT TIME
	TAD SUNCNT	/PICK UP
	AND (7770
	DCA SUNTMP
	RANDOM
	AND (7
	TAD SUNTMP
	SMA		/NEED NEGATIVE NUMBER
	CIA		/MAKE NEGATIVE
	RAL CLL		/PAIRS
	DCA .+3		/STORE -#PNTS
	TAD (SUNPT1-1	/ADDRESS OF PAIRS
	DISPLAY
	 0		/-#POINTS
	TAD .-1		/NOW FOR ALLONG X AXIS
	TAD (220	/COUNTER LENGTH
	CIA		/MAKE NEGATIVE
	DCA SUNL2	/SET UP OTHER HALF
	STA CLL RAL	/-2
	DCA SUNHLF	/HALVES

SUND2,	TAD (SUNPT2-1	/START FOR OTHER AXIS
	DISPLAY
SUNL2,	 0
	JMP I SUN

SUNL1,	CLA CLL
	TAD (SUNPT1-1	/DISPLAY ALL
	DISPLAY
	 -200
	TAD (SUNPT2-1
	DISPLAY
	 -200
	JMP I SUN

SUNCNT, 0
SUNTMP, 0
SUNHLF, -1
    
POLARS, 0		/DISPLAY ONLY POLARIS
	CLA
	RANDOM		/GET RANDOM NUMBER
	AND (37		/31 POINTS
	TAD (7740	/MAKE NEG
	DCA .+3
	TAD (BIGSUN-1
	DISPLAY
	BIGSUN-ESUN
	JMP I POLARS

	/PAGE
/FIRE A MISSEL
/BY PUTTING ANOTHER ONE IN MISTBL(POINTED TO BY MISPNT.
/ALSO RESETS ARMED.

FIRONE, 0
	TAD HYPERS
	SZA CLA
	JMP I FIRONE	/NOT IF IN HYPERSPACE
	TAD ALIVE
	SNA CLA
	JMP I FIRONE	/OR IF DEAD
	TAD ARMDLY	/DELAY FOR FIRING
	DCA ARMED	/RESET FOR PROPPER DELAY
	TAD MISCNT	/CHECK MISSLE COUNT THIS SHIP
	SNA CLA		/SKIP IF ANY LEFT
	JMP I FIRONE	/NO MISSELS LEFT
	ISZ MISCNT	/UPDATE NUMBER
	NOP		/MIGHT SKIP
	MQL		/CLEAR MQ
	TAD ARMDLY	/WILL ALLOW MAX OF 8 MISSELS
	SHL		/PER SHIP
	 2		/BY *10(8)
	DCA I MISPNT	/ALIVE FOR NEXT MISSLE
	ISZ MISPNT
	TAD QPH
	SIN		/GET SIN(PHI)
	DCA FSINPH
	TAD QPH
	COS		/AND COS(PHI)
	DCA FCOSPH
	TAD (300		/TO START IT
	MULT
FCOSPH,  0		/AT X POSITION
	TAD QXPOS	/START
	DCA I MISPNT	/STASH
	ISZ MISPNT
	TAD (300
	MULT		/MULTIPLY
FSINPH,  0		/SIN(PH)=Y COORD
	TAD QYPOS
	DCA I MISPNT	/STASH
	ISZ MISPNT	/POINT TO VELOCITIES
/AND CALCULATE STARTING VELOCITY
	TAD QTHROC	/GET MUSSEL VELOCITY
	DCA .+3		/FOR MULTIPLY
	TAD FCOSPH
	MULT
	 1000
	TAD QVX		/AND CALC STARTING Y VEL
	DCA I MISPNT	/STASH QVX
	ISZ MISPNT
	TAD QTHROC
	DCA .+3
	TAD FSINPH
	MULT
	 1000
	TAD QVY
	DCA I MISPNT	/STASH Y VEL
	ISZ MISPNT
	ISZ NUMMIS	/COUNT THE NUMBER OF LIVE MISS.
	JMP I FIRONE

ARMDLY, -20		/TIME DELAY BETWEEN FIREINGS


/GO INTO HYPERSPACE
HYPER,	0
	STA
	DCA HYPERS
	RANDOM		/COME OUT AT RANDOM POSITION
	DCA QXPOS
	RANDOM
	DCA QYPOS
	JMP I HYPER

	PAGE
MISTBL, ZBLOCK 22^5	/TABLE OF MISSELS
	/ORDER OF DATA IS

	/ALIVE
	/XPOS
	/YPOS	5 ENTRIES PER MIS.
	/VX
	/VY

/THERE ARE NUMMIS OF THEM

	PAGE
/SUBROUTINE TO UPDATE MISSELS

MISSLS, 0
	TAD NUMMIS	/GET NUMBER
	SNA		/SKIP IF THERE ARE ANY
	JMP I MISSLS	/NONE
	CIA		/NEGATE FOR COUTING
	DCA MISSCN	/-# TO DO
	TAD (-100
	DCA I (STOVER	/STILL SOME STUFF
	DCA NNUMMIS	/START WITH 0 LEFT (UPDATED BY PUTMIS)
	DCA QTHR	/MEANINGLESS
	DCA QTHA	/MEANINGLESS
	TAD (MISTBL
	DCA MISSIN	/POINTER INTO TABLE
	TAD MISSIN
	DCA MISPNT	/AND POINTER OUT
MISSL1, JMS GETMIS	/GET A MISSLE
	NXTPOS		/CALC NEW POSITION

/CHECK FOR HIT
	JMS I (COLID1	/COLLISION SHIP1
	JMS I (BANG	/EXPLOSION
	JMS I (COLID2	/COLLISION SHIP2
	JMS I (BANG	/EXPLOSION

	JMS MISSUB	/LOAD THE DISPLAY BUFFER
	ISZ MISSCNT	/MORE?
	JMP MISSL1	/YEP
	TAD NNUMMIS
	DCA NUMMIS
	JMP I MISSLS	/NO: DONE

MISSCN, 0
MISSIN, 0
MISST1, 0
MISST2, 0

/SUBROUTINE TO LOAD UP DISPLAY BUFFER

MISSUB, 0
	TAD QXPOS	/LOAD UP DISPLAY BUFFER
	ASR		/SHIFT FOR GOOD POS
	 2
	CDF D
	DCA MISST1	/SO CAN MAKE 2 COPYS
	TAD MISST1
	DCA I DBUFP	/LOAD X
	ISZ DBUFP
	TAD QYPOS
	CDF 0		/VRS: Don't emulate EAE with DF set
	ASR
	 2
	CDF D		/VRS: Don't emulate EAE with DF set
	DCA MISST2	/SO CAN MAKE 2 COPYS
	TAD MISST2
	DCA I DBUFP	/LOAD Y
	ISZ DBUFP
	TAD MISST1	/ANOTHER COPY
	DCA I DBUFP
	ISZ DBUFP
	TAD MISST2
	DCA I DBUFP
	ISZ DBUFP
	CDF 0		/BACK TO THIS FIELD
	TAD ALIVE
	SNA CLA
	JMP .+3
	ISZ ALIVE	/CHECK IF TIME HAS RUN OUT
	JMS PUTMIS	/NO-STILL ALIVE
	JMP I MISSUB


/GET SOME MISSEL DATA

GETMIS, 0
	TAD (ALIVE-1
	DCA QXR1
	TAD (-5
	DCA QCNT1
	TAD I MISSIN
	DCA I QXR1
	ISZ MISSIN
	ISZ QCNT1
	JMP .-4
	JMP I GETMIS

/ROUTINE TO COPY MISSEL DATA BACK.

PUTMIS, 0
	ISZ NNUMMIS	/COUNT THE MISSEL
	TAD (ALIVE-1
	DCA QXR1
	TAD (-5
	DCA QCNT1
	TAD I QXR1
	DCA I MISPNT
	ISZ MISPNT
	ISZ QCNT1
	JMP .-4
	JMP I PUTMIS

/SUBROUTINE TO CALC NEXT POSSITION IN SHIP BREAKUP

SCATTE, 0
	TAD BREAKU	/MAKE SURE SOME LEFT
	SNA		/SKIP IF DONE
	JMP I SCATTE	/NONE LEFT
	DCA MISSCN	/COUNT THEM
	DCA NNUMMIS	/CLEAR # LEFT
	DCA QTHR	/THRUST IS OFF
	DCA QTHA	/NO ANGLES OF COURSE
	TAD (SCATBL	/TABLE OF PIECES
	DCA MISSIN	/STORE IN POINTER
	TAD MISPNT	/SAVE MISSLE POINTER
	DCA SCATTMP
	TAD (SCATBL	/INIT OUT POINTER
	DCA MISPNT	/TO POINT TO PIECES
	JMS GETMIS	/PUT ONE IN PAGE ZERO
	NXTPOS		/UPDATE POSITION
	JMS MISSUB	/DO DISPLAY BUFFER STUFF
	ISZ MISSCNT	/DONE?
	JMP .-4		/NOT YET
	TAD SCATTMP	/YEP. RESTORE MISPNT
	DCA MISPNT
	TAD NNUMMIS	/NUMBER OF PIECES LEFT
	CIA		/STORE NEGATIVE
	DCA BREAKUP	/IN FLAG WORD
	JMP I SCATTER

SCATTM, 0		/SAVE MISPNT

	PAGE
/ROUTINES TO CHECK FOR COLLISIONS.
/COLIDE - CHECKS FOR COLLSION WITH SUN.
/COLID1 - CHECKS FOR SHIP1
/COLID2 - CHECKS FOR SHIP2
/NOTE THAT COLID1 AND COLID2 ALSO CHECK FOR COLLISION
/WITH SUN, BUT DO NOT TAKE EXPLODE EXIT.
/THIS IS SO MISSELS MAY BE ROMOVED WITHOUT EXPLOSION.
/THE ROUTINES DEADIFY THE APPROPRIATE JOBY.
/CALL:	JMS COLIDE
/	 HIT SOMETHING
/	 NORMAL EXIT

COLIDE, 0
	TAD QXPOS	/CHECK X
	JMS COLIDS	/FOR <128
	SKP		/A POSSIBILITY
	JMP COLLD4	/O.K.
	TAD QYPOS
	JMS COLIDS
	JMP COLLD1
COLLD4, ISZ COLIDE
	JMP I COLIDE	/ALL OK
COLLD1, DCA ALIVE	/KILL IT
	JMP I COLIDE	/AND TAKE FIRST EXIT


/SUBROUTINE TO CHECK ABSOLUTE VALUE
/OF AC<128

COLIDS, 0
	SPA
	CIA
	AND (7600
	SZA CLA
	ISZ COLIDS
	JMP I COLIDS

/CHECK FOR COLLISION WITH SHIP1 AND SUN

COLID1, 0
	JMS COLIDE	/CHECK SUN FIRST
	JMP I COLID1
	TAD I (SHIP1+ALIVE-QR
	SNA CLA		/SKIP IF ALIVE
	JMP COLLD5	/NO
	TAD I (SHIP1+HYPERS-QR
	SZA CLA		/SKIP IF NOT IN HYPERSPACE
	JMP COLLD5	/IS IN HYPER.
	TAD QXPOS
	CIA
	TAD I (SHIP1X
	JMS COLIDS
	SKP
	JMP COLLD5
	TAD QYPOS
	CIA
	TAD I (SHIP1Y
	JMS COLIDS
	JMP COLLD2
COLLD5, ISZ COLID1	/NO COLLISION
	JMP I COLID1
COLLD2, DCA ALIVE	/KILL CURRENT MISSEL ETC.
	DCA I (SHIP1+ALIVE-QR /AND SHIP1
	JMP I COLID1

/COLLISION WITH SHIP2

COLID2, 0
	JMS COLIDE	/CHECK SUN
	JMP I COLID2
	TAD I (SHIP2+ALIVE-QR
	SNA CLA		/SKIP IF ALIVE
	JMP COLLD6
	TAD I (SHIP2+HYPERS-QR
	SZA CLA		/SKIP IF NOT IN HYPERSPACE
	JMP COLLD6	/IS SO IGNORE
	TAD QXPOS
	CIA
	TAD I (SHIP2X
	JMS COLIDS
	SKP
	JMP COLLD6
	TAD QYPOS
	CIA
	TAD I (SHIP2Y
	JMS COLIDS
	JMP COLLD3
COLLD6, ISZ COLID2
	JMP I COLID2
COLLD3, DCA ALIVE
	DCA I (SHIP2+ALIVE-QR
	JMP I COLID2

/ROUTINE TO SET UP PIECES OF SHIP AFTER
/A COLLISION.

BANG,	0
	TAD (BRKTBL-1
	DCA QXR1	/POINT TO PIECES TABLE
	TAD (SCATBL-1	/AND DESTINATION TABLE
	DCA QXR2	/FOR INTIAL CONDITIONS
	TAD (-20	/8 PIECES FOR NOW
	DCA QCNT1	/TO PUT IN
BANGL1, TAD I QXR1	/PICK UP LIFETIME
	DCA I QXR2	/PUT IN TABLE
	TAD I QXR1	/X-POSITION
	TAD QXPOS	/MOVE TO WHERE SHIP IS
	DCA I QXR2	/PUT AWAY
	TAD I QXR1	/AND Y-POSITION
	TAD QYPOS	/MOVE TO WHERE IT SHOULD BE
	DCA I QXR2	/STASH
	TAD I QXR1	/PICK UP A VELOCITY COMP
	TAD QVX		/AND ADD INTIAL VELOCITY
	DCA I QXR2	/STASH
	TAD I QXR1	/AND Y-VELOCITY
	TAD QVY
	DCA I QXR2	/STASH
	ISZ QCNT1	/DONE?
	JMP BANGL1	/NOT YET
	TAD (-20	/INITIALIZE BREAKUP
	DCA BREAKUP	/ALSO IS # ENTRIES
	JMP I BANG	/AND RETURN

	PAGE
BRKTBL, -40;0;0;0;0
	-40;50;0;20;0
	-40;0;50;0;20
	-34;20;20;20;20
	-34;-20;-20;-20;-20
	-30;20;-20;-20;0
	-30;-20;20;0;-20
	-30;0;0;40;40
	-24;0;0;0;20
	-24;0;0;20;0
	-24;0;0;0;-20
	-24;0;0;-20;0
	-20;20;0;10;10
	-20;0;20;10;-10
	-20;-20;0;-10;10
	-20;0;-20;-10;-10

SCATBL, ZBLOCK 21^5

	PAGE
SPCWAR, IOF		/RE-INITIALIZE ALL
	TAD (SHIP1-1
	ONDECK		/GET SHIP1 DATA
	JMS STARTU
	TAD (SHIP1-1
	OFDECK		/COPY OUT
	TAD (SHIP2-1
	ONDECK		/GET SHIP2 INFO
	JMS STARTU	/INITIALIZE
	TAD (-2500
	DCA QXPOS	/START #2 ON OTHER SIDE
	TAD (SHIP2-1
	OFDECK		/COPY OUT
	TAD (MISTBL
	DCA MISPNT	/INITIALIZE MISSELS
	DCA NUMMIS	/NONE TO START
	JMS I (STCLK	/START CLOCK UP
	ION
	JMP I (WAR-2



/INITIALIZE PARAMETERS

STARTU, 0
	DCA QVX		/START WITH NO VELOCITY
	DCA QVY		/IN EITHER DIRECTION
	TAD (2500	/AT THIS X
	DCA QXPOS	/ABOUT 2/3 OUT
	RANDOM		/AND RANDOM Y
	DCA QYPOS	/Y POSITION RANDOM
	DCA QPHDOT	/NO ROTATION
	RANDOM		/AND RANDOM ANGLE
	AND (277	/MASK FOR GOOD ANGLE
	DCA QPH
	IAC
	DCA ALIVE	/MAKE IT ALIVE
	DCA SHIELD	/SHIELDS NOT ON
	DCA HYPERS	/NOT IN HYPERSPACE.
	DCA BREAKU	/NOT BREAKING UP
	TAD MAXMIS	/# MISSELS/SHIP
	DCA MISCNT	/ALLOWED
	DCA ARMED	/START OUT ARMED
	JMS I (SETGRV	/CALC GRAVITY TABLE
	JMP I STARTUP

	PAGE
/THIS IS THE MAJOR CONTROL

	STA
	DCA I (SUNHLF	/LET'S NOT HAVE TROUBLE WITH THIS
WAR,	TAD (DISBUF+2	/FOR NOW INTIALIZE
	DCA DBUFP	/DISPLAY BUFFER POINTER
	CDF D
	DCA I (DISBUF
	DCA I (DISBUF+1
	CDF 0
	TAD (SHIP1-1
	ONDECK		/START OUT WITH SHIP1
	TAD ALIVE	/NOW TO SEE IF HE EXISTS
	SNA CLA		/SKIP IF ALIVE
	JMP WARS2	/NOPE:GO TO SHIP2
	TAD (-100
	DCA STOVER	/SOMEONE STILL ALIVE
	LAS		/GET SWITCHES
IFDEF M1703 <
	6144		/VRS: USE M1703 INPUT
>
	JMS I (WARSUB	/DO THE CALCS
	TAD HYPERS
	SZA CLA		/SKIP IF NOT IN HYPERSPACE
	JMP WAR1E	/IGNORE CHECKING
	JMS I (COLIDE	/CHECK FOR COLLISION WITH SUN
	JMS I (BANG	/START EXPLOSION
WAR1E,	TAD (SHIP1-1
	OFDECK
	FLAME		/DISPLAY FLAME

/NOW FOR SHIP2

WARS2,	TAD (SHIP2-1
	ONDECK		/NOW DO SHIP 2
	TAD ALIVE	/NOW TO SEE IF HE EXISTS
	SNA CLA		/SKIP IF ALIVE
	JMP WARS3	/NOPE:GO TO SHIP2
	TAD (-100
	DCA STOVER	/SOMEONE STILL ALIVE
	LAS		/GET SWITCHES
IFDEF M1703 <
	6144		/ USE M1703 INPUT
>
	LSR;7		/OVER FOR WARSUB
	JMS I (WARSUB	/DO THE CALCULATIONS
	TAD HYPERS
	SZA CLA		/SKIP IF NOT IN HYPERSPACE
	JMP WAR2E	/NO MORE CHECKING
	JMS I (COLIDE	/COLLISION WITH SUN FIRST
	SKP
	JMS I (COLID1	/CHECK COLLISIONS
	JMS I (BANG	/START THE EXPLOSION
WAR2E,	TAD (SHIP2-1
	OFDECK
	FLAME

/NOW FOR THE MISSLES

WARS3,	IOF
	JMS I (MISSLS	/INTERRUPTS CAN BOMB HERE
	ION

/AND ANY BREAKUP

	TAD BREAKUP
	SZA CLA		/SKIP IF ANY
	JMS I (SCATTER	/DO IT

/NOW TO DISPLAY IT

WARDIS, TAD DBUFP
	CIA
	TAD (DISBUF
	IOF		/NO INTS IN LINC MODE
	DCA WARDX	/FOR DISPLAY ROUTINE
	TAD (DISBUF-1
	DISPLAY
WARDX,	  0
	D1=DSUN
	D2=DSTARS
	DSUN		/DISPLAY THE UNIVERSE OR SUN
	ION
	ISZ STOVER	/DELAY FOR AUTO RESTART
	SKP
	JMP I (SPCWAR	/START OVER
	IFNZRO FCLOCK+KW12+AX08+DK8EA+DK8EP <
	TAD WAIT
	SNA CLA
	JMP .-2
	DCA WAIT>
	JMP WAR

WAIT,	0		/-1 WHEN READY
			/SET BY INTERRUPT ROUTINE
STOVER, 0		/DELAY FOR AUTO RESTART


	PAGE
/SUBROUTINE TO DO ALL OF THE SHIP CALCULATIONS.
/ENTER WITH BITS SET ACCORDING TO OPTIONS

WARSUB, 0
	DCA I (SWITCHES
	TAD I (SWITCHES
	RAR		/ROCKET BIT TO LINK
	SZL CLA		/SKIP IF NOT ON
	TAD QTHRUST	/COPY THRUST INTO QTHR
	DCA QTHR	/IF ROCKETS ON
	DCA HYPERS	/TAKE OUT OF HYPERSPACE
	TAD I (SWITCHES
	AND (6		/MASK ROT BITS
	SNA		/SKIP IF ANY ON
	JMP WAR1
	DCA QTM1	/SAVE
	TAD QTM1
	TAD (-6		/TO SEE IF HYPERSPACE
	SNA CLA		/SKIP IF NOT HYPERSPACE
	JMS I (HYPER	/GO INTO HYPERSPACE
	TAD HYPERS	/IF IN HYPERSPACE DON'T DO
	SZA CLA		/THE CALCULATIONS
	JMP I WARSUB
	TAD QTM1
	RTR		/GET CLOCKWISE INTO LINK
	CLA		/GET RID OF OTHER BIT
	TAD QRET	/RETRO CONSTANT
	SNL		/SKIP IF CC
	CIA
WAR1,	DCA QTHA	/SET RETRO THRUST
	TAD ARMED	/TO SEE IF ALREADY ARMED
	SNA CLA		/SKIP IF NOT YET
	JMP .+3		/ALREADY ARMED
	ISZ ARMED	/UPDATE TIME DELAY
	JMP WAR2	/NOT ARMED.
	TAD I (SWITCHES    /IS ARMED SO CHECK
	AND (10		/FIRE BIT.
	SZA CLA		/SKIP IF NOT FIRING
	FIRE		/FIRE A MISSLE.
WAR2,	NXTPOS		/CALC NEW POSITION
	NXTANG		/AND SHIP ANGLE
	DRAW		/SET DISPLAY BUFFER
PSAUC1, JMS I (SAUC	/OR NOP FOR SHIPS
	JMP I WARSUB

	PAGE
/COME HERE FROM INTERRUPT

SAVAC,	0
SAVLK,	0

INTRPT, DCA SAVAC	/SAVE ACCUMULATOR
	RAR
	DCA SAVLK	/AND LINK
	KSF		/KEYBOARD?
	JMP .+4
	KRB		/READ THE CHAR
	DCA ICHAR	/STORE
	JMP I OPTIONS
	TSF		/TELEPRINTER
	JMP CLKINT	/NO CHECK CLOCK
	TCF		/CLEAR THAT FLAG
	DCA TELSW	/SET NOT IN PROGRESS SWITCH
	JMP I OPTIONS

TELSW,	0
ICHAR,	0
DELAY1, 0

CLKINT,
	IFNZRO KW12+DK8EP <
	CLSK		/SKIP IF CLOCK
	JMP INTEXT	/QUIT (UNDEFINED INT?)
	CLSA		/CLEAR THE FLAGS
	>
	IFNZRO FCLOCK <
	6131		/SKIP IF NOT FLAG
	SKP
	JMP INTEXT	/NOPE
	6132		/RECONNECT TO INT
	>
	IFNZRO DK8EA <
	6133		/SKIP ON CLOCK
	JMP INTEXT	/NOPE
	6131		/MAKE SURE INT STILL ENABLED
	ISZ DELAY1	/WANT 30/SEC
	JMP INTEXT	/NOPE: NEXT TIME
	CLL STA RTL	/-2
	DCA DELAY1	/RESET DELAY1
	>
	IFNZRO AX08 <
	6321		/SKIP IF CLOCK
	JMP INTEXT	/WHO???
	6352		/CLEAR CLOCK
	ISZ DELAY1
	JMP INTEXT	/NOT YET
	TAD CLKLIM	/RESET INTRPS
	DCA DELAY1	/DELAY INTERVAL
	>

	STA		/AND SET WAITING
	DCA I (WAIT

INTEXT, 6402		/LINK
	6412
	IFNZRO T30G <6161;NOP>
	CLA CLL
	TAD SAVLK	/GET LINK
	RAL CLL
	TAD SAVAC	/AND AC.
	RMF		/RESTORE FIELDS
	ION		/AND RESTOR INTERRUPTS
	JMP I 0		/RETURN TO PROGRAM

/GO BACK TO SPCWAR

OPTION, KBOARD
	JMP INTEXT

	IFNZRO KW12+DK8EP <
/SUBROUTINE TO START UP CLOCK
/MAY BE HARDWARE DEPENDENT
/THIS IS FOR KW12A CLOCK - PDP12
/OR PROGRAMABLE PDP8E CLOCK DK8EP
	CLSK=6131	/SKIP IF CLOCK
	CLLR=6132	/LOAD CONTROL
	CLAB=6133	/AC TO BUFFER PRESET
	CLEN=6134	/LOAD ENABLE
	CLSA=6135	/BIT RESET FLAGS

STCLK,	0
	CLA CLL		/JUST IN CASE
IFNZRO PDP12 <CLLR	/STOP CLOCK
	CLEN		/CLEAR INTERRUPTS
	>
	TAD (-40	/ABOUT 30CPS
	CLAB		/LOAD PRSET
	CLA CLL
	IFNZRO PDP12 <
	TAD (0100	/1KC - PRESET TIME
	CLLR		/LOAD CONTROL
	CLSA		/CLEAR STATUS AND POSSIBLE OVERFLOW
	CLA CLL
	TAD (300	/INTERRUPT ON OVERFLOW
	CLEN
	CLA CLL
	TAD (4100	/AND START UP CLOCK
	>
	IFNZRO DK8EP <
	/TAD (5300	/INTR ON CLOCK - 1KC
	TAD (5310	/INTR ON CLOCK - 1KC (Josh Dersch)
	>
	CLLR
	CLA CLL
	JMP I STCLK>

	IFNZRO FCLOCK <
/DYER'S FUNNY CLOCK

STCLK,	0
	6132
	JMP I STCLK>

	IFNZRO DK8EA <
/DK8EA (LINE CLOCK)

STCLK,	0
	CLL STA RTL	/-2
	DCA DELAY1	/RESET DELAY1
	6131		/ENABLE INTERRUPTS
	JMP I STCLK>

	IFNZRO AX08 <
STCLK,	0
	CLA CLL
	TAD (400
	6346		/START CRYSTAL CLOCK
	TAD CLKLIM	/INITIALIZE CLOCK
	DCA DELAY1
	JMP I STCLK

CLKLIM, 7400
>

	IFZERO KW12+AX08+FCLOCK+DK8EA+DK8EP <
STCLK,	0
	JMP I STCLK>

	PAGE
KBOARD, JMS GETC	/GET THE CHAR
	JMS DISPCH	/DISPATCH ON CHAR
	-"P;OPHLAT
	-"C;OCURVE
	 -"F;OSTARS	/FIELD OF STARS
	 -"Z;OSUN	/POLARIS ONLY
	 -"B;OBOUNCE	/BOUNCE MODE
	 -"W;OWRAP	/WRAP AROUND
	 -"A;OANGUL	/ANGULAR MOMENT CONSERVE
	 -"N;ONORM	/NO ANG MOM CONS.
	 -"G;OGRAV	/RESET GRAVITY
	 -"M;OMISSL	/RESET NUMB MISSLES
	 -"R;ORETRO	/RESET RETRO CONSTANT
	 -"T;OTHRUS	/RESET THRUST CONSTANT
	 -"S;OSHIPS	/DISPLAY SHIPS
	 -"V;OVELOC	/MUSSEL VELOCITY OF MISSILES
	 -"U;OUFO	/DISPLAY UFO'S
	 -"O;OOPTION	/LIST OPTIONS
	 -203;7600	/^C RETURN TO MONITOR
	 0		/END OF LIST
	JMP I (SPCWAR	/START OVER


/DISPATCH ON ACCUMULATOR

DISPCH, 0
	DCA OTM1	/TEMP STASH
	TAD I DISPCH	/GET COMPARISON
	ISZ DISPCH
	SNA		/0 MEANS DONE
	JMP I DISPCH	/NOT IN LIST
	TAD OTM1	/CHECK AGAINST CAHR
	SNA CLA		/SKIP IF NO MATCH
	JMP .+3		/MATCH
	ISZ DISPCH	/TO NEXT CHAR
	JMP DISPCH+2	/CONTINUE
	TAD I DISPCH	/FOUND IT
	DCA DISPCH	/DO DOUBLE INDIRECT
	JMP I DISPCH

OTM1,	0


/PRINT A MESSAGE

PRMSG,	0
	TAD I PRMSG	/GET ADD OF MESSAGE
	DCA OTM1	/STORE POINTER
	ISZ PRMSG	/NORMAL EXIT
PRST1,	TAD I OTM1
	RTR;RTR;RTR	/OVER FOR PRINT
	JMS PRCHR	/PRINT LEFT HALF
	TAD I OTM1
	JMS PRCHR	/PRINT RIGHT HALF
	ISZ OTM1	/NEXT WORD
	JMP PRST1	/LOOP

PRCHR,	0
	AND (77
	SNA
	JMP I PRMSG	/IF ZERO QUIT
	TAD (-40	/FOR EXTEND
	SPA		/SKIP IF NEUMERIC
	TAD (100	/IS ALPHA
	TAD (240	/BACK TO CORRECT
	JMS PCH /PRINT ROUTINE
	JMP I PRCHR


/PRINT A CHARACTER ROUTINE

PCH,	0
	TLS		/OUTPUT IT
	DCA I (TELSW	/SET TTY INPROGRESS
	JMS I (OPTIONS	/AND WAIT TILL FINISHED
	TAD I (TELSW	/KEYBOARD INTERRUPT
	SZA
	JMP .-3		/NOT YET
	JMP I PCH	/DONE.

/GET AN INPUT CHARACTER

GETC,	0
	TAD I (ICHAR	/FROM INTERRUPT SERVICE
	SZA		/GOT ONE?
	JMP .+3		/YEP
	JMS I (OPTIONS	/WAIT SOME MORE
	JMP GETC+1
	DCA CHAR
	DCA I (ICHAR
	TAD CHAR
	JMP I GETC	/AND RETURN WITH CHAR

CHAR,	0

CRLF,	0
	TAD (215
	JMS PCH
	TAD (212
	JMS PCH
	JMP I CRLF

REINITIALIZE,	JMS I (OPTIONS
	JMP KBOARD

/TURN ON BOUNCE

OBOUNC, TAD (BOUNX
	DCA BOUNCX
	TAD (BOUNY
	DCA BOUNCY
	JMS PRMSG	/TELL HIME
	 MBOUNC
	JMS CRLF
	JMP REINIT

	PAGE
/ROUTINE TO DISABLE BOUNCE

OWRAP,	TAD (NULL
	DCA BOUNCX
	TAD (NULL
	DCA BOUNCY
	JMS I (PRMSG
	 MWRAP
	JMS I (CRLF
	JMP I (REINIT

/ROUTINE TO CONSERVE ANGULAR MOM

OANGUL, CLA IAC
	DCA CONSER
	JMS I (PRMSG
	 MANGCON
	JMS I (CRLF
	JMP I (REINIT

ONORM,	DCA CONSER
	JMS I (PRMSG
	 MNORMAL
	JMS I (CRLF
	JMP I (REINIT

/ROUTINE TO INPUT AN OCTAL NUMBER FROM THE KEYBOARD.
/CALL:	JMS OCTAL
/	 RET1		/NO INPUT
/	 RET2		/AC=OCTAL NUMBER

OCTALX, 0
	DCA NUMB
	DCA INPUT
OCTALL, JMS I (GETC
	JMS I (PCH	/AND PRINT IT
	TAD I (CHAR
	TAD (-"8
	SMA		/SKIP IF <"8
	JMP NUMBEX	/EXIT
	TAD ("8-"0	/NOW CHECK FOR OCTAL
	SPA		/SKIP IF OK
	JMP NUMBEX	/NO=QUIT
	DCA INPUT	/SAVE NUMBER
	TAD NUMB	/GET LAST NUMBER
	CLL RAL;CLL RAL;CLL RAL
	TAD INPUT	/STICK IN NEW NUMBER
	DCA NUMB
	ISZ INPUT	/MAKE SURE NON-ZERO
	JMP OCTALL
NUMBEX, CLA CLL
	TAD INPUT	/TO SEE IF ANY
	SZA CLA
	ISZ OCTALX	/TAKE YES RETURN
	JMS I (CRLF
	TAD NUMB	/STICK NUMBER IN AC
	JMP I OCTALX	/AND RETURN

NUMB,	0
INPUT,	0


OGRAV,	JMS I (PRMSG	/TELL HIM WHAT OPTION IS
	 MGRAVY
	JMS OCTALX	/GET NEW VALUE
	JMP I (REINIT	/NO INPUT
	DCA QGRAV	/SET VALUE
	TAD (KBOARD	/REINITIALIZE
	DCA I (OPTIONS
	JMS I (SETGRV	/SET UP TABLE
	TAD QGRAV	/NOW TO SEE IF ANTI-GRAV.
	SMA CLA		/SKIP IF YES
	JMP I (WAR-2
	JMS I (PRMSG
	 MAGRAV		/ANTI GRAVITY
	JMS I (CRLF
	TAD (KBOARD
	DCA I (OPTIONS
	JMP I (WAR-2

OMISSL, JMS I (PRMSG
	 MMISSLS
	JMS OCTALX	/GET A NUMBER
	JMP I (REINIT
	CIA		/SET MISSEL CONSTANT
	DCA MAXMIS	/SET CONSTANT
	JMP I (REINIT	/DONE

/ROUTINE TO READJUST THRUST

OTHRUS, JMS I (PRMSG
	 MTHRUS
	JMS OCTALX
	JMP I (REINIT
	CLL RTL
	DCA QTHRUS
	JMP I (REINIT

/ROUTINE TO SET RETRO CONSTANT

ORETRO, JMS I (PRMSG
	 MRETRO
	JMS OCTALX
	JMP I (REINIT
	DCA QRET
	JMP I (REINIT

/ROUTINE TO PRINT LOTS OF MESSAGES

MMESG,	0
	JMS I (CRLF	/NEW LINE
	TAD I MMESG	/GET START OF MESSAGE
	SNA		/SKIP IF MORE TO COME
	JMP I MMESG
	DCA .+2
	JMS I (PRMSG	/PRINT IT
	 0
	ISZ MMESG	/NEXT LINE
	JMP MMESG+1	/MORE

/PRINT OPTIONS

	PAGE
OOPTIO, JMS I (MMESG
	 MOPTA
	 MOPTB
	 MOPTBA
	 MOPTC
	 MOPTD
	 MOPTE
	 MOPTF
	 MCURVE
	 MPHLAT
	 MSTARS
	 MSUN
	 MBOUNC
	 MWRAP
	 MANGCO
	 MNORMA
	 MMISSL
	 MTHRUS
	 MRETRO
	 MVELOX
	 0
	JMP I (REINIT

/DISPLAY SAUCERS (UFO'S)

OUFO,	JMS I (PRMSG
	 MUFO
	JMS I (CRLF
	TAD (JMS I PSAUCP
	DCA I (PSAUC1
	TAD (NOP
	DCA I (PSAUC2
	TAD (SAUC1
	DCA I (SHIP1+QSHIP-QR
	TAD (SAUC1E-SAUC1
	DCA I (SHIP1+QSHIPN-QR
	TAD (SAUC2
	DCA I (SHIP2+QSHIP-QR
	TAD (SAUC2E-SAUC2
	DCA I (SHIP2+QSHIPN-QR
OUFOR,	TAD (KBOARD
	DCA I (OPTIONS
	JMP I (WAR-2

/DISPLAY SHIPS

OSHIPS, JMS I (PRMSG
	 MSHIPS
	JMS I (CRLF
	TAD OSHIPJ
	DCA I (PSAUC2
	TAD (NOP
	DCA I (PSAUC1
	TAD (SHIP1C
	DCA I (SHIP1+QSHIP-QR
	TAD (SHIP1E-SHIP1C
	DCA I (SHIP1+QSHIPN-QR
	TAD (SHIP2C
	DCA I (SHIP2+QSHIP-QR
	TAD (SHIP2E-SHIP2C
	DCA I (SHIP2+QSHIPN-QR
	JMP OUFOR

OSHIPJ, PSAUC2+3&177+5200


	PAGE
/RESET MUSSEL VELOCITY OF ROCKETS

OVELOC, JMS I (PRMSG
	 MVELOX
	JMS I (OCTALX
	JMP I (REINIT
	CLL RAR
	DCA QTHROC	/RESET MUSSLE VELOCITY
	JMP I (REINIT
  
/SELECT FLAT OR CURVED SPACE
  
OPHLAT, JMS I (PRMSG
	MPHLAT
	JMS I (CRLF
	CLA
	TAD (3777
	DCA QTIME	/NO TIME CURVE ON OUTLINE
	TAD (SC
	DCA I (NEWPO7+1
	TAD (SC
	DCA I (NEWPO7+11
	JMP I (REINIT
  
OCURVE, JMS I (PRMSG
	MCURVE
	JMS I (CRLF
	CLA
	TAD (SC1
	DCA I (NEWPO7+1
	TAD (SC2
	DCA I (NEWPO7+11
	JMP I (REINIT
  
/DISPLAY OPTIONAL SUN OR UNIVERSE
 
OSTARS, JMS I (PRMSG
	MSTARS
	JMS I (CRLF
	CLA
	TAD (D2
	DCA I (WARDX+1
	JMP I (REINIT

OSUN,	JMS I (PRMSG
	MSUN
	JMS I (CRLF
	CLA
	TAD (D1
	DCA I (WARDX+1
	JMP I (REINIT

	PAGE
MVELOX, TEXT \VELOCITY INITIAL OF MISSLES(2000):\
MOPTA,	TEXT \OPTIONS ARE DESIGNATED BY FIRST CHARACTER\
MOPTB,	TEXT \THE NUMBER IN PARENS ARE "NORMAL" VALUES\
MOPTBA, TEXT \INPUT NUMBERS ARE OCTAL\
MOPTC,	TEXT \AVAILABLE OPTIONS ARE:\
MOPTD,	TEXT \U DISPLAY UFO'S\
MOPTE,	TEXT \S DISPLAY SHIPS\
MSUN,	TEXT 'Z POLARIS ONLY'
MOPTF,	TEXT \G RESET GRAVITY CONSTANT(1000)\
MUFO,	TEXT \DISPLAY UFO'S\
MSHIPS, TEXT \DISPLAY SHIPS\
MCURVE, TEXT 'CURVED SPACE'
MPHLAT, TEXT 'PHLAT SPACE'
MSTARS,  TEXT 'FIELD OF STARS'
MBOUNC, TEXT \BOUNCE ON\
MWRAP,	TEXT \WRAP-AROUND ON\
MANGCO, TEXT \ANGULAR MOMENTUM\
MNORMA, TEXT \NON-ANGULAR MOMENTUM\
MGRAVY, TEXT \STRENGTH OF GRAVITY(1000):\
MAGRAV, TEXT \ANTI-GRAVITY\
MMISSL, TEXT \MAX NUMBER MISSLES:\
MTHRUS, TEXT \THRUST CONSTANT (2):\
MRETRO, TEXT \RETRO-THRUST (4):\

	PAGE
	IFNZRO D <
	XXX=.
	FIELD D%10
	*1000>

	DECIMAL
BIGSUN,
	0;0
	6;4; -6;-4; 0;7; 0;-7; -6;4; 6;-4
	-14;0; 14;0; -7;-12; 7;12; 7;-12; -7;12
	0;-21; 0;21; 19;-11; -19;11; 19;11; -19;-11
	14;-25; -14;25; 28;0; -28;0; 14;25; -14;-25
	0;35; 0;-35; 20;30; -20;-30; -20;30; 20;-30
	0;0

	ESUN=.
	IFNZRO 0 <
	-2;12; 0;12; 3;12; -4;11; -1;11; 1;11; 4;11; 6;11
-6;10; -3;10; 2;10; 4;10; 8;10; -8;9; -4;9; -2;9; 0;9
4;9; 6;9; 7;9; -8;8; -6;8; -3;8; 2;8; 6;8; 8;8; 10;8; -10;7
8;7; 9;7; -8;6; -5;6; 0;6; 3;6; 10;6; 11;6; -11;5; -9;5
-2;5; 5;5; 7;5; 9;5; 11;5; -7;4; 3;4; 12;4; -10;3
-4;3; -1;3; 1;3; 7;3; 10;3; 11;3; -12;2
-11;2; -6;2; 4;2; 12;2; 13;2
-11;1; -10;1; -8;1; -2;1; 1;1; 8;1; 11;1; -12;0; 10;0
-5;0; 6;0; 13;0; -11;-1; -3;-1; 0;-1; 3;-1; 9;-1; 12;-1; -12;-2; -10;-2
-8;-1; -6;-2; -1;-2; 7;-2; 11;-2; 12;-2; -9;-3; -4;-3
4;-3; 11;-3; -11;-4; -9;-4; -7;-4; -1;-4; 2;-4; 7;-4
10;-4; 12;-4; 11;-5; -11;-6; -9;-6
-8;-6; -6;-6; 4;-6; 6;-6; 8;-6; 9;-6; 11;-6; -10;-7
-8;-7; -2;-7; 1;-7
-8;-8; -6;-8; 6;-8; 8;-8; 9;-8; -8;-9; -6;-9; -4;-9; 4;-9; 7;-9
-6;-10; -2;-10; 0;-10; 2;-10; 4;-10; 5;-10; 7;-10; -5;-11; -3;-11; -1;-11
2;-11; 5;-11; -3;-12; -1;-12; 1;-12; 3;-12
ESUN=.
	>
	PAGE
SUNPT1,			/STAR FIELD
/ORION		SIGNUS	URSIA MAJOR	SCORPIO
18;-174;	62;108; -102;31;	-128;250
47;-171;	106;85; -88;20;		-128;242
33;-194;	91;91;	-91;9;		-139;225
40;-191;	71;88;	-91;-23;	-146;216
/SOME MISC.
-149;-213	/IN PUPPIS
-84;-168	/PROCYON
113;-46		/IN ANDROMEDA
-11;77		/ELTANIN

/ORION		SIGNUS	URSIA MAJOR	SCORPIO
47;-188;	73;74;	-73;-20;	-153;213
26;-211;	47;85;	-102;-9;	-164;194
66;-199;	29;74;	-88;-3;		-175;196
		55;120;			-182;199

/PLUS SOME MISCELLANEOUS
-117;188
-168;71		/ARCTURUS
6;6;-6;-6	/SOME SUN SPOTS
208;-105	/NECK OF CETUS
208;102		/IN AQUARIUS
-241;17		/SPICA

/CASEOPEA	CANUS MAJOR	PLEIADES
62;-23;		-18;-253;	117;-110
73;-20;		-29;-239;	117;-108
73;-11;		-18;-228;	113;-111
88;-9;		-44;-222;	113;-108
80;0;		-51;-213
		-102;-239
		-77;-239
		-66;-248
		-66;-219
		-57;-222
/PLUS SOME MISCELLANEOUS
6;-6;-6;6	/MORE SUN SPOTS
-230;159	/IN LIBRA
-200;-139	/ALPHARD

SUNPT2, 
0;1; 0;-1; 1;0; -1;0
0;2; 0;-2; 2;0; -2;0
0;4; 0;-4; 4;0; -4;0
0;6; 0;-6; 6;0; -6;0

/VAIRABLES START HERE
/BRIGHT STARS
146;-29		/IN ANDROMEDA
80;-143		/ALDEBARAN IN TAURUS
-109;100	/ALPHECCA IN CORONA BOREALIS
153;-68		/IN ARIES

/LEO		SAGITARIUS GEMINI	PEGASIS
-200;-17;	-18;250; -55;-114;	168;102
-222;-43;	4;250;	-69;-120;	160;40
-200;-43;	15;242; -73;-128;	193;46
10;0;0;10;-10;0;0;-10	/MORE SUN
-186;-37;	40;242; -58;-125;	164;0
/BRIGHT STARS
-190;145	/IN LIBRA
11;105		/LYRA
69;-63		/MIRFAK IN PERSEUS
164;-63		/IN ARIES

/LEO		SAGITARIUS GEMINI	PEGASIS
-200;-71;	51;239; -44;-122;	200;0
-168;-71;	66;228; -33;-117
-182;-85;	51;228; -58;-151
-171;-83;	62;246; -58;-137
/BRIGHT STARS
-168;-240	/IN PUPPIS
-222;137	/IN LIBRA
-208;29		/IN VIRGO
88;157		/ALTAIR

0;12;12;0;-12;0;0;-12	/MOR SUN
/LEO		SAGITARIUS GEMINI	PEGASIS
-146;-85;	66;239; -29;-137
-146;-77;		-22;-154
			-33;-159
/AURIGA
26;-88;47;-114;29;-128;4;-97
4;4;4;-4;-4;4;-4;-4	/MORE SUN

0;0

IFZERO EAE <
OCTAL
FIELD 0
/ DIGITAL-8-17 EAE EMULATION FOLLOWS.
/ (PAGE ZERO LAYOUT IS CHANGED AND CODE RELOCATED.)
*160
MQL=JMS I .
	PSDMQL
DVI=JMS I .
	PSDDVI
MUY=JMS I .
	PSDMUY
NMI=JMS I .
	PSDNMI
SHL=JMS I .
	PSDSHL
ASR=JMS I .
	PSDASR
LSR=JMS I .
	PSDLSR
SCA=JMS I .
	PSDSCA
MQA=JMS I .
	PSDMQA
CAM=JMS I .
	PSDCAM
/FIXTAB
/	PSDMQL
/*67
SUDOMQ,	0
SUDOSC,	0
/	PSDMQL
/	PSDDVI
/	MQLDVI
/	PSDMUY
/	MQLMUY
/	PSDNMI
/	PSDSHL
/	PSDASR
/	PSDLSR
/	PSDSCA
/	PSDMQA
/	PSDCAM

*7300
PSDNMI,	0		/NMI
	DCA PSDSCA	/SAVE AC
	DCA SUDOSC	/CLEAR STEP COUNTER.
	TAD PSDSCA
	SZA
	JMP .+5
	TAD SUDOMQ
	SNA CLA
	JMP I PSDNMI	/0 AC AND MQ.
NMIBK2,	TAD PSDSCA
	RAL
	SZL
	JMP NMIOUT	/AC0=1
	SPA
	JMP NMIOUT+2	/AC0=0 AND AC1=1
	CLA		/AC0=AC1=0
NMIBCK,	TAD SUDOMQ
	CLL RAL
	DCA SUDOMQ
	TAD PSDSCA
	RAL
	DCA PSDSCA
	ISZ SUDOSC
	JMP NMIBK2
NMIOUT,	SPA
	JMP .+3		/AC0=AC1=1
	RAR		/AC0 DOES NOT EQUAL AC1
	JMP I PSDNMI	/EXIT
	RAR		/TEST IF NUMBER 6000 0000
	TAD .+11
	SZA CLA
	JMP NMIBCK	/NOT 6000
	TAD SUDOMQ
	SZA
	JMP NMIBCK+1	/NOT 0000
	CML		/RESTORE LINK
	TAD PSDSCA	/RESTORE 6000
	JMP I PSDNMI	/EXIT
	-6000
PSDSCA,	0		/SCA
	DCA PSDMQA	/INCLUSIVE OR
	TAD PSDMQA	/STEP COUNTER
	CMA		/AND AC
	AND SUDOSC
	TAD PSDMQA
	JMP I PSDSCA
PSDMQA,	0		/MQA
	DCA PSDSCA	/INCLUSIVE OR
	TAD PSDSCA	/MQ
	CMA		/AND AC
	AND SUDOMQ
	TAD PSDSCA
	JMP I PSDMQA

*PSDNMI+100
PSDMQL,	0		/MQL
	DCA Z SUDOMQ
	JMP I PSDMQL
PSDCAM,	0		/CAM (CLA!MQL)
	CLA
	DCA Z SUDOMQ
	JMP I PSDCAM
MQLMUY,	0		/MQL!MUY
	DCA Z SUDOMQ
	TAD MQLMUY	/SET UP
	DCA PSDMUY	/FOR MUY SUBROUTINE
	JMP PSDMUY+1
MQLDVI,	0		/MQL!DVI
	DCA Z SUDOMQ
	TAD MQLDVI	/SET UP
	DCA PSDDVI	/FOR DVI SUBROUTINE
	JMP PSDDVI+1
	37
PSDSHL,	0		/SHL
	DCA PSDCAM	/SAVE AC
	TAD I PSDSHL	/SHIFT COUNT
	ISZ PSDSHL	/EXIT POINT
	AND PSDSHL-1	/5 BIT COUNTER
	CMA
	DCA SUDOSC
	TAD SUDOMQ	/SHIFT COMBINED
	CLL RAL		/AC AND MQ
	DCA SUDOMQ	/1 BIT TO THE
	TAD PSDCAM	/LEFT
	RAL
	DCA PSDCAM
	ISZ SUDOSC
	JMP .-7		/MORE SHIFTING
	TAD PSDCAM
	JMP I PSDSHL	/EXIT
PSDLSR,	0		/LSR
	DCA PSDCAM	/SAVE AC
	TAD PSDLSR	/USE ASR
	DCA PSDASR	/ROUTINE
	CLL
	JMP PSDASR+5

PSDASR,	0		/ASR
	CLL		/SET LINK=SIGN
	SPA
	CML
	DCA PSDCAM	/SAVE AC
	TAD I PSDASR	/SHIFT COUNT
	ISZ PSDASR	/EXIT POINT
	AND PSDSHL-1	/5 BIT COUNTER
	CMA
	DCA SUDOSC
	TAD PSDCAM	/RESTORE AC
	JMP .+4
	TAD PSDCAM
	SPA
	CML
	RAR
	DCA PSDCAM
	TAD SUDOMQ
	RAR
	DCA SUDOMQ
	CLL
	ISZ SUDOSC
	JMP .-12		/MORE SHIFTING
	TAD PSDCAM
	SPA
	CML		/LINK=AC0
	JMP I PSDASR
	7763
PSDDVI,	0		/DVI
	DCA PSDCAM	/SAVE HIGH ORDER DIVIDEND
	TAD I PSDDVI	/DIVISOR
	ISZ PSDDVI	/EXIT POINT
	CLL CMA IAC
	DCA MQLMUY	/2'S COMPLEMENT OF DIVISOR
	TAD PSDCAM	/HIGH ORDER DIVIDEND
	TAD MQLMUY
	SZL CLA
	JMP I PSDDVI	/DIVIDE OVERFLOW
	TAD PSDDVI-1	/7763
	DCA PSDLSR	/COUNTER
	JMP .+11
	TAD PSDCAM
	RAL
	DCA PSDCAM
	TAD PSDCAM
	TAD MQLMUY
	SZL
	DCA PSDCAM
	CLA
	TAD SUDOMQ
	RAL
	DCA SUDOMQ
	ISZ PSDLSR
	JMP .-14
	TAD PSDCAM	/COUNT EXHAUSTED
	JMP I PSDDVI	/EXIT

PSDMUY,	0		/MUY
	CLA CLL
	DCA MQLDVI	/CLEAR PRODUCT (MOST SIG.) REGISTER
	TAD PSDDVI-1
	DCA PSDLSR	/LOOP COUNTER
	TAD I PSDMUY
	DCA PSDMQL	/OPERAND
	ISZ PSDMUY	/EXIT POINT
	JMP .+10
	TAD MQLDVI
	SNL
	JMP .+3
	CLL
	TAD PSDMQL
	RAR
	DCA MQLDVI
	TAD SUDOMQ
	RAR
	DCA SUDOMQ	/LOW ORDER PRODUCT
	ISZ PSDLSR
	JMP .-13
	TAD MQLDVI	/HIGH ORDER PRODUCT
	JMP I PSDMUY	/EXIT
/PAUSE
>
$