Yet another simple compiler for Apple DOS/6502 (byte version)
Here is the second version of the compiler for Apple DOS.
It differs from the first in that byte variables are not converted to words
unnecessarily. This can give an almost twofold increase in the speed of some programs.
Unfortunately, not all of them, the compiler itself does not apply to them, but the
speed of the program that find a move in the nim game with it (this is one of the
integer tests) almost doubled and it was executed in
a little more than one day.
Three functions have been changed - Expr(), Cond() and Ctrl(), the length of the Code array
has been slightly increased - the compiler does not fit in 14336 bytes. The compilation
procedure is the same. It is not possible to compile a new version using the old one,
because of the fixed memory allocation.
Cross-compiler:
char Text [16384];
word pText;
word nText;
word nLine;
byte Code [16384];
word nCode;
word hFile;
char Heap [ 2048];
word nHeap;
word Name [ 144];
word Cls [ 144];
word Sub [ 144];
word Type [ 144];
word Size [ 144];
word Ofs [ 144];
word nName;
word cBase;
word nData;
word Stk [ 128];
word pStk;
char Buff [ 128];
word open() is
inline 0xB0, 0x00; // mov AL, 00H
inline 0xB4, 0x3D; // mov AH, 3DH
inline 0xB2, 0x4A; // mov DL, Lo(@@Data+Ofs(Heap[64]))
inline 0xB6, 0xC1; // mov DH, Hi(@@Data+Ofs(Heap[64]))
inline 0xCD, 0x21; // int 21H
inline 0x8A, 0xD0; // mov DL, AL
inline 0x8A, 0xF4; // int DH, AH
end
word create() is
inline 0xB4, 0x3C; // mov AH, 03CH
inline 0xB1, 0x00; // mov CL, 00H
inline 0xB5, 0x00; // mov CH, 00H
inline 0xB2, 0x50; // mov DL, Lo(@@Data+Ofs(Heap[70]))
inline 0xB6, 0xC1; // mov DH, Hi(@@Data+Ofs(Heap[70]))
inline 0xCD, 0x21; // int 21H
inline 0x8A, 0xD0; // mov DL, AL
inline 0x8A, 0xF4; // int DH, AH
end
word read() is
inline 0xB4, 0x3F; // mov AH, 3FH
inline 0x8A, 0x1E, 0x08, 0xC1; // mov BL, [@@DATA+Ofs(hFile)]
inline 0x8A, 0x3E, 0x09, 0xC1; // mov BH, [@@DATA+Ofs(hFile)+1]
inline 0xB1, 0x00; // mov CL, 00H
inline 0xB5, 0x40; // mov CH, 40H
inline 0xB2, 0x00; // mov DL, Lo(@@DATA+Ofs(Text))
inline 0xB6, 0x41; // mov DH, Hi(@@DATA+Ofs(Text))
inline 0xCD, 0x21; // int 21H
inline 0x8A, 0xD0; // mov DL, AL
inline 0x8A, 0xF4; // int DH, AH
end
word write() is
inline 0xB4, 0x40; // mov AH, 40H
inline 0x8A, 0x1E, 0x08, 0xC1; // mov BL, [@@DATA+Ofs(hFile)]
inline 0x8A, 0x3E, 0x09, 0xC1; // mov BH, [@@DATA+Ofs(hFile)+1]
inline 0x8A, 0x0E, 0x06, 0xC1; // mov CL, [@@DATA+Ofs(nCode)]
inline 0x8A, 0x2E, 0x07, 0xC1; // mov CH, [@@DATA+Ofs(nCode)+1]
inline 0xB2, 0x06; // mov DL, Lo(@@DATA+Ofs(Code))
inline 0xB6, 0x81; // mov DH, Hi(@@DATA+Ofs(Code))
inline 0xCD, 0x21; // int 21H
end
word close() is
inline 0xB4, 0x3E; // mov AH, 3EH
inline 0x8A, 0x1E, 0x08, 0xC1; // mov BL, [@@DATA+Ofs(hFile)]
inline 0x8A, 0x3E, 0x09, 0xC1; // mov BH, [@@DATA+Ofs(hFile)+1]
inline 0xCD, 0x21; // int 21H
end
char putc(char C) is
inline 0x8A, 0xD0; // mov DL, AL
inline 0xB4, 0x02; // mov AH, 02H
inline 0xCD, 0x21; // int 21H
end
word halt() is
inline 0xB0, 0x00; // mov AL, 00H
inline 0xB4, 0x4C; // mov AH, 4CH
inline 0xCD, 0x21; // int 21H
end
word mul (word A, word B) is
word M:=0;
while B >0 do
word T :=A;
word I :=1;
while B-I>=I do
T:=T+T;
I:=I+I;
end
M:=M+T;
B:=B-I;
end
return M;
end
word div (word A, word B) is
word D:=0;
while A>=B do
word T :=B;
word I :=1;
while A-T>=T do
T:=T+T;
I:=I+I;
end
A:=A-T;
D:=D+I;
end
return D;
end
word mod (word A, word B) is
return A-mul(div(A,B),B);
end
word Init() is
Heap[ 0]:='0';
Heap[ 1]:='1';
Heap[ 2]:='2';
Heap[ 3]:='3';
Heap[ 4]:='4';
Heap[ 5]:='5';
Heap[ 6]:='6';
Heap[ 7]:='7';
Heap[ 8]:='8';
Heap[ 9]:='9';
Heap[10]:='A';
Heap[11]:='B';
Heap[12]:='C';
Heap[13]:='D';
Heap[14]:='E';
Heap[15]:='F';
Heap[16]:='c';
Heap[17]:='h';
Heap[18]:='a';
Heap[19]:='r';
Heap[20]:= char(0);
Heap[21]:='b';
Heap[22]:='y';
Heap[23]:='t';
Heap[24]:='e';
Heap[25]:= char(0);
Heap[26]:='w';
Heap[27]:='o';
Heap[28]:='r';
Heap[29]:='d';
Heap[30]:= char(0);
Heap[31]:='b';
Heap[32]:='e';
Heap[33]:='g';
Heap[34]:='i';
Heap[35]:='n';
Heap[36]:= char(0);
Heap[37]:='i';
Heap[38]:='f';
Heap[39]:= char(0);
Heap[40]:='w';
Heap[41]:='h';
Heap[42]:='i';
Heap[43]:='l';
Heap[44]:='e';
Heap[45]:= char(0);
Heap[46]:='i';
Heap[47]:='n';
Heap[48]:='l';
Heap[49]:='i';
Heap[50]:='n';
Heap[51]:='e';
Heap[52]:= char(0);
Heap[53]:='r';
Heap[54]:='e';
Heap[55]:='t';
Heap[56]:='u';
Heap[57]:='r';
Heap[58]:='n';
Heap[59]:= char(0);
Heap[60]:='e';
Heap[61]:='n';
Heap[62]:='d';
Heap[63]:= char(0);
Heap[64]:='c';
Heap[65]:='.';
Heap[66]:='p';
Heap[67]:='r';
Heap[68]:='g';
Heap[69]:= char(0);
Heap[70]:='c';
Heap[71]:='.';
Heap[72]:='c';
Heap[73]:='o';
Heap[74]:='m';
Heap[75]:= char(0);
nHeap :=76;
Name[ 0]:=16;
Cls [ 0]:= 1;
Size[ 0]:= 1;
Name[ 1]:=21;
Cls [ 1]:= 1;
Size[ 1]:= 1;
Name[ 2]:=26;
Cls [ 2]:= 1;
Size[ 2]:= 2;
nName := 3;
pStk := 0;
nCode := 0;
cBase := 3072;
nData := cBase+16384;
end
word Push(word V) is
Stk[pStk]:=V;
pStk:=pStk+1;
end
word Pop () is
pStk:=pStk-1;
return Stk[pStk];
end
char putn(word N) is
pStk:=0;
while N!=0 do
Push (mod(N,10));
N:=div(N,10);
end
while pStk!=0 do
putc(char(Pop()+48));
end
end
word Stop() is
putn (nLine);
close();
halt ();
end
word val () is
word E:=10;
word I:= 0;
if Buff[0]='0' then
if Buff[1]='x' then
E:=16;
I:= 2;
end
end
word N:=0;
while Buff[I]!=char(0) do
word K:=0;
while Heap[K]!=Buff[I] do
if K=E then
Stop();
end
K:=K+1;
end
N:=mul(N,E)+K;
I:=I+1;
end
return N;
end
char Look() is
if pText>=nText then
pText :=0;
nText :=read();
if pText>=nText then
return char(0);
end
end
return Text[pText];
end
char Read() is
char Ch:=Look();
if Ch =char(10) then
nLine :=nLine+1;
end
pText :=pText+1;
return Ch;
end
word isalnum() is
if 'A'<=Look() then
if Look()<='Z' then
return 0;
end
end
if 'a'<=Look() then
if Look()<='z' then
return 0;
end
end
if '0'<=Look() then
if Look()<='9' then
return 0;
end
end
return 1;
end
word Digraph(char C1, char C2) is
if Buff[0]=C1 then
if Look()=C2 then
Buff[1]:=Read();
Buff[2]:=char(0);
end
end
end
char Scan() is
word pBuff:=0;
while pBuff =0 do
word sFlag:=0;
while sFlag =0 do
if Look()!=char( 9) then
if Look()!=char(10) then
if Look()!=char(13) then
if Look()!=char(32) then
sFlag:=1;
end
end
end
end
if sFlag=0 then
Read();
end
end
while isalnum()=0 do
Buff[pBuff]:= Read();
pBuff :=pBuff+1;
end
if pBuff=0 then
Buff[pBuff]:= Read();
pBuff :=pBuff+1;
end
Buff[pBuff] :=char(0);
Digraph('<','=');
Digraph('!','=');
Digraph('>','=');
Digraph(':','=');
if Buff[0]='/' then
if Look()='/' then
while Look()!=char(10) do
if Read()=char(0) then
Stop();
end
end
pBuff:=0;
end
end
end
end
word Comp(word pHeap) is
word pBuff:=0;
while Buff[pBuff]=Heap[pHeap] do
if Buff[pBuff]=char(0) then
return 0;
end
pHeap:=pHeap+1;
pBuff:=pBuff+1;
end
return 1;
end
word Find(word fFlag) is
word pName:=0;
while pName< nName do
if Comp(Name[pName])=0 then
return pName;
end
pName:=pName+1;
end
if fFlag=0 then
Stop();
end
return pName;
end
byte Emi1(byte B) is
Code[nCode]:=B;
nCode:=nCode+1;
end
word Emi2(word W) is
Emi1(mod(W,256));
Emi1(div(W,256));
end
word Emi3(word P, word W) is
W:=W+cBase;
Code[P] :=mod(W,256);
Code[P+1]:=div(W,256);
end
word MkIX(word I, word D) is
if Size[Type[I]]=2 then
Emi1(0x18); // clc
Emi1(0x8A); // txa
Emi1(0x0A); // asl
Emi1(0xAA); // tax
Emi1(0x98); // tya
Emi1(0x2A); // rol
Emi1(0xA8); // tay
end
Emi1(0x18); // clc
Emi1(0x8A); // txa
Emi1(0x69); // adc #Val
Emi1(mod(Ofs[I],256));
if D =0 then
Emi1(0x85); // sta 0xFE
Emi1(0xFE);
end
if D!=0 then
Emi1(0xAA); // tax
end
Emi1(0x98); // tya
Emi1(0x69); // adc #Val
Emi1(div(Ofs[I],256));
if D =0 then
Emi1(0x85); // sta 0xFF
Emi1(0xFF);
end
if D!=0 then
Emi1(0x48); // pha
Emi1(0x8A); // txa
Emi1(0x48); // pha
end
end
word Assign(word I) is
if Size[I]>1 then
Emi1(0x68); // pla
Emi1(0x85); // sta 0xFE
Emi1(0xFE);
Emi1(0x68); // pla
Emi1(0x85); // sta 0xFF
Emi1(0xFF);
if Size[Type[I]]=2 then
Emi1(0x98); // tya
Emi1(0xA0); // ldy #1
Emi1(0x01);
Emi1(0x91); // sta (0xFE),Y
Emi1(0xFE);
Emi1(0x88); // dey
Emi1(0x8A); // txa
Emi1(0x91); // sta (0xFE),Y
Emi1(0xFE);
end
if Size[Type[I]]=1 then
Emi1(0xA0); // ldy #0
Emi1(0x00);
Emi1(0x8A); // txa
Emi1(0x91); // sta (0xFE),Y
Emi1(0xFE);
end
end
if Size[I]=1 then
Emi1(0x8E); // stx Adr
Emi2(Ofs[I]);
if Size[Type[I]]=2 then
Emi1(0x8C); // sty Adr
Emi2(Ofs[I]+1);
end
end
end
word Expr() is
word eFlag:=0;
word eType;
//if eFlag =0 then
if '0'<=Buff[0] then
if Buff[0]<='9' then
word W:=val();
Emi1(0xA2); // ldx #Val
Emi1(mod(W,256));
//eFlag :=1;
eType :=1;
if W>=256 then
Emi1(0xA0); // ldy #Val
Emi1(div(W,256));
//eFlag:=2;
eType:=2;
end
eFlag:=1;
end
end
if Buff[0]=''' then
Emi1(0xA2); // ldx #Val
Emi1(byte(Read()));
//Emi1(0xA0); // ldy #0
//Emi1(0x00);
Read();
eType:=0;
eFlag:=1;
end
if Buff[0]='(' then
Scan();
//Expr();
//eFlag:=1;
//eFlag:=Expr();
eType:=Expr();
eFlag:=1;
end
//end
if eFlag =0 then
word I:=Find(0);
if Cls[I]=1 then
Push(I);
Scan(); // (
Scan();
//Expr();
//eFlag:=Expr();
eType:=Expr();
I:=Pop();
end
if Cls[I]=2 then
if Size[I]>1 then
Push(I);
Scan(); // [
Scan();
//Expr();
//if Expr()=1 then
if Size[Expr()]=1 then
Emi1(0xA0); // ldy #0
Emi1(0x00);
end
I:=Pop();
MkIX(I, 0);
Emi1(0xA0); // ldy #0
Emi1(0x00);
Emi1(0xB1); // lda (0xFE),Y
Emi1(0xFE);
Emi1(0xAA); // tax
//eFlag:=1;
if Size[Type[I]]=2 then
Emi1(0xC8); // iny
Emi1(0xB1); // lda (0xFE),Y
Emi1(0xFE);
Emi1(0xA8); // tay
//eFlag:=2;
end
end
if Size[I]=1 then
Emi1(0xAE); // ldx Adr
Emi2(Ofs[I]);
//eFlag:=1;
if Size[Type[I]]=2 then
Emi1(0xAC); // ldy Adr
Emi2(Ofs[I]+1);
//eFlag:=2;
end
end
//if Size[Type[I]]=1 then
// Emi1(0xA0); // ldy #0
// Emi1(0x00);
//end
eType:=Type[I];
end
if Cls[I]=3 then
Scan(); // (
Push(I);
Sub[nName]:= 0;
word J:=I+1;
while Sub[J]=1 do
Push(J);
Scan();
//Expr();
word E:=Expr();
J:=Pop();
if Size[Type[J]]=2 then
//if E=1 then
if Size[E]=1 then
Emi1(0xA0); // ldy #0
Emi1(0x00);
end
end
Assign(J);
J:=J+1;
end
I:=Pop();
if J=I+1 then
Scan(); // )
end
Emi1(0x20); // jsr
Emi2(Ofs[I]+cBase);
//eFlag:=Size[Type[I]];
eType:=Type[I];
end
end
Scan();
word Op:=0x00;
if Buff[0]='+' then
Op:=0x65;
end
if Buff[0]='-' then
Op:=0xE5;
end
if Op!=0 then
//if eFlag=2 then
if Size[eType]=2 then
Emi1(0x98); // tya
Emi1(0x48); // pha
end
Emi1(0x8A); // txa
Emi1(0x48); // pha
Push(Op);
//Push(eFlag);
Push(eType);
Scan();
//Expr();
//word eFlag2:=Expr();
word eType2:=Expr();
//word eFlag1:=Pop ();
word eType1:=Pop ();
//eFlag:=eFlag1;
eType:=eType1;
//if eFlag2=2 then
if Size[eType2]=2 then
//eFlag:=2;
eType:=eType2;
end
Op:=Pop();
Emi1(0x86); // stx 0xFE
Emi1(0xFE);
//if eFlag=2 then
if Size[eType]=2 then
//if eFlag2=1 then
if Size[eType2]=1 then
Emi1(0xA0); // ldy #0
Emi1(0x00);
end
Emi1(0x84); // sty 0xFF
Emi1(0xFF);
end
if Op=0x65 then
Emi1(0x18); // clc
end
if Op=0xE5 then
Emi1(0x38); // sec
end
Emi1(0x68); // pla
Emi1(Op); // opr 0xFE
Emi1(0xFE);
Emi1(0xAA); // tax
//if eFlag=2 then
if Size[eType]=2 then
Emi1(0x68); // pla
Emi1(Op); // opr 0xFF
Emi1(0xFF);
Emi1(0xA8); // tay
end
end
//return eFlag;
return eType;
end
word Cond() is
Scan();
word E1:=Expr();
word jType := 0;
word jOfs1 := 0;
word jCode2:=0x90; // bcc
if Buff[0]='<' then
jType := 1;
if Buff[1]='=' then
jType := 2;
jCode2 :=0xB0; // bcs
end
end
if Buff[0]='=' then
jType := 3;
jOfs1 := 6;
jCode2 :=0xF0; // beq
end
if Buff[0]='!' then
jType := 3;
jOfs1 := 9;
jCode2 :=0xD0; // bne
end
if Buff[0]='>' then
jType := 2;
if Buff[1]='=' then
jType := 1;
jCode2 :=0xB0; // bcs
end
end
if jType=0 then
Stop();
end
//if E1=2 then
if Size[E1]=2 then
Emi1(0x98); // tya
Emi1(0x48); // pha
end
Emi1(0x8A); // txa
Emi1(0x48); // pha
Scan();
word E2:=Expr();
word E3:=E1;
//if E2=2 then
if Size[E2]=2 then
//E3:=2;
E3:=E2;
end
//if E3=2 then
if Size[E3]=2 then
//if E2=1 then
if Size[E2]=1 then
Emi1(0xA0); // ldy #0
Emi1(0x00);
end
end
if jType=1 then
Emi1(0x68); // pla
Emi1(0x86); // stx 0xFE
Emi1(0xFE);
Emi1(0x38); // sec
Emi1(0xE5); // sbc 0xFE
Emi1(0xFE);
//if E3=2 then
if Size[E3]=2 then
//if E1=1 then
if Size[E1]=1 then
Emi1(0xA9); // lda #0
Emi1(0x00);
end
//if E1=2 then
if Size[E1]=2 then
Emi1(0x68); // pla
end
Emi1(0x84); // sty 0xFF
Emi1(0xFF);
Emi1(0xE5); // sbc 0xFF
Emi1(0xFF);
end
end
if jType=2 then
Emi1(0x68); // pla
Emi1(0x85); // sta 0xFE
Emi1(0xFE);
Emi1(0x8A); // txa
Emi1(0x38); // sec
Emi1(0xE5); // sbc 0xFE
Emi1(0xFE);
//if E3=2 then
if Size[E3]=2 then
//if E1=1 then
if Size[E1]=1 then
Emi1(0xA9); // lda #0
Emi1(0x00);
end
//if E1=2 then
if Size[E1]=2 then
Emi1(0x68); // pla
end
Emi1(0x85); // sta 0xFF
Emi1(0xFF);
Emi1(0x98); // tya
Emi1(0xE5); // sbc 0xFF
Emi1(0xFF);
end
end
if jType=3 then
Emi1(0x68); // pla
Emi1(0x85); // sta 0xFE
Emi1(0xFE);
//if E1=2 then
if Size[E1]=2 then
Emi1(0x68); // pla
end
//if E3=1 then
if Size[E3]=1 then
Emi1(0xE4); // cpx 0xFE
Emi1(0xFE);
end
//if E3=2 then
if Size[E3]=2 then
Emi1(0xE4); // cpx 0xFE
Emi1(0xFE);
//if E1=1 then
if Size[E1]=1 then
Emi1(0xD0); // bne
Emi1(jOfs1+2);
Emi1(0xA9); // lda #0
Emi1(0x00);
end
//if E1=2 then
if Size[E1]=2 then
Emi1(0xD0); // bne
Emi1(jOfs1);
end
Emi1(0x85); // sta 0xFF
Emi1(0xFF);
Emi1(0xC4); // cpy 0xFF
Emi1(0xFF);
end
end
Emi1(jCode2); // bxx $+3
Emi1(0x03);
Push(nCode);
Emi1(0x4C); // jmp ?
nCode:=nCode+2;
end
word Obj (word T) is
if Cls[T]!=1 then
Stop();
end
Name[nName]:=nHeap;
Type[nName]:= T;
Scan();
if Find(1)<nName then
Stop();
end
word pBuff:=0;
char Ch :=char(1);
while Ch !=char(0) do
Ch := Buff[pBuff];
Heap[nHeap]:= Ch;
nHeap :=nHeap+1;
pBuff :=pBuff+1;
end
Scan();
return nName;
end
char Var (word Subclass) is
if nName >= 144 then
Stop();
end
Cls [nName]:= 2;
Sub [nName]:= Subclass;
Size[nName]:= 1;
Ofs [nName]:=nData;
if Buff[0]='[' then
if Subclass!=0 then
Stop();
end
Scan();
Size[nName]:=val();
Scan(); // ]
Scan(); // ;
end
nData :=nData+mul(Size[nName],Size[Type[nName]]);
nName :=nName+1;
return Buff[0];
end
word Hide() is
word I:=Pop();
while I< nName do
Heap[Name[I]]:=char(0);
I :=I+1;
end
end
word rFlag;
word Ctrl() is
word cFlag:=0;
//if cFlag =0 then
if Comp(37)=0 then // if
Cond();
Push(nName);
Scan();
Ctrl();
while Comp(60)!=0 do // !end
Ctrl();
end
Hide();
Emi3(Pop()+1,nCode);
rFlag:=1; // 14.05.2006
cFlag:=1;
end
//end
if cFlag =0 then
if Comp(40)=0 then // while
Push(nCode);
Cond();
Push(nName);
Scan();
Ctrl();
while Comp(60)!=0 do // !end
Ctrl();
end
Hide();
word pExit:=Pop();
word pLoop:=Pop();
Emi1(0x4C); // jmp Ofs
Emi2(pLoop+cBase);
Emi3(pExit+1,nCode);
rFlag:=1; // 14.05.2006
cFlag:=1;
end
end
if cFlag =0 then
if Comp(46)=0 then // inline
Buff[0]:=',';
while Buff[0]=',' do
Scan();
Emi1(val()); // db Val
Scan();
end
rFlag:=1; // 14.05.2006
cFlag:=1;
end
end
if cFlag =0 then
if Comp(53)=0 then // return
Scan();
Expr();
Emi1(0x60); // rts
rFlag:=0; // 14.05.2006
cFlag:=1;
end
end
if cFlag =0 then
word I:=Find(0);
if Cls[I]=1 then
word N:=Obj(I);
if Var(2)=':' then
Scan();
word E:=Expr();
if Size[Type[N]]=2 then
//if E=1 then
if Size[E]=1 then
Emi1(0xA0); // ldy #0
Emi1(0x00);
end
end
Assign(N);
end
end
if Cls[I]=2 then
if Size[I]>1 then
Scan(); // [
Scan();
//Expr();
//if Expr()=1 then
if Size[Expr()]=1 then
Emi1(0xA0); // ldy #0
Emi1(0x00);
end
MkIX(I, 1);
end
Scan(); // :=
Scan();
//Expr();
word E:=Expr();
if Size[Type[I]]=2 then
//if E=1 then
if Size[E]=1 then
Emi1(0xA0); // ldy #0
Emi1(0x00);
end
end
Assign(I);
end
if Cls[I]=3 then
Expr();
end
rFlag:=1; // 14.05.2006
end
Scan();
end
word Func() is
Scan();
Ctrl();
while Comp(60)!=0 do // !end
Ctrl();
end
if rFlag!=0 then // 14.05.2006 // if rFlag=0 then
Emi1(0x60); // rts
end
end
word X;
begin
Init();
hFile:=open();
pText:=0;
nText:=0;
nLine:=1;
Emi1(0x4C); // jmp ?
nCode:=nCode+2;
Scan();
while Comp(31)!=0 do // !begin
Obj (Find(0));
char Ch:=Buff[0];
if Ch ='(' then
Cls [nName]:= 3;
Sub [nName]:= 0;
Ofs [nName]:=nCode;
nName :=nName+1;
Push(nName);
Scan();
if Buff[0]!=')' then
Obj (Find(0));
while Var(1)=',' do
Scan();
Obj (Find(0));
end
end
Scan(); // is
Func();
Hide();
end
if Ch!='(' then
Var(0);
end
Scan();
end
Emi3 (1,nCode);
Func ();
close();
hFile:=create();
write();
close();
X:=0;
end
Version for Apple DOS:
byte FMWA [ 46]; // 0x4C00 // 45 + 1 extra byte
byte TSLB [ 256]; // 0x4C2E
byte DSB [ 256]; // 0x4D2E
char FName[ 30]; // 0x4E2E
char Text [ 256]; // 0x4E4C
word pText; // 0x4F4C
word nText; // 0x4F4E
word nLine; // 0x4F50
byte Code [14848]; // 0x4F52 //14336
word nCode; // 0x8952 //0x8752
char Heap [ 2048];
word nHeap;
word Name [ 144];
byte Cls [ 144];
byte Sub [ 144];
byte Type [ 144];
word Size [ 144];
word Ofs [ 144];
word nName;
word cBase;
word nData;
word Stk [ 128];
word pStk;
char Buff [ 32];
word GetResultCode() is
inline 0xA0, 0x0A; // ldy #0x0A
inline 0xB1, 0xEE; // lda (0xEE), Y
inline 0xAA; // tax
inline 0xA0, 0x00; // ldy #0x00
end
word InitFMPL() is
inline 0x20, 0xDC, 0x03; // jsr 0x03DC ;Locate FMPL
inline 0x84, 0xEE; // sty 0xEE
inline 0x85, 0xEF; // sta 0xEF
inline 0xA9, 0x00; // lda #>FMWA
inline 0xA0, 0x0C; // ldy #0x0C
inline 0x91, 0xEE; // sta (0xEE), Y
inline 0xA9, 0x4C; // lda #<FMWA
inline 0xC8; // iny
inline 0x91, 0xEE; // sta (0xEE), Y
inline 0xA9, 0x2E; // lda #>TSLB
inline 0xC8; // iny
inline 0x91, 0xEE; // sta (0xEE), Y
inline 0xA9, 0x4C; // lda #<TSLB
inline 0xC8; // iny
inline 0x91, 0xEE; // sta (0xEE), Y
inline 0xA9, 0x2E; // lda #>DSB
inline 0xC8; // iny
inline 0x91, 0xEE; // sta (0xEE), Y
inline 0xA9, 0x4D; // lda #<DSB
inline 0xC8; // iny
inline 0x91, 0xEE; // sta (0xEE), Y
end
word SetVDS() is
inline 0x20, 0xE3, 0x03; // jsr 0x03E3 ;Locate RPL
inline 0x84, 0xEC; // sty 0xEC
inline 0x85, 0xED; // sta 0xED
inline 0xA9, 0x00; // lda #0x00
inline 0xA0, 0x04; // ldy #0x04 ;Volume
inline 0x91, 0xEE; // sta (0xEE), Y
inline 0xA0, 0x02; // ldy #0x02
inline 0xB1, 0xEC; // lda (0xEC), Y
inline 0xA0, 0x05; // ldy #0x05 ;Drive
inline 0x91, 0xEE; // sta (0xEE), Y
inline 0xAA; // tax ;return
inline 0xA0, 0x01; // ldy #0x01
inline 0xB1, 0xEC; // lda (0xEC), Y
inline 0x4A; // lsr A
inline 0x4A; // lsr A
inline 0x4A; // lsr A
inline 0x4A; // lsr A
inline 0xA0, 0x06; // ldy #0x06 ;Slot
inline 0x91, 0xEE; // sta (0xEE), Y
inline 0xA8; // tay ;return
end
word CallFMforOpen() is
inline 0xA9, 0x01; // lda #0x01 ;Open
inline 0xA0, 0x00; // ldy #0x00 ;Opcode
inline 0x91, 0xEE; // sta (0xEE), Y
inline 0xA9, 0x00; // lda #0x00
inline 0xA0, 0x02; // ldy #0x02 ;Record length
inline 0x91, 0xEE; // sta (0xEE), Y
inline 0xC8; // iny
inline 0x91, 0xEE; // sta (0xEE), Y
SetVDS();
inline 0xA9, 0x00; // lda #0x00 ;Text
//inline 0xA9, 0x04; // lda #0x04 ;Binary
inline 0xA0, 0x07; // ldy #0x07 ;File type
inline 0x91, 0xEE; // sta (0xEE), Y
inline 0xA9, 0x2E; // lda #>FName
inline 0xC8; // iny ;File name
inline 0x91, 0xEE; // sta (0xEE), Y
inline 0xA9, 0x4E; // lda #<FName
inline 0xC8; // iny
inline 0x91, 0xEE; // sta (0xEE), Y
inline 0xA2, 0x01; // ldx #0x01 ;File exists
inline 0x4C, 0xD6, 0x03; // jmp 0x03D6 ;Jump to FM
end
word open() is
CallFMforOpen();
return GetResultCode();
end
word CallFMforCreate() is
inline 0xA9, 0x01; // lda #0x01 ;Open
inline 0xA0, 0x00; // ldy #0x00 ;Opcode
inline 0x91, 0xEE; // sta (0xEE), Y
inline 0xA9, 0x00; // lda #0x00
inline 0xA0, 0x02; // ldy #0x02 ;Record length
inline 0x91, 0xEE; // sta (0xEE), Y
inline 0xC8; // iny
inline 0x91, 0xEE; // sta (0xEE), Y
SetVDS();
inline 0xA9, 0x04; // lda #0x04 ;Binary
inline 0xA0, 0x07; // ldy #0x07 ;File type
inline 0x91, 0xEE; // sta (0xEE), Y
inline 0xA9, 0x2E; // lda #>FName
inline 0xC8; // iny ;File name
inline 0x91, 0xEE; // sta (0xEE), Y
inline 0xA9, 0x4E; // lda #<FName
inline 0xC8; // iny
inline 0x91, 0xEE; // sta (0xEE), Y
inline 0xA2, 0x00; // ldx #0x00 ;File may not exists
inline 0x4C, 0xD6, 0x03; // jmp 0x03D6 ;Jump to FM
end
word create() is
CallFMforCreate();
return GetResultCode();
end
word CallFMforRewind() is
inline 0xA9, 0x0A; // lda #0x0A ;Position
inline 0xA0, 0x00; // ldy #0x00 ;Opcode
inline 0x91, 0xEE; // sta (0xEE), Y
inline 0xA9, 0x00; // lda #0x00
inline 0xA0, 0x00; // ldy #0x02 ;Record number
inline 0x91, 0xEE; // sta (0xEE), Y
inline 0xC8; // iny
inline 0x91, 0xEE; // sta (0xEE), Y
inline 0xC8; // iny
inline 0x91, 0xEE; // sta (0xEE), Y
inline 0xC8; // iny
inline 0x91, 0xEE; // sta (0xEE), Y
inline 0x4C, 0xD6, 0x03; // jmp 0x03D6 ;Jump to FM
end
word rewind() is
CallFMforRewind();
return GetResultCode();
end
word CallFMforRead() is
inline 0xA9, 0x03; // lda #0x03 ;Read
inline 0xA0, 0x00; // ldy #0x00 ;Opcode
inline 0x91, 0xEE; // sta (0xEE), Y
inline 0xA9, 0x02; // lda #0x02 ;Range
inline 0xC8; // iny ;Subcode
inline 0x91, 0xEE; // sta (0xEE), Y
inline 0xA9, 0x00; // lda #0x00 ;Lo(sizeof Text)
inline 0xA0, 0x06; // ldy #0x06 ;Range length
inline 0x91, 0xEE; // sta (0xEE), Y
inline 0xA9, 0x01; // lda #0x01 ;Hi(sizeof Text) ; 0x04!
inline 0xC8; // iny
inline 0x91, 0xEE; // sta (0xEE), Y
inline 0xA9, 0x4C; // lda #0x4C ;Lo(@Text)
inline 0xC8; // iny ;Text addr
inline 0x91, 0xEE; // sta (0xEE), Y
inline 0xA9, 0x4E; // lda #0x4E ;Hi(@Text)
inline 0xC8; // iny
inline 0x91, 0xEE; // sta (0xEE), Y
inline 0x4C, 0xD6, 0x03; // jmp 0x03D6 ;Jump to FM
end
word read() is
CallFMforRead();
return GetResultCode();
end
word CallFMforWrite() is
inline 0xA9, 0x04; // lda #0x04 ;Write
inline 0xA0, 0x00; // ldy #0x00 ;Opcode
inline 0x91, 0xEE; // sta (0xEE), Y
inline 0xA9, 0x02; // lda #0x02 ;Range
inline 0xC8; // iny ;Subcode
inline 0x91, 0xEE; // sta (0xEE), Y
//inline 0xAD, 0x52, 0x87; // lda 0x8752 ;Lo(nCode)
inline 0xAD, 0x52, 0x89; // lda 0x8952 ;Lo(nCode)
inline 0xA0, 0x06; // ldy #0x06 ;Range length
inline 0x91, 0xEE; // sta (0xEE), Y
//inline 0xAD, 0x53, 0x87; // lda 0x8753 ;Hi(nCode)
inline 0xAD, 0x53, 0x89; // lda 0x8953 ;Hi(nCode)
inline 0xC8; // iny
inline 0x91, 0xEE; // sta (0xEE), Y
inline 0xA9, 0x52; // lda #0x52 ;Lo(@Code)
inline 0xC8; // iny ;Code addr
inline 0x91, 0xEE; // sta (0xEE), Y
inline 0xA9, 0x4F; // lda #0x4F ;Hi(@Code)
inline 0xC8; // iny
inline 0x91, 0xEE; // sta (0xEE), Y
inline 0x4C, 0xD6, 0x03; // jmp 0x03D6 ;Jump to FM
end
word write() is
CallFMforWrite();
return GetResultCode();
end
word CallFMforClose() is
inline 0xA9, 0x02; // lda #0x02 ;Close
inline 0xA0, 0x00; // ldy #0x00 ;Opcode
inline 0x91, 0xEE; // sta (0xEE), Y
inline 0x4C, 0xD6, 0x03; // jmp 0x03D6 ;Jump to FM
end
word close() is
CallFMforClose();
return GetResultCode();
end
char putc(char C) is
inline 0x8A; // txa
inline 0x18; // clc
inline 0x69, 0x80; // adc #0x80
inline 0x20, 0xF0, 0xFD; // jsr 0xFDF0
end
word halt() is
inline 0x20, 0xD0, 0x03; // jsr 0x03D0
end
word mul (word A, word B) is
word M:=0;
while B >0 do
word T :=A;
word I :=1;
while B-I>=I do
T:=T+T;
I:=I+I;
end
M:=M+T;
B:=B-I;
end
return M;
end
word div (word A, word B) is
word D:=0;
while A>=B do
word T :=B;
word I :=1;
while A-T>=T do
T:=T+T;
I:=I+I;
end
A:=A-T;
D:=D+I;
end
return D;
end
word mod (word A, word B) is
return A-mul(div(A,B),B);
end
word Init() is
word I:= 0;
while I< 30 do
FName[I]:=char(0xA0);
I:=I+1;
end
FName[0]:=char(byte('C')+0x80);
FName[1]:=char(byte('.')+0x80);
FName[2]:=char(byte('P')+0x80);
FName[3]:=char(byte('R')+0x80);
FName[4]:=char(byte('G')+0x80);
Heap[ 0]:='0';
Heap[ 1]:='1';
Heap[ 2]:='2';
Heap[ 3]:='3';
Heap[ 4]:='4';
Heap[ 5]:='5';
Heap[ 6]:='6';
Heap[ 7]:='7';
Heap[ 8]:='8';
Heap[ 9]:='9';
Heap[10]:='A';
Heap[11]:='B';
Heap[12]:='C';
Heap[13]:='D';
Heap[14]:='E';
Heap[15]:='F';
Heap[16]:='c';
Heap[17]:='h';
Heap[18]:='a';
Heap[19]:='r';
Heap[20]:= char(0);
Heap[21]:='b';
Heap[22]:='y';
Heap[23]:='t';
Heap[24]:='e';
Heap[25]:= char(0);
Heap[26]:='w';
Heap[27]:='o';
Heap[28]:='r';
Heap[29]:='d';
Heap[30]:= char(0);
Heap[31]:='b';
Heap[32]:='e';
Heap[33]:='g';
Heap[34]:='i';
Heap[35]:='n';
Heap[36]:= char(0);
Heap[37]:='i';
Heap[38]:='f';
Heap[39]:= char(0);
Heap[40]:='w';
Heap[41]:='h';
Heap[42]:='i';
Heap[43]:='l';
Heap[44]:='e';
Heap[45]:= char(0);
Heap[46]:='i';
Heap[47]:='n';
Heap[48]:='l';
Heap[49]:='i';
Heap[50]:='n';
Heap[51]:='e';
Heap[52]:= char(0);
Heap[53]:='r';
Heap[54]:='e';
Heap[55]:='t';
Heap[56]:='u';
Heap[57]:='r';
Heap[58]:='n';
Heap[59]:= char(0);
Heap[60]:='e';
Heap[61]:='n';
Heap[62]:='d';
Heap[63]:= char(0);
nHeap :=64;
//Heap[64]:='c';
//Heap[65]:='.';
//Heap[66]:='p';
//Heap[67]:='r';
//Heap[68]:='g';
//Heap[69]:= char(0);
//Heap[70]:='c';
//Heap[71]:='.';
//Heap[72]:='c';
//Heap[73]:='o';
//Heap[74]:='m';
//Heap[75]:= char(0);
//nHeap :=76;
Name[ 0]:=16;
Cls [ 0]:= 1;
Size[ 0]:= 1;
Name[ 1]:=21;
Cls [ 1]:= 1;
Size[ 1]:= 1;
Name[ 2]:=26;
Cls [ 2]:= 1;
Size[ 2]:= 2;
nName := 3;
pStk := 0;
nCode := 0;
cBase := 3072-4;
nData := cBase+16384+4;
end
word Push(word V) is
Stk[pStk]:=V;
pStk:=pStk+1;
end
word Pop () is
pStk:=pStk-1;
return Stk[pStk];
end
char putn(word N) is
pStk:=0;
while N!=0 do
Push (mod(N,10));
N:=div(N,10);
end
while pStk!=0 do
putc(char(Pop()+48));
end
end
word Stop() is
putn (nLine);
close();
halt ();
end
word val () is
word E:=10;
word I:= 0;
if Buff[0]='0' then
if Buff[1]='x' then
E:=16;
I:= 2;
end
end
word N:=0;
while Buff[I]!=char(0) do
word K:=0;
while Heap[K]!=Buff[I] do
if K=E then
Stop();
end
K:=K+1;
end
N:=mul(N,E)+K;
I:=I+1;
end
return N;
end
char Look() is
if pText>=nText then
Text[0]:='$';
pText :=0;
nText :=256;
read();
end
return Text[pText];
end
char Read() is
char Ch:=Look();
if Ch =char(10) then
nLine :=nLine+1;
end
pText :=pText+1;
//if Ch!=char(10) then
// putc(Ch);
//end
return Ch;
end
word isalnum() is
if 'A'<=Look() then
if Look()<='Z' then
return 0;
end
end
if 'a'<=Look() then
if Look()<='z' then
return 0;
end
end
if '0'<=Look() then
if Look()<='9' then
return 0;
end
end
return 1;
end
word Digraph(char C1, char C2) is
if Buff[0]=C1 then
if Look()=C2 then
Buff[1]:=Read();
Buff[2]:=char(0);
end
end
end
char Scan() is
word pBuff:=0;
while pBuff =0 do
word sFlag:=0;
while sFlag =0 do
if Look()!=char( 9) then
if Look()!=char(10) then
if Look()!=char(13) then
if Look()!=char(32) then
sFlag:=1;
end
end
end
end
if sFlag=0 then
Read();
end
end
while isalnum()=0 do
Buff[pBuff]:= Read();
pBuff :=pBuff+1;
end
if pBuff=0 then
Buff[pBuff]:= Read();
pBuff :=pBuff+1;
end
Buff[pBuff] :=char(0);
Digraph('<','=');
Digraph('!','=');
Digraph('>','=');
Digraph(':','=');
if Buff[0]='/' then
if Look()='/' then
while Look()!=char(10) do
if Read()=char(0) then
Stop();
end
end
pBuff:=0;
end
end
end
end
word Comp(word pHeap) is
word pBuff:=0;
while Buff[pBuff]=Heap[pHeap] do
if Buff[pBuff]=char(0) then
return 0;
end
pHeap:=pHeap+1;
pBuff:=pBuff+1;
end
return 1;
end
word Find(word fFlag) is
word pName:=0;
while pName< nName do
if Comp(Name[pName])=0 then
return pName;
end
pName:=pName+1;
end
if fFlag=0 then
Stop();
end
return pName;
end
byte Emi1(byte B) is
Code[nCode]:=B;
nCode:=nCode+1;
end
word Emi2(word W) is
Emi1(mod(W,256));
Emi1(div(W,256));
end
word Emi3(word P, word W) is
W:=W+cBase;
Code[P] :=mod(W,256);
Code[P+1]:=div(W,256);
end
word MkIX(word I, word D) is
if Size[Type[I]]=2 then
Emi1(0x18); // clc
Emi1(0x8A); // txa
Emi1(0x0A); // asl
Emi1(0xAA); // tax
Emi1(0x98); // tya
Emi1(0x2A); // rol
Emi1(0xA8); // tay
end
Emi1(0x18); // clc
Emi1(0x8A); // txa
Emi1(0x69); // adc #Val
Emi1(mod(Ofs[I],256));
if D =0 then
Emi1(0x85); // sta 0xFE
Emi1(0xFE);
end
if D!=0 then
Emi1(0xAA); // tax
end
Emi1(0x98); // tya
Emi1(0x69); // adc #Val
Emi1(div(Ofs[I],256));
if D =0 then
Emi1(0x85); // sta 0xFF
Emi1(0xFF);
end
if D!=0 then
Emi1(0x48); // pha
Emi1(0x8A); // txa
Emi1(0x48); // pha
end
end
word Assign(word I) is
if Size[I]>1 then
Emi1(0x68); // pla
Emi1(0x85); // sta 0xFE
Emi1(0xFE);
Emi1(0x68); // pla
Emi1(0x85); // sta 0xFF
Emi1(0xFF);
if Size[Type[I]]=2 then
Emi1(0x98); // tya
Emi1(0xA0); // ldy #1
Emi1(0x01);
Emi1(0x91); // sta (0xFE),Y
Emi1(0xFE);
Emi1(0x88); // dey
Emi1(0x8A); // txa
Emi1(0x91); // sta (0xFE),Y
Emi1(0xFE);
end
if Size[Type[I]]=1 then
Emi1(0xA0); // ldy #0
Emi1(0x00);
Emi1(0x8A); // txa
Emi1(0x91); // sta (0xFE),Y
Emi1(0xFE);
end
end
if Size[I]=1 then
Emi1(0x8E); // stx Adr
Emi2(Ofs[I]);
if Size[Type[I]]=2 then
Emi1(0x8C); // sty Adr
Emi2(Ofs[I]+1);
end
end
end
word Expr() is
word eFlag:=0;
word eType;
//if eFlag =0 then
if '0'<=Buff[0] then
if Buff[0]<='9' then
word W:=val();
Emi1(0xA2); // ldx #Val
Emi1(mod(W,256));
//eFlag :=1;
eType :=1;
if W>=256 then
Emi1(0xA0); // ldy #Val
Emi1(div(W,256));
//eFlag:=2;
eType:=2;
end
eFlag:=1;
end
end
if Buff[0]=''' then
Emi1(0xA2); // ldx #Val
Emi1(byte(Read()));
//Emi1(0xA0); // ldy #0
//Emi1(0x00);
Read();
eType:=0;
eFlag:=1;
end
if Buff[0]='(' then
Scan();
//Expr();
//eFlag:=1;
//eFlag:=Expr();
eType:=Expr();
eFlag:=1;
end
//end
if eFlag =0 then
word I:=Find(0);
if Cls[I]=1 then
Push(I);
Scan(); // (
Scan();
//Expr();
//eFlag:=Expr();
eType:=Expr();
I:=Pop();
end
if Cls[I]=2 then
if Size[I]>1 then
Push(I);
Scan(); // [
Scan();
//Expr();
//if Expr()=1 then
if Size[Expr()]=1 then
Emi1(0xA0); // ldy #0
Emi1(0x00);
end
I:=Pop();
MkIX(I, 0);
Emi1(0xA0); // ldy #0
Emi1(0x00);
Emi1(0xB1); // lda (0xFE),Y
Emi1(0xFE);
Emi1(0xAA); // tax
//eFlag:=1;
if Size[Type[I]]=2 then
Emi1(0xC8); // iny
Emi1(0xB1); // lda (0xFE),Y
Emi1(0xFE);
Emi1(0xA8); // tay
//eFlag:=2;
end
end
if Size[I]=1 then
Emi1(0xAE); // ldx Adr
Emi2(Ofs[I]);
//eFlag:=1;
if Size[Type[I]]=2 then
Emi1(0xAC); // ldy Adr
Emi2(Ofs[I]+1);
//eFlag:=2;
end
end
//if Size[Type[I]]=1 then
// Emi1(0xA0); // ldy #0
// Emi1(0x00);
//end
eType:=Type[I];
end
if Cls[I]=3 then
Scan(); // (
Push(I);
Sub[nName]:= 0;
word J:=I+1;
while Sub[J]=1 do
Push(J);
Scan();
//Expr();
word E:=Expr();
J:=Pop();
if Size[Type[J]]=2 then
//if E=1 then
if Size[E]=1 then
Emi1(0xA0); // ldy #0
Emi1(0x00);
end
end
Assign(J);
J:=J+1;
end
I:=Pop();
if J=I+1 then
Scan(); // )
end
Emi1(0x20); // jsr
Emi2(Ofs[I]+cBase);
//eFlag:=Size[Type[I]];
eType:=Type[I];
end
end
Scan();
word Op:=0x00;
if Buff[0]='+' then
Op:=0x65;
end
if Buff[0]='-' then
Op:=0xE5;
end
if Op!=0 then
//if eFlag=2 then
if Size[eType]=2 then
Emi1(0x98); // tya
Emi1(0x48); // pha
end
Emi1(0x8A); // txa
Emi1(0x48); // pha
Push(Op);
//Push(eFlag);
Push(eType);
Scan();
//Expr();
//word eFlag2:=Expr();
word eType2:=Expr();
//word eFlag1:=Pop ();
word eType1:=Pop ();
//eFlag:=eFlag1;
eType:=eType1;
//if eFlag2=2 then
if Size[eType2]=2 then
//eFlag:=2;
eType:=eType2;
end
Op:=Pop();
Emi1(0x86); // stx 0xFE
Emi1(0xFE);
//if eFlag=2 then
if Size[eType]=2 then
//if eFlag2=1 then
if Size[eType2]=1 then
Emi1(0xA0); // ldy #0
Emi1(0x00);
end
Emi1(0x84); // sty 0xFF
Emi1(0xFF);
end
if Op=0x65 then
Emi1(0x18); // clc
end
if Op=0xE5 then
Emi1(0x38); // sec
end
Emi1(0x68); // pla
Emi1(Op); // opr 0xFE
Emi1(0xFE);
Emi1(0xAA); // tax
//if eFlag=2 then
if Size[eType]=2 then
Emi1(0x68); // pla
Emi1(Op); // opr 0xFF
Emi1(0xFF);
Emi1(0xA8); // tay
end
end
//return eFlag;
return eType;
end
word Cond() is
Scan();
word E1:=Expr();
word jType := 0;
word jOfs1 := 0;
word jCode2:=0x90; // bcc
if Buff[0]='<' then
jType := 1;
if Buff[1]='=' then
jType := 2;
jCode2 :=0xB0; // bcs
end
end
if Buff[0]='=' then
jType := 3;
jOfs1 := 6;
jCode2 :=0xF0; // beq
end
if Buff[0]='!' then
jType := 3;
jOfs1 := 9;
jCode2 :=0xD0; // bne
end
if Buff[0]='>' then
jType := 2;
if Buff[1]='=' then
jType := 1;
jCode2 :=0xB0; // bcs
end
end
if jType=0 then
Stop();
end
//if E1=2 then
if Size[E1]=2 then
Emi1(0x98); // tya
Emi1(0x48); // pha
end
Emi1(0x8A); // txa
Emi1(0x48); // pha
Scan();
word E2:=Expr();
word E3:=E1;
//if E2=2 then
if Size[E2]=2 then
//E3:=2;
E3:=E2;
end
//if E3=2 then
if Size[E3]=2 then
//if E2=1 then
if Size[E2]=1 then
Emi1(0xA0); // ldy #0
Emi1(0x00);
end
end
if jType=1 then
Emi1(0x68); // pla
Emi1(0x86); // stx 0xFE
Emi1(0xFE);
Emi1(0x38); // sec
Emi1(0xE5); // sbc 0xFE
Emi1(0xFE);
//if E3=2 then
if Size[E3]=2 then
//if E1=1 then
if Size[E1]=1 then
Emi1(0xA9); // lda #0
Emi1(0x00);
end
//if E1=2 then
if Size[E1]=2 then
Emi1(0x68); // pla
end
Emi1(0x84); // sty 0xFF
Emi1(0xFF);
Emi1(0xE5); // sbc 0xFF
Emi1(0xFF);
end
end
if jType=2 then
Emi1(0x68); // pla
Emi1(0x85); // sta 0xFE
Emi1(0xFE);
Emi1(0x8A); // txa
Emi1(0x38); // sec
Emi1(0xE5); // sbc 0xFE
Emi1(0xFE);
//if E3=2 then
if Size[E3]=2 then
//if E1=1 then
if Size[E1]=1 then
Emi1(0xA9); // lda #0
Emi1(0x00);
end
//if E1=2 then
if Size[E1]=2 then
Emi1(0x68); // pla
end
Emi1(0x85); // sta 0xFF
Emi1(0xFF);
Emi1(0x98); // tya
Emi1(0xE5); // sbc 0xFF
Emi1(0xFF);
end
end
if jType=3 then
Emi1(0x68); // pla
Emi1(0x85); // sta 0xFE
Emi1(0xFE);
//if E1=2 then
if Size[E1]=2 then
Emi1(0x68); // pla
end
//if E3=1 then
if Size[E3]=1 then
Emi1(0xE4); // cpx 0xFE
Emi1(0xFE);
end
//if E3=2 then
if Size[E3]=2 then
Emi1(0xE4); // cpx 0xFE
Emi1(0xFE);
//if E1=1 then
if Size[E1]=1 then
Emi1(0xD0); // bne
Emi1(jOfs1+2);
Emi1(0xA9); // lda #0
Emi1(0x00);
end
//if E1=2 then
if Size[E1]=2 then
Emi1(0xD0); // bne
Emi1(jOfs1);
end
Emi1(0x85); // sta 0xFF
Emi1(0xFF);
Emi1(0xC4); // cpy 0xFF
Emi1(0xFF);
end
end
Emi1(jCode2); // bxx $+3
Emi1(0x03);
Push(nCode);
Emi1(0x4C); // jmp ?
nCode:=nCode+2;
end
word Obj (word T) is
if Cls[T]!=1 then
Stop();
end
Name[nName]:=nHeap;
Type[nName]:= T;
Scan();
if Find(1)<nName then
Stop();
end
word pBuff:=0;
char Ch :=char(1);
while Ch !=char(0) do
Ch := Buff[pBuff];
Heap[nHeap]:= Ch;
nHeap :=nHeap+1;
pBuff :=pBuff+1;
end
Scan();
return nName;
end
char Var (word Subclass) is
if nName >= 144 then
Stop();
end
Cls [nName]:= 2;
Sub [nName]:= Subclass;
Size[nName]:= 1;
Ofs [nName]:=nData;
if Buff[0]='[' then
if Subclass!=0 then
Stop();
end
Scan();
Size[nName]:=val();
Scan(); // ]
Scan(); // ;
end
nData :=nData+mul(Size[nName],Size[Type[nName]]);
nName :=nName+1;
return Buff[0];
end
word Hide() is
word I:=Pop();
while I< nName do
Heap[Name[I]]:=char(0);
I :=I+1;
end
end
word rFlag;
word Ctrl() is
word cFlag:=0;
//if cFlag =0 then
if Comp(37)=0 then // if
Cond();
Push(nName);
Scan();
Ctrl();
while Comp(60)!=0 do // !end
Ctrl();
end
Hide();
Emi3(Pop()+1,nCode);
rFlag:=1; // 14.05.2006
cFlag:=1;
end
//end
if cFlag =0 then
if Comp(40)=0 then // while
Push(nCode);
Cond();
Push(nName);
Scan();
Ctrl();
while Comp(60)!=0 do // !end
Ctrl();
end
Hide();
word pExit:=Pop();
word pLoop:=Pop();
Emi1(0x4C); // jmp Ofs
Emi2(pLoop+cBase);
Emi3(pExit+1,nCode);
rFlag:=1; // 14.05.2006
cFlag:=1;
end
end
if cFlag =0 then
if Comp(46)=0 then // inline
Buff[0]:=',';
while Buff[0]=',' do
Scan();
Emi1(val()); // db Val
Scan();
end
rFlag:=1; // 14.05.2006
cFlag:=1;
end
end
if cFlag =0 then
if Comp(53)=0 then // return
Scan();
Expr();
Emi1(0x60); // rts
rFlag:=0; // 14.05.2006
cFlag:=1;
end
end
if cFlag =0 then
word I:=Find(0);
if Cls[I]=1 then
word N:=Obj(I);
if Var(2)=':' then
Scan();
word E:=Expr();
if Size[Type[N]]=2 then
//if E=1 then
if Size[E]=1 then
Emi1(0xA0); // ldy #0
Emi1(0x00);
end
end
Assign(N);
end
end
if Cls[I]=2 then
if Size[I]>1 then
Scan(); // [
Scan();
//Expr();
//if Expr()=1 then
if Size[Expr()]=1 then
Emi1(0xA0); // ldy #0
Emi1(0x00);
end
MkIX(I, 1);
end
Scan(); // :=
Scan();
//Expr();
word E:=Expr();
if Size[Type[I]]=2 then
//if E=1 then
if Size[E]=1 then
Emi1(0xA0); // ldy #0
Emi1(0x00);
end
end
Assign(I);
end
if Cls[I]=3 then
Expr();
end
rFlag:=1; // 14.05.2006
end
Scan();
end
word Func() is
Scan();
Ctrl();
while Comp(60)!=0 do // !end
Ctrl();
end
if rFlag!=0 then // 14.05.2006 // if rFlag=0 then
Emi1(0x60); // rts
end
end
word X;
begin
InitFMPL();
Init();
if open ()!= 0 then
putc('E');
putc(char(13));
end
rewind();
nText:=0;
pText:=0;
nLine:=1;
Emi1(0x00); // load addr
Emi1(0x0C);
Emi1(0x00); // file size
Emi1(0x00);
Emi1(0x4C); // jmp ?
nCode:=nCode+2;
Scan();
while Comp(31)!=0 do // !begin
Obj (Find(0));
char Ch:=Buff[0];
if Ch ='(' then
Cls [nName]:= 3;
Sub [nName]:= 0;
Ofs [nName]:=nCode;
nName :=nName+1;
Push(nName);
Scan();
if Buff[0]!=')' then
Obj (Find(0));
while Var(1)=',' do
Scan();
Obj (Find(0));
end
end
Scan(); // is
Func();
Hide();
end
if Ch!='(' then
Var(0);
end
Scan();
end
Emi3 (5,nCode);
Func ();
close();
Code [2]:=mod (nCode-4, 256);
Code [3]:=div (nCode-4, 256);
FName[2]:=char(byte('C')+0x80);
FName[3]:=char(byte('O')+0x80);
FName[4]:=char(byte('M')+0x80);
create();
rewind();
write ();
close ();
//putc (char(13));
//putc ('+');
//putn (nCode-4);
//X:=0;
end