(*~\Глагол\ПриложенияLink\ПГ\~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~*)
(**)                              ОТДЕЛ ЗК;
(*============================================================================*)
(* НАЗНАЧЕНИЕ: Запись Кода                                                    *)
(*============================================================================*)

ИСПОЛЬЗУЕТ
 ОБХОД,

 ВД,НП,ОО,Coff,МР,ФО,CV,ПЗ;

                            (*--- общедоступные ВИДы ---*)
ВИД
  нItem- = НАБОР
    тип+:ЦЕЛ;
    уровень+:ЦЕЛ;     (* module number уровень; 
                                       уровень < 0: module imported and ABS(уровень) is index to ВД.рПонВхОтд[] *)
     вид+:ВД.ДкВиду;
     адр+:ЦЕЛ;         (* often some address                    *)
    disp+:ЦЕЛ;         (* often some code or data location      *)
bas+,inx+:ЦЕЛ;         (* опора- and index-Register             *)
   reloc+:ЦЕЛ;         (* type of relocation или cc для тип=Coc *)
relocInx+:ЦЕЛ;         (* index parameter for relocation        *)
     пон+:ВД.ДкПонятию (* для задач соответствующее понятие     *)
  КОН;

(* Items:

   тип       | адр    disp    bas   inx    reloc  relocInx
*=========================================================*
 1 пПер      | адр
 2 пПрСсылки | адр
 3 пПост     | lval   hval
             | off                (real constant)
             | off    len         (string)
 6 пЗадача   | адр
16 DArr      | адр пПер|пПрСсылки offR
             | размер RegI    offR  basR-на опис
17 Coc       | Tjmp   Fjmp                 cc
18 Stk       |
19 FStk      |
20 Reg       |                R     (R64)
21 Abs       | off
22 RegI      |        disp    R
23 RegX      | scale  disp    R     RX
24 Inx       | scale  disp          RX
25 AbsRel    | off                         reloc
26 RegIRel   |        disp    R            reloc
27 RegXRel   | scale  disp    R     RX     reloc  relocInx
28 InxRel    | scale  disp          RX     reloc  relocInx

addressing modes:
   [bas reg] + [inx reg] * 2^scale + disp
   scale = 0 | 1 | 2 | 3
   disp = data8 | data16 | data32

the fields уровень and вид are set for all modes in ОД.отд
*)

                      (*--
                               локальные ПОСТоянные 
                        --*)
ПОСТ
                    (* Род понятий (нПонятие.родп). Из ВД. *)
  пОтдел     =0;
  пОбласть   =1;
  пВид       =2;
  пПост      =3;
  пПер       =4;
  пПрСсылки  =5;
  пЗадача    =6;
  пВстрЗадача=7;
  пСвойство  =8;
(*
  родп       | n адр   пост    след     область
  ============================================================================
  пОтдел     | 0                        верх    Отдел
  пОбласть   | 1 нстр                   первпер Область действия
  пВид       | 2                                Именованный вид
  пПост      | 3       val                      Постоянная
  пПер       | 4 адр           next             Переменная или приёмник значения
  пПрСсылки  | 5 vadr          next             Приемник переменной
  пЗадача    | 6 сно   sizes   firstpar область Задача
  пВстрЗадача| 7 fno   sizes                    Встроенная задача
  пСвойство  | 8 off           next             Свойство набора

  <сно> является номером в символьной таблице COFF (если <сно> <= 0, то это - адр для связки заготовок)
*)

                    (* Признаки понятия (нПонятие.признаки). Из ВД. *)
  прОбщедоступная=0;
  прНеизменяемая =1;
  прОбъявлена    =2;
  прВложенная    =3;
  прГоловная     =4;
  прПередаваемая =5;
(*
  прОбщедоступная- действует во всех отделах
  прНеизменяемая - только для чтения
  прОбъявлена    - для полностью объявленных задач
  прВложенная    - для вложенных задач
  прГоловная     - для задачи _Zapusk 
  прПередаваемая - для иноязычных приложений
*)

  (*                        Род видов (нВид.родв). Из ВД.
 Причём:
          вЯчейка <= вЦел8 <= вЗнак <= вЦел16 <= вЦел32 <= вЦел64.
   *)
  вНеопр  =0;
  вЯчейка =1;
  вКлюч   =2;
  вЗнак   =3;
  вЦел8   =4;
  вЦел16  =5;
  вЦел32  =6;
  вЦел64  =7;
  вВещ32  =8;
  вВещ64  =9;
  вМнож   =10;
  вПЦепь  =11;
  вПусто  =12;
  вНет    =13;
  вДоступ =14;
  вЗадача =15;
  вБегунок=16;
  вРяд    =17;
  вОРяд   =18;
  вНабор  =19;
  вКон    =20; (* вКон для ДВ. При изменении вКон нужно 3 преобразования с уборка:=ОТКЛ. *)
(*
  родв    | n          овид      след     вхнотд  адрОВ    текстп
  ===============================================================
  вНеопр  | 0
  вЯчейка | 1
  вКлюч   | 2
  вЗнак   | 3
  вЦел8   | 4
  вЦел16  | 5
  вЦел32  | 6
  вЦел64  | 7
  вВещ32  | 8
  вВещ64  | 9
  вМнож   | 10
  вПЦепь  | 11
  вПусто  | 12
  вНет    | 13
  вДоступ | 14         PBaseTyp           вхнотд           текстп
  вЗадача | 15         ResTyp    params   вхнотд           текстп
  вБегунок| 16 шаг     основание          вхнотд  адрОВ    текстп
  вРяд    | 17 nofel   ElemTyp            вхнотд           текстп
  вОРяд   | 18 dim     ElemTyp            вхнотд  lenoff   текстп
  вНабор  | 19         RBaseTyp  fields   вхнотд  адрОВ    текстп
*)

  множЦел={вЦел8..вЦел64};
  множВещ={вВещ32,вВещ64};

      (*
         Способы адресации 80386 (нItem.тип). Не должны пересекаться с
                  номерами ВД.Понятие.родп. Из ЗК.
       *)
  DArr   =16;
  Coc    =17;
  Stk    =18;
  FStk   =19;     (* real on floating-point-stack   *)
  Reg    =20;     (*      bas(+inx*2^32)            *)
  Abs    =21;     (* [адр                         ] *)
  RegI   =22;     (* [    bas+          disp      ] *)
  RegX   =23;     (* [    bas+inx*2^адр+disp      ] *)
  Inx    =24;     (* [        inx*2^адр+disp      ] *)
  AbsRel =25;     (* [адр+                   reloc] *)
  RegIRel=26;     (* [    bas+          disp+reloc] *)
  RegXRel=27;     (* [    bas+inx*2^адр+disp+reloc] *)
  InxRel =28;     (* [        inx*2^адр+disp+reloc] *)

           (* Условия (cc) 80386. Из ЗК. *)
  NOV   =1;
  CST   =2;
  CCL   =3;
  EQL   =4;
  NEQ   =5;
  LSS   =12;
  GEQ   =13;
  LEQ   =14;
  GTR   =15;
  ULSS  =2;
  UGEQ  =3;
  ULEQ  =6;
  UGTR  =7;
  ALWAYS=16;
  NEVER =17;

        (* названия 32-х разрядных регистров
                                 процессора i386 М и их машинные коды. Из МР. *)
  EAX=0;  (* арифметический *)
  ECX=1;  (* арифметический *)
  EDX=2;  (* арифметический *)
  EBX=3;  (* арифметический *)

  ESP=4;
  EBP=5;
  ESI=6;  (* индексный *)
  EDI=7;  (* индексный *)

                   (* Программные ловушки (АвОсты). Из СК. *)
  пределыАвОст=1;
    номерАвОст=2;
    арифмАвОст=3;
   охранаАвОст=4;
    пустоАвОст=5;
      дляАвОст=6;
  выбратьАвОст=7;
    ответАвОст=8;
проверитьАвОст=9;
     нольАвОст=10;
  бегунокАвОст=11;

  maxCodeLen =256000;
  maxConstLen=128000;

  ВсегоРасширений=10; (* Наибольший уровень расширения наборов. Из ЗК. *)


                           (*--- общедоступные ВИДы ---*)
ВИД
  Label-=ЦЕЛ;

ПЕР
  code:ДОСТУП К РЯД maxCodeLen ИЗ ЯЧЦЕЛ;
  pc+:ЦЕЛ; (* тек. позиция в code[] *)

  const:ДОСТУП К РЯД maxConstLen ИЗ ЯЧЦЕЛ;
  cp:ЦЕЛ; (* тек. позиция в const[] *)

  уровень+:ЦЕЛ;
  dsize+:ЦЕЛ;         (* размер области переменных *)
  modDescLabel+:Label; (* метка для ссылки на Описатель Отдела *)

  firstExit:КЛЮЧ; (* ОТКЛ, если уже вызывали EndProc для текущей задачи *)

  (* данные для текущей обрабатываемой задачи *)
  virtRegPatch:ЦЕЛ;   (* место кода, где задан размер стекового окна *)
  virtRegNesting:ЦЕЛ; (* уровень вложенности стекового окна *)
  virtRegStart:ЦЕЛ;   (* размер памяти для переменных (без внешних регистров) *)
  virtRegOffs-:ЦЕЛ;   (* начало памяти для внешних регистров относительно EBP *)


                           (*-- локальные ВИДы --*)
ВИД
              (* доступ к звену - для построения списка описателей задач (ОЗ) *)
  ДкЗаписиОписателяЗадачи = ДОСТУП К НАБОР
      нз:ЦЕЛ;  (* адрес начала задачи *)
      нч:ЦЕЛ;  (* адрес начала ДВ задачи в области постоянных *)
    след:ДкЗаписиОписателяЗадачи (* связка рекурсивная *)
  КОН;               (* а можно было бы использовать ЧэргаСлеД.ДкЗвену_телоД; *)

(*---
        доступ к набору-звену = список описателей задач (ОЗ) по убыванию <нз>
  ---*)
ПЕР
  первОЗ:ДкЗаписиОписателяЗадачи;                  (* 1-й ОЗ по убыванию <нз> *)


(*-оооооооооооооо- опережающие определения/заготовки задач -ооооооооооооооооо-*)

ЗАДАЧА ^Release-(x+:нItem);
ЗАДАЧА ^Ловушка-(n:ЦЕЛ);


(*-----------------------------------------локальная ЗАДАЧА-------------------*)
ЗАДАЧА PutConstB(byte:ЦЕЛ);
(*
 *  Цель: writes a byte or a 8-bit integer into constant area
 *    До: -80H <= byte <= 100H
 *)
УКАЗ
  ЕСЛИ cp >= maxConstLen ТО
    ОО.Ошибка(ОО.МНОГО_ПОСТОЯННЫХ)
  КОН;
  ЕСЛИ byte > 7FH ТО УМЕНЬШИТЬ(byte,100H) КОН;
  const[cp]:=УЗК(УЗК(byte));
  УВЕЛИЧИТЬ(cp)
КОН PutConstB;

(*-----------------------------------------локальная ЗАДАЧА-------------------*)
ЗАДАЧА PutConstC(зн:ЗНАК);
(*  Цель: writes a single character into constant area *)
ПЕР
  word:ЦЕЛ;
УКАЗ
  word:=ВЦЕЛ(зн);
  PutConstB(word ОСТАТОК 100H);
  PutConstB(word ДЕЛИТЬ  100H)
КОН PutConstC;

(*-----------------------------------------локальная ЗАДАЧА-------------------*)
ЗАДАЧА PutConstD(dword:ЦЕЛ);
(*  Цель: writes a dword or 32-bit integer into constant area *)
УКАЗ
  PutConstB(dword ОСТАТОК 100H);
  dword:=dword ДЕЛИТЬ 100H;
  PutConstB(dword ОСТАТОК 100H);
  dword:=dword ДЕЛИТЬ 100H;
  PutConstB(dword ОСТАТОК 100H);
  dword:=dword ДЕЛИТЬ 100H;
  PutConstB(dword ОСТАТОК 100H)
КОН PutConstD;

(*-----------------------------------------локальная ЗАДАЧА-------------------*)
ЗАДАЧА PutConstString(цепь-:ЦЕПЬ);
(*  Цель: writes a <цепь> until 0X into constant area *)
ПЕР
  поз:ЦЕЛ;
  зн:ЗНАК;
УКАЗ
  поз:=0;
  ПОВТОРЯТЬ
    ЕСЛИ поз = РАЗМЕР(цепь) ТО
      PutConstC(0X);
      ВОЗВРАТ
    КОН;
    зн:=цепь[поз];
    PutConstC(зн);
    УВЕЛИЧИТЬ(поз)
  ДО зн = 0X;
КОН PutConstString;

(*-----------------------------------------локальная ЗАДАЧА-------------------*)
ЗАДАЧА PutConstName(имя-:НП.Имя);
(*  Цель: writes a full array <имя> into constant area *)
ПЕР
  поз:ЦЕЛ;
  зн:ЗНАК;
УКАЗ
  зн:=' ';
  поз:=0;
  ПОКА поз < РАЗМЕР(имя) ВЫП
    ЕСЛИ зн # 0X ТО
      зн:=имя[поз]
    КОН;
    PutConstC(зн);
    УВЕЛИЧИТЬ(поз)
  КОН
КОН PutConstName;

(*-----------------------------------------локальная ЗАДАЧА-------------------*)
ЗАДАЧА ПостРовно4;
(*  Цель: выравнивание cp до границы 4 байт *)
УКАЗ
  ПОКА (cp ОСТАТОК 4) # 0 ВЫП PutConstB(0) КОН
КОН ПостРовно4;

(*~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~общедоступная ЗАДАЧА~~~~~~~~~~~~~~~~~~~*)
ЗАДАЧА PutB-(byte:ЦЕЛ);
(*
 *  Цель: writes a byte or a 8-bit integer into code area
 *    До: -80H <= byte < 100H
 *)
УКАЗ
  ЕСЛИ pc >= maxCodeLen ТО
    ОО.Ошибка(ОО.БОЛЬШОЙ_КОД)
  КОН;
  ЕСЛИ byte > 7FH ТО УМЕНЬШИТЬ(byte,100H) КОН;
  code[pc]:=УЗК(УЗК(byte));
  УВЕЛИЧИТЬ(pc)
КОН PutB;

(*~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~общедоступная ЗАДАЧА~~~~~~~~~~~~~~~~~~~*)
ЗАДАЧА PutW-(word:ЦЕЛ);
(*
 *  Цель: writes a word or a 16-bit integer into code area
 *    До: -8000H <= word < 10000H
 *)
УКАЗ
  PutB(word ОСТАТОК 100H);
  PutB(word ДЕЛИТЬ 100H)
КОН PutW;

(*-----------------------------------------локальная ЗАДАЧА-------------------*)
ЗАДАЧА PutD(dword:ЦЕЛ);
(*  Цель: writes a dword or a 32-bit integer into code area *)
УКАЗ
  PutB(dword ОСТАТОК 100H);
  dword:=dword ДЕЛИТЬ 100H;
  PutB(dword ОСТАТОК 100H);
  dword:=dword ДЕЛИТЬ 100H;
  PutB(dword ОСТАТОК 100H);
  dword:=dword ДЕЛИТЬ 100H;
  PutB(dword ОСТАТОК 100H)
КОН PutD;

(*-----------------------------------------локальная ЗАДАЧА-------------------*)
ЗАДАЧА GetB(поз:ЦЕЛ):ЦЕЛ;
ПЕР
  byte:ЦЕЛ;
УКАЗ
  byte:=code[поз];
  ЕСЛИ byte < 0 ТО УВЕЛИЧИТЬ(byte,100H) КОН;
  ВОЗВРАТ byte
КОН GetB;

(*-----------------------------------------локальная ЗАДАЧА-------------------*)
ЗАДАЧА GetW(поз:ЦЕЛ):ЦЕЛ;
(*  Цель: read one word from code area at address 'поз' *)
УКАЗ
  ВОЗВРАТ GetB(поз+1)*100H+GetB(поз)
КОН GetW;

(*-----------------------------------------локальная ЗАДАЧА-------------------*)
ЗАДАЧА GetD(поз:ЦЕЛ):ЦЕЛ;
(*  Цель: read 32-bit integer from code area at address 'поз' *)
УКАЗ
  ВОЗВРАТ GetW(поз+2)*10000H+GetW(поз)
КОН GetD;

(*-----------------------------------------локальная ЗАДАЧА-------------------*)
ЗАДАЧА PutLabel(поз:ЦЕЛ; l:Label);
(*  Цель: writes the 32-bit label 'l' at code address 'поз' *)
ПЕР
  текпоз:ЦЕЛ;
УКАЗ
  текпоз:=pc;
  pc:=поз;
  PutD(l);
  pc:=текпоз
КОН PutLabel;

(*-----------------------------------------локальная ЗАДАЧА-------------------*)
ЗАДАЧА GetLabel(поз:ЦЕЛ):Label;
(*  Цель: returns the 32-bit label at code address 'поз' *)
УКАЗ
  ВОЗВРАТ GetD(поз)
КОН GetLabel;

(*-----------------------------------------локальная ЗАДАЧА-------------------*)
ЗАДАЧА FixLinkValue(след:Label; value:ЦЕЛ);
(*
 *  Цель: inserts at every address in the след, starting at
 *        address 'след', a given value
 *    До: след = starting address of след
 *)
ПЕР
  адр:Label;
УКАЗ
  ПОКА след # 0 ВЫП
    адр:=след;
    след:=GetLabel(след);
    PutLabel(адр,value);
    Coff.СоздатьСкр(Coff.Код,Coff.СКР_ПОСТ,0,адр)
  КОН;
КОН FixLinkValue;

(*~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~общедоступная ЗАДАЧА~~~~~~~~~~~~~~~~~~~*)
ЗАДАЧА FixLinkInd-(след:Label;
                    ном:ЦЕЛ);
(*
 *  Цель: inserts at every address in the след, starting at
 *        address 'след', a given index ном
 *    До: след = starting address of след
 *)
ПЕР
  адр:Label;
УКАЗ
  ПОКА след # 0 ВЫП
    адр:=след;
    след:=GetLabel(след);
    PutLabel(адр,0);
    ЕСЛИ GetB(адр-1) = 0E8H ТО (* CALL rel32 *)
      Coff.СоздатьСкр(Coff.Код,Coff.СКР_ОТНОС,ном,адр)
    ИНАЧЕ
      Coff.СоздатьСкр(Coff.Код,Coff.СКР_ТОЧНО,ном,адр)
    КОН
  КОН
КОН FixLinkInd;

(*~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~общедоступная ЗАДАЧА~~~~~~~~~~~~~~~~~~~*)
ЗАДАЧА FixLink-(след:Label);
(*
 *  Цель: inserts at every address in the след, starting at
 *        address 'след', a relative address for a jump to the
 *        current pc location
 *    До: след = starting address of след
 *)
ПЕР
  адр:Label;
  d:ЦЕЛ;
УКАЗ
  ПОКА след # 0 ВЫП
    адр:=след;
    след:=GetLabel(след);
    d:=pc-4-адр;
    PutLabel(адр,d)
  КОН;
КОН FixLink;

(*~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~общедоступная ЗАДАЧА~~~~~~~~~~~~~~~~~~~*)
ЗАДАЧА MergedLink-(x,y:Label):Label;
(*
 *  Цель: merges the two links 'x' and 'y' and retruns the
 *        starting address of the merged link
 *    До: x = starting address of перв след
 *        y = starting address of second след
 * После: MergedLink = starting address of merged след
 *)
ПЕР
  след,адр:Label;
УКАЗ
  ЕСЛИ y = 0 ТО ВОЗВРАТ x КОН;
  ЕСЛИ x = 0 ТО ВОЗВРАТ y КОН;
  след:=y;
  ПОВТОРЯТЬ
    адр:=след;
    след:=GetLabel(след)
  ДО след = 0;
  PutLabel(адр,x);
  ВОЗВРАТ y
КОН MergedLink;

(*~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~общедоступная ЗАДАЧА~~~~~~~~~~~~~~~~~~~*)
ЗАДАЧА
       PutCall-(ном:ЦЕЛ);
(*
 *  Цель: записать код для вызова задачи
 *    До: ном = номер задачи в таблице COFF символов
 *)
УКАЗ
  PutB(0E8H); (* CALL rel32 *)
  PutD(0);
  Coff.СоздатьСкр(Coff.Код,Coff.СКР_ОТНОС,ном,pc-4)
КОН PutCall;

(*~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~общедоступная ЗАДАЧА~~~~~~~~~~~~~~~~~~~*)
ЗАДАЧА
       PutDllCall-(нс:ЦЕЛ);
УКАЗ
  PutB(0FFH);
  PutB(2*8H+5);
  PutD(0);      (* CALL [disp32] *)

  Coff.СоздатьСкр(Coff.Код,
                  Coff.СКР_ТОЧНО,нс,pc-4)
КОН PutDllCall;

(*~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~общедоступная ЗАДАЧА~~~~~~~~~~~~~~~~~~~*)
ЗАДАЧА
       PutLink-(поз :ЦЕЛ;
                нач+:Label);
(*
 *  Цель: writes след for a forward call in поз addres
 *    До: нач = - starting address of след to same call index
 * После: нач = - new starting address of след
 *)
УКАЗ
  PutLabel(поз,-нач);
  нач:=-поз
КОН PutLink;

(*~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~общедоступная ЗАДАЧА~~~~~~~~~~~~~~~~~~~*)
ЗАДАЧА
       PutCallF-(нач+:Label);
(*
 *  Цель: writes code for a near forward call to own задача
 *    До: нач = - starting address of след to same call index
 * После: нач = - new starting address of след
 *)
УКАЗ
  PutB(0E8H); (* CALL Av *)
  PutD(-нач);
  нач:=-(pc-4)
КОН PutCallF;

(*~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~общедоступная ЗАДАЧА~~~~~~~~~~~~~~~~~~~*)
ЗАДАЧА
       PutO-(opc:ЦЕЛ);
(*
 *  Цель: выдает в область 32 разрядного кода КОП
 *    До: 0 <= <opc> < 10000H - номер КОП
 *)
УКАЗ
  ПРОВЕРИТЬ((opc >= 0) И (opc < 10000H));
  ЕСЛИ (0 <= opc) И (opc < 100H) ТО
    PutB(opc)
  ИНАЧЕ
    PutB(opc ДЕЛИТЬ 100H);
    PutB(opc ОСТАТОК 100H)
  КОН
КОН PutO;

(*~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~общедоступная ЗАДАЧА~~~~~~~~~~~~~~~~~~~*)
ЗАДАЧА
       PutOD-(datasize,opc,data:ЦЕЛ);
(*
 *  Цель: выдает в область кода КОП с непосредственным данным <data>
 *    До: <datasize>          - размер непосредственного данного (1, 2 или 4 ячейки)
 *        0 <= <opc> < 10000H - номер КОП
 *        0 <= <data> < 100000000H - значение непосредственного данного
 *)
УКАЗ
  PutO(opc);
  ВЫБРАТЬ datasize ИЗ
    1: PutB(data)
  | 2: PutW(data)
  | 4: PutD(data)
  КОН
КОН PutOD;

(*~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~общедоступная ЗАДАЧА~~~~~~~~~~~~~~~~~~~*)
ЗАДАЧА
       PutOM-(opc,
              ttt :ЦЕЛ;
              mem+:нItem);
(*
 *  Цель: выдает в область кода КОП с местоположением данных <mem>
 *    До: 0 <= <opc> < 10000H - номер КОП
 *        0 <= <ttt> < 8      - поле ttt в КОП
 *        <mem>               - местоположение в памяти или регистре
 *)
ПЕР
  membas,meminx:ЦЕЛ;
УКАЗ
  ПРОВЕРИТЬ((ttt >= 0) И (ttt < 8));
  ВЫБРАТЬ mem.тип ИЗ
    Reg:
      membas:=МР.РегВоДопМРег(mem.bas);
      PutO(opc);
      PutB(0C0H+08H*ttt+membas)
  | Abs,AbsRel:
      PutO(opc);
      PutB(08H*ttt+05H);
      PutD(mem.адр)
  | RegI:
      membas:=МР.РегВоДопМРег(mem.bas);
      PutO(opc);
      ЕСЛИ mem.disp = 0 ТО
        ЕСЛИ membas = ESP ТО
          PutB(00H+08H*ttt+04H); PutB(20H+ESP);
        АЕСЛИ membas = EBP ТО
          PutB(40H+08H*ttt+EBP); PutB(0);
        ИНАЧЕ
          PutB(00H+08H*ttt+membas)
        КОН
      АЕСЛИ (-80H <= mem.disp) И (mem.disp < 80H) ТО
        ЕСЛИ membas = ESP ТО
          PutB(40H+08H*ttt+04H); PutB(20H+ESP)
        АЕСЛИ membas = EBP ТО
          PutB(40H+08H*ttt+EBP)
        ИНАЧЕ
          PutB(40H+08H*ttt+membas)
        КОН;
        PutB(mem.disp)
      ИНАЧЕ
        ЕСЛИ membas = ESP ТО
          PutB(80H+08H*ttt+04H); PutB(20H+ESP)
        АЕСЛИ membas = EBP ТО
          PutB(80H+08H*ttt+EBP)
        ИНАЧЕ
          PutB(80H+08H*ttt+membas)
        КОН;
        PutD(mem.disp)
      КОН
  | RegIRel:
      membas:=МР.РегВоДопМРег(mem.bas);
      PutO(opc);
      ЕСЛИ membas = ESP ТО
        PutB(80H+08H*ttt+04H); PutB(20H+ESP)
      АЕСЛИ membas = EBP ТО
        PutB(80H+08H*ttt+EBP)
      ИНАЧЕ
        PutB(80H+08H*ttt+membas)
      КОН;
      PutD(mem.disp)
  | RegX:
      membas:=МР.РегВоДопМРег(mem.bas);
      meminx:=МР.РегВоДопМРег(mem.inx);
      ПРОВЕРИТЬ(meminx # ESP);
      PutO(opc);
      ЕСЛИ mem.disp = 0 ТО
        ЕСЛИ membas = ESP ТО
          PutB(08H*ttt+04H);
          PutB(mem.адр*40H+meminx*08H+ESP);
        АЕСЛИ membas = EBP ТО
          PutB(40H+08H*ttt+04H);
          PutB(mem.адр*40H+meminx*08H+EBP);
          PutB(0)
        ИНАЧЕ
          PutB(08H*ttt+04H);
          PutB(mem.адр*40H+meminx*08H+membas);
        КОН
      АЕСЛИ (-80H <= mem.disp) И (mem.disp < 80H) ТО
        PutB(40H+08H*ttt+04H);
        PutB(mem.адр*40H+meminx*08H+membas);
        PutB(mem.disp)
      ИНАЧЕ
        PutB(80H+08H*ttt+04H);
        PutB(mem.адр*40H+meminx*08H+membas);
        PutD(mem.disp)
      КОН
  | RegXRel:
      membas:=МР.РегВоДопМРег(mem.bas);
      meminx:=МР.РегВоДопМРег(mem.inx);
      ПРОВЕРИТЬ(meminx # ESP);
      PutO(opc);
      PutB(80H+08H*ttt+04H);
      PutB(mem.адр*40H+meminx*08H+membas);
      PutD(mem.disp)
  | Inx,InxRel:
      meminx:=МР.РегВоДопМРег(mem.inx);
      ПРОВЕРИТЬ(meminx # ESP);
      PutO(opc);
      PutB(08H*ttt+04H);
      PutB(mem.адр*40H+meminx*08H+05H);
      PutD(mem.disp)
  КОН;
  ЕСЛИ mem.тип В {AbsRel,RegIRel,RegXRel,InxRel} ТО
    Coff.СоздатьСкр(Coff.Код,mem.reloc,mem.relocInx,pc-4)
  КОН
КОН PutOM;

(*~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~общедоступная ЗАДАЧА~~~~~~~~~~~~~~~~~~~*)
ЗАДАЧА
       Put2-;
(* 
    Цель: префикс 2-х байтных данных в 32 разрядном режиме.
 *)
УКАЗ
  PutB(66H)
КОН Put2;

(*~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~общедоступная ЗАДАЧА~~~~~~~~~~~~~~~~~~~*)
ЗАДАЧА
       PutOMD-(datasize,
                    opc,
                    ttt :ЦЕЛ;
                    mem+:нItem;
                    data:ЦЕЛ);
(*
 *  Цель: выдает в область кода КОП с местоположением данных <mem> и
 *        непосредственным данным <data>
 *    До: <datasize>          - размер непосредственного данного (1, 2 или 4 ячейки)
 *        0 <= <opc> < 10000H - номер КОП
 *        0 <= <ttt> < 8      - поле ttt в КОП
 *        <mem>               - местоположение в памяти или регистре
 *        0 <= <data> < 100000000H - значение непосредственного данного
 *)
УКАЗ
  ЕСЛИ datasize = 2 ТО
    Put2
  КОН;
  PutOM(opc,ttt,mem);
  ВЫБРАТЬ datasize ИЗ
  | 1: PutB(data)
  | 2: PutW(data)
  | 4: PutD(data)
  КОН
КОН PutOMD;

(*~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~общедоступная ЗАДАЧА~~~~~~~~~~~~~~~~~~~*)
ЗАДАЧА
       PutORM-(opc,
               reg :ЦЕЛ;
               mem+:нItem);
(*
 *  Цель: выдает в область кода КОП с местоположением данных <mem> и
 *        регистром <reg>
 *    До: 0 <= <opc> < 10000H - номер КОП
 *        <reg>               - регистр
 *        <mem>               - местоположение в памяти или регистре
 *)
ПЕР
  м:ЦЕЛ;
УКАЗ
  м:=МР.РегВоДопМРег(reg);
  PutOM(opc,м,mem)
КОН PutORM;

(*~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~общедоступная ЗАДАЧА~~~~~~~~~~~~~~~~~~~*)
ЗАДАЧА
       PutIMUL3-(reg :ЦЕЛ;
                 mem+:нItem;
                 data:ЦЕЛ);
(*
 *  Цель: выдает в область кода КОП IMUL Gd,Ed,Id с местоположением данных <mem>,
 *        регистром <reg> и непосредственным данным <data>
 *    До: 0 <= <opc> < 10000H - номер КОП
 *        <reg>               - регистр
 *        <mem>               - местоположение в памяти или регистре
 *        0 <= <data> < 100000000H - значение непосредственного данного
 *)
УКАЗ
  PutORM(069H,reg,mem);
  PutD(data)
КОН PutIMUL3;

(*~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~общедоступная ЗАДАЧА~~~~~~~~~~~~~~~~~~~*)
ЗАДАЧА
       PutPushReg-(reg:ЦЕЛ);
(*
 *  Цель: выдает в область кода КОП для заталкивания в стек содержимого
 *        гуляй регистра <reg>
 *)
ПЕР
  x:нItem;
УКАЗ
  ЕСЛИ
       МР.РегСейчасМ(reg)
  ТО
    PutO(050H+МР.РегМВ(reg)) (* PUSH r32 *)
  ИНАЧЕ
    x.тип:=RegI;
    x.bas:=МР.ЗанятьОпредРег({EBP});
    x.disp:=-virtRegOffs-4*МР.РегМВ(reg);
    PutOM(0FFH,6H,x); (* PUSH Ed *)
    МР.ОсвободитьРег(x.bas)
  КОН
КОН PutPushReg;

(*~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~общедоступная ЗАДАЧА~~~~~~~~~~~~~~~~~~~*)
ЗАДАЧА
       PutJmpF-(поз+:Label);
(*
 *  Цель: writes code for an unconditional forward jump
 *    До: поз = starting address of след to same jump address
 * После: поз = new starting address of след
 *)
УКАЗ
  PutB(0E9H); (* JMP rel32 *)
  PutD(поз);
  поз:=pc-4
КОН PutJmpF;

(*~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~общедоступная ЗАДАЧА~~~~~~~~~~~~~~~~~~~*)
ЗАДАЧА
       PutJmpB-(поз:Label);
(* 
 *  Цель: writes code for an unconditional backward jump
 *    До: поз = destination address for the jump
 *)
ПЕР
  d:ЦЕЛ;
УКАЗ
  d:=поз-pc-2;
  ПРОВЕРИТЬ(d <= 0);
  ЕСЛИ d < -80H ТО
    PutB(0E9H); (* JMP rel32 *)
    PutD(d-3);
  ИНАЧЕ
    PutB(0EBH); (* JMP rel8 *)
    PutB(d);
  КОН
КОН PutJmpB;

(*~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~общедоступная ЗАДАЧА~~~~~~~~~~~~~~~~~~~*)
ЗАДАЧА
       PutJmpCF-(coc :ЦЕЛ;
                 поз+:Label);
(*
 *  Цель: writes code for a conditional forward jump
 *    До: coc = condition code
 *        поз = starting address of след to same jump address
 * После: поз = new staring address of след
 *)
УКАЗ
  ЕСЛИ coc = ALWAYS ТО
    PutJmpF(поз)
  АЕСЛИ coc # NEVER ТО
    PutW(0800FH+coc*100H);
    PutD(поз);
    поз:=pc-4;
  КОН
КОН PutJmpCF;

(*~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~общедоступная ЗАДАЧА~~~~~~~~~~~~~~~~~~~*)
ЗАДАЧА
       PutJmpCB-(coc:ЦЕЛ; поз:Label);
(*
 *  Цель: writes code for a conditional backward jump
 *    До: coc = condition code
 *        поз = destination address for the jump
 *)
ПЕР
  d:ЦЕЛ;
УКАЗ
  ЕСЛИ coc = ALWAYS ТО
    PutJmpB(поз)
  АЕСЛИ coc # NEVER ТО
    d:=поз-pc-2;
    ПРОВЕРИТЬ(d <= 0);
    ЕСЛИ d < -80H ТО
      PutW(0800FH+coc*100H);  (* JMPcc rel32 *)
      PutD(d-4)
    ИНАЧЕ
      PutB(070H+coc);         (* JMPcc rel8 *)
      PutB(d)
    КОН
  КОН
КОН PutJmpCB;

(*~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~общедоступная ЗАДАЧА~~~~~~~~~~~~~~~~~~~*)
ЗАДАЧА
       PutCaseJmp-(x+:нItem);
(*
 *  Цель: writes code for an indirect call
 *    До: x = index value in a register,x.тип = Reg
 *)
УКАЗ
  x.тип:=Inx;
  x.адр:=2;              (* scale = 2^2 = 4 *)
  x.disp:=0;             (* pc + caseTabDisp *)
  x.inx:=x.bas;
  PutOM(0FFH,4H,x);      (* JMP r/m32 *)
  pc:=pc-4;
  PutD(pc+4);
  Coff.СоздатьСкр(Coff.Код,Coff.СКР_КОД,0,pc-4);
КОН PutCaseJmp;

(*~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~общедоступная ЗАДАЧА~~~~~~~~~~~~~~~~~~~*)
ЗАДАЧА
       PutIndCall-(x+:нItem);
(*
 *  Цель: writes code for an indirect call
 *    До: x = address where call address [off32] is stored
 *        x.тип В {Abs,RegI}
 *)
ПЕР
  y:нItem;
  L1:Label;
  xbas:ЦЕЛ;
УКАЗ
  ЕСЛИ x.тип В {Abs,AbsRel} ТО
    PutB(0FFH); PutB(2*8H+5); PutD(x.адр); (* CALL [disp32] *)
  ИНАЧЕ (* RegI,RegIRel *)

    ЕСЛИ НП.клПровПусто ТО
      y.тип:=Reg;
      y.bas:=МР.ЗанятьРег();
      PutORM(08BH,y.bas,x); (* MOV r32,r/m32 *)
      PutOM(09H,МР.РегМВ(y.bas),y); (* OR r/m32,r32 *)
      Release(y);
      L1:=0;
      PutJmpCF(NEQ,L1); (* check if pointer is ПУСТО *)
      Ловушка(пустоАвОст);
      FixLink(L1)
    КОН;
      
    ЕСЛИ (x.disp = 0) И (x.тип = RegI) ТО
      ЕСЛИ МР.СтекРег(x.bas) ТО
        xbas:=EBX;
        МР.РегВОпредМРег(x.bas,xbas)
      ИНАЧЕ
        xbas:=МР.РегВоДопМРег(x.bas)
      КОН;
      PutB(0FFH); PutB(2*8H+xbas)           (* CALL [reg] *)
    ИНАЧЕ
      ЕСЛИ МР.СтекРег(x.bas) ТО
        ЕСЛИ МР.РегМВ(x.bas) = EBP ТО
          xbas:=EBP
        ИНАЧЕ
          xbas:=EBX;
          МР.РегВОпредМРег(x.bas,xbas)
        КОН
      ИНАЧЕ
        xbas:=МР.РегВоДопМРег(x.bas)
      КОН;
      PutB(0FFH); PutB(2*40H+2*8H+xbas); (* CALL [reg+disp32] *)
      PutD(x.disp)
    КОН
  КОН;
  ЕСЛИ x.тип В {AbsRel,RegIRel} ТО
    Coff.СоздатьСкр(Coff.Код,x.reloc,x.relocInx,pc-4)
  КОН
КОН PutIndCall;

(*~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~общедоступная ЗАДАЧА~~~~~~~~~~~~~~~~~~~*)
ЗАДАЧА
       AllocString-(цепь-:ЦЕПЬ;
                     адр+:ЦЕЛ);
(* Цель: помещает <цепь> в области постоянных и возвращает ее начальный <адр> *)
ПЕР
  поз:ЦЕЛ;
УКАЗ
  адр:=cp;
  ОТ поз:=0 ДО РАЗМЕР(цепь)-1 ВЫП
    PutConstC(цепь[поз])
  КОН
КОН AllocString;

(*~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~общедоступная ЗАДАЧА~~~~~~~~~~~~~~~~~~~*)
ЗАДАЧА
       AllocReal-(    шв :ШИРВЕЩ;
                     адр+:ЦЕЛ;
                  широкая:КЛЮЧ);
(*
 *  Цель: помещает (широкую) вещ. постоянную в области постоянных
 *    До: <шв>  - постоянная
 * После: <адр> - адрес, по которому записанна постоянная
 *)
ВИД
  Упаковка=НАБОР ц1,ц2:ЦЕЛ КОН;
ПЕР
  целые:Упаковка;
  r:ВЕЩ;
УКАЗ
  ПостРовно4;
  адр:=cp;
  ЕСЛИ широкая ТО
    целые:=ОБХОД.Значение(Упаковка,шв);
    PutConstD(целые.ц1);
    PutConstD(целые.ц2)
  ИНАЧЕ
    r:=УЗК(шв);
    PutConstD(ОБХОД.Значение(ЦЕЛ,r))
  КОН
КОН AllocReal;

(*-----------------------------------------локальная ЗАДАЧА-------------------*)
(* ДВ+ *)
ЗАДАЧА ВыработатьДВ(вид:ВД.ДкВиду;
                    адр:ЦЕЛ;
                nameobj:ВД.ДкПонятию);
(*
 *  Цель: строит Данные о Виде времени выполнения
 *    До:     вид - вид переменной
 *            адр - адрес переменной
 *        nameobj - понятие с именем переменной
 *)
ПЕР
  свво:ВД.ДкПонятию;
  родв:ЦЕЛ;
  овид:ВД.ДкВиду;
УКАЗ
  родв:=вид.родв;
  овид:=вид.овид;
  PutConstD(родв);
  ЕСЛИ nameobj # ПУСТО ТО
    PutConstString(nameobj.имя)
  ИНАЧЕ
    PutConstC(0X)
  КОН;
  PutConstD(адр);
  ВЫБРАТЬ родв ИЗ
  | вНабор:
      свво:=вид.след; (* пробегаем по всем свойствам *)
      ПОКА свво # ПУСТО ВЫП
        ВыработатьДВ(свво.вид,адр+свво.адр,свво);
        свво:=свво.след
      КОН;
      PutConstD(вКон)
  | вДоступ:
      ЕСЛИ овид.родв = вНабор ТО
        PutConstD(вНабор); (* Вид *)
        PutConstC(0X)      (* Имя *)
        (* больше ничего, т.к. имеет свой ДВ по ОВ *)
      ИНАЧЕ
        ВыработатьДВ(овид,0,овид.пон)
      КОН
  | вРяд:
      PutConstD(овид.размер);    (* размер слагаемого *)
      PutConstD(вид.n);          (* число слагаемых   *)
      ВыработатьДВ(овид,0,овид.пон) (* вид слагаемого *)
  | вОРяд:
      ПОКА овид.родв = вОРяд ВЫП
        овид:=овид.овид
      КОН;
      PutConstD(овид.размер); (* размер слагаемого *)
      (* длины размерностей хранятся в ряду *)
      ВыработатьДВ(овид,0,овид.пон)
  | вБегунок:
      ВыработатьДВ(овид,0,овид.пон) (* вид слагаемого *)
  ИНАЧЕ
  КОН
КОН ВыработатьДВ;
(* ДВ- *)

(*~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~общедоступная ЗАДАЧА~~~~~~~~~~~~~~~~~~~*)
ЗАДАЧА
       ВСписокОЗ-(задача:ВД.ДкПонятию;
                      нз:ЦЕЛ);
(*
 *  Цель: сохраняет ДВ задачи в области постоянных и пишет это в ЗаписьОЗ = ДкЗаписиОписателяЗадачи
 *    До: <нз> - адрес начала задачи
 * После:
 *)
ПЕР
  новОЗ:ДкЗаписиОписателяЗадачи;
  пон:ВД.ДкПонятию;
УКАЗ
  СОЗДАТЬ(новОЗ);
  новОЗ.нз:=нз;
  новОЗ.нч:=cp;
  (* новОЗ помещаем в начало списка *)
  новОЗ.след:=первОЗ;
  первОЗ:=новОЗ;
  (* название задачи *)
  PutConstString(задача.имя);
  (* ДВ приёмников задачи *)
  пон:=задача.след;
  ПОКА пон # ПУСТО ВЫП
    ЕСЛИ пон.родп # пПрСсылки ТО (* приёмники переменных не нужны для уборки *)
      ВыработатьДВ(пон.вид,пон.адр,пон) (* но они необходимы для отладки! *)
    КОН;
    пон:=пон.след
  КОН;
  (* ДВ переменных задачи *)
  пон:=задача.область.область;
  ПОКА пон # ПУСТО ВЫП
    ВыработатьДВ(пон.вид,пон.адр,пон);
    пон:=пон.след
  КОН;
  (* конец ДВ задачи *)
  PutConstD(вКон)
КОН ВСписокОЗ;

(*~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~общедоступная ЗАДАЧА~~~~~~~~~~~~~~~~~~~*)
ЗАДАЧА
       AllocTypDesc-(вид:ВД.ДкВиду);
(*
 *  Цель: сохраняет Описатель Вида (ОВ) набора в области постоянных
 * После: вид.адрОВ - адрес ОВ
 *)
ПЕР
  колено:ЦЕЛ;
  адрДВ:ЦЕЛ;

 (*...............................................подЗАДАЧА...*)
  ЗАДАЧА ЗаписьООВ(вид:ВД.ДкВиду);
  (* Цель:  самовызовом записывает адреса описателей опорных видов (ООВ) *)
  УКАЗ
    ЕСЛИ вид = ВД.неопрвид ТО ВОЗВРАТ КОН;
    ЗаписьООВ(вид.овид);
    Coff.СоздатьСкр(Coff.Пост,Coff.СКР_ПОСТ,вид.вхнОтд,cp);
    ПРОВЕРИТЬ(вид.адрОВ # НП.АдрНеопр);
    PutConstD(вид.адрОВ);
    УВЕЛИЧИТЬ(колено)
  КОН ЗаписьООВ;

УКАЗ
  ПРОВЕРИТЬ(вид.родв = вНабор);
  ЕСЛИ вид.колено > ВсегоРасширений ТО
    ОО.Ошибка(ОО.БОЛЬШАЯ_ГЛУБИНА)
  КОН;
  ЕСЛИ вид.вхнОтд = 0 ТО (* только наборы текущего отдела *)
    (* ДВ+ *)
    адрДВ:=cp;
    ВыработатьДВ(вид,0,вид.пон);
    PutConstD(cp-адрДВ);  (* размер ДВ *)
    (* ДВ- *)
    Coff.СоздатьСкр(Coff.Пост,Coff.СКР_ПОСТ,0,cp);
    PutConstD(адрДВ+4);   (* адрес имени вида набор *)
    PutConstD(вид.размер);(* размер данных набора   *)
    (* Описатель Вида (ОВ) *)
    вид.адрОВ:=cp;
    колено:=0;
    ЗаписьООВ(вид);
    (* дополняем конец ОВ 0-ми *)
    ПОКА колено < ВсегоРасширений ВЫП
      PutConstD(0);
      УВЕЛИЧИТЬ(колено)
    КОН
  КОН
КОН AllocTypDesc;

(*~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~общедоступная ЗАДАЧА~~~~~~~~~~~~~~~~~~~*)
ЗАДАЧА
       AllocCaseTab-(low,
                     high:ЦЕЛ;
                     tab+:ЦЕЛ);
(*
 *  Цель: allocate room for a case table in code area
 *    До: low, high = low and high index for case jump
 * После: tab = address, where the case table starts
 *)
ПЕР
  pcAfterTable:ЦЕЛ;
УКАЗ
  tab:=pc;
  pcAfterTable:=pc+(high-low+1)*4;
  ПОКА low <= high ВЫП
    Coff.СоздатьСкр(Coff.Код,Coff.СКР_КОД,0,pc);
    PutD(pcAfterTable);
    УВЕЛИЧИТЬ(low)
  КОН;
КОН AllocCaseTab;

(*~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~общедоступная ЗАДАЧА~~~~~~~~~~~~~~~~~~~*)
ЗАДАЧА
       CaseJump-(tab,from,to:ЦЕЛ);
(*
 *  Цель: writes jump-offsets into case table 'tab' to jump for the
 *                values 'from'..'to' to the current pc location
 *    До: from = starting index
 *          to =      end index
 *)
ПЕР
  текпоз:ЦЕЛ;
УКАЗ
  текпоз:=pc;
  pc:=tab+4*from;
  ПОКА from <= to ВЫП
    PutD(текпоз);
    УВЕЛИЧИТЬ(from)
  КОН;
  pc:=текпоз
КОН CaseJump;

(*~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~общедоступная ЗАДАЧА~~~~~~~~~~~~~~~~~~~*)
ЗАДАЧА
       BegStat-;
(*  Цель: general-purpose задача which is called before each statement *)
УКАЗ
  МР.СбросМатМРеги
КОН BegStat;

(*~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~общедоступная ЗАДАЧА~~~~~~~~~~~~~~~~~~~*)
ЗАДАЧА
       EndStat-;                        (*  Цель: called after each statement *)
УКАЗ
  МР.Проверка;
  МР.СбросМатМРеги
КОН EndStat;

(*~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~общедоступная ЗАДАЧА~~~~~~~~~~~~~~~~~~~*)
ЗАДАЧА
       BegProc-(stackFrameSize,
                       nesting:ЦЕЛ);
(* Заголовок для задачи.
   Вложенные вызовы BegProc и EndProc недопустимы. *)
УКАЗ
  ЕСЛИ stackFrameSize > 7FFFH ТО
    ОО.Ошибка(ОО.МНОГО_ПЕР_ЗАДАЧИ)
  КОН;
  ПРОВЕРИТЬ(stackFrameSize ОСТАТОК 4 = 0);
  МР.СбросВРегов;
  firstExit:=ВКЛ;
  virtRegStart:=stackFrameSize;
  virtRegNesting:=nesting;
  virtRegOffs:=stackFrameSize+nesting*4+4;
  PutB(0C8H);              (* ENTER Iw,Ib *)
  virtRegPatch:=pc;
  PutW(stackFrameSize);
  PutB(nesting)
КОН BegProc;

(*~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~общедоступная ЗАДАЧА~~~~~~~~~~~~~~~~~~~*)
ЗАДАЧА
       EndProc-(parSize:ЦЕЛ);             (* Одна из точек выхода для задачи. *)
ПЕР
  текпоз:ЦЕЛ;
УКАЗ
  ЕСЛИ parSize > 7FFFH ТО
    ОО.Ошибка(ОО.МНОГО_ПРИЕМНИКОВ_ЗАДАЧИ)
  КОН;
  ПРОВЕРИТЬ(ЧЕТ(parSize));
  PutB(0C9H);   (* LEAVE *)
  PutB(0C2H);   (* RET near imm16 *)
  PutW(parSize);
  ПРОВЕРИТЬ(GetB(virtRegPatch+2) = virtRegNesting);
  ПРОВЕРИТЬ((GetW(virtRegPatch) = virtRegStart) ИЛИ НЕ firstExit);
  текпоз:=pc; 
  pc:=virtRegPatch;
  PutW(МР.НужноПамДляВРегов()+virtRegStart);
  pc:=текпоз;
  firstExit:=ОТКЛ
КОН EndProc;


(*-оооооооооооооо- опережающие определения/заготовки задач -ооооооооооооооооо-*)

(*-----------------------------------------локальная ЗАДАЧА-------------------*)
ЗАДАЧА ^КодМвМ(измрег,вмрег:ЦЕЛ);


(*~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~общедоступная ЗАДАЧА~~~~~~~~~~~~~~~~~~~*)
ЗАДАЧА
       CopyItem-(x+,y+:нItem);
(*
 *  Цель: copies the contents of item x to item y
 *    До: x is initialized
 * После: y:=x
 *)

 (*...............................................подЗАДАЧА...*)
  ЗАДАЧА CopyGenReg(r1:ЦЕЛ):ЦЕЛ;  (* r2:=r1 *)
  ПЕР
    r2,м1:ЦЕЛ;
  УКАЗ
    м1:=МР.РегВоДопМРег(r1);
    ЕСЛИ м1 В МР.МРеги ТО
      r2:=МР.ЗанятьРег();
      КодМвМ(м1,МР.РегМВ(r2));
      ВОЗВРАТ r2
    ИНАЧЕ
      ВОЗВРАТ r1
    КОН
  КОН CopyGenReg;

УКАЗ
  y:=x;
  ВЫБРАТЬ x.тип ИЗ
  | Reg,RegI,RegIRel:
      y.bas:=CopyGenReg(x.bas)
  | RegX,RegXRel:
      y.bas:=CopyGenReg(x.bas);
      y.inx:=CopyGenReg(x.inx)
  | Inx,InxRel:
      y.inx:=CopyGenReg(x.inx)
  ИНАЧЕ
  КОН
КОН CopyItem;

(*~~~~~~~~~~~~~~~~~~~ 64 ~~~~~~~~~~~~~~общедоступная ЗАДАЧА~~~~~~~~~~~~~~~~~~~*)
ЗАДАЧА
       Release-(x+:нItem);
(*
 *  Цель: gives all the associated registers of item 'x' free
 * После: all registers used in 'x' are released
 *)
УКАЗ
  ВЫБРАТЬ x.тип ИЗ
  | Reg:
      МР.ОсвободитьРег(x.bas);
      ЕСЛИ (x.вид # ПУСТО) И (x.вид.родв = вЦел64) ТО
        МР.ОсвободитьРег(x.inx)
      КОН
  | RegI,RegIRel:
      МР.ОсвободитьРег(x.bas)
  | RegX,RegXRel:
      МР.ОсвободитьРег(x.bas);
      МР.ОсвободитьРег(x.inx)
  | Inx,InxRel:
      МР.ОсвободитьРег(x.inx)
  | DArr:
      МР.ОсвободитьРег(x.bas);
      ЕСЛИ (x.disp = RegI) ИЛИ (x.disp = RegIRel) ТО
        МР.ОсвободитьРег(x.inx)
      КОН
  ИНАЧЕ
  КОН;
  x.тип:=0
КОН Release;

(*-----------------------------------------локальная ЗАДАЧА-------------------*)
ЗАДАЧА КодМВ(мрег,врег:ЦЕЛ; мВв:КЛЮЧ);
(* copy CPU register to (from) virtual register slot *)
УКАЗ
  ЕСЛИ мВв ТО
    PutB(089H)  (* MOV r/m32,r32 *)
  ИНАЧЕ
    PutB(08BH)  (* MOV r32,r/m32 *)
  КОН;
  PutB(5+мрег*8+80H);
  PutD(-virtRegOffs-4*врег)
КОН КодМВ;

(*-----------------------------------------локальная ЗАДАЧА-------------------*)
ЗАДАЧА КодМС(мрег:ЦЕЛ; мВс:КЛЮЧ);
(* push (pop) a CPU register *)
УКАЗ
  ЕСЛИ мВс ТО
    PutO(050H+мрег)
  ИНАЧЕ
    PutO(058H+мрег)
  КОН
КОН КодМС;

(*-----------------------------------------локальная ЗАДАЧА-------------------*)
ЗАДАЧА КодМвМ(измрег,вмрег:ЦЕЛ);
(* copy CPU register to CPU register *)
УКАЗ
  PutB(08BH);                          (* MOV r32,r/m32 *)
  PutB(измрег+вмрег*8+0C0H)
КОН КодМвМ;

(*-----------------------------------------локальная ЗАДАЧА-------------------*)
ЗАДАЧА КодОбменМсМ(мрег1,мрег2:ЦЕЛ);
(* exchange CPU register contents *)
УКАЗ
  PutB(087H);  (* XCHG r32,r/m32 *)
  PutB(мрег1+мрег2*8+0C0H)
КОН КодОбменМсМ;

(*-----------------------------------------локальная ЗАДАЧА-------------------*)
ЗАДАЧА КодМатемМВ(врег:ЦЕЛ; мВв:КЛЮЧ);
(* store m80real to врег and pop *)
ПЕР
  x:нItem;
УКАЗ
  x.тип:=RegI;
  x.bas:=МР.ЗанятьОпредРег({EBP});
  x.disp:=-virtRegOffs-4*врег;
  ЕСЛИ мВв ТО
    PutOM(0DBH,7,x) (* FSTP m80real *)
  ИНАЧЕ
    PutOM(0DBH,5,x) (* FLD m80real *)
  КОН;
  МР.ОсвободитьРег(x.bas)
КОН КодМатемМВ;


(*----------------------------------------------------------------------------*
 * Запись COFF файла
 *----------------------------------------------------------------------------*)

(*~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~общедоступная ЗАДАЧА~~~~~~~~~~~~~~~~~~~*)
ЗАДАЧА
       OutCode-;
ПЕР
  адрДВПерем,длДВПерем:ЦЕЛ;

 (*...............................................подЗАДАЧА...*)
  ЗАДАЧА ОбходПер(пон:ВД.ДкПонятию);
  УКАЗ
    ЕСЛИ пон # ПУСТО ТО
      ОбходПер(пон.лево);
      ЕСЛИ пон.родп = пПер ТО
        ВыработатьДВ(пон.вид,пон.адр,пон)
      КОН;
      ОбходПер(пон.право)
    КОН
  КОН ОбходПер;

УКАЗ
  (* 1: Записываем в область постоянных ДВ всех переменных уровня отдела *)
  адрДВПерем:=cp;
  ОбходПер(ВД.текОбласть.право);
  длДВПерем:=cp-адрДВПерем;

  (* 3: Записываем в область постоянных Описатель Отдела (ОО) *)
  FixLinkValue(-modDescLabel,cp); (* закрепляем все ссылки из кода на ОО *)
  PutConstName(НП.отдИмя); (* ОО.название *)
  Coff.СоздатьСкр(Coff.Пост,Coff.СКР_ПЕР,0,cp);
  PutConstD(0);             (* ОО.адрПерем *)
  Coff.СоздатьСкр(Coff.Пост,Coff.СКР_КОД,0,cp);
  PutConstD(0);             (* ОО.адрПервЗадачи *)
  Coff.СоздатьСкр(Coff.Пост,Coff.СКР_КОД,0,cp);
  PutConstD(pc);            (* ОО.адрЗаПослЗадачей *)
  Coff.СоздатьСкр(Coff.Пост,Coff.СКР_ПОСТ,0,cp);
  PutConstD(адрДВПерем);    (* ОО.адрДВПерем *)
  PutConstD(длДВПерем);     (* ОО.длДВПерем *)
  (* Записываем Описания Задач *)
  ПОКА первОЗ # ПУСТО ВЫП
    Coff.СоздатьСкр(Coff.Пост,Coff.СКР_КОД,0,cp);
    PutConstD(первОЗ.нз);   (* ОО.нз *)
    Coff.СоздатьСкр(Coff.Пост,Coff.СКР_ПОСТ,0,cp);
    PutConstD(первОЗ.нч);   (* ОО.нч *)
    первОЗ:=первОЗ.след
  КОН;

  (* выравнивание области постоянных по границе параграфа *)
  ПОКА (cp ОСТАТОК 16) # 0 ВЫП PutConstB(0) КОН;

  (* 4: Производим COFF файл
     в данный момент: pc    - размер кода,
                      cp    - размер постоянных,
                      dsize - размер переменных *)
  Coff.WriteCoffHeader(pc,cp,dsize);
  ФО.КодРовно4;
  Coff.WriteConst(const^,cp);
  ФО.КодРовно4;
  Coff.WriteCode(code^,pc);
  ФО.КодРовно4;
  Coff.ЗаписьСкр(Coff.Код);
  Coff.ЗаписьСкр(Coff.Пост);
  ФО.КодРовно4;
  ЕСЛИ НП.клОтлДанные ТО
    CV.Запись;
    Coff.ЗаписьСкр(Coff.ОтлСмв)
  КОН;
  ФО.КодРовно4;
  (* LineNumberTable необходимо записывать даже если не нужны отладочные данные *)
  Coff.WriteLineNumberTable;
  ФО.КодРовно4;
  Coff.WriteSymbolTable;
  (* StringTable следует всегда после SymbolTable *)
  Coff.WriteStringTable
КОН OutCode;

(*~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~общедоступная ЗАДАЧА~~~~~~~~~~~~~~~~~~~*)
ЗАДАЧА
       Ловушка-(n:ЦЕЛ);
(*
 *  Цель: code to terminate programm with return code n
 *    До: n = return code
 *)
УКАЗ
  УВЕЛИЧИТЬ(n,ОО.текПоз.строка * 10000H);
  PutOD(4,068H,0); (* PUSH Id *)
  PutLink(pc-4,modDescLabel);
  PutOD(4,068H,n); (* PUSH Id *)
  PutCall(Coff.rtsHaltInx)
КОН Ловушка;

(*~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~общедоступная ЗАДАЧА~~~~~~~~~~~~~~~~~~~*)
ЗАДАЧА
       Подготовить-;
УКАЗ
  уровень:=0;
  МР.Подготовить(КодМВ,КодОбменМсМ,КодМвМ,КодМС,КодМатемМВ);
  СОЗДАТЬ(code);
  pc:=0;
  СОЗДАТЬ(const);
  cp:=0;
  dsize:=0;
  modDescLabel:=0;
  virtRegStart:=0;
  virtRegPatch:=-1;
  virtRegNesting:=0;
  virtRegOffs:=0;
  первОЗ:=ПУСТО;
  firstExit:=ВКЛ
КОН Подготовить;

(*~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~общедоступная ЗАДАЧА~~~~~~~~~~~~~~~~~~~*)
ЗАДАЧА
       Завершить-;
УКАЗ
  code:=ПУСТО;
  const:=ПУСТО;
  первОЗ:=ПУСТО;
КОН Завершить;

КОН ЗК.
