diff --git a/CGI.Comments b/CGI.Comments index 1ce23d0..7f7e3ae 100644 --- a/CGI.Comments +++ b/CGI.Comments @@ -306,6 +306,14 @@ { the stack. } { } { } +{ pc_fix - fix a floating-point variable } +{ } +{ Gen1t(pc_fix, lab, type) } +{ } +{ Change a floating-point value (generally a passed parameter) } +{ from extended to cgReal, cgDouble,or cgComp. } +{ } +{ } { pc_gil - increment and load from a global variable } { pc_gli - load a global variable, then inc the original } { pc_gdl - decrement and load from a global variable } diff --git a/CGI.pas b/CGI.pas index e040852..8b91ab6 100644 --- a/CGI.pas +++ b/CGI.pas @@ -248,7 +248,7 @@ type pc_gli,pc_gdl,pc_gld,pc_cpi,pc_tri,pc_lbu,pc_lbf,pc_sbf,pc_cbf,dc_cns, dc_prm,pc_nat,pc_bno,pc_nop,pc_psh,pc_ili,pc_iil,pc_ild,pc_idl, pc_bqr,pc_bqx,pc_baq,pc_bnq,pc_ngq,pc_adq,pc_sbq,pc_mpq,pc_umq,pc_dvq, - pc_udq,pc_mdq,pc_uqm,pc_slq,pc_sqr,pc_wsr,pc_rbo); + pc_udq,pc_mdq,pc_uqm,pc_slq,pc_sqr,pc_wsr,pc_rbo,pc_fix); {intermediate code} {-----------------} diff --git a/DAG.pas b/DAG.pas index c40f5ee..0280e8b 100644 --- a/DAG.pas +++ b/DAG.pas @@ -520,7 +520,8 @@ var else if op^.opcode in [pc_mov,pc_cbf,pc_cop,pc_cpi,pc_cpo,pc_gil,pc_gli,pc_gdl, pc_gld,pc_iil,pc_ili,pc_idl,pc_ild,pc_lil,pc_lli,pc_ldl, - pc_lld,pc_sbf,pc_sro,pc_sto,pc_str,pc_cui,pc_cup,pc_tl1] then + pc_lld,pc_sbf,pc_sro,pc_sto,pc_str,pc_cui,pc_cup,pc_tl1, + pc_fix] then SideEffects := true else if op^.opcode = pc_ldc then SideEffects := false @@ -5503,7 +5504,7 @@ case code^.opcode of pc_gil, pc_gli, pc_gdl, pc_gld, pc_lil, pc_lli, pc_ldl, pc_lld, pc_lad, pc_lao, pc_lca, pc_lda, pc_ldc, pc_ldo, pc_lod, pc_nop, dc_cns, dc_glb, dc_dst, pc_lnm, pc_nam, pc_nat, dc_lab, pc_add, - pc_ujp, dc_pin, pc_ent, dc_sym: + pc_ujp, dc_pin, pc_ent, dc_sym, pc_fix: Push(code); pc_ret: diff --git a/Gen.pas b/Gen.pas index 708db71..e47e0ac 100644 --- a/Gen.pas +++ b/Gen.pas @@ -5935,6 +5935,21 @@ procedure GenTree {op: icptr}; end; {GenEnt} + procedure GenFix (op: icptr); + + { Generate code for a pc_fix } + + begin {GenFix} + GenNative(m_pea, immediate, localLabel[op^.q], nil, 0); + if op^.optype = cgReal then + GenCall(95) + else if op^.optype = cgDouble then + GenCall(96) + else if op^.optype = cgComp then + GenCall(97); + end; {GenFix} + + procedure GenFjpTjp (op: icptr); { Generate code for a pc_fjp or pc_tjp } @@ -7387,6 +7402,7 @@ case op^.opcode of pc_dvi,pc_mod,pc_udi,pc_uim: GenDviMod(op); pc_ent: GenEnt(op); pc_equ,pc_neq: GenEquNeq(op, op^.opcode, 0); + pc_fix: GenFix(op); pc_fjp,pc_tjp: GenFjpTjp(op); pc_geq,pc_grt,pc_leq,pc_les: GenCmp(op, op^.opcode, 0); pc_gil,pc_gli,pc_gdl,pc_gld: GenGilGliGdlGld(op); diff --git a/Header.pas b/Header.pas index 71f7228..0dbd579 100644 --- a/Header.pas +++ b/Header.pas @@ -18,7 +18,7 @@ uses CCommon, MM, Scanner, Symbol, CGI; {$segment 'SCANNER'} const - symFileVersion = 27; {version number of .sym file format} + symFileVersion = 28; {version number of .sym file format} var inhibitHeader: boolean; {should .sym includes be blocked?} @@ -892,7 +892,9 @@ procedure EndInclude {chPtr: ptr}; p_fenv_access: WriteByte(ord(fenvAccess)); - p_extensions: WriteByte(ord(extendedKeywords)); + p_extensions: + WriteByte(ord(extendedKeywords) + | (ord(extendedParameters) << 1)); end; {case} end; {if} @@ -1562,7 +1564,11 @@ var p_fenv_access: fenvAccess := boolean(ReadByte); - p_extensions: extendedKeywords := boolean(ReadByte); + p_extensions: begin + i := ReadByte; + extendedKeywords := odd(i); + extendedParameters := odd(i >> 1); + end; otherwise: begin PurgeSymbols; diff --git a/Native.pas b/Native.pas index 4d1272e..02134e5 100644 --- a/Native.pas +++ b/Native.pas @@ -2166,6 +2166,9 @@ case callNum of 92: sp := @'~DOUBLEPRECISION'; 93: sp := @'~COMPPRECISION'; 94: sp := @'~CUMUL2'; + 95: sp := @'~REALFIX'; + 96: sp := @'~DOUBLEFIX'; + 97: sp := @'~COMPFIX'; otherwise: Error(cge1); end; {case} diff --git a/Parser.pas b/Parser.pas index 3deb97c..e0282fb 100644 --- a/Parser.pas +++ b/Parser.pas @@ -3915,15 +3915,20 @@ if isFunction then begin if lp^.itype^.kind = arrayType then nextPdisp := nextPdisp + cgPointerSize else begin - if lp^.itype^.kind = scalarType then - if lp^.itype^.baseType in [cgReal,cgDouble,cgComp] then - {all floating-points are passed as extended} + if (lp^.itype^.kind = scalarType) and + (lp^.itype^.baseType in [cgReal,cgDouble,cgComp]) then begin + if extendedParameters then + {all floating-point params are treated as extended} lp^.itype := MakeQualifiedType(extendedPtr, lp^.itype^.qualifiers); - nextPdisp := nextPdisp + long(lp^.itype^.size).lsw; - if (long(lp^.itype^.size).lsw = 1) - and (lp^.itype^.kind = scalarType) then - nextPdisp := nextPdisp+1; + nextPdisp := nextPdisp + cgExtendedSize; + end {if} + else begin + nextPdisp := nextPdisp + long(lp^.itype^.size).lsw; + if (long(lp^.itype^.size).lsw = 1) + and (lp^.itype^.kind = scalarType) then + nextPdisp := nextPdisp+1; + end; {else} end; {else} lp := lp^.pnext; end; {while} diff --git a/Scanner.pas b/Scanner.pas index 7f46fe0..fdc3b76 100644 --- a/Scanner.pas +++ b/Scanner.pas @@ -92,7 +92,10 @@ var c99Scope: boolean; {follow C99 rules for block scopes?} looseTypeChecks: boolean; {loosen some standard type checks?} + {#pragma extensions flags} + {------------------------} extendedKeywords: boolean; {recognize ORCA/C-specific keywords?} + extendedParameters: boolean; {change all floating params to extended?} {---------------------------------------------------------------} @@ -3307,10 +3310,12 @@ if ch in ['a','d','e','i','l','p','u','w'] then begin else if token.name^ = 'extensions' then begin { extensions bits: } { 1 - extended ORCA/C keywords } + { 2 - change floating params to extended } FlagPragmas(p_extensions); NumericDirective; val := long(expressionValue).lsw; extendedKeywords := odd(val); + extendedParameters := odd(val >> 1); if token.kind <> eolsy then Error(11); end {else if} @@ -4220,6 +4225,7 @@ allowMixedDeclarations := true; {allow mixed declarations & stmts (C99)} c99Scope := true; {follow C99 rules for block scopes} looseTypeChecks := true; {loosen some standard type checks} extendedKeywords := true; {allow extended ORCA/C keywords} +extendedParameters := true; {treat all floating params as extended} foundFunction := false; {no functions found so far} fileList := nil; {no included files} gettingFileName := false; {not in GetFileName} diff --git a/Symbol.pas b/Symbol.pas index 0939667..b4e979d 100644 --- a/Symbol.pas +++ b/Symbol.pas @@ -1010,6 +1010,12 @@ if pp <> nil then begin {prototyped parameters} size := long(sp^.itype^.size).lsw; if (size = 1) and (sp^.itype^.kind = scalarType) then size := 2; + if sp^.itype^.kind = scalarType then + if sp^.itype^.baseType in [cgReal,cgDouble,cgComp] then begin + {convert floating-point parameters to declared type} + Gen1t(pc_fix, pln, sp^.itype^.baseType); + size := cgExtendedSize; + end; {if} Gen3(dc_prm, pln, size, sp^.pdisp); end; {else} sp^.pln := pln; @@ -1036,6 +1042,12 @@ else begin {K&R parameters} size := long(sp^.itype^.size).lsw; if (size = 1) and (sp^.itype^.kind = scalarType) then size := 2; + if sp^.itype^.kind = scalarType then + if sp^.itype^.baseType in [cgReal,cgDouble,cgComp] then begin + {convert floating-point parameters to declared type} + Gen1t(pc_fix, pln, sp^.itype^.baseType); + size := cgExtendedSize; + end; {if} Gen3(dc_prm, sp^.lln, size, sp^.pdisp); end; {else} if first then begin diff --git a/cc.notes b/cc.notes index 6426ba5..be023c1 100644 --- a/cc.notes +++ b/cc.notes @@ -130,7 +130,7 @@ Identifiers may now contain universal character names, a type of escape sequence Several new reserved words (keywords) added in the C99 or C11 standards are now supported. For information on what these are and how they are used, see "New Language Features," below. -The recognition of ORCA/C-specific reserved words can now be disabled, allowing them to be used as identifiers. See "#pragma extensions," below. +Certain ORCA/C-specific extensions to the standard C language can now be disabled. See "#pragma extensions," below. Certain alternate reserved symbols known as digraphs are now supported. See "New Language Features," below. @@ -684,10 +684,12 @@ ORCA/C supports certain extensions that are not part of the standard C language. #pragma extensions parm -The parameter must be an integer constant, which is treated as a set of flags. Currently, one flag bit is defined: +The parameter must be an integer constant, which is treated as a set of flags. Currently, two flag bits are defined: If bit 0 (a value of 1) is set, then asm, comp, extended, pascal, and segment are treated as reserved words (keywords), with the meanings specified in the ORCA/C manual. If bit 0 is clear, then those tokens are instead treated as identifiers, as required by the C standards. Bit 0 is set by default. Note that toolbox headers use these keywords, so bit 0 must be set when they are included. +If bit 1 (a value of 2) is set, then function parameters declared with the types float, double, or comp are treated as actually having the type long double (aka extended) rather than their declared type. This results in faster code and also allows the parameters to have the greater precision and range of the extended type. However, this change of types may cause some standard-compliant code not to work properly, particularly if it takes the address of such a parameter and tries to access it through the resulting pointer. If bit 1 is clear, these parameters are treated as having their declared type, restricting their precision and range and causing pointers to them to behave in the standard way. Bit 1 is set by default, matching ORCA/C's historical behavior. + File Names in Error Messages ----------------------------