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