mirror of
https://github.com/byteworksinc/ORCA-C.git
synced 2024-05-28 12:41:35 +00:00
b8b7dc2c2b
C90 had constraints requiring # and ## tokens to only appear in preprocessing directives, but C99 and later removed those constraints, so this code is no longer necessary when targeting current languages versions. (It would be necessary in a "strict C90" mode, if that was ever implemented.) The main practical effect of this is that # and ## tokens can be passed as parameters to macros, provided the macro either ignores or stringizes that parameter. # and ## tokens still have no role in the grammar of the C language after preprocessing, so they will be an unexpected token and produce some kind of error if they appear anywhere. This also contains a change to ensure that a line containing one or more illegal characters (e.g. $) and then a # is not treated as a preprocessing directive.
676 lines
21 KiB
ObjectPascal
676 lines
21 KiB
ObjectPascal
{$optimize 7}
|
|
{---------------------------------------------------------------}
|
|
{ }
|
|
{ Asm }
|
|
{ }
|
|
{ This unit implements the built-in assembler and }
|
|
{ disassembler. }
|
|
{ }
|
|
{ External Subroutines: }
|
|
{ }
|
|
{ AsmFunction - assemble an assembly language function }
|
|
{ AsmStatement - assemble some in-line code }
|
|
{ InitAsm - initialize the assembler }
|
|
{ }
|
|
{---------------------------------------------------------------}
|
|
|
|
unit Asm;
|
|
|
|
interface
|
|
|
|
{$LibPrefix '0/obj/'}
|
|
|
|
uses CCommon, Table, CGI, Scanner, Symbol, MM, Expression;
|
|
|
|
{$segment 'CC'}
|
|
|
|
procedure AsmFunction (variable: identPtr);
|
|
|
|
{ Assemble an assembly language function }
|
|
{ }
|
|
{ parameters: }
|
|
{ variable - pointer to the function variable }
|
|
|
|
|
|
procedure AsmStatement;
|
|
|
|
{ Assemble some in-line code }
|
|
|
|
|
|
procedure InitAsm;
|
|
|
|
{ Initialize the assembler }
|
|
|
|
|
|
{---------------------------------------------------------------}
|
|
|
|
implementation
|
|
|
|
{---------------------------------------------------------------}
|
|
|
|
var
|
|
doingAsmFunction: boolean; {was AsmStatement called from AsmFunction?}
|
|
|
|
{- Imported from the parser: -----------------------------------}
|
|
|
|
procedure Match (kind: tokenEnum; err: integer); extern;
|
|
|
|
{ insure that the next token is of the specified type }
|
|
{ }
|
|
{ parameters: }
|
|
{ kind - expected token kind }
|
|
{ err - error number if the expected token is not found }
|
|
|
|
{- Private routines --------------------------------------------}
|
|
|
|
function FindLabel (name: stringPtr; definition: boolean): integer;
|
|
|
|
{ Find a label in the label list. If none exists, create one. }
|
|
{ }
|
|
{ parameters: }
|
|
{ name - name of the label }
|
|
{ definition - is this the defining point? }
|
|
|
|
label 1;
|
|
|
|
var
|
|
lb: gotoPtr; {work pointer}
|
|
lnum: integer; {label number}
|
|
|
|
begin {FindLabel}
|
|
lb := gotoList; {try to find an existing label}
|
|
while lb <> nil do begin
|
|
if lb^.name^ = name^ then begin
|
|
lnum := lb^.lab;
|
|
goto 1;
|
|
end;
|
|
lb := lb^.next;
|
|
end; {while}
|
|
lb := pointer(Malloc(sizeof(gotoRecord))); {no label record exists: create one}
|
|
lb^.next := gotoList;
|
|
gotoList := lb;
|
|
lb^.name := name;
|
|
lnum := GenLabel;
|
|
lb^.lab := lnum;
|
|
lb^.defined := false;
|
|
1:
|
|
if definition then begin
|
|
if lb^.defined then
|
|
Error(77)
|
|
else begin
|
|
lb^.defined := true;
|
|
Gen1(dc_lab, lb^.lab);
|
|
end; {else}
|
|
end; {if}
|
|
FindLabel := lnum;
|
|
end; {FindLabel}
|
|
|
|
{- Global routines ---------------------------------------------}
|
|
|
|
procedure AsmFunction {variable: identPtr};
|
|
|
|
{ Assemble an assembly language function }
|
|
{ }
|
|
{ parameters: }
|
|
{ variable - pointer to the function variable }
|
|
|
|
var
|
|
tl: tempPtr; {work pointer}
|
|
|
|
begin {AsmFunction}
|
|
|
|
{process the statements}
|
|
doingAsmFunction := true;
|
|
AsmStatement;
|
|
doingAsmFunction := false;
|
|
|
|
{finish the subroutine}
|
|
Gen0 (dc_enp); {finish the segment}
|
|
CheckGotoList; {make sure all labels are declared}
|
|
while tempList <> nil do begin {dump the local labels}
|
|
tl := tempList;
|
|
tempList := tl^.next;
|
|
dispose(tl);
|
|
end; {while}
|
|
LInit; {dispose of the local memory pool}
|
|
nameFound := false; {no pc_nam for the next function (yet)}
|
|
doingFunction := false; {no longer doing a function}
|
|
end; {AsmFunction}
|
|
|
|
|
|
procedure AsmStatement;
|
|
|
|
{ Assemble some in-line code }
|
|
|
|
label 1,2,3,99;
|
|
|
|
var
|
|
i: integer; {loop variable}
|
|
lnum: integer; {label number}
|
|
name: packed array[0..3] of char; {op code name}
|
|
opc: opcode; {operation code enumeration}
|
|
opname: tokenType; {operation code token}
|
|
optype: operands; {operand type}
|
|
|
|
{set by Exp}
|
|
{----------}
|
|
isConstant: boolean; {constant? (or identifier expression}
|
|
operand: tokenType; {operand (if not isConstant)}
|
|
operation: (plus,minus,none); {kind of operation}
|
|
size: (directPage,absoluteaddress,longAddress); {size of the operand}
|
|
value: longint; {expression value}
|
|
|
|
|
|
procedure Skip;
|
|
|
|
{ An error was found: skip to the end & quit }
|
|
|
|
begin {Skip}
|
|
while not (token.kind in [rbracech,eofsy]) do
|
|
NextToken;
|
|
goto 99;
|
|
end; {Skip}
|
|
|
|
|
|
procedure Exp (stop: tokenSet; EOLallowed: boolean);
|
|
|
|
{ Parse an expression in an operand }
|
|
{ }
|
|
{ Parameters: }
|
|
{ stop - stop symbols }
|
|
{ EOLallowed - can the expression end with EOL? }
|
|
{ }
|
|
{ Outputs: }
|
|
{ isConstant - constant? (or identifier expression) }
|
|
{ operand - operand (if not isConstant) }
|
|
{ operation - kind of operation }
|
|
{ size - size of the operand }
|
|
{ value - expression value }
|
|
|
|
var
|
|
forced: boolean; {is the expression type forced?}
|
|
i: 0..maxint; {loop/index variable}
|
|
id: identPtr; {identifier}
|
|
tcode: intermediate_code; {temp storage for code}
|
|
|
|
begin {Exp}
|
|
if token.kind in [ltch,barch,gtch] {allow for operand size forcing}
|
|
then begin
|
|
forced := true;
|
|
if token.kind = ltch then
|
|
size := directPage
|
|
else if token.kind = barch then
|
|
size := absoluteaddress
|
|
else {if token.kind = gtch then}
|
|
size := longAddress;
|
|
NextToken;
|
|
end {if}
|
|
else
|
|
forced := false;
|
|
|
|
if EOLallowed then begin {handle expressions that can end at eol}
|
|
reportEOL := true;
|
|
stop := stop+[eolsy];
|
|
end; {if}
|
|
if token.kind = ident then begin {handle expressions with an identifier}
|
|
if not forced then
|
|
size := absoluteaddress;
|
|
isConstant := false;
|
|
operand := token;
|
|
id := FindSymbol(token, variableSpace, false, true);
|
|
if id = nil then begin
|
|
code^.llab := FindLabel(token.name, false);
|
|
if (not forced) and (not smallMemoryModel) then
|
|
size := longAddress;
|
|
end {if}
|
|
else begin
|
|
operand.symbolPtr := id;
|
|
if id^.storage in [stackFrame,parameter] then begin
|
|
code^.slab := id^.lln;
|
|
if not forced then
|
|
size := directPage;
|
|
end {if}
|
|
else begin
|
|
code^.lab := id^.name;
|
|
if id^.itype^.kind = functionType then begin
|
|
if id^.itype^.isPascal then begin
|
|
code^.lab := pointer(Malloc(length(id^.name^)+1));
|
|
CopyString(pointer(code^.lab), pointer(id^.name));
|
|
for i := 1 to length(code^.lab^) do
|
|
if code^.lab^[i] in ['a'..'z'] then
|
|
code^.lab^[i] := chr(ord(code^.lab^[i]) & $5F);
|
|
end; {if}
|
|
end; {if}
|
|
if (not forced) and (not smallMemoryModel) then
|
|
size := longAddress;
|
|
end; {else}
|
|
end; {else}
|
|
NextToken;
|
|
if token.kind in [plusch,minusch] then begin
|
|
if token.kind = plusch then
|
|
operation := plus
|
|
else
|
|
operation := minus;
|
|
NextToken;
|
|
tcode := code^;
|
|
Expression(arrayExpression, stop);
|
|
code^ := tcode;
|
|
value := expressionValue;
|
|
if expressionType^.kind = scalarType then
|
|
if expressionType^.baseType <= cgUWord then
|
|
value := value & $0000FFFF;
|
|
end {if}
|
|
else begin
|
|
operation := none;
|
|
value := 0;
|
|
end; {else}
|
|
end {if token = ident}
|
|
else begin {constant expression}
|
|
operation := none;
|
|
isConstant := true;
|
|
tcode := code^;
|
|
Expression(arrayExpression, stop);
|
|
code^ := tcode;
|
|
value := expressionValue;
|
|
if expressionType^.kind = scalarType then
|
|
if expressionType^.baseType <= cgUWord then
|
|
value := value & $0000FFFF;
|
|
if not forced then
|
|
if long(value).msw = 0 then begin
|
|
if long(value).lsw & $FF00 = 0 then
|
|
size := directPage
|
|
else
|
|
size := absoluteaddress;
|
|
end {if}
|
|
else
|
|
size := longAddress;
|
|
end; {else}
|
|
|
|
reportEOL := false;
|
|
if token.kind = eolsy then
|
|
NextToken;
|
|
end; {Exp}
|
|
|
|
|
|
function RegCompare (str: stringPtr; reg: char): boolean;
|
|
|
|
{ Compare a string to a register constant }
|
|
{ }
|
|
{ parameters: }
|
|
{ str - string pointer }
|
|
{ reg - register character }
|
|
|
|
begin {RegCompare}
|
|
RegCompare := false;
|
|
if length(str^) = 1 then
|
|
RegCompare := chr(ord(str^[1]) | $20) = reg;
|
|
end; {RegCompare}
|
|
|
|
|
|
procedure CheckForComment;
|
|
|
|
{ Handle an assembly language comment (ignore chars from ; to EOL) }
|
|
|
|
begin {CheckForComment}
|
|
while token.kind = semicolonch do begin
|
|
while not (charKinds[ord(ch)] in [ch_eol,ch_eof]) do
|
|
NextCh;
|
|
NextCh;
|
|
NextToken;
|
|
end; {if}
|
|
end; {CheckForComment}
|
|
|
|
|
|
begin {AsmStatement}
|
|
Match(lbracech,27);
|
|
while not (token.kind in [rbracech,eofsy]) do begin
|
|
|
|
{find the label and op-code}
|
|
CheckForComment;
|
|
if token.kind <> ident then begin {error if not an identifier}
|
|
Error(9);
|
|
Skip;
|
|
end; {if}
|
|
opname := token;
|
|
NextToken;
|
|
while token.kind = colonch do begin {define a label}
|
|
lnum := FindLabel(opname.name, true);
|
|
NextToken;
|
|
CheckForComment;
|
|
if token.kind <> ident then
|
|
Skip;
|
|
opname := token;
|
|
NextToken;
|
|
end; {while}
|
|
|
|
{identify the op-code}
|
|
if length(opname.name^) = 3 then begin
|
|
name := opname.name^;
|
|
for i := 1 to 3 do
|
|
if name[i] in ['A'..'Z'] then
|
|
name[i] := chr(ord(name[i]) | $20);
|
|
for opc := o_adc to o_xce do
|
|
if names[opc] = name then
|
|
goto 1;
|
|
end; {if}
|
|
Error(95);
|
|
Skip;
|
|
|
|
1: code^.q := 0; {default to no flags}
|
|
|
|
{handle general operand instructions}
|
|
if opc <= o_tsb then begin
|
|
optype := op;
|
|
if token.kind = lparench then begin
|
|
NextToken;
|
|
Exp([commach,rparench], false);
|
|
if token.kind = commach then begin
|
|
NextToken;
|
|
if token.kind = ident then begin
|
|
if RegCompare(token.name, 'x') then begin
|
|
NextToken;
|
|
Match(rparench,12);
|
|
if size = directPage then
|
|
optype := i_dp_x
|
|
else if size = absoluteaddress then
|
|
optype := i_op_x
|
|
else
|
|
Error(96);
|
|
end {if}
|
|
else if RegCompare(token.name, 's') then begin
|
|
NextToken;
|
|
Match(rparench,12);
|
|
Match(commach,86);
|
|
if token.kind = ident then begin
|
|
if RegCompare(token.name, 'y') then
|
|
NextToken
|
|
else
|
|
Error(97);
|
|
end {if}
|
|
else
|
|
Error(97);
|
|
if size = directPage then
|
|
optype := i_dp_s_y
|
|
else Error(96);
|
|
end {else if}
|
|
else
|
|
Error(97);
|
|
end {if token.kind = ident}
|
|
else Error(97);
|
|
end {if token.kind = commach}
|
|
else if token.kind = rparench then begin
|
|
NextToken;
|
|
if token.kind = commach then begin
|
|
NextToken;
|
|
if token.kind = ident then begin
|
|
if RegCompare(token.name, 'y') then
|
|
NextToken
|
|
else
|
|
Error(97);
|
|
end {if}
|
|
else Error(97);
|
|
if size = directPage then
|
|
optype := i_dp_y
|
|
else Error(96);
|
|
end {if}
|
|
else begin
|
|
if size = directPage then
|
|
optype := i_dp
|
|
else if size = absoluteaddress then
|
|
optype := i_op
|
|
else
|
|
Error(96);
|
|
end; {else}
|
|
end {else if token.kind = rparench}
|
|
else Error(12);
|
|
end {if}
|
|
|
|
else if token.kind = lbrackch then begin
|
|
NextToken;
|
|
Exp([commach,rbrackch], false);
|
|
Match(rbrackch,24);
|
|
if token.kind = commach then begin
|
|
NextToken;
|
|
if token.kind = ident then begin
|
|
if RegCompare(token.name, 'y') then
|
|
NextToken
|
|
else
|
|
Error(97);
|
|
end {if}
|
|
else Error(97);
|
|
if size = directPage then
|
|
optype := li_dp_y
|
|
else Error(96);
|
|
end {if}
|
|
else begin
|
|
if size = directPage then
|
|
optype := li_dp
|
|
else if size = absoluteaddress then
|
|
optype := i_la
|
|
else
|
|
Error(96);
|
|
end; {else}
|
|
end {else if}
|
|
|
|
else if token.kind = poundch then begin
|
|
optype := imm;
|
|
NextToken;
|
|
if token.kind = ltch then begin
|
|
NextToken;
|
|
Exp([semicolonch], true);
|
|
end {if}
|
|
else if token.kind = gtch then begin
|
|
NextToken;
|
|
Exp([semicolonch], true);
|
|
if isConstant then
|
|
value := value >> 8
|
|
else
|
|
code^.q := shift8;
|
|
end {else if}
|
|
else if token.kind = carotch then begin
|
|
NextToken;
|
|
Exp([semicolonch], true);
|
|
if isConstant then
|
|
value := value >> 16
|
|
else
|
|
code^.q := shift16;
|
|
end {else if}
|
|
else
|
|
Exp([semicolonch], true);
|
|
end {else if}
|
|
|
|
else begin
|
|
if token.kind = ident then
|
|
if RegCompare(token.name, 'a') then begin
|
|
optype := acc;
|
|
NextToken;
|
|
goto 2;
|
|
end; {if}
|
|
Exp([commach,semicolonch], true);
|
|
if token.kind = commach then begin
|
|
NextToken;
|
|
if token.kind = ident then begin
|
|
if RegCompare(token.name, 'x') then begin
|
|
NextToken;
|
|
if size = directPage then
|
|
optype := dp_x
|
|
else if size = absoluteaddress then
|
|
optype := op_x
|
|
else
|
|
optype := long_x;
|
|
end {if}
|
|
else if RegCompare(token.name, 'y') then begin
|
|
NextToken;
|
|
if size = directPage then
|
|
optype := dp_y
|
|
else if size = absoluteaddress then
|
|
optype := op_y
|
|
else
|
|
Error(96);
|
|
end {else if}
|
|
else if RegCompare(token.name, 's') then begin
|
|
NextToken;
|
|
if size = directPage then
|
|
optype := dp_s
|
|
else Error(96);
|
|
end {else if}
|
|
else Error(97);
|
|
end {if token.kind = ident}
|
|
else Error(97);
|
|
end {if}
|
|
else begin
|
|
if size = directPage then
|
|
optype := dp
|
|
else if size = absoluteaddress then
|
|
optype := op
|
|
else
|
|
optype := la;
|
|
end; {else}
|
|
end; {else}
|
|
|
|
2: {make sure the operand is valid}
|
|
if nopcodes[opc,optype] = 0 then begin
|
|
if optype = i_dp_x then
|
|
optype := i_op_x
|
|
else if optype = i_dp then
|
|
optype := i_op
|
|
else if optype = dp then
|
|
optype := op
|
|
else if optype = dp_x then
|
|
optype := op_x
|
|
else if optype = dp_y then
|
|
optype := op_y;
|
|
if nopcodes[opc,optype] = 0 then
|
|
if optype = op then
|
|
optype := la;
|
|
if nopcodes[opc,optype] = 0 then
|
|
Error(98);
|
|
end; {if}
|
|
|
|
code^.s := nopcodes[opc,optype];
|
|
|
|
if optype = acc then
|
|
code^.r := ord(implied)
|
|
else if optype = imm then
|
|
code^.r := ord(imm)
|
|
else if optype in [la,long_x] then
|
|
code^.r := ord(longabsolute)
|
|
else if optype in [op,op_x,op_y,i_op,i_op_x,i_la] then
|
|
code^.r := ord(absolute)
|
|
else
|
|
code^.r := ord(direct);
|
|
end {if opc <= o_tsb}
|
|
|
|
{handle data declarations}
|
|
else if opc <= o_dcl then begin
|
|
Exp([semicolonch], true);
|
|
if opc = o_dcb then begin
|
|
code^.s := d_dcb;
|
|
code^.r := ord(direct);
|
|
end {if}
|
|
else if opc = o_dcw then begin
|
|
code^.s := d_dcw;
|
|
code^.r := ord(absolute);
|
|
end {else if}
|
|
else begin
|
|
code^.s := d_dcl;
|
|
code^.r := ord(longabsolute);
|
|
end; {else}
|
|
end {if opc <= o_dcl}
|
|
|
|
{handle the brk instruction}
|
|
else if opc = o_brk then begin
|
|
Exp([semicolonch], true);
|
|
code^.r := ord(direct);
|
|
code^.s := 0;
|
|
end {if opc = o_brk}
|
|
|
|
{handle the wdm instruction (treated as having a one-byte operand)}
|
|
else if opc = o_wdm then begin
|
|
Exp([semicolonch], true);
|
|
code^.r := ord(direct);
|
|
code^.s := $42;
|
|
end {if opc = o_wdm}
|
|
|
|
{handle moves}
|
|
else if opc in [o_mvn,o_mvp] then begin
|
|
if opc = o_mvn then
|
|
code^.s := $54
|
|
else
|
|
code^.s := $44;
|
|
Gen0(pc_nat);
|
|
code^.s := d_bmov;
|
|
code^.r := ord(immediate);
|
|
Exp([commach,semicolonch], false);
|
|
if isConstant then begin
|
|
code^.opnd := long(value).msw;
|
|
code^.q := 0;
|
|
end {if}
|
|
else begin
|
|
code^.opnd := value;
|
|
code^.q := shift16;
|
|
end; {else}
|
|
Gen0(pc_nat);
|
|
Match(commach,86);
|
|
code^.s := d_bmov;
|
|
code^.r := ord(immediate);
|
|
Exp([semicolonch], true);
|
|
if isConstant then begin
|
|
code^.opnd := long(value).msw;
|
|
code^.q := 0;
|
|
end {if}
|
|
else begin
|
|
code^.opnd := value;
|
|
code^.q := shift16;
|
|
end; {else}
|
|
goto 3;
|
|
end {if opc in [o_mvn,o_mvp]}
|
|
|
|
{handle relative branches}
|
|
else if opc <= o_bvs then begin
|
|
code^.s := ropcodes[opc];
|
|
if token.kind = ident then begin
|
|
code^.llab := FindLabel(token.name, false);
|
|
NextToken;
|
|
code^.lab := nil;
|
|
if opc in [o_brl,o_per] then
|
|
code^.r := ord(longrelative)
|
|
else
|
|
code^.r := ord(relative);
|
|
goto 3;
|
|
end {if}
|
|
else Error(97);
|
|
end {else if opc <= o_bvs}
|
|
|
|
{handle implied operand instructions}
|
|
else begin
|
|
code^.s := iopcodes[opc];
|
|
code^.r := ord(implied);
|
|
end;
|
|
|
|
{generate the code}
|
|
if operation = minus then
|
|
code^.opnd := -value
|
|
else
|
|
code^.opnd := value;
|
|
3: Gen0(pc_nat);
|
|
|
|
CheckForComment;
|
|
end; {while}
|
|
99:
|
|
if doingAsmFunction then
|
|
useGlobalPool := true;
|
|
Match(rbracech,23);
|
|
end; {AsmStatement}
|
|
|
|
|
|
procedure InitAsm;
|
|
|
|
{ Initialize the assembler }
|
|
|
|
begin {AsmInit}
|
|
doingAsmFunction := false;
|
|
end; {AsmInit}
|
|
|
|
end.
|