perm filename TSERVO[GEM,BGB] blob sn#050704 filedate 1973-08-08 generic text, type C, neo UTF8
COMMENT ⊗   VALID 00015 PAGES
C REC  PAGE   DESCRIPTION
C00001 00001
C00003 00002	ALTERNATE PDP-10 MNEMONICS.
C00006 00003	TITLE TSERVO  -  TABLE TEST
C00009 00004	TURN TABLE (SUB MODE) COMMAND LISTEN LOOP.
C00012 00005	COMMAND EXECUTION.
C00014 00006	TTPDP6:		TURN TABLE SERVO. PDP-6 SPACE WAR JOB.
C00016 00007	ACCUMULATE SERVO STATISTICS.
C00019 00008	VARIABLES.
C00021 00009	DISPLAY TABLE STATUS. PDP-10 SWACE WAR JOB.
C00025 00010	III DISPLAY SUBROUTINES.
C00027 00011	III DPY CONTINUED.
C00029 00012	III DISPLAY ROUTINES.
C00031 00013	SUBR(SQRT)
C00033 00014	BEGIN SINCOS		SINE & COSINE - BGB.
C00035 00015	SUBR(REALIN)
C00038 ENDMK
C⊗;
;ALTERNATE PDP-10 MNEMONICS.

	DEFINE O(A,B){OPDEF A[B]}
	O LIP,HLR↔O LAP,HRR↔O DIP,HRLM↔O DAP,HRRM
	O ZIP,HRRZS↔O ZAP,HLLZS↔O WIP,HRROS↔O WAP,HRRZS
	O CAR,HLRZ↔O LIPI,HRLI↔O LAPI,HRRI↔O DIPZ,HRLZM
	O CDR,HRRZ↔O LACI,MOVEI↔O SLACI,MOVSI↔O DAPZ,HRRZM
	O LAC,MOVE↔O LACN,MOVN↔O LACM,MOVM↔O SLAC,MOVS
	O DAC,MOVEM↔O DACN,MOVNM↔O DACM,MOVMM↔O SDAC,MOVSM
	O NIP,HLRE↔O NAP,HRRE↔O NIM,HRREI↔O GO,JRST
	O FLOAT,FSC 233↔O FLO,FSC 225↔O FIXX,FIX 233000
	O DZM,SETZM

;SAIL LIKE SUBROUTINE LINKAGE.

	↓P←←17
	DEFINE SUBR(NAME){↓NAME: ;}
	DEFINE CALL(NAME,X1,X2,X3,X4){
	IFDIF <> <X1> {PUSH 17,X1↔IFDIF <> <X2> {PUSH 17,X2
	IFDIF <> <X3> {PUSH 17,X3↔IFDIF <> <X4> {PUSH 17,X4}}}}
	PUSHJ 17,NAME}
	DEFINE ARG1<-1(17)>↔DEFINE ARG2<-2(17)>
	DEFINE ARG3<-3(17)>↔DEFINE ARG4<-4(17)>
	DEFINE SETQ(VAR,LIST){CALL(LIST)↔DAC 1,VAR}

;RETURN FROM AN N-ARGUMENT SUBROUTINE CALL.

	DEFINE POP0J <POPJ 17,>
	↓POP1J.:SUB 17,[2(2)]↔GO@2(17)↔DEFINE POP1J<GO POP1J.>
	↓POP2J.:SUB 17,[3(3)]↔GO@3(17)↔DEFINE POP2J<GO POP2J.>
	↓POP3J.:SUB 17,[4(4)]↔GO@4(17)↔DEFINE POP3J<GO POP3J.>
	↓POP4J.:SUB 17,[5(5)]↔GO@5(17)↔DEFINE POP4J<GO POP4J.>

;ACCUMULATOR AND TEMPORARY DATA MANAGEMENT.

	DEFINE ACCUMULATORS(LIST){ACPTR←←2
	FOR AC⊂(LIST)<AC←ACPTR↔ACPTR←←ACPTR+1↔>}
	DEFINE DECLARE (LIST){
	FOR VARNAM⊂(LIST)<VARNAM: 0↔>}

;FATAL ERROR MESSAGE.

	DEFINE FATAL(STR){PUSHJ 17,FATAL.↔ASCIZ/STR/}
	FATAL.:OUTSTR[BYTE(7)15,12,106,101,124↔"AL - "⊗1↔0]
	OUTSTR @(17)↔INCHRW↔GO .-1↔LIT
	DEFINE CRLF{OUTSTR[BYTE(7)15,12]}
	%←1B18
TITLE TSERVO  -  TABLE TEST
COMMENT ⊗_________________________________________________________

   The turn table has two thousand count marks per revolution.
   The PDP6 turn table servo job runs every tick, 1/60 second.
   Thus the basic units of time and angular displacement
   are spacewar ticks and turn table marks; conversion into
   conventional units is only for the sake of diagonostic display.

Run Turn table:
	DATAO 500,[speed(5)]
	Speed 0 TO 77 turn counter clockwise.
	Speed 100 to 176 turn clockwise.
	speed 177 stop and lock.
	Speed 200 table time out.
Read Turn Table:
	DATAI 410,X	;Read Turn Table. 1B18 count invalid bit.
			; 1B17 IS =10000 bit followed by
			; four 4-bit bytes containing BCD numerals.
	CONO  410,0	;Reset table count to zero.
			;=10 arcs of =2000 counts.
_________________________________________________________________⊗

;INITIALIZATION.
PDL:	BLOCK 30
INTERN XTABLE
SA:	CALLI
	LAC P,[IOWD 20,PDL]
REE:	LACI .↔DAC 124
	PPIOT 2,-=100
	PPIOT 3,4004
	SETZ
;DISPLAY BOX AND TITLE.
XTABLE:	DAC CRECHR#		;CRE COMMAND CHARACTER.
	CALL(DPYSET,DPYBUF)
	CALL(AIVECT,[=500],[=400])
	CALL(AVECT,[=000],[=400])
	CALL(AVECT,[=000],[=000])
	CALL(AVECT,[=500],[=000])
	CALL(AVECT,[=500],[=400])
	CALL(DPYBIG,[3])
	CALL(AIVECT,[=10],[=360])
	CALL(DPYSTR,{[[ASCIZ/TURN TABLE SERVO/]]})

;CIRCLE FOR INDICATING TABLE POSITION.
	CALL(AIVECT,[-=50],[=180])
	SETZM TTRADS
CIR1:	CALL(COS,TTRADS)↔FMPR 1,[200.0]↔FIXX 1,↔SUBI 1,=250↔PUSH P,1
	CALL(SIN,TTRADS)↔FMPR 1,[200.0]↔FIXX 1,↔ADDI 1,=180↔PUSH P,1
	CALL(AVECT)
	LAC TTRADS↔FADR[0.125664]↔DAC TTRADS
	CAMG[6.29]↔GO CIR1↔SETZM TTRADS
	NIM -12↔DAC TIME10
	CALL(DPYOUT,[16])
	CALL(XREAD)
;_________________________________________________________________
;TURN TABLE (SUB MODE) COMMAND LISTEN LOOP.
LOOP:	SKIPE CRECHR↔GO[LAC CRECHR↔CAIN"U"↔SETZM CRECHR↔GO .+2]
	INCHRW
	SETZM CTRL↔TRZE 200↔SETOM CTRL#
	SETZM META↔TRZE 400↔SETOM META#
	CAIN 15↔GO[OUTSTR[ASCIZ/
#/]↔GO LOOP]
	DAC CHR#↔SETZ 1,	;NO OPERATION.
	CAIN "A"↔LACI 1,XABSOL	;ABSOLUTE TABLE POSITION.
	CAIN "R"↔LACI 1,XRELAT	;RELATIVE TABLE POSITION.
	CAIN "Y"↔LACI 1,XGO
	CAIN "Z"↔LACI 1,XZHALT	;GO TO ZERO POSITION.
	CAIN "R"↔LACI 1,XREAD
	CAIN "D"↔LACI 1,XDELTA
	CAIN "V"↔LACI 1,XVELOC	;SET DESIRED VELOCITY.
	CAIN "L"↔LACI 1,XLOCK	;EXECUTE LOCK.
	CAIN "X"↔GO TTEXIT	;EXIT.
	JUMPE 1,LOOP		;COMMAND LETTER NOT IMPLEMENTED.
	PUSHJ P,(1)
	SKIPN CRECHR
	GO LOOP
TTEXIT:	SETZB 0,1
	UPGIOT 16,
	UPGIOT 15,
	POP0J

;SUBROUTINE TO RUN SPACE WAR JOBS.
SUBR(SWJOBS)
BEGIN SWJOBS
	LAC TTDEL2↔DAC TTDEL0	;INITIALIZE THE DESIRED VELOCITY.
	LACI =10↔DAC TTVELO
	SETZM DONE↔SETZM MISSED
;	LOCK
	SPCWAR 1,TTPDP6		;FIRE UP PDP-6.
	LAC[XWD %+10,PDP10]
	SPCWGO			;FIRE UP PDP-10
L1:	INCHRS↔SKIPA↔CAIE 40↔SKIPA↔SETOM DONE	;SPACE OR DONE.
	SKIPN DONE↔GO L1	;WAIT FOR TIME OUT.
	SPCWAR'SSW'		;STOP SPACE JOB.
;	UNLOCK
	POP0J
BEND SWJOBS
XRESET:
	LAC OVER
	DAC DELSUM	;TOTAL ARC DISPLACEMENT.
	SETZM DELSQR
	SETOM TICKS	; -1 COUNT INDICATES FIRST EXECUTION.
	SETZM DELMID
	POP0J
;COMMAND EXECUTION.
;-----------------------------------------------------------------
XABSOL:
	CALL(READARC)↔MOVMS
	CAMG[6.283185]↔GO .+3
	FSBR[6.283185]↔GO .-3
	LAC 1,TTRADS↔FSBR 1,0
XGO2:	LAC 1↔SKIPGE↔FADR[6.283185]
	FDVR[3.14159265E-4]
	FIXX↔DAC DELARC↔DZM CTRL
XGO:	LAC CTRL↔DAC TTDIR	;TURN TABLE DIRECTION.
	CALL(XRESET)
	CALL(SWJOBS)
	POP0J
;-----------------------------------------------------------------
XZHALT:	LAC 1,TTRADS↔GO XGO2
XREAD:	
	CALL(XRESET)
;	LOCK
	SETOM DONE
	SPCWAR 1,TTPDP6		;FIRE UP PDP-6.
	LAC[XWD %+10,PDP10]
	SKIPL TIME10↔GO .+5↔SPCWGO
	SKIPGE TIME10↔GO .-1↔GO .+3
	SPCWGO↔INCHRW		;FIRE UP PDP-10
	SPCWAR'SSW'
;	UNLOCK			;STOP SPACE JOB.
	POP0J
XDELTA:
	CALL(READARC)↔MOVMS
	FDVR[3.14159265E-4]
	FIXX↔DAC DELARC
	POP0J
XRELAT:
XVELOC:	CALL(REALIN)↔MOVMS↔FIXX
	CAIGE =10↔LACI =10
	CAILE =200↔LACI =200
	DAC TTDEL2↔POP0J
XLOCK:	SETZM LOCKFLG#
	SPCWAR 0,TTLOCK
	SKIPN LOCKFLG↔GO .-1
	OUTSTR[ASCIZ/	DONE.
*/]↔	POP0J
TTPDP6:		;TURN TABLE SERVO. PDP-6 SPACE WAR JOB.
BEGIN TTPDP6

	SKIPGE 6	;AC6 IF BIT0=0 THEN MAIN JOB NOT RUNNING.
	CONSZ 40↔DISMIS	;ARE WE REALLY ON THE PDP-6.
	JUMPN 5,.-1	;AC5 -1 THEN PDP10 IS DEAD.
	SKIPLE 3↔ADDM 3,MISSED	;MISSED TICKS.

;READ TURN TABLE POSITION & DECODE BCD TO BINARY.
	DATAI 410,TTREAD		;READ TURN TABLE POSITION.
	LAC 2,[POINT 4,TTREAD,15]
	ILDB 0,2			;TEN THOUSAND.
	ILDB 1,2↔IMULI 0,=10↔ADD 0,1	;THOUSANDS.
	ILDB 1,2↔IMULI 0,=10↔ADD 0,1	;HUNDREDS.
	ILDB 1,2↔IMULI 0,=10↔ADD 0,1	;TENS.
	ILDB 1,2↔IMULI 0,=10↔ADD 0,1	;ONES.

;ABSOLUTE TT POSITION. ONE TICK DELTA POSITION.
	AOSN 3↔AOS 3
	EXCH 0,TMARK1↔DAC 0,TMARK2	;CURRENT AND PREVIOUS.
	SUB 0,TMARK1↔MOVMS
	CAILE =10000↔SUBI =20000	;WRAP AROUND.
	MOVMS↔DAC TTDEL1		;DELTA POSITION IN MARKS.
	SKIPE DONE↔GO L2

;VELOCITY SERVO.
	LAC 0,TTDEL1↔IDIV 3	;ACTUAL VELOCITY - MARKS PER TICK.
	LAC 1,TTVELO		;COMMAND VELOCITY - MOTOR UNITS.
	CAMGE 0,TTDEL0↔ADDI 1,1	;RUN FASTER !
	CAMLE 0,TTDEL0↔SUBI 1,1	;RUN SLOWER !
	JUMPL 1,.+3↔CAIGE 1,77
	DAC 1,TTVELO

L2:	LAC TMARK1↔FLOAT
	FMPR[3.14159265E-4]↔DAC TTRADS	;POSITION IN RADIANS.
	LAC TTREAD↔TRNE %↔GO INVALID	;RESET INVALID BIT.
;ACCUMULATE SERVO STATISTICS.

	AOSG TICKS↔GO RUNTT	;JUMP OVER ON FIRST EXECUTION.
	LAC TTDEL1↔ADDM DELSUM	   ;ACCUMULATE DELTA POSITIONS.
	LAC DELSUM↔IDIV TICKS↔DAC DELMID	;DELTA AVERAGE.
	LAC TTDEL1↔IMUL TTDEL1↔ADDM DELSQR	;DELTA SQUARED.
	LAC 0,DELMID↔IMUL 0,DELMID↔LAC 1,DELSQR
	IDIV 1,TICKS↔SUB 1,0↔DAC 1,SDEVIA	;STANDARD DEVIATION.

;STOP CONDITION (TOTAL ARC DISPLACEMENT ≥ DESIRED ARC DISPLACEMENT).
	LAC DELARC
	SUB DELSUM
	SKIPLE↔GO L3
	MOVM OVER↔SETOM DONE
	DATAO 500,[XWD 5,0]↔DISMIS

;SLOW DOWN CONDITION. (TTVELO*TTDEL0) ≥ (ARC DISPLACEMENT TO GO).
L3:	LAC 1,TTVELO
	IMUL 1,TTDEL0
	CAMGE 1,0↔GO RUNTT
	LAC TTDEL0↔SUBI 2
	SKIPG↔LACI 1		;NEVER DECREMENT IT BELOW =1.
	DAC TTDEL0
;_________________________________________________________________
RUNTT:	LAC TTVELO
	SKIPE TTDIR↔MOVNS	;CLOCKWISE DIRECTION.
	ANDI 177↔CAIN 177
	LACI 176↔DAP TTOUT
	SKIPN DONE↔DATAO 500,TTOUT
	DISMIS
;_________________________________________________________________
INVALID:CONO 410,0
	AOS INVCNT		;ENABLE INVALID CLEAR.
STOPTT:	DATAO 500,[XWD 5,0]	;STOP THE TURN TABLE.
	SETOM DONE↔DISMIS	;STOP RUNNING THE TURN TABLE.
BEND TTPDP6;BGB 24 JUNE 1973._____________________________________
TTLOCK:	CONSZ 40↔DISMIS		;ARE WE REALLY ON THE PDP-6.
	DATAO 500,[XWD 5,177]	;LOCK.
	SETOM LOCKFLG
	DISMIS
;VARIABLES.

DONE:	0
TTDIR:	0	;TURN TABLE DIRECTION.
TTVELO: 0	;TURN TABLE MOTOR VELOCITY.
TTREAD:	0	;TURN TABLE SHAFT POSITION.

TMARK0:	0	;DESIRED POSITION MARK.
TMARK1:	0	;CURRENT POSITION MARK.
TMARK2:	0	;PREVIOUS POSITION MARK.
TTRADS:	0	;CURRENT POSITION IN RADIANS.
TTDEGS:	0	;CURRENT POSITION IN DEGREES.

TTDEL0:	=20		;DESIRED DELTA-POSITION PER TICK.
TTDEL1:	0		;ACTUAL DELTA POSITION CURRENT TICK.
TTDEL2:	=20		;INITIAL DELTA-POSITION PER TICK.

TTOUT:	40(5)		;RUN TURN TABLE - DATA 500, ARGUMENT.
INVCNT:	0		;COUNT OF INVALID HITS.

DELARC:	=10000	;DESIRED ARC DISPLACEMENT IN TT-MARKS.
DELSUM:	0	;TOTAL ARC DISPLACEMENT.
OVER:	0	;OVER SHOOT.
DELSQR:	0	;TOTAL OF DELTA'S SQUARED.
DELMIN:	0	;DELTA MINIMUM.
DELMID:	0	;DELTA MEDIAN.
DELMAX:	0	;DELTA MAXIMUM.
SDEVIA:	0	;STANDARD DEVIATION OF DELTA-POSITIONS.
TICKS:	0	;COUNT OF DELTAS IN SUM.
TIME10:	-2	;PDP-10 TICKS.
MISSED:	0	;TOTAL MISSED TICKS.
MISSES:	0	;CURRENT NUMBER OF MISSED TICKS.
;_________________________________________________________________
;DISPLAY TABLE STATUS. ;PDP-10 SWACE WAR JOB.

PDP10:	CONSO 40↔DISMIS		;ARE WE REALLY ON THE PDP-10.
	GO 3,@[.+1]		;LEAVE IOT USER MODE.
	LAC P,[IOWD 20,PDL10]	;SEPARATE PDL SPACE.
	CALL(DPYSET,DPYBUF)

;TIME IN SPACE WAR TICKS.
	CALL(AIVECT,[=40],[=320])↔CALL(DPYBIG,[2])
	CALL(DPYSTR,{[[ASCIZ/TICK/]]})
	CALL(AIVECT,[=150],[=320])↔LAC 1,TICKS↔CALL(DECDPY)

;TURNTABLE POSITION ANGLE.
	LAC TTRADS↔FMPR[57.2957795]↔FIXX↔DAC TTDEGS
	CALL(AIVECT,[=40],[=290])↔CALL(DPYSTR,{[[ASCIZ/ANGLE/]]})
	CALL(AIVECT,[=140],[=290])↔LAC 1,TTDEGS↔CALL(DECDPY)
	CALL(AIVECT,[=200],[=290])↔LAC 1,TMARK1↔CALL(DECDPY)
	CALL(AIVECT,[=290],[=290])↔LAC 10,TTREAD↔CALL(OD)

;DELTA POSITION.
	CALL(AIVECT,[=40],[=260])↔CALL(DPYSTR,{[[ASCIZ/TTDEL/]]})
	CALL(AIVECT,[=150],[=260])↔LAC 1,TTDEL1↔CALL(DECDPY)
	CALL(AIVECT,[=200],[=260])↔LAC 1,DELMID↔CALL(DECDPY)
	CALL(AIVECT,[=250],[=260])↔LAC 1,TTDEL0↔CALL(DECDPY)
	CALL(AIVECT,[=300],[=260])↔LAC 1,SDEVIA
	FLOAT 1,↔CALL(SQRT,1)↔FIXX 1,↔CALL(DECDPY)
;VELOCITY.
	CALL(AIVECT,[=40],[=230])↔CALL(DPYSTR,{[[ASCIZ/TTVELO/]]})
	CALL(AIVECT,[=150],[=230])↔LAC 10,TTVELO↔CALL(OD)
	CALL(AIVECT,[=40],[=200])↔CALL(DPYSTR,{[[ASCIZ/DATAO 500,[XWD 5,/]]})
	CDR 10,TTOUT↔CALL(OD)↔CALL(DTYO,["]"])
;MISSED TICKS.
	CALL(AIVECT,[=40],[=170])↔CALL(DPYSTR,{[[ASCIZ/MISSED TICKS: /]]})
	CALL(AIVECT,[=225],[=170])↔LAC 1,MISSED↔CALL(DECDPY)
;DISPLAY INVALID BIT'S STATUS.
	CALL(AIVECT,[=390],[=290])↔LAC TTREAD↔TRNE %↔GO[
		CALL(DPYSTR,{[[ASCIZ/INVALID./]]})↔GO .+3]
		CALL(DPYSTR,{[[ASCIZ/VALID./]]})
;INDICATE TURN TABLE POSITION ON CIRCLE.
	CALL(AIVECT,[-=325],[=210])
	LAC 1,TTDEGS↔CALL(DECDPY)
	CALL(DPYSTR,{[[ASCIZ/ DEGREES./]]})
	CALL(AIVECT,[-=250],[=180])
	CALL(COS,TTRADS)↔FMPR 1,[200.0]↔FIXX 1,↔SUBI 1,=250↔PUSH P,1
	CALL(SIN,TTRADS)↔FMPR 1,[200.0]↔FIXX 1,↔ADDI 1,=180↔PUSH P,1
	CALL(AVECT)
	CALL(DPYOUT,[15])
	AOS TIME10
	DISMIS
PDL10:	BLOCK 30
;-----------------------------------------------------------------
;III DISPLAY SUBROUTINES.
	FLGIII:-1
	FLGDD:0
;DISPLAY UUO CODES.
	OPDEF UPG [XWD 703000,0]

	A←1↔B←2↔C←3
DPYBUF:	DPYBU.
	=350↔1↔XWD 1,=350
DPYBU.: BLOCK =350
IGNORE:	0
DPYPTR:	0
BUFEND:	0
BUFHD:	0
	0
;III DPY CONTINUED.
DPYBIG:	LAC 1,ARG1
	LACI 3,46	;ZERO LENGTH RELATIVE-INVISIBLE VECTOR
	DPB 1,[POINT 3,3,27]
	PUSH P,(P)	;COPY PC.
	GO LV2

DPYBRT:	LAC 1,ARG1
	LACI 3,46
	DPB 1,[POINT 3,3,24]
	PUSH P,(P)	;COPY PC.
	GO LV2

RIVECT: SKIPA C,[46]
RVECT:	LACI C,6
	GO LV0
AIVECT:	SKIPA C,[146]	;INVISIBLE ABSOLUTE.
AVECT:	LACI C,106
LV0:	SKIPGE IGNORE↔POP2J
LV:	LAC A,ARG2↔LAC B,ARG1
LVC:	DPB A,[POINT 11,C,10]
	DPB B,[POINT 11,C,21]
LV2:	AOS A,DPYPTR↔DAC C,(A)
LV3:	LIPI A,<(<POINT 7,0,35>)>
	DAC A,DPYPTR↔LACI A,(A)
	CAML A,BUFEND↔SETOM IGNORE
	POP2J
;--------------------------------------------------------------
;III DPY CONTINUED.
DPYSTR:	LAC 3,ARG1
	LIPI 3,440700
	ILDB 3↔JUMPE POP1J.
	CALL(DTYO,0)↔GO DPYSTR+2

DTYO:	LAC 1,ARG1
	IDPB A,DPYPTR
	CDR A,DPYPTR
	CAML A,BUFEND
	SETOM IGNORE
	POP1J

DPYCLR:	SKIPL DPYFLG#
	DPYCLR
	DZM BUFHD
	POPJ P,

DPYOUT:	
	SKIPN 1,BUFHD↔GO .+6
	LAC 2,DPYPTR↔DAC 2,-2(1)
	LACI 2,2(2)↔SUB 2,1↔DAC 2,-1(1)
	CDR B,DPYPTR
	SUB B,BUFHD
	ADDI B,1
	DAC B,BUFHD+1
	LAC 1,ARG1
	DPB A,[POINT 4,.+3,12]↔IOR A,DPYFLG↔SKIPL A↔UPG BUFHD
	POP1J

DPYSET:	DZM DPYFLG
	LAC 1,ARG1
	ADDI 1,2
	DAC 1,BUFHD
	CDR 2,-3(1)	;SIZE
	ADDI 2,-3(1)
	SUBI 2,1
	DZM IGNORE
	DAC 2,BUFEND
CLR2:	LAC A,BUFHD
	LACI B,1
	DAC B,1(A)
	LACI B,2(A)
	LIPI B,1(A)
	BLT B,@BUFEND	;SET DPY BUFFER TO NULL CHARACTER WORDS
	PUSH P,(P)	;COPY PC.
	GO LV3
;III DISPLAY ROUTINES.
SUBR(OD)----------------------------------------------------------
BEGIN OD;OCTAL HALF WORD DISPLAY - BGB - 13 DEC 1972.
	LACI 7,6↔DIPZ 10,10↔SETO
L:	ROT 10,3↔ADDI 10,60↔TRNE 10,17↔SETZ
	JUMPN 0,.+3↔CALL(DTYO,10)↔ZAP 10↔SOJG 7,L
	CALL(DTYO,[" "])↔POP0J
BEND;12/13/72-----------------------------------------------------
SUBR(DECDPY)NUM		;DECIMAL DISPLAY NUMBER.
BEGIN DECDPY;-----------------------------------------------------
L:	JUMPGE 1,.+5
	MOVM 2,1
	CALL(DTYO,["-"])
	LAC 1,2
	IDIVI 1,12
	PUSH P,2
	SKIPE 1
	PUSHJ P,L
	POP P,1↔ADDI 1,60
	CALL(DTYO,1)
	POP0J
BEND DECDPY;12/17/72----------------------------------------------
;SUBR(SQRT)
SUBR(SQRT)--------------------------------------------------------
BEGIN SQRT;MODIFIED OLDE LIB40 SQUARE ROOT - BGB - TRADITIONAL.
	A←0 ↔ B←1 ↔ C←2
	MOVM B,ARG1↔JUMPE B,POP1J.↔PUSH P,2

;LET X=F*(2↑2B) WHERE 0.25<F<1.00 THEN SQRT(X)=SQRT(F)*(2↑B).
	ASHC B,-=27↔SUBI B,201	;GET EXPONENT IN B, FRACTION IN C.
	ROT B,-1		;CUT EXP IN HALF, SAVE ODD BIT
	HRRM B,L↔LSH B,-=35	;USE THAT ODD BIT.
	ASH C,-10↔FSC C,177(B)	;0.25 < FRACTION < 1.00

;LINEAR APPROXIMATION TO SQRT(F).
	MOVEM C,A
	FMP C,[0.8125↔0.578125](B)
	FAD C,[0.302734↔0.421875](B)

;TWO ITERATIONS OF NEWTON'S METHOD.
	MOVE B,A
	FDV B,C↔FAD C,B↔FSC C,-1
	FDV A,C↔FADR A,C
     L: FSC A,0↔MOVE 1,A↔POP P,2
	POP1J↔LIT
BEND;28/12/72-----------------------------------------------------
BEGIN SINCOS		;SINE & COSINE - BGB.
	A←1 ↔ B←2 ↔ C←3
↑COS:	SKIPA A,ARG1
↑SIN:	SKIPA A,ARG1
	FADR  A,HALFPI			;COS(X) = SIN(X+π/2).
	MOVM B,A↔CAMG B,[17B5]↔POP1J	;FOR SMALL X, SIN(X)=X.

;B ← (ABS(X)MODULO 2π)/HALFPI
;C ← QUADRANT 0, 1, 2 OR 3.
	FDVR B,HALFPI
	LAC C,B↔FIX C,233000
	CAILE C,3↔GO[
	TRZ C,3↔FSC C,233
	FSBR B,C↔GO .-3]		;MODULO 2π.
	GO .+1(C)↔GO .+4↔JFCL↔GO[
	FSBRI B,(2.0)↔MOVNS B↔GO .+2]	;SIN(X+π)=SIN(-X)
	FSBRI B,(4.0)			;SIN(X+2π)=SIN(X)
	SKIPGE A↔MOVNS	B		;SIN(-X) = -SIN(X).

;FOR -1 ≤ B ≤ +1 REPRESENTING -π/2 ≤ X ≤ +π/2,
;COMPUTE SINE(X) APPROXIMATION BY TAYLOR SERIES.
	DAC B,C↔FMPR B,B	
	LAC A,[164475536722]↔FMP A,B
	FAD A,[606315546346]↔FMP A,B
	FAD A,[175506321276]↔FMP A,B
	FAD A,[577265210372]↔FMP A,B
	FAD A,HALFPI↔FMPR A,C↔POP1J
HALFPI:	201622077325 ;PI/2
	LIT
BEND;-------------------------------------------------------------
PIFLAG:0
SUBR(READARC)
	SETZM PIFLAG
	CALL(REALIN)
	SKIPN PIFLAG
	FMPR[0.0174533]		;CONVERT DEGREES INTO RADIANS.
	POP0J
SUBR(REALIN)
BEGIN REALIN;
;<EXPR>		::= <EXPR>+<TERM>|<EXPR>-<TERM>|<TERM>
;<TERM>		::= <TERM>*<PRIMARY>|<TERM>/<PRIMARY>|<PRIMARY>
;<PRIMARY>	::= -<PRIMARY>|(<EXPR>)||π|<REAL NUMBER>
	CALL(TERM)
	CAIN 1,"+"↔GO[
		PUSH P,0↔CALL(TERM)↔FADR 0,(P)
		SUB P,[XWD 1,1]↔GO REALIN+1]
	CAIN 1,"-"↔GO[
		PUSH P,0↔CALL(TERM)↔MOVN 0,0↔FADR 0,(P)
  	     	SUB P,[XWD 1,1]↔GO REALIN+1]
	POP0J↔POP0J
TERM:	CALL(PRIMARY)
TERM2:	CAIN 1,"*"↔GO[
		PUSH P,0↔CALL(PRIMARY)↔FMPR 0,(P)
		SUB P,[XWD 1,1]↔GO TERM2]
	CAIN 1,"/"↔GO[
		PUSH P,0↔CALL(PRIMARY)↔EXCH 0,(P)↔FDVR 0,(P)
		SUB P,[XWD 1,1]↔GO TERM2]
	POP0J
;BEGIN REALIN	; INPUT SMALL REAL NUMBER - BGB - 16 DEC 1972
;AC-0 INTEGER ACCUMULATION.	AC-0 RETURNS REAL NUMBER.
;AC-1 CHARACTER.		AC-1 RETURNS BREAK CHARACTER.
;AC-2 COUNTER OF DIGITS TO RIGHT OF DECIMAL POINT PLUS ONE.
;AC-3 MINUS SIGN FLAG.
PRIMARY:SETZ↔SETZB 2,3
L0:	CALL(GETCHR)
	CAIN 1," "↔GO .-2
	CAIN 1,"-"↔GO[SETCMM 3↔GO L0]
	CAIN 1,"π"↔GO[SETOM PIFLAG↔MOVE 0,[3.1415926]
	      GETRET: CALL(GETCHR)↔GO L3]
	CAIN 1,"("↔GO[PUSH P,3↔CALL(REALIN)↔POP P,3
		      CAIN 1,")"↔GO GETRET
		      OUTSTR[ASCIZ/WARNING: MISSING ')'
/]↔		      POP0J]
	SKIPA
L1:	CALL(GETCHR)
	CAIN 1,";"↔GO L2↔CAIN 1,","↔GO L2
	CAIE 1,"."↔GO .+3↔JUMPN 2,L2↔AOJA 2,L1
	CAIL 1,"0"↔CAILE 1,"9"↔GO L2
	JUMPN 2,[CAILE 2,4↔GO L1↔AOJA 2,.+1]
	ANDI 1,17↔IMULI =10↔ADD 1↔GO L1
L2:	FLOAT↔SOSLE 2↔FDVR[1.0↔10.0↔100.0↔1000.0↔10000.0](2)
L3:	SKIPE 3↔MOVNS↔POP0J
BEND REALIN;12/16/72(BGB),14-MAR-73(TVR)-----------------------------
GETCHR:	INCHRW 1↔POP0J
END