Skip to content

Commit

Permalink
Expand the size of the object buffer from 64K to 128K, and use 32-bit…
Browse files Browse the repository at this point in the history 
… values to track related sizes.

This allows functions that require an OMF segment byte count of up to 128K to be compiled, although the length in memory at run time is still limited to 64K. (The OMF segment byte count is usually larger, due to the size of relocation records, etc.)

This is useful for compiling large functions, e.g. the main interpreter loop in git. It also fixes the bug shown in the compca23 test case, where functions that require a segment of over 64K may appear to compile correctly but generate corrupted OMF segment headers. This related to tracking sizes with 16-bit values that could roll over.

This patch increases the memory needed at run time by 64K. This shouldn’t generally be a problem on systems with sufficient memory, although it does increase the minimum memory requirement a bit. If behavior in low-memory configurations is a concern, buffSize could be made into a run-time option.
  • Loading branch information
@sheumann
sheumann committed Oct 22, 2017
1 parent 41fb054 commit 8c81b23
Show file tree
Hide file tree
Showing 5 changed files with 329 additions and 278 deletions.
4 changes: 2 additions & 2 deletions CGC.pas
View file
Expand Up @@ -40,12 +40,12 @@ realrec = record {used to convert from real to in-SANE}
var
{msc}
{---}
blkcnt: integer; {number of bytes in current segment}
blkcnt: longint; {number of bytes in current segment}

{buffers}
{-------}
cbufflen: 0..maxcbuff; {number of bytes now in cbuff}
segDisp: integer; {disp in the current segment}
segDisp: longint; {disp in the current segment}

{-- Global subroutines -----------------------------------------}

Expand Down
8 changes: 5 additions & 3 deletions Native.pas
View file
Expand Up @@ -35,7 +35,7 @@ interface
type
labelptr = ^labelentry; {pointer to a forward ref node}
labelentry = record {forward ref node}
addr: integer;
addr: longint;
next: labelptr;
end;

Expand Down Expand Up @@ -359,7 +359,7 @@ procedure WriteNative (opcode: integer; mode: addressingMode; operand: integer;
end;
count: integer; {number of constants to repeat}
i,j,k: integer; {loop variables}
lsegDisp: integer; {for backtracking while writting the }
lsegDisp: longint; {for backtracking while writting the }
{ debugger's symbol table }
lval: longint; {temp storage for long constant}
nptr: stringPtr; {pointer to a name}
Expand Down Expand Up @@ -1292,6 +1292,9 @@ procedure EndSeg;
segDisp := 8; {update header}
Out2(long(pc).lsw);
Out2(long(pc).msw);
if pc > $0000FFFF then
if currentSegment <> '~ARRAYS ' then
Error(112);
blkcnt := blkcnt-4; {purge the segment to disk}
segDisp := blkcnt;
CloseSeg;
Expand Down Expand Up @@ -2218,7 +2221,6 @@ procedure InitFile {keepName: gsosOutStringPtr; keepFlag: integer; partial: bool
if stackSize <> 0 then begin
currentSegment := '~_STACK '; {write the header}
Header(@'~_STACK', $4012, 0);
currentSegment := defaultSegment;
Out($F1); {write the DS record to reserve space}
Out2(stackSize);
Out2(0);
Expand Down
49 changes: 35 additions & 14 deletions ObjOut.asm
View file
Expand Up @@ -81,7 +81,7 @@ COut start
pha
plb
jsr OutByte
inc blkcnt blkcnt := blkcnt+1;
inc4 blkcnt blkcnt := blkcnt+1;
inc4 pc pc := pc+1;
rtl
end
Expand All @@ -105,8 +105,7 @@ Out2 start
pha
plb
jsr OutWord
inc blkcnt blkcnt := blkcnt+2;
inc blkcnt
add4 blkcnt,#2 blkcnt := blkcnt+2;
rtl
end

Expand All @@ -129,7 +128,7 @@ Out start
pha
plb
jsr OutByte
inc blkcnt blkcnt := blkcnt+1;
inc4 blkcnt blkcnt := blkcnt+1;
rtl
end

Expand All @@ -147,15 +146,26 @@ OutByte private
lda objLen if objLen+segDisp = buffSize then
clc
adc segDisp
bcc lb2
lda objLen+2
adc segDisp+2
and #$FFFE
beq lb2
phx PurgeObjBuffer;
jsl PurgeObjBuffer
plx
lda objLen check for segment overflow
clc
adc segDisp
bcs lb2a
lb2 ph4 objPtr p := pointer(ord4(objPtr)+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
pha
lda objPtr
pha
tsc p^ := b;
phd
tcd
Expand All @@ -164,7 +174,7 @@ lb2 ph4 objPtr p := pointer(ord4(objPtr)+segDisp);
txa
sta [1],Y
long M
inc segDisp segDisp := segDisp+1;
inc4 segDisp segDisp := segDisp+1;

pld
tsc
Expand All @@ -175,6 +185,7 @@ lb2 ph4 objPtr p := pointer(ord4(objPtr)+segDisp);

lb2a lda #$8000 handle a segment overflow
sta segDisp
stz segDisp+2
ph2 #112
jsl Error
rts
Expand All @@ -194,24 +205,33 @@ OutWord private
lda objLen if objLen+segDisp+1 = buffSize then
sec
adc segDisp
bcc lb2
lda objLen+2
adc segDisp+2
and #$FFFE
beq lb2
phx PurgeObjBuffer;
jsl PurgeObjBuffer
plx
lda objLen check for segment overflow
sec
adc segDisp
bcs lb3
lb2 ph4 objPtr 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
pha
tsc p^ := b;
phd
tcd
ldy segDisp
txa
sta [1],Y
iny segDisp := segDisp+2;
iny
sty segDisp save new segDisp
add4 segDisp,#2 segDisp := segDisp+2;

pld
tsc
Expand All @@ -224,5 +244,6 @@ lb3 ph2 #112 flag segment overflow error
jsl Error
lda #$8000
sta segDisp
stz segDisp+2
rts
end

0 comments on commit 8c81b23

Please sign in to comment.