Make the object buffer dynamically resizable.
It will now grow as needed to accommodate large segments, subject to the constraints of available memory. In practice, this mostly affects the size of initialized static arrays that can be used. This also removes any limit apart from memory size on how large the object representation produced by a "compile to memory" can be, and cleans up error reporting regarding size limits.
This commit is contained in:
Stephen Heumann
parent
389f60ed27
commit
6857913daa
|
|
@ -1005,7 +1005,7 @@ case errnum of {print the error}
|
|||
8 : msg := 'you cannot change languages from an included file';
|
||||
9 : msg := concat('Error writing ', objFile.theString.theString);
|
||||
10: msg := 'ORCA/C requires version 2.0 or later of the shell';
|
||||
11: msg := 'The program is too large to compile to memory -- use Compile to Disk';
|
||||
{11: msg := 'The program is too large to compile to memory -- use Compile to Disk';}
|
||||
12: msg := 'Invalid sym file detected. Re-run ORCA/C to proceed.';
|
||||
13: msg := 'file name or command-line parameter is too long';
|
||||
otherwise: begin
|
||||
|
|
|
|||
|
|
@ -1481,9 +1481,9 @@ Out(0); {end the segment}
|
|||
segDisp := 8; {update header}
|
||||
Out2(long(pc).lsw);
|
||||
Out2(long(pc).msw);
|
||||
if pc > $0000FFFF then
|
||||
if pc > $00010000 then
|
||||
if currentSegment <> '~ARRAYS ' then
|
||||
Error(112);
|
||||
Error(184);
|
||||
blkcnt := blkcnt-4; {purge the segment to disk}
|
||||
segDisp := blkcnt;
|
||||
CloseSeg;
|
||||
|
|
|
|||
50
ObjOut.asm
50
ObjOut.asm
|
|
@ -144,23 +144,18 @@ Out start CodeGen
|
|||
*
|
||||
OutByte private CodeGen
|
||||
|
||||
lda objLen if objLen+segDisp = buffSize then
|
||||
lda objLen if objLen+segDisp >= buffSize then
|
||||
clc
|
||||
adc segDisp
|
||||
lda objLen+2
|
||||
adc segDisp+2
|
||||
and #$FFFE
|
||||
beq lb2
|
||||
phx PurgeObjBuffer;
|
||||
jsl PurgeObjBuffer
|
||||
and minusBuffSize+2
|
||||
beq lb2
|
||||
phx MakeSpaceInObjBuffer;
|
||||
jsl MakeSpaceInObjBuffer
|
||||
plx
|
||||
lda objLen check for segment overflow
|
||||
clc
|
||||
adc segDisp
|
||||
lda objLen+2
|
||||
adc segDisp+2
|
||||
and #$FFFE
|
||||
bne lb2a
|
||||
lb2 anop carry must be clear
|
||||
lda objPtr+2 p := pointer(ord4(objPtr)+segDisp);
|
||||
adc segDisp+2
|
||||
|
|
@ -183,13 +178,6 @@ lb2 anop carry must be clear
|
|||
adc #4
|
||||
tcs
|
||||
rts
|
||||
|
||||
lb2a lda #$8000 handle a segment overflow
|
||||
sta segDisp
|
||||
stz segDisp+2
|
||||
ph2 #112
|
||||
jsl Error
|
||||
rts
|
||||
end
|
||||
|
||||
****************************************************************
|
||||
|
|
@ -203,25 +191,20 @@ lb2a lda #$8000 handle a segment overflow
|
|||
*
|
||||
OutWord private CodeGen
|
||||
|
||||
lda objLen if objLen+segDisp+1 = buffSize then
|
||||
lda objLen if objLen+segDisp+1 >= buffSize then
|
||||
sec
|
||||
adc segDisp
|
||||
lda objLen+2
|
||||
adc segDisp+2
|
||||
and #$FFFE
|
||||
beq lb2
|
||||
phx PurgeObjBuffer;
|
||||
jsl PurgeObjBuffer
|
||||
and minusBuffSize+2
|
||||
beq lb2
|
||||
phx MakeSpaceInObjBuffer;
|
||||
jsl MakeSpaceInObjBuffer
|
||||
plx
|
||||
lda objLen check for segment overflow
|
||||
sec
|
||||
adc segDisp
|
||||
lda objLen+2
|
||||
adc segDisp+2
|
||||
and #$FFFE
|
||||
bne lb3
|
||||
lb2 anop carry must be clear
|
||||
lda objPtr+2 p := pointer(ord4(objPtr)+segDisp);
|
||||
clc
|
||||
lb2 anop carry must be clear
|
||||
lda objPtr+2 p := pointer(ord4(objPtr)+segDisp);
|
||||
adc segDisp+2
|
||||
pha
|
||||
lda objPtr
|
||||
|
|
@ -240,11 +223,4 @@ lb2 anop carry must be clear
|
|||
adc #4
|
||||
tcs
|
||||
rts
|
||||
|
||||
lb3 ph2 #112 flag segment overflow error
|
||||
jsl Error
|
||||
lda #$8000
|
||||
sta segDisp
|
||||
stz segDisp+2
|
||||
rts
|
||||
end
|
||||
|
|
|
|||
40
ObjOut.pas
40
ObjOut.pas
|
|
@ -138,9 +138,8 @@ procedure Purge;
|
|||
implementation
|
||||
|
||||
const
|
||||
{NOTE: OutByte and Outword assume }
|
||||
{ buffSize is 128K }
|
||||
buffSize = 131072; {size of the obj buffer}
|
||||
initialBuffSize = $10000; {initial size of the obj buffer}
|
||||
{NOTE: must be a power of two >= 64K}
|
||||
maxCBuffLen = 191; {length of the constant buffer}
|
||||
OBJ = $B1; {object file type}
|
||||
|
||||
|
|
@ -218,6 +217,7 @@ var
|
|||
objLen: longint; {# bytes used in obj buffer}
|
||||
objHandle: handle; {handle of the obj buffer}
|
||||
objPtr: ptr; {points to first byte in current segment}
|
||||
minusBuffSize: longint; {size of obj buffer, negated}
|
||||
|
||||
spoolRefnum: integer; {reference number for open file}
|
||||
|
||||
|
|
@ -275,7 +275,7 @@ var
|
|||
|
||||
begin {InitSpoolFile}
|
||||
if memoryCompile then {make sure this is a disk-based compile}
|
||||
TermError(11);
|
||||
TermError(3);
|
||||
dsRec.pCount := 1; {destroy any old file}
|
||||
dsRec.pathname := @objFile.theString;
|
||||
DestroyGS(dsRec);
|
||||
|
|
@ -318,6 +318,32 @@ if len <> 0 then begin
|
|||
end; {PurgeObjBuffer}
|
||||
|
||||
|
||||
procedure MakeSpaceInObjBuffer;
|
||||
|
||||
{ Make space in the object buffer (at least two bytes) by }
|
||||
{ purging or expanding it. }
|
||||
|
||||
var
|
||||
segOffset: longint; {offset into buffer of current segment}
|
||||
|
||||
begin {MakeSpaceInObjBuffer}
|
||||
segOffset := ord4(objPtr) - ord4(objHandle^);
|
||||
|
||||
if (segOffset >= 2) and not memoryCompile then
|
||||
PurgeObjBuffer
|
||||
else begin
|
||||
{resize the buffer}
|
||||
minusBuffSize := minusBuffSize * 2;
|
||||
HUnLock(objHandle);
|
||||
SetHandleSize(-minusBuffSize, objHandle);
|
||||
if ToolError <> 0 then
|
||||
TermError(5);
|
||||
HLock(objHandle);
|
||||
objPtr := ptr(ord4(objHandle^) + segOffset);
|
||||
end; {if}
|
||||
end; {MakeSpaceInObjBuffer}
|
||||
|
||||
|
||||
{---------------------------------------------------------------}
|
||||
|
||||
procedure CloseObj;
|
||||
|
|
@ -437,8 +463,7 @@ longPtr := pointer(objPtr); {set the block count}
|
|||
longPtr^ := segDisp;
|
||||
objLen := objLen + segDisp; {update the length of the obj file}
|
||||
objPtr := pointer(ord4(objHandle^)+objLen); {set objPtr}
|
||||
if objLen = buffSize then
|
||||
PurgeObjBuffer;
|
||||
segDisp := 0;
|
||||
currentSegment := defaultSegment; {revert to default segment name}
|
||||
end; {CloseSeg}
|
||||
|
||||
|
|
@ -555,12 +580,13 @@ if memoryCompile then begin
|
|||
end; {if}
|
||||
|
||||
{allocate memory for an initial buffer}
|
||||
objHandle := pointer(NewHandle(buffSize, userID, $8000, nil));
|
||||
objHandle := pointer(NewHandle(initialBuffSize, userID, $8000, nil));
|
||||
|
||||
{set up the buffer variables}
|
||||
if ToolError = 0 then begin
|
||||
objLen := 0;
|
||||
objPtr := objHandle^;
|
||||
minusBuffSize := -initialBuffSize;
|
||||
end {if}
|
||||
else
|
||||
TermError(5);
|
||||
|
|
|
|||
|
|
@ -714,7 +714,7 @@ if list or (numErr <> 0) then begin
|
|||
109: msg := @'illegal math operation in a constant expression';
|
||||
110: msg := @'lint: unknown pragma';
|
||||
{111: msg := @'the & operator cannot be applied to arrays';}
|
||||
112: msg := @'segment buffer overflow';
|
||||
{112: msg := @'segment buffer overflow';}
|
||||
113: msg := @'all parameters must have a name';
|
||||
114: msg := @'a function call was made to a non-function';
|
||||
115: msg := @'illegal bit field declaration';
|
||||
|
|
@ -786,6 +786,7 @@ if list or (numErr <> 0) then begin
|
|||
181: msg := @'''main'' may not have any function specifiers';
|
||||
182: msg := @'''='' expected';
|
||||
183: msg := @'array index out of bounds';
|
||||
184: msg := @'segment exceeds bank size';
|
||||
otherwise: Error(57);
|
||||
end; {case}
|
||||
writeln(msg^);
|
||||
|
|
|
|||
Loading…
Reference in New Issue