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