Еще один простой компилятор для Apple DOS/6502

Здесь приведены два исходных текста - работающий в среде 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 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.

На 1 МГц Apple //e конпиляция самого компилятора занимает примерно 2 минуты.

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


Сайт создан в системе uCoz