Apple-2gs-SW/ORCA-C
1
0
Fork 0
mirror of https://github.com/byteworksinc/ORCA-C.git synced 2024-12-26 19:29:17 +00:00
Code Issues Projects Releases Wiki Activity

Expand the size of the object buffer from 64K to 128K, and use 32-bit values to track related sizes.

Browse Source 
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.
This commit is contained in:
Stephen Heumann 2016-11-27 19:11:12 -06:00
parent 41fb05404e
commit 8c81b23b6f
5 changed files with 329 additions and 278 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

4
CGC.pas
View File

@ -40,12 +40,12 @@ type
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 -----------------------------------------}

8
Native.pas
View File

@ -35,7 +35,7 @@ uses CCommon, CGI, CGC, ObjOut;
type
labelptr = ^labelentry; {pointer to a forward ref node}
labelentry = record {forward ref node}
addr: integer;
addr: longint;
next: labelptr;
end;
@ -359,7 +359,7 @@ var
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}
@ -1292,6 +1292,9 @@ Out(0); {end the segment}
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;
@ -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);

49
ObjOut.asm
View File

@ -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
@ -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
@ -129,7 +128,7 @@ Out start
pha
plb
jsr OutByte
inc blkcnt blkcnt := blkcnt+1;
inc4 blkcnt blkcnt := blkcnt+1;
rtl
end
@ -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
@ -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
@ -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
@ -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
@ -224,5 +244,6 @@ lb3 ph2 #112 flag segment overflow error
jsl Error
lda #$8000
sta segDisp
stz segDisp+2
rts
end

534
ObjOut.macros
View File

@ -1,253 +1,281 @@
MACRO
&LAB LONG &A,&B
LCLB &I
LCLB &M
&A AMID &A,1,1
&M SETB ("&A"="M").OR.("&A"="m")
&I SETB ("&A"="I").OR.("&A"="i")
AIF C:&B=0,.A
&B AMID &B,1,1
&M SETB ("&B"="M").OR.("&B"="m").OR.&M
&I SETB ("&B"="I").OR.("&B"="i").OR.&I
.A
&LAB REP #&M*32+&I*16
AIF .NOT.&M,.B
LONGA ON
.B
AIF .NOT.&I,.C
LONGI ON
.C
MEND
MACRO
&LAB PH4 &N1
LCLC &C
&LAB ANOP
&C AMID &N1,1,1
AIF "&C"="#",.D
AIF S:LONGA=1,.A
REP #%00100000
.A
AIF "&C"<>"{",.B
&C AMID &N1,L:&N1,1
AIF "&C"<>"}",.G
&N1 AMID &N1,2,L:&N1-2
LDY #2
LDA (&N1),Y
PHA
LDA (&N1)
PHA
AGO .E
.B
AIF "&C"<>"[",.C
LDY #2
LDA &N1,Y
PHA
LDA &N1
PHA
AGO .E
.C
LDA &N1+2
PHA
LDA &N1
PHA
AGO .E
.D
&N1 AMID &N1,2,L:&N1-1
PEA +(&N1)|-16
PEA &N1
AGO .F
.E
AIF S:LONGA=1,.F
SEP #%00100000
.F
MEXIT
.G
MNOTE "Missing closing '}'",16
MEND
MACRO
&LAB SHORT &A,&B
LCLB &I
LCLB &M
&A AMID &A,1,1
&M SETB ("&A"="M").OR.("&A"="m")
&I SETB ("&A"="I").OR.("&A"="i")
AIF C:&B=0,.A
&B AMID &B,1,1
&M SETB ("&B"="M").OR.("&B"="m").OR.&M
&I SETB ("&B"="I").OR.("&B"="i").OR.&I
.A
&LAB SEP #&M*32+&I*16
AIF .NOT.&M,.B
LONGA OFF
.B
AIF .NOT.&I,.C
LONGI OFF
.C
MEND
MACRO
&LAB INC4 &A
&LAB ~SETM
INC &A
BNE ~&SYSCNT
INC 2+&A
~&SYSCNT ~RESTM
MEND
MACRO
&LAB ~SETM
&LAB ANOP
AIF C:&~LA,.B
GBLB &~LA
GBLB &~LI
.B
&~LA SETB S:LONGA
&~LI SETB S:LONGI
AIF S:LONGA.AND.S:LONGI,.A
REP #32*(.NOT.&~LA)+16*(.NOT.&~LI)
LONGA ON
LONGI ON
.A
MEND
MACRO
&LAB ~RESTM
&LAB ANOP
AIF (&~LA+&~LI)=2,.I
SEP #32*(.NOT.&~LA)+16*(.NOT.&~LI)
AIF &~LA,.H
LONGA OFF
.H
AIF &~LI,.I
LONGI OFF
.I
MEND
MACRO
&LAB PUT2 &N1,&F1,&CR,&ERROUT
AIF C:&F1,.A
LCLC &F1
&F1 SETC #0
.A
&LAB ~SETM
PH2 &N1
PH2 &F1
PH2 #C:&CR
PH2 #C:&ERROUT
JSL ~PUT2
~RESTM
MEND
MACRO
&LAB PUT4 &N1,&F1,&CR,&ERROUT
AIF C:&F1,.A
LCLC &F1
&F1 SETC #0
.A
&LAB ~SETM
PH4 &N1
PH2 &F1
PH2 #C:&CR
PH2 #C:&ERROUT
JSL ~PUT4
~RESTM
MEND
MACRO
&LAB PUTS &N1,&F1,&CR,&ERROUT
&LAB ~SETM
LCLC &C
&C AMID "&N1",1,1
AIF "&C"<>"#",.C
AIF L:&N1>127,.A
BRA ~&SYSCNT
AGO .B
.A
BRL ~&SYSCNT
.B
&N1 AMID "&N1",2,L:&N1-1
~L&SYSCNT DC I1"L:~S&SYSCNT"
~S&SYSCNT DC C&N1
~&SYSCNT ANOP
&N1 SETC ~L&SYSCNT-1
AIF C:&F1=0,.D
.C
~PUSHA &N1
AIF C:&F1,.C1
PEA 0
AGO .C2
.C1
PH2 &F1
.C2
PH2 #C:&CR
PH2 #C:&ERROUT
JSL ~PUTS
~RESTM
MEXIT
.D
PEA ~L&SYSCNT|-16
PEA ~L&SYSCNT
LDX #$1C0C+(C:&ERROUT*256)-(512*C:&CR)
JSL $E10000
~RESTM
MEND
MACRO
&LAB ~PUSHA &N1
LCLC &C
&LAB ANOP
&C AMID &N1,1,1
AIF "&C"<>"{",.B
&C AMID &N1,L:&N1,1
AIF "&C"<>"}",.G
&N1 AMID &N1,2,L:&N1-2
SEP #$20
LONGA OFF
LDA #0
PHA
REP #$20
LONGA ON
PHK
LDA &N1
PHA
MEXIT
.B
AIF "&C"<>"[",.C
&N1 AMID &N1,2,L:&N1-2
LDA &N1+2
PHA
LDA &N1
PHA
MEXIT
.C
PEA +(&N1)|-16
PEA &N1
MEXIT
.G
MNOTE "Missing closing '}'",16
MEND
MACRO
&LAB PH2 &N1
LCLC &C
&LAB ANOP
&C AMID &N1,1,1
AIF "&C"="#",.D
AIF S:LONGA=1,.A
REP #%00100000
.A
AIF "&C"<>"{",.B
&C AMID &N1,L:&N1,1
AIF "&C"<>"}",.G
&N1 AMID &N1,2,L:&N1-2
LDA (&N1)
PHA
AGO .E
.B
LDA &N1
PHA
AGO .E
.D
&N1 AMID &N1,2,L:&N1-1
PEA &N1
AGO .F
.E
AIF S:LONGA=1,.F
SEP #%00100000
.F
MEXIT
.G
MNOTE "Missing closing '}'",16
MEND
macro
&l add4 &m1,&m2,&m3
lclb &yistwo
lclc &c
&l ~setm
aif c:&m3,.a
&c amid "&m2",1,1
aif "&c"<>"#",.a
&c amid "&m1",1,1
aif "&c"="{",.a
aif "&c"="[",.a
&c amid "&m2",2,l:&m2-1
aif &c>=65536,.a
clc
~lda &m1
~op adc,&m2
~sta &m1
bcc ~&SYSCNT
~op.h inc,&m1
~&SYSCNT anop
ago .c
.a
aif c:&m3,.b
lclc &m3
&m3 setc &m1
.b
clc
~lda &m1
~op adc,&m2
~sta &m3
~lda.h &m1
~op.h adc,&m2
~sta.h &m3
.c
~restm
mend
macro
&l inc4 &a
&l ~setm
inc &a
bne ~&SYSCNT
inc 2+&a
~&SYSCNT ~restm
mend
macro
&l long &a,&b
lclb &i
lclb &m
&a amid &a,1,1
&m setb ("&a"="M").or.("&a"="m")
&i setb ("&a"="I").or.("&a"="i")
aif c:&b=0,.a
&b amid &b,1,1
&m setb ("&b"="M").or.("&b"="m").or.&m
&i setb ("&b"="I").or.("&b"="i").or.&i
.a
&l rep #&m*32+&i*16
aif .not.&m,.b
longa on
.b
aif .not.&i,.c
longi on
.c
mend
macro
&l ph2 &n1
&l anop
aif "&n1"="*",.f
lclc &c
&c amid &n1,1,1
aif "&c"="#",.d
aif s:longa=1,.a
rep #%00100000
.a
aif "&c"<>"{",.b
&c amid &n1,l:&n1,1
aif "&c"<>"}",.g
&n1 amid &n1,2,l:&n1-2
lda (&n1)
pha
ago .e
.b
aif "&c"="<",.c
lda &n1
pha
ago .e
.c
&n1 amid &n1,2,l:&n1-1
pei &n1
ago .e
.d
&n1 amid &n1,2,l:&n1-1
pea &n1
ago .f
.e
aif s:longa=1,.f
sep #%00100000
.f
mexit
.g
mnote "Missing closing '}'",16
mend
macro
&l short &a,&b
lclb &i
lclb &m
&a amid &a,1,1
&m setb ("&a"="M").or.("&a"="m")
&i setb ("&a"="I").or.("&a"="i")
aif c:&b=0,.a
&b amid &b,1,1
&m setb ("&b"="M").or.("&b"="m").or.&m
&i setb ("&b"="I").or.("&b"="i").or.&i
.a
&l sep #&m*32+&i*16
aif .not.&m,.b
longa off
.b
aif .not.&i,.c
longi off
.c
mend
macro
&l ~lda &op
lclc &c
&c amid "&op",1,1
aif "&c"<>"{",.b
&c amid "&op",l:&op,1
aif "&c"="}",.a
mnote "Missing closing '}'",2
&op setc &op}
.a
&op amid "&op",2,l:&op-2
&op setc (&op)
.b
&l lda &op
mend
macro
&l ~lda.h &op
&l anop
lclc &c
&c amid "&op",1,1
aif "&c"="[",.b
aif "&c"<>"{",.d
&c amid "&op",l:&op,1
aif "&c"="}",.a
mnote "Missing closing '}'",2
&op setc &op}
.a
&op amid "&op",2,l:&op-2
&op setc (&op)
.b
aif &yistwo,.c
&yistwo setb 1
ldy #2
.c
&op setc "&op,y"
lda &op
mexit
.d
aif "&c"<>"#",.e
&op amid "&op",2,l:&op-1
&op setc "#^&op"
lda &op
mexit
.e
lda 2+&op
mend
macro
&l ~op &opc,&op
lclc &c
&c amid "&op",1,1
aif "&c"<>"{",.b
&c amid "&op",l:&op,1
aif "&c"="}",.a
mnote "Missing closing '}'",2
&op setc &op}
.a
&op amid "&op",2,l:&op-2
&op setc (&op)
.b
&l &opc &op
mend
macro
&l ~op.h &opc,&op
&l anop
lclc &c
&c amid "&op",1,1
aif "&c"="[",.b
aif "&c"<>"{",.d
&c amid "&op",l:&op,1
aif "&c"="}",.a
mnote "Missing closing '}'",2
&op setc &op}
.a
&op amid "&op",2,l:&op-2
&op setc (&op)
.b
aif &yistwo,.c
&yistwo setb 1
ldy #2
.c
&op setc "&op,y"
&opc &op
mexit
.d
aif "&c"<>"#",.e
&op amid "&op",2,l:&op-1
&op setc "#^&op"
&opc &op
mexit
.e
&opc 2+&op
mend
macro
&l ~restm
&l anop
aif (&~la+&~li)=2,.i
sep #32*(.not.&~la)+16*(.not.&~li)
aif &~la,.h
longa off
.h
aif &~li,.i
longi off
.i
mend
macro
&l ~setm
&l anop
aif c:&~la,.b
gblb &~la
gblb &~li
.b
&~la setb s:longa
&~li setb s:longi
aif s:longa.and.s:longi,.a
rep #32*(.not.&~la)+16*(.not.&~li)
longa on
longi on
.a
mend
macro
&l ~sta &op
lclc &c
&c amid "&op",1,1
aif "&c"<>"{",.b
&c amid "&op",l:&op,1
aif "&c"="}",.a
mnote "Missing closing '}'",2
&op setc &op}
.a
&op amid "&op",2,l:&op-2
&op setc (&op)
.b
&l sta &op
mend
macro
&l ~sta.h &op
&l anop
lclc &c
&c amid "&op",1,1
aif "&c"="[",.b
aif "&c"<>"{",.d
&c amid "&op",l:&op,1
aif "&c"="}",.a
mnote "Missing closing '}'",2
&op setc &op}
.a
&op amid "&op",2,l:&op-2
&op setc (&op)
.b
aif &yistwo,.c
&yistwo setb 1
ldy #2
.c
&op setc "&op,y"
sta &op
mexit
.d
sta 2+&op
mend

12
ObjOut.pas
View File

@ -139,8 +139,8 @@ implementation
const
{NOTE: OutByte and Outword assume }
{ buffSize is 64K }
buffSize = 65536; {size of the obj buffer}
{ buffSize is 128K }
buffSize = 131072; {size of the obj buffer}
maxCBuffLen = 191; {length of the constant buffer}
OBJ = $B1; {object file type}
@ -313,7 +313,7 @@ if len <> 0 then begin
if ToolError <> 0 then {check for write errors}
TermError(9);
objLen := 0; {adjust file pointers}
BlockMove(segStart, sPtr, ord4(segDisp) & $00FFFF);
BlockMove(segStart, sPtr, segDisp);
objPtr := sPtr;
segStart := sPtr;
end; {if}
@ -436,12 +436,13 @@ var
begin {CloseSeg}
longPtr := pointer(objPtr); {set the block count}
longPtr^ := ord4(segDisp) & $00FFFF;
objLen := objLen + (ord4(segDisp) & $00FFFF); {update the length of the obj file}
longPtr^ := segDisp;
objLen := objLen + segDisp; {update the length of the obj file}
objPtr := pointer(ord4(objHandle^)+objLen); {set objPtr}
segStart := objPtr;
if objLen = buffSize then
PurgeObjBuffer;
currentSegment := defaultSegment; {revert to default segment name}
end; {CloseSeg}
@ -513,7 +514,6 @@ Out2($30); Out2($3B+len);
Out2(0); Out2(0); {temporg}
for i := 1 to 10 do {write the segment name}
Out(ord(currentSegment[i]));
currentSegment := defaultSegment; {revert to default segment name}
Out(len); {segname}
for i := 1 to len do
Out(ord(name^[i]));