ittybittycomputers.com/www.ittybittycomputers.com.tar/www.ittybittycomputers.com/IttyBitty/TinyBasic/TBasm.txt

Text File | 2006-10-18 | 20KB | 851 lines

1 REM TINY BASIC IL ASSEMBLER VERSION 0        1 JAN 1977
2 GOTO 100
3 *SX00JS30J 38BR40BVA0BNC0BEE0BC80PC24LB09LN0ANO08
4 *DS0BSP0CSB10RB11FV12SV13GS14RS15GO16NE17AD18SU19MP1ADV1B
5 *CP1CNX1DLS1FPN20PQ21PT22NL23GL27IL2AMT2BXQ2CWS2DUS2ERT2F
6
7               ....COPYRIGHT (C) 1977  BY TOM PITTMAN....
10 REMARKS:
11 LINES 3-5 ARE OPCODE TABLE
12 LABEL TABLE USES GOSUB STACK
13 .
14 THIS PROGRAM USES A 2-BYTE PEEK USR FUNCTION
15 PUT ITS ADDRESS IN VARIABLE D.
16 IN 6800:
17   LDA A,1,X        A IS LSB
18   LDA B,0,X
19   RTS
20 IN 6502:
21   STX $C3          ($C2=00)
22   LDA ($C2),Y      GET MSB
23   PHA              SAVE IT
24   INY
25   LDA ($C2),Y      GET LSB
26   TAX
27   PLA
28   TAY              Y=MSB
29   TXA
30   RTS
31 NOTE THAT THIS PROGRAM CORRECTS FOR 2-BYTE-DATA
32 IN 6502 FORMAT (LSB,MSB) WHEN INITIALIZING.
33 .
34 THE FOLLOWING VARIABLES ARE DEFINED:
35 A  STARTING ADDRESS
36 B  LINE BUFFER POINTER ADDRESS
37 C  LINE POINTER WORK
38 D  2-BYTE PEEK USR FUNCTION ADDRESS
39 E  END OF OPCODE TABLE
40 F  PASS #
41 G  PEEK USR FUNCTION ADDRESS
42 H  HEX WORK
43 I  TEMP WORK
44 J  TEMP WORK
45 K  TEMP WORK (HEX)
46 L  (RELATIVE) LOCATION COUNTER
47 M
48 N  LINE NUMBER
49 O  OP TABLE START
50 P  POKE USR FUNCTION ADDRESS
51 Q
52 R
53 S  SYMBOL TABLE START
54 T  TEMP (TABLE POINTER)
55 U
56 V  SYMBOL WORK
57 W  SYMBOL WORK
58 X  ERROR COUNT
59 Y
60 Z
61 .
62 SOURCE FILE IS IN THE FORM
63 (LINE NUMBER) :LABEL OP OPND COMMENTS
64 THE LINE NUMBER MUST BE >0.
65 THE LABEL IS IDENTIFIED BY THE LEADING COLON,
66 AND MAY BE 1-4 CHARACTERS LONG (FIRST IS LETTER);
67 IT IS TERMINATED BY BLANK, AND MAY BE OMITTED.
68 .
69 OP IS THE 2-LETTER OPCODE.
70 OPND IS THE OPERAND:
71 FOR SX IT MUST BE A DIGIT 1-7
72 FOR LB OR LN, A DECIMAL NUMBER 0-255 OR 0-65535
73 FOR PC, A STRING OF THE FORM 'STRING'
74 FOR JUMPS & BRANCHES IT MUST BE A SYMBOL
75 BRANCHES MAY REFER TO SYMBOL "*"
76 TO INVOKE ERROR STOP FORM.
77 BC REQUIRES BOTH A SYMBOL AND A STRING,
78 SEPARATED BY ONE OR MORE SPACES.
79 COMMENTS SHOULD BE PRECEDED BY A SPACE,
80 AND SHOULD NOT BEGIN WITH A DIGIT OR (+,-,*,/)
81 COMMENT LINES HAVE A PERIOD
82 FOLLOWING THE LINE NUMBER.
83 THE END OF FILE IS A LINE NUMBER 0.
84 .
85 SOURCE IS LISTED ON BOTH PASSES.
86 OUTPUT IS: HEX ADDRESS, HEX CODE, SEMICOLON,
87 ON SAME LINE AS FOLLOWING SOURCE.
88 .
89 .
90 ERROR FLAGS:
91 *DL* DUPLICATE LABEL (PASS 1)
92 *OP* OPERAND FORMAT ERROR
93 *IE* UNDEFINED OP CODE
94 *LE* INCOMPLETE LINE
95 *US* UNDEFINED SYMBOL (PASS 2)
99 .
100 REM
101 REM LINES 101-199 ONLY NEED TO EXECUTE ONCE.
102 REM THEY SHOULD BE DELETED AT STOP.
103 REM INPUT ADDRESS CONSTANTS
104 PRINT "PLEASE TYPE IN USR ADDRESS FOR PEEK (IN DECIMAL)";
105 INPUT G
106 PRINT "ADDRESS FOR POKE";
107 INPUT P
108 PRINT "ADDRESS FOR 2-BYTE PEEK";
109 INPUT D
110 B=47
111 O=USR(D,32)
112 E=USR(D,34)
113 IF USR(G,B)>0 GOTO 118
114 B=46
115 O=USR(G,32)+USR(G,33)*256
116 E=USR(G,34)+USR(G,35)*256
118 E=E+1
119 REM FIND OPCODE TABLE (LINE 3)
120 O=O+1
121 IF USR(G,O)<>3 GOTO 120
122 O=O+2
130 Y=1
131 N=0
132 PRINT "DO YOU NEED INSTRUCTIONS (Y OR N)";
133 INPUT I
134 IF I=Y LIST 61,99
190 PRINT "REMOVE LINES 10-99, 101-199"
191 PRINT "OR IF YOU HAVE PLENTY OF MEMORY,"
192 PRINT "RETYPE LINE: 100 GOTO 200"
193 PRINT "THEN TYPE RUN."
195 GOTO 200
198 END
199 REM 2-PASS ASSEMBLER. START FIRST PASS.
200 X=0
201 S=E
202 F=0
203 PRINT "(DECIMAL) STARTING ADDRESS";
204 INPUT A
205 F=F+1
206 IF F=3 GOTO 760
207 L=0
208 PRINT
209 PRINT "TBIL ASSEMBLER, PASS ";F
210 PRINT
211 GOSUB 460
212 PRINT ";    ";
213 REM GET NEXT INPUT LINE
214 I=USR(P,USR(G,B),13)
215 INPUT N
216 REM LINE NUMBER 0 IS EOF
217 IF N=0 GOTO 205
218 GOSUB 460
219 REM CHECK FOR COMMENT
220 I=USR(G,USR(G,B))
221 IF I<58 GOTO 212
222 REM PROCESS LABEL, IF ANY
223 IF I>64 GOTO 300
224 GOSUB 405
225 GOSUB 500
231 REM CHECK FOR DUPLICATES ON PASS 1
232 IF F>1 GOTO 300
234 IF T=0 GOSUB 237
235 GOTO 901
237 GOSUB 238
238 GOSUB 239
239 S=S-6
240 REM INSERT THIS ONE
241 I=USR(P,S,V/256)+USR(P,S+1,V)
242 I=USR(P,S+2,W/256)+USR(P,S+3,W)
243 I=USR(P,S+4,L/256)+USR(P,S+5,L)
290 REM LOOK AT OPCODE
300 GOSUB 410
301 IF I<65 GOTO 911
305 I=USR(D,USR(G,B))
306 GOSUB 404
307 REM SEARCH OPCODE TABLE
308 T=O
309 IF USR(D,T)=I GOTO 313
310 T=T+4
311 IF T<O+167 GOTO 309
312 GOTO 911
313 V=USR(G,T+2)
314 W=USR(G,T+3)
315 L=L+1
316 IF T=O GOTO 330
317 IF T<O+10 GOTO 340
318 IF T<O+30 GOTO 360
319 IF T=O+32 GOTO 380
320 IF T=O+36 GOTO 350
321 IF T=O+40 GOTO 550
322 REM THESE OPCODES HAVE NO OPERAND
323 H=V
324 GOSUB 434
325 H=W
326 GOSUB 434
327 PRINT ";  ";
328 GOTO 214
329 REM STACK EXCHANGE OPERATOR
330 GOSUB 410
331 W=USR(G,USR(G,B))
332 IF I>48 IF I<56 GOTO 323
333 REM OPERAND FORMAT ERROR
334 GOTO 921
336 IF F=1 GOTO 212
337 GOTO 931
339 REM JUMP & CALL
340 L=L+1
341 GOSUB 410
342 IF I<65 GOTO 334
344 K=W-W/16*16
345 GOSUB 500
346 IF T=0 GOTO 336
347 K=I+(K+48)*256
348 GOTO 356
349 REM PUSH LITERAL BYTE ON STACK
350 L=L+1
351 GOSUB 410
352 IF I<48 GOTO 334
353 IF I>57 GOTO 334
354 INPUT K
355 K=K+2304
356 GOSUB 440
357 PRINT ";";
358 GOTO 214
359 REM RELATIVE BRANCHES
360 K=T
362 GOSUB 410
363 IF I=42 GOTO 365
364 IF I<65 GOTO 334
365 GOSUB 500
366 IF T=0 IF K<O+28*F GOTO 336
367 IF I>L+31 GOTO 334
368 IF K=O+12 THEN I=I+32
369 IF I<L GOTO 334
370 I=I-L
371 T=K
372 H=USR(G,K+2)+I/16
373 K=I-I/16*16
374 GOSUB 434
375 GOSUB 455
376 IF T<O+28 GOTO 327
377 GOTO 381
379 REM STRING OPERATORS
380 PRINT "24";
381 GOSUB 410
382 J=L
383 T=I
384 GOSUB 405
385 K=USR(G,USR(G,B))
386 GOSUB 405
387 I=USR (G,USR(G,B))
388 IF I<>94 GOTO 391
389 K=K-64
390 GOTO 386
391 L=L+1
392 IF I=13 GOTO 334
393 IF T=I GOTO 397
394 GOSUB 450
395 K=I
396 GOTO 386
397 K=K+128
398 GOSUB 450
399 PRINT ";";
400 IF L=J+1 GOTO 214
401 GOTO 210
402 REM      ---      SUBROUTINES
403 REM ADVANCE INPUT LINE POINTER
404 GOSUB 405
405 C=USR(P,B,USR(G,B)+1)
406 RETURN
407 REM
408 REM SKIP BLANKS IN INPUT LINE
409 GOSUB 405
410 I=USR(G,USR(G,B))
411 IF I=32 GOTO 409
412 IF I>32 RETURN
413 GOTO 941
418 REM
419 REM PRINT HEX DIGITS
420 PRINT "A";
421 RETURN
422 PRINT "B";
423 RETURN
424 PRINT "C";
425 RETURN
426 PRINT "D";
427 RETURN
428 PRINT "E";
429 RETURN
430 PRINT "F";
431 RETURN
434 IF H>64 GOTO H+H+290
435 H=H-48
436 IF H>9 GOTO 400+H+H
437 PRINT H;
438 RETURN
439 REM PRINT NUMBER AS HEX
440 H=K/4096
441 IF K<0 THEN H=H-1
442 K=K-H*4096
443 IF H<0 THEN H=H+16
444 GOSUB 436
445 H=K/256
446 K=K-H*256
447 GOSUB 436
450 H=K/16
451 K=K-H*16
452 GOSUB 436
455 H=K
456 GOTO 436
458 REM
459 REM PRINT LOCATION COUNTER
460 K=A+L
461 GOSUB 440
462 PRINT " ";
463 RETURN
498 REM
499 REM LOOK UP SYMBOL IN TABLE
500 V=0
501 W=8224
502 C=USR(G,B)
503 I=USR(G,C)
504 IF I<48 GOTO 525
505 I=USR(G,C+1)
506 IF I<32 THEN I=(USR(P,C+1,32)+USR(P,C+2,13))*0+32
508 W=USR(D,C)
509 GOSUB 404
510 IF V>0 GOTO 513
511 V=W
512 GOTO 501
513 T=S
514 GOTO 518
515 I=USR(D,T+4)
516 IF V=USR(D,T) IF W=USR(D,T+2) RETURN
517 T=T+6
518 IF T<E GOTO 515
519 T=0
520 I=L
521 RETURN
524 REM ASTERISK OPERAND?
525 IF I<>42 GOTO 510
526 T=1
527 I=L
528 GOTO 405
548 REM
549 REM PUSH 2-BYTE LITERAL ONTO STACK
550 PRINT "0A;"
552 GOSUB 460
553 L=L+2
554 GOSUB 410
555 IF I<48 GOTO 334
556 IF I>57 GOTO 334
557 INPUT K
558 GOTO 356
700 REM PROGRAM END
760 PRINT
770 PRINT X;" ERRORS"
790 END
900 REM ERROR MESSAGES
901 PRINT "*DL* ";
902 X=X+1
903 GOTO 300
911 PRINT "*IE* ";
912 X=X+1
914 L=L+2
915 GOTO 214
921 PRINT "*OP* ";
922 X=X+1
923 GOTO 214
931 PRINT "*US* ";
932 X=X+1
933 GOTO 214
941 PRINT "*LE* ";
942 X=X+1
944 RETURN
999 END




REM -- Run this assembler on original IL source code...
RUN
276
280
277
N
0
   1 .  ORIGINAL TINY BASIC INTERMEDIATE INTERPRETER
   2 .
   3 .  EXECUTIVE INITIALIZATION
   4 .
   5 :STRT PC ":Q^"        COLON, X-ON
   6       GL
   7       SB
   8       BE L0           BRANCH IF NOT EMPTY
   9       BR STRT         TRY AGAIN IF NULL LINE
  10 :L0   BN STMT         TEST FOR LINE NUMBER
  11       IL              IF SO, INSERT INTO PROGRAM
  12       BR STRT         GO GET NEXT
  13 :XEC  SB              SAVE POINTERS FOR RUN WITH
  14       RB                CONCATENATED INPUT
  15       XQ
  16 .
  17 .  STATEMENT EXECUTOR
  18 .
  19 :STMT BC GOTO "LET"
  20       BV *            MUST BE A VARIABLE NAME
  21       BC * "="
  22 :LET  JS EXPR         GO GET EXPRESSION
  23       BE *            IF STATEMENT END,
  24       SV                STORE RESULT
  25       NX
  26 .
  27 :GOTO BC PRNT "GO"
  28       BC GOSB "TO"
  29       JS EXPR         GET LINE NUMBER
  30       BE *
  31       SB              (DO THIS FOR STARTING)
  32       RB
  33       GO              GO THERE
  34 .
  35 :GOSB BC * "SUB"      NO OTHER WORD BEGINS "GO..."
  36       JS EXPR
  37       BE *
  38       GS
  39       GO
  40 .
  41 :PRNT BC SKIP "PR"
  42       BC P0 "INT"     OPTIONALLY OMIT "INT"
  43 :P0   BE P3
  44       BR P6           IF DONE, GO TO END
  45 :P1   BC P4 ";"
  46 :P2   BE P3
  47       NX              NO CRLF IF ENDED BY ; OR ,
  48 :P3   BC P7 '"'
  49       PQ              QUOTE MARKS STRING
  50       BR P1           GO CHECK DELIMITER
  51 :SKIP BR IF           (ON THE WAY THRU)
  52 :P4   BC P5 ","
  53       PT              COMMA SPACING
  54       BR P2
  55 :P5   BC P6 ":"
  56       PC "S^"         OUTPUT X-OFF
  57 :P6   BE *
  58       NL              THEN CRLF
  59       NX
  60 :P7   JS EXPR         TRY FOR AN EXPRESSION
  61       PN
  62       BR P1
  63 .
  64 :IF   BC INPT "IF"
  65       JS EXPR
  66       JS RELO
  67       JS EXPR
  68       BC I1 "THEN"    OPTIONAL NOISEWORD
  69 :I1   CP              COMPARE SKIPS NEXT IF TRUE
  70       NX              FALSE.
  71       J STMT          TRUE. GO PROCESS STATEMENT
  72 .
  73 :INPT BC RETN "INPUT"
  74 :I2   BV *            GET VARIABLE
  75       SB              SWAP POINTERS
  76       BE I4
  77 :I3   PC "? Q^"       LINE IS EMPTY; TYPE PROMPT
  78       GL              READ INPUT LINE
  79       BE I4           DID ANYTHING COME?
  80       BR I3           NO, TRY AGAIN
  81 :I4   BC I5 ","       OPTIONAL COMMA
  82 :I5   JS EXPR         READ A NUMBER
  83       SV              STORE INTO VARIABLE
  84       RB              SWAP BACK
  85       BC I6 ","       ANOTHER?
  86       BR I2           YES IF COMMA
  87 :I6   BE *            OTHERWISE QUIT
  88       NX
  89 .
  90 :RETN BC END "RETURN"
  91       BE *
  92       RS              RECOVER SAVED LINE
  93       NX
  94 .
  95 :END  BC LIST "END"
  96       BE *
  97       WS
  98 .
  99 :LIST BC RUN "LIST"
 100       BE L2
 101 :L1   PC "@^@^@^@^J^@^" PUNCH LEADER
 102       LS              LIST
 103       PC "S^"         PUNCH X-OFF
 104       NL
 105       NX
 106 :L2   JS EXPR         GET A LINE NUMBER
 107       BE L3
 108       BR L1
 109 :L3   BC * ","        SEPARATED BY COMMAS
 110       BR L2
 111 .
 112 :RUN  BC CLER "RUN"
 113       J XEC
 114 .
 115 :CLER BC REM "CLEAR"
 116       MT
 117 .
 118 :REM  BC DFLT "REM"
 119       NX
 120 .
 121 :DFLT BV *            NO KEYWORD...
 122       BC * "="        TRY FOR LET
 123       J LET           IT'S A GOOD BET.
 124 .
 125 .  SUBROUTINES
 126 .
 127 :EXPR BC E0 "-"       TRY FOR UNARY MINUS
 128       JS TERM         AHA
 129       NE
 130       BR E1
 131 :E0   BC E4 "+"       IGNORE UNARY PLUS
 132 :E4   JS TERM
 133 :E1   BC E2 "+"       TERMS SEPARATED BY PLUS
 134       JS TERM
 135       AD
 136       BR E1
 137 :E2   BC E3 "-"       TERMS SEPARATED BY MINUS
 138       JS TERM
 139       SU
 140       BR E1
 141 :E3   RT
 142 .
 143 :TERM JS FACT
 144 :T0   BC T1 "*"       FACTORS SEPARATED BY TIMES
 145       JS FACT
 146       MP
 147       BR T0
 148 :T1   BC T2 "/"       FACTORS SEPARATED BY DIVIDE
 149       JS  FACT
 150       DV
 151       BR T0
 152 :T2   RT
 153 .
 154 :FACT BC F0 "RND"     *RND FUNCTION*
 155       LN 257*128      STACK POINTER FOR STORE
 156       FV              THEN GET RNDM
 157       LN 2345         R:=R*2345+6789
 158       MP
 159       LN 6789
 160       AD
 161       SV
 162       LB 128          GET IT AGAIN
 163       FV
 263       SX 1            (slightly better RND)
 164       DS
 165       JS FUNC         GET ARGUMENT
 166       BR F1
 167 :F0   BR F2           (SKIPPING)
 168 :F1   DS
 169 .     SX 2            PUSH TOP INTO STACK
 170       SX 4
 171       SX 2
 172       SX 3
 173       SX 5
 174       SX 3
 175       DV              PERFORM MOD FUNCTION
 176       MP
 177       SU
 178       DS              PERFORM ABS FUNCTION
 179       LB 6
 180       LN 0
 181       CP              (SKIP IF + OR 0)
 182       NE
 183       RT
 184 :F2   BC F3 "USR"     *USR FUNCTION*
 185       BC * "("        3 ARGUMENTS POSSIBLE
 186       JS EXPR         ONE REQUIRED
 187       JS ARG
 188       JS ARG
 189       BC * ")"
 190       US              GO DO IT
 191       RT
 192 :F3   BV F4           VARIABLE?
 193       FV              YES.  GET IT
 194       RT
 195 :F4   BN F5           NUMBER?
 196       RT              GOT IT.
 197 :F5   BC * "("        OTHERWISE MUST BE (EXPR)
 198 :F6   JS EXPR
 199       BC * ")"
 200       RT
 201 .
 202 :ARG  BC A0 ","        COMMA?
 203       J  EXPR          YES, GET EXPRESSION
 204 :A0   DS               NO, DUPLICATE STACK TOP
 205       RT
 206 .
 207 :FUNC BC * "("
 208       BR F6
 209       RT
 210 .
 211 :RELO BC R0 "="        CONVERT RELATION OPERATORS
 212       LB 2             TO CODE BYTE ON STACK
 213       RT               =
 214 :R0   BC R4 "<"
 215       BC R1 "="
 216       LB 3             <=
 217       RT
 218 :R1   BC R3 ">"
 219       LB 5             <>
 220       RT
 221 :R3   LB 1             <
 222       RT
 223 :R4   BC * ">"
 224       BC R5 "="
 225       LB 6             >=
 226       RT
 227 :R5   BC R6 "<"
 228       LB 5             ><
 229       RT
 230 :R6   LB 4             >
 231       RT
 232 .
0000
   1 .  ORIGINAL TINY BASIC INTERMEDIATE INTERPRETER
   2 .
   3 .  EXECUTIVE INITIALIZATION
   4 .
   5 :STRT PC ":Q^"        COLON, X-ON
   6       GL
   7       SB
   8       BE L0           BRANCH IF NOT EMPTY
   9       BR STRT         TRY AGAIN IF NULL LINE
  10 :L0   BN STMT         TEST FOR LINE NUMBER
  11       IL              IF SO, INSERT INTO PROGRAM
  12       BR STRT         GO GET NEXT
  13 :XEC  SB              SAVE POINTERS FOR RUN WITH
  14       RB                CONCATENATED INPUT
  15       XQ
  16 .
  17 .  STATEMENT EXECUTOR
  18 .
  19 :STMT BC GOTO "LET"
  20       BV *            MUST BE A VARIABLE NAME
  21       BC * "="
  22 :LET  JS EXPR         GO GET EXPRESSION
  23       BE *            IF STATEMENT END,
  24       SV                STORE RESULT
  25       NX
  26 .
  27 :GOTO BC PRNT "GO"
  28       BC GOSB "TO"
  29       JS EXPR         GET LINE NUMBER
  30       BE *
  31       SB              (DO THIS FOR STARTING)
  32       RB
  33       GO              GO THERE
  34 .
  35 :GOSB BC * "SUB"      NO OTHER WORD BEGINS "GO..."
  36       JS EXPR
  37       BE *
  38       GS
  39       GO
  40 .
  41 :PRNT BC SKIP "PR"
  42       BC P0 "INT"     OPTIONALLY OMIT "INT"
  43 :P0   BE P3
  44       BR P6           IF DONE, GO TO END
  45 :P1   BC P4 ";"
  46 :P2   BE P3
  47       NX              NO CRLF IF ENDED BY ; OR ,
  48 :P3   BC P7 '"'
  49       PQ              QUOTE MARKS STRING
  50       BR P1           GO CHECK DELIMITER
  51 :SKIP BR IF           (ON THE WAY THRU)
  52 :P4   BC P5 ","
  53       PT              COMMA SPACING
  54       BR P2
  55 :P5   BC P6 ":"
  56       PC "S^"         OUTPUT X-OFF
  57 :P6   BE *
  58       NL              THEN CRLF
  59       NX
  60 :P7   JS EXPR         TRY FOR AN EXPRESSION
  61       PN
  62       BR P1
  63 .
  64 :IF   BC INPT "IF"
  65       JS EXPR
  66       JS RELO
  67       JS EXPR
  68       BC I1 "THEN"    OPTIONAL NOISEWORD
  69 :I1   CP              COMPARE SKIPS NEXT IF TRUE
  70       NX              FALSE.
  71       J STMT          TRUE. GO PROCESS STATEMENT
  72 .
  73 :INPT BC RETN "INPUT"
  74 :I2   BV *            GET VARIABLE
  75       SB              SWAP POINTERS
  76       BE I4
  77 :I3   PC "? Q^"       LINE IS EMPTY; TYPE PROMPT
  78       GL              READ INPUT LINE
  79       BE I4           DID ANYTHING COME?
  80       BR I3           NO, TRY AGAIN
  81 :I4   BC I5 ","       OPTIONAL COMMA
  82 :I5   JS EXPR         READ A NUMBER
  83       SV              STORE INTO VARIABLE
  84       RB              SWAP BACK
  85       BC I6 ","       ANOTHER?
  86       BR I2           YES IF COMMA
  87 :I6   BE *            OTHERWISE QUIT
  88       NX
  89 .
  90 :RETN BC END "RETURN"
  91       BE *
  92       RS              RECOVER SAVED LINE
  93       NX
  94 .
  95 :END  BC LIST "END"
  96       BE *
  97       WS
  98 .
  99 :LIST BC RUN "LIST"
 100       BE L2
 101 :L1   PC "@^@^@^@^J^@^" PUNCH LEADER
 102       LS              LIST
 103       PC "S^"         PUNCH X-OFF
 104       NL
 105       NX
 106 :L2   JS EXPR         GET A LINE NUMBER
 107       BE L3
 108       BR L1
 109 :L3   BC * ","        SEPARATED BY COMMAS
 110       BR L2
 111 .
 112 :RUN  BC CLER "RUN"
 113       J XEC
 114 .
 115 :CLER BC REM "CLEAR"
 116       MT
 117 .
 118 :REM  BC DFLT "REM"
 119       NX
 120 .
 121 :DFLT BV *            NO KEYWORD...
 122       BC * "="        TRY FOR LET
 123       J LET           IT'S A GOOD BET.
 124 .
 125 .  SUBROUTINES
 126 .
 127 :EXPR BC E0 "-"       TRY FOR UNARY MINUS
 128       JS TERM         AHA
 129       NE
 130       BR E1
 131 :E0   BC E4 "+"       IGNORE UNARY PLUS
 132 :E4   JS TERM
 133 :E1   BC E2 "+"       TERMS SEPARATED BY PLUS
 134       JS TERM
 135       AD
 136       BR E1
 137 :E2   BC E3 "-"       TERMS SEPARATED BY MINUS
 138       JS TERM
 139       SU
 140       BR E1
 141 :E3   RT
 142 .
 143 :TERM JS FACT
 144 :T0   BC T1 "*"       FACTORS SEPARATED BY TIMES
 145       JS FACT
 146       MP
 147       BR T0
 148 :T1   BC T2 "/"       FACTORS SEPARATED BY DIVIDE
 149       JS  FACT
 150       DV
 151       BR T0
 152 :T2   RT
 153 .
 154 :FACT BC F0 "RND"     *RND FUNCTION*
 155       LN 257*128      STACK POINTER FOR STORE
 156       FV              THEN GET RNDM
 157       LN 2345         R:=R*2345+6789
 158       MP
 159       LN 6789
 160       AD
 161       SV
 162       LB 128          GET IT AGAIN
 163       FV
 263       SX 1            (slightly better RND)
 164       DS
 165       JS FUNC         GET ARGUMENT
 166       BR F1
 167 :F0   BR F2           (SKIPPING)
 168 :F1   DS
 169 .     SX 2            PUSH TOP INTO STACK
 170       SX 4
 171       SX 2
 172       SX 3
 173       SX 5
 174       SX 3
 175       DV              PERFORM MOD FUNCTION
 176       MP
 177       SU
 178       DS              PERFORM ABS FUNCTION
 179       LB 6
 180       LN 0
 181       CP              (SKIP IF + OR 0)
 182       NE
 183       RT
 184 :F2   BC F3 "USR"     *USR FUNCTION*
 185       BC * "("        3 ARGUMENTS POSSIBLE
 186       JS EXPR         ONE REQUIRED
 187       JS ARG
 188       JS ARG
 189       BC * ")"
 190       US              GO DO IT
 191       RT
 192 :F3   BV F4           VARIABLE?
 193       FV              YES.  GET IT
 194       RT
 195 :F4   BN F5           NUMBER?
 196       RT              GOT IT.
 197 :F5   BC * "("        OTHERWISE MUST BE (EXPR)
 198 :F6   JS EXPR
 199       BC * ")"
 200       RT
 201 .
 202 :ARG  BC A0 ","        COMMA?
 203       J  EXPR          YES, GET EXPRESSION
 204 :A0   DS               NO, DUPLICATE STACK TOP
 205       RT
 206 .
 207 :FUNC BC * "("
 208       BR F6
 209       RT
 210 .
 211 :RELO BC R0 "="        CONVERT RELATION OPERATORS
 212       LB 2             TO CODE BYTE ON STACK
 213       RT               =
 214 :R0   BC R4 "<"
 215       BC R1 "="
 216       LB 3             <=
 217       RT
 218 :R1   BC R3 ">"
 219       LB 5             <>
 220       RT
 221 :R3   LB 1             <
 222       RT
 223 :R4   BC * ">"
 224       BC R5 "="
 225       LB 6             >=
 226       RT
 227 :R5   BC R6 "<"
 228       LB 5             ><
 229       RT
 230 :R6   LB 4             >
 231       RT
 232 .
0000