There are two sources - cross compiler (host - DOS, target - CP/M)
and self compiler (host and target - CP/M). Compiled program must
be placed in file with name C.PRG, compiled result are saved
in file C.COM. CP/M version was tested in MYZ80 1.24 CP/M emulator.
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 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
char C1:=C;
inline 0x86, 0xD0; // xchg DL, AL
inline 0xB4, 0x02; // mov AH, 2
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;
nData := 16640;
end
word Push(word V) is
Stk[pStk]:=V;
pStk:=pStk+1;
end
word Pop () is
pStk:=pStk-1;
return Stk[pStk];
end
word Stop() is
close();
pStk:=0;
while nLine!=0 do
Push (mod(nLine,10));
nLine:=div(nLine,10);
end
while pStk!=0 do
putc(char(Pop()+48));
end
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+256;
Code[P] :=mod(W,256);
Code[P+1]:=div(W,256);
end
word MkBX(word I) is
if Size[Type[I]]=2 then
Emi1(0xEB); // xchg
Emi1(0x29); // dad H
Emi1(0x11); // lxi D, Val
Emi2(Ofs[I]);
end
if Size[Type[I]]=1 then
Emi1(0x21); // lxi H, Val
Emi2(Ofs[I]);
end
Emi1(0x19); // dad D
end
word Mov (word E, word D, word I) is
if Size[I]=1 then
Emi1(0x21); // lxi H, Val
Emi2(Ofs[I]);
end
Emi1(E); // mov E, M (mov M, E)
if Size[Type[I]]=2 then
Emi1(0x23); // inx H
Emi1(D); // mov D, M (mov M, D)
end
end
word Assign(word I) is
if Size[I]>1 then
Emi1(0xE1); // pop H
end
Mov (0x73,0x72,I);
end
word Expr() is
word eFlag:=0;
//if eFlag =0 then
if '0'<=Buff[0] then
if Buff[0]<='9' then
Emi1(0x11); // lxi D, Val
Emi2(val());
eFlag:=1;
end
end
if Buff[0]=''' then
Emi1(0x11); // lxi D, Val
Emi2(word(Read()));
Read();
eFlag:=1;
end
if Buff[0]='(' then
Scan();
Expr();
eFlag:=1;
end
//end
if eFlag =0 then
word I:=Find(0);
if Cls[I]=1 then
Push(I);
Scan(); // (
Scan();
Expr();
I:=Pop();
end
if Cls[I]=2 then
if Size[I]>1 then
Push(I);
Scan(); // [
Scan();
Expr();
I:=Pop();
MkBX(I);
end
Mov (0x5E,0x56,I);
if Size[Type[I]]=1 then
Emi1(0x16); // mvi D, 0
Emi1(0x00);
end
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();
J:=Pop();
Assign(J);
J:=J+1;
end
I:=Pop();
if J=I+1 then
Scan(); // )
end
Emi1(0xCD); // call Ofs
Emi2(Ofs[I]+256);
end
end
Scan();
byte Op1:=0;
byte Op2:=0;
if Buff[0]='+' then
Op1:=0x83; // add E
Op2:=0x8A; // adc D
end
if Buff[0]='-' then
Op1:=0x93; // sub E
Op2:=0x9A; // sbb D
end
if Op1!=0 then
Emi1(0xD5); // push D
Push(Op1);
Push(Op2);
Scan();
Expr();
Op2:=Pop();
Op1:=Pop();
Emi1(0xE1); // pop H
Emi1(0x7D); // mov A, L
Emi1(Op1); // op1 E
Emi1(0x5F); // mov E, A
Emi1(0x7C); // mov A, H
Emi1(Op2); // op2 D
Emi1(0x57); // mov D, A
end
end
word Jump(byte jCode, word jOfs) is
if jOfs=0 then
Push(nCode);
end
Emi1(jCode); // jxx Addr
Emi2(nCode+jOfs);
end
word Cond() is
Scan();
Expr();
word jType := 0;
word jOfs1 := 0;
word jCode2:=0xD2; // jnc
if Buff[0]='<' then
jType := 1;
if Buff[1]='=' then
jType := 2;
jCode2 :=0xDA; // jc
end
end
if Buff[0]='=' then
jType := 4;
jCode2 :=0xC2; // jnz
end
if Buff[0]='!' then
jType := 3;
jOfs1 := 263;
jCode2 :=0xCA; // jz
end
if Buff[0]='>' then
jType := 2;
if Buff[1]='=' then
jType := 1;
jCode2 :=0xDA; // jc
end
end
if jType=0 then
Stop();
end
Emi1(0xD5); // push D
Scan();
Expr();
Emi1(0xE1); // pop H
if jType=1 then
Emi1(0x7D); // mov A, L
Emi1(0x93); // sub E
Emi1(0x7C); // mov A, H
Emi1(0x9A); // sbb D
end
if jType=2 then
Emi1(0x7B); // mov A, E
Emi1(0x95); // sub L
Emi1(0x7A); // mov A, D
Emi1(0x9C); // sbb H
end
if jType>=3 then
Emi1(0x7D); // mov A, L
Emi1(0x93); // sub E
Jump(0xC2, jOfs1); // jnz
Emi1(0x7C); // mov A, H
Emi1(0x92); // sub D
end
if jType!=4 then
Push(nCode);
end
Jump (jCode2, 0x00);
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
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);
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 pExit2:=Pop();
word pExit1:=Pop();
word pLoop :=Pop();
Emi1(0xC3); // jmp Ofs
Emi2(pLoop+256);
Emi3(pExit1+1,nCode);
Emi3(pExit2+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(0xC9); // ret
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();
Expr();
Assign(N);
end
end
if Cls[I]=2 then
if Size[I]>1 then
Scan(); // [
Scan();
Expr();
MkBX(I);
Emi1(0xE5); // push H
end
Scan(); // :=
Scan();
Expr();
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(0xC9); // ret
end
end
begin
Init();
hFile:=open();
pText:=0;
nText:=0;
nLine:=1;
Emi1(0xC3); // 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 ();
while mod(nCode,128)!=0 do
Emi1(0x1A);
end
close();
hFile:=create();
write();
close();
end
CP/M version are based on code listed above but has another I/O functions
and some other differnces:
byte FCB [ 36];
byte DMA [ 128];
word pText;
word nText;
word nLine;
byte Code [16384];
word nCode;
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 nData;
word Stk [ 128];
word pStk;
char Buff [ 128];
word setdma() is
inline 0x0E, 0x1A; // mvi C, 1AH
inline 0x11, 0x24, 0x41; // lxi D
inline 0xCD, 0x05, 0x00; // call 5
end
word open() is
inline 0x0E, 0x0F; // mvi C, 0FH
inline 0x11, 0x00, 0x41; // lxi D
inline 0xCD, 0x05, 0x00; // call 5
end
word create() is
inline 0x0E, 0x16; // mvi C, 16H
inline 0x11, 0x00, 0x41; // lxi D
inline 0xCD, 0x05, 0x00; // call 5
end
word read() is
inline 0x0E, 0x14; // mvi C, 14H
inline 0x11, 0x00, 0x41; // lxi D
inline 0xCD, 0x05, 0x00; // call 5
inline 0x5F; // mov E, A
inline 0x16, 0x00; // mvi D, 0
end
word write() is
inline 0x0E, 0x15; // mvi C, 15H
inline 0x11, 0x00, 0x41; // lxi D
inline 0xCD, 0x05, 0x00; // call 5
end
word close() is
inline 0x0E, 0x10; // mvi C, 10H
inline 0x11, 0x00, 0x41; // lxi D
inline 0xCD, 0x05, 0x00; // call 5
end
char putc(char C) is
inline 0x0E, 0x02; // mvi C, 2
inline 0xCD, 0x05, 0x00; // call 5
end
word halt() is
inline 0x0E, 0x00; // mvi C, 00H
inline 0xCD, 0x05, 0x00; // call 5
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);
nHeap :=64;
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 Push(word V) is
Stk[pStk]:=V;
pStk:=pStk+1;
end
word Pop () is
pStk:=pStk-1;
return Stk[pStk];
end
word Stop() is
close();
pStk:=0;
while nLine!=0 do
Push (mod(nLine,10));
nLine:=div(nLine,10);
end
while pStk!=0 do
putc(char(Pop()+48));
end
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
if read()!=0 then
return char(0);
end
pText:= 0;
nText:=128;
end
return char(DMA[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+256;
Code[P] :=mod(W,256);
Code[P+1]:=div(W,256);
end
word MkBX(word I) is
if Size[Type[I]]=2 then
Emi1(0xEB); // xchg
Emi1(0x29); // dad H
Emi1(0x11); // lxi D, Val
Emi2(Ofs[I]);
end
if Size[Type[I]]=1 then
Emi1(0x21); // lxi H, Val
Emi2(Ofs[I]);
end
Emi1(0x19); // dad D
end
word Mov (word E, word D, word I) is
if Size[I]=1 then
Emi1(0x21); // lxi H, Val
Emi2(Ofs[I]);
end
Emi1(E); // mov E, M (mov M, E)
if Size[Type[I]]=2 then
Emi1(0x23); // inx H
Emi1(D); // mov D, M (mov M, D)
end
end
word Assign(word I) is
if Size[I]>1 then
Emi1(0xE1); // pop H
end
Mov (0x73,0x72,I);
end
word Expr() is
word eFlag:=0;
//if eFlag =0 then
if '0'<=Buff[0] then
if Buff[0]<='9' then
Emi1(0x11); // lxi D, Val
Emi2(val());
eFlag:=1;
end
end
if Buff[0]=''' then
Emi1(0x11); // lxi D, Val
Emi2(word(Read()));
Read();
eFlag:=1;
end
if Buff[0]='(' then
Scan();
Expr();
eFlag:=1;
end
//end
if eFlag =0 then
word I:=Find(0);
if Cls[I]=1 then
Push(I);
Scan(); // (
Scan();
Expr();
I:=Pop();
end
if Cls[I]=2 then
if Size[I]>1 then
Push(I);
Scan(); // [
Scan();
Expr();
I:=Pop();
MkBX(I);
end
Mov (0x5E,0x56,I);
if Size[Type[I]]=1 then
Emi1(0x16); // mvi D, 0
Emi1(0x00);
end
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();
J:=Pop();
Assign(J);
J:=J+1;
end
I:=Pop();
if J=I+1 then
Scan(); // )
end
Emi1(0xCD); // call Ofs
Emi2(Ofs[I]+256);
end
end
Scan();
byte Op1:=0;
byte Op2:=0;
if Buff[0]='+' then
Op1:=0x83; // add E
Op2:=0x8A; // adc D
end
if Buff[0]='-' then
Op1:=0x93; // sub E
Op2:=0x9A; // sbb D
end
if Op1!=0 then
Emi1(0xD5); // push D
Push(Op1);
Push(Op2);
Scan();
Expr();
Op2:=Pop();
Op1:=Pop();
Emi1(0xE1); // pop H
Emi1(0x7D); // mov A, L
Emi1(Op1); // op1 E
Emi1(0x5F); // mov E, A
Emi1(0x7C); // mov A, H
Emi1(Op2); // op2 D
Emi1(0x57); // mov D, A
end
end
word Jump(byte jCode, word jOfs) is
if jOfs=0 then
Push(nCode);
end
Emi1(jCode); // jxx Addr
Emi2(nCode+jOfs);
end
word Cond() is
Scan();
Expr();
word jType := 0;
word jOfs1 := 0;
word jCode2:=0xD2; // jnc
if Buff[0]='<' then
jType := 1;
if Buff[1]='=' then
jType := 2;
jCode2 :=0xDA; // jc
end
end
if Buff[0]='=' then
jType := 4;
jCode2 :=0xC2; // jnz
end
if Buff[0]='!' then
jType := 3;
jOfs1 := 263;
jCode2 :=0xCA; // jz
end
if Buff[0]='>' then
jType := 2;
if Buff[1]='=' then
jType := 1;
jCode2 :=0xDA; // jc
end
end
if jType=0 then
Stop();
end
Emi1(0xD5); // push D
Scan();
Expr();
Emi1(0xE1); // pop H
if jType=1 then
Emi1(0x7D); // mov A, L
Emi1(0x93); // sub E
Emi1(0x7C); // mov A, H
Emi1(0x9A); // sbb D
end
if jType=2 then
Emi1(0x7B); // mov A, E
Emi1(0x95); // sub L
Emi1(0x7A); // mov A, D
Emi1(0x9C); // sbb H
end
if jType>=3 then
Emi1(0x7D); // mov A, L
Emi1(0x93); // sub E
Jump(0xC2, jOfs1); // jnz
Emi1(0x7C); // mov A, H
Emi1(0x92); // sub D
end
if jType!=4 then
Push(nCode);
end
Jump (jCode2, 0x00);
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
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);
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 pExit2:=Pop();
word pExit1:=Pop();
word pLoop :=Pop();
Emi1(0xC3); // jmp Ofs
Emi2(pLoop+256);
Emi3(pExit1+1,nCode);
Emi3(pExit2+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(0xC9); // ret
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();
Expr();
Assign(N);
end
end
if Cls[I]=2 then
if Size[I]>1 then
Scan(); // [
Scan();
Expr();
MkBX(I);
Emi1(0xE5); // push H
end
Scan(); // :=
Scan();
Expr();
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(0xC9); // ret
end
end
byte InitFCB() is
FCB[ 0]:=0x00;
FCB[ 1]:=byte('C');
word I:= 2;
while I< 12 do
FCB[I]:=byte(' ');
I:= I+1;
end
while I< 36 do
FCB[I]:=0x00;
I:= I+1;
end
end
begin
setdma();
Init();
InitFCB();
FCB[ 9]:=byte('P');
FCB[10]:=byte('R');
FCB[11]:=byte('G');
open();
pText:=0;
nText:=0;
nLine:=1;
Emi1(0xC3); // 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 ();
while mod(nCode,128)!=0 do
Emi1(0x1A);
end
close();
InitFCB();
FCB[ 9]:=byte('C');
FCB[10]:=byte('O');
FCB[11]:=byte('M');
create();
word I:=0;
word J:=0;
while I<nCode do
if J>=128 then
write();
J:=0;
end
DMA[J]:=Code[I];
J:=J+1;
I:=I+1;
end
write();
close();
end