Apple-2gs-SW/ORCA-C
1
0
Fork 0
mirror of https://github.com/byteworksinc/ORCA-C.git synced 2024-12-22 07:30:54 +00:00
Code Issues Projects Releases Wiki Activity
8077a248a4
ORCA-C/CGI.pas

1423 lines
52 KiB
ObjectPascal
Raw Normal View History

Change all text/source files to LF line endings.
2017-10-21 23:40:19 +00:00
{$optimize 7}
{---------------------------------------------------------------}
{ }
{ ORCA Code Generator Interface }
{ }
{ This unit serves as the glue code attaching a compiler }
{ to the code generator. It provides subroutines in a }
Spellcheck comments throughout the code. There are no non-comment changes.
2020-01-29 23:09:52 +00:00
{ format that is convenient for the compiler during }
Change all text/source files to LF line endings.
2017-10-21 23:40:19 +00:00
{ semantic analysis, and produces intermediate code records }
{ as output. These intermediate code records are then }
{ passed on to the code generator for optimization and }
{ native code generation. }
{ }
Do not copy CGI.Comments into CGI.pas. This has no functional effect, since it is all comments. It does mean that printed listings of CGI.pas would not contain those comments, but it is easy enough to restore if someone wants such listings. This change should make compilation slightly faster, and it also avoids issues with filetypes when using certain tools (since they cannot infer the filetype of CGI.Comments from its extension).
2021-02-12 00:53:25 +00:00
{ copy 'cgi.comments'}
Change all text/source files to LF line endings.
2017-10-21 23:40:19 +00:00
{---------------------------------------------------------------}
unit CodeGeneratorInterface;
interface
Move some more code out of the blank segment to make space for static data.
2017-07-15 00:45:40 +00:00
{$segment 'CG'}
Change all text/source files to LF line endings.
2017-10-21 23:40:19 +00:00
{$LibPrefix '0/obj/'}
uses CCommon;
const
{Error interface: these constants map }
{code generator error numbers into the }
{numbers used by the compiler's Error }
{subroutine. }
{--------------------------------------}
cge1 = 57; {compiler error}
cge2 = 58; {implementation restriction: too many local labels}
cge3 = 60; {implementation restriction: string space exhausted}
{65816 native code generation}
{----------------------------}
{instruction modifier flags}
shift8 = 1; {shift operand left 8 bits}
shift16 = 2; {shift operand left 16 bits}
toolCall = 4; {generate a tool call}
stringReference = 8; {generate a string reference}
isPrivate = 32; {is the label private?}
constantOpnd = 64; {the absolute operand is a constant}
localLab = 128; {the operand is a local lab}
m_adc_abs = $6D; {op code #s for 65816 instructions}
m_adc_dir = $65;
m_adc_imm = $69;
m_adc_s = $63;
Implement support for doing quad ops without loading operands on stack. This works when both operands are simple loads, such that they can be broken up into operations on their subwords in a standard format. Currently, this is implemented for bitwise binary ops, but it can also be expanded to arithmetic, etc.
2021-02-25 01:44:28 +00:00
m_adc_indl = $67;
Recognize more indirect long instructions in the native code optimizer. These instructions can be generated for indirect accesses to quad values, and the optimization can sometimes make those code sequences more efficient (e.g. avoiding unnecessary reloads of Y).
2021-03-03 01:19:00 +00:00
m_adc_indly = $77;
Change all text/source files to LF line endings.
2017-10-21 23:40:19 +00:00
m_and_abs = $2D;
m_and_dir = $25;
m_and_imm = $29;
m_and_s = $23;
Implement support for doing quad ops without loading operands on stack. This works when both operands are simple loads, such that they can be broken up into operations on their subwords in a standard format. Currently, this is implemented for bitwise binary ops, but it can also be expanded to arithmetic, etc.
2021-02-25 01:44:28 +00:00
m_and_indl = $27;
Recognize more indirect long instructions in the native code optimizer. These instructions can be generated for indirect accesses to quad values, and the optimization can sometimes make those code sequences more efficient (e.g. avoiding unnecessary reloads of Y).
2021-03-03 01:19:00 +00:00
m_and_indly = $37;
Change all text/source files to LF line endings.
2017-10-21 23:40:19 +00:00
m_asl_a = $0A;
m_bcc = $90;
m_bcs = $B0;
m_beq = $F0;
m_bit_imm = $89;
m_bmi = $30;
m_bne = $D0;
m_bpl = $10;
m_bra = $80;
m_brl = $82;
m_bvs = $70;
m_clc = $18;
m_cmp_abs = $CD;
m_cmp_dir = $C5;
m_cmp_dirX = $D5;
m_cmp_imm = $C9;
m_cmp_long = $CF;
m_cmp_s = $C3;
Implement support for doing quad ops without loading operands on stack. This works when both operands are simple loads, such that they can be broken up into operations on their subwords in a standard format. Currently, this is implemented for bitwise binary ops, but it can also be expanded to arithmetic, etc.
2021-02-25 01:44:28 +00:00
m_cmp_indl = $C7;
Recognize more indirect long instructions in the native code optimizer. These instructions can be generated for indirect accesses to quad values, and the optimization can sometimes make those code sequences more efficient (e.g. avoiding unnecessary reloads of Y).
2021-03-03 01:19:00 +00:00
m_cmp_indly = $D7;
Change all text/source files to LF line endings.
2017-10-21 23:40:19 +00:00
m_cop = $02;
m_cpx_abs = 236;
m_cpx_dir = 228;
m_cpx_imm = 224;
m_dea = 58;
m_dec_abs = 206;
m_dec_absX = $DE;
m_dec_dir = 198;
m_dec_dirX = 214;
m_dex = 202;
m_dey = 136;
m_eor_abs = 77;
m_eor_dir = 69;
m_eor_imm = 73;
m_eor_s = 67;
Implement support for doing quad ops without loading operands on stack. This works when both operands are simple loads, such that they can be broken up into operations on their subwords in a standard format. Currently, this is implemented for bitwise binary ops, but it can also be expanded to arithmetic, etc.
2021-02-25 01:44:28 +00:00
m_eor_indl = $47;
Recognize more indirect long instructions in the native code optimizer. These instructions can be generated for indirect accesses to quad values, and the optimization can sometimes make those code sequences more efficient (e.g. avoiding unnecessary reloads of Y).
2021-03-03 01:19:00 +00:00
m_eor_indly = $57;
Change all text/source files to LF line endings.
2017-10-21 23:40:19 +00:00
m_ina = 26;
m_inc_abs = 238;
m_inc_absX = $FE;
m_inc_dir = 230;
m_inc_dirX = 246;
m_inx = 232;
m_iny = 200;
m_jml = 92;
m_jsl = 34;
m_lda_abs = 173;
m_lda_absx = 189;
m_lda_dir = 165;
m_lda_dirx = 181;
m_lda_imm = 169;
m_lda_indl = 167;
m_lda_indly = 183;
m_lda_long = 175;
m_lda_longx = 191;
m_lda_s = 163;
m_ldx_abs = 174;
m_ldx_dir = 166;
m_ldx_imm = 162;
m_ldy_abs = 172;
m_ldy_absX = 188;
m_ldy_dir = 164;
m_ldy_dirX = 180;
m_ldy_imm = 160;
m_lsr_a = 74;
m_mvn = 84;
m_ora_abs = 13;
m_ora_dir = 5;
m_ora_dirX = 21;
m_ora_imm = 9;
Fix bug where comparing 32-bit values in static arrays or structs against 0 may give wrong results with large memory model. The issue was that 16-bit absolute addressing (in the data bank) was being used to access the data to compare, but with the large memory model the static arrays or structs are not necessarily in the same bank, so absolute long addressing should be used. This was sometimes causing failures in the C4.6.4.1.CC and C4.6.6.1.CC conformance tests in the ORCA/C test suite. The following program often demonstrates the problem (depending on memory layout and contents): #pragma memorymodel 1 #pragma optimize 1 #include <stdio.h> int i; char ch1[32000]; long L1[1]; int main (void) { if (L1 [0] != 0) printf("%li\n", L1[0]); /* shouldn't print */ /* buggy behavior can happen if the bank bytes of these pointers differ */ printf("%p %p\n", &L1[0], &i); }
2016-11-23 06:56:20 +00:00
m_ora_long = 15;
Change all text/source files to LF line endings.
2017-10-21 23:40:19 +00:00
m_ora_longX = 31;
m_ora_s = 3;
Implement support for doing quad ops without loading operands on stack. This works when both operands are simple loads, such that they can be broken up into operations on their subwords in a standard format. Currently, this is implemented for bitwise binary ops, but it can also be expanded to arithmetic, etc.
2021-02-25 01:44:28 +00:00
m_ora_indl = $07;
Recognize more indirect long instructions in the native code optimizer. These instructions can be generated for indirect accesses to quad values, and the optimization can sometimes make those code sequences more efficient (e.g. avoiding unnecessary reloads of Y).
2021-03-03 01:19:00 +00:00
m_ora_indly = $17;
Change all text/source files to LF line endings.
2017-10-21 23:40:19 +00:00
m_pea = 244;
m_pei_dir = 212;
m_pha = 72;
m_phb = 139;
m_phd = 11;
m_phx = 218;
m_phy = 90;
m_php = 8;
m_pla = 104;
m_plb = 171;
m_pld = 43;
m_plx = 250;
m_ply = 122;
m_plp = 40;
m_rep = 194;
m_rtl = 107;
m_rts = 96;
m_sbc_abs = 237;
m_sbc_dir = 229;
m_sbc_imm = 233;
m_sbc_s = 227;
Implement support for doing quad ops without loading operands on stack. This works when both operands are simple loads, such that they can be broken up into operations on their subwords in a standard format. Currently, this is implemented for bitwise binary ops, but it can also be expanded to arithmetic, etc.
2021-02-25 01:44:28 +00:00
m_sbc_indl = $E7;
Recognize more indirect long instructions in the native code optimizer. These instructions can be generated for indirect accesses to quad values, and the optimization can sometimes make those code sequences more efficient (e.g. avoiding unnecessary reloads of Y).
2021-03-03 01:19:00 +00:00
m_sbc_indly = $F7;
Change all text/source files to LF line endings.
2017-10-21 23:40:19 +00:00
m_sec = 56;
m_sep = 226;
m_sta_abs = 141;
m_sta_absX = 157;
m_sta_dir = 133;
m_sta_dirX = 149;
m_sta_indl = 135;
m_sta_indlY = 151;
m_sta_long = 143;
m_sta_longX = 159;
m_sta_s = 131;
m_stx_dir = 134;
m_stx_abs = 142;
m_sty_abs = 140;
m_sty_dir = 132;
m_sty_dirX = 148;
m_stz_abs = 156;
m_stz_absX = 158;
m_stz_dir = 100;
m_stz_dirX = 116;
m_tax = 170;
m_tay = 168;
m_tcd = 91;
m_tcs = 27;
m_tdc = 123;
m_tsx = $BA;
m_txa = 138;
m_txs = $9A;
m_txy = 155;
m_tya = 152;
m_tyx = 187;
m_tsb_dir = $04;
m_tsb_abs = $0C;
m_tsc = 59;
m_xba = $EB;
d_lab = 256;
d_end = 257;
d_bmov = 258;
d_add = 259;
d_pin = 260;
d_wrd = 261;
d_sym = 262;
d_cns = 263;
max_opcode = 263;
{Code Generation}
{---------------}
maxCBuff = 191; {length of constant buffer}
{Note: maxlabel is also defined in CCommon.pas}
Increase the limit on the number of intermediate code labels in a function from 2400 to 3200. This is necessary to compile some very large functions, such as the main interpreter loop in Git. This consumes about 8K of extra memory for the additional label records.
2016-11-24 03:03:04 +00:00
{Note: maxlabel is also defined in CGC.asm}
maxLabel = 3200; {max # of internal labels}
Increase the maximum allowed number of local variables from 200 to 220.
2017-07-15 02:07:23 +00:00
maxLocalLabel = 220; {max # local variables}
Increase the total size of string constants permitted in each function. The size limit is increased from 8000 bytes to 12500 bytes. This was needed to compile some functions with many string constants.
2017-06-19 03:10:46 +00:00
maxString = 12500; {max # chars in string space}
Change all text/source files to LF line endings.
2017-10-21 23:40:19 +00:00
{size of internal types}
{----------------------}
cgByteSize = 1;
cgWordSize = 2;
cgLongSize = 4;
Initial code to recognize 'long long' as a type.
2021-01-30 02:50:21 +00:00
cgQuadSize = 8;
Change all text/source files to LF line endings.
2017-10-21 23:40:19 +00:00
cgPointerSize = 4;
cgRealSize = 4;
cgDoubleSize = 8;
cgCompSize = 8;
cgExtendedSize = 10;
type
segNameType = packed array[1..10] of char; {segment name}
{p code}
{------}
pcodes = {pcode names}
(pc_adi,pc_adr,pc_and,pc_dvi,pc_dvr,pc_cnn,pc_cnv,pc_ior,pc_mod,pc_mpi,
pc_mpr,pc_ngi,pc_ngr,pc_not,pc_sbi,pc_sbr,pc_sto,pc_dec,dc_loc,pc_ent,
pc_fjp,pc_inc,pc_ind,pc_ixa,pc_lao,pc_lca,pc_ldo,pc_mov,pc_ret,pc_sro,
pc_xjp,pc_cup,pc_equ,pc_geq,pc_grt,pc_lda,pc_ldc,pc_ldl,pc_leq,pc_les,
pc_lil,pc_lld,pc_lli,pc_lod,pc_neq,pc_str,pc_ujp,pc_add,pc_lnm,pc_nam,
pc_cui,pc_lad,pc_tjp,dc_lab,pc_usr,pc_umi,pc_udi,
pc_uim,dc_enp,pc_stk,dc_glb,dc_dst,dc_str,pc_cop,pc_cpo,pc_tl1,
dc_pin,pc_shl,pc_shr,pc_bnd,pc_bor,pc_bxr,pc_bnt,pc_bnl,pc_mpl,pc_dvl,
pc_mdl,pc_sll,pc_slr,pc_bal,pc_ngl,pc_adl,pc_sbl,pc_blr,pc_blx,
dc_sym,pc_lnd,pc_lor,pc_vsr,pc_uml,pc_udl,pc_ulm,pc_pop,pc_gil,
pc_gli,pc_gdl,pc_gld,pc_cpi,pc_tri,pc_lbu,pc_lbf,pc_sbf,pc_cbf,dc_cns,
Implement bitwise and/or/xor for 64-bit types. This introduces three new intermediate codes for these operations.
2021-01-30 06:25:15 +00:00
dc_prm,pc_nat,pc_bno,pc_nop,pc_psh,pc_ili,pc_iil,pc_ild,pc_idl,
Implement 64-bit division and remainder, signed and unsigned. These operations rely on new library routines in ORCALib (~CDIV8 and ~UDIV8).
2021-02-05 18:42:48 +00:00
pc_bqr,pc_bqx,pc_baq,pc_bnq,pc_ngq,pc_adq,pc_sbq,pc_mpq,pc_umq,pc_dvq,
Recognize byte swapping and generate an xba instruction for it. Specifically, this recognizes the pattern "(exp << 8) | (exp >> 8)", where exp has an unsigned 16-bit type and does not have side effects.
2021-03-06 03:59:18 +00:00
pc_udq,pc_mdq,pc_uqm,pc_slq,pc_sqr,pc_wsr,pc_rbo);
Change all text/source files to LF line endings.
2017-10-21 23:40:19 +00:00
{intermediate code}
{-----------------}
icptr = ^intermediate_code;
intermediate_code = record {intermediate code record}
opcode: pcodes; {operation code}
q,r,s: integer; {operands}
lab: stringPtr; {named label pointer}
next: icptr; {ptr to next statement}
left, right: icptr; {leaves for trees}
parents: integer; {number of parents}
case optype: baseTypeEnum of
cgByte,
cgUByte,
cgWord,
cgUWord : (opnd: longint; llab,slab: integer);
cgLong,
cgULong : (lval: longint);
Initial code to recognize 'long long' as a type.
2021-01-30 02:50:21 +00:00
cgQuad,
cgUQuad : (qval: longlong);
Change all text/source files to LF line endings.
2017-10-21 23:40:19 +00:00
cgReal,
cgDouble,
cgComp,
Process floating-point values within the compiler using the extended type. This means that floating-point constants can now have the range and precision of the extended type (aka long double), and floating-point constant expressions evaluated within the compiler also have that same range and precision (matching expressions evaluated at run time). This new behavior is intended to match the behavior specified in the C99 and later standards for FLT_EVAL_METHOD 2. This fixes the previous problem where long double constants and constant expressions of type long double were not represented and evaluated with the full range and precision that they should be. It also gives extra range and precision to constants and constant expressions of type double or float. This may have pluses and minuses, but at any rate it is consistent with the existing behavior for expressions evaluated at run time, and with one of the possible models of floating point evaluation specified in the C standards.
2021-03-05 05:52:41 +00:00
cgExtended : (rval: extended);
Change all text/source files to LF line endings.
2017-10-21 23:40:19 +00:00
cgString : (str: longStringPtr);
cgVoid,
ccPointer : (pval: longint; pstr: longStringPtr);
end;
{basic blocks}
{------------}
iclist = ^iclistRecord; {used to form lists of records}
iclistRecord = record
next: iclist;
op: icptr;
end;
blockPtr = ^block; {basic block edges}
blockListPtr = ^blockListRecord; {lists of blocks}
block = record
last, next: blockPtr; {for doubly linked list of blocks}
dfn: integer; {depth first order index}
visited: boolean; {has this node been visited?}
code: icptr; {code in the block}
c_in: iclist; {list of reaching definitions}
c_out: iclist; {valid definitions on exit}
c_gen: iclist; {generated definitions}
dom: blockListPtr; {dominators of this block}
end;
blockListRecord = record {lists of blocks}
next, last: blockListPtr;
dfn: integer;
end;
{65816 native code generation}
{----------------------------}
addressingMode = (implied,immediate, {65816 addressing modes}
longabs,longrelative,relative,absolute,direct,gnrLabel,gnrSpace,
gnrConstant,genaddress,special,longabsolute);
var
{current instruction info}
{------------------------}
isJSL: boolean; {is the current opcode a jsl?}
{65816 native code generation}
{----------------------------}
longA,longI: boolean; {register sizes}
{variables used to control the }
{quality or characteristics of }
{code }
{------------------------------}
checkStack: boolean; {check stack for stack errors?}
cLineOptimize: boolean; {+o flag set?}
code: icptr; {current intermediate code record}
codeGeneration: boolean; {is code generation on?}
commonSubexpression: boolean; {do common subexpression removal?}
currentSegment,defaultSegment: segNameType; {current & default seg names}
segmentKind: integer; {kind field of segment (ored with start/data)}
debugFlag: boolean; {generate debugger calls?}
Add support for inline procedure names as documented in IIgs tech note #103. These are enabled when bit 15 is set in the #pragma debug directive. Support is still needed to ensure these work properly with pre-compiled headers. This patch is from Kelvin Sherlock.
2017-09-10 00:23:27 +00:00
debugStrFlag: boolean; {gsbug/niftylist debug names?}
Change all text/source files to LF line endings.
2017-10-21 23:40:19 +00:00
dataBank: boolean; {save, restore data bank?}
floatCard: integer; {0 -> SANE; 1 -> FPE}
floatSlot: integer; {FPE slot}
loopOptimizations: boolean; {do loop optimizations?}
noroot: boolean; {prevent creation of .root file?}
npeephole: boolean; {do native code peephole optimizations?}
peephole: boolean; {do peephole optimization?}
profileFlag: boolean; {generate profiling code?}
rangeCheck: boolean; {generate range checks?}
registers: boolean; {do register optimizations?}
rtl: boolean; {return with an rtl?}
saveStack: boolean; {save, restore caller's stack reg?}
smallMemoryModel: boolean; {is the small model in use?}
stackSize: integer; {amount of stack space to reserve}
strictVararg: boolean; {repair stack around vararg calls?}
stringsize: 0..maxstring; {amount of string space left}
stringspace: packed array[1..maxstring] of char; {string table}
symLength: integer; {length of debug symbol table}
Spellcheck comments throughout the code. There are no non-comment changes.
2020-01-29 23:09:52 +00:00
toolParms: boolean; {generate tool format parameters?}
Change all text/source files to LF line endings.
2017-10-21 23:40:19 +00:00
volatile: boolean; {has a volatile qualifier been used?}
Don't allocate stack space for varargs stack repair unless it's needed. If there are no varargs calls (and nothing else that saves stack positions), then space doesn't need to be allocated for the saved stack position. This can also lead to more efficient prolog/epilog code for small functions.
2018-01-14 02:02:43 +00:00
hasVarargsCall: boolean; {does current function call any varargs fns?}
Change all text/source files to LF line endings.
2017-10-21 23:40:19 +00:00
{desk accessory variables}
{------------------------}
isNewDeskAcc: boolean; {is this a new desk acc?}
isClassicDeskAcc: boolean; {is this a classic desk acc?}
isCDev: boolean; {is this a control panel device?}
isNBA: boolean; {is this a new button action?}
isXCMD: boolean; {is this an XCMD?}
openName,closeName,actionName, {names of the required procedures}
initName: stringPtr;
refreshPeriod: integer; {refresh period}
eventMask: integer; {event mask}
menuLine: pString; {name in menu bar}
{DAG construction}
{----------------}
DAGhead: icPtr; {1st ic in DAG list}
DAGblocks: blockPtr; {list of basic blocks}
{---------------------------------------------------------------}
procedure CodeGenFini;
{ terminal processing }
procedure CodeGenInit (keepName: gsosOutStringPtr; keepFlag: integer;
partial: boolean);
{ code generator initialization }
{ }
{ parameters: }
{ keepName - name of the output file }
{ keepFlag - keep status: }
{ 0 - don't keep the output }
{ 1 - create a new object module }
{ 2 - a .root already exists }
{ 3 - at least on .letter file exists }
{ partial - is this a partial compile? }
procedure CodeGenScalarInit;
{ initialize codegen scalars }
{procedure InitWriteCode; {debug}
{ initialize the intermediate code opcode table }
procedure Gen0 (fop: pcodes);
{ generate an implied operand instruction }
{ }
{ parameters: }
{ fop - operation code }
procedure Gen1 (fop: pcodes; fp2: integer);
{ generate an instruction with one numeric operand }
{ }
{ parameters: }
{ fop - operation code }
{ fp2 - operand }
procedure Gen2 (fop: pcodes; fp1, fp2: integer);
{ generate an instruction with two numeric operands }
{ }
{ parameters: }
{ fop - operation code }
{ fp1 - first operand }
{ fp2 - second operand }
procedure Gen3 (fop: pcodes; fp1, fp2, fp3: integer);
{ generate an instruction with three numeric operands }
{ }
{ parameters: }
{ fop - operation code }
{ fp1 - first operand }
{ fp2 - second operand }
{ fp3 - third operand }
procedure Gen0Name (fop: pcodes; name: stringPtr);
{ generate a p-code with a name }
{ }
{ parameters: }
{ fop - operation code }
{ name - named label }
procedure Gen1Name (fop: pcodes; fp1: integer; name: stringPtr);
{ generate a one operand p-code with a name }
{ }
{ parameters: }
{ fop - operation code }
{ fp1 - first operand }
{ name - named label }
procedure Gen2Name (fop: pcodes; fp1, fp2: integer; name: stringPtr);
{ generate a two operand p-code with a name }
{ }
{ parameters: }
{ fop - operation code }
{ fp1 - first operand }
{ fp2 - second operand }
{ name - named label }
procedure Gen0tName (fop: pcodes; tp: baseTypeEnum; name: stringPtr);
{ generate a typed zero operand p-code with a name }
{ }
{ parameters: }
{ fop - operation code }
{ tp - base type }
{ name - named label }
procedure Gen1tName (fop: pcodes; fp1: integer; tp: baseTypeEnum;
name: stringPtr);
{ generate a typed one operand p-code with a name }
{ }
{ parameters: }
{ fop - operation code }
{ fp1 - first operand }
{ tp - base type }
{ name - named label }
procedure Gen2tName (fop: pcodes; fp1, fp2: integer; tp: baseTypeEnum;
name: stringPtr);
{ generate a typed two operand p-code with a name }
{ }
{ parameters: }
{ fop - operation code }
{ fp1 - first operand }
{ fp2 - second operand }
{ tp - base type }
{ name - named label }
procedure Gen0t (fop: pcodes; tp: baseTypeEnum);
{ generate a typed implied operand instruction }
{ }
{ parameters: }
{ fop - operation code }
{ tp - base type }
procedure Gen1t (fop: pcodes; fp1: integer; tp: baseTypeEnum);
{ generate a typed instruction with two numeric operands }
{ }
{ parameters: }
{ fop - operation code }
{ fp1 - operand }
{ tp - base type }
procedure Gen2t (fop: pcodes; fp1, fp2: integer; tp: baseTypeEnum);
{ generate a typed instruction with two numeric operands }
{ }
{ parameters: }
{ fop - operation code }
{ fp1 - first operand }
{ fp2 - second operand }
{ tp - base type }
procedure Gen3t (fop: pcodes; fp1, fp2, fp3: integer; tp: baseTypeEnum);
{ generate a typed instruction with three numeric operands }
{ }
{ parameters: }
{ fop - operation code }
{ fp1 - first operand }
{ fp2 - second operand }
{ fp3 - second operand }
{ tp - base type }
procedure GenPS (fop: pcodes; str: stringPtr);
{ generate an instruction that uses a p-string operand }
{ }
{ parameters: }
{ fop - operation code }
{ str - pointer to string }
procedure GenS (fop: pcodes; str: longstringPtr);
{ generate an instruction that uses a string operand }
{ }
{ parameters: }
{ fop - operation code }
{ str - pointer to string }
procedure GenL1 (fop: pcodes; lval: longint; fp1: integer);
{ generate an instruction that uses a longint and an int }
{ }
{ parameters: }
{ lval - longint parameter }
{ fp1 - integer parameter }
Add support for emitting 64-bit constants in statically-initialized data.
2021-02-04 08:17:10 +00:00
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 }
Process floating-point values within the compiler using the extended type. This means that floating-point constants can now have the range and precision of the extended type (aka long double), and floating-point constant expressions evaluated within the compiler also have that same range and precision (matching expressions evaluated at run time). This new behavior is intended to match the behavior specified in the C99 and later standards for FLT_EVAL_METHOD 2. This fixes the previous problem where long double constants and constant expressions of type long double were not represented and evaluated with the full range and precision that they should be. It also gives extra range and precision to constants and constant expressions of type double or float. This may have pluses and minuses, but at any rate it is consistent with the existing behavior for expressions evaluated at run time, and with one of the possible models of floating point evaluation specified in the C standards.
2021-03-05 05:52:41 +00:00
procedure GenR1t (fop: pcodes; rval: extended; fp1: integer; tp: baseTypeEnum);
Change all text/source files to LF line endings.
2017-10-21 23:40:19 +00:00
{ generate an instruction that uses a real and an int }
{ }
{ parameters: }
{ rval - real parameter }
{ fp1 - integer parameter }
{ tp - base type }
procedure GenLdcLong (lval: longint);
{ load a long constant }
{ }
{ parameters: }
{ lval - value to load }
Initial support for constants with long long types. Currently, the actual values they can have are still constrained to the 32-bit range. Also, there are some bits of functionality (e.g. for initializers) that are not implemented yet.
2021-02-04 05:11:23 +00:00
procedure GenLdcQuad (qval: longlong);
{ load a long long constant }
{ }
{ parameters: }
{ qval - value to load }
Process floating-point values within the compiler using the extended type. This means that floating-point constants can now have the range and precision of the extended type (aka long double), and floating-point constant expressions evaluated within the compiler also have that same range and precision (matching expressions evaluated at run time). This new behavior is intended to match the behavior specified in the C99 and later standards for FLT_EVAL_METHOD 2. This fixes the previous problem where long double constants and constant expressions of type long double were not represented and evaluated with the full range and precision that they should be. It also gives extra range and precision to constants and constant expressions of type double or float. This may have pluses and minuses, but at any rate it is consistent with the existing behavior for expressions evaluated at run time, and with one of the possible models of floating point evaluation specified in the C standards.
2021-03-05 05:52:41 +00:00
procedure GenLdcReal (rval: extended);
Change all text/source files to LF line endings.
2017-10-21 23:40:19 +00:00
{ load a real constant }
{ }
{ parameters: }
{ rval - value to load }
procedure GenTool (fop: pcodes; fp1, fp2: integer; dispatcher: longint);
{ generate a tool call }
{ }
{ parameters: }
{ fop - operation code }
{ fp1 - tool number }
{ fp2 - return size }
{ dispatcher - tool entry point }
{procedure PrintBlocks (tag: stringPtr; bp: blockPtr); {debug}
{ print a series of basic blocks }
{ }
{ parameters: }
{ tag - label for lines }
{ bp - first block to print }
function TypeSize (tp: baseTypeEnum): integer;
{ Find the size, in bytes, of a variable }
{ }
{ parameters: }
{ tp - base type of the variable }
{procedure WriteCode (code: icptr); {debug}
{ print an intermediate code instruction }
{ }
{ Parameters: }
{ code - intermediate code instruction to write }
Make floating-point casts reduce the range and precision of numbers. The C standards generally allow floating-point operations to be done with extra range and precision, but they require that explicit casts convert to the actual type specified. ORCA/C was not previously doing that. This patch relies on some new library routines (currently in ORCALib) to do this precision reduction. This fixes #64.
2021-03-07 04:28:39 +00:00
procedure LimitPrecision (var rval: extended; tp: baseTypeEnum);
{ limit the precision and range of a real value to the type. }
{ }
{ parameters: }
{ rval - real value }
{ tp - type to limit precision to }
Change all text/source files to LF line endings.
2017-10-21 23:40:19 +00:00
{------------------------------------------------------------------------------}
implementation
{var
opt: array[pcodes] of packed array[1..3] of char; {debug}
{Imported from CGC.pas:}
function Calloc (bytes: integer): ptr; extern;
{ Allocate memory from a pool and clear it. }
{ }
{ Parameters: }
{ bytes - number of bytes to allocate }
{ ptr - points to the first byte of the allocated memory }
{ }
{ Globals: }
{ useGlobalPool - should the memory come from the global }
{ (or local) pool }
procedure Error (err: integer); extern; {in scanner.pas}
{ flag an error }
{ }
{ err - error number }
function Malloc (bytes: integer): ptr; extern;
{ Allocate memory from a pool. }
{ }
{ Parameters: }
{ bytes - number of bytes to allocate }
{ ptr - points to the first byte of the allocated memory }
{ }
{ Globals: }
{ useGlobalPool - should the memory come from the global }
{ (or local) pool }
procedure InitLabels; extern;
{ initialize the labels array for a procedure }
{Imported from ObjOut.pas:}
procedure CloseObj; extern;
{ close the current obj file }
{Imported from Native.pas:}
procedure InitFile (keepName: gsosOutStringPtr; keepFlag: integer; partial: boolean);
extern;
{ Set up the object file }
{ }
{ parameters: }
{ keepName - name of the output file }
{ keepFlag - keep status: }
{ 0 - don't keep the output }
{ 1 - create a new object module }
{ 2 - a .root already exists }
{ 3 - at least on .letter file exists }
{ partial - is this a partial compile? }
{Imported from DAG.pas:}
procedure DAG (code: icptr); extern;
{ place an op code in a DAG or tree }
{ }
{ parameters: }
{ code - opcode }
{------------------------------------------------------------------------------}
{ copy 'cgi.debug'} {debug}
procedure CodeGenInit {keepName: gsosOutStringPtr; keepFlag: integer;
partial: boolean};
{ code generator initialization }
{ }
{ parameters: }
{ keepName - name of the output file }
{ keepFlag - keep status: }
{ 0 - don't keep the output }
{ 1 - create a new object module }
{ 2 - a .root already exists }
{ 3 - at least on .letter file exists }
{ partial - is this a partial compile? }
begin {CodeGenInit}
{initialize the debug tables {debug}
{InitWriteCode; {debug}
{initialize the label table}
InitLabels;
codeGeneration := true; {turn on code generation}
{set up the DAG variables}
DAGhead := nil; {no ics in DAG list}
InitFile(keepName, keepFlag, partial); {open the interface file}
end; {CodeGenInit}
procedure CodeGenFini;
{ terminal processing }
begin {CodeGenFini}
CloseObj; {close the open object file}
end; {CodeGenFini}
procedure CodeGenScalarInit;
{ initialize codegen scalars }
begin {CodeGenScalarInit}
isJSL := false; {the current opcode is not a jsl}
isNewDeskAcc := false; {assume a normal program}
isCDev := false;
isClassicDeskAcc := false;
isNBA := false;
isXCMD := false;
codeGeneration := false; {code generation is not turned on yet}
currentSegment := ' '; {start with the blank segment}
defaultSegment := ' ';
smallMemoryModel := true; {small memory model}
dataBank := false; {don't save/restore data bank}
strictVararg := not cLineOptimize; {save/restore caller's stack around vararg}
saveStack := not cLineOptimize; {save/restore caller's stack reg}
checkStack := false; {don't check stack for stack errors}
stackSize := 0; {default to the launcher's stack size}
toolParms := false; {generate tool format parameters?}
noroot := false; {create a .root segment}
rtl := false; {return with a ~QUIT}
floatCard := 0; {use SANE}
floatSlot := 0; {default to slot 0}
stringSize := 0; {no strings, yet}
rangeCheck := false; {don't generate range checks}
profileFlag := false; {don't generate profiling code}
debugFlag := false; {don't generate debug code}
Add support for inline procedure names as documented in IIgs tech note #103. These are enabled when bit 15 is set in the #pragma debug directive. Support is still needed to ensure these work properly with pre-compiled headers. This patch is from Kelvin Sherlock.
2017-09-10 00:23:27 +00:00
debugStrFlag := false; {don't generate gsbug debug strings}
Change all text/source files to LF line endings.
2017-10-21 23:40:19 +00:00
traceBack := false; {don't generate traceback code}
Spellcheck comments throughout the code. There are no non-comment changes.
2020-01-29 23:09:52 +00:00
volatile := false; {no volatile qualifiers found}
Change all text/source files to LF line endings.
2017-10-21 23:40:19 +00:00
registers := cLineOptimize; {don't do register optimizations}
peepHole := cLineOptimize; {not doing peephole optimization (yet)}
npeepHole := cLineOptimize;
commonSubexpression := cLineOptimize; {not doing common subexpression elimination}
loopOptimizations := cLineOptimize; {not doing loop optimizations, yet}
{allocate the initial p-code}
code := pointer(Calloc(sizeof(intermediate_code)));
code^.optype := cgWord;
end; {CodeGenScalarInit}
procedure Gen0 {fop: pcodes};
{ generate an implied operand instruction }
{ }
{ parameters: }
{ fop - operation code }
begin {Gen0}
if codeGeneration then begin
{generate the intermediate code instruction}
code^.opcode := fop;
{ if printSymbols then {debug}
{ WriteCode(code); {debug}
DAG(code); {generate the code}
Spellcheck comments throughout the code. There are no non-comment changes.
2020-01-29 23:09:52 +00:00
{initialize volatile variables for next intermediate code}
Change all text/source files to LF line endings.
2017-10-21 23:40:19 +00:00
code := pointer(Calloc(sizeof(intermediate_code)));
{code^.lab := nil;}
code^.optype := cgWord;
end; {if}
end; {Gen0}
procedure Gen1 {fop: pcodes; fp2: integer};
{ generate an instruction with one numeric operand }
{ }
{ parameters: }
{ fop - operation code }
{ fp2 - operand }
begin {Gen1}
if codeGeneration then begin
if fop = pc_ret then
code^.optype := cgVoid;
code^.q := fp2;
Gen0(fop);
end; {if}
end; {Gen1}
procedure Gen2 {fop: pcodes; fp1, fp2: integer};
{ generate an instruction with two numeric operands }
{ }
{ parameters: }
{ fop - operation code }
{ fp1 - first operand }
{ fp2 - second operand }
label 1;
var
lcode: icptr; {local copy of code}
begin {Gen2}
if codeGeneration then begin
lcode := code;
case fop of
pc_lnm,pc_tl1,pc_lda,dc_loc,pc_mov: begin
lcode^.r := fp1;
lcode^.q := fp2;
end;
pc_cnn,pc_cnv:
Make floating-point casts reduce the range and precision of numbers. The C standards generally allow floating-point operations to be done with extra range and precision, but they require that explicit casts convert to the actual type specified. ORCA/C was not previously doing that. This patch relies on some new library routines (currently in ORCALib) to do this precision reduction. This fixes #64.
2021-03-07 04:28:39 +00:00
if (fp1 = fp2)
and not (baseTypeEnum(fp2) in [cgReal,cgDouble,cgComp]) then
Change all text/source files to LF line endings.
2017-10-21 23:40:19 +00:00
goto 1
else if (baseTypeEnum(fp1) in [cgReal,cgDouble,cgComp,cgExtended])
Make floating-point casts reduce the range and precision of numbers. The C standards generally allow floating-point operations to be done with extra range and precision, but they require that explicit casts convert to the actual type specified. ORCA/C was not previously doing that. This patch relies on some new library routines (currently in ORCALib) to do this precision reduction. This fixes #64.
2021-03-07 04:28:39 +00:00
and (baseTypeEnum(fp2) = cgExtended) then
Change all text/source files to LF line endings.
2017-10-21 23:40:19 +00:00
goto 1
else if (baseTypeEnum(fp1) in [cgUByte,cgWord,cgUWord])
and (baseTypeEnum(fp2) in [cgWord,cgUWord]) then
goto 1
Do an explicit conversion when converting from signed to unsigned byte values. This is needed because the value is held in a 16-bit register, sign-extended. The high 8 bits need to be cleared to convert to an unsigned byte. This fixes the compca06.c test case. Note that this generates inefficient code in the case of loading a signed byte value and then immediately casting it to unsigned (it first sign-extends the value, then masks off the high bits). This should be optimized, but at least the generated code is correct now.
2015-12-22 05:01:53 +00:00
else if (baseTypeEnum(fp1) in [cgUByte])
Change all text/source files to LF line endings.
2017-10-21 23:40:19 +00:00
and (baseTypeEnum(fp2) in [cgByte,cgUByte]) then
goto 1
Change Byte -> UByte conversion to use a "Word -> UByte" conversion, rather than introducing a new "Byte -> UByte" conversion. The latter would require more changes to the code generator to understand it, whereas this approach doesn't require any changes. This is arguably less clean, but it matches other places where a byte value is subsequently operated on as a word without an explicit conversion, and the assembly instruction generated is the same.
2015-12-26 00:46:15 +00:00
else if (baseTypeEnum(fp1) = cgByte)
and (baseTypeEnum(fp2) = cgUByte) then
lcode^.q := (ord(cgWord) << 4) | ord(cgUByte)
Change all text/source files to LF line endings.
2017-10-21 23:40:19 +00:00
else
lcode^.q := (fp1 << 4) | fp2;
otherwise:
Error(cge1);
end; {case}
Gen0(fop);
end; {if}
1:
end; {Gen2}
procedure Gen3 {fop: pcodes; fp1, fp2, fp3: integer};
{ generate an instruction with three numeric operands }
{ }
{ parameters: }
{ fop - operation code }
{ fp1 - first operand }
{ fp2 - second operand }
{ fp3 - third operand }
var
lcode: icptr; {local copy of code}
begin {Gen3}
if codeGeneration then begin
lcode := code;
lcode^.s := fp1;
lcode^.q := fp2;
lcode^.r := fp3;
Gen0(fop);
end; {if}
end; {Gen3}
procedure Gen0Name {fop: pcodes; name: stringPtr};
{ generate a p-code with a name }
{ }
{ parameters: }
{ fop - operation code }
{ name - named label }
begin {Gen0Name}
if codeGeneration then begin
code^.lab := name;
Gen0(fop);
end; {if}
end; {Gen0Name}
procedure Gen1Name {fop: pcodes; fp1: integer; name: stringPtr};
{ generate a one operand p-code with a name }
{ }
{ parameters: }
{ fop - operation code }
{ fp1 - first operand }
{ name - named label }
var
lcode: icptr; {local copy of code}
begin {Gen1Name}
if codeGeneration then begin
lcode := code;
lcode^.q := fp1;
lcode^.lab := name;
Gen0(fop);
end; {if}
end; {Gen1Name}
procedure Gen2Name {fop: pcodes; fp1, fp2: integer; name: stringPtr};
{ generate a two operand p-code with a name }
{ }
{ parameters: }
{ fop - operation code }
{ fp1 - first operand }
{ fp2 - second operand }
{ name - named label }
var
lcode: icptr; {local copy of code}
begin {Gen2Name}
if codeGeneration then begin
lcode := code;
lcode^.q := fp2;
lcode^.r := fp1;
lcode^.lab := name;
Gen0(fop);
end; {if}
end; {Gen2Name}
procedure Gen0tName {fop: pcodes; tp: baseTypeEnum; name: stringPtr};
{ generate a typed zero operand p-code with a name }
{ }
{ parameters: }
{ fop - operation code }
{ tp - base type }
{ name - named label }
var
lcode: icptr; {local copy of code}
begin {Gen0tName}
if codeGeneration then begin
lcode := code;
lcode^.lab := name;
lcode^.optype := tp;
Gen0(fop);
end; {if}
end; {Gen0tName}
procedure Gen1tName {fop: pcodes; fp1: integer; tp: baseTypeEnum;
name: stringPtr};
{ generate a typed one operand p-code with a name }
{ }
{ parameters: }
{ fop - operation code }
{ fp1 - first operand }
{ tp - base type }
{ name - named label }
var
lcode: icptr; {local copy of code}
begin {Gen1tName}
if codeGeneration then begin
lcode := code;
lcode^.q := fp1;
lcode^.lab := name;
lcode^.optype := tp;
Gen0(fop);
end; {if}
end; {Gen1tName}
procedure Gen2tName {fop: pcodes; fp1, fp2: integer; tp: baseTypeEnum;
name: stringPtr};
{ generate a typed two operand p-code with a name }
{ }
{ parameters: }
{ fop - operation code }
{ fp1 - first operand }
{ fp2 - second operand }
{ tp - base type }
{ name - named label }
var
lcode: icptr; {local copy of code}
begin {Gen2tName}
if codeGeneration then begin
lcode := code;
lcode^.r := fp1;
lcode^.q := fp2;
lcode^.lab := name;
lcode^.optype := tp;
Gen0(fop);
end; {if}
end; {Gen2tName}
procedure Gen0t {fop: pcodes; tp: baseTypeEnum};
{ generate a typed implied operand instruction }
{ }
{ parameters: }
{ fop - operation code }
{ tp - base type }
begin {Gen0t}
if codeGeneration then begin
code^.optype := tp;
Gen0(fop);
end; {if}
end; {Gen0t}
procedure Gen1t {fop: pcodes; fp1: integer; tp: baseTypeEnum};
{ generate a typed instruction with one numeric operand }
{ }
{ parameters: }
{ fop - operation code }
{ fp1 - operand }
{ tp - base type }
var
lcode: icptr; {local copy of code}
begin {Gen1t}
if codeGeneration then begin
lcode := code;
lcode^.optype := tp;
lcode^.q := fp1;
Gen0(fop);
end; {if}
end; {Gen1t}
procedure Gen2t {fop: pcodes; fp1, fp2: integer; tp: baseTypeEnum};
{ generate a typed instruction with two numeric operands }
{ }
{ parameters: }
{ fop - operation code }
{ fp1 - first operand }
{ fp2 - second operand }
{ tp - base type }
var
lcode: icptr; {local copy of code}
begin {Gen2t}
if codeGeneration then begin
lcode := code;
lcode^.optype := tp;
lcode^.r := fp1;
lcode^.q := fp2;
Gen0(fop);
end; {if}
end; {Gen2t}
procedure Gen3t {fop: pcodes; fp1, fp2, fp3: integer; tp: baseTypeEnum};
{ generate a typed instruction with three numeric operands }
{ }
{ parameters: }
{ fop - operation code }
{ fp1 - first operand }
{ fp2 - second operand }
{ fp3 - second operand }
{ tp - base type }
var
lcode: icptr; {local copy of code}
begin {Gen3t}
if codeGeneration then begin
lcode := code;
lcode^.optype := tp;
lcode^.s := fp1;
lcode^.q := fp2;
lcode^.r := fp3;
Gen0(fop);
end; {if}
end; {Gen3t}
procedure GenPS {fop: pcodes; str: stringPtr};
{ generate an instruction that uses a p-string operand }
{ }
{ parameters: }
{ fop - operation code }
{ str - pointer to string }
var
lcode: icptr; {local copy of code}
begin {GenPS}
if codeGeneration then begin
lcode := code;
lcode^.optype := cgString;
lcode^.q := length(str^);
lcode^.str := pointer(ord4(str)-1);
Gen0(fop);
end; {if}
end; {GenPS}
procedure GenS {fop: pcodes; str: longstringPtr};
{ generate an instruction that uses a string operand }
{ }
{ parameters: }
{ fop - operation code }
{ str - pointer to string }
var
lcode: icptr; {local copy of code}
begin {GenS}
if codeGeneration then begin
lcode := code;
lcode^.optype := cgString;
lcode^.q := str^.length;
lcode^.str := str;
Gen0(fop);
end; {if}
end; {GenS}
procedure GenL1 {fop: pcodes; lval: longint; fp1: integer};
{ generate an instruction that uses a longint and an int }
{ }
{ parameters: }
{ lval - longint parameter }
{ fp1 - integer parameter }
var
lcode: icptr; {local copy of code}
begin {GenL1}
if codeGeneration then begin
lcode := code;
lcode^.optype := cgLong;
lcode^.lval := lval;
lcode^.q := fp1;
Gen0(fop);
end; {if}
end; {GenL1}
Add support for emitting 64-bit constants in statically-initialized data.
2021-02-04 08:17:10 +00:00
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}
Process floating-point values within the compiler using the extended type. This means that floating-point constants can now have the range and precision of the extended type (aka long double), and floating-point constant expressions evaluated within the compiler also have that same range and precision (matching expressions evaluated at run time). This new behavior is intended to match the behavior specified in the C99 and later standards for FLT_EVAL_METHOD 2. This fixes the previous problem where long double constants and constant expressions of type long double were not represented and evaluated with the full range and precision that they should be. It also gives extra range and precision to constants and constant expressions of type double or float. This may have pluses and minuses, but at any rate it is consistent with the existing behavior for expressions evaluated at run time, and with one of the possible models of floating point evaluation specified in the C standards.
2021-03-05 05:52:41 +00:00
procedure GenR1t {fop: pcodes; rval: extended; fp1: integer; tp: baseTypeEnum};
Change all text/source files to LF line endings.
2017-10-21 23:40:19 +00:00
{ generate an instruction that uses a real and an int }
{ }
{ parameters: }
{ rval - real parameter }
{ fp1 - integer parameter }
{ tp - base type }
var
lcode: icptr; {local copy of code}
begin {GenR1t}
if codeGeneration then begin
lcode := code;
lcode^.optype := tp;
lcode^.rval := rval;
lcode^.q := fp1;
Gen0(fop);
end; {if}
end; {GenR1t}
procedure GenLdcLong {lval: longint};
{ load a long constant }
{ }
{ parameters: }
{ lval - value to load }
var
lcode: icptr; {local copy of code}
begin {GenLdcLong}
if codeGeneration then begin
lcode := code;
lcode^.optype := cgLong;
lcode^.lval := lval;
Gen0(pc_ldc);
end; {if}
end; {GenLdcLong}
Initial support for constants with long long types. Currently, the actual values they can have are still constrained to the 32-bit range. Also, there are some bits of functionality (e.g. for initializers) that are not implemented yet.
2021-02-04 05:11:23 +00:00
procedure GenLdcQuad {qval: longlong};
{ load a long long constant }
{ }
{ parameters: }
{ qval - value to load }
var
lcode: icptr; {local copy of code}
begin {GenLdcQuad}
if codeGeneration then begin
lcode := code;
lcode^.optype := cgQuad;
Add support for emitting 64-bit constants in statically-initialized data.
2021-02-04 08:17:10 +00:00
lcode^.qval := qval;
Initial support for constants with long long types. Currently, the actual values they can have are still constrained to the 32-bit range. Also, there are some bits of functionality (e.g. for initializers) that are not implemented yet.
2021-02-04 05:11:23 +00:00
Gen0(pc_ldc);
end; {if}
end; {GenLdcQuad}
Change all text/source files to LF line endings.
2017-10-21 23:40:19 +00:00
procedure GenTool {fop: pcodes; fp1, fp2: integer; dispatcher: longint};
{ generate a tool call }
{ }
{ parameters: }
{ fop - operation code }
{ fp1 - tool number }
{ fp2 - return size }
{ dispatcher - tool entry point }
var
lcode: icptr; {local copy of code}
begin {GenTool}
if codeGeneration then begin
lcode := code;
lcode^.q := fp1;
lcode^.r := fp2;
lcode^.optype := cgLong;
lcode^.lval := dispatcher;
Gen0(fop);
end; {if}
end; {GenTool}
Process floating-point values within the compiler using the extended type. This means that floating-point constants can now have the range and precision of the extended type (aka long double), and floating-point constant expressions evaluated within the compiler also have that same range and precision (matching expressions evaluated at run time). This new behavior is intended to match the behavior specified in the C99 and later standards for FLT_EVAL_METHOD 2. This fixes the previous problem where long double constants and constant expressions of type long double were not represented and evaluated with the full range and precision that they should be. It also gives extra range and precision to constants and constant expressions of type double or float. This may have pluses and minuses, but at any rate it is consistent with the existing behavior for expressions evaluated at run time, and with one of the possible models of floating point evaluation specified in the C standards.
2021-03-05 05:52:41 +00:00
procedure GenLdcReal {rval: extended};
Change all text/source files to LF line endings.
2017-10-21 23:40:19 +00:00
{ load a real constant }
{ }
{ parameters: }
{ rval - value to load }
var
lcode: icptr; {local copy of code}
begin {GenLdcReal}
if codeGeneration then begin
lcode := code;
lcode^.optype := cgReal;
lcode^.rval := rval;
Gen0(pc_ldc);
end; {if}
end; {GenLdcReal}
function TypeSize {tp: baseTypeEnum): integer};
{ Find the size, in bytes, of a variable }
{ }
{ parameters: }
{ tp - base type of the variable }
begin {TypeSize}
case tp of
cgByte,cgUByte: TypeSize := cgByteSize;
cgWord,cgUWord: TypeSize := cgWordSize;
cgLong,cgULong: TypeSize := cgLongSize;
Initial code to recognize 'long long' as a type.
2021-01-30 02:50:21 +00:00
cgQuad,cgUQuad: TypeSize := cgQuadSize;
Change all text/source files to LF line endings.
2017-10-21 23:40:19 +00:00
cgReal: TypeSize := cgRealSize;
cgDouble: TypeSize := cgDoubleSize;
cgComp: TypeSize := cgCompSize;
cgExtended: TypeSize := cgExtendedSize;
cgString: TypeSize := cgByteSize;
cgVoid,ccPointer: TypeSize := cgLongSize;
end; {case}
end; {TypeSize}
Make floating-point casts reduce the range and precision of numbers. The C standards generally allow floating-point operations to be done with extra range and precision, but they require that explicit casts convert to the actual type specified. ORCA/C was not previously doing that. This patch relies on some new library routines (currently in ORCALib) to do this precision reduction. This fixes #64.
2021-03-07 04:28:39 +00:00
procedure LimitPrecision {rval: var extended; tp: baseTypeEnum};
{ limit the precision and range of a real value to the type. }
{ }
{ parameters: }
{ rval - real value }
{ tp - type to limit precision to }
var
d: double;
s: real;
c: comp;
begin {LimitPrecision}
case tp of
cgReal: begin
s := rval;
rval := s;
end;
cgDouble: begin
d := rval;
rval := d;
end;
cgComp: begin
c := rval;
rval := c;
end;
cgExtended: ;
end; {case}
end; {LimitPrecision}
Change all text/source files to LF line endings.
2017-10-21 23:40:19 +00:00
end.
Reference in New Issue Copy Permalink