Apple-2gs-SW/ORCA-C
1
0
Fork 0
mirror of https://github.com/byteworksinc/ORCA-C.git synced 2024-11-17 05:06:10 +00:00
Code Issues Projects Releases Wiki Activity
19683706cc
ORCA-C/CGI.pas

1442 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}
Generate more efficient code for indirect function calls.
2022-10-12 02:14:40 +00:00
shift8 = 1; {shift operand right 8 bits}
shift16 = 2; {shift operand right 16 bits}
Change all text/source files to LF line endings.
2017-10-21 23:40:19 +00:00
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}
Optimize away some tax/tay instructions used only to set flags.
2022-07-10 22:35:56 +00:00
forFlags = 256; {instruction used for effect on flags only}
Generate better code for indexed jumps. They now use a jmp (addr,X) instruction, rather than a more complicated code sequence using rts. This is an improvement that was suggested in an old Genie message from Todd Whitesel.
2022-07-19 02:18:26 +00:00
subtract1 = 512; {subtract 1 from address operand}
Generate more efficient code for indirect function calls.
2022-10-12 02:14:40 +00:00
shiftLeft8 = 1024; {shift operand left 8 bits}
Change all text/source files to LF line endings.
2017-10-21 23:40:19 +00:00
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;
Generate better code for indexed jumps. They now use a jmp (addr,X) instruction, rather than a more complicated code sequence using rts. This is an improvement that was suggested in an old Genie message from Todd Whitesel.
2022-07-19 02:18:26 +00:00
m_jmp_indX = $7C;
Change all text/source files to LF line endings.
2017-10-21 23:40:19 +00:00
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;
Improve code generation for comparisons. This converts comparisons like x > N (with constant N) to instead be evaluated as x >= N+1, since >= comparisons generate better code. This is possible as long as N is not the maximum value in the type, but in that case the comparison is always false. There are also a few other tweaks to the generated code in some cases.
2022-07-11 03:26:59 +00:00
m_rol_a = $2A;
Optimize 16-bit multiplication by various constants. This optimizes most multiplications by a power of 2 or the sum of two powers of 2, converting them to equivalent operations using shifts which should be faster than the general-purpose multiplication routine.
2022-07-07 03:24:54 +00:00
m_ror_a = $6A;
Change all text/source files to LF line endings.
2017-10-21 23:40:19 +00:00
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;
Do not optimize code from asm statements. Previously, the assembly-level optimizations applied to code in asm statements. In many cases, this was fine (and could even do useful optimizations), but occasionally the optimizations could be invalid. This was especially the case if the assembly involved tricky things like self-modifying code. To avoid these problems, this patch makes the assembly optimizers ignore code from asm statements, so it is always emitted as-is, without any changes. This fixes #34.
2022-10-13 03:03:37 +00:00
asmFlag = $8000; {or'd with opcode to indicate asm code}
Change all text/source files to LF line endings.
2017-10-21 23:40:19 +00:00
{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}
Increase some size limits. The new value of maxLocalLabel is aligned with the C99+ requirement to support "511 identifiers with block scope declared in one block". The value of maxLabel is now the maximum it can be while keeping the size of the labelTab array under 32 KiB. (I'm not entirely sure the address calculations in the code generated by ORCA/Pascal would work correctly beyond that.)
2022-07-09 02:30:14 +00:00
maxLabel = 3275; {max # of internal labels}
maxLocalLabel = 512; {max # local variables}
Dynamically allocate string space, and make it larger. This increases the limit on total bytes of strings in a function, and also frees up space in the blank segment.
2022-06-09 03:09:30 +00:00
maxString = 32760; {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}
Dynamically allocate string space, and make it larger. This increases the limit on total bytes of strings in a function, and also frees up space in the blank segment.
2022-06-09 03:09:30 +00:00
stringSpaceType = packed array[1..maxstring] of char; {string space}
Change all text/source files to LF line endings.
2017-10-21 23:40:19 +00:00
{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,
Add option to use the declared type for float/double/comp params. This differs from the usual ORCA/C behavior of treating all floating-point parameters as extended. With the option enabled, they will still be passed in the extended format, but will be converted to their declared type at the start of the function. This is needed for strict standards conformance, because you should be able to take the address of a parameter and get a usable pointer to its declared type. The difference in types can also affect the behavior of _Generic expressions. The implementation of this is based on ORCA/Pascal, which already did the same thing (unconditionally) with real/double/comp parameters.
2022-09-19 02:10:13 +00:00
pc_udq,pc_mdq,pc_uqm,pc_slq,pc_sqr,pc_wsr,pc_rbo,pc_fix);
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?}
Add a new optimize flag for FP math optimizations that break IEEE rules. There were several existing optimizations that could change behavior in ways that violated the IEEE standard with regard to infinities, NaNs, or signed zeros. They are now gated behind a new #pragma optimize flag. This change allows intermediate code peephole optimization and common subexpression elimination to be used while maintaining IEEE conformance, but also keeps the rule-breaking optimizations available if desired. See section F.9.2 of recent C standards for a discussion of how these optimizations violate IEEE rules.
2021-11-30 02:31:15 +00:00
fastMath: boolean; {do FP math opts that break IEEE rules?}
Change all text/source files to LF line endings.
2017-10-21 23:40:19 +00:00
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}
Dynamically allocate string space, and make it larger. This increases the limit on total bytes of strings in a function, and also frees up space in the blank segment.
2022-06-09 03:09:30 +00:00
stringspace: ^stringSpaceType; {string table}
Change all text/source files to LF line endings.
2017-10-21 23:40:19 +00:00
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;
Add a new optimize flag for FP math optimizations that break IEEE rules. There were several existing optimizations that could change behavior in ways that violated the IEEE standard with regard to infinities, NaNs, or signed zeros. They are now gated behind a new #pragma optimize flag. This change allows intermediate code peephole optimization and common subexpression elimination to be used while maintaining IEEE conformance, but also keeps the rule-breaking optimizations available if desired. See section F.9.2 of recent C standards for a discussion of how these optimizations violate IEEE rules.
2021-11-30 02:31:15 +00:00
fastMath := cLineOptimize;
Change all text/source files to LF line endings.
2017-10-21 23:40:19 +00:00
commonSubexpression := cLineOptimize; {not doing common subexpression elimination}
loopOptimizations := cLineOptimize; {not doing loop optimizations, yet}
Dynamically allocate string space, and make it larger. This increases the limit on total bytes of strings in a function, and also frees up space in the blank segment.
2022-06-09 03:09:30 +00:00
{allocate string space}
new(stringspace);
Change all text/source files to LF line endings.
2017-10-21 23:40:19 +00:00
{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;
Work around the SANE comp conversion bug in another place. This affects casts to comp evaluated at compile time, e.g.: static comp c = (comp)-53019223785472.0;
2022-01-23 00:22:37 +00:00
cgComp: if rval < 0.0 then begin
{work around SANE comp conversion bug}
c := -rval;
rval := -c;
end {if}
else begin
c := rval;
rval := c;
end; {else}
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
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