From 6857913daacd9cf1d663efa43fd1293167ff496e Mon Sep 17 00:00:00 2001 From: Stephen Heumann Date: Tue, 6 Dec 2022 21:49:20 -0600 Subject: [PATCH] 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. --- CCommon.pas | 2 +- Native.pas | 4 ++-- ObjOut.asm | 50 +++++++++++++------------------------------------- ObjOut.pas | 40 +++++++++++++++++++++++++++++++++------- Scanner.pas | 3 ++- 5 files changed, 51 insertions(+), 48 deletions(-) diff --git a/CCommon.pas b/CCommon.pas index 102d4a0..c7fef1b 100644 --- a/CCommon.pas +++ b/CCommon.pas @@ -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 diff --git a/Native.pas b/Native.pas index 648b139..c110111 100644 --- a/Native.pas +++ b/Native.pas @@ -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; diff --git a/ObjOut.asm b/ObjOut.asm index a74e177..d643923 100644 --- a/ObjOut.asm +++ b/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 diff --git a/ObjOut.pas b/ObjOut.pas index 6196045..764735c 100644 --- a/ObjOut.pas +++ b/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); diff --git a/Scanner.pas b/Scanner.pas index 3a4c065..7a08ade 100644 --- a/Scanner.pas +++ b/Scanner.pas @@ -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^);