-
Notifications
You must be signed in to change notification settings - Fork 4
/
SCMPCA.B2S
549 lines (546 loc) · 14.6 KB
/
SCMPCA.B2S
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
1010 REM !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! &
REM !! !! &
REM !! SC/MP CROSS ASSEMBLER !! &
REM !! !!
1020 REM !! A.G. NICHOLSON, NEWCASTLE UNI. !! &
REM !! !! &
REM !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
1021 REM &
REM ! Last edited: 30-Jan-79 &
1025 C9%=0%
1030 DIM O$(51), O%(51), T$(255), T%(255), D%(3)
1040 ! -- Set up error trap routine --
1050 ON ERROR GOTO 31020 &
\ X$=SYS(CHR$(6%)+CHR$(-7%))
1060 ! -- Initialise --
1070 N%=51% &
\ T%(0%)=255% &
\ T0%=TIME(1%) &
\ F1$="KB:" &
\ READ O$(I%), O%(I%) FOR I%=0% TO N%
1080 ! -- Print header --
1090 OPEN F1$ AS FILE 1% &
\ GOTO 1130 IF C9% &
\ PRINT #1%,"SC/MP Cross assembler" &
\ PRINT #1%,"#";
1100 ! -- Get listing, source filenames --
1110 INPUT LINE #1%, F2$ &
\ F2$=CVT$$(F2$,-1%)
1120 ! -- Check for errors only switch --
1130 F0%=-1% &
\ L%=INSTR(1%,F2$,"/E") &
\ IF L% THEN F2$=LEFT(F2$,L%-1%)+RIGHT(F2$,L%+2%) &
\ F0%=0%
1140 ! -- Check for object module output switch --
1150 F4%=0% &
\ L%=INSTR(1%,F2$,"/O") &
\ IF L% THEN F2$=LEFT(F2$,L%-1%)+RIGHT(F2$,L%+2%) &
\ F4%=-1%
1160 ! -- Check for listing file and add default extensions --
1170 F5%=INSTR(1%,F2$,"=") &
\ IF F5% THEN F1$=LEFT(F2$,F5%-1%) &
\ F1$=F1$+".LST" UNLESS INSTR(1%,F1$,".") &
\ F2$=RIGHT(F2$,F5%+1%)
1180 F2$=F2$+".SRC" UNLESS INSTR(1%,F2$,".")
1190 PRINT #1%,"Listing sent to ";F1$ IF F5%
1200 IF F4% THEN F4$=LEFT(F2$,INSTR(1%,F2$,"."))+"BIN" &
\ PRINT #1%,"Object module to ";F4$
1210 ! -- Get a unique workfile name --
1220 W$="SCMP"+MID(NUM$(100%+ASCII(SYS(CHR$(6%)+CHR$(9%)))/2%),3%,2%)+".TMP"
1230 ! -- Commence assembly --
1240 GOSUB 1310 &
\ GOSUB 1860 &
\ X%=1% &
\ GOSUB 2460
1250 ! -- Print symbol table --
1260 GOSUB 2480 IF T% AND F0% &
\ PRINT #1%
1270 ! -- Finish up and exit --
1280 CLOSE 1 &
\ IF F5% THEN X%=0% &
\ GOSUB 2460
1290 PRINT "Runtime was";(TIME(1%)-T0%)/10;"sec" &
\ GOTO 32767
1300 ! -- Pass 1 Driver routine --
1310 E%,T%,N0%,N1%,F1%,O%=0% \ P0%=1% &
\ OPEN F2$ FOR INPUT AS FILE 2% &
\ PRINT #1% &
\ OPEN W$ FOR OUTPUT AS FILE 3% &
\ PRINT #1%,"Pass 1"
1320 FOR L%=1% STEP 1% UNTIL O%=N% &
\ INPUT LINE #2%, L$ &
\ L$=CVT$$(L$,165%) &
\ L1%=LEN(L$)
1330 IF L1%=0% THEN O%=0% &
\ GOTO 1450
1340 ! -- Scan source line --
1350 GOSUB 1470 &
\ GOSUB 1520
1360 ! -- Comment line ? --
1370 IF D3%=1% THEN O%=0% &
\ GOTO 1450
1380 ! -- Get argument field --
1390 IF D3% THEN A$=CVT$$(MID(L$,D2%+1%,D3%-D2%-1%),136%) &
ELSE A$=CVT$$(RIGHT(L$,D2%+1%),8%)
1400 ! -- Label ? --
1410 IF D1% THEN S$=CVT$$(LEFT(L$,D1%-1%),128%) &
\ S1%=N1% &
\ GOSUB 1600
1420 ! -- Assignment ? --
1430 IF D4% THEN GOSUB 1650 &
ELSE GOSUB 1690
1440 ! -- Write to workfile --
1450 GOSUB 1710 &
\ NEXT L% &
\ CLOSE 2,3 &
\ RETURN
1460 ! -- Scan for strings in L$, D%() is the delimiter table --
1470 D%=-1% &
\ S2%=0%
1480 S1%=INSTR(S2%+1%,L$,"'") &
\ RETURN UNLESS S1% &
\ IF MID(L$,S1%-1%,1%)="X" THEN S2%=S1% &
\ GOTO 1480
1490 S2%=INSTR(S1%+1%,L$,"'") &
\ IF S2% THEN D%=D%+1% &
\ IF D%<4% THEN D%(D%)=SWAP%(S1% AND 255%) OR (S2% AND 255%) &
\ GOTO 1480
1500 RETURN
1510 &
! -- Search for token delimiters -- &
! D1% Label &
! D2% Opcode &
! D3% Comment &
! D4% Assignment
1520 D1%=INSTR(1%,L$,":") &
\ D1%=0% IF FNS%(D1%) &
\ D3%=0%
1530 D3%=INSTR(D3%+1%,L$,";") &
\ GOTO 1530 IF FNS%(D3%) &
\ D1%=0% IF (D1%>D3% AND D3%<>0%) &
\ D2%=D1%
1540 D2%=D2%+1% &
\ IF D2%>=L1% THEN 1560 &
ELSE X%=ASCII(RIGHT(L$,D2%)) &
\ IF X%=9% OR X%=32% THEN 1540
1550 D2%=D2%+1% &
\ IF D2%<L1% THEN X%=ASCII(RIGHT(L$,D2%)) &
\ IF X%<>9% AND X%<>32% THEN 1550 &
ELSE D2%=D2%-1%
1560 D4%=INSTR(1%,L$,"=") &
\ D4%=0% IF FNS%(D4%) OR (D4%>D3% AND D3%<>0%) &
\ D2%=D4% IF D4%
1570 D2%=D3%-1% IF (D2%>=D3% AND D3%<>0%) &
\ RETURN
1590 &
! Enter symbol S$ and its value S1% into T$() and T%() &
1600 X%=ASCII(S$) &
\ IF X%<65% OR X%>90% OR LEN(S$)>6% THEN &
X%=FNE%("Inv sym "+S$) &
\ RETURN
1610 FOR I%=1% TO T% &
\ IF S$=T$(I%) THEN S1%=FNE%("Redef sym "+S$) &
\ RETURN
1620 NEXT I% &
\ IF T%=T%(0%) THEN PRINT #1%,"Sym ovf" &
\ RETURN
1630 T%=T%+1% &
\ T$(T%)=S$ &
\ T%(T%)=S1% &
\ RETURN
1640 ! -- Enter assignment --
1650 S$=CVT$$(MID(L$,D1%+1%,D4%-D1%-1%),136%) &
\ S1%=FNA%(A$)
1660 IF S$="." THEN N1%=S1% &
ELSE IF S$<>"" THEN GOSUB 1600 &
ELSE S1%=FNE%("Missing symbol")
1670 O%=0% &
\ RETURN
1680 ! -- Get opcode subscript --
1690 X1$=CVT$$(MID(L$,D1%+1%,D2%-D1%),8%) &
\ RETURN IF X1$=O$(O%) FOR O%=0% TO N% &
\ O%=FNE%("Inv opc "+X1$) &
\ RETURN
1700 ! -- Get byte count and output to workfile --
1710 IF O%>46% THEN GOSUB 1770 &
ELSE IF O%>22% THEN N2%=1% &
ELSE IF O%>0% THEN N2%=2% &
ELSE N2%=0%
1720 PRINT #3%,N1%;",";N2%;",";O%;",";F1% &
\ PRINT #3%,A$ &
\ N0%=N0%+N2% &
\ N1%=N1%+N2% &
\ F1%=0% &
\ RETURN
1760 ! -- Get byte count for pseudo-op --
1770 ON O%-46% GOTO 1790, 1790, 1810, 1840, 1840
1780 ! -- .BYTE, .DBYTE --
1790 S1%=0% \ S2%=-1% &
\ FOR N2%=0% WHILE S2% &
\ S1%, S2%=INSTR(S1%+1%,A$,",") &
\ NEXT N2% &
\ N2%=N2%*2% IF O%=48% &
\ RETURN
1800 ! -- .ASCII --
1810 S1%=INSTR(2%,A$,LEFT(A$,1%)) &
\ IF S1% THEN N2%=S1%-2% &
\ RETURN
1820 O%=FNE%("Missing delim") &
\ RETURN
1830 ! -- .LIST, END --
1840 N2%=0% &
\ RETURN
1850 ! -- Pass 2 Driver routine --
1860 L%,C%,F2%=0% &
\ P0%=2% &
\ F3%=-1% &
\ PRINT #1%,"Pass 2" &
\ CLOSE 1 &
\ OPEN F1$ FOR OUTPUT AS FILE 1% &
\ OPEN F2$ FOR INPUT AS FILE 2% &
\ OPEN W$ FOR INPUT AS FILE 3%
1870 ! -- If object out then output leader and <stx> and byte count --
1880 IF F4% THEN OPEN F4$ FOR OUTPUT AS FILE 4% &
\ GOSUB 2350 &
\ B%=2% &
\ GOSUB 2440 &
\ B%=SWAP%(N0%) AND 255% &
\ GOSUB 2440 &
\ B%=N0% AND 255% &
\ GOSUB 2440
1890 IF F0% THEN PRINT #1% &
\ PRINT #1%," Line Addr B1 B2" &
\ PRINT #1%
1900 INPUT #3%,N1%,N2%,O%,F1% &
\ INPUT LINE #3%, A$ &
\ A$=CVT$$(A$,4%) &
\ INPUT LINE #2%, L$ &
\ L$=CVT$$(L$,4%) &
\ L%=L%+1%
1910 ! -- Form object code and output to listing file --
1920 IF O%=N% THEN GOSUB 1980 &
\ RETURN
1930 IF O%=0% THEN GOSUB 2370 &
\ GOTO 1900
1940 O1$=FNH$(N1%,0%) &
\ V%=O%(O%)
1950 IF O%>46% THEN GOSUB 2140 &
ELSE IF O%>25% THEN GOSUB 2120 &
ELSE IF O%>22% THEN GOSUB 2100 &
ELSE IF O%>14% THEN GOSUB 2080 &
ELSE IF O%>8% THEN GOSUB 2030 &
ELSE GOSUB 2010
1960 GOTO 1900
1970 ! -- End of assembly, tidy up --
1980 GOSUB 2370 &
\ IF F4% THEN B%=2% &
\ GOSUB 2440 &
\ B%=C% AND 255% &
\ GOSUB 2440 &
\ GOSUB 2350
1990 CLOSE 2,3,4 &
\ KILL W$ &
\ RETURN
2000 ! -- Memory reference --
2010 S1%=INSTR(1%,A$,"@") &
\ IF S1% THEN V%=V%+4% &
\ A$=LEFT(A$,S1%-1%)+RIGHT(A$,S1%+1%)
2020 ! -- Memory reference, inc, dec and transfer --
2030 GOSUB 2290 &
\ V%=V%+P% &
\ GOSUB 2250
2040 V%=FNA%(A$) &
\ IF P%=0% THEN V%=V%-N1%-1% &
\ IF O%>8% AND O%<13% THEN V%=V%-1%
2041 ! Quirk for wrap around within 4K page - fixed 09-Oct-2018
2042 IF V%>(4096%-127%) THEN V%=V%-4096%
2050 IF V%<-128% OR V%>127% THEN V%=FNE%("Inv disp ="+NUM$(V%))
2060 GOSUB 2270 &
\ GOSUB 2370 &
\ RETURN
2070 ! -- Immediate and Delay --
2080 GOSUB 2250 &
\ V%=FNA%(A$) &
\ GOSUB 2270 &
\ GOSUB 2370 &
\ RETURN
2090 ! -- Pointer exchange --
2100 GOSUB 2290 &
\ P%=FNA%(A$) UNLESS P% &
\ V%=V%+P%
2110 ! -- Single byte --
2120 GOSUB 2250 &
\ GOSUB 2370 &
\ RETURN
2130 ! -- Pseudo-ops. --
2140 ON O%-46% GOTO 2160, 2160, 2210, 2230
2150 ! -- .BYTE, .DBYTE --
2160 A$=A$+"," &
\ FOR I%=1% TO N2% STEP O%-46% &
\ O1$=FNH$(N1%+I%-1%,0%) &
\ S1%=INSTR(1%,A$,",")
2170 S2%=FNA%(LEFT(A$,S1%-1%)) &
\ IF O%=48% THEN V%=SWAP%(S2%) &
\ GOSUB 2250 &
\ V%=S2% &
\ GOSUB 2270
2180 IF O%=47% THEN V%=S2% &
\ GOSUB 2250
2190 GOSUB 2370 &
\ A$=RIGHT(A$,S1%+1%) &
\ NEXT I% &
\ RETURN
2200 ! -- .ASCII --
2210 A$=MID(A$,2%,N2%) &
\ FOR I%=1% TO N2% &
\ O1$=FNH$(N1%+I%-1%,0%) &
\ V%=ASCII(RIGHT(A$,I%)) &
\ GOSUB 2250 &
\ GOSUB 2370 &
\ NEXT I% &
\ RETURN
2220 ! -- .LIST --
2230 F3%=FNA%(A$) &
\ RETURN
2240 ! -- Form B1 and update checksum --
2250 O2$=FNH$(V%,3%) &
\ B%=V% AND 255% &
\ GOSUB 2440 IF F4% &
\ C%=C%+B% &
\ RETURN
2260 ! -- Form B2 and update checksum --
2270 O3$=FNH$(V%,3%) &
\ B%=V% AND 255% &
\ GOSUB 2440 IF F4% &
\ C%=C%+B% &
\ RETURN
2280 ! -- Extract pointer from argument --
2290 P%, S1%=0%
2300 S1%=INSTR(S1%+1%,A$,"(") &
\ RETURN UNLESS S1% &
\ X$=LEFT(A$,S1%-1%) &
\ GOTO 2300 IF X$="H" OR X$="L"
2310 S2%=INSTR(S1%+1%,A$,")") &
\ P%=FNA%(MID(A$,S1%+1%,S2%-S1%-1%)) &
\ A$=LEFT(A$,S1%-1%)+RIGHT(A$,S2%+1%)
2320 IF P%<0% OR P%>3% THEN P%=FNE%("Inv ptr ="+NUM$(P%))
2330 RETURN
2340 ! -- Output a leader to object file --
2350 PRINT #4%,STRING$(80%,0%); &
\ RETURN
2360 ! -- Output assembled code to listing file --
2370 GOTO 2420 UNLESS F0% OR F1%
2380 IF F1% THEN PRINT #1%,"?"; ELSE PRINT #1%," ";
2390 IF F2%<L% THEN PRINT #1% USING "#### ",L%; ELSE PRINT #1%," ";
2400 PRINT #1% USING"\ \ \\ \\",O1$,O2$,O3$; &
\ IF F3% AND L$<>"" THEN PRINT #1%,CHR$(9%);L$ &
ELSE PRINT #1%
2410 ! -- Set a flag, clear output strings --
2420 F2%=L% &
\ O1$,O2$,O3$,L$="" &
\ RETURN
2430 ! -- Output binary byte to object file --
2440 PRINT #4%,CHR$(B%); &
\ RETURN
2450 ! -- Print error count, checksum --
2460 PRINT #X% &
\ PRINT #X%,"Errors detected";E% &
\ PRINT #X%,"Source checksum ";FNH$(C%,0%) &
\ PRINT #X%,"Total bytes ";N0% &
\ PRINT #X% &
\ RETURN
2470 ! -- Print sorted symbol table --
2480 PRINT #1%," Symbol Table" &
\ PRINT #1%
2490 ! -- Bubble sort symbol table --
2500 S2%=-1% &
\ FOR S1%=T%-1% STEP -1% WHILE S2% &
\ S2%=0% &
\ FOR I%=1% TO S1%
2510 IF T$(I%+1%)<T$(I%) THEN S$=T$(I%) &
\ X%=T%(I%) &
\ T$(I%)=T$(I%+1%) &
\ T%(I%)=T%(I%+1%) &
\ T$(I%+1%)=S$ &
\ T%(I%+1%)=X% &
\ S2%=S2%+1%
2520 NEXT I% &
\ NEXT S1%
2530 ! -- Output to listing file --
2540 FOR I%=1% TO T% &
\ PRINT #1% USING " \ \ \ \ ",T$(I%),FNH$(T%(I%),0%); &
\ PRINT #1% IF CCPOS(1%)>63% &
\ NEXT I%
2550 PRINT #1% IF CCPOS(1%) &
\ RETURN
2560 &
! -- Check position of char X% in L$ using -- &
! -- tables D%(). FNS%=-1% means in string --
2570 DEF* FNS%(X%)
2580 GOTO 2600 IF D%=-1% OR X%=0% &
\ FOR X0%=0% TO D% &
\ GOTO 2600 IF X%<(SWAP%(D%(X0%)) AND 255%) &
\ IF X%<(D%(X0%) AND 255%) THEN FNS%=-1% &
\ GOTO 2610
2590 NEXT X0%
2600 FNS%=0%
2610 FNEND
2620 ! -- Evaluate the argument expression --
2630 DEF* FNA%(X$)
2640 ! -- Main driver routine --
2650 X3$=CVT$$(X$,136%) &
\ GOSUB 2680 &
\ GOSUB 2710 &
\ X3%=X0%
2660 GOTO 2890 UNLESS X5% &
\ X7%=X5% &
\ GOSUB 2680 &
\ GOSUB 2710 &
\ GOSUB 2840 &
\ GOTO 2660
2670 REM ! -- Scan for the next operator { ! & % + * - / } --
2680 IF X3$="" THEN X5%,X4%=0% &
\ RETURN
2690 X9%=-1% &
\ FOR X4%=1% TO LEN(X3$) &
\ X5%=ASCII(RIGHT(X3$,X4%)) &
\ X9%= NOT X9% IF X5%=39% &
\ RETURN IF X9% AND ( X5%=33% OR X5%=37% OR X5%=38% &
OR X5%=42% OR X5%=43% OR X5%=45% OR X5%=47%) &
\ NEXT X4% &
\ X5%=0% &
\ X4%=X4%+1% &
\ RETURN
2700 ! -- Get value of term --
2710 X2$=CVT$$(LEFT(X3$,X4%-1%),136%) &
\ X3$=RIGHT(X3$,X4%+1%)
2720 IF X2$="" THEN X0%=0% &
\ RETURN
2730 ! -- H() or L() ? --
2740 X1$=LEFT(X2$,2%) &
\ IF X1$="H(" THEN X9%=1% &
ELSE IF X1$="L(" THEN X9%=2% &
ELSE X9%=0%
2750 IF X9% THEN IF RIGHT(X2$,LEN(X2$))=")" THEN X2$=MID(X2$,3%,LEN(X2$)-3%) &
ELSE 2820
2760 ! -- Hex or Dec number ? -- &
! -- Ascii character ? -- &
! -- Current LC (".") ? -- &
! -- or Symbol ? -- &
2770 IF X1$="X'" THEN X0%=FND%(RIGHT(X2$,3%)) &
\ GOTO 2800
2780 X1$=LEFT(X2$,1%)
2790 IF X1$="0" THEN X0%=FND%(RIGHT(X2$,2%)) &
ELSE IF X1$>="1" AND X1$<="9" THEN X0%=VAL(X2$) &
ELSE IF X1$>="A" AND X1$<="Z" THEN X0%=FNV%(X2$) &
ELSE IF X1$="'" THEN X0%=ASCII(RIGHT(X2$,2%)) &
ELSE IF X2$="." THEN X0%=N1% &
ELSE 2820
2800 IF X9%=1% THEN X0%=SWAP%(X0%) AND 255% &
ELSE IF X9%=2% THEN X0%=X0% AND 255%
2810 RETURN
2820 X0%=FNE%("Inv term = "+X2$) &
\ RETURN
2830 ! -- Carry out the arithmetic or logical operation --
2840 IF X7%>38% THEN 2860 &
ELSE IF X7%=33% THEN X3%=X3% OR X0% &
ELSE IF X7%=37% THEN X3%=X3%+(NOT X0%) &
ELSE IF X7%=38% THEN X3%=X3% AND X0%
2850 RETURN
2860 IF X7%=42% THEN X3%=X3%*X0% &
ELSE IF X7%=43% THEN X3%=X3%+X0% &
ELSE IF X7%=45% THEN X3%=X3%-X0% &
ELSE IF X7%=47% THEN X3%=X3%/X0%
2870 RETURN
2880 ! -- Exit with value of expression --
2890 FNA%=X3%
2900 FNEND
2905 ! -- Print the given error message to the listing file
2906 DEF* FNE%(X$) &
\ PRINT #1%,X$; &
\ IF P0%=1% THEN PRINT #1%," at line";L% ELSE PRINT #1%
2907 E%=E%+1% &
\ F1%=-1% &
\ FNE%=0% &
\ FNEND
2910 ! -- Look up value of symbol --
2920 DEF* FNV%(X$)
2930 GOTO 2940 IF X$=T$(X%) FOR X%=1% TO T% &
\ FNV%=FNE%("Undef sym = "+X$) &
\ GOTO 2950
2940 FNV%=T%(X%)
2950 FNEND
2960 ! -- Dec to Hex conversion --
2970 DEF* FNH$(X%,D%)
2980 X$="" &
\ FOR X1%=0% TO 3% &
\ X0%=(X% AND (16%^(X1%+1%)-1%*(16%^X1%)))/(16%^X1%) &
\ X0%=X0%+16% IF X0%<0% &
\ X$=CHR$(48%+X0%)+X$ IF X0%<10% &
\ X$=CHR$(55%+X0%)+X$ IF X0%>9% &
\ NEXT X1% &
\ IF D% THEN X$=MID(X$,D%,2%)
2990 FNH$=X$
3000 FNEND
3010 ! -- Hex to Dec conversion --
3020 DEF* FND%(X$) &
\ X0%=0% &
\ FOR X1%=1% TO LEN(X$) &
\ X2%=ASCII(MID(X$,X1%,1%)) &
\ IF X2%<48% OR (X2%>57% AND X2%<65%) OR X2%>70% THEN &
FND%=FNE%("Inv Hex const = "+X$) &
\ GOTO 3040
3030 X2%=X2%-48% &
\ X2%=X2%-7% IF X2%>9% &
\ X0%=X2%+X0%*16% &
\ NEXT X1% &
\ FND%=X0%
3040 FNEND
30000 ! CCL Entry point
30010 F2$=CVT$$(SYS(CHR$(7%)),188%) &
\ I%=INSTR(1%,F2$,"SCMPCA") &
\ IF I% THEN F2$=RIGHT(F2$,7%) &
ELSE PRINT "?SCMPCA - Illegal entry" &
\ GOTO 32767
30020 C9%=-1% &
\ GOTO 1050
31000 ! -- Error routine --
31010 ! -- No "END" --
31020 IF ERR=11% AND ERL=1320% THEN O%=N%+FNE%("Missing END") &
\ RESUME 1450
31030 IF ERR=11% AND ERL=1900% THEN L$="" &
\ RESUME 1920
31040 ! -- ^Z at filename request --
31050 RESUME 32767 IF ERL=1110%
31060 ! -- Illegal number in FNA%() --
31070 IF ERR=51% AND ERL=2790% THEN X0%=VAL(X2$)-65536 &
\ RESUME 2800
31080 RESUME 2820 IF ERR=52% AND ERL=2790%
31090 CLOSE 1,2,3 &
\ KILL W$ IF LINE>=1310% &
\ RESUME 32767 IF ERR=28%
31100 ! -- Print any unanticipated error --
31110 ON ERROR GOTO 0
32000 ! -- Opcode data --
32010 DATA "",0
32020 ! Memory reference 1-8
32030 DATA LD,192,ST,200,AND,208,OR,216,XOR,224,DAD,232,ADD,240,CAD,248
32040 ! Transfer 9-12
32050 DATA JMP,144,JP,148,JZ,152,JNZ,156
32060 ! Memory inc,dec 13-14
32070 DATA ILD,168,DLD,184
32080 ! Immediate 15-21
32090 DATA LDI,196,ANI,212,ORI,220,XRI,228,DAI,236,ADI,244,CAI,252
32100 ! Delay 22
32110 DATA DLY,143
32120 ! Pointer 23-25
32130 DATA XPAL,48,XPAH,52,XPPC,60
32140 ! Extension 26-33
32150 DATA LDE,64,XAE,1,ANE,80,ORE,88,XRE,96,DAE,104,ADE,112,CAE,120
32160 ! SIO, Shift, Rotate 34-38
32170 DATA SIO,25,SR,28,SRL,29,RR,30,RRL,31
32180 ! Miscellaneous 39-46
32190 DATA HALT,0,CCL,2,SCL,3,IEN,5,DINT,4,CSA,6,CAS,7,NOP,8
32200 ! Assembler pseudo-ops 47-51
32210 DATA .BYTE,0,.DBYTE,0,.ASCII,0,.LIST,0,END,0
32767 END