PROGRAM Asm6502; { Quickie 6502 assembler v1.4 } { Copyright February 1998 Bruce Tomlin } { 1.4 fixes and enhancements: Added FCC pseudo-op Lines beginning with "*" are now comments Jump indirect wouldn't work correctly if the line had a comment No error was generated if too many macro parameters were used Maximum macro parameters increased from 5 to 10 Lines from macro expansions with errors are now displayed Symbol table is now displayed with more than one column Lines that generate more than 3 bytes are flagged with a "+" } {R-} {$M 16384,0,655360} CONST maxSymLen = 16; { maximum symbol length } maxOpcdLen = 5; { maximum opcode length } maxMacParms = 10; { maximum macro parameters } symTabCols = 3; { number of columns for symbol table dump } (* alphaNumeric = '1234567890@ABCDEFGHIJKLMNOPQRSTUVWXYZ_'; alpha = '@ABCDEFGHIJKLMNOPQRSTUVWXYZ_'; numeric = '1234567890'; *) hex = '0123456789ABCDEF'; white = #9' '; { A tab plus a space } alpha = ['A'..'Z','a'..'z','@','_']; numeric = ['0'..'9']; alphaNumeric = alpha + numeric; comment = ';'; o_Illegal = 0; { opcode not found in FindOpcode } o_Implied = 1; { implied instructions } o_Branch = 2; { branch instructions } o_Mode = 3; { instructions with multiple addressing modes } o_DB = 4; { DB pseudo-op } o_DW = 5; { DW pseudo-op } o_DS = 6; { DS pseudo-op } o_EQU = -7; { EQU and SET pseudo-ops } o_ORG = -8; { ORG pseudo-op } o_RORG = -9; { RORG pseudo-op } o_END = 10; { END pseudo-op } o_LIST = -11; { LIST pseudo-op } o_OPT = -12; { OPT pseudo-op } o_MACRO = -13; { MACRO pseudo-op } o_ENDM = 14; { ENDM pseudo-op } o_MacName = 15; { Macro name } o_FCC = 16; { FCC pseudo-op } a_None = 0; { addressing mode invalid } a_Imm = 1; { Immediate #val } a_Abs = 3; { Absolute val } a_Zpg = 5; { Z-Page val } a_Acc = 7; { Accumulator A or no operand } a_Inx = 9; { Indirect X (val,X) } a_Iny = 11; { Indirect Y (val),Y } a_Zpx = 13; { Z-Page X val,X } a_Abx = 15; { Absolute X val,X } a_Aby = 17; { Absolute Y val,Y } a_Ind = 19; { Indirect [val] Jmp only } a_Zpy = 21; { Z-Page Y val,Y LDX & STX only } TYPE SymStr = String[maxSymLen]; SymPtr = ^SymRec; SymRec = RECORD name: SymStr; { Symbol name } defined: Boolean; { TRUE if defined } value: Integer; { Symbol value } next: SymPtr; { Pointer to next symtab entry } multiDef: Boolean; { TRUE if multiply defined } isSet: Boolean; { TRUE if defined with SET pseudo } equ: Boolean; { TRUE if defined with EQU pseudo } known: Boolean; { TRUE if symbol was defined earlier } END; MacroLinePtr = ^MacroLine; MacroLine = RECORD next: MacroLinePtr; text: String; END; MacroParmPtr = ^MacroParm; MacroParm = RECORD next: MacroParmPtr; name: SymStr; END; MacroPtr = ^MacroRec; MacroRec = RECORD name: SymStr; { Macro name } def: Boolean; { TRUE after macro is defined in pass 2 } text: MacroLinePtr; { Macro text } next: MacroPtr; { Pointer to next macro } parms: MacroParmPtr; { Macro parms } nparms: Integer; { Number of macro parameters } END; OpcdStr = String[maxOpcdLen]; ModeStr = String[22]; OpcdPtr = ^OpcdRec; OpcdRec = RECORD name: OpcdStr; { Opcode name } mode: ModeStr; { Addressing modes } typ: Integer; { Opcode type } parm: Integer; { Opcode parameter } next: OpcdPtr; { Pointer to next opcode entry } END; VAR symTab: SymPtr; { Pointer to first entry in symtab } opcdTab: OpcdPtr; { Opcode table } macroTab: MacroPtr; { Macro table } macPtr: MacroPtr; { current macro in use } macLine: MacroLinePtr; { current macro text pointer } macParms: ARRAY[1..maxMacParms] OF String; lastLabl: SymStr; { last label for @ temps } locPtr: Word; { Current program address } codPtr: Word; { Current program "real" address } outPtr: Word; { Current code output file address } updLoc: Boolean; { TRUE if codPtr needs to be written to file } errFlag: Boolean; { TRUE if error occurred this line } pass: Integer; { Current assembler pass } errCount: Integer; { Total number of errors } line: String; { Current line from input file } listLine: String; { Current listing line } listFlag: Boolean; { FALSE to suppress listing source } listMacFlag: Boolean; { FALSE to suppress showing macro expansions } macLineFlag: Boolean; { TRUE if line came from a macro } listThisLine: Boolean; { TRUE to force listing this line } sourceEnd: Boolean; { TRUE when END pseudo encountered } instr: ARRAY[1..3] OF Integer; { Current instruction word } instrLen: Integer; { Current instruction length } bytStr: String; { Buffer for long DB statements } showAddr: Boolean; { TRUE to show LocPtr on listing } xferAddr: Word; { Transfer address from END pseudo } xferFound: Boolean; { TRUE if xfer addr defined w/ END } evalKnown: Boolean; { TRUE if all operands in Eval were "known" } { Command line parameters } cl_SrcName: String; { Source file name } cl_ListName: String; { Listing file name } cl_ObjName: String; { Object file name } cl_Err: Boolean; { TRUE for errors to screen } source: Text; object: Text; listing: Text; PROCEDURE Debleft(VAR s: String); VAR i: Integer; BEGIN i := 1; WHILE (i<=Length(s)) AND (s[i] IN [#9,' ']) DO Inc(i); Delete(s,1,i-1); END; PROCEDURE Debright(VAR s: String); VAR i: Integer; BEGIN i := Length(s); WHILE (i>0) AND (s[i] IN [#9,' ']) DO Dec(i); s[0] := CHR(i); END; FUNCTION Deblank(s: String): String; VAR i: Integer; BEGIN Debright(s); Debleft(s); Deblank := s; END; PROCEDURE StAppendCh(VAR s: String; ch: Char); BEGIN IF Length(s)<>255 THEN BEGIN s[0] := CHR(Length(s)+1); s[Length(s)] := ch; END; END; FUNCTION UprCase(s: String): String; VAR i: Integer; BEGIN FOR i := 1 TO Length(s) DO IF s[i] IN ['a'..'z'] THEN s[i] := UpCase(s[i]); UprCase := s; END; FUNCTION Hex2(i: Word): String; BEGIN i := i AND 255; Hex2 := Copy(hex,(i SHR 4)+1,1) + Copy(hex,(i AND 15)+1,1); END; FUNCTION Hex4(i: Word): String; BEGIN Hex4 := Hex2(i SHR 8) + Hex2(i AND 255); END; PROCEDURE Error(message: String); BEGIN errFlag := TRUE; Inc(errCount); IF pass<>1 THEN BEGIN listThisLine := TRUE; WriteLn(listing,'*** Error: ',Message,' ***'); IF cl_Err THEN WriteLn('*** Error: ',Message,' ***'); END; END; PROCEDURE AddMacro(name: SymStr; VAR macro: MacroPtr); BEGIN New(macro); macro^.name := name; macro^.def := FALSE; macro^.text := NIL; macro^.next := macroTab; macro^.parms := NIL; macro^.nparms := 0; macroTab := macro; END; PROCEDURE AddMacroParm(macro: MacroPtr; name: String); VAR parm : MacroParmPtr; p : MacroParmPtr; BEGIN New(parm); parm^.next := NIL; parm^.name := UprCase(name); macro^.nparms := macro^.nparms + 1; p := macro^.parms; IF p=NIL THEN macro^.parms := parm ELSE BEGIN WHILE p^.next<>NIL DO p := p^.next; p^.next := parm; END; END; PROCEDURE GetMacParms(macro: MacroPtr); VAR i : Integer; n : Integer; p : Integer; s : String; done : Boolean; parm : MacroParmPtr; BEGIN FOR i := 1 TO maxMacParms DO macParms[i] := ''; n := 0; done := FALSE; REPEAT i := 1; WHILE (i<=Length(line)) AND (line[i]<>comment) AND (line[i]<>',') DO BEGIN IF line[i]='''' THEN BEGIN i := i + 1; WHILE (i<=Length(line)) AND (line[i]<>'''') DO i := i + 1; END; i := i + 1; END; IF line[i]=comment THEN done := TRUE; IF i<>1 THEN BEGIN n := n + 1; IF n<=maxMacParms THEN macParms[n] := Copy(line,1,i-1); Delete(line,1,i); END; UNTIL done OR (Length(line)=0) {OR (n=maxMacparms)}; IF (n>macro^.nparms) OR (n>maxMacParms) THEN Error('Too many macro parameters'); FOR i := 1 TO n DO macParms[i] := Deblank(macParms[i]); line := ''; END; PROCEDURE DoMacParms; VAR i : Integer; j : Integer; n : Integer; word : String; parm : MacroParmPtr; BEGIN i := 1; WHILE (i<=Length(line)) DO BEGIN { look for an alpha character } WHILE (i<=Length(line)) AND NOT (line[i] IN alpha) DO i := i + 1; IF i<=Length(line) THEN BEGIN { now look for the end of the alpha string } j := i; WHILE (j<=Length(line)) AND (line[j] IN alphaNumeric) DO j := j + 1; word := Uprcase(Copy(line,i,j-i)); { find out if it matches any macro parms } parm := macPtr^.parms; n := 1; WHILE (parm<>NIL) AND (parm^.name<>word) DO BEGIN parm := parm^.next; n := n + 1; END; { if we had a match, replace it } IF (parm<>NIL) AND (n<=maxMacParms) THEN BEGIN Delete(line,i,j-i); Insert(macParms[n],line,i); i := i + Length(macParms[n]); END ELSE i := j; END; END; END; PROCEDURE AddMacroLine(macro: MacroPtr; line: String); VAR m: MacroLinePtr; p: MacroLinePtr; BEGIN GetMem(m,SizeOf(MacroLine) - 255 + Length(line)); m^.next := NIL; Move(line,m^.text,Length(line) + 1); p := macro^.text; IF p=NIL THEN macro^.text := m ELSE BEGIN WHILE p^.next<>NIL DO p := p^.next; p^.next := m; END; END; PROCEDURE FindMacro(name: SymStr; VAR macro: MacroPtr); VAR found: Boolean; BEGIN macro := macroTab; found := FALSE; WHILE (macro<>NIL) AND NOT found DO BEGIN found := (macro^.name = name); IF NOT found THEN macro := macro^.next; END; END; PROCEDURE AddOpcode(name: OpcdStr; mode: ModeStr; typ,parm: Integer); VAR p: OpcdPtr; BEGIN New(p); p^.name := name; p^.mode := mode; p^.typ := typ; p^.parm := parm; p^.next := opcdTab; opcdTab := p; END; PROCEDURE FindOpcode(name: String; VAR typ,parm: Integer; VAR mode: ModeStr; VAR macro: MacroPtr); VAR p: OpcdPtr; found: Boolean; BEGIN macro := NIL; found := FALSE; p := opcdTab; WHILE (p<>NIL) AND NOT found DO BEGIN found := (p^.name = name); IF NOT found THEN p := p^.next; END; IF NOT found THEN BEGIN typ := o_Illegal; parm := 0; mode := ''; FindMacro(name,macro); IF macro<>NIL THEN typ := o_MacName; END ELSE BEGIN typ := p^.typ; parm := p^.parm; mode := p^.mode; END; END; PROCEDURE InitOpcodes; BEGIN opcdTab := NIL; AddOpcode('BRK','',o_Implied,$00); AddOpcode('PHP','',o_Implied,$08); AddOpcode('CLC','',o_Implied,$18); AddOpcode('PLP','',o_Implied,$28); AddOpcode('SEC','',o_Implied,$38); AddOpcode('RTI','',o_Implied,$40); AddOpcode('PHA','',o_Implied,$48); AddOpcode('CLI','',o_Implied,$58); AddOpcode('RTS','',o_Implied,$60); AddOpcode('PLA','',o_Implied,$68); AddOpcode('SEI','',o_Implied,$78); AddOpcode('DEY','',o_Implied,$88); AddOpcode('TXA','',o_Implied,$8A); AddOpcode('TYA','',o_Implied,$98); AddOpcode('TXS','',o_Implied,$9A); AddOpcode('TAY','',o_Implied,$A8); AddOpcode('TAX','',o_Implied,$AA); AddOpcode('CLV','',o_Implied,$B8); AddOpcode('TSX','',o_Implied,$BA); AddOpcode('INY','',o_Implied,$C8); AddOpcode('DEX','',o_Implied,$CA); AddOpcode('CLD','',o_Implied,$D8); AddOpcode('INX','',o_Implied,$E8); AddOpcode('NOP','',o_Implied,$EA); AddOpcode('SED','',o_Implied,$F8); AddOpcode('ASLA','',o_Implied,$0A); AddOpcode('ROLA','',o_Implied,$2A); AddOpcode('LSRA','',o_Implied,$4A); AddOpcode('RORA','',o_Implied,$6A); AddOpcode('BPL','',o_Branch,$10); AddOpcode('BMI','',o_Branch,$30); AddOpcode('BVC','',o_Branch,$50); AddOpcode('BVS','',o_Branch,$70); AddOpcode('BCC','',o_Branch,$90); AddOpcode('BCS','',o_Branch,$B0); AddOpcode('BNE','',o_Branch,$D0); AddOpcode('BEQ','',o_Branch,$F0); { ImAbZpAcIxIyZxAxAyInZy } AddOpcode('ORA','090D05 0111151D19 ',o_Mode,0); AddOpcode('ASL',' 0E060A 161E ',o_Mode,0); AddOpcode('JSR',' 20 ',o_Mode,0); AddOpcode('AND','292D25 2131353D39 ',o_Mode,0); AddOpcode('BIT',' 2C24 ',o_Mode,0); AddOpcode('ROL',' 2E262A 363E ',o_Mode,0); AddOpcode('EOR','494D45 4151555D59 ',o_Mode,0); AddOpcode('LSR',' 4E464A 565E ',o_Mode,0); AddOpcode('JMP',' 4C 6C ',o_Mode,0); AddOpcode('ADC','696D65 6171757D79 ',o_Mode,0); AddOpcode('ROR',' 6E666A 767E ',o_Mode,0); AddOpcode('STA',' 8D85 8191959D99 ',o_Mode,0); AddOpcode('STY',' 8C84 94 ',o_Mode,0); AddOpcode('STX',' 8E86 96',o_Mode,0); AddOpcode('LDY','A0ACA4 B4BC ',o_Mode,0); AddOpcode('LDA','A9ADA5 A1B1B5BDB9 ',o_Mode,0); AddOpcode('LDX','A2AEA6 BE B6',o_Mode,0); AddOpcode('CPY','C0CCC4 ',o_Mode,0); AddOpcode('CMP','C9CDC5 C1D1D5DDD9 ',o_Mode,0); AddOpcode('DEC',' CEC6 D6DE ',o_Mode,0); AddOpcode('CPX','E0ECE4 ',o_Mode,0); AddOpcode('SBC','E9EDE5 E1F1F5FDF9 ',o_Mode,0); AddOpcode('INC',' EEE6 F6FE ',o_Mode,0); AddOpcode('DB' ,'',o_DB ,0); AddOpcode('FCB' ,'',o_DB ,0); AddOpcode('BYTE' ,'',o_DB ,0); AddOpcode('DW' ,'',o_DW ,0); AddOpcode('FDB' ,'',o_DW ,0); AddOpcode('WORD' ,'',o_DW ,0); AddOpcode('DS' ,'',o_DS ,0); AddOpcode('RMB' ,'',o_DS ,0); AddOpcode('BLKB' ,'',o_DS ,0); AddOpcode('FCC' ,'',o_FCC,0); AddOpcode('=' ,'',o_EQU,0); AddOpcode('EQU' ,'',o_EQU,0); AddOpcode('SET' ,'',o_EQU,1); AddOpcode('ORG' ,'',o_ORG ,0); AddOpcode('AORG' ,'',o_ORG ,0); AddOpcode('RORG' ,'',o_RORG ,0); AddOpcode('END' ,'',o_END ,0); AddOpcode('LIST' ,'',o_LIST ,0); AddOpcode('OPT' ,'',o_OPT ,0); AddOpcode('MACRO','',o_MACRO,0); AddOpcode('ENDM' ,'',o_ENDM ,0); END; FUNCTION FindSym(symName: SymStr): SymPtr; VAR p: SymPtr; found: Boolean; BEGIN found := FALSE; p := SymTab; WHILE (p<>NIL) AND NOT Found DO BEGIN found := (p^.name = symName); IF NOT found THEN p := p^.next; END; FindSym := p; END; FUNCTION AddSym(symName: SymStr): SymPtr; VAR p: SymPtr; BEGIN New(p); WITH p^ DO BEGIN name := SymName; value := 0; next := SymTab; defined := FALSE; multiDef := FALSE; isSet := FALSE; equ := FALSE; known := FALSE; END; symTab := p; AddSym := p; END; FUNCTION RefSym(symName: SymStr; VAR known: Boolean): Integer; VAR p: SymPtr; BEGIN p := FindSym(symName); IF p=NIL THEN p := AddSym(symName); IF NOT p^.defined THEN Error('Symbol "' + symName + '" undefined'); RefSym := p^.value; CASE pass OF 1: IF NOT p^.defined THEN known := FALSE; 2: IF NOT p^.known THEN known := FALSE; END; END; PROCEDURE DefSym(symName: SymStr; val: Integer; setSym,equSym: Boolean); VAR p: SymPtr; BEGIN IF Length(symName)<>0 THEN BEGIN p := FindSym(symName); IF p=NIL THEN p := AddSym(symName); IF (NOT p^.defined) OR (p^.isSet AND setSym) THEN BEGIN p^.value := val; p^.defined := TRUE; p^.isSet := setSym; p^.equ := equSym; END ELSE IF p^.value <> val THEN BEGIN p^.multiDef := TRUE; Error('Symbol "' + symName + '" multiply defined'); END; IF pass=2 THEN p^.known := TRUE; END; END; FUNCTION GetWord: String; VAR word: String; done: Boolean; BEGIN line := Deblank(line); word := ''; IF Length(line)>0 THEN IF (line[1]=#12) OR (line[1]=comment) THEN line := ''; IF Length(line)>0 THEN BEGIN IF NOT (line[1] IN alphaNumeric) THEN BEGIN word := Copy(Line,1,1); Delete(line,1,1); IF Length(line)>0 THEN BEGIN IF ((word[1]='<') AND (line[1]='<')) OR ((word[1]='>') AND (line[1]='>')) THEN BEGIN word := word + Copy(line,1,1); Delete(line,1,1); END; END; END ELSE BEGIN done := FALSE; WHILE (Length(line)>0) AND NOT done DO BEGIN word := word + Upcase(line[1]); Delete(line,1,1); IF Length(line)>0 THEN done := NOT (line[1] IN alphaNumeric); END; END; END; GetWord := UprCase(word); END; PROCEDURE Expect(expected: String); BEGIN IF GetWord<>expected THEN Error('"' + expected + '" expected'); END; PROCEDURE Comma; BEGIN Expect(','); END; FUNCTION EvalBin(binStr: String): Integer; VAR binVal: Integer; evalErr: Boolean; i,n: Integer; BEGIN evalErr := FALSE; binVal := 0; FOR i := 1 TO Length(binStr) DO BEGIN n := Pos(binStr[i],'01'); IF n=0 THEN evalErr := TRUE ELSE binVal := binVal*2 + n-1; END; IF evalErr THEN BEGIN binVal := 0; Error('Invalid octal number'); END; EvalBin := binVal; END; FUNCTION EvalOct(octStr: String): Integer; VAR octVal: Integer; evalErr: Boolean; i,n: Integer; BEGIN evalErr := FALSE; octVal := 0; FOR i := 1 TO Length(octStr) DO BEGIN n := Pos(octStr[i],'01234567'); IF n=0 THEN evalErr := TRUE ELSE octVal := octVal*8 + n-1; END; IF evalErr THEN BEGIN octVal := 0; Error('Invalid octal number'); END; EvalOct := octVal; END; FUNCTION EvalDec(decStr: String): Integer; VAR decVal: Integer; evalErr: Boolean; i,n: Integer; BEGIN evalErr := FALSE; decVal := 0; FOR i := 1 TO Length(decStr) DO BEGIN n := Pos(decStr[i],'0123456789'); IF n=0 THEN evalErr := TRUE ELSE decVal := decVal*10 + n-1; END; IF evalErr THEN BEGIN decVal := 0; Error('Invalid decimal number'); END; EvalDec := decVal; END; FUNCTION EvalHex(hexStr: String): Integer; VAR hexVal: Integer; evalErr: Boolean; i,n: Integer; BEGIN evalErr := FALSE; hexVal := 0; FOR i := 1 TO Length(hexStr) DO BEGIN n := Pos(Upcase(hexStr[i]),'0123456789ABCDEF'); IF n=0 THEN evalErr := TRUE ELSE hexVal := hexVal*16 + n-1; END; IF evalErr THEN BEGIN hexVal := 0; Error('Invalid hexadecimal number'); END; EvalHex := hexVal; END; FUNCTION Eval0: Integer; FORWARD; FUNCTION Factor: Integer; VAR word: String; val: Integer; BEGIN word := GetWord; val := 0; IF Length(word)=0 THEN Error('Missing operand') ELSE IF (word='.') OR (word='*') THEN val := locPtr ELSE IF word='-' THEN val := -Factor ELSE IF word='+' THEN val := Factor ELSE IF word='~' THEN val := -Factor-1 ELSE IF word='<' THEN val := Factor AND 255 ELSE IF word='>' THEN val := (Factor SHR 8) AND 255 ELSE IF word='%' THEN BEGIN Word := GetWord; val := EvalBin(word); END ELSE IF word='$' THEN BEGIN Word := GetWord; IF Length(word)=0 THEN val := locPtr ELSE val := EvalHex(word); END ELSE IF word='(' THEN BEGIN val := Eval0; Expect(')'); END ELSE IF word='''' THEN BEGIN IF Length(line)=0 THEN Error('Missing operand') ELSE BEGIN val := Ord(line[1]); Delete(line,1,1); Expect(''''); END; END ELSE IF word[1]='@' THEN BEGIN val := RefSym(lastLabl + word, evalKnown); END ELSE IF word[1] IN numeric THEN BEGIN CASE word[Length(word)] OF 'O': val := EvalOct(Copy(word,1,Length(word)-1)); 'D': val := EvalDec(Copy(word,1,Length(word)-1)); 'H': val := EvalHex(Copy(word,1,Length(word)-1)); 'B': val := EvalBin(Copy(word,1,Length(word)-1)); ELSE val := EvalDec(word); END; END ELSE val := RefSym(word,evalKnown); Factor := val; END; FUNCTION Term: Integer; VAR word: String; val: Integer; oldLine: String; BEGIN val := Factor; oldLine := line; word := GetWord; WHILE (word='*') OR (word='/') OR (word='%') DO BEGIN CASE word[1] OF '*': val := val * Factor; '/': val := val DIV Factor; '%': val := val MOD Factor; END; oldLine := line; word := GetWord; END; line := oldLine; Term := val; END; FUNCTION Eval1: Integer; VAR word: String; val: Integer; oldLine: String; BEGIN val := Term; oldLine := line; word := GetWord; WHILE (word='+') OR (word='-') DO BEGIN CASE word[1] OF '+': val := val + Term; '-': val := val - Term; END; oldLine := line; word := GetWord; END; line := oldLine; Eval1 := val; END; FUNCTION Eval0: Integer; VAR word: String; val: Integer; oldLine: String; BEGIN val := Eval1; oldLine := line; word := GetWord; WHILE (word='&') OR (word='|') OR (word='<<') OR (word='>>') DO BEGIN CASE word[1] OF '&': val := val AND Eval1; '|': val := val OR Eval1; '<': val := val SHL Eval1; '>': val := val SHR Eval1; END; oldLine := line; word := GetWord; END; line := oldLine; Eval0 := val; END; FUNCTION Eval: Integer; BEGIN evalKnown := TRUE; Eval := Eval0; END; FUNCTION EvalByte: Integer; VAR val: Integer; BEGIN val := Eval; IF (val<-128) OR (val>255) THEN Error('Byte out of range'); EvalByte := val AND 255; END; FUNCTION FindReg(regName,regList,valList: String): Integer; VAR p: Integer; reg: Integer; code: Integer; BEGIN p := Pos(' ' + Deblank(regName) + ' ',regList); IF p=0 THEN BEGIN reg := 0; Error('Illegal register "' + Deblank(RegName) + '"'); END ELSE Val(Copy(valList,p,2),reg,code); FindReg := reg; END; PROCEDURE CodeOut(byte: Integer); BEGIN IF (pass=2) AND updLoc THEN BEGIN WriteLn(object,':',Hex4(codPtr)); outPtr := codPtr; updLoc := FALSE; END; outPtr := outPtr + 1; IF pass=2 THEN WriteLn(object,Hex2(byte)); END; PROCEDURE AddLocPtr(ofs: Word); BEGIN updLoc := updLoc OR (codPtr+ofs<>outPtr); codPtr := codPtr + ofs; locPtr := locPtr + ofs; END; PROCEDURE CodeAbsOrg(addr: Word); BEGIN updLoc := updLoc OR (addr<>outPtr); locPtr := addr; codPtr := addr; END; PROCEDURE CodeRelOrg(addr: Word); BEGIN locPtr := addr; END; PROCEDURE CodeFlush; BEGIN { Object file format does not use buffering; no flush needed } END; PROCEDURE CodeEnd; BEGIN CodeFlush; IF (pass=2) AND xferFound THEN BEGIN WriteLn(object,'$',Hex4(xferAddr)); END; END; PROCEDURE CodeXfer(addr: Integer); BEGIN xferAddr := addr; xferFound := TRUE; END; PROCEDURE DoOpcode(typ,parm: Integer; modes: String; macro: MacroPtr); VAR val: Integer; word: String; oldLine: String; mode: Integer; ch: Char; done: Boolean; BEGIN CASE typ OF o_Implied: BEGIN instr[1] := parm; instrLen := 1; END; o_Branch: BEGIN val := Eval; val := val - locPtr - 2; IF (val<-128) OR (val>127) THEN BEGIN Error('Branch out of range'); val := 0; END; instr[1] := parm; instr[2] := val; instrLen := 2; END; o_Mode: BEGIN line := Deblank(line); mode := a_None; val := 0; IF Length(line)=0 THEN mode := a_Acc { accumulator } ELSE CASE line[1] OF comment: mode := a_Acc; { accumulator } '#': BEGIN { immediate } Expect('#'); val := Eval; mode := a_Imm; END; '[': BEGIN { indirect } Expect('['); { this is a 6809ism } val := Eval; { that I got used to } Expect(']'); mode := a_Ind; END; '(': BEGIN { indirect X,Y } Expect('('); val := Eval; line := Deblank(line); IF Length(line)>0 THEN CASE line[1] OF ',': BEGIN Expect(','); Expect('X'); Expect(')'); mode := a_Inx; END; ')': BEGIN Expect(')'); Debleft(line); IF (Length(line)=0) OR (line[1]=comment) THEN BEGIN mode := a_Ind; END ELSE BEGIN Expect(','); Expect('Y'); mode := a_Iny; END; END; ELSE mode := a_None; END; END; ELSE BEGIN { everything else } line := Deblank(line); IF (Upcase(line[1])='A') AND ((Length(line)=1) OR ((Length(line)>1) AND ((line[2]=comment) OR (Pos(line[2],white)<>0)))) THEN BEGIN Expect('A'); { accumulator } mode := a_Acc; END ELSE BEGIN val := Eval; line := Deblank(line); IF (Length(line)=0) OR (line[1]=comment) THEN { abs or zpg } IF (val>=0) AND (val<256) AND evalKnown AND (modes[a_Zpg]<>' ') THEN mode := a_Zpg ELSE mode := a_Abs ELSE BEGIN Expect(','); word := GetWord; IF word='X' THEN IF (val>=0) AND (val<256) AND (evalKnown OR (modes[a_Abx]=' ')) THEN mode := a_Zpx ELSE mode := a_Abx ELSE IF word='Y' THEN IF (val>=0) AND (val<256) AND (evalKnown OR (modes[a_Aby]=' ')) AND (modes[a_Zpy]<>' ') THEN mode := a_Zpy ELSE mode := a_Aby END; END; END; END; IF (mode<>a_None) AND (modes[mode]=' ') THEN mode := a_None; IF mode<>a_None THEN BEGIN word := Copy(modes,mode,2); instr[1] := EvalHex(word); END; instrLen := 0; CASE mode OF a_None: Error('Invalid addressing mode'); a_Acc: instrLen := 1; a_Imm, a_Zpg, a_Inx, a_Iny, a_Zpx, a_Zpy: BEGIN instr[2] := val AND 255; instrLen := 2; END; a_Abs, a_Abx, a_Aby, a_Ind: BEGIN instr[2] := val AND 255; instr[3] := val SHR 8; instrLen := 3; END; END; END; o_DB: BEGIN bytStr := ''; oldLine := line; word := GetWord; IF Length(word)=0 THEN Error('Missing operand'); WHILE Length(word)<>0 DO BEGIN IF word='''' THEN WHILE word='''' DO BEGIN val := Pos('''',line); IF val=0 THEN BEGIN bytStr := bytStr + line; line := ''; word := ''; END ELSE BEGIN bytStr := bytStr + Copy(line,1,val-1); Delete(line,1,val); word := GetWord; IF word='''' THEN bytStr := bytStr + ''''; END; END ELSE BEGIN line := oldLine; bytStr := bytStr + CHR(EvalByte); word := GetWord; END; IF word=',' THEN BEGIN oldLine := line; word := GetWord; IF Length(word)=0 THEN Error('Missing operand'); END ELSE BEGIN line := word + ' ' + line; word := ''; END; END; instrLen := -Length(bytStr); END; o_DW: BEGIN bytStr := ''; oldLine := line; word := GetWord; IF Length(word)=0 THEN Error('Missing operand'); WHILE Length(word)<>0 DO BEGIN line := oldLine; val := Eval; bytStr := bytStr + CHR(val AND 255) + CHR(val SHR 8); word := GetWord; oldLine := line; IF word=',' THEN BEGIN word := GetWord; IF Length(word)=0 THEN Error('Missing operand'); END; END; instrLen := -Length(bytStr); END; o_DS: BEGIN val := Eval; IF pass=2 THEN BEGIN showAddr := FALSE; Delete(listLine,1,13); listLine := Hex4(codPtr) + ': (' + Hex4(val) + ')' + listLine; END; AddLocPtr(val); END; o_END: BEGIN oldLine := line; IF Length(GetWord)<>0 THEN BEGIN line := oldLine; val := Eval; CodeXfer(val); line := Copy(line,1,7) + '(' + Hex4(val) + ')' + Copy(line,14,255); END; sourceEnd := TRUE; END; o_ENDM: Error('ENDM without MACRO'); o_MacName: BEGIN IF macPtr<>NIL THEN Error('Nested macros not supported') ELSE BEGIN macPtr := macro; macLine := macro^.text; GetMacParms(macro); END; END; o_FCC: BEGIN bytStr := ''; DebLeft(line); IF Length(line)=0 THEN Error('Missing operand'); ch := line[1]; Delete(line,1,1); done := FALSE; WHILE (Length(line)<>0) AND NOT done DO BEGIN IF line[1]=ch THEN BEGIN IF (Length(line)>1) AND (line[2]=ch) THEN BEGIN bytStr := bytStr + line[1]; Delete(line,1,2); END ELSE BEGIN Delete(line,1,1); DebLeft(line); IF (Length(line)=0) OR (line[1]=comment) THEN done := TRUE ELSE line := ''; END; END ELSE BEGIN bytStr := bytStr + line[1]; Delete(line,1,1); END; END; IF NOT done THEN Error('FCC not terminated properly'); instrLen := -Length(bytStr); END; ELSE Error('Unknown opcode'); END; END; PROCEDURE ReadLine(VAR line: String); BEGIN macLineFlag := (macLine<>NIL); IF macLineFlag THEN BEGIN line := macLine^.text; macLine := macLine^.next; DoMacParms; END ELSE BEGIN macPtr := NIL; ReadLn(source,line); END END; FUNCTION EofSource: Boolean; BEGIN EofSource := EOF(source) AND (macLine=NIL); END; PROCEDURE ListOut; VAR i: Integer; BEGIN IF Deblank(listLine) = #12 THEN WriteLn(listing,#12) ELSE IF Deblank(listLine)='' THEN WriteLn(listing) ELSE BEGIN i := Length(listLine); WHILE (i>0) AND (listLine[i]=' ') DO Dec(i); listLine[0] := CHR(i); WriteLn(listing,listLine); IF errFlag AND cl_Err THEN WriteLn(listLine); END; END; PROCEDURE DoLabelOp(typ,parm: Integer; labl: SymStr); VAR val: Integer; word: String; macro: MacroPtr; opcode: OpcdStr; mode: ModeStr; xmacro: MacroPtr; str: String; nparms: Integer; BEGIN CASE typ OF o_EQU: BEGIN IF Length(labl)=0 THEN Error('Missing label') ELSE BEGIN val := Eval; listLine := Copy(listLine,1,6) + '= ' + Hex4(val) + Copy(listLine,13,255); DefSym(labl,val,parm=1,parm=0); END; END; o_ORG: BEGIN CodeAbsOrg(Eval); DefSym(labl,locPtr,FALSE,FALSE); showAddr := TRUE; END; o_RORG: BEGIN val := Eval; CodeRelOrg(val); DefSym(labl,{locPtr}codPtr,FALSE,FALSE); IF pass=2 THEN BEGIN Delete(listLine,1,11); listLine := Hex4(codPtr) + ' = ' + Hex4(val) + listLine; END; END; o_LIST: BEGIN listThisLine := TRUE; IF Length(labl)<>0 THEN Error('Label not allowed'); word := GetWord; IF word='ON' THEN listFlag := TRUE ELSE IF word='OFF' THEN listFlag := FALSE ELSE IF word='MACRO' THEN listMacFlag := TRUE ELSE IF word='NOMACRO' THEN listMacFlag := FALSE ELSE Error('Illegal operand'); END; o_OPT: BEGIN listThisLine := TRUE; IF Length(labl)<>0 THEN Error('Label not allowed'); word := GetWord; IF word='LIST' THEN listFlag := TRUE ELSE IF word='NOLIST' THEN listFlag := FALSE ELSE Error('Illegal option'); END; o_MACRO: BEGIN FindMacro(labl,macro); IF (macro<>NIL) AND macro^.def THEN Error('Macro multiply defined') ELSE BEGIN IF macro=NIL THEN BEGIN AddMacro(labl,macro); word := GetWord; WHILE (Length(word)<>0) AND (word[1] IN alpha) DO BEGIN AddMacroParm(macro,word); word := GetWord; IF word=',' THEN word := GetWord; END; IF macro^.nParms > maxMacParms THEN Error('Too many macro parameters'); IF Length(word)<>0 THEN Error('Illegal operand'); END; IF pass=2 THEN macro^.def := TRUE; WHILE (NOT EofSource) AND (typ<>o_ENDM) DO BEGIN IF pass=2 THEN ListOut; ReadLine(line); listLine := ' ' + line; { 16 blanks } str := line; labl := ''; IF Length(line)>0 THEN IF Pos(line[1],white)=0 THEN BEGIN labl := GetWord; showAddr := (Length(labl)<>0); IF Length(labl)<>0 THEN IF labl[1]='@' THEN labl := lastLabl + labl ELSE lastLabl := labl; IF Length(line)>0 THEN IF line[1]=':' THEN Delete(line,1,1); END; opcode := GetWord; IF Length(opcode)=0 THEN typ := 0 ELSE FindOpcode(opcode,typ,parm,mode,xmacro); IF typ=o_END THEN Error('END not allowed inside a macro'); IF typ=o_ENDM THEN BEGIN IF (pass=1) AND (Length(labl)<>0) THEN AddMacroLine(macro,labl); END ELSE IF pass=1 THEN AddMacroLine(macro,str); END; IF typ<>o_ENDM THEN Error('Missing ENDM'); END; END; ELSE Error('Unknown opcode'); END; END; PROCEDURE DoPass; VAR labl: SymStr; opcode: SymStr; mode: ModeStr; typ: Integer; parm: Integer; i: Integer; word: String; macro: MacroPtr; BEGIN Assign(source,cl_SrcName); Reset(source); sourceEnd := FALSE; lastLabl := ''; WriteLn('Pass ',pass); outPtr := $FFFF; CodeAbsOrg($0000); errCount := 0; listFlag := TRUE; listMacFlag := FALSE; WHILE (NOT EofSource) AND (NOT sourceEnd) DO BEGIN ReadLine(line); errFlag := FALSE; instrLen := 0; showAddr := FALSE; listThisLine := ListFlag; listLine := ' '; { 16 blanks } IF Pass=2 THEN listLine := Copy(listLine,1,16) + line; labl := ''; IF Length(line)>0 THEN IF Pos(line[1],white)=0 THEN BEGIN IF (Length(line)<>0) AND (line[1]='*') THEN line := ''; labl := GetWord; showAddr := (Length(labl)<>0); IF Length(labl)<>0 THEN IF labl[1]='@' THEN labl := lastLabl + labl ELSE lastLabl := labl; IF Length(line)>0 THEN IF line[1]=':' THEN Delete(line,1,1); END; opcode := GetWord; IF Length(opcode)=0 THEN BEGIN typ := 0; DefSym(labl,locPtr,FALSE,FALSE); END ELSE BEGIN FindOpcode(opcode,typ,parm,mode,macro); IF typ=o_Illegal THEN Error('Illegal opcode "' + Deblank(opcode) + '"') ELSE IF typ<0 THEN BEGIN showAddr := FALSE; DoLabelOp(typ,parm,labl); END ELSE BEGIN showAddr := TRUE; DefSym(labl,locPtr,FALSE,FALSE); DoOpcode(typ,parm,mode,macro); END; IF typ<>o_Illegal THEN IF Length(GetWord)>0 THEN Error('Too many operands'); END; IF Pass=2 THEN BEGIN IF ShowAddr THEN listLine := Hex4(codPtr) + ':' + Copy(listLine,6,255); IF instrLen>0 THEN FOR i := 1 TO instrLen DO BEGIN word := Hex2(instr[i]); listLine[i*3+4] := word[1]; listLine[i*3+5] := word[2]; CodeOut(instr[I]); END ELSE BEGIN FOR i := 1 TO -instrLen DO BEGIN IF i<=3 THEN BEGIN word := Hex2(ORD(bytStr[i])); listLine[i*3+4] := word[1]; listLine[i*3+5] := word[2]; END; CodeOut(ORD(bytStr[i])); END; IF -instrLen > 3 THEN listLine[4*3+4-1] := '+'; END; IF listThisLine AND (errFlag OR listMacFlag OR NOT macLineFlag) THEN ListOut; END; AddLocPtr(ABS(instrLen)); END; IF Pass=2 THEN CodeEnd; { Put the lines after the END statement into the listing file } { while still checking for listing control statements. Ignore } { any lines which have invalid syntax, etc., because whatever } { is found after an END statement should esentially be ignored. } IF Pass=2 THEN WHILE NOT EofSource DO BEGIN ReadLine(line); listThisLine := listFlag; listLine := ' ' + line; { 16 blanks } IF Length(line)>0 THEN IF Pos(line[1],white)<>0 THEN BEGIN word := GetWord; IF Length(word)<>0 THEN BEGIN FindOpcode(word,typ,parm,mode,macro); CASE typ OF o_LIST: BEGIN listThisLine := TRUE; word := GetWord; IF word='ON' THEN listFlag := TRUE ELSE IF word='OFF' THEN listFlag := FALSE ELSE IF word='MACRO' THEN listMacFlag := TRUE ELSE IF word='NOMACRO' THEN listMacFlag := FALSE ELSE listThisLine := listFlag; END; o_OPT: BEGIN listThisLine := TRUE; word := GetWord; IF word='LIST' THEN listFlag := TRUE ELSE IF word='NOLIST' THEN listFlag := FALSE ELSE listThisLine := listFlag; END; END; END; END; IF listThisLine THEN ListOut; END; Close(source); END; PROCEDURE SortSymTab; VAR i,j,t: SymPtr; sorted: Boolean; temp: SymRec; BEGIN IF symTab<>NIL THEN BEGIN i := symTab; j := i^.next; WHILE (j<>NIL) DO BEGIN sorted := TRUE; WHILE (j<>NIL) DO BEGIN IF j^.name < i^.name THEN BEGIN temp := i^; i^ := j^; j^ := temp; t := i^.next; i^.next := j^.next; j^.next := t; sorted := FALSE; END; j := j^.next; END; i := i^.next; j := i^.next; END; END; END; PROCEDURE DumpSym(p: SymPtr; VAR s: String); BEGIN s := p^.name; WHILE Length(s)<=maxSymLen DO StAppendCh(s,' '); s := s + Hex4(p^.value); StAppendCh(s,' '); IF NOT p^.defined THEN StAppendCh(s,'U'); IF p^.multiDef THEN StAppendCh(s,'M'); IF p^.isSet THEN StAppendCh(s,'S'); IF p^.equ THEN StAppendCh(s,'E'); WHILE Length(s)<=maxSymLen + 9 DO StAppendCh(s,' '); END; PROCEDURE DumpSymTab; VAR p: SymPtr; i: Integer; s: String; BEGIN SortSymTab; i := 1; p := symTab; WHILE (p<>NIL) DO BEGIN DumpSym(p,s); p := p^.next; i := i + 1; IF (p=NIL) OR (i > symTabCols) THEN BEGIN i := 1; Debright(s); WriteLn(listing,s); END ELSE Write(listing,s); END; END; PROCEDURE ShowOptions; BEGIN WriteLn; WriteLn(' Command line syntax:'); WriteLn; WriteLn(' ASM6502 [options] src [options]'); WriteLn; WriteLn(' Valid options:'); WriteLn; WriteLn(' -E Show errors to screen'); WriteLn(' -L Make a listing file to src.LIS'); WriteLn(' -L=name'); WriteLn(' -O Make an object file to src.OBJ'); WriteLn(' -O=name'); WriteLn; END; FUNCTION GetOption(VAR optStr: String): String; VAR option: String[80]; p: Integer; BEGIN optStr := Deblank(optStr); p := Pos(' ',optStr); IF p=0 THEN BEGIN option := optStr; optStr := ''; END ELSE BEGIN option := Copy(optStr,1,p-1); optStr := Copy(optStr,p+1,255); END; optStr := UprCase(Deblank(optStr)); GetOption := option; END; FUNCTION GetOptions(VAR cl_SrcName, cl_ListName,cl_ObjName: String; VAR cl_Err: Boolean): Boolean; VAR s: String; len: Integer; optStr: String; option: String; optParm: String; prefix: String; p: Integer; err: Integer; optErr: Boolean; i: Integer; BEGIN cl_SrcName := ''; cl_ListName := 'NUL'; cl_ObjName := 'NUL'; cl_Err := FALSE; optErr := FALSE; optStr := ParamStr(1); FOR i := 2 TO ParamCount DO optStr := optStr + ' ' + ParamStr(i); option := GetOption(optStr); WHILE Length(option)<>0 DO BEGIN optParm := ''; p := Pos('=',option); IF p>0 THEN BEGIN optParm := Copy(option,p+1,255); option := Copy(option,1,p-1); END; option := Uprcase(option); IF option = '-L' THEN cl_ListName := optParm ELSE IF option = '-O' THEN cl_ObjName := optParm ELSE IF option = '-E' THEN cl_Err := TRUE ELSE IF option = '?' THEN optErr := TRUE ELSE BEGIN IF (Copy(option,1,1)='-') OR (Length(cl_SrcName)<>0) OR (Length(optParm)<>0) THEN BEGIN optErr := TRUE; WriteLn('Illegal command line option: ',option); END ELSE BEGIN cl_SrcName := option; IF Pos('.',cl_SrcName)=0 THEN IF p=0 THEN cl_SrcName := cl_SrcName + '.ASM'; p := Pos('.',option); IF p=0 THEN prefix := option ELSE prefix := Copy(option,1,p-1); END; END; option := GetOption(optStr); END; IF cl_SrcName = '' THEN BEGIN optErr := TRUE; WriteLn('Source file not specified') END; IF cl_ListName = '' THEN cl_ListName := prefix + '.LIS'; IF cl_ObjName = '' THEN cl_ObjName := prefix + '.DAT'; IF Copy(cl_ListName,1,1)='.' THEN cl_ListName := prefix + cl_ListName; IF Copy(cl_ObjName ,1,1)='.' THEN cl_ObjName := prefix + cl_ObjName; GetOptions := optErr; END; BEGIN IF GetOptions(cl_SrcName,cl_ListName,cl_ObjName,cl_Err) THEN BEGIN ShowOptions; Halt; END; Assign(listing,cl_ListName); Rewrite(listing); Assign(object,cl_ObjName); Rewrite(object); symTab := NIL; macroTab := NIL; macPtr := NIL; macLine := NIL; xferAddr := 0; xferFound := FALSE; InitOpcodes; pass := 1; DoPass; pass := 2; DoPass; WriteLn(listing); WriteLn(listing,errCount:5,' Total Error(s)'); WriteLn(listing); IF cl_Err THEN BEGIN WriteLn; WriteLn(errCount:5,' Total Error(s)'); END; DumpSymTab; Close(listing); Close(object); IF errCount<>0 THEN Halt(1); END.