/ BASIC FOR PDP-4/X AND OTHER DEC 18-BIT COMPUTERS
/ WON'T ACTUALLY WORK ON A REAL PDP-4
/ BECAUSE THE PDP-4 CONSOLE DID NOT USE ASCII
/ SHOULD WORK ON A REAL PDP-7, PDP-9, OR PDP-15 (BANK MODE)
/ COPYRIGHT (C) 2001 BY DAVID G. CONROY
/ PERMISSION TO USE, COPY, MODIFY, AND DISTRIBUTE THIS SOFTWARE AND ITS
/ DOCUMENTATION FOR ANY PURPOSE AND WITHOUT FEE IS HEREBY GRANTED, PROVIDED
/ THAT THE ABOVE COPYRIGHT NOTICE APPEARS IN ALL COPIES, THAT BOTH THE
/ ABOVE COPYRIGHT NOTICE AND THIS PERMISSION NOTICE APPEAR IN SUPPORTING
/ DOCUMENTATION, AND THAT THE NAME OF DAVID G. CONROY NOT BE USED IN ADVERTISING
/ OR PUBLICITY PERTAINING TO DISTRIBUTION OF THE SOFTWARE WITHOUT SPECIFIC,
/ WRITTEN PRIOR PERMISSION. THIS SOFTWARE IS MADE AVAILABLE "AS IS", AND
/ DAVID G. CONROY DISCLAIMS ALL WARRANTIES, EXPRESS OR IMPLIED, WITH REGARD TO
/ THIS SOFTWARE, INCLUDING WITHOUT LIMITATION ALL IMPLIED WARRANTIES OF
/ MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE, AND IN NO EVENT SHALL
/ DAVID G. CONROY BE LIABLE FOR ANY SPECIAL, INDIRECT OR CONSEQUENTIAL DAMAGES
/ OR ANY DAMAGES WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS,
/ WHETHER IN AN ACTION OF CONTRACT, TORT (INCLUDING NEGLIGENCE) OR STRICT
/ LIABILITY, ARISING OUT OF OR IN CONNECTION WITH THE USE OR PERFORMANCE OF
/ THIS SOFTWARE.
/ 01 DGC 20-MAR-2001
/ THE INITIAL VERSION WAS GENERATED BY
/ STARTING WITH PDP-1/X BASIC 03, AND TRANSLATING IT
/ INTO A PROGRAM WHICH WOULD RUN ON THE PDP-4/X
/ MOST OF THIS WAS LINE-BY-LINE, ALTHOUGH THERE WERE SECTONS
/ WHICH NEEDED A TOTAL UPDATE, LIKE MULTIPLY, DIVIDE,
/ AND THE CODE WHICH DID SIGNED COMPARES
/ 02 DGC 08-APR-2001
/ THIS IS THE FIRST VERSION WHICH WORKS IN FLOATING
/ POINT, RATHER THAN IN FIXED POINT
/ USES MY 18-BIT NO-EAE FLOATING POINT CODE, BUT WILL NEED
/ TO HAVE THE CALLING SEQUENCES FOR FLDA, FLDO, AND
/ FSTA CHANGED TO TAKE THE ADDRESS IN AC, RATHER THAN IN THE
/ NEXT INSTRUCTION WORD, BECAUSE THAT SEEMS TO WORK OUT
/ BETTER IN ALL CASES
/ 03 DGC 21-MAY-2001
/ ADDED SUPPORT FOR EXTENDED MEMORY. REWROTE THE WAY
/ THAT THE EXPRESSION READER DEALS WITH FUNCTIONS TO MAKE
/ THINGS SMALLER AND FASTER. REPLACED THE "ENC" CODE
/ WITH NEW "PACK" CODE (BASED ON THE CODE WHICH ENCODED BLANKS
/ WITH THE 400 BIT, WHICH TURNED OUT TO BE A BAD IDEA)
/ ADDED FIRST VERSION OF SIN(X) AND COS(X). FIXED A BUG IN TAB(X)
/ AND SPC(X) WHERE T9 WAS GETTING SMASHED BY THE EVALUATION
/ OF THE ARG, AND THE WRONG NUMBER OF BLANKS WERE SENT.
/ 04 DGC 28-MAY-2001
/ REWORKED THE BASIC FLOATING POINT LOADS, STORES,
/ MOVES, PUSHES, AND POPS SO THAT THE NAMES WERE CONSISTANT
/ WITH ONE ANOTHER, AND TO ADD SOME FUNCTIONALITY
/ ADDED FPOW(X, Y), TAN(X), ATN(X), AND MADE ABS(X) FASTER
/ CHANGED INITIALIZATION CODE SO THAT IT SITS IN MEMORY WHICH
/ WILL BE OVERWRITTEN BY SOURCE CODE, AND ADDED CODE WHICH
/ PRINTS A GREETING AND THE SIZE OF FREE MEMORY
/ FIXED A TYPO WHICH CAUSED "PRINT 0.9+0.1" TO OUTPUT
/ "+0.:00000" (THE CODE WHICH WATCHED FOR OVERFLOW
/ DURING DECIMAL ROUNDING NOTICED THAT OVERFLOW HAD HAPPENED,
/ BUT IT BOTCHED THE DIVIDE BY 10.0 WHICH FIXES THINGS)
/ 05 DGC 02-JUN-2001
/ ADDED FIRST VERSIONS OF EXP(X) AND LN(X)
/ SINCE EXP(X) NEEDS TO COMPUTE INTEGER POWERS, FPOW WAS SPLIT
/ INTO TWO SECTIONS, ONE OF WHICH ACTUALLY COMPUTES THE
/ INTEGER POWERS, AND THE OTHER WHICH LOOKS AT THE ARGUMENTS
/ AND SELECTS BETWEEM THE EXP/LOG ALGORITHM AND USING THE ROUTINE
/ WHICH COMPUTES INTEGER POWERS.
/ 06 DGC 24-JUN-2001
/ ADDED A KRB AND A TLS OF A NUL CHARACTER AT THE START
/ SO THAT BASIC WILL RUN ON A REAL MACHINE (OR BOB SUPNIK'S EMULATOR)
/ WHICH DOES NOT HAVE A PANEL PROGRAM TO INITIALIZE THE FLAGS
/ NOTE THAT WHEN YOU RUN BASIC UNDER BOB'S EMULATOR YOU NEED TO MAKE
/ THE CONSOLE INTERFACE FULL DUPLEX (SET TTI FDX) OR EVERYTHING
/ YOU TYPE WILL BE ECHOED TWICE; WAS THE CONSOLE INTERFACE ON THE PDP-9
/ AND PDP-15 REALLY HALF DUPLEX ?
/ ADD CONDITIONALS TO MAKE IT EASY TO BUILD A VERSION
/ HONORING THE OPERATE RESTRICTIONS ON A REAL DEC 18-BIT MACHINE
/ THESE COMMENTS DESCRIBE THE MAJOR DATA
/ STRUCTURES; IT WOULD BE NICE IF THESE THINGS COULD BE
/ SYMBOLIC, BUT A LOT OF CODE KNOWS WHAT FIELD
/ IS NEXT TO WHAT OTHER FIELD (THE PDP-4 HAS AUTOINCREMENT BUT
/ NO INDEX REGISTERS) SO IT'S HARD TO DO
/ AT THE VERY LEAST I SHOULD ADD AN ASSEMBLY DIRECTIVE TO
/ PAL-18/X WHICH DOES WHAT THE "ASSUME" MACRO IN THE
/ RSX-11/M SOURCES DOES, AND PUT THEM IN THE CODE AT ALL THE
/ PLACES WHERE ADJACENCY ASSUMPTIONS ARE MADE
/ LINE
/ 0 LEN
/ 1 LNO
/ 2 ... DATA
/ SIMPLE VAR
/ 0 LEN
/ 1 NAME ([17:16]=00, [15:14]=XX, [13:7]=CH1, [6:0]=CH0)
/ 2 ... DATA (2 WORDS)
/ DEFINED FUNCTION
/ 0 LEN
/ 1 NAME ([17:16]=01, [15:14]=XX, [13:7]=CH1, [6:0]=CH0)
/ 2 ADDR OF FORMAL PARAMETER
/ 3 LP
/ 4 CP
/ 5 C
/ SINGLE DIM ARRAY VAR
/ O LEN
/ 1 NAME ([17:16]=10, [15:14]=XX, [13:7]=CH1, [6:0]=CH0)
/ 2 ARRAY BOUND 1
/ 3 ... DATA (2 WORDS PER ELEMENT)
/ DOUBLE DIM ARRAY VAR
/ 0 LEN
/ 1 NAME ([17:16]=11, [15:14]=XX, [13:7]=CH1, [6:0]=CH0)
/ 2 ARRAY BOUND 2
/ 3 ARRAY BOUND 1
/ 4 ... DATA (2 WORDS PER ELEMENT)
/ GSTK
/ 0 LP
/ 1 CP
/ 2 C
/ FSTK
/ 0 VAR
/ 1,2 LIMIT
/ 3,4 STEP
/ 5 LP
/ 6 CP
/ 7 C
NSTK=100 / SIZES
NGSTK=10
NCMDB=50
NGETB=40
GETBM=NGETB-1
NFSTK=10
TMEM=100000 / 32K
RNDX=1 / DEFAULT SEED
LOC 00000
JMP BMEM / HLT ON INTERRUPT; 00000 IS ALSO
HLT / THE START LOCATION
LOC 00010
X0, BSS 1 / AUTO INDEX LOCATIONS
X1, BSS 1 / ALL OF THEM ARE USED IN A
X2, BSS 1 / VERY TEMPORARY WAY
X3, BSS 1
X4, BSS 1
X5, BSS 1
X6, BSS 1
X7, BSS 1
LOC 00020
0 / HLT IF A CAL
HLT / INSTRUCTION HAPPENS
/ ERROR HANDLING
/ JUMP TO ERR WITH ERROR CODE IN AC
/ TYPE OUT ?XX, THEN LINE NUMBER IF NOT DIRECT MODE
/ FORCE DIRECT MODE, CLEAR PUSH/POP STACK
ERRCC, LAC (103103 / ?CC CONTROL-C
JMP ERR
ERRLN, LAC (116114 / ?LN LINE NUMBER ERROR
JMP ERR
ERRMF, LAC (106115 / ?MF MEMORY FULL
JMP ERR
ERRSN, LAC (116123 / ?SN SYNTAX ERROR
JMP ERR
ERRNN, LAC (116116 / ?NN OPERATION NOT LEGAL NOW
JMP ERR
ERRPD, LAC (104120 / ?PD PUSHDOWN STACK ERROR
JMP ERR
ERRSS, LAC (123123 / ?SS STOP
JMP ERR
ERRZD, LAC (104132 / ?ZD DIVIDE BY ZERO
JMP ERR
ERRSR, LAC (122123 / ?SR SUBSCRIPT OUT OF RANGE
JMP ERR
ERRNY, LAC (131116 / ?NY CODE NOT YET WRITTEN
JMP ERR
ERRIR, LAC (122111 / ?IR INSUFFICIENT DATA FOR READ
JMP ERR
ERROV, LAC (126117 / ?OV EXPONENT OVERFLOW OR UNDERFLOW
JMP ERR
ERRDO, LAC (117104 / ?DO FUNCTION DOMAIN ERROR
ERR, DAC T9
LAC COL / GET BACK TO LEFT MARGIN
SNA / IF NOT THERE
JMP ERR1
LAW LAW+15
JMS PUTC
LAW LAW+12
JMS PUTC
ERR1, LAW LAW+77 / "?"
JMS PUTC
LAC T9
AND (777
JMS PUTC
LAC T9
RTR
RTR
RTR
RTR
RAR
AND (777
JMS PUTC
LAC LP / IF THERE IS A CURRENT
SNA / LINE PRINT OUT ITS LINE NUMBER
JMP ERR2
LAW LAW+40
JMS PUTC
ISZ LP
LAC I LP
JMS PUTLNO
DZM LP
ERR2, LAW LAW+15
JMS PUTC
LAW LAW+12
JMS PUTC
JMS CSTK
/ COMMAND PROCESSOR
/ READ AND PACK COMMAND LINE
/ IF LNO, ADD LINE TO THE SAVED PROGRAM, DELETING
/ ANY OLD VERSION OF THE LINE
/ IF NO LNO, POINT THE EXECUTION MACHINERY AT
/ THE DIRECT LINE AND START IT UP
CMD, LAC COL / GET BACK TO LEFT MARGIN
SNA / IF NOT THERE
JMP CMD0
LAW LAW+15
JMS PUTC
LAW LAW+12
JMS PUTC
CMD0, LAW LAW+76 / READ A COMMAND
JMS PUTC
LAW LAW+40
JMS PUTC
LAC (CMDB
JMS GETS
JMS PACK / GET LINE NUMBER, PACK TEXT
LAC LNO
SNA
JMP EXE / NO LINE NUMBER, EXECUTE IN DIRECT MODE
SPA / MUST BE BETWEEN 1 AND 9999
JMP ERRLN
TAD (-23420 / -10000
SMA
JMP ERRLN
LAC (BMEM
CMD1, DAC T9 / LOOK FOR LINE
SAD TTXT
JMP CMD5
TAD (1
DAC T0
LAC LNO
CMA
TAD (1
TAD I T0
SNA
JMP CMD2
SMA
JMP CMD5
LAC T9
ADD I T9
JMP CMD1
CMD2, LAC T9 / DELETE LINE IF FOUND
DAC T0
TAD I T9
DAC T1
CMD3, SAD TTXT
JMP CMD4
LAC I T1
DAC I T0
ISZ T0
ISZ T1
LAC T1
JMP CMD3
CMD4, LAC T0 / RESET TOP OF TEXT
DAC TTXT / WHICH CAUSES ALL VARIABLES TO BE LOST
JMS CLR
CMD5, LAC LLEN / IF THE LINE IS AN EMPTY
SAD (1 / LINE DON'T ADD IT TO THE TEXT
JMP CMD
TAD (1
CLL RAR
DAC LLEN
LAC TTXT
DAC T0
TAD LLEN
TAD (2
DAC T1
TAD (-TMEM / CHECK IF ROOM
SMA SZA
JMP ERRMF / NO
LAC T1 / RESET TOP OF TEXT
DAC TTXT / WHICH CAUSES ALL VARIABLES TO BE LOST
JMS CLR
CMD6, LAC T0 / OPEN UP HOLE FOR THE
SAD T9 / NEW LINE'S HEADER AND TEXT
JMP CMD7
TAD (-1
DAC T0
LAC T1
TAD (-1
DAC T1
LAC I T0
DAC I T1
JMP CMD6
CMD7, LAC (2 / BUILD LINE HEADER
TAD LLEN
DAC I T9
ISZ T9
LAC LNO
DAC I T9
LAC (CMDB-1 / COPY IN THE TEXT OF
DAC T0 / THE NEW LINE
LAC LLEN
CMA
TAD (1
DAC T1
CMD8, ISZ T0
ISZ T9
LAC I T0
DAC I T9
ISZ T1
JMP CMD8
JMP CMD
/ EXE JUMPED TO BY CMD TO EXECUTE DIRECT LINE
/ EXE1 JUMPED TO BY THINGS LIKE GOTO
/ EXE2 JUMPED TO BY IF ON TRUE CONDITION AND NOT A GOTO
/ EXE3 JUMPED TO BY END OF STANDARD COMMANDS
/ EXE4 JUMPED TO TO SKIP REST OF LINE
/ THERE ARE TWO COMMAND DISPATCH TABLES
/ THE TABLE AT EXE5 IS USED IN RUN MODE (LP NON-ZERO)
/ THE TABLE AT EXE6 IS USED IN EDITING MODE (LP ZERO)
/ THE TABLES ARE ONLY USED WHEN A STATEMENT
/ BEGINS WITH A TOKEN CODE, BUT THAT'S OK, BECAUSE IF IT
/ DOESN'T BEGIN WITH A TOKEN CODE THEN THE STATEMENT
/ IS AN (IMPLIED) LET, AND LET STATEMENTS ARE ALLOWED IN
/ BOTH RUN MODE AND EDITING MODE
EXE, LAC (CMDB / RESET CP
CLL RAL
DAC CP
JMS ADVNB / GRAB FIRST TOKEN AND
SAD (15 / DUCK OUT FAST IF IT'S A BLANK LINE
JMP CMD
JMP EXE2
EXE1, DAC LP
TAD (2
CLL RAL
DAC CP
EXE1A, JMS GETCC
JMS ADVNB
EXE2, TAD (-200 / TOKEN ?
SPA
JMP LET / NO, ASSUME LET STMT
TAD (EXE5
DAC T9
JMS ADVNB
LAC LP
SZA
JMP I T9
LAC T9
TAD (EXE6-EXE5
DAC T9
JMP I T9
EXE3, LAC C
SAD (72 / ":"
JMP EXE1A
SAD (15
SKP
JMP ERRSN
EXE4, LAC LP
SNA
JMP CMD
TAD I LP
SAD TTXT
SKP
JMP EXE1
DZM LP
JMP CMD
EXE5, JMP DATA / 200 DATA
JMP DEF / 201 DEF
JMP ERRNN / 202 DELETE
JMP DIM / 203 DIM
JMP END / 204 END
JMP FOR / 205 FOR
JMP GOSUB / 206 GOSUB
JMP GOTO / 207 GOTO
JMP IF / 210 IF
JMP INPUT / 211 INPUT
JMP LET / 212 LET
JMP ERRNN / 213 LIST
JMP ERRNN / 214 NEW
JMP NXT / 215 NEXT
JMP PRINT / 216 PRINT
JMP READ / 217 READ
JMP REM / 220 REM
JMP RSTOR / 221 RESTORE
JMP RTRN / 222 RETURN
JMP ERRNN / 223 RUN
JMP ERRSN / 224 STEP
JMP STOP / 225 STOP
JMP ERRSN / 226 THEN
JMP ERRSN / 227 TO
JMP ERRSN / 230 >=
JMP ERRSN / 231 <=
JMP ERRSN / 232 <>
JMP RNDMZ / 233 RANDOMIZE
JMP ERRSN / 234 AND
JMP ERRSN / 235 OR
JMP ERRSN / 236 NOT
JMP ERRSN / 237 FN
JMP ERRSN / 240 TAB
JMP ERRSN / 241 SPC
JMP ERRSN / 242 SGN
JMP ERRSN / 243 RND
JMP ERRSN / 244 SQR
JMP ERRSN / 245 ABS
JMP ERRSN / 246 INT
JMP ERRSN / 247 SIN
JMP ERRSN / 250 COS
JMP ERRSN / 251 ATN
JMP ERRSN / 252 LOG
JMP ERRSN / 253 EXP
JMP ERRSN / 254 TAN
EXE6, JMP ERRNN / 200 DATA
JMP ERRNN / 201 DEF
JMP DEL / 202 DELETE
JMP ERRNN / 203 DIM
JMP ERRNN / 204 END
JMP ERRNN / 205 FOR
JMP ERRNN / 206 GOSUB
JMP ERRNN / 207 GOTO
JMP ERRNN / 210 IF
JMP ERRNN / 211 INPUT
JMP LET / 212 LET
JMP LIST / 213 LIST
JMP NEW / 214 NEW
JMP ERRNN / 215 NEXT
JMP PRINT / 216 PRINT
JMP ERRNN / 217 READ
JMP ERRNN / 220 REM
JMP ERRNN / 221 RESTORE
JMP ERRNN / 222 RETURN
JMP RUN / 223 RUN
JMP ERRSN / 224 STEP
JMP ERRNN / 225 STOP
JMP ERRSN / 226 THEN
JMP ERRSN / 227 TO
JMP ERRSN / 230 >=
JMP ERRSN / 231 <=
JMP ERRSN / 232 <>
JMP ERRNN / 233 RANDOMIZE
JMP ERRSN / 234 AND
JMP ERRSN / 235 OR
JMP ERRSN / 236 NOT
JMP ERRSN / 237 FN
JMP ERRSN / 240 TAB
JMP ERRSN / 241 SPC
JMP ERRSN / 242 SGN
JMP ERRSN / 243 RND
JMP ERRSN / 244 SQR
JMP ERRSN / 245 ABS
JMP ERRSN / 246 INT
JMP ERRSN / 247 SIN
JMP ERRSN / 250 COS
JMP ERRSN / 251 ATN
JMP ERRSN / 252 LOG
JMP ERRSN / 253 EXP
JMP ERRSN / 254 TAN
/ DATA
DATA=EXE4
/ DEF
DEF, LAC C / MUST BE FN
SAD (TFN
SKP
JMP ERRSN
JMS ADVNB
LAC (1 / FOLLOWED BY
JMS GETNAM / AN UNDEFINED SYMBOL
JMS FNDSYM
JMP ERRNN
LAC SYM
DAC T9
LAC C / FOLLOWED BY "(" NAME ")"
SAD (40
JMS ADVNB
SAD (50 / "("
SKP
JMP ERRSN
JMS ADVNB
CLA
JMS GETNAM
JMS FNDSYM
JMP DEF1
JMS ADDSYM
DEF1, LAC C
SAD (40
JMS ADVNB
SAD (51 / ")"
SKP
JMP ERRSN
JMS ADVNB
SAD (40 / THEN BY "=" BODY
JMS ADVNB
SAD (75 / "="
SKP
JMP ERRSN
JMS ADVNB
LAC TVAR / A DEFINED FUNCTION SYMBOL
TAD (6-TMEM / IS 6 WORDS LONG
SMA SZA
JMP ERRMF
LAC (6 / BUILD A SYMBOL TABLE
DAC I TVAR / ENTRY FOR THE DEFINED FUNCTION
ISZ TVAR
LAC T9
DAC I TVAR
ISZ TVAR
LAC VAR / DATA WORD FOR A SIMPLE
TAD (2 / VARIABLE IS 2 WORDS INTO THE
DAC I TVAR / SYMBOL TABLE ENTRY
ISZ TVAR
LAC LP / LP, CP, AND C DESCRIBE
DAC I TVAR / A PLACE IN THE SOURCE TEXT WHICH
ISZ TVAR / WE SIMPLY ASSUME IS THE
LAC CP / START OF A LEGIT FUNCTION BODY
DAC I TVAR / ENDING AT ":" OR CR
ISZ TVAR
LAC C
DAC I TVAR
ISZ TVAR
DEF2, LAC C
SAD (72 / ":"
JMP EXE3
SAD (15
JMP EXE3
JMS ADV
JMP DEF2
/ DELETE
DEL, JMS GETLNO / GET LINE NUMBER
LAC LNO
SNA
JMP ERRSN / SYNTAX ERROR IF NOT THERE
DAC T9 / USE FOR BOTH LIMITS
DAC T8
LAC C
SAD (40
JMS ADVNB
SAD (54 / ","
SKP
JMP DEL1
JMS ADVNB
JMS GETLNO / GET SECOND LINE NUMBER
LAC LNO
SNA
JMP ERRSN / SYNTAX ERROR IF NOT THERE
DAC T8
CMA
TAD (1
TAD T9
SMA SZA
JMP ERRLN / HI < LO
DEL1, LAC (BMEM
DEL2, DAC T7
SAD TTXT
JMP DEL8
DAC T0
ISZ T0
LAC I T0
CMA
TAD (1
TAD T9
SPA SNA
JMP DEL3
LAC T7
TAD I T7
JMP DEL2
DEL3, LAC T7
TAD I T7
DEL4, DAC T6
SAD TTXT
JMP DEL5
DAC T0
ISZ T0
LAC I T0
CMA
TAD (1
TAD T8
SPA
JMP DEL5
LAC T6
TAD I T6
JMP DEL4
DEL5, LAC TTXT
CMA
TAD (1
TAD T6
SNA
JMP DEL7
DAC T0
DEL6, LAC I T6
DAC I T7
ISZ T6
ISZ T7
ISZ T0
JMP DEL6
DEL7, LAC T7
DAC TTXT
DEL8, JMS CLR
JMP EXE3
/ DIM
DIM, JMS GETSYM / NEED AN ARRAY SYMBOL
LAC SYM
SMA
JMP ERRSN
JMS FNDSYM / WHICH HASN'T BEEN DEFINED YET
JMP ERRNN
LAC SYMSUB+0 / SUBSCRIPTS START AT
TAD (1 / 0 AND END AT THE SPECIFIED BOUND, SO
DAC SYMSIZ+0 / THE SIZE IS 1 ITEM BIGGER
LAC SYMSUB+1
TAD (1
DAC SYMSIZ+1
JMS ADDSYM
LAC C / KEEP GOING AS LONG AS IT
SAD (40 / LOOKS LIKE A COMMA SEPARATED LIST
JMS ADVNB
SAD (54 / ","
SKP
JMP EXE3
JMS ADVNB
JMP DIM
/ END
END, LAC C / CHECK FOR END OF LINE
SAD (15
SKP
JMP ERRSN
DZM LP / FORCE IMMEDIATE MODE AND GO BACK
JMP CMD / TO THE COMMAND HANDLER
/ FOR
FOR, CLA / VARIABLE
JMS GETNAM
JMS FNDSYM
JMP FOR1
JMS ADDSYM
FOR1, LAC VAR / FIX VAR SO IT POINTS
TAD (2 / AT THE DATA WORD OF THE VARIABLE
DAC VAR / 2 WORDS IN
LAC FSTKP
FOR2, SAD (FSTK / LOOK THROUGH THE
JMP FOR4 / FOR STACK FOR AN ENTRY WHICH
TAD (-10 / USES THE SAME VARIABLE, AND IF IT IS FOUND,
DAC T0 / DELETE THAT ENTRY AND ANY
LAC I T0 / ENTRIES WHICH LIE ABOVE IT ON THE STACK
SAD VAR
JMP FOR3
LAC T0
JMP FOR2
FOR3, LAC T0
DAC FSTKP
FOR4, LAC FSTKP
SAD (FSTK+[10*NFSTK]
JMP ERRPD
LAC VAR / MAKE NEW FOR STACK ENTRY
DAC I FSTKP
LAC C
SAD (40
JMS ADVNB
SAD (75 / "="
SKP
JMP ERRSN
JMS ADV
JMS GETFAC
LAC I FSTKP / SET VAR TO INITIAL VALUE
JMS FSTA
ISZ FSTKP
LAC C
SAD (40
JMS ADVNB
SAD (TTO
SKP
JMP ERRSN
JMS ADV
JMS GETFAC
LAC FSTKP / SET LOOP LIMIT
JMS FSTA
ISZ FSTKP
ISZ FSTKP
LAC FSTKP / SET DEFAULT STEP (1.0)
DAC T0
LAC F1+0
DAC I T0
ISZ T0
LAC F1+1
DAC I T0
LAC C
SAD (40
JMS ADVNB
SAD (TSTEP
SKP
JMP FOR5
JMS ADV
JMS GETFAC
LAC FSTKP / SET ACTUAL STEP
JMS FSTA
FOR5, ISZ FSTKP
ISZ FSTKP
LAC LP / COPY THE INTERPRETER'S
DAC I FSTKP / WORKING POINTERS
ISZ FSTKP / INTO THE FOR ENTRY; THIS IS WHERE
LAC CP / A NEXT GOES TO RUN ANOTHER
DAC I FSTKP / ITERATION OF THE LOOP
ISZ FSTKP
LAC C
DAC I FSTKP
ISZ FSTKP
JMP NXT4
/ GOSUB, GOTO
GOSUB, JMS GETLNO
LAC C
SAD (40
JMS ADVNB
LAC GSTKP
SAD (GSTK+[3*NGSTK]
JMP ERRPD
LAC LP
DAC I GSTKP
ISZ GSTKP
LAC CP
DAC I GSTKP
ISZ GSTKP
LAC C
DAC I GSTKP
ISZ GSTKP
JMP GO1
GOTO, JMS GETLNO
LAC C
SAD (40
JMS ADVNB
GO1, LAC (BMEM
GO2, DAC T0
SAD TTXT
JMP ERRLN
TAD (1
DAC T1
LAC I T1
SAD LNO
JMP GO3
LAC T0
TAD I T0
JMP GO2
GO3, LAC T0
JMP EXE1
/ IF
IF, JMS GETFAC
JMS FTST / COMPARE TO 0.0
SNA
JMP EXE4 / IF EQ, IF TEST FAILS
LAC C
SAD (40
JMS ADVNB
LAC C
SAD (TGOTO
SKP
JMP IF1
JMS ADVNB
JMP GOTO
IF1, SAD (TTHEN
SKP
JMP ERRSN
JMS ADVNB
LAC C
TAD (-60
SPA
JMP IF2
TAD (-12
SPA
JMP GOTO
IF2, LAC C
JMP EXE2
/ INPUT
INPUT, LAC (15
DAC IC
INPUT1, JMS GETVAR
LAC IC
INPUT2, SAD (15 / THIS CODE LOOKS LIKE
JMP INPUT6 / IT COULD BE UNTWISTED AND WORK
SAD (40 / BETTER WITH ONLY SAD
SKP / SINCE THIS SKP IS A SAD+SKP = SAS
JMP INPUT4
INPUT3, JMS IADV
JMP INPUT2
INPUT4, LAC (IC
DAC GCP
LAC (IADV
DAC GADVP
JMS FGET / READ FLOATING
JMP INPUT5 / NO DATA
LAC IC
SAD (54 / ","
JMS IADV
LAC VAR / SET VARIABLE TO THE
JMS FSTA / TO VALUE READ FROM THE INPUT
LAC C
SAD (40
JMS ADVNB
SAD (54 / ","
SKP
JMP EXE3
JMS ADV
JMP INPUT1
INPUT5, LAW LAW+77
JMS PUTC
LAW LAW+111
JMS PUTC
LAW LAW+111
JMS PUTC
LAW LAW+15
JMS PUTC
LAW LAW+12
JMS PUTC
INPUT6, LAW LAW+77
JMS PUTC
LAW LAW+40
JMS PUTC
LAC (CMDB
JMS GETS
LAC (CMDB
CLL RAL
DAC ICP
JMP INPUT3
IADV, 0
LAC ICP
CLL RAR
DAC T0
ISZ ICP
LAC I T0
SNL
JMP IADV1
RTR
RTR
RTR
RTR
RAR
IADV1, AND (777
DAC IC
JMP I IADV
/ LET
LET, JMS GETVAR
LAC VAR
JMS PSHA
LAC C
SAD (40
JMS ADVNB
SAD (75 / "="
SKP
JMP ERRSN
JMS ADVNB
JMS GETFAC
JMS POPA
JMS FSTA
JMP EXE3
/ LIST
LIST, DZM T6 / T6 IS LO LIMIT, DEFAULT 0
LAC (23420
DAC T7 / T7 IS HI LIMIT, DEFAULT 10000
JMS GETLNO
LAC LNO
SNA
JMP LIST1
DAC T6 / IF THERE IS A LINE NUMBER
DAC T7 / USE IT FOR BOTH LIMITS
LAC C
SAD (40
JMS ADVNB
SAD (54 / ","
SKP
JMP LIST1
JMS ADVNB
JMS GETLNO
LAC LNO / BETTER BE ONE
SNA
JMP ERRSN
DAC T7 / USE IT FOR THE HI LIMIT
CMA / NUMBER, USE IT FOR THE HI LIMIT, AND
TAD (1
TAD T6
SMA SZA
JMP ERRLN / HI < LO
LIST1, LAC (BMEM
LIST2, DAC T9 / T9 IS LINE
SAD TTXT
JMP EXE3
DAC T8 / T8 IS WORKING LINE
ISZ T8 / T8 NOW POINTS AT THE LINE'S NUMBER
LAC T6 / MUST BE >= LO
CMA
TAD (1
TAD I T8
SPA
JMP LIST5
LAC I T8 / AND <= HI
CMA
TAD (1
TAD T7
SPA
JMP LIST5
LAC I T8 / PRINT LINE NUMBER
JMS PUTLNO
LAW LAW+40 / AND A SPACE
JMS PUTC
LIST3, ISZ T8 / PRINT THE TEXT
LAC I T8
AND (777
SAD (15
JMP LIST4
JMS LISTC
LAC I T8
RTR
RTR
RTR
RTR
RAR
AND (777
SAD (15
JMP LIST4
JMS LISTC
JMP LIST3
LIST4, JMS PUTC / END OF LINE, PRINT CR THEN LF
LAW LAW+12
JMS PUTC
LIST5, LAC T9 / ADVANCE T9 TO POINT
TAD I T9 / TO THE START OF THE NEXT LINE
JMP LIST2
LISTC, 0
DAC T0
LAC (KTAB-1
DAC T1
LAC T0
TAD (-200
SPA
JMP LISTC3
SNA
JMP LISTC2
CMA
TAD (1
DAC T2
LISTC1, ISZ T1
LAC I T1
SZA
JMP LISTC1
ISZ T2
JMP LISTC1
LISTC2, ISZ T1
LAC I T1
SNA
JMP LISTC4
JMS PUTC
JMP LISTC2
LISTC3, LAC T0
JMS PUTC
LISTC4, JMP I LISTC
/ NEW
NEW, LAC C / CHECK FOR END OF LINE
SAD (15
SKP
JMP ERRSN
LAC (BMEM / DELETE SOURCE
DAC TTXT
JMS CLR / DELETE VARIABLES
JMP CMD
/ NEXT
NXT, CLA / GET VARIABLE
JMS GETNAM
JMS FNDSYM
JMP NXT1
JMS ADDSYM
NXT1, LAC VAR / POINT VAR AT THE DATA ITEM
TAD (2 / WHICH IS 2 WORDS INTO
DAC VAR / THE SYMBOL
LAC FSTKP
NXT2, SAD (FSTK / LOOK FOR A MATCHING ENTRY
JMP ERRPD / ON THE FOR STACK
TAD (-10 / GIVE ERROR IF ENTRY NOT FOUND
DAC T0
LAC I T0
SAD VAR
JMP NXT3
LAC T0
DAC FSTKP
JMP NXT2
NXT3, LAW 3-10 / STEP
TAD FSTKP
JMS FLDO / VAR = VAR + STEP
LAC VAR
JMS FLDA
JMS FADD
LAC VAR
JMS FSTA
NXT4, LAW 1-10 / LIMIT
TAD FSTKP
JMS FLDO / LOAD LIMIT INTO FOP
LAW 3-10 / STEP
TAD FSTKP
JMS FLDA / I COULD CHEAT A LITTLE AND
JMS FTST / JUST LOOK AT THE SIGN BIT OF THE
SPA / FIRST WORD, I SUPPOSE
JMP NXT6
LAC VAR / STEP>0, LOOP IF VAR<=LIMIT
JMS FLDA
JMS FCMP
SMA SZA
JMP EXE3 / NO LOOP
JMP NXT8 / LOOP
NXT6, LAC VAR / STEP<0, LOOP IF VAR>=LIMIT
JMS FLDA
JMS FCMP
SPA
JMP EXE3 / NO LOOP
NXT8, LAW 5-10 / POINTERS
TAD FSTKP
DAC T0
LAC I T0 / RESET THE POINTERS TO
DAC LP / MAKE CONTROL RESUME RIGHT AFTER
ISZ T0 / TO FOR OF THE LOOP
LAC I T0
DAC CP
ISZ T0
LAC I T0
DAC C
JMP EXE3
/ PRINT
PRINT, LAC C
SAD (72 / ":"
JMP PR8
SAD (15
JMP PR8
PR1, SAD (42 / """
SKP
JMP PR4
PR2, JMS ADV
SAD (42 / """
JMP PR3
SAD (15
JMP ERRSN
JMS PUTC
JMP PR2
PR3, JMS ADVNB
JMP PR5
PR4, SAD (TTAB / TAB(X)
SKP
JMP PR4A
LAC COL
JMP PR4B
PR4A, SAD (TSPC / SPC(X)
SKP
JMP PR4E
CLA
PR4B, JMS PSHA / SAVE COL (TAB) OR 0 (SPC)
JMS ADVNB
SAD (50 / "("
SKP
JMP ERRSN
JMS ADVNB
JMS GETFAC
LAC C
SAD (40
JMS ADVNB
SAD (51 / ")"
SKP
JMP ERRSN
JMS ADVNB
JMS POPA / THIS COMPUTES NEG(VAL-COL) FOR TAB(X)
DAC T9 / AND NEG(VAL) FOR SPC(X)
JMS FFIX
CMA
TAD (1
TAD T9
SNA
JMP PR5
SPA
JMP PR4C
LAW LAW+15 / IF X
"
JMP GETV3
SAD (74 / "<"
JMP GETV4
SAD (TLE / "<="
JMP GETV5
SAD (TGE / ">="
JMP GETV6
SAD (76 / ">"
JMP GETV7
JMP GETV90
GETV2, JMS ADVNB
JMS FPSHA
JMS GETV10
JMS FMOVO
JMS FPOPA
JMS FCMP
SNA
JMP GETV9 / 1.0
JMP GETV8 / 0.0
GETV3, JMS ADVNB
JMS FPSHA
JMS GETV10
JMS FMOVO
JMS FPOPA
JMS FCMP
SZA
JMP GETV9 / 1.0
JMP GETV8 / 0.0
GETV4, JMS ADVNB
JMS FPSHA
JMS GETV10
JMS FMOVO
JMS FPOPA
JMS FCMP
SPA
JMP GETV9 / 1.0
JMP GETV8 / 0.0
GETV5, JMS ADVNB
JMS FPSHA
JMS GETV10
JMS FMOVO
JMS FPOPA
JMS FCMP
SPA SNA
JMP GETV9 / 1.0
JMP GETV8 / 0.0
GETV6, JMS ADVNB
JMS FPSHA
JMS GETV10
JMS FMOVO
JMS FPOPA
JMS FCMP
SMA
JMP GETV9 / 1.0
JMP GETV8 / 0.0
GETV7, JMS ADVNB
JMS FPSHA
JMS GETV10
JMS FMOVO
JMS FPOPA
JMS FCMP
SMA SZA
JMP GETV9 / 1.0
GETV8, LAC (F0 / 0.0
JMP GETV9A
GETV9, LAC (F1
GETV9A, JMS FLDA
JMP GETV1
GETV10, 0
LAC GETV10
JMS PSHA
JMS GETV20
GETV11, LAC C
SAD (40
JMS ADVNB
SAD (53 / "+"
JMP GETV12
SAD (55 / "-"
JMP GETV13
JMP GETV90
GETV12, JMS ADVNB
JMS FPSHA
JMS GETV20
JMS FMOVO
JMS FPOPA
JMS FADD
JMP GETV11
GETV13, JMS ADVNB
JMS FPSHA
JMS GETV20
JMS FMOVO
JMS FPOPA
JMS FSUB
JMP GETV11
GETV20, 0
LAC GETV20
JMS PSHA
JMS GETV30
GETV21, LAC C
SAD (40
JMS ADVNB
SAD (52 / "*"
JMP GETV22
SAD (57 / "/"
JMP GETV23
JMP GETV90
GETV22, JMS ADVNB
JMS FPSHA
JMS GETV30
JMS FMOVO
JMS FPOPA
JMS FMUL
JMP GETV21
GETV23, JMS ADVNB
JMS FPSHA
JMS GETV30
JMS FMOVO
JMS FPOPA
JMS FDIV
JMP GETV21
GETV30, 0
LAC GETV30
JMS PSHA
JMS GETV40
GETV31, LAC C
SAD (40
JMS ADVNB
SAD (136 / "^"
JMP GETV32
JMP GETV90
GETV32, JMS ADVNB
JMS FPSHA
JMS GETV40
JMS FMOVO
JMS FPOPA
JMS FPOW
JMP GETV31
GETV40, 0
LAC GETV40
JMS PSHA
LAC C
SAD (40
JMS ADVNB
SAD (50 / "("
JMP GETV42
SAD (53 / "+" (UNARY)
JMP GETV43
SAD (55 / "-" (UNARY)
JMP GETV44
SAD (TNOT / NOT
JMP GETV49
SAD (TFN / FN
JMP GETV52
TAD (-TSGN / BUILT IN FUNCTIONS ALL HAVE
SMA / TOKEN CODES >= TSGN
JMP GETV45
LAC (C / FLOATING POINT NUMBER ?
DAC GCP
LAC (ADV
DAC GADVP
JMS FGET
JMP GETV41 / NO
JMP GETV90 / YES
GETV41, JMS GETVAR / LAST CHANCE, READ AND
LAC VAR / EXTRACT THE VALUE OF A VARIABLE
JMS FLDA
JMP GETV90
GETV42, JMS ADVNB / "(" E ")"
JMS GETFAC
LAC C
SAD (40
JMS ADVNB
SAD (51 / ")"
SKP
JMP ERRSN
JMS ADVNB
JMP GETV90
GETV43, JMS ADVNB / "+" E
JMS GETV40
JMP GETV90
GETV44, JMS ADVNB / "-" E
JMS GETV40
JMS FNEG
JMP GETV90
GETV45, JMS PSHA / SAVE FUNCTION INDEX
JMS ADVNB
SAD (50 / "("
SKP
JMP ERRSN
JMS ADVNB
JMS GETFAC
LAC C / " "
SAD (40
JMS ADVNB
SAD (51 / ")"
SKP
JMP ERRSN
JMS ADVNB
JMS POPA / RESTORE FUNCTION INDEX
TAD (GETV46 / GET ADDRESS OF THE FUNCTION'S CODE
DAC T0
LAC I T0
DAC T0 / CALL THE FUNCTION
JMS I T0
JMP GETV90
GETV46, FSGN / MUST BE IN THE SAME ORDER AS THE TOKENS
FRND
FSQR
FABS
FINT
FSIN
FCOS
FATN
FLN
FEXP
FTAN
GETV49, JMS ADVNB / "NOT" E
JMS GETV40
JMS FTST
SZA
JMP GETV50
LAC (F1
JMP GETV51
GETV50, LAC (F0
GETV51, JMS FLDA
JMP GETV90
GETV52, JMS ADVNB / "FN" N "(" E ")"
LAC (1
JMS GETNAM
JMS FNDSYM
SKP
JMP ERRNN / CALL OF UNDEFINED FUNCTION
LAC VAR / ADR OF VAR
JMS PSHA
LAC C
SAD (40
JMS ADVNB
SAD (50 / "("
SKP
JMP ERRSN
JMS ADVNB
JMS GETFAC / READ THE ARG
LAC C
SAD (40
JMS ADVNB
SAD (51 / ")"
SKP
JMP ERRSN
JMS ADVNB
JMS POPA / AC IS ADR OF VAR
TAD (2 / AC IS ADR OF ADR OF DATA OF FORMAL
DAC T1
LAC I T1 / AC IS ADR OF DATA OF FORMAL
DAC T0
LAC I T0 / SAVE DATA+0
JMS PSHA
ISZ T0
LAC I T0 / SAVE DATA+1
JMS PSHA
LAC T0 / SAVE ADR OF DATA+1 OF FORMAL
JMS PSHA
LAC I T1 / AC IS ADR OF DATA OF FORMAL
JMS FSTA / ARG TO DATA OF FORMAL
ISZ T1
LAC LP / SAVE LP, CP, C ON THE
JMS PSHA / STACK, AND RESET THEM TO THE VALUES
LAC I T1 / IN THE SYMBOL TABLE
DAC LP
ISZ T1
LAC CP
JMS PSHA
LAC I T1
DAC CP
ISZ T1
LAC C
JMS PSHA
LAC I T1
DAC C
JMS GETFAC / EVALUATE FUNCTION BODY EXPRESSION
LAC C
SAD (40
JMS ADVNB
SAD (72 / ":"
SKP
SAD (15 / END OF LINE
SKP
JMP ERRSN
JMS POPA / RESTORE C, CP, LP
DAC C
JMS POPA
DAC CP
JMS POPA
DAC LP
JMS POPA / ADR OF DATA+1 OF FORMAL
DAC T0
JMS POPA / RESTORE DATA+1
DAC I T0
LAW -1 / ADR OF DATA+0 OF FORMAL
TAD T0
DAC T0
JMS POPA / RESTORE DATA+0
DAC I T0
JMP GETV90
GETV90, JMS POPA / JUMP TO HERE TO
DAC T0 / POPJ BACK TO THE CALLER
JMP I T0
/ READ VARIABLE, POSSIBLY SUBSCRIPTED
/ THE ADDRESS OF THE CELL HOLDING
/ THE VARIABLE'S DATA IS RETURNED IN THE
/ GLOBAL VARIABLE "VAR"
/ FOR 1 DIMENSION ARRAY, BASE + SUB1
/ FOR 2 DIMENSION ARRAY, BASE + SIZ1*SUB2 + SUB1
/ IN THE SYM, SIZ2 IS BEFORE SIZ1
/ THIS IS A LITTLE ODD, BUT IT IMPROVES THE CODE
GETVAR, 0
LAC GETVAR
JMS PSHA
JMS GETSYM
JMS FNDSYM
JMP GETVR1
LAC (13
DAC SYMSIZ+0
DAC SYMSIZ+1
JMS ADDSYM
GETVR1, ISZ VAR / STEP OVER LENGTH
ISZ VAR / STEP OVER NAME
LAC SYM
SMA
JMP GETVR4
RAL
SMA
JMP GETVR2
LAC SYMSUB+1 / BOUND CHECK
SPA / FOR THE SECOND SUBSCRIPT
JMP ERRSR
CMA
TAD (1
TAD I VAR
SPA SNA
JMP ERRSR
ISZ VAR / STEP OVER SECOND SUBSCRIPT
GETVR2, LAC SYMSUB+0 / BOUND CHECK
SPA / FOR THE FIRST SUBSCRIPT
JMP ERRSR
CMA
TAD (1
TAD I VAR
SPA SNA
JMP ERRSR
LAC SYM
RAL
SMA
JMP GETVR3
LAC SYMSUB+1
DAC T0
LAC I VAR / STRIDE
JMS IMUL
CLL RAL / EACH ENTRY IS 2 WORDS
TAD VAR
DAC VAR
GETVR3, LAC SYMSUB+0
CLL RAL / EACH ENTRY IS 2 WORDS
TAD VAR
DAC VAR
ISZ VAR / STEP OVER THE FIRST SUBSCRIPT
GETVR4, JMS POPA
DAC T0
JMP I T0
/ READ SYMBOL, POSSIBLY SUBSCRIPTED
/ THE SYMBOL'S NAME IS RETURNED IN SYM+0, A MASK
/ WHICH IS USED BY FNDSYM WHEN MATCHING NAMES IN SYM+1,
/ AND THE SUBSCRIPTS, IF PRESENT, IN SYMSUB+0 AND SYMSUB+1
/ THE MASK IS 637777 FOR SIMPLE VARIABLES, AND
/ 437777 FOR SUBSCRIPTED VARIABLES
GETSYM, 0
LAC GETSYM
JMS PSHA
CLA / READ SIMPLE NAME, SET
JMS GETNAM / MASK TO 637777
LAC C
SAD (40
JMS ADVNB
SAD (50 / "("
SKP
JMP GETSY5
JMS ADVNB
LAC SYM / THERE IS NO NEED TO SAVE
TAD (400000 / SYM+1 BECAUSE IT GETS
JMS PSHA / ASSIGNED LATER ON IN THE ROUTINE
JMS GETFAC
JMS FFIX
DAC T9
LAC C
SAD (40
JMS ADVNB
SAD (54 / ","
SKP
JMP GETSY4
JMS ADVNB
JMS POPA
TAD (200000
JMS PSHA
LAC T9
JMS PSHA
JMS GETFAC
JMS FFIX
DAC SYMSUB+1
JMS POPA
DAC T9
GETSY4, LAC T9
DAC SYMSUB+0
JMS POPA
DAC SYM
LAC C
SAD (40
JMS ADVNB
SAD (51 / ")"
SKP
JMP ERRSN
JMS ADVNB
LAC (437777
DAC SYM+1
GETSY5, JMS POPA
DAC T0
JMP I T0
/ READ SIMPLE SYMBOL AND SET TYPE BITS
/ ON ENTRY AC [01..00] HOLDS THE VALUE WHICH WILL
/ END UP IN SYM [17..16] (00 IF NORMAL, 01 IF FUNCTION)
/ ON EXIT SYM+0 HOLDS THE SYMBOL, AND SYM+1 HOLDS 637777,
/ WHICH IS APPROPRIATE FOR SIMPLE SYMBOLS
GETNAM, 0
DAC T1
LAC C
SAD (40
JMS ADVNB
TAD (-101
SPA
JMP ERRSN
TAD (-32
SMA
JMP ERRSN
LAC C
DAC SYM
GETNM1, JMS ADV
TAD (-60
SPA
JMP GETNM3
TAD (-12
SPA
JMP GETNM2
TAD (-7
SPA
JMP GETNM3
TAD (-32
SMA
JMP GETNM3
GETNM2, LAC SYM
AND (037600
SZA
JMP GETNM1
LAC C
CLL RTL
RTL
RTL
RAL
TAD SYM
DAC SYM
JMP GETNM1
GETNM3, LAC T1 / MERGE IN TYPE
CLL RTR
RAR
TAD SYM
DAC SYM
LAC (637777 / AND SET SIMPLE MASK
DAC SYM+1
JMP I GETNAM
/ LOOK UP THE SYMBOL WHOSE NAME
/ IS IN SYM+0 AND WHOSE MASK IS IN SYM+1; IF THE
/ SYMBOL IS FOUND RETURN CALL+1 WITH THE
/ ADDRESS OF THE SYMBOL IN THE GLOBAL
/ VARIABLE VAR, AND RETURN CALL+2 IF THE
/ SYMBOL IS NOT FOUND
FNDSYM, 0
LAC TTXT
FNDS1, DAC VAR
SAD TVAR
JMP FNDS2
TAD (1
DAC T0
LAC I T0
XOR SYM
AND SYM+1
SNA
JMP FNDS3
LAC VAR
TAD I VAR
JMP FNDS1
FNDS2, ISZ FNDSYM
FNDS3, JMP I FNDSYM
/ ADD A NEW SYMBOL TO THE SYMBOL TABLE
/ THE NAME IS IN THE GLOBAL VARIABLE
/ "SYM" AND THE ARRAY SIZES, IF PRESENT, ARE
/ IN THE GLOBAL VARIABLES "SYMSIZ+0" AND
/ "SYMSIZ+1"; THE ADDRESS OF THE
/ NEW SYMBOL IS RETURNED IN THE GLOBAL "VAR"
ADDSYM, 0
LAC (2 / 2 WORDS
DAC T2
LAC (4 / 2 + 2 WORDS
DAC T3
LAC SYM
SMA
JMP ADDS1
LAC SYMSIZ+0 / 2*DIM0 WORDS
CLL RAL
DAC T2
TAD (3 / 2 + 1 + 2*DIM0 WORDS
DAC T3
LAC SYM
RAL
SMA
JMP ADDS1
LAC SYMSIZ+1 / 2*DIM0*DIM1 WORDS
DAC T0
LAC SYMSIZ+0
JMS IMUL
CLL RAL
DAC T2
TAD (4 / 2 + 2 + 2*DIM0*DIM1 WORDS
DAC T3
ADDS1, LAC TVAR / ERRMF IF TVAR+T3 > TMEM
TAD T3
CMA
TAD (1+TMEM
SPA
JMP ERRMF
LAC TVAR
DAC VAR
LAC T3
DAC I TVAR
ISZ TVAR
LAC SYM
DAC I TVAR
ISZ TVAR
SMA
JMP ADDS3
RAL
SMA
JMP ADDS2
LAC SYMSIZ+1
DAC I TVAR
ISZ TVAR
ADDS2, LAC SYMSIZ+0
DAC I TVAR
ISZ TVAR
ADDS3, LAC T2
CMA
TAD (1
DAC T2
ADDS4, DZM I TVAR / 0.0 IS 2*000000
ISZ TVAR
ISZ T2
JMP ADDS4
JMP I ADDSYM
/ AC = AC * T0
IMUL, 0
SMA CLL
JMP IMUL1
CMA CML
TAD (1
IMUL1, DAC T2
DZM T1
LAC T0
SNA
JMP IMUL4
SMA
JMP IMUL2
CMA CML
TAD (1
DAC T0
IMUL2, LAW -22
DAC T3
IMUL3, LAC T2
RAR
DAC T2
LAC T1
SZL
TAD T0
CLL RAR
DAC T1
ISZ T3
JMP IMUL3
LAC T2
RAR
SNL
JMP IMUL4
CLL CMA
TAD (1
DAC T2
LAC T1
SZL CMA
TAD (1
DAC T1
LAC T2
IMUL4, JMP I IMUL
/ GET LINE NUMBER
/ CP/C SHOULD DESCRIBE FIRST CHARACTER OF
/ THE POSSIBLE NUMBER (LEADING BLANKS WILL GET SKIPPED)
/ AT THE END, LNO HOLDS THE NUMBER, AND CP/C DESCRIBE
/ THE DELIMITER; LNO IS 0 IF NO NUMBER
GETLNO, 0
LAC C
SAD (40
JMS ADVNB
DZM LNO
TAD (-60
SPA
JMP GETLN2
TAD (-12
SMA
JMP GETLN2
GETLN1, LAC LNO
CLL RTL
TAD LNO
RAL
TAD C
TAD (-60
DAC LNO
JMS ADV
TAD (-60
SPA
JMP GETLN2
TAD (-12
SPA
JMP GETLN1
GETLN2, JMP I GETLNO
/ PUTDEC
/ PUT DECIMAL NUMBER
/ PUTLNO
/ PUT DECIMAL LINE NUMBER (4 DIGITS, LEADING ZEROS)
/ DOES BAD THINGS IF N<0 OR N>9999
PUTDEC, 0
DAC T3
LAC (PUTD7
DAC T5
DZM T4
JMP PUTD1
PUTLNO, 0
DAC T3
LAC (PUTD8
DAC T5
DAC T4
LAC PUTLNO
DAC PUTDEC
PUTD1, LAC T3
SMA
JMP PUTD2
CMA
TAD (1
DAC T3
LAW LAW+55
JMS PUTC
PUTD2, DZM T2
LAC T3
PUTD3, TAD I T5
SPA
JMP PUTD4
DAC T3
ISZ T2
JMP PUTD3
PUTD4, LAC T2 / CHECK IF BOTH THE
TAD T4 / DIGIT AND THE NON-ZERO SEEN
SNA / FLAG ARE ZERO
JMP PUTD5
DAC T4
LAW LAW+60
TAD T2
JMS PUTC
PUTD5, ISZ T5
LAC T5
SAD (PUTD9+1
SKP
JMP PUTD2
LAW LAW+60
TAD T3
JMS PUTC
JMP I PUTDEC
PUTD7, -303240 / -100000
-23420 / -10000
PUTD8, -1750 / -1000
-144 / -100
PUTD9, -12 / -10
/ PACK TEXT, CMDB TO CMDB
/ LINE NUMBER STRIPPED AND RETURNED IN LNO (LNO IS 0 IF NO NUMBER)
/ LENGTH OF PACKED LINE IN CMDB IS RETURNED IN LLEN
/ PACKED TEXT IS LO THEN HI
/ TOKENS MUST HAPPEN AT THE BEGINNING OF A BLOCK OF ALPHA
/ CHARACTERS, AND MUST END ON A NON-ALPHA CHARACTER, SO THAT "XTOY" IS
/ XTOY, BUT "X TO Y" IS X+TO+Y
PACK, 0
LAC (2*CMDB
DAC CP / CP IS SRC
DAC T9 / T9 IS DST
JMS ADVNB
JMS GETLNO
LAC LNO / WAS THERE A LINE NUMBER ?
SNA
JMP PACK3 / NO
LAC C / YES, SKIP BLANKS BETWEEN
SAD (40 / THE LINE NUMBER AND
JMS ADVNB / THE FIRST CHARACTER OF THE LINE
PACK3, LAC C
SAD (42 / STRING ?
JMP PACK12 / YES
LAC CP / MATCH LOOP
DAC T7 / FIRST SAVE CP AND C SO THEY
LAC C / CAN BE BACKED UP ON MATCH FAILURE
DAC T6
LAC (KTAB-1
DAC T5 / T5 IS TOKEN TABLE POINTER
LAC (200
DAC T4 / T4 IS TOKEN CODE
LAW -NTOKEN
DAC T3 / T3 IS OUTER LOOP CONTROL
PACK6, ISZ T5 / GET CHAR FROM CURRENT TABLE ENTRY
LAC I T5
SNA
JMP PACK7 / END OF ENTRY, MIGHT MATCH
SAD C / MATCH ?
SKP
JMP PACK8 / NO, FORGET THIS ENTRY
JMS ADV
JMP PACK6
PACK7, LAC T4 / SOME TOKENS ALWAYS MATCH
SAD (TFN / "FN"
JMP PACK11
SAD (TGE / ">="
JMP PACK11
SAD (TLE / "<="
JMP PACK11
SAD (TNE / "<>"
JMP PACK11
JMS PACKA / ALPHA DELIMITER ?
JMP PACK11 / NO, MATCH
PACK8, LAC I T5 / SKIP OVER REST OF ENTRY
SNA
JMP PACK9
ISZ T5
JMP PACK8
PACK9, LAC T7 / BACK UP SCAN
DAC CP
LAC T6
DAC C
ISZ T4 / NEXT TOKEN
ISZ T3 / LOOP UNTIL ALL TRIED
JMP PACK6
LAC C / NOT A MATCH, END OF LINE ?
SAD (15
JMP PACK16 / YES
JMS PACKC / NO, STORE CHARACTER
JMS PACKA / ALPHA ?
JMP PACK14 / NO, ADVANCE
PACK10, JMS ADV / COPY FOLLOWING ALPHA
JMS PACKA
JMP PACK3 / DONE
LAC C
JMS PACKC
JMP PACK10
PACK11, LAC T4 / STORE TOKEN CODE
JMS PACKC
JMP PACK3
PACK12, JMS PACKC / FLAG AND STORE STRING QUOTE
PACK13, JMS ADV
SAD (15 / END OF LINE ?
JMP PACK16 / YES
JMS PACKC
LAC C
SAD (42 / DID WE JUST STORE STRING QUOTE ?
JMP PACK14 / YES
JMP PACK13 / NO, KEEP COPYING STRING
PACK14, JMS ADV
JMP PACK3
PACK16, JMS PACKC / END OF LINE
LAC T9 / WORK OUT LENGTH IN CHARACTERS
TAD (-2*CMDB
DAC LLEN
JMP I PACK
PACKA, 0
LAW -101 / "A"
TAD C
SPA
JMP PACKA1
LAW -133 / "Z" + 1
TAD C
SPA
ISZ PACKA / RTN+2, ALPHA
PACKA1, JMP I PACKA / RTN+1, NON-ALPHA
PACKC, 0
DAC T0
LAC T9
CLL RAR
DAC T1
SZL
JMP PACKC1
LAC I T1 / LO 9 BITS
AND (777000
JMP PACKC2
PACKC1, LAC T0 / HI 9 BITS
CLL RTL
RTL
RTL
RTL
RAL
DAC T0
LAC I T1
AND (777
PACKC2, TAD T0
DAC I T1
ISZ T9
JMP I PACKC
/ GET CHARACTER POINTED TO BY CP
/ ON RETURN CHARACTER IS IN AC AND IN C
/ CP HOLDS 2*ADDRESS+POS, WHERE POS IS 0 FOR LOW
/ HALF AND 1 FOR HIGH HALF
ADV, 0
LAC CP
CLL RAR
DAC T0
ISZ CP
LAC I T0
SNL
JMP ADV1
RTR
RTR
RTR
RTR
RAR
ADV1, AND (777
DAC C
JMP I ADV
/ GET CHARACTER POINTED TO BY CP, SKIPPING BLANKS
/ ON RETURN CHARACTER IS IN AC AND IN C
/ CP HOLDS 2*ADDRESS+POS, WHERE POS IS 0 FOR LOW
/ HALF AND 1 FOR HIGH HALF
ADVNB, 0
ADVNB1, LAC CP
CLL RAR
DAC T0
ISZ CP
LAC I T0
SNL
JMP ADVNB2
RTR
RTR
RTR
RTR
RAR
ADVNB2, AND (777
SAD (40
JMP ADVNB1
DAC C
JMP I ADVNB
/ GET STRING, WITH ERASE AND KILL PROCESSING
/ ON ENTRY AC = ADDRESS OF BUFFER
/ THE STRING WILL BE TERMINATED BY A CR
/ BYTES ARE PACKED LITTLE-ENDIAN, SO THE LOW HALF
/ OF THE WORD CONTAINS THE FIRST CHARACTER
/ THIS ROUTINE ECHOS ERASE AS BS-SP-BS (OR 2 X BS-SP-BS, IF
/ THE CHARACTER BEING DELETED IS A CONTROL CHARACTER)
/ AND KILL AS ENOUGH BS-SP-BS TO WIPE OUT THE ENTILE OLD LINE,
/ SO THE TERMINAL HAS TO BE A SCOPE
/ NOTE THAT THIS ROUTINE IS ONLY CALLED WITH GETB AS AN
/ ARGUMENT, SO IT WOULD BE EASY TO MAKE THE CLAIN
/ THAT IT COULD BE CALLED WITH A JMS AND ALWAYS USE CMDB
GETS, 0
CLL RAL
DAC T9
DAC T8
GETS1, JMS GETC
SAD (177 / ERASE
JMP GETS3
SAD (25 / KILL
JMP GETS4
DAC T7
LAC T8
CLL RAR
DAC T0
ISZ T8
LAC (777000
SZL
LAC (777
AND I T0
DAC I T0
LAC T7
SNL
JMP GETS2
CLL RTL
RTL
RTL
RTL
RAL
GETS2, TAD I T0
DAC I T0
LAC T7
JMS PUTC
LAC T7
SAD (15
SKP
JMP GETS1
LAW LAW+12
JMS PUTC
JMP I GETS
GETS3, LAC T8
SAD T9
JMP GETS1
JMS GETS5
JMP GETS1
GETS4, LAC T8
SAD T9
JMP GETS1
JMS GETS5
JMP GETS4
GETS5, 0
LAW -1
TAD T8
DAC T8
CLL RAR
DAC T0
LAC I T0
SNL
JMP GETS6
CLL RTR
RTR
RTR
RTR
RAR
GETS6, AND (777
TAD (-40
SPA
JMS GETS7
JMS GETS7
JMP I GETS5
GETS7, 0
LAW LAW+10
JMS PUTC
LAW LAW+40
JMS PUTC
LAW LAW+10
JMS PUTC
JMP I GETS7
/ GET CHARACTER FROM CONSOLE
/ ON RETURN AC = CHARACTER
/ EVERY TIME GETC WAITS FOR A CHARACTER TO
/ BE TYPED THE RNDS COUNTER IS INCREMENTED; THE VALUE
/ OF RNDS IS USED BY RANDOMIZE TO SET THE
/ CURRENT RANDOM NUMBER TO A VALUE WHICH IS, FOR
/ ALL PRACTICAL PURPOSES, UNKNOWN
GETC, 0
GETC1, LAC GETOX
SAD GETIX
JMP GETC2
TAD (1
AND (GETBM
DAC GETOX
TAD (GETB
DAC T0
LAC I T0
JMP I GETC
GETC2, ISZ RNDS
NOP
JMS GETCC
JMP GETC1
/ POLL FOR ^C CHARACTERS
/ IF ^C, JUMP DIRECTLY TO ERRCC
/ IF NOT, STASH CHARACTER INTO RING BUFFER FOR
/ FUTURE USE BY GETC
GETCC, 0
KSF
JMP GETCC1
KRB
AND (177
DAC T0
SAD (3
JMP ERRCC
LAC GETIX
TAD (1
AND (GETBM
SAD GETOX
JMP GETCC1
DAC GETIX
TAD (GETB
DAC T1
LAC T0
DAC I T1
GETCC1, JMP I GETCC
/ PUT CHARACTER ONTO CONSOLE
/ AC = CHARACTER
/ THROW AWAY CONTROL CHARACTERS EXCEPT FOR
/ BACKSPACE, CARRIAGE RETURN, LINEFEED
/ ALSO UPDATE THE CURRENT HORIZONTAL POSITION
/ FOR USE BY PRINT FIELDS AND SUCH
/ THE SUPPLIED CHARACTER IS MASKED WITH
/ 777 TO ALLOW "LAW CH; JMS PUTC" TO WORK
PUTC, 0
AND (777
SAD (10
JMP PUTC1
SAD (15
JMP PUTC2
SAD (12
JMP PUTC3
TAD (-40
SPA
JMP PUTC4
TAD (40
ISZ COL
JMP PUTC3
PUTC1, LAC COL
SNA
JMP PUTC4
TAD (-1
DAC COL
LAW LAW+10
JMP PUTC3
PUTC2, DZM COL
PUTC3, TSF
JMP PUTC3
TLS
PUTC4, JMP I PUTC
/ ABSVAL
/ FAC = FABS(FAC)
FABS, 0
DZM FAC+0 / FORCE SIGN POSITIVE
JMP I FABS
/ SIGNUM
/ FAC = FSGN(FAC)
FSGN, 0
JMS FTST
SPA
CLA CMA / -1
SMA SZA
LAC (1 / +1
JMS FFLT
JMP I FSGN
/ SQUARE ROOT
/ FAC = SQRT(FAC)
/ ?DO IF FAC<0 ON CALL
FSQR, 0
JMS FTST / ERROR IF FAC<0
SPA
JMP ERRDO
LAC (T6
JMS FSTA
LAC FAC+1 / INITIAL X(I) IS 0.F*2^(E/2)
SPA CLL
CML
RAR
DAC FAC+1
FSQR1, LAC (T8 / UPDATE C(I)
JMS FSTA
JMS FMOVO / X(I+1) = (ARG/X(I)+X(I))/2
LAC (T6
JMS FLDA
JMS FDIV
LAC (T8
JMS FLDO
JMS FADD
LAC (F2
JMS FLDO
JMS FDIV
LAC (T8
JMS FLDO / X(I+1) = X(I) ?
JMS FCMP
SZA
JMP FSQR1 / NO, AGAIN
JMP I FSQR
/ LAGGED FIBONACCI RANDOM NUMBER USING ROTATES
/ THEORY CLAIMS TO BE AT WWW.AGNER.ORG/RANDOM/RANROT.HTM
/ FORMULA IS X[N] = (ROTL(X[N-10], 5)+ROTL(X[N-17], 3)) MOD 2**18
/ FRNDP2 IS N-10, FRNDP1 IS N AND N-17
/ THIS WORKS BECAUSE FRNDB IS 17 WORDS LONG
/ THE (UNSIGNED) INT 0 <= N < 2**18 IS THEN CONVERTED INTO A
/ FLOAT IN THE RANGE 0 <= F < 1 BY SIMPLE SCALING; NOTE THAT THE
/ CONVERSION FROM INT TO FLOAT IS DONE BY HAND BECAUSE
/ FFIX DEALS WITH SIGNED (NOT UNSIGNED) INTS
/ SFRND IS CALLED TO SEED THE GENERATOR WITH A SEED IN AC
FRND, 0
DZM FAC+0
LAC (21 / 17
DAC FAC+1
LAC I FRNDP2 / A = ROTL(FRNDB[FRNDP2], 5)
SPA CLL
CML
RTL
RTL
RAL
DAC T0
LAC I FRNDP1 / B = ROTL(FRNDB[FRNDP1], 3)
SPA CLL
CML
RTL
RAL
TAD T0 / FRNDB[FRNDP1] = (A+B) MOD 2**18
DAC I FRNDP1
DAC FAC+2
DZM FAC+3
LAW -1 / DECREMENT FRANP1 AND FRANP2,
TAD FRNDP1 / WRAPPING THEM AROUND WHEN THEY FALL
SAD (FRNDB-1 / OFF THE FRONT OF FRANB
TAD (21
DAC FRNDP1
LAW -1
TAD FRNDP2
SAD (FRNDB-1
TAD (21
DAC FRNDP2
JMS FNAR / 0 <= FAC < 2**18
LAC (FRNDSF
JMS FLDO
JMS FMUL / 0 <= FAC < 1
JMP I FRND
SFRND, 0
DAC T0
LAC (FRNDB-1
DAC X0
LAW -21
DAC T1
LAC T0
SFRND1, DAC I X0
SPA CLL / ROTL(AC, 5) + 97
CML
RTL
RTL
RAL
TAD (141
ISZ T1
JMP SFRND1
LAC (FRNDB
DAC FRNDP1
LAC (FRNDB+12
DAC FRNDP2
JMP I SFRND
FRNDB, BSS 21
FRNDP1, BSS 1
FRNDP2, BSS 1
FRNDSF, 200000 / 1 / 2**18
000357
/ POWERS, PART 1
/ FAC = FPOW(FAC, FOP)
/ COMPUTE FAC^FOP FOR ARBITRARY FOP; IF FOP IS
/ AN INTEGER PASS THE WORK OFF TO FIPOW AND COMPUTE FAC^FOP
/ BY REPEATED MULTIPLICATIONS, OTHERWISE COMPUTE FAC^FOP
/ AS EXP(FOP*LN(FAC)), WHICH RESTRICTS FAC TO VALUES GREATER THAN
/ ZERO, BECAUSE THAT'S WHERE LN(X) IS ACTUALLY DEFINED.
FPOW, 0
JMS FPSHA / SAVE X
JMS FMOVA / IS Y AN INTEGER ?
JMS FINT
JMS FCMP
SNA
JMP FPOW1 / YES
JMS FPOPA / NO, EXP(Y*LN(X))
JMS FPSHO
JMS FLN
JMS FPOPO
JMS FMUL
JMS FEXP
JMP FPOW2
FPOW1, JMS FPOPA / YES, FIPOW(X, Y)
JMS FIPOW
FPOW2, JMP I FPOW
/ POWERS, PART 2
/ FAC = FIPOW(FAC, FOP)
/ COMPUTE FAC^FOP, IGNORING ANY FRACTIONAL BITS IN
/ FOP (THE ASSUMPTION IS THAT THE CALLER HAS ALREADY CHECKED
/ THAT THIS IS THE CASE), USING REPEATED MULTIPLICATION,
/ WHICH MEANS IT WORKS EVEN IF FAC IS LESS THAN ZERO.
FIPOW, 0
LAC FOP+2 / CHECK FOR Y=0.0
SZA / NOT HAVING TO HANDLE 0.0 MAKES
JMP FIPOW1 / THE REST OF THE CODE NICER
LAC (F1
JMS FLDA
JMP FIPOW8
FIPOW1, LAC FOP+0 / SAVE SIGN OF Y
JMS PSHA
JMS FPSHA / SAVE X
LAC FOP+2 / SIG BITS OF Y
DAC T6
LAC FOP+3
DAC T7
LAC FOP+1 / EXP OF Y
DAC T8
LAC (F1 / RESULT BEGINS AT 1.0
JMS FLDA
LAC T8
TAD (-32
SPA
JMP FIPOW2
TAD FAC+1 / >=26, Y LSB IN T7 & 1000
DAC FAC+1 / BUT SCALE INITIAL 1.0 IF NECESSARY
JMP FIPOW4
FIPOW2, DAC T8 / POSITION LSB OF Y
FIPOW3, LAC T6
CLL RAR
DAC T6
LAC T7
RAR
DAC T7
ISZ T8
JMP FIPOW3
FIPOW4, LAC (T8 / RETVAL IN T8/T9
JMS FSTA
JMS FPOPA
FIPOW5, LAC (T10 / X IN T10/T11
JMS FSTA
LAC T7 / IF LSB OF Y SET A MULTIPLY IS NEEDED
AND (1000
SNA
JMP FIPOW6 / NO
LAC (T8 / R = R*X
JMS FLDO
JMS FMUL
LAC (T8
JMS FSTA
FIPOW6, LAC T6 / EAT LSB
CLL RAR
DAC T6
LAC T7
RAR
AND (777000
DAC T7
SAD T6 / CHECK IF DONE; NOTE THAT IF
SZA / T6/T7=0 THEN WE MUST HAVE JUST EATEN
SKP / THE LAST NZ BIT, SO A MULTIPLY HAS
JMP FIPOW7 / JUST BEEN DONE, AND FAC IS VALID
LAC (T10
JMS FLDA
JMS FMOVO
JMS FMUL / AVOID FALSE OVERFLOW
JMP FIPOW5
FIPOW7, JMS POPA / IF Y<0, R = 1/R
SMA
JMP FIPOW8
JMS FMOVO
LAC (F1
JMS FLDA
JMS FDIV
FIPOW8, JMP I FIPOW
/ TANGENT
/ FAC = FTAN(FAC)
/ EVALUATED USING THE IDENTITY
/ TAN(X) = SIN(X)/COS(X), WITH A CHECK FOR
/ COS(X)=0 SO THE ERROR IS ?DO, RATHER
/ THAT THE CONFUSING ?ZD
FTAN, 0
JMS FPSHA
JMS FCOS
JMS FTST / COS(X) = 0 ?
SNA
JMP ERRDO / YES, ?DO
JMS FMOVO / THIS LITTLE DANCE GETS X BACK
JMS FPOPA / IN FAC, AND COS(X) ON TOS
JMS FPSHO
JMS FSIN
JMS FPOPO
JMS FDIV / SIN(X)/COS(X)
JMP I FTAN
/ COSINE
/ FAC = FCOS(FAC)
/ EVALUATED USING THE IDENTITY
/ COS(X) = SIN(X + PI/2)
FCOS, 0
LAC (FPID2
JMS FLDO
JMS FADD
JMS FSIN
JMP I FCOS
FPID2, 311037 / 1.570796327 (PI/2)
552401
/ SINE
/ FAC = FSIN(FAC)
/ IF ARG<0 THEN SIN(ARG) = -SIN(-ARG)
/ YOU CAN MAKE THE BASIC ALGORITHM DEAL WITH NEGATIVE
/ ANGLES, BUT THIS IS EASIER AND FASTER
/ IF ARG>=0 THE ALGORITHM IS
/ 1) Q = INT(X / (PI/2))
/ DETERMINE WHICH QUADRANT THE ANGLE IS IN
/ 2) X = X - Q*(PI/2)
/ REDUCE X TO THE RANGE [0, PI/2]
/ 3) DETERMINE ARG FOR SERIES BASED ON QUADRANT
/ IF (Q%4)=0 OR (Q%4)=0 THEN ARG = X
/ IF (Q%4)=1 OR (Q%4)=3 THEN ARG = (PI/2)-X
/ 4) EVALUATE SINE, ARG [0, PI/2]
/ THE FUNCTION IS COMPUTED USING A TRUNCATED MACLAURIN SERIES
/ Y = X - X^3/3! + X^5/5! - X^7/7! + X^9/9!
/ EVALUATED USING HORNER'S RULE, WITH Z = X^2
/ Y = ((((S4*Z - 1)*S3*Z + 1)*S2*Z - 1)*S1*Z + 1) * X
/ S4 = 1/(8*9), S3 = 1/(6*7), S2 = 1/(4*5), S1 = 1/(2*3)
/ 5) CORRECT SIGN
/ IF (Q%4)=0 OR (Q%4)=1 THEN RESULT = Y
/ IF (Q%4)=2 OR (Q%4)=3 THEN RESULT = -Y
/ NOTE THAT THE NEGATE NEEDED TO HANDLE NEGATIVE
/ ARGS AND THE NEGATE IN STEP 5 ARE MERGED INTO ONE IN
/ THIS CODE BECAUSE IT'S EASY TO DO SO
FSIN, 0
LAC FAC+0 / SAVE SIGN OF X
DAC T6
DZM FAC+0 / THEN TAKE ABSOLUTE VALUE
LAC (T10 / SAVE IN T10/T11
JMS FSTA
LAC (FPID2 / Q = INT(X / (PI/2))
JMS FLDO
JMS FDIV
JMS FINT
LAC FAC+3 / WE ARE NOW GOING TO
DAC T7 / COMPUTE Q%4 IN BITS 3000 OF T6
LAC FAC+2 / WHICH IS JUST AN "AND"
SNA / IN TWOS-COMPLEMENT NOTATION
JMP FSIN2 / Q = 0, Q%4 = 0
DAC T8
LAC FAC+1
TAD (-32
SNA
JMP FSIN2 / =26, DONE
SMA
JMP ERRDO / >26, DOMAIN ERROR (Q%4 UNKNOWN)
DAC T9
FSIN1, LAC T8 / SLIDE LOW 2 BITS
RAR / DOWN TO THE PROPER PLACE
DAC T8
LAC T7
RAR
DAC T7
ISZ T9
JMP FSIN1
FSIN2, LAC (FPID2 / X = X - Q*(PI/2)
JMS FLDO / WHICH LEAVES X IN THE RANGE
JMS FMUL / [-PI/2, +PI/2]
JMS FMOVO
LAC (T10
JMS FLDA
JMS FSUB
LAC T7 / FIRST QUADRANT CHECK
AND (1000
SNA
JMP FSIN3 / 0, 2
JMS FMOVO / 1, 3; X = (PI/2) - X
LAC (FPID2
JMS FLDA
JMS FSUB
FSIN3, LAC (T8 / T8/T9 IS X
JMS FSTA
JMS FMOVO
JMS FMUL
LAC (T10 / T10/T11 IS Z (X^2)
JMS FSTA
LAC (FS4 / EVALUATE THE MACLAURIN SERIES
JMS FLDO / FOR SIN(X)
JMS FMUL
LAC (F1
JMS FLDO
JMS FSUB
LAC (T10
JMS FLDO
JMS FMUL
LAC (FS3
JMS FLDO
JMS FMUL
LAC (F1
JMS FLDO
JMS FADD
LAC (T10
JMS FLDO
JMS FMUL
LAC (FS2
JMS FLDO
JMS FMUL
LAC (F1
JMS FLDO
JMS FSUB
LAC (T10
JMS FLDO
JMS FMUL
LAC (FS1
JMS FLDO
JMS FMUL
LAC (F1
JMS FLDO
JMS FADD
LAC (T8
JMS FLDO
JMS FMUL
LAC T6 / SET LINK IF ARG<0, NEG NEEDED
RAL
LAC T7 / SECOND QUADRANT CHECK
AND (2000
SZA
CML / 2, 3; ANOTHER NEG NEEDED
SZL
JMS FNEG / FINAL NEGATE
JMP I FSIN
FS4, 343434 / 0.013888888 (1/(8*9))
337372
FS3, 303030 / 0.023809523 (1/(6*7))
301373
FS2, 314631 / 0.050000000 (1/(4*5))
463374
FS1, 252525 / 0.166666666 (1/(2*3))
252376
/ ARCTANGET
/ FAC = FATN(FAC)
/ 1) CHECK IF X<0, AND IF IT IS, MAKE X>=0 BY USING
/ THE FORMULA ATN(X) = -ATN(-X)
/ 2) CHECK IF X>1, AND IF IT IS, MAKE X<=1 BY USING
/ THE FORMULA ATN(X) = PI/2 - ATN(1/X)
/ 3) WE NOW HAVE X IN THE RANGE [0, 1], SO THE ATN IS
/ KNOWN TO BE IN THE RANGE [0, PI/4]
/ ATN(X) IS APPROXIMATED BY A MINIMAX 5TH-ORDER RATIO
/ OF POLYNOMIALS (CRENSHAW, PAGE 179), WHICH IS ACCURATE ENOUGH
/ IF X IS IN THE RANGE [TAN(-PI/12), TAN(+PI/12)]
/ ATN(X) = X * ((A+B*X^2)/(1+C*X^2))
/ A = 0.999999020, B = 0.257977658, C = 0.591204505
/ IF THE ORIGINAL X IS IN THE RANGE [0, +PI/12] THEN THIS
/ APPROXIMATION CAN BE USED DIRECTLY
/ IF THE ORIGINAL X IS IN THE RANGE [PI/12, 3*PI/12] THE
/ FORMULA ATN(X) = ATN(K)+ATN(Z), WHERE Z=(X-K)/(1+K*X), AND
/ K IS CHOSEN TO BE TAN(2*PI/12) IS USED TO CONVERT
/ THE ORIGINAL RANGE INTO A NEW RANGE [-PI/12, +PI/12]
/ K0 = TAN(PI/12), B1 = 2*PI/12, K1 = TAN(2*PI/12)
/ THE VARIABLE T6 KEEPS TRACK OF THE
/ SIGN, RECIPROCAL, AND OFFSET TRANSFORMS ON THE WAY IN
/ SO THAT THEY CAN BE FINISHED UP ON THE WAY OUT
FATN, 0
LAC FAC+0 / REMEMBER SIGN OF X
DAC T6
DZM FAC+0 / X = ABS(X)
LAC (F1 / X>1 ?
JMS FLDO
JMS FCMP
SNA SPA CLL
JMP FATN1 / NO
JMS FMOVO / X = 1/X
LAC (F1
JMS FLDA
JMS FDIV
CLL CML
FATN1, LAC T6 / REMEMBER IF WE DID 1/X
RAR
DAC T6
LAC (FATK0 / X>K0
JMS FLDO
JMS FCMP
SNA SPA CLL
JMP FATN2 / NO
JMS FPSHA / X = (X-K1)/(1+K1*X)
LAC (FATK1
JMS FLDO
JMS FMUL
LAC (F1
JMS FLDO
JMS FADD
JMS FMOVO
JMS FPOPA
JMS FPSHO
LAC (FATK1
JMS FLDO
JMS FSUB
JMS FPOPO
JMS FDIV
CLL CML
FATN2, LAC T6 / REMEMBER WE DID (X-K1)/(1+X*K1)
RAR
DAC T6
JMS FPSHA / APPROX ATN(X)
JMS FMOVO
JMS FMUL
JMS FPSHA / X^2
LAC (FATC
JMS FLDO
JMS FMUL
LAC (F1
JMS FLDO
JMS FADD / 1+C*X^2
JMS FMOVO
JMS FPOPA / X^2
JMS FPSHO / 1+C*X^2
LAC (FATB
JMS FLDO
JMS FMUL
LAC (FATA
JMS FLDO
JMS FADD / A+B*X^2
JMS FPOPO / 1+C*X^2
JMS FDIV / (A+B*X^2)/(1+C*X^2)
JMS FPOPO / X
JMS FMUL
LAC T6 / FINISH ATN(K+X) = ATN(K)+ATN(Z)
SMA
JMP FATN3
LAC (FATB1
JMS FLDO
JMS FADD
FATN3, LAC T6 / FINISH ATN(X) = PI/2-ATN(1/X)
RAL
SMA
JMP FATN4
JMS FMOVO
LAC (FPID2
JMS FLDA
JMS FSUB
FATN4, LAC T6 / FINISH ATN(X) = -ATN(-X)
RTL
SPA
JMS FNEG
FATN5, JMP I FATN
FATK0, 211141 / 0.267949192
213377
FATB1, 206025 / 0.523598775
106400
FATK1, 223632 / 0.577350269
350400
FATA, 377777 / 0.999999020
676400
FATB, 204053 / 0.257977659
227377
FATC, 227262 / 0.591204505
266400
/ NATURAL LOG
/ FAC = FLN(FAC)
/ 1) IF X<=0 GIVE ?DO
/ 2) X IS A FLOATING POINT NUMBER OF THE FORM (2^E)*F, SO
/ LN(X) CAN BE COMPUTED AS LN(2^E)+LN(F), WHICH CAN BE REWRITTEN
/ AS LN(2)*E+LN(F); THIS REDUCES THE RANGE OVER WHICH LN(X)
/ NEEDS TO BE EVALUATED TO 0.5<=X<1.0
/ 3) LN(X) IS COMPUTED USING A CONTINUOUS FRACTION APPROXIMATION
/ LN(X) = 2*Z/(1-Z^2/(3-4*Z^2/(5-9*Z^2/(7-16*Z^2/...; Z = (X-1)/(X+1)
/ IF 0.5<=X<1.0, AN 11TH ORDER APPROXIMATION IS NEEDED!
/ 4) IF 0.7937<=X<1.0 LN(X) IS APPROXIMATED DIRECTLY, AND OVER
/ THIS RANGE OF X WE HAVE -0.1150<=Z<0
/ 5) IF 0.5<=X<0.7937 WE DIVIDE X BY 0.6300, SO 0.7937<=X<1.2598,
/ AND OVER THIS (NEW) RANGE OF X WE HAVE -0.1150<=Z<0.1150
/ SINCE LN(X/K) = LN(X)-LN(K), LN(X) = LN(X/K)+LN(K)
/ 6) WITH -0.1150<=Z<0.1150, LN(X) CAN BE COMPUTED (BARELY)
/ BY A 5TH ORDER APPROXIMATION, WHICH CAN BE WRITTEN IN RATIO OF
/ POLYNOMIALS FORM AS LN(X) = 2*Z*(15-4*Z^2)/(15-9*Z^2)
FLN, 0
JMS FTST / X<=0 ?
SNA SPA
JMP ERRDO / YES, ?DO
JMS FPSHA
LAC FAC+1 / E
JMS FFLT
LAC (FLNG / LN(2.0)
JMS FLDO
JMS FMUL
JMS FMOVO / X TO FAC, LN(2.0)*E TO TOS
JMS FPOPA
JMS FPSHO
DZM FAC+1 / 0.5<=X<1.0
LAC (FLNA
JMS FLDO
JMS FCMP
SPA
JMP FLN1
JMS FLN3 / 0.7937<=X<1.0, NO SCALING
JMP FLN2
FLN1, LAC (FLNB / 0.5<=X<0.7937, SCALING
JMS FLDO
JMS FDIV
JMS FLN3
LAC (FLNC
JMS FLDO
JMS FADD
FLN2, JMS FPOPO / LN(X) = LN(F) + E*LN(2.0)
JMS FADD
JMP I FLN
FLN3, 0
JMS FPSHA / Z = (X-1)/(X+1)
LAC (F1
JMS FLDO
JMS FADD
JMS FMOVO
JMS FPOPA
JMS FPSHO
LAC (F1
JMS FLDO
JMS FSUB
JMS FPOPO
JMS FDIV
JMS FPSHA / Z TO TOS
JMS FMOVO
JMS FMUL
JMS FPSHA / Z^2 TO TOS
LAC (FLND / 15-9*Z^2
JMS FLDO
JMS FMUL
LAC (FLNE
JMS FLDO
JMS FADD
JMS FMOVO / Z^2 TO FAC, 15-9*Z^2 TO TOS
JMS FPOPA
JMS FPSHO
LAC (FLNF / 15-4*Z^2
JMS FLDO
JMS FMUL
LAC (FLNE
JMS FLDO
JMS FADD
JMS FPOPO
JMS FDIV / (15-4*Z^2)/(15-9*Z^2)
JMS FPOPO
JMS FMUL / Z*((15-4*Z^2)/(15-9*Z^2))
LAC (F2
JMS FLDO
JMS FMUL / 2*Z*((15-4*Z^2)/(15-9*Z^2))
JMP I FLN3
FLNA, 313137 / 0.793700525
724400
FLNB, 241212 / 0.629960525
137400
FLNC, 754460 / -0.462098120 (LN(FLNB))
177377
FLND, 620000 / -9.0
000404
FLNE, 360000 / 15.0
000404
FLNF, 600000 / -4.0
000403
FLNG, 261344 / 0.693147181 (LN(2.0))
137400
/ EXPONENTIAL
/ FAC = FEXP(FAC)
/ 1) FORCE X>=0 USING THE EXP(X) = -1/EXP(-X)
/ 2) EXP(X) CAN BE EVALUATED USING A POWER SERIES OF THE FORM
/ EXP(X) = 1 + X + X^2/2! + X^3/3! + X^4/4! + X^5/5! + ...
/ BUT THIS SERIES IS VERY SLOW TO CONVERGE IF X ISN'T VERY SMALL
/ 3) THE RANGE OF X CAN BE LIMITED BY REWRITING X AS X1+X2,
/ WHERE X1 IS AN INTEGER AND 0.0<=X2<1.0, WHICH ALLOWS EXP(X) TO
/ BE REWRITTEN AS EXP(X1)*EXP(X2); NOTE THAT SINCE X1 IS AN
/ INTEGER EXP(X1) IS JUST A BUNCH OF MULTIPLICATIONS
/ SADLY, IF 0.0<=X2<1.0, WE NEED AN 11TH ORDER POLYNOMIAL TO
/ EVALUATE EXP(X2) WITH ENOUGH ACCURACY!
/ 4) REWRITE X AS X1/N+X2, WHERE X1 IS AN INTEGER, AND 0.0<=X2<1/N
/ WHICH ALLOWS EXP(X) TO BE REWRITTEN AS EXP(X1/N)*EXP(X2), OR
/ EXP(1/N)^X1*EXP(X2), AND CAN MAKE X2 AS SMALL AS DESIRED, AT THE
/ COST OF A FEW EXTRA MULTIPLICATIONS COMPUTING EXP(1/N)^X1
/ THE SWEET SPOT SEEMS TO BE N=4, WHICH MAKES 0.0<=X2<0.25, AND
/ TURNS EXP(X2)= 1+X2(1+X2/2(1+X2/3(1+X2/4(1+X2/5(1+X2/6)))))
FEXP, 0
LAC FAC+0 / SAVE SIGN, MAKE POSITIVE
JMS PSHA
DZM FAC+0
LAC (F4 / COMPUTE X1
JMS FLDO
JMS FMUL
JMS FPSHA
JMS FINT
JMS FMOVO / COMPUTE X2, X1 TO TOS
JMS FPOPA
JMS FPSHO
JMS FSUB
LAC (F4
JMS FLDO
JMS FDIV
LAC (T6 / T6 IS X2
JMS FSTA
LAC (FEXA / 1/6
JMS FEXP2
LAC (FEXB / 1/5
JMS FEXP2
LAC (FEXC / 1/4
JMS FEXP2
LAC (FEXD / 1/3
JMS FEXP2
LAC (FEXE / 1/2
JMS FEXP2
LAC (F1
JMS FLDO
JMS FADD
JMS FPOPO / COMPUTE EXP(0.25)^X1, EXP(X2) TO TOS
JMS FPSHA
LAC (FEXF
JMS FLDA
JMS FIPOW
JMS FPOPO / EXP(1/N)^X1 * EXP(X2)
JMS FMUL
JMS POPA / DO FINAL 1/X IF NECESSARY
SMA
JMP FEXP1
JMS FMOVO
LAC (F1
JMS FLDA
JMS FDIV
FEXP1, JMP I FEXP
FEXP2, 0 / THIS IS A LOCAL ROUTINE
JMS FLDO / WHICH EVALUATES A SINGLE TERM OF THE
JMS FMUL / SERIES; IT'S CALLED WITH
LAC (F1 / THE ADDRESS OF A COEFFICIENT IN AC
JMS FLDO / AND X IN T6/T7
JMS FADD
LAC (T6
JMS FLDO
JMS FMUL
JMP I FEXP2
FEXA, 252525 / 0.166666667
252376
FEXB, 314631 / 0.200000000
463376
FEXC, 200000 / 0.250000000
000377
FEXD, 252525 / 0.333333333
252377
FEXE, 200000 / 0.500000000
000400
FEXF, 244265 / 1.284025417 (EXP(1/4))
707401
/ FLOATING POINT INPUT CONVERSION
/ GCP CONTAINS THE ADDRESS OF C, WHICH HOLDS THE CURRENT
/ CHARACTER, AND GADVP CONTAINS THE ADDRESS OF ADV, WHICH IS A
/ ROUTINE WHICH ADVANCES THE CURRENT CHARACTER
/ RETURN JMS+1 IF NO NUMBER, AND RETURN JMS+2 IF THERE IS
/ A NUMBER, WHICH HAS BEEN READ INTO FAC
FGET, 0
DZM FAC+2 / FAC+2/FAC+3 HOLD THE NUMBER
DZM FAC+3
DZM T9 / T9 HOLDS DECIMAL EXPONENT
DZM T8 / T8 NZ IF DIGITS NO LONGER SIGNIFICANT
DZM T7 / T7 NZ IF DIGITS SEEN
DZM T6 / T6 NZ IF DOT SEEN
LAC I GCP / SKIP LEADING BLANKS
SKP
FGET1, JMS I GADVP
SAD (40
JMP FGET1
DZM FAC+0 / LEADING SIGN
SAD (53 / "+"
JMP FGET2
SAD (55 / "-"
SKP
JMP FGET4
CMA / ANYTHING WITH BIT[0]=1
DAC FAC+0 / WILL DO
FGET2, JMS I GADVP
FGET4, SAD (56 / "."
JMP FGET7
SAD (105 / "E"
JMP FGET8
JMS FISDIG / DIGIT ?
JMP FGET13 / NO
ISZ T7
LAC T8 / IS DIGIT STILL SIGNIFICANT ?
SZA
JMP FGET5 / NO
LAC FAC+3 / T4:T5 = 10*FAC+2:FAC+3 + C - "0"
CLL RAL
DAC T5
LAC FAC+2
RAL
DAC T4
LAC T5
CLL RAL
DAC T5
LAC T4
RAL
DAC T4
LAC T5
CLL
TAD FAC+3
DAC T5
CLA RAL
TAD T4
TAD FAC+2
DAC T4
LAC T5
CLL RAL
DAC T5
LAC T4
RAL
DAC T4
LAW -60 / "0"
TAD I GCP
CLL
TAD T5
DAC T5
CLA RAL
TAD T4
DAC T4
AND (777400 / SPILLED BEYOND 26 BITS ?
SZA
JMP FGET5 / YES
LAC T5 / FAC+2:FAC+3 GETS T4:T5
DAC FAC+3
LAC T4
DAC FAC+2
JMP FGET6
FGET5, ISZ T8 / NO LONGER SIGNIFICANT
ISZ T9 / SO JUST INCREMENT DECIMAL EXPONENT
NOP
FGET6, LAC T6 / IF AFTER A "."
SZA / DECREMENT DECIMAL EXPONENT
CLA CMA
TAD T9
DAC T9
JMP FGET2
FGET7, LAC T6 / SECOND "." ?
SZA
JMP FGET13 / YES, END
ISZ T6
JMP FGET2
FGET8, LAC T7 / DIGITS BEFORE THE "E" ?
SNA
JMP FGET13 / NO, END
JMS I GADVP
DZM T8 / T8 HOLDS EXPONENT SIGN
DZM T6 / T6 HOLDS EXPONENT
SAD (53 / "+"
JMP FGET9
SAD (55 / "-"
SKP
JMP FGET10
ISZ T8
FGET9, JMS I GADVP
FGET10, LAC I GCP
JMS FISDIG / DIGIT ?
JMP FGET11 / NO
LAC T6
CLL RTL
TAD T6
RAL
TAD I GCP
TAD (-60
DAC T6
JMP FGET9
FGET11, LAC T8 / UPDATE DECIMAL EXPONENT
RAR
LAC T6
SNL
JMP FGET12
CMA
TAD (1
FGET12, TAD T9
DAC T9
FGET13, LAC T7 / END, TAKE ERROR RETURN
SNA / IF NO DIGITS
JMP I FGET / WERE ACTUALLY SEEN
LAC (43 / 17+18
DAC FAC+1
JMS FNAR
LAC T9 / DECIMAL EXPONENT ?
SNA
JMP FGET14 / NO
LAC (T7 / MULTIPLY NUMBER BY 10^T9
JMS FSTA
LAC T9
JMS FP10 / SMASHES T0 THROUGH T6
LAC (T7
JMS FLDO
JMS FMUL
FGET14, ISZ FGET
JMP I FGET
FISDIG, 0
TAD (-60
SPA / SKIP IF >= "0"
JMP FISDG1
TAD (-12
SPA / SKIP IF >= "9"+1
ISZ FISDIG
FISDG1, JMP I FISDIG
/ FLOATING POINT OUTPUT CONVERSION
/ A FLOATING POINT NUMBER IS OF THE FORM
/ F * 2^E, WHERE 0.5<=F<1.0, AND -256<=E<256
/ THIS CAN ALSO BE WRITTEN AS
/ F * 10^D.D, WHERE D.D IS E/LOG2(10) (3.321928095)
/ WHICH CAN BE REARRANGED INTO THE FORM
/ F * 10^.D * 10*D
/ SINCE 0.5<=F<1.0, AND 1.0<=10^.D<10.0, IT FOLLOWS
/ THAT 0.5<=F*10^.D<10.0
/ THEN, IF IT'S >=1.0, DIVIDE BY 10.0 AND INCREMENT
/ THE DECIMAL EXPONENT, WHICH BRINGS THE FRACTION INTO
/ THE RANGE 0.1<=F<1.0
/ THINGS GET MORE COMPLEX WHEN E<0, WHICH
/ MAKES D.D<0, WHICH MAKES D<0 AND -1.0<.D<=0.0 (BECAUSE
/ OF HOW FFIX WORKS) BUT WE WANT 0<=.D<1.0
/ THIS IS FIXED BY WATCHING FOR D.D<0, AND IF IT IS,
/ REPLACING D WITH D-1 AND .D BY .D+1.0, AS LONG AS WE
/ ARE PREPARED TO DEAL WITH THE FACT THAT
/ 0.5<=F*10^(.D+1.0)<=10.0 (AN "IF" IN A CORRECTION
/ LOOP NEEDS TO BE A "WHILE" BECAUSE TWO LOOPS
/ ARE NEEDED FOR NUMBERS LIKE -3.0)
FPUT, 0
LAC (T7
JMS FSTA
DZM T9 / MORTALS EXPECT 0.0 TO BE
LAC FAC+2 / +0.00000E+00
SNA
JMP FPUT1
LAC FAC+1 / E
JMS FFLT
LAC (FL210
JMS FLDO
JMS FDIV / D.D = E/LOG2(10)
JMS FTST
SPA
JMP FPUTA
JMS FFIX
JMP FPUTB
FPUTA, JMS FFIX / MAKE THINGS ROUND IN THE CORRECT
TAD (-1 / DIRECTION WHEN D.D<0
FPUTB, DAC T9
JMS FP10 / 10^D (SMASHES T0 TO T6)
JMS FMOVO
LAC (T7
JMS FLDA
DZM FAC+0
JMS FDIV / ABS(F) * 10^.D
FPUTC, LAC (F1
JMS FLDO
JMS FCMP / IF 1.0<=ABS(F)*10^.D<10.0
SPA / DIVIDE IT BY 10.0 (AND FIX THE
JMP FPUT0 / DECIMAL EXPONENT) TO BRING
LAC (F10 / IT INTO THE RANGE 0.1<=ABS(F)*10^.D<1.0
JMS FLDO
JMS FDIV
ISZ T9
NOP
JMP FPUTC
FPUT0, LAC (FRN5 / WE ARE GOINT TO GENERATE
JMS FLDO / 6 DIGITS
JMS FADD / SO ROUND BY ADDING 0.0000005
LAC (F1 / THIS CAN CAUSE
JMS FLDO / THE FRACTION TO NO LONGER
JMS FCMP / BE 0.1<=F<1.0, SO CHECK, AND
SPA / REPAIR IF NECESSARY
JMP FPUT1
LAC (F10 / WAS T7! GAK!
JMS FLDO
JMS FDIV
ISZ T9
NOP
FPUT1, LAC T7 / SIGN
RAL
CLA RTL / 0 IF POS, 2 IF NEG
TAD (53 / "+" IF POS, "-" IF NEG
JMS PUTC
LAW LAW+60 / "0"
JMS PUTC
LAW LAW+56 / "."
JMS PUTC
LAW -6
DAC T4
FPUT2, LAC (F10 / EXTRACT A DIGIT
JMS FLDO
JMS FMUL
JMS FMOVO
JMS FFIX
DAC T5
TAD (60 / TYPE DIGIT
JMS PUTC
LAC T5 / RETAIN THE FRACTIONAL PART
CMA / FOR THE NEXT TIME
TAD (1
JMS FFLT
JMS FADD
ISZ T4
JMP FPUT2
LAW LAW+105 / "E"
JMS PUTC
LAC T9 / PRINT EXPONENT
RAL
LAW LAW+53 / "+"
SNL
JMP FPUT2A
LAC T9
CMA
TAD (1
DAC T9
LAW LAW+55 / "-"
FPUT2A, JMS PUTC
LAC T9 / DIVIDE BY 10
DZM T4
FPUT3, TAD (-12
SPA
JMP FPUT4
ISZ T4
JMP FPUT3
FPUT4, DAC T9
LAW LAW+60 / DIGIT 1
TAD T4
JMS PUTC
LAC T9
TAD (12+60 / DIGIT 2
JMS PUTC
JMP I FPUT
F0, 000000 / 0.0
000000
F1, 200000 / 1.0
000401
F2, 200000 / 2.0
000402
F4, 200000 / 4.0
000403
F10, 240000 / 10.0
000404
FL210, 324464 / 3.321928095
741402
FRN5, 206157 / 0.0000005
365354
/ COMPUTE 10.0^AC, -128 0.0)
/ +3 [0..8]=F, [9..17]=0
/ ERROR JUMPS
/ ERROV - EXPONENT OVERFLOW/UNDERFLOW
/ ERRZD - ZERO DIVIDE
/ THERE ARE TWO REGISTERS
/ FAC, FOP
/ FAC CAN BE LOADED/STORED FROM/TO MEMORY
/ FOP CAN BE LOADED FROM MEMORY
/ FAC AND FOP CAN BE PUSHED/POPPED TO/FROM THE STACK
/ FAC CAN BE LOADED FROM FOP
/ FOP CAN BE LOADED FROM FAC
/ UNARY OPERATIONS GO FAC = OP FAC
/ BINARY OPERATIONS GO FAC = FAC OP FOP
FAC, BSS 4
FOP, BSS 4
/ LOAD (2 WORD) MEM AT (AC) TO FAC
FLDA, 0
DAC T0
LAC I T0 / WORD 0 IS
DAC FAC+0 / SIGN AND MS FRAC
AND (377777
DAC FAC+2
ISZ T0
LAC I T0 / WORD 1 IS
AND (777000 / LS FRAC AND EXCESS 400
DAC FAC+3 / EXPONENT
LAC I T0
AND (777
TAD (-400
DAC FAC+1
JMP I FLDA
/ STORE FAC AT (2 WORD) MEM AT (AC)
FSTA, 0
DAC T0
LAC FAC+0 / SIGN AND MS FRAC
AND (400000 / IN WORD 0
TAD FAC+2
DAC I T0
ISZ T0
LAC FAC+1 / LS FRAC AND EXCESS 400 EXPONENT
TAD (400 / IN WORD 1
TAD FAC+3
DAC I T0
JMP I FSTA
/ PUSH FAC ONTO STACK
FPSHA, 0
LAC FAC+0
JMS PSHA
LAC FAC+1
JMS PSHA
LAC FAC+2
JMS PSHA
LAC FAC+3
JMS PSHA
JMP I FPSHA
/ POP STACK INTO FAC
FPOPA, 0
JMS POPA
DAC FAC+3
JMS POPA
DAC FAC+2
JMS POPA
DAC FAC+1
JMS POPA
DAC FAC+0
JMP I FPOPA
/ MOVE FOP TO FAC
FMOVA, 0
LAC FOP+0
DAC FAC+0
LAC FOP+1
DAC FAC+1
LAC FOP+2
DAC FAC+2
LAC FOP+3
DAC FAC+3
JMP I FMOVA
/ LOAD (2 WORD) MEM AT (AC) TO FOP
FLDO, 0
DAC T0
LAC I T0 / WORD 0 IS
DAC FOP+0 / SIGN AND MS FRAC
AND (377777
DAC FOP+2
ISZ T0
LAC I T0 / WORD 1 IS
AND (777000 / LS FRAC AND EXCESS 400
DAC FOP+3 / EXPONENT
LAC I T0
AND (777
TAD (-400 / MAKE 2'S COMPLEMENT
DAC FOP+1
JMP I FLDO
/ PUSH FOP ONTO STACK
FPSHO, 0
LAC FOP+0
JMS PSHA
LAC FOP+1
JMS PSHA
LAC FOP+2
JMS PSHA
LAC FOP+3
JMS PSHA
JMP I FPSHO
/ POP STACK INTO FOP
FPOPO, 0
JMS POPA
DAC FOP+3
JMS POPA
DAC FOP+2
JMS POPA
DAC FOP+1
JMS POPA
DAC FOP+0
JMP I FPOPO
/ MOVE FAC TO FOP
FMOVO, 0
LAC FAC+0
DAC FOP+0
LAC FAC+1
DAC FOP+1
LAC FAC+2
DAC FOP+2
LAC FAC+3
DAC FOP+3
JMP I FMOVO
/ NEGATE FAC
FNEG, 0
LAC FAC+2 / AVOID -0
SNA
JMP FNEG1
LAC FAC+0 / FLIP SIGN
XOR (400000
DAC FAC+0
FNEG1, JMP I FNEG
/ FLOAT AC TO FAC
FFLT, 0
DAC FAC+0 / SAVE SIGN
SMA / THEN FORCE POSITIVE
JMP FFLT1
CMA
TAD (1
FFLT1, DAC FAC+2 / CONS UP A DENORMALIZED
DZM FAC+3 / FLOATING POINT NUMBER WITH THE
LAC (21 / RIGHT VALUE
DAC FAC+1
JMS FNAR / NORMALIZE, ROUND
JMP I FFLT
/ FIX FAC TO AC
FFIX, 0
LAC FAC+1
SPA SNA / IF EXP LE 0, THEN THERE ARE
JMP FFIX3 / NO INTEGER BITS
TAD (-21
SMA SZA / IF GT, DOESN'T FIT IN AN INTEGER
JMP ERROV
SMA
JMP FFIX2
DAC T0
LAC FAC+2
FFIX1, CLL RAR / MOVE THE FRACTION BITS
ISZ T0 / TO THE CORRECT SPOT IN THE
JMP FFIX1 / INTEGER
DAC FAC+2
FFIX2, LAC FAC+0 / GIVE THE INTEGER THE
RAL / CORRECT SIGN
LAC FAC+2
SNL
JMP FFIX4
CMA
TAD (1
JMP FFIX4
FFIX3, CLA
FFIX4, JMP I FFIX
/ INTEGER PART OF FAC
/ LIKE FFIX, BUT DOES NOT DEMAND THAT THE
/ INTEGER PART FIT IN 18 BITS
FINT, 0
LAC FAC+1 / EXP-26
TAD (-32
SMA
JMP FINT2 / EXP>=26, ALL BITS SURVIVE
DAC T0 / EXP<26, T0 IS ISZ COUNT FOR MASK
LAC (777000
DAC T1
LAC (377777
DAC T2
FINT1, LAC T1 / SHIFT MASK LEFT BY
CLL RAL / THE APPROPRIATE NUMBER OF BITS
DAC T1
LAC T2
RAL
DAC T2
ISZ T0
JMP FINT1
LAC T1 / FIX LO FRACTION
AND FAC+3
DAC FAC+3
LAC T2 / FIX HI FRACTION
AND (377777 / KILL OFF SPILL INTO SIGN
AND FAC+2
DAC FAC+2
SZA
JMP FINT2
DZM FAC+0 / MAKE SURE 0.0 IS POSITIVE AND
LAW -400 / HAS THE CORRECT EXPONENT
DAC FAC+1
FINT2, JMP I FINT
/ ADD FOP TO FAC
FADD, 0
LAC FAC+1 / COMPUTE NEG OF DIFFERENCE
CMA / BETWEEN EXPONENTS
TAD (1
TAD FOP+1
SNA / IF EQ, ALIGNED
JMP FADD4
DAC T0
SPA / IF GT, MISALIGNED, AND THE
JMP FADD2 / NUMBER IN FAC IS THE
CMA / ONE WHICH NEEDS TO SHIFT RIGHT, SO FLIP
TAD (1 / FAC AND FOP
DAC T0
LAC FAC+0
DAC T1
LAC FOP+0
DAC FAC+0
LAC T1
DAC FOP+0
LAC FAC+1
DAC T1
LAC FOP+1
DAC FAC+1
LAC T1
DAC FOP+1
LAC FAC+2
DAC T1
LAC FOP+2
DAC FAC+2
LAC T1
DAC FOP+2
LAC FAC+3
DAC T1
LAC FOP+3
DAC FAC+3
LAC T1
DAC FOP+3
FADD2, LAC T0 / IF CLEAR MISS, ALL DONE
TAD (32
SPA
JMP FADD7
FADD3, LAC FOP+2 / SHIFT FOP RIGHT BY ENOUGH
CLL RAR / BITS TO ALIGN IT'S BINARY POINT WITH
DAC FOP+2 / THAT OF FAC
LAC FOP+3
RAR
DAC FOP+3
ISZ T0
JMP FADD3
FADD4, LAC FAC+0 / SIGN-MAGNITUDE ADDITION IS
XOR FOP+0 / A LITTLE UGLY
SPA CLL
JMP FADD5
LAC FOP+3 / IF SAME SIGNS, COMPUTE FAC+FOP
TAD FAC+3
DAC FAC+3
CLA RAL
TAD FOP+2
TAD FAC+2
DAC FAC+2
JMP FADD6
FADD5, LAC FOP+3 / IF DIFFERENT SIGNS, COMPUTE FAC-FOP
CMA CLL
TAD (1
TAD FAC+3
DAC FAC+3
LAC FOP+2
SZL CMA
TAD (1
TAD FAC+2
DAC FAC+2
SMA / IF LT, FOP WAS ACTUALLY THE
JMP FADD6 / LARGER NUMBER, SO NEGATE THE DIFFERENCE,
LAC FAC+3 / WHICH GENERATES FOP-FAC
CMA CLL
TAD (1
DAC FAC+3
LAC FAC+2
SZL CMA
TAD (1
DAC FAC+2
LAC FOP+0 / RESULT HAS FOP'S SIGN
DAC FAC+0
FADD6, JMS FNAR / NORMALIZE, ROUND
FADD7, JMP I FADD
/ SUBTRACT FOP FROM FAC
FSUB, 0
LAC FOP+2 / AVOID MAKING -0 AND
SNA / CONFUSING FAD
JMP FSUB1
LAC FOP+0 / FLIP SIGN
XOR (400000
DAC FOP+0
JMS FADD / ADD DOES ALL OF THE WORK
FSUB1, JMP I FSUB
/ MULTIPLY FAC BY FOP
FMUL, 0
LAC FAC+0 / RESULT SIGN
XOR FOP+0
DAC FAC+0
LAC FAC+1 / RESULT EXPONENT
TAD FOP+1
DAC FAC+1
LAW -32
DAC T0
LAC FAC+2 / MOVE MULTIPLICAND TO T1/T2
DAC T1
LAC FAC+3
DAC T2
DZM FAC+2 / AND CLEAR PRODUCT
DZM FAC+3
FMUL1, LAC T1 / SHIFT MULTIPLICAND RIGHT
CLL RAR
DAC T1
LAC T2
RAR
DAC T2
LAC FOP+3 / SHIFT MULTIPLIER LEFT
RAL
DAC FOP+3
LAC FOP+2
RAL
DAC FOP+2
SMA CLL / IF LT, AN ADD IS NEEDED
JMP FMUL2
LAC FAC+3 / ADD MULTIPLICAND INTO PRODUCT
TAD T2
DAC FAC+3
CLA RAL
TAD FAC+2
TAD T1
DAC FAC+2
FMUL2, ISZ T0
JMP FMUL1
JMS FNAR / NORMALIZE, ROUND
JMP I FMUL
/ DIVIDE
FDIV, 0
LAC FOP+3 / NEGATE DIVISOR OUTSIDE OF THE
CMA CLL / DIVIDE LOOP
TAD (1
DAC FOP+3
LAC FOP+2
SNA
JMP ERRZD / DIVIDE BY 0
SZL CMA
TAD (1
DAC FOP+2
LAC FOP+0 / RESULT SIGN
XOR FAC+0
DAC FAC+0
LAC FOP+1 / RESULT EXPONENT
CMA
TAD (1
TAD FAC+1
DAC FAC+1
LAW -33 / 27 BITS
DAC T0
LAC FAC+2 / MOVE DIVIDEND TO T1/T2
DAC T1
LAC FAC+3
DAC T2
DZM FAC+2 / AND CLEAR QUOTIENT
DZM FAC+3
FDIV2, LAC FAC+3 / SHIFT QUOTIENT LEFT
CLL RAL
DAC FAC+3
LAC FAC+2
RAL
DAC FAC+2
LAC T2 / SUBTRACT DIVISOR FROM DIVIDEND
CLL
TAD FOP+3
DAC T3
CLA RAL
TAD T1
TAD FOP+2
SPA / GE MEANS IT GOES IN
JMP FDIV3
DAC T1 / SO UPDATE DIVIDEND
LAC T3
DAC T2
LAC FAC+3 / AND ADD A 1 TO THE QUOTIENT
TAD (1000
DAC FAC+3
FDIV3, LAC FOP+2 / SHIFT DIVISOR RIGHT
CLL CML RAR
DAC FOP+2
LAC FOP+3
RAR
DAC FOP+3
ISZ T0
JMP FDIV2
JMS FNAR / NORMALIZE, ROUND
JMP I FDIV
/ COMPARE
/ AC<0 IF FAC0 IF FAC>FOP
/ IF SIGNS DIFFERENT
/ FAC<0 AND FOP>=0 MEANS FAC=0 AND FOP<0 MEANS FAC>FOP, FAC.SIGN =0, NEED >0
/ IF SIGNS SAME
/ COMPARE EXPONENTS
/ THEN MS FRAC
/ THEN LS FRAC (AS UNSIGNED)
FCMP, 0
LAC FAC+0 / CHECK SIGNS
XOR FOP+0
SMA / IF MI, SIGNS DIFFERENT
JMP FCMP1
LAC FAC+0 / GET RESULT, AVOIDING
SMA / 0 IN THE TRICKY CASE NOTED ABOVE
LAC (1
JMP I FCMP
FCMP1, LAC FOP+1 / SIGNED COMPARE EXP
CMA
TAD (1
TAD FAC+1
SZA / IF EQ, NO CONCLUSION
JMP I FCMP
LAC FOP+2 / SIGNED COMPARE MS FRAC
CMA
TAD (1
TAD FAC+2
SZA CLL / IF EQ, NO CONCLUSION
JMP I FCMP
LAC FOP+3 / UNSIGNED COMPARE LS FRAC
CMA CML
TAD (1
TAD FAC+3
RAR
JMP I FCMP
/ TEST
/ AC<0 IF FAC<0, AC=0 IF FAC=0, AC>0 IF FAC>0
/ A LOT MORE EFFICIENT THAN FCMP
/ KNOWS THAT
/ 0.0 IS ALWAYS POSITIVE
/ 0.0 IS THE ONLY NUMBER WITH FAC+2 = 0
FTST, 0
LAC FAC+0
AND (400000
TAD FAC+2
JMP I FTST
/ NORMALIZE AND ROUND THE
/ NUMBER IN FAC, WHICH MAY HAVE A DATA
/ BIT IN [0] DUE TO OVERFLOW
FNAR, 0
LAC FAC+2 / CHECK FOR 0
SAD FAC+3
SZA
JMP FNAR1
DZM FAC+0 / YES, FORCE POSITIVE, AND
LAW -400 / FORCE THE SMALLEST POSSIBLE EXPONENT
DAC FAC+1
JMP I FNAR
FNAR1, SMA / IF LT, NUMBER IS GE 1.0
JMP FNAR2
CLL RAR / SO A SINGLE RIGHT SHIFT IS ALL THAT
DAC FAC+2 / IS NEEDED TO FINISH THE
LAC FAC+3 / NORMALIZATION
RAR
DAC FAC+3
ISZ FAC+1
NOP
JMP FNAR3
FNAR2, RAL / OTHERWISE SHIFT FAC LEFT UNTIL
SPA / BIT [1] IS A 1
JMP FNAR3
LAW -1
TAD FAC+1
DAC FAC+1
LAC FAC+3
CLL RAL
DAC FAC+3
LAC FAC+2
RAL
DAC FAC+2
JMP FNAR2
FNAR3, LAC FAC+3 / ROUND BY ADDING A 1
CLL / JUST BELOW
TAD (400 / THE LOWEST BIT WE ACTUALLY
AND (777000 / RETAIN IN THE RESULT
DAC FAC+3
CLA RAL
TAD FAC+2
DAC FAC+2
SMA / IF LT, THE ROUND DENORMALIZED
JMP FNAR4 / THE RESULT, BUT A SINGLE
CLL RAR / RIGHT SHIFT IS ALL THAT IS NEEDED
DAC FAC+2 / TO FIX THINGS
LAC FAC+3
RAR
AND (777000
DAC FAC+3
ISZ FAC+1
NOP
FNAR4, LAC FAC+1 / [-256, 255] IS THE LEGAL RANGE
TAD (400 / FOR THE EXPONENT
AND (777000
SZA
JMP ERROV / USED FOR UNDERFLOW TOO
JMP I FNAR
/ VARIABLES
TTXT, BSS 1 / TOP OF TEXT
TVAR, BSS 1 / TOP OF VARIABLES
COL, BSS 1 / CURRENT OUTPUT COLUMN
LNO, BSS 1 / LINE NUMBER, GENERATED BY ENC
LLEN, BSS 1 / LINE LENGTH, GENERATED BY ENC
T0, BSS 1 / GENERAL TEMPORARIES
T1, BSS 1
T2, BSS 1
T3, BSS 1
T4, BSS 1
T5, BSS 1
T6, BSS 1
T7, BSS 1
T8, BSS 1
T9, BSS 1
T10, BSS 1
T11, BSS 1
LP, BSS 1 / CURRENT LINE, 0 IF DIRECT MODE
CP, BSS 1 / CURRENT CHARACTER POINTER (2*ADDRESS)
C, BSS 1 / CURRENT CHARACTER
VAR, BSS 1 / POINTER TO CURRENT VARIABLE
SYM, BSS 2 / CURRENT SYMBOL
SYMSUB, BSS 2 / 2 WORDS, SUBSCRIPTS FOR CURRENT SYMBOL
SYMSIZ, BSS 2 / 2 WORDS, SIZES FOR CURRENT SYMBOL
RNDS, BSS 1 / RANDOMIZE SEED
GETIX, BSS 1 / KBD RING POINTERS
GETOX, BSS 1
GETB, BSS NGETB / KBD BUFFER
CMDB, BSS NCMDB / COMMAND LINE BUFFER (ALSO USED FOR INPUT)
GSTKP, BSS 1 / GOSUB STACK POINTER
GSTK, BSS 3*NGSTK / GOSUB STACK
STKP, BSS 1 / PUSH/POP STACK POINTER
STK, BSS 1+NSTK / PUSH/POP STACK
GCP, BSS 1 / LINKS TO C AND ADV FOR FGET
GADVP, BSS 1
IC, BSS 1 / FOR INPUT
ICP, BSS 1
RLP, BSS 1 / FOR READ
RCP, BSS 1
RC, BSS 1
FSTKP, BSS 1 / FOR STACK POINTER
FSTK, BSS 10*NFSTK / FOR STACK
/ KEYWORD TABLE
TDATA=200
TGOTO=207
TTHEN=226
TGE=230
TLE=231
TNE=232
TTO=227
TSTEP=224
TAND=234
TOR=235
TNOT=236
TFN=237
TTAB=240
TSPC=241
TSGN=242
TRND=243
TSQR=244
TABS=245
TINT=246
TSIN=247
TCOS=250
TATN=251
TLOG=252
TEXP=253
TTAN=254
KTAB, 104 / 200 DATA
101
124
101
0
104 / 201 DEF
105
106
0
104 / 202 DELETE
105
114
105
124
105
0
104 / 203 DIM
111
115
0
105 / 204 END
116
104
0
106 / 205 FOR
117
122
0
107 / 206 GOSUB
117
123
125
102
0
107 / 207 GOTO
117
124
117
0
111 / 210 IF
106
0
111 / 211 INPUT
116
120
125
124
0
114 / 212 LET
105
124
0
114 / 213 LIST
111
123
124
0
116 / 214 NEW
105
127
0
116 / 215 NEXT
105
130
124
0
120 / 216 PRINT
122
111
116
124
0
122 / 217 READ
105
101
104
0
122 / 220 REM
105
115
0
122 / 221 RESTORE
105
123
124
117
122
105
0
122 / 222 RETURN
105
124
125
122
116
0
122 / 223 RUN
125
116
0
123 / 224 STEP
124
105
120
0
123 / 225 STOP
124
117
120
0
124 / 226 THEN
110
105
116
0
124 / 227 TO
117
0
76 / 230 >=
75
0
74 / 231 <=
75
0
74 / 232 <>
76
0
122 / 233 RANDOMIZE
101
116
104
117
115
111
132
105
0
101 / 234 AND
116
104
0
117 / 235 OR
122
0
116 / 236 NOT
117
124
0
106 / 237 FN
116
0
124 / 240 TAB
101
102
0
123 / 241 SPC
120
103
0
123 / 242 SGN
107
116
0
122 / 243 RND
116
104
0
123 / 244 SQR
121
122
0
101 / 245 ABS
102
123
0
111 / 246 INT
116
124
0
123 / 247 SIN
111
116
0
103 / 250 COS
117
123
0
101 / 251 ATN
124
116
0
114 / 252 LOG
117
107
0
105 / 253 EXP
130
120
0
124 / 254 TAN
101
116
0
NTOKEN=55
LIT
/ THE SOURCE PROGRAM BEGINS AT LOCATION BMEM
/ THE INITIALIZATION CODE ALSO BEGINS AT LOCATION BMEM
/ WHERE IT IS OVERWRITTEN BY THE SOURCE PROGRAM
/ BASIC CANNOT BE RESTARTED, JUST RELOADED
BMEM, IOF / JUST TO BE VERY SAFE
EEM / ENABLE EXTEND (NOP IF NOT INSTALLED)
KRB / KBD FLAG = 0
CLA / TTY FLAG = 1
TLS
DZM GETIX / CLEAR GLOBALS
DZM GETOX
DZM COL
DZM LP
DZM RNDS
LAC (BMEM / CLEAR TEXT BUFFER
DAC TTXT
JMS CLR / CLEAR GOTO STACK, FOR STACK, VARIABLES
JMS CSTK / CLEAR PUSH/POP STACK
LAC (RNDX / IN CASE RND() GETS CALLED BEFORE
JMS SFRND / THE FIRST RUN COMMAND
LAC (BMSG1-1 / SAY HELLO
DAC X0
BMEM1, LAC I X0
SNA
JMP BMEM2
JMS PUTC
JMP BMEM1
BMEM2, LAC (TMEM-BMEM / SAY FREE MEMORY SIZE
JMS PUTDEC
LAC (BMSG2-1
DAC X0
BMEM3, LAC I X0
SNA
JMP BMEM4
JMS PUTC
JMP BMEM3
BMEM4, JMP CMD
BMSG1, "P / HELLO MESSAGE
"D
"P
"-
"4
"/
"X
40
"B
"A
"S
"I
"C
40
"0
"6
40
"D
"G
"C
40
"2
"4
"-
"J
"U
"N
"-
"2
"0
"0
"1
15
12
0
BMSG2, 40 / FREE MEMORY SIZE MESSAGE
"W
"O
"R
"D
"S
40
"F
"R
"E
"E
15
12
0
LIT
/ END