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%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 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%"" 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%)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