There are two sources - cross compiler (host - MS DOS/8086, target - Apple DOS/6502)
and self compiler (host and target - Apple DOS/6502). Compiled program must be placed
in file with name C.PRG, compiled result are saved in file C.COM. Apple DOS version
was tested in AppleWin 1.23 emulator (in Apple //e mode) and CiderPress 3.0.1 disk utility.
Compiler source code listed below may be compiled with
Tiny Context 1.18 (c.118), or with
Context but in second case seven modifications
of source coderequired:
char Temp [16640]; // Add before char Text [16384]; // Because memory models are different
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
Cross-compiler:
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 version are based on code listed above but has another I/O functions
and some other minor differences.
To load and run program use following commands
BLOAD C.COM, A3072
CALL 3072
File write function work incorrect and commented. Instead of compiler print plus character
and code size. To store compiled program on disk use following command:
BSAVE <FILE_NAME>, A$4F56, L<CODE_SIZE>
Note that this command write incorrect load address 0x4F56. Correct address 0x0C00 (3072) must be
present in BLOAD command.
The reason was never determined, and many years later the error could not be reproduced.
Write function uncommented and it seems to be working.
Files to be written to disk must have the following names:
C.COM#060C00
C.PRG#040000
The first two digits after the hash mark are the file type, the next four digits are the download address.
In the CiderPress program, you need to open the MASTER.DSK disk image included in the emulator and write
these two files to it. Set Don't convert text files option before load.
In the emulator, open this disk image, then launch the emulator and run the commands:
BLOAD C.COM
DELETE C.COM
CALL 3072
On 1 MHz Apple //e compilation of compiler itself requires about 3 minutes.
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