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

@@ -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

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;

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;
+         and   minusBuffSize+2
-         jsl   PurgeObjBuffer
+         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;
+         and   minusBuffSize+2
-         jsl   PurgeObjBuffer
+         beq   lb2
+         phx                               MakeSpaceInObjBuffer;
+         jsl   MakeSpaceInObjBuffer
          plx
-         lda   objLen                      check for segment overflow
+         clc
-         sec
+lb2      anop                           carry must be clear
-         adc   segDisp
+         lda   objPtr+2                 p := pointer(ord4(objPtr)+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);
          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

ObjOut.pas

@@ -138,9 +138,8 @@ procedure Purge;
 implementation
 
 const
-					{NOTE: OutByte and Outword assume }
+   initialBuffSize = $10000;            {initial size of the obj buffer}
-                                        { buffSize is 128K                }
+                                        {NOTE: must be a power of two >= 64K}
-   buffSize = 131072;                   {size of the obj buffer}
    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
+segDisp := 0;
-   PurgeObjBuffer;
 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);

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^);