создание новой команды для виртуальной ЭВМ

{$A+,B-,D+,E+,F-,G-,I+,L+,N-,O-,R-,S+,V+,X-}
{$M 17584,0,655360}
 uses                   { TP6 }
 TPString,
 TPCrt,            { ў*аЁ**в б ўЄ«озҐ**®© Єни, *¤аҐб®¬ ®бв**®ў* }
 TPCmd,              { Ё *®ў®© Є®¬**¤®© ¤«п «\а}
 TPWindow,
 TPMenu    ;
const        (*   ‡*¤**ЁҐ **з*«м*ле §**зҐ*Ё© Ї*а*¬Ґва*¬  *)
        N=22;
        Chz=8;
        Wop=500;  (* 764 ў 8c/c = *¤аҐб 0 - 763   *)
        NRON=4;
        Wstek=10;
        Wkesh=10;
        Nul='0000000000000000000000';
type        {* ЋЇЁб**ЁҐ вЁЇ®ў *}
        stp=string[22];
        st21=string[21];
        st9=string[9];
        st4=string[4];
        st3=string[3];
        z=integer;
var        {  ђ*§¤Ґ« ®ЇЁб**Ёп ЇҐаҐ¬Ґ**ле }
        ishp:stp;
        buf_ishp:stp;
        address,adrkom,tippam,adrost:z;
        kop:st4;
        tp1,tp2,pad,pr,per:st3;
        adr1,adr2:z;
        Op:array[0..Wop] of stp;
        Stek:array[1..Wstek-1] of stp;
        Ron:array[0..NRON] of stp;
        KeshD:array[1..Wkesh] of stp;
        KeshA:array[1..Wkesh] of integer;
        Result:array[1..15] of stp;
        Index:integer;
        tpam:st3;
        adr,adrkesh,adrst:z;
        rgs,rgd:stp;
        wdw:char;
        kz:z;
        a,b,c:stp;
        tz,sa,sb,sc,bn,tp,pk,pm,p:char;
        shwh:string[8];
        ff:z;
        shwih:string[1];
        zifra:string[1];
        flerr:boolean;
        flslk:boolean;
        flost:boolean;
        flend:boolean;
        pult,flcht,flcht_old:boolean;
        flkesh:boolean;
        we:st9;
        l:z; kl:char;
        com:boolean;
        M,M1,M2:Menu;
        Ch:Char;
        Key,Key1,Key2:MenuKey;
        W,W1,W2:WindowPtr;
        Disk,Zagrdrive:boolean;
        Nom,NOut:integer;
        BackAtribut:byte;
        ft1:file of char;
        met,met1,metk,mets,
        metd,metr: boolean;
  (* ђ*§¤Ґ« ®ЇЁб**Ёп дг*ЄжЁ© Ё Їа®жҐ¤га *)
function Ich(fc:char):char; (* ?*ўҐабЁп а*§ап¤* *)
        begin
          if fc='0' then Ich:='1'
                    else Ich:='0';
        end;
function Ist(fs:st21):st21;  (* ?*ўҐабЁп б«®ў* *)
          var l:z;
        begin
           for l:=1 to N-1 do begin
                if fs[l]='0' then Ist[l]:='1'
                             else Ist[l]:='0';
                               end;
        end;
 
  (*  Њ®¤Ґ«Ё ЇҐаҐў®¤* зЁбҐ« Ё§ .... *)
procedure PP82;         (*  Ё§ 8-© ў 2-о *)
          var  l:z;
        begin
          ishp:=shwh[1];
          for l:=2 to chz do
                case shwh[l] of
        '0':ishp:=ishp+'000';
        '1':ishp:=ishp+'001';
        '2':ishp:=ishp+'010';
        '3':ishp:=ishp+'011';
        '4':ishp:=ishp+'100';
        '5':ishp:=ishp+'101';
        '6':ishp:=ishp+'110';
        '7':ishp:=ishp+'111';
                end;
        end;
function SUB210(s:stp;ind:z;cnt:z):z;    (* Ё§ 2-© ў 10-о *)
  var
        sf:stp;
        l,r:z;
  begin
        sf:=Copy(s,ind,cnt);
        r:=0;
        for l:=0 to cnt-1 do
         r:=r+((Ord(sf[cnt-l])-Ord('0')) shl l);
        SUB210:=r;
  end;
function PP102(df:z):st9;  (* Ё§ 10-© ў 2-о *)
  var
        cf:st9;
        l:z;
  begin
        cf:='000000000';
        for l:=1 to 9 do
         cf[l]:=Chr(Ord('0')+(df div (1 shl (9-l))) mod 2);
        PP102:=cf;
  end;
function PP108(df:z):st3;   (*  Ё§ 10-© ў 8-о *)
  var
        mp,cf:st9;
        fd:st3;
        v,sp:z;
  begin
        fd:='000';
        cf:=PP102(df);
        mp:='0';
        for v:=0 to 2 do
          begin
           sp:=SUB210(cf,3*v+1,3);
           Str(sp:1,mp);
           fd[v+1]:=mp[1];
          end;
        PP108:=fd;
  end;
function PP810(ap:st9):z;    (* Ё§ 8-© ў 10-о *)
  var
        l,dl,zx,cd,pp:z;
        ws:st9;
  begin
        dl:=Length(ap); ws:='0'; pp:=0;
        for l:=dl downto 1 do
          begin
            ws[1]:=ap[l]; Val(ws,zx,cd);
            pp:=pp+(zx shl (3*(dl-l)));
          end;
        PP810:=pp;
  end;
procedure Tb(m:integer);
  var
        j:integer;
  begin
        for j:=1 to m do write(' ');
  end;
 
   (* Џа®жҐ¤га* ®Ўа*Ў®вЄЁ ®иЁЎ®Є Ё *ў*аЁ©*ле бЁвг*жЁ© *)
procedure Err(code_err:z);
  label qq;
  begin
    if (code_err<>17) and (code_err<22) then
        begin
         GotoXY(40,18);
         write('Ђ„ђ…‘ Џ“‹њ’Ћ‚›• ЋЏ…ђЂ–?‰ : ',PP108(address));
        end;
    if not DisplayWindow(W) then write('ERROR 1');
    GotoXY(2,2);
    Case code_err of
        1:Write('          ЋиЁЎЄ* ў ЇҐаҐе®¤Ґ');
        2:Write('           „Ґ«Ґ*ЁҐ ** *®«м');
        3:Write('       ЏҐаҐЇ®«*Ґ*ЁҐ ЋЏ ЇаЁ §*Јаг§ЄҐ');
        4:Write(' „***л© вЁЇ Ї*¬пвЁ §*ЇаҐйҐ* ЇаЁ ўў®¤Ґ');
        5:Write('              ЏҐаҐЇ®«*Ґ*ЁҐ');
        6:Write('         ЌҐбгйҐбвўгой*п ®ЇҐа*жЁп');
        7:Write('     ЋЎа*йҐ*ЁҐ Є *ҐбгйҐбвўго饬㠐ЋЌг');
        8:Write('        ЋЎа*йҐ*ЁҐ Є Їгб⮬г б⥪г');
        9:Write('ЋЎа*йҐ*ЁҐ Є *ҐбгйҐбвўго饬г *¤аҐбг Ї*¬пвЁ');
       10:Write('ЋЎа*йҐ*ЁҐ Є *ҐбгйҐбвўго饬г вЁЇг Ї*¬пвЁ');
       11:Write('          ЏҐаҐЇ®«*Ґ*ЁҐ б⥪*');
       12:begin
          GotoXY(5,2);Write('‚л е®вЁвҐ §*ўҐаиЁвм а*Ў®вг? (Y/N)');
          HiddenCursor; repeat until KeyPressed;
          ch:=ReadKey;
          if (ch='y') or (ch='Y') or (ch='*') or (ch='Ќ') then
    begin W:=EraseTopWindow;ClrScr;TextAttr:=BackAtribut;halt; end
                        else goto qq;
         end;
       13:Write('     ‡*¤*©вҐ ०Ё¬ Їа®жҐбб®а*');
       14:begin
           Write('            Ћбв**®ў ќ‚Њ'); Nom:=1;
          end;
       15:Write(' ЏҐаҐ©¤ЁвҐ ў ०Ё¬ Їг«мв®ў®Ј® вҐа¬Ё**«*');
       16:Write('       ‡*ЇЁбм ў б⥪ §*ЇаҐйҐ**');
       17:Write(' ‘«ЁиЄ®¬ Ў®«м讥 зЁб«®. Џ®ўв®аЁвҐ ўў®¤');
       18:Write('  ‡*Јаг§Є* ¤***ле ў б⥪ *Ґў®§¬®¦**');
       19:Write('  ЏҐаҐЇ®«*Ґ*ЁҐ ђЋЌ®ў ЇаЁ ўў®¤Ґ ¤***ле');
       20:begin
           Write('  Џа®Ја*¬¬* ®бв**®ў«Ґ** Ї®«м§®ў*⥫Ґ¬');Nom:=1;
          end;
       21:Write('');
       22:Write('     Ќ*агиҐ*ЁҐ д®а¬*в* ЇаЁ ўў®¤Ґ');
       23:Write(' ‚лЎҐаЁвҐ ђ…†?Њ §*Јаг§ЄЁ:¤ЁбЄ/Є«*ўЁ*вга*');
       24:Write(' ЌҐў®§¬®¦*® ®вЄалвм д*©« PROG.COD');
       25:begin
           Write(' ЌҐў®§¬®¦*® ®вЄалвм д*©« DATA',nom,'.COD');Nom:=1;
          end;
       26:Write('      ‘«ЁиЄ®¬ Ў®«ми®© д*©« ўлў®¤*');
       27:Write('       ‡*ЇЁбм Єни §*ЇаҐйҐ** ');
     end;
        flerr:=true;
        HiddenCursor;
        repeat until KeyPressed;
        ch:=readkey;
    qq: NormalCursor;
        W:=EraseTopWindow;
  end;
 
  (*  Џа®жҐ¤гал ўлў®¤* ** ЇҐз*вм  *)
 
procedure Viv28(asd:stp);
        var  l:z;
        begin
        if Pos('0',asd)=0 then begin Tb(16);Exit;end;
        shwih:=asd[1];
        write(' ',shwih);
        for l:=0 to chz-2 do
          begin
                Str(SUB210(asd,3*l+2,3),zifra);
                shwih:=zifra;
                write('  ',shwih);
          end;
        end;
procedure Pech28(asd:stp);
      var
        ip:z; v:char;
      begin
        shwih:=asd[1];
        v:=shwih[1];
        write(v);
        for ip:=0 to Chz-2 do
          begin
                Str(SUB210(asd,3*ip+2,3),zifra);
                shwih:=zifra;
                v:=shwih[1];
                write(v);
           end;
      end;
procedure Outdisk28(asd:stp);
      var
        ip:z; v,v1:char;
      begin
       if Pos('0',asd)=0 then
            begin v1:=#13;write(ft1,v1); end;
       v:=asd[1]; write(ft1,v);
        for ip:=0 to Chz-2 do
          begin
               Str(SUB210(asd,3*ip+2,3),zifra);
               v:=zifra[1];
              write(ft1,v);
          end;
       v1:=#13;  write(ft1,v1);
       if NOut>200 then begin Err(26);flerr:=true;
                          exit; flslk:=false;end
                  else  NOut:=NOut+1;
      end;
 
     (*  ?*ЁжЁ*«Ё§*жЁп  ¬Ґ*о  *)
 
procedure  InitMenu(var M:Menu);
const
  Color1 : MenuColorArray =($0F, $0F, $0F, $70, $0F, $00, $19, $78);
  Frame1 : FrameArray = '      ';
begin
  M := NewMenu([], nil);
  SubMenu(36,15,nohelp,Horizontal,Frame1,Color1,'“ЏђЂ‚‹…Ќ?…');
        MenuMode(False,False,False);
        MenuItem('‡Ђ',2,1,1,'');
        MenuItem('—’',6,1,2,'');
        MenuItem('‡Џ',10,1,3,'');
        MenuItem('Џ“‘Љ',14,1,4,'');
        MenuItem('‡Ђѓђ.',20,1,5,'');
        MenuItem('ђ…†?Њ',27,1,6,'');
        MenuItem('’ЁЇ Ї*¬.',34,1,7,'');
        PopSublevel;
  ResetMenu(M);
 end;
procedure InitMenu1(var M1 : Menu);
const
  Color1 : MenuColorArray = ($0F, $0F, $0F, $70, $0F, $00, $19, $78);
  Frame1 : FrameArray = '      ';
begin
  M1 := NewMenu([], nil);
  SubMenu(53,4,nohelp,Vertical,Frame1,Color1,'ђ…†?Њ');
    MenuMode(False,True,False);
    MenuItem('Џ“‹њ’. ’…ђЊ?ЌЂ‹',2,1,1,'');
    MenuItem('Ђ‚’ЋЊЂ’',3,1,2,'');
    MenuItem('ЉЋЊЂЌ„Ђ',4,1,3,'');
    MenuItem('ЏђЋ‘ЊЋ’ђ Ѓ“”…ђЂ ‚›‚Ћ„Ђ',5,1,4,'');
    MenuItem('ЋЃЊ…Ќ ‘ „?‘ЉЋЊ',6,1,6,'');
    MenuItem('‡Ђѓђ“‡ЉЂ ‘ Љ‹Ђ‚?Ђ’“ђ›',7,1,5,'');
    PopSublevel;
  ResetMenu(M1);
end;
 
procedure InitMenu2(var M2 : Menu);
const
  Color1 : MenuColorArray = ($0F, $0F, $0F, $70, $0F, $00, $19, $78);
  Frame1 : FrameArray = '      ';
begin
  M2 := NewMenu([], nil);
  SubMenu(54,5,nohelp,Vertical,Frame1,Color1,'’ЁЇ Ї*¬пвЁ');
        MenuItem('ЋЇҐа*вЁў**п Ї*¬пвм',1,1,1,'');
        MenuItem('‘⥪®ў*п Ї*¬пвм',2,1,2,'');
        MenuItem('ђЋЌл',3,1,3,'');
        MenuItem('Љни - Ї*¬пвм',4,1,4,'');
        MenuItem('Ђ¤аҐб ®бв**®ў*',5,1,5,'');
        PopSublevel;
  ResetMenu(M2);
end;
     (*  Џа®жҐ¤га* Ї®бва**Ёз*®Ј® звҐ*Ёп Ё§ д*©«* *)
 
procedure Info;
  var
        ft:text;
        sif:string[80];
        stk:integer;
  begin
        assign(ft,'screen.mdl');
  {$I-}
        reset(ft);
        if IOResult<>0 then
         begin
          GotoXY(10,10);
       write('ЌҐў®§¬®¦*® ®вЄалвм д*©« SCREEN.MDL ¤«п д®а¬Ёа®ў**Ёп нЄа***');
        halt;
         end;
 {$I+}
        Clrscr;
        for stk:=1 to 25 do
         begin
          readln(ft,sif); GotoXY(1,stk);
          write(sif);
        end;
  end;
 
  (*  Џа®жҐ¤га* Їа®б¬®ва* б⥪®ў®© Ї*¬пвЁ  *)
 
procedure Stpam;
  var
    x,y:byte;
    i,n:integer;
  begin
   if not DisplayWindow(W2) then write('ERROR W2');
   GotoXY(6,1);  write('‘ ’ … Љ Ћ ‚ Ђ џ  Џ Ђ Њ џ ’ њ');
   x:=4; y:=2;
   for i:=1 to Wstek-1 do
     begin
      if i<8 then begin
      GotoXY(x,y);
       writeln('ЪДДДДДДДДДДДДДДДДДДДДДДДДДДДДДДДї');
 Tb(3);writeln('і                               і');
 Tb(3);writeln('АДДДДДДДДДДДДДДДДДДДДДДДДДДДДДДДЩ');
      y:=y+2;
                 end;
     if i=8 then
             begin GotoXY(4,14);
       write('|                               |');
             end;
      end;
     x:=10; y:=3;
     i:= adrst; n:=1;
     while i<=Wstek-1 do
      begin
       if n<7 then begin
        GotoXY(x,y);
        Viv28(Stek[i]);
        y:=y+2; n:=n+1;
                   end;
       if (n=7) and (i=Wstek-1) and
          (Wstek>7) and (adrst=1) then begin
       { y:=y-2;}
        GotoXY(x,y);
        Viv28(Stek[Wstek-1]);
{        n:=n+1;}
                   end;
        i:=i+1;
      end;
     GotoXY(8,18); write('Ќ*¦¬ЁвҐ <ESC> ¤«п ўл室*');
     repeat kl:=readkey; until kl=#27;
   W2:=EraseTopWindow;
 end;
 
  (*  Џа®жҐ¤га* Їа®б¬®ва* Єни-Ї*¬пвЁ  *)
 
procedure Keshpam;
  label wih;
  var
    x,y:byte;
    i,a:integer;
  begin
   if not DisplayWindow(W2) then write('ERROR W2');
   GotoXY(6,1);  write('Љ ќ ?  -  Џ Ђ Њ џ ’ њ');
    if flkesh=false then
       begin GotoXY(5,5);
             write('* Ґ  Ї ® ¤ Є « о з Ґ * * ! ');
             goto wih;
       end;
   x:=4; y:=2;
   for i:=1 to Wkesh do
     begin
      if i<8 then begin
      GotoXY(x,y);
       writeln('ЪДДДДДДДДДДДДДДДДДДДДДДДДДДДДДДДї');
 Tb(3);writeln('і                               і');
 Tb(3);writeln('АДДДДДДДДДДДДДДДДДДДДДДДДДДДДДДДЩ');
      y:=y+2;
                  end;
      if i=8 then   begin GotoXY(4,14);
         write('|                               |');
                  end;
     end;
      y:=3;
     for i:=1 to Wkesh do
      begin
       if i<8 then begin
        GotoXY(5,y);
        per:=PP108(KeshA[i]);
        write(' ',per,' /');
        GotoXY(12,y);
        Viv28(KeshD[i]);
        y:=y+2;
                   end;
       if i=8 then  begin
        y:=y-2;
        GotoXY(5,y);
        per:=PP108(KeshA[Wkesh]);
        write(' ',per,' /');
        GotoXY(12,y);
        Viv28(KeshD[Wkesh]);
                             end;
      end;
 wih:GotoXY(8,18); write('Ќ*¦¬ЁвҐ <ESC> ¤«п ўл室*');
     repeat kl:=readkey; until kl=#27;
   W2:=EraseTopWindow;
 end;
 
  (*    ЊЋ„…‹њ “‘’ђЋ‰‘’‚Ђ “ЏђЂ‚‹…Ќ?џ ЏЂЊџ’њћ         *)
  {*    ЊЋ„…‹њ ®ЇҐа*жЁЁ —’…Ќ?џ Ё§ ўбҐе ўЁ¤®ў Ї*¬пвЁ  *}
 
Procedure KeshCh;  { —вҐ*ЁҐ Ё*д®а¬*жЁЁ Ё§ ЄҐи-Ї*¬пвЁ }
    Var
     i:z;
  begin
     met:=false;
     for i:=1 to Wkesh do begin
       if KeshA[i]=adr then begin
                ishp:=KeshD[i]; met:=true;
                             end;
                          end;
  end;
 
procedure KeshZm; {‡*¬Ґ**(®Ў*®ў«Ґ*ЁҐ) ў ЄниҐ ¤«п в®Ј® ¦Ґ adr}
   var
     i:z;
  begin
    for i:=1 to Wkesh do
           if KeshA[i]=adr then KeshD[i]:=ishp;
  end;
 
procedure KeshZp; { §*ЇЁбм ў Єни *®ў®© Ё*д®а¬*жЁЁ }
   var
     i:z;
  begin
    for i:=Wkesh-1 downto 1 do begin
        KeshA[i+1]:=KeshA[i]; KeshD[i+1]:=KeshD[i];
                               end;
    KeshA[1]:=adr; KeshD[1]:=ishp;
  end;
 
 
Procedure Chpam;
  label
    konch;
   var
    zx:z;
   begin
      met:=false;
    if tpam='000' then
     begin
       if adr>Wop-1 then begin Err(9);Exit;end;
       KeshCh; if met=false then begin {Ґб«Ё ў ЄниҐ *Ґв}
                      ishp:=Op[adr]; KeshZp;
                                 end;
       goto Konch;
     end;
    if tpam='100' then
     begin
       if adr>Wop-1  then  begin Err(9);Exit;end;
       KeshCh; if met=false then begin { ў ЄниҐ *Ґв Ё*д. }
                     ishp:=Op[adr]; KeshZp;
                                 end;
       met1:=met; { ¬ҐвЄ* Ї®ЁбЄ* ў ЄниҐ Є®бўҐ*. *¤аҐб* }
       adr:=SUB210(ishp,14,9);
       zx:=SUB210(ishp,1,13);
       if (zx<>0) or (adr>Wop-1) then begin Err(9);Exit;end;
       KeshCh; if met=false then begin { ў ЄниҐ *Ґв Ё*д. }
                    ishp:=Op[adr]; KeshZp;
                                  end;
       met:=met or met1;
       goto Konch;
     end;
    if tpam='001'  then
      begin
       if adr>NRON then begin Err(7);Exit;end;
        ishp:=Ron[adr]; goto Konch;
      end;
    if tpam='010' then
      begin
       if adrst>=Wstek then begin Err(8);Exit;end;
       ishp:=Stek[adrst];
       adrst:=adrst+1;
       goto Konch;
      end;
 (*                    !  !  !  !  !                         *)
 (*    Њ … ‘ ’ Ћ   „ ‹ џ   Џ ђ Ћ ѓ ђ Ђ Њ Њ ? ђ Ћ ‚ Ђ Ќ ? џ   *)
 (*              Њ … ’ Ћ „ Ћ ‚  Ђ „ ђ … ‘ Ђ – ? ?            *)
 (*                     !  !  !  !  !                        *)
    if tpam<>'011' then Err(10);
 Konch:
   end;
 
      (*  ЊЋ„…‹њ ®ЇҐа*жЁЁ ‡ЂЏ?‘? ў® ўбҐ ўЁ¤л Ї*¬пвЁ  *)
 
procedure Zpam;
  label
     Mzp,Konz;
   var
     zx:z;
     begin
        if tpam='000' then
             begin
                if adr>Wop-1 then goto Mzp;
                if kop='1100' then adr:=Wop-1-adr;
                Op[adr]:=ishp; KeshZm;
                goto Konz;
             end;
        if tpam='100' then
            begin
              if adr>Wop-1 then goto Mzp;
              buf_ishp:=ishp;
              KeshCh;if met=false then begin
                                ishp:=Op[adr];KeshZp;
                                       end;
              zx:=SUB210(ishp,1,13);
              if zx<>0 then goto Mzp;
              adr:=SUB210(ishp,14,9);
             if kop='1100' then adr:=Wop-1-adr;
              if adr>Wop-1 then goto Mzp;
              ishp:=buf_ishp;
              Op[adr]:=ishp; KeshZm; goto Konz;
            end;
        if tpam='010' then
             begin
              if adrst<=1 then begin Err(11);Exit; end;
              adrst:=adrst-1;
              Stek[adrst]:=ishp; goto Konz;
             end;
        if tpam='001' then
             begin
              if adr>NRON then begin Err(7);Exit;end;
              Ron[adr]:=ishp; goto Konz;
             end;
   (*                 !  !  !  !  !                        *)
   (*  Њ … ‘ ’ Ћ   „ ‹ џ  Џ ђ Ћ ѓ ђ Ђ Њ Њ ? ђ Ћ ‚ Ђ Ќ ? џ  *)
   (*          Њ … ’ Ћ „ Ћ ‚  Ђ „ ђ … ‘ Ђ – ? ?            *)
   (*                 !  !  !  !  !                        *)
        if tpam<>'011' then Err(10); goto Konz;
  Mzp:Err(9);
 Konz:end;
 
procedure OutResult;    (*  Џа®жҐ¤га* ЇҐз*⨠१г«мв*в®ў *)
  var i,y:integer;
  begin
   if not DisplayWindow(W2) then write('ERROR W2');
   GotoXY(8,1); write('Ѓ “ ” … ђ  ‚ › ‚ Ћ „ Ђ');
   if Index=1 then begin GotoXY(11,4);write('ЃгдҐа ўлў®¤* Їгбв');end;
   y:=3;
   for i:=1 to Index-1 do
    begin
        GotoXY(8,y);
        Viv28(Result[i]);
        y:=y+1;
    end;
  GotoXY(8,18); write('Ќ*¦¬ЁвҐ <ESC> ¤«п ўл室*');
  repeat until ReadKey=#27;
  W2:=EraseTopWindow;
 end;
 
procedure ReadWord(max:integer);  (* Џа®жҐ¤га* звҐ*Ёп б«®ў* Ё§ ЎгдҐа* *)
  var dl:integer;
  begin
   dl:=0;
   repeat
    kl:=ReadKey;
    if kl=#0 then kl:=ReadKey;
    if (kl=#8) and (dl>0) then
     begin
      write(char(8),' ',char(8));
      dl:=dl-1;
     end
      else
       if (kl in ['0'..'7']) and (dl<max) then
        begin
         write(kl);
         dl:=dl+1;
         shwh[dl]:=kl;
        end;
   until kl=#13;
   if KeyPressed then kl:=ReadKey;
   shwh[0]:=char(dl);
 end;
 
function InputWord:boolean;   (* ”г*ЄжЁп ўў®¤* б«®ў* *)
   label rty;
   var dl,l:z;
  begin
 rty: GotoXYABS(45,24); write('             ');
      GotoXYABS(45,24); ReadWord(8);
      dl:=length(shwh);
      for l:=1 to 8-dl do
       shwh:='0'+shwh;
      if (shwh[1]<>'0') and (shwh[1]<>'1') then
        begin Err(17); goto rty; end;
      for l:=1 to 8 do
       if not(shwh[l] in ['0'..'7']) then
         begin Err(18); goto rty; end;
       if dl=0 then InputWord:=true
               else InputWord:=false;
  end;
 
  (*      Њ Ћ „ … ‹ ?   ” Ђ ‡   ђ Ђ Ѓ Ћ ’ ›   – “    *)
  (*           ”Ђ‡Ђ  ЌЂ—Ђ‹њЌЋ‰  ‡Ђѓђ“‡Љ?             *)
 
procedure Zagr(flprog:boolean);
  label
    cc,ss;
  var
    y:byte;
    q:char;
    ft:text;
    filedata:string[9];
    sif:string[8];
    i:integer;
    begin
     if not DisplayWindow(W2) then write('ERROR W2');
     flend:=false;
     GotoXY(2,1);
     if flprog then
       begin
        write(' ‡ Ђ ѓ ђ “ ‡ Љ Ђ   Џ ђ Ћ ѓ ђ Ђ Њ Њ › ');
        adr:=address;
        tpam:='000';
         if disk then
            begin
             assign(ft,'prog.cod');
             {$I-} Reset(ft); If IOResult<>0 then Err(24);Nom:=1;
             NOut:=0;
             {$I+}
             assign(ft1,'outdata.cod'); rewrite(ft1);
            end;
       end
         else
          begin  write('       ‚ ‚ Ћ „   „ Ђ Ќ Ќ › •');
           if disk then
            begin
             filedata:=Concat('data',chr(48+nom),'.cod');
             assign(ft,filedata);
             {$I-} Reset(ft); If IOResult<>0 then Err(25);Nom:=Nom+1;
             {$I+}
            end;
          end;
     Window(39,4,76,19);
     y:=1;
     repeat
    ss: GotoXY(1,y); per:=PP108(adr);
        write('   ',per,'  /');
        If disk then
         begin
          readln(ft,sif);
          for i:=1 to 8 do
           if not(sif[i] in ['0'..'7']) then
                         begin Err(22); goto cc; end;
          shwh:=sif;
         end
        else
         begin
          flend:=InputWord;
          if flend then
           begin
            if y<16 then y:=y+1;
            adr:=adr-1; GotoXY(1,y); writeln; goto ss;
           end;
         end;
        if shwh='17777777' then goto cc;
        PP82;
        GotoXY(12,y); Viv28(ishp); writeln;
        if adr>Wop then begin Err(3); goto cc; end;
        if (adr>Nron) and (tpam='001') then begin
                             Err(19);goto cc;end;
        flerr:=false;Zpam;if flerr then goto cc;
        adr:=adr+1;
        if y<16 then y:=y+1;
      until shwh='17777777';
 cc: W2:=EraseTopWindow;
   end;
 
procedure Puskmod;
  label
   pusk,slkm;
  var
   x,y:byte;
   l:z;
 
      (*               ” Ђ ‡ Ђ   ‚ › Ѓ Ћ ђ Љ ?            *)
 
procedure Wibor;
  label
   Kw,Mw,Konw;
 begin
   adr:=adrkom;we:=PP108(adrkom);tpam:='000';Chpam;
   if met then begin metk:=true; met:=false; end;
   if flerr then Exit;
   GotoXY(8,4); Viv28(ishp);
   GotoXY(4,4); if metk then write('*') else write(' ');
   adrkom:=adrkom+1; if address>511 then address:=0;
   GotoXY(6,18);write('ђҐЈ.*¤аҐб* Є®¬**¤л : ',PP108(adrkom));
   if Pos('1',ishp)=0 then begin flost:=true;Exit;end;
   kop:=Copy(ishp,1,4);
   tp1:=Copy(ishp,5,3);
   adr1:=SUB210(ishp,8,6);
   tp2:=Copy(ishp,14,3);
   adr2:=SUB210(ishp,17,6);
   if kop='1110' then
      begin  if tp2='010' then
                begin if adr2=0 then
                        begin
                          adr:=0;
                          tpam:=tp2;
                          ishp:='0000000000000000000000';
                          Delete(ishp,14,9);
                          Insert(PP102(adrkom),ishp,14);
                          Zpam;if flerr then Exit;
                        end
                        else goto kw;
                end;
            if tp1='000' then
                begin
                  adrkom:=adr1;
                  goto Mw;
                end;
            if tp1='100' then
                begin
                  tpam:='000'; adr:=adr1;
                  Chpam;if flerr then Exit;adrkom:=SUB210(ishp,14,9);
                  goto Mw;
                end;
            if (tp1='010') and (adr1=0) then
                begin tpam:=tp1;adr:=0;
                      Chpam;if flerr then Exit;
                        adrkom:=SUB210(ishp,14,9);
                        goto Mw;
                end;
        end;
   if kop='0110' then
      begin if SUB210(c,2,21)=0 then goto Mw;
            if c[1]='0' then begin tpam:=tp1;adr:=adr1;end
                        else begin tpam:=tp2;adr:=adr2;end;
            if tpam='000' then begin adrkom:=adr;goto Mw;end;
            if tpam='100' then begin tpam:='000';Chpam;
                                if flerr then Exit;
                        adrkom:=SUB210(ishp,14,9);goto Mw;end;
            goto Kw;
        end;
   if ((kop='0001') or (kop='1001') or (kop='0010') or (kop='1010')
     or (kop='0011') or (kop='0100') or (kop='1011') or(kop='0101')
     or (kop='1111') or (kop='1100')) then
        begin tpam:=tp1; adr:=adr1;
              if tp1='011' then rgs:=c
                       else begin Chpam;if met then
                                begin mets:=true;met:=false; end;
                                if flerr then Exit;rgs:=ishp;
                             end;
        end;
   if (kop='0001') or (kop='1001') or (kop='0010') or (kop='1010')
                   or (kop='0011') or (kop='0100') or (kop='1000')
                   or (kop='1011') then
        begin tpam:=tp2; adr:=adr2;
                if tp2='011' then rgd:=c
                        else begin Chpam;if met then
                         begin metd:=true;met:=false; end;
                               if tpam='100' then adr:=adr2;
                                if flerr then Exit;rgd:=ishp;
                             end;
        end; goto Konw;
  Kw:Err(1);
  Mw:flslk:=true;
 Konw:end;
 
  (*      ”Ђ‡Ђ  ‚›ЏЋ‹Ќ…Ќ?џ  ЉЋЊЂЌ„  Ѓ…‡  “—Ђ‘’?џ   Ђ ‹ “      *)
 
procedure Wipzu;
  begin
    if kop='0101' then
         begin ishp:=rgs; tpam:=tp2;
                adr:=adr2;Zpam;if flerr then Exit;c:=rgs;
                flslk:=true; metr:=met; Exit;
         end;
    if kop='1000' then
        begin if adr1=0 then begin flslk:=true;Exit;end;
                adr:=adr1;
                for kz:=1 to adr do
                  begin if tp1[1]='0' then wdw:='0'
                                      else wdw:=rgd[1];
                        if tp1[2]='0' then
                     begin if tp1[3]='0' then Insert(wdw,rgd,2)
                                else rgd:=rgd[1]+Copy(rgd,3,20)+wdw;
                     end
                     else begin
                        if tp1[1]='0' then wdw:='0'
                                      else wdw:='1';
                        if tp1[3]='0' then rgd:=wdw+rgd
                                else rgd:=Copy(rgd,2,21)+wdw;
                          end;
                  end;
               ishp:=rgd; tpam:=tp2;
               adr:=adr2; Zpam; if flerr then Exit;
               c:=rgd; flslk:=true; metr:=met;Exit;
         end;
     if kop='1111' then
        begin
         ishp:=rgs;
         if (adr1=0) and (tp1='000') then
            ishp:='1111111111111111111111';
         if Index<=15 then
                begin
                 Result[Index]:=ishp;
                 Index:=Index+1;
                end;
          flslk:=true;
          if disk then OutDisk28(ishp);
          Exit;
        end;
     if kop='0111' then
        begin
         tpam:=tp2; adr:=adr2;
         if (tpam='011') or (tpam='001') then
             begin Err(4); Exit; end;
         if tpam='010' then begin Err(18); Exit; end;
         Zagr(false); if flerr then Exit;
         flslk:=true; Exit;
        end;
      if kop='1100' then
        begin
         RgD:=RgS;    { ЇҐаҐ¤*з* ®ЇҐа**¤* ў ॣЁбва-ЇаЁҐ¬*ЁЄ }
         RgD[1]:='0'; { *®ў*п ®ЇҐа*жЁп }
         ishp:=RgD; { Ї®¤Є«озҐ*ЁҐ RgD Є Ё*д®а¬*жЁ®**®© иЁ*Ґ ЇажҐбб®а*,}
                    { ** Є®в®а®© **室Ёвбп Ё ЋЏ}
         tpam:=Tp2; adr:=Adr2; { Ї®¤Є«озҐ*ЁҐ Tp2 Ё Adr2 Є ўе®¤*л¬ }
                               { ॣЁбва*¬ ““ ўбҐ¬Ё ўЁ¤*¬Ё Ї*¬пвЁ }
         Zpam; { §*ЇгбЄ ®ЇҐа*жЁЁ ‡ЂЏ?‘њ }
         if flerr then Exit; { *ў*аЁ©*л© ўл室 ЇаЁ ®иЁЎЄҐ §*ЇЁбЁ }
         C:=RgD; { ¤гЎ«Ёа®ў**ЁҐ १г«мв*в* ў ॣЁбваҐ-*ЄЄг¬г«пв®аҐ }
         flslk:=true; { гбв**®ўЄ* д«*Ј* ЇҐаҐе®¤* Є б«Ґ¤го饩 Є®¬**¤Ґ }
         Exit; { ўл室 Ё§ д*§л WipZu }
        end;
  end;
 
  (*  ”Ђ‡Ђ   ‚›ЏЋ‹Ќ…Ќ?џ   ЉЋЊЂЌ„›  ‚   Ђ ‹ “    *)
 
procedure Wipalu;
    var  l:z;
  (*  Њ®¤Ґ«м ®ЇҐа*жЁЁ «®ЈЁзҐбЄ®Ј® б«®¦Ґ*Ёп *)
procedure Adlog;
  var l:z;
  begin
     for l:=1 to N do
        begin if (a[l]='0') and (b[l]='0') then
                c[l]:='0' else c[l]:='1';
        end;
  end;
  {*  Њ®¤Ґ«м ®ЇҐа*жЁЁ «®ЈЁзҐбЄ®Ј® г¬*®¦Ґ*Ёп  *}
procedure Mulog;
  var l:z;
  begin
     for l:=1 to N do
        begin if (a[l]='1') and (b[l]='1')
                then c[l]:='1' else c[l]:='0';
        end;
  end;
     (*   Њ®¤г«м б㬬*в®а*   *)
procedure Sumck(d:stp);
  label  Mk;
  var  l:z;
       ak,ck:char;
  begin
    p:='0'; pk:='0';
  Mk: for l:=0 to N-1 do
        begin
         ak:=d[N-l]; ck:=c[N-l];
         if  ((ak='1') and (ck='1')) or ((ak='1') and (pk='1'))
          or ((ck='1') and (pk='1'))  then  pm:='1'
                                      else  pm:='0';
         if (((ak='1') or (pk='1') or (ck='1')) and (pm='0')) or
           ((ak='1') and (pk='1') and (ck='1'))  then ck:='1'
                                                else ck:='0';
         if p='1' then c[N-l]:=ck;
         pk:=pm;
        end;
     if p='0' then begin p:='1'; goto Mk; end;
  end;
 
  (*  Њ®¤Ґ«м б«®¦Ґ*Ёп зЁбҐ« б дЁЄбЁа®ў***®© §*Їпв®©  *)
procedure Addi;
  begin
        tz:=c[1];
        if tz='1' then c:=c[1]+Ist(Copy(c,2,21));
        sa:=a[1];
        if sa='1' then Sumck(a[1]+Ist(Copy(a,2,21)))
                  else Sumck(a);
        sc:=c[1];
        if ((sa='1') and (tz='1') and (sc='0')) or
           ((sa='0') and (tz='0') and (sc='1'))
                then tp:='1' else tp:='0';
        if sc='1' then c:=c[1]+Ist(Copy(c,2,21));
  end;
   (*  Њ®¤Ґ«м г¬*®¦Ґ*Ёп зЁбҐ« б дЁЄбЁа®ў***®© §*Їпв®©  *)
procedure Mult1;
  var ml,l:z;
  begin
        sa:=a[1]; sb:=b[1];
        if sa=sb then tz:='0' else tz:='1';
        for l:=1 to N do c[l]:='0';
        a[1]:='0'; b[1]:='0';
        for ml:=N downto 1 do
          begin
                bn:=b[N];
                if bn='1' then Sumck(a);
                b:=c[N]+b; c:='0'+c;
          end;
        c[1]:=tz;
  end;
   (*  Њ®¤Ґ«м ¤Ґ«Ґ*Ёп зЁбҐ« б дЁЄбЁа®ў***®© §*Їпв®©  *)
procedure Div1;
   label
        m2,m3,m4,m5,m7,m8;
   var
        l,m:z;
  begin
        m:=N; tp:='0';
        for l:=1 to N do b[l]:='0';
        sc:=c[1]; sa:=a[1];
        if sa<>sc then b[N]:='1';
        c[1]:='0'; a[1]:='0';
     m2:Sumck(Ich(a[1])+Ist(Copy(a,2,21)));
     m3:if Pos('0',c)=0 then for l:=1 to N do c[l]:='0';
        sc:=c[1];
        if sc='1' then goto m4;
        if m=N then goto m5;
        b[N]:='1';
     m4:m:=m-1;
        if m=0 then goto m7;
        b:=Copy(b,2,21)+'0';
        if sc='0' then goto m8;
        c:=Copy(c,2,21)+'1';
        Sumck(a); goto m3;
     m8:c:=Copy(c,2,21)+'0'; goto m2;
     m5:tp:='1';
     m7:if sc='1' then Sumck(a);
        if Pos('0',c)=0 then for l:=1 to N do c[l]:='0';
  end;
     (*   ѓ®«®ў**п з*бвм Їа®жҐ¤гал  Wipalu    *)
   begin
        if (kop='0001') or (kop='0010') then
                begin  c:=rgd;
                 if kop='0010' then a:=Ich(rgs[1])+Copy(rgs,2,21)
                                else a:=rgs;
                   Addi;
                  if tp='1' then begin Err(5); Exit; end;
                  rgd:=c;ishp:=rgd;
                   Zpam;if flerr then Exit;
                  flslk:=true; metr:=met;  Exit;
                end;
        if kop='0011' then
                begin a:=rgd; b:=rgs; Mult1;
                  rgd:=c;ishp:=rgd; Zpam; if flerr then Exit;
                  met1:=met;
                  rgd:=b;ishp:=rgd; adr:=adr+1;
                  if tpam='100' then tpam:='000'; Zpam;
                  if flerr then Exit;
                  metr:=met or met1; {ў®§¬®¦*® Єни ЁбЇ®«§®ў.}
                  flslk:=true; Exit; {ЇаЁ Є®бў.*¤а.}
                end;
        if kop='0100' then
                begin c:=rgd; a:=rgs; Div1;
                  if tp='1' then begin Err(5); Exit; end;
                  rgd:=b;ishp:=rgd;Zpam;if flerr then Exit;
                  met1:=met;
                  rgd:=c;ishp:=rgd;adr:=adr+1;
                  if tpam='100' then tpam:='000'; Zpam;
                  if flerr then Exit;
                  metr:=met or met1;
                  c:=b; flslk:=true; Exit;
                end;
        if kop='1001' then
                begin b:=rgd; a:=rgs; Adlog;
                  rgd:=c;ishp:=rgd;Zpam;if flerr then Exit;
                  flslk:=true; metr:=met; Exit;
                end;
        if kop='1010' then
                begin b:=rgd; a:=rgs; Mulog;
                  rgd:=c;ishp:=rgd;Zpam;if flerr then Exit;
                  flslk:=true; metr:=met; Exit;
                end;
        if kop='1011' then
                begin c:='0'+Copy(c,2,21);
                  a:='1'+Copy(rgs,2,21);
                  Addi; rgd:=c; ishp:=rgd;
                  Zpam;if flerr then Exit;
                  flslk:=true; metr:=met; Exit;
                end;
   (*                      !  !  !  !  !                         *)
   (*     Њ … ‘ ’ Ћ   „ ‹ џ   Џ ђ Ћ ѓ ђ Ђ Њ Њ ? ђ Ћ ‚ Ђ Ќ ? џ    *)
   (*               ђ … ‡ … ђ ‚ Ќ › •   Ћ Џ … ђ Ђ – ? ‰          *)
        Err(6);
  end;   {  Wipalu  }
 
       (*    ѓ®«®ў**п з*бвм Їа®жҐ¤гал  Puskmod    *)
         begin
    if not com then
        begin
         GotoXY(40,9);write('„«п *ў*аЁ©*®Ј® ®бв**®ў* **¦¬ЁвҐ <ESC>');
        end;
  Pusk:flerr:=false;flslk:=false;flost:=false;
       met:=false;met1:=false; metk:=false;
       mets:=false;metd:=false; metr:=false;
       Wibor;
         GotoXY(8,16); Viv28(ishp);
         GotoXY(6,18);write('ђҐЈ.*¤аҐб* Є®¬**¤л : ',PP108(adrkom));
          if flerr then Exit;
          if flost then begin Err(14);Exit; end;
         GotoXY(8,7); Viv28(rgs);
          GotoXY(4,7); if mets then write('*') else write(' ');
         GotoXY(8,10);Viv28(rgd);
          GotoXY(4,10); if metd then write('*') else write(' ');
          if flslk then goto Slkm;
       Wipzu;
         GotoXY(8,16); Viv28(ishp);
          if flerr then Exit;
          if flslk then goto Slkm;
       Wipalu;
         GotoXY(8,16); Viv28(ishp);
          if flerr then Exit;
  Slkm:GotoXY(8,13); Viv28(c);
        GotoXY(4,13); if metr then write('*') else write(' ');
        kl:=#0;
        if KeyPressed then kl:=ReadKey;
        if kl=#27 then
         begin Err(20); Exit; end;
        if KeyPressed then kl:=ReadKey;
        if (com) or (adrkom=adrost) then Exit;
        goto Pusk;
 end; (* Puskmod *)
 
  (*   ѓ Ћ ‹ Ћ ‚ Ќ Ђ џ   Џ ђ Ћ ѓ ђ Ђ Њ Њ Ђ   Њ Ћ „ … ‹ ?   ќ ‚ Њ   *)
 
  label
    aq,qwe;
  begin
        BackAtribut:=TextAttr;
        Textmode(2);
        adrkom:=0;address:=0;Index:=1; adrost:=0;
        ishp:=nul;rgs:=nul;rgd:=nul;
        a:=nul;b:=nul;c:=nul;
        adrst:=wstek;
        for l:=0 to Wop do Op[l]:=nul;
        for l:=1 to Wstek-1 do Stek[l]:=nul;
        for l:=0 to Nron do Ron[l]:=nul;
        for l:=1 to Wkesh do KeshD[l]:=nul;
        for l:=1 to Wkesh do KeshA[l]:=0;
        com:=false;pult:=true;flcht:=false;
        flcht_old:=false; flkesh:=true;
        tippam:=0; NOut:=0;
        disk:=false; zagrdrive:=false;
   InitMenu(M);
   InitMenu1(M1);
   InitMenu2(M2);
    if not MakeWindow(W,35,7,79,11,True,True,False,7,7,7,'‘ЋЋЃ™…Ќ?…')
       then write('ERROR');
    if not MakeWindow(W2,38,1,77,20,True,True,False,7,7,7,'')
       then write('ERROR W2 of Make');
   Window(1,1,80,25);
   ClrScr;
   TextColor(LightGray);
   TextBackGround(black);
   Info; {звҐ*ЁҐ Є*авЁ*ЄЁ нЄа*** ў ЇбҐў¤®Ја*дЁЄҐ - «ЁжҐў*п Ї**Ґ«м ќ‚Њ}
   TextColor(white);
    GotoXY(6,18);write('ђҐЈ.*¤аҐб* Є®¬**¤л : ',PP108(adrkom));
    GotoXY(40,18);write('Ђ„ђ…‘ Џ“‹њ’Ћ‚›• ЋЏ…ђЂ–?‰ : ',PP108(address));
    GotoXY(53,3);write('ђҐ¦Ё¬: Џ“‹њ’Ћ‚›‰ ’…ђЊ?ЌЂ‹');
    GotoXY(48,4);write('’ЁЇ Ї*¬пвЁ: ЋЏ…ђЂ’?‚ЌЂџ');
  aq:
   flerr:=false;
    GotoXY(1,25);
    Key:=MenuChoice(M, Ch); {Є«*ўЁиЁ  ¬Ґ*о “ЏђЂ‚‹…Ќ?…}
    if ch=#27 then begin Err(12); goto qwe; end;                        
    case Key of
     1:begin    {Є«*ўЁи* ‡Ђ ¬Ґ*о “ЏђЂ‚‹…Ќ?…}
        GotoXY(45,24);write('         ');
        GotoXY(45,24);ReadWord(3);
        address:=PP810(shwh);if pult then adrkom:=address;
        if tippam=4 then adrost:=address;
       end;
     2:begin    {Є«*ўЁи* —’ ¬Ґ*о “ЏђЂ‚‹…Ќ?…}
        flcht:=true;
        if flcht_old then address:=address+1;
        case tippam of
         0: tpam:='000';
         1: tpam:='001';
         2: begin Stpam; goto qwe;end;
         3: begin Keshpam; goto qwe; end;
         4: goto qwe;
         end;
        adr:=address;
        Chpam;
         if address>Wop then address:=0;
         if flerr then goto qwe;
         GotoXY(13,24); Pech28(ishp);
       end;
     3:begin    {Є«*ўЁи* ‡Џ ¬Ґ*о “ЏђЂ‚‹…Ќ?…}
        case tippam of
         0: tpam:='000';
         1: tpam:='001';
         2: begin Err(16); goto qwe;end;
         3: begin Err(27); goto qwe;end;
         4: goto qwe;
        end;
        adr:=address;
        flend:=InputWord;
        if flend then goto qwe;
        PP82;Zpam;if flerr then goto qwe;
        Chpam;if flerr then goto qwe;
        GotoXY(13,24);Pech28(ishp);
        address:=address+1;
        if address>Wop then address:=0;
       end;
     4: {Є«*ўЁи* Џ“‘Љ ¬Ґ*о “ЏђЂ‚‹…Ќ?…}
         if pult then Err(13) else
        begin
         Puskmod;
         GotoXY(40,9);write('                                      ');
        end;
     5: {Є«*ўЁи* ‡Ђѓђ“‡ЉЂ ¬Ґ*о “ЏђЂ‚‹…Ќ?…}
        if (pult=true) and (Zagrdrive=true)  then Zagr(true) else
             if Zagrdrive then Err(15) else Err(23);
     6:  {Є«*ўЁи* ђ…†?Њ ¬Ґ*о “ЏђЂ‚‹…Ќ?…}
       begin
        GoToXY(48,4);write('     ');
        Key1:=MenuChoice(M1,Ch);
        GotoXY(60,3);
        case Key1 of
         1: begin write('Џ“‹њ’Ћ‚›‰ ’…ђЊ?ЌЂ‹');pult:=true;end;
         2: begin write('Ђ‚’ЋЊЂ’           ');
             if pult then begin Index:=1;adrst:=wstek;end;
             pult:=false; com:=false;
            end;
         3: begin write('ЉЋЊЂЌ„Ђ           ');
             if pult then begin Index:=1;adrst:=wstek;end;
             pult:=false; com:=true;
            end;
         4: OutResult;  {Є«*ўЁи* Ѓ“”…ђ ‚›‚Ћ„Ђ ¬Ґ*о “ЏђЂ‚‹…Ќ?…}
         5: Begin GotoXY(64,24);write('Љ‹Ђ‚?Ђ’“ђЂ');
              ZagrDrive:=true;Disk:=false;
            end;
         6: Begin GotoXY(64,24);write(' „ ? ‘ Љ  ');
              ZagrDrive:=true;Disk:=true;
            end;
        end;
        EraseMenu(M1,False);
       end;
     7:begin  {Є«*ўЁи* ’Џ - вЁЇ Ї*¬пвЁ -   ¬Ґ*о “ЏђЂ‚‹…Ќ?…}
        Key2:=MenuChoice(M2,Ch);
        GotoXY(60,4);
        case Key2 of
        1: begin write('ЋЏ…ђЂ’?‚ЌЂџ'); tippam:=0; end;
        2: begin write('‘’…ЉЋ‚Ђџ   '); tippam:=2; end;
        3: begin write('ђ…ѓ?‘’ђЋ‚Ђџ'); tippam:=1; end;
        4: begin write('Љќ?        '); tippam:=3; end;
        5: begin write('Ђ„ђ.Ћ‘’ЂЌЋ‚'); tippam:=4; end;
        end;
        EraseMenu(M2,False);
       end;
    end;
  qwe:flcht_old:=flcht;flcht:=false;
      GotoXY(6,18);write('ђҐЈ.*¤аҐб* Є®¬**¤л : ',PP108(adrkom));
      GotoXY(40,18);  if tippam=4 then
      write('Ђ„ђ…‘ Џ“‹њ’Ћ‚›• ЋЏ…ђЂ–?‰ : ',PP108(adrost)) else
      write('Ђ„ђ…‘ Џ“‹њ’Ћ‚›• ЋЏ…ђЂ–?‰ : ',PP108(address));
      GotoXY(48,4); write('’ЁЇ Ї');
      goto aq;
 end.