(*~\Глагол\ПриложенияLink\ПГ\~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~*)
(**)                              ОТДЕЛ Coff;
(*============================================================================*)
(* НАЗНАЧЕНИЕ: поддержка COFF формата двоичных файлов                         *)
(*============================================================================*)

ИСПОЛЬЗУЕТ
        (*  \Глагол\              *)
 оЦепи    ИЗ "..\..\Отделы\Иное\",
 Транслит ИЗ "..\..\Отделы\Иное\",
        (*  \Глагол\              *)
  Текст   ИЗ "..\..\Отделы\Обмен\",

  НП,ОО,ФО,ВД,ПЗ;

                         (*--- общедоступные ПОСТоянные ---*)
ПОСТ
  Код-   =1;
  Пер-   =2;
  Пост-  =3;
  ОтлВид-=4;
  ОтлСмв-=5;  (* номера секций COFF *)


                      (*--
                                   локальные ПОСТоянные 
                        --*)
ПОСТ
  MAX_NOFSECTIONS=5;
  SCTNNAME_CODE         = "_Kod";
  SHORT_SCTNNAME_CODE   = ".text";
  SCTNNAME_DATA         = "_Per";
  SHORT_SCTNNAME_DATA   = ".bss";
  SCTNNAME_CONST        = "_Post";
  SHORT_SCTNNAME_CONST  = ".data";
  SCTNNAME_DEBUGTYPES   = ".debug$T";
  SCTNNAME_DEBUGSYMBOLS = ".debug$S";

  MAXSTRINGTABLE=32000;
  MAXLINENUMS   =5000;    (* может быть записей о номерах строк одного отдела *)

  IMAGE_FILE_MACHINE_I386=14CH;
  IMAGE_FILE_BYTES_REVERSED_HI=-8000H;

  IMAGE_SCN_TYPE_NO_PAD=8H;            (* Занято. *)
  IMAGE_SCN_CNT_CODE=20H;              (* Section contains code. *)
  IMAGE_SCN_CNT_INIT_DATA=40H;         (* Section contains initialized data. *)
  IMAGE_SCN_CNT_UNINIT_DATA=80H;       (* Section contains uninitialized data. *)
  IMAGE_SCN_ALIGN_1BYTES=100000H;      (* *)
  IMAGE_SCN_ALIGN_16BYTES=500000H;     (* Default alignment if no others are specified. *)
  IMAGE_SCN_MEM_DISCARDABLE=2000000H;  (* Section can be discarded. *)
  IMAGE_SCN_MEM_EXECUTE=20000000H;     (* Section is executable. *)
  IMAGE_SCN_MEM_READ=40000000H;        (* Section is readable. *)
  IMAGE_SCN_MEM_WRITE=-7FFFFFFFH-1;    (* Section is writeable. *)

  IMAGE_SYM_CLASS_EXTERNAL=2;
  IMAGE_SYM_CLASS_STATIC=3;
  IMAGE_SYM_CLASS_FUNCTION=101;
  IMAGE_SYM_CLASS_FILE=103;

  IMAGE_SYM_DEBUG=-2;      (* special values for section references in the symbol table *)

  IMAGE_REL_I386_DIR32=6H;
  IMAGE_REL_I386_DIR32NB=7H;
  IMAGE_REL_I386_SECTION=0AH;
  IMAGE_REL_I386_SECREL=0BH;
  IMAGE_REL_I386_REL32=014H;

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

                           (*-- локальные ВИДы --*)
ВИД
  ДкSymbolName  = ДОСТУП К нSymbolNameT;                (* набор-Таблица символьных имён *)
                           нSymbolNameT = НАБОР
    имя:ЦЕПЬ[НП.длинаНазвания*3+1];
    задача:КЛЮЧ;
    next:ДкSymbolName
                                          КОН;

  ДкSymbolModule= ДОСТУП К нSymbolModuleT;            (* набор-Таблица символьных Модулей - расширение набора симв.имён *)
                           нSymbolModuleT=НАБОР (нSymbolNameT)
    номотд:ЦЕЛ
                                          КОН;
(*
 * because COFF line number information also relies on задача symbols all
 * Glagol procedures generate symbol table entries whether they are exported or not.
 *)
  ДкSymbolProc  = ДОСТУП К нSymbolProcT;              (* набор-Таблица символов-экспорта из Процедур - расширение набора симв.имён *)
                           нSymbolProcT = НАБОР (нSymbolNameT)
    смещение,                                         (* start-смещение в коде приложения (of задача code) *)
    codeSize,
    firstLine,
    lastLine,
    nofLineRecs,
    lineNumInx,          (* before line number info is written index into table in memory;
                             after that file pointer *)
        номСмв,
    следНомСмв :ЦЕЛ;
                                          КОН;
  нLineNumEntryT = НАБОР
    line,
    смещение:ЦЕЛ;        (* if line=0
                              index into symbol table;
                            else
                              ЗК.pc *)
    symbol:ДкSymbolProc; (* ПУСТО or ДОСТУП-pointer to symbol if задача start *)
  КОН;

                     (*--- общедоступные ПОСТоянные ---*)

(*========= FixUps ===========================================================*)
                     (* Виды скрепок. Из COFF. *)
ПОСТ
                                 (* ссылка на КОД отдела (ном - номер отдела) *)
  СКР_КОД-     =1;
                          (* ссылка на ПОСТоянные отдела (ном - номер отдела) *)
  СКР_ПОСТ-    =2;
                          (* ссылка на ПЕРеменные отдела (ном - номер отдела) *)
  СКР_ПЕР-     =3;
                     (* точная ссылка (ном - номер в символьной таблице COFF) *)
  СКР_ТОЧНО-   =4;
         (* точная ссылка в exe файле (ном - номер в символьной таблице COFF) *)
  СКР_ФАЙЛ-    =5;
              (* относительная ссылка (ном - номер в символьной таблице COFF) *)
  СКР_ОТНОС-   =6;
            (* ссылка на номер секции (ном - номер в символьной таблице COFF) *)
  СКР_СЕКЦИЯ-  =7;
        (* ссылка относительно секции (ном - номер в символьной таблице COFF) *)
  СКР_ОТНСЕКЦ- =8;

                           (*-- локальные ВИДы --*)
ВИД
  ДкСкрепке = ДОСТУП К нВидСкрепки;
                       нВидСкрепки = НАБОР
    слеД:ДкСкрепке; (* следущая по списку скрепка *)
    вид,            (* COFF вид скрепки *)
    ном,            (* номер в символьной таблице COFF *)
    адр:ЦЕЛ;        (* адрес относительно начала области (код,пер,пост) *)
                                     КОН;

                        (*-- локальные ПЕРеменные --*)
ПЕР
  nofSections:ЦЕЛ;           (* number of sections *)
  stringTable:ЦЕПЬ[MAXSTRINGTABLE+1];
  stringLen:ЦЕЛ;
  symbolList    :ДкSymbolName;     (* head of linked list of symbols for the symbol table *)
  lastSymbol    :ДкSymbolName;     (* след element из symbolList *)
  lastSymbolProc:ДкSymbolProc;     (* след SymbolProc из symbolList *)
  номСмв:ЦЕЛ;                (* later index into the symbol table of the next element put into the symbol list *)

  lineNumsД:ДОСТУП К РЯД MAXLINENUMS ИЗ нLineNumEntryT;

  цLineNums:ЦЕЛ;
  колЗаписей_в_symTable:ЦЕЛ; (* the number of records and auxiliary records in the symbol table *)
  symTableFixup:ЦЕЛ;         (* position of pointer to symbol table in object file *)
  sctnList:РЯД MAX_NOFSECTIONS+1 ИЗ
    НАБОР
      length,nofRelocs,nofLines,fixup:ЦЕЛ;
      скрепкаД:ДкСкрепке
    КОН;
  lastTrueLineNr:ЦЕЛ;(* used to check for would-be identical entries in AddLineNum (during code generation) *)
  procLineNrs:ЦЕЛ;   (* total number of line number records for the current задача (during code generation) *)

                      (*--- общедоступные ПЕРеменные ---*)
ПЕР
  rtsGlBP-,
  rtsGlIP-,
  rtsStop-,
  rtsCelChast-,
  rtsLMulInx-,
  rtsLDivModInx-,
  rtsLAshInx-,
  rtsNewInx-,
  rtsHaltInx-:ЦЕЛ;        (* index in symbol table of runtime system routines *)


(*~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~общедоступная ЗАДАЧА~~~~~~~~~~~~~~~~~~~~~*)
ЗАДАЧА
       MakeGlobalName-(   modName-,
                        localName-,
                       linkSymbol+ :ЦЕПЬ);
ПЕР
  латИмя:ЦЕПЬ[НП.длинаНазвания*2+1];
УКАЗ
  Транслит.ВЛат(modName,linkSymbol);
 оЦепи.ДобавитьВКонецЗнак(linkSymbol,"_");
  Транслит.ВЛат(localName,латИмя);
 оЦепи.ДобавитьВКонец(linkSymbol,латИмя)
КОН MakeGlobalName;


(*----------------------------------------------------------------------------*)
(*-------------------------string table management----------------------------*)
(*----------------------------------------------------------------------------*)

(*~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~общедоступная ЗАДАЧА~~~~~~~~~~~~~~~~~~~~~*)
ЗАДАЧА
       WriteStringTable-;
(* Write the entire string table to the object file *)
ПЕР
  поз:ЦЕЛ;
УКАЗ
    ФО.КодЦел4(stringLen+4);
  ОТ поз:=0 ДО stringLen-1 ВЫП
    ФО.КодЗнак(stringTable[поз])
  КОН
КОН WriteStringTable;

(*-----------------------------------------локальная ЗАДАЧА-------------------*)
ЗАДАЧА NewString(txt-:ЦЕПЬ; offs+:ЦЕЛ);
(* Add a string to the string table *)
ПЕР
  i:ЦЕЛ;
УКАЗ
  offs:=stringLen+4;
  i:=0;
  ПОВТОРЯТЬ
    ПРОВЕРИТЬ(stringLen < MAXSTRINGTABLE);
    stringTable[stringLen]:=txt[i];
    УВЕЛИЧИТЬ(i);
    УВЕЛИЧИТЬ(stringLen)
  ДО txt[i-1] = 0X
КОН NewString;

(*-----------------------------------------локальная ЗАДАЧА-------------------*)
ЗАДАЧА ПисНазвание(имя-:ЦЕПЬ);
ПЕР
  поз,дл:ЦЕЛ;
УКАЗ
  дл:=ДЛИНА(имя);
  ЕСЛИ дл <= 8 ТО
    поз:=0;
    ПОКА поз < 8 ВЫП
      ЕСЛИ поз < дл ТО
        ФО.КодЗнак(имя[поз])
      ИНАЧЕ
        ФО.КодЗнак(0X)
      КОН;
      УВЕЛИЧИТЬ(поз)
    КОН
  ИНАЧЕ
    NewString(имя,поз);
    ФО.КодЦел4(0);
    ФО.КодЦел4(поз)
  КОН
КОН ПисНазвание;

(*-----------------------------------------локальная ЗАДАЧА-------------------*)
ЗАДАЧА WriteSectionHeader(
                          имя- :ЦЕПЬ;        (* имя секции *)
                         flags,     (* section contents flags (code,data,...) *)
                         lineN,     (* number of line number informations *)
                      dataSize :ЦЕЛ;     (* размер данных этой секции *)
                   fixupHandle+:ЦЕЛ      (* handle for later fixing file ptrs *)
                         );
УКАЗ
  ПисНазвание(имя);
  ФО.КодЦел4(0); (* 0 in .obj files *)
  ФО.КодЦел4(0); (* 0 in .obj files *)
  ФО.КодЦел4(dataSize); (* размер *)
  fixupHandle:=ФО.КодПозиция();
  ФО.КодЦел4(0);     (* смещение of raw data in file *)
  ФО.КодЦел4(0);     (* смещение of relocations in file *)
  ФО.КодЦел4(0);     (* смещение of line number info in file *)
  ФО.КодЦел2(0);     (* number of relocations *)
  ФО.КодЦел2(lineN); (* number of line numbers *)
  ФО.КодЦел4(flags); (* section flags *)
КОН WriteSectionHeader;

(*-----------------------------------------локальная ЗАДАЧА-------------------*)
ЗАДАЧА WriteSectionAux(length,
                       nofRelocs,
                       nofLines,
                       checkSum,
                       assocSectionTableInx,
                       comdatSlct:ЦЕЛ);
(* write the auxiliary record for a section definition in the symbol table *)
УКАЗ
  УВЕЛИЧИТЬ(колЗаписей_в_symTable);
  ФО.КодЦел4(length);
  ФО.КодЦел2(nofRelocs);
  ФО.КодЦел2(nofLines);
  ФО.КодЦел4(checkSum);
  ФО.КодЦел2(assocSectionTableInx);
  ФО.КодЦел1(comdatSlct);
  ФО.КодЦел1(0); (* reserved *)
  ФО.КодЦел2(0); (* reserved *)
КОН WriteSectionAux;

(*~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~общедоступная ЗАДАЧА~~~~~~~~~~~~~~~~~~~~~*)
ЗАДАЧА
        WriteCoffHeader-(
                        codeSize,          (* общий размер кода *)
                        constSize,         (* общий размер области постоянных *)
                        dataSize  :ЦЕЛ     (* размер данных отдела *)
                       );
(* Write COFF and section headers *)
УКАЗ
  ФО.КодЦел2(IMAGE_FILE_MACHINE_I386);
  ФО.КодЦел2(nofSections); (* number of sections *)
  ФО.КодЦел4(0);           (* time / date stamp *)
  symTableFixup:=ФО.КодПозиция();
  ФО.КодЦел4(-1); (* pointer to symbol table, needs to be fixed later *)
  ФО.КодЦел4(-1); (* number of symbol table entries plus definition for the ComDat section *)
  ФО.КодЦел2(0);  (* размер доп. заголовка, обычно 0 в .obj файлах *)
  ФО.КодЦел2(IMAGE_FILE_BYTES_REVERSED_HI); (* characteristics *)
                                                     
  (* заголовки разделов *)
  WriteSectionHeader(SHORT_SCTNNAME_CODE,
                     IMAGE_SCN_CNT_CODE+
                     IMAGE_SCN_MEM_EXECUTE+
                     IMAGE_SCN_MEM_READ+
                     IMAGE_SCN_ALIGN_16BYTES,
                     цLineNums,
                     codeSize,
                     sctnList[Coff.Код].fixup
                    );
                     sctnList[Coff.Код].length:=codeSize;

  WriteSectionHeader(SHORT_SCTNNAME_DATA,
                     IMAGE_SCN_CNT_UNINIT_DATA+
                     IMAGE_SCN_MEM_READ+
                     IMAGE_SCN_MEM_WRITE+
                     IMAGE_SCN_ALIGN_16BYTES,
                     0,
                     dataSize,
                     sctnList[Coff.Пер].fixup
                    );
                     sctnList[Coff.Пер].length:=dataSize;

  WriteSectionHeader(SHORT_SCTNNAME_CONST,
                     IMAGE_SCN_CNT_INIT_DATA+
                     IMAGE_SCN_MEM_READ+
                     IMAGE_SCN_MEM_WRITE+
                     IMAGE_SCN_ALIGN_16BYTES,
                     0,
                     constSize,
                     sctnList[Coff.Пост].fixup
                    );
                     sctnList[Coff.Пост].length:=constSize;

  ЕСЛИ НП.клОтлДанные ТО
    WriteSectionHeader(SCTNNAME_DEBUGTYPES,
                       IMAGE_SCN_CNT_INIT_DATA+
                       IMAGE_SCN_MEM_READ+
                       IMAGE_SCN_MEM_DISCARDABLE+
                       IMAGE_SCN_TYPE_NO_PAD+
                       IMAGE_SCN_ALIGN_1BYTES,
                       0,
                       0,
                       sctnList[Coff.ОтлВид].fixup
                      );
                       sctnList[Coff.ОтлВид].length:=constSize;

    WriteSectionHeader(SCTNNAME_DEBUGSYMBOLS,
                       IMAGE_SCN_CNT_INIT_DATA+
                       IMAGE_SCN_MEM_READ+
                       IMAGE_SCN_MEM_DISCARDABLE+
                       IMAGE_SCN_TYPE_NO_PAD+
                       IMAGE_SCN_ALIGN_1BYTES,
                       0,
                       0,
                       sctnList[Coff.ОтлСмв].fixup
                      );
                       sctnList[Coff.ОтлСмв].length:=constSize;
  КОН;
КОН WriteCoffHeader;

(*~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~общедоступная ЗАДАЧА~~~~~~~~~~~~~~~~~~~~~*)
ЗАДАЧА
       WriteSymbol-(имя-:ЦЕПЬ;
                    value,
                    sectionNr, (* one-based index into section table *)
                    type,      (* use at least 20H (function) and 0H (not a function) *)
                    storageClass,
                    auxRecords:ЦЕЛ);
(* write an entry into the symbol table *)
УКАЗ
  УВЕЛИЧИТЬ(колЗаписей_в_symTable);
  ПисНазвание(имя);
  ФО.КодЦел4(value);
  ФО.КодЦел2(sectionNr);
  ФО.КодЦел2(type);
  ФО.КодЦел1(storageClass);
  ФО.КодЦел1(auxRecords)
КОН WriteSymbol;

(*-----------------------------------------локальная ЗАДАЧА-------------------*)
ЗАДАЧА WriteSymbolAuxProc(
                          tagInx,
                          размер,
                        lineNums,
                    nextFunction :ЦЕЛ
                         );
(* write auxiliary entry for a function definition into the symbol table *)
УКАЗ
  УВЕЛИЧИТЬ(колЗаписей_в_symTable);
  ФО.КодЦел4(tagInx);
  ФО.КодЦел4(размер);
  ФО.КодЦел4(lineNums);
  ФО.КодЦел4(nextFunction);
  ФО.КодЦел2(0);
КОН WriteSymbolAuxProc;

(*-----------------------------------------локальная ЗАДАЧА-------------------*)
ЗАДАЧА WriteSymbolAuxFileName(fileName-:ЦЕПЬ);
(*
 * write auxiliary entries into the symbol table defining the source file имя;
 *   the number of entries written is (Length(fileName)+17) DIV 18
 *)
ПЕР
  i,j:ЦЕЛ;
УКАЗ
  i:=0;
  ПОКА fileName[i] # 0X ВЫП
    УВЕЛИЧИТЬ(колЗаписей_в_symTable);
    j:=0;
    ПОКА j < 18 ВЫП
      ФО.КодЗнак(fileName[i]);
      ЕСЛИ fileName[i] # 0X ТО УВЕЛИЧИТЬ(i) КОН;
      УВЕЛИЧИТЬ(j)
    КОН
  КОН;
КОН WriteSymbolAuxFileName;

(*-----------------------------------------локальная ЗАДАЧА-------------------*)
ЗАДАЧА WriteSymbolAuxBfEf(line,next:ЦЕЛ);
УКАЗ
  УВЕЛИЧИТЬ(колЗаписей_в_symTable);
  ФО.КодЦел4(0);
  ФО.КодЦел2(line);
  ФО.КодЦел4(0);
  ФО.КодЦел2(0);
  ФО.КодЦел4(next);
  ФО.КодЦел2(0);
КОН WriteSymbolAuxBfEf;


(* ========================== Таблица COFF символов ========================= *)


(*-----------------------------------------локальная ЗАДАЧА-------------------*)
ЗАДАЧА ДобавитьСмв(symД:ДкSymbolName);
УКАЗ
  ЕСЛИ  symbolList = ПУСТО ТО
        symbolList :=symД
  ИНАЧЕ
    lastSymbol.next:=symД
  КОН;
    lastSymbol     :=symД
КОН ДобавитьСмв;

(*~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~общедоступная ЗАДАЧА~~~~~~~~~~~~~~~~~~~~~*)
ЗАДАЧА
       AddSymbolName-(имя-:ЦЕПЬ;
                      symbolTableInx+:ЦЕЛ; задача:КЛЮЧ
                     );
(*
 * Добавляет задачу из др. отдела to the list for symbol table generation.
 * The zero based index the item will have in the symbol table is returned in symbolTableInx.
 * Must not be called any more when WriteCoffHeader has been called.
*)
ПЕР
              symД:ДкSymbolName;
УКАЗ
  symbolTableInx:=номСмв;

      СОЗДАТЬ(symД);
  СПИСАТЬ(имя,symД.имя);
  symД.задача:=задача;
  ДобавитьСмв(symД);
  УВЕЛИЧИТЬ(номСмв)
КОН AddSymbolName;

(*-----------------------------------------локальная ЗАДАЧА-------------------*)
ЗАДАЧА AddSymbolModule(   пон:ВД.ДкПонятию;
                       номотд:ЦЕЛ);
(*
 * Add an imported data section and the module body from another module
 * (containing global module data) to the list for symbol table generation.
 * The zero based index the item will have in the symbol table is returned in symbolTableInx.
 * Must not be called any more when WriteCoffHeader has been called.
 * The index returned + 1 is the index of the symbol for the module body.
*)
ПЕР
              symД:ДкSymbolModule;
УКАЗ
  пон.адр:=номСмв;
      СОЗДАТЬ(symД);
  ДобавитьСмв(symД);
  СПИСАТЬ(пон.имя,symД.имя);
  symД.номотд:=номотд;
  УВЕЛИЧИТЬ(номСмв,3)
КОН AddSymbolModule;

(*~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~общедоступная ЗАДАЧА~~~~~~~~~~~~~~~~~~~~~*)
ЗАДАЧА
       AddImportedProc-(пон:ВД.ДкПонятию);
(*
 * Add an imported задача to the list for symbol table generation.
 * The zero based index the item will have in the symbol table is returned in symbolTableInx.
 * Must not be called any more when WriteCoffHeader has been called.
*)
ПЕР
          symД:ДкSymbolName;
УКАЗ
  пон.адр:=номСмв;
  СОЗДАТЬ(symД);
          symД.задача:=ВКЛ;

  MakeGlobalName(ВД.рПонВхОтд[-пон.уровень].имя,пон.имя,symД.имя);

  ДобавитьСмв(symД);
  УВЕЛИЧИТЬ(номСмв)
КОН AddImportedProc;

(*~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~общедоступная ЗАДАЧА~~~~~~~~~~~~~~~~~~~~~*)
ЗАДАЧА
       AddSymbolProc-(пон:ВД.ДкПонятию;
                      смещение,
                      codeSize,
                     firstLine,
                    lineNumInx :ЦЕЛ);
ПЕР
   symД:ДкSymbolProc;
  число:Текст.РядЧисло;
УКАЗ
  ПРОВЕРИТЬ(пон.адр <= 0);
  пон.адр:=номСмв;
  СОЗДАТЬ(symД);

  ЕСЛИ
       (прГоловная В пон.признаки)
      И
       (НП.отдВид = НП.приложение)
  ТО
    СПИСАТЬ(пон.имя,symД.имя)
  АЕСЛИ 
       (прПередаваемая В пон.признаки)
      И
       (прОбщедоступная В пон.признаки)
      И
       (НП.отдВид = НП.приложение)
  ТО
    symД.имя:="_";
   оЦепи.ДобавитьВКонец(symД.имя,пон.имя)
  ИНАЧЕ

    MakeGlobalName(НП.отдИмя,пон.имя,symД.имя);

    ЕСЛИ прВложенная В пон.признаки ТО
      Текст.ИзЦел10(пон.область.адр,0,число);
      оЦепи.ДобавитьВКонецЗнак(symД.имя,"^");
      оЦепи.ДобавитьВКонец(symД.имя,число)
    КОН
  КОН;
  symД.смещение:=смещение;
  symД.codeSize:=codeSize;
  symД.firstLine:=firstLine;
  ПРОВЕРИТЬ(lastTrueLineNr > 0);
  symД.lastLine:=lastTrueLineNr;
  symД.lineNumInx:=lineNumInx;
  symД.номСмв:=номСмв;
  symД.nofLineRecs:=procLineNrs;
  ДобавитьСмв(symД);
  ЕСЛИ
    lastSymbolProc # ПУСТО
  ТО
    lastSymbolProc.следНомСмв:=номСмв
  КОН;
    lastSymbolProc:=symД;
  УВЕЛИЧИТЬ(номСмв,7) (* an exported задача creates 7 symbol table entries *)
КОН AddSymbolProc;

(*-----------------------------------------локальная ЗАДАЧА-------------------*)
ЗАДАЧА WriteSymbolName(symД:ДкSymbolName);
УКАЗ
  ЕСЛИ symД.задача ТО
    WriteSymbol(symД.имя,
                0,
                0,  (* секция *)
                20H,(* это задача *)
                IMAGE_SYM_CLASS_EXTERNAL,
                0)  (* нет aux records *)
  ИНАЧЕ  
    WriteSymbol(symД.имя,
                0,
                0,  (* секция *)
                0,  (* это не задача *)
                IMAGE_SYM_CLASS_EXTERNAL,
                0)  (* нет aux records *)
  КОН
КОН WriteSymbolName;

(*-----------------------------------------локальная ЗАДАЧА-------------------*)
ЗАДАЧА WriteSymbolModule(symД:ДкSymbolModule);
ПЕР
  str:ЦЕПЬ[3*НП.длинаНазвания+1];

 (*...........................подЗадача..*)
  ЗАДАЧА Секция(с:ЦЕЛ):ЦЕЛ;
  УКАЗ
    ЕСЛИ symД.номотд # 0 ТО
      ВОЗВРАТ 0 (* Внешний *)
    ИНАЧЕ
      ВОЗВРАТ с
    КОН
  КОН Секция;

УКАЗ
  MakeGlobalName(symД.имя,SCTNNAME_CODE,str);
  WriteSymbol(str,
              0,
              Секция(Coff.Код),
              0H, (* not a function *)
              IMAGE_SYM_CLASS_EXTERNAL,
              0); (* aux records *)
  MakeGlobalName(symД.имя,SCTNNAME_DATA,str);
  WriteSymbol(str,
              0,
              Секция(Coff.Пер),
              0H, (* not a function *)
              IMAGE_SYM_CLASS_EXTERNAL,
              0); (* aux records *)
  MakeGlobalName(symД.имя,SCTNNAME_CONST,str);
  WriteSymbol(str,
              0,
              Секция(Coff.Пост),
              0H,  (* not a function *)
              IMAGE_SYM_CLASS_EXTERNAL,
              0); (* aux records *)
КОН WriteSymbolModule;

(*-----------------------------------------локальная ЗАДАЧА-------------------*)
ЗАДАЧА WriteSymbolProc(symД:ДкSymbolProc);
(* write the symbol table entry for the receiver *)
ПЕР
       nextInd,nextBf:ЦЕЛ;
УКАЗ
       nextInd:=symД.следНомСмв;
  ЕСЛИ
       nextInd # 0
  ТО
    nextBf:=nextInd+2
  ИНАЧЕ
    nextBf:=0
  КОН;
  WriteSymbol(symД.имя,
              symД.смещение,
         Coff.Код,
              20H,(* function *)
              IMAGE_SYM_CLASS_EXTERNAL,
              1); (* aux records *)
  WriteSymbolAuxProc(symД.номСмв+2,(* symbol table index of corresponding .bf entry *)
                     symД.codeSize,
                     symД.lineNumInx,(* file смещение of line number records or zero if none *)
                     nextInd);      (* index of next function definition *)
  WriteSymbol(".bf",0,Coff.Код,0H,IMAGE_SYM_CLASS_FUNCTION,1);
  WriteSymbolAuxBfEf(symД.firstLine,nextBf);
  WriteSymbol(".lf", symД.nofLineRecs,Coff.Код,0H,IMAGE_SYM_CLASS_FUNCTION,0);
  WriteSymbol(".ef", symД.codeSize,   Coff.Код,0H,IMAGE_SYM_CLASS_FUNCTION,1);
  WriteSymbolAuxBfEf(symД.lastLine,0)
КОН WriteSymbolProc;

(*~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~общедоступная ЗАДАЧА~~~~~~~~~~~~~~~~~~~~~*)
ЗАДАЧА
       WriteSymbolTable-;
(*
   All задача symbols previously defined with  are automatically
   written to the symbol table.
 *)
ПЕР
  symД:ДкSymbolName;
  str:ЦЕПЬ[НП.длинаНазвания+10];
УКАЗ
  (* fix the pointer to the symbol table in the header *)
  ФО.КодЗакрепить4(symTableFixup,ФО.КодПозиция());
  колЗаписей_в_symTable:=0;

  (* write source filename *)
  WriteSymbol(".file",0,IMAGE_SYM_DEBUG,0H,IMAGE_SYM_CLASS_FILE,
              (ДЛИНА(ФО.отдИмяФ)+17) ДЕЛИТЬ 18); (* aux records *)
  WriteSymbolAuxFileName(ФО.отдИмяФ);

  (* write code section symbol *)
  WriteSymbol(SHORT_SCTNNAME_CODE,0,Код,0H,IMAGE_SYM_CLASS_STATIC,1);
  WriteSectionAux(sctnList[Coff.Код].length,
                  sctnList[Coff.Код].nofRelocs,
                  sctnList[Coff.Код].nofLines,
                  0,0,0);

  (* write data section symbol *)
  WriteSymbol(SHORT_SCTNNAME_DATA,0,Пер,0H,IMAGE_SYM_CLASS_STATIC,1);
  WriteSectionAux(sctnList[Coff.Пер].length,
                  sctnList[Coff.Пер].nofRelocs,
                  sctnList[Coff.Пер].nofLines,
                  0,0,0);

  (* write const section symbol *)
  WriteSymbol(SHORT_SCTNNAME_CONST,0,Coff.Пост,0H,IMAGE_SYM_CLASS_STATIC,1);
  WriteSectionAux(sctnList[Coff.Пост].length,
                  sctnList[Coff.Пост].nofRelocs,
                  sctnList[Coff.Пост].nofLines,
                  0,0,0);

  ЕСЛИ НП.клОтлДанные ТО
    (* write debug types section symbol *)
    WriteSymbol(SCTNNAME_DEBUGTYPES,0,ОтлВид,0H,IMAGE_SYM_CLASS_STATIC,1);
    WriteSectionAux(sctnList[Coff.ОтлВид].length,
                    sctnList[Coff.ОтлВид].nofRelocs,
                    sctnList[Coff.ОтлВид].nofLines,
                    0,0,0);

    (* write debug symbols section symbol *)
    WriteSymbol(SCTNNAME_DEBUGSYMBOLS,0,ОтлСмв,0H,IMAGE_SYM_CLASS_STATIC,1);
    WriteSectionAux(sctnList[Coff.ОтлСмв].length,
                    sctnList[Coff.ОтлСмв].nofRelocs,
                    sctnList[Coff.ОтлСмв].nofLines,
                    0,0,0);
  КОН;
                            (* записываем символы *)
       symД:=symbolList;
  ПОКА
       symД # ПУСТО
  ВЫП
    ЕСЛИ     symД ЯВЛЯЕТСЯ ДкSymbolProc ТО
      WriteSymbolProc(symД(ДкSymbolProc))
    АЕСЛИ    symД ЯВЛЯЕТСЯ   ДкSymbolModule ТО
      WriteSymbolModule(symД(ДкSymbolModule))
    АЕСЛИ    symД ЯВЛЯЕТСЯ ДкSymbolName ТО
      WriteSymbolName(symД(ДкSymbolName))
    КОН;
    symД:=symД.next
  КОН;

  ФО.КодЗакрепить4(symTableFixup+4,колЗаписей_в_symTable);
КОН WriteSymbolTable;

(*~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~общедоступная ЗАДАЧА~~~~~~~~~~~~~~~~~~~~~*)
ЗАДАЧА
       WriteCode-(code- :РЯД ИЗ ЯЧЦЕЛ;
                  размер:ЦЕЛ);
(* write the code block and fix file pointer references *)
УКАЗ
  ФО.КодЗакрепить4(sctnList[Coff.Код].fixup,ФО.КодПозиция());
  ФО.КодПисать(code,размер)
КОН WriteCode;

(*~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~общедоступная ЗАДАЧА~~~~~~~~~~~~~~~~~~~~~*)
ЗАДАЧА
       WriteConst-(data- :РЯД ИЗ ЯЧЦЕЛ;
                   размер:ЦЕЛ);
(* write the initialized data block and fix file pointer references *)
УКАЗ
  ФО.КодЗакрепить4(sctnList[Coff.Пост].fixup,ФО.КодПозиция());
  ФО.КодПисать(data,размер);
КОН WriteConst;

(*~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~общедоступная ЗАДАЧА~~~~~~~~~~~~~~~~~~~~~*)
ЗАДАЧА
       StartDebugTypes-;
УКАЗ
  ФО.КодЗакрепить4(sctnList[Coff.ОтлВид].fixup,ФО.КодПозиция())
КОН StartDebugTypes;

(*~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~общедоступная ЗАДАЧА~~~~~~~~~~~~~~~~~~~~~*)
ЗАДАЧА
       EndDebugTypes-(дл:ЦЕЛ);
УКАЗ
  ФО.КодЗакрепить4(sctnList[Coff.ОтлВид].fixup-4,дл);
  ФО.КодРовно4
КОН EndDebugTypes;

(*~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~общедоступная ЗАДАЧА~~~~~~~~~~~~~~~~~~~~~*)
ЗАДАЧА
       StartDebugSymbols-;
УКАЗ
  ФО.КодЗакрепить4(sctnList[Coff.ОтлСмв].fixup,ФО.КодПозиция())
КОН StartDebugSymbols;

(*~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~общедоступная ЗАДАЧА~~~~~~~~~~~~~~~~~~~~~*)
ЗАДАЧА
       EndDebugSymbols-(дл:ЦЕЛ);
УКАЗ
  ФО.КодЗакрепить4(sctnList[Coff.ОтлСмв].fixup-4,дл);
  ФО.КодРовно4
КОН EndDebugSymbols;


(* ===================== Номера строк ======================================= *)


(*~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~общедоступная ЗАДАЧА~~~~~~~~~~~~~~~~~~~~~*)
ЗАДАЧА
       AddLineNum-(pc,
                   sourceLine:ЦЕЛ;
                     procHead:КЛЮЧ);
(*
 * Добовляет записи о номерах строк в начале каждой задачи при
 * входе в задачу (procHead=ВКЛ) и pc кода вступления задачи.
 * Последовательные вызовы с одинаковыми sourceLine игнорируются, за
 * исключением первого вызова.
 * Последовательные вызовы с одинаковыми pc всегда обновляют номер строки
 * до следующего значения. Данную заджачу нельзя вызывать после
 * отработки WriteCoffHeader.

   add a line number record 
   at the beginning of each задача,
   an entry with procHead=TRUE and the pc of the prolog code
   of the задача has to be added.
   Consecutive calls for an identical line number are ignored except
   for the перв call.
   Consecutive calls for an identical pc always update the line number
   to the след value.
   Must not be called any more when WriteCoffHeader has been called.
 *)
УКАЗ
  ЕСЛИ sourceLine=-1 ТО ВОЗВРАТ КОН;
  ЕСЛИ НП.клОтлДанные ТО
    ЕСЛИ procHead ИЛИ (sourceLine # lastTrueLineNr) ТО
      ЕСЛИ
           (цLineNums > 0)
         И
           (lineNumsД[цLineNums-1].line # 0)
         И
           (lineNumsД[цLineNums-1].смещение = pc)
      ТО
            lineNumsД[цLineNums-1].line:=sourceLine
      ИНАЧЕ
        ПРОВЕРИТЬ(цLineNums < MAXLINENUMS);
        ЕСЛИ procHead ТО
            lineNumsД[цLineNums].line:=0;
            procLineNrs:=1
        ИНАЧЕ
            lineNumsД[цLineNums].line:=sourceLine;
            УВЕЛИЧИТЬ(procLineNrs)
        КОН;
        lineNumsД[цLineNums].смещение:=pc;
        lineNumsД[цLineNums].symbol:=ПУСТО;
        УВЕЛИЧИТЬ(цLineNums)
      КОН
    КОН
  ИНАЧЕ
    lineNumsД[0].line:=sourceLine
  КОН;
  lastTrueLineNr:=sourceLine
КОН AddLineNum;

(*~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~общедоступная ЗАДАЧА~~~~~~~~~~~~~~~~~~~~~*)
ЗАДАЧА
       GetLineInx-():ЦЕЛ;      (* return current index of line number records *)
УКАЗ
  ВОЗВРАТ цLineNums-1;
КОН GetLineInx;

(*-----------------------------------------локальная ЗАДАЧА-------------------*)
ЗАДАЧА CreateLineNumTableReferences;
(*
   Create the references from the line number records to the symbol table
 *)
ПЕР
         symД:ДкSymbolName;
УКАЗ
  ЕСЛИ
       НП.клОтлДанные
  ТО
         symД:=symbolList;
    ПОКА
         symД # ПУСТО
    ВЫП
      ЕСЛИ
         symД ЯВЛЯЕТСЯ ДкSymbolProc
      ТО                                                 (* преобразование
                            symД                к виду
                                 ДкSymbolProc                                 *)
        ПРОВЕРИТЬ(lineNumsД[symД(ДкSymbolProc).lineNumInx].line = 0);

        lineNumsД[symД(ДкSymbolProc).lineNumInx].смещение:=symД(ДкSymbolProc).номСмв;
        lineNumsД[symД(ДкSymbolProc).lineNumInx].symbol  :=symД(ДкSymbolProc);
      КОН;
         symД:=symД.next
    КОН
  КОН
КОН CreateLineNumTableReferences;

(*~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~общедоступная ЗАДАЧА~~~~~~~~~~~~~~~~~~~~~*)
ЗАДАЧА
       WriteLineNumberTable-;
(*
   write the line number info to the object file
   Line number references to the symbol table are set here and file pointer info
   is prepared here, therefore the line number records need to be written before
   the symbol table.
   After this задача has been called no more line numbers may be added with AddLineNum.
 *)
ПЕР
  i:ЦЕЛ;
  procStart:ЦЕЛ;
  symД:ДкSymbolName;
УКАЗ
  ЕСЛИ НП.клОтлДанные ТО
    ФО.КодЗакрепить4(sctnList[Coff.Код].fixup+8,ФО.КодПозиция());
    CreateLineNumTableReferences;
    procStart:=0;
    i:=0;
    ПОКА i < цLineNums ВЫП
      ЕСЛИ lineNumsД[i].line = 0 ТО (* заголовок задачи *)
        ПРОВЕРИТЬ(lineNumsД[i].symbol # ПУСТО);
        lineNumsД[i].symbol.lineNumInx:=ФО.КодПозиция();
        procStart:=lineNumsД[i].symbol.firstLine;
        ФО.КодЦел4(lineNumsД[i].смещение);
        ФО.КодЦел2(0)
      ИНАЧЕ (* адрес кода и номер строки относительно начала задачи *)
        ФО.КодЦел4(lineNumsД[i].смещение);
        ФО.КодЦел2(lineNumsД[i].line-procStart)
      КОН;
      УВЕЛИЧИТЬ(i)
    КОН;
  ИНАЧЕ
           symД:=symbolList; (* set all indices to line number table to zero to indicate that there is none *)
    ПОКА
           symД # ПУСТО
    ВЫП
      ЕСЛИ
           symД ЯВЛЯЕТСЯ ДкSymbolProc
      ТО                                                 (* преобразование
                    symД                к виду
                         ДкSymbolProc                                         *)
                    symД(ДкSymbolProc).lineNumInx:=0
      КОН;
           symД:=symД.next;
    КОН;
  КОН;
КОН WriteLineNumberTable;


(*=================== Скрепки ================================================*)


(*~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~общедоступная ЗАДАЧА~~~~~~~~~~~~~~~~~~~~~*)
ЗАДАЧА
       СоздатьСкр-(секция,
                      вид,ном,адр:ЦЕЛ
                  );
(* Цель:  закрепляет в Coff секции <секция> адрес <адр> относительно
 *        начала области вида <вид> у отдела с номером <ном> *)
ПЕР
          скрепкаД:ДкСкрепке;
УКАЗ
  ЕСЛИ
          вид В {СКР_КОД,СКР_ПОСТ,СКР_ПЕР}
  ТО
    ЕСЛИ
         ВД.рПонВхОтд[ном].адр = 0
    ТО
      AddSymbolModule(ВД.рПонВхОтд[ном],ном)
    КОН;
    ном:=ВД.рПонВхОтд[ном].адр
  КОН;
  ВЫБРАТЬ вид ИЗ
  | СКР_КОД:
      УВЕЛИЧИТЬ(ном,0);
      вид:=IMAGE_REL_I386_DIR32
  | СКР_ПЕР:
      УВЕЛИЧИТЬ(ном,1);
      вид:=IMAGE_REL_I386_DIR32
  | СКР_ПОСТ:
      УВЕЛИЧИТЬ(ном,2);
      вид:=IMAGE_REL_I386_DIR32
  | СКР_ОТНОС:
      вид:=IMAGE_REL_I386_REL32
  | СКР_ТОЧНО:
      вид:=IMAGE_REL_I386_DIR32
  | СКР_ФАЙЛ:
      вид:=IMAGE_REL_I386_DIR32NB
  | СКР_ОТНСЕКЦ:
      вид:=IMAGE_REL_I386_SECREL
  | СКР_СЕКЦИЯ:
      вид:=IMAGE_REL_I386_SECTION
  КОН;
  СОЗДАТЬ(скрепкаД);
          скрепкаД.вид :=вид;
          скрепкаД.ном :=ном;
          скрепкаД.адр :=адр;
          скрепкаД.слеД:=sctnList[секция].скрепкаД;
                         sctnList[секция].скрепкаД:=скрепкаД
КОН СоздатьСкр;

(*~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~общедоступная ЗАДАЧА~~~~~~~~~~~~~~~~~~~~~*)
ЗАДАЧА
       ЗаписьСкр-(секция:ЦЕЛ);
ПЕР
       скрепкаД :ДкСкрепке;
    relocsStart,
      nofRelocs,
          fixup :ЦЕЛ;
УКАЗ
  nofRelocs:=0;
  relocsStart:=ФО.КодПозиция();
       скрепкаД:=sctnList[секция].скрепкаД;
  ПОКА
       скрепкаД # ПУСТО
  ВЫП
    ФО.КодЦел4(скрепкаД.адр);
    ФО.КодЦел4(скрепкаД.ном);
    ФО.КодЦел2(скрепкаД.вид);
    УВЕЛИЧИТЬ(nofRelocs);
       скрепкаД:=скрепкаД.слеД
  КОН;
  fixup:=sctnList[секция].fixup;
    ФО.КодЗакрепить4(fixup+ 4,relocsStart);
    ФО.КодЗакрепить2(fixup+12,nofRelocs);
  sctnList[секция].nofRelocs:=nofRelocs
КОН ЗаписьСкр;

(*~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~общедоступная ЗАДАЧА~~~~~~~~~~~~~~~~~~~~~*)
ЗАДАЧА
       Подготовить-;   (* Initialize all tables prior to each compilation run *)
ПЕР
  i:ЦЕЛ;
УКАЗ
  symbolList:=ПУСТО;
  lastSymbol:=ПУСТО;
  lastSymbolProc:=ПУСТО;
  ЕСЛИ НП.клОтлДанные ТО
    nofSections:=5
  ИНАЧЕ
    nofSections:=3
  КОН;
  номСмв:=1+((ДЛИНА(ФО.отдИмяФ)+17) ДЕЛИТЬ 18)+2*nofSections;
  i:=1;
  ПОКА i <= nofSections ВЫП
    sctnList[i].length:=0;
    sctnList[i].nofRelocs:=0;
    sctnList[i].nofLines:=0;
    sctnList[i].скрепкаД:=ПУСТО;
    УВЕЛИЧИТЬ(i)
  КОН;
  
  СОЗДАТЬ(lineNumsД);        (* доступ к ряду строк отдела *)
  цLineNums:=0;
  lastTrueLineNr:=-1;
  procLineNrs:=0;
  stringLen:=0;
  AddSymbolName("GlIP",           Coff.rtsGlIP,ОТКЛ);
  AddSymbolName("GlBP",           Coff.rtsGlBP,ОТКЛ);
  AddSymbolName("Stop",           Coff.rtsStop,ВКЛ);
  AddSymbolName("CelChast",       Coff.rtsCelChast,ВКЛ);
  AddSymbolName("Umnojenie64",    Coff.rtsLMulInx,ВКЛ);
  AddSymbolName("Delenie64",      Coff.rtsLDivModInx,ВКЛ);
  AddSymbolName("Sdvig64",        Coff.rtsLAshInx,ВКЛ);
  AddSymbolName("SRJEDA_Sozdate", Coff.rtsNewInx,ВКЛ);
  AddSymbolName("SRJEDA_Lovushka",Coff.rtsHaltInx,ВКЛ)
КОН Подготовить;


(*~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~общедоступная ЗАДАЧА~~~~~~~~~~~~~~~~~~~~~*)
ЗАДАЧА
       Завершить-;
ПЕР
  i:ЦЕЛ;
УКАЗ
  symbolList:=ПУСТО;
  lastSymbol:=ПУСТО;
  lastSymbolProc:=ПУСТО;
  lineNumsД:=ПУСТО;

       i:=1;
  ПОКА
       i <= nofSections
  ВЫП
    sctnList[i].скрепкаД:=ПУСТО;
    УВЕЛИЧИТЬ(i)
  КОН
КОН Завершить;

КОН Coff.
