Здесь приведены два исходных текста - работающий в среде MS DOS кросс-компилятор
и компилятор, работающий в среде Apple DOS. Компилируемая программа должна
размещаться в файле с именем C.PRG, результат компиляции записывается
в файл C.COM. Версия для Apple DOS тестировалась в среде эмулятора
AppleWin 1.23 (в режиме Apple //e), для создания образа диска использовался
CiderPress 3.0.1.
Версия для DOS может быть скомпилирована с помощью Tiny Context 1.18 (c.118)
или Context, но во втором случае необходимо выполнить семь модификаций исходного
текста:
char Temp [16640]; // Добавить перед char Text [16384]; // Связано с различиями в использовании памяти
word mul (word A, word B) is -> word mul (word A; word B) is
word div (word A, word B) is -> word div (word A; word B) is
word mod (word A, word B) is -> word mod (word A; word B) is
word Digraph(char C1, char C2) is -> word Digraph(char C1; char C2) is
word Emi3(word P, word W) is -> word Emi3(word P; word W) is
word MkIX(word I, word D) is -> word MkIX(word I; word D) is
Кросс-компилятор:
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;
//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));
Emi1(0xA0); // ldy #Val
Emi1(div(W,256));
eFlag:=1;
end
end
if Buff[0]=''' then
Emi1(0xA2); // ldx #Val
Emi1(byte(Read()));
Emi1(0xA0); // ldy #0
Emi1(0x00);
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();
MkIX(I, 0);
Emi1(0xA0); // ldy #0
Emi1(0x00);
Emi1(0xB1); // lda (0xFE),Y
Emi1(0xFE);
Emi1(0xAA); // tax
if Size[Type[I]]=2 then
Emi1(0xC8); // iny
Emi1(0xB1); // lda (0xFE),Y
Emi1(0xFE);
Emi1(0xA8); // tay
end
end
if Size[I]=1 then
Emi1(0xAE); // ldx Adr
Emi2(Ofs[I]);
if Size[Type[I]]=2 then
Emi1(0xAC); // ldy Adr
Emi2(Ofs[I]+1);
end
end
if Size[Type[I]]=1 then
Emi1(0xA0); // ldy #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(0x20); // jsr
Emi2(Ofs[I]+cBase);
end
end
Scan();
word Op:=0x00;
if Buff[0]='+' then
Op:=0x65;
end
if Buff[0]='-' then
Op:=0xE5;
end
if Op!=0 then
Emi1(0x98); // tya
Emi1(0x48); // pha
Emi1(0x8A); // txa
Emi1(0x48); // pha
Push(Op);
Scan();
Expr();
Op:=Pop();
Emi1(0x86); // stx 0xFE
Emi1(0xFE);
Emi1(0x84); // sty 0xFF
Emi1(0xFF);
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
Emi1(0x68); // pla
Emi1(Op); // opr 0xFF
Emi1(0xFF);
Emi1(0xA8); // tay
end
end
word Cond() is
Scan();
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
Emi1(0x98); // tya
Emi1(0x48); // pha
Emi1(0x8A); // txa
Emi1(0x48); // pha
Scan();
Expr();
if jType=1 then
Emi1(0x68); // pla
Emi1(0x86); // stx 0xFE
Emi1(0xFE);
Emi1(0x38); // sec
Emi1(0xE5); // sbc 0xFE
Emi1(0xFE);
Emi1(0x68); // pla
Emi1(0x84); // sty 0xFF
Emi1(0xFF);
Emi1(0xE5); // sbc 0xFF
Emi1(0xFF);
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);
Emi1(0x68); // pla
Emi1(0x85); // sta 0xFF
Emi1(0xFF);
Emi1(0x98); // tya
Emi1(0xE5); // sbc 0xFF
Emi1(0xFF);
end
if jType=3 then
Emi1(0x68); // pla
Emi1(0x85); // sta 0xFE
Emi1(0xFE);
Emi1(0x68); // pla
Emi1(0xE4); // cpx 0xFE
Emi1(0xFE);
Emi1(0xD0); // bne
Emi1(jOfs1);
Emi1(0x85); // sta 0xFF
Emi1(0xFF);
Emi1(0xC4); // cpy 0xFF
Emi1(0xFF);
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
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();
Expr();
Assign(N);
end
end
if Cls[I]=2 then
if Size[I]>1 then
Scan(); // [
Scan();
Expr();
MkIX(I, 1);
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(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
Версия для Apple DOS основана на приведенном выше коде, но использует другие функции ввода/вывода
и имеет некоторые другие отличия.
Для загрузки и запуска компилятора используются следующие команды:
BLOAD C.COM, A3072
CALL 3072
Функция записи работает некорректно и закомментирована. Вместо нее компилятор выводит символ плюс
и длину созданного кода. Для записи его на диск может быть использована следующая команда:
BSAVE <FILE_NAME>, A$4F56, L<CODE_SIZE>
Нужно отметить, что эта команда записывает некорректный адрес загрузки 0x4F56. Корректный адрес 0x0C00 (3072)
должен быть указан в команде BLOAD.
Причина так и не была выяснена, спустя много лет воспроизвести ошибку не удалось. Функция записи раскомментирована
и похоже, что работает.
Файлы для записи на диск должны иметь следующие имена:
C.COM#060C00
C.PRG#040000
Первые две цифры после решетки - тип файла, следующие четыре - адрес загрузки.
В программе CiderPress нужно открыть входящий в эмулятор образ диска MASTER.DSK и записать на него эти два файла.
Файлы не должны преобразовываться (Don't convert text files)
В эмуляторе открыть этот образ диска, затем запустить эмулятор и выполнить команды:
BLOAD C.COM
DELETE C.COM
CALL 3072
В результате будет создан новый файл C.COM. На Apple //e компиляция самого компилятора
занимает около трех минут.
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 [14336]; // 0x4F52
word nCode; // 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 0xA0, 0x06; // ldy #0x06 ;Range length
inline 0x91, 0xEE; // sta (0xEE), Y
inline 0xAD, 0x53, 0x87; // lda 0x8753 ;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;
//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));
Emi1(0xA0); // ldy #Val
Emi1(div(W,256));
eFlag:=1;
end
end
if Buff[0]=''' then
Emi1(0xA2); // ldx #Val
Emi1(byte(Read()));
Emi1(0xA0); // ldy #0
Emi1(0x00);
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();
MkIX(I, 0);
Emi1(0xA0); // ldy #0
Emi1(0x00);
Emi1(0xB1); // lda (0xFE),Y
Emi1(0xFE);
Emi1(0xAA); // tax
if Size[Type[I]]=2 then
Emi1(0xC8); // iny
Emi1(0xB1); // lda (0xFE),Y
Emi1(0xFE);
Emi1(0xA8); // tay
end
end
if Size[I]=1 then
Emi1(0xAE); // ldx Adr
Emi2(Ofs[I]);
if Size[Type[I]]=2 then
Emi1(0xAC); // ldy Adr
Emi2(Ofs[I]+1);
end
end
if Size[Type[I]]=1 then
Emi1(0xA0); // ldy #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(0x20); // jsr
Emi2(Ofs[I]+cBase);
end
end
Scan();
word Op:=0x00;
if Buff[0]='+' then
Op:=0x65;
end
if Buff[0]='-' then
Op:=0xE5;
end
if Op!=0 then
Emi1(0x98); // tya
Emi1(0x48); // pha
Emi1(0x8A); // txa
Emi1(0x48); // pha
Push(Op);
Scan();
Expr();
Op:=Pop();
Emi1(0x86); // stx 0xFE
Emi1(0xFE);
Emi1(0x84); // sty 0xFF
Emi1(0xFF);
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
Emi1(0x68); // pla
Emi1(Op); // opr 0xFF
Emi1(0xFF);
Emi1(0xA8); // tay
end
end
word Cond() is
Scan();
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
Emi1(0x98); // tya
Emi1(0x48); // pha
Emi1(0x8A); // txa
Emi1(0x48); // pha
Scan();
Expr();
if jType=1 then
Emi1(0x68); // pla
Emi1(0x86); // stx 0xFE
Emi1(0xFE);
Emi1(0x38); // sec
Emi1(0xE5); // sbc 0xFE
Emi1(0xFE);
Emi1(0x68); // pla
Emi1(0x84); // sty 0xFF
Emi1(0xFF);
Emi1(0xE5); // sbc 0xFF
Emi1(0xFF);
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);
Emi1(0x68); // pla
Emi1(0x85); // sta 0xFF
Emi1(0xFF);
Emi1(0x98); // tya
Emi1(0xE5); // sbc 0xFF
Emi1(0xFF);
end
if jType=3 then
Emi1(0x68); // pla
Emi1(0x85); // sta 0xFE
Emi1(0xFE);
Emi1(0x68); // pla
Emi1(0xE4); // cpx 0xFE
Emi1(0xFE);
Emi1(0xD0); // bne
Emi1(jOfs1);
Emi1(0x85); // sta 0xFF
Emi1(0xFF);
Emi1(0xC4); // cpy 0xFF
Emi1(0xFF);
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
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();
Expr();
Assign(N);
end
end
if Cls[I]=2 then
if Size[I]>1 then
Scan(); // [
Scan();
Expr();
MkIX(I, 1);
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(0x60); // rts
end
end
word X;
begin
InitFMPL();
Init();
open ();
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