 
 
 
    
    
    
    
    
    
    
            Утвержден 
    
            2б.00152-01 97 09-1-ЛУ
    
    
    
    
    
    
    
    
    
    
    
    
    
    
    
                          Операционная система МОС ВП 
    
                        Подсистема разработки программ
    
                   РУКОВОДСТВО ПО ПРОГРАМИРОВАННИЮ В СИСТЕМЕ
    
                              Справочный материал 
    
                             2б.00152-01 97 09-3
    
                                 Листов 162/4К
    
    
    
    
    
    
    
    
    
    
    
    
    
    
    
    
    
    

    
    
    
    
                                     1987 
    
               Перв. примен.                            Литера O
               2б.00152-01
    
 

 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
                      Операционная система МОС ВП
 
                    Подсистема разработки программ
 
               РУКОВОДСТВО ПО ПРОГРАММИРОВАНИЮ В СИСТЕМЕ
 
                          Справочный материал
 
                           00152-01 97 09-3
 
                              Листов 158
 
 
                              
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
                                           
 
                                 1987
 
 
 
 

                                - 2 -
 
                          00152-01 97 09-3
 
 
 
 
 
 
                              СОДЕРЖАНИЕ
 
 
 
 
 
      1.  Файловый ввод-вывод                                 5
 
      1.1.  Операции с файлом                                 7
 
      1.1.1.  Атрибуты файла                                  7
 
      1.1.1.1.  Номер логического устройства                  7
 
      1.1.1.2.  Имя файла                                     8
 
      1.1.1.3.  Организация файла и доступ к нему             9
 
      1.1.1.4.  Структура записи                              11
 
      1.1.1.5.  Файловый ввод-вывод                           12
 
      1.1.1.6.  Состояние и диспозиция файла                  13
 
      1.1.1.7.  Защита и доступ                               14
 
      1.1.1.8.  Отводимая дисковая память                     17
 
      1.1.2.  Открытие файлов                                 18
 
      1.1.3.  Выбор ключевых слов для операторов ввода-вывода 20
 
      1.1.4.  Позиционирование на начало файла                24
 
      1.1.5.  Получение характеристик файла                   25
 
      1.1.6.  Закрытие файла                                  26
 
      1.2.  Загрузка и выгрузка базы данных                   27
 
      1.2.1.  Ввод-вывод операторами языка ФОРТРАН            28
 
      1.2.2.  Процедура SYS$CRMPSC                            32
 
      1.2.2.1.  Отображение файла                             34
 
      1.2.2.2.  Открытие файла в режиме пользователя          39
 
      1.2.2.3.  Инициализация отображенной базы данных        41
 
      1.2.2.4.  Сохранение отображенного файла                42
 
      1.3.  Обработка записей базы данных целиком             44
 
      1.3.1.  Создание последовательного файла                44


                                - 3 -
 
                          00152-01 97 09-3
 
 
 
      1.3.2.  Обновление последовательного файла              46
 
      1.3.3.  Сортировка и слияние последовательных файлов    49
 
      1.3.3.1.  Передача ключевой информации                  50
 
      1.3.3.2.  Сортировка файловым интерфейсом               50
 
      1.3.3.3.  Сортировка с интерфейсом по записи            53
 
      1.3.3.4.  Слияние файловым интерфейсом                  57
 
      1.3.3.5.  Слияние с интерфейсом по записи               59
 
      1.4.  Обработка базы данных по частям                   67
 
      1.4.1.  Создание индексированного файла                 68
 
      1.4.2.  Запись в индексированный файл                   70
 
      1.4.3.  Прямой доступ к записи                          73
 
      1.4.4.  Индексно-последовательный метод доступа         77
 
      1.4.5.  Доступ к записям по набору ключей               81
 
      1.4.6.  Обновление записи в индексированном файле       88
 
      1.4.7.  Удаление записи из индексного файла             90
 
      1.4.8.  Обработка совпадающих ключей                    92
 
      1.5.  Упаковка и распаковка данных                      94
 
      1.5.1.  Процедуры упаковки                              94
 
      1.5.2.  Процедуры распаковки                            105
 
      1.6.  Процедуры работы с библиотеками                   111
 
      1.6.1.  Создание, открытие и закрытие библиотек         113
 
      1.6.2.  Добавление модулей                              120
 
      1.6.3.  Удаление модулей                                124
 
      1.6.4.  Извлечение модулей                              126
 
      1.6.5.  Использование нескольких ключей и индексов      129
 
      1.6.6.  Доступ к заголовкам модулей                     134
 
      1.6.7.  Чтение заголовков библиотек                     138
 
      1.6.8.  Вывод на экран справочного текста               140
 
      1.6.9.  Обработка об'ектов из индекса                   143
 


                                - 4 -
 
                          00152-01 97 09-3
 
 
      1.7.  Язык определения файлов                           145
 
      1.7.1.  Создание файла FDL                              146
 
      1.7.1.1.  Использование редактора FDL                   146
 
      1.7.1.2.  Использование   характеристик    существующего
 
                файла данных                                  147
 
      1.7.2.  Приложение файла FDL к файлу данных             149
 
      1.7.2.1.  Создание нового файла данных                  150
 
      1.7.2.2.  Модификация существующего файла данных        151
 
      1.8.  Пользовательские процедуры открытия               152
 
      1.8.1.  Спецификатор USEROPEN                           153
 
      1.8.2.  Написание пользовательской процедуры открытия   154
 
      1.8.3.  Установка полей FAB и RAB                       155
 
 
 
      Перечень ссылочных документов                           158
 
 
 
 
 
 
 
 
 
 
 
 
 


                                - 4K -
 
                          2б.00152-01 97 09-3
 
 
      1.7.  Язык определения файлов                           145
 
      1.7.1.  Создание файла FDL                              146
 
      1.7.1.1.  Использование редактора FDL                   146
 
      1.7.1.2.  Использование   характеристик    существующего
 
                файла данных                                  147
 
      1.7.2.  Приложение файла FDL к файлу данных             149
 
      1.7.2.1.  Создание нового файла данных                  150
 
      1.7.2.2.  Модификация существующего файла данных        151
 
      1.8.  Пользовательские процедуры открытия               152
 
      1.8.1.  Спецификатор USEROPEN                           153
 
      1.8.2.  Написание пользовательской процедуры открытия   154
 
      1.8.3.  Установка полей FAB и RAB                       155
 
 
 
      Перечень ссылочных документов                           158К
 
 
 
 
 
 
 
 
 
 
 
 
 
 

                                - 5 -
 
                          00152-01 97 09-3
       
 
                        1. Файловый ввод-вывод
 
 
 
           Операторы ввода-вывода языка программирования  ФОРТРАН
 
      (в дальнейшем - язык ФОРТРАН) обслуживают запросы на  пере-
 
      мещение данных между файлами  и  программными  переменными.
 
      Оператором ввода-вывода указывается операция  для  выполне-
 
      ния;  список  управления  вводом-выводом  указывает   файл,
 
      запись и атрибуты  формата;  список  ввода-вывода  содержит
 
      переменные, над которыми должна быть произведена операция.
 
           Может произойти некоторая терминологическая путаница с
 
      записями файла и  записями-переменными.  В  данном  разделе
 
      слово "запись" будет относиться к записи в файле,  а  пере-
 
      менная типа "запись" будет называться записью-переменной.
 
           Перед написанием программы,  имеющей  доступ  к  файлу
 
      данных, необходимо иметь следующую информацию:
 
           1) атрибуты файла  (организация,  структура  записи  и
 
      т.д.), которые определяют способ хранения данных и  доступа
 
      к ним. Обычно атрибуты  задаются  ключевыми  словами  языка
 
      ФОРТРАН при открытии файла данных;
 
           2) расположение данных в файле, что с технической точ-
 
      ки зрения не важно. Однако, если читать данные, не зная  их
 
      расположения в файле, то весьма вероятно, что будут  прочи-
 
      таны не те данные; если писать в файл, не зная его структу-
 
      ры, то существует риск испортить имеющиеся в нем данные.
 
           При определении атрибутов файла и  порядка  размещения
 
      данных в нем необходимо принимать во внимание способ досту-
 
      па к данным. Стратегии доступа к файлу  данных  могут  быть
 
      следующими:
 
           1) обработка целиком. Если программа обрабатывает  все
 
      или большую часть данных  файла,  и,  если  на  эти  данные


                                - 6 -
 
                          00152-01 97 09-3
 
 
      делается много ссылок, то следует файл целиком прочитать  в
 
      память; каждую запись поместить в отведенную для нее  пере-
 
      менную или набор переменных.
 
           Если программа при этом получается больше, чем доступ-
 
      ный об'ем памяти (включая дополнительную память, полученную
 
      с помощью LIB$GET_VM), то придется описывать меньшее  коли-
 
      чество переменных и обрабатывать файл по частям. Для  опре-
 
      деления величины программы нужно  сложить  число  байтов  в
 
      каждой секции PSECT (по команде LINK/MAP генерируется  лис-
 
      тинг, включающий длину каждой PSECT);
 
           2) запись  за  записью.  Если  программа  обрабатывает
 
      записи файла одну за другой или файл не помещается в  памя-
 
      ти, то следует читать записи в память по одной  за  обраще-
 
      ние;
 
           3)  отдельные  записи.  Если  программа   обрабатывает
 
      небольшое число записей файла, то следует читать  в  память
 
      только необходимые записи.
 
           Для скорости работы и экономии места на диске  исполь-
 
      зуются неформатные последовательные  файлы.  Для  обработки
 
      выбираемых наборов записей или получения прямого доступа  к
 
      записям используются файлы индексной организации. Для орга-
 
      низации прямого доступа используются последовательные файлы
 
      с записями фиксированной  длины,  относительные  файлы  или
 
      файлы с индексной организацией.
 


                                - 7 -
 
                          00152-01 97 09-3
 
 
           1.1. Операции с файлом
 
 
           Для доступа к файлу необходимо открыть его явно, после
 
      этого можно выполнять операции чтения  и/или  записи.  Если
 
      оператор OPEN будет опущен, то  файл  будет  открыт  неявно
 
      первой операцией READ или WRITE с использованием подходящих
 
      значений по умолчанию. Закончив работу с файлом, можно зак-
 
      рыть его явно или предоставить возможность сделать это сис-
 
      теме при прекращении работы программы.
 
 
 
           1.1.1. Атрибуты файла
 
 
           Когда создается или открывается файл, требуется  зада-
 
      ние номера логического устройства. Можно  задать  и  другие
 
      атрибуты, например, имя файла, организацию файла и структу-
 
      ру записи.
 
           Более широкий  набор  атрибутов  может  быть  задан  с
 
      помощью языка определения файлов (FDL). Все атрибуты  файла
 
      могут быть заданы  с  помощью  системы  управления  данными
 
      СУД-32 (в дальнейшем - СУД-32) в открытой для  пользователя
 
      процедуре. FDL имеет смысл использовать тогда, когда специ-
 
      фикаторы языка ФОРТРАН недоступны. Если недоступны как спе-
 
      цификаторы языка ФОРТРАН, так и FDL, используется  открытая
 
      для пользователя процедура.
 
 
 
           1.1.1.1. Номер логического устройства
 
 
           Номер  логического  устройства  есть  целое  значение,
 
      идентифицирующее файл для  программы.  Файл  связывается  с
 
      номером логического устройства оператором OPEN. После этого
 
      на файл ссылаются по  номеру  логического  устройства.  Для
 


                                - 8 -
 
                          00152-01 97 09-3
 
 
      задания номера логического  устройства  в  операторе  OPEN,
 
      READ, WRITE, DELETE или REWRITE  используется  спецификатор
 
      UNIT или задается номер логического устройства первым пара-
 
      метром соответствующего оператора.
 
           Если над программой  работает  несколько  человек,  то
 
      следует генерировать номер логического устройства с помощью
 
      библиотечной процедуры LIB$GET_LUN. Эта  процедура  возвра-
 
      щает номер логического устройства, не  повторяющийся  среди
 
      других  таких  номеров;  процедура  LIB$GET_LUN  эффективна
 
      только тогда, когда она используется для генерации  номеров
 
      всех логических устройств в программе.
 
 
 
           1.1.1.2. Имя файла
 
 
           Для задания имени файла в операторе OPEN  используется
 
      спецификатор FILE. Имя файла может быть  любой  разрешенной
 
      спецификацией файла или устройства, или логическим  именем.
 
      Если  имя  файла  опущено,  то   будет   использовано   имя
 
      FORNN.DAT, где NN - номер логического устройства.  Специфи-
 
      катор DEFAULTFILE может быть  использован  для  подстановки
 
      принятых по умолчанию устройства, каталога  и  типа  файла.
 
      Если DEFAULTFILE будет опущен, то будет  использовано  уст-
 
      ройство и каталог, установленные по умолчанию  для  прогона
 
      программы; тип файла будет DAT.
 


                                - 9 -
 
                          00152-01 97 09-3
 
 
           1.1.1.3. Организация файла и доступ к нему
 
 
           Организация файла - это организация записей в файле. В
 
      языке ФОРТРАН разрешено три вида организации файла:
 
           1) последовательная. Записи располагаются одна за дру-
 
      гой в том порядке,  в  котором  они  записывались  в  файл.
 
      Добавлять новые записи можно только в конец файла. Доступ к
 
      записям последовательный. Если все записи имеют фиксирован-
 
      ную длину, то к ним возможен и прямой доступ;
 
           2) относительная. Записи размещены в элементах внешней
 
      памяти фиксированной длины. Эти клетки перенумерованы от  1
 
      до N, начиная с первой записи файла. Запись можно поместить
 
      в любой элемент или удалить из него.  Слежение  за  номером
 
      каждой записи возлагается на программу.  Доступ  к  записям
 
      последовательный или прямой;
 
           3) индексная. Записи располагаются  согласно  ключевым
 
      полям. Каждая запись должна иметь хотя  бы  один  ключ,  но
 
      может и больше. Длина ключа и его положение  внутри  записи
 
      должны быть одинаковыми для всех записей в файле с  индекс-
 
      ной организацией.  Для  идентификации  записи  используется
 
      значение, стоящее в поле ключа. Доступ к записям может быть
 
      последовательный или по ключу.
 
           Организация     файла     задается      спецификатором
 
      ORGANIZATION, который может принимать  значения  SEQUENTIAL
 
      (по умолчанию), INDEXED или RELATIVE. Если создается файл с
 
      относительной или индексной организацией,  то  должен  быть
 
      использован спецификатор RECL для задания длины записи фай-
 
      ла.
 
           Доступ к файлу - это способ  доступа  к  его  записям.
 
      Язык ФОРТРАН предоставляет три способа доступа:
 


                                - 10 -
 
                          00152-01 97 09-3
 
 
           1) последовательный. Доступ к записям  предоставляется
 
      последовательно, по порядку их записи в файл.  Для  относи-
 
      тельных файлов доступ будет в  порядке  номеров  элементов,
 
      содержащих записи. Для файлов с индексной организацией дос-
 
      туп предоставляется по преобладающему значению ключа;  если
 
      у двух записей ключи совпадают, то доступ предоставляется в
 
      порядке записи в файл;
 
           2) прямой. Доступ  непосредственно  к  записи.  Запись
 
      задается спецификатором REC в операторах READ и WRITE;
 
           3) по ключу. Доступ к записям осуществляется  согласно
 
      значению ключа. Запись  задается  включением  спецификатора
 
      KEY в оператор READ. Можно сочетать доступ по ключу и  пос-
 
      ледовательный доступ к одному и тому же файлу.
 
           Доступ к  файлу  определяется  спецификатором  ACCESS,
 
      который может принимать значения SEQUENTIAL (по умолчанию),
 
      KEYED, DIRECT или APPEND. APPEND означает  последовательный
 
      доступ и, кроме того, позиционирует  в  конец  файла  после
 
      открытия.
 
           В табл. 1 приводятся режимы доступа,  разрешенные  для
 
      каждого вида организации файла.
 
                                                        Таблица 1
 
      -----------------------------------------------------------
                        !
                        !        Тип доступа
        Организация     !
                        !---------------------------------------
                        !                !          !
                        !Последовательный!  Прямой  !  По ключу
                        !                !          !
       -----------------!----------------!----------!-----------
                        !                !          !
       Последовательная !      да        !   да     !   нет
                        !                !          !
       Относительная    !      да        !   да     !   нет
                        !                !          !
       Индексная        !      да        !   нет    !   да
 
           Примечание. Прямой тип  доступа  при  последовательной


                                - 11 -
 
                          00152-01 97 09-3
 
 
      организации возможен для файлов  с  записями  фиксированной
 
      длины.
 
 
 
           1.1.1.4. Структура записи
 
 
           Структура записи определяет формат расположения данных
 
      в файле. В языке ФОРТРАН разрешены три структуры записи:
 
           1) фиксированной длины. Все записи одного файла  имеют
 
      одинаковую длину, которая задается спецификатором RECL;
 
           2) переменной длины. Записи одного  файла  различаются
 
      по длине в зависимости от содержания. Для получения доступа
 
      к записям переменной длины файла с последовательной органи-
 
      зацией при открытии этого  файла  для  неформатного  ввода-
 
      вывода следует задавать RECORDTYPE='VARIABLE'. В  противном
 
      случае эти записи считаются сегментированными, а первые два
 
      байта - управляющей информацией;
 
           3) сегментированные. Каждая логическая запись файла  с
 
      последовательной организацией состоит из одной или несколь-
 
      ких записей переменной длины. Первые два байта каждой запи-
 
      си содержат управляющую информацию,  указывающую,  является
 
      ли конкретная запись переменной длины первым сегментом сег-
 
      ментированной  записи,  последним  сегментом,  единственным
 
      сегментом или средним сегментом.
 
           Сегментированные записи представляют  собой  специфику
 
      языка ФОРТРАН. Если файл может в дальнейшем  использоваться
 
      программой, написанной не на языке  ФОРТРАН,  то  лучше  не
 
      пользоваться сегментированными записями.
 
           Структура  записи  файла  задается   ключевым   словом
 
      RECORDTYPE в операторе OPEN; ключ может принимать значения:
 
      FIXED, VARIABLE или SEGMENTED. В табл.  2  показано,  какая
 


                                - 12 -
 
                          00152-01 97 09-3
 
 
      структура записи разрешается для различных организаций фай-
 
      ла.
 
                                                        Таблица 2
 
       ----------------------------------------------------------
                       !
      Организация      !   Структура записи
                       !
                       !-----------------------------------------
                       !             !          !
                       !Фиксированная!Переменная!Сегментированная
                       !             !          !
      -----------------!-------------!----------!----------------
                       !
      Последовательная !    да       !   да     !     да
                       !             !          !
      Относительная    !    да       !   да     !     нет
                       !             !          !
      Индексная        !    да       !   да     !     нет
 
 
           Примечание. Сегментированная структура записи допусти-
 
      ма только для файлов с последовательной организацией.
 
 
 
           1.1.1.5. Файловый ввод-вывод
 
 
           Данные из файла могут читаться с помощью операций фор-
 
      матного или неформатного  ввода-вывода.  Неформатный  ввод-
 
      вывод не совершает никаких преобразований  над  данными,  а
 
      передает их точно в том виде, в каком они хранятся в  памя-
 
      ти. О таких данных говорят, что они представлены  в  двоич-
 
      ной, или машино-читаемой форме. Файлы, записанные с  приме-
 
      нением неформатного вывода, быстрее обрабатываются и  зани-
 
      мают меньше места, но командой TYPE их распечатать  нельзя.
 
      Неформатные файлы следует использовать в тех случаях, когда
 
      с ними будут работать только программы  преобразования,  но
 
      не прямой печати.
 
           Форматные операции ввода-вывода преобразуют данные  из
 
      двоичного формата в символьный при операции  записи,  и  из
 
      символьного вида в двоичный при операции чтения.  Форматный


                                - 13 -
 
                          00152-01 97 09-3
 
 
      вывод следует использовать в тех случаях, когда может  воз-
 
      никнуть необходимость посмотреть файл без помощи программы,
 
      которой известна структура этого файла. При выполнении фор-
 
      матного ввода-вывода необходимо включать спецификаторы фор-
 
      мата в операторы READ и WRITE.
 
           Формат файла  задается  спецификатором  FORM,  который
 
      может принимать значения FORMATTED и UNFORMATTED. Если файл
 
      открыт на последовательный доступ, то по умолчанию специфи-
 
      катор FORM получает значение FORMATTED; если файл открыт на
 
      прямой доступ или доступ по ключу, то спецификатор получает
 
      значение UNFORMATTED. Для доступа к записям переменной дли-
 
      ны в последовательном файле с  использованием  неформатного
 
      ввода-вывода следует при открытии файла задать RECORDTYPE =
 
      'VARIABLE'.
 
 
 
           1.1.1.6. Состояние и диспозиция файла
 
 
           Состояние файла задается спецификатором STATUS,  кото-
 
      рый может принимать одно из следующих значений:
 
           1) OLD - открытие существующего файла.  Если  файл  не
 
      существует, сообщается об ошибке;
 
           2) NEW - создание нового файла. Если файл уже  сущест-
 
      вует, создается новая версия;
 
           3) UNKNOWN - открытие  существующего  файла,  если  он
 
      есть, если же его нет, создание нового файла;
 
           4) SCRATCH - создается новый файл, который уничтожает-
 
      ся при закрытии.
 
           По умолчанию файл  после  закрытия  сохраняется.  Если
 
      необходимо поступить с файлом иначе,  то  можно  воспользо-
 
      ваться спецификатором DISPOSE. Этот спецификатор может при-
 


                                - 14 -
 
                          00152-01 97 09-3
 
 
      нимать одно из следующих  значений:  кеер  (то  же,  что  и
 
      SAVE  -  умолчание),  DELETE,  PRINT/DELETE,   SUBMIT   или
 
      SUBMIT/DELETE. Файл, открытый как временный  (SCRATCH),  не
 
      может иметь никакой другой диспозиции. Файл, открытый толь-
 
      ко на чтение, не может быть уничтожен.
 
           Спецификатор DISPOSE может быть включен как в оператор
 
      OPEN, так и в оператор CLOSE. Если же он включен в оба  эти
 
      оператора для одного и того же файла, то диспозиция, задан-
 
      ная в операторе CLOSE, имеет преимущество.
 
 
 
           1.1.1.7. Защита и доступ
 
 
           Файлы принадлежат процессу, который их создает и полу-
 
      чает защиту по умолчанию  создающего  процесса.  Для  того,
 
      чтобы создать файл с защитой и  принадлежностью,  отличными
 
      от принятых по  умолчанию,  следует  использовать  атрибуты
 
      OWNER и PROTECTION в файловой секции файла FDL.
 
           По умолчанию пользователь программы должен иметь  дос-
 
      туп на запись (WRITE) к файлу, чтобы программа  могла  этот
 
      файл открыть. Если при открытии файла  указан  спецификатор
 
      READONLY, то для открытия файла достаточно иметь доступ  на
 
      чтение (READ). Задание  READONLY  не  устанавливает  нового
 
      кода защиты файла. Писать в файл, открытый со  спецификато-
 
      ром READONLY, нельзя.
 
           Спецификаторы READONLY и SHARED  позволяют  нескольким
 
      процессам одновременно открывать один и тот же  файл,  если
 
      каждый процесс при открытии файла использует один  из  этих
 
      спецификаторов. Спецификатор  READONLY  разрешает  процессу
 
      доступ к файлу на чтение; спецификатор SHARED  дает  другим
 
      процессам доступ к файлу на чтение и на запись.  Если  про-
 


                                - 15 -
 
                          00152-01 97 09-3
 
 
      цесс открывает файл без спецификаторов READONLY или SHARED,
 
      то никакой другой процесс не может открыть этот  файл  даже
 
      при использовании спецификаторов READONLY или SHARED.
 
           Если доступ к файлу осуществляется в разделяемом режи-
 
      ме, то операция чтения или операция записи в прямом доступе
 
      могут вернуть состояние  FOR$_SPERECLOC,  указывающее,  что
 
      нужная запись в настоящий момент используется  другим  про-
 
      цессом. В серьезных программах  следует  включать  проверку
 
      кода условия, предусматривающего такую возможность.
 
           Пример.
 
           В программном сегменте операция чтения  сообщает,  что
 
      запись блокирована; в таком случае операция повторяется. Не
 
      следует пытаться читать блокированную запись  без  задержки
 
      (в нашем примере - вызов ERRSNS), чтобы дать возможность  и
 
      время другому  процессу  закончить  операцию  и  освободить
 
      (деблокировать) запись:
 
      !переменная и значения состояния
 
      INTEGER STATUS,
 
      2      IOSTAT,
 
      2      IO_OK
 
      PARAMETER (IO_OK = 0)
 
      INCLUDE '($FORDEF)'
 
      !номер логического устройства
 
      INTEGER LUN /1/
 
      !переменные для записей
 
      INTEGER LEN
 
      CHARACTER*80 RECORD
 
      !продолжение программы
 
      READ (UNIT = LUN,
 
      2    FMT = '(Q,A)',


                                - 16 -
 
                          00152-01 97 09-3
 
 
      2    IOSTAT = IOSTAT) LEN, RECORD(1:LEN)
 
      IF (IOSTAT .NE. IO_OK) THEN
 
        CALL ERRSNS (,,,,STATUS)
 
        IF (STATUS .EQ. FOR$_SPERECLOC) THEN
 
          DO WHILE (STATUS .EQ. FOR$_SPERECLOC)
 
           READ (UNIT = LUN,
 
      2          FMT ='(Q,A)',
 
      2          IOSTAT = IOSTAT) LEN, RECORD(1:LEN)
 
        IF (IOSTAT .NE. IO_OK) THEN
 
         CALL ERRSNS (,,,,STATUS)
 
          IF (STATUS .NE. FOR$_SPERECLOC) THEN
 
           CALL LIB$SIGNAL (%VAL(STATUS))
 
          END IF
 
        END IF
 
       END DO
 
      ELSE
 
         CALL LIB$SIGNAL (%VAL(STATUS))
 
       END IF
 
      END IF
 
      !продолжение программы
 
           При каждом доступе к  записи  разделяемого  файла  эта
 
      запись автоматически блокируется до тех пор, пока не  будет
 
      выполнена другая операция ввода-вывода на том же логическом
 
      устройстве или не  будет  явного  деблокирования  записи  с
 
      помощью оператора UNLOCK.
 


                                - 17 -
 
                          00152-01 97 09-3
 
 
           1.1.1.8. Отводимая дисковая память
 
 
           При открытиии файла можно задать следующие  требования
 
      к дисковой памяти:
 
           1) первоначальный  размер  файла.  Для  задания  этого
 
      параметра используется спецификатор INITIALSIZE. Если  этот
 
      спецификатор будет опущен или будет иметь  значение  0,  то
 
      предварительное отведение  памяти  на  диске  под  файл  не
 
      выполняется;
 
           2) число блоков, добавляющихся при  каждом  расширении
 
      файла. Файл расширяется каждый раз,  когда  отведенный  для
 
      него участок дисковой памяти исчерпан. Для указания величи-
 
      ны, на которую он должен расширяться, используется специфи-
 
      катор EXTENDSIZE. Если этот спецификатор опущен  или  равен
 
      нулю, то  будет  использоваться  для  расширения  системное
 
      умолчание для устройства, содержащего файл;
 
           3) число байтов, передаваемое при каждой операции вво-
 
      да-вывода. Для задания числа байтов, передающихся при  каж-
 
      дой  операции   ввода-вывода,   используется   спецификатор
 
      BLOCKSIZE. По умолчанию для последовательных файлов исполь-
 
      зуется   размер   буфера,   заданный   командой   DCL   SET
 
      RMS_DEFAULT. Для  относительных  и  индексированных  файлов
 
      используется  наименьшее  число  байтов,  в  которые  может
 
      поместиться отдельная запись;
 
           4) число буферов памяти, которые должны будут  исполь-
 
      зоваться для операции ввода-вывода. Для задания числа буфе-
 
      ров используется  спецификатор  BUFFERCOUNT.  По  умолчанию
 
      использует  число  буферов,  заданное  командой   DCL   SET
 
      RMS_DEFAULT. Размер каждого буфера определен спецификатором
 
      BLOCKSIZE.
 


                                - 18 -
 
                          00152-01 97 09-3
 
 
           1.1.2. Открытие файлов
 
 
           Оператор OPEN открывает файл явно.
 
           Для создания нового файла используется  оператор  OPEN
 
      со значением NEW для  спецификатора  STATUS.  При  открытии
 
      существующего файла используется оператор OPEN со значением
 
      OLD спецификатора STATUS.
 
           Пример.
 
           Создание нового файла, имя  которого  запрашивается  с
 
      терминала. Если пользователь не укажет устройство или ката-
 
      лог,   то   будут   использованы   умолчания   WORKDISK   и
 
      [PERSONNEL]:
 
      INTEGER*4 LUN /1/
 
      CHARACTER*256 FILENAME
 
      INTEGER*2 FN_SIZE
 
      INTEGER STATUS
 
      ! принять имя файла
 
      STATUS = LIB$GET_INPUT (FILENAME,
 
      2                      'имя файла: ',
 
      2                       FN_SIZE)
 
      IF (.NOT. STATUS) CALL LIB$SIGNAL (%VAL (STATUS))
 
      !создать файл
 
      OPEN (UNIT=LUN,
 
      2     FILE=FILENAME (1:FN_SIZE),
 
      2     DEFAULTFILE='WORKDISK:[PERSONNEL]',
 
      2     FORM='UNFORMATTED',
 
      2     STATUS='NEW')
 
 
           Открытие не обязательно существующего в данный  момент
 
      файла выполнимо, если в операторе OPEN использовать  специ-
 
      фикатор STATUS  со  значением  UNKNOWN.  Существующий  файл


                                - 19 -
 
                          00152-01 97 09-3
 
 
      будет открыт; если файл еще не существует, он будет создан.
 
           Пример.
 
      INTEGER*4 LUN
 
      CHARACTER*256 FILENAME
 
      INTEGER*2 FN_SIZE
 
      INTEGER STATUS
 
      2       LIB$GET_LUN
 
      2       LIB$GET_INPUT
 
      !принять имя файла
 
      STATUS = LIB$GET_INPUT (FILENAME,
 
      2                      'имя файла: ',
 
      2                       FN_SIZE)
 
      IF (.NOT. STATUS) CALL LIB$SIGNAL (%VAL (STATUS))
 
      !принять свободный номер логического устройства
 
      STATUS = LIB$GET_LUN (LUN)
 
      IF (.NOT. STATUS) CALL LIB$SIGNAL (%VAL (STATUS))
 
      !открыть файл
 
      OPEN (UNIT=LUN,
 
      2     FILE=FILENAME (1:FN_SIZE),
 
      2     FORM='UNFORMATTED',
 
      2     STATUS='UNKNOWN')
 
 
           Значение UNKNOWN спецификатора STATUS  открывает  файл
 
      независимо от того, существует он или нет. Если  необходимо
 
      предпринять дополнительные  действия,  зависящие  от  того,
 
      существует ли файл, то мOжно использовать оператор  INQUIRE
 
      с ключевым словом EXIST. Если файл существует, то  в  пере-
 
      менную, связанную с ключевым словом  EXIST  будет  записано
 
      значение .TRUE.; в противном случае эта переменная  получит
 
      значение .FALSE.
 


                                - 20 -
 
                          00152-01 97 09-3
 
 
           Пример.
 
           Отсутствие файла приводит к созданию временного файла:
 
      CHARACTER*256 FILENAME
 
      INTEGER*2 FN_SIZE
 
      LOGICAL EXIST
 
      INQUIRE (FILE = FILENAME (1:FN_SIZE),
 
      2        EXIST = EXIST)
 
      IF (EXIST) THEN
 
          OPEN (UNIT = LUN,
 
      2         FILE = FILENAME (1:FN_SIZE),
 
      2         FORM = 'UNFORMATTED',
 
      2         STATUS = 'OLD')
 
      ELSE
 
        OPEN (UNIT = LUN,
 
      2       FILE = FILENAME (1:FN_SIZE),
 
      2       FORM = 'UNFORMATTED',
 
      2       STATUS = 'SCRATCH')
 
      END IF
 
      !продолжение программы  .
 
 
 
           1.1.3. Выбор ключевых слов для операторов ввода-вывода
 
 
           Различные  типы  доступа  (последовательный,   прямой,
 
      индексный,  внутренний)  разрешают  различные  типы  ввода-
 
      вывода (форматный, неформатный, ориентированный на  список,
 
      ориентированный на список имен).  Кроме  того,  большинство
 
      операций ввода-вывода (TYPE, READ и т.д.)  работают  только
 
      для определенных комбинаций типов доступа  и  ввода-вывода,
 
      как показано в табл.3.
 


                                - 21 -
 
                          00152-01 97 09-3
 
 
                                                        Таблица 3
 
               Использование операторов ввода-вывода
 
      -----------------------------------------------------------
                 !
      Тип доступа!        Типы ввода-вывода
                 !
                 !-----------------------------------------------
                 !         !           !         !
                 !Форматный!Неформатный!По списку!По списку имен
                 !         !           !         !
      ----------------------------------------------------------
                 !         !           !         !
      Последова- !ACCEPT   !READ       !ACCEPT   !ACCEPT
                 !         !           !         !
      тельный    !PRINT    !WRITE      !PRINT    !PRINT
                 !         !           !         !
                 !READ     !           !READ     !READ
                 !         !           !         !
                 !TYPE     !           !TYPE     !TYPE
                 !         !           !         !
                 !WRITE    !           !WRITE    !WRITE
                 !         !           !         !
      Прямой     !READ     !DELETE     !         !
                 !         !           !         !
                 !WRITE    !READ       !         !
                 !         !           !         !
                 !         !WRITE      !         !
                 !         !           !         !
      Индексный  !READ     !DELETE     !         !
                 !         !           !         !
                 !WRITE    !READ       !         !
                 !         !           !         !
                 !REWRITE  !WRITE      !         !
                 !         !           !         !
                 !         !REWRITE    !         !
                 !         !           !         !
      Внутренний !READ     !           !READ     !
                 !         !           !         !
                 !WRITE    !           !WRITE    !
 
 
           Управляющий список ввода-вывода содержит один или нес-
 
      колько спецификаторов (ключевых слов),  точно  определяющих
 
      действие оператора. Спецификаторы ввода-вывода  могут  быть
 
      указаны как в виде ключевых слов (то есть, ключевое слово =
 
      значение),  так  и  просто  значением.  Если  спецификаторы
 
      используются в виде ключевых слов, то их порядок  безразли-
 
      чен. В противном случае необходимо придерживаться следующих
 
      правил:
 


                                - 22 -
 
                          00152-01 97 09-3
 
 
           1) спецификатор UNIT, если он указан не в форме ключе-
 
      вого слова, должен быть первым;
 
           2) спецификаторы FMT, NML, или REC, при их использова-
 
      нии не в форме ключевого слова, должны быть  вторыми.  Если
 
      такой спецификатор используется не в виде ключевого  слова,
 
      то спецификатор UNIT также должен быть не в форме ключевого
 
      слова.
 
           В табл. 4 приведены спецификаторы для конкретных  ком-
 
      бинаций типов доступа  и  ввода-вывода;  некоторые  из  них
 
      должны быть заданы, другие опущены. Для определенности  все
 
      спецификаторы используются в виде ключевого слова.
 
                                                        Таблица 4
 
               Использование спецификаторов ввода-вывода
 
      -----------------------------------------------------------
                 !
                 !           Типы ввода-вывода
                 !
      Тип доступа!-----------------------------------------------
                 !         !           !         !
                 !Форматный!Неформатный!По списку!По списку имен
                 !         !           !         !
      -----------------------------------------------------------
                 !         !           !         !
      Последова- !Указать: !Указать:   !Указать: !Указать:
                 !         !           !         !
      тельный    !  UNIT=U !  UNIT=U   !  UNIT=U !  UNIT=U
                 !         !           !         !
                 !   FMT=F !           !   FMT=* !  NML=N
                 !         !           !         !
                 !опустить:!опустить:  !опустить:!опустить:
                 !         !           !         !
                 !   NML=N !   NML=N   !   NML=N !   FMT=F
                 !         !           !         !
                 !   REC=R !   FMT=F   !   REC=R !   REC=R
                 !         !           !         !
                 !         !   FMT=*   !         !
                 !         !           !         !
                 !         !   REC=R   !         !
                 !         !           !         !
      Прямой     !Указать: !Указать:   !         !
                 !         !           !         !
                 !  UNIT=U !  UNIT=UT  !         !
                 !         !           !         !
                 !   FMT=F !   REC=R   !         !
                 !         !           !         !
                 !   REC=R !           !         !


                                - 23 -
 
                          00152-01 97 09-3
 
 
                                              Продолжение табл. 4
      -----------------------------------------------------------
                 !
                 !           Типы ввода-вывода
                 !
      Тип доступа!-----------------------------------------------
                 !         !           !         !
                 !Форматный!Неформатный!По списку!По списку имен
                 !         !           !         !
      -----------------------------------------------------------
                 !         !           !         !
                 !Опустить:!Опустить:  !         !
                 !         !           !         !
                 !   END=S !   END=S   !         !
                 !         !           !         !
                 !   NML=N !   FMT=F   !         !
                 !         !           !         !
                 !         !   FMT=*   !         !
                 !         !           !         !
                 !         !   NML=N   !         !
                 !         !           !         !
      Индексный  !Указать: !Указать:   !         !
                 !         !           !         !
                 ! UNIT=UT ! UNIT=UT   !         !
                 !         !           !         !
                 !  FMT=FT ! KEYSPEC   !         !
                 !         !           !         !
                 ! KEYSPEC !           !         !
                 !         !           !         !
                 !опустить:!опустить:  !         !
                 !         !           !         !
                 !   END=S !   END=S   !         !
                 !         !           !         !
                 !   NML=N !   FMT=F   !         !
                 !         !           !         !
                 !   REC=R !   FMT=*   !         !
                 !         !           !         !
                 !         !   NML=N   !         !
                 !         !           !         !
                 !         !   REC=R   !         !
                 !         !           !         !
      Внутренний !Указать: !           !Указать: !
                 !         !           !         !
                 ! UNIT=C  !           !  UNIT=C !
                 !         !           !         !
                 !  FMT=F  !           !   FMT=F !
                 !         !           !         !
                 !опустить:!           !опустить:!
                 !         !           !         !
                 !  NML=N  !           !   END=S !
                 !         !           !         !
                 !  REC=R  !           !   NML=N !
                 !         !           !         !
                 !         !           !   REC=R !
 
 
           Примечания:
 
           1. Спецификаторы UNIT и FMT  со  значениями  UT  и  FT


                                - 24 -
 
                          00152-01 97 09-3
 
 
      соответственно употребляются только в форме ключевого  сло-
 
      ва.
 
           2. KEYSPEC указывает на один из возможных спецификато-
 
      ров - KEY, KEYID, KEYEQ, KEYGT, KEYGE.
 
 
 
           1.1.4. Позиционирование на начало файла
 
 
           Для позиционирования на начало открытого файла с  пос-
 
      ледовательным доступом применяется  оператор  REWIND.  Этот
 
      оператор требует только логический номер  устройства  (фай-
 
      ла).
 
           Обычно оператор REWIND  используется  для  возврата  к
 
      началу последовательного файла после  обнаружения  признака
 
      конца этого файла; таким образом файл может быть  использо-
 
      ван в дальнейшем без закрытия и повторного открытия.
 
           Пример.
 
           Используется оператор REWIND  для  возврата  к  началу
 
      файла после завершения чтения:
 
      INTEGER STATUS,
 
      2       LUN1
 
      INTEGER*2 IOSTAT
 
      INCLUDE '($FORDEF)'
 
      DO WHILE (STATUS .NE. FOR$_ENDDURREA)
 
      !продолжение программы
 
      READ (UNIT=LUN1,
 
      2     IOSTAT=IOSTAT) REC_SIZE, RECORD
 
       IF (IOSTAT .EQ. IOSTAT_OK) THEN
 
         CALL ERRSNS (,,,,STATUS)
 
         IF (STATUS .NE. FOR$ENDDURREA) THEN
 
           CALL LIB$SIGNAL (%VAL (STATUS))
 


                                - 25 -
 
                          00152-01 97 09-3
 
 
         END IF
 
       END IF
 
      END DO
 
      REWIND (UNIT=LUN1)
 
      !продолжение программы  .
 
 
 
           1.1.5. Получение характеристик файла
 
 
           В программе можно узнать  характеристики  существующих
 
      файлов с помощью оператора INQUIRE. Этот  оператор  возвра-
 
      щает информацию о большинстве  из  атрибутов  файла.  Кроме
 
      того, INQUIRE дает возможность  определить,  существует  ли
 
      указанный файл, открыт ли он в настоящий момент и  какой  с
 
      ним связан логический номер устройства. Файл для  получения
 
      характеристик может быть указан по имени или, если он  отк-
 
      рыт, по логическому номеру утройства.
 
           Пример.
 
           Проверяется существование файла, его организация,  тип
 
      записей и их длина:
 
      INTEGER*4 LUN /1/
 
      CHARACTER*256 FILENAME
 
      INTEGER*2 FN_SIZE
 
      !возвращаемая информация
 
      LOGICAL    EXIST
 
      CHARACTER*10 ORGANIZATION
 
      CHARACTER*9 RECORDTYPE
 
      INTEGER*4 RECL
 
      INTEGER STATUS,
 
      2       LIB$GET_INPUT
 
      !продолжение программы
 


                                - 26 -
 
                          00152-01 97 09-3
 
 
      !принять имя файла
 
      STATUS = LIB$GET_INPUT (FILENAME,
 
      2                      'FILE TO INQUIRE ABOUT: ',
 
      2                       FN_SIZE)
 
      !выполнить операцию INQUIRE
 
      INQUIRE (FILE          =FILENAME (1:FN_SIZE),
 
      2        EXIST         =EXIST,
 
      2        ORGANIZATION  =ORGANIZATION,
 
      2        RECORDTYPE    =RECORDTYPE,
 
      2        RECL          =RECL)
 
      !продолжение программы  .
 
 
 
           1.1.6. Закрытие файла
 
 
           При завершении программы все открытые файлы закрывают-
 
      ся автоматически. Оператор CLOSE явно закрывает файл в про-
 
      цессе выполнения программы. Спецификатор DISPOSE указывает,
 
      что следует сделать с файлом после закрытия - по  умолчанию
 
      файл будет сохранен.
 
           Явно закрывать файл необходимо в следующих случаях:
 
           1) программа должна продолжать выполнение, а работа  с
 
      файлом уже завершена;
 
           2) файл  используется  только  в  подпрограмме;  перед
 
      возвратом из подпрограммы необходимо закрыть файл;
 
           3) необходимо использовать данный файл с другими атри-
 
      бутами;
 
           4) в программе используется много файлов; следует зак-
 
      рывать каждый из них сразу после завершения работы  с  ним.
 
      Большое количество открытых файлов может привести к  превы-
 
      шению отведенного процессу для этой цели лимита памяти.
 


                                - 27 -
 
                          00152-01 97 09-3
 
 
           Пример.
 
           Файл открывается с защитой от записи, затем закрывает-
 
      ся и открывается повторно в разделяемом режиме:
 
      INTEGER*4     LUN /1/
 
      INTEGER*2     FN_SIZE
 
      CHARACTER*256 FILENAME
 
      CHARACTER*80  INPUT_REC
 
      !открыть файл
 
      OPEN (UNIT=LUN,
 
      2     FILE=FILENAME(1:FN_SIZE),
 
      2     FORM='UNFORMATTED',
 
      2     STATUS='NEW')
 
      !продолжение программы
 
      !закрыть файл
 
      CLOSE (UNIT=LUN)
 
      !открыть файл снова
 
      OPEN (UNIT=LUN,
 
      2      FILE=FILENAME (1:FN_SIZE),
 
      2      FORM='UNFORMATTED',
 
      2      STATUS='OLD',
 
      2      READONLY)
 
      READ (UNIT=LUN) INPUT_REC
 
      !продолжение программы  .
 
 
 
           1.2. Загрузка и выгрузка базы данных
 
 
           Для передачи файла данных в программные  переменные  с
 
      диска и обратно можно использовать  операторы  ввода-вывода
 
      языка ФОРТРАН или применить системную  служебную  процедуру
 
      SYS$CRMPSC для отображения данных. Отображение файла проис-
 


                                - 28 -
 
                          00152-01 97 09-3
 
 
      ходит быстрее чтения. Однако отображенный файл обычно зани-
 
      мает больше памяти, чем прочитанный  с  помощью  операторов
 
      ввода-вывода.  При  использовании  ввода-вывода  приходится
 
      хранить только данные файла. При  использовании  SYS$CRMPSC
 
      необходимо инициализировать базу данных  и  хранить  полную
 
      структуру, включая части, еще не содержащие данных.
 
 
 
           1.2.1. Ввод-вывод операторами языка ФОРТРАН
 
 
           При использовании операторов ввода-вывода языка  форт-
 
      ран для доступа ко  всей  или  большей  части  базы  данных
 
      выполняются следующие операции:
 
           1) чтение всех записей из базы  данных  в  программные
 
      переменные;
 
           2)  обработка  записей  с  использованием  программных
 
      переменных;
 
           3) сохранение записей в  новом  файле  данных  (или  в
 
      исходном файле).
 
           Ввод-вывод может быть как форматным, так  и  неформат-
 
      ным. Обычно неформатные файлы данных используются для чисел
 
      или других данных, к которым имеют доступ только программы,
 
      понимающие структуру файла. Форматные файлы используются  в
 
      тех случаях, когда данные должны быть доступны любой  прог-
 
      рамме выдачи общего назначения (например, программе,  кото-
 
      рая вызывается по команде TYPE языка команд DCL).
 
           Каждая операция бесформатного ввода-вывода читает  или
 
      пишет одну запись файла. Так как в одиночной операции могут
 
      быть записаны несколько переменных (включая переменные типа
 
      'запись' и массивы), то одна запись файла  может  содержать
 
      несколько переменных. Например, сегмент программы  пишет  в
 


                                - 29 -
 
                          00152-01 97 09-3
 
 
      файл три записи: первая содержит  переменную  типа  RECORD,
 
      вторая - переменную типа INTEGER, а третья - массив:
 
      STRUCTURE /CHAR_STRING/
 
        INTEGER*2    LENCTH
 
        CHARACTER*50 NAME
 
      END STRUCTURE
 
      RECORD /CHAR_STRING/ REPORT_NAME
 
      INTEGER*4 TOTAL_HOUSES
 
      REAL*4 PERSONS_HOUSE (2048)
 
      !продолжение программы
 
      WRITE (UNIT=STATUS_LUN) REPORT_NAME
 
      WRITE (UNIT=STATUS_LUN) TOTAL_HOUSES
 
      WRITE (UNIT=STATUS_LUN) PERSONS_HOUSE
 
 
           При выполнении ввода-вывода над массивами  чтение  или
 
      запись целого массива в одной операции ввода-вывода  прохо-
 
      дит быстрее, чем чтение  или  запись  отдельных  элементов.
 
      Если используется только часть большого мAссива,  то  можно
 
      сэкономить место на диске за счет записи только  используе-
 
      мой части массива. Например, первая запись файла STATUS.SAV
 
      является целым числом элементов массива, записанных в файл.
 
      Остальные записи - это элементы массива, записанные в  файл
 
      по одному в записи.  Создается  новый  файл  STATUS.SAV,  в
 
      который записываются только значимые элементы массивов:
 
      !писать новый STATUS.SAV
 
      IF (TOTAL_HOUSES .NE. 0) THEN
 
        OPEN (UNIT=STATUS_LUN,
 
      2       FILE='STATUS.SAV',
 
      2       STATUS='NEW',
 
      2       FORM='UNFORMATTED')
 


                                - 30 -
 
                          00152-01 97 09-3
 
 
      !выгрузить базу данных
 
      WRITE (UNIT=STATUS_LUN) TOTAL_HOUSES
 
      WRITE (UNIT=STATUS_LUN)(PERSONS_HOUSE (I),I=1,TOTAL_HOUSES)
 
      WRITE (UNIT=STATUS_LUN) (ADULTS_HOUSE (I),I=1,TOTAL_HOUSES)
 
      WRITE (UNIT=STATUS_LUN) (INCOME_HOUSE (I),I=1,TOTAL_HOUSES)
 
      END IF
 
      !продолжение программы  .
 
           Величина и тип переменных, заданных в операторе чтения
 
      или записи, должны быть согласованы с размером записи. Если
 
      какая-нибудь запись в базе данных имеет  переменную  длину,
 
      то длина записи должна быть включена  перед  элементом  или
 
      должна быть вычисляемой. Например,  если  неформатный  файл
 
      содержит символьные  данные,  то  необходимо  иметь  какой-
 
      нибудь способ определения длин строк.
 
           Пример.
 
           Массив NAME_HOUSE содержит фамилию главы дома, которая
 
      хранится в строке  со  счетчиком  (значение  первого  байта
 
      строки - ее длина 51 символ). Другой подход позволяет  каж-
 
      дую строку хранить как переменную типа RECORD с двумя поля-
 
      ми: в первом, типа INTEGER, хранится длина, а в  поле  типа
 
      CHARACTER хранится подстрока:
 
 
      !описание переменных под статистику
 
      INTEGER TOTAL_HOUSES
 
      REAL PERSONS HOUSE (2048),
 
      2    ADULTS_HOUSE (2048),
 
      2    INCOME_HOUSE (2048)
 
      CHARACTER*51 STORE_NAME(2048)
 
      CHARACTER*50 NAME_HOUSE(2048)
 
      INTEGER NAME_LEN (2048)
 


                                - 31 -
 
                          00152-01 97 09-3
 
 
      !продолжение программы
 
      !открыть файл STATS.SAV, содержащий такие значения:
 
      !TOTAL_HOUSES (одно целое)
 
      !PERSONS_HOUSE (одно вещественное TOTAL_HOUSES раз)
 
      !ADULTS_HOUSE (одно вещественное TOTAL_HOUSES раз)
 
      !INCOME_HOUSE (одно вещественное TOTAL_HOUSES раз)
 
      !STORE_NAME (одна строка 51 символ TOTAL_HOUSES раз)
 
      OPEN (UNIT=STATS_LUN,
 
      2     FILE='STATS.SAV'
 
      2     STATUS='OLD',
 
      2     FORM='UNFORMATTED',
 
      2     IOSTAT=IOSTAT)
 
      IF (IOSTAT .EQ. IO_OK) THEN
 
       !если STATS.SAV существует, загрузить базу данных
 
       !из STATS.SAV
 
      READ (UNIT=STATS_LUN) TOTAL_HOUSES
 
      READ (UNIT=STATS_LUN)(PERSONS_HOUSE (I), I=1, TOTAL_HOUSES)
 
      READ (UNIT=STATS_LUN) (ADULTS_HOUSE (I), I=1, TOTAL_HOUSES)
 
      READ (UNIT=STATS_LUN) (INCOME_HOUSE (I), I=1, TOTAL_HOUSES)
 
      READ (UNIT=STATS_LUN) (STORE_NAME (I), I=1, TOTAL_HOUSES)
 
       CLOSE (UNIT=STATS_LUN)
 
       DO I = 1, TOTAL_HOUSES
 
      NAME_LEN(I) = ICNAR(STORE_NAME(I)(1:1))
 
      NAME_HOUSE(I)(1:NAME_LEN(I))=STORE_NAME(I)(2:NAME_LEN(I)+1)
 
      END DO
 
        !если STATS.SAV не существует, предположить новую
 
        !базу данных
 
      ELSE
 
        CALL ERRSNS (,,,,STATUS)
 
        IF (STATUS .NE. FOR$_FILNOTFOU) THEN


                                - 32 -
 
                          00152-01 97 09-3
 
 
           CALL LIB$SIGNAL (%VAL (STATUS))
 
        END IF
 
      END IF
 
      !продолжение программы
 
      !писать новый STATS.SAV
 
      IF (TOTAL_HOUSES .NE. 0) THEN
 
       OPEN (UNIT=STATS_LUN,
 
      2      FILE='STATS.SAV',
 
      2      STATUS='NEW',
 
      2      FORM='UNFORMATTED')
 
        !выгрузить базу данных
 
        DO I = 1, TOTAL_HOUSES
 
      STORE_NAME(I)(1:1) = CHAR(NAME_LEN(I))
 
      STORE_NAME(I)(2:NAME_LEN(I)+1)=NAME_HOUSE(I)(1:NAME_LEN(I))
 
      END DO
 
      WRITE (UNIT=STATS_LUN) TOTAL_HOUSES
 
      WRITE (UNIT=STATS_LUN) (PERSONS_HOUSE (I),I=1,TOTAL_HOUSES)
 
      WRITE (UNIT=STATS_LUN) (ADULTS_HOUSE (I),I=1,TOTAL_HOUSES)
 
      WRITE (UNIT=STATS_LUN) (INCOME_HOUSE (I),I=1,TOTAL_HOUSES)
 
      WRITE (UNIT=STATS_LUN) (STORE_HOUSE (I),I=1,TOTAL_HOUSES)
 
      END IF
 
      END  !конец программы  .
 
 
 
           1.2.2. Процедура SYS$CRMPSC
 
 
           Отобразить файл - это значит связать каждый байт файла
 
      с байтом памяти программы. Доступ  к  данным  отображенного
 
      файла осуществляется ссылкой  на  память  программы;  после
 
      отображения файла программа не  выполняет  операций  чтения
 
      или записи.
 


                                - 33 -
 
                          00152-01 97 09-3
 
 
           Файл, созданный  с  помощью  СУД-32,  обычно  содержит
 
      упраляющую информацию. Не  рекомендуется  отображать  такой
 
      файл, если не известна детально его структура. Лучшей прак-
 
      тикой будет отображение только  тех  файлов,  которые  были
 
      ранее созданы как результат отображения.
 
           Для отображения файла необходимо произвести  следующие
 
      действия:
 
           1) поместить программные  переменные,  предназначенные
 
      для данных, в блок общей памяти.  Выровнять  этот  блок  по
 
      границе страницы на этапе компоновки, используя  файл  воз-
 
      можностей компоновщика ("имя" есть имя общего блока):
 
        PSECT_ATTR = имя, PAGE
 
      где имя - имя общего блока памяти.
 
           Внутри блока общей памяти необходимо задать  данные  в
 
      порядке от наиболее сложных к наименее сложным  (в  порядке
 
      понижения ранга), причем символьные данные последними.  Тем
 
      самым достигается естественное выравнивание данных  и  пре-
 
      дотвращается нежелательное нарушение границ страниц в  вир-
 
      туальной памяти;
 
           2) открыть файл данных, используя  процедуру  открытия
 
      для  пользовательского  ввода-вывода  (в  противоположность
 
      вводу-выводу СУД-32), возвращающую номер канала,  связаного
 
      с файлом;
 
           3) отобразить файл данных в блок общей памяти;
 
           4) обработать записи, используя программные переменные
 
      в блоке общей памяти;
 
           5) освободить память, используемую блоком общей  памя-
 
      ти, что вынудит запись модифицированных  данных  обратно  в
 
      файл на диске.
 
           Инициализировать  переменные  блока  общей  памяти,  в


                                - 34 -
 
                          00152-01 97 09-3
 
 
      который будет отображаться файл, нет необходимости; началь-
 
      ные значения будут утеряны, когда SYS$CRMPSC отобразит файл
 
      в блок общей памяти.
 
 
 
           1.2.2.1. Отображение файла
 
 
           Для   отображения   файла    используется    процедура
 
      SYS$CRMPSC, описание которой приведено в  [1].  Обычно  для
 
      отображения файла применяются следующие параметры:
 
           1) INADR (параметр 1), задается как  целый  массив  из
 
      двух элементов. Значение первого элемента указывает положе-
 
      ние первой переменной блока общей памяти, а второй  элемент
 
      задает положение последней переменной блока  общей  памяти.
 
      Если первая переменная в блоке общей памяти есть массив или
 
      строка, то первой переменной блока общей  памяти  считается
 
      первый элемент этой строки или массива;
 
           2) RETADR (парметр 2), задается как  целый  массив  из
 
      двух элементов. SYS$CRMPSC заносит положение первого  отоб-
 
      раженного элемента в первый элемент этого массива, а  поло-
 
      жение последнего элемента отображения - во  второй  элемент
 
      массива.
 
           Значение, возвращенное в первом элементе массива долж-
 
      но быть тем же, что и адрес, переданный в  первом  элементе
 
      INADR. Значение, возвращенное во втором  элементе  массива,
 
      должно быть равно или несколько больше (в пределах 512 бай-
 
      тов, т.е. одного блока), чем значение, переданное во втором
 
      элементе INADR.
 
           Если первый элемент RETADR ошибочный, то возможно,  не
 
      выровнен на границе страницы блок общей памяти,  содержащий
 
      отображенные данные. Если второй элемент  RETADR  ошибочен,
 


                                - 35 -
 
                          00152-01 97 09-3
 
 
      то вероятно, при создании нового файла данных не было зада-
 
      но ключевое слово INITALSIZE в операторе OPEN;
 
           3) FLAGS (параметр 4). Обычно при использовании личной
 
      секции задается флаг SEC$M_WRT (обозначает, что секция дос-
 
      тупна  для  записи).  Если  файл  новый,   задается   также
 
      SEC$M_DZRO (означает, что секция должна быть  инициализиро-
 
      вана нулевыми значениями);
 
           4) CHAN (параметр 8).  Чтобы  получить  номер  канала,
 
      необходимо применить  процедуру  открытия  файла  в  режиме
 
      пользователя.
 
           Пример.
 
           Отображается файл данных, состоящий из длинного  слова
 
      и трех вещественных массивов в блок общей памяти  INC_DATA,
 
      который выравнивается по границе страницы с  помощью  файла
 
      возможностей INCOME.OPT.
 
           Если процедура  SYS$CRMPSC  возвращает  код  состояния
 
      SS$_IVSECFLG, а флаги в параметре маски  заданы  верно,  то
 
      необходимо проверить, не  передается  ли  нулевое  значение
 
      номера канала:
 
           Файл возможностей INCOME.OPT имеет вид:
 
      PSECT_ATTR = INC_DATA, PAGE
 
           Программа INCOME.FOR содержит:
 
      !описать переменные для статистики
 
      REAL  PERSONS_HOUSE (2048),
 
      2     ADULTS_HOUSE (2048),
 
      2     INCOME_HOUSE (2048)
 
      INTEGER TOTAL_HOUSES
 
      !описать информацию секции
 
      !область данных
 
      COMMON /INC_DATA/ PERSONS_HOUSE,


                                - 36 -
 
                          00152-01 97 09-3
 
 
      2                 ADULTS_HOUSE,
 
      2                 INCOME_HOUSE,
 
      2                 TOTAL_HOUSES
 
      !адреса
 
      INTEGER ADDR(2),
 
      2       RET_ADDR(2)
 
      !длина секции
 
      INTEGER SEC_LEN
 
      !канал
 
      INTEGER*2 CHAN, GARBAGE
 
      COMMON /CHANNEL/ CHAN,
 
      2                GARBAGE
 
      !значения маски
 
      INTEGER MASK
 
      INCLUDE '($SECDEF)'
 
      !процедуры открытия для пользователя
 
      INTEGER UFO_OPEN ,
 
      2       UFO_CREATE
 
      EXTERNAL UFO_OPEN,
 
      2        UFO_CREATE
 
      !описать логический номер устройства
 
      INTEGER STATS_LUN
 
      !описать переменные и значения состояния
 
      INTEGER STATUS,
 
      2       IOSTAT,
 
      2       IO_OK
 
      PARAMETER (IO_OK = 0)
 
      INCLUDE '($FORDEF)'
 
      EXTERNAL INCOME_BADMAP
 
      !описать логическую переменную для оператора INQUIRE


                                - 37 -
 
                          00152-01 97 09-3
 
 
      LOGICAL EXIST
 
      !описать подпрограммы, вызываемые как функции
 
      INTEGER LIB$GET_LUN,
 
      2       SYS$CRMPSC,
 
      2       SYS$DELTVA,
 
      2       SYS$DASSGN
 
      !принять логический номер устройства для STATS.SAV
 
      STATUS = LIB$GET_LUN (STATS_LUN)
 
      IF (.NOT. STATUS) CALL LIB$SIGNAL (%VAL (STATUS))
 
      INQUIRE (FILE = 'STATS.SAV',
 
      2        EXIST = EXIST)
 
      IF (EXIST) THEN
 
        !открыть файл STATS.SAV
 
       OPEN (UNIT=STATS_LUN,
 
      2      FILE='STATS.SAV',
 
      2      STATUS='OLD',
 
      2      USEROPEN=UFO_OPEN)
 
        MASK = SEC$M_WRT
 
      ELSE
 
        !если STATS.SAV не существует, создать новую базу данных
 
        MASK = SEC$M_WRT .OR. SEC$M_DZRO
 
        SEC_LEN =
 
      !(адрес последнего - адрес первого + величина последнего
 
      !+ 511)/512
 
      2 ((%LOC(TOTAL_HOUSES)-%LOG(PERSONS_HOUSE(1))+4+511)/512)
 
        OPEN (UNIT=STATS_LUN,
 
      2       FILE='STATS.SAV',
 
      2       STATUS='NEW',
 
      2       INITIALSIZE=SEC_LEN,
 
      2       USEROPEN=UFO_CREATE)


                                - 38 -
 
                          00152-01 97 09-3
 
 
      END IF
 
      !освободить логический номер устройства и отобразить секцию
 
      CLOSE (STATS_LUN)
 
      !*****************
 
      !отобразить данные
 
      !*****************
 
      !задать первый и последний адрес секции
 
      ADDR(1) = %LOC(PERSONS_HOUSE(1))
 
      ADDR(2) = %LOC(TOTAL_HOUSES)
 
      !отобразить секцию
 
      STATUS = SYS$CRMPSC (ADDR,
 
      2                    RET_ADDR,
 
      2                    ,
 
      2                    %VAL(MASK),
 
      2                    ,,,
 
      2                    %VAL(CHAN),
 
      2                    ,,,)
 
      IF (.NOT. STATUS) CALL LIB$SIGNAL(%VAL(STATUS))
 
      !проверить правильность отображения
 
      IF ((ADDR(1) .NE. RET_ADDR(1)) .OR.
 
      2   (ADDR(2) .GT. RET_ADDR(2)))
 
      2  CALL LIB$SIGNAL (%VAL (%LOC(INCOME_BADMAP)))
 
           !ссылки на данные с использованием
 
           !структур данных, собранных в блоке
 
           !общей памяти
 
      !закрыть и обновить STATS.SAV
 
      STATUS = SYS$DELTVA (RET_ADDR,,)
 
      IF (.NOT. STATUS) CALL LIB$SIGNAL(%VAL(STATUS))
 
      STATUS = SYS$DASSGN (%VAL(CHAN))
 
      IF (.NOT. STATUS) CALL LIB$SIGNAL(%VAL(STATUS))


                                - 39 -
 
                          00152-01 97 09-3
 
 
      END   !конец программы.
 
 
 
           1.2.2.2. Открытие файла в режиме пользователя
 
 
           При открытии файла для отображения используется проце-
 
      дура открытия файла в режиме пользователя, выполняющая сле-
 
      дующие операции:
 
           1) установка  бита  открытия  пользовательского  файла
 
      (FAB$V_UFO) в маске возможностей FAB (блок доступа  к  фай-
 
      лу);
 
           2) открытие файла, используя для  существующего  файла
 
      SYS$OPEN,  а  для  нового  файла  SYS$CREATE   (недопустимо
 
      использовать  SYS$CONNECT,  если  установлен  бит  открытия
 
      пользовательского файла);
 
           3) возврат номера канала программной единице, начавшей
 
      операцию OPEN. Этот номер канала находится в дополнительном
 
      длинном слове состояния блока доступа к файлу  (FAB$L_STV),
 
      и должен возвращаться в блоке общей памяти;
 
           4) возврат кода состояния операции OPEN (SYS$OPEN  или
 
      SYS$CREATE), совпадающего с кодом состояния процедуры  отк-
 
      рытия.
 
           После установки бита открытия пользовательского  файла
 
      в маске возможностей FAB (блок доступа к файлу) для доступа
 
      к данным этого файла нельзя применять ввод-вывод оператора-
 
      ми языка ФОРТРАН; необходимо  использовать  оператор  CLOSE
 
      для освобождения логического номера устройства,  связанного
 
      с файлом. Файл по-прежнему остается открытым. Доступ к фай-
 
      лу осуществляется по номеру канала.
 
           Пример.
 
           Процедура открытия  UFO_OPEN  вызывается  в  программе
 


                                - 40 -
 
                          00152-01 97 09-3
 
 
      INCOME,  если  файл  STATS.SAV   существует;   если   файла
 
      STATS.SAV нет, то процедура открытия UFO_OPEN должна  вызы-
 
      вать SYS$CREATE вместо SYS$OPEN:
 
      INTEGER FUNCTION UFO_OPEN (FAB,
 
      2                          RAB,
 
      2                          LUN)
 
      !включить определения СУД-32
 
      INCLUDE '($FABDEF)'
 
      INCLUDE '($RABDEF)'
 
      !описать формальные параметры
 
      RECORD /FABDEF/ FAB
 
      RECORD /RABDEF/ RAB
 
      INTEGER LUN
 
      !описать канал
 
      INTEGER*4 CHAN
 
      COMMON /CHANNEL/ CHAN
 
      !описать переменную состояния
 
      !INTEGER STATUS
 
      !описать системные процедуры
 
      !INTEGER SYS$OPEN
 
      !установить бит открытия для пользователя в длинном
 
      !слове возможностей
 
      FAB.FAB$L_FOP=FAB.FAB$L_FOP .OR. FAB$M_UFO
 
      !открыть файл
 
      STATUS = SYS$OPEN (FAB)
 
      !прочитать канал из слова состояния
 
      CHAN =FAB.FAB$L_STV
 
      !вернуть состояние операции открытия
 
      UFO_OPEN=STATUS
 
      END


                                - 41 -
 
                          00152-01 97 09-3
 
 
           1.2.2.3. Инициализация отображенной базы данных
 
 
           При первом отображении файла необходимо задать  размер
 
      файла и произвести его инициализацию.
 
           Процедура SYS$CRMPSC отображает данные по размеру фай-
 
      ла; для правильного отображения файл должен иметь достаточ-
 
      ный размер. При создании файла для отображения  необходимый
 
      размер задается в операторе OPEN  с  помощью  спецификатора
 
      INITIALSIZE.
 
           Размер отображаемой базы данных  (т.е.  размер  файла)
 
      определяется следующим образом:
 
           1) определить размер (в байтах)  блока  общей  памяти,
 
      для чего необходимо вычесть адрес первой  переменной  блока
 
      из адреса последней переменной и добавить размер (в байтах)
 
      последней переменной;
 
           2) определить число блоков по 512 байтов в общей памя-
 
      ти, для чего добавить к размеру блока в байтах число 511  и
 
      разделить результат на 512 (один блок равен 512 байтов).
 
           Инициализация файла при его первом отображении необхо-
 
      дима, т.к. автоматическая инициализацция блоков, отведенных
 
      под файл отсутствует; эти блоки содержат случайные  данные.
 
      При  создании  файла  можно  инициализировать  отображенную
 
      область нулевыми значениями,  установив  бит  SEC$V_DZRO  в
 
      параметре маски SYS$CREATE.
 


                                - 42 -
 
                          00152-01 97 09-3
 
 
           1.2.2.4. Сохранение отображенного файла
 
 
           Для закрытия файла данных, открытого на пользовательс-
 
      кий ввод-вывод, необходимо отсоединить канал  ввода-вывода,
 
      связанный с файлом. Перед отсоединением канала, назначенно-
 
      го отображенному файлу, необходимо  уничтожить  виртуальную
 
      память, связанную с файлом (память, использованную под блок
 
      общей памяти). При удалении виртуальной памяти, связанной с
 
      отображенным файлом, все изменения в памяти, сделанные в то
 
      время, когда файл был отображен, переписываются  обратно  в
 
      файл на диске. Для уничтожения виртуальной памяти,  исполь-
 
      зованной отображенным файлом, используется  системная  слу-
 
      жебная процедура SYS$DELTVA. Для отсоединения канала ввода-
 
      вывода, назначенного файлу, используется системная  служеб-
 
      ная процедура SYS$DASSGN.
 
           Для гарантированного удаления об'ема виртуальной памя-
 
      ти необходимо передать в  SYS$DELTVA  адреса,  возвращенные
 
      программой SYS$CRMPSC, а не те адреса, которые ей передава-
 
      лись [1].
 
           Для сохранения изменений, выполненных  в  отображенной
 
      секции, без закрытия файла используется системная служебная
 
      процедура SYS$UPDSEC. Для гарантированного обновления  всех
 
      участков файла  необходимо  передать  процедуре  SYS$UPDSEC
 
      адреса, возвращенные  процедурой  SYS$CRMPSC.  Для  запуска
 
      операции обновления с ожиданием ее  завершения  в  этой  же
 
      точке программы используется параметр EFN (параметр 5) про-
 
      цедуры SYS$UPDSEC для задания флага события, который должен
 
      быть установлен по окончанию обновления [1].
 
           Пример.
 
           Отображенный файл закрывается с автоматической записью
 


                                - 43 -
 
                          00152-01 97 09-3
 
 
      всех изменений на диск:
 
      !адрес секции
 
      INTEGER*4 ADDR(2),
 
      2         RET_ADDR(2)
 
      !флаг события
 
      INTEGER*4 FLAG
 
      !блок состояния
 
      STRUCTURE /IO_BLOCK/
 
       INTEGER*2 IOSTAT,
 
      2          HARDWARE
 
       INTEGER*4 BAD_PAGE
 
      END STRUCTURE
 
      RECORD /IO_BLOCK/ IOSTATUS
 
      !продолжение программы
 
      !принять флаг события
 
      STATUS = LIB$GET_EF (FLAG)
 
      IF (.NOT. STATUS) CALL LIB$SIGNAL (%VAL(STATUS))
 
      !обновить секцию
 
      STATUS = SYS$UPDSEC (RET_ADDR,
 
      2                    ,,,
 
      2                    %VAL(FLAG)
 
      2                    ,
 
      2                    IOSTATUS,,)
 
      IF (.NOT. STATUS) CALL LIB$SIGNAL (%VAL(STATUS))
 
      !подождать конца обновления
 
      STATUS = SYS$SYNCH (%VAL(FLAG),
 
      2                   IOSTATUS)
 
      IF (.NOT. STATUS) CALL LIB$SIGNAL (%VAL(STATUS))
 
      !продолжение программы  .
 


                                - 44 -
 
                          00152-01 97 09-3
 
 
           1.3. Обработка записей базы данных целиком
 
 
           Последовательный файл состоит из записей , расположен-
 
      ных одна за другой в том порядке, в котором они были  запи-
 
      саны в файл. Добавлять новые записи можно  только  к  концу
 
      файла. Как правило, доступ к последовательным файлам после-
 
      довательный.
 
 
 
           1.3.1. Создание последовательного файла
 
 
           Для создания последовательного файла используется опе-
 
      ратор  OPEN,  в  котором  задано  STATUS  =  'NEW',  ACCESS
 
      ='SEQUENTIAL' и ORGANIZATION =  'SEQUENTIAL'  (ORGANIZATION
 
      может быть также задан как INDEXED или RELATIVE).
 
           Пример.
 
           Создается последовательный файл с записями фиксирован-
 
      ной длины:
 
      INTEGER STATUS,
 
      2       LUN,
 
      2       LIB$GET_INPUT,
 
      2       LIB$GET_LUN,
 
      2       STR$UPCASE
 
      INTEGER*2    FN_SIZE,
 
      2            REC_SIZE
 
      CHARACTER*256 FILENAME
 
      CHARACTER*80 RECORD
 
      !принять имя файла
 
      STATUS =LIB$GET_INPUT (FILENAME,
 
      2                      'имя файла: ',
 
      2                       FN_SIZE)
 
      IF (.NOT. STATUS) CALL LIB$SIGNAL (%VAL (STATUS))


                                - 45 -
 
                          00152-01 97 09-3
 
 
      !взять свободный номер устройства
 
      STATUS = LIB$GET_LUN (LUN)
 
      IF (.NOT. STATUS) CALL LIB$SIGNAL (%VAL (STATUS))
 
      !открыть файл
 
      OPEN (UNIT = LUN,
 
      2     FILE = FILENAME (1:FN_SIZE),
 
      2     ORGANIZATION = 'SEQUENTIAL',
 
      2     ACCESS = 'SEQUENTIAL',
 
      2     RECORDTYPE = 'FIXED',
 
      2     FORM = 'UNFORMATTED',
 
      2     RECL = 20,
 
      2     STATUS = 'NEW')
 
      !принять входную запись
 
      STATUS = LIB$GET_INPUT (RECORD,
 
      2                     'ввод: ',
 
      2                     REC_SIZE)
 
      IF (.NOT. STATUS) CALL LIB$SIGNAL (%VAL (STATUS))
 
      DO WHILE (REC_SIZE .NE. 0)
 
        !преобразовать в символы верхнего регистра
 
        STATUS  =  STR$UPCASE (RECORD,RECORD)
 
        IF (.NOT. STATUS) CALL LIB$SIGNAL (%VAL (STATUS))
 
        WRITE (UNIT = LUN) RECORD (1:REC_SIZE)
 
        !принять следующую запись
 
        STATUS  =  LIB$GET_INPUT (RECORD,
 
      2                         'ввод:',
 
      2                          REC_SIZE)
 
        IF (.NOT. STATUS) CALL LIB$SIGNAL (%VAL (STATUS))
 
      END DO
 
      END
 


                                - 46 -
 
                          00152-01 97 09-3
 
 
           1.3.2. Обновление последовательного файла
 
 
           Для обновления последовательного файла читается каждая
 
      его запись, обновляется и записывается в  новый  последова-
 
      тельный файл. Обновленные записи не могут быть занесены  на
 
      то же место последовательного файла, из которого они прочи-
 
      таны.
 
           Пример.
 
           Обновляется последовательный файл,  причем  предостав-
 
      ляется возможность модифицировать запись перед  ее  занесе-
 
      нием в новый файл. Для обоих файлов используется одно и  то
 
      же имя; так как новый файл открывается после старого, то  у
 
      него больше номер версии:
 
      INTEGER STATUS,
 
      2       LUN1,
 
      2       LUN2,
 
      2       IOSTAT
 
      INTEGER*2 FN_SIZE
 
      CHARACTER*256 FILENAME
 
      CHARACTER*80 RECORD
 
      CHARACTER*80 NEW_RECORD
 
      INCLUDE '($FORDEF)'
 
      INTEGER*4 LIB$GET_INPUT,
 
      2         LIB$GET_LUN,
 
      2         STR$UPCASE
 
      ! принять имя файла
 
      STATUS = LIB$GET_INPUT (FILENAME,
 
      2                       'имя файла: ',
 
      2                       FN_SIZE)
 
      IF (.NOT. STATUS) CALL LIB$SIGNAL (%VAL (STATUS))
 


                                - 47 -
 
                          00152-01 97 09-3
 
 
      ! принять свободный номер устройства
 
      STATUS = LIB$GET_LUN (LUN1)
 
      IF (.NOT. STATUS) CALL LIB$SIGNAL (%VAL (STATUS))
 
      ! открыть старый файл
 
      OPEN (UNIT=LUN1,
 
      2     FILE=FILENAME (1:FN_SIZE),
 
      2     ORGANIZATION = 'SEQUENTIAL',
 
      2     ACCESS = 'SEQUENTIAL',
 
      2     RECORDTYPE = 'FIXED',
 
      2     FORM = 'UNFORMATTED',
 
      2     RECL = 20,
 
      2     STATUS = 'OLD')
 
      ! принять свободный номер устройства
 
      STATUS = LIB$GET_LUN (LUN2)
 
      IF (.NOT. STATUS) CALL LIB$SIGNAL (%VAL (STATUS))
 
      ! открыть новый файл
 
      OPEN (UNIT=LUN2,
 
      2     FILE=FILENAME (1:FN_SIZE),
 
      2     ORGANIZATION='SEQUENTIAL',
 
      2     ACCESS='SEQUENTIAL',
 
      2     RECORDTYPE='FIXED',
 
      2     FORM='UNFORMATTED',
 
      2     RECL=20,
 
      2     STATUS='NFW')
 
      ! читать запись из старого файла
 
      READ (UNIT=LUN1,
 
      2     IOSTAT=IOSTAT) RECORD
 
      IF (IOSTAT .NE. IOSTAT_OK) THEN
 
        CALL ERRSNS (,,,,STATUS)
 
        IF (STATUS .NE. FOR$_ENDDURREA) THEN


                                - 48 -
 
                          00152-01 97 09-3
 
 
          CALL LIB$SIGNAL (%VAL (STATUS))
 
        END IF
 
      END IF
 
      DO WHILE (STATUS .NE. FOR$_ENDDURREA)
 
        TYPE *, RECORD
 
        ! принять обновленную запись
 
        STATUS = LIB$GET_INPUT (NEW_RECORD,
 
      2                         'данные: ')
 
        IF (.NOT. STATUS) CALL LIB$SIGNAL (%VAL (STATUS))
 
        ! преобразовать в символы верхнего регистра
 
        STATUS = STR$UPCASE (NEW_RECORD,
 
      2                      NEW_RECORD)
 
        IF (.NOT. STATUS) CALL LIB$SIGNAL (%VAL (STATUS))
 
        ! писать неизменную или обновленную запись
 
        IF (NEW_RECORD .EQ. ' ') THEN
 
          WRITE (UNIT=LUN2) RECORD
 
        ELSE
 
          WRITE (UNIT=LUN2) NEW_RECORD
 
        END IF
 
        ! читать следующую запись
 
        READ (UNIT=LUN1,
 
      2       IOSTAT=IOSTAT) RECORD
 
        IF (IOSTAT .NE. IOSTAT_OK) THEN
 
          CALL ERRSNS (,,,,STATUS)
 
          IF (STATUS .NE. FOR$_ENDDURREA) THEN
 
            CALL LIB$SIGNAL (%VAL(STATUS))
 
          END IF
 
        END IF
 
      END DO
 
      END


                                - 49 -
 
                          00152-01 97 09-3
 
 
           1.3.3. Сортировка и слияние последовательных файлов
 
 
           Обслуживающая программа сортировки позволяет  сортиро-
 
      вать и сливать записи последовательных файлов  по  заданным
 
      одному или нескольким ключевым полям. Можно вести сортиров-
 
      ку одного или нескольких (до десяти) файлов, генерируя еди-
 
      ный выходной файл. Можно также сливать от  двух  до  десяти
 
      предварительно отсортированных входных файлов в один.
 
           Для сортировки  и  слияния  на  командном  уровне  DCL
 
      используются  команды  SORT  и  MERGE,  описанные  подробно
 
      в [2]. Для ведения сортировки и слияния файлов на программ-
 
      ном уровне используются библиотечные процедуры  SOR$  более
 
      полную информацию о которых можно получить в [3].
 
           Последовательные файлы  можно  сортировать  и  сливать
 
      целиком или по записям. При обработке файла целиком пользо-
 
      вательская программа передает в SORT весь файл  и  получает
 
      полностью упорядоченный файл после обработки. При обработке
 
      по записям программа передает в SORT  по  одной  записи  за
 
      один раз; получает упорядоченный файл также по одной  запи-
 
      си. Обычно интерфейс по записи используется  для  обработки
 
      отдельных записей до или после сортировки. Два способа мож-
 
      но сочетать; это позволяет пользовательской программе пере-
 
      давать в SORT целиком файл и получать отдельные записи, или
 
      наоборот.
 
           Программа может одновременно выполнять несколько  опе-
 
      раций сортировки за счет задания контекстного параметра при
 
      вызове различных процедур SOR$. Контекстный параметр -  это
 
      длинное слово, которое передается в SORT, где модифицирует-
 
      ся для слежения  за  параллельными  операциями  сортировки.
 
      Вызов  SOR$END_SORT  повторно  инициализирует   контекстный
 


                                - 50 -
 
                          00152-01 97 09-3
 
 
      параметр.
 
 
 
           1.3.3.1. Передача ключевой информации
 
 
           Для операции сортировки или слияния неоходимо передать
 
      ключевую   информацию   (параметр   KEY_BUFFER)   либо    в
 
      SOR$BEGIN_SORT, либо в SOR$BEGIN_MERGE. Параметр KEY_BUFFER
 
      передается как массив слов. Первое слово  массива  содержит
 
      число ключей, используемых в операции сортировки или  слия-
 
      ния. Каждый следующий блок из четырех слов  описывает  один
 
      из ключей  (множественные  ключи  перечисляются  в  порядке
 
      приоритета):
 
           1) первое слово определяет тип данных ключа;
 
           2) второе  слово  определяет  порядок  сортировки  или
 
      слияния (0 - по возрастанию, 1 - по убыванию);
 
           3) третье слово означает относительное смещение  ключа
 
      (начиная с позиции 0);
 
           4) четвертое слово описывает длину ключа в байтах.
 
           Для сортировки  или  слияния  последовательных  файлов
 
      нужно  вызвать  специфическую  последовательность  процедур
 
      SOR$. Процедуры и вызывающая последовательность зависят  от
 
      типа операций (сортировка или слияние)  и  типа  интерфейса
 
      (файл или записи).
 
 
 
           1.3.3.2. Сортировка файловым интерфейсом
 
 
           Для сортировки последовательных файлов файловым интер-
 
      фейсом выполняются следующие операции:
 
      1) вызов   SOR$PASS_FILES  для  передачи  спецификации
 
      входного и выходного файла в SORT.  Разрешается  до  десяти
 
      входных файлов. Если входных файлов много, то  для  каждого


                                - 51 -
 
                          00152-01 97 09-3
 
 
      из них  следует  по  одному  разу  вызвать  SOR$PASS_FILES.
 
      Выходной файл должен быть задан при  первом  вызове.  Набор
 
      необязательных параметров задает  характеристики  выходного
 
      файла [3];
 
           2) вызов SOR$BEGIN_SORT для передачи ключевой информа-
 
      ции. Можно также задать набор возможностей,  включая  напи-
 
      санную пользователем процедуру сравнения  ключей  [3];  при
 
      использовании файлового интерфейса SOR$BEGIN_SORT открывает
 
      входные и выходной файлы;
 
           3) вызов SOR$SORT_MERGE для  выполнения  сортировки  и
 
      направления отсортированных записей в выходной файл;
 
           4) вызов SOR$END_SORT для окончания сортировки и  зак-
 
      рытия входных и выходного файлов.
 
           Пример.
 
           Ведется сортировка последовательного файла с  примене-
 
      нием файлового интерфейса:
 
      INTEGER STATUS,
 
      2       FN_SIZE_IN,
 
      2       FN_SIZE_OUT,
 
      2       LUN_IN,
 
      2       LUN_OUT
 
      CHARACTER*256 FILENAME_IN,
 
      2             FILENAME_OUT
 
      INTEGER LIB$GET_INPUT,
 
      2       LIB$GET_LUN,
 
      2       SOR$PASS_FILES,
 
      2       SOR$BEGIN_SORT,
 
      2       SOR$SORT_MERGE,
 
      2       SOR$END_SORT
 
      EXTERNAL DSC$K_DTYPE_T  !определение типа символьных данных


                                - 52 -
 
                          00152-01 97 09-3
 
 
      ! определить запись
 
      STRUCTURE /EMPLOYEE/
 
       CHARACTER*20 NAME       ! 1:20
 
       CHARACTER*20 ADDRESS    ! 21:40
 
       CHARACTER*19 CITY       ! 41:59
 
       CHARACTER*2  STATE      ! 60:61
 
       CHARACTER*9  ZIP_CODE   ! 52:70
 
      END STRUCTURE
 
      RECORD /EMPLOYEE/ TEMP
 
      ! ключевая информация сортировки-- 1 ключ
 
      INTEGER*2  KEY_BUFFER (5)
 
      KEY_BUFFER (1) = 1                   !число ключей
 
      KEY_BUFFER (2) = %LOC(DSC$K_DTYPE_T) !символьные данные
 
      KEY_BUFFER (3) = 0           !сортировка по возрастанию
 
      KEY_BUFFER (4) = 0    !начало при нулевом смещении (поз.1)
 
      KEY_BUFFER (5) = 20   !длина ключа
 
      ! принять имя входного файла
 
      STATUS = LIB$GET_INPUT (FILENAME_IN,
 
      2                       'имя входного файла: ',
 
      2                       FN_SIZE_IN)
 
      IF (.NOT. STATUS) CALL LIB$SIGNAL (%VAL (STATUS))
 
      ! принять имя выходного файла
 
      STATUS = LIB$GET_INPUT (FILENAME_OUT,
 
      2                       'имя выходного файла: ',
 
      2                       FN_SIZE_OUT)
 
      IF (.NOT. STATUS) CALL LIB$SIGNAL (%VAL (STATUS))
 
      ! передать файлы в SORT
 
      STATUS = SOR$PASS_FILES (FILENAME_IN (1:FN_SIZE_IN),
 
      2                        FILENAME_OUT (1:FN_SIZE_OUT))
 
      IF (.NOT. STATUS) CALL LIB$SIGNAL (%VAL (STATUS))


                                - 53 -
 
                          00152-01 97 09-3
 
 
      ! передать ключевую информацию в SORT
 
      STATUS = SOR$BEGIN_SORT (KEY_BUFFER)
 
      IF (.NOT. STATUS) CALL LIB$SIGNAL (STATUS))
 
      ! выполнить сортировку
 
      STATUS = SOR$SORT_MERGE ()
 
      IF (.NOT. STATUS) CALL LIB$SIGNAL (%VAL (STATUS))
 
      ! конец сортировки
 
      STATUS = SOR$END_SORT ()
 
      IF (.NOT. STATUS) CALL LIB$SIGNAL (%VAL (STATUS))
 
      END
 
 
 
           1.3.3.3. Сортировка с интерфейсом по записи
 
 
           Для сортировки файлов с использованием  интерфейса  по
 
      записи выполняются следующие действия:
 
           1) вызов SOR$BEGIN_SORT для передачи информации о клю-
 
      чах наибольшей длины записи и возможностей сортировки  (для
 
      интерфейса по записи должен быть задан параметр LRL - длина
 
      записи);
 
           2) вызов SOR$RELEASE_REC один раз  на  каждую  запись,
 
      передаваемую в SORT (должен быть задан буфер записи - пара-
 
      метр DESC);
 
           3) вызов SOR$SORT_MERGE для выполнения сортировки;
 
           4) вызов  SOR$RETURN_REC  по  одному  разу  на  каждую
 
      запись, которая должна быть возвращена из SORT (должен быть
 
      задан буфер записи - параметр DESC);
 
           5) вызов SOR$END_SORT для окончания сортировки и  зак-
 
      рытия выходного и входных файлов.
 
           Пример.
 
           Сортировка последовательного файла ведется с использо-
 


                                - 54 -
 
                          00152-01 97 09-3
 
 
      ванием   интерфейса   по   записи.   Так   как    процедуры
 
      SOR$RELEASE_REC и SOR$RETURN_REC  требуют  передачи  записи
 
      как строки  символов,  то  структурный  блок,  определяющий
 
      переменную типа записи, использует блок об'единения;  пере-
 
      менная может  быть  интерпретирована  как  набор  различных
 
      полей и как одно поле строки символов:
 
      INTEGER STATUS,
 
      2       FN_SIZE_IN,
 
      2       FN_SIZE_OUT,
 
      2       LUN_IN,
 
      2       LUN_OUT,
 
      2       IOSTAT
 
      INTEGER*2 LRL/72/
 
      CHARACTER*256 FILENAME_IN,
 
      2             FILENAME_OUT
 
      INTEGER LIB$GET_INPUT,
 
      2       LIB$GET_LUN,
 
      2       SOR$BEGIN_SORT,
 
      2       SOR$RELEASE_REC,
 
      2       SOR$SORT_MERGE,
 
      2       SOR$RETURN_REC,
 
      2       SOR$END_SORT
 
      INCLUDE '($FORDEF)'
 
      INCLUDE '($SSDEF)'
 
      EXTERNAL DSC$K_DTYPE_T
 
      PARAMETER STATUS_OK = 1
 
      ! открыть выходной файл
 
      OPEN (UNIT=LUN_OUT,
 
      2     FILE=FILENAME_OUT (1:FN_SIZE_OUT),
 
      2     ORGANIZATION = 'SEQUENTIAL',


                                - 55 -
 
                          00152-01 97 09-3
 
 
      2     ACCESS = 'SEQUENTIAL',
 
      2     RECORDTYPE = 'FIXED',
 
      2     FORM = 'UNFORMATTED',
 
      2     RECL = 18,
 
      2     STATUS = 'NEW')
 
      ! отдать в SORT ключевую информацию
 
      STATUS = SOR$BEGIN_SORT (KEY_BUFFER,
 
      2                        LRL)
 
      IF (.NOT. STATUS) CALL LIB$SIGNAL (%VAL (STATUS))
 
      ! читать первую запись входного файла
 
      READ (UNIT=LUN_IN,
 
      2     IOSTAT=IOSTAT) TEMP
 
      IF (IOSTAT .NE. IOSTAT_OK) THEN
 
        CALL ERRSNS (,,,,STATUS)
 
        IF (STATUS .NE. FOR$_ENDDURREA) THEN
 
          CALL LIB$SIGNAL (%VAL (STATUS))
 
        END IF
 
      END IF
 
      ! передать каждую запись в SORT
 
      DO WHILE (STATUS .NE. FOR$ENDDURREA)
 
        ! передача записи
 
        STATUS = SOR$RELEASE_REC (TEMP.STRING)
 
        IF (.NOT. STATUS) CALL LIB$SIGNAL (%VAL (STATUS))
 
        ! читать следующую запись
 
        READ (UNIT=LUN_IN,
 
      2       IOSTAT=IOSTAT) TEMP
 
        IF (IOSTAT .NE. IOSTAT_OK) THEN
 
          CALL ERRSNS (,,,, STATUS)
 
          IF (STATUS .NE. FOR$_ENDDURREA) THEN
 
            CALL LIB$SIGNAL (%VAL (STATUS))


                                - 56 -
 
                          00152-01 97 09-3
 
 
          END IF
 
        END IF
 
      END DO
 
      ! начало сортировки
 
      STATUS = SOR$SORT_MERGE ()
 
      IF (.NOT. STATUS) CALL LIB$SIGNAL (%VAL (STATUS))
 
      ! получить запись из SORT
 
      STATUS = SOR$RETURN_REC (TEMP.STRING)
 
      IF (.NOT. STATUS) CALL LIB$SIGNAL (%VAL (STATUS))
 
      ! писать выходные записи
 
      DO WHILE (STATUS .NE. SS$_ENDOFFILE)
 
        ! писать запись в выходной файл
 
        WRITE (UNIT = LUN_OUT,
 
      2        IOSTAT=IOSTAT) TEMP
 
        IF (IOSTAT .NE. IOSTAT_OK) THEN
 
          CALL ERRSNS (,,,,STATUS)
 
          CALL LIB$SIGNAL (%VAL (STATUS))
 
        END IF
 
        ! издать следующую запись
 
        STATUS = SOR$RETURN_REC (TEMP.STRING)
 
        IF ((STATUS .NE. STATUS_OK) .AND.
 
      2     (STATUS .NE. SS$ENDOFFILE)) THEN
 
          CALL LIB$SIGNAL (%VAL (STATUS))
 
        END IF
 
      END DO
 
      ! конец сортировки
 
      STATUS = SOR$END_SORT ()
 
      IF (.NOT. STATUS) CALL LIB$SIGNAL (%VAL (STATUS))
 
      END  !конец программы  .
 


                                - 57 -
 
                          00152-01 97 09-3
 
 
           1.3.3.4. Слияние файловым интерфейсом
 
 
           Для слияния записей с использованием файлового  интер-
 
      фейса выполняются следующие действия:
 
           1) вызов  SOR$PASS_FILES  для  передачи   спецификаций
 
      входных и выходного файлов в  SORT.  Разрешается  иметь  до
 
      десяти входных файлов. Если входных файлов много, то  вызов
 
      SOR$PASS_FILES делается по одному разу для каждого входного
 
      файла. Выходной файл должен быть задан при  первом  вызове.
 
      Характеристики выходного файла определяются набором не обя-
 
      зательных параметров [3];
 
           2) вызов SOR$BEGIN_SORT для передачи ключевой информа-
 
      ции и возможностей слияния. Разрешено задать набор  возмож-
 
      ностей слияния, включая написанную пользователем  процедуру
 
      сравнения ключей. При  использовании  файлового  интерфейса
 
      SOR$BEGIN_MERGE открывает входные и выходной файлы  и  ини-
 
      циирует операцию слияния;
 
           3) вызов SOR$END_MERGE для завершения слияния и закры-
 
      тия входных и выходного файлов.
 
           Пример.
 
           Два последовательных файла сливаются с  использованием
 
      файлового интерфейса:
 
      INTEGER STATUS,
 
      2       FN_SIZE_IN1,
 
      2       FN_SIZE_IN2,
 
      2       FN_SIZE_OUT,
 
      2       LUN_OUT
 
      CHARACTER*256 FILENAME_IN1,
 
      2             FILENAME_IN2,
 
      2             FILENAME_OUT
 


                                - 58 -
 
                          00152-01 97 09-3
 
 
      INTEGER LIB$GET_INPUT,
 
      2       LIB$GET_LUN,
 
      2       SOR$PASS_FILES,
 
      2       SOR$BEGIN_MERGE,
 
      2       SOR$END_SORT
 
      EXTERNAL DSC$K_DTYPE_T
 
      ! определить запись
 
      STRUCTURE /EMPLOYEE/
 
       CHARACTER*22 NAME               !  1:20
 
       CHARACTER*20 ADDRESS            ! 21:40
 
       CHARACTER*19 CITY               ! 41:59
 
       CHARACTER*2 STATE               ! 60:61
 
       CHARACTER*9 ZIP_CODE            ! 62:70
 
      END STRUCTURE
 
      RECORD /EMPLOYEE/ TEMP
 
      ! ключевая информация сортировки - 1 ключ
 
      INTEGER*2 KEY_BUFFER (5)
 
      KEY_BUFFER (1) = 1                   !число ключей
 
      KEY_BUFFER (2) = %LOC(DSC$K_DTYPE_T) !данные символьные
 
      KEY_BUFFER (3) = 0           !сортировка по возрастанию
 
      KEY_BUFFER (4) = 0           !начало при смещении 0 (поз.1)
 
      KEY_BUFFER (5) = 22          !длина ключа
 
      ! принять имя первого входного файла
 
      STATUS = LIB$GET_INPUT (FILENAME_IN1,
 
      2                       'имя входного файла: ',
 
      2                       FN_SIZE_IN1)
 
      IF (.NOT. STATUS) CALL LIB$SIGNAL (%VAL (STATUS))
 
      ! принять имя второго входного файла
 
      STATUS = LIB$GET_INPUT (FILENAME_IN2,
 
      2                       'имя входного файла: ',


                                - 59 -
 
                          00152-01 97 09-3
 
 
      2                       FN_SIZE_IN2)
 
      IF (.NOT. STATUS) CALL LIB$SIGNAL (%VAL (STATUS))
 
      ! принять имя выходного файла
 
      STATUS = LIB$GET_INPUT (FILENAME_OUT,
 
      2                       'имя выходного файла: ',
 
      2                       FN_SIZE_OUT)
 
      IF (.NOT. STATUS) CALL LIB$SIGNAL (%VAL (STATUS))
 
      ! передать файлы в SORT - выходной файл при первом вызове
 
      STATUS = SOR$PASS_FILES (FILENAME_IN1 (1:FN_SIZE_IN1),
 
      2                        FILENAME_OUT (1:FN_SIZE_OUT))
 
      IF (.NOT. STATUS) CALL LIB$SIGNAL (%VAL (STATUS))
 
      ! передать второй входной файл в SORT
 
      STATUS = SOR$PASS_FILES (FILENAME_IN2 (1:FN_SIZE_IN2))
 
      IF (.NOT. STATUS) CALL LIB$SIGNAL (%VAL (STATUS))
 
      ! передать в SORT ключевую информацию
 
      STATUS = SOR$BEGIN_MERGE (KEY BUFFER)
 
      IF (.NOT. STATUS) CALL LIB$SIGNAL (%VAL (STAтUS))
 
      ! конец слияния
 
      STATUS = SOR$END_SORT ()
 
      IF (.NOT. STATUS) CALL LIB$SIGNAL (%VAL (STATUS))
 
      END  !конец программы  .
 
 
 
           1.3.3.5. Слияние с интерфейсом по записи
 
 
           Для слияния последовательных файлов  с  использованием
 
      интерфейса по записи выполняются следующие действия:
 
           1) вызов SOR$BEGIN_MERGE  для  передачи  информации  о
 
      ключах, наибольшей длины  записи,  порядка  слияния  (число
 
      подлежащих слиянию входных файлов) и пользовательской  про-
 
      цедуры ввода. Последние три параметра (LRL,  MERGE_ORDER  и
 


                                - 60 -
 
                          00152-01 97 09-3
 
 
      USER_INPUT) при использовании интерфейса по  записи  обяза-
 
      тельны; первый параметр  (KEY_BUFFER)  может  быть  опущен,
 
      если задается операция сравнения  ключей.  Пользовательская
 
      процедура ввода должна определять очередность чтения  вход-
 
      ных файлов, получать запись и определять ее длину;
 
           2) вызов SOR$RETURN_REC для получения очередной  запи-
 
      си, возвращаемой из SORT (должен быть задан параметр DEX  -
 
      буфер для записи). SOR$RETURN_REC вызывает пользовательскую
 
      процедуру ввода до тех пор,  пока  не  будут  переданы  все
 
      записи. При использовании интерфеса по записи выпуск, слия-
 
      ние  и  чтение   записей   происходят   во   время   вызова
 
      SOR$RETURN_REC;
 
           3) вызов SOR$END_SORT для завершения слияния и  закры-
 
      тия входных и выходного файлов.
 
           Пользовательская процедура ввода  должна  воспринимать
 
      четыре параметра: буфер для записи, параметр порядка файлов
 
      (целое число, переданное из SORT и указывающее номер  вход-
 
      ного файла для чтения), длина буфера записи (целое) и  кон-
 
      текстный параметр (длинное слово, используемое для слежения
 
      за одновременными операциями). Процедура должна  возвращать
 
      значение состояния: либо SS$_NORMAL  при  успешном  чтении,
 
      либо SS$_ENDOFFILE в ситуации "конец файла".  Любую  другую
 
      ошибку SOR$BEGIN_MERGE передает обратно в программу, выпол-
 
      няющую слияние.
 
           Пример.
 
           Два последовательных файла сливаются с  использованием
 
      интерфейса  по  записи.  Блок  общей  памяти   UNIT_NUMBERS
 
      используется  для  передачи  логических  номеров  устройств
 
      входных  файлов  в  процедуру  ввода  GET_RECORD.  Так  как
 
      SOR$RETURN_REC требует передачи ей записи как строки симво-


                                - 61 -
 
                          00152-01 97 09-3
 
 
      лов, то  структурный  блок,  определяющий  переменную  типа
 
      записи,  использует  блок  об'единения,  который  позволяет
 
      интерпретировать в переменной типа записи разные  поля  как
 
      единое поле строки символов:
 
 
      INTEGER STATUS,
 
      2       GET_RECORD,
 
      2       FN_SIZE_IN1,
 
      2       FN_SIZE_IN2,
 
      2       FN_SIZE_OUT,
 
      2       STATUS_OK,
 
      2       IOSTAT_OK,
 
      2       LUN_IN1,
 
      2       LUN_IN2,
 
      2       LUN_OUT,
 
      2       RECORD_LEN
 
      2       IOSTAT
 
      PARAMETER (STATUS_OK = 1)
 
      PARAMETER (IOSTAT_OK = 0)
 
      INTEGER*2 LRL /72/
 
      EXTERNAL DSC$K_DTYPE_T
 
      LOGICAL*1 ORDER         !порядок слияния
 
      DATA ORDER/2/
 
      ! блок общей памяти для передачи логических номеров
 
      ! устройств
 
      COMMON /UNIT_NUMBERS/ LUN_IN1,
 
      2                     LUN_IN2
 
      CHARACTER*256 FILENAME_IN1,
 
      2             FILENAME_IN2,
 
      2             FILENAME_OUT
 


                                - 62 -
 
                          00152-01 97 09-3
 
 
      EXTERNAL GET_RECORD
 
      INTEGER LIB$GET_INPUT,
 
      2       LIB$GET_LUN,
 
      2       SOR$BEGIN_MERGE,
 
      2       SOR$RETURN_REC,
 
      2       SOR$PASS_FILES,
 
      2       SOR$END_SORT
 
      INCLUDE '($FORDEF)'
 
      INCLUDE '($SSDEF)'
 
      ! определить запись
 
      STRUCTURE /EMPLOYEE/
 
       UNION
 
        MAP
 
         CHARACTER*22 NAME               ! 1:20
 
         CHARACTER*20 ADDRESS            ! 21:40
 
         CHARACTER*19 CITY               ! 41:59
 
         CHARACTER*2  STATE              ! 60:61
 
         CHARACTER*9  ZIP_CODE           ! 62:70
 
        END MAP
 
        MAP
 
         CHARACTER*72 STRING             !целая запись
 
        END мар
 
       END UNION
 
      END STRUCTURE
 
      RECORD /EMPLOYEE/ TEMP
 
      ! ключевая информация сортировки - 1 ключ
 
      INTEGER*2 KEY_BUFFER (5)
 
      KEY_BUFFER (1) = 1                   !число ключей
 
      KEY_BUFFER (2) = %LOC(DSC$K_DTYPE_T) !символьные данные
 
      KEY_BUFFER (3) = 0    !сортировка по возрастанию


                                - 63 -
 
                          00152-01 97 09-3
 
 
      KEY_BUFFER (4) = 0    !начало на нулевом смещении (поз.1)
 
      KEY_BUFFER (5) = 22   !длина ключа
 
      ! принять имя первого файла
 
      STATUS = LIB$GET_INPUT (FILENAME_IN1,
 
      2                       'имя входного файла: ',
 
      2                       FN_SIZE_IN1)
 
      IF (.NOT. STATUS) CALL LIB$SIGNAL (%VAL (STATUS))
 
      ! принять имя второго файла
 
      STATUS = LIB$GET_INPUT (FILENAME_IN2,
 
      2                       'имя входного файла: ',
 
      2                       FN_SIZE_IN2)
 
      IF (.NOT.STATUS) CALL LIB$SIGNAL (%VAL (STATUS))
 
      !принять имя выходного файла
 
      STATUS = LIB$GET_INPUT (FILENAME_OUT,
 
      2                       'имя выходного файла: ',
 
      2                       FN_SIZE_OUT)
 
      IF (.NOT. STATUS) CALL LIB$SIGNAL (%VAL (STATUS))
 
      ! взять свободный логический номер устройства
 
      STATUS = LIB$GET_LUN (LUN_IN1)
 
      IF (.NOT. STATUS) CALL LIB$SIGNAL (%VAL (STATUS))
 
      ! открыть входной файл
 
      OPEN (UNIT=LUN_IN1,
 
      2     FILE=FILENAME_IN1 (1:FN_SIZE_IN1),
 
      2     ORGANIZATION='SEQUENTIAL',
 
      2     ACCESS='SEQENTIAL',
 
      2     RECORDTYPE='FIXED',
 
      2     FORM='UNFORMATTED',
 
      2     RECL=18,
 
      2     STATUS='OLD')
 
      ! принять свободный номер устройства


                                - 64 -
 
                          00152-01 97 09-3
 
 
      STATUS = LIB$GET_LUN (LUN_IN2)
 
      IF (.NOT. STATUS) CALL LIB$SIGNAL (%VAL(STATUS))
 
      ! открыть второй входной файл
 
      OPEN (UNIT=LUN_IN2,
 
      2     FILE=FILENAME_IN2 (1:FN_SIZE_IN2),
 
      2     ORGANIZATION='SEQUENTIAL',
 
      2     ACCESS='SEQUENTIAL',
 
      2     RECORDTYPE='FIXED',
 
      2     FORM='UNFORMATTED',
 
      2     RECL=18,
 
      2     STATUS='OLD')
 
      ! взять свободный логический номер устройства
 
      STATUS = LIB$GET_LUN (LUN_OUT)
 
      IF (.NOT. STATUS) CALL LIB$SIGNAL (%VAL (STATUS))
 
      ! открыть выходной файл
 
      OPEN (UNIT=LUN_OUT,
 
      2     FILE FILENAME_OUT (1:FN_SIZE_OUT),
 
      2     ORGANIZATION='SEQUENTIAL',
 
      2     ACCESS='SEQUENTIAL',
 
      2     RECORDTYPE='FIXED',
 
      2     FORM='UNFORMATTED',
 
      2     RECL=18
 
      2     STATUS='NEW')
 
      ! начать MERGE
 
      STATUS = SOR$BEGIN_MERGE (KEY_BUFFER,
 
      2                         LRL,,
 
      2                         ORDER,,,
 
      2                         GET_RECORD)
 
      IF (.NOT. STATUS) CALL LIB$SIGNAL (%VAL (STATUS))
 
      ! прием, слияние и выпуск записей


                                - 65 -
 
                          00152-01 97 09-3
 
 
      ! RETURN_REC CALLS GET_RECORD FOR INPUT
 
      DO WHILE (STATUS .NE. SS$ENDOFFILE)
 
        STATUS = SOR$RETURN_REC (TEMP.STRING,
 
      2                          RECORD_LEN)
 
        IF (.NOT. STATUS) THEN
 
          IF (STATUS .NE. SS$ENDOFFILE)
 
      2     CALL LIB$SIGNAL (%VAL (STATUS))
 
        ELSE
 
          ! писать запись в выходной файл
 
          WRITE (UNIT=LUN_OUT,
 
      2          IOSTAT=IOSTAT) TEMP
 
        IF (IOSTAT .NE. IOSTAT_OK) THEN
 
          CALL ERRSNS (,,,,STATUS)
 
          CALL LIB$SIGNAL (%VAL STATUS))
 
        END IF
 
       END IF
 
      END DO
 
      ! конец сортировки
 
      STATUS = SOR$END_SORT ()
 
      IF (.NOT. STATUS) CALL LIB$SIGNAL (%VAL (STATUS))
 
      END
 
      ! пользовательская функция получения записей
 
      INTEGER FUNCTION GET_RECORD (RECORDX,
 
      2                            FILE_ORDER,
 
      2                            SIZE)
 
      INTEGER STATUS,
 
      2       IOSTAT,
 
      2       STATUS_OK,
 
      2       IOSTAT_OK,
 
      2       MAX_NUM_FILES,


                                - 66 -
 
                          00152-01 97 09-3
 
 
      2       LUNX,
 
      2       FILE_ORDER,
 
      2       SIZE
 
      PARAMETER (STATUS_OK = 1)
 
      PARAMETER (IOSTAT_OK = 0)
 
      PARAMETER (MAX_NUM_FILES = 2) !максимальное число
 
                                    !входных файлов
 
      INCLUDE '($SSDEF)'
 
      INCLUDE '($FORDEF)'
 
      COMMON /UNIT_NUMBERS/ LUN_IN1,
 
      2                     LUN_IN2
 
      CHARACTER*72 RECORDX           !буфер записи
 
      GET_RECORD = SS$NORMAL
 
      ! определить, какой из входных файлов читать
 
      IF (FILE_ORDER .EQ. 1) THEN
 
        LUNX = LUN_IN1
 
      ELSE IF (FILE_ORDER .EQ. 2) THEN
 
        LUNX = LUN_IN2
 
      ELSE IF ((FILE_ORDER .LT. 1) .OR.
 
      2          (FILE_ORDER .GT. MAX_NUM_FILES)) THEN
 
        GET_RECORD = SS$ENDOFFILE
 
      END IF
 
      IF (GET_RECORD .NE. SS$ENDOFFILE) THEN
 
        ! читать запись из входного файла
 
        READ (UNIT=LUNX,
 
      2       IOSTAT=IOSTAT) RECORDX
 
        ! ошибка при чтении
 
        IF (IOSTAT .NE. IOSTAT_OK) THEN
 
          CALL ERRSNS (,,,,STATUS)
 
          IF (STATUS .EQ. FOR$ENDDURREA) THEN


                                - 67 -
 
                          00152-01 97 09-3
 
 
            GET_RECORD = SS$ENDOFFILE
 
          ELSE
 
            CALL LIB$SIGNAL (%VAL(STATUS))
 
          END IF
 
        END IF
 
        ! успешное чтение
 
        SIZE = LEN (RECORDX)
 
      END IF
 
      еND  !конец программы  .
 
 
 
           1.4. Обработка базы данных по частям
 
 
           Индексированный  файл  состоит  из  записей,   которые
 
      содержат наборы ключей. Каждый ключ из набора занимает одну
 
      и ту же позицию в своей записи. Каждый набор ключей состав-
 
      ляет один индекс в записях файла. Структура  записи  позво-
 
      ляет осуществлять:
 
           1) прямой доступ. Доступ к конкретной записи осуществ-
 
      ляется заданием значения одного из ее ключей;
 
           2) последовательный доступ. Доступ к записям осуществ-
 
      ляется последовательно  по  возрастающим  значениям  набора
 
      ключей.
 
           Ключи могут быть целые или символьные. Индексированный
 
      файл обязан иметь по крайней  мере  один  ключ,  первичный;
 
      может иметь до 254 альтернативных ключей.
 
           Например, необходимо хранить  следующую  информацию  о
 
      заказах покупателей: номер заказа, идентификационный  номер
 
      покупателя, номер об'екта.
 
           Можно обеспечить возможность прямого доступа к  заказу
 
      либо по его номеру, либо по идентификационному номеру поку-
 


                                - 68 -
 
                          00152-01 97 09-3
 
 
      пателя; задать номер заказа как первичный  ключ,  поскольку
 
      он определен однозначно; идентификационный номер покупателя
 
      задать вторым ключом (альтернативным).
 
 
 
           1.4.1. Создание индексированного файла
 
 
           Для создания индексированного файла используется  опе-
 
      ратор OPEN с такими спецификаторами:
 
           1) STATUS = 'NEW';
 
           2) ORGANIZATION = 'INDEXED';
 
           3) ACCESS = 'KEYED';
 
           4) RECL = N; причем N представляет собой точный размер
 
      для записей фиксированной длины и максимальную величину для
 
      записей переменной длины. Для форматных файлов  величина  N
 
      задается в байтах, а для неформатных - в длинных словах;
 
           5) KEY = (начало:конец:тип,...): первые  два  значения
 
      являются позициями начального и конечного байта  поля;  тип
 
      ключа должен быть INTEGER*2 (2 байта), INTEGER*4 (4  байта)
 
      или CHARACTER.
 
           Первичный ключ (ключ 0) задается первым, за ним указы-
 
      вается первый из альтернативных ключей (ключ 1) и т.д.
 
           По умолчанию не разрешается совпадение  значений  пер-
 
      вичного ключа, т.е. никакие  две  записи  одного  файла  не
 
      могут иметь одинаковые значения первичного ключа. Для  аль-
 
      тернативных ключей совпадающие значения разрешаются.
 
           Примеры:
 
           1. Определяется запись и соответствующий  спецификатор
 
      ключа; для гарантии непрерывности полей используется  пере-
 
      менная типа записи:
 


                                - 69 -
 
                          00152-01 97 09-3
 
 
      ! определение записи
 
      STRUCTURE /ITEM/
 
       INTEGER*4      ORDER_NUMBER  ! ключ 0, позиции 1-4
 
       CHARACTER*10   CUSTOMER_ID   ! ключ 1, позиции 5-14
 
       INTEGER*2      ITEM_NUMBER   ! позиции 15-16
 
      END STRUCTURE
 
      ! спецификация ключа
 
      KEY = (1:4:INTEGER, 5:14:CHARACTER) !  .
 
 
           2. Создается индексированный файл с  первичным  ключом
 
      ORDER_NUMBER и альтернативным ключом CUSTOMER_ID:
 
 
      INTEGER STATUS,
 
      2       LUN
 
      INTEGER*2 ORDER_SIZE,
 
      2         ITEM_SIZE
 
      CHARACTER*256 FILENAME
 
      INTEGER*2 FN_SIZE
 
      CHARACTER*4 ORDER_INT
 
      CHARACTER*2 ITEM_INT
 
      ! определить запись
 
      STRUCTURE /ITEM/
 
       INTEGER*4 ORDER_NUMBER      !позиция 1--4 (ключ 0)
 
       CHARACTER*10 CUSTOMER_ID    !позиция 5--14 (ключ 1)
 
       INTEGER*4 CUSTOMER_LEN
 
       INTEGER*2 ITEM_NUMBER       !позиция 15--16
 
      END STRUCTURE
 
      RECORD /ITEM/ TEMP
 
      INTEGER LIB$GET_INPUT,
 
      2       LIB$GET_LUN
 
      ! принять имя файла


                                - 70 -
 
                          00152-01 97 09-3
 
 
      STATUS = LIB$GET_INPUT (FILENAME,
 
      2                       'имя файла: ',
 
      2                       FN_SIZE)
 
      IF (.NOT. STATUS) CALL LIB$SIGNAL (%VAL (STATUS))
 
      ! взять свободный логический номер устройства
 
      STATUS = LIB$GET_LUN (LUN)
 
      IF (.NOT. STATUS) CALL LIB$SIGNAL (%VAL (STATUS))
 
      ! открыть файл
 
      OPEN (UNIT = LUN,
 
      2     FILE=FILENAME (1:FN_SIZE),
 
      2     ORGANIZATION='INDEXED',
 
      2     ACCESS='KEYED',
 
      2     RECORDTYPE='FIXED',
 
      2     FORM='UNFORMATTED',
 
      2     RECL=5,
 
      2     KEY=(1:4:INTEGER, 5:14:CHARACTER),
 
      2     STATUS='NEW')
 
      !продолжение программы  .
 
 
 
           1.4.2. Запись в индексированный файл
 
 
           Оператор WRITE вставляет в файл новую запись и  обнов-
 
      ляет индексы так, что к этой записи может быть  осуществлен
 
      доступ по любому из ее ключей.  Вставляемая  запись  должна
 
      включать первичный ключ;  вторичный  ключ  можно  опустить,
 
      если он находится в конце записи переменной длины.
 
           Пример.
 
           Программа создает индексный  файл,  используя  ввод  с
 
      терминала (контроль ошибок ввода опущен):
 


                                - 71 -
 
                          00152-01 97 09-3
 
 
      INTEGER STATUS,
 
      2       LUN
 
      INTEGER*2 ORDER_SIZE,
 
      2         ITEM_SIZE
 
      CHARACTER*256 FILENAME
 
      INTEGER*2 FN_SIZE
 
      CHARACTER*4 ORDER_INT
 
      CHARACTER*2 ITEM_INT
 
      ! определить запись
 
      STRUCTURE /ITEM/
 
      INTEGER*4 ORDER_NUMBER      !позиция 1--4 (ключ 0)
 
      CHARACTER*10 CUSTOMER_ID    !позиция 5-14 (ключ 1)
 
      INTEGER*4 CUSTOMER_LEN
 
      INTEGER*2 ITEM_NUMBER       !позиция 15--16
 
      END STRUCTURE
 
      RECORD /ITEM/ TEMP
 
      INTEGER LIB$GET_INPUT,
 
      2       LIB$GET_LUN
 
      ! принять имя файла
 
      STATUS = LIB$GET_INPUT (FILENAME,
 
      2                       'имя файла: ',
 
      2                       FN_SIZE)
 
      IF (.NOT. STATUS) CALL LIB$SIGNAL (%VAL (STATUS))
 
      ! взять свободный логический номер устройства
 
      STATUS = LIB$GET_LUN (LUN)
 
      IF (.NOT. STATUS) CALL LIB$SIGNAL (%VAL (STATUS))
 
      ! открыть файл
 
      OPEN (UNIT=LUN,
 
      2     FILE=FILENAME (1:FN_SIZE),
 
      2     ORGANIZATION='INDEXED',


                                - 72 -
 
                          00152-01 97 09-3
 
 
      2     ACCESS='KEYED',
 
      2     RECORDTYPE='FIXED',
 
      2     FORM='UNFORMATTED',
 
      2     RECL=5,
 
      2     KEY=(1:4:INTEGER, 5:14:CHARACTER),
 
      2     STATUS='NEW')
 
      ! инструкции
 
      STATUS = LIB$PUT_OUTPUT ('для завершения введите 0)
 
      IF (.NOT. STATUS) CALL LIB$SIGNAL (%VAL(STATUS))
 
      STATUS = LIB$PUT_OUTPUT (' ')
 
      IF (.NOT. STATUS) CALL LIB$SIGNAL (%VAL(STATUS))
 
      ! принять входную запись
 
      STATUS = LIB$GET_INPUT (ORDER_INT,
 
      2                       'номер заказа: ',
 
      2                       ORDER_SIZE)
 
      IF (.NOT. STATUS) CALL LIB$SIGNAL (%VAL(STATUS))
 
      ! преобразовать в целое
 
      READ (UNIT=ORDER_INT(1:ORDER_SIZE),
 
      2     FMT='(BN,I)') TEMP.ORDER_NUMBER
 
      DO WHILE (TEMP.ORDER_NUMBER .NE. 0)
 
        STATUS = LIB$GET_INPUT (TEMP.CUSTOMER_ID,
 
      2                        'номер клиента: ',
 
      2                        TEMP.CUSTOMER_LEN)
 
        IF (.NOT. STATUS) CALL LIB$SIGNAL (%VAL(STATUS))
 
        STATUS = LIB$GET_INPUT (ITEM_INT,
 
      2                         'номер пункта: ',
 
      2                         ITEM_SIZE)
 
        IF (.NOT. STATUS) CALL LIB$SIGNAL (%VAL(STATUS))
 
        ! преобразовать в целое
 
        READ (UNIT=ITEM_INT (1:ITEM_SIZE),


                                - 73 -
 
                          00152-01 97 09-3
 
 
      2       FMT='(BN,I)') TEMP.ITEM_NUMBER
 
        ! писать запись
 
        WRITE (UNIT=LUN) TEMP
 
        ! писать строку пробелов между записями
 
        STATUS = LIB$PUT_OUTPUT (' ')
 
        ! GET THE RECORD INPUT
 
        STATUS = LIB$GET_INPUT (ORDER_INT,
 
      2                         'номер заказа: ',
 
      2                         ORDER_SIZE)
 
        IF (.NOT. STATUS) CALL LIB$SIGNAL (%VAL(STATUS))
 
        ! CONVERT TO INTEGER
 
        READ (UNIT=ORDER_INT(1:ORDER_SIZE),
 
      2       FMT='(BN,I)') TEMP.ORDER_NUMBER
 
      END DO
 
      !продолжение программы  .
 
 
 
           1.4.3. Прямой доступ к записи
 
 
           Для доступа к заданной записи файла используется  опе-
 
      ратор READ, включающий следующие спецификаторы:
 
           1) KEYID -  задает  ключевое  поле  для  исследования.
 
      KEYID (ключ ссылки) принимает целые значения, соответствую-
 
      щие номеру ключа (0 - для первичного ключа, 1 - для первого
 
      альтернативного и т.д.). Для первого чтения из файла  KEYID
 
      по умолчанию полагается  значением  первичного  ключа;  для
 
      последующих чтений KEYID  по  умолчанию  полагается  равным
 
      последнему из ключей ссылки, применявшихся  для  доступа  к
 
      файлу;
 
           2) KEY - задает значение заданного ключа в разыскивае-
 
      мой записи. Вместо KEY можно задать один из следующих  спе-
 


                                - 74 -
 
                          00152-01 97 09-3
 
 
      цификаторов;
 
           3) KEYEQ - значение ключа найденной записи должно рав-
 
      няться разыскиваемому значению (этот спецификатор полностью
 
      аналогичен спецификатору KEY);
 
           4) KEYGT - значение ключа разыскиваемой записи  должно
 
      быть больше, чем заданное значение;
 
           5) KEYGE - значение ключа разыскиваемой записи  должно
 
      быть больше или равно заданному значению.
 
           Если ни одна запись не имеет заданного значения ключа,
 
      будет выставлено  условие  ошибки  FOR$_ATTACCNON  (попытка
 
      доступа к несуществующей записи). При попытке получить дос-
 
      туп к записи, блокированной  другим  пользователем,  фикси-
 
      руется ошика FOR_SPERECLOC (указанная запись блокирована).
 
           Пример.
 
           Читаются и обрабатываются записи по первичному  ключу,
 
      вводимому с терминала:
 
      INTEGER STATUS,
 
      2       LUN,
 
      2       IOSTAT,
 
      2       IOSTAT_OK
 
      INTEGER*2      FN_SIZE
 
      CHARACTER*256  FILENAME
 
      CHARACTER*9    REQUEST_SOC
 
      INTEGER*4      SOC_LEN
 
      ! определить запись
 
      STRUCTURE /EMPLOYEE/
 
       CHARACTER*20  NAME
 
       CHARACTER*20  ADDRESS
 
       CHARACTER*15  CITY
 
       CHARACTER*2   STATE


                                - 75 -
 
                          00152-01 97 09-3
 
 
       CHARACTER*6   ZIP_CODE
 
       CHARACTER*9   SOC_SEC_NUM
 
      END  STRUCTURE
 
      RECORD /EMPLOYEE/ TEMP
 
      INTEGER LIB$GET_INPUT,
 
      2       LIB$GET_LUN
 
      ! принять имя файла
 
      STATUS = LIB$GET_INPUT (FILENAME,
 
      2                       'имя файла: ',
 
      2                       FN_SIZE)
 
      IF (.NOT. STATUS) CALL LIB$SIGNAL (%VAL (STATUS))
 
      ! принять требуемый номер социального страхования
 
      STATUS = LIB$GET_INPUT (REQUEST_SOC,
 
      2                       'DESIRED SS NUMBER: ',
 
      2                       SOC_LEN)
 
      IF (.NOT. STATUS) CALL LIB$SIGNAL (%VAL (STATUS))
 
      DO WHILE (SOC_LEN .NE. 9)
 
        ! GET REGUESTED SOCIAL SECURITY NUMBER
 
        STATUS = LIB$GET_INPUT (REQUEST_SOC,
 
      2                         'ENTER FULL SS NUMBER: ',
 
      2                         SOC_LEN)
 
        IF (.NOT. STATUS) CALL LIB$SIGNAL (%VAL(STATUS))
 
      END DO
 
      STATUS = LIB$GET_LUN (LUN)
 
      IF (.NOT. STATUS) CALL LIB$SIGNAL (%VAL (STATUS))
 
      ! открыть файл
 
      OPEN (UNIT=LUN,
 
      2     FILE=FILENAME (1:FN_SIZE),
 
      2     ORGANIZATION='INDEXED',
 
      2     ACCESS='KEYED',


                                - 76 -
 
                          00152-01 97 09-3
 
 
      2     RECORDTYPE='FIXED',
 
      2     FORM='UNFORMATTED',
 
      2     RECL=18,
 
      2     KEY=(64:72:CHARACTER),
 
      2     STATUS='OLD')
 
      ! читать запись
 
      READ (UNIT=LUN,
 
      2     KEY=REQUEST_SOC,
 
      2     KEYID=0) TEMP
 
      IF (IOSTAT .NE. IOSTAT_OK) THEN
 
        CALL ERRSNS (,,,,STATUS)
 
        IF (STATUS .NE. FOR$_ATTACCNON) THEN
 
          CALL LIB$SIGNAL (%VAL (STATUS))
 
        END IF
 
      END IF
 
      DO WHILE (STATUS .EQ. FOR$_ATTACCNON)
 
        ! принять требуемый номер социального страхования
 
        STATUS = LIB$GET_INPUT (REQUEST_SOC,
 
      2                         'DESIRED SS NUMBER: ',
 
      2                         SOC_LEN)
 
        IF (.NOT. STATUS) CALL LIB$SIGNAL (%VAL(STATUS))
 
        DO WHILE (SOC_LEN .NE. 9)
 
          ! принять требуемый номер социального страхования
 
          STATUS = LIB$GET_INPUT (REQUEST_SOC,
 
      2                           'ENTER FULL SS NUMBER: ',
 
      2                           SOC_LEN)
 
          IF (.NOT. STATUS) CALL LIB$SIGNAL (%VAL(STATUS))
 
        END DO
 
        ! читать запись
 
        READ (UNIT=LUN,


                                - 77 -
 
                          00152-01 97 09-3
 
 
      2       KEY=REQUEST_SOC,
 
      2       KEYID=0) TEMP
 
        IF (IOSTAT .NE. IOSTAT_OK) THEN
 
          CALL ERRSNS (,,,,STATUS)
 
          IF (STATUS .NE. FOR$_ATTACCNON) THEN
 
            CALL LIB$SIGNAL (%VAL(STATUS))
 
          END IF
 
        END IF
 
      END DO
 
      !продолжение программы  .
 
 
 
           1.4.4. Индексно-последовательный метод доступа
 
 
           Можно получить последовательный доступ к индексирован-
 
      ному файлу (как к последовательному) с  помощью  последова-
 
      тельного оператора READ. Однако индексированные файлы  поз-
 
      воляют иметь доступ к отдельным своим частям, но  не  имеют
 
      (в обычном смысле) начала. Действия могут быть следующими:
 
           1) первую  нужную  запись  можно  получить  с  помощью
 
      индексного оператора READ, указав ее ключ;
 
           2) последующие записи читаются  с  помощью  последова-
 
      тельных операторов READ. Записи возвращаются  в  последова-
 
      тельности ключа ссылки, указанного в предыдущем  шаге.  Эта
 
      последовательность варьируется в зависимости от ключа ссыл-
 
      ки;
 
           3) может быть последней записью  файла  или  последней
 
      записью из допустимых для чтения. После каждого  последова-
 
      тельного  оператора  READ   необходимо   проверять   ошибки
 
      FOR$ENDDURREA (конец файла), чтобы не пропустить  последнюю
 
      запись последовательности.
 


                                - 78 -
 
                          00152-01 97 09-3
 
 
           Пример.
 
           Читаются записи файла, начиная с записи, имеющей номер
 
      социального страхования больше или равный заданному ключом;
 
      заканчивая записью, содержащей номер социального  страхова-
 
      ния меньший или равный заданному  другим  ключом.  Заметим,
 
      что для получения первого  номера  социального  страхования
 
      программа использует KEYGE; можно использовать KEYEQ,  если
 
      только искомый номер известен точно.  Необходимо  отметить,
 
      что последняя запись определяется как  проверкой  на  конец
 
      файла, так и по номеру социального страхования, превосходя-
 
      щего значение STOP_SOC:
 
 
      INTEGER STATUS,
 
      2       LUN,
 
      2       IOSTAT,
 
      2       IOSTAT_OK
 
      INTEGER*2 FN_SIZE
 
      PARAMETER (IOSTAT_OK = 0)
 
      CHARACTER*256 FILENAME
 
      CHARACTER*9   START_SOC,
 
      2             STOP_SOC
 
      INTEGER*4     SOC_LEN
 
      INCLUDE '($FORDEF)'
 
      ! определить запись
 
      STRUCTURE /EMPLOYEE/
 
       CHARACTER*20 NAME
 
       CHARACTER*20 ADDRESS
 
       CHARACTER*15 CITY
 
       CHARACTER*2  STATE
 
       CHARACTER*6  ZIP_CODE
 


                                - 79 -
 
                          00152-01 97 09-3
 
 
       CHARACTER*9  SOC_SEC_NUM
 
      END STRUCTURE
 
      RECORD /EMPLOYEE/ TEMP
 
      INTEGER LIB$GET_INPUT,
 
      2       LIB$GET_LUN
 
      ! принять имя файла
 
      STATUS = LIB$GET_INPUT (FILENAME,
 
      2                       'имя файла: ',
 
      2                       FN_SIZE)
 
      IF (.NOT. STATUS) CALL LIB$SIGNAL (%VAL (STATUS))
 
      ! принять начальный номер социального страхования
 
      STATUS = LIB$GET_INPUT (START_SOC,
 
      2                       'начальный номер сс: ',
 
      2                       SOC_LEN)
 
      IF (.NOT. STATUS) CALL LIB$SIGNAL (%VAL(STATUS))
 
      DO WHILE (SOC_LEN .NE. 9)
 
        ! принять требуемый номер социального страхования
 
        STATUS = LIB$GET_INPUT (REQUEST_SOC,
 
      2                         'введите нужный номер сс: ',
 
      2                         SOC_LEN)
 
        IF (.NOT. STATUS) CALL LIB$SIGNAL (%VAL(STATUS))
 
      END DO
 
      ! принять конечный номер социального страхования
 
      STATUS = LIB$GET_INPUT (STOP_SOC,
 
      2                       'конечный номер сс: ')
 
      IF (.NOT. STATUS) CALL LIB$SIGNAL (%VAL(STATUS))
 
      DO WHILE (SOC_LEN .NE. 9)
 
        ! принять требуемый номер социального страхования
 
        STATUS = LIB$GET_INPUT (REQUEST_SOC,
 
      2                         'введите нужный номер сс: ',


                                - 80 -
 
                          00152-01 97 09-3
 
 
      2                         SOC_LEN)
 
        IF (.NOT. STATUS) CALL LIB$SIGNAL (%VAL(STATUS))
 
      END DO
 
      ! принять свободный логический номер устройства
 
      STATUS = LIB$GET_LUN (LUN)
 
      IF (.NOT. STATUS) CALL LIB$SIGNAL (%VAL(STATUS))
 
      ! открыть файл
 
      OPEN (UNIT=LUN,
 
      2     FILE=FILENAME (1:FN_SIZE),
 
      2     ORGANIZATION='INDEXED',
 
      2     ACCESS='KEYED',
 
      2     RECORDTYPE='FIXED',
 
      2     FORM='UNFORMATTED',
 
      2     RECL=18,
 
      2     KEY=(64:72:CHARACTER),
 
      2     STATUS='OLD')
 
      ! читать первую запись
 
      READ (UNIT=LUN,
 
      2     KEYGE=START_SOC,
 
      2     KEYID=0) TEMP
 
      DO WHILE ((TEMP.SOC_SEC_NUM .LE. STOP_SOC) .AND.
 
      2           (STATUS .NE. FOR$_ENDDURREA))
 
      !продолжение программы
 
        ! читать последующие записи
 
        READ (UNIT=LUN,
 
      2       IOSTAT=IOSTAT) TEMP
 
        IF (IOSTAT .NE. IOSTAT_OK) THEN
 
          CALL ERRSNS (,,,,STATUS)
 
          IF (STATUS .NE. FOR$_ENDDURREA) THEN
 
            CALL LIB$SIGNAL (%VAL(STATUS))


                                - 81 -
 
                          00152-01 97 09-3
 
 
          END IF
 
        END IF
 
      END DO
 
      !продолжение программы  .
 
 
 
           1.4.5. Доступ к записям по набору ключей
 
 
           В некоторых случаях желательно найти запись (или запи-
 
      си), обладающую несколькими заданными свойствами (атрибута-
 
      ми).
 
           Для идентификации записей с двумя или более требуемыми
 
      атрибутами необходимо  снабдить  каждую  запись  однозначно
 
      определенным идентификатором  (первичный  ключ)  и  сделать
 
      каждый атрибут вторичным (альтернативным) ключом. По задан-
 
      ному набору атрибутов программа составляет квалификационные
 
      списки записей и находит нужные записи посредством  сравне-
 
      ния списков.
 
           Пример.
 
           Выполняется  поиск  номера   автомобиля,   обладающего
 
      заданными свойствами. Каждая запись содержит набор  качеств
 
      автомобиля и его инвентарный номер, служащий  идентификато-
 
      ром. Пользователь может выбрать любые два качества (атрибу-
 
      та). Для первого атрибута программа проводит индексное чте-
 
      ние, сохраняя инвентарные номера в виде массива;  выполняет
 
      индексное чтение по второму атрибуту, сохраняя  инвентарные
 
      номера в виде другого массива;  затем  сравнивает  эти  два
 
      массива, печатая инвентарные номера  тех  записей,  которые
 
      содержат оба атрибута.
 
           Подпрограмма GET_ATTRIBUTE разрешает пользователю ука-
 
      зать требуемые атрибуты,  переводит  их  в  параметры  KEY,
 


                                - 82 -
 
                          00152-01 97 09-3
 
 
      KEYID и KEY_SIZE, и передает их обратно в основную програм-
 
      му для использования в операторах READ.
 
 
      IMPLICIT NONE
 
      INTEGER STATUS,
 
      2       LUN,
 
      2       KEYID,
 
      2       KEY_SIZE,
 
      2       I,
 
      2       ONECNT,
 
      2       ONE_MAX,
 
      2       TWOCNT,
 
      2       TWO_MAX,
 
      2       STATUS_OK,
 
      2       IOSTAT_OK,
 
      2       IOSTAT
 
      INTEGER*2 FN_SIZE
 
      CHARACTER*256 FILENAME
 
      CHARACTER*10 KEY
 
      CHARACTER*8 ARRAY1(255)
 
      CHARACTER*8 ARRAY2(255)
 
      CHARACTER*10 FIELD
 
      DATA ONECNT /1/
 
      DATA TWOCNT /1/
 
      PARAMETER (IOSTAT_OK = 0)
 
      PARAMETER (STATUS_OK = 1)
 
      INCLUDE '($FORDEF)'
 
      INCLUDE '($RMSDEF)'
 
      ! определить запись
 
      STRUCTURE /CAR/
 


                                - 83 -
 
                          00152-01 97 09-3
 
 
       CHARACTER*8  STOCK_NUMER     ! ключ 0 (номер авто)
 
       CHARACTER*10 MODEL           ! ключ 1 (модель)
 
       CHARACTER*3  COLOR           ! ключ 2 (цвет)
 
       CHARACTER*3  ENCINE_SIZE     ! ключ 3 (размер)
 
       CHARACTER*2  CYLINDERS       ! ключ 4 (число цилидров)
 
       CHARACTER*2  RADIO           ! ключ 5 (радио)
 
       CHARACTER*4  TRANS           ! ключ 6 (подвеска)
 
      END STRUCTURE
 
      RECORD /CAR/ TEMP
 
      INTEGER LIB$GET_INPUT,
 
      2       LIB$GET_LUN
 
      ! принять имя файла
 
      STATUS = LIB$GET_INPUT (FILENAME,
 
      2                       'имя файла: ',
 
      2                       FN_SIZE)
 
      IF (.NOT. STATUS) CALL LIB$SIGNAL (%VAL(STATUS))
 
      ! взять свободный логический номер устройства
 
      STATUS = LIB$GET_LUN (LUN)
 
      IF (.NOT. STATUS) CALL LIB$SIGNAL (%VAL(STATUS))
 
      ! открыть файл
 
      OPEN (UNIT=LUN,
 
      2     FILE=FILENAME (1:FN_SIZE),
 
      2     ORGANIZATION='INDEXED',
 
      2     ACCESS='KEYED',
 
      2     RECORDTYPE='FIXED',
 
      2     FORM='UNFORMATTED',
 
      2     RECL=8,
 
      2     KEY=(1:8:CHARACTER,9:18:CHARACTER,19:21:CHARACTER,
 
      2          22:24:CHARACTER,25:26:CHARACTER,27:28:CHARACTER,
 
      2          29:32:CHARACTER),


                                - 84 -
 
                          00152-01 97 09-3
 
 
      2     STATUS='OLD')
 
      CALL GET_ATTRIBUTE (KEYID,
 
      2                    KEY,
 
      2                    KEY_SIZE)
 
      ! читать запись
 
      READ  (UNIT=LUN,
 
      2      KEY=KEY(1:KEY_SIZE),
 
      2      KEYID=KEYID,
 
      2      IOSTAT=IOSTAT) TEMP
 
      IF (IOSTAT .NE. IOSTAT_OK) THEN
 
        CALL ERRSNS (,,,,STATUS)
 
        CALL LIB$SIGNAL (%VAL(STATUS))
 
      END IF
 
      ! поместить инвентарный номер в массив 1
 
      ARRAY1 (ONECNT) = TEMP.STOCK_NUMBER
 
      !установить поле равное ключу
 
      FIELD (1:KEY_SIZE) = KEY(1:KEY_SIZE))
 
      DO WHILE ((FIELD(1:KEY_SIZE) .EQ. KEY(1:KEY_SIZE)) .AND.
 
      2         (STATUS. NE. FOR$_ENDDURREA))
 
        !вести последовательное чтение
 
        READ (UNIT = LUN,
 
      2        IOSTAT = IOSTAT) TEMP
 
      IF (IOSTAT .NE.IOSTAT_OK) THEN
 
        CALL ERRSNS (,,,,STATUS)
 
        IF (STATUS .NE. FOR$_ENDDURREA) THEN
 
            CALL LIB$SIGNAL (%VAL (STATUS))
 
          END IF
 
        ELSE
 
          !изменить, если необходимо, значение в поле
 
          IF (KEYID .EQ. 1) THEN


                                - 85 -
 
                          00152-01 97 09-3
 
 
            FIELD = TEMP.MODEL
 
          ELSE IF (KEYID .EQ. 2) THEN
 
            FIELD = TEMP.COLOR
 
          ELSE IF (KEYID .EQ. 3) THEN
 
            FIELD = TEMP.ENGINE_SIZE
 
          ELSE IF (KEYID .EQ. 4) THEN
 
            FIELD = TEMP.CYLINDERS
 
          ELSE IF (KEYID .EQ. 5) THEN
 
            FIELD = TEMP.RADIO
 
          ELSE IF (KEYID .EQ. 6) THEN
 
            FIELD = TEMP.TRANS
 
          END IF
 
          !проверить на конец последовательности
 
          !и загрузить в массив
 
          IF (FIELD (1:KEY_SIZE) .EQ. KEY (1:KEY_SIZE)) THEN
 
            ONECNT = ONECNT + 1
 
            ARRAY1 (ONECNT) = TEMP.STOCK_NUMBER
 
          END IF
 
        END IF
 
      END DO
 
      ONE_MAX = ONECNT
 
      STATUS = STATUS_OK
 
      CALL GET_ATTRIBUTE(KEYID,
 
      2                  KEY,
 
      2                  KEY_SIZE)
 
      !читать запись
 
      READ (UNIT = LUN,
 
      2     KEY = KEY(1:KEY_SIZE),
 
      2     KEYID = KEYID,
 
      2     IOSTAT = IOSTAT)TEMP


                                - 86 -
 
                          00152-01 97 09-3
 
 
      IF (IOSTAT .NE. IOSTAT_OK) THEN
 
        CALL ERRSNS(,,,,STATUS))
 
        CALL LIB$SIGNAL (%VAL (STATUS))
 
      END IF
 
      !загрузить массив 2
 
      ARRAY2 (TWOCNT) = TEMP.STOCK_NUMBER
 
      !установить поле, равное ключу
 
      FIELD(1:KEY_SIZE) = KEY(1:KEY_SIZE)
 
      DO WHILE ((FIELD(1:KEY_SIZE)) .EQ. KEY(1:KEY_SIZE)) .AND.
 
      2       (STATUS .NE. FOR$_ENDDURREA))
 
        !вести последовательное чтение
 
        READ (UNIT = LUN,
 
      2     IOSTAT = IOSTAT) TEMP
 
        IF (IOSTAT .NE. IOSTAT_OK) THEN
 
          CALL ERRSNS(,,,,STATUS))
 
          IF (STATUS .NE. FOR$_ENDDURREA) THEN
 
            CALL LIB$SIGNAL (%VAL (STATUS))
 
          END IF
 
        ELSE
 
          IF (KEYID .EQ. 1) THEN
 
            FIELD = TEMP.MODEL
 
          ELSE IF (KEYID .EQ. 2) THEN
 
            FIELD = TEMP.COLOR
 
          ELSE IF (KEYID .EQ. 3) THEN
 
            FIELD = TEMP.ENGINE_SIZE
 
          ELSE IF (KEYID .EQ. 4) THEN
 
            FIELD = TEMP.CYLINDERS
 
          ELSE IF (KEYID .EQ. 5) THEN
 
            FIELD = TEMP.RADIO
 
          ELSE IF(KEYID .EQ. 6) THEN


                                - 87 -
 
                          00152-01 97 09-3
 
 
            FIELD = TEMP.TRANS
 
          END IF
 
          !проверить конец последовательности и загрузить массив
 
          IF (FIELD(1:KEY_SIZE) .EQ. KEY(1:KEY_SIZE) THEN
 
            TWOCNT = TWOCNT + 1
 
            ARRAY2(TWOCNT) = TEMP.STOCK_NUMBER
 
          END IF
 
        END IF
 
      END DO
 
      TWO_MAX = TWOCNT
 
      STATUS = STATUS_OK
 
      !сравнить два массива
 
      DO I = 1, ONE_MAX
 
          TWOCNT = 1
 
          DO WHILE((ARRAY(I) .NE. ARRAY2(TWOCNT)) .AND.
 
      2            (TWOCNT .LE. TWO_MAX))
 
          TWOCNT = TWOCNT + 1
 
        END DO
 
        IF (ARRAY1 (I) .EQ. ARRAY2 (TWOCNT)) THEN
 
          !и напечатать его
 
          TYPE *, ARRAY (I)
 
        END IF
 
      END DO
 
      !продолжение программы
 


                                - 88 -
 
                          00152-01 97 09-3
 
 
           1.4.6. Обновление записи в индексированном файле
 
 
           Для обновления  существующей  записи  индексированного
 
      файла нужно прочитать ее, модифицировать и записать обратно
 
      с помощью оператора REWRITE (оператор WRITE вставляет новую
 
      запись). По умолчанию разрешено модифицировать  любой  аль-
 
      тернативный ключ, но не первичный ключ. Попытка модификации
 
      ключа, который  не  разрешено  менять,  приведет  к  ошибке
 
      FOR$_INCKEYCHG (несовместимое изменение ключа). Эта  ошибка
 
      обрабатывается также, как ошибка  дублирования  ключа  (код
 
      ошибки тот же).
 
           Пример.
 
           Обновляется запись с номером об'екта 4 (значение  4  в
 
      поле   второго   альтернативного    ключа).    Подпрограмма
 
      NEWADDRESS читает новый адрес,  город,  страну  и  почтовый
 
      индекс с терминала и  передает  эту  информацию  обратно  в
 
      вызывающую программную единицу:
 
      INTEGER STATUS,
 
      2       LUN,
 
      2       LIB$GET_INPUT,
 
      2       LIB$GET_LUN
 
      INTEGER*2       FN_SIZE
 
      CHARACTER*256 FILENAME
 
      !определить запись
 
      STRUCTURE /ITEM/
 
       INTEGER*4    ORDER_NUMBER  !поз.1-4    (ключ 0)
 
       CHARACTER*20 NAME          !поз 5--24
 
       CHARACTER*20 ADDRESS       !поз 25--44
 
       CHARACTER*19 CITY          !поз 45--63
 
       CHARACTER*2  STATE         !поз 64--65
 


                                - 89 -
 
                          00152-01 97 09-3
 
 
       CHARACTER*9  ZIP_CODE      !поз 66--74 (ключ 1)
 
       INTEGER*2    ITEM_NUMBER   !поз 75--76 (ключ 2)
 
      END STRUCTURE
 
      RECORD /ITEM/ TEMP
 
      !принять имя файла
 
      STATUS = LIB$GET_INPUT (FILENAME,
 
      2                       'имя файла:',
 
      2                       FN_SIZE)
 
      !взять свободный номер устройства
 
      STATUS  = LIB$GET_LUN (LUN)
 
      IF (.NOT. STATUS) CALL LIB$SIGNAL (%VAL (STATUS))
 
      !открыть файл
 
      OPEN (UNIT = LUN,
 
      2     FILE = FILENAME (1:FN_SIZE),
 
      2     ORGANIZATION = 'INDEXED',
 
      2     ACCESS = 'KEYED',
 
      2     RECORDTYPE = 'VARIABLE',
 
      2     FORM = 'UNFORMATTED',
 
      2     RECL = 19,
 
      2     KEY = (1:4:INTEGER, 66:74:CHARACTER, 75:76:INTEGER),
 
      2     STATUS = 'OLD')
 
      !прочитать запись, чтобы сделать ее текущей
 
      READ (UNIT = LUN,
 
      2     KEY = 4,
 
      2     KEYID = 2) TEMP
 
      !принять новый адрес
 
      CALL NEWADDRESS (ADDRESS,
 
      2                CITY,
 
      2                STATE,
 
      2                ZIP_CODE)


                                - 90 -
 
                          00152-01 97 09-3
 
 
      !обновить запись
 
      REWRITE (UNIT = LUN) TEMP
 
      !продолжение программы   .
 
 
 
           1.4.7. Удаление записи из индексного файла
 
 
           Для удаления записи необходимо прочитать ее,  а  затем
 
      удалить с помощью оператора DELETE. Удаление записи убирает
 
      ее из всех индексов файла.
 
           Пример.
 
           Удаляется запись, содержащая об'ект номер 3:
 
 
      INTEGER STATUS,
 
      2        LUN,
 
      2        LIB$GET_INPUT,
 
      2        LIB$GET_LUN
 
      INTEGER*2      FN_SIZE
 
      CHARACTER*256  FILENAME
 
      !определить запись
 
       STRUCTURE    /ITEM/
 
       INTEGER*4    ORDER_NUMBER  !поз 1--4   (ключ 0)
 
       CHARACTER*20 NAME          !поз 5--24
 
       CHARACTER*20 ADDRESS       !поз 25--44
 
       CHARACTER*19 CITY          !поз 45--63
 
       CHARACTER*2  STATE         !поз 64--65
 
       CHARACTER*9  ZIP_CODE      !поз 66--74 (ключ 1)
 
       INTEGER*2    ITEM_NUMBER   !поз 75--76 (ключ 2)
 
      END STRUCTURE
 
      RECORD /ITEM/ TEMP
 
      !принять имя файла
 
      STATUS = LIB$GET_INPUT (FILENAME,


                                - 91 -
 
                          00152-01 97 09-3
 
 
      2                       'имя файла:',
 
      2                       FN_SIZE)
 
      IF (.NOT. STATUS) CALL LIB$SIGNAL (%VAL (STATUS))
 
      !взять свободный номер устройства
 
      STATUS = LIB$GET_LUN (LUN)
 
      IF (.NOT. STATUS) CALL LIB$SIGNAL (%VAL STATUS))
 
      !открыть файл
 
      OPEN (UNIT = LUN,
 
      2     FILE = FILENAME (1:FN:SIZE),
 
      2     ORGANIZATION = 'INDEXED',
 
      2     ACCESS = 'KEYED',
 
      2     RECORDTYPE = 'VARIABLE',
 
      2     FORM = 'UNFORMATTED',
 
      2     RECL = 19,
 
      2     KEY = (1:4:INTEGER, 66:74:CHARACTER, 75:76:INTEGER),
 
      2     STATUS = 'OLD')
 
      !прочитать запись, чтобы сделать ее текущей
 
      READ (UNIT = LUN,
 
      2     KEY = 4,
 
      2     KEYID = 2) TEMP
 
      !принять новый адрес
 
      CALL NEWADDRESS (ADDRESS,
 
      2                CITY,
 
      2                STATE,
 
      2                ZIP_CODE)
 
      !обновить запись
 
      DELETE (UNIT = LUN)
 
      !продолжение программы   .
 


                                - 92 -
 
                          00152-01 97 09-3
 
 
           1.4.8. Обработка совпадающих ключей
 
 
           По умолчанию язык ФОРТРАН создает  файлы,  разрешающие
 
      совпадение альтернативных ключей, но подавляющие совпадение
 
      первичных ключей. Для создания файла с  атрибутами  ключей,
 
      отличных от принятых по умолчанию, необходимо  использовать
 
      язык определения файлов (FDL); если файл содержит совпадаю-
 
      щие ключи, то при индексном доступе эти ключи будут обрабо-
 
      таны в том порядке, в котором они записаны.
 
           В тех  случаях,  когда  совпадение  ключей  запрещено,
 
      произойдет ошибка FOR$_INCKEYCHG  (несовместимое  изменение
 
      ключа).
 
           Пример.
 
           Обнаружение ошибки FOR$INCKEYCHG  приводит  к  запросу
 
      нового значения ключа:
 
 
      INTEGER STATUS,
 
      2       IOSTAT,
 
      2       IOSTAT_OK,
 
      INTEGER LIB$GET_INPUT,
 
      2       LIB$GET_LUN
 
      !определить запись
 
      STRUCTURE /ITEM/
 
       INTEGER*4    ORDER_NUMBER !поз. 1-4    (ключ 0)
 
       CHARACTER*20 NAME         !поз. 5-24
 
       CHARACTER*20 ADDRESS      !поз. 25-44
 
       CHARACTER*19 CITY         !поз. 45-63
 
       CHARACTER*2  STATE        !поз. 64-65
 
       CHARACTER*9  ZIP_CODE     !поз. 66-74  (ключ 1)
 
       INTEGER*2    ITEM_NUMBER  !поз. 75-76  (ключ 2)
 
      END STRUCTURE


                                - 93 -
 
                          00152-01 97 09-3
 
 
      RECORD /ITEM/ TEMP
 
      INCLUDE '($FORIOSDEF)'
 
      !продолжение программы   .
 
      !писать запись
 
      WRITE (UNIT = LUN,
 
      2      IOSTAT = IOSTAT) TEMP
 
      IF ((IOSTAT .NE. IOSTAT_OK) .AND.
 
      2   (IOSTAT .NE. FOR$IOS_INCKEYCHG)) THEN
 
        CALL ERRSNS (,,,,STATUS)
 
        CALL LIB$SIGNAL (%VAL(STATUS))
 
      END IF
 
      !проверить на ошибку совпадения
 
      DO WHILE (IOSTAT .EQ. FOR$IOS_INCKEYCNG)
 
        TYPE *, 'это дубликатный номер заказа'
 
        TYPE *, 'введите другое значение'
 
        READ (UNIT = *, FMT=*) TEMP.ORDER_NUMBER
 
        !писать новое значение
 
        WRITE (UNIT = LUN,
 
      2        IOSTAT = IOSTAT) TEMP
 
        IF ((IOSTAT .NE. IOSTAT_OK) .AND.
 
      2     (IOSTAT .NE. FOR$IOS_INCKEYCHG)) THEN
 
           CALL ERRSNS (,,,,STATUS)
 
           CALL LIB$SIGNAL (%VAL(STATUS))
 
        END IF
 
      END DO
 
      !продолжение программы   .
 


                                - 94 -
 
                          00152-01 97 09-3
 
 
           1.5. Упаковка и распаковка данных
 
 
           Для упаковки (уплотнения) данных в библиотеке  исполь-
 
      зуется квалификатор /DATA = REDUCE команды LIBRARY (подроб-
 
      ности изложены в [4]). После уплотнения библиотеки  библио-
 
      текарь автоматически упаковывает каждую запись, вводимую  в
 
      библиотеку, и автоматически  распаковывает  каждую  запись,
 
      извлекаемую из библиотеки. Для распаковки  всей  библиотеки
 
      используется  команда  LIBRARY  с  квалификатором  /DATA  =
 
      EXPAND.
 
           Невозможно уплотнять файлы (кроме библиотек) на уровне
 
      командного языка DCL. Процедуры DCX  [1]  дают  возможность
 
      проводить уплотнение и  расширение  файлов  на  программном
 
      уровне. Для получения  доступа  к  уплотненному  файлу  его
 
      необходимо предварительно распаковать. Основными кандидата-
 
      ми на уплотнение являются большие файлы,  к  которым  редко
 
      обращаются. Можно уплотнять и небольшие файлы, но это неэф-
 
      фективно , поскольку вместе с уплотненными записями  прихо-
 
      дится хранить данные функции упаковки-распаковки.
 
 
 
           1.5.1. Процедуры упаковки
 
 
           Уплотнение файла с помощью процедур DCX включает  сле-
 
      дующие этапы:
 
           1) инициализация рабочей области для анализа.  Исполь-
 
      зуется процедура DCX$ANALYZE_INIT  для  подготовки  рабочей
 
      области под анализ записей. Первый (и, как правило, единст-
 
      венный) параметр, передаваемый этой процедуре,  есть  пере-
 
      менная  целого  типа,  содержащая   контекстное   значение.
 
      Средства уплотнения данных присваивают значения  этой  кон-
 
      текстной  переменной,   связанное   с   созданной   рабочей


                                - 95 -
 
                          00152-01 97 09-3
 
 
      областью. Каждый раз, когда необходимо анализировать запись
 
      в этой области, необходимо задавать связанную  с  ней  кон-
 
      текстную переменную. Одновременно можно  анализировать  два
 
      или более файлов, создавая для них различные рабочие облас-
 
      ти; каждая область должна иметь свою  контекстную  перемен-
 
      ную; анализ записей файлов производится  в  соответствующей
 
      рабочей области;
 
           2) анализ записей файла. Для  передачи  каждой  записи
 
      файла в  рабочую  область  анализа  используется  процедура
 
      DCX$ANALYZE_DATA. В процессе  анализа  средства  уплотнения
 
      данных  собирают   информацию,   которая   используется   в
 
      DCX$MAKE_MAP для создания функции уплотнения файла.  Гаран-
 
      тией передачи первого байта каждой записи средствами уплот-
 
      нения данных (байт не будет истолкован как символ  управле-
 
      ния кареткой  языка  ФОРТРАН)  является  задание  параметра
 
      CARRIAGECONTROL = 'NONE' при открытии файла;
 
           3) создание функции уплотнения. Для  создания  функции
 
      уплотнения используется процедура DCX$MAKE_MAP. Этой проце-
 
      дуре передается контекстная переменная; кроме того,  проце-
 
      дура использует информацию, хранимую в связанной  с  файлом
 
      рабочей области, для вычисления функции уплотнения записей.
 
      Если DCX$MAKE_MAP возвращает состояние DCX$AGAIN,  то  сле-
 
      дует  повторять  этапы  два  и  три  до   тех   пор,   пока
 
      DCX$MAKE_MAP не вернет состояние DCX$_NORMAL  ,  что  озна-
 
      чает, что функция уплотнения создана;
 
           4)  очистка  рабочей  области.  Для  удаления  рабочей
 
      области применяется процедура  DCX$ANALYZE_DONE.  Удаляемая
 
      рабочая  область   идентифицируется   передачей   процедуре
 
      DCX$ANALYZE_DONE контекстной переменной;
 
           5) сохранение функции уплотнения. Без функции уплотне-


                                - 96 -
 
                          00152-01 97 09-3
 
 
      ния нельзя распаковать уплотненные записи.  Перед  уплотне-
 
      нием записей необходимо записать функцию уплотнения в файл,
 
      содержащий уплотненные записи.
 
           В языке ФОРТРАН нельзя использовать адреса непосредст-
 
      венно; для передачи адреса функции уплотнения  подпрограмме
 
      используется способ непосредственной передачи по  значению;
 
      также передается подпрограмме длина функции уплотнения.
 
           В  подпрограмме  формальный  параметр,  соответстующий
 
      адресу функции, описывается как одномерный байтовый  массив
 
      переменной длины.
 
           Формальный  параметр,  соответствующий  длине  функции
 
      об'является целым и используется  как  размерность  массива
 
      переменной длины. Длина функции и содержащий функцию массив
 
      необходимо записать в файл, который будет содержать  уплот-
 
      ненные записи; длина должна храниться в таком  виде,  чтобы
 
      была гарантирована возможность (чтения функции из  файла  с
 
      помощью неформатного ввода;
 
           6) уплотнение  каждой  записи.  Инициализация  рабочей
 
      области       уплотнения       выполняется       процедурой
 
      DCX$COMPRESS_INIT. Для области уплотнения контекстная пере-
 
      менная задается так же, как для области анализа.
 
           Для уплотнения каждой  записи  используется  процедура
 
      DCX$COMPRESS_DATA; передaча  каждой  уплотненной  записи  в
 
      файл, содержащий функцию уплотнения выполняется при  помощи
 
      неформатного вывода. Для каждой строки записывается ее дли-
 
      на и подстрока, содержащая запись
 
           Уничтожение  рабочей  области,  созданной   процедурой
 
      DCX$COMPRESS_INIT,          выполняется          процедурой
 
      DCX$COMPRESS_DONE. Подлежащая уничтожению  рабочая  область
 
      идентифицируется  контекстной  переменной,  передаваемой  в


                                - 97 -
 
                          00152-01 97 09-3
 
 
      процедуру DCX$COMPRESS_DONE. Освобождениe виртуальной памя-
 
      ти,  использованной  процедурой  DCX$MAKE_MAP  для  функции
 
      уплотнения, выполняется процедурой LIB$FREE_VM.
 
           Пример.
 
           Целочисленная  функция  GET_MAP   анализирует   каждую
 
      запись файла и вызывает DCX$MAKE_MAP для  создания  функции
 
      уплотнения. Значением функции GET_MAP является код  состоя-
 
      ния, возвращаемой процедурой DCX$MAKE_MAP;  адрес  и  длина
 
      функции  уплотнения  возвращаются   в   списке   параметров
 
      GET_MAP. Головная программа COMPRESS  вызывает  GET_MAP  до
 
      тех пор, пока последняя не возратит нормальный код заверше-
 
      ния:
 
      !переменная состояния
 
      INTEGER STATUS,
 
      2       IOSTAT,
 
      2       IO_OK,
 
      2       STATUS_OK
 
      PARAMETER (IO_OK = O)
 
      PARAMETER (STATUS_OK = 1)
 
      INCLUDE '($FORDEF)'
 
      EXTERNAL DCX$_AGAIN
 
      !контекстная переменная
 
      INTEGER CONTEXT
 
      !функция упаковки-распаковки
 
      INTEGER MAP,
 
      2       MAP_LEN
 
      !имя, длина и номер логического устройства исходного файла
 
      CHARACTER*256 NORM_NAME
 
      INTEGER NORM_LEN
 
      INTEGER NORM_LUN


                                - 98 -
 
                          00152-01 97 09-3
 
 
      !имя, длина  и  номер  логичекого  устройства  уплотненного
 
      !файла
 
      CHARACTER*256 COMP_NAME
 
      INTEGER*2 COMP_LEN
 
      INTEGER COMP_LUN
 
      !логический конец файла
 
      LOGICAL EOF
 
      !буферы записей, максимальная величина записей - 32767
 
      CHARACTER*32767 RECORD,
 
      2               RECORD2
 
      INTEGER RECORD_LEN,
 
      2       RECORD2_LEN
 
      !процедура пользователя
 
      INTEGER GET_MAP,
 
      2       WRITE_MAP
 
      !библиотечные процедуры
 
      INTEGER DCX$ANALYZE_INIT,
 
      2       DCX$ANALYZE_DONE,
 
      2       DCX$COMPRESS_INIT,
 
      2       DCX$COMPRESS_DATA,
 
      2       DCX$COMPRESS_DONE,
 
      2       LIB$GET_INPUT,
 
      2       LIB$GET_LUN,
 
      2       LIB$FREE_VM
 
      !принять имя файла, подлежащего уплотнению, и открыть его
 
      STATUS = LIB$GET_INPUT (NORM_NAME,
 
      2                       'файл для упаковки: ',
 
      2                       NORM_LEN)
 
      IF (.NOT. STATUS) CALL LIB$SIGNAL (%VAL (STATUS))
 
      STATUS = LIB$GET_LUN (NORM_LUN)


                                - 99 -
 
                          00152-01 97 09-3
 
 
      IF (.NOT. STATUS) CALL LIB$SIGNAL (%VAL STATUS))
 
      OPEN (UNIT = NORM_LUN,
 
      2     FILE = NORM_NAME (1:NORM_LEN),
 
      2     CARRIAGECONTROL = 'NONE',
 
      2     STATUS = 'OLD')
 
      ****************************
 
      !анализ данных
 
      ****************************
 
      !инициализировать рабочую область
 
      STATUS = DCX$ANALYZE_INIT (CONTEXT)
 
      IF (.NOT.STATUS) CALL LIB$SIGNAL (%VAL (STATUS))
 
      !принять (отобразить) функцию упаковки-распаковки
 
      STATUS = GET_MAP (NORM LUN,
 
      2                 CONTEXT,
 
      2                 MAP,
 
      2                 MAP_LEN)
 
      DO WHILE (STATUS .EQ. %LOC(DCX$_AGAIN))
 
         !вернуться к началу файла
 
         REWIND (UNIT = NORM_LUN)
 
         !попытайтесь отобразить снова
 
         STATUS = GET_MAP (NORM_LUN,
 
      2                    CONTEXT,
 
      2                    MAP,
 
      2                    MAP_LEN)
 
      END DO
 
      IF (.NOT. STATUS) CALL LIB$SIGNAL (%VAL (STATUS))
 
      !очистить рабочую область
 
      STATUS = DCX$ANALYZE_DONE (CONTEXT)
 
      IF (.NOT. STATUS) CALL LIB%SIGNAL (%VAL (STATUS))
 
      !*****************************


                                - 100 -
 
                          00152-01 97 09-3
 
 
      !уплотнить данные
 
      !*****************************
 
      !вернуться к началу файла, подлежащего уплотнению
 
      REWIND (UNIT = NORM_LUN)
 
      !открыть файл для уплотненных записей
 
      STATUS = LIB$GET_LUN (COMP_LUN)
 
      IF (.NOT. STATUS) CALL LIB$SIGNAL (%VAL (STATUS))
 
      STATUS = LIB$GET_INPUT (COMP_NAME,
 
      2                       'файл для упакованных записей: '.
 
      2                       COMP_LEN)
 
      IF (.NOT. STATUS) CALL LIB$SIGNAL (%VAL (STATUS))
 
      OPEN (UNIT = COMP_LUN,
 
      2     FILE = COMP_NAME (1:COMP_LEN),
 
      2     STATUS = 'NEW',
 
      2     FORM = 'UNFORMATTED')
 
      !инициализировать рабочую область
 
      STATUS = DCX$COMPRESS_INIT (CONTEXT,
 
      2                           MAP)
 
      IF (.NOT. STATUS) CALL LIB$SIGNAL (%VAL (STATUS))
 
      !записать функцию упаковки-распаковки в новый файл
 
      CALL WRITE_MAP (COMP_LUN,
 
      2               %VAL(MAP),
 
      2               MAP_LEN)
 
      !читать запись из файла, подлежащего уплотнению
 
      EOF = .FALSE.
 
      READ (UNIT = NORM_LUN,
 
      2     FMT = '(Q,A)',
 
      2     IOSTAT = IOSTAT) RECORD_LEN,
 
      2                      RECORD(1:RECORD_LEN)
 
      IF (IOSTAT .NE. IO_OK) THEN


                                - 101 -
 
                          00152-01 97 09-3
 
 
        CALL ERRSNS (,,,,STATUS)
 
        IF (STATUS .NE. FOR$ENDDURREA) THEN
 
          CALL LIB$SIGNAL (%VAL(STATUS))
 
        ELSE
 
          EOF = .TRUE.
 
          STATUS = STATUS_OK
 
        END IF
 
      END IF
 
      DO WHILE (.NOT. EOF)
 
        !уплотнить запись
 
        STATUS = DCX$COMPRESS_DATA (CONTEXT,
 
      2                             RECORD(1:RECORD_LEN),
 
      2                             RECORD2,
 
      2                             RECORD2_LEN)
 
        IF (.NOT. STATUS) CALL LIB$SIGNAL (%VAL (STATUS))
 
        !писать уплотненную запись в новый файл
 
        WRITE (UNIT = COMP_LUN) RECORD2_LEN
 
        WRITE (UNIT = COMP_LUN) RECORD2 (1:RECORD2_LEN
 
        !читать из файла, подлежащего уплотнению
 
        READ (UNIT = NORM_LUN,
 
      2       FMT = '(Q,A)',
 
      2       IOSTAT = IOSTAT) RECORD_LEN,
 
      2                        RECORD (1:RECORD_LEN)
 
        IF (IOSTAT .NE. IO_OK) THEN
 
          CALL ERRSNS (,,,,STATUS)
 
          IF (STATUS .NE. FOR$ENDDURREA) THEN
 
            CALL LIB$SIGNAL (%VAL (STATUS))
 
          ELSE
 
            EOF = .TRUE.
 
            STATUS = STATUS_OK


                                - 102 -
 
                          00152-01 97 09-3
 
 
          END IF
 
        END IF
 
      END DO
 
      !закрыть файлы и очистить рабочую область
 
      CLOSE (NORM_LUN)
 
      CLOSE (COMP_LUN)
 
      STATUS = LIB$FREE_VM (MAP_LEN,
 
      2                     MAP)
 
      IF (.NOT. STATUS) CALL LIB$SIGNAL (%VAL (STATUS))
 
      STATUS = DCX$COMPRESS_DONE (CONTEXT)
 
      IF (.NOT. STATUS) CALL LIB$SIGNAL (%VAL (STATUS))
 
      END
 
      !функция GET_MAP.FOR
 
      INTEGER FUNCTION GET_MAP (LUN,     !входной
 
      2                         CONTEXT, !входной
 
      2                         MAP,     !выходной
 
      2                         маP_LEN) !выходной
 
      !анализ  записей файла, открытого на логическом устройстве
 
      !LUN, и  попытка  создать  функцию  упаковки-распаковки  с
 
      !использованием  DCX$MAKE_MAP
 
      !формальные параметры
 
      !контекстная переменная
 
      INTEGER CONTEXT
 
      !номер логического устройства
 
      INTEGER LUN
 
      !функция упаковки-распаковки
 
      INTEGER MAP
 
      2       MAP_LEN
 
      !переменная состояния
 
      INTEGER STATUS,


                                - 103 -
 
                          00152-01 97 09-3
 
 
      2       IOSTAT,
 
      2       IO_OK,
 
      2       STATUS_OK
 
      PARAMETER (IO_OK = 0)
 
      PARAMETER (STATUS_OK = 1)
 
      INCLUDE '($FORDEF)'
 
      !логический конец файла
 
      LOGICAL EOF
 
      !буфер записи, максимальный размер записи - 32767
 
      CHARACTER*32767 RECORD
 
      INTEGER RECORD_LEN
 
      !библиотечные процедуры
 
      INTEGER DCX$ANALYZE_DATA
 
      2       DCX$MAKE_MAP
 
      !анализ записей
 
      EOF = .FALSE.
 
      READ (UNIT = LUN,
 
      2     FMT = '(Q,A)',
 
      2     IOSTAT = IOSTAT) RECORD_LEN, RECORD
 
      IF (IOSTAT .NE. IO_OK) THEN
 
        CALL ERRSNS (,,,,STATUS)
 
        IF (STATUS .NE. FOR$_ENDDURREA) THEN
 
          CALL LIB$SIGNAL (%VAL (STATUS))
 
        ELSE
 
          EOF = .TRUE.
 
          STATUS = STATUS_OK
 
        END IF
 
      END IF
 
      DO WHILE (.NOT. EOF)
 
        STATUS = DCX$ANALYZE DATA (CONTEXT,


                                - 104 -
 
                          00152-01 97 09-3
 
 
      2                            RECORD (1:RECORD_LEN))
 
        IF (.NOT. STATUS) CALL LIB$SIGNAL (%VAL (STATUS))
 
        READ (UNIT = LUN,
 
      2       FMT = '(Q,A)',
 
      2       IOSTAT = IOSTAT) RECORD_LEN,RECORD
 
        IF (IOSTAT .NE. IO_OK) THEN
 
          CALL ERRSNS (,,,,STATUS)
 
          IF (STATUS .NE. FOR$_ENDDURREA) THEN
 
            CALL LIB$SIGNAL (%VAL (STATUS))
 
          ELSE
 
            EOF = .TRUE.
 
            STATUS = STATUS_OK
 
          END IF
 
        END IF
 
      END DO     !конец функции
 
      STATUS = DCX$MAKE_MAP (CONTEXT,
 
      2                      MAP,
 
      2                      MAP_LEN)
 
      GET_MAP = STATUS
 
      END
 
      !подпрограмма WRITE_MAP.FOR
 
      SUBROUTINE WRITE_MAP (LUN,     !передаваемый
 
      2                     мар,     !передаваемый
 
      2                     MAP_LEN) !передаваемый
 
      !писать функцию упаковки-распаковки в файл уплотненных
 
      !данных
 
      !формальные параметры
 
      INTEGER LUN,        !логическое устройство файла
 
      2       MAP_LEN     !длина функции
 
      BYTE MAP (MAP_LEN)  !функция упаковки-распаковки


                                - 105 -
 
                          00152-01 97 09-3
 
 
      !писать длину отображения
 
      WRITE (UNIT = LUN) MAP_LEN
 
      !писать отображение
 
      WRITE (UNIT = LUN) MAP
 
      END    !конец процедуры  .
 
 
 
           1.5.2. Процедуры распаковки
 
 
           Для распаковки файла следует предусмотреть следующее:
 
           1) чтение функции уплотнения.  В  процессе  чтения  из
 
      уплотненного файла функции уплотнения нельзя делать никаких
 
      предположений о размере функции. Лучшим способом будет про-
 
      читать длину функции из уплотненного файла, а затем вызвать
 
      процедуру  LIB$GET_VM  для  получения  необходимого  об'ема
 
      памяти для функции. Процедура LIB$GET_VM  возвращает  адрес
 
      первого байта области памяти.
 
           В языке  ФОРТРАН  адрес  непосредственно  использовать
 
      нельзя, поэтому, для передачи адреса области  памяти  подп-
 
      рограмме, используется способ передачи по значению;  анало-
 
      гично передается подпрограмме длина функции уплотнения.
 
           В подпрограмме формальный параметр, отвечающий области
 
      памяти, описывается как одномерный байтовый массив перемен-
 
      ной длины. Формальный параметр, отвечающий  длине  функции,
 
      описывается как целое число и используется в качестве  раз-
 
      мерности массива. Функция уплотнения считывается в формаль-
 
      ный параметр - массив. Функция уплотнения хранится в  подп-
 
      рограмме, поэтому не следует возвращаться в основную  прог-
 
      рамму до тех пор, пока не будут расширены  все  уплотненные
 
      записи;
 
           2) инициализация рабочей области выполнения  распаков-
 


                                - 106 -
 
                          00152-01 97 09-3
 
 
      ки. С целью инициализации рабочей  области  для  распаковки
 
      записей     необходимо      воспользоваться      процедурой
 
      DCX$EXPAND_INIT. Первый параметр, передаваемый этой  проце-
 
      дуре, есть переменная целого  типа  содержащая  контекстное
 
      значение. Второй параметр  есть  адрес  функции  уплотнения
 
      (для передачи адреса массива, содержащего функцию,  исполь-
 
      зуется встроенная функция %LOC);
 
           3) распаковка записей.  Для  распаковки  всех  записей
 
      используется процедура DCX$EXPаND_DATA;
 
           4)  очистка  рабочей  области.  Для  удаления  рабочей
 
      области используется процедура  DCX$EXPAND_DONE.  Удаляемая
 
      рабочая  область  идентифицируется  передачей  в  процедуру
 
      DCX$EXPAND_DONE контекстной переменной.
 
           Пример.
 
           Выполняется распаковка уплотненного файла. Первой  его
 
      записью является  целое  число,  содержащее  длину  функции
 
      уплотнения в байтах; вторая запись  содержит  саму  функцию
 
      уплотнения.  Остальная  часть  файла  содержит  уплотненные
 
      записи; каждая уплотненная запись состоит из двух  записей:
 
      первая - длина записи, а  вторая  -  подстрока,  содержащая
 
      запись:
 
 
      INTEGER STATUS
 
      !имена, длины и логические номера устройств файлов
 
      CHARACTER*256 OLD_FILE,
 
      2             NEW_FILE
 
      INTEGER*2 OLD_LEN,
 
      2         NEW_LEN
 
      INTEGER OLD_LUN,
 
      2       NEW_LUN
 


                                - 107 -
 
                          00152-01 97 09-3
 
 
      !длина функции упаковки-распаковки
 
      INTEGER MAP,
 
      2       MAP_LEN
 
      !процедура пользователя
 
      EXTERNAL EXPAND_DATA
 
      !библиотечные процедуры
 
      INTEGER LIB$GET_LUN,
 
      2       LIB$GET_INPUT,
 
      2       LIB$GET_VM,
 
      2       LIB$FREE_VM
 
      !открыть файл, подлежащий расширению
 
      STATUS = LIB$GET_LUN (OLD_LUN)
 
      IF (.NOT. STATUS) CALL LIB$SIGNAL (%VAL (STATUS))
 
      STATUS = LIB$GET_INPUT (OLD_FILE,
 
      2                       'FILE TO EXPAND: ',
 
      2                       OLD_LEN)
 
      IF (.NOT. STATUS) CALL LIB$SIGNAL (%VAL (STATUS))
 
      OPEN (UNIT = OLD_LUN,
 
      2     STATUS = 'OLD',
 
      2     FILE = OLD_FILE (1:OLD_LEN),
 
      2     FORM = 'UNFORMATTED')
 
      !открыть файл для распакованных записей
 
      STATUS = LIB$GET_LUN (NEW_LUN)
 
      IF (.NOT. STATUS) CALL LIB$SIGNAL (%VAL (STATUS))
 
      STATUS = LIB$GET_INPUT (NEW_FILE,
 
      2                       'файл для распакованных данных: ',
 
      2                       NEW_LEN)
 
      IF (.NOT. STATUS) CALL LIB$SIGNAL (%VAL (STATUS))
 
      OPEN (UNIT = NEW_LUN,
 
      2     STATUS = 'NEW',


                                - 108 -
 
                          00152-01 97 09-3
 
 
      2     CARRIAGECONTROL = 'NONE',
 
      2     FILE = NEW_FILE(1:NEW_LEN))
 
      !распаковка файла
 
      !принять длину функции упаковка-распаковка
 
      READ (UNIT = OLD_LUN) MAP_LEN
 
      STATUS = LIB$FREE_VM (MAP_LEN,
 
      2                    MAP)
 
      IF (.NOT. STATUS) CALL LIB$SIGNAL (%VAL (STATUS))
 
      !расширение записей
 
      CALL EXPAND_DATA (%VAL (MAP),
 
      2                 MAP_LEN,  !длина функции
 
      2                 OLD_LUN,  !файл с уплотненными данными
 
      2                 NEW_LUN)  !файл с расширенными данными
 
      !удалить рабочую виртуальную память, использованную для
 
      !функции
 
      STATUS = LIB$GET_VM (MAP_LEN,
 
      2                    MAP)
 
      IF (.NOT. STATUS) CALL LIB$SIGNAL (%VAL (STATUS))
 
      END
 
      !подпрограмма пользователя
 
      SUBROUTINE EXPAND_DATA (MAP,      !передаваемый
 
      2                       MAP_LEN,  !передаваемый
 
      2                       OLD_LUN,  !передаваемый
 
      2                       NEW_LUN)  !передаваемый
 
      !программа расширения данных
 
      !формальные параметры
 
      INTEGER MAP_LEN,   !длина функции расширения
 
      2       оLD_LUN,   !логическое устройство уплотненного
 
                         !файла
 
      2       NEW_LUN)   !логическое устройство расширенного


                                - 109 -
 
                          00152-01 97 09-3
 
 
                         !файла
 
      BYTE MAP (MAP_LEN) !массив, содержащий функцию
 
      !переменные состояния
 
      !INTEGER STATUS,
 
      2        IOSTAT,
 
      2        IO_OK,
 
      2        STATUS_OK
 
      PARAMETER (IO_OK = O)
 
      PARAMETER (STATUS_OK = 1)
 
      INCLUDE '($FORDEF)'
 
      !контекстная переменная
 
      INTEGER CONTEXT
 
      !логический конец файла
 
      LOGICAL EOF
 
      !буферы записей
 
      CHARACTER*32767 RECORD,
 
      2               RECORD2
 
      INTEGER RECORD_LEN,
 
      2       RECORD2_LEN
 
      !библиотечные процедуры
 
      INTEGER DCX$EXPAND_INIT,
 
      2        DCX$EXPAND_DATA,
 
      2        DCX$EXPAND_DONE
 
      !чтение данных функции упаковки-распаковки
 
      READ (UNIT = OLD.LUN) MAP
 
      !инициализация рабочей области
 
      STATUS = DCX$EXPAND_INIT (CONTEXT,
 
      2                         %LOC(MAP(1)))
 
      IF (.NOT. STATUS) CALL LIB$SIGNAL (%VAL (STATUS))
 
      !расширение записей


                                - 110 -
 
                          00152-01 97 09-3
 
 
      EOF = .FALSE.
 
      !читать длину уплотненной записи
 
      READ (UNIT = OLD_LUN,
 
      2     IOSTAT = IOSTAT) RECORD_LEN
 
      IF (STATUS .NE. IO_OK) THEN
 
        CALL ERRSNS (,,,,STATUS)
 
        IF (STATUS .NE. FOR$_ENDDURREA) THEN
 
          CALL LIB$SIGNAL (%VAL (STATUS))
 
        ELSE
 
          EOF = .TRUE.
 
          STATUS = STATUS_K
 
        END IF
 
      END IF
 
      DO WHILE (.NOT. EOF)
 
        !читать уплотненную запись
 
        READ (UNIT = OLD_LUN) RECORD (1:RECORD_LEN)
 
        !расширить запись
 
        STATUS = DCX$EXPAND_DATA (CONTEXT,
 
      2                           RECORD(1:RECORD_LEN),
 
      2                           RECORD2,
 
      2                           RECORD2_LEN)
 
        IF (.NOT. STATUS) CALL LIB$SIGNAL (%VAL (STATUS))
 
        !писать расширенную запись в новый файл
 
        WRITE (UNIT = NEW_LUN,
 
      2        FMT = '(A)') RECORD2 (1:RECORD2_LEN)
 
        !читать длину уплотненной записи
 
        READ (UNIT = OLD_LUN,
 
      2       IOSTAT = IOSTAT) RECORD_LEN
 
        IF (IOSTAT .NE. IO_OK) THEN
 
          CALL ERRSNS (,,,,STATUS)


                                - 111 -
 
                          00152-01 97 09-3
 
 
          IF (STATUS .NE. FOR$_ENDDURREA) THEN
 
            CALL LIB$SIGNAL (%VAL(STATUS))
 
          ELSE
 
            EOF = .TRUE.
 
            STATUS = STATUS_OK
 
          END IF
 
        END IF
 
      END DO
 
      !очистить рабочую область
 
      STATUS = DCX$EXPAND_DONE (CONTEXT)
 
      IF (.NOT. STATUS) CALL LIB$SIGNAL (%VAL (STATUS))
 
      END   !конец программы   .
 
 
 
           1.6. Процедуры работы с библиотеками
 
 
           Библиотека - это файл специального формата, в  котором
 
      хранятся единицы  данных,  называемые  модулями.  Системно-
 
      определенные библиотеки бывают следующих типов:
 
           1) об'ектные библиотеки. Каждый об'ектный модуль соот-
 
      ветствует одному библиотечному модулю. Об'ектная библиотека
 
      по умолчанию имеет тип OLB; вводимый в об'екную  библиотеку
 
      файл имеет по умолчанию тип OBJ;
 
           2)  библиотека  разделяемых  образов.  Каждая  таблица
 
      идентификаторов разделяемого  образа  соответствует  одному
 
      библиотечному модулю. Библиотека разделяемых образов  имеет
 
      по умолчанию тип OLB;  вводимый  в  библиотеку  разделяемых
 
      образов файл имеет по умолчанию тип EXE;
 
           3) макробиблиотеки (библиотеки макроопределений). Каж-
 
      дая исходная программа  сответствует  одному  библиотечному
 
      модулю. Макробиблиотека по умолчанию имеет тип  MLB;  файл,
 


                                - 112 -
 
                          00152-01 97 09-3
 
 
      вводимый в макробиблиотеку имеет по умолчанию тип MAR;
 
           4) библиотеки справочных текстов. В  библиотеке  спра-
 
      вочных текстов храняться специальным образом  форматирован-
 
      ные строки текста. Каждая строка  первого  уровня  начинает
 
      новый библиотечный модуль. По умолчанию библиотека справоч-
 
      ных текстов имеет тип HLB; вводимый в такую библиотеку файл
 
      имеет по умолчанию тип HLP;
 
           5) текстовые библиотеки. Каждый введенный в библиотеку
 
      текстовый файл соответствует одному  библиотечному  модулю.
 
      Текстовая библиотека по умолчанию имеет тип TLB; вводимый в
 
      текстовую библиотеку файл имеет по умолчанию тип TXT.
 
           Модули в библиотеке  каталогизированы  по  имени.  Для
 
      библиотек разделяемых образов именами модулей являются име-
 
      на файлов разделяемых образов. Для  об'ектных  библиотек  и
 
      макробиблиотек именами модулей являются имена  программ  (а
 
      не имена файлов, содержащих программы). Для библиотек спра-
 
      вочных текстов именами модулей являются имена строк первого
 
      уровня. Для текстовых библиотек  имена  модуля  назначаются
 
      пользователем и по умолчанию приравниваются к именам исход-
 
      ных файлов. В об'ектных библиотеках и библиотеках разделяе-
 
      мых образов модули каталогизируются также по именам опреде-
 
      ленных в них глобальных идентификаторов.
 
           Для работы с библиотеками на уровне  командного  языка
 
      DCL используется команда LIBRARY.
 
           Для  работы  с  библиотеками  на  программном   уровне
 
      используются процедуры LBR$ [3].
 


                                - 113 -
 
                          00152-01 97 09-3
 
 
           1.6.1. Создание, открытие и закрытие библиотек
 
 
           Использование библиотеки требует следующей  последова-
 
      тельности действий:
 
           1) инициализация  библиотеки;  используется  процедура
 
      LBR$INI_CONTROL. Значение, возвращенное из  LBR$INI_CONTROL
 
      в  первом  параметре,  необходимо  использовать  в  вызовах
 
      остальных процедур LBR$; не следует менять этого  значения.
 
      Вторым параметром передается одно из следующих значений:
 
           LBR$C_CREATE - для создания и обновления новой библио-
 
      теки;
 
           LBR$C_UPDATE - для обновления существующей библиотеки;
 
           LBR$E_READ -  для  чтения  (обновление  запрещено)  из
 
      существующей библиотеки;
 
           2)   открытие   библиотеки;   используется   процедура
 
      LBR$OPEN. В качестве первого параметра этой процедуре пере-
 
      дается значение, возвращенное из LBR$INI_CONTROL; в качест-
 
      ве второго параметра передается частичная или полная специ-
 
      фикация файла библиотеки; в качестве четвертого параметра -
 
      любые умолчания относительно спецификации файла. Если  соз-
 
      дается новая библиотека, то в качестве  третьего  параметра
 
      передается  массив  возможностей  создания.  Идентификаторы
 
      CRE$ [3] указывают значащие длинные  слова  массива  по  их
 
      смещению от начала массива, выраженном в байтах; эти значе-
 
      ния переводятся в индексы делением на четыре и  добавлением
 
      единицы. Если значащие длинные слова не будут загружены  до
 
      вызова LBR$INI_CONTROL, то библиотека может быть  испорчена
 
      в момент создания;
 
           3) работа с библиотекой. Вызываются различные процеду-
 
      ры LBR$ и выполняются другие операции согласно  конструкции
 


                                - 114 -
 
                          00152-01 97 09-3
 
 
      программы;
 
           4)   закрытие   библиотеки;   используется   процедура
 
      LBR$CLOSE, которой в  качестве  первого  (и  единственного)
 
      параметра    передается    значение,    возвращенное     из
 
      LBR$INI_CONTROL. Библиотеку необходимо закрывать  явно  для
 
      сохранения произведенных изменений.
 
           Примечание.  Не  нужно  использовать  LBR$INI_CONTROL,
 
      LBR$OPEN  и  LBR$CLOSE  для  записи  справочного  текста  с
 
      помощью   LBR$OUTPUT_HELP;   необходимо   просто    вызвать
 
      LBR$OUTPUT_HELP.
 
           Некоторые  идентификаторы,  используемые   процедурами
 
      LBR$, не определены в принятых по умолчанию об'ектных  биб-
 
      лиотеках и библиотеках разделяемых образов.  Их  необходимо
 
      включить явно, вызвав $LBRDEF, $MHDDEF, $LHIDEF и $HLPDEF в
 
      макропрограммах, задав в качестве параметра GLOBAL, и ском-
 
      поновать эти макропрограммы с прикладной программой [3].
 
           Для получения доступа к существующей библиотеке  необ-
 
      ходимо выполнить попытку ее открытия в  режиме  UPDATE  или
 
      READ, проверяя на ошибку RMS$_FNF. Если эта ошибка произой-
 
      дет, то необходимо открыть библиотеку в режиме CREATE, т.е.
 
      Создать ее.
 
           Пример.
 
           Открытие или создание и открытие текстовой библиотеки:
 
      !файл определения команды DOLIB.CLD:
 
      !определение команды DOLIB
 
      DEFINE VERB DOLIB
 
      IMAGE WORK:[TEXTLIB] DOLIB
 
      !в спецификации файла - только имя
 
      !по - умолчанию каталог - текущий,тип - TLB
 
      PARAMETER P1, LABEL = LIBSPEC,PROMPT ="библиотека",


                                - 115 -
 
                          00152-01 97 09-3
 
 
      2             VALUE (REQUIRED)
 
      !спецификаторы действий:
 
      QUALIFIER ENTER                  !/ENTER
 
      QUALIFIER EXTRACT, VALUE (LIST)  !/EXTRACT = (MODULE,...)
 
      QUALIFIER DELETE, VALUE (LIST)   !/DELETE = (MODULE,...)
 
      QUALIFIER TYPEINFO               !/TYPEINFO
 
      QUALIFIER MODHEAD, VALUE (LIST)  !/MODHEAD = (MODULE,...)
 
      QUALIFIER LIST, VALUE (DEFAULT = (" * ") !/LIST[=MATCHNAME]
 
      QUALIFIER ALIAS, VALUE (LIST) !/ALIAS = (MODULE, ALIAS,...)
 
      QUALIFIER SHOWALIAS, VALUE (REQUIRED) !/SHOWALIAS = MODULE
 
      !программа DOLIB - сообщения
 
       .TITLE DOLIB MESSAGES
 
       .FACILITY DOLIB, 1 /PREFIX = DOLIB_
 
       .SEVERITY WARNING
 
      MODEX "MODULE ALREADY EXISTS ---'  !AS'" /FAO = 1
 
      NOMOD "NO SUCH MODULE ---'  !AS'" /FAC = 1
 
       .SEVERITY SEVERE
 
      NOACTION "NO ACTION SPECIFIED ON COMMAND LINE"
 
       .END
 
      !определения макро
 
      $LBRDEF GLOBAL
 
      $CREDEF GLOBAL
 
      $MHDDEF GLOBAL
 
      $LHIDEF GLOBAL
 
      $HLPDEF GLOBAL
 
       .END
 
      !программа DOLIB
 
      PROGRAM DOLIB
 
      !формат команды: DOLIB [QUALITIER] LIBRARY-NAME
 
      !квалификаторы:  /ENTER


                                - 116 -
 
                          00152-01 97 09-3
 
 
      !                /EXTRACT = (MODULE-NAME,...)
 
      !                /DELETE = (MODULE-NAME,...)
 
      !                /TYPEINFO
 
      !                /MODHEAD = (MODULE-NAME,...)
 
      !                /LIST [ = MATCH-NAME]
 
      !                /ALIAS = (MODULE, ALIAS,...)
 
      !                /SHOWALIAS = MODULE
 
      CHARACTER*31 LIBSPEC,      !файл библиотеки
 
      2            STATUS,       !возвращаемое состояние
 
      2            INDEX,        !индекс библиотеки
 
      2            FUNC,         !функция библиотеки
 
      2            OPTIONS (20), !опции создания
 
      2            TYPE,
 
      2            KEYLEN,
 
      2            ALLOC,
 
      2            IDXMAX,
 
      2            UHDMAX,
 
      2            ENTALL
 
      !библиотечные процедуры МОС ВП
 
      EXTERNAL LBR$INI_CONTROL,
 
      2        LBR$OPEN,
 
      2        LBR$CLOSE,
 
      2        CLI$PRESENT
 
      !смещение в массиве опций создания определены в $CREDEF
 
      EXTERNAL CRE$L_TYPE,   !тип библиотеки
 
      2        CRE$L_KEYLEN, !мах длина ключей
 
      2        CRE$L_ALLOC,  !размер при инициализации
 
      2        CRE$L_IDXMAX, !число индексов
 
      2        CRE$L_UHDMAX,  !длина заголовка модулей
 
      2        CRE$L_ENTALL


                                - 117 -
 
                          00152-01 97 09-3
 
 
      !значения - определены в $LBRDEF
 
      EXTERNAL LBR$C_TYP_UNK,
 
      2        LBR$C_TYP_OBJ,
 
      2        LBR$C_TYP_MLB,
 
      2        LBR$C_TYP_HLP,
 
      2        LBR$C_TYP_TXT,
 
      2        LBR$C_CREATE,
 
      2        LBR$C_READ,
 
      2        LBR$C_UPDATE
 
      !коды возврата
 
      EXTERNAL, RMS$_FNF,       !файл не найден
 
      2         DOLIB_NOACTION  !не задано действие
 
      !принять имя библиотеки
 
      CALL CLI$GET_VALUE ('LIBSPEC',
 
      2                    LIBSPEC)
 
      !определить функцию - обновить или только читать
 
      !только чтение с квалификаторами
 
      IF (CLI$PRESENT ('EXTRACT') .OR.
 
      2   CLI$PRESENT ('TYPEINFO') .OR.
 
      2   CLI$PRESENT ('LIST') .OR.
 
      2   CLI$PRESENT ('SHOWALIAS')) THEN
 
        FUNC = %LOC (LBR$C_READ)
 
      ELSE
 
        FUNC = %LOC (LBR$C_UPDATE)
 
      END IF
 
      !инициализировать и открыть библиотеку
 
      STATUS = LBR$INI_CONTROL (INDEX,
 
      2                         FUNC)
 
      IF (.NOT. STATUS) CALL LIB$SIGNAL (%VAL (STATUS))
 
      STATUS = LIB$OPEN (INDEX,


                                - 118 -
 
                          00152-01 97 09-3
 
 
      2                  LIBSPEC,,
 
      2                  '.TLB')
 
      !если библиотеки нет, создать
 
      IF (STATUS EQ %LOC (RMS$_FNF)) THEN
 
        !инициализация с функцией CREATE
 
        STATUS = LBR$INI_CONTROL (INDEX,
 
      2                           %LOC (LBR$C_CREATE))
 
        IF (.NOT. STATUS) CALL LIB$SIGNAL (%VAL (STATUS))
 
        !считать индексы массива
 
        TYPE = %LOC (CRE$L_TYPE) / 4 + 1
 
        KEYLEN = %LOC (CRE$L_KEYLEN) / 4 + 1
 
        ALLOC = %LOC (CRE$L_ALLOC) / 4 + 1
 
        IDXMAX = %LOC (CRE$L_IDXMAX) / 4 + 1
 
        UHDMAX = %LOC (CRE$L_UHDMAX) / 4 + 1
 
        ENTALL = %LOC (CRE$L_ENTALL) / 4 + 1
 
        !загрузить массив возможностей создания
 
        OPTIONS (TYPE) = %LOC (LBR$C_TYP_TXT)
 
        OPTIONS (KEYLEN) = 31
 
        OPTIONS (ALLOC) = 8
 
        OPTIONS (IDXMAX) = 2
 
        OPTIONS (UHDMAX) = 64
 
        OPTIONS (ENTALL) = 96
 
        !открыть библиотеку
 
        STATUS = LBR$OPEN (INDEX,
 
      2                    LIBSPEC,
 
      2                    OPTIONS,
 
      2                    '.TLB')
 
        IF (.NOT. STATUS) CALL LIB$SIGNAL (%VAL (STATUS))
 
      ELSE IF ((NOT.STATUS) THEN
 
        CALL LIB$SIGNAL (%VAL(STATUS))


                                - 119 -
 
                          00152-01 97 09-3
 
 
      END IF
 
      !переход по запросу пользователя
 
      IF (CLI$PRESENT('ENTER')) THEN
 
        CALL ENTER (INDEX)
 
      ELSE IF (CLI$PRESENT('EXTRACT')) THEN
 
        CALL EXTRACT (INDEX)
 
      ELSE IF(CLI$PRESENT('DELETE')) THEN
 
        CALL DELETE (INDEX)
 
      ELSE IF (CLI$PRESENT('TYPEINFO')) THEN
 
        CALL TYPEINFO (INDEX)
 
      ELSE IF (CLI$PRESENT('MODHEAD')) THEN
 
        CALL MODHEAD (INDEX)
 
      ELSE IF (CLI$PRESENT('LIST')) THEN
 
        CALL LIST (INDEX)
 
      ELSE IF (CLI$PRESENT('ALIAS')) THEN
 
        CALL ALIAS (INDEX)
 
      ELSE IF (CLI$PRESENT('SHOWALIAS')) THEN
 
        CALL SHOWAL (INDEX)
 
      ELSE
 
        CALL LIB$SIGNAL (%LOC (DOLIB_NOACTION))
 
      END IF
 
      !закрыть библиотеку
 
      STATUS = LBR$CLOSE (INDEX)
 
      IF (.NOT. STATUS) CALL LIB$SIGNAL (%VAL (STATUS))
 
      !выход
 
      END
 


                                - 120 -
 
                          00152-01 97 09-3
 
 
           1.6.2. Добавление модулей
 
 
           Для  вставки  новых  модулей  в  открытую   библиотеку
 
      используются следующие процедуры:
 
           LBR$LOOKUP_KEY - необязательная процедура, позволяющая
 
      убедиться в отсутствии модуля. Ожидаемое состояние  возвра-
 
      та - LBR$_KEYNOTFND;
 
           LBR$PUT_RECORD -  вызывается  для  каждой  вводимой  в
 
      модуль записи; содержание записи передается в качестве вто-
 
      рого параметра. При первом вызове LBR$PUT_RECORD возвращает
 
      адрес записи в файле (RFA) в библиотеке в качестве третьего
 
      параметра. При последующих вызовах этой процедуре передает-
 
      ся RFA в качестве третьего параметра, поэтому нельзя  изме-
 
      нять это значение между вызывами;
 
           LBR$PUT_END  -  вызывается  после  последнего   вызова
 
      LBR$PUT_RECORD;
 
           LBR$INSERT_KEY - вызывается для каталогизации записей,
 
      только что введенных в библиотеку. Второй  параметр  указы-
 
      вает имя модуля.
 
           Для замены существующего модуля  необходимо  запомнить
 
      старое значение RFA, возвращенное (сообщения об ошибке быть
 
      не должно) процедурой LBR$LOOKUP_KEY, в одной переменной, а
 
      новое значение RFA, возвращенное процедурой  LBR$PUT_RECORD
 
      при первом вызове - в другой переменной. Можно использовать
 
      процедуру LBR$REPLACE_KEY вместо LBR$INSERT_KEY, задав ста-
 
      рое значение RFA в качестве третьего параметра и новое зна-
 
      чение RFA - в качестве четвертого параметра.
 
           Пример.
 
           Подпрограмма ENTER  запрашивает  имена  модулей  и  их
 
      тексты с SYS$INPUT и добавляет модули к текстовой библиоте-
 


                                - 121 -
 
                          00152-01 97 09-3
 
 
      ке:
 
      SUBROUTINE ENTER (INDEX)
 
      !вводятся текстовые модули в библиотеку с SYS$INPUT
 
      INTER STATUS,           !состояние возврата
 
      2     INDEX,            !индекс библиотеки
 
      2     TXTRFA(2)         !RFA модуля
 
      CHARACTER*31 MODNAME    !имя модуля
 
      CHARAKTER*255 TEXTLINE  !одна запись текста
 
      INTEGER*2 MODNAME_LEN,  !длина имени модуля
 
      2 TEXTLINE_LEN          !длина текстовой записи
 
      !библиотечные процедуры
 
      !INTEGER LBR$LOOKUP_KEY,
 
      2        LBR$PUT_RECORD
 
      2        LBR$PUT_END,
 
      2        LBR$INSERT_KEY,
 
      2        LBR$GET_INPUT,
 
      2        LBR$PUT_OUTPUT
 
      !коды возврата
 
      EXTERNAL RMS$_EOF,       !конец файла
 
      2        LBR$KEYNOTFND,  !ключ не найден
 
      2        DOLIB_MODEX     !модуль уже есть
 
      !принять имя первого модуля
 
      STATUS = LIB$GET_INPUT (MODNAME,
 
      2                       'имя модуля или CTRL/Z: ',
 
      2                       MODNAME_LEN)
 
      IF ((.NOT. STATUS) .AND.
 
      2  (STATUS .NE. %LOC (RMS$_EOF))) THEN
 
        CALL LIB$SIGNAL (%VAL (STATUS))
 
      END IF
 
      !вставлять модули, пока не будет конец файла


                                - 122 -
 
                          00152-01 97 09-3
 
 
      DO WHILE (STATUS .NE. %LOC (RMS$_EOF))
 
        !проверить,что модуля пока нет
 
        STATUS = LBR$LOOKUP_KEY (INDEX,
 
      2                          MODNAME (1:MODNAME_LEN),
 
      2                          TXTRFA)
 
        !вставить модуль в библиотеку
 
        IF (STATUS .EQ. %LOC (LBR$_KEYNOTFND)) THEN
 
          !принять первую строку текста
 
          STATUS = LBR$PUT_OUTPUT
 
      2   ('введите строки текста. Конец ввода - CTRL/Z: ')
 
          IF (.NOT. STATUS) CALL LIB$SIGNAL (%VAL (STATUS))
 
          STATUS = LIB$GET_INPUT (TEXTLINE,,
 
      2                           TEXTLINE_LEN)
 
          IF ((.NOT. STATUS) .AND.
 
      2       (STATUS .NE. %LOC (RMS$_EOF)) THEN
 
            CALL LIB$SIGNAL (%VAL (STATUS))
 
          END IF
 
          !вставлять строки текста, пока не будет конец файла
 
          DO WHILE (STATUS .NE. %LOC (RMS$_EOF))
 
            !вставить строку
 
            STATUS = LIB$PUT_RECORD '(INDEX,,
 
      2                               TEXTLINE (1:TEXTLINE_LEN),
 
      2                               TXTRFA)
 
           IF (.NOT. STATUS) CALL LIB$SIGNAL (%VAL (STATUS))
 
           !принять другую строку
 
           STATUS = LIB$GET_INPUT (TEXTLINE,,TEXTLINE_LEN)
 
           IF ((.NOT. STATUS) .AND.
 
      2        (STATUS .NE. %LOC (RMS$_EOF))) THEN
 
             CALL LIB$SIGNAL (%VAL (STATUS))
 
           END IF


                                - 123 -
 
                          00152-01 97 09-3
 
 
         END DO
 
         !прервать текст и каталогизировать модуль
 
         STATUS = LBR$PUT_END (INDEX)
 
         IF (.NOT. STATUS) CALL LIB$SIGNAL (%VAL (STATUS))
 
         STATUS = LBR$INSERT_KEY (INDEX,
 
      2                           MODNAME (1:MODNAME_LEN),
 
      2                           TXTRFA)
 
         IF (.NOT. STATUS) CALL LIB$SIGNAL (%VAL (STATUS))
 
       ELSE IF (STATUS) THEN
 
         CALL LIB$SIGNAL (DOLIB_MODEX,
 
      2                   %VAL (1),
 
      2                   MODNAME (1:MODNAME_LEN)
 
       ELSE
 
         CALL LIB$SIGNAL (%VAL(STATUS))
 
       END IF
 
        !принять другое имя модуля
 
        STATUS = LIB$GET_INPUT (MODNAME,
 
      2                         'имя модуля:',
 
      2                         MODNAME_LEN)
 
        IF ((.NOT. STATUS) .AND.
 
      2     (STATUS .NE. %LOC (RMS$_EOF))) THEN
 
          CALL LIB$SIGNAL (%VAL (STATUS))
 
        END IF
 
      END DO
 
      !выход
 
      END
 


                                - 124 -
 
                          00152-01 97 09-3
 
 
           1.6.3. Удаление модулей
 
 
           Для удаления модулей из библиотеки применяются следую-
 
      щие процедуры:
 
           LBR$LOOKUP_KEY - вызывается для обнаружения местополо-
 
      жения модуля. Имя модуля задается в качестве второго  пара-
 
      метра; в качестве третьего параметра LBR$LOOKUP_KEY возвра-
 
      щает RFA модуля; не следует менять это значение;
 
           LBR$DELETE_KEY - вызывается для удаления ключа модуля.
 
      Имя модуля задается вторым параметром;
 
           LBR$DELETE_DATA - вызывается для удаления самого моду-
 
      ля. Во втором параметре задается RFA модуля.
 
           Пример.
 
           Подпрограмма DELETE принимает имена модулей из команд-
 
      ной строки и удаляет указанные модули из текстовой  библио-
 
      теки:
 
 
      SUBROUTINE DELETE (INDEX)
 
      !удаляются имена модулей, заданные в квалификаторе /DELETE
 
      INTEGER STATUS,        !состояние возврата
 
      2       INDEX,         !индекс библиотеки
 
      2       TXTRFA(2)      !RFA модуля
 
      CHARACTER*31 MODNAME   !имя модуля
 
      INTEGER MODNAME_LEN    !длина имени модуля
 
      !библиотечные процедуры
 
      INTEGER LBR$LOOKUP_KEY,
 
      2       LBR$DELETE_KEY,
 
      2       LBR$DELETE_DATA,
 
      2       CLI$GET_VALUE,
 
      2       LBR$LOCC
 
      !коды возврата


                                - 125 -
 
                          00152-01 97 09-3
 
 
      EXTERNAL LBR$_KEYNOTFND,   !ключ не найден
 
      2        DOLIB_NOMOD       !нет такого модуля
 
      !взять имя модуля из /DELETE командной строки
 
      STATUS = CLI$GET_VALUE ('DELETE', MODNAME)
 
      !удалять модули до появления неудовлетворительного
 
      !состояния возврата, свидетельствующего об окончании
 
      !значений квалификатора
 
      DO WHILE (STATUS)
 
        !вычислить длину имени модуля
 
        !взять имя модуля из /DELETE командной строки
 
        !искать модули в индексе библиотеки
 
        STATUS = LBR$LOOкUP_KEY (INDEX,
 
      2                          MODNAME (1:MODNAME_LEN),
 
      2                          TXTRFA)
 
        !удалить модуль, если он существует
 
        IF (STATUS) THEN
 
          STATUS = LBR$DELETE_KEY (INDEX,
 
      2                            MODNAME(1:MODNAME_LEN))
 
          IF (.NOT. STATUS) CALL LIB$SIGNAL (%VAL (STATUS))
 
          STATUS = LBR$DELETE_DATA (INDEX,TXTRFA)
 
          IF (.NOT. STATUS) CALL LIB$SIGNAL (%VAL (STATUS))
 
          !
 
          ELSE IF (STATUS .EQ. %LOC (LBR$_KEYNOTFND) THEN
 
          CALL LIB$SIGNAL (DOLIB_NOMOD,
 
      2                    %VAL (1),
 
      2                    MODNAME (1:MODNAME_LEN))
 
        ELSE
 
          CALL LIB$SIGNAL (%VAL (STATUS))
 
        END IF
 
        !принять новое имя модуля


                                - 126 -
 
                          00152-01 97 09-3
 
 
        STATUS  = CLI$GET_VALUE('DELETE', MODNAME)
 
      END DO
 
      выход
 
      END
 
 
 
           1.6.4. Извлечение модулей
 
 
           Для извлечения модулей из библиотеки используются сле-
 
      дующие процедуры:
 
           LBR$LOOKUP_KEY - вызывается для определения местополо-
 
      жения модуля. Имя модуля задается в качестве второго  пара-
 
      метра; в третьем параметре  LBR$LOOKUP_KEY  возвращает  RFA
 
      модуля не следует менять это значение;
 
           LBR$GET_RECORD - вызывается по одному разу для  каждой
 
      записи модуля. Строку символов, предназначенную для  приема
 
      извлекаемой записи, необходимо задавать вторым  параметром.
 
      После извлечения  из  модуля  всех  записей  LBR$GET_RECORD
 
      возвращает код состояния RMS$_EOF.
 
           Пример.
 
           Подпрограмма EXTRACT берет  имя  модуля  из  командной
 
      строки, извлекает содержимое модуля  и  записывает  его  на
 
      устройство SYS$OUTPUT:
 
 
      SUBROUTINE EXTRACT (INDEX)
 
      !извлекаются текстовые модули, названные в квалификаторе
 
      !/EXTRACT, и их содержание печатается на SYS$OUTPUT
 
      INTEGER STATUS,         !состояние возврата
 
      2       INDEX,          !индекс библиотеки
 
      2       TXTRFA(2)       !RFA модуля
 
      CHARACTER*31 MODNAME    !имя модуля
 
      CHARACTER*255 TEXTLINE  !строка текста


                                - 127 -
 
                          00152-01 97 09-3
 
 
      INTEGER MODNAME_LEN     !длина имени модуля
 
      INTEGER TEXTLINE_LEN    !длина строки текста
 
      !библиотечные процедуры
 
      INTEGER LBR$LOOKUP_KEY,
 
      2       LBR$GET_RECORD,
 
      2       LBR$PUT_OUTPUT,
 
      2       CLI$GET_VALUE,
 
      2       LIB$LOCC
 
      !коды возврата
 
      EXTERNAL LBR$KEYNOTFND,   !ключ не найден
 
      2        RMS$_EOF,        !конец текста в модуле
 
      2        DOLIB_NOMOD      !нет такого модуля
 
      !взять модуль по имени из /EXTRACT командной строки
 
      STATUS = CLI$GET_VALUE ('EXTRACT', MODNAME)
 
      !извлекать до получения неудовлетворительного состояния
 
      !возврата, означающего конец значений квалификатора
 
      DO WHILE (STATUS)
 
        !вычислить длину имени модуля
 
        !извлекаются текстовые модули, названные в квалификаторе
 
        !/EXTRACT, и их содержание печатается на SYS$OUTPUT
 
        !искать имя модуля в индексе библиотеки
 
        STATUS = LBR$LOOKUP_KEY (INDEX,
 
      2                          MODNAME(1:MODNAME_LEN),
 
      2                          TXTRFA)
 
      !извлечь модуль, если он существует
 
       IF (STATUS) THEN
 
         !взять строку текста
 
         STATUS = LBR$GET_RECORD (INDEX, TEXTLINE)
 
         IF ((.NOT. STATUS) .AND.
 
      2       (STATUS .NE. %LOC(RMS$_EOF))) THEN


                                - 128 -
 
                          00152-01 97 09-3
 
 
           CALL LIB$SIGNAL (%VAL (STATUS))
 
         END IF
 
         !писать и извлекать записи до получения конца файла
 
         DO WHILE ((STATUS .NE. %LOC (RMS$_EOF))
 
           !вычислить длину текста
 
           TEXTLINE_LEN = 255
 
        DO WHILE ((TEXTLINE (TEXTLINE_LEN:TEXTLINE_LEN) .EQ. ' ')
 
      2      .AND.(TEXTLINE_LEN GT.O))
 
             !извлечь модуль, если он существует
 
           END DO
 
          !печатать текст
 
          IF (TEXTLINE_LEN .GT. O) THEN
 
            STATUS = LIB$PUT_OUPUT (TEXTLINE (1:TEXTLINE_LEN))
 
          ELSE
 
            STATUS = LIB$PUT_OUTPUT(' ')
 
          END IF
 
          IF (.NOT. STATUS) CALL LIB$SIGNAL (%VAL (STATUS))
 
          !взять другую запись
 
          TEXTLINE (1:255) = ' '
 
          STATUS = LIB$GET_RECORD (INDEX, TEXTLINE)
 
          IF ((.NOT. STATUS) .AND.
 
      2       (STATUS .NE. %LOC (RMS$_EOF))) THEN
 
            CALL LIB$SIGNAL (%VAL (STATUS))
 
           END IF
 
         END DO
 
       STATUS = LIB$PUT_OUTPUT ('***конец модуля***')
 
       !дать предупреждение, если модуль не существует
 
       ELSE IF (STATUS .EQ. %LOC (LBR$_KEYNOTFND) THEN
 
         CALL LIB$SIGNAL (DOLIB_NOMOD,
 
      2                   %VAL (1),


                                - 129 -
 
                          00152-01 97 09-3
 
 
      2                   MODNAME (1:MODNAME_LEN))
 
       ELSE
 
         CALL LIB$SIGNAL (%VAL (STATUS))
 
       END IF
 
       STATUS = CLI$GET_VALUE ('EXTRACT', MODNAME)
 
      END DO
 
      !выход
 
      END
 
 
 
           1.6.5. Использование нескольких ключей и индексов
 
 
           Один и тот же модуль можно указать с помощью  несколь-
 
      ких ключей. Ключ может быть в первичном индексе (индекс  1)
 
      или в альтенативных индексах (от второго до десятого индек-
 
      са). Лучше всего зарезервировать первичный индекс под имена
 
      модулей.  В  системно-определенных  об'ектных   библиотеках
 
      индекс 2 содержит глобальные идентификаторы, определенные в
 
      различных модулях. Например, подпрограмма  ALIAS  связывает
 
      дополнительные ключи (которые она называет псевдоименами) с
 
      модулями, и хранит эти ключи в индексе 2:
 
      SUBROUTINE ALIAS (INDEX)
 
      !модули каталогизируются по псевдоименам
 
      INTEGER STATUS,      !состояние возвращения
 
      2       INDEX,       !индекс библиотеки
 
      2      TXTRFA(2)     !модуль RFA
 
      CHARACTER*31 MODNAME,!имя модуля
 
      2      ALIASNAME     !название псевдоимени
 
      INTEGER MODNAME_LEN  !длина имени модуля
 
      INTEGER ALIASNAME_LEN !длина псевдоимени
 
      !библиотечные процедуры VMS
 


                                - 130 -
 
                          00152-01 97 09-3
 
 
      INTEGER LBR$LOOKUP_KEY,
 
      2        LBR$SET_INDEX,
 
      2        LBR$INSERT_KEY,
 
      2        LIB$GET_INPUT,
 
      2        LIB$GET_VALUE,
 
      2        LIB$LOCC
 
      !коды возврата
 
      EXTERNAL LBR$_KEYNOTFND,!ключ не найден
 
      2        LBR$_DUPKEY,   !повторение ключа
 
      2        RMS$_EOF,      !конец текста в модуле
 
      2        DOLIB_NOMOD    !нет такого модуля
 
      !взять имя модуля из /ALIAS командной строки
 
      CALL CLI$GET_VALUE ('ALIAS',MODNAME)
 
      !вычислить длину имени модуля
 
      MODNAME_LEN = LIB$LOCC (' ',MODNAME) - 1
 
      !искать имя модуля в индексе библиотеки
 
      STATUS = LBR$LOOKUP_KEY(INDEX,
 
      2                       MODNAME (1.MODNAME_LEN),
 
      3                       TXTRFA)
 
      END IF
 
      !ввести псевдоимена, если модуль существует
 
      IF (STATUS) THEN
 
        !установить в индекс 2
 
        SтATUS = LBR$GET_INDEX (INDEX,2)
 
        IF (.NOT.STATUS) CALL LIB$SIGNAL (%VAL (STATUS))
 
        !взять псевдоимя из /ALIAS KOмандной строки
 
        STATUS = CLI$GET_VALUE ('ALIAS', ALIASNAME)
 
        !вводить псевдоимена в индекс 2 до
 
        !неудовлетворительного состояния возврата
 
        !означающего окончание значений квалификатора


                                - 131 -
 
                          00152-01 97 09-3
 
 
        DO WHILE (STATUS)
 
          !вычислить длину псевдоимени
 
          ALIASNAME_LEN=LIB$LOCC(' ',ALIASNAME) - 1
 
          !помесить псевдоимя в индекс
 
          STATUS = LBR$INSERT_KEY (INDEX,
 
      2                            ALIASNAME(1:ALIASNAME_LEN),
 
      2                            TXTRFA )
 
          IF ((.NOT.STATUS) .AND.
 
      2   (STATUS .NE. %LOC(LBR$_DUPKEY)) THEN
 
            CALL LIB$SIGNAL (%VAL (STATUS))
 
          END IF
 
      !взять новое псевдоимя
 
          STATUS CLI$GET_VALUE ('ALIAS',ALIASNAME)
 
        END DO
 
          !выдать предупреждение если модуля нет
 
      ELSE IF (STATUS .EQ. %LOC (LBR$_KEYNOTFND) THEN
 
        CALL LIB$SIGNAL (DOLIB_NOMOD,
 
      2                  %VAL(1),
 
      2                  MODNAME (1:MODNAME_LEN))
 
      ELSE
 
        CALL LIB$SIGNAL (%VAL (STATUS))
 
      END IF
 
      !выход
 
      END   !конец программы   .
 
 
           Модуль можно искать по любому связанному с ним  ключу.
 
      Например, фрагмент программы ищет ключ в индексе 2, если  в
 
      первичном индексе его найти не удалось:
 
 
      STATUS = LBR$SET_INDEX (INDEX,1)
 
      IF (.NOT. STATUS) CALL LIB$SIGNAL (%VAL (STATUS))


                                - 132 -
 
                          00152-01 97 09-3
 
 
      STATUS = LBR$LOOCUP_KEY (INDEX,
 
      2                        MODNAME(1:MODNAME_LEN)
 
      2                        TXTRFA)
 
      IF (STATUS .EQ. %LOC (LBR$_KEYNOTFND)) THEN
 
      STATUS = LBR$SET_INDEX (INDEX, 2)
 
      IF (.NOT.STATUS) CALL LIB$SIGNAL (%VAL (STATUS))
 
      STATUS = LBR$LOOCUP_KEY (INDEX,
 
      2                        MODNAME(1:MODNAME_LEN),
 
      2                        TXTRFA)
 
      IF (.NOT. STATUS) CALL LIB$SIGNAL (%VAL (STATUS))
 
      END IF   !конец фрагмента   .
 
 
           Идентифицировать связанные с модулем ключи можно  либо
 
      поиском  модуля   с   использованием   одного   из   ключей
 
      (LBR$LOOKUP_KEY), либо поиском ключей в доступных  индексах
 
      (LBR$SEARCH). Процедура LBR$SEARCH вызывает  пользовательс-
 
      кую подпрограмму каждый раз, когда находит ключ. Эта  подп-
 
      рограмма должна быть  внешней  (EXTERNAL)  функцией  целого
 
      типа, возвращающей код успешного (нечетное число) или неус-
 
      пешного завершения (четное число).  Например,  подпрограмма
 
      SHOWAL печатает имена ключей из  индекса  2  (псевдоимена),
 
      указывающие на  модуль,  определенный  в  командной  строке
 
      своим именем из первичного индекса:
 
 
      SUBROUTINE SHOWAL (INDEX)
 
      !распечатка псевдоимен модуля
 
      INTEGER STATUS,       !состояние возврата
 
      2       INDEX,        !индекс билиотеки
 
      2      TXTRFA(2)      !RFA для текста модуля
 
      CHARACTER*31 MODNAME  !имя модуля
 
      INTEGER MODNAME_LEN   !длина имени моуля


                                - 133 -
 
                          00152-01 97 09-3
 
 
      !библиотечные процедуры МОС ВП
 
      INTEGER LBR$LOOKUP_KEY,
 
      2       LBR$SEARCH,
 
      2       LBR$LOCC,
 
      !коды возврата
 
      EXTERNAL LBR$KEYNOTFND, !ключ не найден
 
      2         LBR$NOMOD     !нет такого модуля
 
      !программа поиска
 
      EXTERNAL SEARCH
 
      INTEGER SEARCH
 
      !взять имя модуля и вычислить длину
 
      CALL CLI$GET_VALUE ('SHOWALIAS', MODNAME)
 
      MODNAME_LEN = LIB$LOCC (' ',MODNAME) - 1
 
      !искать модуль в индексе 1
 
      2 STATUS = LBR$LOOKUP_KEY (INDEX,
 
      2                          MODNAME (1:MODNAME_LEN),
 
      2                          TXTRFA)
 
      IF (.NOT. STATUS) CALL LIB$SIGNAL (%VAL (STATUS))
 
      !искать псевдоимена в индексе 2
 
      2 STATUS = LBR$SEARCH (INDEX,
 
      2                    2,
 
      2                    TXTRFA,
 
      2                    SEARCH)
 
      END
 
      INTEGER FUNCTION SEARCH (ALIASNAME, RFA)
 
      ! функция, вызываемая для каждого
 
      ! псевдоимени, указывает на MODNAME;
 
      ! вывод псевдоимени;
 
      INTEGER STATUS_OK,      ! успешный возврат
 
      2       RFA (2)         ! RFA модуля


                                - 134 -
 
                          00152-01 97 09-3
 
 
      PARAMETER (STATUS_OK = 1) ! нечет
 
      CHARACTER*(*) ALIASNAME ! имя модуля
 
      ! вывести имя модуля;
 
      TYPE *, MODNAME
 
      ! выход;
 
      SEARCH = STATUS_OK
 
      END   !конец подпрограммы-функции   .
 
 
 
           1.6.6. Доступ к заголовкам модулей
 
 
           Разрешается  хранить  пользовательскую  информацию   в
 
      заголовке каждого модуля в об'еме,  заданном  при  создании
 
      библиотеки возможностью CRE$L_UHDMAX. Общий размер  каждого
 
      заголовка в байтах MHD$B_USRDAT (определено с помощью макро
 
      $MHDDEF - текущее значение  16)  плюс  значение,  указанное
 
      возможностью CRE$L_UHDMAX.
 
           Для размещения данных пользователя в заголовок  модуля
 
      необходимо найти местоположение модуля с помощью  процедуры
 
      LBR$LOOKUP_KEY, затем поместить данные в  заголовок  модуля
 
      вызовом процедуры LBR$SET_MODULE,  задав  при  этом  первый
 
      (значение указателя, возвращенное из LBR$INI_CONTROL), вто-
 
      рой (RFA, возвращенное из LBR$LOOKUP_KEY) и  пятый  (строка
 
      символов, содержащая данные) парамеры.
 
           Для чтения данных  пользователя  из  заголовка  модуля
 
      необходимо   найти   местоположение   модуля   с    помощью
 
      LBR$LOOKUP_KEY, затем прочитать заголовок модуля целиком  с
 
      помощью процедуры  LBR$SET_MODULE,  задав  первый,  второй,
 
      третий (строка символов для получения содержимого заголовка
 
      модуля) и четвертый  (длина  заголовка  модуля)  параметры.
 
      Данные пользователя начинаются с байтового смещения,  опре-
 


                                - 135 -
 
                          00152-01 97 09-3
 
 
      деленного MHD$B_USRDAT. Это значение преобразуется в индекс
 
      строки символов добавлением единицы.
 
           Пример.
 
           Данные пользователя из заголовков модулей выводятся на
 
      SYS$OUTPUT  и  в  них  вносятся  изменения,   введенные   с
 
      SYS$INPUT:
 
 
      SUBROUTINE MODHEAD (INDEX)
 
      !модифицируются заголовки модулей
 
      INTEGER STATUS,         !состояние возврата
 
      2       INDEX,          !индекс библиотеки
 
      2       TXTRFA (2)      !RFA модуля
 
      CHARACTER*31 MODNAME    !имя модуля
 
      INTEGER MODNAME_LEN     !длина имени модуля
 
      CHARACTER*8O HEADER     !заголовок модуля
 
      INTEGER HEADER_LEN      !длина заголовка модуля
 
      INTEGER USER_START      !начало данных пользователя
 
                              !в модуле
 
      CHARACTER*64 USERDATA   !раздел данных пользователя в
 
                              !в заголовке
 
      INTEGER*2 USERDATA_LEN  !длина данных пользователя
 
      !библиотечные процедуры MOС ВП
 
      INTEGER LBR$LOOKUP KEY,
 
      2       LBR$SET_MODULE,
 
      2       LIB$GET_INPUT,
 
      2       LIB$PUT_OUTPUT,
 
      2       CLI$GET_VALUE,
 
      2       LIB$LOCC
 
      !смещение данных пользователя определено в $MHDDEF
 
      EXTERNAL MHD$B_USRDAT
 


                                - 136 -
 
                          00152-01 97 09-3
 
 
      !коды возврата
 
      EXTERNAL LBR$_KEYNOTFND, !ключ не найден
 
      2        DOLIB_NOMOD     !нет такого модуля
 
      !вычислить начало данных пользователя в заголовке
 
      USER_START = %LOC (MHD$B_USRDAT) + 1
 
      !принять имя модуля из /MODHEAD командной строки
 
      STATUS = CLI$GET_VALUE ('MODHEAD',MODNAME)
 
      !принимать заголовки модулей, пока неудовлетворительное
 
      !состояние возврата не укажет на конец квалификатора
 
      DO WHILE (STATUS)
 
        !вычислить длину имени модуля
 
        MODNAME_LEN = LIB$LOCC (' ', MODNAME) - 1
 
        !искать имя модуля в индексе библиотеки
 
        STATUS = LIB$LOOKUP_KEY (INDEX,
 
      2                          MODNAME (1:MODNAME_LEN),
 
      2                          TXTRFA)
 
        !взять заголовок если модуль существует
 
        IF (STATUS) THEN
 
          STATUS = LBR$SET_MODULE (INDEX,
 
      2                            TXTRFA,
 
      2                            HEADER,
 
      2                            HEADER_LEN)
 
          IF (.NOT. STATUS) CALL LIB$SIGNAL (%VAL (STATUS))
 
          !вывести заголовок и запросить замену
 
          STATUS = LIB$PUT_OUTPUT
 
      2   ('USER DATA FOR MODULE '//MODNAME (1:MODNAME_LEN)//': '
 
          IF (.NOT. STATUS) CALL LIB$SIGNAL (%VAL (STATUS))
 
      STATUS = LIB$PUT_OUTPUT
 
      2   (HEADER (USER_START:HEADER_LEN)
 
          IF (.NOT. STATUS) CALL LIB$SIGNAL (%VAL STATUS))


                                - 137 -
 
                          00152-01 97 09-3
 
 
      STATUS = LIB$PUT_OUTPUT
 
      2   ('ENTER  REPLACEMENT TEXT BELOW OR JUST HIT RETURN: ')
 
          IF (.NOT. STATUS) CALL LIB$SIGNAL (%VAL (STATUS))
 
          STATUS = LIB$GET_INPUT (USERDATA,, USERDATA_LEN)
 
          IF (.NOT.STATUS) CALL LIB$SIGNAL (%VAL (STATUS))
 
          !заменить данные пользователя
 
          IF (USERDATA_LEN .GT. 0) THEN
 
          STATUS = LBR$SET_MODULE (INDEX,
 
      2                            TXTRFA,,,
 
      2                            USERDATA (1:USERDATA_LEN))
 
          END IF
 
          !если модуля нет, выдать  предупреждение
 
        ELSE IF (STATUS .EQ. %LOC (LBR$_KEYNOTFND) THEN
 
          CALL LIB$SIGNAL (DOLIB_NOMOD)
 
      2               %VAL (1),
 
      2               MODNAME (1:MODNAME_LEN))
 
        ELSE
 
          CALL LIB$SIGNAL (%VAL (STATUS))
 
        END IF
 
      !взять следующее имя модуля
 
      STATUS = CLI$GET_VALUE ('MODHEAD',MODNAME)
 
      END DO
 
      !выход
 
      END    !конец программы   .
 


                                - 138 -
 
                          00152-01 97 09-3
 
 
           1.6.7. Чтение заголовков библиотек
 
 
           Для получения общей информации о библиотеке вызывается
 
      процедура LBR$GET_HEADER. В качестве первого  параметра  ей
 
      передается    значение,    возвращенное    LBR$INI_CONTROL.
 
      LBR$GET_HEADER возвращает информацию во  втором  параметре,
 
      который должен быть массивом из 128 длинных слов. Идентифи-
 
      каторы LHI$ идентифицируют значащие слова этого массива  по
 
      их байтовым смещениям  в  массиве  (см.[3]).  Эти  значения
 
      переводятся в индексы делением на 4 и добавлением единицы.
 
           Пример.
 
           Подпрограмма TYPEINFO читает информацию  из  заголовка
 
      библиотеки:
 
 
      SUBROUTINE TYPEINFO (INDEX)
 
      !выводит на SYS$OUTPUT старший и младший ID библиотеки
 
      INTEGER STATUS,         !состояние возврата
 
      2       INDEX,          !индекс библиотеки
 
      2       HEADER (128),   !структура для информации заголовка
 
      2       TYPE,           !индексы для структуры заголовка
 
      2       MAJOR_ID,       !старший ID
 
      2       MINOR_ID,       !младший ID
 
      CHARACTER*8 MAJOR_ID_TEXT, !вывести в символьном формате
 
      2       MINOR_ID_TEXT
 
      !процедуры библиотеки МОС ВП
 
      INTEGER LBR$GET_HEADER,
 
      2       LIB$PUT_OUPUT
 
      !смещения для заголовка --- определены в $LHIDEF
 
      EXTERNAL LHI$L_TYPE,
 
      2        LHI$L_MAJORID,
 
      2        LHI$L_MINORID


                                - 139 -
 
                          00152-01 97 09-3
 
 
      !значение типа библиотеки---определены в $LBRDEF
 
      EXTERNAL LBR$C_TYP_OBJ,
 
      2        LBR$C_TYP_MLB,
 
      2        LBR$C_TYP_HLP,
 
      2        LBR$C_TYP_TXT
 
      !принять информацию заголовка
 
      STATUS = LBR$GET_HEADER (INDEX,HEADER)
 
      IF (.NOT. STATUS) CALL LIB$SIGNAL (%VAL (STATUS))
 
      !вычислить индексы для структуры заголовка
 
      TYPE = %LOC (LHI$L_TYPE) /4 + 1
 
      MAJOR_ID = %LOC(LHI$L_MAJORID) /4 + 1
 
      MINOR_ID = %LOC(LHI$L_MINORID) /4 + 1
 
      !вывести из библиотеки
 
      IF (HEADER (TYPE) .EQ. %LOC (LBR$C_TYP_OBJ)) THEN
 
        STATUS = LIB$PUT_OUTPUT('тип библиотеки: OBJECT')
 
      ELSE IF (HEADER (TYPE) .EQ. %LOC (LBR%C_TYP_MLB)) THEN
 
        STATUS = LIB$PUT_OUTPUT('тип библиотеки: MACRO')
 
      ELSE IF (HEADER (TYPE) .EQ. %LOC (LBR$C_TYP_HLP)) THEN
 
        STATUS = LIB$PUT_OUTPUT('тип библиотеки: HELP')
 
      ELSE IF (HEADER (TYPE) .EQ. %LOC (LBR$C_TYP_TXT)) THEN
 
        STATUS = LIB$PUT_OUTPUT ('тип библиотеки: TEXT')
 
      ELSE
 
        STATUS = LIB$PUT_OUTPUT('тип библиотеки: UNKNOWN')
 
      END IF
 
      IF (.NOT. STATUS) CALL LIB$SIGNAL(%VAL (STATUS))
 
      !преобразовать и вывести старший ID
 
      WRITE (UNIT = MAJOR_ID_TEXT
 
      2      FMT = '(I)') HEADER (MAJOR_ID)
 
      STATUS = LIB$PUT_OUTPUT ('MAJOR_ID: '//MAJOR_ID_TEXT)
 
      IF (.NOT. STATUS) CALL LIB$SIGNAL (%VAL (STATUS))


                                - 140 -
 
                          00152-01 97 09-3
 
 
      !преобразовать и вывести младший ID
 
      WRITE (UNIT = MINOR_ID_TEXT,
 
      2       FMT = '(I)') HEADER (MINOR_ID)
 
      STATUS = LIB$PUT_OUTPUT ('MINOR ID: '//MINOR_ID_TEXT)
 
      IF (.NOT. STATUS) CALL LIB$SIGNAL (%VAL (STATUS))
 
      !выход
 
      END    !конец программы   .
 
 
 
           1.6.8. Вывод на экран справочного текста
 
 
           Информацию  из  библиотеки  справочных  текстов  можно
 
      вывести на экран с помощью процедуры LBR$OUTPUT_HELP,  ука-
 
      зав первый (подпрограмма вывода), третий (ключевые слова) и
 
      четвертый  (имя  библиотеки)  параметры.  Необходимо  также
 
      задать последний параметр, если пятый  параметр  устанавли-
 
      вает режим подсказки или опущен. Все подпрограммы,  указан-
 
      ные в списке параметров, должны быть  описаны  как  внешние
 
      (EXTERNAL). В  качестве  первого  и  последнего  параметров
 
      могут быть использованы LIB$PUT_OUTPUT и LIB$GET_INPUT. При
 
      использовании собственных  процедур  необходимо  проверить,
 
      что список их параметров такой же, как у  LIB$PUT_OUTPUT  и
 
      LIB$GET_INPUT соответственно. Не следует вызывать процедуры
 
      LBR$INI_CONTROL и LBR$OPEN перед вызовом LBR$OUTPUT_HELP.
 
           Пример.
 
           Программа  GET_HELP  запрашивает  ключевые   слова   с
 
      SYS$INPUT и выводит на SYS$OUTPUT тексты, связанные с этими
 
      ключевыми словами, подавляя подсказку:
 
 
      PROGRAM GET_HELP
 
      !печать текста из библиотеки справочных текстов
 
      CHARACTER*31 LIBSPEC     !имя библиотеки


                                - 141 -
 
                          00152-01 97 09-3
 
 
      CHARACTER*15 KEYWORD     !ключевое слово в библиотеке
 
                               !справочных текстов
 
      INTEGER*2 LIBSPEC_LEN
 
      2       KEYWORD_LEN      !длина ключевого слова
 
      INTEGER FLAGS,           !флаги вида справки
 
      2       STATUS           !состояние возврата
 
      !библиотечные процедуры
 
      INTEGER LBR$OUTPUT_HELP,
 
      2       LBR$GET_INPUT,
 
      2       LIB$PUT_OUTPUT
 
      EXTERNAL LIB$GET_INPUT,
 
      2        LIB$PUT_OUTPUT
 
      !коды ошибок
 
      EXTERNAL RMS$_EOF,       !конец файла
 
      2        LIB$_INPSTRTRU  !входная строка укорочена
 
      !значения флагов --- определены в $HLPDEF
 
      EXTERNAL HLP$M_PROMPT,
 
      2        HLP$M_PROCESS,
 
      2        HLP$M_GROUP,
 
      2        HLP$M_SYSTEM,
 
      2        HLP$M_LIBLIST,
 
      2        HLP$M_HELP
 
      !принять имя библиотеки
 
      STATUS = LIB$GET_INPUT (LIBSPEC,
 
      2                       'библиотека: ',
 
      2                       LIBSPEC_LEN)'
 
      IF (.NOT. STATUS) CALL LIB$SIGNAL (%VAL (STATUS))
 
      IF (LIBSPEC_LEN .EQ. 0) THEN
 
        LIBSPEC = 'HELPLIB'
 
        LIBSPEC_LEN = 7


                                - 142 -
 
                          00152-01 97 09-3
 
 
      END IF
 
      !установить флаг подавления подсказки
 
      FLAGS = %LOC (HLP$_PROCESS) +
 
      2       %LOC (HLP$_GROUP) +
 
      2       %LOC (HLP$SYSTEM)
 
      !принять ключевое слово
 
      STATUS = LIB$GET_INPUT (KEYWORD,
 
      2                       'ключевое слово или CTRL/Z: ',
 
      IF ((.NOT. STATUS) .AND.
 
      2  (STATUS .NE. %LOC (LIB$_INPSTRTRU)) .AND.
 
      2  (STATUS .NE. %LOC (RMS$_EOF))) THEN
 
        CALL LIB$SIGNAL (%VAL(STATUS)
 
      END IF
 
      !выводить текст, пока не найдется конец файла
 
      DO WHILE (STATUS .NE. %LOC (RMS$_EOF))
 
        STATUS = LBR$OUTPUT_HELP (LIB$PUT OUTPUT,
 
      2                           KEYWORD (1:KEYWORD_LEN),
 
      2                           LIBSPEC (1:LIBSPEC_LEN),
 
      2                           FLAGS,
 
      2                           LIB$GET_INPUT)
 
        IF (.NOT. STATUS) CALL LIB$SIGNAL (%VAL (STATUS))
 
        !принять новое ключевое слово
 
        STATUS = LIB$GET_INPUT (KEYWORD ,
 
      2                         'ключевое слово или CTRL/Z: ',
 
      2                          KEYWORD_LEN)
 
        IF ((.NOT. STATUS) .AND.
 
      2     (STATUS .NE. %LOC (LIB$_INPSTRTRU))
 
      2     (STATUS .NE. %LOC (RMS$_EOF))) THEN
 
          CALL LIB$SIGNAL (%VAL (STATUS))
 
        END IF


                                - 143 -
 
                          00152-01 97 09-3
 
 
      END DO
 
      !выход
 
      END    !конец программы   .
 
 
 
           1.6.9. Обработка об'ектов из индекса
 
 
           Об'екты из индекса можно обрабатывать по одному, вызы-
 
      вая процедуру LBR$GET_INDEX. Четвертым параметром  задается
 
      имя соответствия для об'екта (или об'ектов) в индексе, под-
 
      лежащего  обработке;  для  обработки  типовых  имен   можно
 
      использовать  символы  звездочки  и  процента  -  например,
 
      'MOD*' означает все об'екты,  имена  которых  начинаются  с
 
      MOD. 'MOD%' означает все об'екты, имена которых состоят  из
 
      четырех символов и начинаются с MOD,  и  '*'  означает  все
 
      об'екты.
 
           Третий  параметр  указывает  написанную  пользователем
 
      процедуру, которая будет исполнена по одному разу для  каж-
 
      дого об'екта, указаного в третьем параметре. Эта  процедура
 
      должна быть функцией, описаной  как  внешняя,  возвращающей
 
      состояние успеха (нечетное число) или неудачи (четное  чис-
 
      ло). LBR$GET_INDEX  прекращает  обработку  при  возвращении
 
      состояния неудачи. Первый параметр,  передаваемый  функции,
 
      должен быть описан как строка символов передаваемой длины -
 
      этот параметр будет содержать имя об'екта из индекса.  Вто-
 
      рой параметр описывается как массив целых из  двух  элемен-
 
      тов.
 
           Пример.
 
           В  подпрограмме  LIST  имя  соответствия  берется   из
 
      командной строки и выводятся имена соответствующих об'ектов
 
      из индекса I (индекс, содержащий имена модулей):
 


                                - 144 -
 
                          00152-01 97 09-3
 
 
      SUBROUTINE LIST (INDEX)
 
      !распечатка модулей библиотеки
 
      INTEGER STATUS,         !состояние возврата
 
      2       INDEX,          !индекс библиотеки
 
      CHARACTER*31 MATCHNAME  !имя распечатываемого модуля
 
      INTEGER MATCHNAME_LEN   !длина имени соответствия
 
      !библиотечные процедуры
 
      INTEGER LBR$GET_INDEX,
 
      3       LIB$LOCC
 
      INTEGER MATCH
 
      EXTERNAL MATCH
 
      !принять имя модуля и вычислить длину
 
      !распечатка модулей библиотеки
 
      !вызвать процедуры вывода имен модуля
 
      2 STATUS = LBR$GET_INDEX(INDEX,
 
      3                        1,!первичный индекс,
 
      4                        MATCH,
 
      5                        MATCHNAME(1:MATCHNAME_LEN))
 
      IF (.NOT. STATUS) CALL LIB$SIGNAL (%VAL (STATUS))
 
      !выход
 
      END
 
      INTEGER FUNCTION MATCH (MODNAME, RFA)
 
      !функция, вызываемая для каждого модуля, соответвующего
 
      !MATCHNAME
 
      !вывод имени модуля
 
      INTEGER STATUS_OK,         !состояние удачного возврата
 
      2       RFA(2)             !RFA имени модуля в индексе
 
      PARAMETER (STATUS_OK = 1)  !нечетное значение
 
      CHARACTER*(*) MODNAME      !имя модуля
 
      !вывод имени


                                - 145 -
 
                          00152-01 97 09-3
 
 
      TYPE *, MODNAME    !вывод имени модуля
 
      !выход
 
      MATCH = STATUS_OK
 
      END   !конец процедуры-функции   .
 
 
 
           1.7. Язык определения файлов
 
 
           Команды и  процедуры  языка  определения  файлов  дают
 
      средства определения характеристик файла. Обычно язык опре-
 
      деления файла (FDL) используют для следующих операций :
 
           1) задание характеристик файла, которые обычным  обра-
 
      зом в языке ФОРТРАН недоступны;
 
           2) проверка и (или) модификация файловых характеристик
 
      ранее созданного файла данных в целях улучшения его взаимо-
 
      действий с программой или МОС ВП.
 
           При открытии файла с помощью оператора OPEN  использо-
 
      вать атрибуты FDL нельзя. Вместо этого создается файл  дан-
 
      ных с помощью FDL, устанавливаются желательные  характерис-
 
      тики, файл  закрывается,  а  потом  открывается  оператором
 
      OPEN. Так как между установкой атрибутов файла и доступом к
 
      нему со стороны программы файл закрыт, то с  помощью  языка
 
      FDL нельзя задавать атрибуты этапа  прогона  (то  есть  те,
 
      которые игнорируются или уничтожаются  при  закрытии  файла
 
      данных).
 


                                - 146 -
 
                          00152-01 97 09-3
 
 
           1.7.1. Создание файла FDL
 
 
           Файл FLD - это текстовый  файл  специального  формата,
 
      содержащий ряд атрибутов FDL. Файл FDL можно создать  текс-
 
      товым редактором, однако  гарантировать  правильный  формат
 
      файла может только редактор FDL;  можно  использовать  файл
 
      FDL от существующего файла данных.
 
 
 
           1.7.1.1. Использование редактора FDL
 
 
           Для  вызова   редактора   FDL   используется   команда
 
      EDIT/FDL. Редактор используется интерактивно  для  создания
 
      новых или модификации существующих файлов  FDL;  его  можно
 
      использовать и не интерактивно для улучшения взаимодействия
 
      программы или системы с ассоциированным файлом данных.
 
           В течение всего сеанса  интерактивного  редактирования
 
      редактор FDL показывает доступные  команды  или  подходящие
 
      атрибуты, каждый в сопровожлении  краткого  описания,  и  с
 
      помощью подсказки запрашивает ответ. Подсказка  состоит  из
 
      краткого вопроса, требуемого типа  значения  или  диапазона
 
      допустимых значений и ответа по умолчанию в  скобках.  Если
 
      ответа  по  умолчанию  нет,  то  в  скобках  будет   стоять
 
      тире ([-]); в этом случае необходимо дать ответ (или  прер-
 
      вать текущую команду с помощью CTRL/Z), чтобы EDIT/FDL  мог
 
      продолжить сеанс редактирования.
 
           Если редактор FDL применяется  для  задания  некоторой
 
      конкретной характеристики файла, недоступной из языка форт-
 
      ран, нужно использовать подкоманды редактора ADD, DELETE  и
 
      MODIFY для редактирования соответствующих  атрибутов.  Если
 
      FDL используется для улучшения взаимодействия  системы  или
 
      программы с существующим файлом данных, то редактором опти-


                                - 147 -
 
                          00152-01 97 09-3
 
 
      мизируется связанный с  ним  файл  FDL.  При  использовании
 
      редактора FDL для оптимизации  взаимодействия  системы  или
 
      программы с еще не созданным файлом необходимо использовать
 
      подкоманду редактора INVOKE для выбора  подходящего  сцена-
 
      рия. Сценарий - это ряд вопросов, относящихся к файлу  дан-
 
      ных, который планируется создать. Aнализируя ответы на  эти
 
      вопросы, редактор решает, какие характеристики более  всего
 
      подходят файлу и создает файл FDL, описывающий эти характе-
 
      ристики.
 
 
 
           1.7.1.2. Использование   характеристик   существующего
 
      файла данных
 
 
           Для создания файла FDL ,  описывающего  характеристики
 
      существующего   файла    данных,    используется    команда
 
      ANALYZE/RMS_FILE/FDL языка DCL, описание которой  приведено
 
      в [5], или  библиотечная  процедура  FDL$GENERATE.  Команда
 
      ANALYZE/RMS_FILE/FDL анализирует указанный  файл  данных  и
 
      создает файл FDL, описывающий характеристики  этого  файла.
 
      Процедура FDL$GENERATE изучает структуры СУД-32 (блок  дос-
 
      тупа к файлу - FAB, блок доступа к записи - RAB)  заданного
 
      файла данных и создает файл FDL, описывающий эти структуры.
 
           Файл  FDL,  созданный  командой  ANALYZE/RMS_FILE/FDL,
 
      отличается от файла FDL, созданного процедурой FDL$GENERATE
 
      (например, если при создании файлу не было изначально отве-
 
      дено место в памяти, а затем было отведено  30  блоков,  то
 
      атрибут секции файла ALLOCATE  в  файле  FDL,  созданном  с
 
      помощью FDL$GENERATE, будет 0; тот же атрибут в файле, соз-
 
      данном командой ANALYZE/RMS_FILE/FDL  будет  30).  Редактор
 
      FDL    может    оптимизировать    файл    FDL,    созданный
 


                                - 148 -
 
                          00152-01 97 09-3
 
 
      ANALYZE/RMS_FILE/FDL, но он не  может  оптимизировать  файл
 
      FDL, созданный процедурой FDL$GENERATE.
 
           Примеры.
 
           1. Создание файла FDL INCOME.FDL, описывающего  харак-
 
      теристики файла данных INCOME83.DAT:
 
      $ ANALYZE/RMS_FILE/FDL = INCOME INCOME83.DAT
 
           2. Сегмент программы создает файл FDL INCOME.FDL, опи-
 
      сывающий стркутуры СУД-32 файла  данных  INCOME83.DAT.  Так
 
      как адреса FAB и RAB доступны  только  из  пользовательской
 
      процедуры открытия, FDL$GENERATE может быть вызвана  только
 
      из пользовательской процедуры открытия [3].
 
      !файл MAIN.FOR
 
      INTEGER LUN
 
      !пользовательская процедура открытия
 
      INTEGER  FDL
 
      EXTERNAL FDL
 
      !   продолжение программы
 
      STATUS = LIB$GET_LUN (LUN)
 
      IF (.NOT. STATUS) CALL LIB$SIGNAL (%VAL (STATUS))
 
      OPEN (UNIT = LUN,
 
      2     FILE = 'INCOME83.DAT',
 
      2     STATUS = 'OLD',
 
      2     USEROPEN = FDL)
 
      !   продолжение программы
 
      !файл USER_OPEN.FOR
 
      !INTEGER FUNCTION FDL (FAB,
 
      2                      RAB,
 
      2                      LUN)
 
      !создать файл FDL
 
      !формальные параметры


                                - 149 -
 
                          00152-01 97 09-3
 
 
      BYTE FAB(*),
 
      2    RAB(*)
 
      INTEGER LUN
 
      !MASK FOR FDL$GENERATE
 
      INTEGER MASK
 
      EXTERNAL FDL$V_FULL_OUTPUT
 
      !состояние и библиотечные процедуры
 
      INTEGER STATUS,
 
      2       FDL$GENERATE
 
      MASK = IBSET (MASK, %LOC (FDL$V_FULL_OUTPUT))
 
      STATUS = FDL$GENERATE (MASK,
 
      2                      %LOC(FAB),
 
      2                      %LOC(RAB),
 
      2                      'TEST.FDL',
 
      2                      ,,,)
 
      IF (.NOT. STATUS) CALL LIB$SIGNAL (%VAL (STATUS))
 
      !   продолжение программы
 
      !возврат состояния пользовательского открытия
 
      FDL = STATUS
 
      END  !функции   .
 
 
 
           1.7.2. Приложение файла FDL к файлу данных
 
 
           Существующий файл FDL может использоваться для модифи-
 
      кации характеристик другого существующего файла данных. При
 
      модификации характеристик система открывает новый файл дан-
 
      ных и переписывает записи из существующего файла  данных  в
 
      новый.
 


                                - 150 -
 
                          00152-01 97 09-3
 
 
           1.7.2.1. Создание нового файла данных
 
 
           Для создания нового файла данных  с  характеристиками,
 
      заданными в  файле  FDL,  используется  команда  языка  DCL
 
      CREATE/FDL [4] или библиотечная процедура  FDL$CREATE  [3].
 
      Например,  команда  CREATE  создает  пустой   файл   данных
 
      INCOME83.DAT, используя характеристики заданные в файле FDL
 
      INCOME.FDL:
 
 
      $ CREATE/FDL = INCOME.FDL INCOME83.DAT
 
 
           Следующий сегмент программы создает пустой файл данных
 
      с именем INCOME83.DAT, используя  характеристики,  заданные
 
      файлом FDL INCOME.FDL. Переменная STATEMENT содержит  номер
 
      последнего   оператора   FDL,   обработанного    процедурой
 
      FDL$CREATE; этот параметр полезен для отладки файла FDL.
 
           Пример.
 
      INTEGER STATEMENT
 
      INTEGER STATUS,
 
      2       FDL$CREATE
 
      STATUS = FDL$CREATE ('INCOME.FDL',
 
      2                    'INCOME83.DAT',
 
      2                    ,,,,
 
      2                    STATEMENT,
 
      2                    ,,)
 
      IF (.NOT. STATUS) CALL LIB$SIGNAL (%VAL (STATUS))
 
      !   продолжение программы   .
 


                                - 151 -
 
                          00152-01 97 09-3
 
 
           1.7.2.2. Модификация существующего файла данных
 
 
           Для замены характеристик  существующего  файла  данных
 
      заданными в файле FDL характеристиками используется команда
 
      языка DCL CONVERT/FDL [4].
 
           Например, команда CONVERT изменяет характеристики фай-
 
      ла  данных  INCOME.DAT  согласно  заданным  в   файле   FDL
 
      INCOME.FDL.   Модифицированный   файл   переписывается    в
 
      NEWINCOME83.DAT (для  переписи  модифицированного  файла  в
 
      файл с тем же именем,  что  и  исходный  файл,  задается  в
 
      качестве второго параметра звездочка):
 
 
      $ CONVERT/FDL = INCOME INCOME83.DAT NEWINCOME83.DAT
 
 
           Обычно  характеристики  существующего   файла   данных
 
      меняют для того, чтобы улучшить взаимодействие с этим  фай-
 
      лом системы или программы. Если пользователь  не  знаком  в
 
      достаточной степени с СУД-32 и внутренней структурой файла,
 
      то лучше всего будет дать системе оптимизировать файл  дан-
 
      ных так, как показано в следующих этапах:
 
           1)  создать  файл  FDL, используя  команду  языка  DCL
 
      ANALYZE/RMS_FILE/FDL, например:
 
      $ ANALYZE/RMS_FILE/FDL = INCOME INCOME83.DAT
 
           2) оптимизировать файл FDL, используя редактор  FDL  в
 
      не  интерактивном  режиме.  Так  как  файл  FDL,  созданный
 
      FDL$GENERATE, описывает не сам файл, а структуры СУД-32, то
 
      EDIT/FDL не может его оптимизировать; поэтому не  воспримет
 
      такой файл в качестве входного в не  интерактивном  сеансе,
 
      напрмер:
 
      $ EDIT/FDL/NOINTERACTIVE/ANALYZE = INCOME NEWINCOME
 
           3) изменить файл данных; для  изменения  характеристик
 


                                - 152 -
 
                          00152-01 97 09-3
 
 
      существующего файла данных на заданные  в  оптимизированном
 
      файле FDL используется команда языка DCL CONVERT/FDL.  Нап-
 
      ример, следующая команда меняет характеристики файла данных
 
      INCOME83.DAT согласно с теми, которые заданы  в  файле  FDL
 
      NEWINCOME.FDL.  Модифицированный  файл   переписывается   в
 
      NEWINCOME83.DAT:
 
      $ CONVERT/FDL = NEWINCOME INCOME83.DAT NEWINCOME.DAT
 
 
 
           1.8. Пользовательские процедуры открытия
 
 
           Пользовательская процедура открытия  дает  непосредст-
 
      венный доступ к блокам FAB и RAB (блок доступа  к  файлу  и
 
      блок доступа к  записи  -  структуры  СУД-32,  определяющие
 
      характеристики файла). Пользовательская процедура  открытия
 
      используется для задания  тех  характеристик,  которые  по-
 
      другому из языка ФОРТРАН недоступны.
 
           Задаваемая пользовательская процедура  открывает  файл
 
      сама, вместо того, чтобы позволить  языку  ФОРТРАН  открыть
 
      его. Перед передачей блоков FAB и RAB пользовательской про-
 
      цедуре открытия язык ФОРТРАН устанавливает  любые  характе-
 
      ристики файла, заданные ключевыми словами в операторе  OPEN
 
      и умолчанием. Пользовательская процедура открытия не должна
 
      устанавливать или модифицировать те  характеристики  файла,
 
      которые могут быть установлены с помощью ключевых слов язы-
 
      ка ФОРТРАН, так как он может не знать, что эти  характерис-
 
      тики установлены, и может работать не так, как ожидается.
 
           Примечание.  Библиотека  системных  определений  языка
 
      ФОРТРАН  SYS$LIBRARY:FORSYSDEF.TLB   включает   определения
 
      структур записей для большей части структур СУД-32, обеспе-
 
      чивающих  непосредственный  доступ  к  СУД-32.   Правильное
 


                                - 153 -
 
                          00152-01 97 09-3
 
 
      использование этих структур  требует  знаний  о  внутреннем
 
      строении  СУД-32,  подробное  описание  которой   приведено
 
      в [6]; здесь обсуждаются только структуры FAB и RAB  (кото-
 
      рые доступны из  пользовательской  процедуры  открытия),  и
 
      процедуры SYS$CONNECT,SYS$CREATE, и SYS$OPEN.
 
 
 
           1.8.1. Спецификатор USEROPEN
 
 
           Для открытия файла с помощью пользовательской процеду-
 
      ры  необходимо  в  операторе  OPEN   указать   спецификатор
 
      USEROPEN. Значением этого  спецификатора  должно  быть  имя
 
      процедуры ( а не строка символов, содержащая имя).  Пользо-
 
      вательская процедура открытия должна быть описана как функ-
 
      ция типа INTEGER*4; так как пользовательская процедура отк-
 
      рытия задается параметром, то она  должна  быть  описана  в
 
      операторе EXTERNAL.
 
           Пример.
 
           Открытие файла SECTION.DAT с использованием  процедуры
 
      UFO-OPEN:
 
 
      !номер логического устройства
 
      INTEGER LUN
 
      !описание пользовательской процедуры открытия
 
      INTEGER UFO_OPEN
 
      EXTERNAL UFO_OPEN
 
      !    продолжение описаний
 
      OPEN (UNIT_LUN,
 
      2     FILE = 'SECTION.DAT',
 
      2     STATUS = 'OLD',
 
      2     USEROPEN = UFO_OPEN)
 
      !    продолжение программы   .


                                - 154 -
 
                          00152-01 97 09-3
 
 
           1.8.2. Написание пользовательской процедуры открытия
 
 
           Пользовательская процедура открытия должна иметь тип и
 
      воспринимать следующие три параметра:
 
           1) адрес блока FAB,  задаваемый  как  переменная  типа
 
      RECORD. Используется структура записи FABDEF,  определенная
 
      в модуле $FABDEF из SYS$LIBRARY:FORSYSDEF.TLB;
 
           2) адрес блока RAB,  задаваемый  как  переменная  типа
 
      RECORD. Используется структура записи RABDEF,  определенная
 
      в модуле $RABDEF из SYS$LIBRARY:FORSYSDEF.TBL;
 
           3)  номер  логического  устройства,   задаваемый   как
 
      INTEGER.
 
           Пользовательская процедура открытия обязана  выполнять
 
      по крайней мере следущие операции:
 
           1) открытие существующего  файла  системной  служебной
 
      процедурой SYS$OPEN;  создание  файла  системной  служебной
 
      процедурой SYS$CREATE;
 
           2) привязка к файлу с помощью системной служебной про-
 
      цедуры SYS$CONNECT для установления потока  записей  ввода-
 
      вывода;
 
           3) возвращение кода состояния  процедур  SYS$OPEN  или
 
      SYS$CREATE в качестве значения функции.
 
           Кроме этого, перед открытием  файла  необходимо  наст-
 
      роить одно или несколько полей в блоках FAB и RAB.
 
           Пример.
 
           Пользовательская процедура открытия UFO_OPEN открывает
 
      существующий файл, заданный в операторе OPEN  в  вызывающей
 
      программной единице:
 
 
      INTEGER FUNCTION UFO_OPEN (FAB,
 
      2                          RAB,


                                - 155 -
 
                          00152-01 97 09-3
 
 
      2                          LUN)
 
      !включить определения СУД-32
 
      INCLUDE '($FABDEF)'
 
      INCLUDE '($RABDEF)'
 
      !описать формальные параметры
 
      RECORD /FABDEF/ FAB
 
      RECORD /RABDEF/ RAB
 
      INTEGER LUN
 
      !описать переменную состояния
 
      INTEGER STATUS
 
      !описать системные процедуры
 
      INTEGER SYS$CREATE,
 
      2       SYS$OPEN,
 
      2       SYS$CONNECT
 
      !возможные модификации FAB и (или) RAB
 
      !    продолжение программы
 
      !открыть файл
 
      STATUS = SYS$OPEN (FAB)
 
      IF (STATUS)
 
      2  STATUS = SYS$CONNECT (RAB)
 
      !вернуть состояние $OPEN или $CONNECT
 
      UFO_OPEN = STATUS
 
      END
 
 
 
           1.8.3. Установка полей FAB и RAB
 
 
           Каждое поле в блоках FAB и RAB определено  символичес-
 
      ким именем, например, FAB$L_FOP. Там,  где  отдельные  биты
 
      поля представляют собой различные атрибуты, каждое  битовое
 
      смещение идентифицируется подобным же символическим именем,
 


                                - 156 -
 
                          00152-01 97 09-3
 
 
      например, FAB$V_CTG. Первые три буквы идентифицируют струк-
 
      туру, содержащую поле. Буква, следующая за знаком  денежной
 
      единицы означает либо длину поля (в - байт, W - слово, L  -
 
      длинное слово),либо смещение бита (V -  бит),  а  не  поле.
 
      Буквы, идущие за  подчеркиванием,  идентифицируют  атрибут,
 
      связанный с полем или битом. Идентификатор FAB$L_FOP идети-
 
      фицирует поле возможностей FAB; это поле есть длинное  сло-
 
      во; идентификатор FAB$V_CTG идентифицирует бит непрерывнос-
 
      ти в поле возможностей.
 
           Определения структурных элементов для FAB и RAB  нахо-
 
      дятся   в   модулях   $FABDEF    и    $RABDEF    библиотеки
 
      SYS$LIBRARY:FORSYSDEF.TLB. Для использования этих определе-
 
      ний необходимо:
 
           1)  включить  эти   модули   в   программную   единицу
 
      (INCLUDE);
 
           2) описать переменные типа RECORD для FAB и RAB;
 
           3) ссылаться на различные поля FAB  и  RAB,  пользуясь
 
      символическими именами полей.
 
           Пример.
 
           Пользовательская процедура открытия UFO_CONTIG задает,
 
      что блоки, отведенные файлу, должны быть расположены непре-
 
      рывно. Для задания непрерывности следует сбросить бит жела-
 
      тельной непрерывности (FAB$V_CBT) в поле FAB$L_FOP и  уста-
 
      новить бит непрерывности (FAB$VCTG) того же поля:
 
 
      INTEGER FUNCTION UFO_CONTIG (FAB,
 
      2                            RAB,
 
      2                            LUN)
 
      !включить определения СУД-32
 
      INCLUDE '($FADDEF)'
 


                                - 157 -
 
                          00152-01 97 09-3
 
 
      INCLUDE '($RABDEF)'
 
      !описать формальные параметры
 
      RECORD /FABDEF/ FAB
 
      RECORD /RABDEF/ RAB
 
      INTEGER LUN
 
      !описать переменную состояния
 
      INTEGER STATUS
 
      !описать системные процедуры
 
      INTEGER SYS$CREATE,
 
      2       SYS$CONNECT
 
      !сбросить бит желательной непрерывности и
 
      !установить бит непрерывности в поле возможностей
 
      FAB.FAB$L_FOP = IBCLR(FAB.FAB$L_FOP, FAB$V_CBT)
 
      FAB.FAB$L_FOP = IBSET (FAB.FAB$L_FOP, FAB$V_CTG)
 
      !открыть файл
 
      STATUS = SYS$CREATE (FAB)
 
      IF (STATUS) STATUS = SYS$CONNECT (RAB)
 
      !вернуть состояние открытия или привязки
 
      UFO_CONTIG = STATUS
 
      END   !конец процедуры открытия   .
 
 
 
 
 
 

                                - 158 -
 
                          00152-01 97 09-3
 
 
                     Перечень ссылочных документов
 
 
 
      1. Операционная система МОС ВП. Подсистема системного  сер-
 
         виса. Программы системного обслуживания. Справочный  ма-
 
         териал.  00152-01 97 06.
 
      2. Oперационная система МОС ВП. Подсистема разработки прог-
 
         рамм. Программа сортировки/слияния. Руководство програм-
 
         миста. 00152-01 33 06.
 
      3. Операционная система МОС ВП. Подсистема системного  сер-
 
         виса. Интерфейсные программы. Руководство  программиста.
 
          00152-01 33 02.
 
      4. Операционная   система  МОС  ВП.  Подсистема  разработки
 
         программ.   Библиотекарь.   Руководство    пользователя.
 
          00152-01 92 16.
 
      5. Операционная система МОС ВП. Подсистема управления. Диа-
 
         логовый   командный   язык.    Руководство    оператора.
 
          00152-01 34 01-1.
 
      6. Операционная  система МОС ВП. Система управления данными
 
         СУД-32. Проектирование файлов. Руководство пользователя.
 
          00152-01 92 01.
 
 
 
 

                                - 158K -
 
                          2б.00152-01 97 09-3
 
 
                     Перечень ссылочных документов
 
 
 
      1. Операционная система МОС ВП. Подсистема системного  сер-
 
         виса. Программы системного обслуживания. Справочный  ма-
 
         териал.  2б.00152-01 97 06.
 
      2. Oперационная система МОС ВП. Подсистема разработки прог-
 
         рамм. Программа сортировки/слияния. Руководство програм-
 
         миста. 2б.00152-01 33 06.
 
      3. Операционная система МОС ВП. Подсистема системного  сер-
 
         виса. Интерфейсные программы. Руководство  программиста.
 
         2б.00152-01 33 02.
 
      4. Операционная   система  МОС  ВП.  Подсистема  разработки
 
         программ.   Библиотекарь.   Руководство    пользователя.
 
         2б.00152-01 92 16.
 
      5. Операционная система МОС ВП. Подсистема управления. Диа-
 
         логовый   командный   язык.    Руководство    оператора.
 
         2б.00152-01 34 01-1.
 
      6. Операционная  система МОС ВП. Система управления данными
 
         СУД-32. Проектирование файлов. Руководство пользователя.
 
         2б.00152-01 92 01.
 
 
 
 
 
 
 
 
 
 
 
 
 
                              - 159K -

                         2б.00152-01 97 09-3

    ----------------------------------------------------------- 
    I               Лист регистрации изменений                I 
    ----------------------------------------------------------- 
    I Номера листов (страниц)IВсего I       IВходяшийI    I   I 
    I------------------------IлистовI    N  I    N   I    IДа-I 
    I   IИз- IЗа- I   IАнну- I(стра-I       Iсопрово-IПодпIта I 
    IИзмIме- Iме- IНо-Iлиро- Iниц) вIдокуменIдительноI    I   I 
    I   Iнен-Iнен-IвыхIванныхIдокум.I   та  Iго докумI    I   I 
    I   Iных Iных I   I      I      I       I и дата I    I   I 
    ----------------------------------------------------------- 
    I   I    I    I   I      I      I       I        I    I   I 
    ----------------------------------------------------------- 
    I   I    I    I   I      I      I       I        I    I   I 
    ----------------------------------------------------------- 
    I   I    I    I   I      I      I       I        I    I   I 
    ----------------------------------------------------------- 
    I   I    I    I   I      I      I       I        I    I   I 
    ----------------------------------------------------------- 
    I   I    I    I   I      I      I       I        I    I   I 
    ----------------------------------------------------------- 
    I   I    I    I   I      I      I       I        I    I   I 
    ----------------------------------------------------------- 
    I   I    I    I   I      I      I       I        I    I   I 
    ----------------------------------------------------------- 
    I   I    I    I   I      I      I       I        I    I   I 
    ----------------------------------------------------------- 
    I   I    I    I   I      I      I       I        I    I   I 
    ----------------------------------------------------------- 
    I   I    I    I   I      I      I       I        I    I   I 
    ----------------------------------------------------------- 
    I   I    I    I   I      I      I       I        I    I   I 
    ----------------------------------------------------------- 
    I   I    I    I   I      I      I       I        I    I   I 
    ----------------------------------------------------------- 
    I   I    I    I   I      I      I       I        I    I   I 
    ----------------------------------------------------------- 
    I   I    I    I   I      I      I       I        I    I   I 
    ----------------------------------------------------------- 
    I   I    I    I   I      I      I       I        I    I   I 
    ----------------------------------------------------------- 
    I   I    I    I   I      I      I       I        I    I   I 
    ----------------------------------------------------------- 
    I   I    I    I   I      I      I       I        I    I   I 
    ----------------------------------------------------------- 
    I   I    I    I   I      I      I       I        I    I   I 
    ----------------------------------------------------------- 
    I   I    I    I   I      I      I       I        I    I   I 
    ----------------------------------------------------------- 
    I   I    I    I   I      I      I       I        I    I   I 
    ----------------------------------------------------------- 
    I   I    I    I   I      I      I       I        I    I   I 
    ----------------------------------------------------------- 
    I   I    I    I   I      I      I       I        I    I   I 
    ----------------------------------------------------------- 
    I   I    I    I   I      I      I       I        I    I   I 
    ----------------------------------------------------------- 
    I   I    I    I   I      I      I       I        I    I   I 
    ----------------------------------------------------------- 

!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!