00001 DIM LABEL$(100)
00002 DIM LABEL(100)
00003 EOD=96
00004 MODE 3
00005 ON ERROR GOSUB "DISK-ERR"
00006 DEF LEN 80
00007 I$="":II$="":NI$=""
00008 DEF LEN 20
00009 GOTO "MENU"
00010 PASS=1 :PC=0
00050 PC=0
00060 LINEINPUT #1,I$
00080 LL$=""
00090 OPCODE$=""
00100 "ASSEMBLE"
00110 GOSUB "SPACE-STRIPPER"
00120 FIRST$=LEFT$(NI$,1)
00130 IF FIRST$="'" THEN GOSUB "LABEL"
00140 IF FIRST$="-" THEN NPC=0:OPCODE$="" :GOTO 400
00200 "FIND-INSTRUCTION"
00205 RESTORE
00210 FOR T=1 TO EOD
00220 READ A$,OPCODE,SUB
00230 Q$=LEFT$(NI$,LEN(A$))
00240 IF Q$=A$ GOTO "FOUND"
00250 NEXT
00255 PRINT:PRINTI$:PRINT
00260 PRINT"INSTRUCTION NOT FOUND " : STOP
00300 "FOUND"
00310 LS=LEN(A$)
00320 NI$=RIGHT$(NI$,LEN(NI$)-LS)
00330 ON SUB GOSUB "TYPE-1","TYPE-2","TYPE-3","TYPE-4","TYPE-5","TYPE-6","TYPE-7","TYPE-8","TYPE-9","TYPE-10","TYPE-11","TYPE-12","TYPE-13","TYPE-14","TYPE-17","TYPE-18"
00335 II$=""
00340 FOR T=1 TO LEN(I$)
00350 C$=MID$(I$,T,1)
00360 IF C$>=" " AND C$<CHR$(127) THEN II$=II$+C$
00370 NEXT
00380 I$=II$
00400 PRINTHEX$(PC);" ";LL$,OPCODE$,I$
00410 PC=PC+NPC
00420 IF PRNQ$<>"Y" GOTO 500
00430 IF PASS<>2 GOTO 500
00440 LPRINT HEX$(PC);" ";LL$,OPCODE$,I$
00500 IF OBJQ$="Y" THEN WRITE #2,OPCODE$;LEN(OPCODE$)
00510 GOTO 60
00999 END
01000 "SPACE-STRIPPER"
01010 NI$=""
01020 FOR T=1 TO LEN(I$)
01030 Z$=MID$(I$,T,1)
01040 IF Z$>" " THEN NI$=NI$+Z$
01050 NEXT
01060 RETURN
02000 "LABEL"
02010 Z=INSTR(2,NI$,"'")
02015 IF PASS=2 GOTO 2090
02020 IF Z=0 PRINT"NO DELIMITER IN LABEL" : STOP
02030 LA$=MID$(NI$,2,Z-2)
02040 FOR T=1 TO LA
02050 IF LA$=LABEL$(T) THEN PRINT"LABEL ALREADY DEFINED" : STOP
02060 NEXT T
02070 LA=LA+1
02075 IF LA>100 THEN PRINT"TOO MANY LABELS ": STOP
02080 LABEL$(LA)=LA$ : LABEL(LA)=PC
02090 LL$=MID$(NI$,2,Z-2)
02095 NI$=RIGHT$(NI$,LEN(NI$)-Z)+"-"
02100 C=INSTR(1,I$,"'")
02110 D=INSTR(C+1,I$,"'")
02120 I$=RIGHT$(I$,LEN(I$)-D)
02130 RETURN
03000 "REGISTER-BOUNDS"
03010 R=ASC(R$)-48
03020 IF R<LO OR R>HI THEN PRINT"REGISTER OUT OF RANGE" : STOP
03030 RETURN
03100 "FIND-LABEL"
03110 IF PASS=1 THEN TE$="000" : RETURN
03120 FOR T=1 TO LA
03130 Z$="'"+LABEL$(T)+"'"
03140 X=INSTR(1,NI$,Z$)
03150 IF X<>0 GOTO "LABEL-FOUND"
03160  NEXT
03170 PRINT" LABEL NOT FOUND " : STOP
03200 "LABEL-FOUND"
03210 TE$=RIGHT$(HEX$(LABEL(T)),3)
03220 RETURN
04000 "TYPE-1"
04010 R$=LEFT$(NI$,1)
04020 LO=0 : HI=7
04030 GOSUB "REGISTER-BOUNDS"
04040 OPCODE$=RIGHT$(HEX$(OPCODE+R),2)
04050 NPC=1
04060 RETURN
04100 "TYPE-2"
04110 R$=LEFT$(NI$,1)
04120 LO=0 : HI=1
04130 GOSUB "REGISTER-BOUNDS"
04140 OPCODE$=RIGHT$(HEX$(OPCODE+R),2)
04150 NPC=1
04160 RETURN
04200 "TYPE-3"
04210 DAT$=LEFT$(NI$,2)
04230 OPCODE$=RIGHT$(HEX$(OPCODE),2)+DAT$
04240 NPC=2
04250 RETURN
04300 "TYPE-4"
04310 R$=LEFT$(NI$,1)
04320 LO=0 : HI=2 :GOSUB "REGISTER-BOUNDS"
04330 OPCODE$=RIGHT$(HEX$(OPCODE+R),2)
04340 OPCODE$=OPCODE$+MID$(NI$,4,2)
04350  X=LEN(OPCODE$)
04360 IF X<>4 THEN PRINT" DATA BYTE INCORRECT" : STOP
04370 NPC=2
04380 RETURN
04400 "TYPE-5"
04410 R$=LEFT$(NI$,1)
04420 LO=0 : HI=3 : GOSUB "REGISTER-BOUNDS"
04430 OPCODE$=RIGHT$(HEX$(OPCODE+R),2)
04450 NPC=1
04460 RETURN
04500 "TYPE-6"
04510 F$=LEFT$(NI$,1)
04520 TE$=MID$(NI$,2,3)
04530 IF F$="'" GOSUB "FIND-LABEL"
04540 R$=LEFT$(TE$,1)
04550 LO=0 : HI=7 : GOSUB "REGISTER-BOUNDS"
04560 R=R*32
04570 OPCODE$=RIGHT$(HEX$(OPCODE+R),2)
04580 OPCODE$=OPCODE$+RIGHT$(TE$,2)
04590 NPC=2
04595 RETURN
04600 "TYPE-7"
04610 OPCODE$=RIGHT$(HEX$(OPCODE),2)
04620 NPC=1
04630 RETURN
04700 "TYPE-8"
04710 R$=LEFT$(NI$,1)
04720 LO=0 : HI=7 : GOSUB "REGISTER-BOUNDS"
04730 OPCODE$=RIGHT$(HEX$(OPCODE+R),2)
04740 F$=MID$(NI$,3,1)
04745 TE$=MID$(NI$,4,3)
04750 IF F$="'" GOSUB "FIND-LABEL"
04760 OPCODE$=OPCODE$+RIGHT$(TE$,2)
04770 NPC=2
04780 RETURN
04800 "TYPE-9"
04810 R$=LEFT$(NI$,1)
04820 LO=1 : HI=2 : GOSUB "REGISTER-BOUNDS"
04830 OPCODE$=RIGHT$(HEX$(OPCODE+R),2)
04840 NPC=1
04850 RETURN
04900 "TYPE-10"
04910 R$=LEFT$(NI$,1)
04920 LO=0 : HI=7 : GOSUB "REGISTER-BOUNDS"
04930 OPCODE$=RIGHT$(HEX$(OPCODE+R*32),2)
04940 F$=MID$(NI$,2,1)
04945 TE$=MID$(NI$,2,2)
04950 IF F$="'" GOSUB "FIND-LABEL"
04960 OPCODE$=OPCODE$+RIGHT$(TE$,2)
04970 NPC=2
04980 RETURN
05000 "TYPE-11"
05005 TE$=MID$(NI$,2,2)
05010 F$=LEFT$(NI$,1)
05020 IF F$="'" GOSUB "FIND-LABEL"
05040 OPCODE$=RIGHT$(HEX$(OPCODE),2)+RIGHT$(TE$,2)
05050 NPC=2
05060 RETURN
05100 "TYPE-12"
05110 F$=MID$(NI$,3,1)
05120 R$=LEFT$(NI$,1)
05130 LO=0 : HI=7 : GOSUB "REGISTER-BOUNDS"
05140 IF F$="A" THEN OPCODE$=RIGHT$(HEX$(&HA8+R),2) :NPC=1 : RETURN
05150 OPCODE$=RIGHT$(HEX$(&HB8+R),2)+MID$(NI$,4,2)
05160 NPC=2
05170 RETURN
05200 "TYPE-13"
05210 F$=MID$(NI$,3,1)
05220 R$=LEFT$(NI$,1)
05230 LO=0 : HI=7 : GOSUB "REGISTER-BOUNDS"
05240 IF F$="A" THEN OPCODE$=RIGHT$(HEX$(OPCODE+R),2) :NPC=1 : RETURN
05250 OPCODE$=RIGHT$(HEX$(&HB0+R),2)+MID$(NI$,4,2)
05260 NPC=2
05270 RETURN
05300 "TYPE-14"
05310 R$=LEFT$(NI$,1)
05320 LO=0 :HI=3 : GOSUB "REGISTER-BOUNDS"
05330 OPCODE$=RIGHT$(HEX$(OPCODE+R),2)
05340 NPC=1
05350 RETURN
05400 "TYPE-17"
05410 R$=LEFT$(NI$,1)
05420 LO=1 : HI=2 : GOSUB "REGISTER-BOUNDS"
05430 OPCODE$=RIGHT$(HEX$(OPCODE+R),2)
05440 NPC=1
05450 RETURN
05500 "TYPE-18"
05520 IF OPCODE=1 THEN GOSUB "HEX-DEC"
05530 IF OPCODE=2 THEN "CHK-PASS"
05540 IF OPCODE=3 THEN OPCODE$=MID$(NI$,1,2) :NPC=1 :RETURN
05545 IF OPCODE=4 THEN NPC=0 : RETURN
05550 RETURN
05600 "HEX-DEC"
05610 NPC=0 :PC=0
05620 OPCODE$=MID$(NI$,1,3)
05630 Z$=MID$(OPCODE$,1,1) : GOSUB "CONVERT"
05640 PC=PC+K*256
05650 Z$=MID$(OPCODE$,2,1) : GOSUB "CONVERT"
05660 PC=PC+K*16
05670 Z$=MID$(OPCODE$,3,1) : GOSUB "CONVERT"
05680 PC=PC+K
05690 OPCODE$="."+OPCODE$
05695 PRINT:IF PASS=2 AND PRNQ$="Y" THEN LPRINT
05696 RETURN
05700 "CONVERT"
05710 K=ASC(Z$)
05720 K=K-48 
05730 IF K>9 THEN K=K-7
05740 IF K<0 OR K>15 THEN PRINT"INVALID ADDRESS" : STOP
05750 RETURN
05800 "CHK-PASS"
05810 RECORD #1,0
05820 IF PASS=2 GOTO "FINISHED"
05830 PRINT:PRINT" PASS-2"
05840 PRINT"========":PRINT
05841 PASS=2
05845 PASS=2
05850 IF PRNQ$="N" GOTO 60
05860 LPRINT "NAME OF FILE : ";SF$
05870 LPRINT 
05890 LPRINT "(C) P.J.GRIFFITHS 19";MID$(DATE$,7,2)
05895 LPRINT
05896 LPRINT "************************"
05897 LPRINT :GOTO 60
05900 "FINISHED"
05905 CLOSE
05910 PRINT:IF PRNQ$="Y" THEN LPRINT
05920 PRINT
05930 PRINT" LIST OF LABELS USED"
05940 PRINT"====================="
05960 IF PRNQ$<>"Y" GOTO 6000
05970 LPRINT
05975 LPRINT" LIST OF LABELS USED"
05980 LPRINT"====================="
06000 FOR T=1 TO LA
06010 PRINTT;LABEL$(T),HEX$(LABEL(T))
06020 IF PRNQ$="Y" THEN LPRINTT;LABEL$(T),HEX$(LABEL(T))
06030 NEXT
06100 PRINT:PRINT" ASSEMBLY FINISHED"
06110 IF OBJQ$="N" THEN END
06120 PRINT"OBJECT CODE FILE NAME IS ";
06130 COLOR 15 :PRINT OF$ :COLOR 7
06140 DEF PAGE 0,0 TO 79,24
06150 END
07000 "DISK-ERR"
07005 PRINT:PRINT:PRINT
07006 LOCATE 16,24
07010 FE=ERROR>>8
07020 ET=ERROR AND 255
07030 ERROR=0
07050 IF ET=1 THEN OPCODE=2 : GOTO 5530
07060 IF ET=2 THEN PRINT"DISK FULL";
07070 IF ET=3 THEN PRINT"FILE NOT FOUND";
07075 IF ET>4 THEN PRINT"DISK";
07080 IF FE=1 THENPRINT" ERROR IN SOURCE FILE"
07090 IF FE=2 THENPRINT" ERROR IN OBJECT FILE"
07100 SOUND 1056,500
07110 CLOSE
07120 END
08000 "MENU"
08001 CLS
08010 COLOR 15
08012 PRINT@(22,3)"8048 SERIES ASSEMBLER"
08014 PRINT@(21,4)"-----------------------"
08019 COLOR 7
08020 PRINT@(20,7);"DRIVE LETTER <CR> FOR A ? ";
08021 COLOR 15
08022 INPUT;&1,"";SD$
08025 IF SD$="" THEN SD$="A" : PRINT"A";
08026 PRINT":"
08027 SD$=SD$+":"
08028 COLOR 7
08030 PRINT@(20,8);"SOURCE  FILE  NAME      ? ";
08032 COLOR 15
08035 INPUT;&8,"";SF$
08036 COLOR 7
08037 IF SF$="" GOTO 8030
08040 PRINT@(20,9);"CREATE OBJECT FILE (Y/N)? ";
08041 COLOR 15
08045 INPUT;&1,"";OBJQ$
08046 IF OBJQ$="" THEN PRINT"N" :OBJQ$="N"
08047 COLOR7
08050 PRINT@(20,10);"LIST TO PRINTER    (Y/N)? ";
08055 COLOR 15
08060 INPUT;&1,"";PRNQ$
08061 IF PRNQ$="" THEN PRINT"N" :PRNQ$="N"
08065 COLOR 7
08070 OF$=SD$+SF$+".OBJ"
08080 SF$=SD$+SF$+".ASM"
08090 OPEN "I",1,SF$
08100 IF OBJQ$="Y" THEN OPEN "O",2,OF$
08104 PRINT:PRINT
08105 DEF PAGE 0,13 TO 79,24
08110 GOTO 10
10000 DATA "ADDA,R",&H68,1
10002 DATA "ADDA,@R",&H60,2
10004 DATA "ADDA,#",&H03,3
10006 DATA "ADDCA,R",&H78,1
10008 DATA "ADDCA,@R",&H70,2
10010 DATA "ADDCA,#",&H13,3
10012 DATA "ANLA,R",&H58,1
10014 DATA "ANLA,@R",&H50,2
10016 DATA "ANLA,#",&H53,3
10018 DATA "ANLP",&H98,4
10020 DATA "ANLDEP",&H9C,5
10022 DATA "CALL",&H14,6
10024 DATA "CLRA",&H27,7
10026 DATA "CLRC",&H97,7
10028 DATA "CLRF0",&H85,7
10030 DATA "CLRF1",&HA5,7
10032 DATA "CPLA",&H37,7
10034 DATA "CPLC",&HA7,7
10036 DATA "CPLF0",&H95,7
10038 DATA "CPLF1",&HB5,7
10040 DATA "DAA",&H57,7
10042 DATA "DECA",&H07,7
10044 DATA "DECR",&HC8,1
10046 DATA "DISI",&H15,7
10048 DATA "DISTCNTI",&H35,7
10050 DATA "DJNZR",&HE8,8
10052 DATA "ENI",&H05,7
10054 DATA "ENTCNTI",&H25,7
10056 DATA "ENT0CLK",&H75,7
10058 DATA "INA,P",&H08,9
10060 DATA "INCA",&H17,7
10062 DATA "INCR",&H18,1
10064 DATA "INC@R",&H10,2
10066 DATA "INSA,BUS",&H08,7
10068 DATA "JB",&H12,10
10070 DATA "JC",&HF6,11
10072 DATA "JF0",&HB6,11
10074 DATA "JF1",&H76,11
10076 DATA "JMP",&H04,6
10078 DATA "JMPP@A",&HB3,7
10080 DATA "JNC",&HE6,11
10082 DATA "JNI",&H86,11
10084 DATA "JNT0",&H26,11
10086 DATA "JNT1",&H46,11
10088 DATA "JNZ",&H96,11
10090 DATA "JTF",&H16,11
10092 DATA "JT0",&H36,11
10094 DATA "JT1",&H56,11
10096 DATA "JZ",&HC6,11
10098 DATA "MOVA,#",&H23,3
10100 DATA "MOVA,PSW",&HD7,7
10102 DATA "MOVA,R",&HF8,1
10104 DATA "MOVA,@R",&HF0,2
10106 DATA "MOVA,T",&H42,7
10108 DATA "MOVPSW,A",&HD7,7
10110 DATA "MOVR",00,12
10112 DATA "MOV@R",&HA0,13
10114 DATA "MOVT,A",&H62,7
10116 DATA "MOVDA,EP",&H0C,14
10118 DATA "MOVDEP",&H3C,5
10120 DATA "MOVPA,@A",&HA3,7
10122 DATA "MOVP3A,@A",&HE3,7
10124 DATA "MOVXA,@R",&H80,2
10126 DATA "MOVX@R",&H90,13
10128 DATA "NOP",&H00,7
10130 DATA "ORLA,R",&H48,1
10132 DATA "ORLA,@R",&H40,2
10134 DATA "ORLA,#",&H43,3
10136 DATA "ORLDEP",&H8C,5
10137 DATA "ORLP",&H88,4
10138 DATA "OUTLBUS,A",&H02,7
10140 DATA "OUTLP",&H38,15
10142 DATA "RETR",&H93,7
10144 DATA "RET",&H83,7
10146 DATA "RLA",&HE7,7
10148 DATA "RLCA",&HF7,7
10150 DATA "RRA",&H77,7
10152 DATA "RRCA",&H67,7
10154 DATA "SELMB0",&HE5,7
10156 DATA "SELMB1",&HF5,7
10158 DATA "SELRB0",&HC5,7
10160 DATA "SELRB1",&HD5,7
10162 DATA "STOPTCNT",&H65,7
10164 DATA "STRTCNT",&H45,7
10166 DATA "STRTT",&H55,7
10168 DATA "SWAPA",&H47,7
10170 DATA "XCHA,R",&H28,1
10172 DATA "XCHA,@R",&H40,2
10174 DATA "XCHDA,@R",&H30,2
10176 DATA "XRLA,R",&HD8,1
10178 DATA "XRLA,@R",&HD0,2
10180 DATA "XRLA,#",&HD3,3
10182 DATA "ORG$",1,16
10184 DATA "END",2,16
10186 DATA ",",3,16
10188 DATA "-",4,16