The following compiler uses stack as temporary storage for symbols. Top of stack
analysis uses explicitly defined in a grammar
possible previous characters.
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 [ 128];
word Id [ 128];
word pRight [ 128];
word Len [ 128];
word Len2 [ 128];
word nLeft;
word Right [ 384];
word pLeft [ 384];
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;
word pFirst :=nRight;
while IsEnd()!=0 do
if Buff[0]!='<' then
AddSym(Find());
end
if Buff[0] ='<' then
pFirst:=nRight;
end
end
Len [nLeft]:=nRight-pRight[nLeft];
Len2 [nLeft]:=nRight-pFirst;
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 Save(word I) is
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 Hide() is
word H:=Frame[nStk];
while H<nName do
Heap[Name[H]]:=char(0);
H:=H+1;
end
end
word Patch(word C, word S, word N) is
Cls [Val[nStk]]:= C;
Sub [Val[nStk]]:= S;
Size[Val[nStk]]:= N;
Ofs [Val[nStk]]:=nData;
word D := Size[Type[Val[nStk]]]*Size[Val[nStk]];
nData :=nData+D;
if nData%2!=0 then
nData:=nData+1;
end
end
word Param(word I) is
if Ptr[I]>=nName then
Stop();
end
if Sub[Ptr[I]]!=1 then
Stop();
end
Save(Ptr[I]);
Ptr[I]:=Ptr[I]+1;
lFlag:=0;
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(2, 0, 1);
end
if A= 30 then
Patch(3, 0, Val[nStk+2]);
end
if A= 40 then
Patch(2, 1, 1);
end
if A= 50 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= 60 then
word N := nCode-3;
Code[1]:= N%256;
Code[2]:= N/256;
Frame[nStk] :=nName;
end
if A= 70 then
lFlag:=0;
end
if A= 80 then
lFlag:=0;
rFlag:=0;
end
if A= 90 then
lFlag:=0;
rFlag:=1;
end
if A=100 then
word N:=(nCode-Val[nStk])-3;
Code[Val[nStk]+1]:=N%256;
Code[Val[nStk]+2]:=N/256;
Hide();
end
if A=110 then
Pop();
Emi1(0x3B); // cmp BX, AX
Emi1(0xD8);
Emi1(Jx[Val[nStk+2]]); // jxx $+3
Emi1(0x03);
Ptr [nStk]:= Val[nStk];
Val [nStk]:=nCode;
Frame[nStk]:=nName;
Emi1(0xE9); // jmp ?
Emi2(0x00);
lFlag:=0;
end
if A=120 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=130 then
Val[nStk]:=nCode;
end
if A=140 then
Emi1(Val[nStk]);
end
if A=150 then
Emi1(0xC3); // retn
end
if A=160 then
Save(Val[nStk]);
end
if A=170 then
Patch(2, 2, 1);
end
if A=180 then
word I:=Val[nStk];
if Cls[I]=3 then
Pop();
end
Save(I);
end
if A=190 then
word I:=Val[nStk+1];
Pop();
if I =0 then
Emi1(0x03); // add AX, BX
Emi1(0xC3);
end
if I =1 then
Emi1(0x93); // xchg BX, AX
Emi1(0x2B); // sub AX, BX
Emi1(0xC3);
end
if I =2 then
Emi1(0xF7); // mul BX
Emi1(0xE3);
end
if I>=3 then
Emi1(0x93); // xchg BX, AX
Emi1(0x33); // xor DX, DX
Emi1(0xD2);
Emi1(0xF7); // div BX
Emi1(0xF3);
end
if I =4 then
Emi1(0x92); // xchg DX, AX
end
end
if A=200 then
Push();
Emi1(0xB8); // mov AX, Val
Emi2(Val[nStk]);
end
if A=210 then
word I:=Val[nStk];
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
if A=220 then
if Size[Type[Val[nStk]]]!=1 then
Emi1(0xD1); // shl AX, 1
Emi1(0xE0);
end
end
if A=230 then
if Ptr[nStk]<nName then
if Sub[Ptr[nStk]]=1 then
Stop();
end
end
Push();
word W:=(0xFFFF-((nCode+3)-Ofs[Val[nStk]]))+1;
Emi1(0xE8); // call Ofs
Emi2(W);
end
if A=240 then
Param(nStk);
end
if A=250 then
Param(nStk-2);
end
if A=260 then
Ptr[nStk]:=Val[nStk]+1;
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-Len2[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