From 8c81b23b6f3289a4d227aded3317e25510465760 Mon Sep 17 00:00:00 2001 From: Stephen Heumann Date: Sun, 27 Nov 2016 19:11:12 -0600 Subject: [PATCH] Expand the size of the object buffer from 64K to 128K, and use 32-bit values to track related sizes. MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit 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. --- CGC.pas | 4 +- Native.pas | 8 +- ObjOut.asm | 49 +++-- ObjOut.macros | 534 ++++++++++++++++++++++++++------------------------ ObjOut.pas | 12 +- 5 files changed, 329 insertions(+), 278 deletions(-) diff --git a/CGC.pas b/CGC.pas index 89f9e82..8945741 100644 --- a/CGC.pas +++ b/CGC.pas @@ -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 -----------------------------------------} diff --git a/Native.pas b/Native.pas index 6a3ee5b..ef8f61a 100644 --- a/Native.pas +++ b/Native.pas @@ -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); diff --git a/ObjOut.asm b/ObjOut.asm index ba164be..79a213e 100644 --- a/ObjOut.asm +++ b/ObjOut.asm @@ -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 diff --git a/ObjOut.macros b/ObjOut.macros index a94011d..19dea07 100644 --- a/ObjOut.macros +++ b/ObjOut.macros @@ -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 diff --git a/ObjOut.pas b/ObjOut.pas index f8f861d..f9b886f 100644 --- a/ObjOut.pas +++ b/ObjOut.pas @@ -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]));