The following compiler uses stack as temporary storage for symbols.
Converted grammar allows choice
the appropriate rule by the order of appearance.
c.def file:
symb ;
numb ;
name ;
type ;
var ;
array ;
fn ;
lsb "[" 0 0;
rsb "]" 0 0;
lcb "(" 0 0;
rcb ")" 0 0;
assign ":=" 0 0;
plus "+" 0 0;
minus "-" 0 1;
star "*" 0 2;
slash "/" 0 3;
pct "%" 0 4;
lt "<" 0 0;
le "<=" 0 1;
eq "=" 0 2;
ne "!=" 0 3;
ge ">=" 0 4;
gt ">" 0 5;
comma "," 0 0;
semi ";" 0 0;
is 0 0;
begin 0 0;
if 0 0;
then 0 0;
while 0 0;
do 0 0;
inline 0 0;
return 0 0;
end 0 0;
char 1 1;
byte 1 1;
word 1 2.
Program : 10 Declarations Main Stmts end
| 10 Main Stmts end
;
Declarations : 0 Declarations Declaration
| 0 Declaration
;
Declaration : 20 TypeName semi
| 30 TypeName lsb numb rsb semi
| 10 Header Stmts end
;
Header : 40 TypeName lcb Args TypeName rcb is
| 50 TypeName lcb TypeName rcb is
| 0 TypeName lcb rcb is
;
Args : 0 Args Arg
| 0 Arg
;
Arg : 60 TypeName comma
;
TypeName : 70 type name
;
Main : 80 begin
;
Stmts : 90 Stmts Stmt
| 90 Stmt
;
Stmt : 100 IfBlk
| 100 WhileBlk
| 100 Inlines
| 110 Ret
| 100 Local
| 100 Assign
| 100 PCall
;
IfBlk : 120 IfHdr Stmts end
;
IfHdr : 130 if Comp symb then
| 130 if Comp numb then
| 140 if Comp Ref then
| 150 if Comp Call then
| 150 if Comp Cast then
| 150 if Comp Expr then
;
WhileBlk : 160 WhileHdr Stmts end
;
WhileHdr : 130 Loop Comp symb do
| 130 Loop Comp numb do
| 140 Loop Comp Ref do
| 150 Loop Comp Call do
| 150 Loop Comp Cast do
| 150 Loop Comp Expr do
;
Loop : 170 while
;
Inlines : 0 Opcodes semi
;
Opcodes : 180 Opcodes comma numb
| 190 inline numb
;
Ret : 200 return symb semi
| 200 return numb semi
| 210 return Ref semi
| 220 return Call semi
| 220 return Cast semi
| 220 return Expr semi
;
Local : 230 TypeName assign symb semi
| 230 TypeName assign numb semi
| 240 TypeName assign Ref semi
| 250 TypeName assign Call semi
| 250 TypeName assign Cast semi
| 250 TypeName assign Expr semi
;
Assign : 260 Ref assign symb semi
| 260 Ref assign numb semi
| 270 Ref assign Ref semi
| 280 Ref assign Call semi
| 280 Ref assign Cast semi
| 280 Ref assign Expr semi
;
PCall : 0 Call semi
;
Comp : 290 symb RelOp
| 290 numb RelOp
| 300 Ref RelOp
| 310 Call RelOp
| 310 Cast RelOp
| 310 Expr RelOp
;
Left : 290 numb Op
| 300 Ref Op
| 310 Call Op
| 310 Cast Op
| 310 Expr Op
| 310 Value Op
;
Ref : 0 var
| 320 array lsb numb rsb
| 330 array lsb Ref rsb
| 340 array lsb Call rsb
| 340 array lsb Cast rsb
| 340 array lsb Expr rsb
;
Call : 350 Fn2 lcb Params symb rcb
| 350 Fn2 lcb Params numb rcb
| 360 Fn2 lcb Params Ref rcb
| 370 Fn2 lcb Params Call rcb
| 370 Fn2 lcb Params Cast rcb
| 370 Fn2 lcb Params Expr rcb
| 380 Fn2 lcb symb rcb
| 380 Fn2 lcb numb rcb
| 390 Fn2 lcb Ref rcb
| 370 Fn2 lcb Call rcb
| 370 Fn2 lcb Cast rcb
| 370 Fn2 lcb Expr rcb
| 400 Fn2 lcb rcb
;
Params : 0 Params Param
| 0 Param
;
Param : 410 symb comma
| 410 numb comma
| 420 Ref comma
| 430 Call comma
| 430 Cast comma
| 430 Expr comma
;
Fn2 : 440 fn
;
Cast : 450 type lcb symb rcb
| 450 type lcb numb rcb
| 460 type lcb Ref rcb
| 0 type lcb Call rcb
| 0 type lcb Expr rcb
;
Expr : 470 Left numb
| 480 Left Ref
| 490 Left Call
| 490 Left Cast
| 490 Left Value
;
Value : 0 lcb Expr rcb
;
RelOp : 0 lt
| 0 le
| 0 eq
| 0 ne
| 0 ge
| 0 gt
;
Op : 0 plus
| 0 minus
| 0 star
| 0 slash
| 0 pct
.
c.prg file:
char Text [16384];
word pText;
word nText;
word nLine;
byte Code [16384];
word nCode;
word hFile;
char Heap [ 2048];
word nHeap;
word Jx [ 6];
word nData;
word Name [ 256];
word Cls [ 256];
word Sub [ 256];
word Type [ 256];
word Size [ 256];
word Ofs [ 256];
word nName;
word Sym [ 96];
word nSym;
word Left [ 192];
word Id [ 192];
word pRight [ 192];
word Len [ 192];
word nLeft;
word Right [ 640];
word pLeft [ 640];
word nRight;
word Stk [ 32];
word Val [ 32];
word Ptr [ 32];
word Frame [ 32];
word nStk;
char Buff [ 32];
word open() is
inline 0xB4, 0x3D; // mov AH, 3DH
inline 0xB0, 0x00; // mov AL, 0
inline 0xBA, 0x4A, 0xC1; // mov DX, @@DATA+Ofs(Heap[64])
inline 0xCD, 0x21; // int 21H
end
word create() is
inline 0xB4, 0x3C; // mov AH, 3CH
inline 0xB9, 0x00, 0x00; // mov CX, 0
inline 0xBA, 0x4A, 0xC1; // mov DX, @@DATA+Ofs(Heap[64])
inline 0xCD, 0x21; // int 21H
end
word read() is
inline 0xB4, 0x3F; // mov AH, 3FH
inline 0x8B, 0x1E, 0x08, 0xC1; // mov BX, word [@@DATA+Ofs(hFile)]
inline 0xB9, 0x00, 0x40; // mov CX, 16384
inline 0xBA, 0x00, 0x41; // mov DX, @@DATA+Ofs(Text)
inline 0xCD, 0x21; // int 21H
end
word write() is
inline 0xB4, 0x40; // mov AH, 40H
inline 0x8B, 0x1E, 0x08, 0xC1; // mov BX, word [@@DATA+Ofs(hFile)]
inline 0x8B, 0x0E, 0x06, 0xC1; // mov CX, word [@@DATA+Ofs(nCode)]
inline 0xBA, 0x06, 0x81; // mov DX, @@DATA+Ofs(Code)
inline 0xCD, 0x21; // int 21H
end
word close() is
inline 0xB4, 0x3E; // mov AH, 3EH
inline 0x8B, 0x1E, 0x08, 0xC1; // mov BX, word [@@DATA+Ofs(hFile)]
inline 0xCD, 0x21; // int 21H
end
char putc(char C) is
char C1:=C;
inline 0x92; // xchg DX, AX
inline 0xB4, 0x02; // mov AH, 2
inline 0xCD, 0x21; // int 21H
end
word halt() is
inline 0xB8, 0x00, 0x4C; // mov AX, 4C00H
inline 0xCD, 0x21; // int 21H
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]:='#';
Heap [ 17]:= char(0);
Heap [ 64]:='c';
Heap [ 65]:='.';
Heap [ 66]:='d'; // p
Heap [ 67]:='e'; // r
Heap [ 68]:='f'; // g
Heap [ 69]:= char(0);
nHeap := 70;
Sym [ 1]:= 16; // #
nSym := 2;
Jx [ 0]:= 0x72;
Jx [ 1]:= 0x76;
Jx [ 2]:= 0x74;
Jx [ 3]:= 0x75;
Jx [ 4]:= 0x73;
Jx [ 5]:= 0x77;
end
word Stop() is
nStk:=0;
while nLine!=0 do
Stk[nStk]:=nLine%10;
nStk :=nStk+1;
nLine :=nLine/10;
end
while nStk !=0 do
nStk :=nStk-1;
putc(char(Stk[nStk]+48));
end
close();
halt ();
end
word val () is
word E:=10;
word J:= 0;
if Buff[0]='0' then
if Buff[1]='x' then
E:=16;
J:= 2;
end
end
word N:=0;
while Buff[J]!=char(0) do
word K:=0;
while Heap[K]!=Buff[J] do
if K=E then
Stop();
end
K:=K+1;
end
N:=E*N;
N:=N+K;
J:=J+1;
end
return N;
end
word Copy() is
word pHeap:=nHeap;
word pBuff:=0;
while Buff[pBuff]!=char(0) do
Heap[nHeap]:= Buff[pBuff];
nHeap :=nHeap+1;
pBuff :=pBuff+1;
end
Heap[nHeap]:=char(0);
nHeap :=nHeap+1;
return pHeap;
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
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 C:=Look();
pText :=pText+1;
return C;
end
word isalpha (char C) is
if 'A'<=C then
if C<='Z' then
return 0;
end
end
if 'a'<=C then
if C<='z' then
return 0;
end
end
return 1;
end
word isnumber(char C) is
if '0'<=C then
if C<='9' then
return 0;
end
end
return 1;
end
word isalnum (char C) is
if isalpha (C)=0 then
return 0;
end
if isnumber(C)=0 then
return 0;
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
if Read()=char(10) then
nLine:=nLine+1;
end
end
end
//if pBuff=0 then
while isalnum(Look())=0 do
Buff[pBuff]:= Read();
pBuff :=pBuff+1;
end
//end
if pBuff=0 then
Buff[pBuff]:= Read();
pBuff :=pBuff+1;
end
if Buff[0]=''' then
Buff[pBuff]:=Read(); // char
pBuff :=pBuff+1;
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 pSymb;
word pProg;
word L;
word V;
word Alter() is
L:=1;
word pName:=0;
while pName <nName do
word pHeap:=Name[pName];
if Heap[pHeap]!=char(0) then
if Comp(pHeap)=0 then
L:=pSymb+2;
L:=L+Cls[pName];
V:=pName;
if Cls [pName]=0 then
L:=Ofs [pName];
V:=Size[pName];
end
return L;
end
end
pName:=pName+1;
end
if Buff[0]=''' then
L:=pSymb;
V:= word(Buff[1]);
end
if isnumber(Buff[0])=0 then
L:=pSymb+1;
V:= val ();
end
if isalpha (Buff[0])=0 then
L:=pSymb+2;
V:= Copy();
end
return L;
end
word Find() is
word I:=1;
while I<nSym do
if Comp(Sym[I])=0 then
return I;
end
I:=I+1;
end
Sym [nSym]:= Copy();
nSym :=nSym +1;
return I;
end
word IsEnd() is
Scan();
if Buff[0]!='|' then
if Buff[0]!=';' then
if Buff[0]!='.' then
return 1;
end
end
end
return 0;
end
word AddSym(word pSym) is
Right[nRight]:=pSym;
pLeft[nRight]:=nLeft;
nRight :=nRight+1;
end
word LoadGrammar() is
hFile := open();
pText := 0;
nText := 0;
nLine := 1;
pSymb :=nSym;
nName := 0;
Buff[0] := ';';
while Buff[0]= ';' do
Scan();
word pSym:=Find();
Scan();
if Buff[0]!=';' then
Name[nName]:= Sym [pSym];
if Buff[0]='"' then
Scan();
Name[nName]:=Copy();
Scan(); // "
Scan();
end
Cls [nName]:= val ();
Scan();
Size[nName]:= val ();
Ofs [nName]:=pSym;
nName :=nName+1;
Scan(); // ;
end
end
pProg :=nSym;
nLeft := 0;
nRight := 0;
Buff[0] := ';';
while Buff[0]= ';' do
Scan();
word pSym:=Find();
Scan();
Buff[0]:='|';
while Buff[0]='|' do
Scan();
Left [nLeft]:=pSym;
Id [nLeft]:= val();
pRight[nLeft]:=nRight;
while IsEnd()!=0 do
AddSym(Find());
end
Len [nLeft]:=nRight-pRight[nLeft];
AddSym(0);
nLeft :=nLeft+1;
end
end
close();
end
byte Emi1(byte C) is
Code[nCode]:=C;
nCode:=nCode+1;
end
byte Emi2(word W) is
Emi1(W%256);
Emi1(W/256);
end
word lFlag;
word Push() is
if lFlag!=0 then
Emi1(0x50); // push AX
end
lFlag:=1;
end
word Pop() is
Emi1(0x5B); // pop BX
end
word Move(word I, byte C) is
Emi1(C);
C:=0x06; // [Ofs]
if Cls[I]=3 then
C:=0x87; // [BX+Ofs]
end
Emi1(C);
Emi2(Ofs[I]);
end
word Lda (word I) is
if Cls[I]!=3 then
Push();
end
if Cls[I] =3 then
Emi1(0x93); // xchg BX, AX
end
byte C:=0x8B; // mov AX, [(BX+)Ofs]
if Size[Type[I]]=1 then
Emi1(0x32); // xor AH, AH
Emi1(0xE4);
C:=0x8A; // mov AL, [(BX+)Ofs]
end
Move(I, C);
lFlag:=1;
end
word Ldc (word N) is
Push();
Emi1(0xB8); // mov AX, Val
Emi2(N);
end
word Calc(word Op) is
Pop ();
if Op=0 then
Emi1(0x03); // add AX, BX
Emi1(0xC3);
end
if Op=1 then
Emi1(0x93); // xchg BX, AX
Emi1(0x2B); // sub AX, BX
Emi1(0xC3);
end
if Op=2 then
Emi1(0xF7); // mul BX
Emi1(0xE3);
end
if Op>=3 then
Emi1(0x93); // xchg BX, AX
Emi1(0x33); // xor DX, DX
Emi1(0xD2);
Emi1(0xF7); // div BX
Emi1(0xF3);
end
if Op=4 then
Emi1(0x92); // xchg DX, AX
end
end
word Cond() is
Pop ();
Emi1(0x3B); // cmp BX, AX
Emi1(0xD8);
Emi1(Jx[Val[nStk+1]]);// jxx Ofs
Emi1(0x03);
Ptr[nStk]:= Val[nStk];
Val[nStk]:=nCode;
Emi1(0xE9); // jmp ?
nCode :=nCode+2;
lFlag :=0;
end
word Shl () is
if Size[Type[Val[nStk]]]!=1 then
Emi1(0xD1); // shl AX, 1
Emi1(0xE0);
end
end
word Save(word I) is
if Cls[I]=3 then
Pop ();
end
byte C:=0x89; // mov [(BX+)Ofs], AX
if Size[Type[I]]=1 then
C:=0x88; // mov [(BX+)Ofs], AL
end
Move(I, C);
end
word pParm;
word Pass() is
if pParm>=nName then
Stop();
end
if Sub[pParm]!=1 then
Stop();
end
Save(pParm);
pParm:=pParm+1;
lFlag:=0;
end
word Call() is
if pParm<nName then
if Sub[pParm]=1 then
Stop();
end
end
word W:=(0xFFFF-((nCode+3)-Ofs[Val[nStk]]))+1;
Emi1(0xE8); // call Ofs
Emi2(W);
pParm:=Ptr[nStk];
lFlag:=1;
end
word Hide() is
word H:=Frame[nStk];
while H <nName do
Heap[Name[H]]:=char(0);
H:=H+1;
end
end
word Patch(word I, word C, word S, word D) is
Cls [I]:= C;
Sub [I]:= S;
Size[I]:= D;
Ofs [I]:=nData;
nData :=nData+(D*Size[Type[I]]);
if nData%2!=0 then
nData:=nData+1;
end
end
word rFlag;
word Action(word A) is
if A= 10 then
if rFlag=0 then
Emi1(0xC3); // retn
end
Hide();
end
if A= 20 then
Patch(Val[nStk], 2, 0, 1);
end
if A= 30 then
Patch(Val[nStk], 3, 0, Val[nStk+2]);
end
if A= 40 then
Patch(Val[nStk+3], 2, 1, 1);
end
if A= 50 then
Patch(Val[nStk+2], 2, 1, 1);
end
if A= 60 then
Patch(Val[nStk], 2, 1, 1);
end
if A= 70 then
Name [nName]:= Val[nStk+1];
Cls [nName]:= 4;
Sub [nName]:= 0;
Type [nName]:= Val[nStk];
Ofs [nName]:=nCode;
Val [nStk] :=nName;
nName :=nName+1;
Frame[nStk] :=nName;
end
if A= 80 then
word N := nCode-3;
Code[1]:= N%256;
Code[2]:= N/256;
end
if A= 90 then
lFlag:=0;
end
if A=100 then
rFlag:=0;
end
if A=110 then
rFlag:=1;
end
if A=120 then
word N :=(nCode-Val[nStk])-3;
Code[Val[nStk]+1]:=N%256;
Code[Val[nStk]+2]:=N/256;
Hide();
end
if A=130 then
Ldc (Val[nStk+2]);
Cond();
Frame[nStk]:=nName;
end
if A=140 then
Lda (Val[nStk+2]);
Cond();
Frame[nStk]:=nName;
end
if A=150 then
Cond();
Frame[nStk]:=nName;
end
if A=160 then
word W:= (0xFFFF-((nCode+3)-Ptr[nStk]))+1;
Emi1(0xE9); // jmp Ofs
Emi2(W);
word N :=(nCode-Val[nStk])-3;
Code[Val[nStk]+1]:=N%256;
Code[Val[nStk]+2]:=N/256;
Hide();
end
if A=170 then
Val[nStk]:=nCode;
end
if A=180 then
Emi1(Val[nStk+2]);
end
if A=190 then
Emi1(Val[nStk+1]);
end
if A=200 then
Ldc (Val[nStk+1]);
Emi1(0xC3); // retn
end
if A=210 then
Lda (Val[nStk+1]);
Emi1(0xC3); // retn
end
if A=220 then
Emi1(0xC3); // retn
end
if A=230 then
Patch(Val[nStk], 2, 2, 1);
Ldc (Val[nStk+2]);
Save (Val[nStk]);
end
if A=240 then
Patch(Val[nStk], 2, 2, 1);
Lda (Val[nStk+2]);
Save (Val[nStk]);
end
if A=250 then
Patch(Val[nStk], 2, 2, 1);
Save (Val[nStk]);
end
if A=260 then
Ldc (Val[nStk+2]);
Save (Val[nStk]);
end
if A=270 then
Lda (Val[nStk+2]);
Save (Val[nStk]);
end
if A=280 then
Save (Val[nStk]);
end
if A=290 then
Ldc (Val[nStk]);
Val [nStk]:=Val[nStk+1];
end
if A=300 then
Lda (Val[nStk]);
Val [nStk]:=Val[nStk+1];
end
if A=310 then
Val [nStk]:=Val[nStk+1];
end
if A=320 then
word W:=Val[nStk+2];
if Size[Type[Val[nStk]]]!=1 then
W:=2*W;
end
Ldc (W);
end
if A=330 then
Lda (Val[nStk+2]);
Shl ();
end
if A=340 then
Shl ();
end
if A=350 then
Ldc (Val[nStk+3]);
Pass();
Call();
end
if A=360 then
Lda (Val[nStk+3]);
Pass();
Call();
end
if A=370 then
Pass();
Call();
end
if A=380 then
Ldc (Val[nStk+2]);
Pass();
Call();
end
if A=390 then
Lda (Val[nStk+2]);
Pass();
Call();
end
if A=400 then
Push();
Call();
end
if A=410 then
Ldc (Val[nStk]);
Pass();
end
if A=420 then
Lda (Val[nStk]);
Pass();
end
if A=430 then
Pass();
end
if A=440 then
Ptr[nStk]:=pParm;
pParm := Val[nStk]+1;
end
if A=450 then
Ldc (Val[nStk+2]);
end
if A=460 then
Lda (Val[nStk+2]);
end
if A=470 then
Ldc (Val[nStk+1]);
Calc(Val[nStk]);
end
if A=480 then
Lda (Val[nStk+1]);
Calc(Val[nStk]);
end
if A=490 then
Calc(Val[nStk]);
end
end
word CheckTop() is
Stk[nStk]:=0;
word I:=0;
while I<nLeft do
if nStk>=Len[I] then
word J:=nStk-Len[I];
word K:=pRight[I];
while Stk[J]=Right[K] do
if Stk[J]=0 then
return I;
end
J:=J+1;
K:=K+1;
end
end
I:=I+1;
end
return I;
end
word Compile() is
Heap [ 66]:='p';
Heap [ 67]:='r';
Heap [ 68]:='g';
hFile := open();
pText := 0;
nText := 0;
nLine := 1;
lFlag := 0;
rFlag := 0;
nCode := 0;
nData :=16640;
Emi1(0xE9); // jmp ?
Emi2(0x00);
Stk [0] := 1; // #
nStk := 0;
while Stk[0]!=pProg do
Scan ();
Alter();
if nStk>=32 then
Stop();
end
Stk [nStk]:=L;
Val [nStk]:=V;
nStk :=nStk+1;
word I:=CheckTop();
while I< nLeft do
nStk :=nStk-Len[I];
Stk[nStk]:=Left[I];
Action(Id[I]);
nStk :=nStk+1;
I:=CheckTop();
end
end
close();
Heap [ 66]:='c';
Heap [ 67]:='o';
Heap [ 68]:='m';
hFile:=create();
write();
close();
end
begin
Init();
LoadGrammar();
Compile();
end