Never make the segment in the root file dynamic.

This would previously happen if a segment directive with "dynamic" appeared before the first function in the program. That would cause the resulting program not to work, because the root segment needs to be a static segment at the start of the program, but if it is dynamic it would come after a jump table and a static segment of library code.

The root segments are also configured to refer to main or the NDA/CDA entry points using LEXPR records, so that they can be in dynamic segments (not that they necessarily should be). That change is intentionally not done for CDEV/XCMD/NBA, because they use code resources, which do not support dynamic segments, so it is better to force a linker error in these cases.
This commit is contained in:
Stephen Heumann 2022-12-11 14:46:38 -06:00
parent 1754607908
commit ecca7a7737
7 changed files with 32 additions and 5 deletions

View File

@ -340,6 +340,7 @@ var
commonSubexpression: boolean; {do common subexpression removal?} commonSubexpression: boolean; {do common subexpression removal?}
currentSegment,defaultSegment: segNameType; {current & default seg names} currentSegment,defaultSegment: segNameType; {current & default seg names}
segmentKind: integer; {kind field of segment (ored with start/data)} segmentKind: integer; {kind field of segment (ored with start/data)}
defaultSegmentKind: integer; {default segment kind}
debugFlag: boolean; {generate debugger calls?} debugFlag: boolean; {generate debugger calls?}
debugStrFlag: boolean; {gsbug/niftylist debug names?} debugStrFlag: boolean; {gsbug/niftylist debug names?}
dataBank: boolean; {save, restore data bank?} dataBank: boolean; {save, restore data bank?}
@ -820,6 +821,8 @@ isXCMD := false;
codeGeneration := false; {code generation is not turned on yet} codeGeneration := false; {code generation is not turned on yet}
currentSegment := ' '; {start with the blank segment} currentSegment := ' '; {start with the blank segment}
defaultSegment := ' '; defaultSegment := ' ';
segmentKind := 0; {default to static code segments}
defaultSegmentKind := 0;
smallMemoryModel := true; {small memory model} smallMemoryModel := true; {small memory model}
dataBank := false; {don't save/restore data bank} dataBank := false; {don't save/restore data bank}
strictVararg := {save/restore caller's stack around vararg} strictVararg := {save/restore caller's stack around vararg}

View File

@ -18,7 +18,7 @@ uses CCommon, MM, Scanner, Symbol, CGI;
{$segment 'HEADER'} {$segment 'HEADER'}
const const
symFileVersion = 36; {version number of .sym file format} symFileVersion = 37; {version number of .sym file format}
var var
inhibitHeader: boolean; {should .sym includes be blocked?} inhibitHeader: boolean; {should .sym includes be blocked?}
@ -887,6 +887,7 @@ procedure EndInclude {chPtr: ptr};
WriteByte(currentSegment[i]); WriteByte(currentSegment[i]);
end; {for} end; {for}
WriteWord(segmentKind); WriteWord(segmentKind);
WriteWord(defaultSegmentKind);
end; end;
p_unix: WriteByte(ord(unix_1)); p_unix: WriteByte(ord(unix_1));
@ -1563,6 +1564,7 @@ var
currentSegment[i] := chr(ReadByte); currentSegment[i] := chr(ReadByte);
end; {for} end; {for}
segmentKind := ReadWord; segmentKind := ReadWord;
defaultSegmentKind := ReadWord;
end; end;
p_unix: unix_1 := boolean(ReadByte); p_unix: unix_1 := boolean(ReadByte);

View File

@ -2318,11 +2318,17 @@ procedure InitFile {keepName: gsosOutStringPtr; keepFlag: integer; partial: bool
{ set up the data bank register } { set up the data bank register }
var
lisJSL: boolean; {saved copy of isJSL}
begin {SetDataBank} begin {SetDataBank}
lisJSL := isJSL;
isJSL := false;
CnOut(m_pea); CnOut(m_pea);
RefName(@'~GLOBALS', 0, 2, -8); RefName(@'~GLOBALS', 0, 2, -8);
CnOut(m_plb); CnOut(m_plb);
CnOut(m_plb); CnOut(m_plb);
isJSL := lisJSL;
end; {SetDataBank} end; {SetDataBank}
@ -2332,6 +2338,12 @@ procedure InitFile {keepName: gsosOutStringPtr; keepFlag: integer; partial: bool
fname2.theString.size := length(fname2.theString.theString); fname2.theString.size := length(fname2.theString.theString);
OpenObj(fname2); OpenObj(fname2);
{force this to be a static segment}
if (segmentKind & $8000) <> 0 then begin
currentSegment := ' ';
segmentKind := 0;
end; {if}
{write the header} {write the header}
InitNative; InitNative;
Header(@'~_ROOT', $4000, 0); Header(@'~_ROOT', $4000, 0);
@ -2353,6 +2365,7 @@ procedure InitFile {keepName: gsosOutStringPtr; keepFlag: integer; partial: bool
CnOut(0); CnOut(0);
{glue code for calling open routine} {glue code for calling open routine}
isJSL := true;
CnOut(m_phb); CnOut(m_phb);
SetDataBank; SetDataBank;
CnOut(m_jsl); CnOut(m_jsl);
@ -2393,6 +2406,7 @@ procedure InitFile {keepName: gsosOutStringPtr; keepFlag: integer; partial: bool
RefName(initName, 0, 3, 0); RefName(initName, 0, 3, 0);
CnOut(m_plb); CnOut(m_plb);
CnOut(m_rtl); CnOut(m_rtl);
isJSL := false;
end end
{classic desk accessory initialization} {classic desk accessory initialization}
@ -2410,6 +2424,7 @@ procedure InitFile {keepName: gsosOutStringPtr; keepFlag: integer; partial: bool
RefName(lab, menuLen + dispToCDAClose, 4, 0); RefName(lab, menuLen + dispToCDAClose, 4, 0);
{glue code for calling open routine} {glue code for calling open routine}
isJSL := true;
CnOut(m_pea); CnOut(m_pea);
CnOut2(1); CnOut2(1);
CnOut(m_jsl); CnOut(m_jsl);
@ -2436,6 +2451,7 @@ procedure InitFile {keepName: gsosOutStringPtr; keepFlag: integer; partial: bool
RefName(@'~DAID', 0, 3, 0); RefName(@'~DAID', 0, 3, 0);
CnOut(m_plb); CnOut(m_plb);
CnOut(m_rtl); CnOut(m_rtl);
isJSL := false;
end end
{control panel device initialization} {control panel device initialization}
@ -2493,6 +2509,7 @@ procedure InitFile {keepName: gsosOutStringPtr; keepFlag: integer; partial: bool
else begin else begin
{write the initial JSL} {write the initial JSL}
isJSL := true;
CnOut(m_jsl); CnOut(m_jsl);
if rtl then if rtl then
RefName(@'~_BWSTARTUP4', 0, 3, 0) RefName(@'~_BWSTARTUP4', 0, 3, 0)
@ -2515,6 +2532,7 @@ procedure InitFile {keepName: gsosOutStringPtr; keepFlag: integer; partial: bool
RefName(@'~C_SHUTDOWN2', 0, 3, 0) RefName(@'~C_SHUTDOWN2', 0, 3, 0)
else else
RefName(@'~C_SHUTDOWN', 0, 3, 0); RefName(@'~C_SHUTDOWN', 0, 3, 0);
isJSL := false;
end; end;
{finish the current segment} {finish the current segment}
@ -2529,6 +2547,7 @@ procedure InitFile {keepName: gsosOutStringPtr; keepFlag: integer; partial: bool
begin {SetStack} begin {SetStack}
if stackSize <> 0 then begin if stackSize <> 0 then begin
currentSegment := '~_STACK '; {write the header} currentSegment := '~_STACK '; {write the header}
segmentKind := 0;
Header(@'~_STACK', $4012, 0); Header(@'~_STACK', $4012, 0);
Out($F1); {write the DS record to reserve space} Out($F1); {write the DS record to reserve space}
Out2(stackSize); Out2(stackSize);

View File

@ -464,7 +464,8 @@ longPtr^ := segDisp;
objLen := objLen + segDisp; {update the length of the obj file} objLen := objLen + segDisp; {update the length of the obj file}
objPtr := pointer(ord4(objHandle^)+objLen); {set objPtr} objPtr := pointer(ord4(objHandle^)+objLen); {set objPtr}
segDisp := 0; segDisp := 0;
currentSegment := defaultSegment; {revert to default segment name} currentSegment := defaultSegment; {revert to default segment name & kind}
segmentKind := defaultSegmentKind;
end; {CloseSeg} end; {CloseSeg}

View File

@ -3701,6 +3701,7 @@ var
end {if} end {if}
else else
segmentKind := 0; segmentKind := 0;
defaultSegmentKind := segmentKind;
Match(semicolonch,22); Match(semicolonch,22);
end {if} end {if}
else begin else begin

View File

@ -933,6 +933,7 @@ procedure DoGlobals;
currentSegment := ' ' currentSegment := ' '
else else
currentSegment := '~ARRAYS '; currentSegment := '~ARRAYS ';
segmentKind := 0; {this segment is not dynamic!}
Gen2Name(dc_str, $4000, 1, @'~ARRAYS'); Gen2Name(dc_str, $4000, 1, @'~ARRAYS');
didOne := true; didOne := true;
end; {if} end; {if}
@ -1046,14 +1047,12 @@ begin {DoGlobals}
{if printSymbols then {debug} {if printSymbols then {debug}
{ PrintTable(globalTable); {debug} { PrintTable(globalTable); {debug}
{these segments are not dynamic!}
segmentKind := 0;
{declare the ~globals segment, which holds non-array data types} {declare the ~globals segment, which holds non-array data types}
if smallMemoryModel then if smallMemoryModel then
currentSegment := ' ' currentSegment := ' '
else else
currentSegment := '~GLOBALS '; currentSegment := '~GLOBALS ';
segmentKind := 0; {this segment is not dynamic!}
Gen2Name(dc_str, $4000, 0, @'~GLOBALS'); Gen2Name(dc_str, $4000, 0, @'~GLOBALS');
GenGlobals; GenGlobals;
Gen0(dc_enp); Gen0(dc_enp);

View File

@ -2055,6 +2055,8 @@ int foo(int[42]);
227. If an unsigned 16-bit value was divided by a constant 1000 or larger, and the result was assigned to two different variables (e.g. a = b = c/1000), incorrect code would be generated when using native code peephole optimization. (This was a regression introduced in ORCA/C 2.2.0 B6.) 227. If an unsigned 16-bit value was divided by a constant 1000 or larger, and the result was assigned to two different variables (e.g. a = b = c/1000), incorrect code would be generated when using native code peephole optimization. (This was a regression introduced in ORCA/C 2.2.0 B6.)
228. If a segment directive specifying a dynamic segment was used before the first function in the main source file, an invalid .root file would be generated, causing the resulting program to crash. (Note that having your program's main function in a dynamic segment serves little purpose and will cause an unrecoverable error if there is not enough free memory to load it. Also, CDevs, XCMDs, and NBAs cannot use dynamic segments.)
-- Bugs from C 2.1.0 that have been fixed ----------------------------------- -- Bugs from C 2.1.0 that have been fixed -----------------------------------
1. In some situations, fread() reread the first 1K or so of the file. 1. In some situations, fread() reread the first 1K or so of the file.