1  ! COPYRIGHT 1983-M.A.CRAGG
2  L$="SCODE87" @ V$=" 8610151100" ! ROMless Version
3  INTEGER Arp,Drp,A(12),R(255),R,R1,I,I1,J,K,Bintab,S(255),N,Opcode
4 O2,T9=0 @ P9=2
5 CLEAR @ ALPHALL @ DISP L$ @ DISP "Initializing, please wait."
6 IF NOT DATE  THEN 16
8 ON ERROR GOTO 15
10 ! CALL "*TIM.S" ( L$,2 )
12 T9=1
15 OFF ERROR
16 ! PRINTER IS 710,80 @ PRINT " N "
20 DIM M$[88],O2$(137)[6],O4$(5)[6],R$[80],N$[32],A$[25],Operand$[80],C0$[64],S0
$[95],L2$(200)[8],A2$(200)[8]
25 GOSUB 6710
42 N$,C0$="" @ Opcode,Binary,Binbas,Bintab,Base_addr=0
45 GOSUB 4400
46 GOSUB 1900 @ GOSUB 1420
50 GOSUB 800
54 I0=16 @ S=0 @ BEEP 100,100 @ CLEAR @ DISP "Create source code as data file";@
 INPUT R$
55 ON FNR1 GOTO 58,56,58
56 S=1 @ BEEP 100,100 @ DISP "File Name";@ INPUT F$
57 GOTO 8000
58 N$,C0$="" @ Opcode,Base_addr=0 @ Lwamem=DPEEKC (32801)
59 ! *********************************************************************
60 F1,F2,F3,Bintab,J,K,P3,P4=0 @ A$="" @ GOSUB 1100
61 F2=1
65 OFF ERROR @ BEEP 100,100 @ DISP "Memory start location."
66 DISP "Valid inputs are:-" @ DISP "     Octal Number" @ DISP "     REL(Octal N
umber)" @ DISP "     BINTAB"
67 DISP "     ROMTAB"
68 INPUT M$
70 ON FNR2 GOTO 73,6500,71,72
71 Bintab=1 @ GOTO 6500
72 I=POS (M$,")")-1 @ M$=VAL$ (OCT (DEC (VAL (M$[5,I]))+Base_addr))
73 ON ERROR GOTO 65
74 M=VAL (M$) @ M0=DEC (M)
75 OFF ERROR @ GOSUB 900
76 ! IF T9 THEN CALL "*TIM" ( L$,P9 ) ELSE PRINT L$;V$
78 OFF ERROR
80 IF M<60000 OR M>77777 THEN R,R1=0 @ A$="SYSTEM" @ GOTO 104
90 BEEP 100,100 @ DISP "ROM# (dec.value)";
100 INPUT R1
102 R=R1 @ GOTO 6200
104 ! 
106 IF M>77777 THEN GOSUB 6300 @ PRINT N$ @ GOTO 110
108 PRINT "ROM ";R;" (";A$;")"
110 IF M=60000 OR Bintab THEN P3=1 @ M0=M0+2 @ GOTO 135
111 BEEP 100,100 @ DISP "Title of routine";@ INPUT R$
112 IF R$#"" THEN PRINT "Routine: ";R$
127 PRINT "***********************LEVEL 0"
130 CLEAR
132 ! 
133 ! 
135 KEY LABEL
138 OFF ERROR
139 GOSUB 650
140 I1=1 @ OFF ERROR @ IF F3 THEN GOSUB 3600
147 IF M0>= Lwamem THEN 500
150 M=OCT (M0)
157 GOSUB 600
170 IF P3 THEN 5200
190 Opcode=OPEERB (M,R)
200 ! 
210 ! 
220 IF Opcode<100 THEN 2100 !      Addr. reg no.
230 IF Opcode<200 THEN 2000 !      Data. reg no.
236 Opindex=DEC (Opcode-200)+1
237 IF Opcode=236 THEN 4200
250 IF Opcode<224 THEN 2300
260 IF Opcode<230 THEN 2400
270 IF Opcode<240 THEN 2500
280 IF Opcode<250 THEN 2400
285 IF Opcode=251 AND Drp=4 AND NOT S THEN 2550
290 IF Opcode<254 THEN 2600
300 IF Opcode<260 THEN 2400
310 IF Opcode<264 THEN 2700
320 IF Opcode<270 THEN 2800
330 IF Opcode<274 THEN 2700
340 IF Opcode<300 THEN 2800
350 IF Opcode=306 THEN 2900
360 IF Opcode<310 THEN 2400
370 IF Opcode=316 THEN 3000
375 IF Opcode<320 THEN 2600
380 IF Opcode<326 THEN 2700
390 IF Opcode=326 THEN 2500
400 IF Opcode=327 THEN 2700
410 IF Opcode<340 THEN 2400
420 IF Opcode<342 THEN 3100
425 IF Opcode<344 THEN 3110
430 IF Opcode<346 THEN 3100
435 IF Opcode<350 THEN 3110
440 IF Opcode<352 THEN 3100
445 IF Opcode<354 THEN 3110
450 IF Opcode<356 THEN 3100
460 IF Opcode<360 THEN 3110
470 GOTO 3200
499 ! *******************************************************************
500 IF S THEN GOSUB 8100
505 BEEP 100,100
510 DISP "End of Binary pgm." @ WAIT 2000 @ GOTO 4392
520 ! 
600 To_label$,Operand$,C0$,To_addr$,Rel_addr$="" @ Line_label$="         "
610 RETURN
650 PRINT L$;V$ @ RETURN
700  GOSUB 600 @ Relln_addr$,Line_addr$,Opcode$="" @ C0$="**********************
******************************" @ RETURN
800 ON KEY# 1,"EXIT" GOTO 1300
810 ON KEY# 2,"TJMP" GOSUB 1350
820 ON KEY# 3,"TSTEP" GOSUB 1450
830 ON KEY# 4,"TDMP" GOSUB 1400
835 ON KEY# 5,"PRTR" GOSUB 1420
840 RETURN
900 IF M0<Base_addr THEN M0=M0+Base_addr @ M=OCT (M0) @ GOTO 920
910 RETURN
920 IF M0>= Lwamem THEN M0=M0-Base_addr @ M=OCT (M0)
930 RETURN
999 ! *******************************************************************
1000 Drp=VAL (R$[1,I-2]) @ Drp$=VAL$ (Drp)
1002 Arp=VAL (R$[I,LEN (R$)]) @ Arp$=VAL$ (Arp)
1004 PRINT USING "6A,2X,3A,2X,A,DD" ; "      ","DRP","R",Drp
1006 PRINT USING "6A,2X,3A,2X,A,DD" ; "      ","ARP","R",Arp
1010 GOTO 135
1019 ! *******************************************************************
1020 DEF FNR
1040 I=POS (R$,",")+1
1050 FNR=I
1060 FN END
1099 ! *******************************************************************
1100 Drp,Arp=2 @ Drp$,Arp$="#"
1110 RETURN
1199 ! *******************************************************************
1200 DEF FNR1
1210 IF NOT LEN (R$) THEN I=1 @ GOTO 1230
1220 I=POS ("YN",UPC$ (R$[1,1]))+1
1230 FNR1=I
1240 FN END
1249 ! *******************************************************************
1250 DEF FNR2
1252 IF LEN (M$)<4 THEN 1270
1255 IF M$="BINARY" THEN I=2 @ GOTO RTN2
1260 IF M$="BINTAB" THEN I=3 @ GOTO RTN2
1265 IF M$[1,4]="REL(" THEN I=4 @ GOTO RTN2
1267 IF M$="ROMTAB" THEN M$="60000"
1270 I=1
1275 RTN2:
1280 FNR2=I
1285 FN END
1299 ! *******************************************************************
1300 K,R=0
1310 PRINT "!!!!!!FORCED EXIT TO LEVEL ";K;"ROM#";R
1312 PRINT USING "/"
1320 OFF ERROR @ BEEP 100,100 @ DISP "JMP ADDRESS (OCT)";@ INPUT M$
1330 GOTO 70
1349 ! *******************************************************************
1350 IF F2 THEN F2=0 @ RETURN
1360 F2=1 @ RETURN
1400 IF F1 THEN F1=0 @ RETURN
1410 F1=1 @ RETURN
1420 BEEP 100,100 @ CLEAR @ DISP "Printer address";
1430 INPUT P9
1440 PRINTER IS P9 @ RETURN
1450 IF F3 THEN F3=0 @ RETURN
1460 F3=1 @ RETURN
1499 ! *******************************************************************
1500 ! Get line address & opcode
1505 Relln_addr$,Line_addr$=VAL$ (OCT (M0))&" "
1507 B2=Bintab+Binary+(M0>= Binbas)
1510 IF B2>= 2 THEN Base_addr=Binbas ELSE Base_addr=0
1520 Relln_addr$="  "&VAL$ (OCT (M0-Base_addr))&" " ! REL for Binary, ABS for Ro
m
1530   Opcode$=O2$(Opindex)
1540 RETURN
1599 ! *******************************************************************
1600 ! Op label finding routine
1605 To_label$="" @ Old_label=0
1610 FOR I2=1 TO I0
1620 IF A2$(I2)=To_addr$ THEN To_label$=L2$(I2) @ I2=I0 @ Old_label=1
1630 NEXT I2
1640 IF NOT Old_label THEN I0=I2 @ To_label$="LAB"&VAL$ (I2) @ L2$(I2)=To_label$
 @ A2$(I2)=To_addr$
1645 ! C0$=C0$&" ("&To_addr$&") "
1650 RETURN
1699 ! *******************************************************************
1700 ! Line label finding routine
1705 L3$,Line_label$="        "
1710 FOR I2=1 TO I0
1720 IF A2$(I2)=TRIM$ (Line_addr$) THEN Line_label$[1,LEN (L2$(I2))]=L2$(I2) @ I
2=I0
1730 NEXT I2
1790 RETURN
1799 ! *******************************************************************
1800 ! Relative label finding routine
1805 To_label$="" @ I=1 @ Old_label=0 @ IF I0=0 THEN 1840
1810 FOR I2=1 TO I0
1820 IF A2$(I2)=To_addr$ THEN To_label$=L2$(I2) @ I2=I0 @ Old_label=1
1830 NEXT I2
1835 IF B2>= 2 THEN C0$=C0$&" REL("&Rel_addr$&") " ELSE C0$=C0$&" ("&To_addr$&")
"
1840 IF NOT Old_label THEN I0=I2 @ To_label$="RL"&VAL$ (I2) @ L2$(I2)=To_label$ 
@ A2$(I2)=To_addr$
1850 ! C0$=C0$&" ("&To_addr$&")"
1855 IF SGN (O2)=-1 AND Opcode>357 THEN C0$=C0$&" Unlabelled"
1860 RETURN
1899 ! *******************************************************************
1900 L2$(6)="ROMJSB" @ A2$(6)="6223"
1910 L2$(7)="BINTAB" @ A2$(7)="104070"
1920 L2$(8)="ERROR " @ A2$(8)="10224"
1930 L2$(9)="ROMFL " @ A2$(9)="104065"
1940 L2$(10)="PTR2- " @ A2$(10)="177715"
1950 L2$(11)="PTR2  " @ A2$(11)="177714"
1952 L2$(1)="RUNTIM" @ A2$(1)="      "
1954 L2$(2)="ASCIIS" @ A2$(2)="      "
1956 L2$(3)="PARSE " @ A2$(3)="      "
1958 L2$(4)="ERMSG " @ A2$(4)="      "
1960 L2$(5)="INIT  " @ A2$(5)="      "
1962 L2$(12)="PTR2+ " @ A2$(12)="177716"
1964 L2$(13)="PTR1  " @ A2$(13)="177710"
1966 L2$(14)="PTR1- " @ A2$(14)="177711"
1968 L2$(15)="PTR1+ " @ A2$(15)="177712"
1970 L2$(16)="ERROR+" @ A2$(16)="10220"
1990 RETURN
1999 ! *******************************************************************
2000 Drp=Opcode-100 @ Drp$=VAL$ (Drp) ! Data reg. no.
2005 IF Drp$="1" THEN Drp$="*"
2010 Opindex=130 @ GOSUB 1500
2015 Operand$=" R"&Drp$
2030 GOSUB 7000
2035 M0=1+M0
2040 GOTO 140
2099 ! *******************************************************************
2100 Arp=Opcode @ Arp$=VAL$ (Arp) ! Addr. reg. no.
2105 IF Arp$="1" THEN Arp$="*"
2110 Opindex=131 @ GOSUB 1500
2115 Operand$=" R"&Arp$
2130 GOSUB 7000
2135 M0=1+M0
2140 GOTO 140
2199 ! *******************************************************************
2300 GOSUB 1500
2320 Operand$=" R"&Drp$
2330 GOSUB 7000
2340 M0=1+M0
2350 GOTO 140
2399 ! *******************************************************************
2400 GOSUB 1500
2430 Operand$=" R"&Drp$&", R"&Arp$
2440 GOSUB 7000
2445 M0=M0+1
2450 IF Drp#4 THEN 140
2455 IF NOT RMD (Opcode,5) THEN 2470
2460 IF RMD (Opcode-1,10) THEN 4380
2465 PRINT "-----------------------------"
2470 ! 
2475 IF F1 THEN 4380
2480 BEEP 100,100 @ DISP "Routine has branched. Do you wish to continue.";
2490 INPUT R$
2495 ON FNR1 GOTO 2480,4330,4380
2499 ! *******************************************************************
2500 GOSUB 1500
2530 GOSUB 7000
2535 M0=M0+1
2540 GOTO 140
2549 ! *******************************************************************
2550 M1=1 @ GOSUB 4000 @ Opindex=129 @ O1=OCT (DEC (O1)+1)
2560 GOSUB 1500
2570 Operand$=" " ! @ To_addr$=VAL$ (O1)
2575 Rel_addr$=VAL$ (OCT (DEC (O1)-Base_addr))
2580 GOSUB 7000
2583 M0=M0+3
2585 GOTO 3400
2599 ! *******************************************************************
2600 ! Get literal
2601 IF FP (Opcode/2) THEN 2650 ! (Multibyte)
2602 ! Literal byte
2605 I=1
2610 GOSUB 1500
2615 M=OCT (M0+1)
2616 Byt=OPEERB (M,R)
2620 Operand$=" R"&Drp$&",="&VAL$ (Byt)
2630 GOSUB 7000
2635 M0=M0+1+I
2640 GOTO 140
2649 ! *******************************************************************
2650 ! Multibyte literal
2655 I=(8-10*FP (Drp/10))*(Drp>37)+(2-FP (Drp/2)*2)*(Drp<40)
2660 GOSUB 1500
2670 FOR J=1 TO I
2671 Operand$=Operand$&VAL$ (OCT (DPEERB (M0+J,R)))&","
2672 NEXT J
2673 Operand$=Operand$[1,LEN (Operand$)-1]
2674 Operand$=" R"&Drp$&",="&Operand$
2680 GOSUB 7000
2685 M0=M0+1+I
2690 GOTO 140
2699 ! *******************************************************************
2700 M1=1 @ GOSUB 4000
2710 GOSUB 1500 @ IF S THEN GOSUB 1600
2720 Operand$=" R"&Drp$&",="
2730 GOSUB 7000
2735 M0=M0+3
2740 GOTO 2450
2799 ! *******************************************************************
2800 ! Index LD/ST
2805 M1=1 @ GOSUB 1500
2810 GOSUB 4000 @ Rel_addr$=To_addr$ @ IF S THEN GOSUB 1800 @ C0$=C0$&" Unlabell
ed"
2820 Operand$=" R"&Drp$&", X"&Arp$&", "
2830 GOSUB 7000
2835 M0=M0+3
2840 GOTO 2450
2899 ! *******************************************************************
2900 ! JSB X
2905 M1=1 @ GOSUB 1500
2910 GOSUB 4000 @ Rel_addr$=To_addr$ @ IF S THEN GOSUB 1800 @ C0$=C0$&" Unlabell
ed"
2920 Operand$=" X"&Arp$&","
2930 GOSUB 7000
2935 M0=M0+3
2940 GOTO 4380
2999 ! *******************************************************************
3000 M1=1 @ GOSUB 4000 @ Operand$="="
3005 IF O1=6223 THEN 4600
3006 IF O1=10220 THEN P4=1 @ GOTO 4800
3007 IF O1=10224 THEN 4800
3010 GOSUB 1500 @ IF S THEN GOSUB 1600
3020 M0=M0+3
3030 GOSUB 7000
3040 GOTO 4100
3099 ! *******************************************************************
3100 S$=",+R" @ GOTO 3120
3110 S$=",-R"
3120 GOSUB 1500
3130 Operand$=" R"&Drp$&S$&Arp$
3140 GOSUB 7000
3145 M0=M0+1
3150 GOTO 140
3199 ! *******************************************************************
3200 ! Jumps
3205 GOSUB 1500
3210 GOSUB 4050 @ Operand$=" "
3222 IF SGN (O2)=1 THEN C0$="+"
3224 C0$=C0$&VAL$ (O2)
3226 IF S THEN GOSUB 1800 ! Rel label
3230 GOSUB 7000
3235 M0=M0+2
3240 IF Opcode=360 THEN 3320
3260 IF F1 OR F2 THEN 140
3270 GOSUB 3350
3280 ON FNR1 GOTO 3270,3290,4380
3290 M0=DEC (O1)
3299 ! *******************************************************************
3300 PRINT "        -----------"
3310 GOTO 4380
3320 IF F1 THEN 3300
3330 GOSUB 3350
3340 ON FNR1 GOTO 3330,3290,3300
3350 BEEP 100,100 @ DISP O2$(Opindex)&" "&VAL$ (O2)&" to "&VAL$ (OCT (DEC (O1)-B
ase_addr)) @ INPUT R$@ RETURN
3399 ! *******************************************************************
3400 IF F1 THEN 3300
3405 GOSUB 3500
3410 ON FNR1 GOTO 3405,3290,3300
3499 ! *******************************************************************
3500 BEEP 100,100 @ DISP O2$(Opindex)&" "&VAL$ (O1);@ INPUT R$@ RETURN
3599 ! *******************************************************************
3600 BEEP 100,100 @ DISP "Press CONT to resume"
3610 PAUSE
3660 RETURN
3699 ! *******************************************************************
4000 ! Get label address
4010 M=OCT (M0+M1)
4020 O1=OPEERA (M,R)
4030 To_addr$=VAL$ (O1)
4032 Rel_addr$=To_addr$
4035 O2=1
4040 RETURN
4049 ! *******************************************************************
4050 ! Relative jumps
4052 ! M=M0+1
4055 Byt=DPEERB (M0+1,R)
4060 O2=-((256-Byt)*(Byt>127))+(Byt<128)*Byt+2
4070 O1=OCT (M0+O2)
4075 To_addr$=VAL$ (O1)
4080 Rel_addr$=VAL$ (OCT (DEC (O1)-Base_addr))
4085 O2=OCT (O2)
4090 RETURN
4099 ! *******************************************************************
4100 ! JSB
4130 IF F1 OR F2 THEN 4380
4140 GOSUB 3500
4145 ON FNR1 GOTO 4140,4150,4380
4150 R(K)=R
4154 S(K)=M0 @ M0=DEC (O1) @ K=K+1
4155 PRINT ">>>>>>>>>>>>>>>>JSB LEVEL ";K
4160 GOTO 140
4199 ! *******************************************************************
4200 ! RTN
4205 Opindex=132 @ GOSUB 1500
4206 IF NOT S THEN C0$="*******************LEVEL "&VAL$ (K-1+(0=K))
4210 GOSUB 7000
4212 IF NOT S THEN PRINT "! ***********************************************"
4215 IF S THEN S0$=VAL$ (L)&" !***********************************************" 
@ GOSUB 7080
4220 IF NOT K THEN 4300
4230 K=K-1
4235 R=R(K)
4240 M0=S(K)
4247 GOTO 140
4250 S0$=VAL$ (L)&" ! ***********************" @ GOSUB 7080
4260 RETURN
4300 M0=M0+1 @ IF F1 THEN 4380
4305 BEEP 100,100 @ DISP "End of routine, do you wish to  continue";
4310 INPUT R$
4320 ON FNR1 GOTO 4305,4330,4390
4330 BEEP 100,100 @ DISP "Next line (Y/N)";@ INPUT R$
4340 ON FNR1 GOTO 4330,4380,4350
4345 PRINT USING "/"
4350 BEEP 100,100 @ DISP "Mem address (OCT), ROM#(DEC)";
4360 INPUT M,R
4370 M0=DEC (M)
4375 GOSUB 900
4380 GOSUB 1100 @ GOTO 140
4390 IF S THEN GOSUB 8100
4392 PRINT USING "////" @ GOTO 54
4399 ! *******************************************************************
4400 FOR I=1 TO 137
4410 READ M1$
4420 O2$(I)=M1$
4430 NEXT I
4435 RETURN
4440 DATA "ELB","ELM","ERB","ERM","LLB","LLM","LRB","LRM","ICB","ICM","DCB","DCM
","TCB","TCM"
4450 DATA "NCB","NCM","TSB","TSM","CLB","CLM","ORB","ORM","XRB","XRM","BIN","BCD
","SAD","DCE"
4460 DATA "ICE","CLE","RTN","PAD","LDB","LDM","STB","STM","LDBD","LDMD","STBD","
STMD"
4470 DATA "LDB","LDM","STB","STM","LDBI","LDMI","STBI","STMI","LDBD","LDMD","STB
D","STMD"
4480 DATA "LDBD","LDMD","STBD","STMD","LDBI","LDMI","STBI","STMI","LDBI","LDMI",
"STBI"
4490 DATA "STMI","CMB","CMM","ADB","ADM","SBB","SBM","JSB","ANM","CMB","CMM","AD
B","ADM"
4500 DATA "SBB","SBM","JSB","ANM","CMBD","CMMD","ADBD","ADMD"
4510 DATA "SBBD","SBMD","326","ANMD","CMBD","CMMD","ADBD","ADMD","SBBD","SBMD","
336","ANMD"
4520 DATA "POBD","POMD","POBD","POMD","PUBD","PUMD","PUBD","PUMD","POBI","POMI",
"POBI","POMI"
4530 DATA "PUBI","PUMI","PUBI","PUMI","JMP","JNO","JOD","JEV","JNG","JPS","JNZ",
"JZR","JEN"
4540 DATA "JEZ","JNC","JCY","JLZ","JLN","JRZ","JRN","GTO","DRP","ARP","RTN","NAM
","DEF ","BSZ","BYT ","ASP "
4599 ! *******************************************************************
4600 GOSUB 1500
4601 Operand$="=ROMJSB " @ To_addr$,Rel_addr$=""
4602 PRINT @ GOSUB 7000
4605 M0=M0+3
4610 O1=OCT (DPEERA (M0,R)) @ To_addr$=VAL$ (O1) @ Rel_addr$=To_addr$
4611 GOSUB 1500 @ IF S THEN GOSUB 1600
4612 Opcode$="DEF" @ Operand$=" "
4613 GOSUB 7000
4614 M0=M0+2
4615 R1=DPEERB (M0,R)
4617 GOSUB 5000
4618 C0$=A$
4640 GOSUB 1500
4650 Opcode$="BYT " @ Operand$=VAL$ (OCT (R1)) @ To_addr$,Rel_addr$,To_label$=""

4652 GOSUB 7000 @ PRINT
4653 C0$=""
4655 M0=1+M0 @ S(K)=M0
4656 IF F1 OR F2 THEN 4380
4660 GOSUB 3500
4670 ON FNR1 GOTO 4660,4690,4380
4690 R(K)=R
4710 R=R1
4730 GOTO 4154
4799 ! *******************************************************************
4800 S$="=ERROR"
4810 IF P4 THEN S$=S$&"+"
4830 GOSUB 1500
4840 Operand$=S$ @ To_addr$,Rel_addr$,C0$=""
4841 GOSUB 7000
4842 P4=0
4844 M0=M0+3
4846 GOSUB 1500 @ Opcode$="BYT "
4847  Byt=DPEERB (M0,R)
4848 Operand$=VAL$ (OCT (Byt)) @ C0$="ERROR "&VAL$ (Byt)
4849 GOSUB 7000
4850 M0=M0+1 @ S(K)=M0
4855 IF S$="=ERROR+" THEN 2465
4860 GOTO 4380
4899 ! *******************************************************************
5000 IF R1=1 THEN A$="SYS GRAPHICS" @ A4,J4=55 @ RETURN
5005 IF R1=240 THEN A$="EXT PLOTTER " @ A4,J4=57 @ RETURN
5010 IF R1=231 THEN A$="ADV.PGMG.2" @ A4,J4=2 @ RETURN
5015 IF R1=232 THEN A$="ADV.PGMG.1" @ A4=69 @ J4=75 @ RETURN
5020 IF R1=208 THEN A$="MASS STORAGE" @ A4=30 @ J4=38 @ RETURN
5030 IF R1=192 THEN A$="INPUT/OUTPUT" @ A4=77 @ J4=91 @ RETURN
5040 IF R1=177 THEN A$="MATRIX 2" @ A4,J4=0 @ RETURN
5045 IF R1=176 THEN A$="MATRIX 1" @ A4,J4=0 @ RETURN
5046 IF R1=14 THEN A$="MIKSAM  " @ A4,J4=0 @ RETURN
5050 IF R1=40 THEN A$="ASSEMBLER" @ A4,J4=24 @ RETURN
5060 R1=0 @ A$="SYSTEM" @ A4=230 @ J4=255 @ RETURN
5099 ! *******************************************************************
5100 ! 
5105 FOR I=1 TO 5
5110 READ L2$(I)@ A2$(I)=""
5130 NEXT I
5140 RETURN
5150 DATA " RUNTIM"," ASCIIS"," PARSE"," ERMSG"," INIT "
5200 ! BINTAB for source code
5205 F1,Byt,P4,I1=0 @ PRINT @ GOSUB 600
5215 IF Bintab THEN 5270
5220 PRINT "ABS ROM 60000"
5230 PRINT "       BYT ";OCT (R)
5240 PRINT "       BYT ";OCT (256-R)
5250 GOTO 5290
5270 M0=M0+2 ! Runtime Table addr.
5280 Opindex=133 @ GOSUB 1500 @ Relln_addr$="   0 " ! NAM
5282 Operand$=" "&VAL$ (N)&","&N$[1,MIN (LEN (N$),6)]
5284 GOSUB 7000 @ GOSUB 600
5290 Opindex=134
5295 M1=0
5300 FOR I=1 TO 5
5310 GOSUB 4000
5315 A1(I)=DEC (O1)
5320 GOSUB 1500
5325 Rel_addr$,To_label$="" @ Operand$=L2$(I) @ A2$(I)=VAL$ (O1) @ C0$=VAL$ (OCT
 (A1(I)-Base_addr))
5327 GOSUB 7000
5330 M0=M0+2
5340 NEXT I
5341 IF NOT S THEN 8700
5342 GOSUB 4250
5343 GOSUB 8500
5385 M0=A1(1) @ M1=0
5390 GOSUB 600
5395 GOSUB 4000
5400 A1(0)=DEC (O1)-Base_addr
5405 IF A1(0)=0 THEN Opindex=135 @ Operand$=" 2" @ GOSUB 1500 @ GOTO 5410
5406 IF O1=177777 THEN Opindex=136 @ Operand$="377,377" @ GOSUB 1500 @ GOTO 5410

5407 Rel_addr$=VAL$ (OCT (A1(0))) @ Opindex=134
5408 GOSUB 1500 @ GOSUB 1800
5410 GOSUB 7000 @ M0=2+M0
5415 IF O1#177777 THEN 5390
5416 GOSUB 4250
5430 FOR K1=2 TO 4 STEP 2 ! ASKIIS & ERMSG
5432 M0=A1(K1) @ M=OCT (M0)
5434 Operand$=CHR$ (34) @ To_label$,A$="" @ Opindex=137
5440 J1=0
5450 Byt=DPEERB (DEC (M),R)
5455 IF Byt<32 THEN A$=A$&"c"&VAL$ (Byt) @ GOTO 5470
5460 A$=A$&CHR$ (Byt MOD 128)
5470 J1=1+J1
5475 M=OCT (DEC (M)+1)
5480 IF Byt>127 THEN 5500
5490 GOTO 5450
5500 IF A$=CHR$ (0) OR A$="" THEN Operand$="200" @ Opindex=136 ELSE Operand$=Ope
rand$&A$&CHR$ (34)
5506 IF Bintab AND Byt=255 THEN Opindex=136 @ A$="" @ Operand$="377"
5510 GOSUB 1500
5520 GOSUB 7000
5575 M0=M0+J1
5580 IF Operand$#"377" THEN 5434
5582 GOSUB 4250
5585 NEXT K1
5600 M0=M0+1
5605 IF M0=A1(5) THEN F1=1 @ Binary=1 @ P3,Bintab=0 @ GOTO 140
5610 GOTO 60
5620 ! *********************************************************************
6000 FOR I=1 TO DEC (M1)
6060 A(I)=OCT (DPEERB (M-1+I,R))
6070 NEXT I
6080 RETURN
6100 M0=M0+2
6110 GOTO 5100
6200 ! ROM finding routine
6210 IF DPEERB (24576,R)=R THEN GOSUB 5000 @ GOTO 104
6240 BEEP @ CLEAR @ DISP "ROM not found" @ WAIT 2000
6250 GOTO 60
6300   IF NOT REL (1,0) THEN 6320
6310   IF OCT (M0)>REL (1,0) THEN A$="BINARY pgm:"&N$ @ RETURN
6320 N$=A$&" RAM" @ RETURN
6500 IF NOT Binary THEN GOSUB 6700
6502 DISP "Enter pgm. name.";@ INPUT N$
6503 IF N$="DISASB" THEN 6526
6505 A$="" @ FOR I=1 TO LEN (N$)
6507 A$=A$&CHR$ (DPEEKB (Binbas+7+I))
6509 NEXT I
6510 IF A$=N$ THEN 6526
6512 GOTO 6520
6513 IF ERRN =25 THEN 6524
6514 BEEP 100,100 @ CLEAR
6515 DISP "Place pgm. on current MSUS. and enter pgm. name.";@ INPUT N$
6520 ON ERROR GOTO 6513
6522 LOADBIN N$
6524 OFF ERROR
6525 CLEAR @ PRINT L$;V$
6526 GOSUB 6600
6530 M=OCT (M0+7)
6540 N=OPEERB (M,R)
6550 A4,J4=255
6560 A$=VAL$ (N)
6570 Lwamem=DPEEKC (32801)
6580 PRINT USING 6585 ; "BINARY PGM:"&CHR$ (34),N$,CHR$ (34)&" #"&A$&" (Length",
OPEEKA (OCT (Binbas+4))," Oct)"
6585 IMAGE 12A,15A,14A,6D,5A
6590 M0=Binbas+24 @ Binary=1 @ IF Bintab THEN 5200
6595 GOTO 60
6600 M=104075 @ IF N$="DISASB" THEN M=104073
6605 Base_addr,Binbas,M0=DPEEKA (DEC (M))
6610 R,R1=0
6630 RETURN
6700   SCRATCHBIN
6710 ON ERROR GOTO 6775
6720 N=DPEEKA (0)
6730 OFF ERROR
6735 Lwamem=DPEEKC (32801)
6740 Binary=0 @ RETURN
6750 CLEAR @ BEEP
6760 DISP "Place binary pgm. DISASB on default MSUS then press CONT"
6770 PAUSE
6775 ON ERROR GOTO 6750
6780 LOADBIN "DISASB"
6790 GOTO 6730
6799 ! *********************************************************************
7000 ! Print routines
7002 IF LEN (C0$) THEN C0$=" ! "&C0$
7004 IF S THEN GOSUB 1700
7005 IF S THEN 7078
7007 ! IF NOT F1 THEN To_addr$=To_label$
7010 PRINT Relln_addr$;
7055 PRINT Line_label$;Opcode$;Operand$;Rel_addr$;C0$
7077 RETURN
7078 S0$=VAL$ (L)&" "&Line_label$&Opcode$&Operand$&To_label$&C0$
7080 PRINT# 1 ; S0$
7085 L=L+10
7090 PRINT Relln_addr$&S0$
7095 RETURN
7099 ! *********************************************************************
8000 ON ERROR GOTO 8050
8010 CREATE F$,100
8020 OFF ERROR
8030 ASSIGN# 1 TO  F$
8040 L=1000 @ GOTO 60
8050 OFF ERROR
8060 IF ERRN #63 THEN DISP ERRN  @ STOP
8070 BEEP @ DISP "This file already exists, do you wish to overwrite it";@ INPUT
 R$
8080 ON FNR1 GOTO 8050,8030,54
8099 ! *********************************************************************
8100 C0$,To_addr$,Rel_addr$,Operand$=""
8110 Opcode$=" DAD "
8200 FOR I1=6 TO I0
8210   Line_label$=L2$(I1) @ To_label$=A2$(I1)
8215 IF Line_label$[1,2]#"RL" THEN GOSUB 7078
8220 NEXT I1
8230 Opcode$=" FIN " @ Operand$,To_label$,C0$="" @ Line_label$="        " @ GOSU
B 7078 @ ASSIGN# 1 TO  *
8250 RETURN
8299 ! *********************************************************************
8500 ! SORT 
8510 IF A1(1)>A1(3) THEN A1(0)=A1(3) @ A1(3)=A1(1) @ A1(1)=A1(0)
8520 RETURN
8700 IF Line_label$="RUNTIM  " THEN A1(8)=2 ELSE A1(8)=0
8710 J=1 @ GOSUB 600
8720 GOSUB 700 @ C0$=""
8730 GOSUB 7000
8740 A1(1)=A1(1)+2 @ A1(3)=A1(3)+2
8745 IF Bintab AND A1(3)>A1(1) THEN A1(8)=A1(3)-2+A1(8) ELSE A1(8)=65535
8750 IMAGE 6D,2X,4A,6A,6X,"(",6D,")"
8760 PRINT "ASCIIS                          RUNTIM PARSE   ATTRIB   TOKEN "
8770 PRINT "--------------------------------------------------------------"
8780 M0=A1(2)
8790 A1(6)=DPEERA (A1(1),R) ! Parse address
8800 ! 
8810 A1(7)=DPEERA (A1(3),R) ! Parse address
8820 ! 
8830 A$="" ! ASCIIS
8840 IF J=0 THEN 8930
8850 IF NOT Bintab AND NOT R AND J<37 THEN 8930
8860 IF J>A4 THEN 8930
8870 Byt=DPEERB (M0,R)
8880 IF Byt<40 THEN A$=A$&"*"
8890 A$=A$&CHR$ (Byt MOD 128)
8900 M0=M0+1
8910 IF Byt>127 THEN 8930
8920 GOTO 8870
8930 IF A$=CHR$ (0) OR A$="" OR Byt=255 THEN A$="****************"
8940 IF J>J4 THEN 9120
8950 IF A1(6)=A1(8) OR A1(1)>= A1(8) THEN 9120
8960 ! IF Byt=255 THEN 8830
8970 M=A1(6)-1
8980 Byt=DPEERB (M,R)
8985 IF A1(6)=Base_addr THEN P$="------" @ Att1,Byt=0 @ GOTO 9040
8990 Att1=OCT (Byt)
9000 IF Byt<64 THEN P$="------" ELSE P$=VAL$ (OCT (A1(7)-Base_addr)) @ Byt=0 @ G
OTO 9040
9010 IF Byt<37 THEN Byt=0 @ GOTO 9040
9020 M=M-1
9030 Byt=DPEERB (M,R)
9040 A2$(I0)=VAL$ (OCT (A1(6)-Base_addr))
9050 PRINT USING 9070 ; A$,A2$(I0),P$,OCT (Byt),Att1,OCT (J)
9060 ! IF P$#"------" THEN I0=1+I0 @ A2$(I0)=P$ @ L2$(I0)="PT"&VAL$ (J)
9070 IMAGE 31A,X,6A,X,6A,X,3D,",",3D,5X,3D
9080 A1(1)=A1(1)+2
9090 A1(3)=A1(3)+2
9100 J=1+J
9110 GOTO 8790
9120 PRINT " "
9140 GOTO 60
9150 ! *********************************************************************