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