github.com/agn453.RSTS-E
1
0
Fork 0
mirror of https://github.com/agn453/RSTS-E.git synced 2026-01-11 23:22:42 +00:00
Code Issues Releases Wiki Activity
agn453.RSTS-E/micros/X80.B2S
Tony Nicholson 634765cfb3 Include microcomputer cross-assemblers
2021-11-12 11:44:23 +11:00

922 lines
27 KiB
QBasic
Raw Permalink Blame History

This file contains invisible Unicode characters

This file contains invisible Unicode characters that are indistinguishable to humans but may be processed differently by a computer. If you think that this is intentional, you can safely ignore this warning. Use the Escape button to reveal them.

1000 REM &
REM !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! &
REM !! !! &
REM !! 8080/8085 Cross Assembler !! &
REM !! !!
1010 REM !! A.G. Nicholson, Newcastle Uni . !! &
REM !! !! &
REM !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! &
1020 REM &
REM ! Version of 12-May-80 &
1030 EXTEND
1040 CCL.ENTRY%=0%
1050 DIM SYMBOLS$(767%), &
VALUES%(767%), &
FLAGS%(767%), &
SYMBOL.CHARS%(6%), &
DELIMITER.TABLE%(3%)
1060 ! -- Set up error trap routine --
1070 ON ERROR GOTO 31020 &
\ X$=SYS(CHR$(6%)+CHR$(-7%))
1080 ! -- Initialise --
1090 NUMBER.OF.SYMBOLS%=0% &
\ SYMBOL.TABLE.SIZE%=768% &
\ START.CPU.TIME%=TIME(1%) &
\ LISTING.FILE$="KB:"
1100 FOR I%=1% TO 97% &
\ READ SYMBOL$,VALUE%,FLAG.WORD% &
\ GOSUB 2310 &
\ NEXT I% &
! Read in opcodes
1110 FLAG.WORD%=0% &
\ FOR I%=1% TO 13% &
\ READ SYMBOL$,VALUE% &
\ GOSUB 2310 &
\ NEXT I% &
! Read in register definitions
1120 ! -- Print header --
1130 OPEN LISTING.FILE$ AS FILE 1% &
\ GOTO 1180 IF CCL.ENTRY% &
\ PRINT #1%,"8080/8085 Cross assembler" &
\ PRINT #1%,"#";
1140 ! &
1150 ! -- Get listing, source filenames --
1160 INPUT LINE #1%, SOURCE.FILE$ &
\ SOURCE.FILE$=CVT$$(SOURCE.FILE$,-1%)
1170 ! -- Check for errors only switch --
1180 ERRORS.ONLY.SWITCH%=-1% &
\ I%=INSTR(1%,SOURCE.FILE$,"/E") &
\ IF I% THEN SOURCE.FILE$=LEFT(SOURCE.FILE$,I%-1%)+ &
RIGHT(SOURCE.FILE$,I%+2%) &
\ ERRORS.ONLY.SWITCH%=0%
1190 ! -- Check for symbol table listing switch --
1200 SYMBOL.TABLE.LIST.FLAG%=INSTR(1%,SOURCE.FILE$,"/S") &
\ IF SYMBOL.TABLE.LIST.FLAG% THEN SOURCE.FILE$= &
LEFT(SOURCE.FILE$,SYMBOL.TABLE.LIST.FLAG%-1%)+ &
RIGHT(SOURCE.FILE$,SYMBOL.TABLE.LIST.FLAG%+2%)
1210 ! -- Check for object module output switch --
1220 OBJECT.OUT.FLAG%=0% &
\ I%=INSTR(1%,SOURCE.FILE$,"/O") &
\ IF I% THEN SOURCE.FILE$=LEFT(SOURCE.FILE$,I%-1%)+ &
RIGHT(SOURCE.FILE$,I%+2%) &
\ OBJECT.OUT.FLAG%=-1%
1230 ! -- Check for listing file and add default extensions --
1240 LISTING.TO.FILE.FLAG%=INSTR(1%,SOURCE.FILE$,"=") &
\ IF LISTING.TO.FILE.FLAG% THEN LISTING.FILE$= &
LEFT(SOURCE.FILE$,LISTING.TO.FILE.FLAG%-1%) &
\ LISTING.FILE$=LISTING.FILE$+".LST" UNLESS &
INSTR(1%,LISTING.FILE$,".") &
\ SOURCE.FILE$=RIGHT(SOURCE.FILE$, &
LISTING.TO.FILE.FLAG%+1%)
1250 SOURCE.FILE$=SOURCE.FILE$+".SRC" UNLESS &
INSTR(1%,SOURCE.FILE$,".")
1260 PRINT #1%,"Listing sent to "+ &
LISTING.FILE$ IF LISTING.TO.FILE.FLAG%
1270 IF OBJECT.OUT.FLAG% THEN OBJECT.FILE$= &
LEFT(SOURCE.FILE$,INSTR(1%,SOURCE.FILE$,"."))+"HEX" &
\ PRINT #1%,"Object module to ";OBJECT.FILE$
1280 ! -- Get a unique workfile name --
1290 WORK.FILE$="X80X"+MID(NUM$(100%+ASCII(SYS(CHR$(6%)+ &
CHR$(9%)))/2%),3%,2%)+".TMP"
1300 ! -- Commence assembly --
1310 GOSUB 2010 &
\ GOSUB 3010 &
\ X%=1% &
\ GOSUB 3720
1320 ! -- Print symbol table --
1330 GOSUB 3750 IF SYMBOL.TABLE.LIST.FLAG% &
\ PRINT #1%
1340 ! -- Finish up and exit --
1350 CLOSE 1% &
\ IF LISTING.TO.FILE.FLAG% THEN X%=0% &
\ GOSUB 3720
1360 PRINT "Runtime was";(TIME(1%)-START.CPU.TIME%)/10;"sec" &
\ GOTO 32767
1370 !
2000 &
! -- Pass 1 Driver routine -- &
2010 ERROR.COUNT%, &
TOTAL.BYTES%, &
LOCATION.COUNTER%, &
ERROR.LINE.FLAG%, &
OPCODE.TABLE.SUBSCRIPT%=0% &
\ PASS.NUMBER%=1% &
\ OPEN SOURCE.FILE$ FOR INPUT AS FILE 2% &
\ OPEN WORK.FILE$ FOR OUTPUT AS FILE 3% &
\ PRINT #1%,"Pass 1"
2020 INPUT LINE #2%,SOURCE.LINE$ &
\ SOURCE.LINE$=CVT$$(SOURCE.LINE$,421%) &
\ LINE.LENGTH%=LEN(SOURCE.LINE$) &
\ LINE.NUMBER%=LINE.NUMBER%+1%
2030 IF LINE.LENGTH%=0% OR LEFT(SOURCE.LINE$,1%)="$" THEN &
OPCODE.TABLE.SUBSCRIPT%=-1% &
\ GOTO 2150
2040 ! -- Scan source line --
2050 GOSUB 2190 &
\ GOSUB 2240
2060 ! -- Comment line ? --
2070 IF COMMENT.DELIMITER%=1% THEN &
OPCODE.TABLE.SUBSCRIPT%=-1% &
\ GOTO 2150
2080 ! -- Get argument field --
2090 IF COMMENT.DELIMITER% THEN ARGUMENT$= &
CVT$$(MID(SOURCE.LINE$,OPCODE.DELIMITER%+1%, &
COMMENT.DELIMITER%-OPCODE.DELIMITER%-1%),258%) &
ELSE ARGUMENT$=CVT$$(RIGHT(SOURCE.LINE$,OPCODE.DELIMITER%+1%),258%)
2100 ! -- Label ? --
2110 IF LABEL.DELIMITER% THEN SYMBOL$= &
CVT$$(LEFT(SOURCE.LINE$,LABEL.DELIMITER%-1%),128%) &
\ VALUE%=LOCATION.COUNTER% &
\ FLAG.WORD%=-2% &
\ GOSUB 2310
2120 ! -- Assignment ? --
2130 IF EQU.DELIMITER% THEN GOSUB 2380 &
ELSE GOSUB 2420
2140 ! -- Write to workfile --
2150 GOSUB 2460 &
\ GOTO 2020 IF OPCODE.TABLE.SUBSCRIPT%=-1% &
\ GOTO 2020 IF FLAGS%(OPCODE.TABLE.SUBSCRIPT%)<>10%
2160 CLOSE 2%,3% &
\ RETURN &
! -- End of Pass 1
2170 ! &
2180 &
! -- Scan for strings in SOURCE.LINE$ -- &
2190 DELIMITER%=-1% &
\ TEMP2%=0%
2200 TEMP1%=INSTR(TEMP2%+1%,SOURCE.LINE$,"'") &
\ RETURN UNLESS TEMP1%
2210 TEMP2%=INSTR(TEMP1%+1%,SOURCE.LINE$,"'") &
\ IF TEMP2% THEN DELIMITER%=DELIMITER%+1% &
\ IF DELIMITER%<4% THEN DELIMITER.TABLE%(DELIMITER%)= &
SWAP%(TEMP1% AND 255%) OR (TEMP2% AND 255%) &
\ GOTO 2200
2220 RETURN
2230 &
! -- Search for token delimiters -- &
! LABEL.DELIMITER% Label &
! OPCODE.DELIMITER% Opcode &
! COMMENT.DELIMITER% Comment &
! EQU.DELIMITER% Assignment &
2240 LABEL.DELIMITER%=INSTR(1%,SOURCE.LINE$,":") &
\ LABEL.DELIMITER%=0% IF FNCHECK.SYNTAX%(LABEL.DELIMITER%) &
\ COMMENT.DELIMITER%=0%
2250 COMMENT.DELIMITER%=INSTR(COMMENT.DELIMITER%+1%,SOURCE.LINE$,";") &
\ GOTO 2250 IF FNCHECK.SYNTAX%(COMMENT.DELIMITER%) &
\ LABEL.DELIMITER%=0% IF (LABEL.DELIMITER%> &
COMMENT.DELIMITER% AND COMMENT.DELIMITER%<>0%) &
\ OPCODE.DELIMITER%=LABEL.DELIMITER%
2260 OPCODE.DELIMITER%=OPCODE.DELIMITER%+1% &
\ IF OPCODE.DELIMITER%>=LINE.LENGTH% THEN 2280 &
ELSE X%=ASCII(RIGHT(SOURCE.LINE$,OPCODE.DELIMITER%)) &
\ IF X%=9% OR X%=32% THEN 2260
2270 OPCODE.DELIMITER%=OPCODE.DELIMITER%+1% &
\ IF OPCODE.DELIMITER%<LINE.LENGTH% THEN &
X%=ASCII(RIGHT(SOURCE.LINE$,OPCODE.DELIMITER%)) &
\ IF X%<>9% AND X%<>32% THEN 2270 &
ELSE OPCODE.DELIMITER%=OPCODE.DELIMITER%-1%
2280 EQU.DELIMITER%=INSTR(1%,SOURCE.LINE$,"=") &
\ EQU.DELIMITER%=0% IF FNCHECK.SYNTAX%(EQU.DELIMITER%) OR &
(EQU.DELIMITER%>COMMENT.DELIMITER% AND &
COMMENT.DELIMITER%<>0%) &
\ OPCODE.DELIMITER%=EQU.DELIMITER% IF EQU.DELIMITER%
2290 OPCODE.DELIMITER%=COMMENT.DELIMITER%-1% IF &
(OPCODE.DELIMITER%>=COMMENT.DELIMITER% AND &
COMMENT.DELIMITER%<>0%) &
\ RETURN
2300 &
! Enter symbol SYMBOL$ into symbol table &
! and its value VALUE% &
2310 IF NUMBER.OF.SYMBOLS%=SYMBOL.TABLE.SIZE% THEN &
VALUE%=FNERROR.PRINT%("?X80 - FATAL: Symbol table overflow") &
\ STOP &
! Symbol table full
2320 X%=ASCII(SYMBOL$) &
\ IF X%<>46% AND ( X%<65% OR X%>90% ) THEN &
VALUE%=FNERROR.PRINT%("Invalid symbol = "+SYMBOL$) &
\ RETURN &
! Invalid symbol
2330 TEMP2%=FNHASH.SYMBOL%(SYMBOL$,SYMBOL.TABLE.SIZE%) &
! Hash symbol
2340 IF SYMBOLS$(TEMP2%)="" THEN SYMBOLS$(TEMP2%)=SYMBOL$ &
\ VALUES%(TEMP2%)=VALUE% &
\ FLAGS%(TEMP2%)=FLAG.WORD% &
\ NUMBER.OF.SYMBOLS%=NUMBER.OF.SYMBOLS%+1% &
\ RETURN &
! If slot empty, enter symbol, value and flagword
2350 IF SYMBOLS$(TEMP2%)=SYMBOL$ AND FLAGS%(TEMP2%)<0% THEN &
VALUE%=FNERROR.PRINT%("Redefined symbol = "+SYMBOL$) &
\ RETURN &
! Multiple definition not allowed
2360 TEMP2%=FNREHASH.SYMBOL%(TEMP2%,SYMBOL.TABLE.SIZE%) &
\ GOTO 2340
2370 &
! -- Enter assignment -- &
2380 SYMBOL$=CVT$$(MID(SOURCE.LINE$,LABEL.DELIMITER%+1%, &
EQU.DELIMITER%-LABEL.DELIMITER%-1%),136%) &
\ VALUE%=FNEVALUATE.EXPR%(ARGUMENT$)
2390 IF SYMBOL$="." THEN LOCATION.COUNTER%=VALUE% &
ELSE IF SYMBOL$="" THEN VALUE%= &
FNERROR.PRINT%("Missing symbol") &
ELSE FLAG.WORD%=-1% &
\ GOSUB 2310
2400 OPCODE.TABLE.SUBSCRIPT%=-1% &
\ RETURN
2410 &
! -- Get opcode subscript -- &
2420 OPCODE$=CVT$$(MID(SOURCE.LINE$,LABEL.DELIMITER%+1%, &
OPCODE.DELIMITER%-LABEL.DELIMITER%),8%) &
\ IF OPCODE$<>"" THEN OPCODE.TABLE.SUBSCRIPT%= &
FNHASH.SYMBOL%(OPCODE$,SYMBOL.TABLE.SIZE%) &
ELSE OPCODE.TABLE.SUBSCRIPT%=-1% \ RETURN
2430 IF SYMBOLS$(OPCODE.TABLE.SUBSCRIPT%)=OPCODE$ THEN RETURN &
ELSE IF FLAGS%(OPCODE.TABLE.SUBSCRIPT%)<0% OR &
SYMBOLS$(OPCODE.TABLE.SUBSCRIPT%)="" THEN &
OPCODE.TABLE.SUBSCRIPT%= &
FNERROR.PRINT%("Invalid opcode = "+OPCODE$)-1% &
ELSE OPCODE.TABLE.SUBSCRIPT%= &
FNREHASH.SYMBOL%(OPCODE.TABLE.SUBSCRIPT%, &
SYMBOL.TABLE.SIZE%) &
\ GOTO 2430 &
! Check for opcode match in the symbol table &
! If flagword < 0 then report an error else rehash
2440 RETURN
2450 &
! -- Get byte count and output to workfile -- &
2460 IF OPCODE.TABLE.SUBSCRIPT%=-1% THEN BYTE.COUNT%=0% &
ELSE IF FLAGS%(OPCODE.TABLE.SUBSCRIPT%)>3% THEN &
GOSUB 2500 &
ELSE BYTE.COUNT%=FLAGS%(OPCODE.TABLE.SUBSCRIPT%) &
! Get byte count into BYTE.COUNT%
2470 PRINT #3%,LOCATION.COUNTER%;","; &
BYTE.COUNT%;","; &
OPCODE.TABLE.SUBSCRIPT%;","; &
ERROR.LINE.FLAG% &
\ PRINT #3%,ARGUMENT$ &
\ TOTAL.BYTES%=TOTAL.BYTES%+BYTE.COUNT% &
\ LOCATION.COUNTER%=LOCATION.COUNTER%+BYTE.COUNT% &
\ ERROR.LINE.FLAG%=0% &
\ RETURN
2480 ! &
2490 &
! -- Get byte count for pseudo-op -- &
2500 ON FLAGS%(OPCODE.TABLE.SUBSCRIPT%)-9% &
GOTO 2590, 2520, 2520, 2520, &
2540, 2540, 2540, 2590, &
2570 &
! .END .BYTE .DBYTE .WORD &
! .ASCII .ASCIP .ASCIZ .LIST &
! .BLKB
2510 ! -- .BYTE, .DBYTE, .WORD --
2520 TEMP1%=0% &
\ TEMP2%=-1% &
\ FOR BYTE.COUNT%=0% WHILE TEMP2% &
\ TEMP1%,TEMP2%=INSTR(TEMP1%+1%,ARGUMENT$,",") &
\ NEXT BYTE.COUNT% &
\ BYTE.COUNT%=BYTE.COUNT%*2% IF FLAGS%(OPCODE.TABLE.SUBSCRIPT%)=12% &
OR FLAGS%(OPCODE.TABLE.SUBSCRIPT%)=13% &
\ RETURN
2530 ! -- .ASCII, .ASCIP, .ASCIZ --
2540 TEMP1%=INSTR(2%,ARGUMENT$,LEFT(ARGUMENT$,1%)) &
\ IF TEMP1%=0% THEN OPCODE.TABLE.SUBSCRIPT%= &
FNERROR.PRINT%("Missing delimiter")-1% &
ELSE BYTE.COUNT%=TEMP1%-2%
2550 BYTE.COUNT%=BYTE.COUNT%+1% IF FLAGS%(OPCODE.TABLE.SUBSCRIPT%)=16% &
\ RETURN
2560 ! -- .BLKB
2570 BYTE.COUNT%=FNEVALUATE.EXPR%(ARGUMENT$) &
\ RETURN
2580 ! -- .LIST, END --
2590 BYTE.COUNT%=0% &
\ RETURN
2600 ! &
3000 &
! -- Pass 2 Driver routine -- &
3010 LINE.NUMBER%, &
CHECKSUM%, &
NEW.LINE.FLAG%=0% &
\ PASS.NUMBER%=2% &
\ LIST.FLAG%=-1% &
\ PRINT #1%,"Pass 2" &
\ CLOSE 1% &
\ OPEN LISTING.FILE$ FOR OUTPUT AS FILE 1% &
\ OPEN SOURCE.FILE$ FOR INPUT AS FILE 2% &
\ OPEN WORK.FILE$ FOR INPUT AS FILE 3% &
\ KILL WORK.FILE$
3020 IF OBJECT.OUT.FLAG% THEN &
OPEN OBJECT.FILE$ FOR OUTPUT AS FILE 4% &
\ NEW.OBJ.LINE%=0%
3030 IF ERRORS.ONLY.SWITCH% THEN PRINT #1%," Line Addr B1 B2 B3" &
\ PRINT #1%
3040 INPUT #3%,LOCATION.COUNTER%, &
BYTE.COUNT%, &
OPCODE.TABLE.SUBSCRIPT%, &
ERROR.LINE.FLAG% &
\ INPUT LINE #3%, ARGUMENT$ &
\ ARGUMENT$=CVT$$(ARGUMENT$,4%) &
\ INPUT LINE #2%, SOURCE.LINE$ &
\ SOURCE.LINE$=CVT$$(SOURCE.LINE$,4%) &
\ LINE.NUMBER%=LINE.NUMBER%+1%
3050 ! -- Form object code and output to listing file --
3060 IF LEFT(SOURCE.LINE$,1%)="$" THEN &
SOURCE.LINE$=RIGHT(SOURCE.LINE$,2%)
3070 IF OPCODE.TABLE.SUBSCRIPT%=-1% THEN GOSUB 3630 &
\ GOTO 3040
3080 IF FLAGS%(OPCODE.TABLE.SUBSCRIPT%)=10% THEN &
GOSUB 3130 &
\ RETURN
3090 ADDRESS$=FNDEC.TO.HEX$(LOCATION.COUNTER%,0%) &
\ VALUE%=VALUES%(OPCODE.TABLE.SUBSCRIPT%) &
\ FLAG.WORD%=SWAP%(VALUE%) AND 255% &
\ VALUE%=VALUE% AND 255%
3100 IF FLAGS%(OPCODE.TABLE.SUBSCRIPT%)>3% THEN GOSUB 3370 &
ELSE IF FLAG.WORD% THEN GOSUB 3170 &
ELSE GOSUB 3540 &
\ GOSUB 3630
3110 GOTO 3040
3120 &
! -- End of assembly, tidy up -- &
3130 GOSUB 3630 &
\ PRINT #4% IF OBJECT.OUT.FLAG%
3140 CLOSE 2%,3%,4% &
\ RETURN
3150 ! &
3160 &
! -- Process operands -- &
3170 FIRST.ARG.TYPE%=FLAG.WORD% AND 7% &
\ SECOND.ARG.TYPE%=(FLAG.WORD% AND 56%)/8% &
\ SHIFT.ARG.FLAG%=(FLAG.WORD% AND 192%)/64% &
\ SHIFT.ARG.FLAG%=4% IF SHIFT.ARG.FLAG%=2%
3180 ! -- If two operands evaluate the second into ARG2.VALUE%
3190 IF SECOND.ARG.TYPE%=0% THEN ARG2.VALUE%=0% &
ELSE TEMP2%=INSTR(1%,ARGUMENT$,",") &
\ IF TEMP2%=0% THEN ARG2.VALUE%= &
FNERROR.PRINT%("Missing operand") &
ELSE ARG2.VALUE%=FNEVALUATE.ARGUMENT%( &
RIGHT(ARGUMENT$,TEMP2%+1%),SECOND.ARG.TYPE%) &
\ ARGUMENT$=LEFT(ARGUMENT$,TEMP2%-1%)
3200 ! -- Evaluate the first (only) operand
3210 ARG1.VALUE%=FNEVALUATE.ARGUMENT%(ARGUMENT$,FIRST.ARG.TYPE%)
3220 ! -- If register , do appropriate shift and OR into opcode base
3230 IF FIRST.ARG.TYPE%<4% OR FIRST.ARG.TYPE%=7% THEN &
ARG1.VALUE%=ARG1.VALUE%*(2%^SHIFT.ARG.FLAG%) &
\ VALUE%=VALUE% OR ARG1.VALUE%
3240 IF SECOND.ARG.TYPE%<4% THEN VALUE%=VALUE% OR ARG2.VALUE% &
! -- Assemble the bytes for this instruction
3250 GOSUB 3540
3260 IF SHIFT.ARG.FLAG%=1% THEN GOSUB 3330 &
\ GOSUB 3560 &
\ GOSUB 3630 &
\ RETURN
3270 IF SECOND.ARG.TYPE%=4% THEN FIRST.ARG.TYPE%=4% &
\ ARG1.VALUE%=ARG2.VALUE%
3280 IF FIRST.ARG.TYPE%=4% THEN VALUE%=ARG1.VALUE% &
\ GOSUB 3560 &
\ GOSUB 3630 &
\ RETURN
3290 IF SECOND.ARG.TYPE%=5% THEN FIRST.ARG.TYPE%=6% &
\ ARG1.VALUE%=ARG2.VALUE%
3300 IF FIRST.ARG.TYPE%=6% THEN VALUE%=ARG1.VALUE% &
\ GOSUB 3560 &
\ VALUE%=SWAP%(ARG1.VALUE%) &
\ GOSUB 3580
3310 GOSUB 3630 &
\ RETURN
3320 ! -- Z80 relative branches
3330 VALUE%=ARG1.VALUE%-LOCATION.COUNTER%-2% &
\ IF VALUE%<-128% OR VALUE%>127% THEN &
VALUE%=FNERROR.PRINT%("Invalid displacement ="+NUM$(VALUE%))
3340 RETURN
3350 ! &
3360 &
! -- Pseudo-ops. -- &
3370 ON FLAGS%(OPCODE.TABLE.SUBSCRIPT%)-9% &
GOTO 3490, 3390, 3390, 3390, &
3450, 3450, 3450, 3490, &
3510 &
! .END .BYTE .DBYTE .WORD &
! .ASCII .ASCIP .ASCIZ .LIST &
! .BLKB
3380 ! -- .BYTE, .DBYTE, .WORD --
3390 ARGUMENT$=ARGUMENT$+"," &
\ TEMP3%=1% &
\ TEMP3%=2% IF FLAGS%(OPCODE.TABLE.SUBSCRIPT%)=12% &
OR FLAGS%(OPCODE.TABLE.SUBSCRIPT%)=13% &
\ FOR I%=1% TO BYTE.COUNT% STEP TEMP3% &
\ ADDRESS$=FNDEC.TO.HEX$(LOCATION.COUNTER%+I%-1%,0%) &
\ TEMP1%=INSTR(1%,ARGUMENT$,",")
3400 TEMP2%=FNEVALUATE.EXPR%(LEFT(ARGUMENT$,TEMP1%-1%)) &
\ IF FLAGS%(OPCODE.TABLE.SUBSCRIPT%)=12% THEN &
VALUE%=SWAP%(TEMP2%) &
\ GOSUB 3540 &
\ VALUE%=TEMP2% &
\ GOSUB 3560
3410 IF FLAGS%(OPCODE.TABLE.SUBSCRIPT%)=13% THEN &
VALUE%=TEMP2% &
\ GOSUB 3540 &
\ VALUE%=SWAP%(TEMP2%) &
\ GOSUB 3560
3420 IF FLAGS%(OPCODE.TABLE.SUBSCRIPT%)=11% THEN &
VALUE%=TEMP2% &
\ GOSUB 3540
3430 GOSUB 3630 &
\ ARGUMENT$=RIGHT(ARGUMENT$,TEMP1%+1%) &
\ NEXT I% &
\ RETURN
3440 ! -- .ASCII, .ASCIP, .ASCIZ --
3450 ARGUMENT$=MID(ARGUMENT$,2%,BYTE.COUNT%) &
\ ARGUMENT$=LEFT(ARGUMENT$,BYTE.COUNT%-1%)+CHR$(0%) &
IF FLAGS%(OPCODE.TABLE.SUBSCRIPT%)=16% &
\ FOR I%=1% TO BYTE.COUNT% STEP 3% &
\ ADDRESS$=FNDEC.TO.HEX$(LOCATION.COUNTER%+I%-1%,0%) &
\ VALUE%=FNCHAR%(I%) &
\ GOSUB 3540 &
\ VALUE%=FNCHAR%(I%+1%) &
\ GOSUB 3560 IF I%+1%<=BYTE.COUNT% &
\ VALUE%=FNCHAR%(I%+2%) &
\ GOSUB 3580 IF I%+2%<=BYTE.COUNT% &
\ GOSUB 3630 &
\ NEXT I% &
\ RETURN
3460 ! -- Get character J% from ARGUMENT$
3470 DEF* FNCHAR%(J%) &
\ CHAR%=ASCII(MID(ARGUMENT$,J%,1%)) &
\ CHAR%=CHAR% OR 128% IF FLAGS%(OPCODE.TABLE.SUBSCRIPT%)=15% &
AND J%=BYTE.COUNT% &
\ FNCHAR%=CHAR% &
\ FNEND &
3480 ! -- .LIST --
3490 LIST.FLAG%=FNEVALUATE.EXPR%(ARGUMENT$) &
\ ADDRESS$="" &
\ RETURN
3500 ! -- .BLKB
3510 TEMP1%=FNEVALUATE.EXPR%(ARGUMENT$) &
\ IF OBJECT.OUT.FLAG% THEN VALUE%=0% &
\ FOR X%=1% TO TEMP1% &
\ GOSUB 3610 &
\ NEXT X%
3520 GOSUB 3630 &
\ RETURN
3530 &
! -- Form B1 -- &
3540 BYTE1$=FNDEC.TO.HEX$(VALUE%,3%) &
\ GOSUB 3610 &
\ RETURN
3550 &
! -- Form B2 -- &
3560 BYTE2$=FNDEC.TO.HEX$(VALUE%,3%) &
\ GOSUB 3610 &
\ RETURN
3570 &
! -- Form B3 -- &
3580 BYTE3$=FNDEC.TO.HEX$(VALUE%,3%) &
\ GOSUB 3610 &
\ RETURN
3590 ! &
3600 &
! -- Output object and update checksum -- &
3610 OBJECT.BYTE%=VALUE% AND 255% &
\ OBJECT.BYTE%=FNOBJECT.OUTPUT%(VALUE%) IF OBJECT.OUT.FLAG% &
\ CHECKSUM%=CHECKSUM%+OBJECT.BYTE% &
\ RETURN
3620 &
! -- Output assembled code to listing file -- &
3630 GOTO 3680 UNLESS ERRORS.ONLY.SWITCH% OR ERROR.LINE.FLAG%
3640 IF ERROR.LINE.FLAG% THEN PRINT #1%,"?"; ELSE PRINT #1%," ";
3650 IF NEW.LINE.FLAG%<LINE.NUMBER% THEN &
PRINT #1% USING "#### ",LINE.NUMBER%; &
ELSE PRINT #1%," ";
3660 PRINT #1% USING"\ \ \\ \\ \\",ADDRESS$,BYTE1$,BYTE2$,BYTE3$; &
\ IF LIST.FLAG% AND SOURCE.LINE$<>"" THEN &
PRINT #1%,CHR$(9%);SOURCE.LINE$ &
ELSE PRINT #1%
3670 ! -- Set a flag, clear output strings --
3680 NEW.LINE.FLAG%=LINE.NUMBER% &
\ ADDRESS$,BYTE1$,BYTE2$,BYTE3$,SOURCE.LINE$="" &
\ RETURN
3690 &
! -- Output binary byte to object file -- &
3700 DEF* FNOBJECT.OUTPUT%(X%) &
\ OBJECT.BYTE%=X% AND 255% &
\ PRINT #4%,FNDEC.TO.HEX$(OBJECT.BYTE%,3%); &
\ NEW.OBJ.LINE%=NEW.OBJ.LINE%+1% &
\ PRINT #4% IF (NEW.OBJ.LINE% AND 15%)=0% &
\ FNOBJECT.OUTPUT%=OBJECT.BYTE% &
\ FNEND
3710 &
! -- Print error count, checksum -- &
3720 PRINT #X% &
\ PRINT #X%,"Errors detected ";FNDEC.TO.HEX$(ERROR.COUNT%,0%) &
\ PRINT #X%,"Source checksum ";FNDEC.TO.HEX$(CHECKSUM%,0%) &
\ PRINT #X%,"Total hex bytes ";FNDEC.TO.HEX$(TOTAL.BYTES%,0%) &
\ PRINT #X% &
\ RETURN
3730 ! &
3740 &
! -- Print sorted symbol table -- &
3750 TEMP1%,TEMP2%=0% &
\ NUMBER.OF.SYMBOLS%=NUMBER.OF.SYMBOLS%-111% &
\ RETURN IF NUMBER.OF.SYMBOLS%<0%
3760 PRINT #1%," Symbol Table" &
\ PRINT #1%
3770 TEMP1%=TEMP1%+1% WHILE FLAGS%(TEMP1%)>=0% &
\ SYMBOLS$(TEMP2%)=SYMBOLS$(TEMP1%) &
\ VALUES%(TEMP2%)=VALUES%(TEMP1%) &
\ FLAGS%(TEMP2%)=FLAGS%(TEMP1%) &
\ TEMP2%=TEMP2%+1% &
\ TEMP1%=TEMP1%+1% &
\ GOTO 3770 UNLESS TEMP2%=NUMBER.OF.SYMBOLS%+1%
3780 ! -- Quick sort the symbol table
3790 TEMP1%=FNQUICKSORT%(0%,NUMBER.OF.SYMBOLS%,0%,NUMBER.OF.SYMBOLS%)
3800 ! -- Output to listing file --
3810 FOR I%=0% TO NUMBER.OF.SYMBOLS% &
\ IF FLAGS%(I%)=-1% THEN S$="#" ELSE S$=" "
3820 PRINT #1% USING " \ \ \ \ ", &
SYMBOLS$(I%),FNDEC.TO.HEX$(VALUES%(I%),0%)+S$; &
\ PRINT #1% IF CCPOS(1%)>63% &
\ NEXT I%
3830 PRINT #1% IF CCPOS(1%) &
\ RETURN
3840 &
! -- Check position of char X% in SOURCE.LINE$ using tables &
! -- DELIMITER%(). FNCHECK.SYNTAX%=-1% means in string &
3850 DEF* FNCHECK.SYNTAX%(X%)
3860 GOTO 3880 IF DELIMITER%=-1% OR X%=0% &
\ FOR X0%=0% TO DELIMITER% &
\ GOTO 3880 IF X%<(SWAP%(DELIMITER.TABLE%(X0%)) AND 255%) &
\ IF X%<(DELIMITER.TABLE%(X0%) AND 255%) THEN &
FNCHECK.SYNTAX%=-1% &
\ GOTO 3890
3870 NEXT X0%
3880 FNCHECK.SYNTAX%=0%
3890 FNEND
3900 ! &
4000 &
! -- Evaluate the argument expression -- &
4010 DEF* FNEVALUATE.EXPR%(X$)
4020 &
! -- Main driver routine -- &
4030 EXPR$=X$ &
\ GOSUB 4060 &
\ GOSUB 4080 &
\ EXP.VAL%=TERM%
4040 GOTO 4290 UNLESS OP% &
\ LAST.OP%=OP% &
\ GOSUB 4060 &
\ GOSUB 4080 &
\ GOSUB 4190 &
\ GOTO 4040
4050 &
REM ! -- Scan for the next operator { ! & % + * - / } -- &
4060 EXP.FLAG%=-1% &
\ FOR TOK.PTR%=1% TO LEN(EXPR$) &
\ TOK.CHR$=MID(EXPR$,TOK.PTR%,1%) &
\ EXP.FLAG%= NOT EXP.FLAG% IF TOK.CHR$="'" &
\ OP%=INSTR(1%,"!%&*+-/",TOK.CHR$) &
\ RETURN IF OP% AND EXP.FLAG% &
\ NEXT TOK.PTR% &
\ OP%=0% &
\ TOK.PTR%=TOK.PTR%+1% &
\ RETURN
4070 &
! -- Get value of term -- &
4080 TERM$=LEFT(EXPR$,TOK.PTR%-1%) &
\ EXPR$=RIGHT(EXPR$,TOK.PTR%+1%)
4090 IF TERM$="" THEN TERM%=0% &
\ RETURN
4100 ! -- H() or L() ? --
4110 TEMP1$=LEFT(TERM$,2%) &
\ IF TEMP1$="H(" THEN EXP.FLAG%=1% &
ELSE IF TEMP1$="L(" THEN EXP.FLAG%=2% &
ELSE EXP.FLAG%=0%
4120 IF EXP.FLAG% THEN IF RIGHT(TERM$,LEN(TERM$))=")" THEN &
TERM$=MID(TERM$,3%,LEN(TERM$)-3%) &
ELSE 4170
4130 TEMP1$=LEFT(TERM$,1%)
4140 IF TEMP1$>="A" AND TEMP1$<="Z" THEN TERM%=FNSYMBOL.LOOKUP%(TERM$) &
ELSE IF TEMP1$="0" THEN TERM%=FNHEX.TO.DEC%(RIGHT(TERM$,2%)) &
ELSE IF TEMP1$>="1" AND TEMP1$<="9" THEN TERM%=VAL(TERM$) &
ELSE IF TEMP1$="'" THEN TERM%=ASCII(RIGHT(TERM$,2%)) &
ELSE IF TEMP1$="^" THEN TERM%=FNOCT.TO.DEC%(RIGHT(TERM$,2%)) &
ELSE IF TERM$="." THEN TERM%=LOCATION.COUNTER% &
ELSE 4170
4150 IF EXP.FLAG%=1% THEN TERM%=SWAP%(TERM%) AND 255% &
ELSE IF EXP.FLAG%=2% THEN TERM%=TERM% AND 255%
4160 RETURN
4170 TERM%=FNERROR.PRINT%("Invalid term = "+TERM$) &
\ RETURN
4180 &
! -- Carry out the arithmetic or logical operation -- &
4190 ON LAST.OP%+1% &
GOTO 4270, 4200, 4210, 4220, &
4230, 4240, 4250, 4260 &
! or not and &
! mult add sub div
4200 EXP.VAL%=EXP.VAL% OR TERM% &
\ RETURN &
! or
4210 EXP.VAL%=EXP.VAL%+(NOT TERM%) &
\ RETURN &
! not
4220 EXP.VAL%=EXP.VAL% AND TERM% &
\ RETURN &
! and
4230 EXP.VAL%=EXP.VAL%*TERM% &
\ RETURN &
! multiply
4240 EXP.VAL%=EXP.VAL%+TERM% &
\ RETURN &
! add
4250 EXP.VAL%=EXP.VAL%-TERM% &
\ RETURN &
! subtract
4260 IF TERM%=0% THEN EXP.VAL%=FNERROR.PRINT%("Division by zero") &
ELSE EXP.VAL%=EXP.VAL%/TERM%
4270 RETURN
4280 &
! -- Exit with value of expression -- &
4290 FNEVALUATE.EXPR%=EXP.VAL%
4300 FNEND
4310 &
! -- Find value of argument of the type TYPE% &
4320 DEF* FNEVALUATE.ARGUMENT%(X$,TYPE%) &
\ EXP.VAL%=FNEVALUATE.EXPR%(X$)
4330 IF TYPE%=1% AND (EXP.VAL%<0% OR EXP.VAL%>7%) THEN &
EXP.VAL%=FNERROR.PRINT%("Invalid register id") &
ELSE IF (TYPE%=2% AND EXP.VAL% AND 4%) OR &
(TYPE%=3% AND EXP.VAL%>1%) THEN &
EXP.VAL%=FNERROR.PRINT%("Invalid register pair") &
ELSE IF TYPE%=7% AND (EXP.VAL%<0% OR EXP.VAL%>7%) &
THEN EXP.VAL%=FNERROR.PRINT%("Invalid RST vector")
4340 FNEVALUATE.ARGUMENT%=EXP.VAL% &
\ FNEND
4350 ! &
4360 &
! -- Print the given error message to the listing file &
4370 DEF* FNERROR.PRINT%(X$) &
\ PRINT #1%,"********";X$; &
\ IF PASS.NUMBER%=1% THEN PRINT #1%," at line";LINE.NUMBER% &
ELSE PRINT #1%
4380 ERROR.COUNT%=ERROR.COUNT%+1% &
\ ERROR.LINE.FLAG%=-1% &
\ FNERROR.PRINT%=0% &
\ FNEND
4390 &
! -- Look up value of symbol -- &
4400 DEF* FNSYMBOL.LOOKUP%(SYMBOL$) &
\ X%=FNHASH.SYMBOL%(SYMBOL$,SYMBOL.TABLE.SIZE%)
4410 IF SYMBOLS$(X%)=SYMBOL$ AND FLAGS%(X%)<=0% THEN &
FNSYMBOL.LOOKUP%=VALUES%(X%) &
ELSE IF SYMBOLS$(X%)="" THEN FNSYMBOL.LOOKUP%= &
FNERROR.PRINT%("Undefined symbol = "+SYMBOL$) &
ELSE X%=FNREHASH.SYMBOL%(X%,SYMBOL.TABLE.SIZE%) &
\ GOTO 4410
4420 FNEND
4430 &
! -- Dec to Hex conversion -- &
4440 DEF* FNDEC.TO.HEX$(X%,D%)
4450 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%)
4460 FNDEC.TO.HEX$=X$
4470 FNEND
4480 &
! -- Hex to Dec conversion -- &
4490 DEF* FNHEX.TO.DEC%(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 &
FNHEX.TO.DEC%=FNERROR.PRINT%("Invalid HEX constant = "+X$) &
\ GOTO 4510
4500 X2%=X2%-48% &
\ X2%=X2%-7% IF X2%>9% &
\ X0%=X2%+X0%*16% &
\ NEXT X1% &
\ FNHEX.TO.DEC%=X0%
4510 FNEND
4520 &
! -- Octal to Dec conversion -- &
4530 DEF* FNOCT.TO.DEC%(X$) &
\ X0%=0% &
\ FOR X1%=1% TO LEN(X$) &
\ X2%=ASCII(MID(X$,X1%,1%))-48% &
\ IF X2%<0% OR X2%>7% THEN &
FNOCT.TO.DEC%=FNERROR.PRINT%("Invalid OCTAL constant = "+X$) &
\ GOTO 4550
4540 X0%=X0%*8% + X2% &
\ NEXT X1% &
\ FNOCT.TO.DEC%=X0%
4550 FNEND
4560 &
! -- Calculate X1% modulo X2% -- &
4570 DEF* FNMOD%(X1%,X2%) &
\ X1%=X1%-(X1%/X2%)*X2% &
\ X1%=X1%+X2% IF X1%<0% &
\ FNMOD%=X1% &
\ FNEND
4580 &
! -- Hash symbol X$, modulo SYMBOL.TABLE.SIZE% -- &
4590 DEF* FNHASH.SYMBOL%(SYMBOL$,M%) &
\ SYMBOL$=LEFT(SYMBOL$+" ",6%) &
\ CHANGE SYMBOL$ TO SYMBOL.CHARS% &
\ SYMBOL.CHARS%(X%)=SYMBOL.CHARS%(X%)-48% FOR X%=1% TO 6% &
\ FNHASH.SYMBOL%=FNMOD%(SYMBOL.CHARS%(1%)*23%+ &
SYMBOL.CHARS%(2%)*19%+SYMBOL.CHARS%(3%)*17%+ &
SYMBOL.CHARS%(4%)*13%+SYMBOL.CHARS%(5%)*11%+ &
SYMBOL.CHARS%(6%)*7%,M%) &
\ FNEND
4600 &
! -- Rehash function, modulo X2% &
4610 DEF* FNREHASH.SYMBOL%(X1%,X2%)=FNMOD%(X1%+23%,X2%)
4620 &
! -- Quick sort symbol table &
4630 DEF* FNQUICKSORT%(LOW%,HIGH%,I%,J%) &
\ I%=LOW% &
\ J%=HIGH% &
\ X$=SYMBOLS$((HIGH%+LOW%)/2%)
4640 I%=I%+1% WHILE SYMBOLS$(I%)<X$
4650 J%=J%-1% WHILE X$<SYMBOLS$(J%)
4660 IF I%>J% THEN 4680 &
ELSE IF I%<>J% THEN VALUE%=VALUES%(I%) &
\ FLAG.WORD%=FLAGS%(I%) &
\ SYMBOL$=SYMBOLS$(I%) &
\ VALUES%(I%)=VALUES%(J%) &
\ FLAGS%(I%)=FLAGS%(J%) &
\ SYMBOLS$(I%)=SYMBOLS$(J%) &
\ VALUES%(J%)=VALUE% &
\ FLAGS%(J%)=FLAG.WORD% &
\ SYMBOLS$(J%)=SYMBOL$
4670 I%=I%+1% &
\ J%=J%-1% &
\ IF I%<=J% THEN 4640
4680 IF LOW%<J% THEN TEMP1%=FNQUICKSORT%(LOW%,J%,LOW%,J%)
4690 IF I%<HIGH% THEN TEMP1%=FNQUICKSORT%(I%,HIGH%,I%,HIGH%)
4700 FNQUICKSORT%=-1% &
\ FNEND
4710 ! &
30000 &
! CCL Entry point &
30010 SOURCE.FILE$=CVT$$(SYS(CHR$(7%)),188%) &
\ I%=INSTR(1%,SOURCE.FILE$,"X80") &
\ IF I% THEN SOURCE.FILE$=RIGHT(SOURCE.FILE$,4%) &
ELSE PRINT "?X80 - Illegal entry" &
\ GOTO 32767
30020 IF SOURCE.FILE$<>"" THEN CCL.ENTRY%=-1% ELSE CCL.ENTRY%=0%
30030 GOTO 1070
30999 ! &
31000 &
! -- Error routine -- &
31010 ! -- No ".END" --
31020 IF ERR=11% AND ERL=2020% THEN OPCODE.TABLE.SUBSCRIPT%= &
FNERROR.PRINT%("Missing .END")+ &
FNHASH.SYMBOL%(".END",SYMBOL.TABLE.SIZE%) &
\ SOURCE.LINE$="" &
\ RESUME 2150
31030 IF ERR=11% AND ERL=3040% THEN SOURCE.LINE$="" &
\ OPCODE.TABLE.SUBSCRIPT%=FNHASH.SYMBOL%(".END", &
SYMBOL.TABLE.SIZE%) &
\ RESUME 3080
31040 ! -- ^Z at filename request --
31050 RESUME 32767 IF ERL=1160%
31060 ! -- Illegal number in FNEVALUATE.EXPR%() --
31070 IF ERR=51% AND ERL=4140% THEN X0%=VAL(TERM$)-65536 &
\ RESUME 4150
31080 RESUME 4170 IF ERR=52% AND ERL=4140%
31090 CLOSE 1%,2%,3%,4% &
\ RESUME 32767% IF ERR=28%
31100 ! -- Print any unanticipated error --
31110 ON ERROR GOTO 0
31999 ! &
32000 &
! -- Opcode data &
32010 ! Table is of the form: &
! SYMBOL,value,byte count &
! where: the low byte of value is the opcode base &
! and the high byte a flag consisting of &
! bits 15,14 a shift flag 0=none,2=four,3=three &
! bits 13-11,10-8 are arg2, arg1 types &
! 0-none, 1-register, 2-register pair, &
! 3-limited register pair, 4-data byte, &
! 5-data word, 6-address and 7-for RST
32020 DATA .END, 0, 10, .BYTE, 0, 11, &
.DBYTE, 0, 12, .WORD, 0, 13, &
.ASCII, 0, 14, .ASCIP, 0, 15, &
.ASCIZ, 0, 16, .LIST, 0, 17, &
.BLKB, 0, 18
32030 DATA CALL, 1741, 3, CC, 1756, 3, &
CM, 1788, 3, CNC, 1748, 3, &
CNZ, 1732, 3, CP, 1780, 3, &
CPE, 1772, 3, CPO, 1764, 3, &
CZ, 1740, 3
32040 DATA JC, 1754, 3, JM, 1786, 3, &
JMP, 1731, 3, JNC, 1746, 3, &
JNZ, 1730, 3, JP, 1778, 3, &
JPE, 1770, 3, JPO, 1762, 3, &
JZ, 1738, 3
32050 DATA LDA, 1594, 3, LHLD, 1578, 3, &
SHLD, 1570, 3, STA, 1586, 3, &
LXI, -22015, 3
32060 DATA ACI, 1230, 2, ADI, 1222, 2, &
ANI, 1254, 2, CPI, 1278, 2, &
ORI, 1270, 2, SBI, 1246, 2, &
SUI, 1238, 2, XRI, 1262, 2, &
IN, 1243, 2, OUT, 1235, 2, &
MVI, -7930, 2
32070 DATA DJNZ, 17936, 2, JR, 17944, 2, &
JRNZ, 17952, 2, JRZ, 17960, 2, &
JRNC, 17968, 2, JRC, 17976, 2
32080 DATA ADC, 392, 1, ADD, 384, 1, &
ANA, 416, 1, CMP, 440, 1, &
ORA, 432, 1, SBB, 408, 1, &
SUB, 400, 1, XRA, 424, 1, &
DAD, -32247, 1, DCX, -32245, 1, &
INX, -32253, 1, POP, -32063, 1, &
PUSH, -32059, 1
32090 DATA DCR, -16123, 1, INR, -16124, 1, &
LDAX, -31990, 1, STAX, -31998, 1, &
MOV, -14016, 1, RST, -14393, 1
32100 DATA CMA, 47, 1, CMC, 63, 1, &
DAA, 39, 1, EI, 251, 1, &
HLT, 118, 1, NOP, 0, 1, &
DI, 243, 1, PCHL, 233, 1, &
RAL, 23, 1, RAR, 31, 1, &
RC, 216, 1, RET, 201, 1, &
RLC, 7, 1, RM, 248, 1, &
RNC, 208, 1, RNZ, 192, 1, &
RP, 240, 1, RPE, 232, 1, &
RPO, 224, 1, RRC, 15, 1, &
RZ, 200, 1, SPHL, 249, 1, &
STC, 55, 1, XCHG, 235, 1, &
XTHL, 227, 1
32110 DATA RIM, 32, 1, SIM, 48, 1, &
EXX, 217, 1, EXAF, 8, 1
32120 !--Register symbol definitions
32130 DATA B, 0, C, 1, D, 2, &
E, 3, H, 4, L, 5, &
M, 6, A, 7, BC, 0, &
DE, 1, HL, 2, SP, 3, &
PSW, 3
32767 END
Reference in New Issue View Git Blame Copy Permalink