Apple-2gs-SW
/
ORCA-C
mirror of https://github.com/byteworksinc/ORCA-C.git
1
0
Fork 0
Code Issues Projects Releases Wiki Activity

Add support for emitting 64-bit constants in statically-initialized data.

This commit is contained in:
Stephen Heumann 2021-02-04 02:17:10 -06:00
parent c37fae0f3b
commit 168a06b7bf
8 changed files with 80 additions and 16 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
CCommon.pas
View File

@ -311,7 +311,7 @@ type
isStructOrUnion: boolean; {is this a struct or union initializer?}
case isConstant: boolean of {is this a constant initializer?}
false: (iTree: tokenPtr);
true : (
true : ( {Note: qVal.lo must overlap iVal}
case itype: baseTypeEnum of
cgByte,
cgUByte,

7
CGI.Comments
View File

@ -3,13 +3,14 @@
{ dc_cns - generate a constant value }
{ }
{ GenL1(dc_cns, lval, count); }
{ GenQ1(dc_cns, qval, count); }
{ GenR1t(dc_cns, rval, count, type); }
{ Gen2t(dc_cns, ival, count, type); }
{ GenS(dc_cns, sptr); }
{ }
{ Creates COUNT occurrences of the constant lval, rval or }
{ ival, based on the type. In Gen2t can accept byte or word }
{ types. In the case of GenS, the operand is a string }
{ Creates COUNT occurrences of the constant lval, qval, rval }
{ or ival, based on the type. In Gen2t can accept byte or }
{ word types. In the case of GenS, the operand is a string }
{ constant, and no repeat count is allowed. }
{ }
{ }

2
CGI.Debug
View File

@ -338,6 +338,8 @@ with code^ do
write(r:1);
cgLong,cgULong:
write(lval:1);
cgQuad,cgUQuad:
write('***');
cgReal,cgDouble,cgComp,cgExtended:
write('***');
cgString: begin

34
CGI.pas
View File

@ -557,6 +557,15 @@ procedure GenL1 (fop: pcodes; lval: longint; fp1: integer);
{ fp1 - integer parameter }
procedure GenQ1 (fop: pcodes; qval: longlong; fp1: integer);
{ generate an instruction that uses a longlong and an int }
{ }
{ parameters: }
{ qval - longlong parameter }
{ fp1 - integer parameter }
procedure GenR1t (fop: pcodes; rval: double; fp1: integer; tp: baseTypeEnum);
{ generate an instruction that uses a real and an int }
@ -1203,6 +1212,28 @@ if codeGeneration then begin
end; {GenL1}
procedure GenQ1 {fop: pcodes; qval: longlong; fp1: integer};
{ generate an instruction that uses a longlong and an int }
{ }
{ parameters: }
{ qval - longlong parameter }
{ fp1 - integer parameter }
var
lcode: icptr; {local copy of code}
begin {GenQ1}
if codeGeneration then begin
lcode := code;
lcode^.optype := cgQuad;
lcode^.qval := qval;
lcode^.q := fp1;
Gen0(fop);
end; {if}
end; {GenQ1}
procedure GenR1t {fop: pcodes; rval: double; fp1: integer; tp: baseTypeEnum};
{ generate an instruction that uses a real and an int }
@ -1260,8 +1291,7 @@ begin {GenLdcQuad}
if codeGeneration then begin
lcode := code;
lcode^.optype := cgQuad;
lcode^.qval.lo := qval.lo;
lcode^.qval.hi := qval.hi;
lcode^.qval := qval;
Gen0(pc_ldc);
end; {if}
end; {GenLdcQuad}

6
Expression.pas
View File

@ -3941,14 +3941,12 @@ else begin {record the expression for an initialize
isConstant := true;
end {else if}
else if tree^.token.kind = longlongconst then begin
longlongExpressionValue.lo := tree^.token.qval.lo;
longlongExpressionValue.hi := tree^.token.qval.hi;
longlongExpressionValue := tree^.token.qval;
expressionType := longLongPtr;
isConstant := true;
end {else if}
else if tree^.token.kind = ulonglongconst then begin
longlongExpressionValue.lo := tree^.token.qval.lo;
longlongExpressionValue.hi := tree^.token.qval.hi;
longlongExpressionValue := tree^.token.qval;
expressionType := ulongLongPtr;
isConstant := true;
end {else if}

12
Native.pas
View File

@ -346,7 +346,7 @@ procedure WriteNative (opcode: integer; mode: addressingMode; operand: integer;
label 1;
type
rkind = (k1,k2,k3); {cnv record types}
rkind = (k1,k2,k3,k4); {cnv record types}
var
ch: char; {temp storage for string constants}
@ -355,7 +355,8 @@ var
case rkind of
k1: (rval: real;);
k2: (dval: double;);
k3: (ival1,ival2,ival3,ival4: integer;);
k3: (qval: longlong);
k4: (ival1,ival2,ival3,ival4: integer;);
end;
count: integer; {number of constants to repeat}
i,j,k: integer; {loop variables}
@ -606,6 +607,13 @@ case mode of
CnOut2(long(lval).lsw);
CnOut2(long(lval).msw);
end;
cgQuad,cgUQuad : begin
cnv.qval := icptr(name)^.qval;
CnOut2(cnv.ival1);
CnOut2(cnv.ival2);
CnOut2(cnv.ival3);
CnOut2(cnv.ival4);
end;
cgReal : begin
cnv.rval := icptr(name)^.rval;
CnOut2(cnv.ival1);

29
Parser.pas
View File

@ -1946,7 +1946,13 @@ var
variable^.storage := global;
if isConstant and (variable^.storage in [external,global,private]) then begin
if bitsize = 0 then begin
iPtr^.iVal := expressionValue;
if etype^.baseType in [cgQuad,cgUQuad] then begin
iPtr^.qVal := longlongExpressionValue;
end {if}
else begin
iPtr^.qval.hi := 0;
iPtr^.iVal := expressionValue;
end; {else}
iPtr^.itype := tp^.baseType;
InitializeBitField;
end; {if}
@ -1954,13 +1960,20 @@ var
scalarType: begin
bKind := tp^.baseType;
if (bKind in [cgByte..cgULong])
and (etype^.baseType in [cgByte..cgULong]) then begin
if bKind in [cgLong,cgULong] then
if (etype^.baseType in [cgByte..cgULong,cgQuad,cgUQuad])
and (bKind in [cgByte..cgULong,cgQuad,cgUQuad]) then begin
if bKind in [cgLong,cgULong,cgQuad,cgUQuad] then
if eType^.baseType = cgUByte then
iPtr^.iVal := iPtr^.iVal & $000000FF
else if eType^.baseType = cgUWord then
iPtr^.iVal := iPtr^.iVal & $0000FFFF;
if bKind in [cgQuad,cgUQuad] then
if etype^.baseType in [cgByte..cgULong] then
if (etype^.baseType in [cgByte,cgWord,cgLong])
and (iPtr^.iVal < 0) then
iPtr^.qVal.hi := -1
else
iPtr^.qVal.hi := 0;
goto 3;
end; {if}
if bKind in [cgReal,cgDouble,cgComp,cgExtended] then begin
@ -2017,6 +2030,14 @@ var
Error(47);
errorFound := true;
end {else}
else if etype^.baseType in [cgQuad,cgUQuad] then
if (longlongExpressionValue.hi = 0) and
(longlongExpressionValue.lo = 0) then
iPtr^.iType := cgULong
else begin
Error(47);
errorFound := true;
end {else}
else begin
Error(48);
errorFound := true;

4
Symbol.pas
View File

@ -494,6 +494,8 @@ procedure DoGlobals;
end;
cgLong,cgULong:
GenL1(dc_cns, ip^.ival, ip^.count);
cgQuad,cgUQuad:
GenQ1(dc_cns, ip^.qval, ip^.count);
cgReal,cgDouble,cgComp,cgExtended:
GenR1t(dc_cns, ip^.rval, ip^.count, ip^.itype);
cgString:
@ -583,6 +585,8 @@ procedure DoGlobals;
end;
cgLong,cgULong:
GenL1(dc_cns, ip^.ival, 1);
cgQuad,cgUQuad:
GenQ1(dc_cns, ip^.qval, 1);
cgReal,cgDouble,cgComp,cgExtended:
GenR1t(dc_cns, ip^.rval, 1, ip^.itype);
cgString: