10 ' Mini 6301 Assembler  Using and programming the Epson HX-20 portable computer_(Eric Balkan (auth.))_1985 page 104-106
20 ' Original code Copyright 1981 Robert Labenski.
30 ' Enhancements Copyright 1983 Eric Balkan.
40 ' Original 6800 version first published in Byte 12/81
130 CLEAR 1000: DEFINT A-Z
135 'WIDTH 46,16
137 'SCROLL 9,0,8,4
140 DIM S$(160) 'Source Data
150 DIM NO$(156) 'Implied Operands
160 DIM OP$(41) 'Full Opcodes
170 DIM BR$(I7) 'Br inst
180 DIM OB$(16O) 'Object
190 DIM AD(16O) 'Address
200 DIM LA$(70) 'Source Labels LC=Index
210 DIM LN(70) 'Line # of Labels
220 DIM AR(80) 'Addr Resolution AC=Index
225 DIM EQ$(30) 'Equates
230 GOSUB 1550:GOTO 1200
240 RESTORE 'Assemble
250 LC=0: AC=0: CD=0:EQ=0
260 IF OT THEN 340 ELSE OT=1:GOTO 310
270 CD=0:FOR X=1 TO LEN(A$):Y=ASC (MID$(A$,X,1))
280 IF Y<=57 AND Y>=48 THEN Y=Y-48
290 IF Y>64 THEN Y=Y-55
300 CD=16*CD+ Y:NEXT:RETURN
305 'Build instr table
310 FOR A=0 TO 55:READ NO$(A):NEXT
320 FOR A=0 TO 40:READ OP$(A):NEXT
330 FOR A=0 TO 16:READ BR$(A):NEXT
340 OK=1 'Main assembly loop

350 FOR A=0 TO N-1
360 IF LEFT$(S$(A),1)="*" THEN OB$(A)=" ":AD(A)=CD:GOTO 450
370 IF MID$(S$(A),9,1)<>" , " THEN 400
380 AD(A)=CD
390 OB$(A)=" ":FOR B=1O TO 40;A$=MID$(S$(A),B,1):IF A$=" ' " THEN 450 ELSE Y=ASC(A$):X=0:A$=" ":GOSUB 950:0B$(A)=OB$(A)+A$:CD=CD+1:NEXT
400 A$=MID$(S$(A),9,4):IF LEN(A$)=3 THEN A$=A$+" "
410 IF A$="ORG" THEN A$=MID$(S$(A),18,4):OB$(A)=" ":GOSUB270:GOTO 450
420 IF LEFT$(S$(A),4)<> II II THEN LA$(LC)=LEFT$(S$(A),4):LN(LC)=A:LC=LC+1
425 IF A$="EQU " AND MID$(S$(A),17,1)=I$"THEN A$=MID$(S$(A),18,4):OB$(A)=" ":EQ$(EQ)=LEFT$(S$(A),4)+A$+"$":EQ=EQ+1:GOTO450 ELSE IF A$="EQU " THEN A$=MID$(S$(A),17,4):OB$(A)=" ":EQ$(EQ)=LEFT$(S$(A),4)+A$:EQ=EQ+1:GOTO 450
429 IF LEFT$(A$,3)="BIT" THEN 440
430 IF LEFT$(A$,1)="B" THENGOSUB 71O:GOTO 450
440 IF LEN(S$(A))<17 THENGOSUB 530 ELSE GOSUB 600
450 NEXT A
460 IF SW =0 THEN 520
470 FOR A=0 TO AC-1
475 FOR B=0 TO EQ-1:IF RIGHT$(OB$(AR(A)),4)<>LEFT$(EQ$(B),4) THEN NEXT ELSE OB$(AR(A)=LEFT$(OB$(AR(A)),LEN(OB$(AR(A)))-4 + MID$(EQ$(B),5,4):IF RIGHT$(EQ$(B),1)="$" THEN 510
480 FOR B=0 TO LC-1:IF RIGHT$(OB$(AR(A)),4)<>LA$(B) THEN NEXT ELSE 490
485 OB$(AR(A))="?Labl":GOT0510
490 IF MID$(S$(AR(A)),9,1)="B" THEN X=AD(AR(A)):Y=AD(LN(B)):AD(100)=Y-(X+2):C=100: GOSUB 940: OB$(AR(A=LEFT$(OB$(AR(A)),2) + RIGHT$(A$,2):GOTO 510
500 C=LN(B):GOSUB 94O:OB$(AR(A))=LEFT$(OB$(AR(A)),2) + "0" + A$
510 NEXT A
520 RETURN
530 ' Implied Operands
540 IF MID$(S$(A),9,1)="$" THEN OB$(A)=RIGHT$(S$(A),LEN(S$(A))-9:AD(A)=CD:CD=CD+LEN(S$(A))-9)/2:RETURN
550 FOR B=0 TO 55
560 IF LEFT$(NO$(B),4)<A$ THEN NEXT
565 IF LEFT$(NO$(B),4)>A$ THEN OB$(A)="?INST": RETURN
570 OB$(A)=RIGHT$(NO$(B),2):AD(A)=CD:CD=CD+1:RETURN
580 NEXT
585 OB$(A)="?Inst":RETURN
600 ' Other OPs

610 AD(A)=CD
620 FOR B=O to 40
625 IF LEFT$(OP$(B),4)<A$ THEN NEXT
630 IF LEFT$(OP$(B),4)>A$ THEN OB$(A)="?Inst":RETURN
645 IF MID$(OP$(B),2,2)="IM" THEN GOSUB 1800:RETURN
650 IF MID$(S$(A),20,2) = ",X" THEN OB$(A) = MID$(OP$(B), 10,2)+MID$(S$(A),18,2):CD=CD+2:RETURN
660 IF MID$(S$(A),17,1) = "#" THEN OB$(A) = MID$(OP$(B),6,2):OB$(A) = OB$(A)+MID$(S$(A),19,2): CD=CD+2: B$=LEFT$(OB$(A),2): IF B$<>"8C" AND B$<>"CE" AND B$<> "8E" THEN RETURN ELSE CD=CD+1:OB$(A)=OB$(A)+RIGHf$(S$(A),2):RETURN
670 IF MID$(S$(A),17,1)=" " THEN OB$(A)="?????":RETURN
680 IF MID$(S$(A),17,1)="$" THEN A$=MID$(S$(A),18,4) ELSE A$=MID$(S$(A),17,4):AR(AC)=A: AC=AC+1: SW=1:A$=A$+STRING$(4-(LEN(A$))," ")
690 IF LEN(A$)=4 THEN OB$(A)=MID$(OP$(B),12,2):OB$(A) = OB$(A) + A$:CD=CD+3:RETURN
700 OB$(A)=MID$(OP$(B),8,2):OB$(A)=OB$(A) + A$:CD=CD+2:RETURN
710
720 FOR B=0 TO 16
722 IF LEFT$(BR$(B),2)<MID$(A$,2,2) THEN NEXT
725 IF MID$(A$,2,2)<LEFT$(BR$(B),2) THEN OB$(A)="??BR ":RETURN
740 OB$(A)=RIGHT$(BR$(B),2):AD(A)=CD:CD=CD+2:AR(AC)=A:AC=AC+1
750 A$=MID$(S$(A),17,4):OB$(A)=OB$(A)+ A$+STRING$(4-LEN(A$)," "):SW=l:RETURN
760 OK=0:LC=0:AC=0
770 IF LEN(A$)> 1 THEN 810
775 IF N<0 THEN N=0
780 LINE INPUT S$(N)
790 IF S$(N)=" " THEN RETURN
800 N=N+1:GOTO 780
810 A=VAL (RIGHf$(A$,LEN(A$)-1)): IF A>N THEN 780
820 LINEINPUT A$
830 IF A$=" " THEN RETURN
840 FOR B=N+1 TO A STEP -1:IF B=0 THEN 850 ELSE S$(B)=S$(B-1):NEXT
850 S$(A)=A$:A=A+1:N=N+1:GOTO 820
860 IF LEN(A$)=1 THEN A=0:B=N-1:GOTO 900
880 A=VAL(RIGHT$(A$,LEN(A$)-1)):B=A
890 IF MID$(A$,3,1)="-" THEN B=VAL (MID$(A$,4,2))
895 IF MID$(A$,4,1)="-" THEN B=VAL (MID$(A$,5,2))
900 IF B>N THEN B=N-1
910 IF A>N-THEN A=N-1
915 IF A<0 THEN A=0
920 IF OK THEN FOR C=A TO B: GOSUB 940:PRINT C;TAB(4)A$;"  ";OB$(C);TAB(18)S$(C) ELSE GOTO 930

926 IF B$="P" THEN LPRINT C;TAB(4)A$;"  ";OB$(C);TAB(18)S$(C)
927 NEXT:RETURN
930 FOR C=A TO B:PRINT C;"  ";S$(C):IF B$="P" THEN LPRINT C;"  ";S$(C)
935 NEXT:RETURN
940 A$=" ":Y=AD(C):X=INT(Y/256):GOSUB 970
950 X=INT((Y-(X*256))/16):GOSUB 970
960 X=INT(Y-(INT(Y/16)*16))
970 IF X>9 AND X<16 THEN A$=A$+CHR$(X+55) ELSE A$=A$+RIGHT$(STR$(X),1)
980 RETURN
990 OK=0:LC=0:AC=0
1000 B=VAL(RIGHf$(A$,LEN(A$)-1))
1010 IF B>N THEN RETURN
1020 FOR C=B TO N-1:S$(C)=S$(C+1):NEXT
1030 N=N-1:RETURN
1040 'Symbol Print
1060 FOR A=0 TO LC-1:C=LN(A):GOSUB 940:PRINT LA$(A);" ";LN(A);" ";A$:
1070 NEXT:RETURN
1080 INPUT "L=Load S=Save ";B$
1100 IF(B$<>"S")*(B$<>"L") THEN RETURN
1110 INPUT" File Specs ";A$
1120 IF B$="S" THEN 1170
1130 OPEN "I",1,A$:INPUT#1,OK,N
1140 ' FOR A=0 TO N-1:INPUT #1,S$(A),OB$(A),AD(A):NEXT
1145 FOR A=0 TO N-1:INPUT#1,ZZ$,S$(A),ZZ$,ZZ$,OB$(A),ZZ$AD(A):NEXT
1150 CLOSE:RETURN
1160 PRINT "No Source":RETURN
1170 IF N=0 THEN 1160 ELSE OPEN "O",1,A$:PRINT#1,OK;N;
1180 FOR A=0 TO N-1:PRINT#1,CHR$(34);S$(A);CHR$(34);CHR$(34); OB$(A);CHR$(34);AD(A);:NEXT
1190 B$=" ":CLOSE:RETURN
1200 LINEINPUT "Ready* ";A$:B$=LEFT$(A$,1)
1220 IF B$="L" OR B$="P" THEN GOSUB 860
1230 IF B$="I" THEN GOSUB 760
1240 IF B$="D" THEN GOSUB 990
1250 IF B$="C" THEN INPUT "Sure (Y/N)";Z$:IF Z$="Y" THEN 130
1260 IF B$="A" THEN GOSUB 240
1270 IF B$="F" THEN GOSUB 1080
1280 IF B$="S" THEN GOSUB 1040
1290 IF B$="H" THEN GOSUB 1550
1293 IF B$="?" THEN GOSUB 1550
1295 IF B$="E" THEN GOSUB 1610
1297 IF B$="M" THEN GOSUB 1900
1300 GOTO 1200
1301 'Implied Operands
1315 DATA ABA 1B,ABX 3A,ASLA 48,ASLB 58,ASLD 05,ASRA 47,ASRB 57
1320 DATA CLC 0C,CLI 0E,CLRA 4F,CLRB 5F,CLV 0A,COMA 43,COMB 53
1322 DATA DAA 19,DECA 4A,DECB 5A,DES 34,DEX 09,INCA 4C,INCB 5C,INS 31,INX 08
1325 DATA LSRA 44,LSRB 54,LSRD 04,MUL 3D,NOP 01

1340 DATA PSHA 36,PSHB 37,PSHX 3C,PULA 32,PULB 33,PULX 38,ROLA, 49,ROLB 59,RORA 46,RORB 56,RTI 3B,RTS 39
1360 DATA SBA 10,SEC OD,SEI OF,SEV OB,SLP lA,SWI 3F, TAB 16,TAP 06,TBA 17,TPA 07,TSTA 4D,TSTB 5D,TSX 3O,TXS 35,WAI 3E,XGDX 18
1420 ' Other Operands
1430 DATA ADDA 8B9BABBB,ADDB CBDBEBFB,ADCA 8999A9B9,ADCB C9D9E9F9,ADDD C3D3E3F3
1440 DATA AIM ??7161??,ANDA 8494A4B4,ANDB C4D4E4F4,BITA 8595A5B5,BITB C5D5E5F5
1450 DATA CLR ????6F7F,CMPA 8191A1B1,CMPB C1D1E1F1,CPX 8C9CACBC, DEC ????6A7A, EIM ??7565??,EORA 8898A8B8,EORB C8D8E8F8,INC ????6C7C
1455 DATA JMP ????6E7E,JSR ??9DADBD
1460 DATA LDAA 8696A6B6,LDAB C6D6E6F6,LDD CCDCECFC,LDS 8E9EAEBE,LDX CEDEEEFE,OIM ??7262??,ORAA 8A9AAABA,ORAB CADAEAFA
1470 DATA SBCA 8292A2B2,SBCB C2D2E2F2
1505 DATA STAA ??97A7B7,STAB ??D7E7F7,STD ??DDEDFD,STS ??9FAFBF, STX ??DFEFFF,SUBA 8090A0B0,SUBB C0D0E0F0,SUBD 8393A3B3,TIM ??7B6B??,TST ????6D7D
1530 ' Branch Instructions
1540 DATA CC24,CS25,EQ27,GE2C,GT2E,HI22,LE2F,LS23,LT2D,M12B,NE26,PL2A,RA20,RN21,SR80,VC28,VS29
1550 ' Operator's Guide
1560 CLS:PRINT "H=Help (This Page)"
1562 PRINT "F=File (Save/Load)"
1570 PRINT "I=Insert"
1572 PRINT "Ixx=Insert before L#xx"
1580 PRINT "Dxx=Delete Line#xx"
1582 PRINT "C=Clear"
1590 PRINT "L=List all text"
1592 PRINT "Lxx=List Line#xx"
1594 PRINT "Lxx-xx=List Range"
1596 PRINT "P=Print Text"
1600 PRINT" A=Assemble"
1605 PRINT "S=Symbol Display"
1606 PRINT "M=Put Obj in Memory"
1608 PRINT "E=Examples"
1609 RETURN
1610 PRINT "Instruction Examples"
1620 PRINT "Immed (ADDA #$IA)"
1630 PRINT "Direct (ADDA $IA)"
1640 PRINT "Indxd (ADDA $IA,X)"
1650 PRINT "Extnd (ADDA $0A40)"
1660 PRINT "Implied - No Operand"
1665 PRINT "Other (OIM $10,#$01)"
1666 PRINT "' (OIM $10,X,#$01)"
1668 PRINT "LBL1 EQU LBL2"
1669 PRINT "LBL1 EQU $XXXX"
1670 PRINT "ORG $XXXX"
1672 PRINT "Literals $XX For Hex"

1674 PRINT "  'XX' For ASCII"
1680 PRINT "Source is Positional"
1682 PRINT "(Use Tabs)"
1690 PRINT "LABEL t OP t OPERAND"
1695 RETURN
1800 ' 3-Operand Instructions
1810 IF MID$(S$(A),20,2)=",X" THEN OB$(A)=MID$(OP$(B),10,2) + MID$(S$(A),25,2)+MID$(S$(A),18,2):CD=CD+3:GOTO 1830
1820 OB$(A)=MID$(OP$(B),8,2)+ MID$(S$(A),23,2) + MID$(S$(A),18,2):CD=CD+3
1830 RETURN
1900 FOR C=O TO N-1
1910 GOSUB 940
1920 IF OB$(C)=" " THEN 1950
1925 FOR LL=O TO LEN (OB$(C))/2-1
1927 GOSUB 2000
1930 POKE AD(C)+LL,B
1940 NEXT LL
1950 NEXT C
1960 RETURN
2000 CB$="0123456789ABCDEF"
2005 B=O
2030 FOR CX=1 TO 16
2040 IF MID$(OB$(C),2*LL+1,1)=MID$(CB$,CX,1) THEN B=(CX-1)*16:GOTO 2055
2050 NEXT CX
2055 FOR CX=1 TO 16
2060 IF MID$(OB$(C),2*LL+2,1)=MID$(CB$,CX,1) THEN B=(CX-1)+B:GOTO 2080
2070 NEXT CX
2080 RETURN