Compiler source code listed below may be compiled with any version of
Tiny Context for DOS and then may compile itself.
But this compiler can't compile Tiny Context with parameters and local variables.
Source code:
char Text [16384];
word pText;
word nText;
word nLine;
byte Code [16384];
word nCode;
word hFile;
char Heap [ 2048];
word pHeap;
word nHeap;
word nData;
word Name [ 128];
word Cls [ 128];
word Type [ 128];
word Size [ 128];
word Ofs [ 128];
word pName;
word nName;
word Stk [ 128];
word pStk;
char Buff [ 128];
word pBuff;
word open() is
inline 0xB4, 0x3D; // mov AH, 3DH
inline 0xB0, 0x00; // mov AL, 00H
inline 0xBA, 0x4A, 0xC1; // mov DX, @@Data+Ofs(Heap[64])
inline 0xCD, 0x21; // int 21H
end
word create() is
inline 0xB4, 0x3C; // mov AH, 03CH
inline 0xB9, 0x00, 0x00; // mov CX, 00H
inline 0xBA, 0x50, 0xC1; // mov DX, @@Data+Ofs(Heap[70])
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
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;
nData := 16640;
end
word I;
word Push() is
Stk[pStk]:=I;
pStk:=pStk+1;
end
word Pop () is
pStk:=pStk-1;
I:=Stk[pStk];
end
word Stop() is
close();
pStk:=0;
while nLine!=0 do
I:=nLine%10;
I:=I+48;
Push();
nLine:=nLine/10;
end
while pStk!=0 do
Pop();
inline 0x92;
inline 0xB4, 0x02;
inline 0xCD, 0x21;
end
inline 0xB8, 0x00, 0x4C;
inline 0xCD, 0x21;
end
word E;
word J;
word K;
word N;
word val () is
E:=10;
J:= 0;
if Buff[0]='0' then
if Buff[1]='x' then
E:=16;
J:= 2;
end
end
N:=0;
while Buff[J]!=char(0) do
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
char Read() is
if pText=nText then
pText:=0;
nText:=read();
end
if pText<nText then
return Text[pText];
end
return char(0);
end
word Next() is
pText:=pText+1;
end
word isalnum() is
if 'A'<=Read() then
if Read()<='Z' then
return 0;
end
end
if 'a'<=Read() then
if Read()<='z' then
return 0;
end
end
if '0'<=Read() then
if Read()<='9' then
return 0;
end
end
return 1;
end
word sFlag;
char Scan() is
pBuff:=0;
while pBuff=0 do
sFlag:=0;
while sFlag=0 do
if Read()!=char( 9) then
if Read()!=char(10) then
if Read()!=char(13) then
if Read()!=char(32) then
sFlag:=1;
end
end
end
end
if sFlag=0 then
if Read()=char(10) then
nLine:=nLine+1;
end
Next();
end
end
while isalnum()=0 do
Buff[pBuff]:= Read();
pBuff :=pBuff+1;
Next();
end
if pBuff=0 then
Buff[pBuff]:= Read();
pBuff :=pBuff+1;
Next();
if Buff[0]='<' then
if Read()='=' then
Buff[pBuff]:= Read();
pBuff :=pBuff+1;
Next();
end
end
if Buff[0]='!' then
if Read()='=' then
Buff[pBuff]:= Read();
pBuff :=pBuff+1;
Next();
end
end
if Buff[0]='>' then
if Read()='=' then
Buff[pBuff]:= Read();
pBuff :=pBuff+1;
Next();
end
end
if Buff[0]=':' then
if Read()='=' then
Buff[pBuff]:= Read();
pBuff :=pBuff+1;
Next();
end
end
if Buff[0]='/' then
if Read()='/' then
while Read()!=char(10) do
if Read()=char(0) then
Stop();
end
Next();
end
pBuff:=0;
end
end
end
end
Buff[pBuff]:=char(0);
end
word Comp() is
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() is
pName:=0;
while pName<nName do
pHeap:=Name[pName];
if Comp()=0 then
return pName;
end
pName:=pName+1;
end
return nName;
end
byte C;
byte Emit() is
Code[nCode]:=C;
nCode:=nCode+1;
end
word W;
byte Emi2() is
C:=W%256;
Emit();
C:=W/256;
Emit();
end
word Call() is
Scan(); // (
Scan(); // )
C:=0xE8; // call Ofs
W:=nCode+3;
W:=W-Ofs[I];
W:=0xFFFF-W;
W:=W+1;
Emit();
Emi2();
end
word eFlag;
word Expr() is
eFlag:=0;
//if eFlag=0 then
if '0'<=Buff[0] then
if Buff[0]<='9' then
C:=0xB8; // mov AX, Val
W:=val();
Emit();
Emi2();
eFlag:=1;
end
end
if Buff[0]=''' then
C:=0xB8; // mov AX, Val
W:=word(Read());
Emit();
Emi2();
Next();
Read();
Next();
eFlag:=1;
end
//end
if eFlag=0 then
I:=Find();
if I=nName then
Stop();
end
if Cls[I]=1 then
Push();
Scan(); // (
Scan();
Expr();
Pop ();
eFlag:=1;
end
if Cls[I]=2 then
if Size[I]!=1 then
Push();
Scan(); // [
Scan();
Expr();
Pop ();
if Size[Type[I]]=2 then
C:=0xD1; // shl AX, 1
Emit();
C:=0xE0;
Emit();
end
C:=0x93; // xchg BX, AX
Emit();
end
C:=0x8B; // mov AX, [(BX+)Ofs]
if Size[Type[I]]=1 then
C:=0x32; // xor AH, AH
Emit();
C:=0xE4;
Emit();
C:=0x8A; // mov AL, [(BX+)Ofs]
end
Emit();
C:=0x06; // [Ofs]
if Size[I]!=1 then
C:=0x87; // [BX+Ofs]
end
W:=Ofs[I];
Emit();
Emi2();
eFlag:=1;
end
if Cls[I]=3 then
Call();
eFlag:=1;
end
end
if eFlag=0 then
Stop();
end
I:=0;
Scan();
if Buff[0]='+' then
I:=1;
end
if Buff[0]='-' then
I:=2;
end
if Buff[0]='*' then
I:=3;
end
if Buff[0]='/' then
I:=4;
end
if Buff[0]='%' then
I:=5;
end
if I=0 then
return 0;
end
C:=0x50; // push AX
Emit();
Push();
Scan();
Expr();
Pop ();
C:=0x5B; // pop BX
Emit();
if I =1 then
C:=0x03; // add AX, BX
Emit();
C:=0xC3;
Emit();
end
if I =2 then
C:=0x93; // xchg BX, AX
Emit();
C:=0x2B; // sub AX, BX
Emit();
C:=0xC3;
Emit();
end
if I =3 then
C:=0xF7; // mul BX
Emit();
C:=0xE3;
Emit();
end
if I>=4 then
C:=0x93; // xchg BX, AX
Emit();
C:=0x33; // xor DX, DX
Emit();
C:=0xD2;
Emit();
C:=0xF7; // div BX
Emit();
C:=0xF3;
Emit();
if I=5 then
C:=0x92; // xchg DX, AX
Emit();
end
end
end
word jCode;
word Cond() is
Scan();
Expr();
jCode:=0;
if Buff[0]='<' then
jCode:=0x72; // jb Ofs
if Buff[1]='=' then
jCode:=0x76; // jbe Ofs
end
end
if Buff[0]='=' then
jCode:=0x74; // je Ofs
end
if Buff[0]='!' then
jCode:=0x75; // jne Ofs
end
if Buff[0]='>' then
jCode:=0x77; // ja Ofs
if Buff[1]='=' then
jCode:=0x73; // jae Ofs
end
end
if jCode=0 then
Stop();
end
C:=0x50; // push AX
Emit();
Scan();
Expr();
C:=0x5B; // pop BX
Emit();
C:=0x3B; // cmp BX, AX
Emit();
C:=0xD8;
Emit();
C:=jCode; // jxx Ofs
Emit();
C:=0x03;
Emit();
I:=nCode;
Push();
C:=0xE9; // jmp ?
Emit();
nCode:=nCode+2;
end
word cFlag;
word Ctrl() is
cFlag:=0;
//if cFlag=0 then
pHeap:=37; // if
if Comp()=0 then
Cond();
Scan();
Ctrl();
while Comp()!=0 do
Ctrl();
end
Pop ();
N:=nCode-Stk[pStk];
N:=N-3;
Code[Stk[pStk]+1]:=N%256;
Code[Stk[pStk]+2]:=N/256;
cFlag:=1;
end
//end
if cFlag=0 then
pHeap:=40; // while
if Comp()=0 then
I:=nCode;
Push();
Cond();
Scan();
Ctrl();
while Comp()!=0 do
Ctrl();
end
Pop ();
Pop ();
C:=0xE9; // jmp Ofs
W:=nCode+3;
W:=W-Stk[pStk];
W:=0xFFFF-W;
W:=W+1;
Emit();
Emi2();
N:=nCode-Stk[pStk+1];
N:=N-3;
Code[Stk[pStk+1]+1]:=N%256;
Code[Stk[pStk+1]+2]:=N/256;
cFlag:=1;
end
end
if cFlag=0 then
pHeap:=46; // inline
if Comp()=0 then
Buff[0]:=',';
while Buff[0]=',' do
Scan();
C:=val(); // db Val
Emit();
Scan();
end
cFlag:=1;
end
end
if cFlag=0 then
pHeap:=53; // return
if Comp()=0 then
Scan();
Expr();
C:=0xC3; // retn
Emit();
cFlag:=1;
end
end
if cFlag=0 then
I:=Find();
if I=nName then
Stop();
end
if Cls[I]=2 then
if Size[I]!=1 then
Push();
Scan(); // [
Scan();
Expr();
Pop ();
if Size[Type[I]]=2 then
C:=0xD1; // shl AX, 1
Emit();
C:=0xE0;
Emit();
end
C:=0x50; // push AX
Emit();
end
Push();
Scan(); // :=
Scan();
Expr();
Pop ();
if Size[I]!=1 then
C:=0x5B; // pop BX
Emit();
end
C:=0x89; // mov [(BX+)Ofs], AX
if Size[Type[I]]=1 then
C:=0x88; // mov [(BX+)Ofs], AL
end
Emit();
C:=0x06; // [Ofs]
if Size[I]!=1 then
C:=0x87; // [BX+Ofs]
end
W:=Ofs[I];
Emit();
Emi2();
cFlag:=1;
end
if Cls[I]=3 then
Call();
Scan(); // ;
cFlag:=1;
end
if cFlag=0 then
Stop();
end
end
Scan();
pHeap:=60;
end
word Func() is
Scan();
Ctrl();
while Comp()!=0 do
Ctrl();
end
C:=0xC3; // retn
Emit();
end
char Ch;
begin
Init();
hFile:=open();
pText:=0;
nText:=0;
nLine:=1;
C:=0xE9; // jmp ?
Emit();
nCode:=nCode+2;
Scan();
pHeap:=31; // begin
while Comp()!=0 do
I:=Find();
if I=nName then
Stop();
end
if Cls[I]!=1 then
Stop();
end
Name[nName]:=nHeap;
Type[nName]:= I;
Scan();
if Find()<nName then
Stop();
end
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;
Scan();
Ch:=Buff[0];
if Ch ='(' then
Cls [nName]:= 3;
Ofs [nName]:=nCode;
nName :=nName+1;
Scan(); // )
Scan(); // is
Func();
end
if Ch!='(' then
Cls [nName]:= 2;
Size[nName]:= 1;
Ofs [nName]:=nData;
if Buff[0]='[' then
Scan();
Size[nName]:=val();
Scan(); // ]
Scan(); // ;
end
I :=Size[I]*Size[nName];
nData:=nData+I;
nName:=nName+1;
end
Scan();
pHeap:=31; // begin
end
N :=nCode-3;
Code[1]:= N%256;
Code[2]:= N/256;
Func();
close();
hFile:=create();
write();
close();
end