Автор: Вирт Н. Гуткнехт Ю.
Теги: системное программное обеспечение языки программирования компьютерные технологии программирование операционные системы переводная литература издательство дмк пресс
ISBN: 978-5-94074-672-0
Год: 2012
Текст
Никлаус Вирт, Юрг Гуткнехт
Разработка
операционной системы
и компилятора
Проект Оберон
Москва, 2012
Niklaus Wirth, Jiirg Gutknecht
Project Oberon
The Design
of an Operating System
and Compiler
▲
TT
Addison-Wesley
ACM Press, New York
УДК 004.451:004.430берон
ББК 32.973.26-018.2
В52
Вирт Н., Гуткнехт Ю.
В52 Разработка операционной системы и компилятора. Проект Оберон: Пер. с англ. Бо¬
рисов Е.В., Чернышов JI.H. - М.: ДМК Пресс, 2012. - 560 с.: ил.
ISBN 978-5-94074-672-0
В книге описан проект Оберон, представляющий полную программную среду для
современной рабочей станции. Главная цель, поставленная авторами, - спроекти¬
ровать и реализовать всю систему с нуля и построить ее так, чтобы она могла быть
описана, объяснена и понята как единое целое.
В дополнение к основной системе во всех деталях описан компилятор языка Обе¬
рон и графическая подсистема.
Для программистов, преподавателей и студентов, изучающих теорию и практику
построения операционных систем.
Все права защищены. Любая часть этой книги не может быть воспроизведена в какой
бы то ни было форме и какими бы то ни было средствами без письменного разрешения вла¬
дельцев авторских прав.
Материал, изложенный в данной книге, многократно проверен. Но поскольку вероятность
технических ошибок все равно существует, издательство не может гарантировать абсолютную
точность и правильность приводимых сведений. В связи с этим издательство не несет ответ¬
ственности за возможные ошибки, связанные с использованием книги.
УДК 004.451:004.430берон
ББК 32.973.26-018.2
ISBN 0-201-54428-8 (анг.)
ISBN 978-5-94074-672-0 (рус.)
Copyright © by the ACM Press
© Перевод на русский язык,
Е. В. Борисов, Л. Н. Чернышов, 2012
© Оформление, ДМК Пресс, 2012
Содержание
От авторов перевода 8
Предисловие 14
1. История и мотивация.... 16
2. Основные понятия и структура системы 21
2.1. Введение 21
2.2. Понятия 22
2.2.1. Окошки 22
2.2.2. Команды 24
2.2.3. Задачи 25
2.2.4. Инструментальные тексты как настраиваемые меню 27
2.2.5. Расширяемость 28
2.2.6. Динамическая загрузка 29
2.3. Структура системы 29
2.4. Краткий обзор глав 32
3- Система управления задачами 37
3.1. Понятие задачи 37
3.1.1. Интерактивные задачи 37
3.1.2. Фоновые задачи 39
3.2. Планировщик задач 41
3.3. Понятие команды 43
3.3.1. Атомарные действия 44
3.3.2. Обобщенное выделение текста 46
3.3.3. Обобщенное копирование из текста 47
3.3.4. Обобщенное копирование окошка 47
3.4. Наборы инструментов 48
Полная реализация 51
4. Система отображения 62
4.1. Модель планировки экрана 62
4.2. Окошки как объекты 66
4.3. Кадры как основные объекты отображения 68
4.4. Управление отображением 71
4.4.1. Окошки 72
4.4.2. Окошки меню 77
4.4.3. Управление курсором 82
4.5. Растровые операции 84
4.6. Стандартные конфигурации отображения 89
Литература 91
Полная реализация 91
5. Текстовая система 104
5.1. Текст как абстрактный тип данных 105
5.1.1. Загрузка и сохранение 106
5.1.2. Редактирование текста 107
5.1.3. Доступ к тексту 108
5.2. Управление текстом 111
5.3. Текстовые кадры 120
5.4. Шрифтовой аппарат 134
5.5. Набор инструментов редактирования 138
Литература 140
Полная реализация 140
6. Загрузчик модулей 183
6.1. Компоновка и загрузка 183
6.2. Представление модуля в системе Оберон 186
6.3. Связывающий загрузчик 188
6.4. Набор инструментов загрузчика 195
6.5. Формат объектного файла Оберона 197
7. Файловая система 198
7.1. Файлы 198
7.2. Реализация файлов в оперативной памяти 201
7.3. Реализация файлов на диске 208
7.4. Каталог файлов 222
7.5. Набор инструментов файловых утилит 241
Литература 245
8. Память: разметка и управление 246
8.1. Разметка памяти и ее организация во время выполнения 246
8.2. Выделение блоков модулей 249
8.3. Управление динамической памятью 251
8.4. Ядро 258
9- Драйверы устройств 261
9.1. Краткий обзор 261
9.2. RS-232: ASCII-стандарт для клавиатуры и последовательного
канала 262
9.3. RS-485: SDLC-стандарт для сети 269
9.4. Драйвер диска, использующий интерфейс SCSI 276
10. Сеть 281
10.1. Введение 281
Содержание
6
10.2. Протокол 282
10.3. Адресация станций 284
10.4. Реализация 284
11. Выделенный сервер для распространения файлов,
почты и печати 293
11.1. Концепция и структура 293
11.2. Почтовая служба 295
11.3. Служба печати 315
11.4. Разные службы 325
11.5. Пользовательское администрирование 329
12. Компилятор 337
12.1. Введение 337
12.2. Шаблоны кода 339
12.3. Внутренние структуры данных и интерфейсы 355
12.4. Синтаксический анализатор 362
12.5. Сканер (лексический анализатор) 386
12.6. Поиск в таблице символов и символьные файлы 393
12.7. Выбор кода 409
12.8. Генерация кода 446
12.9. Средство символьной отладки 462
13. Графический редактор 470
13.1. История и назначение 470
13.2. Краткое руководство по системе рисования линий в Обероне ... 471
13.2.1. Основные команды 472
13.2.2. Команды меню 474
13.2.3. Дополнительные команды 474
13.2.4. Макросы 475
13.2.5. Прямоугольники 475
13.2.6. Наклонные линии, окружности и эллипсы 476
13.2.7. Сплайновые кривые 476
13.2.8. Построение нового макроса 477
13.3. Ядро и его структура 477
13.4. Отображение графики 485
13.5. Пользовательский интерфейс 488
13.6. Макросы 490
13.7. Классы объектов 491
13.8. Реализация 494
13.8.1. Модуль Draw 494
13.8.2. Модуль GraphicFrames 500
13.8.3. Модуль Graphics 513
13.9. Прямоугольники и кривые 531
13.9.1. Прямоугольники 531
13.9.2. Наклонные линии, окружности и эллипсы 535
Содержание
8
Содержание
14. Инструменты создания и поддержки системы 541
14.1. Процесс запуска 541
14.2. Инструменты создания 543
14.3. Инструменты поддержки 545
Литература 548
А. Десять лет спустя: от объектов к компонентам 549
А. 1. Библиотеки объектов .550
Обобщенный алгоритм выгрузки 551
Обобщенный алгоритм загрузки 552
А.2. Кадры как визуальные объекты 553
А.З. Встроенные объекты 555
А.4. Аксессуары 556
От авторов перевода
Признаться, мы не сразу решились взяться за перевод книги профессоров Никла-
уса Вирта и Юрга Гуткнехта, полагая, что ее содержание, уходящее корнями в да¬
лекие 80 - 90-е годы прошлого века, вряд ли сможет заинтересовать современного
читателя. Однако по мере знакомства с ней наши сомнения стали быстро рассеи¬
ваться, пока не стало понятно, что в книге излагается оригинальный и - не побо¬
имся этого слова - свежий, из первых рук взгляд на, казалось бы, давно известную
тему и, главное, богатейший практический материал. Решающий удар по нашим
сомнениям был нанесен, когда при чтении книги мы натолкнулись на приведен¬
ные ее авторами слова одного из основоположников дисциплины программиро¬
вания К.Хоара: «В нашей отрасли считается, что инженеры должны постоянно
создавать новые артефакты без возможности изучения предыдущих работ, знание
которых как раз и должно доказывать их ценность для отрасли». Для нас стало
очевидным, что медлить с переводом этой книги просто преступно: ее идеи, ее
глубокое и насыщенное содержание обязательно должны выйти за пределы узкой
«касты жрецов» и стать достоянием широкого круга профессионалов и не только
их. Мы с азартом взялись за перевод и закончили его так быстро, что он оказался
некоторой неожиданностью для авторов, которые намеревались не спеша «омоло¬
дить» для последующих изданий свою уникальную книгу.
А книга, вне всяких сомнений, во многом уникальна. Устав распутывать бес¬
численные узелки хитросплетений самых «совершенных» на то время операци¬
онных систем, ее авторы предприняли отчаянную, дерзкую и, как они сами выра¬
зились, «безумную» попытку спроектировать и реализовать с нуля собственную
операционную систему для персональной рабочей станции. И эта попытка была
ими блестяще осуществлена (причем всего за три года!) в проекте Оберон, резуль¬
таты которого во всех подробностях представлены в этой книге-отчете. Результа¬
ты проекта действительно значительные.
Прежде всего, «побочным», но отнюдь не второстепенным, продуктом проек¬
та стал новый язык программирования Оберон - достойный продолжатель своих
знаменитых предков Паскаля и Модулы-2. Унаследовав от них все самое лучшее
и избавившись от лишнего, он стал стройнее и лаконичнее: его полный синтаксис
занимает не более двух страниц. В то же время он стал мощнее за счет встроенно¬
го в него механизма расширения типов, позволяющего программировать практи¬
чески любые расширяемые системы (каковой является и сама система Оберон),
10
От авторов перевода
придерживаясь при этом объектно-ориентированной парадигмы. Его строжайшая
типизация (в том числе указателей) позволяет теперь проектировать, описывать
и разрабатывать исключительно надежные программные системы, не опасаясь за
то, что какой-нибудь «атипичный» указатель заведет вычислительный процесс,
например, в запретную зону памяти, как это бывало раньше. О «внешних влия¬
ниях» на язык Оберон Н.Вирт с легкой иронией говорил: «Просто невозможно
поблагодарить всех тех, кто так или иначе подпитывал своими идеями то, что те¬
перь называется Оберон. Большинство идей пришло от использования и изучения
таких существующих языков, как Модула-2, Ада, Smalltalk и Cedar, которые часто
предостерегали нас от того, как не надо делать».
Не последнюю роль в поддержке доброго имени языка Оберон играют его
компилятор, загрузчик и сборщик мусора. Компактный и быстрый компилятор
создает достаточно плотный код. «Умный» динамический загрузчик не позволя¬
ет размножаться в оперативной памяти многочисленным копиям одних и тех же
исполняемых модулей, и, кроме того, внимательно следит за версиями исполня¬
емых модулей, предоставляя тем самым возможность их совместной разработки.
А сборщик мусора, как неотъемлемый компонент управления динамической па¬
мятью, обеспечивает оперативное автоматическое освобождение основной памя¬
ти от «хлама».
Благодаря этим и другим своим широким и мощным возможностям, язык
Оберон становится в руках разработчика средством спецификации, надежной ре¬
ализации и детального документирования больших программных проектов, как и
сам проект Оберон, то есть может служить в качестве языка системного програм¬
мирования высокого уровня. Вместе с тем, благодаря своей семантической ясно¬
сти, синтаксической простоте и лаконичности на грани аскетизма, он может стать,
пожалуй, наилучшим среди прочих языком для обучения дисциплине программи¬
рования, то есть служить в качестве языка систематического программирования.
Несмотря на то, что представленная в книге полная реализация системы Обе¬
рон написана на языке Оберон, его строгого определения вы в ней не найдете. От¬
части и по этой причине в нашем предисловии мы просто не имели права обойти
его вниманием и не посвятить ему хотя бы несколько похвальных строк. Однако
читатель даже с небольшим опытом программирования при внимательном чте¬
нии найдет в книге все необходимые сведения о языке (особенно в главе 12, по¬
священной его компилятору) и легко разберется в текстах программ. Тем же, кто
хочет почувствовать «аромат» и «вкус» языка, можно порекомендовать, например,
книгу Н. Вирта «Алгоритмы и структуры данных: Новая версия для Оберона» и
прилагаемый к ней CD с популярным открытым вариантом системы Оберон - си¬
стемой программирования BlackBox Component Builder с базовым языком Ком¬
понентный Паскаль - усовершенствованным диалектом языка Оберон.
Но главный «персонаж» книги - конечно же, сама система Оберон, представ¬
ляющая собой очищенную от «мути» и «вредных примесей», компактную, полно-
функциональную, многозадачную операционную систему для персональной рабо¬
чей станции, которая, будучи дополненной (расширенной) ее авторами сетевыми
возможностями, может послужить основой для мультисерверной станции.
От авторов перевода
11
К счастью, авторы фактически освободили нас от труда вводить читателя
в курс дела, поскольку сами поставили перед собой и с блеском решили непро¬
стую задачу по описанию операционной системы с нуля во всех ее деталях, как го¬
ворят, от «а» до «я». Мы посчитали, что давать здесь свои пространные пояснения
к представляемой в книге системе (даже такой сложной, как операционная) было
бы проявлением неуважения к высочайшему профессионализму, с которым авто¬
ры задумали и осуществили свой проект. Поэтому львиная доля наших усилий
была направлена именно на достойный этой книги перевод, для того чтобы здесь
ограничиться только несколькими общими комментариями.
Главный недостаток широко распространенных коммерческих операционных
систем - в том, что все они наследуют и, главное, преумножают пороки своих
предков. Их развитие (если не сказать, разбухание) - это постоянное наращива¬
ние новых возможностей вокруг некогда отлаженного и проверенного ядра, за¬
частую путем объединения нескольких отдельных специализированных систем
в одну, более мощную и универсальную. При этом в погоне за скорым результатом
у разработчиков коммерческих систем практически нет времени, чтобы оглянуть¬
ся назад и разобраться во всем том, что было сделано раньше, а главное понять,
насколько грамотно и хорошо все это было сделано. (Впрочем, перед ними такая
задача и не ставится.) В итоге, за гигантские размеры «операционок», за неэффек¬
тивность их работы, за расточительство памяти расплачиваются, увы, многочис¬
ленные их пользователи, вынужденные приобретать иод них компьютеры с еще
более мощными процессорами и еще большей оперативной памятью.
Таким образом, практически все коммерческие операционные системы под¬
тверждают закон Райзера: несмотря на свой стремительный прогресс «железо»
ускоряется медленнее, чем замедляется «софт». Проектом Оберон авторы попы¬
тались опровергнуть этот закон, и эта попытка им, похоже, удалась. Вот их вывод:
«система Оберон потребовала очень малых усилий для создания коммерческих
операционных систем широкого назначения и скромных запросов к скорости и
объемам памяти компьютера при той же мощности и гибкости для пользователя,
хотя и без некоторых излишеств».
Высокая «себестоимость» системы Оберон проявилась уже хотя бы в том, что
многие оригинальные идеи этого, в сущности, открытого проекта стремительно
разлетелись по многим более поздним коммерческим системам. По этому пово¬
ду в одной из своих лекций Н.Вирт, с присущим ему чувством юмора, говорил,
что разработчики языка Java за несколько лет до его создания «изучали исходные
коды Оберона, в частности, коды его сборщиков мусора. Потом испортили Оберон
синтаксисом Си и назвали получившееся словом «Java». Несмотря на это, хорошо
структурированная, модульная и потому компактная и надежная система Оберон
вместе со своим базовым языком Оберон заняла достойное место в ряду других
систем и по сей день продолжает успешно развиваться и совершенствоваться, не
теряя при этом своего ясного, открытого и выразительного «лица».
Первой идеи проекта Оберон начала активно развивать и продвигать осно¬
ванная в 1992 году коллегами Н.Вирта по ЕТН компания Oberon Microsystems,
одним из членов совета директоров которой стал сам Н.Вирт. К настоящему вре¬
12
От авторов перевода
мени в мире, в том числе в России, существует и используется несколько успеш¬
ных операционных систем и удобных сред разработки и поддержки программ на
языке Оберон или его диалектах, «отцом» которых стал описанный в книге ори¬
гинальный проект. Так, сама компания Oberon Microsystems разработала компакт¬
ную и «ресурсосберегающую» среду визуального программирования BlackBox
Component Builder для диалекта языка Оберон, названного Компонентным Па¬
скалем. Для разработки и исполнения программ на языках уже семейства Оберон
(Оберон-2, Оберон 07 и др.) были разработаны и другие операционные системы и
среды, «производные» от первоначальной системы Оберон, - ETH Oberon, Win-
Oberon, Bluebottle, A2 System и другие. Многие из них успешно используются
в самых разных областях техники - от бортовых систем управления полетом бес¬
пилотных летательных аппаратов и гражданских авиалайнеров до систем управ¬
ления сложной медицинской техникой. Появились также намерения воплотить
систему Оберон в «железе» - в виде микросхемы на одном чипе. Все, кто заинте¬
ресуется этими и еще более «юными» потомками проекта Оберон, смогут легко
отыскать их по ключевым словам на страницах всемирной «паутины».
Система Оберон может быть смонтирована с помощью прилагаемого к ней на¬
бора инструментов на абсолютно «голом» компьютере как самостоятельная опе¬
рационная система или «посажена» на «родную» операционную систему компью¬
тера как удобная интегрированная среда разработки и исполнения программ на
собственном базовом языке семейства Оберон.
Несмотря на исчерпывающую полноту изложения материала, присущую тех¬
ническим отчетам, авторы временами переходят на конспективный стиль в рас¬
чете на то, что читатель знаком с основными (фундаментальными) понятиями
информатики.
Надеемся, что все интересующиеся этой темой читатели прочтут книгу с та¬
ким же увлечением, как и ее переводчики. Надеемся также, что она окажется нуж¬
ной и полезной как ветеранам отрасли, так и начинающим. Для первых она может
стать глотком свежего воздуха, придать второе дыхание, а для вторых - допингом
для новых «безумных» идей и дерзновенных свершений.
И, конечно же, вне всяких сомнений, богатейший материал книги (в полном
объеме или частично) можно и должно рекомендовать для изучения любых дис¬
циплин системного программирования, в которых рассматривается широкий круг
вопросов - от проектирования до реализации операционных систем.
В заключение, несколько слов о переводе.
Операционным системам присуща широта охвата самых разнообразных тем
и понятий - от низкоуровневых, конкретных (сигналов на линиях передачи дан¬
ных, протоколов, растровых операций на экране дисплея) до высокоуровневых,
абстрактных (абстрактных типов данных, изощренных алгоритмов разметки и
сборки «мусора»). Поэтому попытка соединить в одном, довольно небольшом по
объему, тексте «стихи и прозу, лед и пламень» уже сама по себе представляет собой
многотрудную задачу не только для его авторов, но и для его переводчиков. Но
если авторов к преодолению многочисленных трудностей в их подвижнической
работе подстегивала их «безумная» идея, то нас в более чем скромной работе -
«безумный» интерес к их идее, на волне которого наши трудности в итоге оказа¬
лись почти смешными.
Так, например, весь текст книги пронизывает красной нитью фундаментальное
понятие системы Оберон «viewer». Похоже, авторы просто в воду глядели, когда
утверждали в главе 4: «несмотря на то, что все, казалось бы, пришли к согласию
в значении этого слова, на деле любые два системных разработчика расходятся
в его трактовке». Именно это и случилось с нами, когда мы искали подходящий пе¬
ревод этому многозначному слову. В итоге, отказавшись от труднопроизносимого
«просмотрщика», от двусложного «средства просмотра», от уже занятого другими
системами «окна» и от многих-многих других, мы остановились на простом и не¬
сколько наивном, но коротком слове «окошко».
Другой пример - также многозначное слово «master». В контексте разных глав
его значение, в идеале, должно быть разным. Однако после длительных согласо¬
ваний мы не нашли ничего лучшего, как «присвоить» ему единое, не зависящее
от контекста, значение другого (тоже латинского) слова «клиент», то есть тот, кто
чего-то просит или требует и оттого, видимо, всегда прав.
Заканчивая, мы хотим принести свои извинения профессиональным инжене-
рам-схемотехникам за возможные неточности перевода специальных терминов
в главе 9, касающейся тех аппаратных средств и внешних устройств компьютеров,
технических описаний которых у нас не было (да и не могло быть) под рукой.
Москва, декабрь 2011 г.
Е. Борисов, Л. Чернышов
От авторов перевода
13
Предисловие
Эта книга представляет результаты проекта Оберон, а именно полную программ¬
ную среду для современной рабочей станции. Проект был предпринят авторами
в 1986-1989 годах, и его главная цель состояла в том, чтобы спроектировать и реа¬
лизовать всю систему с нуля (на пустом месте) и построить ее таким образом, что¬
бы она могла быть описана, объяснена и понята как единое целое. Чтобы вскрыть
все аспекты, проблемы, проектные решения и детали, авторы не только придума¬
ли, но, более того, запрограммировали всю описанную в книге систему.
Хотя существует множество книг, объясняющих принципы и структуру опе¬
рационных систем, ощущается нехватка описаний систем, которые на самом деле
реализованы и используются. Мы хотели не только дать совет, как может созда¬
ваться система, но и показать, как она была создана. В связи с этим ключевую
роль в книге играют тексты программ, так как только они содержат окончательные
объяснения. Поскольку в этом случае выбору удобного формализма придавалась
особая важность, мы разрабатывали язык Оберон не только как эффективный
инструмент реализации, но и как средство публикации алгоритмов, подобно соз¬
данному три десятилетия назад Алголу 60. Благодаря своей структуре язык Обе¬
рон также хорошо подходит и для отображения глобальной модульной структуры
программируемых систем.
Несмотря на небольшое количество человеко-лет, затраченных на реализацию
системы Оберон, и несмотря на ее компактность, позволяющую уместить ее опи¬
сание в одной книге, это не академическая игрушка, а скорее универсальная сис¬
тема для рабочей станции, которая нашла множество довольных и даже востор¬
женных пользователей в академической среде и в промышленности. Описанное
здесь ядро системы, состоящее из управления памятью, файлами, отображением,
текстом, окошками (viewers), из загрузчика программ и драйверов устройств, чер¬
пает свою главную мощь из удачно выбранного, гибкого набора основных средств
и, что более важно, из их эффективной расширяемости во многих направлениях и
для многих приложений. Расширяемость чрезвычайно усиливается языком Обе¬
рон, с одной стороны, и эффективностью основного ядра, с другой. Она коренится
в применении объектно-ориентированной парадигмы, которая используется вез¬
де, где расширяемость оказывается выгодной.
В дополнение к основной системе мы описываем во всех деталях компилятор
языка Оберон и графическую систему, которые могут рассматриваться как при¬
ложения. Первый показывает, как разработать компактный компилятор, чтобы
достичь и быстрой компиляции, и эффективного, компактного кода. Последняя
приводится в качестве примера расширяемой разработки, основанной на объект¬
Предисловие
15
но-ориентированных методах, и показывает возможность ее тесной интеграции
с существующей текстовой системой. Еще одно дополнение к основной системе -
сетевой модуль, позволяющий множеству рабочих станций взаимодействовать
между собой. Мы также показываем, насколько система Оберон, будучи допол¬
ненной распределением файлов, печатью и электронной почтой, удобна в качестве
основы для мультисерверной станции.
Компактность и регулярная структура, а также должное внимание эффек¬
тивной реализации важных деталей оказываются ключом к экономичной инже¬
нерии программного обеспечения. Системой Оберон мы хотим опровергнуть за¬
кон Райзера, который был подтвержден фактически всеми недавними выпусками
операционных систем: несмотря на большие скачки вперед, аппаратные средства
ускоряются медленнее, чем замедляется программное обеспечение. Система Обе¬
рон потребовала очень малых усилий для создания коммерческих операционных
систем широкого назначения и скромных запросов к скорости и объемам памяти
компьютера при той же мощности и гибкости для пользователя, хотя и без некото¬
рых излишеств. Приглашаем читателя узнать, как это стало возможно.
Но еще важнее то, что мы надеялись представить заслуживающее внимания
исследование значительной части программирования вообще для пользы всех тех,
кто стремится учиться на опыте других.
Мы хотим поблагодарить многих людей за их предложения, советы и поддерж¬
ку. В частности, наших коллег X. Мессенбека и Б. Сэндерса и наших товарищей
из Института вычислительных систем (Institut fur Computersysteme) за прочте¬
ние всей или части рукописи этой книги. Мы благодарны М. Брэндису, Р. Крелье,
А. Дистели, М. Францу и Дж. Темплу за их работы по успешному переносу систе¬
мы Оберон на различные коммерческие компьютеры, делающие таким образом
предлагаемое исследование более интересным для многих читателей. Мы также
благодарны нашей школе ЕТН за вклад в обеспечение такой обстановки и под¬
держки, которые позволили нам заняться этим проектом и довести его до конца.
Цюрих, февраль 1992 г.
Н. В. и Ю. Г.
1. ИСТОРИЯ И МОТИВАЦИЯ
Можно ли заставить себя сосредоточиться на работе в теплый день под роскош¬
ным солнцем и синим небом? Этим риторическим вопросом я не раз задавался,
проводя отпуск в Калифорнии в 1985 году. Любой чувствовал бы себя обязанным
вернуться домой полным удовольствий от жизни в деревне, путешествий или за¬
нятий любимым спортом в такие солнечные дни. Но здесь каждый день был та¬
ким, и поддаться подобному соблазну значило бы положить конец всей работе.
И не я ли сам выбрал это место в мире за его привлекательный, приятный климат?
К счастью, моя работа была так же соблазнительна, облегчая тем самым мою
участь. Я имел честь восседать перед самой передовой и мощной, где бы то ни было,
рабочей станцией и постигать секреты, возможно, новейшей причуды в ремесле
скоростной разработки, гоняя по экрану цветные прямоугольники. Все это долж¬
но было происходить по строгим правилам, налагаемым физическими законами и
новейшими технологиями. К счастью, передовой компьютер тут же выражал недо¬
вольство, если эти правила нарушались. Это был контролер правил, который по¬
добно старшему брату предупреждал вас о шагах, ведущих к беде. Он делал то, что
было бы невозможно сделать самому, отслеживая тысячи связей между тысячами
размещенных на экране прямоугольников. Это называлось машинным проекти¬
рованием (computer-aided design), или проектированием с помощью компьютера.
«Помощь» - это скорее эвфемизм, хотя компьютер не жаловался на принижение
его роли в этом процессе.
В то время как мои глаза были прикованы к многоцветью экрана и я со всей
очевидностью оказался перед лицом своей крайней неосведомленности, в откры¬
тую всегда дверь шагнул мой коллега. Оказалось, он тоже проводил свободное от
домашних дел время в этой лаборатории, но лицо его выражало не столько счастье,
сколько огорчение. Плитка шоколада в его руке была для него тем же, чем для дру¬
гих чашка кофе или флейта, давая временное расслабление и отвлечение. То был
не первый случай, когда он появлялся в таком настроении, и я без слов угадывал
его причину. И это могло бы повторяться еще не раз.
Его дни не были заполнены забавами с прямоугольниками; у него была цель -
разработать компилятор для этого самого передового компьютера. Поэтому он вы¬
нужден был знать основную программную систему намного ближе, если не глуб¬
же. В его положении столь частые неудачи должны были быть поняты, поскольку
он программировал, а я лишь использовал систему в приложениях, то есть был
конечным пользователем! Эти неудачи нужно было понять не для того, чтобы их
©N. Wirth, 30.08.1991 /09.11.1991
исправить, а чтобы найти способ избежать их. Но как достичь необходимого по¬
нимания? В этот момент я понял, что пока далек от этого вопроса; я ограничил
знакомство с этой новой системой до необходимого минимума, который был дос¬
таточен для моей задачи.
Вскоре стало ясно, что разобраться в системе было почти невозможно. Ее раз¬
меры были просто устрашающими, а документация - довольно скудной. Ответы
на неотложные вопросы лучше всего было получать из расспросов разработчиков
системы, которые всегда были рядом. При этом мы сделали потрясающее откры¬
тие: часто мы не могли понять их язык. Их объяснения были полны жаргона и ссы¬
лок на другие части системы, которые оставались для нас такими же загадочными.
Таким образом, наши перерывы в работе, вызванные расстройствами от конст¬
рукции компилятора и процессора, стали посвящаться попыткам уяснить суть,
принципы новых аспектов системы. Чем она отличается от обычных операци¬
онных систем? Какие из ее концепций существенны, а какие можно улучшить,
упростить или даже отбросить? И где именно они заложены? Можно ли извлечь
суть системы и очистить ее, как в химическом процессе?
Во время последующих обсуждений потихоньку возникала идея предпринять
наш собственный проект. И вдруг она обрела реальность. «Безумие, это невозмож¬
но» было моей первой реакцией. Полный объем работы казался непреодолимым.
В конце концов, мы оба должны были выполнять дома и свои преподавательские
обязанности. Но мысль уже засела в нас и продолжала занимать наши умы.
Чуть позже домашние обстоятельства сложились так, что мне нужно было
принять важный курс системного программирования. Поскольку по неписаным
правилам он должен был иметь дело прежде всего с принципами построения опе¬
рационных систем, я колебался. Мои сомнения были легко объяснимы: ведь я ни¬
когда не разрабатывал ни систему в целом, ни даже ее часть. А как можно препо¬
давать инженерную дисциплину без личного опыта!
Неужели невозможно? А разве мы не проектировали компиляторы, операци¬
онные системы и редакторы документов малыми командами? И разве я много¬
кратно не сталкивался с тем, когда не вполне подходящая и неудачная программа
переписывалась с нуля как часть исходного кода оригинального проекта? Наш
мозговой штурм продолжался со многими перерывами более чем несколько не¬
дель, и сквозь туман стали медленно проступать определенные контуры структу¬
ры системы. Некоторое время спустя безумное решение было принято: мы начнем
с нуля проект операционной системы для нашей рабочей станции (которая, как
оказалось, обладала гораздо меньшей мощностью, чем та, на которой я гонял по
экрану прямоугольники).
Основная цель - накопить собственный опыт и достичь полного понимания
каждой детали - в сущности, определила наши трудовые ресурсы: два частично за¬
нятых программиста. Предварительно мы установили себе срок завершения работ
в три года. Как выяснилось позже, оценка была верной: программирование нача¬
лось в начале 1986 года, а первая версия системы была выпущена к концу 1988 года.
Хотя поиск подходящего названия для проекта - это обычно вопрос второсте¬
пенный и зачастую дело случая или прихоть разработчиков, было бы уместно рас-
История и мотивация
17
сказать, как в поле нашего внимания попал Оберон. Случилось так, что мы начали
наш проект, когда космический зонд Voyager заполнял передовицы газет серия¬
ми своих захватывающих снимков планеты Уран и ее спутников, наибольший из
которых назывался Оберон. С этого момента я рассматривал проект Voyager как
исключительно хорошо спланированное и успешное предприятие, и в качестве
скромной дани ему я выбрал имя его последнего объекта исследования. На самом
деле есть совсем немного инженерных проектов, результаты которых выходят за
пределы ожиданий и ожидаемой их жизни; по большей части они терпят неудачу
гораздо раньше, особенно в области программного обеспечения. И последнее, но
немаловажное: напомним, что Оберон известен как король эльфов.
Сознательное ограничение трудовых ресурсов заставило нас принять единст¬
венное, но здравое решение: сосредоточиться на основных функциях и пренебречь
красотами, которые лишь угождают укоренившимся традициям и преходящим
вкусам. Конечно, в первую очередь должно быть определено и оформлено основ¬
ное ядро. Хотя основание уже было заложено. Наш руководящий принцип стал
еще более важным, когда мы решили, что результат должен будет использоваться в
качестве обучающего материала. Я помнил призыв К. Хоора (С. A. R. Ноаге) о том,
что книги по операционным системам должны быть конкретными, а не представ¬
лять собой описание полусырых, абстрактных принципов. В начале 70-х он сето¬
вал: в нашей отрасли считается, что инженеры должны постоянно создавать новые
артефакты без возможности изучения предыдущих работ, которое должно доказы¬
вать их ценность для отрасли. Как же он был прав, даже сегодня!
Возникшая цель - опубликовать результат во всех его деталях - заставила по-
новому отнестись к выбору языка программирования: он стал решающим. Язык
Модула-2, которым мы планировали воспользоваться, оказался не очень подходя¬
щим. Во-первых, потому что ему недоставало средств адекватного выражения рас¬
ширяемости, а мы провозгласили расширяемость одним из основных принципов
новой системы. В «адекватность» мы включаем машинную независимость. Наши
программы не должны зависеть от особенностей машины и низкоуровневых
средств программирования, за исключением, быть может, интерфейсов устройств,
где такой зависимости не избежать.
Поэтому язык Модула-2 был расширен свойством, которое теперь известно
как расширение типа (type extension). Мы выяснили также, что язык Модула-2 со¬
держал несколько средств, которые не нужны и на самом деле не способствуют его
выразительной силе, но в то же время усложняют компилятор. А компилятор дол¬
жен был быть не только реализован, но и описан, изучаем и понятен. Это привело
к решению начать с пересмотра языка реализации проекта и применить к нему тот
же принцип: сосредоточиться на главном, избавляясь от лишнего. Новому языку,
который все еще имел много общего с Модула-2, дали то же имя, что и всей сис¬
теме, - Оберон [1, 2]. В отличие от его предка, он лаконичнее и, главное, является
значительным шагом к выражению программ на высоком уровне абстракции не¬
зависимо от особенностей машины.
Мы начали разработку системы в конце 1985 года, а программирование - в на¬
чале 1986 года на нашей рабочей станции Lilith и ее языке Модула-2. Сначала был
18
История и мотивация
История и мотивация
19
создан кросс-компилятор, а за ним - модули внутреннего ядра вместе с необходи¬
мыми средствами тестирования и загрузки. Одновременно шла разработка систе¬
мы отображения и текстовой системы без возможности их тестирования, конечно.
Мы поняли, насколько отсутствие отладчика и, более того, компилятора может
способствовать тщательному программированию. (Это действительно так, в чем
убедился один из пас, когда примерно в то же самое время и примерно в тех же усло¬
виях писал компиляторы языка С. - Прим. перев.)
Затем последовал перевод компилятора на язык Оберон. Эго было сделано
стремительно, потому что оригинал был написан с намерением последующего
перевода. После его проверки на целевом компьютере Ceres вместе со средствами
редактирования текста пуповина Lilith могла быть отрезана. Система Оберон, по
крайней мере, ее черновая версия, стала реальной. Это случилось примерно в се¬
редине 1987 года; после этого было опубликовано ее описание [3].
Завершение системы заняло еще год, ушедший на объединение рабочих стан¬
ций в сеть для передачи файлов [4], на средства централизованной печати и на
инструменты поддержки. Наша цель - завершить систему в три года - была дос¬
тигнута. В середине 1988 года система была представлена более широкому со¬
обществу пользователей, и можно было начать работу над приложениями. Была
разработана почтовая служба, добавлена графическая система и продолжены
различные работы по общим системам подготовки документов. Средство отобра¬
жения было расширено так, чтобы работать с любым экраном, включая цветной.
Одновременно на основе опыта использования системы совершенствовались от¬
дельные ее части. С 1989 года в наших вводных курсах программирования язык
Модула-2 был заменен языком Оберон.
Здесь, видимо, уместно сказать об используемом оборудовании. Рабочая стан¬
ция Ceres тоже была разработана в Институте вычислительных систем ЕТН, что
обеспечило идеальную почву для внедрения системы Оберон на «голой» машине.
Это дало безграничную возможность проектировать без оглядок на установлен¬
ные ограничения и избегать компромиссов, вызванных несовместимой средой.
Ceres-1 была создана на микропроцессоре NS-32032 фирмы National Semicon¬
ductor, который в 1985 году был первым коммерчески доступным процессором
с 32-разрядной шиной. Его удобная система команд оказалась особенно привле¬
кательной для разработчика компилятора. Компьютер был оснащен 2 Мб опера¬
тивной памяти, жестким диском на 40 Мб, дисководом, дисплеем с разрешением
1024 х 800 пикселей и, конечно, клавиатурой и мышью. Этих ресурсов было более
чем достаточно для системы Оберон.
Ceres-2 была создана в 1988 году заменой процессора его более быстрой версией
NS-32532, который увеличил ее вычислительную мощность по сравнению с пред¬
шественницей почти в 5 раз. Память была увеличена до 4-8 Мб, а диск до 80 Мб.
Для установки программного обеспечения было переделано «всего» несколько
модулей: ядро (из-за иной структуры страницы) и драйверы устройств (из-за
иных адресов устройств).
В 1990 году была разработана недорогая версия Ceres-З, и 100 таких компью¬
теров были созданы и установлены в лабораториях. Этот одноплатный компью¬
20
История и мотивация
тер построен на процессоре NS-32GX32 без устройства виртуальной адресации
с 4-8 Мб оперативной памяти. Его отличительная черта заключается в том, что
файловая система реализована в одной (защищенной) половине оперативной па¬
мяти вместо диска, резко повышая скорость ее работы. Ceres-З свободны от ме¬
ханических устройств (даже вентилятора) и потому совершенно бесшумны. Они
используются прежде всего в лабораториях для студентов. Польза центрального
сервера для распределения системных файлов очевидна.
Успех системы, ее гибкость дали в 1989 году начало проекту по переносу си¬
стемы на многие коммерчески доступные рабочие станции. От плана устанав¬
ливать систему на «голых», как Ceres, машинах быстро отказались: никто бы и
не стал делать таких попыток, если для экспериментов с Обероном нужно было
покупать другой компьютер или хотя бы менять ROM. Минусы надстройки над
существующей системой нужно было принять; они представляют собой некое
редко используемое программное обеспечение, занимающее часть памяти, ино¬
гда значительную. Па момент написания этой книги существовали реализации
на Apple Macintosh II, Sun Microsystem Sparc Station, DEC Station 3100 и 5000
и IBM RS/6000. Каждая из этих реализаций занимала примерно половину чело¬
веко-года. Решение о надстройке над существующей системой имеет неоценимое
преимущество: приложения, созданные в основной системе, доступны из Оберона.
Все они отвечают своим описаниям из руководства пользователя [Reiser, 1991],
имеют тот же пользовательский интерфейс, и каждая программа, работающая на
одном из этих компьютеров, может без изменений выполняться на любом другом.
Очевидно, это - важное преимущество, которое может появиться только при про¬
граммировании на более высоком уровне абстракции, как в языке Оберон.
Литература
1. N. Wirth. The programming language Oberon. Software - Practice and Experien¬
ce 18, 7, (July 1988) 671-690.
2. M. Reiser and N. Wirth. Programming in Oberon - Steps beyond Pascal and Mo-
dula. Addison-Wesley, 1992.
3. N. Wirth and J. Gutknecht. The Oberon System. Software - Practice and Expe¬
rience, 19, 9 (Sept. 1989), 857-893.
4. N. Wirth. Ceres-Net: A low-cost computer network. Software - Practice and
Experience, 20,1 (Jan. 1990), 13-24.
5. M. Reiser. The Oberon System - User Guide and Programmer's Manual Addison-
Wesley, 1991.
2. ОСНОВНЫЕ ПОНЯТИЯ
И СТРУКТУРА СИСТЕМЫ
2.1. Введение
Для оправдания значительных усилий по проектированию и разработке опе¬
рационной системы с нуля в ее фундаментальных понятиях должно быть много
новизны. Мы начнем эту главу с обсуждения основных понятий, лежащих в ос¬
нове системы Оберон, и главных проектных решений. Далее на этом базисе будет
представлена структура системы, причем в самом общем виде, а именно: состав и
взаимозависимость ее крупных блоков, или модулей. Глава заканчивается крат¬
ким обзором последующих разделов книги. Это должно помочь читателю понять
роль, место и значение частей системы, представленных отдельными главами.
Основная цель операционной системы - представить компьютер пользовате¬
лю и программисту на определенном уровне абстракции. Например, память предс¬
тавляется в виде требуемых участков или переменных указанного типа данных,
диск - в виде цепочек символов (или байтов), именуемых файлами, дисплей -
в виде прямоугольных областей, именуемых окошками (viewers), клавиатура -
как входной поток символов, а мышь - как пара координат и набор состояний ее
кнопок. Каждая абстракция характеризуется определенными свойствами и управ¬
ляется набором операций. Задача системы - выполнять эти операции и управлять
ими в пределах доступных ресурсов основного компьютера. Это обычно называ¬
ется управлением ресурсами.
Каждая абстракция скрывает в себе подробности, причем именно те, от ко¬
торых она абстрагируется. Сокрытие может происходить на разных уровнях.
Например, компьютер в зависимости от своего режима работы (обычный/при¬
вилегированный) может запретить доступ к определенным участкам памяти или
определенным устройствам. То же самое можно сделать с помощью средств со¬
крытия языка программирования с его правилами видимости. Последнее, конеч¬
но, намного гибче и мощнее, и первое на самом деле играет почти незаметную роль
в нашей системе. Сокрытие важно, потому что оно гарантирует сохранность опре¬
деленных свойств абстракции, именуемых инвариантами. По сути, абстракция -
ключ к модульности, а без модульности исчезает всякая надежда на возможность
добиться надежности и правильности. Ясно, что система Оберон проектировалась
с целью установления модульной структуры на базе целенаправленных абстрак¬
ций. Наличие соответствующего языка программирования - необходимая пред¬
посылка для этого, а важность его выбора невозможно переоценить.
©N. Wirth, 30.08.1991/09.11.1991
22
Основные понятия и структура системы
2.2. Понятия
2.2.1. Окошки
В то время как абстракции отдельных переменных, представляющих участки
оперативной памяти, и файлов, представляющих участки дисковой памяти, явля¬
ются хорошо устоявшимися понятиями и имеют значение в любой вычислительной
системе, абстракции устройств ввода-вывода приобрели свою значимость с повы¬
шением взаимодействия (интерактивности) между пользователем и компьютером.
Высокая интерактивность требует широкой полосы пропускания, а единствен¬
ный широкополосный канал пропускания у человека - это глаз. Следовательно,
устройство визуализации вывода компьютера должно было хорошо подходить для
человеческого глаза. Это произошло в середине 1970-х с появлением дисплея с вы¬
сокой разрешающей способностью, что, в свою очередь, стало возможным благо¬
даря более быстрым и более дешевым электронным компонентам памяти. Дисплей
с высоким разрешением знаменовал собой один из немногих, очень существенных
прорывов в истории компьютерных технологий. Типичная полоса пропускания со¬
временного дисплея - порядка 100 МГц. Именно дисплей с высоким разрешением
сделал визуальный вывод предметом абстракции и управления ресурсами. В систе¬
ме Оберон дисплей разделен на окошки, именуемые также окнами, или, точнее, на
кадры - прямоугольные области экрана. Обычно окошко состоит из двух кадров -
полоски заголовка с именем объекта окошка и меню команд и основного кадра с не¬
ким текстом, графикой, изображением или другим объектом. Само окошко - это
кадр; кадры могут быть вложенными, в принципе, до любой глубины.
Система обеспечивает процедуры генерации кадра (окошка), его перемеще¬
ния и закрытия. Она размещает новое окошко в определенном месте, а по запросу
дает подсказку, куда его лучше всего поместить. Она следит за множеством откры¬
тых окошек. Это так называемое управление окошками, в отличие от управления
их содержимым.
Однако высокая интерактивность требует не только широкополосного про¬
пускания визуального вывода, но и гибкости ввода. Конечно, нет никакой необхо¬
димости в одинаково широкой полосе пропускания, поскольку клавиатура, огра¬
ниченная скоростью набора около 100 Гц, для этого не годится. Прорывом на этом
фронте стала так называемая мышь, указывающее устройство, которое появилось
примерно в то же время, что и дисплей с высоким разрешением.
Это было не только удачным совпадением. Мышь возможна только на дис¬
плее с высоким разрешением и с надлежащим программным обеспечением. Кон¬
цептуально сама по себе она - очень простое устройство, подающее сигналы при
движении по столу. Эти сигналы заставляют компьютер обновлять положение
указателя (курсора) на дисплее. Так как обратную связь поддерживает глаз чело¬
века, от мыши не требуется высокой точности. Например, когда пользователь хо¬
чет указать на некоторый объект на экране, скажем, символ, он перемещает мышь,
пока курсор не достигнет этого объекта. Она заметно контрастирует с цифровым
датчиком, который, как предполагается, должен предоставить точные координа¬
ты. Система Оберон во многом полагается на возможности мыши.
Понятия
Возможно, самая хитроумная идея заключалась в том, чтобы снабдить мышь
кнопками. Имея возможность одной рукой и перемещать курсор, и подавать
команды, пользователь может сразу увидеть результат их выполнения. Позици¬
онная зависимость реализована в программном обеспечении делегированием об¬
работки сигнала процедуре (так называемому обработчику или интерпретатору),
которая локализуется в том окошке, куда хотя бы на миг попадает курсор. Таким
образом, соответствующим программным обеспечением может быть достигнута
удивительная гибкость активации команд. В связи с этим появились различные
технологии, например всплывающие меню, ниспадающие меню и т. д., которые
возможны даже при наличии всего одной кнопки. Для многих приложений мышь
с несколькими кнопками еще лучше, а система Оберон в основном предполагает
наличие трех кнопок. Назначение кнопкам разных функций, конечно, может лег¬
ко привести к путанице, когда каждое приложение подразумевает разное назна¬
чение кнопок. Но этого легко избежать, если придерживаться определенных «гло¬
бальных» соглашений. В системе Оберон левая кнопка прежде всего используется
для пометки позиции (устанавливая символ вставки), средняя - для выполнения
общих команд (см. ниже), а правая - для выделения отображаемых объектов.
Сейчас стало модным использовать наложение окон, отображающих стопку
документов на столе. Мы нашли эту метафору не очень убедительной. Перед тем
как выполнить некую операцию над содержимым частично скрытого окна, оно
обычно поднимается наверх и делается полностью видимым. В итоге незначитель¬
ное достоинство несопоставимо со значительными усилиями, необходимыми для
реализации такой схемы. Это хороший пример того, когда выгода от усложнения
несоразмерна его цене. Поэтому мы выбрали решение, которое гораздо проще реа¬
лизовать и которое, тем не менее, не имеет реальных недостатков по сравнению
с перекрывающимися окнами, - мозаичные окошки, как показано на рис. 2.1.
Рис. 2.1. Дисплей Оберона с мозаичными окошками
| 23'
24
Основные понятия и структура системы
2.2.2. Команды
Позиционно-зависимые команды с фиксированным (для каждого типа окош¬
ка) смыслом должны быть дополнены общими командами. Обычно такие команды
подаются с клавиатуры набором в специальном окне команд имени программы, ко¬
торая должна быть выполнена. В этом отношении система Оберон предлагает но¬
вое и гораздо более гибкое решение, которое приводится в следующих параграфах.
Прежде всего отметим, что программа - в самом общем смысле текст, скомпи¬
лированный в единицу исполнения, - это обычно довольно большой блок дейст¬
вий, чтобы быть только командой. Сравните ее, например, со вставкой части текс¬
та по команде мыши. В Обероне понятие единицы действия отделено от понятия
единицы трансляции. Первая - это команда, представленная (экспортируемой)
процедурой, а последняя - это модуль. Следовательно, модуль может определять
и, как правило, определяет несколько, а то и множество команд. Такая (общая)
команда может быть вызвана в любое время указанием на ее имя в любом тексте,
видимом в любом окошке на дисплее, и нажатием средней кнопки мыши. Имя
команды имеет вид М.Р, где Р - идентификатор процедуры, а М - идентификатор
модуля, где объявлена Р. Как следствие, любой щелчок на команде может вызвать
загрузку одного или нескольких модулей, если М еще не загружен в основную
память. Следующий вызов М.Р происходит мгновенно, так как М уже загружен.
Более того, модули никогда не удаляются (автоматически), потому что следую¬
щая команда вполне может обратиться к тому же самому модулю.
Каждая команда имеет целью изменение состояния некоторых операндов.
Обычно они следуют за идентификатором команды, и Оберон выполняет это согла¬
шение. Строго говоря, команды обозначаются как процедуры без параметров, но си¬
стема дает им возможность идентифицировать самих себя в тексте и, следователь¬
но, прочитать и проинтерпретировать последующий текст, то есть их фактические
параметры. Однако и чтение, и интерпретация должны программироваться явно.
Текст параметров должен ссылаться на объекты, которые уже существуют до
запуска команды и, вполне возможно, являются результатами выполнения преды¬
дущих команд. В большинстве операционных систем такими объектами являются
записанные в каталоги файлы, которые играют роль интерфейса между коман¬
дами. Система Оберон расширяет это понятие: ссылки между последовательны¬
ми командами не ограничиваются файлами, а могут быть любыми глобальными
переменными, потому что модули, как сказано выше, не исчезают из памяти по
завершении команды.
Такая колоссальная гибкость, похоже, должна открыть ящик Пандоры, и дейст¬
вительно делает это, если неправильно применяется. Причина в том, что состоя¬
ния глобальных переменных могут целиком определять и менять эффект коман¬
ды. Переменные представляют скрытые состояния, скрытые в том смысле, что
пользователь вообще не знает о них и не имеет никакого простого способа опре¬
делить их значение. Положительный аспект использования глобальных перемен¬
ных как интерфейса между командами - в том, что некоторые из них могут быть
видны на дисплее. Все окошки вместе с их содержимым сведены в структуру дан¬
ных, которая задается глобальной переменной в модуле Viewers. Таким образом,
части этой переменной образуют видимые состояния и вполне уместны в качестве
параметров команд.
Таким образом, одно из правил того, что можно назвать стилем программи¬
рования Оберона, состоит в том, чтобы избегать скрытых состояний и сокращать
количество глобальных переменных. Однако мы не возводим это правило в ранг
догмы. Есть поистине полезные исключения, даже если у переменных вообще нет
видимых частей.
Остается вопрос: как обозначить видимые объекты в параметрах команды.
Очевидный способ - использовать в качестве параметра ближайшее выделение.
Процедура определения местонахождения этого выделения обеспечивается моду¬
лем Oberon. (Она ограничивается выделениями текста.) Другой способ - исполь¬
зовать позицию символа вставки в тексте. Он применяется в случае вставки ново¬
го текста; нажатие клавиши на клавиатуре также считается командой и вызывает
вставку символов в позицию символа вставки.
Специальное средство - пометка «звездочка» - вводится для указания в каче¬
стве операнда окошка. Она помещается в позицию курсора при нажатии на кла¬
виатуре клавиши пометки (SETUP). Процедура Oberon.MarkedViewer определяет
помеченное «звездочкой» окошко. А команды, для которых оно является парамет¬
ром, обычно сопровождаются в тексте символом «звездочка». Что именно из по¬
меченного окошка передается в качестве фактического параметра - текст, картин¬
ка или любая другая его часть, - зависит от того, как написана процедура команды.
Наконец, не должно остаться незамеченным наиболее приятное свойство сис¬
темы. Оно - прямое следствие постоянства глобальных переменных и становится
ясным, когда команда терпит неудачу. Обнаруженные отказы приводят к преры¬
ванию, которое должно считаться аварийным завершением команды. В худшем
случае глобальные данные могут остаться в неопределенном состоянии, но они
не будут потеряны, и следующая команда может быть выполнена на их текущем
состоянии. Прерывание открывает небольшое окошко со списком вызванных про¬
цедур с их локальными переменными и их текущими значениями. Эта информа¬
ция помогает программисту разобраться в причинах прерывания.
2.2.3. Задачи
Из вышесказанного следует, что система Оберон отличается очень гибкой схе¬
мой активации команд. Понятие команды простирается от вставки единственно¬
го символа и установки пометки до вычислений, которые могут длиться часами
или днями. Кроме того, она отличается очень гибким понятием выбора операн¬
да, не ограничиваясь именованными файлами. И, что более важно, фактическим
отсутствием скрытых состояний. Состояние системы практически определяется
тем, что видно пользователю.
Это делает ненужным помнить длинную историю ранее активированных
команд, запущенных программ, установленных режимов и т. д. На наш взгляд,
режимы - характерный признак недружелюбных к пользователю систем. С этой
Понятия
25
26
Основные понятия и структура системы
точки зрения становится очевидным, что система позволяет пользователю сле¬
дить за несколькими различными задачами одновременно. Они представлены
в виде окошек, содержащих тексты, графику или иные отображаемые объекты.
Пользователь переключается между задачами неявно, выбирая разные окошки
в качестве операндов для следующей команды. Суть такой концепции в том, что
переключение задач находится под явным контролем пользователя, а атомами
действий являются команды.
В то же время мы относим Оберон к однопроцессным (или однопоточным)
системам. Как же понять этот очевидный парадокс? Возможно, это лучше всего
объяснить, рассматривая основной режим работы. Пока процессор не занят вы¬
полнением команды, он непрерывно циклически опрашивает источники событий.
Такой цикл называется центральным; он находится в модуле Oberon, который
можно считать ядром системы. Мышь и клавиатура - два фиксированных источ¬
ника событий. Если возникает событие клавиатуры, управление передается об¬
работчику, установленному в так называемом окошке-фокусе, который содержит
символ вставки. Если возникает событие по нажатию кнопки мыши, управление
передается обработчику, в котором в настоящее время находится курсор. Все это
возможно под парадигмой единственного непрерывного процесса.
Понятие единственного процесса подразумевает непрерывность, и поэтому
эти команды тоже не могут взаимодействовать с пользователем. Взаимодействие
ограничено выбором команд перед их выполнением. Следовательно, в типичных
программах Оберона нет операторов ввода. Ввод задается параметрами, опреде¬
ленными и подставляемыми до выполнения команды.
Такая схема кажется поначалу довольно ограниченной. Но практически это
не так, если рассмотреть действия одного пользователя. Именно он ведет диалог
с компьютером. Человек способен вести диалог одновременно с несколькими про¬
цессами, только когда отданные им команды являются очень длительными по вре¬
мени. Мы полагаем, что выполнение длительных вычислений лучше передавать
на слабосвязанные серверы вычислений в распределенной системе.
Главное преимущество системы, имеющей дело с единственным процессом,
состоит в том, что переключения задач происходят только в определенных пользо¬
вателем точках, где состояние локального процесса не должно сохраняться до его
возобновления. Кроме того, поскольку переключения выбираются пользователем,
задачи не могут вносить неожиданные и неконтролируемые помехи при обраще¬
нии к общим переменным. Поэтому проектировщик системы может опустить все
механизмы защиты от таких помех, что существенно упрощает ее.
Основное отличие системы Оберон от многопроцессных систем - в том, что
в первой переключения задач происходят только между командами системы, тогда
как во вторых переключение может происходить после любой машинной коман¬
ды. Ясно, что различие - в степени детализации действия. Детализация в Обероне
укрупненная, что вполне приемлемо для однопользовательской системы.
Система предоставляет возможность добавления в центральный цикл опра¬
шивающих команд. Это нужно, когда появляются дополнительные источники со¬
бытий. Известный пример - сеть, в которой команды могут посылаться с других
Понятия
27
рабочих станций. Центральный цикл просматривает список так называемых де¬
скрипторов задач. Каждый дескриптор ссылается на процедуру команды. Одно из
двух стандартных событий - ввод с клавиатуры или нажатие кнопки мыши - про¬
исходит, только когда это позволяет их защита (условие). Добавляемые задачи
должны иметь свою собственную защиту в начале своих процедур.
При добавлении сетевых команд, именуемых запросами, возникает вопрос:
что происходит, когда занятому выполнением другой команды процессору посту¬
пает очередной запрос? Очевидно, запрос будет потерян, если не принять меры.
Проблема легко исправляется буферизацией ввода. Она есть в любом драйвере
устройства ввода - как в драйвере клавиатуры, так и в сетевом драйвере. Входя¬
щий сигнал вызывает прерывание, а его обработчик принимает ввод и буферизует
его. Подчеркнем, что обработка прерываний - привилегия драйверов, системных
компонент самого низкого уровня. Прерывание не вызывает выбора задачи и пе¬
реключения задач. Управление просто возвращается в точку прерывания, а преры¬
вание остается незаметным для программ. Но у всякого правила есть исключение:
при вводе с клавиатуры символа аварийного завершения работы прерывание воз¬
вращает управление центральному циклу.
2.2.4. Инструментальные тексты
как настраиваемые меню
Конечно, понятия окошек, задающих собственную интерпретацию щелчков
мыши, команд, вызываемых из любого текста на экране, любого отображаемого
объекта, выбранного в качестве интерфейса между командами, и команд, являю¬
щихся недиалоговыми непрерывающимися единицами действий, имеют значи¬
тельное влияние на стиль программирования в Обероне и полностью меняют
стиль использования компьютера. Простота и гибкость, с которыми фрагменты
текста могут выделяться, перемещаться, копироваться и обозначать команды и
их параметры, резко сокращают необходимость в наборе текста. Мышь становит¬
ся доминирующим устройством ввода данных, а клавиатура служит только для
ввода текстовых данных. Это подкрепляется использованием так называемых
инструментальных текстов, наборов часто используемых команд, которые обычно
отображаются в узкой системной дорожке окошек. Вам совсем не нужно набирать
команды вручную! Обычно они уже видны где-то. Как правило, для любого рабо¬
чего проекта пользователь составляет инструментальный текст, который может
рассматриваться как собственноручно созданное личное меню.
Редко набираемые на клавиатуре команды имеют еще более приятное досто¬
инство: их имена могут быть осмысленными. Например, операция копирования
обозначается как «Сору» вместо «ср», переименования - как «Rename» вместо
«гп», выбор каталога файлов именуется «Directory» вместо «Is». Исчезает необхо¬
димость в запоминании бесконечного списка загадочных сокращений, что являет¬
ся еще одним признаком недружелюбных к пользователю систем.
Но влияние концепций Оберона не ограничивается только стилем использо¬
вания компьютера. Оно распространяется и на способ написания программ, взаи¬
модействующих с окружением. В большинстве случаев определение абстрактного
типа Text в ядре системы предполагает замену файлов текстами как носителями
данных ввода и вывода. Получаемое преимущество - это возможность прямого
редактирования текста. Например, результат команды System.Directory - это тре¬
буемый фрагмент каталога файлов в виде (отображаемого) текста. Его часть или
он весь могут быть выделены и скопированы в другие тексты обычными команда¬
ми редактирования (щелчками мыши). Или же компилятор получает в качестве
входа те же тексты. Поэтому можно откомпилировать текст, выполнить програм¬
му и перекомпилировать исправленный текст без сохранения его на диске между
компиляциями и тестированиями. Повсеместная редактируемость текста вместе
с наличием глобальных данных (в отдельных окошках) позволяет избежать мно¬
жества лишних шагов, которые не способствуют прогрессу фактически решаемой
задачи.
2.2.5. Расширяемость
Важной целыо разработки системы Оберон была расширяемость. Это про¬
стота наращивания системы новыми средствами путем добавления модулей, ко¬
торые могут использовать уже существующие ресурсы. Это (что так же важно)
и сокращение системы до тех необходимых средств, которые в настоящее время
и на самом деле используются. Например, редактору документов, работающему
с документами без рисунков, не нужно загружать обширный графический редак¬
тор рабочей станции, работающей автономно, не нужно загружать обширное се¬
тевое программное обеспечение, а офисной системе не нужны ни компилятор, ни
ассемблер. Кроме того, система, создающая новый вид кадра дисплея, не должна
включать процедуры управления окошками, содержащими такие кадры. Вместо
этого она должна использовать существующее управление окошками. Всплески
использования памяти многими широко используемыми системами происходят
из-за нарушения этих фундаментальных правил разработки. Завышенные требо¬
вания к памяти для операционной системы хотя и общеприняты, но абсурдны и
являются еще одним признаком недружелюбия к пользователю или, возможно,
признаком дружелюбия между производителями. Причина тому - не что иное,
как неадекватная расширяемость.
Мы не ограничиваем это понятие процедурной расширяемостью, которую
просто реализовать. Важно то, что расширение - это не только добавление новых
процедур и функций, но введение собственных типов данных, построенных на ба¬
зисе, обеспеченном системой, то есть расширяемость данных. Например, графи¬
ческая система должна быть в состоянии определить свои графические кадры на
базе кадров, обеспеченных основным модулем отображения, путем расширения
их необходимыми графическими атрибутами.
Это требует адекватных языковых средств. Язык Оберон обеспечивает такие
средства в виде расширений типов. Язык был создан именно по этой причине.
(Язык Модула-2 был бы таковым, если бы не отсутствие в нем этих возможностей.)
Его влияние на структуру системы было глубоким, а результаты были самыми об-
28
Основные понятия и структура системы
належивающими. Например, многие дополнения были созданы с удивительной
легкостью. Одно из них описано в конце этой книги. При этом базовая система
весьма скромна в своих требованиях к ресурсам (см. таблицу в конце раздела 2.3).
2.2.6. Динамическая загрузка
Активация команд, находящихся в модулях, которые не загружены в память,
предполагает загрузку модулей и, конечно, всех их импортов. Вызов загрузчика,
однако, не ограничивается активацией команды; он может также осуществляться
программными обращениями к процедурам. Такая возможность необходима для
успешной реализации подлинной расширяемости. Модули должны загружаться
по требованию. Например, редактор документов загружает графический пакет,
только если в активном документе есть графический элемент, но не иначе.
В системе Оберон нет отдельного компоновщика. Модуль связывается с его
импортами при загрузке, но не ранее. Поэтому каждый модуль представлен только
одним экземпляром как в основной памяти (связанный), так и во вспомогательной
(несвязанный, в виде файла). Уход от тиражирования копий в разных связанных
объектных файлах - это ключ к экономии памяти. Заранее связанных мегафайлов
в системе Оберон нет, а каждый модуль - повторно используемый.
2.3. Структура системы
Наибольшая опознаваемая единица системы - модуль. Поэтому и при описа¬
нии системы наиболее уместен модульный подход. А так как интерфейсы модулей
явно объявлены, их взаимозависимость тоже легко показать в виде орграфа, дуги
которого суть импорты.
Граф модулей системы Оберон - иерархический, то есть не имеет циклов.
Самые нижние члены иерархии фактически импортируют только аппаратные
средства. Здесь имеются в виду модули, содержащие драйверы устройств. Хотя
модуль Kernel тоже относится к этому классу: он «импортирует память» и включа¬
ет драйвер диска. Модули на вершине иерархии фактически экспортируются поль¬
зователю. Поскольку пользователь имеет прямой доступ к процедурам команд, мы
называем этих высших членов иерархии командными, или инструментальными,
модулями.
Иерархия базовой системы показана на рис. 2.2. Граф упрощен за счет ис¬
ключения дуг непосредственного импорта, когда косвенный путь тоже ведет от
источника к приемнику. Например, Files импортирует Kernel; прямой импорт пе
показан, потому что путь от Kernel ведет к Files через FileDir. Имена модулей во
множественном числе обычно указывают на определение абстрактного типа дан¬
ных в модуле. Тип экспортируется вместе с его операциями. Примеры - Files,
Modules, Fonts, Texts,Viewers, MenuViewers и TextFrames. (Исключение - вспомо¬
гательный модуль Reals для Texts, содержащий операции преобразования чисел
с плавающей запятой, присутствующих в коде ассемблера.) Модули с именами
в единственном числе обычно обозначают управляемый модулем ресурс, будь то
Структура системы
29
Основные понятия и структура системы
Рис. 2.2. Структура ядра системы Оберон
глобальная переменная или устройство. Переменная или устройство сами по себе
скрыты (не экспортируются) и становятся доступными через экспортируемые
процедуры модуля. Примеры - все драйверы устройств: Input - для клавиатуры и
мыши, Kernel - для памяти и диска, Display и SCC (контроллер связи). Исключе¬
ния - командные модули, имена которым обычно давались согласно их основному
виду деятельности, скажем Edit и Backup.
Как уже отмечалось, модуль Oberon - сердце системы, содержащее централь¬
ный цикл, к которому управление возвращается после каждой выполненной
команды, как бы она ни завершилась, успешно или нет. Oberon экспортирует не¬
сколько вспомогательных процедур и прежде всего те, что позволяют вызвать
команду (Call) и обратиться к тексту ее параметров через переменную Oberon.
Par. Кроме того, он содержит текстовый журнал и экспортирует эту переменную.
Текст сообщения, как правило, служит для выдачи подсказок и кратких отчетов
об ошибках команд. Текст отображается в окошке журнала, который автомати¬
чески открывается при инициализации модуля System. Модуль Oberon включает
также два маркера, используемых глобально на дисплее, - курсор и метку. Он
экспортирует процедуры их рисования и стирания и позволяет придавать им раз¬
личный вид.
Система на рис. 2.2 в основном содержит средства для создания и редакти¬
рования текстов, для сохранения их в файловой системе и копирования их на
дискеты. Все остальные функции осуществляются модулями, которые должны
добавляться обычным образом загрузчиком модулей но требованию. В первую
30
Структура системы
ЕЯ
очередь к ним относятся компилятор, сетевая связь, редакторы документов и все
разработанные пользователем программы. Положенные в основу системы высшие
приоритеты - модульность, исключение излишеств и необходимая достаточность
ядра - привели к необыкновенно компактной системе. И хотя это свойство может
считаться не слишком важным в эпоху падающих цен на массовую память, мы по¬
лагаем, что это очень существенно. Мы просто хотели бы привлечь внимание чи¬
тателя к корреляции между размером системы и ее надежностью. Кроме того, мы
не считаем хорошей инженерной практикой расточительно расходовать ресурсы
только потому, что это, оказывается, дешево. В следующей таблице перечисляют¬
ся модули ядра и главные прикладные модули и указывается размер в байтах ис¬
пользуемого ими кода, их констант, их статических переменных и, наконец, число
строк исходного текста.
Имя модуля
Код (байтов)
Константы
Переменные
Исходные строки
Kernel
1896
144
108
*
FileDir
4324
56
0
368
Files
3640
24
4
450
Modules
2356
32
48
229
Input
452
4
48
73
Display
2284
392
52
*
Fonts
1204
44
8
117
Viewers
1836
12
20
248
Reals
484
104
0
*
Texts
9388
176
8
666
Oberon
3836
48
120
495
MenuViewers
2776
8
4
226
Text Frames
10148
152
112
868
System
6820
688
76
617
51444
1884
608
4357
see
1144
8
2056
161
V24
340
4
516
71
Diskette
2812
40
1504
382
Printer
1512
36
1072
175
Edit
4668
240
596
458
Backup
1428
280
48
147
Net
5868
548
88
610
17772
1156
5880
2004
Compiler
8988
144
84
967
OCS
3600
448
944
314
OCT
5000
504
260
583
32
Основные понятия и структура системы
осс
6252
140
22540
611
ОСЕ
12212
320
48
972
ОСН
5804
48
36
553
41856
1604
23912
4000
Graphics
7124
232
116
728
Graphic Frames
5648
60
60
566
Draw
2876
268
44
265
Rectangles
1508
16
8
128
Curves
3572
12
4
229
20728
588
232
1916
Всего
131800
5232
30632
12277
* Написан в коде ассемблера.
2.4. Краткий обзор глав
Реализация системы идет снизу вверх. Это естественно, так как модули верх¬
них уровней - это клиенты модулей нижних уровней, и они не могут работать без
доступа к импортам. С другой стороны, описание системы лучше строить в нис¬
ходящем направлении, потому что система проектируется с учетом ожидаемых
приложений и функций. Декомпозиция в иерархию модулей основывается на ис¬
пользовании вспомогательных функций и абстракций и на отсрочке их детали¬
зации до будущих времен, когда их необходимость будет полностью обоснована.
По этой причине мы будем продвигаться в основном в нисходящем направлении.
Главы 3-5 описывают внешнее ядро системы. Глава 3 фокусируется на ди¬
намических аспектах. В частности, она вводит фундаментальные единицы дей¬
ствия - задачу и команду. Модель управления задачами системы Оберон раз¬
личает две категории задач - интерактивные и фоновые. Интерактивные задачи
представляются на экране дисплея прямоугольными областями, так называемы¬
ми окошками. Фоновые задачи не должны связываться ни с одним отображаемым
объектом. Они запускаются с низким приоритетом в отсутствие интерактивности.
Хороший пример фоновой задачи - сборщик мусора в памяти. И интерактивные,
и фоновые задачи относятся планировщиком задач к одному процессу. Команды
Оберона - это явные атомарные единицы интерактивных действий. Они реализу¬
ются в виде экспортируемых процедур без параметров и заменяют более тяжело¬
весное понятие программы, известное в традиционных операционных системах.
Глава продолжается определением программного инструментария как логически
связанной коллекции команд и заканчивается наброском инструментария управ¬
ления системой.
Глава 4 описывает систему отображения Оберона. Она начинается с обсуж¬
дения нашей стратегии иерархического разбиения изображения для размещения
окошек. Далее следует детальное исследование роли окошек в Обероне. Вводит¬
ся тин Viewer как класс объектов с открытым интерфейсом передачи сообщений,
обеспечивающим понятийное основание для далеко идущей расширяемости. За¬
тем окошки определяются как совершенно особый случай так называемых кадров,
которые могут быть вложенными. Исследуется категория стандартных окошек,
содержащих кадр меню и кадр содержимого. Следующая тема - управление кур¬
сором. Курсор в Обероне - это размеченный путь. И менеджер окошек, и обра¬
ботчик курсора работают с абстрактными логическими областями дисплея, а не
с самим физическим монитором. Это позволяет унифицировать обработку запро¬
сов отображения независимо от количества и типов применяемых мониторов. На¬
пример, умозрительно обеспечиваются беспрепятственные переходы курсора за
границы экрана. Глава продолжается представлением краткого и полного набора
растровых операций, которые используются для размещения текстовых и гра¬
фических элементов в области отображения. Заключает главу обзор системного
инструментария отображения.
Глава 5 знакомит с текстом. Оберон отличается трактовкой текста как абст¬
рактного типа данных, который встроен в центральную систему. Обсуждается
множество фундаментальных следствий. Например, текст может быть создай од¬
ной командой, отредактирован пользователем и затем использован следующей
командой. Сами команды могут представляться текстуально в виде М.Р с после¬
дующим списком текстовых параметров. Следовательно, любую команду можно
вызвать прямо из текста (именуемого инструментальным), просто указав на нее
мышью. Однако сердцевина этой главы - представление текстовой системы Обе¬
рона в качестве исследования по модуляризации программ. Проблемы управления
текстом и его отображения прекрасно разделяются. И управление текстом, и его
отображение обладают как абстрактным открытым интерфейсом, так и скрытой
внутри структурой данных. В заключение этой главы обсуждаются управление
шрифтами Оберона и инструментарий редактирования и отчасти определяется
абстрактный интерфейс принтера.
Главы 6-9 описывают внутреннее ядро на том же нисходящем пути. Глава 6
представляет загрузчик программных модулей и обосновывает введение типа дан¬
ных Module. Глава включает управление памятью программного кода и определяет
формат хранения откомпилированных модулей в виде объектных файлов. Кроме
того, в ней обсуждаются проблемы связывания раздельно компилируемых моду¬
лей и разрешения внешних ссылок на определенные в других модулях объекты.
На примере компьютера Ceres объясняется, каким образом способы адресации
процессора помогают решить эту задачу.
Глава 7 посвящена файловой системе, исключительно важной потому, что
с файлами имеет дело почти каждая программа и вычисление. Глава состоит из
двух отдельных частей: первая описывает структуру файлов, то есть их представ¬
ление в дисковой памяти с ее последовательной природой, вторая описывает ката¬
лог файлов и его организацию в виде В-дерева для обеспечения быстроты поиска.
Управление памятью - тема главы 8. Единое централизованное управление
памятью - одно из ключевых проектных решений, гарантирующее эффективное
и экономное ее использование. В главе объясняется сегментация памяти в опре¬
деленных областях. Однако центральная ее тема - это обсуждение динамического
Краткий обзор глав
зз
34
Основные понятия и структура системы
управления памятью в сегменте, называемом кучей. В виде исключения алгорит¬
мы выделения (соответствующего встроенной процедуре NEW) и освобождения
(называемого сборкой мусора) памяти объясняются только в принципе, без конк¬
ретных распечаток программ. Причина этого в том, что они написаны на ассембле¬
ре, а не на Обероне, и потому их детали не очень интересны читателю.
На самом нижнем уровне иерархии модулей - драйверы устройств. Они опи¬
сываются в главе 9, которая содержит драйверы для некоторых широко распрост¬
раненных стандартов интерфейса: RS-232, последовательный, используемый
в модулях Input для клавиатуры и V24 для каналов связи, RS-485, последователь¬
ный (модуль SCC), используемый для включения рабочей станции в сеть, и SCSI,
применяемый в интерфейсах дисков и, возможно, других устройств посредством
8-разрядной параллельной шины.
Вторая часть книги, включающая главы 10-14, посвящена тому, что можно
назвать первыми приложениями базовой системы Оберон. Поэтому эти главы не¬
зависимы друг от друга и ссылаются только на главы 3-9.
Несмотря на то что система Оберон больше подходит для работы на автоном¬
ных рабочих станциях, средство связи межу многими компьютерами должно рас¬
сматриваться как фундаментальное. Модуль Net, обеспечивающий передачу фай¬
лов между рабочими станциями, связанными шиноподобной сетыо, - это тема
главы 10. Она освещает не только проблемы доступа к сети, отказов и конфликтов
при передаче, но и проблему сетевых имен. Все решения реализованы в удиви¬
тельно компактном модуле, который использует сетевой драйвер из главы 9.
Когда множество рабочих станций подключаются к сети, появляется необхо¬
димость в централизованном сервере. Централизованные возможности, служащие
в качестве сервиса распределения файлов, станции печати и хранилища электрон¬
ной почты, представлены в главе 11. Они возникают как расширение модуля Net
из главы 10 и являются убедительным примером применения средств управления
задачами из раздела 2.2. Отметим, что сервер работает на машине, которая непод¬
контрольна пользователю. Это обстоятельство требует высокой степени надежно¬
сти не только в отношении отказов передачи, но и в отношении данных, которые
не отвечают определенным форматам.
Представленная система серверов показывает, что однопоточная схема Обе¬
рона вовсе не ограничивается однопользовательскими системами. То, что каждая
однажды принятая команда или запрос обрабатываются до полного завершения,
вполне допустимо, если запрос не занимает процессор надолго, что обычно имеет
место в представленных серверных приложениях. Если процессор занят, посту¬
пающие запросы ставятся в очередь. Таким образом, процессор не чередует запро¬
сы, а выполняет их один за другим, что в целом увеличивает общую производи¬
тельность из-за отсутствия частого переключения между задачами.
В главе 12 описывается компилятор языка Оберон. И хотя тут он выступает
как модуль приложения, но, естественно, играет особую роль, потому что система
(и сам по себе компилятор) формулируется на языке, который компилятор пере¬
водит в код. Вместе с редактором текста он был основным инструментом при раз¬
работке системы. Использование прямых алгоритмов разбора и организации та¬
Краткий обзор глав
ЕИ
блицы символов привело к довольно компактной программе (см. раздел 2.3). Этот
результат - заслуга определения языка: язык лишен сложных структур и редко
используемых прикрас. Его структура регулярна, а синтаксис компактен.
Компилятор, как и сама глава, разделен на три основные части. Первая от¬
носится только к языку и не связана с каким-либо конкретным целевым компью¬
тером. Поэтому эта часть представляет наибольший интерес для читателя. Вто¬
рая часть, по сути, не зависит от языка, но крепко привязана к набору команд
целевого компьютера; в ней обсуждается выбор команд. В третьей части опи¬
сывается модуль, который приводит команды к конкретному формату целевой
машины.
Хотя алгоритмы и детали в последних двух частях главы машинно зависимы,
многое останется похожим и для других целевых компьютеров с похожей архитек¬
турой. Может показаться, что наш выбор процессора NS-32000 (восемь лет назад)
ошибочен, потому что процессор не так широко известен. Но от схожих архитектур
(Motorola 680x0 и Intel 80x86) он отличается гораздо более регулярным набором
команд. Это самое привлекательное свойство для разработчиков компиляторов
и, более того, для описания компилятора. Каждая иррегулярность - источник до¬
полнительной сложности. Даже в ретроспективе NS-32000 был, безусловно, луч¬
шим выбором с точки зрения описания. А мы полагаем, что наши читатели хотят
не просто копировать, но и понимать наши программы.
Тексты в системе Оберон играют ведущую роль. Их подготовка поддержива¬
ется главным инструментом системы - редактором. В главе 13 описывается еще
один редактор - тот, что обрабатывает графические объекты. В первую очередь
в качестве объектов вводятся только горизонтальные и вертикальные линии и
короткие надписи. Главное отличие текстов состоит в том, что их координаты на
плоскости рисунка не следуют автоматически из координат их предшественни¬
ка, потому что они образуют множество, а не последовательность. Каждый объект
имеет свои собственные, независимые координаты. Влияние этого, казалось бы,
незначительного различия на редактор является далеко идущим и пронизывает
весь проект. Таким образом, существует едва заметное сходство текстового и гра¬
фического редакторов. И об одном, наверное, стоит упомянуть - это деление на
три части. Модуль нижнего уровня определяет соответствующую абстрактную
структуру данных для текстов или графики, конечно, вместе с такими процеду¬
рами их обработки, как поиск, вставка и удаление. Модуль среднего уровня опре¬
деляет соответствующий кадр и содержит все процедуры отображения этого объ¬
екта, включая обработчик кадра, определяющий интерпретацию событий мыши и
клавиатуры. Модули высших уровней - это соответствующие инструментальные
модули (Edit, Draw). Представленный графический редактор особенно интересен
тем, что является убедительным примером расширяемости Оберона. Графический
редактор интегрирован в систему; он внедряет свои графические кадры в окошки-
меню и использует средства текстовой системы для надписей. И наконец, новые
виды элементов могут быть включены простым добавлением новых модулей, то
есть без расширения и даже без перекомпиляции существующих модулей. В главе
приводятся три примера: прямоугольники, круги и эллипсы.
Система рисования (Draw) широко применялась для подготовки электронных
схем. Это приложение предлагает концепцию, которая полезна и в других случа¬
ях, например в рекурсивном определении понятия объекта. Множество объектов
можно считать одним объектом и дать ему имя. Такой объект называется макро¬
сом. Задача проектировщика - реализовать макрос так, чтобы он тоже был расши¬
ряемым, то есть никоим образом не ссылался ни на тип его элементов, ни даже на
операции ввода файлов, в которых хранятся макросы.
Теперь читатель, наверное, понял, что представленные нами приложения - это
то, что действительно нужно было нашему проекту. В этом, по крайней мере, га¬
рантия того, что они не только проектировались, но и применялись. На самом деле
многие из них использовались сотнями людей, а многие - ежедневно на протяже¬
нии более чем нескольких лет. Глава 14 как раз и представляет два других таких же
инструментальных средства, а именно: одно - для установки системы Оберон на
новой, «голой» машине, другое - для восстановления диска после сбоев. Первое,
хоть и редко использовалось, было необходимо для разработки системы. Инстру¬
менты поддержки или восстановления - бесценные средства при отказах. А они
случаются! Глава 14 охватывает материал, который редко представляется в лите¬
ратуре.
36
Основные понятия и структура системы
3. СИСТЕМА УПРАВЛЕНИЯ ЗАДАЧАМИ
В конечном счете именно врожденная способность точно выполнять задачи заказ¬
чика превращает жесткое вычислительное устройство в гибкий универсальный
инструмент. Следовательно, моделирование и планирование задач - основные и
важнейшие вопросы разработки любой операционной системы. Конечно, мы не
можем считать, что однажды установленная схема управления задачами будет
идеальной для всех возможных режимов использования. Например, для закрытой
централизованной системы, обслуживающей множество пользователей в режиме
разделения времени, с одной стороны, и для персональной рабочей станции, с ко¬
торой работает один пользователь с высокой степенью интерактивности, с другой
стороны, нужны, наверное, разные схемы.
В Обероне мы сознательно сосредоточились на персональных рабочих стан¬
циях. Точнее, средства управления задачами Оберона мы повернули лицом к од¬
нопользовательской интерактивной персональной рабочей станции, возможно,
интегрированной в локальной сети. В разделе 3.1 мы начинаем с разъяснения
понятия задачи. В разделе 3.2 мы продолжаем детальное объяснение стратегии
планирования. Затем в разделе 3.3 мы вводим понятие команды. И наконец, в раз¬
деле 3.4 приводим обзор предопределенного системного набора инструментов.
Набор инструментов (Toolbox) - это связная коллекция команд, которые относят¬
ся к определенной теме, например управлению системой и ее диагностике, управ¬
лению отображением, управлению файлами.
3.1. Понятие задачи
В принципе, мы различаем две категории задач в Обероне - интерактивные
и фоновые. Грубо говоря, интерактивные задачи связаны с локальными областями
экрана дисплея и с взаимодействием между их содержимым. Напротив, фоновые
задачи - глобальные. Они не всегда связаны с какими-то заданными отображае¬
мыми объектами.
3.1.1. Интерактивные задачи
Каждая интерактивная задача представлена так называемым окошком (viezver).
Окошки образуют интерфейс системы отображения Оберона и воплощают мно¬
жество ролей, которые собраны в абстрактном типе данных Viewer. Мы глубже
познакомимся с системой отображения в главе 4. Здесь же достаточно знать, что
окошки представляются графически в виде прямоугольников на экране дисплея и
ЕЗ
что они - неявные носители интерактивных задач. На рис. 3.1 показан типичный
экран дисплея Оберона, который поделен на семь окошек, соответствующих семи
одновременно активным интерактивным задачам.
Рис. 3.1. Типичная конфигурация дисплея Оберона, состоящая из семи окошек
Чтобы почувствовать твердую почву под ногами, приведем программное объ¬
явление типа Viewer в слегка упрощенном виде:
Viewer = POINTER ТО ViewerDesc;
ViewerDesc = RECORD
X, Y, W, H: INTEGER;
handle: Handler;
state: INTEGER
END;
X} Y, W, H определяют прямоугольник - окошко на экране, то есть положение
X, Y нижнего левого угла относительно начала координат дисплея, ширину W и
высоту Я. Переменная state говорит о текущем состоянии видимости (видим, за¬
крыт, накрыт), a handle задает функцию обработчика окошка. Тип обработчика
Система управления задачами
Понятие задачи
39
Handler = PROCEDURE (V: Viewer; VAR M: ViewerMsg);
где ViewerMsg - некоторый базовый тип сообщений, точное объявление которого
не так важно сейчас:
ViewerMsg = RECORD ... (*поля основных параметров *) END;
Однако мы должны обратить внимание на использование объектно-ориенти¬
рованной терминологии. Это уместно потому, что обработчик - это процедурная
переменная, поведение которой зависит от определенного окошка. Так, вызов
V.handle(V, М) можно понимать как посылку сообщения М, которое должно быть
обработано по-своему методом принимающего его окошка V.
Отметим важное различие между стандартной объектно-ориентированной
моделью и нашей парадигмой обработчика. Стандартная модель закрыта в том
смысле, что данный класс объектов понимает только определенный набор со¬
общений. Парадигма обработчика, напротив, является открытой, потому что она
определяет лишь корень (ViewerMsg) потенциально не ограниченного дерева рас¬
ширяющихся типов сообщений. Например, конкретный обработчик мог бы обра¬
батывать сообщения типа MyViewerMsg, где
MyViewerMsg = RECORD (ViewerMsg)
тура г: MyParameters
END;
расширенный тип ViewerMsg.
Стоит отметить, что наша открытая объектно-ориентированная модель чрез¬
вычайно гибка. Например, расширение множества типов обрабатываемых объек¬
том сообщений просто реализовать, то есть оно не оказывает никакого влияния на
откомпилированный интерфейс объекта. Хотя справедливости ради надо сказать,
что такая высокая степень гибкости не дается бесплатно. Цепа вопроса - обяза¬
тельная явная диспетчеризация сообщений во время выполнения. Поэтому наша
объектная модель - это диспетчеризация времени выполнения. Последующие гла¬
вы продемонстрируют это свойство.
Наконец, возвращаясь к перспективе задач, нужно обратить внимание на то,
что каждая посылка сообщения окошку соответствует активации или реактива¬
ции интерактивной задачи, которая его представляет.
3.1.2. Фоновые задачи
Фоновые задачи Оберона априорно не связаны ни с каким определенным объ¬
ектом в системе. Чисто технически это экземпляры абстрактного типа данных,
состоящего из объявлений типов Task и TaskDesc вместе со встроенными операци¬
ями Install и Remove:
Task = POINTER ТО TaskDesc;
TaskDesc = RECORD
40
Система управления задачами
safe: BOOLEAN;
handle: PROCEDURE
END;
PROCEDURE Install (T: Task);
PROCEDURE Remove (T: Task);
Процедуры Install и Remove вызываются явно, чтобы изменить состояние ука¬
занной задачи с not ready на ready, и наоборот, соответственно. Поле safe в TaskDesc
служит признаком так называемых безопасных задач. В отличие от потенциально
опасных задач, они не снимаются автоматически после программного прерыва¬
ния. Процедурная переменная handle используется также для реактивации задачи.
Вызов процедуры без параметров handle следует рассматривать как посылку не¬
явного сообщения продолжить (continue).
Конкретная фоновая задача - это обычно расширение абстактного типа Task.
Как правило, расширяющая часть типа ссылается на объекты, с которыми эта за¬
дача работает:
MyTask = POINTER ТО MyTaskDesc;
MyTaskDesc = RECORD (TaskDesc)
myobj: MyObjType
END;
Для лучшего понимания приведем два реальных примера конкретных фоно¬
вых задач. Первый - это общесистемный сборщик мусора, собирающий неисполь¬
зуемую память. Второй пример - это сетевой монитор, контролирующий входя¬
щий трафик в локальной сети. В обоих примерах состояние задачи определяется
глобальными системными переменными. Мы вернемся к этому в главах 8 и 10
соответственно. Таблица 3.1 подытоживает модель управления задачами Оберона.
Завершая этот раздел, нельзя не сделать важных выводов. Передачи управ¬
ления между задачами реализованы в Обероне как обыкновенные вызовы и воз¬
враты обыкновенных процедур (на самом деле процедурных переменных). Внео¬
чередность невозможна. Это значит, что активные периоды задач последовательно
упорядочены и могут контролироваться одним потоком (процессом). Такое упро¬
щение дорогого стоит: блокировки общих ресурсов совсем не обязательны, а о взаи¬
моблокировках даже речи нет.
Таблица 3.1
Тип задачи
Создать
К ready
(Реакти¬
вировать
Пассивировать
К not ready
Интерактивная
Создать
окошко
Открыть
окошко
Послать
сообщение
Завершить
обработку
Закрыть
окошко
Фоновая
Создать
задачу
Поставить
на выполнение
(Install)
Послать
сообщение
продолжить
(continue)
Завершить
обработку
Удалить
(Remove)
3.2. Планировщик задач
Мы исходим из общего предположения, что в любой момент времени мно¬
жество поставленных задач готовы к обслуживанию в системе. Напомним, что
существует две категории задач - интерактивные и фоновые. Они существенно
отличаются по критерию активации или реактивации и по приоритету диспет¬
черизации. Интерактивные задачи (ре)активируются только при вмешательстве
пользователя и обслуживаются с наивысшим приоритетом. Напротив, фоновые
задачи опрашиваются с низким приоритетом.
Мы уже знаем, что интерактивные задачи активируются отправкой сообще¬
ний. Для этой цели используются два типа сообщений InputMsg и ControlMsg, из¬
вещающих о событии клавиатуры и мыши соответственно. Несколько упрощенно
они объявляются так:
InputMsg = RECORD (ViewerMsg)
id: INTEGER;
X, Y: INTEGER;
keys: SET;
ch: CHAR
END;
ControlMsg = RECORD (ViewerMsg)
id: INTEGER;
X, Y: INTEGER
END;
Поле id задает точный запрос, переданный с этой реактивацией. В случае
InputMsg возможные запросы - это потребить (символ из ноля с/г) и отследить
(мышь, стартующую из состояния, заданного keys и X, Y). В случае ControlMsg вы¬
бор осуществляется между пометить (окошко в позиции X, Y) и нейтрализовать.
Пометка означает перемещение глобального системного указателя (как правило,
«звездочки») в текущее положение мыши. Нейтрализация окошка равносильна
удалению всех меток и графических атрибутов из этого окошка.
Все средства управления задачами собраны в одном модуле, названном Oberon.
В частности, в определении модуля объявлены абстрактный тип данных Task и
типы сообщений InputMsg и ControlMsg. Однако самое важное в модуле - это пла¬
нировщик задач, который можно считать динамическим центром системы.
Перед началом подробного изучения планировщика нам нужна еще некоторая
подготовка. Начнем с понятия фокус-окошка. По определению, это особое окошко,
которое служит для получения последующего ввода с клавиатуры. Отметим, что
фокус-окошко - это фактически фокус-задача. Однако, памятуя наше определение
задачи, мы считаем термины окошко и интерактивная задача взаимозаменяемыми.
Модуль Oberon обеспечивает следующие средства связи с фокус-окошком:
глобальную переменную FocusViewer, процедуру PassFocus для передачи фокуса
новому окошку и дефокусировочный вариант ControlMsg для оповещения преж¬
него фокус-окошка о передаче фокуса.
Планировщик задач
41
Далее мы раскрываем реализацию абстрактного типа Task, которая скрыта от
клиентов. Она основана на кольце дескрипторов задач и указателе на последнюю
активированную задачу в кольце. Гарантируется, что кольцо никогда не пусто, по¬
тому что вышеупомянутый сборщик мусора устанавливается как безопасная за¬
дача при загрузке системы.
Теперь можно приступить к доскональному изучению нашей версии плани¬
ровщика. Читатель отсылается к процедуре Loop в модуле Oberon, приведенном
полностью в конце этой главы.
получить позицию мыши и состояние ее кнопок;
LOOP
IF доступен ввод с клавиатуры THEN считать символ
IF символ - escape THEN
оповестить окошки сообщением о нейтрализации
ELSIF символ - setup THEN
послать сообщение о пометке окошка, где стоит мышь
ELSE послать сообщение о получении фокус-окошку
END;
получить позицию мыши и состояние ее клавиш
ELSIF нажата хотя бы одна кнопка THEN
REPEAT
послать сообщение дорожке окошка, содержащего мышь;
получить позицию мыши и состояние ее кнопок
UNTIL все кнопки не отпущены
ELSE (*не нажата ни одна кнопка*)
послать сообщение дорожке окошка, содержащего мышь;
получить позицию мыши и состояние кнопок;
WHILE мышь не двигается и нет ввода с клавиатуры DO
взять следующую задачу из кольца в качестве текущей задачи;
IF текущая задача небезопасна THEN удалить ее из кольца END;
послать сообщение о продолжении текущей задачи;
вновь обеспечить в кольце текущую задачу;
получить позицию мыши и состояние ее кнопок
END
END
END
Сознательно опустив пока в наших объяснениях исключительные ситуации
программы, теперь было бы уместно дополнить ее некоторыми концептуальны¬
ми замечаниями о способе продолжения в случае программного прерывания или,
другими словами, в случае сбоя в задаче. Конечно, обработка такого случая может
проводиться на многих разных уровнях абстракции. Согласно нашему общему
нисходящему подходу, мы сейчас фокусируем внимание на уровне нашей модели
управления задачами.
Можно выполнить три последовательных действия по восстановлению после
сбоя программы:
42
Система управления задачами
Понятие команды
амии
восстановление после сбоя программы = BEGIN
сохранить текущее состояние системы;
вызвать стандартный обработчик прерываний;
вернуться к началу планировщика задач
END
В сущности, состояние системы определяется значениями всех глобальных и
локальных переменных в данный момент. Обработчик прерываний обычно откры¬
вает дополнительное окошко, отображающее причину прерывания и сохраненное
состояние системы. На рис. 3.1 окошко прерывания показано в правом нижнем
углу экрана дисплея.
Обратите внимание, что в приведенном выше фрагменте программы не¬
безопасные фоновые задачи удаляются из кольца готовых задач до реактивации
и восстанавливаются только после успешного возвращения. Следовательно, не¬
безопасные задачи исключаются автоматически после сбоя. Это эффективная
защита от каскадных сбоев. Очевидно, такая защита не нужна в случае интерак¬
тивных задач, потому что их реактивация находится под контролем пользователя
системы.
Итак, Оберон - многозадачная система, основанная на двоякой модели. Ин¬
терактивные задачи связаны с системой отображения и планируются с высоким
приоритетом при вмешательстве пользователя. Фоновые задачи автономны и
планируются с низким приоритетом. Модель активации задач реализована как
передача сообщений и в итоге как вызов процедур, присвоенных переменным.
Они упорядочены последовательно и управляются одним процессом.
3.3. Понятие команды
Коротко: операционная система - это универсальная платформа, на которой
можно строить пакеты прикладного программного обеспечения. Платформа ста¬
новится для разработчика программного обеспечения интерфейсом с «системой»
и (в частности) с низлежащим оборудованием. К сожалению, интерфейсы боль¬
шинства традиционных операционных систем страдают слишком примитивным
механизмом доступа, который основывается исключительно на понятии «про¬
граммного прерывания» или «вызова супервизора» и на файлах, играющих роль
«каналов» связи. Ситуация особенно нелепа в отношении абстракций при разра¬
ботке языков программирования высокого уровня.
В Обероне мы сделали наибольший упор на преодоление семантического раз¬
рыва между пакетами прикладного программного обеспечения и системной плат¬
формой. Результат наших усилий - очень выразительный и компактный интер¬
фейс прикладного программирования в виде явной иерархии определений модулей.
Наверное, самый значительный и заметный результат такого подхода - коллекция
таких очень мощных общесистемных абстрактных типов данных, как Task, Frame,
Viewer, File, Font, Text, Module, Reader, Scanner, Writer и т. д.
44
Система управления задачами
3.3.1. Атомарные действия
Самая важная, как и самая универсальная, функция любой операционной сис-
темы - выполнение программ. Поэтому наш следующий щаг - разъяснение тер¬
мина программа, как он употребляется в Обероне. Мы должны рассмотреть как
статический, так и динамический аспекты.
Статически программа в Обероне - это просто пакет программ с точкой входа.
Более формально это пара (М*, Р), где М - произвольный модуль, Р ~ экспортиру¬
емая модулем Мпроцедура без параметров, а М* обозначает иерархию, состоящую
из самого М и всех прямо и косвенно импортируемых модулей. Заметим, чтр две
иерархии М* и N* не являются несвязными вообще, даже если М и N - разные
модули. Скорее, их пересечение - это надмножество (множество А является над¬
множеством В, если любой элемент В есть также элемент ЛПрим. пер.) опера¬
ционной системы.
Динамически программа в Обероне определяется как атомарное действие,
влияющее на глобальное состояние системы, где атомарный означает «без вме¬
шательства пользователя». Заметьте, что это определенйе - всего лишь неизбеж¬
ное следствие нашей модели неприоритетного планирования задач с выгодами
однопоточного процесса. Аргументация примерно такова: когда обычная йнтер-
активная программа, чтобы двинуться дальше, запрашивает ввод от пользовате¬
ля, в принципе, нет никаких оснований не позволить ему приостановить текущую
задачу и запустить другую с целью создания необходимых для ввода данных.
Поэтому обычная интерактивная программа может рассматриваться как после¬
довательность атомарных действий, разделенных вмешательствами, которые, воз¬
можно, включают действия других программ. Рисунки 3.2 и 3.3 иллюстрируют эту
аргументацию, сопоставляя возможные последовательности обработки в обычной
интерактивной системе и в системе Оберон соответственно.
Итак, по сути, программы в Обероне представляются в виде экспортируемых
процедур без параметров, которые не взаимодействуют с пользователем системы.
В честь этих отличительных свойств такие процедуры называются командами.
Понятие команды
тнмка
Рис. 3.3. Типичный ход обработки в системе Оберон
Возвращаясь к вызову и выполнению программ, мы приходим теперь к следую-
щему уточнению:
вызов программы (М*. Р) = BEGIN
загрузить иерархию модуля М*; выполнить команду Р
END
Системный интерфейс самого механизма исполнения команд тоже обеспечи¬
вается модулем Oberon. Его основное действие - вызвать команду по ее имени и
передать список фактических параметров:
PROCEDURE Call (VAR name: ARRAY OF CHAR;
par: ParList; new: BOOLEAN; VAR res: INTEGER);
flame - имя нужной команды в виде М.Р, par - список фактических параметров,
ПШ ~ опция, гарантирующая предварительную загрузку новой версии М* и res -
получаемый в результате код. Тип ParList объявляется в сущности как
FarList = POINTER ТО ParRec;
P&rRec = RECORD
vwr: Viewers.Viewer;
text: Texts.Text;
pos: LONGINT
END;
46
Система управления задачами
Параметр vwr указывает на вызываемое окошко (задачу), а пара параметров
(text, pos) задает начальную позицию pos текстового списка параметров в тексте
text. Обратите внимание на абстрактный тип данных с именем Text, который экс¬
портируется модулем Texts. Мы посвятим всю главу 5 доскональному представле¬
нию текстовой системы Оберона, а пока можно считать текст просто последова¬
тельностью символов.
Список фактических параметров передается в распоряжение вызванной
команды модулем Oberon в виде экспортируемой глобальной переменной
Par: ParList
Реальный список параметров может быть простым расширением стандартно¬
го списка параметров ParList. В этом случае дополнительные поля представляют
нестандартные и настраиваемые параметры.
В принципе, команды действуют на всю систему и имеют доступ к текущему
глобальному состоянию через мощный системный модульный интерфейс, список
фактических параметров которого - это только один компонент. Другим является
так называемый системный журнал, который является общесистемным протоко¬
лом, отражающим в хронологическом порядке ход выполнения команд и исклю¬
чительные ситуации.
Журнал представляется глобальной переменной типа Text:
Log: Texts.Text;
Теперь становится ясно, что разработчики гибких и адаптируемых команд мо¬
гут полагаться на богатый арсенал глобальных средств, которые отражают текущее
состояние системы и делают его доступным. Другими словами, они могут пола¬
гаться на высокую степень системной интеграции. Поэтому мы находим в Обе¬
роне необычайно широкий спектр интегрированных понятий. Например, систему
отличает полная интеграция абстрактных типов данных Viewer и Text, с которыми
мы столкнулись выше. Они будут темами глав 4 и 5.
Модуль Oberon помогает интеграции этих типов со следующими концептуаль¬
ными средствами, из которых с первыми двумя мы уже знакомы: стандартный
список параметров для команд, системный журнал, обобщенное выделение текс¬
та, обобщенное копирование из текста и обобщенное копирование окошка. Здесь
мы, наверное, должны пояснить употребление нами термина «обобщенный». Он -
синоним к «понимаемый по-своему каждым окошком (интерактивной задачей)»
и обычно используется в связи с сообщениями или указаниями, истинное лицо
получателя которых неизвестно.
Теперь перейдем к краткому обсуждению обобщенных средств, оставаясь на
том же текущем уровне абстракции и понимания.
3.3.2. Обобщенное выделение текста
Выделение текста определяется текстом, границами отрезка символов внутри
этого текста и отметкой о времени. Без дальнейших уточнений «выделение текс-
та» всегда означает «самое последнее выделение текста». Программно оно может
быть выполнено вызовом процедуры GetSelection:
PROCEDURE GetSelection (VAR text: Texts.Text; VAR beg, end, time: LONGINT);
Параметры задают требуемый отрезок текста, начиная с позиции beg и закан¬
чивая end - 1 ,а также соответствующую отметку о времени. Процедура реализу¬
ется передачей так называемого сообщения о выделении всем окошкам. Вот объ¬
явление этого сообщения:
SelectionMsg = RECORD (ViewerMsg)
time: LONGINT;
text: Texts.Text;
beg, end: LONGINT
END;
3.3.3. Обобщенное копирование из текста
Цель - общее указание «копировать из текста». Для передачи таких запросов
определяется вариант типа ViewerMsg:
CopyOverMsg = RECORD (ViewerMsg)
text: Texts.Text;
beg, end: LONGINT
END;
Обычно получатели такого сообщения копируют заданный отрезок текста
в свой локальный фокус.
3.3.4. Обобщенное копирование окошка
Обобщенное копирование окошка - это то же, что размножение. Это самая
простая из возможных обобщенных операций. Здесь снова для передачи запросов
нужного типа используется вариант типа ViewerMsg:
CopyMsg = RECORD (ViewerMsg)
vwr: Viewers.Viewer
END;
Получатели сообщения о копировании создают своего двойника и возвращают
его отправителю в поле vwr.
Теперь подытожим этот раздел. Оберон - операционная система, предлагаю¬
щая своим клиентам очень выразительный модульный интерфейс, который экс¬
портирует множество таких мощных абстрактных типов данных, как, например,
Viewer и Text. Богатый арсенал глобальных и обобщенных средств служит для це¬
лей системной интеграции. Программы в Обероне оформлены в виде так пазывае-
Понятие команды
48
Система управления задачами
мых команд, то есть экспортируемых процедур без параметров, которые не взаи¬
модействуют с пользователем. Набор предлагаемых модулем команд становится
пользовательским интерфейсом. Параметры передаются командам в глобальном
списке параметров, созданном вызываемой задачей в центральном модуле Oberon.
Команды влияют на глобальное состояние системы.
3.4. Наборы инструментов
В модульной среде программирования программные модули могут иметь мно¬
жество разновидностей. Некоторые известные примеры приведены в табл. 3.2:
коллекция логически связанных объявлений данных и типов, капсула с абстракт¬
ным типом данных, каркас для реализации объектного класса и библиотека слу¬
жебных процедур.
Оберон добавляет еще одну разновидность - набор инструментов. По опреде¬
лению, это просто коллекция команд в смысле предыдущего раздела.
Наборы инструментов принципиально отличаются от других разновидностей
модулей тем, что они лежат на вершине иерархии модулей. Инструментальные
модули «импортируются» пользователями системы во время выполнения. Други¬
ми словами, их определения задают пользовательский интерфейс.
Грубо говоря, набор инструментов существует для любой темы или при¬
ложения. В табл. 3.3 приводятся системно-ориентированные темы с именами
соответствующих наборов инструментов и ссылками на главы, объясняющие их
команды.
Таблица 3.2
Вид модуля
Роль определения
Роль реализации
Объявления
Объявляет данные и объекты
Пусто
Абстрактный тип данных
Определяет интерфейс
Реализует операции
Каркас класса
Определяет объект-генератор
Реализует методы
Служебные процедуры
Определяет параметры
Реализует службы
Набор инструментов
Определяет интерфейс пользователя
Реализует интерфейс
пользователя
Таблица 3.3
Тема
Набор инструментов
Главы
Управление системой
System
3
Управление отображением
System
4
Редактирование текста
Edit
5
Управление модулями
System
6
Управление файлами
System
7
Наблюдение за системой
System
8, 12
Управление сетью
Net
10
Компиляция
Compiler
12
Редактирование графики
Draw
13
В качестве примера определения набора инструментов приведем версию мо¬
дуля System с комментариями:
DEFINITION System;
(*Управление системой*)
PROCEDURE SetUser; (идентификация пользователя*)
PROCEDURE SetFont; (*установить шрифт для набираемого текста*)
PROCEDURE SetColoг; (*установить цвет для набираемого текста и графики*)
PROCEDURE Time; (*установить или отобразить время*)
PROCEDURE Collect; (*собрать мусор*)
(♦Управление отображением*)
PROCEDURE Open; (*открыть окошко*)
PROCEDURE OpenLog; (*открыть окошко журнала*)
PROCEDURE Close; (*закрыть окошко *)
PROCEDURE CloseTrack;
PROCEDURE Recall; (*открыть повторно последнее закрытое окошко*)
PROCEDURE Сору; ^копировать окошко *)
PROCEDURE Grow; (*увеличить окошко *)
(★Управление модулями*)
PROCEDURE Free; (*освободить данный модуль*)
PROCEDURE ShowCommands; (*показать команды данного модуля*)
PROCEDURE ShowModules; (*показать загруженные модули*)
(♦Управление файлами *)
PROCEDURE Directory;
PROCEDURE CopyFiles;
PROCEDURE RenameFiles;
PROCEDURE DeleteFiles;
(♦Наблюдение за системой *)
PROCEDURE Watch; (*memory and disk storage*)
PROCEDURE State; (*состояние глобальных переменных модуля *)
END System;
В принципе, команды могут интерпретироваться любой интерактивной зада¬
чей произвольно и по-своему. Но если задача представлена текстовым окошком,
мы получаем привлекательный универсальный интерпретатор команд, просто ин¬
терпретируя основной текст. Если текст - это список имен команд, сопровождае¬
мых параметрами, то мы называем его инструментом (tool).
Более точно: инструмент - это текст, подчиняющийся следующему синтакси¬
су в нотации РБНФ (расширенная форма Бэкуса-Наура):
инструмент = {[Комментарий] ИмяКоманды [СписокПараметров]}.
Наборы инструментов
49
50
Система управления задачами
Текстовый список параметров, если он есть, доступен вызываемой команде
посредством полей text и pos в глобальном списке параметров Par, который экспор¬
тируется модулем Oberon. Поскольку этот список параметров интерпретируется
каждой командой по-своему, его формат полностью открыт. Однако мы зафик¬
сируем некоторые соглашения и правила для стандартизации пользовательского
интерфейса:
1. Элементы текстового списка параметров - универсальные синтаксические
единицы, как имя, строка литер, целое число, вещественное число, длинное
вещественное число и специальный символ.
2. Символ ссылки «А» в текстовом списке параметров ссылается на текущее
выделение текста в качестве продолжения. В случае, когда символ ссыл¬
ки следует непосредственно за именем команды, весь список параметров
представляет собой выделенный текст.
3. Символ метки «*» в текстовом списке параметров ссылается на текущее по¬
меченное окошко. Обычно символ метки заменяет имя файла. В этом слу¬
чае вместо содержимого файла интерпретатором команд обрабатывается
содержимое помеченного окошка.
4. Символ «@» в текстовом списке параметров обозначает начало текста, ко¬
торый берется в качестве операнда.
5. Символ завершения «~» заканчивает текстовый список параметров в слу¬
чае переменного числа параметров.
Поскольку инструменты - это обычные редактируемые тексты (в отличие от
общепринятых меню), их можно менять «на лету». Снова обратимся к рис. 3.1,
на котором показан типичный экран Оберона, состоящий из двух вертикальных
дорожек - более широкой пользовательской дорожки слева и узкой системной до¬
рожки справа. В пользовательской дорожке отображаются три документа: текст,
графика и изображение. В системной дорожке мы видим окошко журнала, отобра¬
жающего системный журнал, два инструментальных окошка со стандартными сис¬
темными и личными пользовательскими инструментами соответственно, а также
одно окошко прерываний внизу экрана.
Рассмотрим понятия команды и инструмента на примере раздела управления
системой набора инструментов System. Его команды SetUser, Time, SetFont, SetColor
и Collect используются для управления общесистемными возможностями, а имен¬
но для установки идентификатора пользователя, для отображения или установ¬
ки системного времени, для предустановки системного шрифта для набираемого
текста, для установки системного цвета и для активации сборщика мусора. Реали¬
зация функций включена в раздел «Законченные реализации» в конце этой главы.
На рис. 3.4 представлен возможный фрагмент текстового инструмента, состояще¬
го из команд управления системой.
На этом раздел завершается. Итак, набор инструментов - это особый вид
модуля Оберона. Он определяется как коллекция команд. Находясь на вершине
модульной иерархии, наборы инструментов полностью задают пользовательский
интерфейс системы. Инструменты - это последовательности вызовов команд
Полная реализация
51
System.SetUser{type user/password}
System.Time{dd mo yy hh mm ss}
System.SetFonts SyntaxlOi.Sen.Fnt
System.SetFontT
System.SetColor®
System.Collect
Рис. 3.4. Фрагмент инструмента
управления системой
в текстовом представлении. Они могут редактироваться и настраиваться. В типо¬
вой схеме экрана Оберона инструменты отображаются в окошках внутри систем¬
ной дорожки.
Полная реализация
MODULE Oberon; (*JG 6.9.90*)
IMPORT Kernel, Modules, Input, Display, Fonts, Viewers, Texts;
CONST
consume* = 0; track* =1; (* id входного сообщения*)
defocus* = 0; neutralize* = 1; mark* = 2; (*id управляющего сообщения *)
BasicCycle = 20;
ESC = 1BX; SETUP = 0A4X;
TYPE
Painter* = PROCEDURE (x, y: INTEGER);
Marker* = RECORD Fade*, Draw*: Painter END;
Cursor* = RECORD
marker*: Marker; on*: BOOLEAN; X*, Y*: INTEGER
END;
ParList* = POINTER TO ParRec;
ParRec* = RECORD
vwr*: Viewers.Viewer;
frame*: Display.Frame;
text*: Texts.Text;
pos*: LONGINT
END;
InputMsg* = RECORD (Display.FrameMsg)
id*: INTEGER;
keys*: SET;
X*, Y*: INTEGER;
ch*: CHAR;
fnt*: Fonts.Font;
52
Система управления задачами
col*, voff*: SHORTINT
END;
SelectionMsg* = RECORD (Display.FrameMsg)
time*: LONGINT;
text*: Texts.Text;
beg*, end*: LONGINT
END;
ControlMsg* = RECORD (Display.FrameMsg)
id*, X*, Y*: INTEGER
END;
CopyOverMsg* = RECORD (Display.FrameMsg)
text*: Texts.Text;
beg*, end*: LONGINT
END;
CopyMsg* = RECORD (Display.FrameMsg)
F*: Display.Frame
END;
Task* = POINTER TO TaskDesc;
TaskDesc* = RECORD
next: Task;
safe*: BOOLEAN;
handle*: PROCEDURE
END;
VAR
User*: ARRAY 8 OF CHAR;
Password*: LONGINT;
Arrow*, Star*: Marker;
Mouse*, Pointer*: Cursor;
FocusViewer*: Viewers.Viewer;
Log*: Texts.Text;
Par*: ParList; (*actual parameters*)
CurTask*, PrevTask: Task;
CurFnt*: Fonts.Font; CurCol*, CurOff*: SHORTINT;
DW, DH, CL, HO, H1, H2, H3: INTEGER;
ActCnt: INTEGER; (*число действий для GC*)
Mod: Modules.Module;
Полная реализация
PROCEDURE Min (i, j: INTEGER): INTEGER;
BEGIN IF i <= j THEN RETURN i ELSE RETURN j END
END Min;
(♦идентификация пользователя*)
PROCEDURE Code(VAR s: ARRAY OF CHAR): LONGINT;
VAR i: INTEGER; a, b, c: LONGINT;
BEGIN
a := 0; b := 0; i := 0;
WHILE s[i] # OX DO
с := b; b := a; a := (c MOD 509 + 1) * 127 + 0RD(s[i]);
INC(i)
END;
IF b >= 32768 THEN b := b - 65536 END;
RETURN b * 65536 + a
END Code;
PROCEDURE SetUser* (VAR user, password: ARRAY OF CHAR);
BEGIN C0PY(user, User); Password := Code(password)
END SetUser;
(*часы*)
PROCEDURE GetClock* (VAR t, d: LONGINT);
BEGIN Kernel.GetClock(t, d)
END GetClock;
PROCEDURE SetClock* (t, d: LONGINT);
BEGIN Kernel.SetClock(t, d)
END SetClock;
PROCEDURE Time* (): LONGINT;
BEGIN RETURN Input.Time()
END Time;
(★управление курсором*)
PROCEDURE* FlipArrow (X, Y: INTEGER);
BEGIN
IF X < CL THEN
IF X > DW - 15 THEN X := DW - 15 END
ELSE
IF X > CL + DW - 15 THEN X := CL + DW - 15 END
END;
IF Y < 15 THEN Y := 15 ELSIF Y > DH THEN Y : = DH END;
Display.CopyPattern(Display.white, Display.arrow, X, Y - 15, 2)
END FlipArrow;
PROCEDURE* FlipStar (X, Y: INTEGER);
53
BEGIN
IF X < CL THEN
IF X < 7 THEN X := 7 ELSIF X > DW - 8 THEN X := DW - 8 END
ELSE
IF X < CL + 7 THEN X := CL + 7
ELSIF X > CL + DW - 8 THEN X := CL + DW - 8
END
END ;
IF Y < 7 THEN Y := 7 ELSIF Y > DH - 8 THEN Y : = DH - 8 END;
Display.CopyPattern(Display.white, Display.star, X - 7, Y - 7, 2)
END FlipStar;
PROCEDURE OpenCursor* (VAR c: Cursor);
BEGIN с.on := FALSE; c.X := 0; c.Y := 0
END OpenCursor;
PROCEDURE FadeCursor* (VAR c; Cursor);
BEGIN IF c.on THEN c.marker.Fade(c.X, c.Y); c.on := FALSE END
END FadeCursor;
PROCEDURE DrawCursor* (VAR c: Cursor; VAR m: Marker; X, Y; INTEGER);
BEGIN
IF c.on & ((X # c.X) OR (Y # c.Y) OR (m.Draw # c.marker.Draw)) THEN
c.marker.Fade(c.X, c.Y); c.on ;= FALSE
END;
IF “c.on THEN
m.Draw(X, Y); c.marker := m; c.X := X; c.Y := Y; c.on := TRUE
END
END DrawCursor;
(★управление отображением*)
PROCEDURE RemoveMarks* (X, Y, W, H: INTEGER);
BEGIN
IF (Mouse.X > X - 16) & (Mouse.X < X + W + 16)
& (Mouse.Y > Y - 16) & (Mouse.Y < Y + H + 16) THEN FadeCursor(Mouse)
END;
IF (Pointer.X > X - 8) & (Pointer.X < X + W + 8)
& (Pointer.Y > Y - 8) & (Pointer.Y < Y + H + 8) THEN FadeCursor(Pointer)
END
END RemoveMarks;
PROCEDURE* HandleFiller (V: Display.Frame; VAR M: Display.FrameMsg);
BEGIN
WITH V: Viewers.Viewer DO
IF M IS InputMsg THEN
WITH M: InputMsg DO
IF M.id = track THEN DrawCursor(Mouse, Arrow, M.X, M.Y) END
END;
54
Система управления задачами
Полная реализация
55
ELSIF М IS ControlMsg THEN
WITH M: ControlMsg DO
IF M.id = mark THEN DrawCursor(Pointer, Star, M.X, M.Y) END
END
ELSIF M IS Viewers.ViewerMsg THEN
WITH M: Viewers.ViewerMsg DO
IF (M.id = Viewers.restore) & (V.W > 0) & (V.H > 0) THEN
RemoveMarks(V.X, V.Y, V.W, V.H);
Display.ReplConst(Display.black, V.X, V.Y, V.W, V.H, 0)
ELSIF (M.id = Viewers.modify) & (M.Y < V.Y) THEN
RemoveMarks(V.X, M.Y, V.W, V.Y - M.Y);
Display.ReplConst(Display.black, V.X, M.Y, V.W, V.Y - M.Y, 0)
END
END
END
END
END HandleFiller;
PROCEDURE OpenDisplay* (UW, SW, H: INTEGER);
VAR Filler: Viewers.Viewer;
BEGIN
Input.SetMouseLimits(Viewers.curW + UW + SW, H);
Display.ReplConst(Display.black, Viewers.curW, 0, UW + SW, H, 0);
NEW(Filler); Filler.handle := HandleFiller;
Viewers.InitTrack(UW, H, Filler); (*init user track*)
NEW(Filler); Filler.handle := HandleFiller;
Viewers.InitTrack(SW, H, Filler) (*init system track*)
END OpenDisplay;
PROCEDURE DisplayWidth* (X: INTEGER): INTEGER;
BEGIN RETURN DW
END DisplayWidth;
PROCEDURE DisplayHeight* (X: INTEGER): INTEGER;
BEGIN RETURN DH
END DisplayHeight;
PROCEDURE OpenTrack* (X, W: INTEGER);
VAR Filler: Viewers.Viewer;
BEGIN
NEW(Filler); Filler.handle := HandleFiller;
Viewers.OpenTrack(X, W, Filler)
END OpenTrack; .
PROCEDURE UserTrack* (X: INTEGER): INTEGER;
BEGIN RETURN X DIV DW * DW
END UserTrack;
PROCEDURE SystemTrack* (X: INTEGER): INTEGER;
56
Система управления задачами
BEGIN RETURN X DIV DW * DW + DW DIV 8 * 5
END SystemTrack;
PROCEDURE UY (X: INTEGER): INTEGER;
VAR fil, bot, alt, max: Display.Frame;
BEGIN
Viewers.Locate(X, 0, fil, bot, alt, max);
IF fil.H >= DH DIV 8 THEN RETURN DH END;
RETURN max.Y + max.H DIV 2
END UY;
PROCEDURE AllocateUserViewer* (DX: INTEGER; VAR X, Y: INTEGER);
BEGIN
IF Pointer.on THEN X := Pointer.X; Y := Pointer.Y
ELSE X := DX DIV DW * DW; Y := UY(X)
END
END AllocateUserViewer;
PROCEDURE SY (X: INTEGER): INTEGER;
VAR fil, bot, alt, max: Display.Frame;
BEGIN
Viewers.Locate(X, DH, fil, bot, alt, max);
IF fil.H >= DH DIV 8 THEN RETURN DH END;
IF max.H >= DH - HO THEN RETURN max.Y + H3 END;
IF max.H >= H3 - HO THEN RETURN max.Y + H2 END;
IF max.H >= H2 - HO THEN RETURN max.Y + H1 END;
IF max # bot THEN RETURN max.Y + max.H DIV 2 END;
IF bot.H >= H1 THEN RETURN bot.H DIV 2 END;
RETURN alt.Y + alt.H DIV 2
END SY;
PROCEDURE AllocateSystemViewer* (DX: INTEGER; VAR X, Y: INTEGER);
BEGIN
IF Pointer.on THEN X := Pointer.X; Y := Pointer.Y
ELSE X := DX DIV DW * DW + DW DIV 8 * 5; Y := SY(X)
END
END AllocateSystemViewer;
PROCEDURE MarkedViewer* (): Viewers.Viewer;
BEGIN RETURN Viewers.This(Pointer.X, Pointer.Y)
END MarkedViewer;
PROCEDURE PassFocus* (V: Viewers.Viewer);
VAR M: ControlMsg;
BEGIN M.id := defocus; FocusViewer.handle(FocusViewer, M); FocusViewer := V
END PassFocus;
(♦интерпретация комманд*)
PROCEDURE Call* (VAR name: ARRAY OF CHAR; par: ParList; new: BOOLEAN;
Полная реализация
57
VAR res: INTEGER);
VAR Mod: Modules.Module; P: Modules.Command; i, j: INTEGER;
BEGIN res := 1;
i := 0; j := 0;
WHILE name[j] # OX DO
IF name[j] = V THEN i := j END;
INC(j)
END;
IF i > 0 THEN
name[i] := OX;
IF new THEN Modules.Free(name, FALSE) END;
Mod := Modules.ThisMod(name);
IF Modules.res = 0 THEN
INC(i); j := i;
WHILE name[j] # OX DO name[j - i] := name[j]; INC(J) END>
name[j - i] := OX;
P := Modules.ThisCommand(Mod, name);
IF Modules.res = 0 THEN
Par := par; Par.vwr := Viewers.This(par.frame.X, par.frame.Y);
P; res := 0
END
ELSE res := Modules.res
END
END
END Call;
PROCEDURE GetSelection* (VAR text: Texts.Text; VAR beg, end, time: LONGINT);
VAR M: SelectionMsg;
BEGIN
M.time := -1; Viewers.Broadcast(M);
text := M.text; beg := M.beg; end := M.end; time := M.time
END GetSelection;
PROCEDURE* GC;
VAR x: LONGINT;
BEGIN IF ActCnt <= 0 THEN Kernel.GC; ActCnt := BasicCycle END
END GC;
PROCEDURE Install* (T: Task);
VAR t: Task;
BEGIN t := PrevTask;
WHILE (t.next # PrevTask) & (t.next ff T) DO t := t.next END;
IF t.next = PrevTask THEN T.next := PrevTask; t.next := T END
END Install;
PROCEDURE Remove* (T: Task);
VAR t: Task;
BEGIN t := PrevTask;
WHILE (t.next # T) & (t.next # PrevTask) DO t := t.next END;
IF t.next = T THEN t.next := t.next.next; PrevTask := t.next END;
58
Система управления задачами
IF CurTask = Т THEN CurTask := PrevTask.next END
END Remove;
PROCEDURE Collect* (count: INTEGER);
BEGIN ActCnt := count
END Collect;
PROCEDURE SetFont* (fnt: Fonts.Font);
BEGIN CurFnt := fnt
END SetFont;
PROCEDURE SetColor* (col: SHORTINT);
BEGIN CurCol := col
END SetColor;
PROCEDURE SetOffset* (voff: SHORTINT);
BEGIN CurOff := voff
END SetOffset;
PROCEDURE Loop*;
VAR V: Viewers.Viewer; M: InputMsg; N: ControlMsg;
prevX, prevY, X, Y: INTEGER; keys: SET; ch: CHAR;
BEGIN
LOOP
Input.Mouse(keys, X, Y);
IF Input.Available() > 0 THEN Input.Read(ch);
IF ch < OFOX THEN
IF ch = ESC THEN
N.id := neutralize; Viewers.Broadcast(N);
FadeCursor(Pointer)
ELSIF ch = SETUP THEN
N.id := mark; N.X := X; N.Y := Y; V := Viewers.This(X, Y);
V.handle(V, N)
IF ch < " " THEN
IF ch = 1X THEN ch := 83X (*/*)
ELSIF ch = OFX THEN ch := 84X (*„*)
ELSIF ch = 15X THEN ch := 85X (*...*)
END
ELSIF ch > THEN
IF ch = 81X THEN ch := 80X (*€*)
ELSIF ch = 8FX THEN ch := 81X (* *)
ELSIF ch = 95X THEN ch := 82X (*,*)
END
END;
M.id := consume; M.ch := ch; M.fnt := CurFnt;
M.col := CurCol; M.voff := CurOff;
FocusViewer.handle(FocusViewer, M);
DEC(ActCnt)
END
Полная реализация
59
ELSIF ch = 0F1X THEN Display.SetMode(0, {}) (*on*)
ELSIF ch = 0F2X THEN Display.SetMode(0, {0}) (*off*)
ELSIF ch = 0F3X THEN Display.SetMode(0, {2}) (*inv*)
END
ELSIF keys # {} THEN
M.id := track; M.X := X; M.Y := Y; M.keys := keys;
REPEAT
V := Viewers.This(M.X, M.Y); V.handle(V, M);
Input.Mouse(M.keys, M.X, M.Y)
UNTIL M.keys = {};
DEC(ActCnt)
ELSE
IF (X # prevX) OR (Y # prevY) OR “Mouse.on THEN
M.id := track; M.X := X; M.Y := Y; M.keys := keys; V := Viewers.
This(X, Y);
V.handle(V, M);
prevX := X; prevY := Y
END;
CurTask := PrevTask.next;
IF "CurTask.safe THEN PrevTask.next := CurTask.next END;
CurTask.handle; PrevTask.next := CurTask; PrevTask := CurTask
END
END
END Loop;
BEGIN User[0] := OX;
Arrow.Fade := FlipArrow; Arrow.Draw := FlipArrow;
Star.Fade := FlipStar; Star.Draw := FlipStar;
OpenCursor(Mouse); OpenCursor(Pointer);
DW := Display.Width;
H3 := DH - DH DIV 3;
H2 := H3 - H3 DIV 2;
H1 := DH DIV 5;
HO := DH DIV 10;
DH := Display.Height;
CL := Display.ColLeft;
OpenDisplay(DW DIV 8 * 5, DW DIV 8 * 3, DH);
FocusViewer := Viewers.This(0, 0);
CurFnt := Fonts.Default;
CurCol ;= Display.white;
CurOff := 0;
Collect(BasicCycle);
NEW(PrevTask);
PrevTask.handle := GC;
PrevTask.safe := TRUE;
PrevTask.next := PrevTask;
Mod := Modules.ThisMod("System");
60
Система управления задачами
Display.SetMode(0, {})
END Oberon.
MODULE System; (* JG 11.11.90*)
IMPORT Kernel, Input, Oberon, Fonts, Texts;
CONST
StandardMenu = "System.Close System.Copy System.Grow Edit.Search Edit.Store";
LogMenu = "System.Close System.Grow Edit.Locate Edit.Store";
VAR W: Texts.Writer;
PROCEDURE Max (i, j: LONGINT): LONGINT;
BEGIN IF i >= j THEN RETURN i ELSE RETURN j END
END Max;
(* Набор инструментов для управления системой *)
PROCEDURE SetUser*;
VAR i: INTEGER; ch: CHAR;
user: ARRAY 8 OF CHAR;
password: ARRAY 16 OF CHAR;
BEGIN
i := 0; Input.Read(ch);
WHILE (ch # "/") & (i < 7) DO user[i] := ch; INC(i); Input.Read(ch) END;
user[i] := OX; i := 0; Input.Read(ch);
WHILE (ch > " ") & (i < 15) DO password[i] := ch; INC(i); Input.Read(ch) END;
password[i] := OX;
Oberon.SetUser(user, password)
END SetUser;
PROCEDURE SetFont*;
VAR beg, end, time: LONGINT;
T: Texts.Text; S: Texts.Scanner;
BEGIN Texts.OpenScanner(S, Oberon.Par.text, Oberon.Par.pos); Texts.Scan(S);
IF (S.class = Texts.Char) & (S.c = "~") THEN
Oberon.GetSelection(T, beg, end, time);
IF time >= 0 THEN
Texts.OpenScanner(S, T, beg); Texts.Scan(S);
IF S.class = Texts.Name THEN Oberon.SetFont(Fonts.This(S.s)) END
END
ELSIF S.class = Texts.Name THEN Oberon.SetFont(Fonts.This(S.s))
END
END SetFont;
PROCEDURE SetColor*;
VAR beg, end, time: LONGINT;
T: Texts.Text; S: Texts.Scanner; ch: CHAR;
Полная реализация
BEGIN Texts.OpenScanner(S, Oberon.Par.text, Oberon.Par.pos); Texts.Scan(S);
IF (S.class = Texts.Char) & (S.с = "~") THEN
Oberon.GetSelection(T, beg, end, time);
IF time >= 0 THEN
Texts.OpenReader(S, T, beg); Texts.Read(S, ch); Oberon.SetColor(S.col)
END
ELSIF S.class = Texts.Int THEN Oberon.SetColor(SHORT(SHORT(S.i)))
END
END SetColor;
PROCEDURE SetOffset*;
VAR beg, end, time: LONGINT;
T: Texts.Text;S: Texts.Scanner; ch: CHAR;
BEGIN Texts.OpenScanner(S, Oberon.Par.text, Oberon.Par.pos); Texts.Scan(S);
IF (S.class = Texts.Char) & (S.с = "~") THEN
Oberon.GetSelection(T, beg, end, time);
IF time >= 0 THEN
Texts.OpenReader(S, T, beg); Texts.Read(S, ch); Oberon.SetColor(S.voff)
END
ELSIF S.class = Texts.Int THEN Oberon.SetOffset(SHORT(SHORT(S.i)))
END
END SetOffset;
PROCEDURE Time*;
VAR par: Oberon.ParList;
S: Texts.Scanner;
t, d, hr, min, sec, yr, mo, day: LONGINT;
BEGIN par := Oberon.Par;
Texts.OpenScanner(S, par.text, par.pos); Texts.Scan(S);
IF S.class = Texts.Int THEN (*установить дату*)
day := S.i; Texts.Scan(S); mo := S.i; Texts.Scan(S);
yr := S.i; Texts.Scan(S);
hr := S.i; Texts.Scan(S); min := S.i; Texts.Scan(S); sec := S.i;
t := (hr*64 + min)*64 + sec; d := (уr* 16 + mo)*32 + day;
Kernel.SetClock(t, d)
ELSE (*read date*)
Texts.WriteString(W, "System.Time");
Oberon.GetClock(t, d); Texts.WriteDate(W, t, d); Texts.WriteLn(W);
Texts.Append(Oberon.Log, W.buf)
END
END Time;
PROCEDURE Collect*;
BEGIN Oberon.Collect(O)
END Collect;
BEGIN Texts.OpenWriter(W)
END System.
61
4. СИСТЕМА ОТОБРАЖЕНИЯ
Экран дисплея - самая важная часть интерфейса, предоставляемого рабочей
станцией ее пользователям. На первый взгляд, он представляет просто прямо¬
угольную область вывода. Однако в комбинации с мышью он быстро разрастается
в изощренную интерактивную платформу ввода-вывода почти безграничной гиб¬
кости. Его «двуличие» - это именно то главное, чем он выделяется среди обычных
внешних устройств, управляемых операционной системой. В настоящей главе мы
подробно разберемся в причинах центрального положения системы отображения
в операционной системе и ее определяющего влияния на всю архитектуру систе¬
мы. В частности, мы покажем, что система отображения - естественное основание
или опора для функциональной расширяемости.
4.1. Модель планировки экрана
В начале семидесятых Xerox PARC в Калифорнии запустил проект Smalltalk
с целью создания и разработки новых и более естественных способов общения
с персональными компьютерами [4]. Наверное, самым заметным из нескольких
значительных достижений этого предприятия явилась идея применения образа
рабочего стола к экрану дисплея. Этот образ представляет собой рабочий стол и
коллекцию, возможно, взаимно перекрывающихся листов бумаги, лежащих на
нем. Проецируя такую конфигурацию на поверхность экрана, мы получаем знако¬
мую теперь картинку на рис. 4.1а с коллекцией частично или полностью видимых
на фоне экрана прямоугольных областей, так называемых окон или окошек (view¬
ers).
Образ рабочего стола используется многими современными операционными
системами и пользовательскими оболочками и как естественная модель для систе¬
мы, чтобы отделять отображаемые данные, относящиеся к разным задачам, и как
мощный инструмент пользователя, чтобы интерактивно организовывать экран
дисплея согласно своим вкусам и предпочтениям.
Однако этому образу присущи врожденные недостатки. Прежде всего они
связаны с перекрытием. Во-первых, любое эффективное управление перекрываю¬
щимися окошками должно опираться на подчиненное ему управление (произ¬
вольными) кусками прямоугольников и на изощренные операции их отсечения.
Это так, потому что частично перекрывающиеся окошки должны частично вос¬
станавливаться под управлением менеджера окошек. Например, на рис. 4.16 каж¬
дый из кусков а,Ькс окошка А должен быть восстановлен после закрытия окош¬
ка В. Во-вторых, есть большая опасность полного покрытия окошек и потери их
(а) (б)
Рис. 4.1: а - моделируемый рабочий стол с перекрывающимися окошками;
б - частичное перекрытие на рабочем столе
навсегда. И в-третьих, не существует никаких канонических эвристических алго¬
ритмов автоматического выделения пространства экрана для вновь открываемых
окошек.
Опыт показал, что частичное перекрытие желательно и полезно лишь в ред¬
ких случаях, и, таким образом, излишняя сложность управления им [1,3] вряд ли
оправдана. Поэтому были найдены альтернативные стратегии организации экра¬
на дисплея. Интересный класс приемлемых решений можно назвать мозаикой.
Есть несколько вариантов мозаики [2]. Наверное, самый очевидный (поскольку
самый естественный) основан на повторяющемся горизонтальном или верти¬
кальном делении существующих окошек. Начав с полного экрана и последова¬
тельно открывая окошки А, В, С, D, Е и Fy мы приходим к конфигурации, как на
рис. 4.2. Второй вариант - иерархическая мозаика. И опять иерархия начинает¬
ся с полного экрана, который теперь делится на множество вертикальных доро¬
жек, каждая из которых затем делится на множество горизонтальных окошек. На
рис. 4.3 - снимок иерархически поделенного экрана дисплея. Мы приняли в Обе¬
роне решение в пользу такого вида деления в основном потому, что алгоритм по¬
вторного использования области закрытого окошка проще и единообразнее. Па-
64
Система отображения
пример, предположим, что окошко ^на рис. 4.2 закрыли. Тогда ясно, что вернуть
предыдущую операцию открытия можно, расширив окошко Е вниз до конца. Од¬
нако, если закрылось окошко В, то такой простой процедуры уже не существует.
Например, освободившаяся область может быть поделена между окошками С и
D расширением их влево. Ясно, что в случае иерархического деления такие слож¬
ные ситуации не возникают.
(a)
(6)
Рис. 4.2: a - план экрана при неограниченном делении;
б - конфигурация окошек при неограниченном делении
Иерархическое деление используется также в системе Cedar Xerox PARC [5].
Однако вариант Оберона несколько отличается от варианта Cedar. Во-первых,
Оберон поддерживает быстрое по времени контекстное переключение между
перекрывающимися слоями из одной или нескольких смежных дорожек. На рис.
4.4 представлен снимок стандартного экрана дисплея Оберона. Он предполага¬
ет две исходные дорожки и два уровня перекрытия, где верхний слой - это весь
экран. Во-вторых, в отличие от Cedar, экран дисплея Оберона не обеспечивает
резервных областей для общесистемных средств. Как показано на рис. 4.5, стан¬
дартный экран Cedar показывает строку команд наверху, а строку значков - вни-
Модель планировки экрана
Рис. 4.3. План экрана при иерархическом делении
Рис. 4.4. Перекрытия дорожек и рядов дорожек
Рис. 4.5. План стандартного экрана Cedar со строкой команд и строкой значков
зу. И в-третьих, Оберон основан на иной эвристической стратегии автоматиче¬
ского размещения новых окошек. В Cedar по умолчанию считается, что область
каждой дорожки делится поровну между ее окошками. При размещении нового
окошка существующие окошки в дорожке уменьшаются по высоте и сдвигаются
к верху. А вновь открытое окошко помещается в освободившееся внизу дорожки
место. Напротив, Оберон обычно разбивает на две равные половины наибольшее
из существующих на дорожке окошек. Отметим, что достоинство этой последней
стратегии размещения - в том, что существующее содержимое окошек остается
неизменным.
4.2. Окошки как объекты
Несмотря на то что все, казалось бы, пришли к согласию в значении слова
окошко, на деле любые два системных разработчика расходятся в этом. Между тем
первоначальная роль окошка как просто отдельной области дисплея стала сильно
перегружаться дополнительной функциональностью. В зависимости от системы
Система отображения
66
Окошки кок объекты
67
окошки - это отдельные виды определенной конфигурации объектов, носители
задач, процессов, приложений и т. д. Поэтому сначала мы должны дать паше собст¬
венное точное определение понятия окошка.
Лучшее средство для этого - абстрактный тип данных Viewer, который мы вве¬
ли в главе 3. Итак, тип Viewer служит шаблоном, описывающим окошки абстракт¬
но, как «черные ящики», в терминах состояния видимости (прямоугольника па
экране дисплея) и обработчика сообщения. Точный функциональный интерфейс,
обеспеченный данным вариантом окошка, определяется множеством принимае¬
мых сообщений. Это множество структурировано как настраиваемая иерархия
расширений типа.
Теперь можно получить более конкретную спецификацию роли окошка, опре¬
делив некоторые основные категории универсальных сообщений, которые, как
ожидается, будут приниматься всеми вариантами окошка. Например, мы знаем,
что сообщения о пользовательских действиях, как и сообщения, определяющие
обобщенную операцию, универсальны. Эти две категории универсальных сооб¬
щений фиксируют роли окошек как интерактивных задач и как частей системы
в целом соответственно.
Всего таких категорий четыре. Они приведены в табл. 4.1 вместе с соответствую¬
щими функциями и получателями сообщений.
Таблица 4.1
Получатель
Функция
Сообщение
Планировщик задач
Диспетчеризация интерактивных
задач
Информирует о вмешательстве
пользователя
Интерпретатор команд
Обработка интегрированных
команд
Определяет обобщенную
операцию
Менеджер окошек
Организация области
отображения
Просит изменить положение или
размер
Менеджер документов
Работа с документами
Просит изменить содержимое
или формат
По сути дела, эти функции определяют роль окошек Оберона. Коротко: мож¬
но считать окошко Оберона ненакрытым прямоугольным блоком на экране, яв¬
ляющимся как интегрированной областью отображения некоторых объектов до¬
кумента, так и представлением интерактивной задачи в виде «чувствительной»
области редактирования.
Немного смещая акценты и считая различных получателей сообщений под¬
системами, мы сразу обнаруживаем в окошках роль интеграторов различных под¬
систем на базе интерфейсов передачи сообщений. В таком свете тип Viewer оказы¬
вается общим объектно-ориентированным базисом подсистем Оберона.
Функции из табл. 4.1 образуют своего рода костяк содержания глав 3, 4 и 5.
Планирование задач и интерпретация команд уже известны нам из разделов 3.2
и 3.3. Управление окошками и управление текстами будут темами разделов 4.4
и 5.2 соответственно. Таким образом, встроенный тип Text будет служить прос¬
тейшим примером документного типа.
68
Система отображения
Действиями, которые выполняют окошки, в основном управляют события,
точнее сообщения, представляющие извещения о событиях. Мы обсудим это по¬
дробно в разделах 4.4 и 5.3 для случаев абстрактного класса стандартных окошек
и класса окошек, отображающих стандартный текст соответственно.
Вот предварительный обзор некоторых типичных видов сообщений:
□ При каждом нажатии клавиши в текущее фокус-окошко посылается сооб¬
щение клавиатуры, содержащее введенный символ, а при каждом щелчке
мышью в окошко с текущей позицией мыши посылается сообщение мыши,
извещающее о ее новом состоянии.
□ Сообщение часто представляет собой некую обобщенную операцто, кото¬
рая предполагает собственную ее интерпретацию получателями. Очевид¬
ные примеры в нашем контексте: «вернуть текущее выделение текста»,
«копировать отрезок из текста» и «создать копию (двойника)». Обратите
внимание, что обобщенные операции - это ключ к расширяемости.
□ В мозаичных средах окошек каждое открытие нового окошка и каждое из¬
менение размера или положения существующего очевидно влияют на со¬
седние окошки. Поэтому менеджер окошек выдает сообщение для каждого
соседнего окошка, чтобы те тщательно подогнали свои размеры.
□ Как только в содержимое или формат документа внесены изменения, всем
видимым окошкам рассылается сообщение об изменениях. Обратите вни¬
мание, что рассылка сообщения моделью (документом) всем ее потенци¬
альным представлениям (окошкам) - интересная реализация известного
подхода MVC (Model-View-Controller), который освобождает модели от
«знания» (регистрации) своих представлений.
4.3. Кадры как основные объекты
отображения
Когда в главе 3 и в предыдущем разделе мы вводили окошки, то упрощали их
ради абстракции. Мы уже знаем, что окошки появляются как элементы второго
уровня в иерархии деления изображения. Считая их «черными ящиками», мы пока
ничего не выяснили о продолжении иерархии. Фактически окошки - это ни элемен¬
тарные объекты отображения, ни атомы. Они - лишь особый случай так называемых
кадров (frames) отображения. Кадры дисплея, или просто кадры, - это произволь¬
ные прямоугольники, отображающие коллекцию объектов или фрагмент документа.
В частности, рекурсивное вложение кадров в другие кадры - это возможность, кото¬
рая делает их чрезвычайно мощным инструментом для любого органайзера.
Тип Frame объявляется как:
Frame = POINTER ТО FrameDesc;
FrameDesc = RECORD
next, dsc:
Frame; X, Y, W, H: INTEGER;
handle: Handler
END;
Компоненты next и dsc - это связи с последующими кадрами. Их имена пред¬
полагают многоуровневую рекурсивную иерархическую структуру: next указы¬
вает на следующий кадр на том же уровне, тогда как dsc указывает на (первого)
потомка, то есть на следующий более низкий уровень иерархии вложенных кад¬
ров. X, Y,W,Hyl обработчик handle служат первоначальной цели, с которой мы их
ввели. В частности, обработчик позволяет кадрам по-своему реагировать па полу¬
чение сообщений. Его тип:
Handler = PROCEDURE (F: Frame; VAR M: FrameMsg):
где FrameMsg представляет корень потенциально неограниченной древовидной
иерархии возможных сообщений кадрам:
FrameMsg = RECORD END;
Введя теперь понятие кадра, мы можем раскрыть всю правду об окошках. Фак¬
тически тип Viewer -производный тип, расширение тина Frame:
Viewer = POINTER ТО ViewerDesc;
ViewerDesc = RECORD (FrameDesc)
state: INTEGER
END;
Эти объявления формально выражают то, что окошки - не что иное, как осо¬
бый случай (вариант или подкласс) кадров вообще, дополненный состоянием
видимости. В частности, окошки наследуют иерархическую структуру кадров.
Это чрезвычайно полезное свойство, сразу открывающее безграничный спектр
возможностей разработчикам особого подкласса окошек для организации пред¬
ставления прямоугольных областей. Например, область окошка, скажем, класса
Desktop может играть роль фона, покрытого произвольной коллекцией, возможно,
взаимоперекрывающихся кадров (см. пример па рис. 4.6). Другими словами, наше
решение об использовании глобальной схемы мозаичных окошек может быть лег¬
ко переделано в локальное.
Еще более важный пример предопределенной структуры - это абстрактный
класс так называемых окошек меню, знакомых по большинству снимков стандарт¬
ного экрана дисплея Оберона. Окошко меню состоит из тонкой прямоугольной
границы и внутренней области, разделенной вертикально на область меню навер¬
ху и область содержания внизу (см. рис. 4.7).
С точки зрения структуры данных класс окошек меню определяется как рас¬
ширение типа Viewer с дополнительным компонентом тепиН, задающим высоту
кадра меню:
MenuViewer = POINTER ТО MenuViewerDesc;
MenuViewerDesc = RECORD (ViewerDesc)
menuH: INTEGER
END;
Кадры как основные объекты отображения
69
Система отображения
Рис. 4.6. Класс окошек Desktop, организующий перекрывающиеся кадры
Каждое окошко меню V определяет ровно два потомка: кадр меню V.dsc и кадр
основного содержания, или основной кадр V.dsc.next. Содержимое двух потомков
вообще не фиксируется. Однако в стандартном случае кадр меню - это текстовый
70
кадр, отображающий строку команд в инверсном режиме. По определению харак¬
тер основного кадра определяет тип окошка. Если это тоже текстовый кадр, то мы
называем окошко текстовым окошком; если это кадр с графикой, мы называем его
графическим окошком и т. д.
4.4. Управление отображением
Система отображения Оберона охватывает две основные темы: управление
окошками и управление курсором. Давайте сначала обратимся к более сложной
теме управления окошками, а управление курсором отложим до конца раздела.
Прежде чем начать наше объяснение, нужно ввести понятие логической области
отображения. Она представляется как двумерная декартова плоскость вместе со
всеми отображаемыми на ней объектами. Суть такой абстракции - строгое отделе¬
ние любых физических аспектов устройств отображения. Фактически любое конк¬
ретное назначение отображающих мониторов определенным конечным участкам
области отображения - это исключительно вопрос конфигурирования системы.
Будучи подсистемой системы с четкой модульной структурой, система ото¬
бражения представляется в виде небольшой иерархии модулей. Ее ядро - линейно
упорядоченное множество из трех модулей Display, Viewers и MenuViewers, где по¬
следний строится на первых. Концептуально каждый модуль добавляет соответст¬
вующий класс объектов отображения и коллекцию связанных с ним служебных
программ.
В табл. 4.2 приводится краткий обзор подсистемы управления окошками.
В этой таблице модули верхних строк импортируют модули нижних строк, а типы
верхних строк расширяют типы нижних строк.
Таблица 4.2
Модуль
Тип
Служебные функции
MenuViewers
MenuViewer
Обработка сообщений для окошек-меню
Viewers
Viewer
Управление делящимися окошками
Display
Frame
Блочные растровые операции
В столбце Тип табл. 4.2 мы видим хорошо знакомые нам типы Frame, Viewer
и MenuViewer соответственно, где последний - это сокращение от MenuViewers.
Viewer.
В дополнение к модулям ядра системы отображения один из разделов моду¬
ля Oberon обеспечивает специализированный интерфейс прикладного програм¬
мирования, который упрощает использование приложениями пакета управления
окошками в случае стандартных конфигураций отображения в Обероне. Мы вер¬
немся к этой теме в разделе 4.6.
Теперь давайте сосредоточимся на ядре управления окошками, в частности на
модулях Viewer и Menu Viewers, отложив обсуждение модуля Display до следующе¬
го раздела. Как обычно, мы начинаем представление модуля с текста его определе¬
ния с комментариями, а заканчиваем обсуждением его реализации.
Управление отображением
71
72
Система отображения
4.4.1. Окошки
Начиная знакомство с модулем Viewers, можно грубо определить область его
ответственности как «инициализация и поддержка глобальной планировки об¬
ласти отображения». Из предыдущих обсуждений мы уже хорошо знакомы как
со структурой глобального пространства отображения, так и с его строительными
блоками: область отображения делится иерархически на кадры, где первые два
уровня иерархии кадров соответствуют дорожкам и окошкам соответственно.
Вот формальное определение модуля:
DEFINITION Viewers;
IMPORT Display;
CONST restore = 0; modify = 1; suspend = 2; (*id сообщений*)
TYPE
Viewer = POINTER TO ViewerDesc;
ViewerDesc = RECORD (Display.FrameDesc)
state: INTEGER
END;
ViewerMsg = RECORD (Display.FrameMsg)
id: INTEGER;
X, Y, W, H: INTEGER;
state: INTEGER
END;
VAR curW: INTEGER;
(*работа с дорожками *)
PROCEDURE InitTrack (W, H: INTEGER; Filler: Viewer);
PROCEDURE OpenTrack (X, W: INTEGER; Filler: Viewer);
PROCEDURE CloseTrack (X: INTEGER);
(*работа с окошками*)
PROCEDURE Open (V: Viewer; X, Y: INTEGER);
PROCEDURE Change (V: Viewer; Y: INTEGER);
PROCEDURE Close (V: Viewer);
(*разное*)
PROCEDURE This (X, Y: INTEGER): Viewer;
PROCEDURE Next (V: Viewer): Viewer;
PROCEDURE Recall (VAR V: Viewer);
PROCEDURE Locate (X, H: INTEGER; VAR fil, bot, alt, max: Viewer);
PROCEDURE Broadcast (VAR M: Display.FrameMsg);
END Viewers.
Сделаем несколько пояснений. Первая группа процедур, состоящая из InitTrack,
OpenTrack и CloseTrack, поддерживает дорожки области отображения. InitTrack со¬
здает новую дорожку шириной W и высотой Я, отделяя ее вертикальной перего¬
родкой от области отображения. Кроме того, InitTrack инициализирует вновь со¬
зданную дорожку окошком-заполнителем Filler, который передается как параметр.
Окошко-заполнитель, по сути, служит фоном, заполняющим дорожку сверху. Вы¬
сота уменьшается до 0, если дорожка полностью накрыта рабочими окошками.
Конфигурирование области отображения - часть инициализации системы
после ее запуска. Оно состоит в выполнении последовательности шагов вида
NEW(Filler); Filler.handle := HandleFiller; InitTrack(W, H, Filler)
где предполагается, что HandleFiller обрабатывает сообщения, которые требуют
изменения размера и вида курсора.
Глобальная переменная curW задает ширину уже сформированной части
области отображения. Отметим, что ее формирование начинается с х = 0 и необ¬
ратимо в том смысле, что сетка, определенная инициализированными дорожками,
позже уже не может стать мельче. Но помните, что она в любое время может стать
крупнее при наложении одной новой дорожки на несколько уже существующих
смежных дорожек.
Процедура OpenTrack служит именно этой цели. Чтобы быть перекрытой
в области отображения, дорожка (или ряд дорожек) должна охватывать сегмент
[X, X + W). Процедура CloseTrack обратна к OpenTrack. Она вызывается для закры¬
тия (самой верхней) дорожки с абсциссой X в области отображения и восстанов¬
ления накрытой ею дорожки (или ряда дорожек).
Следующие три процедуры применяются для организации окошек внутри са¬
мих дорожек. Процедура Open размещает заданное окошко в заданной позиции.
Более точно: Open находит окошко с координатами (X, Y), делит его горизонталь¬
но на высоте Y и открывает окошко V в нижней части области. В частном случае
совпадения Y с верхней границей уже размещенного окошка последнее автома¬
тически закрывается. Процедура Change позволяет изменять высоту заданного
окошка V перемещением его верхней границы в новое положение Y (в пределах
его соседей). Процедура Close удаляет заданное окошко Vиз области отображения.
Рисунок 4.8 поясняет эти операции.
Последняя группа процедур предоставляет различные сервисы. Процедура
This дает окошко с координатами (X, Y). Процедура Next возвращает следующего
верхнего соседа заданного отображаемого окошка V. Процедура Recall позволяет
вернуть и восстановить последнее закрытое окошко. Locate - процедура, которая
помогает эвристическому размещению новых окошек. Для любой заданной до¬
рожки и желаемой минимальной высоты процедура Locate предлагает выбор из
нескольких разных окошек на дорожке - окошка-заполнителя, альтернативного
нижнего окошка и окошка максимальной высоты. Наконец, процедура Broadcast
передает сообщение в область отображения, то есть посылает заданное сообщение
всем отображаемым в настоящее время окошкам.
Управление отображением
73
74
Система отображения
Рис. 4.8. Основные операции над окошками
Теперь самое время заглянуть за кулисы. Начнем с разоблачения внутренней
структуры данных модуля Viewer. Напомним, что согласно принципу сокрытия
информации внутренняя структура данных - это безраздельная собственность
модуля, доступная только через его процедурный интерфейс. Рисунок 4.9 по¬
казывает структуру данных снимка экрана дисплея с рис. 4.4. Отметим, что
перекрывающиеся дорожки и окошки - все-таки часть внутренней структуры
данных.
В структуре данных мы видим связку, которая представляет область отобра¬
жения и указывает на список дорожек, каждая из которых указывает на список
окошек, а те, в свою очередь, - на список произвольных подкадров. И список доро¬
жек, и список окошек замкнуты в кольцо, где дорожка-заполнитель (заполняющая
область отображения) и окошко-заполнитель (заполняющее дорожки) действуют
в качестве замков. Кроме того, каждая дорожка указывает на (возможно, пустой)
список низлежащих дорожек.
Технически тип дескриптора дорожки TrackDesc - это скрытое расширение
типа дескриптора окошка ViewerDesc. Повторяя объявления дескрипторов окошка
и кадра, мы приходим к такой иерархии типов:
Управление отображением
Рис. 4.9. Снимок внутренней структуры данных отображения,
соответствующей плану на рис. 4.4
TrackDesc = RECORD (ViewerDesc)
under: Display.Frame
END;
ViewerDesc = RECORD (FrameDesc)
75
76
Система отображения
state: INTEGER
END;
FrameDesc = RECORD
next, dsc: Frame;
X, Y, W, H: INTEGER;
handle: Handler
END;
Примечательно, что структура данных управления окошками разнородна с ти¬
пом Frame в качестве базового. Она дает хороший пример вложенной иерархии
кадров с дополнительным свойством, что первые два уровня соответствуют пер¬
вым двум уровням иерархии, определяемой типами Track, Viewer и Frame.
В принципе, объекты в объектно-ориентированной среде - это автономные
сущности. Однако они могут временно связываться с некоторым (помимо сис¬
темы) более высоким экземпляром. Например, мы можем считать объекты собст¬
венной структуры данных модуля связанными с этим модулем. В этом случае ре¬
шение о текущей связи объекта - это фундаментальная проблема. Для окошек
такая информация хранится в особой переменной экземпляра, называемой state
(состояние).
Для каждого окошка V в качестве системного инварианта имеем
V связано с модулем Viewers <=> V.state # О
Если мы называем видимым некоторое отображаемое окошко и приостанов¬
ленным некоторое окошко, которое накрыто перекрывающей его дорожкой, то мы
можем уточнить этот инвариант так:
{V - видимое <=> V.state > 0} и {V - приостановленное <=> V.state < 0}
Кроме того, более подробная информация о виде окошка V задается величи¬
ной |V.state|:
|V. state |
Вид окошка
0
Закрытое
1
Заполнитель
>1
Рабочее
Два побочных комментария:
□ Величина \V.state\ остается неизменной в модуле Viewers. Это может ис¬
пользоваться, например, для того чтобы отличить разные уровни важности
или предпочтений с целью поддержки более изящного алгоритма для эв¬
ристического размещения новых окошек.
□ Хотя для этого нет никаких языковых средств, state должна считаться пере¬
менной «только для чтения» любым модулем, кроме Viewers.
Управление отображением
77
Теперь мы готовы понять, как экспортируемые процедуры модуля Viewers ра¬
ботают «за кулисами». Все они влияют на только что рассмотренную внутреннюю
динамическую структуру данных. Некоторые процедуры используют ее только как
справочник или работают с отдельными элементами (This, Next, Locate, Change),
другие добавляют в нее новые элементы (InitTrack, OpenTrack, Open), а некоторые
даже удаляют элементы (CloseTrack, Close). Большинство процедур оказывают по¬
бочные эффекты на размер или состояние существующих элементов.
Давайте теперь сменим перспективу и взглянем на модуль Viewers как па об¬
щий низкоуровневый менеджер окошек, чье точное содержание неизвестно (и чьи
управляющие программы могут быть разработаны только годы спустя). Короче
говоря, давайте взглянем на модуль Viewer's как на менеджер «черных ящиков».
Такая абстракция тут же лишает возможности вызывать при реализации опреде¬
ленные процедуры, скажем, изменения размера или состояния окошка. Тут нужен
интерфейс, ориентированный на посылку сообщений.
Вклад модуля Viewers в такой интерфейс соответствует третьей категории со¬
общений, приведенных в табл. 4.1. Их общий тип таков:
ViewerMsg = RECORD (Display.FrameMsg)
id: INTEGER;
X, Y, W, H: INTEGER;
state: INTEGER
END;
Существуют три варианта этого типа, заданных полем id: восстановить содер¬
жимое, изменить высоту (продлить или сократить снизу) и приостановить (за¬
крыть временно или совсем). Дополнительные компоненты сообщения говорят
о желаемом новом положении, размере и состоянии.
В табл. 4.3 приводятся сообщения окошек, их отправители и получатели.
Таблица 4.3
Источник
Сообщение
Приемники
OpenTrack
Приостановить временно
Окошки, накрываемые открывающейся дорожкой
CloseTrack
Приостановить постоянно
Окошки на закрывающейся дорожке
Восстановить
Окошки, накрытые закрывающейся дорожкой
Open
Изменить или приостановить
постоянно
Верхний сосед открывающегося окошка
Change
Изменить
Верхний сосед изменяющегося окошка
Close
Приостановить постоянно
Закрывающееся окошко
4.4.2. Окошки меню
До сих пор мы рассматривали окошки абстрактно, как «черные ящики». Те¬
перь наш следующий шаг -сосредоточиться на особом классе окошек, называе¬
мых окошками меню. Вспоминая данное ранее определение, мы знаем, что окошко
меню характеризуется структурой, состоящей из двух вертикально разделенных
78
Система отображения
кадров-потомков - кадра меню сверху и кадра содержимого снизу. Поскольку ха¬
рактер и содержание этих кадров обычно не известны их родительскому окош¬
ку (или «предку»), снова вся надежда на интерфейс с коллекцией абстрактных
сообщений. В чистом виде обработка окошек меню сводится к комбинации под¬
готовки, преобразования и рассылки сообщений порожденным кадрам. В итоге
пространство отображения в Обероне строится иерархически, а передача сообще¬
ний внутри него подчиняется правилу строгого родительского управления.
Начнем наше более подробное обсуждение снова с определения модуля:
DEFINITION MenuViewers;
IMPORT Viewers, Display;
CONST extend = 0; reduce = 1; move = 2; (*id сообщений *)
TYPE
Viewer = POINTER TO ViewerDesc;
ViewerDesc = RECORD (Viewers.ViewerDesc)
menuH: INTEGER
END;
ModifyMsg = RECORD (Display.FrameMsg)
id: INTEGER;
dY, Y, H: INTEGER
END;
PROCEDURE Handle (V: Display.Frame; VAR M: Display.FrameMsg);
PROCEDURE New (Menu, Main: Display.Frame; menuH, X, Y: INTEGER): Viewer;
END MenuViewers.
Представленный этим определением интерфейс заметно скуп. Есть только две
процедуры: генератор New и стандартный обработчик сообщения Handle. Генера¬
тор возвращает во вновь созданное окошко меню из двух (произвольных) кадров,
передаваемых как параметры. Обработчик сообщения отвечает за все «поведение»
объекта и, в частности, за вышеупомянутый функционал получателя сообщениия.
Обработчики сообщений в Обероне реализуются в виде «процедурных пере¬
менных», которые, очевидно, должны инициализироваться нужным образом при
создании объекта. Иными словами, с каждым объектом должно явно связываться
некоторое конкретное поведение, причем разные экземпляры объекта одного типа
потенциально могут иметь разное поведение и/или один и тот же экземпляр мо¬
жет менять свое поведение в течение своей жизни. Поэтому в центре нашей объ¬
ектной модели стоит экземпляр.
Концептуально создание объекта - атомарное действие, состоящее из трех ос¬
новных шагов:
1) выделить блок памяти;
2) установить обработчик сообщений;
3) инициализировать переменные состояния.
Для стандартного окошка меню V это выглядит как
NEW(V); V.handle := Handle; V.dsc := Menu; V.dsc.next := Main; V.menuH := menuH
Здесь вызов New равносилен
создать V; открыть V в X, У
где открытие V нуждается в поддержке модуля Viewers.
Реализация процедуры Handle воплощает стандартную стратегию обработки
сообщения окошком меню. Грубо ее код выглядит следующим образом.
Обработчик сообщения для окошка меню
IF сообщение говорит о вмешательстве пользователя THEN
IF сдвинута мышь THEN
IF мышь находится в области меню THEN
IF мышь - в верхней области меню и нажата левая кнопка THEN
обработать изменение окошка
ELSE передать управление кадру меню
END
ELSE
IF мышь - в основном кадре THEN передать управление основному кадру FND
END
ELSIF ввод с клавиатуры THEN
передать управление кадру меню;
передать управление основному кадру
END
ELSIF сообщение определяет обобщенную операцию THEN
IF сообщение о копии (двойнике) THEN
послать сообщение о копировании в кадр меню, чтобы получить копию (двойника);
послать сообщение о копировании в основной кадр, чтобы получить копию (двойника);
создать из копии двойника окошка меню
ELSE
передать управление кадру меню;
передать управление основному кадру
END
ELSIF сообщение об изменении содержимого THEN
передать управление кадру меню;
передать управление основному кадру
ELSIF сообщение об изменении положения или размера THEN
IF операция - восстановить THEN
нарисовать область окошка и его границу;
послать сообщение об изменении (увеличении от высоты 0) кадра меню;
послать сообщение об изменении (увеличении от высоты 0) основного кадра
ELSIF операция - изменить THEN
Управление отображением
79
IF операция - увеличить THEN
увеличить область окошка и границу;
послать сообщение об изменении (увеличении) кадру меню;
послать сообщение об изменении (увеличении) основному кадру
ELSE (*уменьшить*)
послать сообщение об изменении (уменьшении) основному кадру;
послать сообщение об изменении (уменьшении) кадру меню;
уменьшить окошко и границу
END
ELSIF операция - приостановить THEN
послать сообщение об изменении (уменьшении до высоты 0) основному кадру;
послать сообщение об изменении (уменьшении до высоты 0) кадру меню;
END
END
В принципе, обработчик действует как диспетчер сообщений, который просто
обрабатывает сообщение и/или делегирует его обработку порожденным кадрам.
Отметим, что основной оператор ветвления обработчика осуществляет выбор
именно из четырех основных категорий сообщений из табл. 4.1.
Из вышеприведенного алгоритма обработки сообщений о копировании, то есть
запросов на генерацию копии или двойника окошка меню, мы можем вывести об¬
щую рекурсивную схему создания двойника любого кадра:
1) послать сообщение о копировании каждому элементу списка потомков;
2) сгенерировать копию дескриптора исходного кадра;
3) прикрепить копии потомков к копии дескриптора.
Основной момент здесь - это использование новых исходящих сообщений для
обработки заданного входящего сообщения. Можно считать обработку сообщения
преобразованием, которое отображает входящие сообщения в множество исходя¬
щих сообщений с возможными побочными эффектами. Простейший случай тако¬
го преобразования известен как делегирование. В этом случае входное сообщение
просто передается потомкам.
Поясним одну тонкость. Приведенный алгоритм разработан для создания глу¬
бокой копии составного объекта (в нашем случае - окошка меню). Если же нужна
мелкая копия, то потомки не должны копироваться, а вместо их копий к копии
составного объекта должны привязываться сами потомки.
Другой пример обработки сообщений - движение мыши. Предположим, что
окошко меню получает сообщение мыши, когда она находится в верхней части его
кадра, а левая ее кнопка нажата. Это значит «изменить высоту окошка, переместив
его верхнюю границу по вертикали». Никакого сообщения о требуемом преобра¬
зовании подкадров еще нет. Следовательно, модуль MenuViewers, используя пре¬
имущества нашей открытой модели сообщений, просто вводит соответствующий
тип сообщения с именем Modify Msg:
ModifyMsg = RECORD (Display.FrameMsg)
id: INTEGER;
80
Система отображения
dY, Y, H: INTEGER
END;
Поле id задает один из двух вариантов - увеличить или уменьшить. Первый
вариант сообщения заставляет принимающий его кадр сдвинуться по вертикали
на вектор переноса dY и затем увеличиться вниз до высоты Я. Второй вариант
заставляет кадр уменьшиться снизу до высоты Я и затем сдвинуться на dY. В обо¬
их случаях Yуказывает F-координату нового левого нижнего угла. Рисунок 4.10
иллюстрирует результат.
Рис. 4.10. Операция изменения кадра
Сообщения, поступающие от менеджера окошек и заставляющие принимаю¬
щее их окошко увеличиваться или уменьшаться снизу, точно так же отображают¬
ся в сообщения типа ModifyMsg. Конечно, в этих случаях никакого смещения не
требуется, и dY равен 0.
81
Управление отображением
82
Система отображения
Внимательный читатель, возможно, спросит, зачем вообще стандартный обра¬
ботчик экспортируется модулем MenuViewers. За этим замыслом - повторное ис¬
пользование кода. Например, обработчик сообщений для подкласса окошек меню
можно эффективно реализовать, используя повторно стандартный обработчик
окошек меню. Обработав сначала все новые или иные случаи, он затем просто вы¬
зывает стандартный обработчик.
4.4.3. Управление курсором
Обычно курсор показывает и визуализирует на экране текущее положение
символа вставки в тексте или, вообще, текущий фокус внимания. Для этого, как
правило, используются маленькая стрелка или похожий графический символ.
В Обероне мы слегка обобщили и расширили это понятие. Курсор - это путь в ло¬
гической области отображения, текущее положение которого можно сделать ви¬
димым с помощью маркера.
Менеджер окошек и обработчик курсора - два отдельных пользователя одной
области отображения. На самом деле мы должны вообразить две параллельные
плоскости: одну - для отображения окошек, другую - для отображения курсоров.
Если же существует только одна физическая плоскость, то нам надо позаботиться
о неразрушающем рисовании маркеров, например в инверсном видеорежиме. Тог¬
да перед прорисовкой маркера не должно быть никаких предварительных усло¬
вий. Однако, для задач, разрушающих картинку в области своего окошка, область
должна быть предварительно заблокирована после превращения в невидимые
всех маркеров этой области.
Техническая поддержка управления курсором также содержится в модуле
Oberon. Соответствующий интерфейс прикладного программирования таков:
DEFINITION Oberon;
TYPE
Marker = RECORD
Fade, Draw: PROCEDURE (x, y: INTEGER)
END;
Cursor = RECORD
marker: Marker; on: BOOLEAN; X, Y: INTEGER
END;
VAR Arrow, Star: Marker;
Mouse, Pointer: Cursor;
PROCEDURE OpenCursor (VAR c: Cursor);
PROCEDURE FadeCursor (VAR c: Cursor);
PROCEDURE DrawCursor (VAR c: Cursor; VAR m: Marker; X, Y: INTEGER);
PROCEDURE MarkedViewer (): Viewers.Viewer;
PROCEDURE RemoveMarks (X, Y, W, H: INTEGER);
END Oberon.
Управление отображением
83
Состояние курсора задается его режимом видимости on, его позицией (X, Y)
в области отображения и текущим маркером. Marker - абстрактный тин данных
с интерфейсом из двух операций Fade и Draw. Основная выгода, которую мы мо¬
жем извлечь из такой абстракции, - это снова концептуальная независимость
используемого оборудования. Например, Fade и Draw можно адаптировать к за¬
данным аппаратным средствам монитора со встроенной поддержкой курсора или,
в случае отсутствия такой поддержки, можно просто реализовать, как те же про¬
цедуры (вызовы), рисующие шаблон маркера в инверсном видеорежиме.
Функциональный интерфейс курсоров состоит из трех операций: OpenCur¬
sor - для открытия нового курсора, FadeCursor - для выключения маркера откры¬
того курсора и DrawCursor - для разметки пути курсора к новой точке заданным
маркером. Подчеркнем, что маркер, представляющий данный курсор, может ме¬
нять свою форму динамически, на лету.
Два курсора Mouse и Pointer предопределены. Они представляют мышь и инте¬
рактивно управляемый глобальный системный указатель соответственно. Обыч¬
но (но не обязательно) эти курсоры визуализируются встроенным маркером Arrow
(маленькая стрелка, указывающая на северо-запад) и Star (символ звездочки) со¬
ответственно. Pointer может использоваться для пометки любого отображаемого
объекта. Он играет прежде всего роль неявного параметра команд.
В связи с предопределенными курсорами добавлены две вспомогательные
служебные процедуры MarkedViewer и RemoveMarks. MarkedViewer возвращает
окошко, которое в настоящий момент помечено указателем. Возвращаемое ею зна¬
чение равносильно Viewers.This (Pointer.X, Pointer.Y). RemoveMarks делает невиди¬
мыми предопределенные курсоры в пределах данного прямоугольника в области
отображения. Эта процедура используется для блокировки прямоугольника для
вызывающей его программы.
Давайте подытожим основные моменты и характеристики концепции управ¬
ления курсором в Обероне.
1. На основании использования абстрактных маркеров и логической области
отображения любая аппаратная зависимость заключена в системных мо¬
дулях и потому скрыта от прикладного программиста. Курсоры двигают¬
ся единообразно в пределах всей области отображения, даже за пределами
экрана.
2. Обработка курсоров децентрализована за счет ее делегирования собствен¬
ным обработчикам, которые устанавливаются в окошках. Как правило,
обработчик реагирует на получение сообщения о движении мыши про¬
рисовкой курсора мыши в обозначенной новой позиции. Выгода от такой
самостоятельной обработки - гибкость. Например, умный локальный об¬
работчик мог бы выбирать вид маркера в зависимости от его конкретного
положения или мог бы превращать курсор в одну точку сетки экрана.
3. Даже при том, что обработка курсора децентрализована, существует
некоторая поддержка рисунка курсора, встроенная в объявление типа
Cursor. Курсоры - это полноправные объекты и как таковые могут «пом¬
нить» свое текущее состояние. Следовательно, интерфейсным операци-
84
Система отображения
ям FadeCursor и DrawCursor требуется только указание на желаемое бу¬
дущее состояние.
4. Если менеджер окошек - это один пользователь области отображения, то
обработчик курсора - другой пользователь того же ресурса. Если есть толь¬
ко одна физическая плоскость, реализующая область отображения, то лю¬
бой ее участок должен блокироваться текущим пользователем перед разру¬
шающим рисованием. Поэтому маркеры обычно рисуются неразрушающе
в инверсном видеорежиме.
Теперь давайте подытожим раздел в целом. Центральный ресурс, управляемый
подсистемой отображения, - это логическая область отображения, цель которой -
отвлечение от низлежащего аппаратного обеспечения отображения монитора. Об¬
ласть отображения прежде всего используется менеджером окошек для размеще¬
ния дорожек и окошек. Они образуют только первые два уровня потенциально
неограниченной вложенной иерархии кадров отображения. Например, стандарт¬
ные окошки меню содержат два зависимых кадра - кадр меню и основной кадр
содержания. Окошки менеджером окошек воспринимаются как «черные ящики»
и общаются с ним через сообщения. Окошки и, вообще, кадры используются как
элементы основанных на сообщениях интерфейсов, связывающих подсистему
отображения с другими подсистемами вроде планировщика и различных менед¬
жеров документов. Наконец, область отображения также обеспечивает основное
пространство для движения курсоров. В Обероне курсор - это помеченный путь.
Два стандартных курсора Mouse и Pointer предопределены.
4.5. Растровые операции
В разделе 4.4 мы ввели область отображения как абстрактное понятие, пред¬
ставленное двумерной декартовой плоскостью. Пока этой информации было до¬
статочно, потому что нас интересовала только ее общая структура, а ее содержа¬
ние полностью игнорировалось. Теперь, когда нас заинтересовало содержание, мы
должны раскрыть подробности модели.
Декартова плоскость, представляющая область отображения, дискретна. Бу¬
дем считать точки области отображения узлами сетки или элементами изобра¬
жения (пикселями) и предположим, что ее содержимое создается присваиванием
цветов пикселям. В настоящий момент число возможных цветов, которые может
иметь пиксель, не имеет значения. В простейшем случае двух цветов мы полагаем,
что один цвет - для фона, а другой - для переднего плана.
Простейшие операции наполнения содержанием дискретной плоскости - это
«установить цвет пикселя», или «установить пиксель» для краткости. Однако на
самом деле немногие алгоритмы строятся именно на таких атомарных операциях.
На практике гораздо важнее блочные операции, обычно называемые растровы¬
ми операциями. Под блоком мы подразумеваем прямоугольную область пикселей,
чьи границы параллельны осям системы координат.
Растровые операции основаны на общем принципе действия: блок шириной
SW и высотой SH исходных пикселей помещается в точку с координатами (DX,
DY) в области отображения. В простейшем случае блок (DX, DY, SW, SH) просто
накрывается исходным блоком. Вообще, новое значение пикселя блока-результа¬
та - это комбинация его старого значения и значения соответствующего исходно¬
го пикселя:
d : = f (s, d)
f иногда называется типом комбинации растровой операции.
В простейшем случае мы имеем следующие типы:
Тип
f
Заменить
S
Закрасить
sORd
Обратить
sXORd
Отметим, что «обратить» равносильно инверсному видеорежиму, когда s -
TRUE для всех пикселей.
Есть много различных вариантов растровых операций. Некоторые обращают¬
ся к исходному блоку в области отображения, другие задают постоянный шаблон,
который считается исходным блоком. Некоторые варианты требуют не просто по¬
местить, а размножить исходный блок внутри данного блока (DX, DY, DW, DH).
При проектировании растрового интерфейса проблема состояла в том, чтобы
найти общий, небольшой и полный набор растровых операций, который покрыва¬
ет все потребности, в частности потребность размещения знаков символов. В ре¬
зультате модуль Display экспортирует удивительно компактный набор растровых
операций:
DEFINITION Display;
CONST
black = 0; white = 15; (*цвета*)
replace = 0; paint = 1; invert = 2; (*типы операций*)
PROCEDURE CopyBlock (SX, SY, W, H, DX, DY, mode: INTEGER);
PROCEDURE CopyPattern (col: INTEGER; pat: Pattern; DX, DY, mode: INTEGER);
PROCEDURE Dot (col: INTEGER; DX, DY: LONGINT; mode: INTEGER);
PROCEDURE ReplPattern ( col: INTEGER; pat: Pattern; DX, DY, DW, DH, mode: INTEGER);
PROCEDURE ReplConst (col: INTEGER; DX, DY, DW, DH, mode: INTEGER);
END Display.
В списках параметров mode - это тип комбинации (replace, paint или invert).
CopyBlock копирует исходный блок (SX, SY, W, Н) в позицию (DX, DY) и исполь¬
зует mode для получения нового содержимого в блоке назначения (DX, DY, W, Н).
По умолчанию предполагается, что число цветов на пиксель в исходном блоке и в
Растровые операции
85
области назначения одинаково. Возможно, небезынтересно знать, что Copy Block -
это, по сути, та же известная BitBlt (передача блока битов) в проекте SmallTalk [4].
В Обероне CopyBlock используется прежде всего для прокрутки в пределах окош¬
ка его содержимого.
Остальные растровые операции используют постоянный шаблон. По идее, мы
должны считать тип Pattern указателем:
Pattern = POINTER ТО PatternDesc;
PatternDesc = RECORD
w, h: SHORTINT;
raster: ARRAY (w + 7) DIV 8 * h OF SYSTEM.BYTE
END;
w и h - ширина и высота блока, содержащего двоичный шаблон, определенный
растром. Данные шаблона задаются линейной последовательностью байтов, ко¬
торые заливаются в блок слева направо и снизу вверх.
В связи с этим объявлением есть две непонятные проблемы. Первая - в том,
что в Обероне не допускаются массивы переменной длины. Вторая касается эко¬
номии использования памяти. Если печатные шрифты - это огромные коллек¬
ции шаблонов символов, то было бы слишком расточительно выделять отдельную
запись для каждого отдельного шаблона. В главе 5 мы увидим, как упаковываются
последовательности шаблонов символов. В качестве выхода из положения мы ре¬
шили определить тип Pattern как LONGINT (как «адрес памяти») вместе с конст¬
руктором шаблона
PROCEDURE SetPattern (
VAR image: ARRAY OF SYSTEM.BYTE; W, H: INTEGER; VAR pat: Pattern);
Некоторые стандартные шаблоны предопределены в модуле Display и экспор¬
тируются как глобальные переменные типа Pattern. Среди них шаблоны Arrow,
Star и Cross для представления маркеров, символа вставки и стрелки вниз. Вто¬
рая группа предопределенных шаблонов поддерживает рисования графики. Она
включает несколько шаблонов серых оттенков и шаблон сетки.
Параметр со/ в шаблонных растровых операциях задает основной цвет шабло¬
на. Цвета black и white - предопределенные. Процедура Copy Pattern копирует цве¬
товой шаблон в позицию (DX, DY) в области отображения, используя заданный
тип комбинирования. Видимо, это наиболее часто используемая из всех операций,
потому что она нужна для отображения текста. Процедура ReplPattem размножа¬
ет заданный шаблон внутри данного блока назначения. Она начинает с нижнего
левого угла и идет слева направо и снизу вверх. Рисунок 4.11 иллюстрирует эту
операцию. Процедуры Dot и ReplConst - особые случаи CopyPattem и ReplPattem,
соответственно, неявно использующие шаблон из одного основного пикселя.
Dot - это в точности упомянутый нами ранее «set pixel». ReplConst используется
для рисования горизонтальных и вертикальных линий, а также прямоугольников.
86
Система отображения
Рис. 4.11. Операция размножения шаблона
Но растровые операции, в конечном счете, воздействуют на конкретные раст¬
ровые матрицы, отражающие содержимое конкретных экранов мониторов. В нашей
первоначальной реализации они программировались ради эффективности в коде
ассемблера. Мы решили включить необходимую их поддержку именно сюда. По
этой причине мы возложили на модуль Display еще две обязанности: (а) отображе¬
ние экрана монитора на область отображения и (б) функцию драйвера устройства.
Вот соответствующая часть определения модуля Display:
DEFINITION Display;
VAR (*отображение*)
Unit: LONGINT;
Width, Height: INTEGER;
Bottom, UBottom: INTEGER;
Left, ColLeft: INTEGER;
PROCEDURE Map (X: INTEGER): LONGINT;
(*драйвер устройства *)
PROCEDURE SetMode (X: INTEGER; s: SET);
(♦цветовая таблица *)
PROCEDURE SetColor (col, red, green, blue: INTEGER);
PROCEDURE GetColor (col: INTEGER; VAR red, green, blue: INTEGER);
(♦аппаратный курсор *)
PROCEDURE SetCursor (mode: SET);
PROCEDURE DrawCX (X, Y: INTEGER);
PROCEDURE FadeCX (X, Y: INTEGER);
END Display.'
Растровые операции
87
88
Система отображения
Это определение (и более того, его реализация) обеспечивает поддержку толь¬
ко ограниченного класса возможных конфигураций. Теоретически возможно лю¬
бое количество экранов мониторов. Однако они должны отображаться в регуляр¬
ный горизонтальный массив предопределенных блоков в области отображения.
Каждый блок разбит вертикально на две конгруэнтные области, где предполагает¬
ся, что соответствующий монитор в состоянии выбрать и отобразить лишь одну из
этих двух областей. Наконец, предполагается, что все блоки черно-белых монито¬
ров располагаются левее всех блоков цветных мониторов. Рисунок 4.12 дает ясное
представление о такой конфигурации.
Рис. 4.12. Стандартная регулярная блочная структура области дисплея
При таких ограничениях любая конкретная конфигурация может быть пара¬
метризована переменными из вышеприведенного определения. Unit, Width и
Height задают размеры отображаемой области, где Width и Height - ширина и вы¬
сота в пикселях, a Unit - размер пикселя в единицах 1/36000 мм. 1/36000 мм - об¬
щий делитель всех стандартных единиц измерения, используемых наборщиками,
таких как миллиметр, дюйм, пика и размер точки обычных устройств печати. Bot¬
tom и Ubottom задают нижнюю ^/-координату первичной и вторичной областей со¬
ответственно. Наконец, Left и ColLeft задают левую х-координату области черно¬
белых и цветных мониторов соответственно.
Закончим эти объяснения кратким функциональным описанием процедур из
приведенного выше определения. Процедура Мар по заданной х-координате воз¬
вращает начальный адрес (первичного) растрового изображения, соответствую¬
щего монитору дисплея в этой позиции. Эта процедура позволяет клиенту преоб¬
разовать любую заданную пару (X, Y) координат в адрес памяти и таким образом
реализовать свои растровые операции. Остальные процедуры относятся к драй¬
веру. Очевидно, они привязаны к определенным конкретным типам мониторов.
Процедура SetMode устанавливает режим монитора в позиции X. Как пра¬
вило, режим выбирается между нормальным, инверсным и погашенным. Кроме
того, она задает отображаемую область (первичную или вторичную). Процедуры
SetColor и GetColor обслуживают (общую) цветовую таблицу цветных экранов.
Эта таблица отображает номера цветов в цвета, составленные из основных элемен¬
тов red, green и blue. Остальные процедуры поддерживают аппаратное управление
курсором. SetCursor выбирает из двух возможных классов курсора - перекрестие
или шаблон. Наконец, процедуры DrawCX и FadeCX рисуют и стирают выбран¬
ный курсор в заданной позиции.
4.6. Стандартные конфигурации
отображения
Теперь давайте снова поднимем нашу прежнюю тему конфигурирования облас¬
ти отображения. Мы видели, что ни одна конкретная планировка области отобра¬
жения не влияет на общее управление окошками. Однако модуль Oberon обеспе¬
чивает поддержку некоторого привычного для Оберона стандарта отображения.
Согласно этому модулю, стандартная конфигурация состоит из одного или не¬
скольких горизонтально смежных дисплеев, где дисплей - это пара, состоящая из
двух дорожек равной высоты - пользовательской слева и системной справа. Рису¬
нок 4.13 показывает стандартную конфигурацию из двух дисплеев одинакового
размера, одного черно-белого и одного цветного. Отметим, что если о каком-то
физическом мониторе даже нет речи, то на самом деле дисплей обычно соотно¬
сится с монитором.
Рис. 4.13. Стандартная конфигурация Оберона
из двух логически смежных дисплеев одинакового размера и структуры
Стандартные конфигурации отображения
89
Вот соответствующий фрагмент определения:
DEFINITION Oberon;
PROCEDURE OpenDisplay (UW, SW, H: INTEGER);
PROCEDURE OpenTrack (X, W: INTEGER);
PROCEDURE DisplayWidth (X: INTEGER): INTEGER;
PROCEDURE DisplayHeight (X: INTEGER): INTEGER;
PROCEDURE UserTrack (X: INTEGER): INTEGER;
PROCEDURE SystemTrack (X: INTEGER): INTEGER;
PROCEDURE AllocateUserViewer (DX: INTEGER; VAR X, Y: INTEGER);
PROCEDURE AllocateSystemViewer (DX: INTEGER; VAR X, Y: INTEGER);
END Oberon.
Процедура OpenDisplay инициализирует и открывает новый дисплей раз¬
мером Я (высота), UW (ширина пользовательской дорожки) и SW (ширина си¬
стемной дорожки). Процедура OpenTrack накрывает ряд существующих дорожек
в сегменте [X, X + W) новой дорожкой. Обе процедуры принимают на себя бремя
создания окошка-заполнителя.
Следующая группа процедур DisplayWidth, DisplayHeight, UserTrack и System¬
Track возвращает ширину или высоту соответствующего структурного объекта,
расположенного в позиции X области отображения.
Процедуры AllocateUserViewer и AllocateSystemViewer выдают предложения
о положении нового окошка в желаемой дорожке дисплея, расположенной в DX.
В первую очередь это положение определяется системным указателем, который
может быть задан вручную. Если указатель не задан, положение рассчитывается
на основании некоторых эвристик, стратегия которых основывается на различных
способах разбиения на части, которые применяются соответственно к пользова¬
тельской дорожке и к системной дорожке с целью создания эстетически приемле¬
мых планировок экрана.
Кроме программного интерфейса модуля Oberon для стандартной планировки
экрана раздел управления отображением в наборе инструментов модуля System
обеспечивает пользовательский интерфейс:
DEFINITION System;
(«Управление дисплеем *)
PROCEDURE Open; («открыть окошко*)
PROCEDURE OpenLog; («открыть окошко журнала*)
PROCEDURE Close; (*закрыть окошко *)
PROCEDURE CloseTrack;
PROCEDURE Recall; («восстановить последнее закрытое окошко*)
PROCEDURE Сору; («копировать окошко *)
90
Система отображения
Полная реализация
PROCEDURE Grow; («увеличить окошко *)
END System.
В свою очередь, эти команды вызываются для открытия текстового окошка
в системной дорожке, открытия окошка системного журнала, закрытия окошка,
закрытия дорожки, восстановления (и повторного открытия) последнего закрыто¬
го окошка, копирования окошка и увеличения окошка. Команды Close, CloseTrack,
Recall, Сору и Grow - обобщенные. Close, Copy и Grow обычно включаются в об¬
ласть заголовка окошка меню. Их подробная реализация приведена далее.
Литература
1. С. Binding, User Interface Components based on a Multiple Window Package,
University of Washington, Seattle, Technical Report 85-08-07.
2. E. S. Cohen, E. T. Smith, L. A. Iverson, Constraint-Based Tiled Windows, IEEE,
1985.
3. M. Wille, Overview: Entwurf und Realisierung eines Fenstersystems f...r Ar-
beitsplatzrechner, Diss. ETH Nr. 8771,1988.
4. A. Goldberg, Smalltalk-80: The Interactive Programming Environment, Addi¬
son-Wesley 1984.
5. W. Teitelman, «А tour through Cedar», IEEE Software, 1, (2), 44-73 (1984).
Полная реализация
MODULE Viewers; (*JG 14.9.90*)
IMPORT Display;
CONST
restore* = 0; modify* = 1; suspend* = 2; (*id сообщений*)
inf = MAX(INTEGER);
TYPE
Viewer* = POINTER TO ViewerDesc;
ViewerDesc* = RECORD (Display.FrameDesc)
state*: INTEGER
END;
(♦state > 1: отображено
state = 1: наполнено
state = 0: закрыто
state < 0: приостановлено*)
ViewerMsg* = RECORD (Display.FrameMsg)
И1
92
Система отображения
id*: INTEGER;
X*, Y*, W*, H*: INTEGER;
state*: INTEGER
END;
Track = POINTER TO TrackDesc;
TrackDesc = RECORD (ViewerDesc)
under: Display.Frame
END;
VAR
curW*, minH*, DW, DH: INTEGER;
FillerTrack: Track; FillerViewer, buf: Viewer; (*для закрытых окошек*)
PROCEDURE Open* (V: Viewer; X, Y: INTEGER);
VAR T, u, v: Display.Frame; M: ViewerMsg;
BEGIN
IF (V.state = 0) & (X < inf) THEN
IF Y > DH THEN Y := DH END;
T := FillerTrack.next;
WHILE X >= T.X + T.W DO T := T.next END;
u := T.dsc; v := u.next;
WHILE Y > v.Y + v. H DO u : = v; v : = u.next END;
IF Y < v.Y + minH THEN Y := v.Y + minH END;
IF (v.next.Y # 0) & (Y > v.Y + v.H - minH) THEN
WITH v: Viewer DO
V.X := T.X; V.W := T.W; V.Y := v.Y; V.H := v.H;
M.id := suspend; M.state := 0;
v.handle(v, M); v.state := 0; buf := v;
V.next := v.next; u.next := V;
V. state := 2
END
ELSE
V.X := T.X; V.W := T.W; V.Y := v.Y; V.H := Y - v.Y;
M.id := modify; M.Y
v.handle(v, M); v.Y
V.next := v; u.next
V.state := 2
= Y; M.H := v.Y + v.H - Y;
= M.Y; v.H := M.H;
= V;
END
END
END Open;
PROCEDURE Change* (V: Viewer; Y: INTEGER);
VAR v: Display.Frame; M: ViewerMsg;
BEGIN
IF V.state > 1 THEN
IF Y > DH THEN Y := DH END;
v : = V.next;
Полная реализация
IF (v.next.Y # 0) & (Y > v.Y + v.H - minH) THEN
Y := v.Y + v.H - minH
END;
IF Y >= V.Y + minH THEN
M.id := modify; M.Y : = Y; M.H := v.Y + v.H - Y;
v.handle(v, M); v.Y := M.Y; v.H := M.H;
V.H := Y - V.Y
END
END
END Change;
PROCEDURE RestoreTrack (S: Display.Frame);
VAR T, t, v: Display.Frame; M: ViewerMsg;
BEGIN
WITH S: Track DO
t := S.next;
WHILE t.next.X # S.X DO t := t.next END;
T := S.under;
WHILE T.next # NIL DO T := T.next END;
t.next := S.under; T.next := S.next;
M.id := restore;
REPEAT t := t.next;
v := t.dsc;
REPEAT v := v.next; v.handle(v, M);
WITH v: Viewer DO v.state := - v.state END
UNTIL v = t.dsc
UNTIL t = T
END
END RestoreTrack;
PROCEDURE Close* (V: Viewer);
VAR T, U: Display.Frame; M: ViewerMsg;
BEGIN
IF V.state > 1 THEN
U := V.next; T := FillerTrack;
REPEAT T := T.next UNTIL V.X < T.X + T.W;
IF (T(Track).under = NIL) OR (U.next # V) THEN
M.id := suspend; M.state := 0;
V.handle(V, M); V.state := 0; buf := V;
M.id := modify; M.Y := V.Y; M.H := V.H + U.H;
U.handle(U, M); U.Y := M.Y; U.H := M.H;
WHILE U.next # V DO U := U.next END;
U.next := V.next
ELSE (*close track*)
M.id := suspend; M.state := 0;
V.handle(V, M); V.state := 0; buf := V;
U.handle(U, M); U(Viewer).state := 0;
Resto'reTrack(T)
END
93
END
END Close;
PROCEDURE Recall* ( VAR V: Viewer);
BEGIN V := buf
END Recall;
PROCEDURE This* (X, Y: INTEGER): Viewer;
VAR T, V: Display.Frame;
BEGIN
IF (X < inf) & (Y < DH) THEN
T := FillerTrack;
REPEAT T := T.next UNTIL X < T.X + T.W;
V := T.dsc;
REPEAT V := V.next UNTIL Y < V.Y + V.H;
RETURN V(Viewer)
ELSE RETURN NIL
END
END This;
PROCEDURE Next* (V: Viewer): Viewer;
BEGIN RETURN V.next(Viewer)
END Next;
PROCEDURE Locate* (X, H: INTEGER; VAR fil, bot, alt, max: Display.Frame);
VAR T, V: Display.Frame;
BEGIN
IF X < inf THEN
T := FillerTrack;
REPEAT T := T.next UNTIL X < T.X + T.W;
fil := T.dsc; bot := fil.next;
IF bot.next # fil THEN
alt := bot.next; V := alt.next;
WHILE (V # fil) & (alt.H < H) DO
IF V.H > alt. H THEN alt : = V END; V := V.next
END
ELSE alt := bot
END;
max := T.dsc; V := max.next;
WHILE V # fil DO
IF V.H > max.H THEN max := V END; V := V.next
END
END
END Locate;
PROCEDURE InitTrack* (W, H: INTEGER; Filler: Viewer);
VAR S: Display.Frame; T: Track;
BEGIN
IF Filler.state = 0 THEN
94
Система отображения
Полная реализация
Filler.X := curW; Filler.W := W; Filler.Y := 0; Filler.H := H;
Filler.state := 1;
Filler.next := Filler;
NEW(T);
T.X := curW; T.W := W; T.Y := 0; T.H := H;
T.dsc := Filler; T.under := NIL;
FillerViewer.X := curW + W; FillerViewer.W := inf - FillerViewer.X;
FillerTrack.X := FillerViewer.X; FillerTrack.W := FillerViewer.W;
S := FillerTrack;
WHILE S.next # FillerTrack DO S := S.next END;
S.next := T; T.next := FillerTrack;
curW := curW + W
END
END InitTrack;
PROCEDURE OpenTrack* (X, W: INTEGER; Filler: Viewer);
VAR newT: Track; S, T, t, v: Display.Frame; M: ViewerMsg;
BEGIN
IF (X < inf) & (Filler.state = 0) THEN
S := FillerTrack; T := S.next;
WHILE X >= T.X + T.W DO S := T; T := S.next END;
WHILE X + W > T.X + T.W DO T := T.next END;
M.id := suspend;
t := S;
REPEAT t := t.next; v := t.dsc;
REPEAT v := v.next;
WITH v: Viewer DO
M.state := -v.state; v.handle(v, M); v.state := M.state
END
UNTIL v = t.dsc
UNTIL t = T;
Filler.X := S.next.X; Filler.W := T.X + T.W - S.next.X; Filler.Y := 0;
Filler.H := DH;
Filler.state := 1;
Filler.next := Filler;
NEW(newT);
newT.X := Filler.X; newT.W := Filler.W; newT.Y := 0; newT.H := DH;
newT.dsc := Filler; newT.under := S.next; S.next := newT;
newT.next := T.next; T.next := NIL
END
END OpenTrack;
PROCEDURE CloseTrack* (X: INTEGER);
VAR T, V: Display.Frame; M: ViewerMsg;
BEGIN
IF X < inf THEN
T := FillerTrack;
REPEAT T := T.next UNTIL X < T.X + T.W;
IF T(Track).under # NIL THEN
95
96
Система отображения
М.id := suspend; М.state := 0; V := T.dsc;
REPEAT V := V.next; V.handle(V, M); V(Viewer).state := 0 UNTIL V = T.dsc;
RestoreT rack(T)
END
END
END CloseTrack;
PROCEDURE Broadcast* (VAR M: Display.FrameMsg);
VAR T, V: Display.Frame;
BEGIN
T := FillerTrack.next;
WHILE T # FillerTrack DO
V := T.dsc;
REPEAT V := V.next; V.handle(V, M) UNTIL V = T.dsc;
T : = T.next
END
END Broadcast;
BEGIN but := NIL;
NEW(FillerViewer);
FillerViewer.X := 0; FillerViewer.W := inf; FillerViewer.Y := 0;
FillerViewer.H := DH;
FillerViewer.next := FillerViewer;
NEW(FillerTrack);
FillerTrack.X := 0; FillerTrack.W := inf; FillerTrack.Y := 0; FillerTrack.H := DH;
FillerTrack.dsc := FillerViewer;
FillerTrack.next ;= FillerTrack;
curW := 0; minH := 1;
DW := Display.Width; DH := Display.Height
END Viewers.
MODULE MenuViewers; (*JG 26.8.90*)
IMPORT Input, Display, Texts, Viewers, Oberon;
CONST extend* = 0; reduce* = 1;
TYPE
Viewer* = POINTER TO ViewerDesc;
ViewerDesc* = RECORD (Viewers.ViewerDesc)
menuH*: INTEGER
END;
ModifyMsg* = RECORD (Display.FrameMsg)
id*: INTEGER;
dY*, Y*, H*: INTEGER
END;
PROCEDURE Copy (V: Viewer; VAR V1: Viewer);
VAR Menu, Main: Display.Frame; M: Oberon.CopyMsg;
BEGIN
Menu := V.dsc; Main := V.dsc.next;
NEW(V1); Vr := V~; V1.state := 0;
Menu.handle(Menu, M); Vl.dsc := M.F;
Main.handle(Main, M); Vl.dsc.next :=M.F
END Copy;
PROCEDURE Draw (V: Viewers.Viewer);
BEGIN
Display.ReplConst(Display.white, V.X, V.Y, 1, V.H, 0);
Display.ReplConst(Display.white, V.X + V.W - 1, V.Y, 1, V.H, 0);
Display.ReplConst(Display.white, V.X + 1, V.Y, V.W - 2, 1, 0);
Display.ReplConst(Display.white, V.X + 1, V.Y + V.H - 1, V.W - 2, 1, 0)
END Draw;
PROCEDURE Extend (V: Viewer; newY: INTEGER);
VAR dH: INTEGER;
BEGIN dH := V.Y - newY;
IF dH > 0 THEN
Display.ReplConst(Display.black, V.X + 1, newY + 1, V.W - 2, dH, 0);
Display.ReplConst(Display.white, V.X, newY, 1, dH, 0);
Display.ReplConst(Display.white, V.X + V.W - 1, newY, 1, dH, 0);
Display.ReplConst(Display.white, V.X + 1, newY, V.W - 2, 1, 0)
END
END Extend;
PROCEDURE Reduce (V: Viewer; newY: INTEGER);
BEGIN Display.ReplConst(Display.white, V.X + 1, newY, V.W - 2, 1, 0)
END Reduce;
PROCEDURE Grow (V: Viewer; oldH: INTEGER);
VAR dH: INTEGER;
BEGIN dH := V.H - oldH;
IF dH > 0 THEN
Display.ReplConst(Display.white, V.X, V.Y + oldH, 1, dH, 0);
Display.ReplConst(Display.white, V.X + V.W - 1, V.Y + oldH, 1, dH, 0);
Display.ReplConst(Display.white, V.X + 1, V.Y + V.H - 1, V.W - 2, 1, 0)
END
END Grow;
PROCEDURE Shrink (V: Viewer; newH: INTEGER);
BEGIN Display.ReplConst(Display.white, V.X + 1, V.Y + newH - 1, V.W - 2, 1, 0)
END Shrink;
PROCEDURE Adjust (F: Display.Frame; id, dY, Y, H: INTEGER);
VAR M: ModifyMsg;
BEGIN M.id := id; M.dY := dY; M.Y := Y; M.H := H; F.handle(F, M); F.Y := Y; F.H := H
END Adjust;
PROCEDURE Restore (V: Viewer);
Полная реализация
97
98
Система отображения
VAR Menu, Main: Display.Frame;
BEGIN
Menu := V.dsc; Main := V.dsc.next;
Oberon.RemoveMarks(V.X, V.Y, V.W, V.H);
Draw(V);
Menu.X := V.X + 1; Menu.Y := V.Y + V.H - 1; Menu.W := V.W - 2; Menu.H := 0;
Main.X := V.X + 1; Main.Y := V.Y + V.H - V.menuH; Main.W := V.W - 2; Main.H := 0;
IF V.H > V.menuH + 1 THEN
Adjust(Menu, extend, 0, V.Y + V.H - V.menuH, V.menuH - 1);
Adjust( Main, extend, 0, V.Y + 1, V.H - V.menuH - 1)
ELSE Adjust(Menu, extend, 0, V.Y +1, V.H - 2)
END
END Restore;
PROCEDURE Change (V: Viewer; X, Y: INTEGER; Keys: SET);
VAR Menu, Main: Display.Frame;
V1: Viewers.Viewer; keysum: SET; YO, dY, H: INTEGER;
BEGIN (*Keys ft {}*)
Menu := V.dsc; Main := V.dsc.next;
Oberon.DrawCursor(Oberon.Mouse, Oberon.Arrow, X, Y);
Display.ReplConst(Display.white, V.X + 1, V.Y + V.H - 1 - V.dsc.H, V.W - 2,
V.dsc.H, 2);
YO := Y;
keysum := Keys;
PROCEDURE Modify (V: Viewer; Y, H: INTEGER);
VAR Menu, Main: Display.Frame;
BEGIN
Menu := V.dsc; Main := V.dsc.next;
IF Y < V.Y THEN (‘расширять*)
Oberon.RemoveMarks(V.X, Y, V.W, V.Y - Y);
Extend(V, Y);
IF H > V.menuH + 1 THEN
Adjust(Menu, extend, 0, Y + H - V.menuH, V.menuH - 1);
Adjust(Main, extend, 0, Y + 1, H - V.menuH - 1)
ELSE Adjust(Menu, extend, 0, Y + 1, H - 2)
END
ELSIF Y > V.Y THEN (*уменьшать*)
Oberon.RemoveMarks(V.X, V.Y, V.W, V.H);
IF H > V.menuH + 1 THEN
Adjust(Main, reduce, 0, Y + 1, H - V.menuH - 1);
Adjust(Menu, reduce, 0, Y + H - V.menuH, V.menuH - 1)
ELSE
Adjust(Main, reduce, 0, Y + H - V.menuH, 0);
Adjust(Menu, reduce, 0, Y + 1, H - 2)
END;
Reduce(V, Y)
END
END Modify;
Полная реализация
99
LOOP
Input.Mouse(Keys, X, Y);
IF Keys = {} THEN EXIT END;
keysum := keysum + Keys;
Oberon.DrawCursor(Oberon.Mouse, Oberon.Arrow, X, Y)
END;
Display.ReplConst(Display.white, V.X + 1, V.Y + V.H - 1 - V.dsc.H, V.W - 2,
V.dsc.H, 2);
IF "(0 IN keysum) THEN
IF 1 IN keysum THEN V1 ;= Viewers.This(X, Y);
IF Y < V1.Y + V.menuH + 2 THEN Y := V1.Y + V.menuH + 2 END;
Viewers.Close(V); Viewers.0pen(V, X, Y); Restore(V)
ELSE
IF Y > YO THEN (*extend*) dY := Y - YO;
V1 := Viewers.Next(V);
IF V1.state > 1 THEN
IF (V1 IS Viewer) & (V1.H >= V1(Viewer).menuH + 2) THEN
IF dY > V1.H - V1(Viewer).menuH - 2 THEN dY :=
V1.H - V1(Viewer).menuH - 2 END
ELSIF dY > V1.H - Viewers.minH THEN dY :=
V1.H - Viewers.minH
END
ELSIF dY > V1.H THEN dY := V1.H
END;
Viewers.Change(V, V.Y + V.H + dY);
Oberon.RemoveMarks(V.X, V.Y, V.W, V.H);
Grow(V, V.H - dY);
IF V.H > V.menuH + 1 THEN
Adjust(Menu, extend, dY, V.Y + V.H - V.menuH, V.menuH - 1);
Adjust(Main, extend, dY, V.Y + 1, V.H - V.menuH - 1)
ELSE Adjust(Menu, extend, dY, V.Y + 1, V.H - 2)
END
ELSIF Y < YO THEN (*reduce*) dY := YO - Y;
IF dY > V.H - V(Viewer).menuH - 2 THEN dY := V.H - V(Viewer).
menuH - 2 END;
Oberon.RemoveMarks(V.X, V.Y, V.W, V.H);
H := V.H - dY;
IF H > V.menuH + 1 THEN
Adjust(Main, reduce, dY, V.Y + 1, H - V.menuH - 1);
Adjust(Menu, reduce, dY, V.Y + H - V.menuH, V.menuH - 1)
ELSE
Adjust(Main, reduce, dY, V.Y + H - V.menuH, 0);
Adjust(Menu, reduce, dY, V.Y +1, H - 2)
END;
Shrink(V, H);
Viewers.Change(V, V.Y + H)
END
END
END
100
Система отображения
END Change;
PROCEDURE Suspend (V: Viewer);
VAR Menu, Main: Display.Frame;
BEGIN
Menu := V.dsc; Main := V.dsc.next;
Adjust(Main, reduce, 0, V.Y + V.H - V.menuH, 0);
Adjust(Menu, reduce, 0, V.Y + V.H - 1, 0)
END Suspend;
PROCEDURE Handle* (V: Display.Frame; VAR M: Display.FrameMsg);
VAR Menu, Main: Display.Frame; V1: Viewer;
BEGIN
WITH V: Viewer DO
Menu := V.dsc; Main := V.dsc.next;
IF M IS Oberon.InputMsg THEN
WITH M: Oberon.InputMsg DO
IF M.id = Oberon.track THEN
IF M.Y < V.Y + 1 THEN Oberon.DrawCursor(Oberon.Mouse,
Oberon.Arrow, M.X, M.Y)
ELSIF M.Y < V.Y + V.H - V.menuH THEN Main.handle(Main, M)
ELSIF M.Y < V.Y + V.H - V.menuH + 2 THEN Menu.handle(Menu, M)
ELSIF M.Y < V.Y + V.H - 1 THEN
IF 2 IN M.keys THEN Change(V, M.X, M.Y, M.keys)
ELSE Menu.handle(Menu, M)
END
ELSE Oberon.DrawCursor(Oberon.Mouse, Oberon.Arrow, M.X, M.Y)
END
ELSE Menu.handle(Menu, M); Main.handle(Main, M)
END
END
ELSIF M IS Oberon.ControlMsg THEN
WITH M: Oberon.ControlMsg DO
IF M.id = Oberon.mark THEN
Oberon.DrawCursor(Oberon.Mouse, Oberon.Arrow, M.X, M.Y);
Oberon.DrawCursor(Oberon.Pointer, Oberon.Star, M.X, M.Y)
ELSE Menu.handle(Menu, M); Main.handle(Main, M)
END
END
ELSIF M IS Oberon.CopyMsg THEN
WITH M: Oberon.CopyMsg DO Copy(V(Viewer), VI); M.F := V1 END
ELSIF M IS Viewers.ViewerMsg THEN
WITH M: Viewers.ViewerMsg DO
IF M.id = Viewers.restore THEN Restore(V)
ELSIF M.id = Viewers.modify THEN Modify(V, M.Y, M.H)
ELSIF M.id = Viewers.suspend THEN Suspend(V)
END
END
ELSE Menu.handle(Menu, M); Main.handle(Main, M)
Полная реализация
END
END
END Handle;
PROCEDURE New* (Menu, Main: Display.Frame; menuH, X, Y: INTEGER): Viewer;
VAR V: Viewer;
BEGIN NEW(V);
V.handle := Handle; V.dsc := Menu; V.dsc.next := Main; V.menuH := menuH;
Viewers.Open(V, X, Y); Restore(V);
RETURN V
END New;
END MenuViewers.
MODULE System; (*JG 3.10.90*)
IMPORT Viewers, MenuViewers, Oberon, Texts, TextFrames;
CONST
StandardMenu = "System.Close System.Copy System.Grow Edit.Search Edit.Store";
LogMenu = "System.Close System.Grow Edit.Locate Edit.Store";
VAR W: Texts.Writer;
PROCEDURE Max (i, j: LONGINT): LONGINT;
BEGIN IF i >= j THEN RETURN i ELSE RETURN j END
END Max;
(* набор инструментов для стандартного отображения *)
PROCEDURE Open*;
VAR par: Oberon.ParList;
V: Viewers.Viewer;
T: Texts.Text; S: Texts.Scanner;
X, Y: INTEGER;
beg, end, time: LONGINT;
BEGIN
par := Oberon.Par;
Texts.OpenScanner(S, par.text, par.pos); Texts.Scan(S);
IF (S.class = Texts.Char) & (S.с = """) OR (S.line # 0) THEN
Oberon.GetSelection(T, beg, end, time);
IF time >= 0 THEN Texts.OpenScanner(S, T, beg); Texts.Scan(S) END
END;
IF S.class = Texts.Name THEN
Oberon.AllocateSystemViewer(par.vwr.X, X, Y);
V := MenuViewers.New(
TextFrames.NewMenu(S.s, StandardMenu),
TextFrames. NewText(Text Frames. Text (S. s), 0),
TextFrames.menuH,
101
102
Система отображения
X, Y)
END
END Open;
PROCEDURE OpenLog*;
VAR V: Viewers.Viewer; X, Y: INTEGER;
BEGIN
Oberon.AllocateSystemViewer(Oberon.Par.vwr.X, X, Y);
V := MenuViewers.New(
TextFrames.NewMenu("System. Log", LogMenu),
TextFrames.NewText(Oberon.Log, Max(0, Oberon.Log.len - 200)),
TextFrames.menuH,
X, Y)
END OpenLog;
PROCEDURE Close*;
VAR par: Oberon.ParList; V: Viewers.Viewer;
BEGIN par := Oberon.Par;
IF par.frame = par.vwr.dsc THEN V := par.vwr
ELSE V := Oberon.MarkedViewer()
END;
Viewers.Close(V)
END Close;
PROCEDURE CloseTrack*;
VAR V: Viewers.Viewer;
BEGIN V := Oberon.MarkedViewer(); Viewers.CloseTrack(V.X)
END CloseTrack;
PROCEDURE Recall*;
VAR V: Viewers.Viewer; M: Viewers.ViewerMsg;
BEGIN
Viewers.Recall(V);
IF V.state = 0 THEN
Viewers.Open(V, V.X, V.Y + V.H); M.id := Viewers.restore; V.handle(V, M)
END
END Recall;
PROCEDURE Copy*;
VAR V, V1: Viewers.Viewer; M: Oberon.CopyMsg; N: Viewers.ViewerMsg;
BEGIN
V := Oberon.Par.vwr; V.handle(V, M); V1 := M.F(Viewers.Viewer);
Viewers.0pen(V1, V.X, V.Y + V.H DIV 2);
N.id := Viewers.restore; V1. handle(V1, N)
END Copy;
PROCEDURE Grow*;
VAR V, V1: Viewers.Viewer; M: Oberon.CopyMsg; N: Viewers.ViewerMsg;
DW, DH: INTEGER;
Полная реализация
103
BEGIN V := Oberon.Par.vwr;
DW := Oberon.DisplayWidth(V.X); DH := Oberon.DisplayHeight(V.X);
IF V.H < DH - Viewers.minH THEN Oberon.OpenTrack(V.X, V.W)
ELSIF V.W < DW THEN Oberon.OpenTrack(Oberon.UserTrack(V.X), DW)
END;
IF (V.H < DH - Viewers.minH) OR (V.W < DW) THEN
V.handle(V, M); V1 := M.F(Viewers.Viewer);
Viewers.Open(V1, V.X, DH);
N.id := Viewers.restore; V1.handle(V1, N)
END
END Grow;
PROCEDURE OpenViewers;
VAR V: Viewers.Viewer; t, d: LONGINT; X, Y: INTEGER;
BEGIN
Oberon.GetClock(t, d);.Texts.WriteString(W, "System.Time");
Texts.WriteDate(W, t, d); Texts.WriteLn(W); Texts.Append(Oberon.Log, W.buf);
Oberon.AllocateSystemViewer(0, X, Y);
V := MenuViewers.New(
TextFrames.NewMenu("System.Log", LogMenu),
TextFrames.NewText(Oberon.Log, 0),
TextFrames.menuH,
X, Y);
Oberon.AllocateSystemViewer(0, X, Y);
V := MenuViewers.New(
TextFrames.NewMenu("System.Tool", StandardMenu),
TextFrames.NewText(TextFrames.Text("System.Tool"), 0),
TextFrames.menuH,
X, Y)
END OpenViewers;
BEGIN
Texts.OpenWriter(W);
Oberon.Log := TextFrames.Text("");
OpenViewers
END System.
5. ТЕКСТОВАЯ СИСТЕМА
На заре вычислительной эры текст был единственным средством обмена инфор¬
мацией между пользователями и компьютерами. Текстовая запись применялась
не только для обозначения всех видов данных, таких как имена и числа (пред¬
ставленные последовательностью цифр), но и для записи программ (основанной
на понятиях формального языка и синтаксиса) и команд (с их именами). Факти¬
чески даже самые современные и самые сложные вычислительные среды так и не
смогли существенно поколебать доминирующей роли текста. Они лишь ввели
альтернативные модели вроде графических интерфейсов пользователя (GUI) в ка¬
честве графической замены командных строк.
Есть много причин популярности текста вообще и в связи с компьютерами
в частности. Назовем только некоторые: текст, содержащий любое количество ин¬
формации, может быть построен на небольшом алфавите из стандартизированных
элементов (символов), шаблон их создания чрезвычайно прост (выстраивание
элементов в строку), а получающаяся структура совсем проста (последователь¬
ность). И, наверно, наиболее важно то, что синтаксически структурированный
текст может анализироваться и интерпретироваться.
В компьютерной терминологии последовательности элементов называют
файлами, и, в частности, последовательности символов известны, как текстовые
файлы. Глядя на их двоичное представление, мы найдем их чрезвычайно удоб¬
ными для хранения в машинной памяти и на внешних носителях. Если помни¬
те, отдельные символы обычно кодируются одним байтом (код ASCII). Поэтому
можно отождествить двоичную структуру текстовых файлов с последовательно¬
стью байтов, точно соответствующей структуре любой памяти компьютера. Тут
мы должны напомнить, что за исключением, быть может, управляющих симво¬
лов конца строки, информация о воспроизведении (rendering) текста не является
частью обычных текстовых файлов. Например, выбор типа шрифта и параметров
форматирования параграфа полностью оставляют на интерпретатор воспроизве¬
дения.
К сожалению, в обычных вычислительных средах текст используется просто
для ввода/вывода и используется неоптимально. Вводимые тексты, как правило,
считываются с клавиатуры под управлением некоего редактора, интерпретиру¬
ются, а затем пропадают. Выводимый текст эфемерен. Однажды отображенный
на экране, он больше не доступен для любых других частей программы. Корень
проблемы обнаруживается легко: обычные операционные системы не обладают
ни интегрированным управлением, ни абстрактным интерфейсом программиро¬
вания для текстов.
Текст как абстрактный тип данных
105
Конечно, такая слабая поддержка текста на уровне программирования долж¬
на отразиться на пользователях. Они вынуждены чаще, чем нужно, повторно на¬
бирать определенную строку текста, вместо того чтобы просто взять ее где-то на
экране. Исследования показали, что в среднем до 80% необходимого для ввода
текста уже где-то отображено.
Движимые нашим положительным опытом с интегрированным текстом в сис¬
теме Cedar [2], мы решили обеспечить в Обероне централизованное управление
текстом на довольно низком системном уровне. Однако этого недостаточно. Фак¬
тически нам нужен абстрактный интерфейс программирования для текста, то есть
абстрактный тип данных Text вместе с полным набором операций. Мы посвятим
раздел 5.1 объяснению этого типа данных. В разделе 5.2 пристальнее рассмотрим
основы управления текстом в Обероне, включая структуры данных и используе¬
мые для реализации алгоритмы.
Текстовые кадры - особый класс кадров отображения. Обычно (но не всегда)
они появляются как кадры в окошках меню (см. раздел 4.4.2). Их роль двояка:
(а) отображение текста на экране дисплея и (б) отработка команд редактирования.
Подробности будут обсуждаться в разделе 5.3.
С целью использования мощности современных дисплеев с двоичной матри¬
цей, а также результатов более ранних проектов в области разработки цифровых
шрифтов мы решили включать графические атрибуты и, в частности, специфика¬
ции шрифта в тексты Оберона. В разделе 5.4 мы объясним шрифтовой аппарат,
начав с абстрактного уровня и спускаясь до уровня растровых данных.
5.1. Текст как абстрактный
тип данных
Понятие абстракции - самое важное достижение разработки языков про¬
граммирования. Оно обеспечивает мощный инструмент создания упрощенных
представлений о сложных программных компонентах. Два выдающихся примера
программных абстракций - определения (интерфейсы) и абстрактные типы дан¬
ных. Эти понятия воплощают «открытый обзор» определенной части программы
и определенного вида объектов соответственно.
Теперь дадим точное определение понятия текста в Обероне как абстрактно¬
го типа данных. Важно не путать этот тип с гораздо более слабым типом string, ко¬
торый часто поддерживается развитыми языками программирования. Мы будем
строго избегать этого в данном разделе, чтобы раскрыть все аспекты реализации.
Наша точка зрения состоит в том, что прикладная программа работает с текстом
или использует его как средство общения.
Сначала давайте усовершенствуем понятие символа. Мы знаем, что символы
представляют текстовые элементы информации. Однако каждый символ связан
также с некоторым определенным графическим шаблоном, часто называемым на¬
чертанием (glyph). В Обероне мы отдаем должное обоим аспектам, подразумевая
код ASCII в качестве диапазона индексов для печатных шрифтов. Мы пред пола¬
106
Текстовая система
гаем, что символы представлены парами вида (font, ref), где font задает шрифт,
a ref - ASCII-код символа. Мы рассмотрим полностью тему шрифтов и их начер¬
таний в разделе 5.4. Добавив еще пару атрибутов цвет и вертикальное смещение,
мы получим четверку свойств символа (font, ref, col, voff). Компоненты font, col
и voff вместе часто называют обличием (looks). Теперь мы можем объявить текст
приблизительно, как «последовательность атрибутных символов».
Формально мы определяем следующий тип дескриптора:
Text = POINTER ТО TextDesc;
TextDesc = RECORD
len: LONGINT;
notify: Notifier
END;
Здесь только одна переменная состояния и один метод. Переменная len пред¬
ставляет текущую длину описываемого текста (то есть число символов в последо¬
вательности). Процедурная переменная notify является методом (иногда называе¬
мым методом последействия) для уведомления заинтересованных клиентов об
изменении состояния.
По определению, каждый абстрактный тип данных идет с полным набором
операций. В случае типа Text нужно рассмотреть три различные темы - загрузка
(из файла)/сохранение (в файле), редактирование и доступ соответственно.
5.1.1. Загрузка и сохранение
Начнем с файлов. Сначала введем пару взаимно обратных операций, называе¬
мых загрузить и выгрузить. Их значение - «загрузить из файла и создать внут¬
реннюю структуру данных» и «преобразовать внутреннюю структуру данных
в линейную последовательность и сохранить в файле». Есть три соответствующие
процедуры:
PROCEDURE Open (Т: Text; name: ARRAY OF CHAR);
PROCEDURE Load (T: Text; f: Files. File; pos: LONGINT; VAR len: LONGINT);
PROCEDURE Store (T: Text; f: Files.File; pos: LONGINT; VAR len: LONGINT);
Логические объекты, подобные текстам, хранятся в Обероне на внешних носи¬
телях в виде секций. Секция адресуется парой (file, pos), состоящей из дескриптора
файла и начальной позиции. Вообще, структура секций подчиняется следующему
синтаксису:
секция = идентификация тип длина содержимое.
Процедура Open принимает заданный текстовый файл (состоящий из одной
секции текста), процедура Load загружает произвольную секцию текста, начинаю¬
щуюся с (f, pos), a Store выгружает секцию текста в (f,pos). Параметр Т обознача¬
ет загруженный текст. len возвращает длину секции. Отметим, что в случае Load
идентификация секции должна быть считана и принята до вызова загрузчика.
5.1.2. Редактирование текста
Наша следующая группа операций поддерживает редактирование текста. Она
включает четыре процедуры:
PROCEDURE Delete (Т: Text; beg, end: LONGINT);
PROCEDURE Insert (T: Text; pos: LONGINT; B: Buffer);
PROCEDURE Append (T: Text; B: Buffer);
PROCEDURE ChangeLooks (T: Text; beg, end: LONGINT;
sel: SET; fnt: Fonts.Font; col, voff: SHORTINT);
И опять сначала мы должны объяснить типы параметров. Процедуры Delete и
ChangeLooks получают в качестве аргумента отрезок текста, который по опреде¬
лению является интервалом [beg, end) внутри данного текста. В списках парамет¬
ров Insert и Append мы обнаруживаем новый тип данных Buffer.
Буферы - это средство хранения безымянных последовательностей символов.
Тип Buffer представляет собой еще один абстрактный тип данных:
Buffer = POINTER ТО BufDesc;
BufDesc = RECORD
len: LONGINT
END;
len задает текущую длину буферизуемой последовательности. Следующие
процедуры представляют внутренние операции с буферами:
PROCEDURE OpenBuf (В: Buffer);
PROCEDURE Copy (SB, DB: Buffer);
PROCEDURE Save (T: Text; beg, end: LONGINT; B: Buffer); '
PROCEDURE Recall (VAR B: Buffer);
В свою очередь, их задачи - это открытие заданного буфера В, копирование
буфера SB в DB, сохранение отрезка текста [beg, end) в заданном буфере и возврат
последнего удаленного отрезка текста в буфер В.
Теперь мы готовы понять, как работают процедуры редактирования. Процеду¬
ра Delete удаляет заданный отрезок [beg, end) внутри текста Т, Insert вставляет
содержимое буфера в позицию pos текста Г, a Append(T, В) - это сокращение для
Insert(T, T.len, В). Отметим, что побочный эффект Insert и Append - освобожде¬
ние указанного в них буфера. Наконец, процедура ChangeLooks позволяет сме¬
нить выбраные обличия внутри заданного отрезка [beg, end) текста. Г. sel - это
маска выбора подмножества из множества обличий {шрифт, цвет, вертикальное
смещение}.
Текст как абстрактный тип данных
107
Теперь пора обратиться к понятию уведомителя (notifier). Напомним, что
notify - это «метод последействия». Он должен быть установлен клиентом при
открытии текста и вызывается по окончании каждой операции редактирования.
Его процедурный тип таков:
Notifier = PROCEDURE (Т: Text; op: INTEGER; beg, end: LONGINT);
Параметры op, beg и end сообщают об операции (op), которая вызывает уведо¬
мителя, и о затронутом ею отрезке [beg, end) текста. Существует три возможных
варианта ор, соответствующих трем различным операциям редактирования: ор =
delete, insert, replace соответствуют процедурам Delete, Insert (и Append) и Change¬
Looks соответственно.
Безусловно, самое важное применение уведомителя - это обновление изобра¬
жения, то есть приведение всех затронутых окошек, которые отображаются в на¬
стоящий момент, к новому состоянию текста. Мы еще вернемся к этому важному
моменту, когда будем обсуждать текстовые кадры в разделе 5.3.
В заключение этого раздела стоит, наверно, отметить, что рассмотренная здесь
группа операций разработана так, чтобы быть одинаково полезной и для интерак¬
тивных текстовых редакторов, и для программируемых текстовых генераторов/
манипуляторов.
5.1.3. Доступ к тексту
Теперь давайте обратимся к третьей и последней группе операций с текста¬
ми - доступу Согласно принципу разделения обязанностей, одному из наших ру¬
ководящих принципов, механизм доступа воздействует не на сами тексты, а на
внешние объекты, называемые читателями (readers) и писателями (writers).
Читатели используются для последовательного чтения текстов. Их тип объ¬
является как
Reader = RECORD
eot: BOOLEAN; (*конец текста*)
fnt: Fonts.Font;
col: SHORTINT;
voff: SHORTINT
END;
Читатель сначала должен быть установлен в некоторую заданную позицию
текста, а затем может продвигаться по тексту, читая символ за символом. Его пере¬
менные состояния отслеживают конец текста и показывают обличие предвари¬
тельно прочитанного символа.
Соответствующие операции таковы:
108
PROCEDURE OpenReader (VAR R: Reader; T: Text; pos: LONGINT);
PROCEDURE Read (VAR R: Reader; VAR ch: CHAR);
Текстовая система
Процедура OpenRecider устанавливает читатель R в позицию pos в тексте Т.
Процедура Read возвращает символ в текущей позиции R и продвигает R к следую¬
щей позиции.
Текущая позиция читателя R возвращается обращением к функции Pos:
PROCEDURE Pos (VAR R: Reader): LONGINT;
В главе 3 мы узнали, что тексты в Обероне часто используются в качестве
списков параметров команд. Однако применительно к интерпретатору команд
текст скорее оказывается последовательностью лексем, нежели последовательно¬
стью символов. Поэтому мы позаимствовали хорошо известные понятия синтак¬
сиса и сканирования из дисциплины построения компиляторов. Сканер Оберона
распознает лексемы некоторых универсальных классов. Это - имя, строка, целое,
вещественное, длинное целое и специальный символ.
Точный синтаксис универсальных лексем Оберона таков:
token = name | string | integer | real | longreal | spexchar.
name = ident { ident }.
ident = letter { letter | digit }.
string = { char } | "" { char }
integer = ["+"|"-"] number.
real = [”+"|"-"] number number ["E" number],
longreal = ["+"|"-"] number number ["D" ["+”|"-"] number],
number = digit { digit }.
spexchar = любая литера, кроме letter, digit, пробела, табуляции и возврата каретки.
Тип Scanner определяется аналогично:
Scanner = RECORD (Reader)
nextCh: CHAR;
line: INTEGER;
class: INTEGER;
i: LONGINT;
x: REAL;
y: LONGREAL;
c: CHAR;
len: SHORTINT;
s: ARRAY 32 OF CHAR
END;
Фактически этот тип - вариантная запись, где class - тэг варианта. В зависимости
от него значение текущей лексемы сохраняется в одном из полей г, х, г/, с или s. В поле
len хранится длина 5, в поле nextCh обычно хранится следующий за текущей лексемой
(завершающий) символ, a line подсчитывает количество прочитанных строк.
Операции со сканерами:
PROCEDURE OpenScanner (VAR S: Scanner; T: Text; pos: LONGINT);
PROCEDURE Scan (VAR S: Scanner);
Текст как абстрактный тип данных
109
110
Текстовая система
Они в точности соответствуют своим двойникам - OpenReader* и Read соот¬
ветственно.
Важно осознавать, что в одном и том же тексте может сосуществовать произ¬
вольное количество читателей и сканеров. Как правило, читатели и сканеры под¬
чинены и привязаны к некоторой определенной деятельности и имеют временную
природу, в отличие от их хозяина - текста, время жизни которого в динамической
памяти системы, как правило, гораздо больше. Этот факт проявляет себя отсутст¬
вием всякой возможности ссылаться на читатели и сканеры по указателям.
Писатели двойственны читателям. Они служат для создания и пополнения
текстов. Но опять же они не воздействуют на тексты непосредственно. Скорее, они
действуют как самостоятельные объекты, непрерывно потребляющие и буферизу¬
ющие текстовые данные.
Формальное объявление типа Writer напоминает объявление типа Reader.
Writer = RECORD
buf: Buffer;
fnt: Fonts.Font;
col: SHORTINT;
voff: SHORTINT
END;
buf - внутренний буфер, содержащий потребляемые данные, fnt, col и voff за¬
дают текущее обличие следующего прочитанного символа.
Следующие процедуры вместе образуют основное управление писателями:
PROCEDURE OpenWriter (VAR W: Writer);
PROCEDURE SetFont (VAR W: Writer; fnt: Fonts.Font);
PROCEDURE SetColor (VAR W: Writer; col: SHORTINT);
PROCEDURE SetOffset (VAR W: Writer; voff: SHORTINT);
Процедура OpenWriter открывает новый писатель с пустым буфером. Процеду¬
ры SetFont, SetColor и SetOffset устанавливают соответствующее текущее обличие.
Например, SetFont (W, fnt) эквивалентен W.fnt: = fnt. Эти процедуры добавлены
потому, что fnt, col и voff считаются для клиентов переменными только для чтения.
Возникает вопрос: как данные производятся и передаются писателям? Ответ -
набором процедур писателя, каждая из которых обрабатывает свой тип данных:
PROCEDURE Write (VAR W: Writer; ch: CHAR);
PROCEDURE WriteLn (VAR W: Writer);
PROCEDURE WriteString (VAR W: Writer; s: ARRAY OF CHAR);
PROCEDURE Writelnt (VAR W: Writer; x, n: LONGINT);
PROCEDURE WriteHex (VAR W: Writer; x: LONGINT);
PROCEDURE WriteReal (VAR W: Writer; x: REAL; n: INTEGER);
PROCEDURE WriteRealFix (VAR W: Writer; x: REAL; n, k: INTEGER);
PROCEDURE WriteRealHex (VAR W: Writer; x: REAL);
PROCEDURE WriteLongReal (VAR W: Writer; x: LONGREAL; n: INTEGER);
PROCEDURE WriteLongRealHex (VAR W: Writer; x: LONGREAL);
PROCEDURE WriteDate (VAR W: Writer; t, d: LONGINT);
Их поможет понять изучение следующего наброска фрагмента клиентской
программы, которая создает текстовый вывод:
открыть писатель; установить желаемый шрифт;
REPEAT
обработать;
записать результат в писатель;
добавить буфер писателя к выходному тексту
UNTIL закончится
Конечно, писатели могут использоваться повторно. Например, единствен¬
ный глобальный писатель, как правило, разделяется всеми процедурами моду¬
ля. В этом случае писатель должен открываться только однажды при загрузке
модуля.
Основная выгода от такого строгого разъединения записывающих и редакти¬
рующих операций над текстами -возможность свободного выбора степени дета¬
лизации, с которой обновляется текст (и его образ на экране).
Подведем итог. Text в Обероне - мощный абстрактный тип данных с внутрен¬
ними операциями трех категорий - загрузка/сохранение, редактирование и до¬
ступ. В свою очередь, последние две категории вводят следующие абстрактные
типы, названные Buffer, Reader Scanner и Writer. Вместе они гарантируют ясное
и строгое разделение обязанностей - текста, редактирования текста и доступа
к тексту. Чтобы позволить контекстно-зависимую постобработку операций редак¬
тирования, применяется метод последействия. Он используется прежде всего для
сохранения согласованности между текстовыми моделями и отображаемыми их
окошками.
5.2. Управление текстом
Искусство и проблема модуляризации - это поиск эффективного разбиения
на модули с относительно тонкими интерфейсами, или, другими словами, на мо¬
дули с большим потенциалом сокрытия информации. Текстовые системы - пре¬
красное упражнение по этой теме. Пристальный анализ немедленно приводит
к следующим отдельным задачам, соответствующим Модели, Представлению и
Контроллеру согласно схеме МУС (Model, View, Controller): управление текстом,
отображение текста и редактирование текста. Если мы объединим Представление
и Контроллер и добавим вспомогательный модуль обработки шрифтов Fonts, то
придем к линейной трехмодульной иерархии импорта, изображенной в табл. 5.1.
Таблица 5.1
Модуль
Тип объекта
Функция
TextFrames
Frame
Отображение и редактирование текста
Texsts
Text
Управление текстом
Fonts
Font
Управление шрифтами
Управление текстом
111
112
Текстовая система
Обратите внимание, что в отличие от подсистемы отображения связанные
типы объектов не связаны иерархически.
Модулям TextFrames и Fonts будут посвящены отдельные разделы 5.3 и 5.4 со¬
ответственно. В этом разделе мы направим наше внимание на модуль Texts. Счи¬
тая его моделью абстрактного типа данных Text, представленного в предыдущем
разделе, его определение совпадает со спецификацией самого абстрактного типа
данных, и нам нет нужды повторять его здесь.
Актуальные темы этого раздела - внутреннее представление и файловое пред¬
ставление текстов. Сразу подчеркнем, что внутреннее представление - сугубо
частный вопрос модуля Texts. Оно встроено в модуль и скрыто от клиентов. В част¬
ности, представление всегда можно изменить, не испортив ни одного клиентского
модуля. В принципе, то же справедливо и для файлового представления. Однако
на самом деле его постоянство имеет первостепенную важность, потому что оно
служит дополнительной цели длительного хранения текста на внешних носителях
и его переноса в другие среды.
Наш выбор внутреннего представления текста определялся перечнем требова¬
ний и желаемых свойств. Список пожеланий таков:
1) простая структура данных;
2) закрытость для операций редактирования;
3) эффективность операций редактирования;
4) эффективность последовательного чтения;
5) эффективность прямого позиционирования;
6) сверхэффективность загрузки;
7) сохранение представлений файлов.
За исключением пункта 5, мы нашли эти требования точно соответствующи¬
ми обобщенному варианту метода цепочек отрывков, который первоначально ис¬
пользовался для редактора текста Bravo в Xerox PARC, а также для более ранних
редакторов документов Dyna и Lara [1] в ЕТН. В оригинале цепочка отрывков
в состоянии описать простейший текст без обличий. Она основана на двух прин¬
ципах:
1) текст считается последовательностью отрывков, где отрывок - это секция
текстового файла, состоящего из сплошной последовательности символов;
2) каждый отрывок представлен дескриптором (f,pos, len), составляющие ко¬
торого обозначают соответственно файл, начальную позицию и длину. Весь
текст представляется цепочкой дескрипторов отрывков (короче, цепочкой
отрывков). Операции редактирования работают с цепочками дескрипторов
отрывков, а не с самими отрывками.
На рис. 5.1 показана типичная цепочка отрывков, представляющая текст (в его
текущем состоянии). Исследуя действия основных операций редактирования
delete и insert на цепочке отрывков, мы получаем такие алгоритмы:
удалить отрезок текста [beg, end) = BEGIN
разбить отрывки в позициях beg и end;
удалить из цепочки дескрипторы отрывков от beg до end
Управление текстом
113
END
вставить отрезок текста в pos = BEGIN
разбить отрывок в позиции pos;
вставить в позицию pos дескрипторы отрывков отрезка текста
END
Рис. 5.1. Цепочка отрывков, представляющая текст
Конечно, разбиение излишне, если нужная точка разбиения случайно совпада¬
ет с началом отрывка. Рисунки 5.2 и 5.3 показывают итоговую цепочку отрывков
после удаления и вставки соответственно.
Рис. 5.2. Цепочка отрывков после операции удаления
114
Текстовая система
Рис. 5.3. Цепочка отрывков после операции вставки
Проверяя наш список пожеланий выше, сразу видно, что требования 1, 2 и
3 выполнены. Требование 4 также выполнено в предположении об эффективном
механизме прямого позиционирования в файлах. Требование 6 может быть снято,
потому что список отрывков изначально состоит из одного отрывка, охватываю¬
щего весь текстовый файл. Наконец, требование 7 выполнено просто потому, что
операции вообще не влияют на представление файла.
В Обероне мы приспособили метод цепочек отрывков к текстам с обличиями.
Формально сначала определим ряд (run) как отрезок текста, чьи символы имеют
одинаковое обличие. Теперь потребуем, чтобы сама цепочка отрывков подчиня¬
лась структуре ряда. Это, очевидно, означает, что каждый отрывок содержится
внутри одного ряда. Рисунок 5.4 изображает такую цепочку отрывков, представ¬
ляющую текст с различными обличиями. По сравнению с рассмотренной выше
первоначальной версией цепочки отрывков, есть только два новых аспекта: до¬
полнительная операция смены обличим и начальное состояние цепочки отрывков.
сменить обличие на отрезке [beg, end) текста = BEGIN
разбить отрывки в beg и в end;
сменить обличие в дескрипторах отрывков от beg до end в цепочке
END
Это показывает, что требования 2 и 3 в списке пожеланий все еще выполня¬
ются.
Сначала отрывки совпадают с рядами, и число элементов в цепочке отрывков
равно числу рядов. Поскольку это число, как правило, мало по сравнению с общим
числом символов в тексте, требование 6 все еще выполняется.
Управление текстом
115
I have trained that man , says the
laboratory rat, so that every time
I press this lever he gives me food
Цепочка отрывков
Рис. 5.4. Обобщенная цепочка отрывков, представляющая текст с обличиями
Мы заключаем, что новые аспекты не снижают положительных оценок, данных
выше цепочке отрывков, в отношении требований 1, 2,3,4, 6 и 7 нашего списка по¬
желаний. Но остается требование эффективного прямого позиционирования. Про¬
блема - в необходимости последовательного просмотра списка отрывков для на¬
хождения отрывка, который содержит нужную позицию. Мы исследовали разные
решения этой проблемы эффективности. Они основываются на различных струк¬
турах данных, связывающих дескрипторы отрывков, среди них - дерево отрывков
и вариант цепочки отрывков, снабженной дополнительной дальней связью.
В конечном счете мы склонились в пользу более простого решения. В его
оправдание обратим внимание на то, что типичный сценарий сводится к локаль¬
ной области редактируемого текста, то есть к однократному переходу в достаточ¬
но далекую позицию с последующими многократными переходами в соседние
позиции. Поэтому приемлемое решение - это кэширование самых последних рас¬
четных значений (pos, piece) карты трансляции. Конечно, это не решает пробле¬
мы в случае промахов кэширования. Однако заметьте, что проблема обостряется
только в случае исключительно длинных цепочек отрывков, чего не случается
в обычных текстах и сеансах редактирования.
Теперь проиллюстрируем метод отрывков на примере двух важных основных
операций Insert и Read. Начнем с обзора используемых типов данных. За исклю¬
чением некоторых вспомогательных частных переменных, помеченных стрелкой,
типы Text, Buffer и Reader нам уже известны из предыдущего раздела. Тип Piece
сугубо собственный и скрыт от клиентов.
116
Текстовая система
Text = POINTER ТО TextDesc;
Notifier = PROCEDURE (T: Text; op: INTEGER; beg, end: LONGINT);
TextDesc = RECORD
len: LONGINT;
notify: Notifier;
trailer: Piece;
-» org: LONGINT;
—> pee: Piece
END;
Buffer = POINTER TO BufDesc;
BufDesc = RECORD
len: LONGINT;
—» header, last: Piece
END;
Reader = RECORD (Files.Rider)
eot: BOOLEAN;
fnt: Fonts.Font;
col: SHORTINT;
voff: SHORTINT;
-> ref: Piece;
—> org: LONGINT;
-> off: LONGINT
END;
—> Piece = POINTER TO PieceDesc;
-> PieceDesc = RECORD
f: Files.File;
off: LONGINT;
len: LONGINT;
fnt: Fonts.Font;
col: SHORTINT;
voff: SHORTINT;
prev, next: Piece
END;
Как показано на рис. 5.1, цепочка отрывков реализована как двусвязный спи¬
сок с отрывком-стражем, замыкающим его в кольцо. Поле trailer в типе TextDesc
указывает на отрывок-страж. Поля org и рее реализуют кэш-трансляцию, состоя¬
щую только из одного входа (org, рее). Он связывает позицию org с отрывком рее.
Поля header и last в типе Buffer раскрывают реализацию буферов как цепочек
отрывков. Они указывают на первый и последний дескрипторы отрывков соот¬
ветственно. Наконец, поля ref, org и off в типе Reader запоминают текущий от¬
рывок, его начало и текущее смещение в этом отрывке.
Обратите внимание, что читатели - это фактически расширения типа так на¬
зываемых файловых бегупков. Бегунки играют ту же роль для файлов, что читате¬
ли для текстов. Подробности см. в главе 7 о файлах.
Поля/, off и len в типе Piece задают основной файл, начальную позицию в нем
и длину отрывка.fnt, col и voff - его обличие. Наконец, prev и next - э го указатели
на предыдущий и следующий отрывки в цепочке соответственно.
FindPiece и SplitPiece - вспомогательные процедуры, которые используются
почти всеми операциями с отрывками.
PROCEDURE FindPiece (Т: Text; pos: LONGINT; VAR org: LONGINT; VAR p: Piece);
VAR n: INTEGER;
BEGIN
1) IF pos < T.org THEN T.org := -1; T.pce := T.trailer END;
2) org := T.org; p := T.pce;
n := 0;
3) WHILE pos >= org + p.len DO org := org + p.len; p := p.next; INC(n) END;
4) IF n > 50 THEN T.org := org; T.pce := p END
END FindPiece;
Пояснения (к нумерованным строкам приведенного выше фрагмента);
1) отменить кэш, если новая позиция < позиции в кэше;
2) использовать кэш как отправную точку;
3) пройти по цепочке отрывков;
4) обновить кэш, если пройдено более 50 отрывков.
1) PROCEDURE SplitPiece (р: Piece; off: LONGINT; VAR pr: Piece);
VAR q: Piece;
BEGIN
2) IF off > 0 THEN NEW(q);
q.fnt := p.fnt; q.col := p.col; q.voff := p.voff;
q.len := p.len - off;
q.f := p.f; q.off := p.off + off;
p.len := off;
3) q.next := p.next; p.next := q;
4) q.prev := p; q.next.prev := q; pr := q
ELSE pr := p
END
END SplitPiece;
Пояснения:
1) возвратить правую часть отрывка pr после разбивки;
2) создать новый отрывок, если только остающаяся длина > 0;
3) вставить новый отрывок в правую цепочку;
4) вставить новый отрывок в левую цепочку.
Процедура Insert занимается вставкой текста. Она работает с буфером, кото¬
рый содержит вставляемый отрезок текста:
PROCEDURE Insert (Т: Text; pos: LONGINT; В: Buffer);
VAR pi, pr, p, qb, qe: Piece; org, end: LONGINT;
BEGIN
Управление текстом
117
1) FindPiece(T, pos, org, p); SplitPiece(p, pos - org, pr);
2) IF T.org >= org THEN
T.org := org - p.prev.len; T.pce := p.prev END; pi := pr.prev; qb := B.header.next;
3) IF (qb # NIL) & (qb.f = pl.f) & (qb.off = pi.off + pi.len)
& (qb.fnt = pl.fnt) & (qb.col = pi.col) & (qb.voff = pl.voff) THEN
pi.len := pi.len + qb.len; qb := qb.next
END;
IF qb # NIL THEN qe := B.last;
4) qb.prev := pi; pi.next := qb; qe.next := pr; pr.prev := qe
END;
5) T.len := T. len + B.len; end := pos + B.len;
6) B.last := B.header; B.last.next := NIL; B.len := 0;
7) T.notify(T, insert, pos, end)
END Insert;
Пояснения:
1) разбить отрывок в месте вставки;
2) подогнать кэш, если нужно;
3) слить отрывки, если возможно;
4) вставить буфер;
5) обновить длину текста;
6) очистить буфер;
7) уведомить.
Процедура Read осуществляет последовательное чтение символов в текстах.
Она работает с читателем:
PROCEDURE Read (VAR R: Reader; VAR ch: CHAR);
BEGIN
1) Files.Read(R, ch); R.fnt := R.ref.fnt; R.col := R.ref.col; R.voff := R. ref.voff;
INC(R.off);
2) IF R.off = R.ref.len THEN
3) IF R.ref.f = WFile THEN R.eot := TRUE END;
R.org := R.org + R.off; R.off := 0;
4) R.ref := R.ref.next; R.org := R.org + R.off; R.off := 0;
5) Files.Set(R, R.ref.f, R.ref.off)
END
END Read;
Пояснения:
1) прочитать символ из файла и обновить обличие в читателе;
2) если достигнут конец отрывка;
3) проверить, достигнут ли отрывок-страж;
4) переместить читатель к следующему отрывку;
5) положение бегунка файла.
Процедура Read обычно используется в качестве примитива сканерами текс¬
та и, в частности, встроенным сканером Scan для распознавания универсальных
118
Текстовая система
лексем, которые были определены в предыдущем разделе. Сканирование - до¬
вольно сложная операция, которая, например, включает преобразование последо¬
вательности цифр во внутреннее представление с плавающей точкой. Некоторая
низкоуровневая помощь для таких преобразований в обоих направлениях обеспе¬
чивается модулем Reals, реализация которого машинно зависима. Этот модуль ис¬
пользуется также процедурами WriteReal.
DEFINITION Reals;
PROCEDURE Convert (x: REAL; n: INTEGER; VAR d: ARRAY OF CHAR);
PROCEDURE ConvertH (x: REAL; VAR d: ARRAY OF CHAR);
PROCEDURE ConvertHL (x: LONGREAL; VAR d: ARRAY OF CHAR);
PROCEDURE ConvertL (x: LONGREAL; n: INTEGER; VAR d: ARRAY OF CHAR);
PROCEDURE Expo (x: REAL): INTEGER;
PROCEDURE ExpoL (x: LONGREAL): INTEGER;
PROCEDURE FSR (): LONGINT;
PROCEDURE SetFSR (status: LONGINT);
PROCEDURE Ten (e: INTEGER): REAL;
PROCEDURE TenL (e: INTEGER): LONGREAL;
PROCEDURE Valid (x: REAL): BOOLEAN;
PROCEDURE ValidL (x: LONGREAL): BOOLEAN;
END Reals.
Несмотря на свою очевидную простоту, метод цепочек отрывков взаимодейст¬
вует с другими системными компонентами весьма тонким способом. Например,
после редактирования документов между ними обычно существуют многочис¬
ленные перекрестные ссылки. Иными словами, отрывки одного документа могут
ссылаться на внешние файлы, то есть на файлы, которые изначально относились
к другим документам. Как следствие файловая система должна или использовать
некоторый умный алгоритм сборки мусора, или вообще не использовать повторно
страницы файла, даже если тем временем была создана новая его версия с тем же
именем.
Проблема иного рода, тоже касающаяся файловой системы, возникает, если,
скажем, отдельная строка текста собирается из нескольких маленьких отрывков.
Тогда последовательное чтение этой строки может потребовать нескольких быст¬
рых переходов к различным позициям в различных файлах. В зависимости от
качества механизма буферизации файла это может привести к значительным за¬
держкам в движении мыши.
И наконец, набираемые символы, которые предполагается вставить в текст,
должны сохраняться в непрерывно растущем файле, так называемом файле кла¬
виатуры. Для такого файла должно быть разрешено существование одновременно
нескольких читателей и одного писателя.
Как следствие, для безупречной работы метода отрывков файловой системе
должны быть присущи следующие качества:
1. Однажды выделенная файловая страница не должна использоваться пов¬
торно (до перезапуска системы).
Управление текстом
ГЙ9|
120
Текстовая система
2. Требуется гибкий механизм буферизации файлов, поддерживающий мно¬
жество буферов на один файл.
3. У файлов должна быть возможность открываться одновременно и на чте¬
ние, и на запись.
Формат текстовых секций в файлах подчиняется набору синтаксических пра¬
вил (продукций), которые можно легко записать в РБНФ-нотации:
TextSection = ident header {char},
header = type offset run {run} null length,
run = font [name] color offset length.
В первой продукции ident - это идентификатор для текстовых блоков. Во
второй продукции type - определитель типа, offset - смещение символьной час¬
ти, тп - дескриптор ряда, null - символ null и length - длина последовательно¬
сти символов. В третьей продукции font, color и offset - спецификации обличил,
a length - длина ряда. Чтобы сберечь место, имена шрифтов кодируются поряд¬
ковыми номерами внутри секции текста. Шрифт сопровождается именем только
тогда, когда впервые появляется в текстовом блоке.
Завершим раздел двумя побочными комментариями и выводом.
Комментарии:
□ По причинам совместимости простые ASCII-файлы тоже допускаются
в качестве текстовых файлов. Они отображаются в тексты, состоящие из
одного ряда со стандартным обличием.
□ Загрузка секции текста из файла чрезвычайно эффективна, потому что,
очевидно, достаточно считать заголовок и превратить его в начальное сос¬
тояние цепочки отрывков.
Вывод: механизм, используемый для реализации абстрактного типа данных
Text, полностью скрыт от клиентов. Он является обобщением оригинального ме¬
тода цепочек отрывков, приспособленного к текстам с обличиями. Метод цепочек
отрывков основан на принципе косвенности: операции выполняются над дескрип¬
торами текстов, а не над самими текстами. Достоинства - эффективность и нераз¬
рушающие операции. Однако метод работает должным образом только в комби¬
нации с подходящей файловой системой.
5.3. Текстовые кадры
Задачи текстовых кадров - это отображение (прорисовка) текста и взаимо¬
действие с пользователем. Текстовый кадр представляет текстовое окошко и конт¬
роллер в виде интерактивного редактора текста. Технически текстовый кадр - это
подкласс кадра отображения и, таким образом, это объект с открытым интерфей¬
сом сообщений из главы 4.
Геометрия размещения текстовых кадров определяется двумя областями -
прямоугольником с содержимым и вертикальной полосой прокрутки вдоль левой
границы. Тип текстовых кадров - прямое расширение типа Display.Frame:
Текстовые кадры
121
prame = POINTER TO FrameDesc;
FrameDesc = RECORD (Display.FrameDesc)
text: Texts.Text;
org: LONGINT;
col: INTEGER;
lsp: INTEGER;
left, right, top, bot: INTEGER;
markH: INTEGER;
time: LONGINT;
mark, car, sel: INTEGER;
carloc: Location;
selbeg, selend: Location
END;
Поля text и org задают отображаемую текстовую часть: первое ссылается на
основной текст, а последнее обозначает начальную позицию отображаемой части.
Поля col и lsp- параметры прорисовки; они задают цвет фона кадра и межстрочный
интервал. Поля right, top и bot - границы. Они определяют прямоугольник содер¬
жимого. mark представляет состояние маркера позиции, который является малень¬
ким горизонтальным штрихом, указывающим позицию отображенной части отно¬
сительно всего текста. markH представляет его положение внутри текстового кадра.
Символ вставки и выделение - два важных свойства текстовых кадров. Символ
вставки указывает потенциальную «точку вставки» и служит неявным парамет¬
ром для размещения принимаемых (например, с клавиатуры) символов. Выделе¬
ние - это отрезок отображаемого текста. Оно тоже обычно служит параметром
для различных операций и команд, среди них - удаление (Delete) и смена обличил
(Change Looks). Состояние и положение символа вставки задаются переменными
саг и carloc соответственно. Аналогично, состояние выделения, его начало и ко¬
нец отражаются в полях sel, selbeg и selend дескриптора кадра. Поле time - отметка
о времени текущего выделения.
В принципе, символ вставки и выделение с тем же успехом можно считать
компонентами основного текста (модели). Однако мы намеренно решили связать
эти свойства с кадрами (окошками) для большей гибкости. Например, два различ¬
ных выделения в смежных окошках, отображающих один и тот же текст, обычно
интерпретируются как одно-единое выделение в них обоих.
Вспомогательный тип Location суммирует информацию о положении внутри
текстового кадра. Его определение:
Location = RECORD
org, pos: LONGINT;
dx, x, y: INTEGER
END;
x, у задают предусмотренное положение относительно начала координат текс¬
тового кадра, a dx - ширину символа в этом положении, pos - соответствующая
позиция в тексте, a org - начальная позиция соответствующей строки текста.
122
Текстовая система
Напомним, что «способности» кадра как объекта определяются исключитель¬
но его обработчиком сообщений. Поэтому самое время изучить обработчик тек¬
стового кадра. Вот его грубое описание:
PROCEDURE Handle (F: Display.Frame; VAR M: Display.FrameMsg);
VAR F1: Frame;
BEGIN
WITH F: Frame DO
IF M IS Oberon.InputMsg THEN
WITH M: Oberon.InputMsg DO
1) IF M.id = Oberon.track THEN Edit(F, M.X, M.Y, M.keys)
ELSIF M.id = Oberon.consume THEN
2) IF F.car # 0 THEN Write(F, M.ch, M.fnt, M.col, M.voff) END
END
END
ELSIF M IS Oberon.ControlMsg THEN
WITH M: Oberon.ControlMsg DO
3) IF M.id = Oberon.defocus THEN Defocus(F)
4) ELSIF M.id = Oberon.neutralize THEN Neutralize(F)
END
END
ELSIF M IS Oberon.SelectionMsg THEN
5) WITH M: Oberon.SelectionMsg DO GetSelection(F, M.text, M.beg, M.end, M.time) END
ELSIF M IS Oberon.CopyOverMsg THEN
6) WITH M: Oberon.CopyOverMsg DO CopyOver(F, M.text, M.beg, M.end) END
ELSIF M IS Oberon.CopyMsg THEN
7) WITH M: Oberon.CopyMsg DO Copy(F, F1); M.F := F1 END
ELSIF M IS MenuViewers.ModifyMsg THEN
8) WITH M: MenuViewers.ModifyMsg DO Modify(F, M.id, M.dY, M.Y, M.H) END
ELSIF M IS UpdateMsg THEN
WITH M: UpdateMsg DO
9) IF F.text = M.text THEN Update(F, M) END
END
END
END
END Handle;
Пояснения:
1) сообщение о движении мыши: вызвать встроенный редактор немедленно;
2) сообщение о приеме: вставить символ в позицию вставки, если она верна;
3) сообщение о дефокусировке: удалить символ вставки;
4) сообщение о нейтрализации: удалить символ вставки и выделение;
5) сообщение о выделении: возвратить текущее выделение с отметкой о вре¬
мени;
6) сообщение о копировании из текста: копировать заданный отрезок текста в
позицию символа вставки;
Текстовые кадры
123
7) сообщение о копии: создать копию (двойника);
8) сообщение об изменении: преобразовать и изменить размер;
9) сообщение об обновлении: обновить отображение текста, если он был из¬
менен.
Мы снова узнаем наши категории универсальных сообщений, введенных
в главе 4 (табл. 4.1). Сообщения в строках 1 и 2 относятся к действиям пользова¬
теля. Сообщения 3, 4, 5, 6 и 7 задают некоторые обобщенные операции. Сообще¬
ние 8 требует изменения положения или размера. Такого рода сообщения идут от
предка окошка меню. Они генерируются интерактивным обработчиком и препро¬
цессором исходящих сообщений окошка. Наконец, сообщение 9 говорит об изме¬
нении содержимого.
Обработчик текстового кадра встроен в модуль по имени TextFrames. Этот мо¬
дуль экспортирует введенные ранее типы Frame (текстовый кадр) и Location, как и
процедуру Handle. Кроме того, он экспортирует тип UpdateMsg для сообщений об
изменениях, производимых в отображаемом тексте.
UpdateMsg = RECORD (Display.FrameMsg)
id: INTEGER;
text: Texts.Text;
beg, end: LONGINT
END;
Поле id именует одну из операций replace, insert или delete. Остальные поля
text, beg и end ограничивают производимые изменения диапазоном. Дополнитель¬
ные процедуры генерируют новые стандартные текстовые кадры меню и его ос¬
новного содержимого соответственно:
PROCEDURE NewMenu (name, commands: ARRAY OF CHAR): Frame;
PROCEDURE NewText (text: Texts.Text; pos: LONGINT): Frame;
На этом можно закончить минимальное определение модуля TextFrames. Од¬
нако этот модуль дополнительно экспортирует ряд полезных служебных про¬
цедур, которые позволяют составлять собственные обработчики из элементов
стандартного обработчика:
PROCEDURE Edit (F: Frame; X, Y: INTEGER; Keys: SET);
PROCEDURE Write (F: Frame; ch: CHAR; fnt: Fonts.Font; col, voff: SHORTINT);
PROCEDURE Defocus (F: Frame);
PROCEDURE Neutralize (F: Frame);
PROCEDURE GetSelection (F: Frame; VAR text: Texts.Text; VAR beg, end, time: LONGINT);
PROCEDURE CopyOver (F: Frame; text: Texts.Text; beg, end: LONGINT);
PROCEDURE Copy (F: Frame; VAR F1: Frame);
PROCEDURE Modify (F: Frame; id, dY, Y, H: INTEGER);
PROCEDURE Update (F: Frame; VAR M: UpdateMsg);
Модуль также поддерживает движения мыши в пределах текстовых кадров:
Текстовая система
PROCEDURE TrackCaret (F: Frame; X, Y: INTEGER; VAR keysum: SET);
PROCEDURE TrackSelection (F: Frame; X, Y: INTEGER; VAR keysum: SET);
PROCEDURE TrackLine (F: Frame; X, Y: INTEGER; VAR org: LONGINT; VAR keysum: SET);
PROCEDURE TrackWord (F: Frame; X, Y: INTEGER; VAR pos: LONGINT; VAR keysum: SET);
Теперь посмотрим на реализацию некоторых из перечисленных операций.
С этой целью мы должны сначала объяснить понятие дескриптора строки, кото¬
рый используется для оптимизации операции позиционирования внутри тексто¬
вых кадров.
Line = POINTER ТО LineDesc;
LineDesc = RECORD
len: LONGINT;
wid: INTEGER;
eot: BOOLEAN;
next: Line
END;
Каждый дескриптор строки обеспечивает подробную информацию об одной
строке текста, которая отображается в настоящее время: len - число символов
в строке, imd. - ширина строки, eot - признак завершающей строки, a next указы¬
вает на следующий дескриптор строки.
Текстовые кадры поддерживают собственную структуру данных, называемую
цепочкой строк, которая описывает список отображаемых строк текста:
Frame = POINTER ТО FrameDesc;
FrameDesc = RECORD (Display.FrameDesc)
text: Texts.Text;
org: LONGINT;
col: INTEGER;
lsp: INTEGER;
left, right, top, bot: INTEGER;
markH: INTEGER;
time: LONGINT;
mark, car, sel: INTEGER;
carloc: Location;
selbeg, selend: Location;
—» trailer: Line
END;
Поле trailer представляет элемент-страж, который замыкает цепочку строк
в кольцо.
Цепочка строк содержит полезную совокупную информацию о текущем со¬
держимом текстового кадра. Она может с успехом использоваться некоторыми
связанными типами данных, например типом Location, который был введен ранее:
Текстовые кадры
125
Location = RECORD
org, pos: LONGINT;
dx, x, y: INTEGER;
-> lin: Line
END;
Встроенная процедура редактирования Edit заслуживает того, чтобы рассмот¬
реть ее несколько подробнее. Она вызывается планировщиком задач для обработ¬
ки событий мыши внутри текстового кадра. Следующий фрагмент кода прекрасно
показывает, как взаимодействуют различные компоненты текстовой системы.
1) PROCEDURE Edit (F: Frame; X, Y: INTEGER; Keys: SET);
2) VAR
3) M: Oberon.CopyOverMsg;
4) R: Texts.Reader;
5) text: Texts.Text; buf: Texts.Buffer;
6) cmd: INTEGER;
7) time, pos, beg, end: LONGINT;
8) keysum: SET;
9) ch: CHAR;
10) BEGIN
11) Oberon.DrawCursor(Oberon.Mouse, Oberon.Arrow, X, Y);
12) IF X < F.X + Min(F.left, barW) THEN
13) IF (0 IN Keys) OR (1 IN Keys) THEN keysum := Keys;
14) REPEAT
15) Input.Mouse(Keys, X, Y);
16) keysum := keysum + Keys;
17) Oberon.DrawCursor(Oberon.Mouse, Oberon.Arrow, X, Y)
18) UNTIL Keys = {};
19) IF ~(2 IN keysum) THEN
20) IF (0 IN keysum) OR (F.Y + F.H < Y) THEN pos := О
21) ELSE pos := (F.Y + F.H - Y) * (F.text.len) DIV F.H
22) END;
23) RemoveMarks(F); Oberon.RemoveMarks(F.X, F.Y, F.W„ F.H);
24) Show(F, pos)
25) ELSIF ~(0 IN keysum) THEN
26) RemoveMarks(F); Oberon.RemoveMarks(F.X, F.Y, F.W, F.H);
27) Show(F, F.text.len)
28) END
29) ELSIF 2 IN Keys THEN
30) Track.Line(F, X, Y, pos, keysum);
31) IF (pos >= 0) & "(0 IN keysum) THEN
32) RemoveMarks(F); Oberon.RemoveMarks(F.X, F.Y, F.W, F.H);
33) Show(F, pos)
34) END
35) END
36) ELSE
37) if 0 IN Keys THEN
38) TrackSelection(F, X, Y, keysum);
Текстовая система
39) IF F. sel ft 0 THEN
40) IF (2 IN keysum) & ~(1 IN keysum) THEN
41) Oberon. PassFocus(Viewers.This(F.X, F.Y));
42) Oberon.GetSelection(text, beg, end, time);
43) Texts.Delete(text, beg, end); SetCaret(F, beg)
44) ELSIF (1 IN keysum) & ~(2 IN keysum) THEN
45) Oberon.GetSelection(text, beg, end, time);
46) M.text := text; M.beg := beg; M.end := end;
47) Oberon.FocusViewer.handle(Oberon.FocusViewer, M)
48) END
49) END
50) ELSIF 1 IN Keys THEN
51) TrackWord(F, X, Y, pos, keysum);
52) IF (pos >= 0) & "(0 IN keysum) THEN Call(F, pos, 2 IN keysum) END
53) ELSIF 2 IN Keys THEN
54) Oberon.PassFocus(Viewers.This(F.X, F.Y)); TrackCaret(F, X, Y, keysum);
55) IF F.car # 0 THEN
56) IF (1 IN keysum) & "(0 IN keysum) THEN
57) Oberon.GetSelection(text, beg, end, time);
58) IF time >= 0 THEN
59) NEW(buf); Texts.OpenBuf(buf);
60) Texts.Save(text, beg, end, buf);
61) Texts.Insert(F.text, F.carloc.pos, buf);
62) SetCaret(F, F.carloc.pos + (end - beg))
63) END
64) ELSIF (0 IN keysum) & "(1 IN keysum) THEN
65) Oberon.GetSelection(text, beg, end, time);
66) IF time >= 0 THEN
67) Texts.OpenReader(R, F.text, F.carloc.pos); Texts.Read(R, ch);
68) Texts.ChangeLooks(text, beg, end, {0, 1, 2}, R.fnt, R.col, R.voff)
69) END
70) END
73) END
74) END
75) END
76) END Edit;
Пояснения:
И) обновить курсор;
12-35) управление мышью в линейке прокрутки;
13-28) если нажата правая или средняя кнопка;
14-18) вести мышь, пока все кнопки не отпущены;
19-24) если левая кнопка не была тоже нажата;
20-22) вычислить новый верхний край;
23) удалить все маркеры, чтобы монополизировать кадр;
24) перейти к новому верхнему краю;
25-28) если правая кнопка не была нажата;
126
26) удалить все маркеры, чтобы монополизировать кадр;
27) перейти в конец;
29-35) если нажата левая кнопка;
30) вести мышь, чтобы определить новую верхнюю строку;
31-34) если правильно, то прокрутить до новой верхней строки;
36-75) управление мышью в пределах области текста;
37-49) если нажата правая кнопка («кнопка выделения»);
38) вести мышь для определения выделения;
39-49) если выделение правильно;
40-43) если нажата еще и левая (но не средняя) кнопка;
41) захватить фокус;
42) получить выделение;
43) удалить выделенный участок текста;
44-48) если нажата еще и средняя (но не левая) кнопка;
45) получить выделение;
46-47) копирование из выделенного участка в фокус;
50-52) если нажата средняя кнопка («кнопка выполнения»);
51) вести мышь, чтобы определить имя;
52) если правильно, вызвать команду с этим именем;
53-74) если нажата левая кнопка («кнопка указания»);
54) захватить фокус и вести мышь для определения символа вставки;
55-73) если символ вставки достигнут;
56-63) если нажата еще и средняя (но не правая) кнопка;
57) получить самое новое выделение;
58-63) если существует;
59) создать и открыть буфер;
60) сохранить самое новое выделение в буфере;
61) вставить его у символа вставки;
64-70)
65) получить самое новое выделение;
66-69) если существует;
67) открыть читателя на символе вставки и прочитать один
символ;
68) сменить обличие выделенного участка на обличие про¬
читанного символа.
В частности, мы видим, что операция редактирования задается первой нажа¬
той кнопкой (первичной кнопкой) я может затем изменяться «сонажатием», то есть
нажатием вторичной кнопки с удержанием первичной. По умолчанию (со)нажатие
всех кнопок значит аннулирование операции. Обратите внимание, что интерпре¬
тация событий мыши в линейке прокрутки отличается от их интерпретации в об¬
ласти текста. Таблицы 5.2а и 5.26 обобщают эти два случая. Они могут быть легко
выведены из приведенных выше пояснений.
Текстовые кадры
127
Таблица 5.2а (в линейке прокрутки)
Кнопка
-
Левая
Левая
Прокрутка вверх
-
Средняя
Переход на мышь
Переход в конец
Правая
Переход в начало
-
Таблица 5.26 (в области текста)
Кнопка
-
Левая
Средняя |
Левая
Установить символ
вставки
-
Копировать обличие 1
Средняя
Выполнить команду
Загрузить и выполнить команду
-
Правая
Выделить
Выделить и удалить
Выделить и копировать
В области текста кнопки интерпретируются согласно их обобщенной семан¬
тике:
□ левая кнопка = кнопка указания;
□ средняя кнопка = кнопка выполнения;
□ правая кнопка = кнопка выделения.
Давайте «нырнем» в одну из операций редактирования, например в TrackCaret
в строке 54.
PROCEDURE TrackCaret (F: Frame; X, Y: INTEGER; VAR keysum: SET);
VAR loc: Location;
keys: SET;
BEGIN
1) IF F.trailer.next # F.trailer THEN
2) LocateChar(F, X - F.X, Y - F.Y, F.carloc);
3) FlipCaret(F);
4) keysum := {};
REPEAT
Input.Mouse(keys, X, Y);
keysum := keysum + keys;
Oberon.DrawCursor(Oberon.Mouse, Oberon.Mouse.marker, X, Y);
LocateChar(F, X - F.X, Y - F.Y, loc);
IF loc.pos # F.carloc.pos THEN FlipCaret(F); F.carloc := loc; FlipCaret(F) END
5) UNTIL keys = {};
6) F.car := 1
END
END TrackCaret;
Пояснения:
1) страж гарантирует непустую цепочку строк;
2) встать на указанный символ;
3) перевести символ вставки в новое положение;
4-5) согласованно перемещать мышь и переводить символ вставки;
6) установить состояние символа вставки.
Текстовая система
128 I
TrackCaret использует две вспомогательные процедуры Flip Caret и Locate Char.
FlipCaret используется для выключения или включения шаблона символа встав¬
ки. LocateChar - важная операция, которая используется для определения поло¬
жения символа в заданной декартовой координате (х, у) внутри кадра.
PROCEDURE FlipCaret (F: Frame);
BEGIN
1) IF F.carloc.x < F.W THEN
2) IF (F.carloc.y >= 10) & (F.carloc.x + 12 < F.W) THEN
3) Display.CopyPattern(Display.white, Display.hook,
F.X + F.carloc.x, F.Y + F.carloc.y - 10, 2)
END
END
END FlipCaret;
Пояснения:
1-2) если есть место для изображения символа вставки;
3) копировать стандартный шаблон символа вставки в инверсном видсорежиме.
PROCEDURE LocateChar (F: Frame; x, у: INTEGER; VAR loc: Location);
VAR R: Texts.Reader;
pat: Display.Pattern;
pos, lim: LONGINT;
ox, dx, u, v, w, h: INTEGER;
1) BEGIN LocateLine(F, y, loc);
2) lim := loc.org + loc.lin.len - 1;
3) pos := loc.org; ox := F.left;
4) Texts.0penReader(R, F.text, loc.org); Texts.Read(R, nextCh);
5) LOOP
IF pos = lim THEN dx := eolW; EXIT END;
6) Display.GetChar(R.fnt.raster, nextCh, dx, u, v, w, h, pat);
IF ox + dx > x THEN EXIT END;
INC(pos); ox := ox + dx; Texts.Read(R, nextCh)
7) END;
8) loc.pos := pos; loc.dx := dx; loc.x := ox
END LocateChar;
Пояснения:
1) определить положение строки текста, соответствующее у\
2) установить предел последнего фактического символа в этой строке;
3) начать цикл определения положения с первого символа строки;
4) установить читатель и считать первый символ строки;
5-7) просмотреть символы строки до предела или до х;
6) получить ширину dx текущего символа;
8) возвратить найденное положение.
Отметим, что необходимость читать символы текста (повторно) в LocateChar
коренится в так называемых пропорциональных шрифтах текста, которыми он
Текстовые кадры
129
130
Текстовая система
представлен. Мы обнаружили, что благодаря возможностям буферизации низле-
жащей файловой системы хранение ширины символа - ненужная оптимизация. В
случае же шрифтов фиксированной ширины, конечно, было бы вполне достаточно
простого деления на ширину символа.
Наконец, процедура LocateLine использует цепочку строк для определения по¬
ложения нужной строки текста, не читая текст вообще.
PROCEDURE LocateLine (F: Frame; у: INTEGER; VAR loc: Location);
VAR T: Texts.Text; L: Line; org: LONGINT; cury: INTEGER;
BEGIN T := F.text;
1) org := F.org; L := F.trailer.next; cury := F.H - F.top - asr;
2) WHILE (L.next # F.trailer) & (cury > у + dsr) DO
org := org + L.len; L := L.next; cury := cury - lsp
3) END;
4) loc.org := org; loc.lin := L; loc.у := cury
END LocateLine;
Пояснения:
1) начать с первой строки кадра;
2-3) пройти по цепочке строк до последней или до у\
4) вернуть найденную строку.
Наша следующая, вслед за редактированием текста, тема - это отображение
(прорисовка) текста. Давайте разберем случай из строки 56 в процедуре Edit, когда
пользователь нажал левую кнопку-указатель, а затем нажал еще и среднюю кноп¬
ку Напомним, что notifier вызывается в конце каждой операции редактирования
и, в частности, в конце Texts.Insert. В случае стандартных текстовых кадров notifier
просто посылает сообщение об обновлении в пространство отображения:
PROCEDURE NotifyDisplay (Т: Texts.Text; op: INTEGER; beg, end: LONGINT);
VAR M: UpdateMsg;
BEGIN M.id := op; M.text := T; M.beg := beg; M.end := end; Viewers.Broadcast(M)
END NotifyDisplay;
Теперь давайте рассмотрим реакцию текстового кадра на получение сообщения
об обновлении. Взглянув на строку 9 обработчика текстового кадра, мы увидим,
что там вызывается процедура Update, которая, в свою очередь, вызывает проце¬
дуру Insert модуля TextFrames:
PROCEDURE Insert (F: Frame; beg, end: LONGINT);
VAR R: T^xts.Reader; L, LO, 1: Line;
org, len: LONGINT; curY, botY, YO, Y1, Y2, dY, wid: INTEGER;
BEGIN
IF beg < F.org THEN F.org : = F.org + (end - beg)
ELSE
2) WHILE (L.next # F.trailer) & (cury > у + dsr) DO
org := org + L.len; L := L.next; cury := cury -
Текстовые кадры
131
3) END;
org := org + L.len; L := L.next; curY := curY - lsp
2) END;
3) IF L # F.trailer THEN
botY := F.Y + F.bot + dsr;
4) Texts.OpenReader(R, F.text, org); Texts.Read(R, nextCh);
5) len := beg - org; wid := Width(R, len);
6) ReplConst (F.col, F, F.X + F.left + wid, curY - dsr, L.wid - wid, lsp, 0);
7) DisplayLine(F, L, R, F.X + F.left + wid, curY, len);
8) org := org + L.len; curY := curY - lsp; Y0 := curY; L0 := L.next;
WHILE (org <= end) & (curY >= botY) DO
NEW(l);
Display.ReplConst(F.col, F.X + F.left, curY - dsr, F.W - F.left, lsp, 0);
DisplayLine(F, 1, R, F.X + F.left, curY, 0); L.next := 1; L := 1;
org := org + L.len; curY := curY - lsp
9) END;
10) IF L0 # L.next THEN Y1 := curY;
11) L.next := L0;
WHILE (L.next # F.trailer) & (curY >= botY) DO
L := L.next; curY := curY - lsp
12) END;
L.next := F.trailer; dY := Y0 - Y1;
IF Y1 > curY + dY THEN
13) Display.CopyBlock
(F.X + F.left, curY + dY + lsp - dsr, F.W - F.left,
Y1 - curY - dY, F.X + F.left, curY + lsp - dsr, 0);
Y2 := Y1 - dY
ELSE Y2 := curY
END;
14) curY := Y1; L := L0;
WHILE curY # Y2 DO
Display.ReplConst(F.col, F.X + F.left, curY - dsr, F.W - F.left, lsp, 0);
DisplayLine(F, L, R, F.X + F.left, curY, 0);
L := L.next; curY := curY - lsp
15) END
END
END
END;
16) UpdateMark(F)
END Insert;
Некоторые пояснения:
1-2) найти строку, где начинается вставляемая часть;
3) если она отображается в этом окошке;
4) установить читатель на эту строку;
5) получить ширину неизменяемой части строки (не трогать ее);
6) очистить остаток строки;
7) отобразить новый остаток строки;
8-9) отобразить вновь вставленные строки текста;
10) если это не было однострочным обновлением;
132
Текстовая система
11-12) пропустить записанные поверх строки текста;
13) применить быстрое перемещение блока для корректировки повторно ис¬
пользуемых строк;
14-15) отобразить вновь ранее записанные поверх строки текста;
16) корректировать маркер позиции.
Особое внимание в реализации уделено устранению «мерцания» и минимиза¬
ции времени обработки. Конкретно предприняты следующие меры:
1) устранена повторная запись одних и тех же данных;
2) сведено к минимуму число заново перерисованных строк текста;
3) применено перемещение блоков для корректировки повторно используе¬
мых отображаемых строк.
Конечно, правила, управляющие перерисовкой и форматированием, карди¬
нально влияют на сложность процедур, подобных Insert. Для текстовых кадров мы
сознательно выбрали самый простой набор возможных правил форматирования,
которые можно свести к следующим:
1) для данного текстового кадра межстрочные интервалы постоянны;
2) неявные разрывы строк отсутствуют.
Именно такой набор правил позволяет отобразить текстовую строку за один
проход. Если же межстрочные интервалы должны подгоняться под размеры
шрифтов или строки могут неявно рваться, то неизбежны два прохода.
Алгоритмы обновления используют следующие однопроходные процедуры
перерисовки Width и DisplayLine:
PROCEDURE Width (VAR R: Texts.Reader; len: LONGINT): INTEGER;
VAR pat: Display.Pattern; pos: LONGINT; ox, dx, x, y, w, h: INTEGER;
1) BEGIN pos := 0; ox := 0;
WHILE pos ft len DO
Display.GetChar(R.fnt.raster, nextCh, dx, x, y, w, h, pat);
ox := ox + dx; INC(pos); Texts.Read(R, nextCh)
2) END;
3) RETURN ox
END Width;
Пояснения:
1-2) пройти no len символам этой строки;
3) вернуть накопленную ширину.
Заметим, что процедуры Width и LocateChar схожи. Поэтому вышеупомянутое
замечание об использовании возможностей буферизации низлежащей файловой
системы в равной степени относится и к процедуре Width.
PROCEDURE DisplayLine (F: Frame; L: Line;
VAR R: Texts.Reader; X, Y: INTEGER; len: LONGINT);
VAR pat: Display.Pattern; NX, dx, x, y, w, h: INTEGER;
1) BEGIN NX := F.X + F.W;
2) WHILE (nextCh # CR) & (R.fnt tt NIL) DO
3) Display.GetChar(R.fnt.raster, nextCh, dx, x, y, w, h, pat);
4) IF (X + x + w <= NX) & (h # 0) THEN
5) Display.CopyPattern(R.col, pat, X + x, Y + y, 2)
6) END;
7) X := X + dx; INC(len); Texts.Read(R, nextCh)
8) END;
9) L.len := len + 1; L.wid := X + eolW - (F.X + F.left);
10) L.eot := R.fnt = NIL; Texts.Read(R, nextCh)
END DisplayLine;
Пояснения:
1) установить правую границу;
2-8) отобразить символы этой строки;
3) получить ширину dx, блок х, y,w,hn шаблон pat следующего символа;
4) если есть достаточно места в прямоугольнике содержимого;
5) отобразить шаблон;
7) перейти к позиции следующего символа; прочитать следующий символ;
9-10) установить дескриптор строки.
Процедура DisplayLine тоже подобна LocateChar, и замечание об использова¬
нии возможностей буферизации файловой системы применимо и здесь. Основ¬
ное различие между LocateChar и Width, с одной стороны, и DisplayLine, с другой,
в том, что последней физически доступен экран дисплея. Поэтому владение бло¬
кировкой экрана - молчаливое предусловие вызова DisplayLine.
Заключает нашу экскурсию за кулисы текстовой системы быстрое знакомство
со вспомогательной процедурой, которая обновляет маркер позиции:
PROCEDURE UpdateMark (F: Frame);
VAR oldH: INTEGER;
BEGIN
1) oldH := F.markH; F.markH := SH0RT(F.org * F.H DIV (F.text.len + 1));
IF (F.mark > 0) & (F.left >= barW) & (F.markH # oldH) THEN
2) Display.ReplConst(Display.white, F.X + 1, F.Y + F.H - 1 - oldH, markW, 1, 2);
3) Display.ReplConst(Display.white, F.X + 1, F.Y + F.H - 1 - F.markH, markW, 1, 2)
END
END UpdateMark;
Пояснения:
1) показывает, как вычисляется позиция маркера. Грубо говоря, это неизмен¬
ная пропорция:
расстояние от верха кадра / высота кадра = позиция первого символа текс¬
та в кадре / длина текста;
2) стереть старый маркер;
3) нарисовать новый маркер.
А она, в свою очередь, завершает наш раздел о текстовых кадрах. Подыто¬
жим самое важное. Задачи редактирования текста (ориентированного на ввод)
Текстовые кадры
133
134
Текстовая система
и прорисовки текста (ориентированной на вывод) объединены понятием тексто¬
вого кадра. Текстовые кадры образуют подкласс кадров отображения и реализу¬
ются в отдельном модуле TextFrames. Отображаемый текст доступен реализации
TextFrames исключительно из «официального» абстрактного интерфейса модуля
Texts, обсужденного в разделе 5.2. Он поддерживает собственную структуру дан¬
ных из цепочек строк, чтобы ускорить позиционирование. Текстовые кадры ис¬
пользуют простые правила форматирования, которые обеспечивают сверхэффек-
тивную прорисовку текста за один проход. В частности, для каждого текстового
кадра устанавливается фиксированный межстрочный интервал. Поэтому внутри
заданного текстового кадра возможны разные стили основного шрифта, но не
разные его размеры.
В отношении различных производных типа Display.Frame, с которым мы стал¬
кивались в главах 4 и 5, получаем иерархию типов в табл. 5.3, где типы вышеле¬
жащих строк - это расширения соответствующего им базового типа низлежащей
строки:
Таблица 5.3
Viewers.Track
MenuViewers. Viewer
Viewers.Viewer
TextFrames. Frame
Display. Frame
5.4. Шрифтовой аппарат
В предыдущих разделах мы видели, что тексты Оберона поддерживают специ¬
фикации атрибутов («обличия») для символов. Поддерживаются три разных
атрибута - шрифт, цвет и вертикальное смещение. Сначала давайте сосредото¬
чимся на атрибуте шрифт. Шрифт можно считать стилем, в котором создан стан¬
дартный набор символов. Как правило, весь текст набирается в одном стиле, то
есть существует один шрифт на текст. Однако иногда автор хочет выделить за¬
головки или слова, изменяя размер шрифта, его жирность или наклон. В специ¬
альных текстах могут встречаться специальные символы вроде математических
символов или иных знаков. В еще более сложных документах текст может изо¬
биловать математическими или химическими формулами.
Эти наблюдения приводят нас к различной интерпретации понятия шрифта.
Можно считать шрифт индексированной библиотекой (графических) объектов,
главным образом, но не обязательно, начертаний (glyphs). В случае обычных сим¬
волов естественно использовать код ASCII в качестве индекса, что приводит нас
к интерпретации текста как последовательности пар (библиотека, индекс). Заме¬
тим, что этот очень общий взгляд, в принципе, равносилен определению текста как
последовательности произвольных объектов.
Модель отображения символов предусматривает два уровня абстракции. На
первом уровне символы - это черные ящики (блоки), заданные набором метриче¬
ских данных х, у, w, h и dx. (х, у) - вектор от текущей точки отсчета на основной
линии к началу координат ящика, wnh- ширина и высота ящика, vl dx- рассто¬
яние до точки отсчета следующего символа на той же основной линии. На втором
уровне абстракции символ задается цифровым шаблоном или начертанием, кото¬
рое должно быть изображено в ящике. На рис. 5.5 показана эта модель символов.
Два дополнительных атрибута символа - цвет и вертикальное смещение - ста¬
новятся теперь параметрами модели отображения символа. Вертикальное смеще¬
ние позволяет перенести г/-координату вектора (x,y)By + voff,a атрибут цвет
задает цвет шаблона.
Хорошими примерами процедур, работающих на первом уровне абстракции,
являются рассмотренные в предыдущем разделе LocateChar и Width, как и форма-
тизаторы текста для удаленного принтера. Напротив, процедура DisplayLine рабо¬
тает на втором уровне.
Представление символов в виде цифровых шаблонов - это лишь последний
этап сложного процесса. Вначале есть обобщенное описание формы каждого сим¬
вола в виде контуров и подсказок (hints). Контур, как правило, состоит из пря¬
мых линий и сплайновых кривых. Подсказки включаются для того, чтобы помочь
оцифровщику в его усилиях точно отобразить заполненные контуры символов на
растр устройства. Например, подсказка может гарантировать постоянство форм
Шрифтовой аппарат
135
136
Текстовая система
с засечками и размеров основы по всему шрифту в тексте, независимо от позиций
символов относительно линий сетки. Автоматическая оцифровка создает циф¬
ровые шаблоны достаточно высокого качества для разрешений печатных носи¬
телей. Однако для разрешений экрана мы предпочли добавить этап ручной на¬
стройки. Это та причина, по которой цифровые шаблоны в Обероне не создаются
«на лету».
Управление шрифтом в Обероне сосредоточено в модуле Fonts с расширением
нижнего уровня в модуле Display, с которым мы уже знакомы из главы 4. Интер¬
фейс модуля Fonts очень прост и невелик:
MODULE Fonts;
IMPORT Display;
TYPE
Name = ARRAY 32 OF CHAR;
Font = POINTER TO FontDesc;
FontDesc = RECORD
name: Name;
height, minX, maxX, minY, maxY INTEGER;
raster: Display.Font
END;
VAR Default: Font;
PROCEDURE This (name: ARRAY OF CHAR): Font;
END Fonts.
Поле name в типе Font - это имя соответствующего файла. Поля height, тахХ,
minY и maxY - высота строки и итоговые метрические данные, а поле raster ссы¬
лается на упомянутое расширение низкого уровня в модуле Display. Default - это
общесистемный шрифт по умолчанию. Он устанавливается при загрузке системы.
Это процедура загрузки шрифта из файла, заданного его именем.
Определение низкоуровнего расширения для управления шрифтом таково:
MODULE Display;
TYPE
Font = POINTER TO Bytes;
Bytes = RECORD END;
PROCEDURE GetChar (f: Font; ch: CHAR; VAR dx, x, y, w, h: INTEGER;
VAR p; Pattern);
END Display.
Тип Display.Font - это указатель на запись открытой длины, содержащей мет¬
рические описания и шаблоны всех символов шрифта. Процедура GetChar возвра¬
щает метрические данные dx, х, у, w, h и шаблонр символа ch в шрифте/.
Тип Font должен рассматриваться как абстрактный тип данных с двумя встро¬
енными операциями This и GetChar. Понимая неизменную природу шрифта, мно¬
гочисленные внутренние копии одного и того же шрифта, конечно, нежелательны.
Поэтому загруженные шрифты кэшируются в собственном списке, который за¬
являет о себе собственным полем next в типе FontDesc:
Font = POINTER ТО FontDesc;
FontDesc = RECORD
name: Name;
height, minX, maxX, minY, maxY: INTEGER;
raster: Display.Font;
—» next: Font
END;
Кэш поддерживается процедурой загрузки This согласно следующей схеме:
найти шрифт в кэше;
IF найден THEN вернуть кэшируемую загрузку
ELSE загрузить шрифт; кэшировать его
END
Реализация типа Font создала немного проблем. Одна из них - нежелательный
побочный эффект кэширования. Проблема возникает, когда шрифт используется
лишь короткое время. Поскольку он кэшируется, он никогда не будет убираться
системным сборщиком мусора. В таких крайних случаях, как сервер печати с мно¬
жеством огромных шрифтов, есть все шансы заполнить память неиспользуемыми
шрифтами. В этом и в аналогичных ему случаях есть только один очевидный вы¬
ход - дать сборщику мусора доступ к кэшу шрифтов.
Мы заканчиваем этот раздел формальной спецификацией формата файла
шрифта. Отметим, что, с одной стороны, формат файла целиком принадлежит
управляющему модулю, а с другой - он должен быть крайне стабильным, потому
что может использоваться для долговременного резервного копирования и широ¬
комасштабного обмена данными.
Вот РБНФ-спецификация файлов шрифта Оберона:
FontFile = ident header contents.
header = abstraction family variant height minX maxX minY maxY.
contents = nofRuns { beg end } { dx x у w h } { rasterByte }.
ident, abstraction, family и variant - это однобайтовые значения, задающие
идентификацию файла, абстракцию (первый уровень без растровых байтов, вто¬
рой - с растровыми), семейство шрифтов (Times Roman, Syntax и т. д.) и вариант
(жирный, курсив и т. д.). Значения height, minX, maxX, minY и maxY - двухбай-
Шрифтовой аппарат
137
138
Текстовая система
товые. Они задают высоту строки, а также минимальные и максимальные х и у
координаты (блока) соответственно. Все значения в продукции contents - двух¬
байтовые. nofRuns задает число рядов (интервалов без промежутков) в пределах
диапазона кода ASCII, а каждая пара [beg, end) описывает один ряд. Четверка (dx,
x,y,w,h) - это метрические данные символов (в порядке кода ASCII), а последо¬
вательность rasterByte задает всю растровую информацию.
Итак, шрифты в Обероне - это индексированные библиотеки объектов. Объ¬
екты - это описания изображений символов на двух уровнях абстракции - как
метрические данные «черных ящиков» и как двоичные шаблоны (начертания).
Тип Font - это абстрактный тип данных со встроенными операциями загрузки
и получения данных о символьном объекте. Загруженные шрифты кэшируются
в собственном списке.
5.5. Набор инструментов
редактирования
Мы видели, что каждый текстовый кадр интегрируется с интерактивным ре¬
дактором текста, который мы можем считать интерпретатором набора встроенных
(внутренних) команд. Конечно, нам хотелось бы иметь возможность расширять
этот набор своими (внешними) командами редактирования. Это и вправду стоя¬
щий тест для любой структуры или базового инструментария - попробовать и до¬
бавить дополнительные инструменты без швов. Модуль Edit - результат такой по¬
пытки. Это набор инструментов, состоящий из некоторых стандартных внешних
команд редактирования.
Вот его определение:
DEFINITION Edit;
PROCEDURE Open; (^открыть текстовое окошко*)
PROCEDURE Show; (*показать текст*)
PROCEDURE Locate; (*установить позицию*)
PROCEDURE Search; (*найти шаблон*)
PROCEDURE Store; (*запомнить текст*)
PROCEDURE Recall; (*восстановить удаленный текст*)
PROCEDURE CopyFont;
PROCEDURE ChangeFont;
PROCEDURE ChangeColor;
PROCEDURE ChangeOffset;
PROCEDURE Print; (напечатать текст*)
END Edit.
Первая группа команд в этом наборе инструментов используется для отобра¬
жения, определения положения и сохранения текста или его частей. В свою оче¬
редь, они открывают текстовый файл и отображают его, открывают текст програм¬
мы и показывают объявление данного объекта, определяют положение заданной
позиции в отображаемом тексте (основное применение - место ошибки, найден¬
ной компилятором), находят шаблон и сохраняют текущее состояние отобра¬
женного текста. Команды следующей группы связаны с редактированием. Они
позволяют восстанавливать ранее удаленную часть текста, копировать шрифт те¬
кущего выделения текста и менять его атрибуты. Отметим, что команды CopyFont,
ChangeFont, ChangeColorn ChangeOffset - это внешние разновидности внутренних
операций смены обличил. Наконец, команда Print печатает указанный текст.
Реализации инструментальных команд приводятся в разделе реализации. От¬
метим, что реализация команды Print опирается на модуль по имени Printer. Он
представляет собой абстрактный принтер и состоит из набора процедур доступа
к устройству печати и собственно печати строк текста и графических элементов.
Он определяется следующим образом:
DEFINITION Printer;
VAR PageWidth, PageHeight, res: INTEGER; (*результат*)
PROCEDURE Open (VAR name, user: ARRAY OF CHAR; password: LONGINT);
(*res = 0: открыт, 1: нет принтера, 2: нет связи, 3: не отвечает, 4: нет доступа*)
PROCEDURE UseListFont (VAR name: ARRAY OF CHAR);
PROCEDURE String (x, y: INTEGER; VAR s, fname: ARRAY OF CHAR);
PROCEDURE ContString (VAR s, fname: ARRAY OF CHAR); ^продолжение*)
PROCEDURE Line (xO, yO, x1, y1: INTEGER);
PROCEDURE Circle (xO, yO, r: INTEGER);
PROCEDURE Ellipse (xO, yO, a, b: INTEGER);
PROCEDURE Spline (xO, yO, n, open: INTEGER; VAR X, Y: ARRAY OF INTEGER);
PROCEDURE Picture (x, y, w, h, mode: INTEGER; adr: LONGINT);
PROCEDURE ReplConst (x, y, w, h: INTEGER);
PROCEDURE ReplPattem (x, y, w, h, col: INTEGER);
PROCEDURE Page (nofcopies: INTEGER);
PROCEDURE Close;
END Printer.
Пояснения:
Модель печати - постраничная. Процедуры Open и Close используются для
открытия и закрытия сеанса печати. Процедура UseListFont устанавливает под¬
ходящий шрифт для печатных листов. Процедуры String, ContString, Line, Circle,
Ellipse, Spline, Picture, ReplConst и ReplPattem вызываются для размещения на те¬
кущей странице строки, прямой линии, круга, эллипса, сплайна, оцифрованной
картинки или затененного прямоугольника соответственно. Эти процедуры, как
правило, вызываются неоднократно до тех пор, пока нужная страница целиком
не заполнится. После этого вызывается процедура Page, которая создает фактиче¬
скую копию этой страницы.
Реализация модуля Printer зависит от среды. Альтернативно он может управ¬
лять локальным принтером или генерировать программу для удаленной печати.
В главе 10 приводится вариант интегрированного сервера печати для локальной
сети. Для каждого сеанса печати генерируется и затем отправляется на сервер так
называемый файл печати.
Набор инструментов редактирования
139
140
Текстовая система
Литература
1. J. Gutknecht, «Concept of the Text Editor Lara», Communications of the ACM,
Sept. 1985, Vol.28, No. 9.
2. W. Teitelman, «А tour through Cedar», IEEE Software, 1, (2), 44-73 (1984).
Полная реализация
MODULE Fonts; (*JG 18.11.90*)
IMPORT SYSTEM, Display, Files;
CONST FontFileld = ODBX;
TYPE
Name* = ARRAY 32 OF CHAR;
Font* = POINTER TO FontDesc;
FontDesc* = RECORD
name*: Name;
height*, minX*, maxX*, minY*, maxY*: INTEGER;
raster*: Display.Font;
next: Font
END;
VAR Default*, First: Font; nofFonts: INTEGER;
PROCEDURE This* (name: ARRAY OF CHAR): Font;
TYPE
RunRec = RECORD beg, end: INTEGER END;
BoxRec = RECORD dx, x, y, w, h: INTEGER END;
VAR
F: Font;
f: Files.File; R: Files.Rider;
NofBytes, RasterBase, A, a: LONGINT;
NofRuns, NofBoxes: INTEGER;
к, 1, m, n: INTEGER;
ch: CHAR;
run: ARRAY 16 OF RunRec;
box: ARRAY 256 OF BoxRec;
PROCEDURE Enter (d: LONGINT);
BEGIN
SYSTEM.PUT(A, d MOD 256); INC(A);
Полная реализация
141
SYSTEM.PUT(A, d DIV 256); INC(A)
END Enter;
BEGIN F := First;
WHILE (F # NIL) & (name # F.name) DO F := F.next END;
IF F = NIL THEN
f := Files.Old(name);
IF f # NIL THEN
Files.Set(R, f, 0); Files.Read(R, ch);
IF ch = FontFileld THEN
Files.Read(R, ch); (*abstraction*)
Files.Read(R, ch); (*family*)
Files.Read(R, ch); (*variant*)
NEW(F);
Files.ReadBytes(R, F.height, 2);
Files.ReadBytes(R, F.minX, 2); Files.ReadBytes(R, F.maxX, 2);
Files.ReadBytes(R, F.minY, 2); Files.ReadBytes(R, F.maxY, 2);
Files.ReadBytes(R, NofRuns, 2);
NofBoxes := 0; к := 0;
WHILE к # NofRuns DO
Files.ReadBytes(R, run[k].beg, 2); Files.ReadBytes(R, run[k].
end, 2);
NofBoxes := NofBoxes + run[k].end - run[k].beg;
INC(k)
END;
NofBytes := 512 + 5; 1 := 0;
WHILE 1 # NofBoxes DO
Files.ReadBytes(R, box[l].dx, 2);
Files.ReadBytes(R, box[l].x, 2); Files.ReadBytes(R, box[l].y, 2);
Files.ReadBytes(R, box[l].w, 2); Files.ReadBytes(R, box[l].h, 2);
NofBytes := NofBytes + 5 + (box[l].w + 7) DIV 8 * box[l].h;
INC(l)
END;
SYSTEM.NEW(F.raster, NofBytes);
RasterBase := SYSTEM.VAL(LONGINT, F.raster);
A := RasterBase; a := A + 512;
SYSTEM.PUT(a, OX); INC(a); (*dummy ch*)
SYSTEM.PUT(a, OX); INC(a);
SYSTEM.PUT(a, OX); INC(a);
SYSTEM.PUT(a, OX); INC(a);
SYSTEM.PUT(a, OX); INC(a);
к := 0; 1 := 0; m := 0;
WHILE к < NofRuns DO
WHILE m < run[k].beg DO Enter(515); INC(m) END;
WHILE m < run[k].end DO Enter(a + 3 - RasterBase);
SYSTEM.PUT(a, box[l].dx MOD 256); INC(a);
SYSTEM.PUT(a, box[l].x MOD 256); INC(a);
SYSTEM.PUT(a, box[l].y MOD 256); INC(a);
SYSTEM.PUT(a, box[l].wM0D 256); INC(a);
SYSTEM.PUT(a, box[l].h MOD 256); INC(a);
142
Текстовая система
n := (box[l].w + 7) DIV 8 * box[l].h;
WHILE n # 0 DO
Files.Read(R, ch); SYSTEM.PUT(a, ch); INC(a); DEC(n)
END;
INC(l); INC(m)
END;
INC(k)
END;
WHILE m < 256 DO Enter(515); INC(m) END;
C0PY(name, F.name);
IF nofFonts < 12 THEN INC(nofFonts); F.next := First; First := F END
ELSE F := Default
END
ELSE F := Default
END
END;
RETURN F
END This;
BEGIN Default := This("Syntax10.Sen.Fnt"); nofFonts := 1
END Fonts.
MODULE Texts; (*JG 21.11.90*)
IMPORT Files, Fonts, Reals;
CONST
(*классы символов*)
Inval* = 0; (*некорректный символ*)
Name* = 1; (*имя s (длина len)*)
String* = 2; (*строка литер s (длина len)*)
Int* = 3; (*целое i (десятичное или шестнадцатеричное)*)
Real* = 4; (*вещественное число х*)
LongReal* = 5; (*длинное вещественное число *)
Char* = 6; ^специальный символ с*)
TAB = 9Х; CR = ODX; maxD = 9;
(* TextBlock = TextBlockld off run {run} 0 len {AsciiCode}.
run = fnt [name] col voff len. *)
TextBlockld = 1FFH;
replace* = 0; insert* = 1; delete* = 2; (*коды операций*)
TYPE
Piece = POINTER TO PieceDesc;
PieceDesc = RECORD
f: Files.File;
off: LONGINT;
len: LONGINT;
Полная реализация
fnt: Fonts.Font;
col: SHORTINT;
voff: SHORTINT;
prev, next: Piece
END;
Text* = POINTER TO TextDesc;
Notifier* = PROCEDURE (T: Text; op: INTEGER; beg, end: LONGINT);
TextDesc* = RECORD
len*: LONGINT;
notify*: Notifier;
trailer: Piece;
org: LONGINT; (*кэш-память *)
pee: Piece
END;
Reader* = RECORD (Files.Rider)
eot*: BOOLEAN;
fnt*: Fonts.Font;
col*: SHORTINT;
voff*: SHORTINT;
ref: Piece;
org: LONGINT;
off: LONGINT
END;
Scanner* = RECORD (Reader)
nextCh*: CHAR;
line*: INTEGER;
class*: INTEGER;
i*: LONGINT;
x*: REAL;
y*: LONGREAL;
c*: CHAR;
len*: SHORTINT;
s*: ARRAY 32 OF CHAR
END;
Buffer* = POINTER TO BufDesc;
BufDesc* = RECORD
len*: LONGINT;
header, last: Piece
END;
Writer* = RECORD Files.Rider)
buf*: Buffer;
fnt*: Fonts.Font;
col*: SHORTINT;
voff*: SHORTINT
143
144
Текстовая система
END;
VAR W: Writer; WFile: Files.File; DelBuf: Buffer;
PROCEDURE EQ (VAR s, t: ARRAY OF CHAR): BOOLEAN;
VAR i: INTEGER;
BEGIN i := 0;
WHILE (s[i] # OX) & (t[i] # OX) & (s[i] = t[i]) DO INC(i) END;
RETURN s[i] = t[i]
END EQ;
PROCEDURE ReadName (VAR R: Files.Rider; VAR name: ARRAY OF CHAR);
VAR i: INTEGER; ch: CHAR;
BEGIN
i := 0; Files.Read(R, ch);
WHILE ch # OX DO name[i] := ch; INC(i); Files.Read(R, ch) END;
name[i] := OX
END ReadName;
PROCEDURE WriteName (VAR W: Files.Rider; VAR name: ARRAY OF CHAR);
VAR i: INTEGER; ch: CHAR;
BEGIN
i := 0; ch := name[i];
WHILE ch # OX DO Files.Write(W, ch); INC(i); ch := name[i] END;
Files.Write(W, OX)
END WriteName;
PROCEDURE Load* (T: Text; f: Files.File; pos: LONGINT; VAR len: LONGINT);
VAR
R: Files.Rider;
Q, q, p: Piece;
off: LONGINT;
N, fnt: SHORTINT;
FName: ARRAY 32 OF CHAR;
Diet: ARRAY 32 OF Fonts.Font;
BEGIN
N := 1;
NEW(Q); Q.f := WFile; Q.off := 0; Q.len := 1; Q.fnt := NIL; Q.col := 0;
Q.voff := 0; p := Q;
Files.Set(R. f, pos); Files.ReadBytes(R, off, 4);
LOOP
Files.Read(R, fnt);
IF fnt = 0 THEN EXIT END;
IF fnt = N THEN
ReadName(R, FName);
Dict[N] := Fonts.This(FName);
INC(N)
END;
NEW(q);
q.fnt := Diet[fnt];
Files.Read(R, q.col);
Files.Read(R, q.voff);
Files.ReadBytes(R, q.len, 4);
q.f := f; q.off := off;
off := off + q.len;
p.next := q; q.prev := p; p := q
END;
p.next := Q; Q.prev := p;
T.trailer := Q; Files.ReadBytes(R, T.len, 4);
T.org := - 1; T.pce ;= T.trailer; (*инициализация кэша*)
len := off - pos
END Load;
PROCEDURE Open* (T: Text; name: ARRAY OF CHAR);
VAR f: Files.File; R: Files.Rider; Q, q: Piece;
id: INTEGER; len: LONGINT;
BEGIN
f := Files.01d(name);
IF f # NIL THEN
Files.Set(R, f, 0); Files.ReadBytes(R, id, 2);
IF id = TextBlockld THEN Load(T, f, 2, len)
ELSE (*А5сИ-файл*)
len := Files.Length(f);
NEW(Q); Q.fnt := NIL; Q.col := 0; Q.voff := 0; Q.f := WFile;
Q.off := 0; Q.len := 1;
NEW(q); q.fnt := Fonts.Default; q.col := 15; q.voff := 0; q.f := f;
q.off := 0; q.len := len;
Q.next := q; q.prev := Q; q.next := Q; Q.prev := q;
T.trailer := Q; T.len := len;
T.org := - 1; T.pce := T.trailer (*инициализация кэша*)
END
ELSE (*создать новый текст*)
NEW(Q); Q.fnt := NIL; Q.col := 0; Q.voff := 0; Q.f := WFile; Q.off := 0;
Q.len := 1;
Q.next := Q; Q.prev := Q;
T.trailer := Q; T.len := 0;
T.org := - 1; T.pce := T.trailer (*инициализация кэша*)
END
END Open;
PROCEDURE OpenBuf* (B: Buffer);
BEGIN NEW(B.header); (*пустой участок*)
B.last := В.header; B.len := 0
END OpenBuf;
PROCEDURE FindPiece (T: Text; pos: LONGINT; VAR org: LONGINT; VAR p: Piece);
VAR n: INTEGER;
BEGIN
IF pos < T.org THEN T.org := - 1; T.pce := T.trailer END;
org := T.org; p := T.pce; (*из кэш-памяти*)
Полная реализация
145
146
Текстовая система
n := 0;
WHILE pos >= org + p.len DO org := org + p.len; p := p.next; INC(n) END;
IF n > 50 THEN T.org : = org; T.pce := p END
END FindPiece;
PROCEDURE SplitPiece (p: Piece; off: LONGINT; VAR pr: Piece);
VAR q: Piece;
BEGIN
IF off > 0 THEN NEW(q);
q.fnt := p.fnt; q.col := p.col; q.voff := p.voff;
q.len := p.len - off;
q.f := p.f; q.off := p.off + off;
p.len := off;
q.next := p.next; p.next := q;
q.prev := p; q.next.prev := q;
pr := q
ELSE pr := p
END
END SplitPiece;
PROCEDURE OpenReader* (VAR R: Reader; T: Text; pos: LONGINT);
VAR p: Piece; org: LONGINT;
BEGIN
FindPiece(T, pos, org, p);
R.ref := p; R.org := org; R.off := pos - org;
Files.Set(R, R.ref.f, R.ref.off + R.off); R.eot := FALSE
END OpenReader;
PROCEDURE Read* (VAR R: Reader; VAR ch: CHAR);
BEGIN
Files.Read(R, ch); R.fnt : = R.ref.fnt; R.col := R.ref.col; R.voff : = R.ref.voff;
INC(R.off);
IF R.off = R.ref.len THEN
IF R.ref.f = WFile THEN R.eot := TRUE END;
R.org := R.org + R.off; R.off := 0;
R.ref := R.ref.next; R.org := R.org + R.off; R.off := 0;
Files.Set(R, R.ref.f, R.ref.off)
END
END Read;
PROCEDURE Pos* (VAR R: Reader): LONGINT;
BEGIN RETURN R.org + R.off
END Pos;
PROCEDURE Store* (T: Text; f: Files.File; pos: LONGINT; VAR len: LONGINT);
VAR
p, q: Piece;
R: Reader; W: Files.Rider;
off, rlen: LONGINT; id: INTEGER;
N, n: SHORTINT; ch: CHAR;
Полная реализация
Diet: ARRAY 32 OF Fonts.Name;
BEGIN
Files.Set(W, f, pos);
id := TextBlockld; Files.WriteBytes(W, id, 2);
Files.WriteBytes(W, off, 4); (*держатель места*)
N := 1;
p := T.trailer.next;
WHILE p ft T.trailer DO
rlen := p.len; q := p.next;
WHILE (q # T.trailer) & (q.fnt = p.fnt) & (q.col = p.col) & (q.voff
p.voff) DO
rlen := rlen + q.len; q := q.next
END;
Diet[N] := p.fnt.name;
n : = 1;
WHILE ~EQ(Diet[n], p.fnt.name) DO INC(n) END;
Files.Write(W, n);
IF n = N THEN WriteName(W, p.fnt.name); INC(N) END;
Files.Write(W, p.col);
Files.Write(W, p.voff);
Files.WriteBytes(W, rlen, 4);
p := q
END;
Files.Write(W, 0); Files.WriteBytes(W, T.len, 4);
off := Files.Pos(W);
OpenReader(R, T, 0); Read(R, eh);
WHILE "R.eot DO Files.Write(W, ch); Read(R, ch) END;
Files.Set(W, f, pos + 2); Files.WriteBytes(W, off, 4); (*правка*)
len := off + T.len - pos
END Store;
PROCEDURE Save* (T: Text; beg, end: LONGINT; B: Buffer);
VAR p, q, qb, qe: Piece; org: LONGINT;
BEGIN
IF end > T.len THEN end := T.len END;
FindPiece(T, beg, org, p);
NEW(qb); qb" := p~;
qb.len := qb.len - (beg - org);
qb.off := qb.off + (beg - org);
qe := qb;
WHILE end > org + p.len DO
org := org + p.len; p := p.next;
NEW(q); q~ := p~; qe.next := q; q.prev := qe; qe := q
END;
qe.next := NIL; qe.len := qe.len - (org + p.len - end);
B.last.next := qb; qb.prev := B.last; B.last := qe;
B.len := B.len + (end - beg)
END Save;
PROCEDURE Copy* (SB, DB: Buffer);
147
VAR Q, q, p: Piece;
BEGIN
p := SB.header; Q := DB.last;
WHILE p it SB. last DO p : = p. next;
NEW(q); q~ := p~; Q.next := q; q.prev := Q; Q := q
END;
DB.last := Q; DB.len := DB.len + SB.len
END Copy;
PROCEDURE ChangeLooks* (T: Text; beg, end: LONGINT; sel: SET; fnt: Fonts.Font;
col, voff:
SHORTINT);
VAR pb, pe, p: Piece; org: LONGINT;
BEGIN
IF end > T.len THEN end := T.len END;
FindPiece(T, beg, org, p); SplitPiece(p, beg - org, pb);
FindPiece(T, end, org, p); SplitPiece(p, end - org, pe);
p := pb;
REPEAT
IF 0 IN sel THEN p.fnt := fnt END;
IF 1 IN sel THEN p.col := col END;
IF 2 IN sel THEN p.voff := voff END;
p := p.next
UNTIL p = pe;
T.notify(T, replace, beg, end)
END ChangeLooks;
PROCEDURE Insert* (T: Text; pos: LONGINT; B: Buffer);
VAR pi, pr, p, qb, qe: Piece; org, end: LONGINT;
BEGIN
FindPiece(T, pos, org, p); SplitPiece(p, pos - org, pr);
IF T.org >= org THEN (^подогнать кэш-память*)
T.org := org - p.prev.len; T.pce := p.prev
END;
pi := pr.prev; qb := B.header.next;
IF (qb # NIL) & (qb.f = pl.f) & (qb.off = pi.off + pi.len)
& (qb.fnt = pi.fnt) & (qb.col = pi.col) & (qb.voff = pi.voff) THEN
pi.len := pi.len + qb.len; qb := qb.next
END;
IF qb # NIL THEN qe := B.last;
qb.prev := pi; pi.next := qb; qe.next := pr; pr.prev := qe
END;
T.len := T.len + B.len; end := pos + B.len;
B.last := B.header; B.last.next := NIL; B.len := 0;
T.notify(T, insert, pos, end)
END Insert;
PROCEDURE Append* (T: Text; B: Buffer);
BEGIN Insert(T, T.len, B)
END Append;
148
Текстовая система
Полная реализация
149
PROCEDURE Delete* (T: Text; beg, end: LONGINT);
VAR pb, pe, pbr, per: Piece; orgb, orge: LONGINT;
BEGIN
IF end > T.len THEN end := T.len END;
FindPiece(T, beg, orgb, pb); SplitPiece(pb, beg - orgb, pbr);
FindPiece(T, end, orge, pe); SplitPiece(pe, end - orge, per);
IF T.org >= orgb THEN (*подогнать кэш-память*)
T.org := orgb - pb.prev.len; T.pce := pb.prev
END;
DelBuf.header.next := pbr; DelBuf.last := per.prev;
DelBuf.last.next := NIL; DelBuf.len := end - beg;
per.prev := pbr.prev; pbr.prev.next := per;
T.len := T.len - DelBuf.len;
T.notify(T, delete, beg, end)
END Delete;
PROCEDURE Recall* (VAR B: Buffer); (*удаленный текст*)
BEGIN В := DelBuf; NEW(DelBuf); OpenBuf(DelBuf)
END Recall;
PROCEDURE OpenScanner* (VAR S: Scanner; T: Text; pos: LONGINT);
BEGIN OpenReader(S, T, pos); S.line := 0; Read(S, S.nextCh)
END OpenScanner;
(♦форматы плавающей точки:
x = 1.m * 2~(e-127) bit 0: sign, bits 1- 8: e, bits 9-31: m
x = 1.m * 2~(e-1023) bit 0: sign, bits 1-11: e, bits 12-63: m *)
PROCEDURE Scan* (VAR S: Scanner);
CONST maxD = 32;
VAR ch, term: CHAR;
neg, negE, hex: BOOLEAN;
i, j, h: SHORTINT;
e: INTEGER; k: LONGINT;
x, f: REAL; y, g: LONGREAL;
d: ARRAY maxD OF CHAR;
PROCEDURE ReadScaleFactor;
BEGIN Read(S, ch);
IF ch = THEN negE := TRUE; Read(S, ch)
ELSE negE := FALSE;
IF ch = "+" THEN Read(S, ch) END
END;
WHILE ("0" <= ch) & (ch <= "9") DO
e := e * 10 + ORD(ch) - ЗОН; Read(S, ch)
END
END ReadScaleFactor;
BEGIN ch := S.nextCh; i := 0;
LOOP
150
Текстовая система
IF ch = CR THEN INC(S.line)
ELSIF (ch # " '•) & (ch # TAB) THEN EXIT
END;
Read(S, ch)
END;
IF ("A” <= CAP(ch)) & (CAP(ch) <= "Z") THEN (*имя*)
REPEAT S.s[i] := ch; INC(i); Read(S, ch)
UNTIL (CAP(ch) > "Z")
OR ("A" > CAP(ch)) & (ch > ”9")
OR ("0" > ch) & (ch # ".'•)
OR (i = 31);
S.s[i] := OX; S.len := i; S.class := 1
ELSIF ch = 22X THEN (*строка литер*)
Read(S, ch);
WHILE (ch # 22X) & (ch >= " ") & (i # 31) DO
S.s[i] := ch; INC(i); Read(S, ch)
END;
S.s[i] := OX; S.len := i + 1; Read(S, ch); S.class := 2
ELSE
IF ch = THEN neg := TRUE; Read(S, ch) ELSE neg := FALSE END;
IF(”0" <= ch) & (ch <= "9") THEN (*число*)
hex := FALSE; j := 0;
LOOP d[i] := ch; INC(i); Read(S, ch);
IF ch < "0M THEN EXIT END;
IF "9" < ch THEN
IF ("A" <= ch) & (ch <= "F") THEN hex := TRUE;
ch := CHR(0RD(ch) - 7)
ELSIF ("a" <= ch) & (ch <= "f") THEN hex := TRUE;
ch := CHR(0RD(ch) - 27H)
ELSE EXIT
END
END
END;
IF ch = "H" THEN (*шестандцатеричное число*)
Read(S, ch); S.class := 3;
IF l - j > 8 THEN j := i - 8 END;
k := ORD(d[j ]) - ЗОН; INC(j);
IF (i - j = 7) & (k >= 8) THEN DEC(k, 16) END;
WHILE j < i DO k := k * 10H + (ORD(d[j]) - ЗОН); INC(j) END;
IF neg THEN S.i := - k ELSE S.i := k END
ELSIF ch = THEN (*чтение вещественного*)
Read(S, ch); h := i;
WHILE ("0” <= ch) & (ch <= "9") DO d[i] := ch; INC(i); Read(S, ch) END;
IF ch = "D" THEN
e := 0; у := 0; g := 1;
REPEAT у := у * 10 + (ORD(d[j]) - ЗОН); INC(j) UNTIL j = h;
WHILE j < i DO g := g / 10; у := (ORD(d[j]) - ЗОН) * g + yt
INC(j) END;
ReadScaleFactor;
IF negE THEN
Полная реализация
151
IF е <= 308 THEN у := у / Reals.TenL(e) ELSE у := 0 END
ELSIF e > 0 THEN
IF e <= 308 THEN у := Reals.TenL(e) * у ELSE HALT(40) END
END;
IF neg THEN у := - у END;
S.class := 5; S.у := у
ELSE e := 0; x := 0; f := 1;
REPEAT x := x * 10 + (ORD(d[j]) - ЗОН); INC(j) UNTIL j = h;
WHILE j < i DO f := f / Ю; x := (ORD(d[j]) - ЗОН) * f + x;
INC(j) END;
IF ch = "E" THEN ReadScaleFactor END;
IF negE THEN
IF e <= 38 THEN x := x / Reals.Ten(e) ELSE x := 0 END
ELSIF e > 0 THEN
IF e <= 38 THEN x := Reals.Ten(e) * x ELSE HALT(40) END
END;
IF neg THEN x := - x END;
S.class := 4; S.x := x
END;
IF hex THEN S.class := 0 END
ELSE (^десятичное целое*)
S.class := 3; к := 0;
REPEAT к := к * 10 + (ORD(d[j]) - ЗОН); INC(j) UNTIL j = i;
IF neg THEN S.i := - к ELSE S.i := к END;
IF hex THEN S.class := 0 ELSE S.class := 3 END
END
ELSE S.class := 6;
IF neg THEN S.с := ELSE S.с := ch; Read(S, ch) END
END
END;
S.nextCh := ch
END Scan;
PROCEDURE OpenWriter* (VAR W: Writer);
BEGIN
NEW(W.buf); OpenBuf(W.buf); W.fnt := Fonts.Default; W.col := 15; W.voff := 0;
Files.Set(W, Files.New(""), 0)
END OpenWriter;
PROCEDURE SetFont* (VAR W: Writer; fnt: Fonts.Font);
BEGIN W.fnt := fnt
END SetFont;
PROCEDURE SetColor* (VAR W: Writer; col: SHORTINT);
BEGIN W.col := col
END SetColor;
PROCEDURE SetOffset* (VAR W: Writer; voff: SHORTINT);
BEGIN W.voff := voff
END SetOffset;
152
Текстовая система
PROCEDURE Write* (VAR W: Writer; ch: CHAR);
VAR p: Piece;
BEGIN
IF (W. buf. last, fnt ft W.fnt) OR (W. buf. last, col # W.col)
OR (W.buf.last.voff # W.voff) THEN
NEW(p);
p.f := Files.Base(W); p.off := Files.Pos(W); p.len := 0;
p.fnt := W.fnt; p.col := W.col; p.voff := W.voff;
p.next := NIL; W.buf.last.next := p;
p.prev := W.buf.last; W.buf.last := p
END;
Files.Write(W, ch);
INC(W.buf.last.len); INC(W.buf.len)
END Write;
PROCEDURE WriteLn* (VAR W: Writer);
BEGIN Write(W, CR)
END WriteLn;
PROCEDURE WriteString* (VAR W: Writer; s: ARRAY OF CHAR);
VAR i: INTEGER;
BEGIN i := 0;
WHILE s[i] >= " " DO Write(W, s[i]); INC(i) END
END WriteString;
PROCEDURE Writelnt* (VAR W: Writer; x, n: LONGINT);
VAR i: INTEGER; xO: LONGINT;
a: ARRAY 11 OF CHAR;
BEGIN i := 0;
IF x < 0 THEN
IF x = MIN(LONGINT) THEN WriteString(W, " -2147483648"); RETURN
ELSE DEC(n); xO := - x
END
ELSE xO := x
END;
REPEAT
a[i] := CHR(xO MOD 10 + ЗОН); xO := xO DIV 10; INC(i)
UNTIL xO = 0;
WHILE n > i DO Write(W, " "); DEC(n) END;
IF x < 0 THEN Write(W, "-") END;
REPEAT DEC(i); Write(W, a[i]) UNTIL i = 0
END Writelnt;
PROCEDURE WriteHex* (VAR W: Writer; x: LONGINT);
VAR i: INTEGER; y: LONGINT;
a: ARRAY 10 OF CHAR;
BEGIN i := 0; Write(W, " ");
REPEAT у := x MOD 10H;
IF у < 10 THEN a[i] := CHR(y + ЗОН) ELSE a[i] := CHR(y + 37H) END;
x := x DIV 10H; INC(i)
Полная реализация
153
UNTIL i = 8;
REPEAT DEC(i); Write(W, a[i]) UNTIL i = 0
END WriteHex;
PROCEDURE WriteReal* (VAR W: Writer; x: REAL; n: INTEGER);
VAR e: INTEGER; xO: REAL;
d: ARRAY maxD OF CHAR;
BEGIN e := Reals.Expo(x);
IF e = 0 THEN
WriteString(W, ” 0");
REPEAT Write(W, " "); DEC(n) UNTIL n <= 3
ELSIF e = 255 THEN
WriteString(W, " NaN");
WHILE n > 4 DO Write(W, " "); DEC(n) END
ELSE
IF n <= 9 THEN n := 3 ELSE DEC(n, 6) END;
REPEAT Write(W, " "); DEC(n) UNTIL n <= 8;
(♦записывается n цифр, 2 < n <= 8*)
IF x < 0.0 THEN Write(W, "-"); x := - x ELSE Write(W, " ") END;
e := (e - 127) * 77 DIV 256;
IF e >= 0 THEN x := x / Reals.Ten(e) ELSE x := Reals.Ten( - e) * x END;
IF x >= 10.0 THEN x := 0.1 * x; INC(e) END;
xO := Reals.Ten(n - 1); x := xO * x + 0.5;
IF x >= 10.0 * xO THEN x := x * 0.1; INC(e) END;
Reals.Convert(x, n, d);
DEC(n); Write(W, d[n]); Write(W, ".");
REPEAT DEC(n); Write(W, d[n]) UNTIL n = 0;
Write(W, "E");
IF e < 0 THEN Write(W, "-"); e := - e ELSE Write(W, "+") END;
Write(W, CHR(e DIV 10 + ЗОН)); Write(W, CHR(e MOD 10 + ЗОН))
END
END WriteReal;
PROCEDURE WriteRealFix* (VAR W: Writer; x: REAL; n, k: INTEGER);
VAR e, i: INTEGER; sign: CHAR; xO: REAL;
d: ARRAY maxD OF CHAR;
PROCEDURE seq (ch: CHAR; n: INTEGER);
BEGIN WHILE n > 0 DO Write(W, ch); DEC(n) END
END seq;
PROCEDURE dig (n: INTEGER);
BEGIN
WHILE n > 0 DO
DEC(i); Write(W, d[i]); DEC(n)
END
END dig;
BEGIN e := Reals.Expo(x);
IF к < 0 THEN к := 0 END;
IF e = 0 THEN seq(" ", n - к - 2); Write(W, "0"); seq(" ", к + 1)
ELSIF e = 255 THEN WriteString(W, ” NaN"); seq(" ", n - 4)
ELSE e := (e - 127) * 77 DIV 256;
IF x < 0 THEN sign := x := - x ELSE sign := " " END;
IF e >= 0 THEN (*x >= 1.0, 77/256 = log 2*) x := x / Reals.Ten(e)
ELSE (*x < 1.0*) x ;= Reals.Ten( - e) * x
END;
IF x >= 10.0 THEN x := 0.1 * x; INC(e) END;
(* 1 <= x < 10 *)
IF к + e >= maxD - 1 THEN к := maxD - 1 - e
ELSIF к + e < 0 THEN к := - e; x := 0.0
END;
xO := Reals.Ten(k + e); x := xO * x + 0.5;
IF x >= 10.0 * xO THEN INC(e) END;
(*e = количество цифр перед десятичной точкой*)
INC(e); i := k + е; Reals.Convert(x, i, d);
IF e > 0 THEN
seq(" ", n - e - k - 2); Write(W, sign); dig(e);
Write(W, "."); dig(k)
ELSE seq(" ", n - k - 3);
Write(W, sign); Write(W, "0"); Write(W, ".”);
seq("0", - e); dig(k + e)
END
END
END WriteRealFix;
PROCEDURE WriteRealHex* (VAR W: Writer; x: REAL);
VAR i: INTEGER;
d: ARRAY 8 OF CHAR;
BEGIN Reals.ConvertH(x, d); i := 0;
REPEAT Write(W, d[i]); INC(i) UNTIL i = 8
END WriteRealHex;
PROCEDURE WriteLongReal* (VAR W: Writer; x: LONGREAL; n: INTEGER);
CONST maxD =16;
VAR e: INTEGER; xO: LONGREAL;
d: ARRAY maxD OF CHAR;
BEGIN e := Reals.ExpoL(x);
IF e = 0 THEN
WriteString(W, " 0");
REPEAT Write(W, " "); DEC(n) UNTIL n <= 3
ELSIF e = 2047 THEN
WriteString(W, " NaN");
WHILE n > 4 DO Write(W, " "); DEC(n) END
ELSE
IF n <= 10 THEN n := 3 ELSE DEC(n, 7) END;
REPEAT Write(W, " "); DEC(n) UNTIL n <= maxD;
(*записывается n цифр, 2 <= n <= maxD*)
IF x < 0 THEN Write(W, "-"); x := - x ELSE Write(W, " ") END;
e := SHORT(LONG(e - 1023) * 77 DIV 256);
154
Текстовая система
Полная реализация
155
IF е >= О THEN х := х / Reals.TenL(e) ELSE х := Reals.TenL( - e) * x END;
IF x >= 10.0D0 THEN x := 0.1D0 * x; INC(e) END;
xO := Reals.TenL(n - 1); x := xO * x + 0.5D0;
IF x >= 10.ODO * xO THEN x := 0.1D0 * x; INC(e) END;
Reals.ConvertL(x, n, d);
DEC(n); Write(W, d[n]); Write(W,
REPEAT DEC(n); Write(W, d[n]) UNTIL n = 0;
Write(W, "D");
IF e < 0 THEN Write(W, "-"); e := - e ELSE Write(W, "+") END;
Write(W, CHR(e DIV 100 + ЗОН)); e := e MOD 100;
Write(W, CHR(e DIV 10 + ЗОН));
Write(W, CHR(e MOD 10 + ЗОН))
END
END WriteLongReal;
PROCEDURE WriteLongRealHex* (VAR W: Writer; x: LONGREAL);
VAR i: INTEGER;
d: ARRAY 16 OF CHAR;
BEGIN Reals.ConvertHL(x, d); i := 0;
REPEAT Write(W, d[i]); INC(i) UNTIL i = 16
END WriteLongRealHex;
PROCEDURE WriteDate* (VAR W: Writer; t, d: LONGINT);
PROCEDURE WritePair (ch: CHAR; x: LONGINT);
BEGIN Write(W, ch);
Write(W, CHR(x DIV 10 + ЗОН)); Write(W, CHR(x MOD 10 + ЗОН))
END WritePair;
BEGIN
WritePair(" ", d MOD 32); WritePair(".", d DIV 32 MOD 16);
WritePair(".", d DIV 512 MOD 128);
WritePair(" ", t DIV 4096 MOD 32); WritePair(":", t DIV 64 MOD 64);
WritePair(":", t MOD 64)
END WriteDate;
BEGIN
NEW(DelBuf); OpenBuf(DelBuf);
OpenWriter(W); Write(W, OX);
WFile := Files.Base(W)
END Texts.
MODULE TextFrames; (*JG 8.10.90*)
IMPORT Display, Fonts, Input, MenuViewers, Modules, Oberon, Texts, Viewers;
CONST
replace* = 0; insert* = 1; delete* = 2; (*id сообщения*)
CR = ODX;
TYPE
Текстовая система
156
Line = POINTER TO LineDesc;
LineDesc = RECORD
len: LONGINT;
wid: INTEGER;
eot: BOOLEAN;
next: Line
END;
Location* = RECORD
org*, pos*: LONGINT;
dx*, x*, y*: INTEGER;
lin: Line
END;
Frame* = POINTER TO FrameDesc;
FrameDesc* = RECORD (Display.FrameDesc)
text*: Texts.Text;
org*: LONGINT;
col*: INTEGER;
lsp*: INTEGER;
left*, right*, top*, bot*: INTEGER;
markH*: INTEGER;
time*: LONGINT;
mark*, car*, sel*: INTEGER;
carloc*: Location;
selbeg*, selend*: Location;
trailer: Line
END;
(*mark < 0: маркер стрелки
mark = 0: нет маркера
mark > 0: маркер позиции*)
UpdateMsg* = RECORD (Display.FrameMsg)
id*: INTEGER;
text*: Texts.Text;
beg*, end*: LONGINT
END;
VAR
menuH*, barW*, left*, right*, top*, bot*, lsp*: INTEGER; (*стандартные размеры*)
asr, dsr, selH, markW, eolW: INTEGER;
par: Oberon.ParList; nextCh: CHAR;
W, KW: Texts.Writer; (*писатель клавиатуры*)
PROCEDURE Min (i, j: INTEGER): INTEGER;
BEGIN IF i >= j THEN RETURN j ELSE RETURN i END
END Min;
(* поддержка отображения *)
PROCEDURE ReplConst (col: INTEGER; F: Frame; X, Y, W, H: INTEGER; mode: INTEGER);
BEGIN
IF X + W <= F.X + F.W THEN Display.ReplConst(col, X, Y, W, H, mode)
ELSIF X < F.X + F.W THEN Display.ReplConst(col, X, Y, F.X + F.W - X, H, mode)
END
END ReplConst;
PROCEDURE FlipMark (F: Frame);
BEGIN
IF (F.mark > 0) & (F.left >= barW) THEN
Display.ReplConst(Display.white, F.X + 1, F.Y + F.H - 1 - F.markH,
markW, 1, 2)
END
END FlipMark;
PROCEDURE UpdateMark (F: Frame);
VAR oldH: INTEGER;
BEGIN
oldH := F.markH; F.markH := SH0RT(F.org * F.H DIV (F.text.len + 1));
IF (F.mark > 0) & (F.left >= barW) & (F.markH # oldH) THEN
Display.ReplConst(Display.white, F.X + 1, F.Y + F.H - 1 - oldH, markW, 1, 2);
Display.ReplConst(Display.white, F.X + 1, F.Y + F.H - 1 - F.markH,
markW, 1, 2)
END
END UpdateMark;
PROCEDURE Width (VAR R: Texts.Reader; len: LONGINT): INTEGER;
VAR pat: Display.Pattern; pos: LONGINT; ox, dx, x, y, w, h: INTEGER;
BEGIN pos := 0; ox := 0;
WHILE pos # len DO
Display.GetChar(R.fnt.raster, nextCh, dx, x, y, w, h, pat);
ox := ox + dx; INC(pos); Texts.Read(R, nextCh)
END;
RETURN ox
END Width;
PROCEDURE DisplayLine (F: Frame; L: Line;
VAR R: Texts.Reader; X, Y: INTEGER; len: LONGINT);
VAR pat: Display.Pattern; NX, dx, x, y, w, h: INTEGER;
BEGIN NX := F.X + F.W;
WHILE (nextCh # CR) & (R.fnt # NIL) DO
Display.GetChar(R.fnt.raster, nextCh, dx, x, y, w, h, pat);
IF (X + x + w <= NX) & (h # 0) THEN
Display.CopyPattern(R.col, pat, X + x, Y + y, 2)
END;
X := X + dx; INC(len); Texts.Read(R, nextCh)
END;
L. len := len + 1; L.wid := X + eolW - (F.X + F.left);
Полная реализация
157
158
Текстовая система
L.eot := R.fnt = NIL; Texts.Read(R, nextCh)
END DisplayLine;
PROCEDURE Validate (T: Texts.Text; VAR pos: LONGINT);
VAR R: Texts.Reader;
BEGIN
IF pos > T.len THEN pos := T.len
ELSIF pos > 0 THEN
DEC(pos); Texts.OpenReader(R, T, pos);
REPEAT Texts.Read(R, nextCh); INC(pos) UNTIL R.eot OR (nextCh = CR)
ELSE pos := 0
END
END Validate;
PROCEDURE Mark* (F: Frame; mark: INTEGER);
BEGIN
IF ((mark >= 0) = (F.mark < 0)) & (F.H >= 16) THEN
Display.CopyPattern(Display.white, Display.downArrow, F.X, F.Y, 2)
END;
IF ((mark > 0) = (F.mark <= 0)) & (F.H > 0) & (F.left >= barW) THEN
Display.ReplConst(Display.white, F.X + 1, F.Y + F.H - 1 - F.markH,
markW, 1, 2)
END;
F.mark := mark
END Mark;
PROCEDURE Restore* (F: Frame);
VAR R: Texts. Reader; L, 1: Line; curY, botY: INTEGER;
BEGIN (*F.mark = 0*)
Display.ReplConst(F.col, F.X, F.Y, F.W, F.H, 0);
IF F.left >= barW THEN
Display. ReplConst(Display.white, F.X + barW - 1, F.Y, 1, F.H, 2)
END;
Validate(F.text, F.org);
botY := F.Y + F.bot + dsr;
Texts.0penReader(R, F.text, F.org); Texts.Read(R, nextCh);
L := F. trailer; curY := F.Y + F.H - F.top - asr;
WHILE “L.eot & (curY >= botY) DO
NEW(l);
DisplayLine(F, 1, R, F.X + F.left, curY, 0);
L.next := 1; L := 1; curY := curY - lsp
END;
L. next := F.trailer;
F.markH := SH0RT(F.org * F.H DIV (F.text.len + 1))
END Restore;
PROCEDURE Suspend* (F: Frame);
BEGIN (*F.mark = 0*)
F.trailer.next := F.trailer
END Suspend;
Полная реализация
159
PROCEDURE Extend* (F: Frame; newY; INTEGER);
VAR R: Texts.Reader; L, 1; Line; org: LONGINT; curY, botY: INTEGER;
BEGIN (*F.mark = 0*)
Display.ReplConst(F.col, F.X, newY, F.W, F.Y - newY, 0);
IF F.left >= barW THEN
Display.ReplConst(Display.white, F.X + barW - 1, newY, 1, F.Y - newY, 2)
END;
F.H := F.H + F.Y - newY; F.Y := newY;
IF F.trailer.next = F.trailer THEN Validate(F.text, F.org) END;
L := F.trailer; org := F.org; curY := F.Y + F.H - F.top - asr;
WHILE L.next # F.trailer DO
L := L.next; org := org + L.len; curY := curY - lsp
END;
botY := F.Y + F.bot + dsr;
Texts.OpenReader(R, F.text, org); Texts.Read(R, nextCh);
WHILE "L.eot & (curY >= botY) DO NEW(l);
DisplayLine(F, 1, R, F.X + F.left, curY, 0);
L.next := 1; L := 1; curY := curY - lsp
END;
L.next := F.trailer;
F.markH := SH0RT(F.org * F.H DIV (F.text.len + 1))
END Extend;
PROCEDURE Reduce* (F: Frame; newY: INTEGER);
VAR L: Line; curY, botY: INTEGER;
BEGIN (*F.mark = 0*)
F.H := F.H + F.Y - newY; F.Y := newY;
botY := F.Y + F.bot + dsr;
L := F.trailer; curY := F.Y + F.H - F.top - asr;
WHILE (L.next # F.trailer) & (curY >= botY) DO
L := L.next; curY := curY - lsp
END;
L.next := F.trailer;
IF curY + asr > F.Y THEN
Display.ReplConst(F.col, F.X + F.left, F.Y, F.W - F.left, curY + asr - F.Y, 0)
END;
F.markH := SH0RT(F.org * F.H DIV (F.text.len + 1));
Mark(F, 1)
END Reduce;
PROCEDURE Show* (F: Frame; pos: LONGINT);
VAR R: Texts.Reader; L, 1: Line;
org: LONGINT; curY, botY, Y0: INTEGER; keys: SET;
BEGIN
IF F.trailer.next # F.trailer THEN
Validate(F.text, pos);
IF pos < F.org THEN Mark(F, 0);
Display.ReplConst(F.col, F.X + F.left, F.Y, F.W - F.left, F.H, 0);
botY := F.Y; F.Y := F.Y + F.H; F.H := 0;
F.org := pos; F.trailer.next := F.trailer; Extend(F, botY);
160
Текстовая система
Mark(F, 1)
ELSIF pos > F.org THEN
org := F.org; L := F.trailer.next; curY := F.Y + F.H - F.top - asr;
WHILE (L.next # F.trailer) & (org # pos) DO
org := org + L.len; L := L.next; curY := curY - lsp;
END;
IF org = pos THEN
F.org := org; F.trailer.next := L; YO := curY;
WHILE L.next # F.trailer DO
org := org + L.len; L := L.next; curY := curY - lsp
END;
Display.CopyBlock
(F.X + F.left, curY - dsr, F.W - F.left, YO + asr - (curY - dsr),
F.X + F.left, curY - dsr + F.Y + F.H - F.top - asr - YO, 0);
curY := curY + F.Y + F.H - F.top - asr - YO;
Display.ReplConst(F.col, F.X + F.left, F.Y, F.W -F.left,
curY - dsr - F.Y, 0);
botY := F.Y + F.bot + dsr;
org := org + L.len; curY := curY - lsp;
Texts.OpenReader(R, F.text, org); Texts.Read(R, nextCh);
WHILE “L.eot & (curY >= botY) DO NEW(l);
DisplayLine(F, 1, R, F.X + F.left, curY, 0);
L.next := 1; L := 1; curY := curY - lsp
END;
L.next ;= F.trailer;
UpdateMark(F)
ELSE Mark(F, 0);
Display.ReplConst(F.col, F.X + F.left, F.Y, F.W -F.left, F.H, 0);
botY := F.Y; F. Y : = F. Y + F. H; F. H : = 0;
F.org := pos; F.trailer.next := F.trailer; Extend(F, botY);
Mark(F, 1)
END
END
END
END Show;
PROCEDURE LocateLine (F: Frame; y: INTEGER; VAR loc: Location);
VAR T: Texts.Text; L: Line; org: LONGINT; cury: INTEGER;
BEGIN T := F.text;
org := F.org; L := F. trailer, next; cury := F.H - F.top - asr;
WHILE (L.next # F.trailer) & (cury > у + dsr) DO
org := org + L.len; L := L.next; cury := cury - lsp
END;
loc.org := org; loc.lin := L; loc.у := cury
END LocateLine;
PROCEDURE LocateString (F: Frame; x, y: INTEGER; VAR loc: Location);
VAR R: Texts.Reader; pat: Display.Pattern;
bpos, pos, lim: LONGINT; bx, ex, ox, dx, u, v, w, h: INTEGER;
BEGIN LocateLine(F, y, loc);
Полная реализация
lim := loc.org + loc.lin.len - 1;
bpos := loc.org; bx := F.left;
pos := loc.org; ox := F.left;
Texts.OpenReader(R, F.text, loc.org); Texts.Read(R, nextCh);
LOOP
LOOP (*сканирование строки*)
IF (pos = lim) OR (nextCh <= « «) THEN EXIT END;
Display.GetChar(R.fnt.raster, nextCh, dx, u, v, w, h, pat);
INC(pos); ox := ox + dx; Texts.Read(R, nextCh)
END;
ex := ox;
LOOP (*сканирование пробела*)
IF (pos = lim) OR (nextCh > " ") THEN EXIT END;
Display.GetChar(R.fnt.raster, nextCh, dx, u, v, w, h, pat);
INC(pos); ox := ox + dx; Texts.Read(R, nextCh)
END;
IF (pos = lim) OR (ox > x) THEN EXIT END;
Display.GetChar(R.fnt.raster, nextCh, dx, u, v, w, h, pat);
bpos := pos; bx := ox;
INC(pos); ox := ox + dx; Texts.Read(R, nextCh)
END;
loc.pos := bpos; loc.dx := ex - bx; loc.x := bx
END LocateString;
PROCEDURE LocateChar (F: Frame; x, y: INTEGER; VAR loc: Location);
VAR R: Texts.Reader; pat: Display.Pattern;
pos, lim: LONGINT; ox, dx, u, v, w, h: INTEGER;
BEGIN LocateLine(F, y, loc);
lim := loc.org + loc.lin.len - 1;
pos := loc.org; ox := F.left;
Texts.OpenReader(R, F.text, loc.org); Texts.Read(R, nextCh);
LOOP
IF pos = lim THEN dx := eolW; EXIT END;
Display.GetChar(R.fnt.raster, nextCh, dx, u, v, w, h, pat);
IF ox + dx > x THEN EXIT END;
INC(pos); ox := ox + dx; Texts.Read(R, nextCh)
END;
loc.pos := pos; loc.dx := dx; loc.x := ox
END LocateChar;
PROCEDURE LocatePos (F: Frame; pos: LONGINT; VAR loc: Location);
VAR T: Texts.Text; R: Texts.Reader; L: Line; org: LONGINT; cury: INTEGER;
BEGIN T := F.text;
org := F.org; L := F.trailer.next; cury := F.H - F.top - asr;
IF pos < org THEN pos := org END;
WHILE (L.next # F.trailer) & (pos >= org + L.len) DO
org := org + L.len; L := L.next; cury := cury - lsp
END;
IF pos >= org + L.len THEN pos := org + L.len - 1 END;
Texts.OpenReader(R, T, org); Texts.Read(R, nextCh);
ГТбТ]
162
Текстовая система
loc.org := org; loc.pos := pos; loc.lin := L;
loc.x := F.left + Width(R, pos - org); loc.у := cury
END LocatePos;
PROCEDURE Pos* (F: Frame; X, Y: INTEGER); LONGINT;
VAR loc: Location;
BEGIN LocateChar(F, X - F.X, Y - F.Y, loc);
RETURN loc.pos
END Pos;
PROCEDURE FlipCaret (F: Frame);
BEGIN
IF F.carloc.x < F.W THEN
IF (F.carloc.у >= 10) & (F.carloc.x + 12 < F.W) THEN
Display.CopyPattern(Display.white, Display.hook, F.X + F.carloc.x,
F.Y + F.carloc.у - 10, 2)
END
END
END FlipCaret;
PROCEDURE SetCaret* (F: Frame; pos: LONGINT);
BEGIN LocatePos(F, pos, F.carloc); FlipCaret(F); F.car := 1
END SetCaret;
PROCEDURE TrackCaret* (F: Frame; X, Y: INTEGER; VAR keysum: SET);
VAR loc: Location; keys: SET;
BEGIN
IF F.trailer.next # F.trailer THEN
LocateChar(F, X - F.X, Y - F.Y, F.carloc);
FlipCa ret(F);
keysum := {};
REPEAT
Input.Mouse(keys, X, Y);
keysum := keysum + keys;
Oberon.DrawCursor(Oberon.Mouse, Oberon.Mouse.marker, X, Y);
LocateChar(F, X - F.X, Y - F.Y, loc);
IF loc.pos # F.carloc.pos THEN FlipCa ret(F); F.carloc := loc;
FlipCaret(F) END
UNTIL keys = {};
F.car := 1
END
END TrackCaret;
PROCEDURE RemoveCaret* (F: Frame);
BEGIN IF F.car # 0 THEN FlipCaret(F); F.car := 0 END
END RemoveCaret;
PROCEDURE FlipSelection (F: Frame; VAR beg, end: Location);
VAR T: Texts.Text; L: Line; Y: INTEGER;
BEGIN T := F.text;
Полная реализация
163
L := beg.lin; Y := F.Y + beg.у - 2;
IF L = end.lin THEN ReplConst(Display.white, F, F.X + beg.x, Y,
end.x - beg.x, selH, 2)
ELSE
ReplConst(Display.white, F, F.X + beg.x, Y, F.left + L.wid - beg.x, selH, 2);
LOOP
L := L.next; Y := Y - lsp;
IF L = end.lin THEN EXIT END;
ReplConst(Display.white, F, F.X + F.left, Y, L.wid, selH, 2)
END;
ReplConst(Display.white, F, F.X + F.left, Y, end.x - F.left, selH, 2)
END
END FlipSelection;
PROCEDURE SetSelection* (F: Frame; beg, end: LONGINT);
BEGIN
IF F.sel # 0 THEN FlipSelection(F, F.selbeg, F.selend) END;
LocatePos(F, beg, F.selbeg); LocatePos(F, end, F.selend);
IF F.selbeg.pos < F.selend.pos THEN
FlipSelection(F, F.selbeg, F.selend); F.time := Oberon.Time(); F.sel := 1
END
END SetSelection;
PROCEDURE TrackSelection* (F: Frame; X, Y: INTEGER; VAR keysum: SET);
VAR loc: Location; keys: SET;
BEGIN
IF F.trailer.next # F.trailer THEN
IF F.sel # 0 THEN FlipSelection(F, F.selbeg, F.selend) END;
LocateChar(F, X - F.X, Y - F.Y, loc);
IF (F.sel # 0) & (loc.pos = F.selbeg.pos) & (F.selend.pos = F.selbeg.pos
+ 1) THEN
LocateChar(F, F.left, Y - F.Y, F.selbeg)
ELSE F.selbeg := loc
END;
INC(loc.pos); loc.x := loc.x + loc.dx; F.selend := loc;
FlipSelection(F, F.selbeg, F.selend);
keysum := {};
REPEAT
Input.Mouse(keys, X, Y);
keysum := keysum + keys;
Oberon.DrawCursor(Oberon.Mouse, Oberon.Mouse.marker, X, Y);
LocateChar(F, X - F.X, Y - F.Y, loc);
IF loc.pos < F.selbeg.pos THEN loc := F.selbeg END;
INC(loc.pos); loc.x := loc.x + loc.dx;
IF loc.pos < F.selend.pos THEN FlipSelection(F, loc, F.selend);
F.selend := loc
ELSIF loc.pos > F.selend.pos THEN FlipSelection(F, F.selend, loc);
F.selend := loc
END
UNTIL keys = {};
164
Текстовая система
F.time := Oberon.Time(); F.sel := 1
END
END TrackSelection;
PROCEDURE RemoveSelection* (F: Frame);
BEGIN IF F.sel # 0 THEN FlipSelection(F, F. selbeg, F. selend); F.sel := 0 END
END RemoveSelection;
PROCEDURE TrackLine* (F: Frame; X, Y: INTEGER; VAR org: LONGINT; VAR keysum: SET);
VAR T: Texts.Text; old, new: Location; keys: SET;
BEGIN
IF F.trailer.next # F.trailer THEN T := F.text;
LocateLine(F, Y - F.Y, old);
ReplConst(Display.white, F, F.X + F.left, F.Y + old.у - dsr, old.lin.wid, 2, 2);
keysum := {};
REPEAT
Input.Mouse(keys, X, Y);
keysum := keysum + keys;
Oberon.DrawCursor(Oberon.Mouse, Oberon.Mouse.marker, X, Y);
LocateLine(F, Y - F.Y, new);
IF new.org # old.org THEN
ReplConst(Display.white, F, F.X + F.left, F.Y + old.у - dsr,
old.lin.wid, 2, 2);
ReplConst(Display.white, F, F.X + F.left, F.Y + new.у - dsr,
new.lin.wid, 2, 2);
old := new
END
UNTIL keys = {};
ReplConst(Display.white, F, F.X + F.left, F.Y + new.у - dsr,
new.lin.wid, 2, 2);
org := new.org
ELSE org := - 1
END
END TrackLine;
PROCEDURE TrackWord* (F: Frame; X, Y: INTEGER; VAR pos: LONGINT; VAR keysum:
SET);
VAR T: Texts.Text; old, new: Location; keys: SET;
BEGIN
IF F.trailer.next # F.trailer THEN T := F.text;
LocateString(F, X - F.X, Y - F.Y, old);
ReplConst(Display.white, F, F.X + old.x, F.Y + old.у - dsr, old.dx, 2, 2);
keysum := {};
REPEAT
Input.Mouse(keys, X, Y);
keysum := keysum + keys;
Oberon.DrawCursor(Oberon.Mouse, Oberon.Mouse.marker, X, Y);
LocateString(F, X - F.X, Y - F.Y, new);
IF new.pos it old.pos THEN
ReplConst(Display.white, F, F.X + old.x, F.Y + old.у - dsr,
Полная реализация
165
old.dx, 2, 2);
ReplConst(Display.white, F, F.X + new.x, F.Y + new.у - dsr,
new.dx, 2, 2);
old := new
END
UNTIL keys = {};
ReplConst(Display.white, F, F.X + new.x, F.Y + new.у - dsr, new.dx, 2, 2);
pos := new.pos
ELSE pos := - 1
END
END TrackWord;
PROCEDURE Replace* (F: Frame; beg, end: LONGINT);
VAR R: Texts.Reader; L: Line; org, len: LONGINT; curY, wid: INTEGER;
BEGIN
IF end > F.org THEN
IF beg < F.org THEN beg := F.org END;
org := F.org; L := F.trailer.next; curY := F.Y + F.H - F.top - asr;
WHILE (L # F.trailer) & (org + L.len <= beg) DO
org := org + L.len; L := L.next; curY := curY - lsp
END;
IF L # F.trailer THEN
Texts.OpenReader(R, F.text, org); Texts.Read(R, nextCh);
len := beg - org; wid := Width(R, len);
ReplConst(F.col, F, F.X + F.left + wid, curY - dsr, L.wid - wid, lsp, 0);
DisplayLine(F, L, R, F.X + F.left + wid, curY, len);
org := org + L.len; L := L.next; curY := curY - lsp;
WHILE (L # F.trailer) & (org <= end) DO
Display.ReplConst(F.col, F.X + F.left, curY - dsr,
F.W - F.left, lsp, 0);
DisplayLine(F, L, R, F.X + F.left, curY, 0);
org := org + L.len; L := L.next; curY := curY - lsp
END
END
END;
UpdateMark(F)
END Replace;
PROCEDURE Insert* (F: Frame; beg, end: LONGINT);
VAR R: Texts.Reader; L, L0, 1: Line;
org, len: LONGINT; curY, botY, YO, Y1, Y2, dY, wid: INTEGER;
BEGIN
IF beg < F.org THEN F.org := F.org + (end - beg)
ELSE
org := F.org; L := F.trailer.next; curY := F.Y + F.H - F.top - asr;
WHILE (L ft F.trailer) & (org + L.len <= beg) DO
org := org + L.len; L := L.next; curY := curY - lsp
END;
IF L # F.trailer THEN
botY := F.Y + F.bot + dsr;
166
Текстовая система
Texts.OpenReadeг(R, F.text, org); Texts.Read(R, nextCh);
len := beg - org; wid := Width(R, len);
ReplConst(F.col, F, F.X + F.left + wid, curY - dsr, L.wid - wid, lsp, 0);
DisplayLine(F, L, R, F.X + F.left + wid, curY, len);
org := org + L.len; curY := curY - lsp;
YO := curY; L0 := L.next;
WHILE (org <= end) & (curY >= botY) DO NEW(l);
Display.ReplConst(F.col, F.X + F.left, curY - dsr, F.W - F.left,
lsp, 0);
DisplayLine(F, 1, R, F.X + F.left, curY, 0);
L.next := 1; L := 1;
org := org + L.len; curY := curY - lsp
END;
IF L0 # L.next THEN Y1 := curY;
L.next := L0;
WHILE (L.next # F.trailer) & (curY >= botY) DO
L := L.next; curY := curY - lsp
END;
L.next := F.trailer;
dY := YO - Y1;
IF Y1 > curY + dY THEN
Display.CopyBlock
(F.X + F.left, curY + dY + lsp - dsr, F.W - F.left,
Y1 - curY - dY,
F.X + F.left, curY + lsp - dsr,
0);
Y2 := Y1 - dY
ELSE Y2 := curY
END;
curY := Y1; L := L0;
WHILE curY # Y2 DO
Display.ReplConst(F.col, F.X + F.left, curY - dsr,
F.W - F.left, lsp, 0);
DisplayLine(F, L, R, F.X + F.left, curY, 0);
L := L.next; curY := curY - lsp
END
END
END
END;
UpdateMark(F)
END Insert;
PROCEDURE Delete* (F: Frame; beg, end: LONGINT);
VAR R: Texts. Reader; L, LO, 1: Line;
org, orgO, len: LONGINT; curY, botY, YO, Y1, wid: INTEGER;
BEGIN
IF end <= F.org THEN F.org := F.org - (end - beg)
ELSE
IF beg < F.org THEN
F.trailer.next.len := F.trailer.next.len + (F.org - beg);
Полная реализация
167
F.org := beg
END;
org := F.org; L := F.trailer.next; curY := F.Y + F.H - F.top - asr;
WHILE (L # F.trailer) & (org + L.len <= beg) DO
org := org + L.len; L := L.next; curY := curY - lsp
END;
IF L # F.trailer THEN
botY := F.Y + F.bot + dsr;
orgO := org; LO := L; YO := curY;
WHILE (L # F.trailer) & (org <= end) DO
org := org + L.len; L := L.next; curY := curY - lsp
END;
Y1 := curY;
Texts.OpenReader(R, F.text, orgO); Texts.Read(R, nextCh);
len := beg - orgO; wid := Width(R, len);
ReplConst(F.col, F, F.X + F.left + wid, YO - dsr, LO.wid - wid, lsp, 0);
DisplayLine(F, LO, R, F.X + F.left + wid, YO, len);
YO := YO - lsp;
IF L # LO.next THEN
LO.next := L;
L := LO; org := orgO + LO.len;
WHILE L.next # F.trailer DO
L := L.next; org := org + L.len; curY := curY - lsp
END;
Display.CopyBlock
(F.X + F.left, curY + lsp - dsr, F.W - F.left, Y1 - curY,
F.X + F.left, curY + lsp - dsr + (YO - Y1), 0);
curY := curY + (YO - Y1);
Display.ReplConst(F.col, F.X + F.left, F.Y, F.W - F.left,
curY + lsp - (F.Y + dsr), 0);
Texts.OpenReader(R, F.text, org); Texts.Read(R, nextCh);
WHILE 'L.eot & (curY >= botY) DO NEW(l);
DisplayLine(F, 1, R, F.X + F.left, curY, 0);
L.next := 1; L := 1; curY := curY - lsp
END;
L.next := F.trailer
END
END
END;
UpdateMark(F)
END Delete;
(* управление сообщениями *)
PROCEDURE RemoveMarks (F: Frame);
BEGIN RemoveCaret(F); RemoveSelection(F)
END RemoveMarks;
PROCEDURE NotifyDisplay* (T: Texts.Text; op: INTEGER; beg, end: LONGINT);
VAR M: UpdateMsg;
168
Текстовая система
BEGIN М.id := op; М.text := Т; М.beg := beg; М.end := end; Viewers.Broadcast(M)
END NotifyDisplay;
PROCEDURE Call* (F: Frame; pos: LONGINT; new: BOOLEAN);
VAR S: Texts.Scanner; res: INTEGER;
BEGIN
Texts.OpenScanner(S, F.text, pos); Texts.Scan(S);
IF S.class = Texts.Name THEN
par.vwr := Viewers.This(F.X, F.Y);
par.frame := F; par.text := F.text; par.pos := pos + S.len;
Oberon.Call(S.s, par, new, res);
IF res > 1 THEN
Texts.WriteString(W, "Call error: ”);
IF res = 2 THEN
Texts.WriteString(W, " not an obj-file or error in file")
ELSIF res = 3 THEN
Texts.WriteString(W, Modules.imported);
Texts.WriteString(W, " imported with bad key from ");
Texts.WriteString(W, Modules.importing)
ELSIF res = 4 THEN
Texts.WriteString(W, " not enough space")
END;
Texts.WriteLn(W); Texts.Append(Oberon.Log, W.buf)
END
END
END Call;
PROCEDURE Write* (F: Frame; ch: CHAR; fnt: Fonts.Font; col, voff: SHORTINT);
BEGIN (*F.car # 0*)
IF ch = 7FX THEN
IF F.carloc.pos > F.org THEN
Texts.Delete(F.text, F.carloc.pos - 1, F.carloc.pos);
SetCaret(F, F.carloc.pos - 1)
END
ELSIF (20X <= ch) & (ch < 86X) OR (ch = ODX) OR (ch = 9X) THEN
KW.fnt := fnt; KW.col := col; KW.voff := voff; Texts.Write(KW, ch);
Texts.Insert(F.text, F.carloc.pos, KW.buf);
SetCaret(F, F.carloc.pos + 1)
END
END Write;
PROCEDURE Defocus* (F: Frame);
EGIN RemoveCaret(F)
END Defocus;
PROCEDURE Neutralize* (F: Frame);
BEGIN RemoveMarks(F)
END Neutralize;
PROCEDURE Modify* (F: Frame; id, dY, Y, H: INTEGER);
Полная реализация
169
BEGIN
Mark(F, 0); RemoveMarks(F);
IF id = MenuViewers.extend THEN
IF dY > 0 THEN
Display.CopyBlock(F.X, F.Y, F.W, F.H, F.X, F.Y + dY, 0); F.Y := F.Y +• dY
END;
Extend(F, Y)
ELSIF id = MenuViewers.reduce THEN
Reduce(F, Y + dY);
IF dY > 0 THEN Display.CopyBlock(F.X, F.Y, F.W, F.H, F.X, Y, 0); F.Y ; = Y END
END;
IF F.H > 0 THEN Mark(F, 1) END
END Modify;
PROCEDURE Open* (
F: Frame; H: Display.Handler; T: Texts.Text; org: LONGINT;
col, left, right, top, bot, lsp: INTEGER);
VAR L: Line;
BEGIN NEW(L);
L.len := 0; L.wid := 0; L.eot := FALSE; L.next := L;
F.handle := H; F.text := T; F.org := org; F.trailer := L;
F.left := left; F.right := right; F.top := top; F.bot := bot;
F.lsp := lsp; F.col := col; F.mark := 0; F.car := 0; F.sel := 0
END Open;
PROCEDURE Copy* (F: Frame; VAR F1: Frame);
BEGIN NEW(FI);
0pen(F1, F.handle, F.text, F.org, F.col, F.left, F.right, F.top, F.bot, F.lsp)
END Copy;
PROCEDURE CopyOver* (F: Frame; text: Texts.Text; beg, end: LONGINT);
VAR buf: Texts.Buffer;
BEGIN
IF F.car > 0 THEN
NEW(buf); Texts.OpenBuf(buf);
Texts.Save(text, beg, end, buf);
Texts.Insert(F.text, F.carloc.pos, buf);
SetCaret(F, F.carloc.pos + (end - beg))
END
END CopyOver;
PROCEDURE GetSelection* (F: Frame; VAR text: Texts.Text; VAR beg, end, time:
LONGINT);
BEGIN
IF F.sel > 0 THEN
IF F.time > time THEN
text := F.text; beg := F.selbeg.pos; end := F.selend.pos;
time := F.time
ELSIF F.text = text THEN
IF (F.time < time) & (F.selbeg.pos < beg) THEN beg := F.selbeg.pos
170
Текстовая система
ELSIF (F.time > time) & (F.selend.pos > end) THEN end := F.selend.pos;
time := F.time
END
END
END
END GetSelection;
PROCEDURE Update* (F: Frame; VAR M: UpdateMsg);
BEGIN (*F.text = M.text*)
RemoveMarks(F); Oberon.RemoveMarks(F.X, F.Y, F.W, F.H);
IF M.id = replace THEN Replace(F, M.beg, M.end)
ELSIF M.id = insert THEN Insert(F, M.beg, M.end)
ELSIF M.id = delete THEN Delete(F, M.beg, M.end)
END
END Update;
PROCEDURE Edit* (F: Frame; X, Y: INTEGER; Keys; SET);
VAR M: Oberon.CopyOverMsg;
T: Texts.Text; R: Texts.Reader; buf: Texts.Buffer;
time, pos, beg, end: LONGINT; keysum: SET; ch: CHAR;
BEGIN
Oberon.DrawCursor(Oberon.Mouse, Oberon.Arrow, X, Y);
IF X < F.X + Min(F.left, barW) THEN
IF (0 IN Keys) OR (1 IN Keys) THEN keysum := Keys;
REPEAT
Input.Mouse(Keys, X, Y);
keysum := keysum + Keys;
Oberon.DrawCursor(Oberon.Mouse, Oberon.Arrow, X, Y)
UNTIL Keys = {};
IF ~(2 IN keysum) THEN
RemoveMarks(F); Oberon.RemoveMarks(F.X, F.Y, F.W, F.H);
IF (0 IN keysum) OR (F.Y + F.H < Y) THEN pos := 0
ELSE pos := (F.Y + F.H - Y) * (F.text.len) DIV F.H
END;
RemoveMarks(F); Oberon.RemoveMarks(F.X, F.Y, F.W, F.H);
Show(F, pos)
ELSIF '(0 IN keysum) THEN
RemoveMarks(F); Oberon. Remove.Marks(F. X, F.Y, F.W, F.H);
Show(F, F.text.len)
END
ELSIF 2 IN Keys THEN
TrackLine(F, X, Y, pos, keysum);
IF (pos >= 0) & "(0 IN keysum) THEN
RemoveMarks(F); Oberon.RemoveMarks(F.X, F.Y, F.W, F.H);
Show(F, pos)
END
END
ELSE
IF 0 IN Keys THEN
TrackSelection(F, X, Y, keysum);
Полная реализация
IF F.sel # 0 THEN
IF (2 IN keysum) & "(1 IN keysum) THEN (*удалить текст*)
Oberon.PassFocus(MenuViewers.Ancestor);
Oberon.GetSelection(T, beg, end, time);
Texts.Delete(T, beg, end); SetCaret(F, beg)
ELSIF (1 IN keysum) & "(2 IN keysum) THEN ^копировать в фокус*)
Oberon.GetSelection(T, beg, end, time);
M.text := T; M.beg ;= beg; M.end := end;
Oberon.FocusViewer.handle(Oberon.FocusViewer, M)
END
END
ELSIF 1 IN Keys THEN
TrackWord(F, X, Y, pos, keysum);
IF (pos >=■ 0) & "(0 IN keysum) THEN Call(F, pos, 2 IN keysum) END
ELSIF 2 IN Keys THEN
Oberon.PassFocus(Viewers.This(F.X, F.Y)); TrackCaret(F, X, Y, keysum);
IF F.car # 0 THEN
IF (1 IN keysum) & "(0 IN keysum) THEN Скопировать из выделения*)
Oberon.GetSelection(T, beg, end, time);
IF time >= 0 THEN
NEW(buf); Texts.OpenBuf(buf);
Texts.Save(T, beg, end, buf);
Texts.Insert(F.text, F.carloc.pos, buf);
SetCaret(F, F.carloc.pos + (end - beg))
END
ELSIF (0 IN keysum) & "(1 IN keysum) THEN Скопировать шрифт*)
Oberon.GetSelection(T, beg, end, time);
IF time >= 0 THEN
Texts.OpenReader(R, F.text, F.carloc.pos); Texts.Read(R, ch);
Texts.ChangeLooks(T, beg, end, {0, 1, 2}, R.fnt, R.col, R.voff)
END
END
END
END
END
END Edit;
PROCEDURE Handle* (F: Display.Frame; VAR M: Display.FrameMsg);
VAR F1: Frame;
BEGIN
WITH F: Frame DO
IF M IS Oberon.InputMsg THEN
WITH M: Oberon.InputMsg DO
IF M.id = Oberon.track THEN Edit(F, M.X, M.Y, M.keys)
ELSIF M.id = Oberon.consume THEN
IF F.car # 0 THEN Write(F, M.ch, M.fnt, M.col, M.voff) END
END
END
ELSIF M IS Oberon.ControlMsg THEN
WITH M: Oberon.ControlMsg DO
171
172
Текстовая система
IF M.id = Oberon.defocus THEN Defocus(F)
ELSIF M.id = Oberon.neutralize THEN Neutralize(F)
END
END
ELSIF M IS Oberon.SelectionMsg THEN
WITH M: Oberon.SelectionMsg DO GetSelection(F, M.text, M.beg, M.end,
M.time) END
ELSIF M IS Oberon.CopyOverMsg THEN
WITH M: Oberon.CopyOverMsg DO CopyOver(F, M.text, M.beg, M.end) END
ELSIF M IS Oberon.CopyMsg THEN
WITH M: Oberon.CopyMsg DO Copy(F, F1); M.F := F1 END
ELSIF M IS MenuViewers.ModifyMsg THEN
WITH M: MenuViewers.ModifyMsg DO Modify(F, M.id, M.dY, M.Y, M.H) END
ELSIF M IS UpdateMsg THEN
WITH M: UpdateMsg DO
IF F.text = M.text THEN Update(F, M) END
END
END
END
END Handle;
(*создание*)
PROCEDURE Menu (name, commands: ARRAY OF CHAR): Texts.Text;
VAR T: Texts.Text;
BEGIN
NEW(T); T.notify := NotifyDisplay; Texts.Open(T, "");
Texts.WriteString(W, name); Texts.WriteString(W, " | ");
Texts.WriteString(W, commands);
Texts.Append(T, W.buf);
RETURN T
END Menu;
PROCEDURE Text* (name: ARRAY OF CHAR): Texts.Text;
VAR T: Texts.Text;
BEGIN NEW(T); T.notify := NotifyDisplay; Texts.Open(T, name); RETURN T
END Text;
PROCEDURE NewMenu* (name, commands: ARRAY OF CHAR): Frame;
VAR F: Frame;
BEGIN NEW(F);
Open(F, Handle, Menu(name, commands), 0, Display.white, left DIV 4, 0, 0, 0, lsp);
RETURN F
END NewMenu;
PROCEDURE NewText* (text: Texts.Text; pos: LONGINT): Frame;
VAR F: Frame;
BEGIN NEW(F);
Open(F, Handle, text, pos, Display.black, left, right, top, bot, lsp);
RETURN F
Полная реализация
173
END NewText;
BEGIN
menuH := Fonts.Default.height + 2; barW := menuH;
left := barW + Fonts.Default.height DIV 2; right := Fonts.Default.height DIV 2;
top := Fonts.Default.height DIV 2; bot := Fonts.Default.height DIV 2;
asr := Fonts.Default.maxY; dsr := - Fonts.Default.minY; lsp := Fonts.Default.height;
selH := Fonts.Default.height; markW := Fonts.Default.height DIV 2;
eolW := Fonts.Default.height DIV 2;
Texts.OpenWriter(W); Texts.OpenWriter(KW);
NEW(par)
END TextFrames.
MODULE Edit; (*JG 26.11.91*)
IMPORT Display, Files, Fonts, MenuViewers, Oberon, Printer, TextFrames, Texts,
Viewers;
CONST
CR = ODX; maxlen = 32;
StandardMenu = "System.Close System.Copy System.Grow Edit.Search Edit.Store";
VAR
W: Texts.Writer;
time: LONGINT;
M: INTEGER;
pat: ARRAY maxlen OF CHAR;
d: ARRAY 256 OF INTEGER;
PROCEDURE Max (i, j: LONGINT): LONGINT;
BEGIN IF i >= j THEN RETURN i ELSE RETURN j END
END Max;
PROCEDURE Open*;
VAR par: Oberon.ParList;
T: Texts.Text; S: Texts.Scanner;
V: Viewers.Viewer;
X, Y: INTEGER;
beg, end, time: LONGINT;
BEGIN
par := Oberon.Par;
Texts.OpenScanner(S, par.text, par.pos); Texts.Scan(S);
IF (S.class = Texts.Char) & (S.с = "~") OR (S.line # 0) THEM
Oberon.GetSelection(T, beg, end, time);
IF time >= 0 THEN Texts.OpenScanner(S, T, beg); Texts.Scan(S) END
END;
IF S.class = Texts.Name THEN
Oberon.AllocateUserViewer(par.vwr.X, X, Y);
V := MenuViewers.New(
TextFrames.NewMenu(S.s, StandardMenu),
TextFrames.NewText(TextFrames.Text(S.s), 0),
174
Текстовая система
TextFrames.menuH,
X, Y)
END
END Open;
PROCEDURE Show*;
VAR par: Oberon.ParList;
T, t: Texts.Text;
R: Texts.Reader; S: Texts.Scanner;
V: Viewers.Viewer;
X, Y, n, i, j: INTEGER;
pos, len, beg, end, time: LONGINT;
buf: ARRAY 32 OF CHAR;
name: ARRAY 35 OF CHAR;
M: INTEGER;
pat: ARRAY maxlen OF CHAR;
d: ARRAY 256 OF INTEGER;
PROCEDURE Forward (n: INTEGER);
VAR m: INTEGER; j: INTEGER;
BEGIN m := M - n;
j := 0;
WHILE j # m DO buf[j] := buf[n + j]; INC(j) END;
WHILE j # M DO Texts.Read(R, buf[j]); INC(j) END
END Forward;
BEGIN
par := Oberon.Par;
Texts.OpenScanner(S, par.text, par.pos); Texts.Scan(S);
IF (S.class = Texts.Char) & (S.с = "~") OR (S.line # 0) THEN
Oberon.GetSelection(T, beg, end, time);
IF time >= 0 THEN Texts.OpenScanner(S, T, beg); Texts.Scan(S) END
END;
IF S.class = Texts.Name THEN
i := - 1; j := 0;
WHILE S.s[j] # OX DO
IF S.s[j] = V THEN i := j END;
name[j] := S.s[j]; j := j + 1
END;
IF i < 0 THEN name[j] i := j END;
name[i + 1] := "M"; name[i + 2] := "o"; name[i + 3] := "d"; name[i + 4] := OX;
t := TextFrames.Text(name);
IF j > i THEN (*задано имя объекта*)
j := i + 1; M := 0;
WHILE (H tt maxlen) & (S. s[j] # OX) DO pat[M] := S.s[j]: j := Э + 1:
M := H + 1 END;
j := 0;
WHILE j # 256 DO d[j] := M; INC(j) END;
j := 0;
WHILE j # M - 1 DO d[0RD(pat[j])] := M - 1 - j; INC(j) END;
pos := 0; len := t.len;
Texts.OpenReader(R, t, pos);
Forward(M); pos := pos + M;
LOOP j := M;
REPEAT DEC(j) UNTIL (j < 0) OR (buf[j] # pat[j]);
IF (j < 0) OR (pos >= len) THEN EXIT END;
n := d[0RD(buf[M - 1])];
Forward(n); pos := pos + n
END
ELSE pos := 0
END;
Oberon.AllocateUserViewer(par.vwr.X, X, Y);
V := MenuViewers.New(
TextFrames.NewMenu(name, StandardMenu),
TextFrames.NewText(t, pos - 200),
TextFrames.menuH,
X, Y)
END
END Show;
PROCEDURE Store*;
VAR par: Oberon.ParList;
V: Viewers.Viewer;
Text: TextFrames.Frame;
T: Texts.Text; S: Texts.Scanner;
f: Files.File;
beg, end, time, len: LONGINT;
PROCEDURE Backup (VAR name: ARRAY OF CHAR);
VAR res, i: INTEGER; bak: ARRAY 32 OF CHAR;
BEGIN i := 0;
WHILE name[i] # OX DO bak[i] := name[i]; INC(i) END;
bak[i] := bak[i + 1] := "B"; bak[i + 2] := "a"; bak[i + 3] := "k";
bak[i + 4] : = OX;
Files.Rename(name, bak, res)
END Backup;
BEGIN
Texts.WriteString(W, "Edit.Store ");
par := Oberon.Par;
IF par.frame = par.vwr.dsc THEN
V := par.vwr; Texts.OpenScanner(S, V.dsc(TextFrames.Frame).text, 0)
ELSE V := Oberon.MarkedViewer(); Texts.OpenScanner(S, par.text, par.pos)
END;
Texts.Scan(S);
IF (S.class = Texts.Char) & (S.с = """) THEN
Oberon.GetSelection(T, beg, end, time);
IF time >= 0 THEN Texts.OpenScanner(S, T, beg); Texts.Scan(S) END
END;
IF (S.class = Texts.Name) & (V.dsc # NIL) & (V.dsc.next IS TextFrames.Frame) THEN
Полная реализация
175
176
Текстовая система
Text := V.dsc.next(TextFrames.Frame);
TextFrames.Mark(Text, - 1);
Texts.WriteString(W, S.s); Texts.WriteLn(W);
Texts.Append(Oberon.Log, W.buf);
Backup(S.s);
f := Files.New(S.s);
Texts.Store(Text.text, f, 0, len);
Files.Register(f);
TextFrames.Mark(Text, 1)
END
END Store;
PROCEDURE CopyFont*;
VAR
T: Texts.Text; R: Texts.Reader;
V: Viewers.Viewer; F: Display.Frame;
beg, end: LONGINT;
X, Y: INTEGER;
ch: CHAR;
BEGIN
V := Oberon.MarkedViewer(); F := V.dsc;
X := Oberon.Pointer.X; Y := Oberon.Pointer.Y;
LOOP
IF F = NIL THEN EXIT END;
IF (X >= F.X) & (X < F.X + F.W) & (Y >= F.Y) & (Y < F.Y + F.H) THEN
IF F IS TextFrames.Frame THEN
WITH F: TextFrames.Frame DO
Texts.OpenReader(R, F.text, TextFrames.Pos(F, X, Y));
Texts.Read(R, ch);
Oberon.GetSelection(T, beg, end, time);
IF time >= 0 THEN Texts.ChangeLooks(T, beg, end, {0}, R.fnt,
0, 0) END
END
END;
EXIT
END;
F := F.next
END
END CopyFont;
PROCEDURE ChangeFont*;
VAR par: Oberon.ParList;
T: Texts.Text; S: Texts.Scanner;
beg, end: LONGINT;
BEGIN
Oberon.GetSelection(T, beg, end, time);
IF time >= 0 THEN par := Oberon.Par;
Texts.OpenScanner(S, par.text, par.pos); Texts.Scan(S);
IF S.class = Texts.Name THEN
Texts.ChangeLooks(T, beg, end, {0}, Fonts.This(S.s), 0, 0)
Полная реализация
177
END
END
END ChangeFont;
PROCEDURE ChangeColor*;
VAR par: Oberon.ParList;
T: Texts.Text; S: Texts.Scanner;
col: SHORTINT; ch: CHAR;
beg, end, time: LONGINT;
BEGIN par := Oberon.Par;
Texts.OpenScanner(S, par.text, par.pos); Texts.Scan(S);
IF S.class = Texts.Int THEN col := SH0RT(SH0RT(S.i))
ELSIF (S.class = Texts.Char) & (S.с = "''") &
(par.frame(TextFrames.Frame).sel > 0) THEN
Texts.OpenReader(S, par.text, par.frame(TextFrames.Frame).selbeg.pos);
Texts.Read(S, ch); col := S.col
ELSE col := Oberon.CurCol
END;
Oberon.GetSelection(T, beg, end, time);
IF time >= 0 THEN Texts.ChangeLooks(T, beg, end, {1}, NIL, col, 0) END
END ChangeColor;
PROCEDURE ChangeOffset*;
VAR par: Oberon.ParList;
T: Texts.Text; S: Texts.Scanner;
voff: SHORTINT; ch: CHAR;
beg, end, time: LONGINT;
BEGIN par := Oberon.Par;
Texts.OpenScanner(S, par.text, par.pos); Texts.Scan(S);
IF S.class = Texts.Int THEN voff := SH0RT(SH0RT(S.i))
ELSIF (S.class = Texts.Char) & (S.с = "~") &
(par.frame(TextFrames.Frame).sel > 0) THEN
Texts.OpenReader(S, par.text, par.frame(TextFrames.Frame).selbeg.pos);
Texts.Read(S, ch); voff := S.voff
ELSE voff := Oberon.CurOff
END;
Oberon.GetSelection(T, beg, end, time);
IF time >=0 THEN Texts.ChangeLooks(T, beg, end, {2}, NIL, voff, 0) END
END ChangeOffset;
PROCEDURE Search*;
VAR V: Viewers.Viewer;
Text: TextFrames.Frame;
T: Texts.Text; R: Texts.Reader;
pos, beg, end, prevTime, len: LONGINT; n, i, j: INTEGER;
buf: ARRAY 32 OF CHAR;
PROCEDURE Forward (n: INTEGER);
VAR m: INTEGER; j: INTEGER;
BEGIN m := M - n;
178
Текстовая система
] := 0;
WHILE j # m DO buf[j] := buf[n + j]; INC(j) END;
WHILE j # M DO Texts.Read(R, buf[j]); INC(j) END
END Forward;
BEGIN
V := Oberon.Par.vwr;
IF Oberon.Par.frame # V.dsc THEN V := Oberon.MarkedViewer() END;
IF (V.dsc # NIL) & (V.dsc. next IS TextFrames.Frame) THEN
Text := V.dsc.next(TextFrames.Frame);
TextFrames.Mark(Text, - 1);
prevTime := time; Oberon.GetSelection(T, beg, end, time);
IF time > prevTime THEN
Texts.OpenReader(R, T, beg);
i := 0; pos := beg;
REPEAT Texts.Read(R, pat[i3); INC(i); INC(pos)
UNTIL (i = maxlen) OR (pos = end);
M := i;
j : = 0;
WHILE j # 256 DO d[j] := M; INC(j) END;
j := 0;
WHILE j # M - 1 DO d[0RD(pat[j])] := M - 1 - j; INC(j) END
END;
IF Text.car > 0 THEN pos := Text.carloc.pos ELSE pos := 0 END;
len := Text.text.len;
Texts.OpenReader(R, Text.text, pos);
Forward(M); pos := pos + M;
LOOP j := M;
REPEAT DEC(j) UNTIL (j < 0) OR (buf[j] # pat[j]);
IF (j < 0) OR (pos >= len) THEN EXIT END;
n := d[0RD(buf[M - 1])];
Forward(n); pos := pos + n
END;
IF j < 0 THEN
TextFrames.RemoveSelection(Text);
TextFrames.RemoveCaret(Text);
Oberon.RemoveHarks(Text.X, Text.Y, Text.W, Text.H);
TextFrames.Show(Text, pos - 200);
Oberon.PassFocus(V);
TextFrames.SetCaret(Text, pos)
END;
TextFrames. Mark(Text, 1)
END
END Search;
PROCEDURE Locate*;
VAR V: Viewers.Viewer;
Text: TextFrames. Frame;
T: Texts.Text; S: Texts.Scanner;
beg, end, time: LONGINT;
Полная реализация
179
BEGIN
V := Oberon.MarkedViewer();
IF (V.dsc # NIL) & (V.dsc.next IS TextFrames.Frame) THEN
Text := V.dsc.next(TextFrames.Frame);
Oberon.GetSelection(T, beg, end, time);
IF time >= 0 THEN
Texts.OpenScanner(S, T, beg);
REPEAT Texts.Scan(S) UNTIL (S.class >= Texts.Int); («пропустить имена*)
IF S.class = Texts.Int THEN
TextFrames.RemoveSelection(Text);
TextFrames.RemoveCaret(Text);
Oberon.RemoveMarks(Text.X, Text.Y, Text.W, Text.H);
TextFrames.Show(Text, Max(0, S.i - 200));
Oberon.PassFocus(V);
TextFrames.SetCaret(Text, S.i)
END
END
END
END Locate;
PROCEDURE Recall*;
VAR V: Viewers.Viewer;
Menu, Main: Display.Frame;
buf: Texts.Buffer;
pos: LONGINT;
BEGIN V := Oberon.FocusViewer;
IF V IS MenuViewers.Viewer THEN
Menu := V.dsc; Main := V.dsc.next;
IF (Main IS TextFrames.Frame) & (Main(TextFrames.Frame).car > 0) THEN
WITH Main: TextFrames.Frame DO
Texts.Recall(buf);
pos :- Main.carloc.pos + buf.len;
Texts.Insert(Main.text, Main.carloc.pos, buf);
TextFrames.SetCaret(Main, pos)
END
ELSIF (Menu IS TextFrames.Frame) & (Menu(TextFrames.Frame).car > 0) THEN
WITH Menu: TextFrames.Frame DO
Texts.Recall(buf);
pos := Menu.carloc.pos + buf.len;
Texts.Insert(Menu.text, Menu.carloc.pos, buf);
TextFrames.SetCaret(Menu, pos)
END
END
END
END Recall;
PROCEDURE Print*;
CONST
textX = 160; textY = 225; botY = 100;
I 180 I
Текстовая система
VAR
par: Oberon.ParList;
V: Viewers.Viewer;
Menu, Text: TextFrames.Frame;
T, source: Texts.Text;
R: Texts.Reader; S: Texts.Scanner;
fnt: Fonts.Font;
id, ch: CHAR;
pageno: SHORTINT; listing: BOOLEAN;
nofcopies, len, lsp, Y, topY: INTEGER;
beg, end, time: LONGINT;
PROCEDURE SendHeader;
VAR pno: ARRAY 4 OF CHAR;
BEGIN Printer.String(textX, Printer.PageHeight - 125, S.s, Fonts.Default.name);
IF pageno DIV 10 = 0 THEN pno[0] :=
ELSE pno[0] := CHR(pageno DIV 10 + ЗОН) END;
pno[1 ] := CHR(pageno MOD 10 + ЗОН); pno[2] := OX;
Printer.String(Printer.PageWidth - 236, Printer.PageHeight - 125, pno,
Fonts.Default.name)
END SendHeader;
PROCEDURE PrintUnit (source: Texts.Text; pos: LONGINT);
VAR i: INTEGER; new: BOOLEAN;
buf: ARRAY 200 OF CHAR;
BEGIN Texts.WriteString(W, S.s);
IF source, len # 0 THEN
Texts.WriteString(W, " printing"); Texts.WriteInt(W, nofcopies, 3);
Texts.Append(Oberon.Log, W.buf);
lsp := Fonts.Default.height * 7 DIV 2; pageno := 0;
SendHeader; Y := topY;
Texts.OpenReader(R, source, pos);
IF "listing THEN
REPEAT Texts.Read(R, ch);
new := TRUE; fnt := R.fnt;
WHILE "R.eot & (ch # CR) DO
i := 0;
REPEAT buf[i] := ch; INC(i); Texts.Read(R, ch)
UNTIL R.eot OR (ch = CR) OR (R.fnt # fnt);
buf[i] := OX;
IF new THEN Printer.String(textX, Y, buf, fnt.name)
ELSE Printer.ContString(buf, fnt.name)
END;
new := FALSE; fnt : = R. fnt
END;
Y := Y - lsp;
IF Y < botY THEN
Printer.Page(nofcopies); INC(pageno); SendHeader; Y := topY
END
UNTIL R.eot
Полная реализация
181
ELSE lsp := 32;
REPEAT Texts.Read(R, ch);
WHILE "R.eot & (ch # CR) DO
i := 0;
REPEAT buf[i] := ch; INC(i); Texts.Read(R, ch)
UNTIL R.eot OR (ch = CR);
buf[i] := OX;
Printer.String(textX, Y, buf, Fonts.Default.name)
END;
Y := Y - lsp;
IF Y < botY THEN
Printer.Page(nofcopies); INC(pageno); SendHeader; Y := topY
END
UNTIL R.eot
END;
IF Y < topY THEN Printer.Page(nofcopies) END
ELSE Texts.WriteString(W, " not found")
END;
Texts.WriteLn(W);
Texts.Append(Oberon.Log, W.buf)
END PrintUnit;
PROCEDURE Option;
VAR ch: CHAR;
BEGIN nofcopies := 1;
IF S.nextCh = "/" THEN
Texts.Read(S, ch);
IF (ch >= "0") & (ch <= "9”) THEN nofcopies := ORD(ch) - ЗОН END;
WHILE ch > " " DO Texts.Read(S, ch) END;
S.nextCh := ch
END
END Option;
BEGIN par := Oberon.Par;
Texts.WriteString(W, "Edit.Print"); Texts.WriteLn(W);
Texts.Append(Oberon.Log, W.buf);
Texts.OpenScanner(S, par.text, par.pos); Texts.Scan(S);
IF S.class = Texts.Name THEN
Printer.0pen(S.s, Oberon.User, Oberon.Password);
IF Printer.res = 0 THEN
topY := Printer.PageHeight - textY; Texts.Scan(S);
IF (S.class = Texts.Char) & (S.с = "%") THEN
listing := TRUE; Printer.UseListFont(Fonts.Default.name);
Texts.Scan(S)
ELSE listing := FALSE
END;
IF (S.class = Texts.Char) & (S.с = „*") THEN
Option; V := Oberon.MarkedViewer();
IF (V.dsc IS TextFrames.Frame) & (V.dsc.next IS TextFrames.Frame)
THEN
182
Текстовая система
Menu := V.dsc(TextFrames.Frame);
Text := V.dsc.next(TextFrames.Frame);
Texts.OpenScanner(S, Menu.text, 0); Texts.Scan(S);
TextFrames.Mark(Text, - 1); PrintUnit(Text.text, 0);
TextFrames.Mark(Text, 1)
END
ELSE
WHILE S.class = Texts.Name DO
Option; NEW(source); Texts.Open(source, S.s);
PrintUnit(source, 0);
Texts.Scan(S)
END;
IF (S.class = Texts.Char) & (S.с = "“")
THEN Oberon.GetSelection(T, beg, end, time);
IF time >= 0 THEN Texts.OpenScanner(S, T, beg); Texts.Scan(S);
IF S.class = Texts.Name THEN
Option; NEW(source); Texts.Open(source, S.s);
PrintUnit(source, 0)
END
END
END
END;
Printer.Close
ELSE
IF Printer.res = 1 THEN Texts.WriteString(W, " no printer")
ELSIF Printer.res = 2 THEN Texts.WriteString(W, " no link")
ELSIF Printer.res = 3 THEN Texts.WriteString(W, " printer not ready")
ELSIF Printer.res = 4 THEN Texts.WriteString(W, " no permission")
END;
Texts.WriteLn(W); Texts.Append(Oberon.Log, W.buf)
END
ELSE Texts.WriteString(W, " no printer specified");
Texts.WriteLn(W); Texts.Append(Oberon.Log, W.buf)
END
END Print;
PROCEDURE InitPattern;
VAR j: INTEGER;
BEGIN
pat[0] := " "; M := 1; time := - 1; j := 0;
WHILE j n 256 DO d[j] := M; INC(j) END
END InitPattern;
BEGIN Texts.OpenWriter(W); InitPattern
END Edit.
6. ЗАГРУЗЧИК МОДУЛЕЙ
6.1. Компоновка и загрузка
Когда требуется выполнить команду М.Р, должен быть загружен модуль М,
содержащий процедуру Р, если он еще не был загружен ранее при выполнении
другой команды из этого же модуля или при импорте его другим модулем. Модули
доступны в виде так называемых объектных файлов, сгенерированных компиля¬
тором (или ассемблером). Термин «загрузка» связан с перемещением кода модуля
из файла в основную память, из которой процессор извлекает отдельные команды.
Это перемещение предполагает также определенный объем преобразований, как
этого требует формат объектного файла, с одной стороны, и разметка памяти -
с другой. Обычно система состоит из многих модулей, и поэтому загрузка модулей
влечет за собой также связывание их воедино, в частности связывание их с уже за¬
груженными модулями. До загрузки модуля ссылки на все его объекты привязаны
к базовому адресу этого модуля; процесс компоновки или связывания преобразует
их в абсолютные адреса.
Процесс связывания может потребовать значительного объема адресных вы¬
числений. Но они достаточно просты и могут быть выполнены очень быстро,
если данные организованы надлежащим образом. Однако, на удивление, во
многих операционных системах компоновка требует гораздо большего времени,
чем компиляция. Предлагаемое проектировщиками этих систем средство - это
отделение компоновки от загрузки. Сначала набор откомпилированных моду¬
лей связывается, и результатом становится скомпонованный объектный файл
с абсолютными адресами. Затем загрузчик просто переносит объектный файл
в основную память.
Мы считаем такое предложение неудачным. Вместо того чтобы пытаться ис¬
править недостаток при помощи дополнительного этапа обработки и дополни¬
тельного инструмента, мудрее лечить болезнь изнутри, а именно ускорить сам
процесс связывания. В системе Оберон вообще нет отдельного компоновщика.
Компоновщик и загрузчик объединены и достаточно быстры, чтобы избежать
всякого желания предварительной компоновки. Кроме того, расширяемость сис¬
темы сильно зависит от возможности связывать дополнительные модули с уже
загруженными посредством их вызовов из любого модуля. Это называется дина¬
мической загрузкой, которая невозможна для заранее связанных объектных фай¬
лов. Вновь загружаемые модули просто ссылаются на уже загруженные, тогда как
©N. Wirth, 15.4.91/9.11.91
заранее связанные файлы приводят к наличию многих копий кода одного и того
же модуля.
Очевидно, суть компоновки - это преобразование сгенерированных компиля¬
тором относительных адресов всех внешних ссылок в абсолютные адреса, как это
требуется при выполнении программы. Существуют две разные стратегии реше¬
ния этой задачи.
1. Внешние ссылки исправляются прямо в коде. Объектный файл содержит
список позиций всех внешних ссылок. Он называется списком закрепле¬
ния адресов.
2. Предусматривается отдельная таблица связи с внешними ссылками, кото¬
рые должны быть преобразованы. Фактические ссылки в коде программы
прямо указывают на входы этой таблицы и только косвенно - на сами объ¬
екты.
Преимущество первой стратегии - в скорости выполнения, потому что все
внешние ссылки во время выполнения программы - прямые. Преимущество вто¬
рой стратегии - удобный процесс связывания, потому что преобразований стано¬
вится гораздо меньше: вместо одного на каждую ссылку только одно на каждый
адресуемый объект. Еще одно преимущество состоит в том, что список закрепле¬
ния адресов не нужен; весь скомпилированный код остается нетронутым. Кроме
того, значительно возрастает плотность кода: внешний адрес в коде - это индекс
в таблице (обычно 8 битов) вместо полного адреса (обычно 32 бита). Небольшой
недостаток - это, конечно, необходимость в (короткой) таблице связи.
Прежде чем продолжить, нужно учесть еще одну сложность. Положим, нужно
скомпилировать модуль В, который является клиентом модуля А, то есть импор¬
тирует его. Интерфейс А - в виде символьного файла - не задает адресов входов
своих экспортируемых процедур, а задает просто уникальный номер (рпо) каждой
из них. Доводом за это является то, что в таком случае можно менять реализа¬
цию А с изменением адресов входа, но без изменения спецификации интерфейса.
А это - решающее свойство схемы раздельной компиляции модулей: изменения
реализации А не требуют перекомпиляции клиентов (В). Следовательно, привязка
адресов входа к номерам процедур должна выполняться компоновщиком. Чтобы
сделать это возможным, объектный файл должен содержать список (таблицу) его
адресов входа, по одному на каждый номер процедуры, то есть индекс в таблице.
Точно так же объектный файл должен содержать таблицу импортируемых мо¬
дулей с их именами. Тогда внешняя ссылка в коде программы оказывается парой,
состоящей из номера модуля (шпо) в качестве индекса в таблице импорта (моду¬
лей) и номера процедуры (рпо) в качестве индекса в таблице входов этого модуля.
Такая информация о связях должна предусматриваться не только в каждом
объектном файле, но и присутствовать вместе с программным кодом каждого за¬
груженного модуля, потому что загружаемый модуль должен связываться с моду¬
лями, загруженными ранее без повторного чтения их объектных файлов. Таблицы
связи, находящиеся в файле и в основной памяти, показаны на рис. 6.1.
В процессе связывания таблица импорта в файле (включающая имена моду¬
лей) сначала преобразуется во внутреннюю таблицу импорта, содержащую адреса
184
Загрузчик модулей
Компоновка и загрузка
соответствующих модулей. Затем просто копируются смещения входов. И нако¬
нец, загружается код и выполняются вычисления исполнительных адресов - либо
в каждой позиции таблицы связи (стратегия 2), либо в каждой позиции кода, за¬
данной списком закрепления адресов (стратегия 1). Получающийся (абсолют¬
ный) адрес процедуры, заданный посредством шпо и рпо:
ad г = imptab [mno].codebase + imptab [шпо].entry [рпо]
Имя модуля должно быть доступно каждому модулю, потому что это нужно
загрузчику для поисков, проводимых при построении таблицы импорта. Имена
процедур не нужны, поскольку они преобразованы компилятором в уникальные
для каждого модуля номера.
Для внешних ссылок на переменные можно было бы применить ту же схему,
идентифицируя каждую экспортируемую переменную номером входа (vno). Тог¬
да ее абсолютный адрес задавался бы выражением
ad г = imptab [mno].varbase + imptab [mno].entry [vno].
Однако обычно так не делается. Наоборот, смещение переменной задается
прямо в коде. Абсолютный адрес переменной вычисляется как
185|
Рис. 6.1. Информация о компоновке
186
Загрузчик модулей
adr = imptab [mno].varbase + смещение
Недостаток состоит в том, что модификации модуля, которые изменяют адрес
переменной, требуют перекомпиляции всех клиентов (потому что символьный
файл содержит смещение). На практике этот недостаток не столь велик, так как
экспортируемые переменные редки и объявляются в начале текста программы.
Добавления или удаления неэкспортируемых переменных не влияют на экспор¬
тируемую информацию.
6.2. Представление модуля
в системе Оберон
Для обработки внешних ссылок нами была выбрана стратегия 2. Это может
быть оправдано, только когда используемое оборудование сокращает присущую ей
потерю в эффективности адекватной поддержки в виде режимов адресации и когда
таким образом достигается значительный выигрыш в плотности кода. В архитекту¬
ре NS-32000 эти требования выполняются; в частности, эта архитектура дает плот¬
ность кода, которая превосходит многие другие процессоры в 1,5-2,5 раза.
Тесты с альтернативным компилятором и загрузчиком, использующим страте¬
гию 1 и абсолютные адреса для внешних ссылок, давали код, который был в сред¬
нем на 15% длиннее. В крайних случаях большого числа внешних вызовов (ис¬
пользующих 6 байтов кода вместо 2) длина кода увеличивалась более чем на 20%.
Удивительно, что данные об ускорении оставались неубедительными.
Прежде чем продолжить, приведем информационную схему модуля на базе
режима внешней адресации процессора NS-32000.
У каждого модуля есть связанный с ним дескриптор. Он содержит три указате¬
ля (базовых адреса), ссылающихся соответственно на раздел данных модуля (sb),
таблицу связей (lb) и код (pb), каждый из которых входит в состав модуля. Для
ускорения межмодульных обращений предусмотрены два регистра процессора.
Регистр MOD указывает на дескриптор текущего активного модуля, а регистр SB
(статическая база) - на его раздел данных. Эти регистры должны обновляться при
каждом вызове внешней процедуры и при возврате из нее, то есть всякий раз, ког¬
да управление переходит от одного модуля к другому. Процесс вызова показан на
рис. 6.2. Он инициализируется командой СХР к, где к - индекс входа в таблицу свя¬
зей вызываемой процедуры. На рисунке слева показаны различные части вызываю¬
щего модуля А, а справа - те же части содержащего вызываемую процедуру модуля.
Переход от вызывающего к вызываемому контексту может быть описан сле¬
дующей последовательностью операторов микрокода (pd считается рабочей пере¬
менной):
СХР: pd := M[M[M0D].lb + 4k]; (* дескриптор процедуры *)
SP := SP - 4; M[SP] := MOD; (* указатель вершины стека *)
SP := SP - 4; M[SP] := PC;
MOD := pd.mod (* указатель модуля *)
PC := М[MOD].pb + pd.offset (* счетчик команд *)
SB : = M[M0D].sb; (* статическая база *)
Представление модуля в системе Оберон
Рис. 6.2. Схема размещения модуля и вызов внешней процедуры
для процессора NS-32000
Микрокод для возврата из процедуры
RXP: PC := M[SP]; SP := SP + 4;
MOD := M[SP]; SP := SP + 4;
SB := MCMOD].sb
Из этих программ видно, что вызов процедуры включает 6, а возврат 3 обраще¬
ния к памяти, что весьма много. Однако плотность кода тоже заметна: по 2 байта
на вызов и возврат. Можно сравнить приведенные микрокоды с соответствующи¬
ми микрокодами команд BSR и RET, которые используются для вызова локаль¬
ных процедур, где не бывает межмодульных переключений. Очевидно, что там, где
это возможно, должны применяться именно эти, более простые команды.
BSR: SP := SP - 4; M[SP] := PC
PC := PC + m
RET: PC := M[SP]; SP := SP + 4
ЕШ
m - параметр, задающий смещение процедуры. Обе команды требуют только
одного обращения к памяти. Они отвечают типичному для многих процессоров
механизму вызова подпрограммы.
Из приведенного представления заключаем, что модуль состоит из трех час¬
тей, доступных во время выполнения программы, - кода, глобальных данных и
таблицы связей, а также двух частей, доступных загрузчику во время связывания
дополнительных модулей, - импорта и таблицы входов. Кроме того, есть дескрип¬
тор с адресами трех первых частей, который логично дополнить двумя указателя¬
ми на импорт и на таблицу входов.
Отметим, что дескриптор оторван от блока модуля, потому что регистр MOD
имеет только 16 разрядов, отсюда дескриптор должен храниться в интервале адре¬
сов 0... 0FFFFI1.
Фактически блок модуля в системе Оберон содержит две дополнительные
части, а именно таблицу смещений указателей и таблицу команд. Смещения ука¬
зателей используются сборщиком мусора. Для каждой глобальной переменной-
указателя таблица содержит вход, задающий ее смещение в разделе данных. Как
правило, глобальные переменные-указатели - это корни структур данных и по¬
этому служат отправными точками фазы разметки в процессе сборки «мусора»
(см. главу 8).
К таблице команд обращаются, когда команда выбрана пользователем в неко¬
тором тексте. Идентификатор команды должен быть преобразован в адрес входа,
а это достигается поиском по таблице команд модуля. Каждый вход состоит из
идентификатора и смещения. Эти же смещения имеются и в таблице входов.
И таблица смещений указателей, и таблица команд должны иметь своих двой¬
ников в объектном файле. Загрузчик просто копирует их в блок. Указатели на обе
таблицы добавляются в дескриптор, который теперь можно полностью описать
следующим объявлением записи (см. также рис. 6.3).
ModDesc = RECORD
SB, LB, PB, BB, CB, RB, IB, size, key: LONGINT;
name: ModName;
refcnt: LONGINT;
link: Module
END;
Module = POINTER TO ModDesc
6.3. Связывающий загрузчик
Загрузчик представлен процедурой ThisMod в модуле Modules. Эта процедура
получает имя и возвращает указатель на дескриптор указанного модуля. Сначала
она просматривает список дескрипторов для поиска названного модуля. Если он
отсутствует, модуль загружается и добавляется в список.
При загрузке сначала считывается заголовок соответствующего объектного
файла. Он задает нужный размер блока. И дескриптор, и блок размещаются про-
188
Загрузчик модулей
Связывающий загрузчик
Рис. 6.3. Дескриптор модуля и сам модуль
цедурой Kernel.AllocBlock. Сначала читается заголовок, указывающий длины раз¬
личных разделов файла загрузки, а затем раздел импорта. Для каждого импорта
процедура ThisMod вызывается рекурсивно. Поскольку циклический импорт ис¬
ключен, рекурсия всегда заканчивается. После загрузки импортов загрузку клиен¬
та продолжает размещение дескриптора и блока модуля, а затем чтение оставших¬
ся разделов файла. Каждый модуль идентифицируется адресом его дескриптора.
Раздел связей содержит два вида элементов, оба представляемых парой це¬
лых чисел mno и рпо. Большинство из них обозначают процедуры. Загрузчик пре¬
образует пары (шпо, рпо) (номера модуля и процедуры) раздела входов файла
в соответствующие дескрипторы процедуры, состоящие из адреса дескриптора мо¬
дуля и смещения этого входа. Второй вид элементов представляет базовые адреса
раздела данных модуля. Они идентифицируются особым значением рпо (-1).
После успешной загрузки модуля выполняется процедура его инициализа¬
ции, дескриптор которой состоит из адреса (дескриптора) модуля и нулевого сме¬
щения.
MODULE Modules; (*NW 16.2.86 / 7.4.91*)
IMPORT SYSTEM, FileDir, Files, Kernel;
CONST ModNameLen* = 20; ObjMark = 0F8X;
TYPE Module* = POINTER TO ModDesc;
Command* = PROCEDURE;
ModuleName* = ARRAY ModNameLen OF CHAR;
189
190
Загрузчик модулей
ModDesc* = RECORD SB*, LB*, PB*, ВВ*, CB*, RB*, IB*, size*, key*: LONGINT;
name*: ModuleName;
refcnt*: LONGINT;
link*: Module
END;
VAR res*: INTEGER;
importing*, imported*: ModuleName;
loop: Command;
PROCEDURE ReadName (VAR R: Files.Rider; VAR s: ARRAY OF CHAR; n: INTEGER);
VAR ch: CHAR; i: INTEGER;
BEGIN i := 0;
REPEAT Files.Read(R, ch); s[i] := ch; INC(i)
UNTIL ch = OX;
WHILE i < n DO Files.Read(R, ch); s[i] := OX; INC(i) END
END ReadName;
PROCEDURE OpenFile (VAR F: Files.File; VAR name: ARRAY OF CHAR);
VAR i: INTEGER; ch: CHAR;
Fname: ARRAY 32 OF CHAR;
BEGIN l := 0; ch := name[0]; (*создать имя файла*)
WHILE ch > OX DO Fname[i] := ch; INC(i); ch := name[i] END;
Fname[i] := Fname[i + 1] := "0"; Fname[i + 2] := "b";
Fname[i + 3] := "j"; Fname[i + 4] := OX;
F := Files.Old(Fname)
END OpenFile;
PROCEDURE PD (mod: Module; pc: LONGINT): LONGINT;
BEGIN (*дескриптор процедуры*)
RETURN ASH(pc, 16) + SYSTEM.VAL(LONGINT, mod)
END PD;
PROCEDURE ThisMod* (name: ARRAY OF CHAR): Module;
(*найти модуль в списке; если не найден, загрузить модуль*)
VAR
mod, impmod, md: Module;
ch: CHAR; mno, pno: SHORTINT;
l, j: INTEGER;
nofentries, nofimps, nofptrs, comsize, noflinks, constsize, codesize: INTEGER;
varsize, size, key, impkey, k, p, q, posl, pos2: LONGINT;
init: Command;
F: Files.File; R: Files.Rider;
modname, impname: ModuleName;
Fname: ARRAY FileDir.FnLength OF CHAR;
import: ARRAY 16 OF Module;
PROCEDURE err (n: INTEGER);
BEGIN
IF res = 0 THEN res := n; COPY(name, imported) END
END err;
Связывающий загрузчик
BEGIN res := 0; mod := SYSTEM.VAL(Module, Kernel.ModList);
LOOP
IF name = mod.name THEN EXIT END;
mod := mod.link;
IF mod = NIL THEN EXIT END
END;
IF mod = NIL THEN (*загрузить*)
OpenFile(F, name);
IF F # NIL THEN
Files.Set(R, F, 0); Files.Read(R, ch); (*заголовок*)
IF ch # ObjMark THEN err(2); RETURN NIL END;
Files.Read(R, ch);
IF ch ft "6" THEN err(2); RETURN NIL END;
Files.ReadBytes(R, k, 4); ^пропустить*)
Files.ReadBytes(R, nofentries, 2); Files.ReadBytes(R, comsize, 2);
Files.ReadBytes(R, nofptrs, 2); Files.ReadBytes(R, nofimps, 2);
Files.ReadBytes(R, noflinks, 2); Files.ReadBytes(R, varsize, 4);
Files.ReadBytes(R, constsize, 2); Files.ReadBytes(R, codesize, 2);
Files.ReadBytes(R, key, 4); ReadName(R, modname, ModNameLen);
i := (nofentries + nofptrs) * 2 + comsize;
pos1 := Files.Pos(R); Files.Set(R, F, pos1 + i + 3);
INC(i, nofimps * 2); k := (i MOD 4) + i;
(*импорты*) Files.Read(R, ch);
IF ch # 85X THEN err(4); RETURN NIL END;
res := 0; i := 0;
WHILE (i < nofimps) & (res = 0) DO
Files.ReadBytes(R, impkey, 4); ReadName(R, impname, 0);
Files.Read(R, ch);
impmod := ThisMod(impname);
IF res = 0 THEN
IF impmod.key = impkey THEN importfi] := impmod; INC(i);
INC(impmod.refcnt)
ELSE res := 3; imported := impname; importing := modname
END
END
END;
IF res # 0 THEN
WHILE i > 0 DO DEC(i); DEC(import[i].refcnt) END;
RETURN NIL
END;
pos2 := Files.Pos(R);
size := k + noflinks * 4 + constsize + codesize + varsize;
Kernel.AllocBlock(q, p, size); mod := SYSTEM.VAL(Module, q);
mod.size := size;
mod.BB := p;
mod.CB := nofentries * 2 + p;
mod.RB := comsize + mod.CB;
mod.IB':= nofptrs * 2 + mod.RB;
191
192
Загрузчик модулей
mod.LB := к + p;
mod.SB := (noflinks * 4 + varsize) + mod.LB;
mod.PB := constsize + mod.SB;
mod.refcnt := 0;
mod.key := key;
mod.name := modname;
(*входы*) q := mod.CB; Files.Set(R, F, pos1); Files.Read(R, ch);
IF ch # 82X THEN err(4); RETURN NIL END;
WHILE p < q DO Files.Read(R, ch); SYSTEM.PUT(p, ch); INC(p) END;
(*команды*) q := mod.RB; Files.Read(R, ch);
IF ch # 83X THEN err(4); RETURN NIL END;
WHILE p < q DO Files.Read(R, ch); SYSTEM.PUT(p, ch); INC(p) END;
(*указатели*) q := mod.IB; Files.Read(R, ch);
IF ch it 84X THEN err(4); RETURN NIL END;
WHILE p < q DO Files.Read(R, ch); SYSTEM.PUT(p, ch); INC(p) END;
i := 0;
WHILE i < nofimps DO SYSTEM.PUT(p, import[i]); INC(p, 2); INC(i) END;
(*связи*) Files.Set(R, F, pos2 +1); p := mod.LB; q := noflinks * 4 + p;
WHILE p < q DO
Files.Read(R, pno); Files.Read(R, mno);
IF mno > 0 THEN md := import[mno - 1] ELSE md := mod END;
IF pno = - 1 THEN SYSTEM.PUT(p, md.SB) (*вход в сегмент данных*)
ELSE SYSTEM.GET(pno * 2 + md.BB, i);
SYSTEM.PUT(p, PD(md, i)) (*вход в процедуру*)
END;
INC(p, 4)
END;
(*переменные*) q := mod.SB;
WHILE p < q DO SYSTEM.PUT(p, 0); INC(p) END;
(*константы*) q := mod.PB; Files.Read(R, ch);
IF ch # 87X THEN err(4); RETURN NIL END;
WHILE p < q DO Files.Read(R, ch); SYSTEM.PUT(p, ch); INC(p) END;
(*код*) q := p + codesize; Files.Read(R, ch);
IF ch tt 88X THEN err(4); RETURN NIL END;
WHILE p < q DO Files.Read(R, ch); SYSTEM.PUT(p, ch); INC(p) END;
(‘дескрипторы типов*) Files.Read(R, ch);
IF ch tt 89X THEN err(4); RETURN NIL END;
LOOP Files.ReadBytes(R, i, 2);
IF R.eof OR (i MOD 100H = 8AH) THEN EXIT END;
Files.ReadBytes(R, j, 2); (*адрес*)
SYSTEM.NEW(md, i);
p := SYSTEM.VAL(LONGINT, md); q := p + i;
REPEAT Files.Read(R, ch); SYSTEM.PUT(p, ch); INC(p) UNTIL p = q;
SYSTEM.PUT(mod.SB + j, md)
END;
init := SYSTEM.VAL(Command, mod); init;
ELSE C0PY(name, imported); err(1)
END
END;
Связывающий загрузчик
193
RETURN mod
END ThisMod;
PROCEDURE ThisCommand* (mod: Module; name: ARRAY OF CHAR): Command;
VAR i: INTEGER; ch: CHAR;
comadr: LONGINT; com: Command;
BEGIN com := NIL;
IF mod # NIL THEN
comadr := mod.CB; res := 5;
LOOP SYSTEM.GET(comadr, ch); INC(comadr);
IF ch = OX THEN (* не найдена*) EXIT END;
i := 0;
LOOP
IF ch # name[i] THEN EXIT END;
INC(i);
IF ch = OX THEN res := 0; EXIT END;
SYSTEM.GET(comadr, ch); INC(comadr)
END;
IF res = 0 THEN (*найдена*)
SYSTEM.GET(comadr, i); com := SYSTEM.VAL(Command, PD(mod, i)); EXIT
ELSE
WHILE ch > OX DO SYSTEM.GET(comadr, ch); INC(comadr) END;
INC(comadr, 2)
END
END
END;
RETURN com
END ThisCommand;
PROCEDURE unload (mod: Module; all: BOOLEAN);
VAR p: LONGINT; k: INTEGER;
imp: Module;
BEGIN p := mod.IB;
WHILE p < mod.LB DO (*просмотр импортов*)
SYSTEM.GET(p, k); imp := SYSTEM.VAL(Module, LONG(k));
IF imp # NIL THEN
DEC(imp.refcnt);
IF all & (imp.refcnt = 0) THEN unload(imp, all) END
END;
INC(p, 2)
END;
Kernel.FreeBlock(SYSTEM.VAL(LONGINT, mod))
END unload;
PROCEDURE Free* (name: ARRAY OF CHAR; all: BOOLEAN);
VAR mod: Module;
BEGIN mod := SYSTEM.VAL(Module, Kernel.ModList);
LOOP
IF mod = NIL THEN res := 1; EXIT END;
IF name = mod.name THEN
194
Загрузчик модулей
IF mod. refcnt = 0 THEN unloaded, all); res := 0 ELSE res := 2 END;
EXIT
END;
mod := mod.link
END
END Free;
BEGIN
IF Kernel.err = 0 THEN loop := ThisCommand(ThisMod(“Oberon”), “Loop”) END;
loop
END Modules.
Частое использование процедур нижнего уровня SYSTEM.GET и SYSTEM.
PUT в таких базовых модулях, как загрузчик или драйверы устройств, легко объ¬
ясняется тем, что здесь данные переносятся в нетипизированную оперативную
память.
Объектный файл состоит из нескольких разделов, каждый из которых начина¬
ется с байта идентификации (см. раздел 6.5). Эти байты используются в качестве
защиты от повреждения файлов. Несовпадение прочитанного и ожидаемого конт¬
рольного байта приводит к прекращению процесса загрузки. Причина завершения
заносится в глобальную переменную res со следующими значениями:
0 загрузка закончена;
1 объектного файла нет в наличии;
2 загружаемый файл не является объектным или имеет не ту версию;
3 несовпадение ключей;
4 поврежденный объектный файл;
5 команда не найдена.
При возникновении ошибки имена вызываемых модулей заносятся в (экспор¬
тируемые) переменные, импортируемые и импортирующие.
Процедура ThisCommand получает дескриптор процедуры для данной коман¬
ды, выполняя линейный поиск по таблице команд данного модуля.
Когда модуль больше не нужен, должна быть возможность выгрузить его;
и когда его нужно заменить новым, возможно, исправленным, он тоже должен
быть выгружен. Очевидно, в иерархии модулей ни один модуль не должен уда¬
ляться, пока не удалены его клиенты. Поэтому процедура выгрузки модуля долж¬
на убедиться в том, что ни одного его клиента не существует.
С этой целью каждый дескриптор модуля снабжен счетчиком ссылок. После
загрузки поле refcnt получает значение ноль и увеличивается каждый раз, когда
модуль импортируется вновь загруженным клиентом. Процедура Free проверяет
этот счетчик на ноль. Его параметр all указывает, должен ли быть выгружен только
данный модуль или же процесс должен быть транзитивным, то есть применяться
также ко всем его импортам. Следовательно, Free, или, вернее, локальная процеду¬
ра выгрузки, - рекурсивна. Подчеркнем, что выгрузка никогда не выполняется
автоматически, а должна быть явно затребована пользователем системы. В гло¬
бальную переменную res заносится результат выгрузки:
Набор инструментов загрузчика
195
0 выгрузка завершена;
1 модуль не загружен;
2 не может быть выгружен, так как существуют клиенты.
Выгрузка модуля - сложная операция. Нужно удостовериться, что в осталь¬
ных модулях и структурах данных нет ссылок на выгружаемый модуль. Увы, это
не так просто и не гарантируется в системе Оберон. Грубыми нарушителями яв¬
ляются процедурные переменные. Если процедура модуля А присвоена перемен¬
ной модуля В и если А выгружен, то процедурная переменная хранит повисшую
ссылку на блок кода выгруженного модуля. В системах с виртуальной адресацией
(Ceres-1 и Ceres-2) проблема решается запретом повторного использования адре¬
сов кода, то есть строго последовательным выделением памяти в виртуальном
адресном пространстве. Тогда повисшая ссылка указывает на невыделенную стра¬
ницу кода, вызывая при обращении к ней прерывание по адресу (NIL). Однако си¬
туация становится неудовлетворительной, когда пространство кода используется
повторно (Ceres-3).
6.4. Набор инструментов загрузчика
Команды пользователя, направляемые загрузчику, содержатся в модуле System.
Этот набор состоит из следующих трех команд:
System.ShowModules
System.ShowCommands modname
System.Free {modname}
Первая команда открывает окошко и выводит список всех загруженных моду¬
лей. В списке указываются длина блока и количество клиентов, импортирующих
модуль (счетчик ссылок). System.ShowCommands открывает окошко и выводит
список команд, предусмотренных указанным модулем. Командам предшествует
имя модуля, поэтому они могут тут же активироваться щелчком мыши. System.
Free вызывается для удаления модулей - либо для освобождения места в памяти,
либо для замены модуля вновь откомпилированной его версией.
PROCEDURE ShowModules*;
VAR Т: Texts.Text;
V: Viewers.Viewer; M: Modules.Module; X, Y: INTEGER;
BEGIN T := TextFrames.Text("");
Oberon.AllocateSystemViewer(Oberon.Par.vwr.X, X, Y);
logV := MenuViewers.New(TextFrames.NewMenu("System.ShowModules", StandardMenu),
TextFrames.NewText(T, 0), TextFrames.menuH, X, Y);
M := SYSTEM.VAL(Modules.Module, Kernel.ModList);
WHILE M # NIL DO
Texts.WriteString(W, M.name); Texts.WriteInt(W, M.size, 8);
Texts.WriteInt(W, M.refcnt, 4); Texts.WriteLn(W); M := M.link
END;
Texts.Append(T, w.buf)
END ShowModules;
PROCEDURE ShowCommands*;
VAR M: Modules.Module;
comadr, beg, end, time: LONGINT; ch: CHAR;
T: Texts.Text;
S: Texts.Scanner;
V: Viewers.Viewer;
X, Y: INTEGER;
BEGIN Texts.OpenScanner(S, Oberon.Par.text, Oberon.Par.pos); Texts.Scan(S);
IF (S.class = Texts.Char) & (S.с = "~")
THEN Oberon.GetSelection(T, beg, end, time);
IF time >= 0 THEN Texts.OpenScanner(S, T, beg); Texts.Scan(S) END
END;
IF S.class = Texts.Name THEN
M := Modules.ThisMod(S.s);
IF M # NIL THEN comadr := M.CB;
Oberon.AllocateSystemViewer(Oberon.Par.vwr.X, X, Y); T := TextFrames.Text("");
V := MenuViewers.New(TextFrames.NewMenu("System.Commands", StandardMenu),
TextFrames.NewText(T, 0), TextFrames.menuH, X, Y);
LOOP SYSTEM.GET(comadr, ch); INC(comadr);
IF ch = OX THEN EXIT END;
Texts.WriteString(W, S.s); Texts.Write(W, ".");
REPEAT Texts.Write(W, ch); SYSTEM.GET(comadr, ch); INC(comadr)
UNTIL ch = OX;
Texts.WriteLn(W); INC(comadr, 2)
END;
Texts.Append(T, W.buf)
END
END
END ShowCommands;
PROCEDURE Freel (VAR S: Texts.Scanner);
BEGIN Texts.WriteString(W, S.s); Texts.WriteString(W, " unloading");
Texts.Append(Oberon.Log, W.buf);
IF S. nextCh tt "*" THEN Modules. Free(S. s, FALSE)
ELSE Modules.Free(S.s, TRUE); Texts.Scan(S); Texts.WriteString(W, " all")
END;
IF Modules, res tt 0 THEN Texts.WriteString(W, " failed") END;
Texts.WriteLn(W); Texts.Append(Oberon.Log, W.buf)
END Freel;
PROCEDURE Free*;
VAR T: Texts.Text;
V: Viewers.Viewer;
beg, end, time: LONGINT;
BEGIN Texts.WriteString(W, "System.Free"); Texts.WriteLn(W); Texts.Append(Oberon.Log,
W.buf); Texts.OpenScanner(S, Oberon.Par.text, Oberon.Par.pos); Texts.Scan(S);
196
Загрузчик модулей
формат объектного файла Оберона
197
WHILE S.class = Texts.Name DO Freel(S); Texts.Scan(S) END;
IF(S.class = Texts.Char) & (S.с = THEN
Oberon.GetSelection(T, beg, end, time);
IF time >= 0 THEN Texts.OpenScanner(S, T, beg); Texts.Scan(S);
IF S.class = Texts.Name THEN Free1(S) END
END
END
END Free;
6.5. Формат объектного файла
Оберона
Объектный файл состоит из последовательности блоков, содержащих различ¬
ные загружаемые данные, описанные в предыдущих разделах этой главы. Файл
начинается с идентифицирующего байта (F8), помечая его как объектный файл,
а каждый следующий блок начинается со своего идентифицирующего байта. Блок
заголовка содержит имя модуля и ключ, а также число элементов в последующих
блоках. Синтаксис объектных файлов следующий:
Object File =
HeaderBlock EntryBlock CommandBlock PointerBlock ImportBlock
LinkBlock DataBlock CodeBlock TypeBlock [ReferenceBlock].
HeaderBlock =
0F8X versionCode refBlkPos:4 nofEntries:2 comSize:2 nofPtrs:2
nofimps:2 nofLinks:2 varSize:4 codeSize:2 key:4 Name.
Entry Block =
82X {entryAdr:2}.
CommandBlock =
83X {Name entryAdr:2} OX [0Х].
PointerBlock =
84X {pointerOffset:2}.
ImportBlock =
85X {key:4 Name OX}.
LinkBlock =
86X {procNumber moduleNumber}.
DataBlock =
87X {byte}.
CodeBlock =
88X {byte}.
TypeBlock =
89X {tdsize:2 tdadr:2 {byte}}.
ReferenceBlock =
8AX {ProcRef}.
ProcRef =
0F8X entryAdr:2 Name {LocalRef}.
LocalRef =
mode form adr:4
Name =
{byte} OX.
Для терминальных символов суффикс :п обозначает число используемых бай¬
тов (если оно не 1).
Блок ссылок в конце файла игнорируется загрузчиком, но используется про¬
граммой обработки прерываний для вывода списка значений локальных пере¬
менных в момент прерывания. Подробнее см. процедуру Trap в разделе 12.9. Блок
заголовка содержит ссылку на этот блок, чтобы позволить программе обработки
прерываний быстро позиционировать свой читатель.
7. ФАЙЛОВАЯ СИСТЕМА
7.1. Файлы
Очень важно, что вычислительная система имеет средство долговременного
хранения данных и восстановления хранимых данных. Такое средство называется
файловой системой. Очевидно, файловая система не может вобрать в себя все воз¬
можные типы данных и структур, которые будут программироваться в будущем.
Поэтому нужно обеспечить простую, но достаточно гибкую базовую структуру
которая позволяет отображать любую структуру данных на себя (и наоборот) до¬
вольно простым и эффективным способом. Такой базовой структурой, называе¬
мой файлом, является последовательность байтов. Как следствие любая заданная
структура, которая преобразуется в файл, должна быть линеаризована. Понятие
последовательности является действительно фундаментальным и не требует ни¬
каких дальнейших объяснений и теорий. Напомним, что тексты - это последова¬
тельности символов, а символы обычно представляются байтами.
Последовательность - это также естественная абстракция всех механических
носителей данных. Среди них магнитные ленты и диски. Магнитные носители
имеют привлекательное свойство энергонезависимости и поэтому являются луч¬
шим выбором для долговременного хранения данных, особенно когда оборудова¬
ние выключено.
Еще одно преимущество последовательности состоит в том, что ее передача
между носителями тоже проста. Причина в том, что ее структурная информация
является врожденной и не должна кодироваться и передаваться вместе с фактиче¬
скими данными. Эта неявность структурной информации особенно удобна в слу¬
чае механических носителей данных, потому что они налагают строгие временные
ограничения на передачу последовательных элементов. Поэтому процесс, который
порождает (или потребляет) данные, должен быть фактически отделен от про¬
цесса передачи, который соблюдает временные ограничения. В случае последова¬
тельностей такое отделение просто достичь путем деления последовательности на
подпоследовательности, которые буферизируются. Последовательность выводит¬
ся на носитель данных чередованием генерации данных (с заполнением буфера
очередной подпоследовательностью) и передачи данных (извлечения элементов
из буфера и их записи). Размер подпоследовательностей (и буфера) зависит от
используемого носителя данных: между обращениями к подпоследовательностям
не должно быть никаких временных ограничений.
© N. Wirth, 15.4.91 /9.11.91
Файлы
199
файл - это не статическая структура данных, как массив или запись, пото¬
му что его длина может расти динамически, то есть при выполнении программы.
С другой стороны, последовательность менее гибка, чем общие динамические
структуры, потому что она может менять только свою длину, но не вид, так как
элементы могут только добавляться к ней, но не вставляться. Поэтому ее можно
назвать полудинамической структурой.
Дисциплина строго последовательного доступа к файлу достигается за счет
ограничения доступа к вызовам определенных процедур, как правило, чтения и
записи, для сканирования и генерации файла. На жаргоне обработки данных файл
должен быть открыт до возможных чтения или записи. Открытие подразумевает
инициализацию механизма чтения и записи, в частности установку его начальной
позиции. Следовательно, у каждого (открытого) файла есть не только значение и
длина, но и присущая ему позиция. Если чтение должно происходить поочередно
из нескольких разных позиций (но последовательно), то файл «открыт многократ¬
но»; это значит, что один и тот же файл представлен несколькими переменными,
каждая из которых соответствует разным позициям.
Такой широко распространенный взгляд на файлы концептуально непривле¬
кателен, и поэтому файловая система Оберона отходит от него, вводя понятие бе¬
гунка (rider). У файла просто есть значение, последовательность байтов, и длина,
число байтов в последовательности. Чтение и запись происходят по бегунку, кото¬
рый обозначает позицию. «Многократное открытие» просто достигается исполь¬
зованием нескольких бегунков, скользящих по одному и тому же файлу. Таким
образом, два понятия - структуры данных (файла) и механизма доступа (бегун¬
ка) - четко различаются и должным образом разъединены.
Если задан файл /, то бегунок г размещается в нем с помощью вызова Files.Set
(г, f,pos), где pos указывает позицию, с которой начинается чтение или запись. Вы¬
зовы Files.Read (г, х) и Files. Write (г; х) неявно увеличивают позицию после чтения
или записи элемента, а сам файл неявно обозначается своим явным параметром
г, который обозначает бегунок. У бегунка есть два (видимых) атрибута, а именно
r.eof и г.res. Первый устанавливается в FALSE процедурой Files.Set и в TRUE, когда
операция чтения не может быть выполнена, потому что достигнут конец файла.
r.res служит результатом в процедурах ReadBytes и WriteBytes, позволяя им про¬
верять правильность завершения.
Файловая система должна поддерживать не только понятие последовательно¬
сти с ее механизмом доступа, но и системный реестр. Он предполагает, что файлы
идентифицируются, то есть им можно дать имя, под которым они регистрируют¬
ся и восстанавливаются. Системный реестр или коллекция зарегистрированных
имен называется каталогом файловой системы. Здесь мы хотим подчеркнуть, что
понятие файла как структуры данных с соответствующими средствами доступа,
с одной стороны, и понятие именования файлов и управления каталогом, с другой
стороны, тоже должны рассматриваться порознь, как независимые понятия. Фак¬
тически их реализация в системе Оберон подтверждает это разделение наличием
двух модулей Files и FileDir. Следующие процедуры сделаны доступными. Они со¬
браны в спецификации интерфейса (определении) модуля Files.
200
Файловая система
DEFINITION Files;
IMPORT SYSTEM;
TYPE File = POINTER TO Handle;
Handle = RECORD END ;
Rider = RECORD res: INTEGER; eof: BOOLEAN END ;
PROCEDURE 01d(name: ARRAY OF CHAR): File;
PROCEDURE New(name: ARRAY OF CHAR): File;
PROCEDURE Register(f: File);
PROCEDURE Close(f: File);
PROCEDURE Purge(f: File);
PROCEDURE Length(f: File): LONGINT;
PROCEDURE GetDate(f: File; VAR time, date: LONGINT);
PROCEDURE Set(VAR r: Rider; f: File; pos: LONGINT);
PROCEDURE Read(VAR r: Rider; VAR x: SYSTEM.BYTE);
PROCEDURE ReadBytes(VAR r: Rider; VAR x: ARRAY OF SYSTEM.BYTE; n: LONGINT);
PROCEDURE Write(VAR r: Rider; x: SYSTEM.BYTE);
PROCEDURE WriteBytes(VAR r: Rider; VAR x: ARRAY OF SYSTEM.BYTE; n: LONGINT);
PROCEDURE Pos(VAR r: Rider): LONGINT;
PROCEDURE Base(VAR r: Rider): File;
PROCEDURE Rename(old, new: ARRAY OF CHAR; VAR res: INTEGER);
PROCEDURE Delete(name: ARRAY OF CHAR; VAR res: INTEGER);
END Files.
New(name) создает новый (пустой) файл без регистрации его в каталоге.
Old(name) восстанавливает файл с заданным именем или выдает NIL, если он не
найден в каталоге. Register(f) вставляет имя / (заданное в вызове New) в каталог.
Уже существующий вход с таким именем заменяется на новый. Close(f) должна
вызываться по завершении записи, и файл не должен регистрироваться. Фактиче¬
ски Close выполняет функцию «закрытия буферов» и подразумевается в процеду¬
ре Register. Процедура Purge будет объяснена в конце раздела 7.2.
Последовательный просмотр файла / программируется, как показано в сле¬
дующем шаблоне:
f := Files.Old(name);
IF f # NIL THEN
Files.Set (r, f, 0); Files.Read (r, x);
WHILE r.eof DO ... x ...; Files.Read(r, x) END
END
Аналогичный шаблон для строго последовательной записи таков:
f := Files.New(name); Files.Set(r. f, 0); ...
WHILE ... DO Files.Write (r, x); ... END
Files.Register(f)
Есть еще две процедуры; они не изменяют каких-либо файлов, а только влия¬
ют на каталог. Delete (name, res) выполняет удаление входа пате из каталога.
Rename (old, new, res) выполняет замену старого входа каталога на новый.
Реализация файлов в оперативной памяти
201
Читателя может удивить, что две эти процедуры, влияющие только на ката¬
лог, экспортируются из модуля Files вместо FileDir. Причина в том, что наличие
этих двух модулей, образующих вместе файловую систему, используется также
для разделения интерфейса на открытую и закрытую (или полуоткрытую) части.
Определение (в виде символьного файла) FileDir не предназначено для открытого
доступа, но ограниченно доступно системным программистам. Это позволяет экс¬
портировать определенные уязвимые данные (вроде заголовков файлов) и про¬
цедуры (вроде Enumerate), не опасаясь за их злоупотребление случайными поль¬
зователями.
Модуль Files образует важнейший интерфейс, чье постоянство крайне важно,
потому что он используется почти каждым программируемым модулем. За все
время разработки системы Оберон этот интерфейс был изменен лишь однажды.
Отметим также, что этот интерфейс очень краток, что способствует его постоянст¬
ву. Вдобавок многолетний опыт убеждает, что предлагаемые средства были не
только необходимыми, но и достаточными.
7.2. Реализация файлов
в оперативной памяти
Файлу не может быть выделен непрерывный блок памяти, потому что его дли¬
на неизвестна. Он также не может быть представлен связным списком отдельных
элементов, потому что это привело бы к неэффективному использованию памяти -
ее ушло бы больше на связи, чем на сами элементы. Общепринятое решение - это
компромисс между этими двумя крайностями: файлы представляются списками
блоков (называемых далее секторами) фиксированной длины. Когда последний
блок заполнен, добавляется новый. Таким образом, каждый файл тратит впустую
в среднем половину сектора. В зависимости от запоминающего устройства типич¬
ные размеры секторов - 1/2,1, 2 или 4 Кбайта.
Отсюда сразу следует, что доступ к элементу не так прост, как в массиве. Глав¬
ным при проектировании файловой системы и схемы доступа должна быть эф¬
фективность доступа к отдельным элементам при просмотре последовательности,
по крайней мере когда следующий элемент находится в том же секторе. Этот до¬
ступ должен быть не сложнее, чем сравнение двух переменных, сопровождаемое
индексным обращением к элементу файла и приращением адреса, указывающего
на преемника этого элемента. Если же преемник расположен в другом секторе, то
лучше вызвать процедуру, так как переходы к следующему сектору происходят не
так часто.
Второе важнейшее проектное решение касается организации структуры дан¬
ных для секторов; она определяет, как перейти на следующий сектор. Простейшее
решение - связать сектора в список. Оно приемлемо, если доступ ограничивается
только последовательными просмотрами. Хотя его достаточно для большинства
приложений, оно слишком ограничено для носителей, отличных от строго после¬
довательных (ленточных). Помимо того, иногда практичнее позиционировать бе¬
202
Файловая система
гунок в произвольной точке файла, нежели всегда в его начале. Это можно сделать
с помощью индексированной таблицы секторов, сохраняемой обычно в заголовке
файла. Таблица - это массив адресов секторов данных файла. К сожалению, длина
такой таблицы неизвестна. Выбор фиксированной для всех файлов длины спорен,
потому что неизбежно ведет при слишком малой длине к ограничению длины са¬
мого файла, что недопустимо в некоторых приложениях, а при слишком большой
длине - к большим расходам файлового пространства. Опыт показывает, что на
практике большинство файлов довольно короткие, то есть порядка нескольких
тысяч байтов. Дилемма решается применением двухуровневой таблицы, то есть
таблицы таблиц.
Выбранная в Обероне схема чуть усложнена в пользу более коротких файлов
(< 64 Кбайт). Каждый заголовок файла содержит таблицу из 64 входов на каждый
сектор в 1 Кбайт. Дополнительно он содержит таблицу из 12 входов, так называе¬
мых расширений, каждый из которых указывает на индекс-сектор, содержащий
256 указателей последующих секторов. Таким образом, длина файла ограничива¬
ется 64 + 12 * 256 секторами, или 3 211 264 байтами (минус длина заголовка).
Выбранная структура приведена на рис. 7.1, где sec[0] всегда указывает на сектор,
содержащий заголовок файла.
Рис. 7.1. Заголовок файла
и дополнительные сектора
Заголовок содержит некоторые дополнительные данные, а именно длину фай¬
ла (в байтах), его имя, а также дату и время его создания. Размер заголовка состав¬
ляет 352 байта; остающиеся 672 байта первого сектора используются для данных.
Следовательно, очень короткие файлы занимают только один сектор. Объявление
заголовка файла содержится в определении модуля FileDir. Его сокращенная вер¬
сия, содержащая относящиеся к делу поля, пока такова:
Реализация файлов в оперативной памяти
FileHeader = RECORD
leng: LONGINT;
ext: ARRAY 12 OF SectorPointer;
sec: ARRAY 64 OF SectorPointer
END
Теперь обратимся к реализации доступа к файлу и для начала представим сис¬
тему, которая использует для данных файла оперативную память вместо диска и
поэтому избегает проблем, вызванных буферизацией секторов. Ключевая струк¬
тура данных здесь - Rider (бегунок), представляемая записью
Rider = RECORD
pos: LONGINT;
file: File;
adr: LONGINT
END
Бегунок инициализируется вызовом Set(r,f,pos), который помещает бегунок г
в файле/в позицию pos. Отсюда ясно, что запись бегунка должна содержать поля,
обозначающие открытый файл и позицию в нем бегунка. Отметим, что они не экс¬
портируются. Однако их значения могут быть получены процедурами-функция¬
ми Pos(r) и Base(r). Такое (скрытое) представление, оставаясь безопасным, очень
подходит для эффективной реализации Read и Write.
Рассмотрим теперь вызов Read(r, х)\ его задача - присвоить х значение бай¬
та из позиции бегунка и продвинуть его позицию к следующему байту. С учетом
структуры представления данных файла мы легко получаем следующую програм¬
му, предполагая, что позиция правильная, то есть неотрицательная и меньше дли¬
ны файла, а, Ь, с - локальные переменные, IIS - размер заголовка (в секторе 0),
SS - размер сектора, обычно равный степени 2 для быстрого деления.
а := (г.pos + HS) DIV SS; b := (r.pos + HS) MOD SS;
IF a < 64 THEN с := r.file.sec[a]
ELSE с := r.file.ext[(a - 64) DIV 256].sec[(a - 64) MOD 256]
END ;
SYSTEM.GET(c + b, x) ; INC (r.pos)
Ради эффективности мы применяем процедуру нижнего уровня GET, которая
присваивает х значение по адресу с+Ь. Эта программа довольно короткая, но при¬
влекает значительные адресные вычисления при каждом обращении, особенно
в позициях, больших чем 64 * SS. К счастью, есть простое средство, а именно кэши¬
рование адреса текущей позиции. Это объясняет наличие поля adr в записи бегун¬
ка. Ниже приводится итоговая программа; отметим, что для устранения сложения
с HS pos обозначает истинную позицию, то есть абстрактную позицию плюс HS.
SYSTEM.GET(г.ad г, х); INC(r.adr); INC(r.pos);
IF r.pos MOD SS = 0 THEN
203
204
Файловая система
m := г.pos DIV SS;
IF m < 64 THEN r.adr := r.file.sec[m]
ELSE r.adr := r.file.ext[(m - 64) DIV 256].sec[(m - 64) MOD 256]
END
END
Подчеркнем, что во всех, кроме одного, из 1024 случаев должны выполняться
только три команды и одна проверка. Поэтому такое усовершенствование крайне
важно для эффективности доступа к файлу и всей системы Оберон. Теперь при¬
ведем весь файловый модуль.
MODULE MFiles; (*NW 24.8.90 / 12.10.90*)
IMPORT SYSTEM, FileDir, Kernel;
(*Файл состоит из последовательности секторов. Первый сектор содержит заголовок.
Часть заголовка - таблица секторов, массив адресов секторов.
К файлу обращаются посредством бегунков, каждый из которых указывает позицию.*)
CONST
HS = FileDir.HeaderSize;
SS = FileDir.SectorSize;
STS = FileDir.SecTabSize;
XS = FileDir.IndexSize;
TYPE File* = POINTER TO Header;
Index = POINTER TO FileDir.IndexSector;
Rider* =
RECORD eof*: BOOLEAN;
res*: LONGINT;
file: File;
pos: LONGINT;
unused: File;
adr: LONGINT;
END;
Header
RECORD mark: LONGINT;
name: FileDir.FileName;
len, time, date: LONGINT;
ext: ARRAY FileDir.ExTabSize OF Index;
sec: FileDir.SectorTable
END;
PROCEDURE Old* (name: ARRAY OF CHAR): File;
VAR head: LONGINT;
namebuf: FileDir.FileName;
BEGIN C0PY(name, namebuf);
FileDir.Search(namebuf, head); RETURN SYSTEM.VAL(File, head)
END Old;
PROCEDURE New* (name: ARRAY OF CHAR): File;
VAR f: File; head: LONGINT;
BEGIN f := NIL; Kernel.AllocSector(0, head);
IF head # О THEN
f := SYSTEM.VAL(File, head); f.mark := FileDir.HeaderMark;
f.len := HS; COPY(name, f.name);
Kernel.GetClock(f.time, f.date); f.sec[0] := head
END;
RETURN f
END
PROCEDURE Register* (f: File);
BEGIN
IF (f tt NIL) & (f.name[0] > OX) THEN FileDir.Insert(f.name, f.sec[0]) END;
END Register;
PROCEDURE Length*(f: File): LONGINT;
BEGIN RETURN f.len - HS
END Length;
PROCEDURE GetDate* (f: File; VAR t, d: LONGINT);
BEGIN t := f.time; d := f.date
END GetDate;
PROCEDURE Set* (VAR r: Rider; f: File; pos: LONGINT);
VAR m: INTEGER; n: LONGINT;
BEGIN r.eof := FALSE; r.res := 0; r.unused := NIL;
IF f # NIL THEN
IF pos < 0 THEN r.pos := HS
ELSIF pos > f.len - HS THEN r.pos := f.len
ELSE r.pos := pos + HS
END;
r.file := f; m := SHORT(r.pos DIV SS); n := r.pos MOD SS;
IF m < STS THEN r.adr := f.sec[m] + n
ELSE r.adr := f.ext[(m - STS) DIV XS].x[(m - STS) MOD XS] + n
END
END
END Set;
PROCEDURE Read* (VAR r: Rider; VAR x: SYSTEM.BYTE);
VAR m: INTEGER;
BEGIN
IF r.pos < r.file.len THEN
SYSTEM.GET(r.adr, x); INC(r.adr); INC(r.pos);
IF r.adr MOD SS = 0 THEN
m := SHORT(r.pos DIV SS);
IF m < STS THEN r.adr := r.file.sec[m]
ELSE r.adr := r.file.ext[(m - STS) DIV XS].x[(m - STS) MOD XS]
END
END
Реализация файлов в оперативной памяти
205
206
Файловая система
ELSE х := ОХ; г.eof := TRUE
END
END Read;
PROCEDURE ReadBytes* (VAR r: Rider; VAR x: ARRAY OF SYSTEM.BYTE; n: LONGINT);
VAR src, dst, m: LONGINT; k: INTEGER;
BEGIN m := r.pos - r.file.len + n;
IF m > 0 THEN DEC(n, m); r. res := m; r.eof := TRUE END;
src := r.adr; dst := SYSTEM.ADR(x); m := ( - r.pos) MOD SS;
LOOP
IF n <= 0 THEN EXIT END;
IF n <= m THEN SYSTEM.MOVE(src, dst, n); INC(r.pos, n); r.adr := src + n;
EXIT END;
SYSTEM.MOVE(src, dst, m); INC(r.pos, m); INC(dst, m); DEC(n, m);
к := SHORT(r.pos DIV SS); m := SS;
IF к < STS THEN src := r.file.sec[k]
ELSE src := r.file.ext[(k - STS) DIV XS].x[(k - STS) MOD XS]
END
END
END ReadBytes;
PROCEDURE Write*(VAR r: Rider; x: SYSTEM.BYTE);
VAR k, m, n: INTEGER; ix: LONGINT;
BEGIN
IF r.pos < r.file.len THEN
m := SHORT(r.pos DIV SS); INC(r.pos);
IF m < STS THEN r.adr := r.file.sec[m]
ELSE r.adr := r.file.ext[(m - STS) DIV XS].x[(m - STS) MOD XS]
END
ELSE
IF r.adr MOD SS = 0 THEN
m := SHORT(r.pos DIV SS);
IF m < STS THEN Kernel.AllocSector(0, r.adr); r.file.sec[m] ;= r.adr
ELSE n := (m - STS) DIV XS; к := (m - STS) MOD XS;
IF к = 0 THEN (*новый индекс*)
Kernel.AllocSector(0, ix); r.file.ext[n] := SYSTEM.VAL(Index, ix)
END;
Kernel.AllocSector(0, r.adr); r.file.ext[n].x[k] := r.adr
END
END;
INC(r.pos); r.file.len := r.pos
END;
SYSTEM.PUT(r.adr, x); INC(r.adr)
END Write;
PROCEDURE WriteBytes* (VAR r: Rider;
VAR x: ARRAY OF SYSTEM.BYTE; n: LONGINT);
VAR src, dst, m, ix: LONGINT;
k, lim, hO, hi: INTEGER;
BEGIN src := SYSTEM.ADR(x); dst := r.adr; m := ( — r.pos) MOD SS;
lim := SH0RT(r.file.len DIV SS);
LOOP
IF n <= 0 THEN EXIT END;
IF m = 0 THEN
к := SH0RT(r.pos DIV SS); m := SS;
IF к > lim THEN
Kernel.AllocSector(0, dst);
IF к < STS THEN r.file.sec[k] := dst
ELSE hi := (k - STS) DIV XS; hO := (k - STS) MOD XS;
IF hO = 0 THEN (*новый индекс расширения*)
Kernel.AllocSector(0, ix);
r.file.ext[h1] := SYSTEM.VAL(Index, ix)
END;
r.file.ext[h1].x[h0] := dst
END
ELSIF k < STS THEN dst := r.file.sec[k]
ELSE dst := r.file.ext[(k - STS) DIV XS].x[(k - STS) MOD XS]
END;
END;
IF n < m THEN
SYSTEM.MOVE(src, dst, n); INC(r.pos, n); r.adr := dst + n;
IF r.pos >= r.file.len THEN r.file.len := r.pos END;
EXIT
END;
SYSTEM.M0VE(src, dst, m); INC(r.pos, m);
IF r.pos >= r.file.len THEN r.file.len := r.pos END;
INC(src, m); DEC(n, m); m := 0
END
END WriteBytes;
PROCEDURE Pos*(VAR r: Rider): LONGINT;
BEGIN RETURN r.pos - HS
END Pos;
PROCEDURE Base* (VAR r: Rider): File;
BEGIN RETURN r.file
END Base;
END MFiles.
Выделение нового сектора происходит при создании файла (Files.New) и при
записи в конец файла по заполнении текущего сектора. Процедура AUocSector вы¬
дает адрес выделенного сектора. Он определяется поиском свободного сектора
в таблице занятости секторов. В этой таблице каждый сектор представляется од¬
ним битом, указывающим, выделен сектор или нет. Хотя концептуально эта таб¬
лица относится к файловой системе, она находится в модуле Kernel, так как из
соображений безопасности должна быть защищена от записи в пользовательском
режиме.
Реализация файлов в оперативной памяти
207
208
Файловая система
Освобождение секторов файла могло бы происходить, как только файл боль¬
ше не доступен ни через переменную любого загруженного модуля, ни из каталога
файла. Однако этот момент трудно отследить. Поэтому в Обероне для освобож¬
дения файлового пространства применяется метод сборки мусора. С учетом того,
что файловое пространство является большим, а сборка «мусорных» секторов от¬
нимает довольно много времени, мы относим этот процесс к инициализации сис¬
темы. Он представлен процедурой FileDir.Init. В этот момент доступны только те
файлы, которые зарегистрированы в каталоге. Поэтому Init просматривает весь
каталог и заносит доступные каждому файлу сектора в таблицу занятости секто¬
ров (см. раздел 7.4).
Для таких приложений, как серверные системы, где инициализация бывает
нечасто, предусмотрена процедура чистки Files.Purge. Ее задача - вернуть исполь¬
зованные данным файлом сектора в пул свободных секторов. Очевидно, что в этом
случае ответственность за отсутствие ссылок на очищенный файл несет програм¬
мист. Такое возможно в замкнутой серверной системе, однако в обычных условиях
файлы не должны очищаться, поскольку нарушение указанного предусловия при¬
водит к непредсказуемой катастрофе.
В модуле Kernel определены следующие процедуры выделения, освобождения
и пометки секторов в таблице занятости:
PROCEDURE AllocSector(hint: LONGINT; VAR sec: LONGINT); (*используется в Write*)
PROCEDURE MarkSector(sec: LONGINT); (*используется в Init*)
PROCEDURE FreeSector(sec: LONGINT); (*используется в Purge*)
Процедуры ReadBytes и WriteBytes предусмотрены для быстрой передачи по¬
следовательностей байтов. Ускорение достигается применением команд переме¬
щения блока. В случае ReadBytes поле результата r.res равно числу недочитанных
байтов. Оно больше нуля, только когда достигнут конец файла; r.res> 0 подразу¬
мевает r.eof. Выигрыш в скорости показыват следующие данные. Последователь¬
ное чтение файла из 32 Кбайтов с помощью (32 ООО вызовов) Read(r, ch) занимает
около 0,25 сек. (на Ceres-З, использующей RAM для «дисковых» секторов). Такое
же чтение файла блоками по 1 Кбайт с помощью ReadBytes(r, block, 1024) занимает
лишь около 0,013 сек. Это в 18 раз быстрее, что очень существенно.
7.3. Реализация файлов на диске
Напомним сначала, что организация файлов как наборов отдельно размещае¬
мых блоков (секторов) - неотъемлемое требование при размещении динамически
растущих последовательностей. Однако если носитель данных - лента или диск,
существует дополнительная причина использования блоков. Они составляют
подпоследовательности, которые при передаче буферизуются по отдельности для
преодоления временных ограничений таких носителей. Для достижения адекват¬
ной утилизации пространства блоки не должны быть слишком длинными. Типич¬
ный их размер -1,2 или 4 Кбайта.
Реализация файлов на диске
209
Необходимость буферизации оказывает сильное влияние на реализацию до¬
ступа к файлу. Осложнение возникает из-за того, что должна поддерживаться
абстракция последовательности отдельных байтов. Сравнивая тексты программ
двух соответствующих реализаций, можно увидеть, что сложность доступа к фай¬
лу увеличивается значительно.
Первая, очевидная мера - скопировать таблицу секторов файла в оператив¬
ную память, когда файл «открывается» вызовом New() или OldQ. Содержащая
эту копию запись - это дескриптор файла (называемый заголовком), а значение f,
обозначающее файл, указывает на этот заголовок (вместо фактического заголовка
на диске). Дескриптор содержит и остальную информацию заголовка, в частности
длину файла.
Если файл читается (или пишется) строго последовательно, для передачи дан¬
ных выделяется один буфер. При чтении буфер заполняется одним сектором дис¬
ка, а байты выбираются поштучно из буфера. При записи байты накапливаются
поштучно, а буфер по заполнении целиком записывается на диск. Буфер связан
с файлом, а указатель на него находится в дескрипторе.
Вспомним, однако, что в файле могут размещаться и перемещаться независи¬
мо несколько бегунков. Может показаться, что с каждым бегунком нужно связать
буфер. Но такое предположение сразу же отпадает, когда мы понимаем, что не¬
сколько бегунков могут быть активными в соседних позициях. Если эти позиции
относятся к одному сектору, который дублируется в буферах разных бегунков,
эти буферы могут легко стать противоречивыми. Очевидно, что буферы должны
связываться не с бегунками, а с самим файлом. Поэтому дескриптор содержит на¬
чало списка связанных буферов. Каждый буфер отвечает своей позиции в файле.
Инвариант системы - в том, что никакие два буфера не представляют один и тот
же сектор.
Даже при одном бегунке возможность наличия нескольких связанных с фай¬
лом буферов может быть выгодной, если бегунок часто меняет положение. Это
становится вопросом стратегии и эвристики при выделении нового буфера. В сис¬
теме Оберон мы приняли следующее решение:
1. Первый буфер создается при открытии файла (New, Old).
2. Дополнительные буферы могут выделяться при (пере)установке бегунка
в файле.
3. С одним файлом может быть связано не более четырех буферов.
4. Строго последовательное движение бегунков не вызывает выделения бу¬
феров.
5. Отдельные буферы создаются при необходимости обращения к расшире¬
нию таблицы секторов файла (позиция бегунка > 64 Кб). Каждый буфери¬
зует 256 адресов секторов соответствующего индекс-сектора.
Обрисованная схема требует и основывается на следующих структурах дан¬
ных и типах:
File = POINTER ТО Handle;
Buffer = POINTER TO BufferRecord;
210
Файловая система
Index = POINTER ТО IndexRecord;
Handle = RECORD next: File;
aleng, bleng: INTEGER;
nofbufs: INTEGER;
modH: BOOLEAN;
firstbuf:Buffer:
sechint: DiskAdr;
name: FileDir.FileName;
time, date: LONGINT;
ext: ARRAY FileDir.ExTabSize OF Index;
sec: ARRAY 64 OF DiskAdr
END;
BufferRecord = RECORD apos, lim: INTEGER;
mod: BOOLEAN;
next: Buffer;
data: FileDir.DataSector
END;
IndexRecord = RECORD adr: DiskAdr;
mod: BOOLEAN; (*индекс был изменен*)
sec: FileDir.IndexSector
END;
Rider = RECORD eof: BOOLEAN;
res: LONGINT;
file: File;
apos, bpos: INTEGER;
buf: Buffer
END ;
Чтобы повысить эффективность доступа, бегунки снабжены полем, содержа¬
щим адрес элемента позиции бегунка. Из установленных выше правил выделения
буферов очевидно, что значение этого поля может быть только подсказкой. Это
значит, что доверять данной информации нельзя. При каждом ее использовании
ее достоверность должна проверяться. Проверка состоит в сравнении позиции бе¬
гунка r.apos с фактической позицией-подсказкой буфера r.buf.apos. Если они от¬
личаются, должен быть найден и, если его нет, выделен буфер с нужной позицией.
Достоинство подсказки - в том, что она верна с очень высокой вероятностью. Про¬
верка включена в процедуры Read, ReadBytes, Write и WriteBytes.
Некоторые поля типов RECORD требуют дополнительных пояснений:
1. Длина хранится в «подготовленном» виде, а именно в виде двух целых чи¬
сел aleng и bleng, где aleng -номер сектора и
(*достигут конец файла*)
(*число непрочитанных байтов*)
(*позиция*)
(*подсказка: подходящий буфер*)
(*lim = число байтов*)
(*буфер был изменен*)
(♦следующий буфер в цепочке *)
(*длина файла*)
(*число выделенных буферов*)
(*заголовок был изменен*)
(*начало цепочки буферов*)
(*подсказка сектора*)
длина = (aleng * SS) + bleng - HS
aleng = (длина + HS) DIV SS
bleng = (длина + HS) MOD SS
Точно так же хранится и позиция в бегунках (apos, bpos).
2. Поле nofbufs задает число буферов в списке, начинающемся с firstbuf:
^ < nofbufs < Maxbufs.
3. При каждой записи данных в буфер файл становится несовместимым, то
есть данные на диске устаревают. Файл обновляется, то есть при повторном
выделении буфера он копируется в соответствующий сектор диска, напри¬
мер после заполнения и «расширения» буфера во время последовательной
записи. Во время последовательного чтения буфер тоже расширяется и по¬
вторно используется, но не копируется на диск, потому что все еще совмес¬
тим с файлом. Совместимость буфера задается его переменной состояния
mod (изменен). Точно так же поле modH в дескрипторе файла указывает,
был ли изменен его заголовок.
4. Поле sechint хранит номер последнего выделенного файлу сектора и слу¬
жит подсказкой процедуре выделения памяти в ядре, которая выделяет
следующий сектор с адресом, большим чем подсказка. Это способ ускорить
последовательные просмотры файлов.
5. Позиция буфера задается его полем apos. Используемый как индекс в таб¬
лице секторов заголовков файла, он дает сектор, соответствующий со¬
держимому текущего буфера. Поле lim задает число байтов s, хранимых
в буфере. Чтение не может выйти за эту границу, а запись за ее пределы
предполагает увеличение длины файла. Все буферы, кроме буфера послед¬
него сектора, заполняются целиком и имеют lim = SS.
6. Скрытое поле бегунка buf является просто подсказкой для ускорения по¬
иска нужного буфера. Подсказка удачная, но не гарантирует правильности.
Ее достоверность должна быть проверена перед использованием. Подсказ¬
ка буфера теряет силу, когда буфер заново выделяется и/или бегунок пере¬
устанавливается.
Структура бегунков остается практически той же, что и для файлов, исполь¬
зующих основную память. Скрытое поле adr просто заменяется указателем на бу¬
фер, накрывающий позицию бегунка. Вид файла / с двумя бегунками показан на
рис. 7.2.
MODULE Files; (*NW 11.1.86 / 22.1.91*)
IMPORT SYSTEM, FileDir, Kernel;
(*Файл состоит из последовательности страниц. Первая страница содержит заголовок.
Насть заголовка - таблица страниц, массив дисковых адресов страниц.
К файлу обращаются посредством бегунков, каждый из которых указывает позицию.*),
CONST MaxBufs =4;
HS = FileDir.HeaderSize;
SS = FileDir.SectorSize;
STS = FileDir.SecTabSize;
Реализация файлов на диске
Г2П
Файловая система
212 |
Рис. 7.2. Файл f с двумя бегунками и двумя буферами
XS = FileDir.IndexSize;
TYPE DiskAdr = LONGINT;
File* = POINTER TO Handle;
Buffer = POINTER TO BufferRecord;
FileHd = POINTER TO FileDir.FileHeader;
Index = POINTER TO IndexRecord;
Rider* =
RECORD eof*: BOOLEAN;
res*: LONGINT;
file: File;
apos, bpos: INTEGER;
buf: Buffer;
unused: LONGINT
END;
Handle =
RECORD next: File;
aleng, bleng: INTEGER;
nofbufs: INTEGER;
modH: BOOLEAN;
firstbuf: Buffer;
sechint: DiskAdr;
name: FileDir.FileName;
time, date: LONGINT;
unused: ARRAY 1 OF LONGINT;
ext: ARRAY FileDir.ExTabSize OF Index;
sec: FileDir.SectorTable
END;
213
BufferRecord =
RECORD apos, lim: INTEGER;
mod: BOOLEAN;
next: Buffer;
data: FileDir.DataSector
END;
IndexRecord =
RECORD adr: DiskAdr;
mod: BOOLEAN;
sec: FileDir.IndexSector
END;
(*aleng * SS + bleng = длина (включая заголовок)
apos * SS + bpos = текущая позиция
О <= bpos <= lim <= SS
0 <= apos <= aleng < PgTabSize
(apos < aleng) & (lim = SS) OR (apos = aleng)*)
VAR root: File; (*список открытых файлов*)
PROCEDURE Check (VAR s: ARRAY OF CHAR;
VAR name: FileDir.FileName; VAR res: INTEGER);
VAR i: INTEGER; ch: CHAR;
BEGIN ch := s[0]; i := 0;
IF ("A" <= CAP(ch)) & (CAP(ch) <= "Z") THEN
LOOP name[i] := ch; INC(i); ch := s[i];
IF ch = OX THEN
WHILE i < FileDir.FnLength DO name[i] := OX; INC(i) END;
res := 0; EXIT
END;
IF “(("A" <= CAP(ch)) & (CAP(ch) <= "Z")
OR ("0" <= ch) & (ch <= "9") OR (ch = ".")) THEN res := 3; EXIT
END;
IF i = FileDir.FnLength THEN res := 4; EXIT END;
END
ELSIF ch = OX THEN name[0] := OX; res := - 1
ELSE res := 3
END
END Check;
PROCEDURE Old* (name: ARRAY OF CHAR): File;
VAR i, k, res: INTEGER;
f: File;
header: DiskAdr;
buf: Buffer;
head: FileHd;
namebuf: FileDir.FileName;
Реализация файлов на диске
214
Файловая система
inxpg: Index;
BEGIN f := NIL; Check(name, namebuf, res);
IF res = 0 THEN
FileDir.Search(namebuf, header);
IF header # 0 THEN f := root;
WHILE (f # NIL) & (f.sec[0] # header) DO f := f.next END;
IF f = NIL THEN
NEW(buf); buf.apos := 0; buf.next := buf; buf.mod := FALSE;
head := SYSTEM.VAL(FileHd, SYSTEM.ADR(buf.data));
Kernel.GetSector(header, head'');
NEW(f); f.aleng := head.aleng; f.bleng := head.bleng;
f.time := head.time; f.date := head.date;
IF f.aleng = 0 THEN buf.lim := f.bleng ELSE buf.lim := SS END;
f.firstbuf := buf; f.nofbufs := 1; f.name[0] := OX;
f.sec := head.sec;
к := (f.aleng + (XS - STS)) DIV XS; i := 0;
WHILE i < к DO
NEW(inxpg); inxpg.adr := head.ext[i]; inxpg.mod := FALSE;
Kernel.GetSector(inxpg.adr, inxpg.sec); f.ext[i] := inxpg; INC(i)
END;
WHILE i < FileDir.ExTabSize DO f.ext[i] := NIL; INC(i) END;
f.sechint := header; f.modH := FALSE; f.next := root; root := f
END
END
END;
RETURN f
END Old;
PROCEDURE New* (name: ARRAY OF CHAR): File;
VAR i, res: INTEGER;
f: File;
header: DiskAdr;
buf: Buffer;
head: FileHd;
namebuf: FileDir.FileName;
BEGIN f := NIL; Check(name, namebuf, res);
IF res <= 0 THEN
NEW(buf); buf.apos := 0; buf.mod := FALSE; buf.lim := HS; buf.next := buf;
head := SYSTEM.VAL(FileHd, SYSTEM.ADR(buf.data));
head.mark := FileDir.HeaderMark;
head, aleng := 0; head.bleng := HS; head, name := namebuf;
Kernel.GetClock(head.time, head.date);
NEW(f); f.aleng := 0; f.bleng := HS; f.modH := TRUE;
f.time := head.time; f.date := head.date;
f. firstbuf := buf; f.nofbufs := 1; f.name := namebuf; f.sechint := 0;
l := 0;
REPEAT f.ext[i] := NIL; head.ext[i] := 0; INC(i) UNTIL i = FileDir.ExTabSize;
l := 0;
REPEAT f.sec[i] := 0; head.sec[i] := 0; INC(i) UNTIL i = STS
Реализация файлов на диске
215
END;
RETURN f
END New;
PROCEDURE UpdateHeader (f: File; VAR h: FileDir.FileHeader);
VAR k: INTEGER;
BEGIN h.aleng := f.aleng; h.bleng := f.bleng;
h.sec := f.sec; к := (f.aleng + (XS - STS)) DIV XS;
WHILE к > 0 DO DEC(k); h.ext[k] := f.ext[k].adr END
END UpdateHeader;
PROCEDURE ReadBuf (f: File; buf: Buffer; pos: INTEGER);
VAR sec: DiskAdr;
BEGIN
IF pos < STS THEN sec := f.sec[pos]
ELSE sec := f.ext[(pos - STS) DIV XS].sec.x[(pos - STS) MOD XS]
END;
Kernel.GetSector(sec, buf.data);
IF pos < f.aleng THEN buf.lim := SS ELSE buf.lim := f.bleng END;
buf.apos := pos; buf.mod := FALSE
END ReadBuf;
PROCEDURE WriteBuf (f: File; buf: Buffer);
VAR i, k: INTEGER;
secadr: DiskAdr; inx: Index;
BEGIN
IF buf.apos < STS THEN
secadr := f.sec[buf.apos];
IF secadr = 0 THEN
Kernel.AllocSector(f.sechint, secadr);
f.modH := TRUE; f.sec[buf.apos] := secadr; f.sechint := secadr
END;
IF buf.apos = 0 THEN
UpdateHeader(f, SYSTEM.VAL(FileDir.FileHeader, buf.data)); f.modH := FALSE
END
ELSE i := (buf.apos - STS) DIV XS; inx := f.ext[i];
IF inx = NIL THEN
NEW(inx); inx.adr := 0; inx.sec.x[0] := 0; f.ext[i] := inx; f.modH := TRUE
END;
к := (buf.apos - STS) MOD XS; secadr := inx.sec.x[k];
IF secadr = 0 THEN
Kernel.AllocSector(f.sechint, secadr);
f.modH := TRUE; inx.mod := TRUE; inx.sec.x[k] := secadr;
f.sechint := secadr
END
END;
Kernel.PutSector(secadr, buf.data); buf.mod := FALSE
END WriteBuf;
PROCEDURE Buf (f: File; pos: INTEGER): Buffer;
VAR buf: Buffer;
BEGIN buf := f.firstbuf;
LOOP
IF buf.apos = pos THEN EXIT END;
buf := buf.next;
IF buf = f.firstbuf THEN buf := NIL; EXIT END
END;
RETURN buf
END Buf;
PROCEDURE GetBuf (f: File; pos: INTEGER): Buffer;
VAR buf: Buffer;
BEGIN buf := f.firstbuf;
LOOP
IF buf.apos = pos THEN EXIT END;
IF buf.next = f.firstbuf THEN
IF f.nofbufs < MaxBufs THEN (‘размещение нового буфера*)
NEW(buf); buf.next := f.firstbuf.next; f. firstbuf.next := buf;
INC(f.nofbufs)
ELSE (*взять один из буферов*) f.firstbuf := buf;
IF buf.mod THEN WriteBuf(f, buf) END
END;
buf.apos := pos;
IF pos <= f.aleng THEN ReadBuf(f, buf, pos) END;
EXIT
END;
buf := buf.next
END;
RETURN buf
END GetBuf;
PROCEDURE Unbuffer (f: File);
VAR i, k: INTEGER;
buf: Buffer;
inx: Index;
head: FileDir.FileHeader;
BEGIN buf := f.firstbuf;
REPEAT
IF buf.mod THEN WriteBuf(f, buf) END;
buf := buf.next
UNTIL buf = f.firstbuf;
к := (f.aleng + (XS - STS)) DIV XS; i := 0;
WHILE i < к DO
inx := f.ext[i]; INC(i);
IF inx.mod THEN
IF inx.adr = 0 THEN
Kernel.AllocSector(f.sechint, inx.adr); f.sechint := inx.adr;
f.modH := TRUE
END;
216
Файловая система
реализация файлов на диске
217
Kernel.PutSector(inx.adr, inx.sec); inx.mod := FALSE
END
END;
IF f.modH THEN
IF f.sec[0] = 0 THEN Kernel.AllocSector(0, f.sec[0]) END;
Kernel.GetSector(f.sec[0], head); UpdateHeader(f, head);
Kernel.PutSector(f.sec[0], head); f.modH := FALSE
END
END Unbuffer;
PROCEDURE Register* (f: File);
BEGIN
IF (f # NIL) & (f.name[0] > OX) THEN
Unbuffer(f); FileDir.Insert(f.name, f.sec[0]); f.next := root; root := f
END;
END Register;
PROCEDURE Close* (f: File);
BEGIN
IF f # NIL THEN Unbuffer(f) END;
END Close;
PROCEDURE Purge* (f: File);
VAR a, i, j, k: INTEGER;
ind: FileDir.IndexSector;
BEGIN
IF f # NIL THEN a := f.aleng + 1; f.aleng := 0;
IF a <= STS THEN i := a
ELSE i := STS; DEC(a, i);
j := (a - 1) MOD XS; k := (a - 1) DIV XS;
WHILE k >= 0 DO
Kernel.GetSector(f.ext[k].adr, ind);
REPEAT DEC(j); Kernel.FreeSector(ind.x[j])
UNTIL j = 0;
Kernel.FreeSector(f.ext[k].adr); j := XS; DEC(k)
END
END;
REPEAT DEC(i); Kernel.FreeSector(f.sec[i])
UNTIL i = 0
END
END Purge;
PROCEDURE Length* (f: File): LONGINT;
BEGIN RETURN L0NG(f.aleng) * SS + f.bleng - HS
END Length;
PROCEDURE GetDate* (f: File; VAR t, d: LONGINT);
BEGIN t := f.time; d := f.date
END GetDate;
PROCEDURE Set* (VAR r: Rider; f: File; pos: LONGINT);
218
Файловая система
VAR a, b: INTEGER;
BEGIN r.eof := FALSE; r. res := 0;
IF f # NIL THEN
IF pos < 0 THEN a := 0; b := HS
ELSIF pos < L0NG(f.aleng) * SS + f.bleng - HS THEN
a := SH0RT((pos + HS) DIV SS); b := SH0RT((pos + HS) MOD SS);
ELSE a := f.aleng; b := f.bleng
END;
r.file := f; r.apos := a; r.bpos := b; r.buf := f.firstbuf
ELSE r.file := NIL
END
END Set;
PROCEDURE Read* (VAR r: Rider; VAR x: SYSTEM.BYTE);
VAR buf: Buffer;
BEGIN
IF r.apos # r.buf.apos THEN r.buf := GetBuf(r.file, r.apos) END;
IF r.bpos < r.buf.lim THEN
x := r.buf.data.B[r.bpos]; INC(r.bpos)
ELSIF r.apos < r.file.aleng THEN
INC(r.apos); buf := Buf(r.file, r.apos);
IF buf = NIL THEN
IF r.buf.mod THEN WriteBuf(r.file, r.buf) END;
ReadBuf(r.file, r.buf, r.apos)
ELSE r.buf := buf
END;
x := r.buf.data.B[0]; r.bpos := 1
ELSE
x := OX; r.eof := TRUE
END
END Read;
PROCEDURE ReadBytes* (VAR r: Rider; VAR x: ARRAY OF SYSTEM.BYTE; n: LONGINT);
VAR src, dst, m: LONGINT; buf: Buffer;
BEGIN dst := SYSTEM.ADR(x);
IF LEN(x) < n THEN HALT(25) END;
IF r.apos # r.buf.apos THEN r.buf := GetBuf(r.file, r.apos) END;
LOOP
IF n <= 0 THEN EXIT END;
src := SYSTEM.ADR(r.buf.data.B) + r.bpos; m := r.bpos + n;
IF m <= r.buf.lim THEN
SYSTEM.M0VE(src, dst, n); r.bpos : = SHORT(m); r.res := 0; EXIT
ELSIF r.buf.lim = SS THEN
m : = r. buf. lim - r. bpos;
IF m > 0 THEN SYSTEM.M0VE(src, dst, m); INC(dst, m); DEC(n, m) END;
IF r.apos < r.file.aleng THEN
INC(r.apos); r.bpos := 0; buf := Buf(r.file, r.apos);
IF buf = NIL THEN
IF r.buf.mod THEN WriteBuf(r.file, r.buf) END;
ReadBuf(г.file, r.buf, г.apos)
ELSE г.buf := buf
END
ELSE r.res := n; r.eof := TRUE; EXIT
END
ELSE m := r.buf.lim - r.bpos;
IF m > 0 THEN SYSTEM.M0VE(src, dst, m); r.bpos := r.buf.lim END;
r.res := n - m; r.eof := TRUE; EXIT
END
END
END ReadBytes;
PROCEDURE NewExt (f: File);
VAR i, k: INTEGER; ext: Index;
BEGIN к := (f.aleng - STS) DIV XS;
IF к = FileDir.ExTabSize THEN HALT(23) END;
NEW(ext); ext.adr := 0; ext.mod := TRUE; f.ext[k] := ext; i := XS;
REPEAT DEC(i); ext.sec.x[i] := 0 UNTIL i = 0
END NewExt;
PROCEDURE Write* (VAR r: Rider; x: SYSTEM.BYTE);
VAR f: File; buf: Buffer;
BEGIN
IF r.apos # r.buf.apos THEN r.buf := GetBuf(r.file, r.apos) END;
IF r.bpos >= r.buf.lim THEN
IF r.bpos < SS THEN
INC(r.buf.lim); INC(r.file.bleng); r.file.modH := TRUE
ELSE f := r.file; WriteBuf(f, r.buf); INC(r.apos); buf := Buf(r.file, r.apos);
IF buf = NIL THEN
IF r.apos <= f.aleng THEN ReadBuf(f, r.buf, r.apos)
ELSE r.buf.apos := r.apos; r.buf.lim := 1; INC(f.aleng);
f.bleng := 1; f.modH := TRUE;
IF (f.aleng - STS) MOD XS = 0 THEN NewExt(f) END
END
ELSE r.buf := buf
END;
r.bpos := 0
END
END;
r.buf.data.B[r.bpos] := x; INC(r.bpos); r.buf.mod := TRUE
END Write;
PROCEDURE WriteBytes* (VAR r: Rider; VAR x: ARRAY OF SYSTEM.BYTE;
n: LONGINT);
VAR src, dst, m: LONGINT; f: File; buf: Buffer;
BEGIN src := SYSTEM.ADR(x);
IF LEN(x) < n THEN HALT(25) END;
IF r.apos # r.buf.apos THEN r.buf := GetBuf(r.file, r.apos) END;
LOOP
Реализация файлов на диске
219
220
Файловая система
IF п <= О THEN EXIT END;
г. buf. mod := TRUE; dst := SYSTEM. ADR(r. buf. data. B) + r.bpos; m := r.bpos + n;
IF m <= r.buf.lim THEN
SYSTEM.MOVE(src, dst, n); r.bpos := SHORT(m); EXIT
ELSIF m <= SS THEN
SYSTEM.MOVE(src, dst, n); r.bpos := SHORT(m);
r.file.bleng := SHORT(m); r.buf.lim := SHORT(m); r.file.modH := TRUE; EXIT
ELSE m := SS - r.bpos;
IF m > 0 THEN SYSTEM.MOVE(src, dst, m); INC(src, m); DEC(n, m) END;
f := r.file; WriteBuf(f, r.buf); INC(r.apos); r.bpos := 0;
buf := Buf(f, r.apos);
IF buf = NIL THEN
IF r.apos <= f.aleng THEN ReadBuf(f, r.buf, r.apos)
ELSE r.buf.apos := r.apos; r.buf.lim := 0; INC(f.aleng);
f.bleng := 0; f.modH := TRUE;
IF (f.aleng - STS) MOD XS = 0 THEN NewExt(f) END
END
ELSE r.buf := buf
END
END
END
END WriteBytes;
PROCEDURE Pos* (VAR r: Rider): LONGINT;
BEGIN RETURN LONG(r.apos) * SS + r.bpos - HS
END Pos;
PROCEDURE Base* (VAR r: Rider): File;
BEGIN RETURN r.file
END Base;
PROCEDURE Delete* (name: ARRAY OF CHAR; VAR res: INTEGER);
VAR adr: DiskAdr;
namebuf: FileDir.FileName;
BEGIN Check(name, namebuf, res);
IF res = 0 THEN
FileDir.Delete(namebuf, adr);
IF adr = 0 THEN res := 2 END
END
END Delete;
PROCEDURE Rename* (old, new: ARRAY OF CHAR; VAR res: INTEGER);
VAR adr: DiskAdr;
oldbuf, newbuf: FileDir.FileName;
head: FileDir.FileHeader;
BEGIN Check(old, oldbuf, res);
IF res = 0 THEN
Check(new, newbuf, res);
IF res = 0 THEN
Реолизоция фойлов но диске
221
FileDir.Delete(oldbuf, adr);
IF adr # 0 THEN
FileDir.Insert(newbuf, adr);
Kernel.GetSector(adr, head); head.name := newbuf;
Kernel.PutSector(adr, head)
ELSE res := 2
END
END
END
END Rename;
BEGIN Kernel.FileRoot := SYSTEM.ADR(root)
END Files.
Ниже приводятся некоторые комментарии, касающиеся модуля Files.
1. По окончании записи в файл его имя обычно регистрируется в каталоге.
Register вызывает процедуру Unbuffer. Она просматривает связанные буфе¬
ры и копирует их на диск, который должен быть изменен. Во время этого
процесса, возможно, придется передать и новые индексные сектора. Если
файл должен остаться безымянным и локальным в модуле или команде,
то есть не должен регистрироваться, а только читаться, освобождение бу¬
феров должно выполняться явным обращением к Close (означающим «за¬
крыть буферы»), которое тоже вызывает Unbuffer.
2. Процедура Old (а для полноты и New) отходит от общего правила програм¬
мирования в Обероне в том, что объект создается вызывающим (а не вы¬
зываемым) модулем. Такое правило предполагало бы операторы
New(f); Files.Open(f, name)
вместо / := Files.Old (name). Оно объясняется тем, что ради большей гиб¬
кости можно создать любое расширение типа /. А причина нашего отхода
от правила для случая файлов - в том, что при ближайшем рассмотрении
создается не новый файл, а лишь новый дескриптор. Разница становит¬
ся очевидной, если мы предположим, что несколько операторов / := Files.
Old(name) с различными / и одинаковыми пате, вполне возможно, могут
появиться в разных модулях. В этом случае для устранения несогласован¬
ности файла необходимо, чтобы полученные модулями указатели ссы¬
лались на один и тот же дескриптор. Каждый (открытый) файл должен
иметь ровно один дескриптор. Поэтому первым действием при открытии
файла должна быть проверка наличия дескриптора этого файла. С этой це¬
лью все дескрипторы соединены в список, привязанный к глобальной пере¬
менной root, и связаны полем next дескриптора. Может показаться, что эта
мера благополучно решает проблему устранения несогласованности. Одна¬
ко здесь есть ловушка, которую легко проглядеть: все открытые файлы по¬
стоянно оставались бы доступными через root, и сборщик мусора никогда
бы не смог удалить ни дескриптор файла, ни связанные с ним буферы. Это
было бы недопустимо. Мы не нашли ничего лучшего для решения этой про¬
222
Файловая система
блемы, чем спроектировать сборщик мусора так, чтобы он исключал этот
список из своей фазы разметки.
3. Указатели секторов представлены номерами секторов типа LONGINT.
Фактически мы используем номера, умноженные на 29. Это предполагает,
что ошибка в любом бите приводит к номеру, который не кратен 29 и, следо¬
вательно, может быть легко обнаружен. Таким образом, критические адре¬
са секторов программно проверяются на четность и безопасны (от ошибок
в битах) даже на компьютерах без аппаратной проверки четности. Провер¬
ка выполняется процедурами Kemel.GetSectorn Kernel.Put Sector.
7.4. Каталог файлов
Каталог - это множество пар, каждая из которых состоит из имени (ключа) и
объекта (здесь - файла). Он служит для поиска объектов по имени. Если важна
эффективность, то каталог организуется как множество, упорядоченное по клю¬
чам. Наиболее часто используемые структуры для упорядоченных множеств -
деревья и хэш-таблицы. У последних есть недостатки, если размер множества
неизвестен, в частности когда неизвестен порядок величин и когда имеют место
удаления. Поэтому в системе Оберон для каталога файлов используется древо¬
видная структура, а точнее В-дерево, которое было разработано специально для
того, чтобы можно было иметь доступ не к отдельным парам, а только к множест¬
вам пар как целому (размещенным в секторе диска).
Для основательного изучения В-деревьев отсылаем читателя к литературе [1,
2]. Здесь же будет достаточно привести основные особенности В-деревьев:
1. В В-дереве порядка N каждый узел (называемый страницей) содержит
m элементов (пар), где N < m < 2N, за исключением корня, для которого
О < m < 2N.
2. Страница с m элементами имеет или 0 потомков и называется страницей-
листом, или m + 1 потомков.
3. Все страницы-листья находятся на одном (нижнем) уровне.
Из пункта 3 следует, что В-дерево - это сбалансированное дерево. Его высота,
а с ней и длина самого длинного пути имеют верхнюю грань, примерно равную
2 * log к, где к - количество элементов, а логарифм берется по основанию N и округ¬
ляется до большего целого. Его минимальная высота равна log к по основанию 2N.
На каждой странице должно быть достаточно места для 2N элементов и для
2N + 1 ссылок на потомков. Следовательно, N прямо зависит от размера страницы
и размера элемента. В системе Оберон имена ограничены 32 символами (байта¬
ми), а объект - это ссылка на соответствующий файл (4 байта). Каждый указатель
потомка занимает 4 байта, а размер страницы задается размером сектора (1024)
минус число байтов для хранения ш (2 байта). Следовательно,
N = ((1024 - 2 - 4) DIV (32 + 4 + 4)) DIV 2 = 12.
В-дерево высоты h и порядка 12 может содержать следующие минимальное и
максимальное числа элементов:
Каталог файлов
Высота
Минимум
Максимум
1
0
24
2
25
624
3
625
15 624
4
15 625
390 624
Отсюда следует, что высота В-дерева никогда не превысит 4, если емкость
диска чуть меньше 400 Мб, при условии что каждый файл занимает один сектор
в 1 Кб. На практике она редко бывает больше 3.
В определении модуля FileDir приводятся доступные операции с каталогом.
Помимо процедур Search, Insert, Delete и Enumerate, оно содержит некоторые опре¬
деления данных, которые должны считаться закрытой частью интерфейса файло¬
вой системы.
DEFINITION FileDir;
IMPORT SYSTEM, Kernel;
CONST
FnLength = 32; (*макс. длина имени файла*)
SecTabSize = 64; (*число входов первичной таблицы*)
ExTabSize = 12;
SectorSize = 1024;
IndexSize = SectorSize DIV 4; (*число входов в секторе индексов*)
HeaderSize = 352;
DirRootAdr = 29;
DirPgSize = 24; (*макс.число элементов на странице*)
TYPE
FileName = ARRAY FnLength OF CHAR;
SectorTable = ARRAY SecTabSize OF LONGINT;
ExtensionTable = ARRAY ExTabSize OF LONGINT;
EntryHandler = PROCEDURE (name: FileName; sec: LONGINT; VAR continue: BOOLEAN);
FileHeader = RECORD (Kernel.Sector)
mark: LONGINT;
name: FileName;
aleng, bleng: INTEGER;
date, time: LONGINT;
ext: ExtensionTable;
sec: SectorTable;
END ;
IndexSector = RECORD (Kernel.Sector)
x: ARRAY IndexSize OF LONGINT;
END ;
DataSector = RECORD (Kernel.Sector)
B: ARRAY SectorSize OF SYSTEM.BYTE;
223
224
Файловая система
END ;
DirEntry = RECORD
name: FileName;
adr, p: LONGINT;
END ;
DirPage = RECORD (Kernel.Sector)
mark: LONGINT;
m: INTEGER; (*число элементов на странице*)
рО: LONGINT;
е: ARRAY DirPgSize OF DirEntry;
END ;
PROCEDURE Search(VAR name: FileName; VAR fad: LONGINT);
PROCEDURE Insert(VAR name: FileName; fad: LONGINT);
PROCEDURE Delete(VAR name: FileName; VAR fad: LONGINT);
PROCEDURE Enumerate(prefix: ARRAY OF CHAR; proc: EntryHandler);
END FileDir.
Процедуры Search, Insert и Delete представляют типичные операции для ката¬
логов. Эффективность первой операции исключительно важна. Однако структура
В-дерева гарантирует также эффективную вставку и удаление, хотя код для этих
операций сложен. Процедура Enumerate используется для получения фрагментов
каталога. Программист должен гарантировать, чтобы параметрическая процедура
Enumerate не выполняла никаких изменений в каталоге.
Как было при представлении модуля Files, обсудим сначала версию, которая
использует для каталога не диск, а оперативную память. Это позволит нам со¬
средоточиться на алгоритмах работы с каталогом, избегая дополнительных слож¬
ностей из-за необходимости читать страницы (сектора) в основную память для
выборочного их обновления и сохранения на диске. В частности, обратим внима¬
ние на определения типов данных DirPage для узлов В-дерева и DirEntry для его
элементов. Поле Е.р входа Е указывает на страницу, в которой все элементы (с ин¬
дексом k) имеют ключ E.p.e[k].пате > Е.пате. Указатель р.рО указывает на стра¬
ницу, в которой все элементы имеют ключи р.рО.е [kj.name <р.е [0].пате. Можно
представить эти условия рис. 7.3, где имена заменены целыми числами в качестве
ключей.
Рис. 7.3. Пример В-дерева порядка 2
Процедура Search начинается с просмотра корневой страницы. Она выполняет
двоичный поиск среди своих элементов согласно следующему алгоритму. Пусть
е[0 ... т-1] - упорядоченные ключи, ах- параметр поиска.
1_ := 0; R := т;
WHILE L < R DO
i := (L+R) DIV 2;
IF x <= e[i] THEN R := i ELSE L := i + 1 END
END;
IF (R < m) & (x = e[R]) THEN found END
Инвариантом является
e [L-1] < x < e [R]
Если искомый элемент не найден, поиск продолжается в подходящем потомке
страницы, если он есть. Иначе элемент не содержится в дереве.
Процедуры Insert и Delete используют тот же алгоритм для поиска элемента
на странице. Однако они используют рекурсию вместо итерации для продолже¬
ния поиска страницы вдоль пути. Напомним, что глубина рекурсии не больше че¬
тырех. Причина использования рекурсии - в том, что она облегчает оформление
структурных изменений, которые выполняются при «сворачивании» рекурсии, то
есть на обратном пути. Сначала ищется точка вставки (удаления), а затем элемент
вставляется (удаляется).
После вставки число элементов на странице может стать больше 2N, нарушая
первое условие В-дерева. Эта ситуация называется переполнением страницы. Ин¬
вариант должен быть немедленно восстановлен. Этого можно достичь переме¬
щением одного из крайних элементов массива е на соседнюю страницу. Однако
вместо этого мы решили сразу же разбивать переполненную страницу на две стра¬
ницы. Процесс разбиения страницы изображен на рис. 7.4, где рассмотрены три
случая, а именно: R<N, R = NhR>N, где R - точка вставки. Там же а обозначает
переполненную страницу, b - новую страницу и и - вставленный элемент.
2N + 1 элементов (2N из полной страницы а плюс один вставляемый элемент
и) поровну разносятся по страницам а и Ь. Один элемент v выталкивается вверх по
дереву. Он должен быть вставлен в родительскую страницу а. Так как эта страница
получает дополнительного потомка, она должна также получить дополнительный
элемент, чтобы отвечать второму правилу В-дерева.
Таким образом, разбиение страниц может повториться, потому что вставка
элемента v в родительскую страницу может снова потребовать разбиения. Если
корневая страница полна, она тоже разбивается, а возникающий элемент v встав¬
ляется в новую корневую страницу, содержащую один элемент. Только в этом слу¬
чае высота В-дерева увеличивается.
Когда элемент должен быть удален, его нельзя просто выкинуть, если он на¬
ходится во внутренней странице. В этом случае он сначала заменяется другим эле¬
ментом, а именно одним из двух соседних элементов на странице-листе, то есть
следующим наименьшим (или следующим наибольшим) элементом, который
Каталог файлов
225
всегда есть на странице-листе. В представленном решении элемент замены - наи¬
больший в левом поддереве (см. процедуру del). Следовательно, фактическое уда¬
ление всегда происходит на странице-листе.
При удалении число элементов на странице может стать меньше N, нарушая
инвариант 1. Этот случай называется неполной страницей. Так как перестройка
дерева относительно сложна, мы пытаемся в первую очередь восстановить инва¬
риант, забирая элемент с соседней страницы. На самом деле разумно брать не¬
сколько элементов, чтобы таким образом уменьшить вероятность неполноты на
той же странице после дальнейших удалений. Число элементов, которые можно
взять с соседней страницы Ь, равно b.m - N. Следовательно, мы берем
k = (b.m - N + 1) DIV 2
элементов. Затем процесс балансировки (выравнивания) страниц разносит эле¬
менты неполной и соседней с ней страницы поровну между ними (см. процедуру
Underflow).
| 226
Файловая система
Рис. 7.4. Разбиение страницы при вставке элемента и
Однако,тогда (и только тогда), когда у соседней страницы нельзя забрать эле¬
мент, эти две страницы могут и должны быть объединены. Это действие, называе¬
мое слиянием страниц, помещает N-1 элемент неполной страницы, N элементов
соседней страницы плюс один элемент с родительской страницы на одну страницу
размера 2N. Один элемент должен быть взят с родительской страницы, потому что
эта страница теряет одного потомка, и инвариант 2 сохраняется. Случаи баланси¬
ровки и объединения страниц показаны на рис. 7.5, где а - неполная страница, b -
ее соседняя страница и с - их предок; 5 - позиция на странице-предке (указателя)
неполной страницы. Рассмотрены два разных случая, а именно когда неполная
страница является самым правым элементом (s = c.m) или когда не является та¬
ковой (см. процедуру Underflow).
Рис. 7.5. Балансировка и объединение страниц при удалении элемента
Каталог файлов
[227
Подобно процессу разбиения, слияние может повторяться, потому что уда¬
ление элемента с родительской страницы может снова привести к неполноте и
возможному слиянию. Корневая страница неполна, только когда удаляется ее по¬
следний элемент. Лишь в этом случае высота В-дерева уменьшается.
MODULE ВТгее;
IMPORT Oberon, Texts;
CONST N = 3;
TYPE Page = POINTER TO PageRec;
Entry = RECORD
key, data: INTEGER;
p: Page
END;
PageRec = RECORD
m: INTEGER; (*число входов на странице*)
рО: Page;
е: ARRAY 2*N OF Entry
END;
VAR root: Page; W: Texts.Writer;
PROCEDURE search (x: INTEGER; a: Page;
VAR data: INTEGER); VAR i, L, R: INTEGER;
BEGIN (*a # NIL*)
LOOP L := 0; R := a.m; (*бинарный поиск*)
WHILE L < R DO
i := (L + R) DIV 2;
IF x <= a.e[i].key THEN R := i ELSE L := i + 1 END
END;
IF(R < a.m) & (a.e[R].key = x) THEN (*найдено*)
data := a.e[R].data; EXIT
END;
IF R = 0 THEN a := a.pO ELSE a := a.e[R - 1].p END;
IF a = NIL THEN (*не найдено*)
EXIT
END
END
END search;
PROCEDURE insert (x: INTEGER; a: Page; VAR h: BOOLEAN; VAR v: Entry);
(*a # NIL. Найти ключ x в В-дереве с корнем а; если найден, увеличить счетчик.
В противном случае вставить новый элемент с ключом х.
Если вход должен быть поднят выше, присвоить его v.h := "дерево становится
выше"*)
VAR i, L, R: INTEGER; b: Page; u: Entry;
BEGIN (*a # NIL & ~h*)
228
Файловая система
Каталог файлов
229
L := 0; R := a.m; (*бинарный поиск*)
WHILE L < R DO
i := (L + R) DIV 2;
IF x <= a.e[i].key THEN R := i ELSE L := i + 1 END
END;
IF(R < a.m) & (a.e[R].key = x) THEN (*найден*) INC(a.e[R].data)
ELSE (*элемент не на этой странице*)
IF R = 0 THEN b := a.pO ELSE b := a.e[R - 1].p END;
IF b = NIL THEN (*нет в дереве, вставить*)
u.p := NIL; h := TRUE; u.key := x
ELSE insert(x, b, h, u)
END;
IF h THEN (*вставить и слева от a.e[R]*)
IF a.m < 2 * N THEN
h := FALSE; i := a.m;
WHILE i > R DO DEC(i); a.e[i + 1] := a.e[i] END;
a.e[R] := u; INC(a.m)
ELSE NEW(b); (*переполнение: разбить а на a, b и присвоить v срединный вход*)
IF R < N THEN (*вставить в левую страницу а*)
i := N - 1; v := а.е[i];
WHILE i > R DO DEC(i); a.e[i + 1] := a.e[i] END;
a.e[R] := u; i := 0;
WHILE i < N DO b.e[i] := a.e[i + N]; INC(i) END
ELSE (*вставить в правую страницу b*)
DEC(R, N); i := 0;
IF R = 0 THEN v := и
ELSE v := a.e[N];
WHILE i < R - 1 DO b.e[i] := a.e[i + N + 1]; INC(i) END;
b.e[i] := u; INC(i)
END;
WHILE i < N DO b.e[i] := a.e[i + N]; INC(i) END
END;
a.m := N; b.m := N; b.pO := v.p; v.p := b
END
END
END
END insert;
PROCEDURE underflow (c, a: Page; s: INTEGER; VAR h: BOOLEAN);
(*a = неполная страница, с = страница-предок, s = индекс удаляемого входа в с*)
VAR b: Page; i, k: INTEGER;
BEGIN (*h & (a.m = N-1) & (c.e[s-1].p = a) *)
IF s < c.m THEN (*b := страница справа от a*)
b := c.e[s].p; к := (b.m - N + 1) DIV 2; (*k = число доступных на странице
b элементов*)
a.e[N - 1] := c.e[s]; a.e[N - 1].p := b.pO;
IF к > 0 THEN (*выровнять перемещением k-1 элементов из b в a*)
i := 0;
WHILE i < к - 1 DO a.efi + N] := b.efi]; INC(i) END;
c.e[s] := b.e[k - 1]; b.pO := c.e[s].p;
230
Файловая система
c.e[s].p := b; DEC(b.m, к); i := 0;
WHILE i < b.m DO b.e[i] := b.e[i + k]; INC(i) END;
a.m := N - 1 + k; h := FALSE
ELSE (*слить страницы а и b, удалив b*)
i := 0;
WHILE i < N DO a.e[i + N] := b.e[i]; INC(i) END;
i := s; DEC(c.m);
WHILE i < c.m DO c.e[i] := c.e[i + 1]; INC(i) END;
a.m := 2 * N; h := c.m < N
END
ELSE (*b := страница слева от a*) DEC(s);
IF s = 0 THEN b := c.pO ELSE b := c.e[s - 1].p END;
к := (b.m - N + 1) DIV 2; (*k = число доступных на странице b элементов*)
IF к > О THEN i := N - 1;
WHILE i > 0 DO DEC(i); a.e[i + k] := a.e[i] END;
i := к - 1; a.e[i] := c.e[s]; a.e[i].p := a.pO;
(♦переместить k-1 элементов из b в а, один - в с*) DEC(b.m, к);
WHILE i > О DO DEC(i); a.e[i] := b.e[i + b.m + 1] END;
c.e[s] := b.e[b.m]; a.pO := c.e[s].p;
c.e[s].p := a; a.m := N - 1 + k; h := FALSE
ELSE (*слить страницы а и b, удалив a*)
c.e[s].p := a.pO; b.e[N] := c.e[s]; i := 0;
WHILE i < N - 1 DO b.e[i + N + 1] := a.e[i]; INC(i) END;
b.m := 2 * N; DEC(c.m); h := c.m < N
END
END
END underflow;
PROCEDURE delete (x: INTEGER; a: Page; VAR h: BOOLEAN);
(*найти и удалить ключ х в В-дереве а; если страница становится неполной,
выровнять или слить с соседней страницей; h := "страница а неполна”*)
VAR i, L, R: INTEGER; q: Page;
PROCEDURE del (p: Page; VAR h: BOOLEAN);
VAR k: INTEGER; q: Page; (*a, R - глобальные*)
BEGIN k := p.m - 1; q := p.e[k].p;
IF q # NIL THEN del(q, h);
IF h THEN underflow(p, q, p.m, h) END
ELSE p.e[k].p := a. e[R]. p; a.e[R] := p.e[k];
DEC(p.m); h := p.m < N
END
END del;
BEGIN (*a # NIL*) L := 0; R := a.m; (*бинарный поиск*)
WHILE L < R DO
i := (L + R) DIV 2;
IF x <= a.e[i].key THEN R := i ELSE L := i + 1 END
END;
IF R = 0 THEN q := a.pO ELSE q := a.e[R - 1].p END;
IF(R < a.m) & (a.e[R].key = x) THEN (*найден*)
Каталог файлов
231
IF q = NIL THEN (*a - страница-лист*)
DEC(a.m); h:=a.m<N;i:=R;
WHILE i < a.m DO a.e[i] := a.e[i + 1]; INC(i) END
ELSE del(q, h);
IF h THEN underflow(a, q, R, h) END
END
ELSE delete(x, q, h);
IF h THEN underflow^, q, R, h) END
END
END delete;
PROCEDURE Search* (key: INTEGER; VAR data: INTEGER);
BEGIN search(key, root, data)
END Search;
PROCEDURE Insert* (key: INTEGER; VAR data: INTEGER);
VAR h: BOOLEAN; u: Entry; q: Page;
BEGIN h := FALSE; u.data := data; insert(key, root, h, u);
IF h THEN (*вставить новую базовую страницу*)
q := root; NEW(root);
root.m := 1; root.pO := q; root.e[0] := u
END
END Insert;
PROCEDURE Delete* (key: INTEGER);
VAR h: BOOLEAN;
BEGIN h := FALSE; delete(key, root, h);
IF h THEN (*базовая страница неполна*)
IF root.m = 0 THEN root := root.pO END
END
END Delete;
BEGIN NEW(root); root.m := 0
END BTree.
В-дерево также очень удобно для перечисления его элементов, потому что при
обходе дерева каждая его страница посещается ровно один раз и, следовательно,
должна считываться (с диска) тоже ровно один раз. Обход запрограммирован
в процедуре Enumerate и использует рекурсию. Она вызывает параметрическую
процедуру ргос для каждого элемента дерева. Тин ргос определяет в качестве па¬
раметров имя и перечисляемый элемент (точнее, его адрес). Третий параметр
continue - это логический VAR-параметр. Если процедура установит его в FALSE,
то процесс перечисления будет прерван.
Enumerate используется для получения перечня имен зарегистрированных
файлов. С этой целью фактическая процедура, замещающая ргос, просто вводит
заданное имя в текст и игнорирует адрес (номер сектора) файла, если не требует
такой специальной информации о файле, как его размер или дата создания.
Множество посещаемых элементов может быть ограничено заданием строки,
которая должна быть префиксом всех перечисляемых имен. В этом случае сразу
ищется наименьшее имя с заданным префиксом, и оно становится именем (клю¬
чом) первого перечисляемого элемента. Затем процесс продолжается вплоть до
первого элемента, имя которого не имеет заданного префикса. Таким образом,
процесс получения всех элементов с ключом, имеющим заданный префикс, избе¬
гает обхода всего дерева, значительно повышая его скорость. Если префикс - это
пустая строка, то обходится все дерево.
Принцип работы процедуры Enumerate показан в следующем наброске, где мы
отвлекаемся от структуры В-дерева и опускаем рассмотрение префиксов:
PROCEDURE Enumerate(
ргос: PROCEDURE (name: FileName; adr: INTEGER; VAR continue: BOOLEAN));
VAR continue: BOOLEAN; this: DirEntry;
BEGIN continue := TRUE; this := FirstElement;
WHILE continue & (this # NIL) DO
proc(this.name, this.adr, continue); this := NextEntry(this)
END
END Enumerate
Из этого наброска можно заключить, что структура дерева не должна меняться
при обходе, так как функция NextEntry, совершенно очевидно, опирается на струк¬
турную информацию, хранимую в элементах самой структуры. Следовательно,
действия параметрической процедуры не должны влиять на структуру дерева.
Перечисление не должно использоваться, например, для удаления заданного мно¬
жества файлов. Чтобы предотвратить неправильное использование необходимо¬
го средства перечисления элементов, интерфейс FileDir вообще не доступен для
пользователей.
Обработка хранящегося на диске каталога следует точно такому же алгорит¬
му. Страницы, к которым обращаются, извлекаются с диска целиком (каждая
страница помещается в отдельный сектор диска) и сохраняются в буферах типа
DirPage, откуда можно обращаться к ее отдельным элементам. В принципе, эти бу¬
феры могут быть локальными в процедурах insert и delete. Один буфер выделяется
глобально; именно тот, который используется процедурой Search. Причина этого
исключения не только в том, что итерационный поиск требует только одного бу¬
фера, но и в том, что процедура Files.Old и, в свою очередь, Search могут вызваться,
когда процессор находится в привилегированном режиме и, следовательно, ис¬
пользует системный (вместо пользовательского) стек, который довольно мал и не
смог бы вместить буфер секторов.
Естественно, обновленная страница должна быть сохранена на диске. Невос¬
становленный сектор - это очень трудно диагностируемая ошибка программиро¬
вания, потому что некоторые части программы выполняются очень редко, и, сле¬
довательно, ошибка может выглядеть спорадической и ошибочно приписываться
к сбоям в работе аппаратуры.
MODULE FileDir; (*NW 12.1.86 / 23.8.90*)
IMPORT SYSTEM, Kernel;
232
Файловая система
Каталог файлов
(★Каталог файлов является В-деревом с корневой страницей в DirRootAdr.
Каждый вход содержит имя файла и дисковый адрес сектора заголовка файла*),
CONST FnLength* = 32;
SecTabSize* = 64;
ExTabSize* =12;
SectorSize* = 1024;
IndexSize* = SectorSize DIV 4;
HeaderSize* = 352;
DirRootAdr* = 29;
DirPgSize* = 24;
N = DirPgSize DIV 2;
DirMark* = 9B1EA38DH;
HeaderMark* = 9BA71D86H;
FillerSize = 52;
TYPE DiskAdr = LONGINT;
FileName* = ARRAY FnLength OF CHAR;
SectorTable* = ARRAY SecTabSize OF DiskAdr;
ExtensionTable* = ARRAY ExTabSize OF DiskAdr;
EntryHandler* = PROCEDURE (name: FileName; sec: DiskAdr; VAR continue: BOOLEAN);
FileHeader* =
RECORD (Kernel.Sector) (*выделяется в первой странице каждого файла на диске*)
mark*: LONGINT;
name*: FileName;
aleng*, bleng*: INTEGER;
date*, time*: LONGINT;
ext*: ExtensionTable;
sec*: SectorTable;
fill: ARRAY SectorSize - HeaderSize OF CHAR;
END;
IndexSector* =
RECORD (Kernel.Sector)
x*: ARRAY IndexSize OF DiskAdr
END;
DataSector* =
RECORD (Kernel.Sector)
B*: ARRAY SectorSize OF SYSTEM.BYTE
END;
DirEntry* = (*узел В-дерева*)
RECORD
name*: FileName;
adr*: DiskAdr; (*номер сектора заголовка файла*)
р*: DiskAdr (*номер сектора-потомка в каталоге*)
END;
233
234
Файловая система
DirPage* =
RECORD (Kernel.Sector)
mark*: LONGINT;
m*: INTEGER;
pO*: DiskAdr; (*номер сектора левого потомка в каталоге*)
fill: ARRAY FillerSize OF CHAR;
e*: ARRAY DirPgSize OF DirEntry
END;
PROCEDURE Search* (VAR name: FileName; VAR A: DiskAdr);
VAR i, j, L, R: INTEGER; dadr: DiskAdr;
a: DirPage;
BEGIN dadr := DirRootAdr; •
LOOP Kernel.GetSector(dadr, a);
L := 0; R := a.m; (*бинарный поиск*)
WHILE L < R DO
i := (L + R) DIV 2;
IF name <= a.e[i].name THEN R := i ELSE L := i + 1 END
END;
IF(R < a.m) & (name = a.e[R].name) THEN
A := a.e[R].adr; EXIT (*найден *)
END;
IF R = 0 THEN dadr := a.pO ELSE dadr := a.e[R - 1].p END;
IF dadr = 0 THEN A := 0; EXIT (*не найден*) END
END
END Search;
PROCEDURE insert (VAR name: FileName; dpgO: DiskAdr;
VAR h: BOOLEAN; VAR v: DirEntry; fad: DiskAdr);
(*h = "дерево становится выше, a v - повышающий его элемент"*)
VAR ch: CHAR;
i, j, L, R: INTEGER;
dpgl: DiskAdr;
u: DirEntry;
a: DirPage;
BEGIN (*~h*) Kernel.GetSector(dpgO, a);
L := 0; R := a.m; (*бинарный поиск*)
WHILE L < R DO
i := (L + R) DIV 2;
IF name <= a.e[i].name THEN R := i ELSE L := i + 1 END
END;
IF(R < a.m) & (name = a.e[R].name) THEN
a.e[R].adr := fad; Kernel.PutSector(dpgO, а) (*заменить*)
ELSE (*не на этой странице*)
IF R = 0 THEN dpgl := a.pO ELSE dpgl := a.e[R - 1 ].p END;
IF dpgl = 0 THEN (*нет в дереве, вставить*)
u.adr := fad; u.p := 0; h := TRUE; j := 0;
REPEAT ch := name[j]; u.name[j] := ch; INC(j)
UNTIL ch = OX;
Каталог файлов
235
WHILE j < FnLength DO u.name[j] := OX; INC(j) END
ELSE
insert(name, dpgl, h, u, fad)
END;
IF h THEN (*вставить u слева от e[R]*)
IF a.m < DirPgSize THEN
h := FALSE; i := a.m;
WHILE i > R DO DEC(i); a.e[i + 1] := a.e[i] END;
a.e[R] := u; INC(a.m)
ELSE (*разбить страницу и присвоить v срединный элемент*)
a.m := N; a.mark := DirMark;
IF R < N THEN (‘вставить в левую половину*)
v := a.e[N - 1]; i := N - 1;
WHILE i > R DO DEC(i); a.e[i + 1] := a.e[i] END;
a.e[R] := u; Kernel.PutSector(dpgO, a);
Kernel.AllocSector(dpgO, dpgO); i := 0;
WHILE i < N DO a.e[i] := a.e[i + N]; INC(i) END
ELSE (*вставить в правую половину*)
Kernel.PutSector(dpgO, a);
Kernel.AllocSector(dpgO, dpgO); DEC(R, N); i := 0;
IF R = 0 THEN v := и
ELSE v := a.e[N];
WHILE i < R - 1 DO a.e[i] := a.e[N + 1 + i]; INC(i) END;
a.e[i] := u; INC(i)
END;
WHILE i < N DO a.e[i] := a.e[N + i]; INC(i) END
END;
a.pO := v.p; v.p := dpgO
END;
Kernel.PutSector(dpgO, a)
END
END
END insert;
PROCEDURE Insert* (VAR name: FileName; fad: DiskAdr);
VAR oldroot: DiskAdr;
h: BOOLEAN; U: DirEntry;
a: DirPage;
BEGIN h := FALSE;
insert(name, DirRootAdr, h, U, fad);
IF h THEN (‘корень переполнен*)
Kernel.GetSector(DirRootAdr, a);
Kernel.AllocSector(DirRootAdr, oldroot); Kernel.PutSector(oldroot, a);
a.mark := DirMark; a.m := 1; a.pO := oldroot; a.e[0] := U;
Kernel.PutSector(DirRootAdr, a)
END
END Insert;
PROCEDURE underflow (VAR c: DirPage; (*страница-предок*)
236
Файловая система
dpgO: DiskAdr; s: INTEGER; (*точка вставки в с*) VAR h: BOOLEAN); (*с неполна*)
VAR i, k: INTEGER;
dpgl: DiskAdr;
a, b: DirPage; (*a := неполная страница, b := соседняя страница*)
BEGIN Kernel.GetSectoг(dpgO, a);
(*h & a.m = N-1 & dpgO = c.e[s-1].p*)
IF s < c.m THEN (*b := страница справа от a*)
dpgl :=c.e[s].p; Kernel.GetSector(dpg1, b);
к := (b.m- N + 1) DIV 2; (*k = число доступных на странице b элементов*)
a.e[N - 1] := c.e[s]; a.e[N - 1].p := b.pO;
IF к > 0 THEN
(♦переместить k-1 элементов из b в а, один - в с*) i := 0;
WHILE i < к - 1 DO a.e[i + N] := b.e[i]; INC(i) END;
c.e[s] := b.e[i]; b.pO := c.e[s].p;
c.e[s].p := dpgl; DEC(b.m, k); i := 0;
WHILE i < b.m DO b.e[i] := b.e[i + k]; INC(i) END;
Kernel. PutSector(dpg1, b); a.m := N - 1 + k; h := FALSE
ELSE (*слить страницы а и b, удалив b*) i := 0;
WHILE i < N DO a.e[i + N] := b.e[i]; INC(i) END;
i := s; DEC(c.m);
WHILE i < c.m DO c.e[i] := c.e[i + 1]; INC(i) END;
a.m := 2 * N; h := c.m < N
END;
Kernel.PutSector(dpgO, a)
ELSE (*b := страница слева от a*) DEC(s);
IF s = 0 THEN dpgl := c.pO ELSE dpgl := c.e[s - 1].p END;
Kernel.GetSector(dpg1, b);
к := (b.m - N + 1) DIV 2; (*k = число доступных на странице b элементов*)
IF к > О THEN
i := N - 1;
WHILE i > 0 DO DEC(i); a.e[i + k] := a.e[i] END;
i := к - 1; a.e[i] := c.e[s]; a.e[i].p := a.pO;
(♦переместить k-1 элементов из b в а, один -в с*) DEC(b.m, к);
WHILE i > О DO DEC(i); a.e[i] := b.e[i + b.m + 1] END;
c.e[s] := b.e[b.m]; a.pO := c.e[s].p;
c.e[s].p := dpgO; a.m := N - 1 + k; h := FALSE;
Kernel.PutSector(dpgO, a)
ELSE (*слить страницы а и b, удалив a*)
c.e[s].p := a.pO; b.e[N] := c.e[s]; i := 0;
WHILE i < N - 1 DO b.e[i + N + 1] := a.e[i]; INC(i) END;
b.m := 2 * N; DEC(c.m); h := c.m < N
END;
Kernel.PutSector(dpg1, b)
END
END underflow;
PROCEDURE delete (VAR name: FileName; dpgO: DiskAdr; VAR h: BOOLEAN;
VAR fad: DiskAdr);
(*найти и удалить вход с ключом name; если страница неполна,
Каталог файлов
237
выровнять или слить соседние страницы; h := "страница dpgO неполна"*)
VAR i, J. к, L, R: INTEGER;
dpgl: DiskAdr;
a: DirPage;
PROCEDURE del (dpgl: DiskAdr; VAR h: BOOLEAN);
VAR dpg2: DiskAdr; (*a, R - глобальные*)
b: DirPage;
BEGIN Kernel.GetSector(dpg1, b); dpg2 := b.e[b.m - 1].p;
IF dpg2 # 0 THEN del(dpg2, h);
IF h THEN underflow(b, dpg2, b.m, h); Kernel.PutSector(dpg1, b) END
ELSE
b.e[b.m - 1].p := a.e[R].p; a.e[R] := b.e[b.m - 1];
DEC(b.m); h := b.m < N; Kernel.PutSector(dpg1, b)
END
END del;
BEGIN (*“h*) Kernel.GetSector(dpgO, a);
L := 0; R := a.m; (*бинарный поиск*)
WHILE L < R DO
i := (L + R) DIV 2;
IF name <= a.e[i].name THEN R := i ELSE L := i + 1 END
END;
IF R = 0 THEN dpgl := a.pO ELSE dpgl := a.e[R - 1].p END;
IF(R < a.m) & (name = a.e[R].name) THEN
(*найден, теперь удалить*) fad := a.e[R].adr;
IF dpgl = 0 THEN (*a - это страница-лист?*)
DEC(a.m); h :=a.m<N; i : = R;
WHILE i < a.m DO a.e[i] := a.e[i + 1]; INC(i) END
ELSE del(dpg1, h);
IF h THEN underflow^, dpgl, R, h) END
END;
Kernel.PutSector(dpgO, a)
ELSIF dpgl # 0 THEN
delete(name, dpgl, h, fad);
IF h THEN underflow(a, dpgl, R, h); Kernel.PutSector(dpgO, a) END
ELSE (*нет в дереве*) fad := О
END
END delete;
PROCEDURE Delete* (VAR name: FileName; VAR fad: DiskAdr);
VAR h: BOOLEAN; newroot: DiskAdr;
a: DirPage;
BEGIN h := FALSE;
delete(name, DirRootAdr, h, fad);
IF h THEN (*неполный корень*)
Kernel.GetSector(DirRootAdr, a);
IF (a.m = 0) & (a.pO # 0) THEN
newroot := a.pO; Kernel.GetSector(newroot, a);
238
Файловая система
Kernel.PutSectoг(DirRootAdг, a) (*убрать новый корень*)
END
END
END Delete;
PROCEDURE enumerate (VAR prefix: ARRAY OF CHAR; dpg: DiskAdr;
proc: EntryHandler; VAR continue: BOOLEAN);
VAR i, j, diff: INTEGER; dpgl: DiskAdr; a: DirPage;
BEGIN Kernel.GetSector(dpg, a); i := 0;
WHILE (i < a.m) & continue DO
j := 0;
LOOP
IF prefix[j] = OX THEN diff := 0; EXIT END;
diff := 0RD(a.e[i].name[j]) - 0RD(prefix[j]);
IF diff # 0 THEN EXIT END;
INC(j)
END;
IF i = 0 THEN dpgl := a.pO ELSE dpgl := a.e[i - 1].p END;
IF diff >= 0 THEN ^совпадающий префикс*)
IF dpgl # 0 THEN enumerate(prefix, dpgl, proc, continue) END;
IF diff = 0 THEN
IF continue THEN proc(a.e[i].name, a.e[i].adr, continue) END
ELSE continue := FALSE
END
END;
INC(i)
END;
IF continue & (i > 0) & (a.e[i - 1].p # 0) THEN
enumerate(prefix, a.e[i - 1].p, proc, continue)
END
END enumerate;
PROCEDURE Enumerate* (prefix: ARRAY OF CHAR; proc: EntryHandler);
VAR b: BOOLEAN;
BEGIN b := TRUE; enumerate(prefix, DirRootAdr, proc, b)
END Enumerate;
PROCEDURE Init;
VAR k: INTEGER;
A: ARRAY 2000 OF DiskAdr;
PROCEDURE MarkSectors;
VAR L, R, i, j, n: INTEGER; x: DiskAdr;
hd: FileHeader;
B: IndexSector;
PROCEDURE sift (L, R: INTEGER);
VAR i, j: INTEGER; x: DiskAdr;
BEGIN j := L; x := A[j];
Каталог файлов
239
LOOP i := j; j := 2 * j + 1;
IF (j + 1 < R) & (A[j] < A[j + 1]) THEN INC(j) END;
IF(j >= R) OR (x > A[j]) THEN EXIT END;
A[i]:=A[j]
END;
A[i] := x
END sift;
BEGIN L := к DIV 2; R := к; (*сортировка по дереву с приоритетом*)
WHILE L > 0 DO DEC(L); sift(L, R) END;
WHILE R > 0 DO
DEC(R); x := A[0]; A[0] := A[R]; A[R] := x; sift(L, R)
END;
WHILE L < k DO
Kernel.GetSector(A[L], hd);
IF hd.aleng < SecTabSize THEN j := hd.aleng + 1;
REPEAT DEC(j); Kernel.MarkSector(hd.sec[j]) UNTIL j = 0
ELSE j := SecTabSize;
REPEAT DEC(j); Kernel.MarkSector(hd.sec[j]) UNTIL j = 0;
n := (hd.aleng - SecTabSize) DIV 256; i := 0;
WHILE i <= n DO
Kernel.MarkSector(hd.ext[i]);
Kernel.GetSector(hd.ext[i], В); (*сектор индексов*)
IF i < n THEN j := 256 ELSE j := (hd.aleng - SecTabSize)
MOD 256 + 1 END;
REPEAT DEC(j); Kernel.MarkSector(B.x[j]) UNTIL j = 0;
INC(i)
END
END;
INC(L)
END
END MarkSectors;
PROCEDURE TraverseDir (dpg: DiskAdr);
VAR i, j: INTEGER; a: DirPage;
BEGIN Kernel.GetSector(dpg, a); Kernel.MarkSector(dpg); i := 0;
WHILE i < a.m DO
A[k] := a.e[i].adr; INC(k); INC(i);
IF k = 2000 THEN MarkSectors; k := 0 END
END;
IF a.pO # 0 THEN
TraverseDir(a.pO); i := 0;
WHILE i < a.m DO
TraverseDir(a.e[i].p); INC(i)
END
END
END TraverseDir;
BEGIN Kernel.ResetDisk; k := 0;
TraverseDir(DirRootAdr); MarkSectors
240
Файловая система
END Init;
BEGIN Init
END FileDir.
Каталог файлов Оберона представляет отдельное упорядоченное множество
пар «имя - файл». Поэтому он называется также плоским каталогом. Его внутрен¬
няя древовидная структура не видна извне. Хотя некоторые файловые системы
используют каталог с видимой древовидной структурой, особенно UNIX. При по¬
иске имя (ключ) направляет путь поиска; само имя отражает структуру, фактиче¬
ски оно - цепочка имен (разделяемых обычно косой чертой или точкой). Тогда
первое имя ищется в корневом каталоге, чьи потомки не файлы, а подкаталоги.
Процесс повторяется, пока не использовано последнее имя в цепочке (и обяза¬
тельно обозначает файл).
Так как длина пути поиска файлов в дереве растет как логарифм числа эле¬
ментов, любой подраздел дерева неизбежно снижает производительность, так как
log(m + n) < log(m) + log (п) для любых т, п > 7. Это справедливо, только ког¬
да существуют множества элементов с общими свойствами. Если значения этих
свойств однажды сохранены, а именно в подкаталоге, в котором общие значения
свойств относятся ко всем элементам, а не к каждому в отдельности, то получается
выигрыш не только в экономии памяти, но, возможно, и в числе обращений, ко¬
торые зависят от этих свойств. Как правило, общие свойства - это имя владельца,
пароль и права доступа (запрет чтения или записи), свойства, которые прежде все¬
го имеют значение в многопользовательской среде. Так как Оберон был явно заду¬
ман как однопользовательская система, потребность в таких средствах невелика,
а следовательно, плоский каталог дает лучшую производительность при простой
реализации.
Каждая операция каталога начинается с обращения к корневой странице. Оче¬
видная мера повышения эффективности - хранить корневую страницу «постоян¬
но» в основной памяти. Мы решили не делать этого по четырем причинам:
1. Если аппаратура дает сбой или компьютер выключается до того, как кор¬
невая страница скопирована на диск, каталог файла будет противоречивым
с серьезными последствиями.
2. Корневая страница должна обрабатываться иначе, чем другие страницы,
делая программу сложнее.
3. Обращения к каталогу не доминируют над процессом вычислений; следо¬
вательно, любое улучшение едва сказалось бы на общей производительно¬
сти системы. Выгода от усложнений была бы малой.
4. Процедура Init вызывается при инициализации системы для создания
таблицы занятости секторов. Поэтому этой процедуре (и модулю) нужно
позволить обращаться к структуре таблиц(ы) секторов файлов, что дости¬
гается размещением ее определения в модуле FileDir (вместо Files). В от¬
личие от Enumerate, она обходит все В-дерево. Номера секторов файлов,
предоставляемые TraverseDir, заносятся в буфер. По заполнении они сор-
тируются, после чего читается каждый сектор заголовка файла, а сектора,
указанные в его таблице секторов, помечаются как занятые. Сортировка
значительно ускоряет чтение секторов заголовков. Однако инициализация
таблицы занятости секторов явно превышает время запуска компьютера.
Для файловой системы с 10 ООО файлов запись всех файлов занимает по¬
рядка 15 секунд.
7.5. Набор инструментов
файловых утилит
Закончим эту главу представлением команд, которые образуют набор инстру¬
ментов для обработки файлов. Эти команды содержатся в модуле System и служат
для копирования, переименования и удаления файлов, а также для получения
фрагментов каталога файлов.
Все процедуры CopyFiles, RenameFiles и DeleteFiles следуют одному шаблону
Текст параметра просматривается для имен файла, и для каждой операции вы¬
зывается соответствующая процедура. Если текст параметра содержит стрелку,
он интерпретируется как указатель на самое последнее выделение текста, на ко¬
торое указывает имя файла. В случаях CopyFiles и RenameFiles, которые требуют
двух имен для одного действия, имена разделяются «=>», задающим направление
в действиях копирования или переименования.
PROCEDURE CopyFile (name: ARRAY OF CHAR; VAR S: Texts.Scanner);
VAR f, g: Files.File; Rf, Rg: Files.Rider; ch: CHAR;
BEGIN Texts.Scan(S);
IF (S.class = Texts.Char) & (S.с = "=") THEN Texts.Scan(S);
IF (S.class = Texts.Char) & (S.с = ">") THEN Texts.Scan(S);
IF S.class = Texts.Name THEN
Texts.WriteString(W, name); Texts.WriteString(W, " => ");
Texts.WriteString(W, S.s);
Texts.WriteString(W, " copying”); Texts.Append(0beron.Log, W.buf);
f := Files.Old(name);
IF f # NIL THEN g := Files.New(S.s);
Files.Set(Rf, f, 0); Files.Set(Rg, g, 0); Files.Read(Rf, ch);
WHILE "Rf.eof DO Files.Write(Rg, ch); Files.Read(Rf, ch) END;
Files.Register(g)
ELSE Texts.WriteString(W, " failed")
END;
Texts.WriteLn(W); Texts.Append(0beron.Log, W.buf)
END
END
END
END CopyFile;
PROCEDURE CopyFiles*;
VAR beg, end, time: LONGINT; res: INTEGER;
Ha6op инструментов файловых утилит
241
242
Файловая система
T: Texts.Text;
S: Texts.Scanner;
BEGIN Texts.WriteString(W, "System.CopyFiles"); Texts.WriteLn(W);
Texts.Append(Oberon.Log, W.buf);
Texts.OpenScanner(S, Oberon.Par.text, Oberon.Par.pos); Texts.Scan(S);
WHILE S.class = Texts.Name DO CopyFile(S.s, S); Texts.Scan(S) END;
IF(S.class = Texts.Char) & (S.с = "''") THEN Oberon.GetSelection(T, beg, end, time);
IF time >= 0 THEN
Texts.OpenScanner(S, T, beg); Texts.Scan(S);
IF S.class = Texts.Name THEN CopyFile(S.s, S) END
END
END
END CopyFiles;
PROCEDURE RenameFile (name: ARRAY OF CHAR; VAR S: Texts.Scanner);
VAR res: INTEGER;
BEGIN Texts.Scan(S);
IF (S.class = Texts.Char) & (S.с = "=") THEN Texts.Scan(S); .
IF (S.class = Texts.Char) & (S.с = ">") THEN Texts.Scan(S);
IF S. class = Texts.Name THEN
Texts.WriteString(W, name); Texts.WriteString(W, " => ");
Texts.WriteString(W, S.s);
Texts.WriteString(W, " renaming"); Texts.Append(Oberon.Log, W.buf);
Files.Rename(name, S.s, res);
IF res > 1 THEN Texts.WriteString(W, " failed") END;
Texts.WriteLn(W); Texts.Append(Oberon.Log, W.buf)
END
END
END
END RenameFile;
PROCEDURE RenameFiles*;
VAR beg, end, time: LONGINT; res: INTEGER;
T: Texts.Text;
S: Texts.Scanner;
BEGIN Texts.WriteString(W, "System.RenameFiles"); Texts.WriteLn(W);
Texts.Append(Oberon.Log, W.buf);
Texts.OpenScanner(S, Oberon.Par.text, Oberon.Par.pos); Texts.Scan(S);
WHILE S.class = Texts. Name DO RenameFile(S.s, S); Texts.Scan(S) END;
IF(S.class = Texts.Char) & (S.с = THEN
Oberon.GetSelection(T, beg, end, time);
IF time >= 0 THEN
Texts.OpenScanner(S, T, beg); Texts.Scan(S);
IF S.class = Texts.Name THEN RenameFile(S.s, S) END
END
END
END RenameFiles;
PROCEDURE DeleteFile (VAR name: ARRAY OF CHAR);
Набор инструментов файловых утилит
243
VAR res: INTEGER;
BEGIN Texts.WriteString(W, name); Texts.WriteString(W, " deleting");
Texts.Append(Oberon.Log, W.buf); Files.Delete(name, res);
IF res # 0 THEN Texts.WriteString(W, " failed") END;
Texts.WriteLn(W); Texts.Append(Oberon.Log, W.buf)
END DeleteFile;
PROCEDURE DeleteFiles*;
VAR beg, end, time: LONGINT;
T: Texts.Text;
S: Texts.Scanner;
BEGIN Texts.WriteString(W, "System.DeleteFiles"); Texts.WriteLn(W);
Texts.Append(Oberon.Log, W.buf);
Texts.OpenScanner(S, Oberon.Par.text, Oberon.Par.pos); Texts.Scan(S);
WHILE S.class = Texts.Name DO DeleteFile(S.s); Texts.Scan(S) END;
IF(S.class = Texts.Char) & (S.с = "'*”) THEN
Oberon.GetSelection(T, beg, end, time);
IF time >= 0 THEN Texts.OpenScanner(S, T, beg); Texts.Scan(S);
IF S.class = Texts.Name THEN DeleteFile(S.s) END
END
END
END DeleteFiles;
Процедура Directory служит для получения фрагментов каталога файла. Она
использует процедуру FileDir.Enumerate. Параметрическая процедура List прове¬
ряет, отвечает ли полученное имя шаблону, заданному параметром команды ка¬
талога. Если отвечает, то имя заносится в текст окошка, открытого в системной
дорожке. Так как шаблон может содержать одну или несколько звездочек (любые
символы), проверка состоит из последовательности поисков частей шаблона (раз¬
деленных звездочками) в имени файла. Для сокращения числа вызовов List про¬
цедура Enumerate вызывается с первой частью шаблона в качестве префикса пара¬
метра. Тогда перечисление начинается с наименьшего имени с таким префиксом и
заканчивается, как только все имена с таким префиксом просмотрены.
Если заданный шаблон сопровождается опцией «/date», то помимо имен фай¬
лов выводятся их дата создания и длина. Это требует не только обхода секторов
каталога на диске, но и дополнительно для каждого перечисляемого файла чтения
его сектора заголовка. Эти две процедуры используют глобальные переменные
pat и diroption.
PROCEDURE* List (name: FileDir.FileName; adr: LONGINT; VAR cont: BOOLEAN);
VAR iO, ii, jO, j1: INTEGER; f: BOOLEAN; hp: FileDir.FileHeader;
EGIN iO := pos; jO := pos; f := TRUE;
LOOP
IF pat[iO] = THEN INC(iO);
IF pat[Ю] = OX THEN EXIT END
ELSE
IF name[jO] # OX THEN f := FALSE END;
244
Файловая система
EXIT
END;
f := FALSE;
LOOP
IF name[jO] = OX THEN EXIT END;
i1 := iO; j1 := jO;
LOOP
IF (pat[11] = OX) OR (pat[i1] = "*") THEN f := TRUE; EXIT END;
IF pat[ii] # name[j1] THEN EXIT END;
INC(i1); INC(j1)
END;
IF f THEN jO := j1; iO := i1; EXIT END;
INC(jO)
END;
IF ~f THEN EXIT END
END;
IF f THEN
Texts.WriteString(W, name);
IF diroption = "d” THEN
Kernel.GetSector(adr, hp);
Texts.WriteString(W, " "); Texts.WriteDate(W, hp.time, hp.date);
Texts.WriteInt(W, LONG(hp.aleng)*FileDir.SectorSize + hp.bleng -
FileDir.HeaderSize, 8)
END;
Texts.WriteLn(W)
END
END List;
PROCEDURE Directory*;
VAR X, Y, i: INTEGER; ch: CHAR;
R: Texts.Reader;
T, t: Texts.Text;
V: Viewers.Viewer;
beg, end, time: LONGINT;
pre: ARRAY 32 OF CHAR;
BEGIN Texts.OpenReader(R, Oberon.Par.text, Oberon.Par.pos); Texts.Read(R, ch);
WHILE ch = " " DO Texts.Read(R, ch) END;
IF (ch = "~") OR (ch = ODX) THEN
Oberon.GetSelection(T, beg, end, time);
IF time >= 0 THEN
Texts.OpenReader(R, T, beg); Texts.Read(R, ch);
WHILE ch <= " " DO Texts.Read(R, ch) END
END
END;
i := 0;
WHILE (ch > " ") & (ch it „/“) DO pat[i] := ch; INC(i); Texts.Read(R, ch) END;
pat[i] := OX;
IF ch = "/" THEN Texts.Read(R, diroption) ELSE diroption := OX END;
i := 0;
WHILE pat[i] > "*" DO pre[i] := pat[i]; INC(i) END;
pre[i] := OX; pos := i;
Oberon.AllocateSystemViewer(Oberon.Par.vwr.X, X, Y); t := TextFrames.Text(”");
V := MenuViewers.New(
TextFrames.NewMenu("System.Directory”, StandardMenu),
TextFrames.NewText(t, 0), TextFrames.menuH, X, Y);
FileDir.Enumeratedre, List); Texts.Append(t, W.buf)
END Directory;
Литература
1. R. Bayer and E. M. McCreight. Organization and maintenance of large ordered
indexes. Acta Informatica, 1, 3, (1972), 173-189.
2. D. Comer. The ubiquiteous В-tree. ACM Comp Surveys, 11, 2, (June 1979),
121-137.
Литература
245
8. ПАМЯТЬ: РАЗМЕТКА И УПРАВЛЕНИЕ
8.1. Разметка памяти
и ее организация во время
выполнения
Решающее свойство системы Оберон - это централизованное управление ре¬
сурсами. Его достоинство - в том, что исключаются дублирование алгоритмов
управления и предварительное разделение ресурсов. Недостаток - в том, что ал¬
горитмы управления фиксируются раз и навсегда и остаются одними и теми же
для всех приложений. Поэтому успех централизованного управления ресурсами
кардинально зависит от его гибкости и эффективной реализации. Эта глава пред¬
ставляет схему и алгоритмы управления оперативной памятью в системе Оберон.
Разметка памяти системы Оберон определяется структурой кода и данных,
типичных при использовании модульных языков программирования высокого
уровня, в частности языка Оберон. Она предполагает разделение памяти на три
области.
1. Область блоков (модули). Каждый модуль определяет процедуры (код) и
глобальные (статические) переменные. Инициализирующая часть модуля
может считаться процедурой, неявно вызываемой после его загрузки. При
загрузке должно быть выделено место для кода и данных. Как правило,
в модулях очень мало или вовсе нет глобальных переменных, следователь¬
но, размер выделяемой области определяется прежде всего кодом. Область,
объединяющая код и данные, называется блоком. Блоки выделяются в об¬
ласти блоков.
2. Рабочая область (стек). Выполнение каждой команды предполагает вызов
цепочки процедур, каждая из которых может иметь параметры и локаль¬
ные переменные. Так как вызовы и завершения процедур следуют строго
в порядке LIFO (Last-In First-Out), стек - это единственно подходящая
стратегия выделения памяти локальным данным. Освобождение памяти по
завершении процедуры достигается простой переустановкой указателя, за¬
дающего вершину стека. Так как такая операция входит в набор машинных
команд (для возвратов), она не отнимает времени. Поскольку Оберон -
однопроцессная система, вполне достаточно одного стека. Кроме того, по
завершении команды стек пуст, что будет важно для упрощения схемы
восстановления (повторного использования) динамически выделяемого
пространства.
3. Динамическая область (куча). Кроме глобальных (статических) и локаль¬
ных (стековых) переменных, программа может обращаться к безымянным
переменным, на которые ссылаются по указателю. Такие переменные соз¬
даются именно динамически явным вызовом операции NEW. Эти перемен¬
ные выделяются в так называемой куче. Освобождаются они «автомати¬
чески», когда нужна свободная память и на них не ссылается ни один из
загруженных модулей. Такой процесс называется сборкой мусора.
К сожалению, число различных областей больше двух. Если бы их было две,
то не было бы необходимости ограничивать их размеры; просто сумма их разме¬
ров ограничивалась бы только размером памяти. В случае трех областей прихо¬
дится произвольно определять предельные размеры. Однако наличие аппаратных
средств отображения адресов облегчает задачу, потому что виртуальное адресное
пространство так велико, что его предел почти никогда не достигается.
Кроме того, отметим, что и стек, и куча должны быть на самом деле выделены,
то есть любой адрес в этих областях должен обозначать физическое место в памя¬
ти. Следовательно, нет смысла в создании их суммарного виртуального адресно¬
го пространства, превышающего всю физическую память. В таком случае размер
виртуального пространства блоков становится разностью между виртуальным
и физическим адресными пространствами. Итоговая схема показана на рис. 8.1.
Верхняя часть адресного пространства отводится под регистры устройств.
Рис. 8.1. Разметка памяти
для Ceres-1 и Ceres-2
Если отображение адресов невозможно, как в случае Ceres-З, который не име¬
ет модуля управления памятью, приходится фиксировать ограничения размеров.
Принятая для Ceres-З разметка показана на рис. 8.2; стек ограничен 128 Кб.
Разметка памяти и ее организация во время выполнения
247
Рис. 8.2. Разметка памяти
для Ceres-3
Область с интервалом адресов 0...FFFFH содержит:
1. NIL-страницу (0...FFFPI), которая всегда свободна. Ее назначение - позво¬
лить обращениям по NIL-указателям вызывать адресные прерывания.
2. Системный стек (1000H-17FFH), который используется подпрограммами
прерываний, выполняющимися в привилегированном режиме, включая
обработчик прерываний.
3. Таблицы размещения страниц и секторов диска.
4. Дескрипторы модулей (4000II-7FFFH).
5. Блоки для резидентных модулей внутреннего ядра, то есть Kernel, FileDir,
Files и Modules.
Рабочая область организована обычным образом, как стек записей активации
процедур. Его вершина задается регистром SP. Второй регистр, так называемый
указатель кадра, FP - это начало динамической цепочки записей активации.
При вызове процедуры новый элемент добавляется в два шага. Первый шаг вы¬
полняется после загрузки параметров инструкцией вызова (СХР - для внешних
процедур, BSR - для локальных процедур). Второй шаг выполняется машинной
командой ENTER - первой командой тела любой процедуры. Запись активации
удаляется (и тоже в два шага) по завершении процедуры командами EXIT и RXP
для внешних или RET для локальных процедур. Состояние рабочей области до и
после этих четырех шагов показано на рис. 8.3.
Из этого следует, что локальные переменные адресуются относительно значе¬
ния FP с отрицательными смещениями. Параметры адресуются относительно FP
с положительными смещениями, начиная с 12 для внешних процедур, вызывае-
248
Память: разметка и управление
Выделение блоков модулей
Рис. 8.3. Состояние стека до и после вызова процедуры и возврата из нее
мых командой СХР, и начиная с 8 для локальных процедур, когда регистр MOD
не заносится в стек командой вызова.
К глобальным переменным и константам (строкам) обращаются по регистру
SP (статическая база). Значение этого регистра автоматически подгоняется как
командами СХР и RXP, так и любыми прерываниями.
8.2. Выделение блоков модулей
Как указано в предыдущем разделе, память для глобальных (статических)
переменных, констант и программного кода модулей выделяется в области бло¬
ков. Каждый модуль представлен отдельным блоком. Кроме того, каждому моду¬
лю назначается дескриптор модуля, содержащий различные указатели на разделы
блока (см. главу 6). Деление на дескриптор и блок предполагается архитектурой
процессора NS-32000, который поддерживает модульные структуры посредством
его режима внешней адресации. Физическое разделение необходимо потому, что
адреса дескрипторов ограничены 16-разрядными значениями, и поэтому ими нель¬
зя управлять так же, как общей, динамической памятью, что довольно неудачно.
Управление блоками выполняется двумя процедурами - Kernel.AllocBlock и Ker¬
nel.FreeBlock. Реализации различны для разных моделей компьютера Ceres, потому
что в Ceres-1 и Ceres-2 существует концепция виртуальной памяти, представленная
устройством управления памятью (MMU, Memory Management Unit) для отобра¬
жения адресов, тогда как в Ceres-З ее нет. В первом случае выделенные (физиче¬
ские) страницы регистрируются в таблице занятости страниц. Память рассматри¬
вается как набор страниц, а таблица содержит по одному биту на каждую страницу,
и 0 в нем значит, что соответствующая страница выделена. Каждый блок состоит из
целого числа страниц, размер которых приводится в следующей таблице.
249
Память: разметка и управление
Компьютер
Процессор
Размер страницы
Ceres-1
NS-32032
512
Ceres-2
NS-32532
4096
Ceres-3
NS-32GX32
1024
В случае Ceres-1 и Ceres-2 виртуальное адресное пространство для блоков так
велико, что новые блоки могут создаваться с постоянным наращиванием адресов,
несмотря на дыры, возникающие от освобождения блоков. Необходимые физиче¬
ские страницы получаются просто сканированием таблицы занятости. Освобожде¬
ние блока - это просто пометка освобождаемых страниц как не занятых в таблице.
Конечно, соответствующие записи в таблицах страниц должны помечаться
(или сбрасываться) так же, как, возможно, должны выделяться новые таблицы
страниц. Подчеркнем, что эти операции должны выполняться с отключением
MMU и с запретом любых прерываний.
МMU-архитектура процессора NS-32000 использует схему двухуровневых
таблиц, показанную на рис. 8.4. Причина в том, что таблица страниц должна быть
достаточно большой, чтобы охватить весь диапазон виртуальных адресов. Если
размер страницы равен 4 Кб, а адресное пространство 4 Гб (при 32-разрядных
адресах), то понадобится не меньше 220 элементов. Это приведет к таблице разме¬
ром в 4 Мб, что, очевидно, недопустимо. Используя двухуровневую схему, каждая
запись (первичной) таблицы указывает на таблицу второго уровня, которая охва¬
тывает собой большой раздел памяти. В процессоре NS-32532 все таблицы имеют
размер 4 Кб и состоят из 1024 записей. Следовательно, каждая таблица второго
уровня охватывает пространство 1024 * 4 Кб = 4 Мб, и, таким образом, страни¬
цы первого уровня из 1024 записей достаточно, чтобы охватить все виртуальное
пространство в 4 Гб.
Конечно, недостаток двухуровневой схемы в том, что при кэш-промахе потре¬
буются уже не два, а три шага для обращения к слову памяти. (За подробностями
отсылаем читателя к литературе и к руководству по процессору).
250
Рис. 8.4. Схема виртуальной адресации NS-32000
Обработка таблиц сведена к двум внутренним подпрограммам ядра - для выде¬
ления и освобождения физических страниц. Они состоят примерно из 75 команд.
Конечно, необходимость трехкратного доступа для каждого обращения к па¬
мяти устраняется кэш-трансляцией в MMU. Однако при каждом кэш-промахе
снижение производительности неизбежно. Кроме того, для каждого обращения
нужен дополнительный подцикл поиска в кэш-таблице. Компьютер Ceres-З не
имеет MMU и трансляции адресов. Как следствие каждый блок должен состо¬
ять из целого числа физически смежных страниц. Дыры от освобождаемых бло¬
ков должны использоваться повторно. Мы применяем простую схему хранения
списка дыр и выделения нового блока в первой попавшейся дыре достаточной
величины (стратегия «первый подходящий»). Учитывая относительную редкость
освобождения модулей, усилия по улучшению стратегии не стоят получающейся
в результате дополнительной сложности.
Примечательно, что без виртуальной адресации код для выделения и освобож¬
дения блоков лишь незначительно сложнее, чем с ней (69 команд против 49). Если
же добавить подпрограммы управления таблицами страниц, то он становится еще
проще (69 команд против 124). Все остальные преимущества MMU - это лучшее,
за счет отсутствия дыр, использование памяти (незначительное преимущество),
и то, что случайные обращения к уже выгруженным модулям, например из пред¬
установленных процедур, приводят к прерыванию по несуществующему адресу.
Стоит напомнить, что понятие отображения адресов появилось в ответ на
необходимость виртуальной памяти на дисках как внешних хранилищах, когда
страницы могли перемещаться на задний план для освобождения места для вновь
требуемых страниц и могли быть затем восстановлены с диска но запросу, то есть
когда к ним нужен был доступ. Эта схема называется подкачкой по обращению.
Она не используется в системе Оберон, и можно утверждать, что подкачка по об¬
ращению потеряла свое значение с появлением большой первичной (оператив¬
ной) памяти.
Опыт использования Ceres приводит к заключению: если для многопользова¬
тельских операционных систем переадресация через MMU была важной чертой,
то для однопользовательских рабочих станций она становится ненужным изли¬
шеством. Современная технология полупроводников позволила интегрировать
схему трансляции и кэширования целиком в одном чипе или даже в самом процес¬
соре и привела к сокрытию (и игнорированию) значительной сложности схемы.
Ее побочное влияние на скорость выполнения совершенно непредсказуемо. Это
делает системы с MMU фактически непригодными для приложений с жесткими
ограничениями на реальное время.
8.3. Управление динамической
памятью
Термин динамическая память используется здесь для всех переменных, па¬
мять которым выделяется ни статически (глобальные переменные), ни в стеке
(локальные переменные), а вызовом встроенной процедуры NEW. Такие перемен-
Управление динамической памятью
251
252
Память: разметка и управление
ные не имеют имен, и к ним обращаются исключительно по указателям. Область,
где они размещаются, называется кучей.
Место, выделенное таким динамическим переменным, становится свободным
и повторно используемым, как только исчезает последняя ссылка на него. Это
тяжелый случай, и в многопроцессных системах его даже невозможно выявить.
Обычно его игнорируют, а вместо этого определяют доступность всех выделенных
переменных (записей, объектов), только когда требуется большее место в памяти.
Этот процесс называется сборкой мусора.
В системе Оберон нет явной процедуры освобождения, позволяющей програм¬
мисту сообщить о том, что к переменной больше не обращаются. Первая причина
ее отсутствия - в том, что программист обычно не знает, когда запросить освобож¬
дение. А во-вторых, его «подсказка» не может заслуживать доверия. Ошибочное
освобождение, случившееся, когда еще существуют ссылки на рассматриваемый
объект, может привести к повторному выделению одного и того же пространства
с пагубными последствиями. Следовательно, кажется благоразумным полностью
положиться на системное управление, чтобы выявить, какие области памяти
действительно можно повторно использовать.
Прежде чем обсудить схему восстановления памяти, которая является главной
темой управления динамической памятью, обратим наше внимание на проблему
выделения памяти, то есть на реализацию процедуры NEW. Простейшее решение
состоит в том, чтобы поддерживать список свободных блоков и выбирать первый,
достаточно большой.
Такая стратегия приводит к относительно большой фрагментации пространст¬
ва и создает много маленьких элементов, особенно в начале списка. Поэтому мы
используем чуть более совершенную схему и поддерживаем пять списков доступ¬
ного пространства. Четыре из них содержат фрагменты фиксированного размера,
а именно 16, 32, 64 и 128 байтов. Пятый список содержит фрагменты, размер ко¬
торых кратен 128. Процедура NEW округляет нужный размер до ближайшего из
этих значений и выбирает первый элемент соответствующего списка. Отметим,
что при выборе значения разрешается объединять любые два смежных элемента
в один элемент следующего списка. Такая схема при минимальных усилиях разум¬
но понижает фрагментацию, то есть появление в больших количествах мелких
фрагментов. Тело процедуры NEW состоит всего из 100 команд, и обычно только
малая их часть должна выполняться.
Оператор NEW(p) компилируется в последовательность команд, присваиваю¬
щих адрес переменной-указателя р фиксированному регистру (R0), а тэг типа -
другому регистру (R1). Тэг типа - это указатель на дескриптор типа, содержащий
информацию, необходимую сборщику мусора. Он включает размер занимаемого и
теперь уже выделенного пространства. Действие NEW - это присваивание р адре¬
са выделенного блока и присваивание тэга префиксу блока (см. рис. 8.5).
Примечание: компилятором языка Оберон для Ceres допускается также про¬
цедура SYSTEM.NEW (р, п). Она позволяет выделить блок без фиксированного
типа, заданного дескриптором. Здесь в префикс блока помещается вместо тэга раз¬
мер п. Разряд 0 указывает, представляют разряды 0-23 тэг или размер. Такое сред-
Управление динамической памятью
Рис. 8.5. Действие процедуры NEW(p)
ство необходимо потому, что дескрипторы - это тоже элементы кучи, и у них нет
своего дескриптора, так как система может полагаться на известную их структуру.
В заключение подчеркнем, что эта схема делает выделение объекта очень эф¬
фективным. Однако она значительно дороже, чем для явно объявленной перемен¬
ной.
Теперь вернемся к проблеме восстановления памяти или сборки мусора. Есть
две существенно различные схемы: подсчет ссылок и просмотр пометок. В первой
каждый объект наделен (скрытым) счетчиком ссылок, указывающим на количест¬
во существующих ссылок.
NEW(p) инициализирует счетчик ссылок р" в 1.
q: = р уменьшает на 1 счетчик ссылок q~, выполняет присваивание, затем увеличивает
на 1 счетчик ссылок р\ Когда счетчик ссылок достигает нуля, элемент вносится
в список свободных.
Есть два недостатка, присущих этому подходу. Первый - немалые накладные
расходы в присваиваниях указателей. Второй - циклические структуры данных
невозможно распознать как свободные, даже при отсутствии внешних ссылок па
их элементы.
Система Оберон для Ceres применяет вторую схему, которая не использует
таких скрытых операций, как в схеме подсчета ссылок, а полагается на процесс,
запускаемый, когда свободной памяти становится недостаточно и нужно больше.
Он состоит из двух фаз. На первой фазе помечаются все элементы, на которые есть
ссылки и которые поэтому все еще доступны. На второй фазе освобождается их
непомеченное дополнение. Первую фазу называют фазой разметки, вторую - фа¬
зой просмотра. Ее главный недостаток - в том, что процесс может быть запущен
в непредсказуемые для пользователя системы моменты. Тогда во время процесса
покажется, что компьютер блокирован. Из этого следует, что интерактивная сис¬
тема, использующая сборку мусора, просмотром пометок должна гарантировать,
что процесс достаточно быстр, чтобы быть едва заметным. Современные процес¬
соры делают это возможным даже при большой основной памяти. Тем не менее
обнаружение всех доступных узлов по всей компьютерной системе в пределах се¬
кунды, кажется, должно быть огромным подвигом.
Понятно, что фаза разметки, по сути, - это обход дерева или, скорее, обход
леса деревьев. Корни деревьев - это все существующие именованные переменные-
указатели. Отложим вопрос о том, как эти корни находятся, и приведем сначала
253
Память: разметка и управление
краткий обзор обхода дерева. Вообще, узлы обходимой структуры могут содер¬
жать много указателей (ветвлений). Однако мы ограничимся сначала двоичным
деревом, потому что таким образом можно лучше объяснить суть проблемы и ее
решение.
Главная проблема сводится к утилизации памяти самим алгоритмом обхода.
Обычно информация об уже пройденных узлах должна сохраняться, будь то явно
или неявно, как при использовании рекурсии. Такая стратегия явно неприемлема,
потому что объем необходимой памяти может стать очень большим и потому что
сборка мусора обычно запускается именно тогда, когда памяти не хватает. Задача
может казаться невыполнимой, тогда как решение заложено в идее инвертировать
указатели вдоль пути обхода, оставляя таким образом открытым путь назад. Она
воплощена в следующей процедуре, задача которой состоит в обходе дерева, за¬
данного параметром root, и пометке каждого узла. Предполагается, что значения
пометок изначально равны 0. Пусть структура данных определяется типами
Ptr = POINTER TO Node;
Node = RECORD m: INTEGER; L, R: Ptr END;
а алгоритм - процедурой
PROCEDURE traverse(root: Ptr);
VAR p, q, r; Ptr;
BEGIN p := root; q := root;
REPEAT (* p tt NIL *) INC(p.m); (^пометить*)
IF p. L tt NIL THEN
r := p.L; p.L := p.R; p.R := q; q := p; p := r
ELSE
p.L := p.R; p.R := q; q:= NIL
END
UNTIL p = q
END traverse
Отметим, что независимо от размера обходимого дерева требуются всего три
локальные переменные. Третья, г - фактически просто вспомогательная перемен¬
ная для выполнения ротации значений p. L, p. R, q и р, как показано на рис. 8.6.
Снимок обхода дерева показан на рис. 8.7.
Пара указателей р, q отмечает позицию процесса. Алгоритм обходит дерево
слева направо, в смысле «прежде - вниз». Когда он возвращается в корень, все
узлы помечены.
Рис. 8.6. Ротация указателей
254
Управление динамической памятью
Рис. 8.7. Обход дерева
Как убедительно подтвердить такие заявления? Лучший способ - проанали¬
зировать алгоритм в произвольном узле. Начнем с гипотезы Я о том, что из за¬
данного начального состояния Р алгоритм достигнет состояния Q (см. рис. 8.8).
Рис. 8.8. Переход из состояния Р
в состояние О
Состояние Q отличается от Р узлом и его уже помеченными потомками В и
С и переставленными р nq. Теперь применим алгоритм к состоянию Р, предпо¬
ложив, что В и С не пусты. Процесс иллюстрируется на рис. 8.9, где РО замещает
Риз рис. 8.7.
Переходы РО —> PI, Р2 —> РЗ и Р4 —> Р5 — прямой результат применения рота¬
ции указателей, заданных в алгоритме последовательностью из пяти присваива¬
ний. Переходы PI -> Р2 и РЗ -> Р4 вытекают из гипотезы Я, примененной к сос¬
тояниям Р1 и РЗ: поддеревья помечены, а р и q переставлены. Отметим попутно,
что узел посещается трижды. Посещения сопровождаются увеличением значения
пометки от 0 до 3.
Рисунок 8.9 показывает, что если Я верна для шагов Р1 -» Р2 и РЗ —»Р4, то она
также верна для шага РО -> Р5, который посещает поддерево р. Следовательно, она
также верна для шага root -> root, который представляет собой обход всего дерева.
Это рекурсивное доказательство основывается на алгоритме, выполняющем
правильные переходы даже в случае p.L = NIL, то есть когда В - пустое дерево.
В этом случае состояние Р1 пропускается; первый переход - это РО —> Р2.
Если p.L - снова NIL, то есть С тоже пустое, то следующий переход - это Р2
Р4. Этим и закончим демонстрацию правильности алгоритма.
Теперь модифицируем алгоритм обхода дерева для случая, когда структура
не ограничивается двоичным деревом, а может быть деревом любой степени, то
есть у каждого узла может быть любое число п потомков. Однако в практических
255
Память: разметка и управление
Рис. 8.9. Переходы от РО к Р5
с троекратным посещением узла
целях мы ограничим п диапазоном 0 < n < N и таким образом можем представить
все узлы типом
Node = RECORD m, n: INTEGER;
dsc: ARRAY N OF Node
END
В принципе, алгоритм обхода двоичного дерева можно принять почти без
изменений, просто расширив вращение указателей с p. L, p. R, q, р до p.dscfO], ...,
p.dsc[n-1], q,p. Однако это было бы слишком неэффективным решением. Следую¬
щий вариант - более эффективный.
PROCEDURE traverse(root: Ptr);
VAR k: INTEGER; p, q, r: Ptr;
BEGIN p := root; q := root;
LOOP (* p it NIL*) k := p.m; INC(p.in); (*пометить*)
IF k < p.n THEN
r := p.dsc[k];
IF r # NIL THEN p.dsc[k] := q; q := p; p := r END
ELSIF p = q THEN EXIT
ELSE k := q.m - 1;
r := q.dsc[k]; q.dsc[k] := p; p := q; q := r
256
Управление динамической памятью
257
END
END
END traverse
Отметим, что значение пометки, начинающееся с (непомеченного) нуля, ис¬
пользуется как счетчик уже посещенных потомков и, следовательно, как индекс
поля потомка, который должен быть обработан следующим. Алгоритм может при¬
меняться не только к деревьям, но и к произвольным структурам, включая цикли¬
ческие, если условие продолжения k < р.п расширить до (k < р.п) & (гж = 0). Оно
приводит к пропуску уже помеченного потомка.
Рис. 8.10. Прямой переход от РО к Р2,
когда p. L = NIL
Сборщик мусора Оберона использует именно такой алгоритм. Пометка вклю¬
чается в скрытый префикс каждой записи. Префикс занимает всего 4 байта; три
используются для тэга или размера, один резервируется для сборщика мусора и
используется как пометка. Из этого следует, что запись не может содержать боль¬
ше 255 указателей. Число п указателей (потомков) в записи содержится в де¬
скрипторе типа записи. (Записи без дескриптора, созданные SYSTEM.NEW, не
должны содержать потомков.)
Дескрипторы типа состоят из следующих полей (исключая префикс):
size размер описываемого типа, в байтах (3 байта)
п число потомков описываемого типа (1 байт)
base таблица указателей на дескрипторы основных (базовых) типов (7 элементов)
offsets смещения указателей потомков в описываемом типе (по 2 байта каждый)
Сами дескрипторы типов имеют префикс, содержащий поле пометки и размер
дескриптора длиной не менее 36 байтов (3 байта для размера, 1 байт для п, 4 для
префикса и 28 для таблицы основных тэгов).
Подчеркнем, что память для дескрипторов типа должна выделяться в куче.
Хотя они - константы, они не могут размещаться среди констант модуля в области
блоков, потому что элементы кучи могут ссылаться на дескриптор типа даже по¬
сле того, как определяющий этот тип модуль был выгружен. Это тот случай, когда
структура, заданная переменной объявленного в модуле М основного типа Г, со¬
держит элементы определенного в модуле М' расширения Т\ и при этом модуль
М'уже выгружен, а Меще нет.
Память: разметка и управление
Рис. 8.11. Записи с дескриптором типа и без него
Фаза просмотра осуществляется относительно простым алгоритмом. Куча, то
есть память между Heap Org и HeapLimit (это переменная), просматривается по¬
элементно, начиная с Heap Org. С помеченных элементов снимается пометка, и не¬
помеченные элементы освобождаются привязкой их к соответствующему списку
доступного пространства.
Поскольку куча всегда может содержать свободные элементы, фаза просмотра
должна уметь распознать их, чтобы пропустить или объединить их со смежным
свободным элементом. С этой целью считается, что свободные элементы тоже
имеют префикс. Префикс служит, чтобы определить размер элемента и распо¬
знать его как свободный по специальному (отрицательному) значению пометки.
Вот возможные значения пометок и предпринимаемые для них действия:
Значение Состояние Действие
пометки
= 0 Непомеченный Собрать, пометить как свободный
> 0 Помеченный Снять пометку
< 0 Свободный Пропустить или объединить
8.4. Ядро
Процессор NS-32000 имеет два разных режима работы - привилегированный
и пользовательский. Первый разрешает, а второй запрещает выполнение опреде¬
ленных специальных команд и доступ к защищенным областям памяти. Так как
мы хотим использовать это средство защиты для определенных таблиц распре¬
деления ресурсов, повреждение которых привело бы к катастрофе, доступ к ним
должен быть привилегированным. Оно может быть введено только привилегиро¬
ванной машинной командой, которая вызывает прерывание. Однако в языке Обе¬
рон нет средств обработки прерываний. Поэтому обработчик прерывание написан
в коде ассемблера, который позволяет выражать привилегированных команды.
Модуль Kernel - это коллекция процедур на ассемблере, выполняемых в привиле¬
гированном режиме.
258 |
Попутно отметим, что только базовые модули могут писаться в коде ассембле¬
ра, потому что ассемблер преднамеренно не допускает спецификаций импортов.
Главное оправдание программированию в коде ассемблера - потребность в эф¬
фективности, достигаемой в основном разумным использованием нескольких
доступных регистров. Эффективность важна прежде всего в листовых процеду¬
рах, то есть процедурах, которые не вызывают других процедур. Поэтому весьма
уместно ограничить использование ассемблера листовыми модулями.
Процедуры ядра могут быть поделены на четыре группы: управление блоками,
управление сегментами (секторами), управление кучей (динамической памятью)
и разное. Кроме того, ядро экспортирует определенные переменные (только для
чтения). Они отражают состояние различных управляющих программ и указыва¬
ют на количество уже выделенной памяти.
MODULE Kernel; (*NW 11.4.86 / 12.4.91*)
TYPE Sector* = RECORD END ;
IntProc* = PROCEDURE;
VAR ModList*: LONGINT;
NofPages*, NofSectors*, allocated*: LONGINT;
StackOrg*, HeapLimit*: LONGINT;
FileRoot*, FontRoot*: LONGINT;
SectNo*: LONGINT;
pc*, sb*, fp*, spO*, sp1*, mod*, eia*: LONGINT; (^состояние в момент прерывания*)
err*, per*: INTEGER;
(* Управление блоками *)
PROCEDURE AllocBlock(VAR dadr, blkadr: LONGINT; size: LONGINT);
PROCEDURE FreeBlock(dadr: LONGINT);
(* Управление кучей - сборщик мусора *)
PROCEDURE GC;
(* Управление сегментами диска *)
PROCEDURE AllocSector(hint: LONGINT; VAR sec: LONGINT);
PROCEDURE MarkSector(sec: LONGINT);
PROCEDURE FreeSector(sec: LONGINT);
PROCEDURE GetSector(src: LONGINT; VAR dest: Sector);
PROCEDURE PutSector(dest: LONGINT; VAR src: Sector);
PROCEDURE ResetDisk;. .
(* Разное*)
PROCEDURE InstallIP(P: IntProc; chan: INTEGER);
PROCEDURE InstallTrap(P: IntProc);
PROCEDURE SetICU(n: CHAR);
PROCEDURE GetClock(VAR time, date: LONGINT);
PROCEDURE SetClock(time, date: LONGINT);
END Kernel.
259
Ядро
Процедуры GetClock и SetClock представляют интерфейс часов реального
времени. Время и дата представляются (длинными) целыми числами следующим
образом:
время = (часы * 64 + минуты) *64 + секунды
дата = (год * 16 + месяц) *32 + день
Команда Watch в модуле System позволяет пользователю проверить коли¬
чество выделенных ресурсов.
260
Память: разметка и управление
PROCEDURE Watch*;
BEGIN
Texts.WriteString(W, "System.Watch"); Texts.WriteLn(W);
Texts.WriteInt(W, Kernel.NofPages, 1); Texts.WriteString(W, " pages, ");
Texts.WriteInt(W, Kernel.NofSectors, 1); Texts.WriteString(W, " sectors, ");
Texts.WriteInt(W, Kernel.allocated, 1); Texts.WriteString(W, " bytes allocated");
Texts.WriteLn(W); Texts.Append(Oberon.Log, W.buf)
END Watch;
9. ДРАЙВЕРЫ УСТРОЙСТВ
9.1 ■ Краткий обзор
Драйверы устройств - это процедуры, которые составляют непосредственный
интерфейс между аппаратными средствами и программным обеспечением. Они
обращаются к тем частям компьютерной техники, которые обычно называют пе¬
риферийным устройством. Компьютеры, как правило, содержат системную шину,
которая передает данные между различными его частями. Процессор и память
считаются его внутренними частями; остальные части - диск, клавиатура, дис¬
плей и т. д. - считаются внешними, или периферийными, устройствами, несмотря
на то что они зачастую находятся в том же корпусе.
Такие периферийные устройства подключаются к системной шине через спе¬
циальные регистры (буферы данных) и приемопередатчики (переключатели, бу¬
феры в смысле цифровой электроники). Эти регистры и приемопередатчики адре¬
суются процессором так же, как участки памяти, - говорят, что они отображены
в памяти, - и образуют аппаратный интерфейс между шиной процессора и устрой¬
ством. Обращения к ним обычно ограничиваются определенными процедурами
драйверов, которые образуют программный интерфейс.
Драйверы, безусловно, аппаратно зависимы и оправдывают свое существова¬
ние именно тем, что скрывают эту зависимость и предоставляют своим клиентам
подходящую абстракцию устройства. Очевидно, что эта абстракция должна все
еще отражать основные характеристики устройства, но не его детали (например,
адреса регистров его интерфейса).
С одной стороны, наше намерение подробно представить драйверы, связываю¬
щие систему Оберон с компьютером Ceres, - это стремление к полноте. Но, с другой
стороны, это и выяснение того факта, что их разработка представляет существен¬
ную часть инженерной задачи по созданию системы. Эта часть может выглядеть
тривиальной с концептуальной точки зрения; на практике это, конечно, не так.
Чтобы сократить количество типов интерфейсов, были установлены стандар¬
ты. Компьютер Ceres тоже использует такие стандарты интерфейса, и мы сосредо¬
точимся на них в следующих разделах. Будут рассмотрены следующие устройства:
1. Клавиатура. Она считается последовательным устройством, поставляю¬
щим один байт входных данных за одно нажатие клавиши. Она соединя¬
ется последовательным каналом согласно стандартам RS-232 и ASCII
(American Standard Code for Information Interchange). Программное обес¬
печение содержится в модуле Input (раздел 9.2).
©N. Wirth, 14.4.91/11.11.91
262
Драйверы устройств
2. Мышь. Мышь Ceres - это указывающее устройство, предоставляющее коор¬
динаты вместе с состояниями трех кнопок. Для Ceres-1 и Ceres-2 интерфейс
нестандартный; для Ceres-З используется последовательная передача, осно¬
ванная на стандарте RS-232. Программное обеспечение - часть модуля Input.
3. Дисплей. Интерфейс дисплея - это область памяти, которая содержит ото¬
бражаемую информацию, один бит на пиксель для монохромного и четыре
бита на пиксель для цветного дисплея. Размер по умолчанию - 800 строк и
1024 точки в строке. Программное обеспечение - модуль Display, который
состоит главным образом из операций рисования часто встречающихся
шаблонов, так называемых растровых операций (см. главу 4).
4. Диск. Дисковый интерфейс Ceres-1 и Ceres-2 нестандартный и не будет
описываться. Драйвер содержится в модуле Kernel. Ceres-3 работает без
диска, но дополнительный жесткий диск может быть подключен через
стандартный интерфейс SCSI, описанный в разделе 9.4.
5. Дискета. Дискеты в 3,5 дюйма используют тот же нестандартный интер¬
фейс, что и жесткий диск. Программное обеспечение - модуль Diskette.
Этот интерфейс в книге не описывается.
6. Последовательный канал. Это стандартный последовательный интерфейс
RS-232, позволяющий компьютерам устанавливать соединения между со¬
бой и сообщаться по телефонным линиям через модемы. Программный
интерфейс - модуль V24, описанный в разделе 9.2. Скорость передачи до¬
стигает 19,2 Кбит/сек.
7. Сеть. Компьютеры Ceres могут быть связаны локальной сетью с примене¬
нием стандарта RS-485. Он работает со скоростью передачи 230 Кбит/сек.,
а информация пересылается пакетами до 512 байтов в стандартном форма¬
те протокола SDLC. Программный интерфейс - модуль SCC, описанный
в разделе 9.3; аппаратный интерфейс - компонент под названием контрол¬
лер последовательной связи (Serial Communications Controller, SCC).
8. Часы реального времени. В компьютеры Ceres входят часы, обеспечи¬
вающие время и дату, которые служат для записи времени и даты создания
файлов. Их, едва ли интересный, нестандартный интерфейс содержится
в модуле Kernel.
Во всех описанных ниже модулях драйверов процедуры SYSTEM.PUT, SYS¬
TEM.GET и SYSTEM.BIT используются для обращения к регистрам интерфейса
устройств. Их первый параметр - (длинное) целое число, задающее адрес регистра.
9.2. RS-232:
ASCII-стандарт для клавиатуры
и последовательного канала
Все модели компьютера Ceres оборудованы компонентом, названным уни¬
версальным асинхронным приемником и передатчиком (Universal Asynchronous
Receiver and Transmitter, UART). У него есть 8-битное параллельное подключе¬
RS-232: ASCII-стандарт для клавиатуры и последовательного канала
ние к системной шине и два внешних подключения, одно для передатчика и одно
для приемника, обеспечивающих дуплексную линию передачи. LJART выполняет
линеаризацию 8 битов при посылке и делинеаризацию при получении. 8 битов
образуют короткий пакет, называемый также кадром, и дополняются стартовым
битом (всегда 1). Между последовательными пакетами нет фиксированного ин¬
тервала времени. Поэтому передачу называют асинхронной. Однако в пределах
пакета существует фиксированная частота, и передача синхронна. Поэтому такто¬
вые частоты передатчика и приемника должны быть одинаковыми. Стартовый бит
используется для запуска тактового генератора сдвигов приемника. Существует
также минимальный гарантированный интервал времени между последним битом
пакета и стартовым битом следующего пакета. Он измеряется в тактах передачи
одного бита, и поэтому можно говорить о числе «стоп-битов», заполняющих этот
интервал. Наконец, пакет может быть дополнен битом четности. Формат такого
пакета показан на рис. 9.1.
Рис. 9.1. Пакет символа ASCII
Компьютер Ceres использует UART Signetics 2692, который содержит два
(почти) независимых линейных интерфейса, называемых каналами А и В. Он так¬
же позволяет выбирать некоторые параметры, такие как скорость передачи, число
битов данных, стой-битов и тип контроля четности (нет, чёт, нечет). Выбранные
значения сохраняются в регистрах параметров UART. Самые главные регистры -
это регистр данных и регистр состояния.
Посылая байт, процессор должен ждать, пока UART будет готов. Состояние
готовности подтверждается вторым битом регистра состояния. Затем байт данных
загружается в регистр данных, автоматически запуская, таким образом, передачу.
Для приема байта можно использовать аналогичную схему. Однако это, воз¬
можно, породило бы нежелательные временные ограничения и зависимости.
Мы должны рассматривать акт приема байта как часть акта передачи, то есть как
действие, тесно связанное с посылкой байта. Посылка и получение должны вы¬
полняться в одно и то же время. Сам UART обеспечивает некоторое разделение че¬
рез свои буферы данных. Однако они содержат только один байт (или небольшое
их количество), и крайне желательно достичь большего разделения.
Это возможно за счет больших буферов данных - обычно на стороне приемни¬
ка - и разрешения основному процессору передавать байт в этот буфер, как только
он получен. Это требует, чтобы процессор был занят на короткое мгновение, кото¬
рое достигается за счет его прерывания. В этом случае постоянный опрос состоя¬
ния UART при вводе не нужен.
Для клавиатуры (только ввод) в UART используется канал А. Он управляется
модулем Input, чей интерфейс приводится ниже.
263
264
Драйверы устройств
DEFINITION Input;
PROCEDURE Available(): INTEGER;
PROCEDURE Read(VAR ch: CHAR);
PROCEDURE Mouse(VAR keys: SET; VAR x, y: INTEGER);
PROCEDURE SetMouseLimits(w, h: INTEGER);
PROCEDURE Time(): LONGINT;
END Input.
Процедура-функция Available дает число символов, набранных в буфере вво¬
да. Если его значение больше нуля, Read предоставляет следующий символ (байт)
из буфера входного потока. Если символов нет, Read предполагает задержку, пока
символ не будет получен.
Модуль Input содержит также интерфейс мыши (указывающего устройства).
Аппаратные средства содержат два счетчика, один для движения по направлению
X, другой - по направлению Y. Процедура Mouse предоставляет значения этих
счетчиков и состояние трех кнопок (клавиш). Последнее представляется элемен¬
тами множества: 0 - для правой кнопки, 1 - для средней и 2 - для левой. SetMouse-
Limits позволяет задавать предельные значения координат прямоугольника, внут¬
ри которого отображается позиция мыши и рисуется курсор. Позиция допускает
«перенос» и в горизонтальном, и в вертикальном направлениях. Изменение преде¬
лов полезно, когда несколько дисплеев установлены в ряд и считаются лежащими
в одной плоскости рисунка.
Компонент UART содержит также дополнительный счетчик (это действитель¬
но многоцелевой чип), который увеличивается каждые 1/300 секунды и может
служить для измерения прошедшего времени. Значение этого счетчика предостав¬
ляется процедурой Time.
MODULE Input; (*NW 5.10.86 / 15.11.90 Ceres-2*)
IMPORT SYSTEM, Kernel;
CONST N = 32;
MOUSE = 0FFFFB000H; UART - 0FFFFC000H; ICU = 0FFFF9000H;
VAR MW, MH: INTEGER; (*границы для мыши*)
T: LONGINT; (*счетчик времени*)
n, in, out: INTEGER;
buf: ARRAY N OF CHAR;
PROCEDURE Available*(): INTEGER;
BEGIN RETURN n
END Available;
PROCEDURE Read*(VAR ch: CHAR);
BEGIN
REPEAT UNTIL n > 0;
DEC(n); ch := buf[out]; out := (out+1) MOD N
END Read;
PROCEDURE Mouse*(VAR keys: SET; VAR x, y: INTEGER);
VAR u: LONGINT;
BEGIN SYSTEM.GET(MOUSE, u);
keys := {0,1,2} - SYSTEM.VAL(SET, u DIV 1000H MOD 8);
x := SHORT(u MOD 1000H) MOD MW;
у := SHORT(u DIV 10000H) MOD 819;
IF у >= MH THEN у := 0 END
END Mouse;
PROCEDURE SetMouseLimits*(w, h: INTEGER);
BEGIN MW := w; MH := h
END SetMouseLimits;
PROCEDURE Time*(): LONGINT;
VAR lo, lo1, hi: CHAR; t: LONGINT;
BEGIN
REPEAT SYSTEM.GET(UART+28, lo); SYSTEM.GET(UART+24, hi);
t := T - LONG(ORD(hi))*256 - ORD(lo); SYSTEM.GET(UART+28, lo1)
UNTIL lo1 = lo;
RETURN t
END Time;
PROCEDURE+ KBINT;
VAR ch: CHAR;
BEGIN SYSTEM.GET(UART+12, ch); (*RHRA*)
IF ch = OFFX THEN HALT(24) END ;
IF n < N THEN buf[in] := ch; in := (in+1) MOD N; INC(n) END
END KBINT;
PROCEDURE+ CTInt;
VAR dmy: CHAR;
BEGIN SYSTEM.GET(UART+60, dmy); (‘остановить таймер*)
INC(T, OFFFFH); SYSTEM.GET(UART+56, dmy) (‘перезапустить таймер*)
END CTInt;
BEGIN MW := 1024; MH := 800;
n := 0; in := 0; out := 0; T := OFFFFH;
Kernel.InstallIP(KBINT, 4); Kernel.InstallIP(CTInt, 0);
SYSTEM.PUT(UART+16, 10X); (*ACR*)
SYSTEM.PUT(UART+ 8, 15X); (*CRA доступен*)
SYSTEM.PUT(UART, 13X); (*MR1A, RxRdy -Int, без контроля четности, 8 бит*)
SYSTEM.PUT(UART, 7X); (*MR2A 1 стоп-бит*)
SYSTEM.PUT(UART+ 4, 44X); (*CSRA, скорость = 300 бит/сек*)
SYSTEM.PUT(UART+52, 14X); (*0PCR 0P4 = KB и ОРЗ = C/T int*)
SYSTEM.PUT(UART+28, OFFX); (*CTLR*)
SYSTEM.PUT(UART+24, OFFX); (*CTUR*)
SYSTEM.GET(UART+56, buf[0]); (*запустить таймер*)
SYSTEM.PUT(ICU + 4, 18X); (*очистить ICU биты 0 IMR и IRR*)
SYSTEM.PUT(ICU + 4, 1CX); (*очистить ICU биты 4 IMR и IRR*)
END Input.
265
RS-232: ASCII-стандарт для клавиатуры и последовательного канала
266
Драйверы устройств
Некоторые комментарии:
1. То, что многие свойства UART могут быть параметризованы, приводит к бо¬
лее длинной последовательности инициализации. Мы воздерживаемся от
объяснения всех подробностей Signetics 2692 и отсылаем к соответствую¬
щим спецификациям устройства. Здесь достаточно сказать, что RS-232 ис¬
пользует для клавиатуры скорость 300 бит/сек., 8 битов без проверки чет¬
ности и 1 стоп-бит.
2. Обработчик прерываний объявлен в Обероне как процедура без пара¬
метров, помеченная знаком плюс. Обработчик прерываний клавиатуры
KBINT получает один символ. Если это символ аварийного завершения
(Cntl-Shift-Delete), то вызов HALT(24) обеспечит прерывание. Это позво¬
ляет оператору прервать вычисление, если оно оказалось бесконечным.
3. Буфер клавиатуры спроектирован как циклический буфер. Когда он полон,
входящие символы игнорируются (кроме аварийного завершения).
4. Значение 16-разрядного таймера (счетчика) UART можно получить за два
шага, читая старшую и младшую его половины соответственно. 32-раз-
рядное расширение обеспечивается в виде переменной Т, увеличивающей¬
ся на 216 при каждом прерывании по таймеру, которое возникает, когда
счетчик UART t достиг нуля. Так как счетчик UART уменьшается каждые
1/300 сек., предоставляемое процедурой Time значение вычисляется как
T-t.
5. Перед активацией канала прерывания должны быть выполнены три усло¬
вия:
• Должно быть разрешено прерывание процессора. Это обычно.
• Должен быть включен механизм прерывания устройства.
• Прохождение соответствующего сигнала прерывания должно быть раз¬
решено блоком управления прерываниями (ICU, Interrupt Control Unit),
расположенным между устройствами и процессором.
Третье условие устанавливается последними двумя операторами последо¬
вательности инициализации модуля: одна команда необходима для преры¬
вания клавиатуры, другая - для прерывания таймера.
6. Значения счетчиков мыши служат координатами для курсора, отображаемо¬
го на экране. Поэтому они ограничены диапазонами 0 < х < MW и 0 < у < МН.
Предельные значения могут быть установлены процедурой SetMouseLimits
согласно размерам (разрешению) имеющегося дисплея.
Канал В UART ведет к внешнему контакту RS-232(V24). Этот последователь¬
ный канал не используется системой Оберон и, следовательно, полностью предо¬
ставлен пользователю. Его программный интерфейс - модуль V24.
DEFINITION V24;
IMPORT SYSTEM;
PROCEDURE Start(CSR, MR1, MR2: CHAR);
PROCEDURE SetOP(s: SET);
PROCEDURE ClearOP(s: SET);
PROCEDURE IP(n: INTEGER): BOOLEAN;
PROCEDURE SR(n: INTEGER): BOOLEAN;
PROCEDURE Available(): INTEGER;
PROCEDURE Receive(VAR x: SYSTEM.BYTE);
PROCEDURE Send(x: SYSTEM.BYTE);
PROCEDURE Break;
PROCEDURE Stop;
END V24.
Приемник и передатчик канала запускаются вызовом процедуры Start. У нее
три параметра, значения которых задают тактовую частоту передачи режима чет¬
ности, число битов в байте и число стоп-битов. Процедура Available обозначает
число байтов, допускаемых (принимаемых) буфером ввода. Receive предоставля¬
ет следующий байт последовательности, a Send отправляет заданный параметром
байт. SR дает значение заданного бита в регистре состояния, a Stop служит для
выключения и передатчика, и приемника.
Двойственная природа расширенного многоцелевого UART в Signetics 2692
становится здесь очевидной: в дополнение к двум каналам и счетчику/таймеру
он содержит также регистры ввода и вывода (7 и 8 битов соответственно) с внеш¬
ними контактами (штырьками). На компьютере Ceres эти сигналы используются
по-разному и не должны использоваться программистом, за исключением сле¬
дующих:
ввод: 0
DCD (Data Carrier Detected)
обнаружен носитель данных
1
CTS (Clear To Send)
сброс передачи
2
DSR (Data Set Ready)
данные готовы
вывод: 0
DTR (Data Terminal Ready)
оконечное устройство ввода данных готово
1
RTS (Request To Send)
запрос передачи
Значение этих битов исходит из их применения в модемах. Процедуры SetOP
и ClearOP служат для установки и очистки тех битов регистра вывода UART (ОР),
которые заданы в их параметре установки. Процедура-функция IP служит для
проверки заданного бита в регистре ввода UART (IP). И наконец, процедура Break
служит для применения сигнала прерывания (значение 0 в течение по меньшей
мере 20 мсек.) к последовательному каналу. В следующей таблице приводятся ос¬
новные регистры UART.
RHRA/B
Регистр временного хранения
(приемник)
Принятые данные
THRA/B
Регистр временного хранения
(передатчик)
Передаваемые данные
MR1A/B
Регистр режима 1
Rx-контроль, режим четности и тип,
число бит в байте
MR2A/B
Регистр режима 2
Режим канала, управление Тх-контроль,
длина стоп-бита
CRA/B
Регистр команд
pS-232: ASCII-стандарт для клавиатуры и последовательного канала
267
268
Драйверы устройств
CSRA/B
Регистр часов
Тактовые частоты приемника
и передатчика
SRA/B
Регистр состояния
RxRdy, TxRdy; переполнение, четность,
ошибки кадровой синхронизации
OPCR
Регистр конфигурации выходного порта
IPCR
Регистр изменения входного порта
ISR
Регистр состояния прерывания
IMR
Регистр маски прерываний
CTUR
Значение старшего байта
счетчика/таймера
CTLR
Значение младшего байта
счетчика/таймера
MODULE V24; (*NW 18.3.89 / 19.1.91*)
(‘управляемый прерываниями канал В UART*)
IMPORT SYSTEM, Kernel;
CONST BufLen = 512;
UART = 0FFFFC000H; ICU = 0FFFF9000H;
VAR in, out: INTEGER;
buf: ARRAY BufLen OF SYSTEM.BYTE;
PROCEDURE+ Int;
BEGIN SYSTEM.GET(UART+44, buf[in]); in := (in+1) MOD BufLen
END Int;
PROCEDURE Start*(CSR, MR1, MR2: CHAR);
BEGIN in := 0; out := 0;
Kernel.InstallIP(Int, 2);
SYSTEM.PUT(UART+40, 30X); (*CRB сброс передатчика*)
SYSTEM.PUT(UART+40, 20X); (*CRB сброс приемника*)
SYSTEM.PUT(UART+36, CSR); (*CSRB тактовая частота*)
SYSTEM.PUT(UART+40, 15X); (*CRB разрешены Tx и Rx, указатель на MR1 *)
SYSTEM.PUT(UART+32, MR1); (*MR1B, четность, число битов в байте*)
SYSTEM.PUT(UART+32, MR2); (*MR2B стоп-бит*)
SYSTEM.PUT(UART+20, 20X); (*IMR RxRdy Int разрешен*)
SYSTEM.PUT(ICU + 4, 1AX); (*ICU IMR и IRR бит 2*)
END Start;
PROCEDURE SetOP*(s: SET);
BEGIN SYSTEM.PUT(UART+56, s)
END SetOP;
PROCEDURE ClearOP*(s: SET); BEGIN SYSTEM.PUT(UART+60, s)
END ClearOP;
PROCEDURE IP*(n: INTEGER): BOOLEAN; BEGIN RETURN SYSTEM.BIT(UART+52, n)
END IP;
PROCEDURE SR*(n: INTEGER): BOOLEAN; BEGIN RETURN SYSTEM.BIT(UART+36, n)
END SR;
PROCEDURE Available*(): INTEGER; BEGIN RETURN (in - out) MOD BufLen
END Available;
PROCEDURE Receive*(VAR x: SYSTEM.BYTE);
BEGIN
REPEAT UNTIL in # out;
x := buf[out]; out := (out+1) MOD BufLen
END Receive;
PROCEDURE Send*(x: SYSTEM.BYTE);
BEGIN
REPEAT UNTIL SYSTEM.BIT(UART+36, 2);
SYSTEM.PUT(UART+44, x)
END Send;
PROCEDURE Break*;
VAR i: LONGINT;
BEGIN
SYSTEM.PUT(UART+40, 60X); i := 500000;
REPEAT DEC(i) UNTIL i = 0;
SYSTEM.PUT(UART+40, 70X)
END Break;
PROCEDURE Stop*;
BEGIN SYSTEM.PUT(UART+20, 0); (*IMR запрет Rx-npep.*)
SYSTEM.PUT(ICU + 4, 3AX) (*ICU канал 2*)
END Stop;
END V24.
9.3. RS-485: SDLC-стандарт для сети
Система Оберон для Ceres позволяет также сетевые соединения. Основные
различия между сетевым соединением и каналом RS-232 - это шины с мно¬
жественными ветвлениями вместо двухточечной линии и синхронная передача
вместо асинхронной. Если желательны скорости передачи свыше 20 Кбит/сек.,
описанная в предыдущем разделе асинхронная передача неэкономична, потому
что между передачами последовательных байтов слишком много времени тратит¬
ся впустую. Синхронная передача повышает производительность, и это использу¬
ется компьютерами Ceres для взаимодействия в локальной сети.
Строго говоря, разница между так называемыми асинхронной и синхронной
передачами заключается только в длине пакета, потому что первая тоже использу¬
ет синхронность при передаче каждого байта. Цена более длинных пакетов - это
RS-485: SDLC-стандарт для сети
269]
Драйверы устройств
необходимость в более точных тактовых импульсах; точность тактового импульса
ограничивает длину пакета, если не применяется некоторая схема кодирования
для передачи тактового импульса вместе с данными. RS-485 и стандарты SDLC
не определяют такого кодирования; тактовый импульс не передается. Здесь он за¬
фиксирован на 230 Кбит/сек., выдавая примерно 30 Кбайт/сек.
Отсюда прямо следует, что вычисление последовательности байтов и переда¬
ча пакета не могут чередоваться из-за строгих ограничений синхронизации. Так
как один байт должен передаваться каждые 30 нсек., данные всего пакета должны
быть подготовлены до начала передачи.
Стандартный протокол SDLC (Synchronous Data Link Control, синхронное
управление передачей данных) фиксирует формат пакета переменной длины.
Роль стартового бита выполняет начальный байт, так называемый флаг. За ним
следуют байты данных, а весь пакет заканчивается другим флагом. Флаг состо¬
ит из 6 последовательных единиц. Следовательно, 6 последовательных единиц не
должны встречаться внутри раздела данных. Эта проблема решается передатчи¬
ком, автоматически вставляющим, и приемником, удаляющим нулевой бит после
каждого появления пяти последовательных единиц. Если вслед за пятью едини¬
цами идет ненулевой бит, флаг принят. Такая вставка (и удаление) нуля, как и
установка флагов до и после данных, выполняется автоматически компонентом
аппаратного интерфейса SCC (Zilog 8530).
Для обнаружения ошибок передачи передатчик вычисляет но данным цикли¬
ческий код избыточности (CRC, Cyclic Redundancy Code) и добавляет его к це¬
почке данных прямо перед концевым флагом. Приемник тоже вычисляет этот код
и сравнивает его с полученным. Если они различны, устанавливается бит состоя¬
ния, который должен проверяться для каждого принимаемого пакета.
Стандарт SDLC требует также, чтобы первый байт пакета - вслед за фла¬
гом - задавал адрес приемника. Это необходимо, потому что в сети получатель не
определяется автоматически, как при двухточечном соединении. Поэтому каждая
станция получает уникальную идентификацию. Кроме того, мы определили не¬
которые дополнительные свойства пакетов. Каждый пакет состоит из заголовка,
сопровождаемого данными. Первые 9 байтов образуют заголовок, первый из кото¬
рых - адрес получателя, второй - адрес отправителя, а третий - тип пакета. Сле¬
дом идут два байта, задающие длину пакета (в байтах). Остальные четыре байта
в настоящее время не используются. Этот формат пакета показан на рис. 9.2 и
отражен в типе данных Header.
Рис. 9.2. Формат пакета Ceres-net
270
RS-485: SDLC-стандарт для сети
271
DEFINITION SCC;
TYPE Header =
RECORD valid: BOOLEAN; dadr, sadr, typ: SHORTINT;
len: INTEGER; (* длина данных вслед за заголовком*)
destLink, srcLink: INTEGER (*не используются*)
END ;
PROCEDURE Start(filter: BOOLEAN);
PROCEDURE Send(VAR head: Header; VAR buf: ARRAY OF SYSTEM.BYTE);
PROCEDURE AvailableO: INTEGER;
PROCEDURE ReceiveHead(VAR head: Header);
PROCEDURE Receive(VAR x: SYSTEM.BYTE);
PROCEDURE Skip(m: INTEGER);
PROCEDURE Stop;
END SCC.
Как в случае интерфейса V24, приемник буферизует входящий поток данных
(без флагов и CRC). Процедура Receive выбирает последовательные байты от бу¬
фера. Число байтов в буфере дает процедура Available. Задача приема упрощается
процедурой ReceiveHead. Она вызывается, когда ожидается очередной пакет. Поле
valid имеет значение «пакет принят, и его заголовок правильный».
Передатчик и приемник могут включаться и выключаться вызовами проце¬
дур Start и Stop. Первая имеет логический параметр filter со значением «отклонять
пакеты, адресованные не этой станции». Схема интерфейса способна сравнивать
первый байт заголовка (адрес назначения) с собственным адресом станции (хра¬
нимым в регистре) и отказываться от пакета при несовпадении. Конечно, актив¬
ный фильтр - это обычный режим работы, потому что в таком режиме отклонен¬
ные пакеты не требуют взаимодействия с процессором компьютера.
Программа SCC-драйвера, понятно, обладает доступом к регистрам устройст¬
ва. Главная функция этих регистров приведена в таблице ниже; за остальными
подробностями отсылаем к техническим спецификациям контроллера. Достаточ¬
но сказать, что к регистрам (кроме регистра данных) обращаются в два шага. Сна¬
чала в управляющий порт посылается номер регистра, после чего передается его
значение. (Номер регистра и значение мультиплексированы по времени; см. про¬
цедуру PUT). Ниже дается краткий обзор доступных регистров устройства:
Регистры записи
0 Регистр команд
1 Прерывание приема/передачи и определение режима передачи данных
2 Вектор прерываний
3 Параметры и контроль приема
4 Различные параметры и режимы приема/передачи
5 Параметры и контроль передачи
6 Символы синхронизации или поле адреса SDLC (фильтр)
7 Признак синхронизации или флаг SDLC
Драйверы устройств
8 Буфер передачи (данных)
9 Управление главным прерыванием
10 Различные контрольные биты приемника/передатчика
11 Контроль режима тактового импульса
12 Константа времени генератора скорости в бодах (младший байт)
13 Константа времени генератора скорости в бодах (старший байт)
14 Различные контрольные биты
15 Управление внешними/штатными прерываниями
Регистры чтения
0 Состояние буфера передачи/приема
1 Регистр состояния (ошибки, конец кадра)
2 Вектор прерываний
3 Задержки прерываний
8 Буфер принятых данных
10 Биты состояния
MODULE SCC; (*NW 13.11.87 / 22.8.90 Ceres-2*)
IMPORT SYSTEM, Kernel;
CONST BufLen = 2048;
com = 0FFFFD008H; (*команды и состояния, SCC канал A*)
dat = 0FFFFD00CH;
DIPS = 0FFFFFC00H;
ICU = 0FFFF9004H;
RxCA = 0; (*R0: Rx разрешить симв.*)
ТхВЕ = 2; (*R0: Tx Буфер пуст*)
Hunt = 4; (*RO: Синхронизация/Слежение*)
TxUR = 6; (*R0: Tx Недобор*)
RxOR = 5; (*R1: Rx Перебор*)
CRC = 6; (*R1: ошибка CRC*)
EOF = 7; (*R1: Конец блока (End Of Frame)*)
TYPE Header* =
RECORD valid*: BOOLEAN;
dadr*, sadr*, typ*: SHORTINT;
len*: INTEGER; (*длина данных после заголовка*)
destLink*, srcLink*: INTEGER (*номера связей*)
END;
VAR in, out: INTEGER;
Adr: SHORTINT;
SCCR3: CHAR;
buf: ARRAY BufLen OF CHAR;
PROCEDURE PUT (r: SHORTINT; x: SYSTEM.BYTE);
BEGIN SYSTEM.PUT(com, r); SYSTEM.PUT(com, x)
END PUT;
272
RS-485: SDLC-стандарт для сети
273
PROCEDURE+ Inti;
VAR del, oldin: INTEGER; stat: SET; dmy: CHAR;
BEGIN SYSTEM.GET(dat, buf[in]);
PUT(1, OX); («запретить прерывания*)
oldin := in; in := (in + 1) MOD BufLen; del := 16;
LOOP
IF SYSTEM.BIT(com, RxCA) THEN del := 16;
IF in # out THEN SYSTEM.GET(dat, buf[in]); in := (in + 1) MOD BufLen
ELSE SYSTEM.GET(dat, dmy)
END
ELSE SYSTEM.PUT(com, 1X); DEC(del);
IF SYSTEM.BIT(com, EOF) & (del <= 0) OR (del <= - 16) THEN EXIT END
END
END;
SYSTEM.PUT(com, IX); SYSTEM.GET(com, stat);
IF (RxOR IN stat) OR (CRC IN stat) OR (in = out) THEN
in := oldin (*сбросить буфер*)
ELSE in := (in - 2) MOD BufLen («снять CRC*)
END;
SYSTEM.PUT(com, 30X); (*сбросить ошибку*)
SYSTEM.PUT(com, 10X); (*сбросить внеш./штат.прерывания*)
PUT(1, 8Х); (*разрешить Rx-npep. на 1-м символе*)
SYSTEM.PUT(com, 20Х); (*разрешить Rx-npep. на след, символе*)
PUT(3, SCCR3); (*ввести режим слежения*)
END Int1;
PROCEDURE Start* (filter: BOOLEAN);
BEGIN in := 0; out := 0;
IF filter THEN SCCR3 := ODDX ELSE SCCR3 := 0D9X END;
SYSTEM.GET(DIPS, Adr); Adr := Adr MOD 40H;
Kernel.InstallIP(Int1, 1);
PUT(9, 80X); (*сбросить А, запретить все прерывания*)
PUT(4, 20X); (*режим SDLC*)
PUT(1, OX); (*запретить все прерывания*)
PUT(2, OX); (*вектор прерываний*)
PUT(3, SCCR3); («8 бит, режим слежения, вкл. Rx-CRC, найти адрес, выкл. Rx*)
PUT(5, 0Е1Х); (*8 бит, SDLC, вкл. Tx-CRC, выкл. Тх*)
PUT(6, Adr); (*адрес SDLC*)
PUT(7, 7ЕХ); (*флаг SDLC*)
PUT(9, 6X); («вкл. главное прерывание без вектора*)
PUT(10, ОЕОХ); (*FM0*)
PUT(11, 0F7X); («Xtal, RxC = DPLL TxC = скорость reHL*)
PUT(12, 6X); (*младш. байт скорости ген.: Xtal DIV 16*)
PUT(13, OX); («старш.байт скорости ген.*)
PUT(14, ОАОХ); (*DPLL = Xtal*)
PUT(14, OCOX); (*режим FM*)
PUT(3, SCCR3); («разрешить,Rx ввести режим слежения*)
SYSTEM.PUT(com, 80X); (*сбросить TxCRC*)
PUT(15, OX); (*маска внеш. прерываний*)
274
Драйверы устройств
SYSTEM. PUKcom, 10X);
SYSTEM.PUT(com, 10X); («сбросить внеш./штат.*)
PUT(1, OX); («вкл. Rx-npep. выкл. 1-й симв.*)
PUT(9, ОЕХ); («не сбрасывать А, разрешить прер., запретить daisy-цепочки*)
PUT(1, 8Х); («разрешить Rx прер.*)
PUT(14, 21Х); (*ввести режим поиска*)
SYSTEM.PUT(ICU, 19Х); («сбросить биты IRR и IMR, канал 1«)
END Start;
PROCEDURE SendPacket* (VAR head, buf: ARRAY OF SYSTEM.BYTE);
VAR i, len: INTEGER;
BEGIN head[2] := Adr;
len := 0RD(head[5]) * 100H + 0RD(head[4]);
LOOP (*выбрать линию*) i := 60;
REPEAT DEC(i) UNTIL SYSTEM.BIT(com, Hunt) OR (i = 0);
IF i > 0 THEN (*линия свободна*) EXIT END;
i := LONG(Adr) * 128 + 800; (*delay*)
REPEAT DEC(i) UNTIL i = 0
END;
Kernel.SetICU(0A2X); (*запретить прерывания!*)
PUT(5, 63X); (* RTS, послать 1-e*)
PUT(5, 6BX); (* RTS, разрешить Tx*)
SYSTEM.PUT(com, 80X); («сбросить Tx-CRC*)
SYSTEM.PUT(dat, 0RD(head[1])); (*послать назначение*)
SYSTEM.PUT(com, OCOX); (*сбросить недобор/флаг E0M«)
REPEAT UNTIL SYSTEM. BIT(conn, TxBE);
i := 2;
REPEAT SYSTEM.PUT(dat, head[i]); INC(i);
REPEAT UNTIL SYSTEM.BIT(com, TxBE)
UNTIL i = 10;
i := 0;
WHILE i < len DO
SYSTEM.PUT(dat, buf[i]); INC(i); («послать данные*)
REPEAT UNTIL SYSTEM.BIT(com, TxBE)
END;
REPEAT UNTIL SYSTEM.BIT(com, TxUR) & SYSTEM.BIT(com, TxBE);
PUT(5, 63X); («RTS, запретить Tx, послать 1-e«)
i := 300;
REPEAT DEC(i) UNTIL i = 0;
PUT(5, 0E1X); (*~RTS*)
PUT(1, 8X); (*разрешить Rx-Int на 1-м симв.*)
PUT(14, 21X); («ввести режим поиска*)
SYSTEM.PUT(com, 20Х); («разрешить Rx-Int на след, симв.*)
PUT(3, SCCR3); («ввести режим слежения*)
SYSTEM.PUT(ICU, 0А1Х) (*разрешить прерывания*)
END SendPacket;
PROCEDURE Available* (): INTEGER;
BEGIN RETURN (in - out) MOD BufLen
RS-485: SDLC-стандарт для сети
275
END Available;
PROCEDURE Receive* (VAR x: SYSTEM.BYTE);
BEGIN
REPEAT UNTIL in # out;
x := buf[out3; out := (out + 1) MOD BufLen
END Receive;
PROCEDURE ReceiveHead* (VAR head: ARRAY OF SYSTEM.BYTE);
VAR i: INTEGER;
BEGIN
IF (in - out) MOD BufLen >= 9 THEN head[0] := 1; i := 1;
REPEAT Receive(head[i]); INC(i) UNTIL i = 10
ELSE head[0] := 0
END
END ReceiveHead;
PROCEDURE Skip* (m: INTEGER);
BEGIN
IF m <= (in - out) MOD BufLen THEN out := (out + m) MOD BufLen ELSE out := in END
END Skip;
PROCEDURE Stop*;
BEGIN PUT(9, 80X); (*сбросить SCCA*)
SYSTEM.PUT(ICU, 39X); SYSTEM.PUT(ICU, 59X); (*сбросить IMR и IRR*)
END Stop;
BEGIN Start(TRUE)
END SCC.
Некоторые комментарии вслед:
1. Последовательность инициализации отдельных регистров существенна
для правильного функционирования. Недостатки их спецификации по
части документации были источником серьезных трудностей и головных
болей.
2. Некоторые части драйвера критичны по времени (особенно для Ceres-1).
Например, после получения прерывания первый байт должен быть прочи¬
тан немедленно. Очередь из 3 байтов в аппаратуре приемника предостав¬
ляет достаточно времени, чтобы отключить прерывания, сохранить байт и
скопировать индекс буфера (oldin), который используется как точка отката
в случае ошибки передачи.
3. Перед отправкой пакета нужно убедиться, что канал свободен, проверив
так называемый бит слежения. Если канал занят, он опрашивается снова
после задержки. На задержку влияет адрес станции, вынуждая все станции
иметь слегка различные задержки. Фактические коллизии могут быть об¬
наружены только приемником при проверке CRC в конце пакета.
4. После передачи последнего байта данных канал должен оставаться заня¬
тым - для передачи CRC и флага и для остановки приемника (стоп-биты!).
Это время занимает порядка 200 не, что гораздо меньше частоты таймера
и, следовательно, должно программироваться как плотный (напряженный)
цикл задержки. Константа задержки зависит от тактовой частоты компью¬
тера и модели. И это очень прискорбно.
5. Конец пакета обозначается битом EOF в регистре состояния SCC. К со¬
жалению, это не надежно. Иногда он сообщает о конце пакета преждевре¬
менно. Ситуацию спасает многократная проверка того, что последующие
байты данных еще не поступили. Получающийся фрагмент программы
кажется не очень хорошо продуманным; но программ, которые устраняют
аппаратные дефекты, не бывает.
Процедура Skip служит для отказа от принимаемых данных, а именно по¬
следующих m байтов, ш сравнивается с числом сохраненных байтов, заданных
n = (in-out) MOD BufLen, чтобы не «промахнуться». Оставляем заинтересованно¬
му читателю выяснить, почему предохранитель m <= п верен, тогда как m < п был
бы неверным.
9.4. Драйвер диска,
использующий интерфейс SCSI
Процедурный интерфейс системы Оберон для диска представлен двумя про¬
цедурами Kernel.GetSector и Kernel.PutSector. Они тесно связаны с используемым
контроллером диска. Недавно появилось несколько стандартов для дисковых ин¬
терфейсов, и поэтому мы представим один из них, а именно тот, что называется
интерфейсом малых вычислительных систем (Small Computer Systems Interface,
SCSI), который настолько универсален, что пригоден для других устройств и даже
для быстрого обмена данными между компьютерами.
Компьютер Ceres-З оборудован этим интерфейсом, и, следовательно, диски
(или другие устройства) могут подключаться внешним образом. Подчеркнем,
что SCSI представляет собой шину, а не просто двухточечное соединение. Однако
взаимодействовать по ней могут не более 8 партнеров.
Шина сигнала SCSI состоит из 8 линий данных (плюс четность) и нескольких
линий управления (а именно SEL, BSY, REQ, АСК, C/D, MSG, I/O, RST и ATN).
Следовательно, 8 (или 9) битов, составляющие байт, передаются параллельно.
Байты передаются асинхронно, то есть без каких бы то ни было временных зави¬
симостей в их последовательности. Это возможно с помощью двух управляющих
сигналов REQ и АСК, которые используются следующим образом.
Чтобы передать байт от клиента серверу, последний сначала ждет, пока клиент
не выложит байт на линию данных и не сообщит о наличии байта подтверждаю¬
щим сигналом REQ. Затем сервер выбирает (читает) линии данных, подтверждает
это сигналом АСК и ждет, пока клиент отменит (сбросит) сигнал REQ. В заключе¬
ние сервер отменяет сигнал АСК. Сигнал REQ выдается (определяется) клиентом
и проверяется сервером, сигнал АСК выдается сервером и опрашивается клиен¬
том. Эта последовательность действий называется «рукопожатием» и применяет-
276
Драйверы устройств
с я при передаче байта в обоих направлениях (см. рис. 9.3.). В приведенной ниже
программе этот протокол передачи реализуется двумя процедурами Send (отпра¬
вить последовательность из п байтов) и Receive (принять один байт).
Рис. 9.3. «Рукопожатие» в SCSI
Для полного выполнения таких транзакций, как чтение или запись сектора дис¬
ка, стандарт протокола SCSI предусматривает шесть фаз (кроме нейтральной, когда
шина свободна). Начинающий транзакцию агент (обычно, компьютер) называется
отправителем, а адресат называется получателем. В системах, где только один агент
имеет возможность действовать как отправитель, первое действие - это выбор полу¬
чателя. Напомним, что стандарт SCSI определяет не линию, а шину; следовательно,
сначала нужно уведомить (выбрать) партнера-получателя. Эта фаза выбора харак¬
теризуется управляющим сигналом SEL, выдаваемым одновременно с одной из
8 линий данных. Устройство-получатель подтверждает это управляющим сигналом
BSY. В приведенной ниже программе фаза выбора описывается процедурой Select,
которая включает паузу в случае, если получатель не отвечает (или не существует).
С этого момента и далее получатель действует как клиент, а отправитель как сервер.
Вторая фаза - командная, когда выбранный получатель запрашивает, а отпра¬
витель отвечает посылкой команды, закодированной в виде последовательности
байтов. Эта фаза определяется подтверждающим сигналом С/D (команда/дан¬
ные) и отменяющим сигналом MSG. Команда состоит из последовательности (не
менее 6) байтов. Первый байт - код операции, или байт команды, остальные - ее
параметры. Если получатель - это контроллер диска, за первым байтом следуют
3 байта, задающие адрес сектора (старший байт - первый), число задействован¬
ных секторов диска и специальный байт устройства.
Если команда приемлема для получателя, начинается третья фаза. Это - фаза
данных, задаваемая отмененными сигналами С/D и MSG. Следовательно, отпра¬
витель ждет сигнала подтверждения REQ и затем проверяет сигнал С/D. Если он
не отменен, фаза данных пропускается. Иначе передается заданное число байтов.
Затем следует фаза состояния, в которой получатель посылает информацию о
состоянии, обычно один байт. Нуль значит, что запрошенная команда завершена.
Последняя фаза называется фазой сообщения, когда и С/D, и MSG сигналы
подтверждены. На этой фазе получатель передает сообщение отправителю. Оно
не имеет никакого значения в нашем приложении, но должно быть как-то принято
согласно правилам стандарта.
В системах, где несколько агентов имеют возможность действовать как от¬
правители, существует опасность того, что некоторые из них могут войти в фазу
Драйвер диска, использующий интерфейс SCSI
277
выбора в один и тот же момент. Последствия были бы непредсказуемыми. Что-
бы избежать этой недопустимой возможности, выбору должна предшествовать
арбитражная фаза. Примечательно, что никакого отдельного центрального агента
для предоставления допуска к шине одному из конкурентов не требуется. Арби¬
траж называется распределенным и проходит следующим образом.
Сначала отправитель подтверждает сигнал BSY и одновременно линию дан¬
ных, соответствующую адресу отправителя. Если в пределах определенного про¬
межутка времени (арбитражная задержка = 200 нсек) никакая линия данных с
большим номером не подтверждается (конкурентом), отправителю разрешается
войти в фазу выбора подтверждением SEL. Иначе BSY отклоняется, чтобы пере¬
дать приоритет конкуренту более высокого ранга. Теперь понятна причина, поче¬
му только 8 вместо 28 устройств могут подключаться к шине SCSI: каждая линия
данных должна быть связана ровно с одним устройством.
Значения сигналов, характеризующих различные фазы, приводятся в следую¬
щей таблице:
Фаза
SEL
BSY
C/D
MSG
I/O
Нейтральная
0
0
X
х
х
Арбитраж
0
1
0
0
0
Выбор
1
0
0
0
0
Команда
0
1
1
0
0
Данные
0
1
0
0
0/1
Состояние
0
1
1
0
1
Сообщение
0
1
1
1
0/1
Основные регистры интерфейса и назначение их разрядов показаны на рис. 9.4.
Полный стандарт определяет и другие регистры и средства, которые к нашим це¬
лям не относятся.
1. При подаче данных на шину регистр ODR подключается к шине, только
когда соблюдены следующие условия: бит 0 (DB) в ICR подтвержден и
фазы отправителя и получателя совпадают.
Рис. 9.4. Основные регистры SCSI и назначение их разрядов
278 I
Драйверы устройств
2. Фазы совпадают, если фазовые сигналы на шине (I/O, C/D, MSG), опре¬
деленные получателем, имеют те же значения, что хранятся в регистре от¬
правленной команды (TCR) отправителя. Несовпадение фаз указывается
в регистре BSR (РНМ).
3. RST - сигнал сброса, DP - четность на шине данных, РСК указывает на
проверку четности, a TAR задает режим работы получателя.
Когда устройством-получателем является дисковод, обычно доступны многие
команды. Те, что касаются нас, - это команды чтения и записи сектора. Как объясня¬
лось выше, первый байт всегда задает операцию. За ним следуют 3 байта, задающие
номер сектора, число передаваемых последовательных секторов и нулевой байт.
MODULE Disk; (*NW 12.4.90 / 2.10.90*)
IMPORT SYSTEM, Kernel;
CONST SS = 1024; devno = 0; maxSector = 102432;
SCSI = 0FFFF8000H;
ODR = SCSI; (*регистр выходных данных*)
CSD = SCSI; (*тек. данные SCSI*)
ICR = SCSI + 4; (*регистр команд отправителя*)
MR2 = SCSI + 8; (*регистр режимов*)
TCR = SCSI + 12; (*регистр команд получателя*)
SER = SCSI + 16; (*регистр разрешения выбора*)
CSB = SCSI + 16; (*тек. состояние шины SCSI*)
BSR = SCSI + 20; (‘состояние шины*)
RPI = SCSI + 28; (*сбросить четность и прерывания*)
TYPE DiskAdr = LONGINT;
Buffer = ARRAY 256 OF LONGINT;
VAR stat*, msg: CHAR;
PROCEDURE Select (n: LONGINT);
BEGIN
REPEAT UNTIL "SYSTEM.BIT(CSB, 6); (*~BSY*)
REPEAT UNTIL "SYSTEM.BIT(CSB, 1); (*~SEL*)
SYSTEM.PUT(0DR, {n}); SYSTEM.PUT(ICR, 5); (*SEL*)
REPEAT UNTIL SYSTEM.BIT(CSB, 6) (*BSY*)
END Select;
PROCEDURE Receive (VAR x: CHAR);
BEGIN
REPEAT UNTIL SYSTEM.BIT(CSB, 5); (*REQ*)
SYSTEM.GET(CSD, x);
SYSTEM.PUT(ICR, ЮН); (*подтвердить АСК*)
REPEAT UNTIL "SYSTEM.BIT(CSB, 5); (*~REQ*)
SYSTEM.PUT(ICR, 0); ^отменить АСК*)
END Receive;
PROCEDURE Send (x: CHAR);
BEGIN
Драйвер диска, использующий интерфейс SCSI
279
280
Драйверы устройств
REPEAT UNTIL SYSTEM.BIT(CSB, 5); (*REQ*)
SYSTEM.PUT(ODR, x);
SYSTEM.PUT(ICR, 11H); (^подтвердить АСК*)
REPEAT UNTIL "SYSTEM.BIT(CSB, 5); (*REQ*)
SYSTEM. PUT(ICR, 1) (отменить АСК*)
END Send;
PROCEDURE Reset*;
BEGIN SYSTEM.PUT(ICR, 80X); SYSTEM.PUT(TCR, 0); SYSTEM.PUT(ICR, 0);
SYSTEM.PUT(MR2, 20X); SYSTEM.GET(RPI, stat)
END Reset;
PROCEDURE GetSector* (src: DiskAdr; VAR dest: Kernel.Sector);
VAR adr, limit: LONGINT; x: CHAR;
BEGIN INC(src, src);
SYSTEM.GET(RPI, x); (*сбросить четность*) Select(devno);
SYSTEM.PUT(TCR, 2); SYSTEM.PUT(ICR, 1);
Send(8X); Send(CHR(src DIV 10000H)); Send(CHR(src DIV 100H)); Send(CHR(src));
Send(2X); Send(OX);
SYSTEM.PUT(TCR, 1); SYSTEM.PUT(ICR, 0);
adr := SYSTEM.ADR(dest); limit := adr + SS;
LOOP Receive(x);
IF “SYSTEM.BIT(CSB, 3) THEN SYSTEM.PUT(adr, x); INC(adr)
ELSE stat := x; EXIT
END;
IF adr = limit THEN Receive(stat); EXIT END
END;
Receive(msg); SYSTEM.PUT(TCR, 0); SYSTEM.PUT(ICR, 0)
END GetSector;
PROCEDURE PutSector* (dest: DiskAdr; VAR src: Kernel.Sector);
VAR adr, limit: LONGINT; x: CHAR;
BEGIN INC(dest, dest); Select(devno);
SYSTEM.PUT(TCR, 2); SYSTEM.PUT(ICR, 1);
Send(OAX); Send(CHR(dest DIV 10000H)); Send(CHR(dest DIV 100H));
Send(CHR(dest));
Send(2X); Send(OX);
SYSTEM.PUT(TCR, 0); adr := SYSTEM.ADR(src); limit := adr + SS;
REPEAT SYSTEM.GET(adr, x); Send(x); INC(adr)UNTIL adr = limit;
Receive(stat); Receive(msg);
SYSTEM.PUT(TCR, 0); SYSTEM.PUT(ICR, 0)
END PutSector;
PROCEDURE Sense*;
VAR x: CHAR;
BEGIN Select(devno); SYSTEM.PUT(TCR, 2); SYSTEM.PUT(ICR, 1);
Send(3X); Send(OX); Send(OX); Send(OX); Send(OX); Send(OX);
REPEAT Receive(stat) UNTIL SYSTEM.BIT(CSB, 3);
Receive(msg); SYSTEM.PUT(TCR, 0); SYSTEM.PUT(ICR, 0)
END Sense;
END Disk.
10. СЕТЬ
10.1. Введение
Рабочие станции, как правило, но не всегда, связаны с локальным окружени¬
ем сетью. Есть два существенно разных взгляда на архитектуру таких сетей. Бо¬
лее требовательный взгляд состоит в том, что все связанные станции образуют
единое, объединенное рабочее пространство (называемое также адресным прост¬
ранством), в котором работают отдельные процессоры. Он предполагает, что
«тонкие» связи между процессорами скрыты от пользователей. В худшем случае
они могут становиться видимыми из-за низких межмашинных скоростей доступа
к данным. Скрыть разницу между доступом внутри компьютера и между компью¬
терами - это прежде всего забота разработчиков.
Второй, более консервативный взгляд предполагает, что отдельные рабочие
станции, хоть и связанные, но по сути автономные элементы, которые обменива¬
ются данными нечасто. Поэтому доступ к данным других станций инициализи¬
руется явными командами передачи. Команды, обрабатывающие внешние обра¬
щения, не являются частью базовой системы, а реализуются в модулях, которые
могут считаться приложениями.
В системе Оберон мы придерживаемся этого второго взгляда, и в этой главе
описываем модуль Net, который является автономным модулем команд, основан¬
ным на сетевом драйвере SCC, представленном в разделе 9.3. Он может быть ак¬
тивирован на любой станции, подключенной к сети, и все они считаются равными.
Такое множество слабосвязанных станций может хорошо работать в сетях с уме¬
ренными скоростями передачи и поэтому с дешевыми аппаратными интерфейса¬
ми и витыми парами.
Очевидный выбор единицы передачи данных - это файл. Поэтому централь¬
ная тема этой главы - передача файлов по сети. Некоторые дополнительные сред¬
ства, предлагаемые выделенной серверной станцией, будут предметом главы 11.
Команды, которые должны быть представлены здесь, - это всего лишь SendFiles,
ReceiveFiles и SendMsg.
Как объяснено в главе 2, Оберон - это однопроцессная система, где каждая
команда монополизирует процессор до ее завершения. Когда команда устанавли¬
вает связь по сети, в действие одновременно вовлекаются (по крайней мере) два
процессора. Поэтому парадигма Оберона, казалось бы, должна исключать такое
взаимодействие; но, к счастью, это не так, и решение проблемы весьма простое.
©N. Wirth, 27.8.91/12.11.91
282
Каждая команда выдается пользователем, работающим на рабочей станции
Назовем его здесь клиентом (master) (чья команда выполняется). Станция-адре¬
сат, очевидно, именуемая сервером, должна быть в состоянии распознать команду
чтобы заняться ее выполнением. Так как команда, называемая запросом, приходит
по сети в закодированном виде, задача Оберона, представленная процедурой-об¬
работчиком, должна быть включена в цикл опроса событий системы. Такой обра¬
ботчик должен иметь общий вид:
IF возникло событие THEN обработать событие END
Условие здесь должно подразумевать, что запрос был получен из сети. Под¬
черкнем, что событие на сервере возникает только после того, как текущая выпол¬
няемая команда, если она есть, завершена. Однако данные поступают приемнику
сразу после того, как их отправил клиент. Следовательно, любая значительная за¬
держка, конечно, недопустима, и подход Оберона, кажется, снова терпит неудачу.
Однако это не так, потому что необходимый, подлинный параллелизм действий
отправителя и получателя обрабатывается в модуле драйвера, который помещает
данные в буфер. Драйвер активируется но прерыванию, а его буфер получателя
фактически разъединяет партнеров и снимает строжайшее требование синхрон¬
ности. Все это остается полностью скрытым в модуле драйвера.
10.2. Протокол
Если в выполнении команды участвуют более одного агента, то между ними
должно быть установлено и соблюдено определенное соглашение. Оно определяет
множество запросов, их кодировку и порядок обмена данными, которые из него
следуют. Такое соглашение называется протоколом. Так как в нашем подходе дей¬
ствия, начатые клиентом и сервером, следуют поочередно строго друг за другом,
протокол может быть определен с применением РБНФ (расширенной формы Бе-
куса-Наура), хорошо известной из спецификации синтаксиса языков.
Порождаемые клиентом элементы будут записываться обычным шрифтом,
а порождаемые сервером - курсивом.
Упрощенный вид запроса ReceiveFile определяется следующим образом и бу¬
дет уточнен впоследствии:
ReceiveFile = SND filename (АСК data \ NAK).
Здесь символ SND представляет закодированный запрос на получение с сер¬
вера файла, заданного именем filename. АСК говорит о том, что запрос принят и
следом идут запрошенные данные data. Символ NAK указывает на то, что запро¬
шенный файл не может быть предоставлен. Транзакция состоит ровно из двух ча¬
стей - запроса и ответа, по одному от каждого из партнеров.
Сеть
Эта нехитрая схема неудачна из-за налагаемого сетевым драйвером ограниче¬
ния на размер каждой передаваемой порции. Напомним, что модуль SCC ограни¬
чивает данные каждого пакета 512 байтами. Очевидно, что файлы нужно разбивать
и передавать как последовательность пакетов. Причина этого ограничения - на¬
дежность передачи. Разбиение позволяет партнеру подтверждать правильность
получения пакета, возвращая короткое подтверждение. Каждое подтверждение
служит также запросом следующего пакета. Исключением является последнее
подтверждение, следующее за последней порцией данных, длина которой меньше
допустимого максимума. Пересмотренный протокол определяется как
ReceiveFile = SND filename (DAT data АСК {DAT data ACK} | NAK).
Теперь вспомним, что каждый пакет, как определено в разделе 9.3, характери¬
зуется типом в его заголовке. Символы SND, DAT, АСК и NAK указывают на этот
тип. Порции данных пакетов АСК и NAK пусты.
Пересмотренный протокол не в состоянии справляться с ошибками передачи.
Правильность передачи проверяется драйвером с помощью циклического контро¬
ля избыточности (CRC), а ошибочный пакет просто отбрасывается. Это предпола¬
гает, что приемник должен установить ограничение по времени. Если ожидаемый
пакет не в состоянии прибыть в пределах заданного периода времени (времени
ожидания), запрос должен быть повторен. В нашем случае запрос предполагает
подтверждение. Следовательно, в подтверждении должно указываться, какой па¬
кет нужно отправить - следующий (нормальный случай) или предыдущий (оши¬
бочный случай). Решение состоит в том, чтобы прикрепить порядковый номер
к каждому подтверждению и к каждому пакету данных. Эти номера берутся по
модулю 8, хотя в принципе было бы достаточно по модулю 2.
С добавлением идентификации пользователя и пароля к каждому запросу и
дополнительного кода ответа NPR для «не разрешено» протокол обретает свой
окончательный вид:
ReceiveFile = SND username password filename (datastream \ NAK | NPR).
datastream = DATQ data ACK1 {DATi data ACK.+l},
Протокол для передачи файла от клиента к серверу определяется аналогично:
SendFile = REC username password filename (ACK0 datastream | NAK | NPR).
datastream = DAT0 data ACK1 {DAT data ACK.+1}.
Третий приведенный выше запрос SendMsg не относится ни к какому файлу,
а просто передает и отображает короткое сообщение. Он включается здесь для
проверки связи между двумя партнерами и, возможно, для явного подтверждения
оказанной услуги сообщением «готово» или «спасибо».
SendMsg = MSG message АСК.
Протокол
I 283
10.3. Адресация станций
Каждый пакет должен нести адрес назначения подобно адресу отправителя.
Адреса - это номера станций. Конечно, пользователю было бы неудобно запоми¬
нать номер станции желаемого партнера. Вместо этого предпочтительнее исполь¬
зовать символьные имена. С этой целью нас приучили использовать инициалы
партнера.
Исходный адрес автоматически вставляется в заголовки пакетов драйвером.
Он получается выставлением DIP-переключателей при установке и подключении
компьютера. Но откуда появляется адрес назначения? Решение с таблицей адре¬
сов на каждой рабочей станции сразу отклоняем из-за возможных несоответствий.
Концепция централизованной авторизации с хранением словаря «имя/адрес»
тоже непривлекательна из-за обновлений, необходимых всякий раз, когда пользо¬
ватель работает на другом компьютере. Кроме того, мы исходили из предпосылки
равноправия всех участников сети.
Самое привлекательное решение - децентрализованная служба имен. Она
основана на средстве оповещения, то есть возможности направить пакет всем под¬
ключенным станциям в обход их адресных фильтров за счет особого адреса назна¬
чения (-1). Оповещение используется для выдачи запроса об имени, содержащего
символьное имя нужного партнера. Получающая запрос станция возвращает от¬
вет отправителю запроса, если это имя совпадает с его собственным символьным
именем. После чего отправитель запроса получает адрес нужного партнера из поля
исходного адреса принятого ответа. Соответствующий простой протокол таков:
NameRequest = NRQ partnername [NRS].
Уже упомянутое средство времени ожидания здесь обязательно. Следующие
правила суммируют разработанный протокол:
protocol = {request}.
request = ReceiveFile | SendFile | SendMsg | NameRequest.
Накладные расходы, вызванные запросами имен, могут быть сокращены за
счет использования локального словаря адресов. На практике достаточно одного
входа. Тогда запрос имени нужен только при изменении партнера.
10.4. Реализация
Модуль Net - это реализация обрисованных выше средств. Программа при¬
ведена ниже. Она начинается с множества вспомогательных локальных процедур.
Следом идут процедура Serve, которая должна быть установлена как задача Обе¬
рона, и команды SendFiles, ReceiveFiles и SendMsg, у каждой из которых есть свой
двойник в процедуре Serve. В конце - команды для запуска и остановки средств
сервера.
284
Сеть
Разберем подробно процедуру Receiveriles. Она начинается с чтения из команд¬
ной строки первого параметра, который обозначает станцию-иартнсра. Процедура
FindPartner выдает запрос на имя, если адрес партнера еще не был определен пре¬
дыдущей командой. В глобальную переменную partner записывается символьное
имя (id), адрес которого хранится в поле адреса глобальной переменной headO,
которая используется в качестве заголовка каждого пакета, отправленного про¬
цедурой SCC.SendPacket. Переменная partner может считаться кэш-именем с един¬
ственным входом для сокращения количества выдаваемых запросов на имя.
Когда партнер идентифицирован, из командной строки читается следующий
параметр - имя файла для передачи. Если параметр имеет вид пате0:пате1, то
с сервера извлекается хранящийся на нем файл nameO.namel и сохраняется ло¬
кально как namef. Следовательно, патеО служит префиксом имени файла на сер¬
вере.
Затем параметры запроса объединяются в локальной буферной переменной
buf. Это - имя пользователя, пароль и затем имя файла. (Имя пользователя и
пароль не используются представленным здесь сервером.) Командный пакет от¬
правляется вызовом Send(SND, к, buf), где k обозначает длину строки параметров
команды. Затем по вызову ReceiveHead ожидается ответный пакет. Если тип полу¬
ченного пакета DAT с порядковым номером 0, создается новый файл. Процедура
ReadData получает данные и сохраняет их в новом файле согласно определенному
в разделе 10.2 протоколу. Этот процесс повторяется для каждого файла, заданного
в списке имен файлов командной строки.
Процедура Receive Head (Т) принимает и отвергает пакеты, пока не поступит
файл от нужного партнера. Процедура представляет собой входной фильтр в до¬
полнение к аппаратному фильтру. Она фильтрует по адресу источника пакета,
тогда как аппаратный фильтр - по адресу назначения. Если ни один пакет не при¬
ходит в пределах выделенного времени Т, возвращается тип кода -1, означающий
истечение времени ожидания.
Процедура ReceiveData проверяет порядковые номера входящих пакетов дан¬
ных (типы кода 0-7). Если обнаружен неправильный номер, возвращается пакет
АСК с предыдущим порядковым номером (типы кода 16-23), требующий повтор¬
ной передачи. Разрешается не более двух попыток. Этого, кажется, достаточно,
учитывая, что сервер тоже не принимает других запросов, будучи занятым пере¬
дачей файла.
Блок, соответствующий ReceiveFiles в процедуре Serve, защищен условием
headl.typ = SND. Переменная headl - это приемник заголовков при получении
пакета ReceiveHead. Сначала просматриваются параметры запроса. Id и рт иг¬
норируются. Затем открывается требуемый файл. Если он существует, переда¬
ча обрабатывается двойником ReceiveData - процедурой SendData. Время при¬
ема следующего запроса ограничивается величиной Т1, тогда как время приема
в ReceiveData следующего пакета данных ограничивается величиной ТО. Т1 - это
примерно ТО, умноженное на максимальное число возможных повторных пере¬
дач. Прежде чем отключиться от транзакции, отправитель данных ждет до тех пор,
пока не убедится в том, что запросов на повторную передачу больше не предвидит-
Реализация
Г285|
ся. Значение ТО (300) соответствует 1 сек.; время передачи пакета максимальной
длины - около 16 мсек.
Процедура SendFiles разработана аналогично; ее двойник на сервере защищен
условием headl.typ = REC. Сервер принимает запрос, только когда его состояние
не защищено (глобальная переменная protected). В противном случае запрос не
принимается с выдачей пакета NPR. Обратим внимание, что обе процедуры Send-
Data и ReceiveData используются как командными процедурами, так и сервером.
MODULE Net; (*NW 3.7.88 / 25.8.91*)
IMPORT SCC, Files, MenuViewers, Oberon, TextFrames, Texts, Viewers;
CONST PakSize = 512;
TO = 300; T1 = 1000; (*время ожидания*)
АСК = ЮН; NAK = 25Н; NPR = 26H; (подтверждения*)
NRQ = 34H; NRS = 35H; (*имя: запрос, отклик*)
SND = 41Н; REC = 42H; MSG = 44H;
VAR W: Texts.Writer;
Server: Oberon.Task;
headO, headl: SCC.Header;
partner, dmy: ARRAY 8 OF CHAR;
protected: BOOLEAN; (*защита от записи*)
PROCEDURE SetPartner (VAR name: ARRAY OF CHAR);
BEGIN headO.dadr := headl.sadr; C0PY(name, partner)
END SetPartner;
PROCEDURE Send (t: SHORTINT; L: INTEGER; VAR data: ARRAY OF CHAR);
BEGIN headO.typ := t; headO.len := L; SCC.SendPacket(headO, data)
END Send;
PROCEDURE ReceiveHead (timeout: LONGINT);
VAR time: LONGINT;
BEGIN time := Oberon.Time() + timeout;
LOOP SCC.ReceiveHead(head1);
IF headl.valid THEN
IF headl.sadr = headO.dadr THEN EXIT ELSE SCC.Skip(head1.len) END
ELSIF Oberon.Time() >= time THEN headl.typ := - 1; EXIT
END
END
END ReceiveHead;
PROCEDURE FindPartner (VAR name: ARRAY OF CHAR; VAR res: INTEGER);
VAR time: LONGINT; k: INTEGER;
BEGIN SCC.Skip(SCC.AvailableO); res := 0;
IF name # partner THEN k := 0;
WHILE name[k] > OX DO INC(k) END;
headO.dadr := - 1; Send(NRQ, k + 1, name); time := Oberon.Time() + T1;
LOOP SCC.ReceiveHead(head1);
286
Сеть
IF heacM.valid THEN
IF headl.typ = NRS THEN SetPartner(name); EXI
ELSE SCC.Skip(head1.len)
END
ELSIF Oberon.Time() >= time THEN res := 1; partner[0] := OX; EXIT
END
END
END
END FindPartner;
PROCEDURE Appends (VAR s, d: ARRAY OF CHAR; VAR k: INTEGER);
VAR i: INTEGER; ch: CHAR;
BEGIN i := 0;
REPEAT ch := s[i]; d[k] := ch; INC(i); INC(k) UNTIL ch = OX
END AppendS;
PROCEDURE AppendW (s: LONGINT; VAR d: ARRAY OF CHAR; n: INTEGER; VAR k: INTEGER);
VAR i: INTEGER;
BEGIN i := 0;
REPEAT d[k] := CHR(s); s := s DIV 100H; INC(i); INC(k) UNTIL i = n
END AppendW;
PROCEDURE PickS (VAR s: ARRAY OF CHAR);
VAR i: INTEGER; ch: CHAR;
BEGIN i := 0;
REPEAT SCC.Receive(ch); s[i] := ch; INC(i) UNTIL ch = OX
END PickS;
PROCEDURE PickQ (VAR w: LONGINT);
VAR cO, cl, c2: CHAR; s: SHORTINT;
BEGIN SCC.Receive(cO); SCC.Receive(c1); SCC.Receive(c2); SCC.Receive(s);
w := s; w := ((w * 100H + L0NG(c2)) * 100H + LONG(c1)) * 100H + LONG(cO)
END PickQ;
PROCEDURESendData(F: Files.File);
VAR k: INTEGER;
seqno: SHORTINT; x: CHAR;
len: LONGINT;
R: Files.Rider;
buf: ARRAY PakSize OF CHAR;
BEGIN Files.Set(R, F, 0); len := 0; seqno := 0;
LOOP к := 0;
LOOP Files.Read(R, x);
IF R.eof THEN EXIT END;
buf[k] := x; INC(k);
IF к = PakSize THEN EXIT END
END;
REPEAT Send(seqno, k, buf); ReceiveHead(T1)
Реализация
287
288
Сеть
UNTIL headl.typ tt seqno + ACK;
seqno := (seqno + 1) MOD 8; len := len + k;
IF headl.typ # seqno + ACK THEN
Texts.WriteString(W, ” failed"); EXIT
END;
IF к < PakSize THEN EXIT END
END;
Texts.WriteInt(W, len, 7)
END SendData;
PROCEDURE ReceiveData (F: Files.File; VAR done: BOOLEAN);
VAR k, retry: INTEGER;
seqno: SHORTINT; x: CHAR;
len: LONGINT;
R: Files.Rider;
BEGIN Files.Set(R, F, 0); seqno := 0; len := 0; retry := 2;
LOOP
IF headl.typ = seqno THEN
seqno := (seqno + 1) MOD 8; len := len + headl. len; retry := 2;
Send(seqno + ACK, 0, dmy); к := 0;
WHILE к < headl.len DO
SCC.Receive(x); Files.Write(R, x); INC(k)
END;
IF к < PakSize THEN done := TRUE; EXIT END
ELSE DEC(retry);
IF retry = 0 THEN
Texts.WriteString(W, " failed"); done := FALSE; EXIT
END;
Send(seqno + ACK, 0, dmy)
END;
ReceiveHead(TO)
END;
Texts.Writelnt(W, len, 7)
END ReceiveData;
PROCEDURE reply (msg: INTEGER);
BEGIN
CASE msg OF
0:
I 1: Texts.WriteString(W, " нет связи")
| 2: Texts.WriteString(W, " нет доступа")
I 3: Texts.WriteString(W, " не готов")
I 4: Texts.WriteString(W, " не найден")
I 5: Texts.WriteString(W, " не отвечает")
END;
Texts.WriteLn(W); Texts.Append(Oberon.Log, W.buf)
END reply;
PROCEDURE* Serve;
реализация
289
VAR i: INTEGER;
done: BOOLEAN; ch: CHAR;
F: Files.File;
pw: LONGINT;
Id: ARRAY 10 OF CHAR;
FileName: ARRAY 32 OF CHAR;
BEGIN SCC.ReceiveHead(headl);
IF headl.valid THEN
IF headl.typ = SND THEN
PickS(Id); PickQ(pw); PickS(FileName);
Texts.WriteString(W, Id); Texts.Write(W, " ");
Texts.WriteString(W, FileName);
F := Files.Old(FileName);
IF F # NIL THEN
Texts.WriteString(W, " sending"); SetPartner(Id);
Texts.Append(Oberon.Log, W.buf); SendData(F)
ELSE Send(NAK, 0, dmy); Texts.Write(W, "“")
END;
reply(O)
ELSIF headl.typ = REC THEN
PickS(Id); PickQ(pw); PickS(FileName);
IF “protected THEN
Texts.WriteString(W, Id); Texts.Write(W, " ");
Texts.WriteString(W, FileName);
F := Files.New(FileName);
IF F # NIL THEN
Texts.WriteString(W, " receiving”); SetPartner(Id);
Texts.Append(Oberon.Log, W.buf);
Send(ACK, 0, dmy); ReceiveHead(TO); ReceiveData(F, done);
IF done THEN Files.Register(F) END
ELSE Send(NAK, 0, dmy); Texts.Write(W, "'")
END;
reply(O)
ELSE Send(NPR, 0, dmy)
END
ELSIF headl.typ = MSG THEN i := 0;
WHILE i < headl.len DO SCC.Receive(ch); Texts.Write(W, ch); INC(i) END;
Send(ACK, 0, dmy); reply(O)
ELSIF headl.typ = NRQ THEN i := 0;
LOOP SCC.Receive(ch); Id[i] := ch; INC(i);
IF ch = OX THEN EXIT END;
IF i = 7 THEN Id[7] := OX; EXIT END
END;
WHILE i < headl.len DO SCC.Receive(ch); INC(i) END;
IF Id = Oberon.User THEN SetPartner(Id); Send(NRS, 0, dmy) END
ELSE SCC.Skip(head1.len)
END
END
END Serve;
290
PROCEDURE GetParl (VAR S: Texts.Scanner);
BEGIN Texts.OpenScanner(S, Oberon.Par.text, Oberon.Par.pos); Texts.Scan(S)
END GetParl;
PROCEDURE GetPar (VAR S: Texts.Scanner; VAR end; LONGINT);
VAR T: Texts.Text; beg, tm: LONGINT;
BEGIN Texts.Scan(S);
IF (S.class = Texts.Char) & (S.с = "~") THEN
Oberon.GetSelection(T, beg, end, tm);
IF tm >= 0 THEN Texts.OpenScanner(S, T, beg); Texts.Scan(S) END
ELSE end := Oberon.Par.text.len
END
END GetPar;
PROCEDURE SendFiles*;
VAR k: INTEGER;
end: LONGINT;
S: Texts.Scanner;
F: Files.File;
name: ARRAY 32 OF CHAR;
buf: ARRAY 64 OF CHAR;
BEGIN GetParl(S);
IF S.class = Texts.Name THEN
FindPartner(S.s, k);
IF к = 0 THEN
GetPar(S, end);
LOOP
IF S.class # Texts.Name THEN EXIT END;
Texts.WriteString(W, S.s); к :=0; AppendS(S.s, name, k);
IF S.nextCh = ":" THEN («префикс*)
Texts.Scan(S); Texts.Scan(S);
IF S.class = Texts.Name THEN
name[k - 1] := AppendS(S.s, name, k);
Texts.Write(W, Texts.WriteString(W, S.s)
END
END;
F := Files.Old(S.s);
IF F # NIL THEN k := 0;
AppendS(Oberon.User, buf, k); AppendW(Oberon. Password, buf, 4, k);
AppendS(name, buf, k); Send(REC, k, buf); ReceiveHead(TO);
IF headl.typ = ACK THEN
Texts.WriteString(W, " отсылается");
Texts.Append(Oberon.Log, W.buf);
SendData(F); reply(O)
ELSIF headl.typ = NPR THEN reply(2); EXIT
ELSIF headl.typ = NAK THEN reply(3); EXIT
ELSE reply(5); EXIT
END
ELSE reply(4)
END;
Сеть
Реализация
291
IF Texts.Pos(S) >= end THEN EXIT END;
Texts.Scan(S)
END
ELSE reply(1)
END
END
END SendFiles;
PROCEDURE ReceiveFiles*;
VAR k: INTEGER; done: BOOLEAN;
end: LONGINT;
S: Texts.Scanner;
F: Files.File;
name: ARRAY 32 OF CHAR;
buf: ARRAY 64 OF CHAR;
BEGIN GetParl(S);
IF S.class = Texts.Name THEN
FindPartner(S.s, k);
IF к = 0 THEN
GetPar(S, end);
LOOP
IF S.class # Texts.Name THEN EXIT END;
Texts.WriteString(W, S.s); к := 0; AppendS(S.s, name, k);
IF S.nextCh = THEN (*prefix*)
Texts.Scan(S); Texts.Scan(S);
IF S.class = Texts.Name THEN
name[k - 1] := AppendS(S.s, name, k);
Texts.Write(W, ":"); Texts.WriteString(W, S.s)
END
END;
к := 0; AppendS(0beron.User, buf, k);
AppendW(0beron.Password, buf, 4, k);
AppendS(name, buf, k); Send(SND, k, buf);
Texts.WriteString(W, " receiving"); Texts.Append(0beron.Log, W.buf);
ReceiveHead(T1);
IF headl.typ = 0 THEN
F := Files.New(S.s);
IF F # NIL THEN
ReceiveData(F, done);
IF done THEN Files.Register(F); reply(O) ELSE EXIT END
ELSE reply(3); Send(NAK, 0, dmy)
END
ELSIF headl.typ = NAK THEN reply(4)
ELSIF headl.typ = NPR THEN reply(2); EXIT
ELSE reply(5); EXIT
END;
IF Texts.Pos(S) >= end THEN EXIT END;
Texts.Scan(S)
END
ELSE reply(1)
292
END
END
END ReceiveFiles;
PROCEDURE SendMsg*;
VAR 1: INTEGER; ch: CHAR;
S: Texts.Scanner;
msg: ARRAY 64 OF CHAR;
BEGIN GetParl(S);
IF S.class = Texts.Name THEN
FindPartner(S.s, i);
IF i = 0 THEN
Texts.Read(S, ch);
WHILE (ch >= " ") & (i < 64) DO
msg[i] := ch; INC(i); Texts.Read(S, ch)
END;
Send(MSG, i, msg); ReceiveHead(TO);
IF headl.typ # ACK THEN reply(3) END
ELSE reply(1)
END
END
END SendMsg;
PROCEDURE StartServer*;
BEGIN protected := TRUE; SCC.Start(TRUE);
Oberon.Remove(Server); Oberon.Install(Server);
Texts.WriteString(W, " Сервер запущен");
Texts.WriteLn(W); Texts.Append(Oberon.Log, W.buf)
END StartServer;
PROCEDURE Unprotect*;
BEGIN protected := FALSE
END Unprotect;
PROCEDURE WProtect*;
BEGIN protected := TRUE
END WProtect;
PROCEDURE Reset*;
BEGIN SCC.Start(TRUE)
END Reset;
PROCEDURE StopServer*;
BEGIN Oberon.Remove(Server); Texts.WriteString(W, " Сервер остановлен");
Texts.WriteLn(W); Texts.Append(Oberon.Log, W.buf)
END StopServer;
BEGIN Texts.OpenWriter(W); NEW(Server); Server.handle := Serve
END Net.
Сеть
11. ВЫДЕЛЕННЫЙ СЕРВЕР
ДЛЯ РАСПРОСТРАНЕНИЯ ФАЙЛОВ,
ПОЧТЫ И ПЕЧАТИ
11.1. Концепция и структура
В системе слабосвязанных рабочих станций желательно централизовать
определенные службы. Первый пример - это хранение общих файлов. Даже если
каждая станция снабжена диском для постоянного хранения данных, служба об¬
щих файлов полезна, например, для хранения новых версий системных файлов,
справочников, отчетов и т. д. Общее хранилище устраняет несогласованность, ко¬
торая неизбежна, когда создаются локальные копии. Мы называем это службой
распространения файлов.
Централизованная служба желательна также, если она требует оборудования,
чья стоимость и обслуживание не позволяют приобретать их для каждой рабо¬
чей станции, особенно если служба используется нечасто. Лучший тому пример -
служба печати.
Третий случай - это средство связи в виде электронной почты. Хранилище
сообщений, несомненно, должно быть централизованным. Мы представляем его
в виде набора почтовых ящиков, по одному для каждого пользователя системы.
Почтовый ящик должен быть доступным всегда, то есть даже когда рабочая стан¬
ция его владельца выключена.
Последний пример централизованной службы - это сервер времени. Он по¬
зволяет таймеру реального времени станции работать синхронно с центральным
таймером.
Попутно отметим, что каждый пользователь имеет полный контроль над своей
станцией, включая право включать и выключать ее в любое время. Тогда как цент¬
ральный сервер работает постоянно.
В этой главе мы представим набор серверных модулей, поддерживающих все
вышеупомянутые службы. Они опираются на основную систему Оберон без моду¬
ля Net (см. главу 10). В отличие от Net, модуль NetServer, который управляет всеми
сетевыми взаимодействиями, не содержит командных процедур (кроме тех, что
запускают и останавливают его). Это потому, что он никогда не работает каккли-
©N. Wirth, 27.8.91/15.11.91
ент. Двойники подпрограмм его сервера постоянно находятся в других модулях,
включая (расширенную версию) Net, на персональных рабочих станциях.
Подпрограммы службы распространения файлов те же, что в модуле Net, с до¬
бавлением проверок разрешений на основе принимаемых имен и паролей поль¬
зователей. Подпрограммы служб печати и почтового обслуживания, в принципе,
могли быть тоже включены таким же образом в NetServer. Ыо из соображений на¬
дежности и синхронизации это простое решение оказывается непривлекательным.
Ослабление зависимости во время передачи и получения данных действительно
очень желательно. Поэтому данные, принятые к печати или к отправке по почте,
сохраняются (сервером NetSewer) во временных файлах, а потом «вручаются»
подходящему агенту, то есть серверу печати или почтовому серверу.
Такой централизованный по данным интерфейс между серверами - в отличие
от процедурных интерфейсов - имеет преимущество в том, что отдельные серверы
независимы в том смысле, что ни один не импортирует другие. Поэтому их разра¬
ботку можно вести автономно. Их канал связи - это модуль, который определяет
структуру данных и операции над ней для передачи временных файлов от одно¬
го сервера к другому. Используемая с этой целью структура данных - это FIFO-
очередь (First-In First-Out). Мы называем ее элементы задачами, потому что каж¬
дый из них несет в себе цель и объект, файл, который должен быть обработан.
Модуль, содержащий FIFO-очереди, называется Core. Окончательная структура
вызываемых модулей показана на рис. 11.1.
Рис. 11.1. Модульная структура серверной системы
Рисунок 11.1 включает еще один сервер LineSeweni показывает легкость, с ко¬
торой дополнительные серверы можно включать в эту схему. Они действуют как
дальнейшие источники и/или приемники задач, создавая или принимая очере¬
ди, содержащиеся в Core. LineServer действительно создает и принимает задачи
как NetSewer. Вместо шины RS-485 он управляет линией RS-232, которая, будучи
подключенной к модему, позволяет обращаться к серверу по телефонным линиям.
Мы воздерживаемся от более детального описания этого модуля, потому что во
многом он - подобие NetSewer.
Централизованный открытый сервер требует определенных мер защиты от
несанкционированного использования. Напомним, что запросы всегда передают
в качестве параметров имя и пароль пользователя. Сервер сверяет их правиль¬
ность с таблицей пользователей. Соответствующие подпрограммы и таблица со¬
держатся в модуле Core (см. раздел 11.5).
Выделенный сервер для распространения файлов, почты и печати
294
11.2. Почтовая служба
Сердце почтовоой службы - набор почтовых ящиков, хранимых на выделен¬
ном центральном сервере. Каждый зарегистрированный пользователь владеет
почтовым ящиком. Очевидные необходимые операции - поместить сообще¬
ние и извлечь его. Однако, в отличие от обычных ящиков «для писем и газет»,
извлекаемое сообщение не обязательно исчезает из ящика; его извлечение создает
копию. Таким образом, ящик автоматически становится хранилищем, а сообще¬
ния из него могут извлекаться многократно. Такая схема требует дополнитель¬
ной команды, которая удаляет сообщение из ящика. Кроме того, нужна команда
получения оглавления, в котором каждое сообщение представлено, по-видимому,
указанием на отправителя и временем доставки.
Предложенная выше почтовая схема приводит к следующим командам:
□ NetMailbox ServerName. Эта команда извлекает оглавление почтового ящи¬
ка текущего пользователя с указанного сервера и отображает его в новом
окошке. Имя пользователя и пароль должны быть зарегистрированы ранее
командой System. SetUser.
□ Net.SendMail ServerName. Текст в помеченном окошке отправляется на ука¬
занный сервер. Чтобы быть принятым, текст должен начинаться, по край¬
ней мере, одной строкой, начинающейся с «То» и содержащей, по крайней
мере, одного получателя.
□ Net.ReceiveMail Эта команда находится в полосе заголовка (меню) окошка,
полученного после запроса оглавления почтового ящика. Перед запуском
команды в этом оглавлении нужно выделить строку сообщения, которое
нужно прочитать.
□ Net.DeleteMail. Эта команда тоже находится в полосе заголовка окошка
почтового ящика. Сообщение, которое нужно удалить, тоже должно быть
выделено перед выполнением.
Почтовая система, представленная здесь, предназначена прежде всего для
обмена короткими сообщениями, которые обычно отправляются, принимаются,
читаются и отклоняются. Почтовые ящики не предназначены для того, чтобы слу¬
жить долговременными архивами для большого, да еще и растущего числа длин¬
ных текстов. Такая ограниченность цели позволяет выбрать разумно простую
реализацию и приводит к эффективному, практически мгновенному доступу к со¬
общениям при низкой загрузке сервера.
Используемый в ЕТН почтовый сервер Оберона предоставляет связь и с внеш¬
ними корреспондентами. Он соединяется с внешним почтовым сервером, кото¬
рый, (почти) как другие клиенты, считается источником и приемником сообще¬
ний. Кроме того, отправляемые на этот сервер сообщения должны кодироваться
в стандартный формат, а принимаемые - декодироваться, соответственно. Части
модуля MailServer для кодирования и декодирования не описаны в этой книге.
Скажем лишь, что при его разработке и реализации масса времени была потраче¬
на на быстрый локальный обмен сообщениями, которым мы ограничились в этом
представлении.
Почтовая служба
295
Из представленных в разделе 11.1 структур следует, что в передачу сообщений
пользователя почтовому ящику вовлечены три агента. Таким образом, дополне¬
ния к серверной системе распределяются по трем модулям. Новые команды до¬
бавлены к модулю Net (см. раздел 10.4); эти процедуры будут приведены ниже.
Их двойники находятся в модуле NetSewer на выделенном компьютере. Третий
агент - это модуль MailServer. Оба они приведены ниже в этом разделе. Послед¬
ний управляет добавлением поступающих сообщений в почтовые ящики. Путь,
который проходит сообщение при добавлении и извлечении, показан на рис. 11.2.
Серые прямоугольники означают хранение.
Рис. 11.2. Путь сообщений к почтовому ящику и обратно
Взаимодействие между рабочей станцией и выделенным сервером происходит
по сети и, таким образом, требует расширения его протокола (см. раздел 10.2). До¬
полнения точно соответствуют четырем командам, приведенным выше.
MailBox = MDIR username password (datastream \ NAK \ NPR).
SendMail = RML username password (ACK datastream | NAK | NPR).
ReceiveMail = SML username password msgno (datastream | NAK \ NPR).
DeleteMail = DML username password msgno (ACK \ NAK \ NPR).
Номер сообщения берется из выделенной строки в окошке почтового ящи¬
ка. Передаваемые данные воспринимаются как (неформатированные) тексты, в
отличие от пересылки файлов, где они воспринимаются как некоторая последо¬
вательность байтов. Приведенные ниже четыре командные процедуры принад¬
лежат модулю Net; они приводятся вместе со вспомогательными процедурами
SendText и ReceiveText, которые точно соответствуют SendData и ReceiveData (см.
раздел 10.4).
CONST MDIR = 4АН; SML = 4ВН; RML = 4CH; DML = 4DH;
PROCEDURE SendText (T: Texts.Text);
VAR k: INTEGER;
seqno: SHORTINT; x: CHAR;
R: Texts. Reader.¬
buf: ARRAY PakSize OF CHAR;
BEGIN Texts.OpenReader(R, T, 0); seqno := 0;
296
Выделенный сервер для распространения файлов, почты и печати
Почтовая служба
LOOP к := 0;
LOOP Texts.Read(R, x);
IF R.eot THEN EXIT END;
buf[k] := x; INC(k);
IF к = PakSize THEN EXIT END
END;
REPEAT Send(seqno, k, buf); ReceiveHead(T1)
UNTIL headl.typ # seqno + ACK;
seqno := (seqno + 1) MOD 8;
IF headl.typ # seqno + ACK THEN
Texts.WriteString(W, " failed”); EXIT
END;
IF к < PakSize THEN EXIT END
END
END SendText;
PROCEDURE ReceiveText (T: Texts.Text);
VAR k, retry: INTEGER;
seqno: SHORTINT; x: CHAR;
BEGIN seqno := 0; retry := 2;
LOOP
IF headl.typ = seqno THEN
seqno := (seqno + 1) MOD 8; retry := 2;
Send(seqno + 10H, 0, dmy); к := 0;
WHILE к < headl.len DO
SCC.Receive(x); Texts.Write(W, x); INC(k)
END;
Texts.Append(T, W.buf);
IF к < PakSize THEN EXIT END
ELSE DEC(retry);
IF retry = 0 THEN
Texts.WriteString(W, " failed"); Texts.WriteLn(W);
Texts.Append(Oberon.Log, W.buf); EXIT
END;
Send(seqno + 10H, 0, dmy)
END;
ReceiveHead(TO)
END
END ReceiveText;
PROCEDURE Mailbox*;
VAR к, X, Y: INTEGER;
T: Texts.Text;
V: Viewers.Viewer;
S: Texts.Scanner;
buf: ARRAY 32 OF CHAR;
BEGIN GetParl(S);
297
IF S.class = Texts.Name THEN
FindPartner(S.s, k);
IF к = 0 THEN
AppendS(Oberon.User, buf, k); AppendW(Oberon.Password, buf, 4, k);
Send(MDIR, k, buf); ReceiveHead(T1);
IF headl.typ = 0 THEN
T := TextFrames.Text("");
Oberon.AllocateSystemViewer(Oberon.Par.frame.X, X, Y);
V := MenuViewers.New(
TextFrames.NewMenu(S.s, "System.Close Net.ReceiveMail Net.DeleteMail”),
TextFrames.NewText(T, 0), TextFrames.menuH, X, Y);
ReceiveText(T)
ELSIF headl.typ = NAK THEN reply(4)
ELSIF headl.typ = NPR THEN reply(2)
ELSE reply(5)
END
ELSE reply(1)
END
END
END Mailbox;
PROCEDURE ReceiveMail*;
VAR к, X, Y: INTEGER;
T: Texts.Text;
F: TextFrames.Frame;
S: Texts.Scanner;
V: Viewers.Viewer;
buf: ARRAY 32 OF CHAR;
BEGIN F := Oberon.Par.frame(TextFrames.Frame);
Texts.OpenScanner(S, F.text, 0); Texts.Scan(S); FindPartner(S.s, k);
IF к = 0 THEN
F := F.next(TextFrames.Frame);
IF F.sel > 0 THEN
Texts.OpenScanner(S, F.text, F.selbeg.pos); Texts.Scan(S);
IF S.class = Texts.Int THEN
к := 0; AppendS(Oberon.User, buf, k); AppendW(Oberon.Password, buf, 4, k);
AppendW(S.i, buf, 2, k); Send(SML, k, buf); ReceiveHead(T1);
IF headl.typ = 0 THEN
T := TextFrames.Text("");
Oberon.AllocateUserViewer(Oberon.Par.frame.X, X, Y);
V := MenuViewers.New(
TextFrames.NewMenu("Message.Text",
"System.Close System.Copy System.Grow Edit.Store"),
TextFrames.NewText(T, 0), TextFrames.menuH, X, Y);
ReceiveText(T)
ELSIF headl.typ = NAK THEN reply(4)
ELSIF headl.typ = NPR THEN reply(2)
ELSE reply(5)
END
298
Выделенный сервер для распространения файлов, почты и печати
Почтовая служба
299
END
END
ELSE reply(1)
END
END ReceiveMail;
PROCEDURE SendMail*;
VAR k: INTEGER;
S: Texts.Scanner;
T, M: Texts.Text;
v: Viewers.Viewer;
buf: ARRAY 64 OF CHAR;
BEGIN GetParl(S);
IF S.class = Texts.Name THEN
FindPartner(S.s, k);
IF к = 0 THEN
v := Oberon.MarkedViewer();
IF (v.dsc # NIL) & (v.dsc.next IS TextFrames.Frame) THEN
T := v.dsc.next(TextFrames.Frame).text;
IF T.len < 60000 THEN
Texts.OpenScanner(S, T, 0); Texts.Scan(S);
IF (S.class = Texts.Name) & (S.s = "To") THEN
M := v.dsc(TextFrames.Frame).text; Texts.OpenScanner(S, M, 0);
Texts.Scan(S);
IF S.class = Texts.Name THEN
Texts.WriteString(W, S.s);
AppendS(Oberon.User, buf, k);
AppendW(Oberon.Password, buf, 4, k);
Send(RML, k, buf); ReceiveHead(T1);
IF headl.typ = ACK THEN
Texts.WriteString(W, " mailing");
Texts.Append(Oberon.Log, W.buf);
SendText(T); reply(O)
ELSIF headl.typ = NPR THEN reply(2)
ELSIF headl.typ = NAK THEN reply(3)
ELSE reply(5)
END
END
ELSE reply(8)
END
ELSE reply(9)
END
END
ELSE reply(1)
END
END
END SendMail;
PROCEDURE DeleteMail*;
300
Выделенный сервер для распространения файлов, почты и печати
VAR к: INTEGER; ch: CHAR;
Т: Texts.Text;
F: TextFrames.Frame;
S: Texts.Scanner;
buf: ARRAY 32 OF CHAR;
BEGIN F := Oberon.Par.frame(TextFrames.Frame);
Texts.OpenScanner(S, F.text, 0); Texts.Scan(S); FindPartner(S.s, k);
IF к = 0 THEN
F := F.next(TextFrames.Frame);
IF F.sel > 0 THEN
Texts.OpenScanner(S, F.text, F.selbeg.pos); Texts.Scan(S);
IF S.class = Texts.Int THEN
к := 0; AppendS(Oberon.User, buf, k); AppendW(Oberon.Password, buf, 4, k);
AppendW(S.i, buf, 2, k); Send(DML, k, buf); ReceiveHead(TI);
IF headl.typ = ACK THEN
REPEAT Texts.Read(S, ch) UNTIL ch < " ";
Texts.Delete(F.text, F.selbeg.pos, Texts.Pos(S))
ELSIF headl.typ = NAK THEN reply(3)
ELSIF headl.typ = NPR THEN reply(2)
ELSE reply(5)
END
END
END
ELSE reply(1)
END
END DeleteMail;
Теперь обратим наше внимание на двойников командных процедур в модуле
NetSewer, приведенных в этом разделе. Предварим объяснение этих подпрограмм
описанием их интерфейса с почтовым сервером и определением структуры почто¬
вых ящиков. Начнем с простейшего случая - двойника SendMail. Это часть проце¬
дуры NetSewer. Sewe, которая защищена условием typ = RML, указывая на запрос
получения почты. Как и во всех других службах, читаются параметры имени и
пароля пользователя и проверяется разрешение на запрос. Проверка выполняет¬
ся процедурой Core.UserNo, которая выдает отрицательное число, если в службе
отказано. В утвердительном случае процедура ReceiveData получает сообщение
и сохраняет его в файле, который затем помещается в очередь почты как задача,
которая позже должна быть обработана почтовым сервером. Это может повлечь
распространение сообщения по нескольким почтовым ящикам.
Модуль Core приведен в разделе 11.5. Как упоминалось ранее, он служит
связью между различными серверными модулями, определяя типы данных свя¬
занных очередей, а также почтовых ящиков. Очереди задач представляются FIFO-
списками. Дескриптор типа Queue содержит указатель на первый извлекаемый
элемент списка и указатель на последний помещаемый элемент (см. рис. 11.3). Эти
указатели не экспортируются; вместо этого вызов процедуры Core.GetTask выдает
очередную задачу, а вызов Core.RemoveTask удаляет ее. Существуют две экспор¬
тируемые переменные типа Queue: MailQueue, используемая в MailSewer, и Print-
Queue, используемая в PnntServer (см. раздел 11.3). (На самом деле мы используем
третью очередь LineQueue, используемую в LineServer.) Элементы очередей имеют
тип TaskDesc, который определяет файл, представляющий принимаемые данные.
Кроме того, он определяет номер пользователя и идентификацию источника за¬
дачи. Модуль Core содержит три процедуры для обработки очередей задач:
PROCEDURE InsertTask(VAR q: Queue; F: Files.File;
VAR id: ARRAY OF CHAR; uno: INTEGER);
PROCEDURE GetTask(VAR q: Queue; VAR F: Files.File;
VAR id: ARRAY OF CHAR; VAR uno: INTEGER);
PROCEDURE RemoveTask(VAR q: Queue);
Рис. 11.3. Структура очереди задач
Серверные двойники остальных почтовых команд обращаются к почтовым
ящикам напрямую. Простота требуемых действий - результат тщательно выбран¬
ного представления почтового ящика - и соображения эффективности не дают
права обойти очередь задач и почтовый сервер.
Каждый почтовый ящик представляется файлом. У такого решения есть
огромное преимущество в том, что для управления отведенными под почтовые
цели сегментами дисковой памяти не нужно вводить никакого особого админист¬
рирования. Файл почтового ящика разделен на три раздела - занятости блоков,
каталога и сообщений. Каждый раздел быстро находится, потому что первые два
имеют фиксированную длину (32 и 31 * 32 = 992 байта). Раздел сообщений счи¬
тается последовательностью блоков (по 256 байтов), а каждое сообщение зани¬
мает целое число смежных блоков. Для каждого блока раздел занятости блоков
содержит отдельный бит, указывающий, занят блок сообщением или нет. Так как
раздел занятости блоков имеет длину 32 байта, раздел сообщений содержит самое
большее 256 блоков, то есть 64 Кб. Длина блока была выбрана на основе анализа
сообщений, который показал, что средняя длина сообщения меньше 500 байтов.
Раздел каталога - это массив из 31 элемента типа MailEntiy, записи с такими
полями: pos и len - индекс первого блока и количество байтов сообщения; time
и date - время и дата поступления сообщения, a originator - источник сообще¬
Почтовая служба
301
Выделенный сервер для распространения файлов, почты и печати
ния. Записи связаны (полем next) в хронологическом порядке их поступления,
а запись 0 служит заголовком списка. Из этого следует, что почтовый ящик со¬
держит не более 30 сообщений. Состояние почтового ящика показывает пример
на рис. 11.4.
MailEntry = RECORD
pos, next: INTEGER;
len: LONGINT;
time, date: INTEGER;
originator: ARRAY 20 OF CHAR
END ;
MResTab = ARRAY 8 OF SET;
MailDir = ARRAY 31 OF MailEntry;
Рис. 11.4. Состояние файла почтового ящика
Теперь мы в состоянии рассмотреть обработчик запросов на извлечение со¬
общений. Он защищен условием typ = SML. После проверки разрешений откры¬
вается файл почтового ящика соответствующего заявителя. Последний открытый
почтовый ящик сохраняется в глобальной переменной MF, которая действует
как единственный вход кэша. Соответствующий код пользователя задается гло¬
бальной переменной mailuno. Так как обычно к одному почтовому ящику следуют
несколько запросов, эта мера позволяет избежать повторного открытия данного
файла. После этого бегунок встает непосредственно в позицию в соответствующей
записи каталога для чтения длины сообщения и его позиции в разделе сообщений.
Согласно им, бегунок переставляется, а процедура SendMail обрабатывает пере¬
дачу сообщения.
Запросы к каталогу почтового ящика обрабатываются подпрограммой, защи¬
щенной условием typ = MDIR. Раздел каталога должен быть прочитан и преоб¬
разован в текст. Эта задача поддерживается различными вспомогательными про-
I 302
цедурами (Append...), которые объединяют поставляемые данные в буфере для
последующей передачи. Подчеркнем, что этот запрос не требует чтения других
разделов файла и потому очень быстр.
Последний из четырех запросов к почтовой службе (DML) удаляет указанное
сообщение. Удаление из каталога требует иеренривязки записей. Неиспользуемые
записи помечаются значением 0 в их поле len. Кроме того, занимаемые сообще¬
нием блоки освобождаются, а раздел занятости блоков соответствующим образом
обновляется. Остальные подробности можно узнать из следующего текста про¬
граммы.
MODULE NetServer; (*NW 15.2.90 / 22.11.91*)
IMPORT SCC, Core, FileDir, Files, Oberon, Texts;
CONST PakSize = 512; GCInterval = 50;
TO = 300; T1 = 1000; (*время ожидания*)
maxFileLen = 100000H;
ACK = 10H; NAK = 25H; NPR = 26H; (*подтверждения приема*)
NRQ = 34H; NRS = 35H; (*имя: запрос, отклик*)
SND = 41H; REC = 42H; (*запрос на отправку/получение*)
FDIR = 45Н; DEL = 49H; (*запросы каталога и удаления файла*)
PRT = 43Н; (*запрос принятия к печати*)
TRQ = 46Н; TIM = 47Н; (*запросы времени*)
MSG = 44Н; NPW = 48Н; (*запрос нового пароля*)
ТОТ = 7FH; (*время ожидания*)
MDIR = 4АН; SML = 4ВН; RML = 4СН; DML = 4DH;
VAR W: Texts.Writer;
handler: Oberon.Task;
headO, headl: SCC.Header;
partner: Core.ShortName;
seqno: SHORTINT;
K, reqent, mailuno: INTEGER;
protected: BOOLEAN;
MF: Files.File; (*последний доступный почтовый файл*)
buf: ARRAY 1024 OF CHAR; (*используется FDIR и MDIR*)
dmy: ARRAY 4 OF CHAR;
PROCEDURE E0L;
BEGIN Texts.WriteLn(W); Texts.Append(0beron.Log, W.buf)
END E0L;
PROCEDURE SetPartner (VAR name: ARRAY OF CHAR);
BEGIN headO.dadr := headl.sadr; headO.destLink- := headl.srcLink;
C0PY(name, partner)
END SetPartner;
PROCEDURE Send (t: SHORTINT; L: INTEGER; VAR data: ARRAY OF CHAR);
Почтовая служба
303
BEGIN headO.typ := t; headO.len := L; SCC.SendPacket(headO, data)
END Send;
PROCEDURE ReceiveHead (timeout: LONGINT);
VAR time: LONGINT;
BEGIN time := Oberon.Time() + timeout;
LOOP SCC.ReceiveHead(headl);
IF headl.valid THEN
IF headl.sadr = headO.dadr THEN EXIT
ELSE SCC.Skip(head1.len)
END
ELSIF Oberon.Time() >= time THEN headl.typ := TOT; EXIT
END
END
END ReceiveHead;
PROCEDURE Appends (VAR s, d: ARRAY OF CHAR; VAR k: INTEGER);
VAR i: INTEGER; ch: CHAR;
BEGIN i := 0;
REPEAT ch := s[i]; d[k] := ch; INC(i); INC(k) UNTIL ch = OX
END AppendS;
PROCEDURE AppendW (s: LONGINT; VAR d: ARRAY OF CHAR; n: INTEGER;
VAR k: INTEGER);
VAR i: INTEGER;
BEGIN i := 0;
REPEAT d[k] := CHR(s); s := s DIV 100H; INC(i); INC(k) UNTIL i = n
END AppendW;
PROCEDURE AppendN (x: LONGINT; VAR d: ARRAY OF CHAR; VAR k: INTEGER);
VAR i: INTEGER; u: ARRAY 8 OF CHAR;
BEGIN i := 0;
REPEAT u[i] := CHR(x MOD 10 + ЗОН); INC(i); x := x DIV 10 UNTIL x = 0;
REPEAT DEC(i); d[k] := u[i]; INC(k) UNTIL i = 0
END AppendN;
PROCEDURE AppendDate (t, d: INTEGER; VAR buf: ARRAY OF CHAR; VAR k: INTEGER);
PROCEDURE Pair (ch: CHAR; x: LONGINT);
BEGIN buf[k] := ch; INC(k);
buf[k] := CHR(x DIV 10 + ЗОН); INC(k); buf[k] := CHR(x MOD 10 + ЗОН); INC(k)
END Pair;
BEGIN
Pair(" ", d MOD 20H); Pair(".", d DIV 20H MOD 10H); Pair(V\ d DIV 200H MOD 80H);
Pair(" ", t DIV 800H MOD 20H); Pair(":", t DIV 20H MOD 40H);
Pair(":", t MOD 20H * 2)
END AppendDate;
PROCEDURE SendBuffer (len: INTEGER; VAR done: BOOLEAN);
VAR i, kd, ks: INTEGER; ch: CHAR;
BEGIN
!■■■£
304J
Выделенный сервер для распространения файлов, почты и печати
Почтовая служба
305
REPEAT Send(seqno, len, buf); ReceiveHead(T1)
UNTIL headl.typ # seqno + 10H;
seqno := (seqno + 1) MOD 8; kd := 0; ks := PakSize;
WHILE ks < К DO buf[kd] := buf[ks]; INC(kd); INC(ks) END;
К := kd; done := headl.typ = seqno + 10H
END SendBuffer;
PROCEDURE* AppendDirEntry (name: FileDir.FileName; adr: LONGINT;
VAR done: BOOLEAN);
VAR i, kd, ks: INTEGER; ch: CHAR;
BEGIN i := 0; ch := name[0];
WHILE ch > OX DO buf[K] := ch; INC(i); INC(K); ch := name[i] END;
buf[K] := ODX; INC(K);
IF К >= PakSize THEN SendBuffer(PakSize, done) END
END AppendDirEntry;
PROCEDURE PickS (VAR s: ARRAY OF CHAR);
VAR i, n: INTEGER; ch: CHAR;
BEGIN i := 0; n := SHORT(LEN(s)) - 1; SCC.Receive(ch);
WHILE ch > OX DO
IF i < n THEN s[i] := ch; INC(i) END;
SCC.Receive(ch)
END;
s[i] := OX
END PickS;
PROCEDURE PickQ (VAR w: LONGINT);
VAR cO, cl, c2: CHAR; s: SHORTINT;
BEGIN SCC.Receive(cO); SCC.Receive(cl); SCC.Receive(c2); SCC.Receive(s);
w := s; w := ((w * 100H + L0NG(c2)) * 100H + LONG(cl)) * 100H + LONG(cO)
END PickQ;
PROCEDURE PickW (VAR w: INTEGER);
VAR cO: CHAR; s: SHORTINT;
BEGIN SCC.Receive(cO); SCC.Receive(s); w := s; w := w * 100H + ORD(cO)
END PickW;
PROCEDURE SendData (F: Files.File);
VAR k: INTEGER;
x: CHAR;
len: LONGINT;
R: Files.Rider;
BEGIN Files.Set(R, F, 0); len := 0; seqno := 0;
LOOP к := 0;
LOOP Files.Read(R, x);
IF R.eof THEN EXIT END;
buf[k] := x; INC(k);
IF к = PakSize THEN EXIT END
END;
REPEAT Send(seqno, k, buf); ReceiveHead(TI)
306
Выделенный сервер для распространения файлов, почты и печати
UNTIL headl.typ # seqno + 10H;
seqno := (seqno + 1) MOD 8; len := len + k;
IF headl.typ # seqno + 10H THEN EXIT END;
IF к < PakSize THEN EXIT END
END
END SendData;
PROCEDURE ReceiveData (F: Files.File; VAR done: BOOLEAN);
VAR k, retry: INTEGER;
x: CHAR;
len: LONGINT;
R: Files.Rider;
BEGIN Files.Set(R, F, 0); seqno := 0; len := 0; retry := 4;
LOOP
IF headl.typ = seqno THEN
seqno := (seqno + 1) MOD 8; len := len + headl.len;
IF len > maxFileLen THEN
Send(NAK, 0, dmy); done := FALSE; Files.Close(F); Files.Purge(F);
EXIT
END;
retry := 4; Send(seqno + 10H, 0, dmy); к := 0;
WHILE к < headl.len DO
SCC.Receive(x); Files.Write(R, x); INC(k)
END;
IF к < PakSize THEN done := TRUE; EXIT END
ELSE DEC(retry);
IF retry = 0 THEN done := FALSE; EXIT END;
Send(seqno + 10H, 0, dmy)
END;
ReceiveHead(TO)
END
END ReceiveData;
PROCEDURE SendMail (VAR R: Files.Rider; len: LONGINT);
VAR k: INTEGER; x: CHAR;
buf: ARRAY PakSize OF CHAR;
BEGIN seqno := 0;
LOOP к := 0;
LOOP Files.Read(R, x);
IF к = len THEN EXIT END;
buf[k] := x; INC(k);
IF к = PakSize THEN EXIT END
END;
REPEAT Send(seqno, k, buf); ReceiveHead(T1)
UNTIL headl.typ # seqno + 10H;
seqno := (seqno +1) MOD 8; len := len - k;
IF headl.typ # seqno + 10H THEN EXIT END;
IF к < PakSize THEN EXIT END
END
Почтовая служба
FWrl
END SendMail;
PROCEDURE* Serve;
VAR i, j, kO, k1, n, uno: INTEGER;
ch: CHAR; typ: SHORTINT;
done: BOOLEAN;
F: Files.File;
R: Files.Rider;
t, d, pw, npw, pos, len: LONGINT;
Id: Core.ShortName;
fname: Core.Name;
mdir: Core.MailDir;
mrtab: Core.MResTab;
EGIN SCC.ReceiveHead(head1);
IF "headl.valid THEN RETURN END;
typ := headl.typ;
IF typ = SND THEN
PickS(Id); PickQ(pw); PickS(fname); SetPartner(Id);
IF Core.UserNo(Id, pw) >= 0 THEN
F := Files.Old(fname);
IF F # NIL THEN SendData(F)
ELSE Send(NAK, 0, dmy)
END
ELSE Send(NPR, 0, dmy)
END
ELSIF typ = REC THEN
PickS(Id); PickQ(pw); PickS(fname); SetPartner(Id);
IF "protected & (Core.UserNo(Id, pw) >= 0) THEN
F := Files.New(fname);
Send(ACK, 0, dmy); ReceiveHead(TO);
IF headl.valid THEN
ReceiveData(F, done);
IF done THEN Files.Register(F) END
END
ELSE Send(NPR, 0, dmy)
END
ELSIF typ = PRT THEN
PickS(Id); PickQ(pw); SetPartner(Id); uno := Core.UserNo(Id, pw);
IF uno >= 0 THEN
F := Files.New("");
Send(ACK, 0, dmy); ReceiveHead(TO);
IF headl.valid THEN
ReceiveData(F, done);
IF done THEN Files.Close(F);
Core.InsertTask(Core.PrintQueue, F, Id, uno) END
END
ELSE Send(NPR, 0, dmy)
END
ELSIF typ = DEL THEN
308
PickS(Id); PickQ(pw); PickS(fname); SetPartner(Id);
IF "protected & (Core.UserNo(Id, pw) >= 0) THEN
Files.Delete(fname, k);
IF к = 0 THEN Send(ACK, 0, dmy) ELSE Send(NAK, 0, dmy) END
ELSE Send(NPR, 0, dmy)
END
ELSIF typ = FDIR THEN
PickS(Id); PickQ(pw); PickS(fname); SetPartner(Id);
uno := Core.UserNo(Id, pw);
IF uno >= 0 THEN
К := 0; seqno := 0; FileDir.Enumerate(fname, AppendDirEntry);
SendBuffer(K, done)
ELSE Send(NPR, 0, dmy)
END
ELSIF typ = MDIR THEN
PickS(Id); PickQ(pw); SetPartner(Id); uno := Core.UserNo(Id, pw);
IF uno >= 0 THEN
IF uno # mailuno THEN
Core.GetFileName(uno, fname); MF := Files.Old(fname); mailuno := uno
END;
К := 0; seqno := 0;
IF MF # NIL THEN
Files.Set(R, MF, 32); Files.ReadBytes(R, mdir, SIZE(Core.MailDir));
i := mdir[0]. next; j := 30; done := TRUE;
WHILE (i # 0) & (j > 0) & done DO
AppendN(i, buf, K); AppendDate(mdir[i],time,
mdir[i].date, buf, K);
buf[K] := " "; INC(K); AppendS(mdir[i].originator, buf, K);
buf[K-1] := " "; AppendN(mdir[i].len, buf, K); buf[K] := ODX;
INC(К);
IF К >= PakSize THEN SendBuffer(PakSize, done) END;
i := mdir[i].next; DEC(j)
END
END;
SendBuffer(K, done)
ELSE Send(NPR, 0, dmy)
END
ELSIF typ = SML THEN (^отправить почту *)
PickS(Id); PickQ(pw); PickW(n); SetPartner(Id); uno := Core.UserNo(Id, pw);
IF uno >= 0 THEN
IF uno # mailuno THEN
Core.GetFileName(uno, fname); MF := Files.Old(fname); mailuno := uno
END;
IF(MF # NIL) & (n > 0) & (n < 31) THEN
Files.Set(R, MF, (n + 1)*32);
Files.ReadBytes(R, i, 2); Files.ReadBytes(R, j, 2);
pos := LONG(i) * 100H;
Files.ReadBytes(R, len, 4);
IF len > 0 THEN Files.Set(R, MF, pos); SendMail(R, len)
Выделенный сервер для распространения файлов, почты и печати
ELSE Send(NAK, 0, dmy)
END
ELSE Send(NAK, 0, dmy)
END
ELSE Send(NPR, 0, dmy)
END
ELSIF typ = RML THEN (*принять почту*)
PickS(Id); PickQ(pw); SetPartner(Id); uno := Core.UserNo(Id, pw);
IF uno >= 0 THEN
F := Files.New("");
Send(ACK, 0, dmy); ReceiveHead(TO);
IF headl.valid THEN
ReceiveData(F, done);
IF done THEN Files.Close(F);
Core.InsertTask(Core.MailQueue, F, Id, uno) END
END
ELSE Send(NPR, 0, dmy)
END
ELSIF typ = DML THEN (*удалить почту*)
PickS(Id); PickQ(pw); PickW(n); SetPartner(Id); uno := Core.UserNo(Id, pw);
IF uno >= 0 THEN
IF uno # mailuno THEN
Core.GetFileName(uno, fname); MF := Files.Old(fname); mailuno := uno
END;
IF(MF # NIL) & (n > 0) & (n < 31) THEN
Files.Set(R, MF, 0);
Files.ReadBytes(R, mrtab, 32);
Files.ReadBytes(R, mdir, SIZE(Core.MailDir));
i := 0; ks := 30;
LOOP к := mdir[i].next; DEC(ks);
IF (k = 0) OR (ks = 0) THEN Send(NAK, 0, buf); EXIT END;
IF к = n THEN
j := mdir[n].pos;
к := SHORT((mdir[n].len + LONG(j)* 10ОН) DIV 100H) + 1;
REPEAT INCL(mrtab[j DIV 32], j MOD 32); INC(j) UNTIL j = k;
mdir[n].len := 0; mdir[i].next := mdir[n].next;
Files.Set(R, MF, 0); Files.WriteBytes(R, mrtab, 32);
Files.WriteBytes(R, mdir, SIZE(Core.MailDir)); Files.Close(MF);
Send(ACK, 0, dmy); EXIT
END;
i := к
END
ELSE Send(NAK, 0, dmy)
END
ELSE Send(NPR, 0, dmy)
END
ELSIF typ = TRQ THEN
Oberon.GetClock(t, d); SetPartner(Id); i := 0;
AppendW(t, fname, 4, i); AppendW(d, fname, 4, i); Send(TIM, 8, fname)
Почтовая служба
I 309
310
Выделенный сервер для распространения файлов, почты и печати
ELSIF typ = NRQ THEN i := 0;
LOOP SCC.Receive(ch); Id[i] := ch; INC(i);
IF ch = OX THEN EXIT END;
IF i = 7 THEN Id[7] := OX; EXIT END
END;
WHILE l < headl.len DO SCC.Receive(ch); INC(i) END;
IF Id = Oberon.User THEN SetPartner(Id); Send(NRS, 0, dmy) END
ELSIF typ = MSG THEN l := 0;
WHILE i < headl.len DO SCC.Receive(ch); Texts.Write(W, ch); INC(i) END;
SetPartner(Id); Send(ACK, 0, dmy); EOL
ELSIF typ = NPW THEN
PickS(Id); PickQ(pw); uno := Core.UserNo(Id, pw);
IF uno >= 0 THEN
SetPartner(Id); Send(ACK, 0, dmy); ReceiveHead(TO);
IF headl.typ = 0 THEN
PickQ(npw); Core.SetPassword(uno, npw); Send(ACK, 0, dmy)
ELSE Send(NAK, 0, dmy)
END
ELSE Send(NPR, 0, dmy)
END
ELSE SCC.Skip(head1.len)
END;
Core.Collect
END Serve;
(* Команды *)
PROCEDURE Start*;
VAR password: ARRAY 4 OF CHAR;
S: Texts.Scanner;
BEGIN Texts.OpenScanner(S, Oberon.Par.text, Oberon.Par.pos); Texts.Scan(S);
IF S.class = Texts.Name THEN
Oberon.Remove(handler); Oberon.Install(handler);
reqcnt := 0; MF := NIL; mailuno := - 2;
password[0] := OX; Oberon.SetUser(S.s, password);
Texts.WriteString(W, "Net started (NW 22.11.91)"); EOL
END
END Start;
PROCEDURE Reset*;
BEGIN SCC.Start(TRUE)
END Reset;
PROCEDURE Stop*;
BEGIN Oberon.Remove(handler); Texts.WriteString(W, "Net stopped"); EOL
END Stop;
PROCEDURE Protect*;
BEGIN protected := TRUE
Почтовая служба
311
END Protect;
PROCEDURE Unprotect*;
BEGIN protected := FALSE
END Unprotect;
BEGIN Texts.OpenWriter(W); NEW(handler); handler.handle := Serve
END NetServer.
Попутно отметим, что использование файлов для представления почтовых
ящиков совместно со службами распространения файлов, находящимися на том
же сервере, позволяет любому обращаться (и проверять) любой почтовый ящик.
Хотя мы не утверждаем, что эта система обеспечивает безопасную защиту от
шпионажа, минимальные усилия для защиты были предприняты простым шиф¬
рованием сообщений в файлах почтового ящика. Это шифрование не приводится
в текстах программ данной книги.
Одна оставшаяся операция требует более подробного объяснения - это об¬
работка задач, помещаемых в почтовую очередь. Она заключается в помещении
сообщения, представленного файлом задачи, в один или несколько почтовых ящи¬
ков. Она выполняет интерпретацию заголовка сообщения, то есть строк с адреса¬
ми, и построение нового заголовка, содержащего имя источника и дату помещения
в почтовый ящик. Эти действия выполняются процедурами в модуле MailServer.
Его процедура Sewe установлена как задача Оберона и защищена условием Core.
MailQueue.n > 0, означающим, что должно быть отправлено, по крайней мере, одно
сообщение.
Имя источника получается из Core.GetUserName (uno), где uno - помер поль¬
зователя, полученный из его записи в очереди. Фактическое время получается из
Oberon.GetClock. Вид нового заголовка показан в следующем примере:
From; Gutknecht
At: 12.08.91 09:34:15
Затем для принятого заголовка сообщения ищутся получатели. Их имена пе¬
речислены в строках заголовка, начинающихся с «То» (или «сс»). После того как
прочитано имя, с помощью вызова процедуры Core.UserNum получается номер
соответствующего пользователя. Затем процедурой Dispatch сообщение помеща¬
ется в назначенный почтовый ящик. Поиск получателей продолжается до тех пор,
пока не появится строка, не начинающаяся с «То» (или «сс»). Отрицательный но¬
мер пользователя указывает на то, что данное имя не зарегистрировано. В этом
случае сообщение возвращается отправителю, то есть помещается в почтовый
ящик отправителя. Исключение - получатель «all», который задает рассылку всем
зарегистрированным пользователям.
Процедура Dispatch сначала открывает файл почтового ящика пользователя,
заданного номером получателя то. Если почтовый ящик существует, читаются
его разделы занятости блоков (mrtab) и каталога (mdir). В противном случае со-
здается новый, пустой ящик. Затем следует поиск свободного места в каталоге и
если оно найдено, поиск достаточного числа свободных смежных блоков в разделе
сообщений. Число необходимых блоков задается длиной сообщения. Если нет ни
свободных мест, ни достаточного свободного пространства в разделе сообщений,
сообщение возвращается отправителю (заданному sno). Если же и эта попытка
терпит неудачу, сообщение переадресуется почтмейстеру (с номером пользовате¬
ля 0). Предполагается, что почтмейстер проверяет свой почтовый ящик достаточ¬
но часто, чтобы не произошло переполнения. Если же почтовый ящик почтмейсте¬
ра тоже переполнен, сообщение теряется.
Только когда выполнены все условия для успешного завершения, начинается
вставка. Она начинается с пометки блоков в таблице занятости и со вставки в ката¬
лог новой информации. Затем таблица и каталог файла обновляются. После этого
сообщение с созданным новым заголовком записывается в раздел сообщений.
MODULE MailServer; (*NW 17.4.89 / 25.8.91*)
IMPORT Core, Files, Oberon, Texts;
VAR W: Texts.Writer;
handler: Oberon.Task;
PROCEDURE Dispatch (F: Files.File; rno, sno, hdlen: INTEGER;
VAR orig, head: ARRAY OF CHAR);
(*вставить внешнее сообщение (из msg) в почтовый ящик получателя rno*)
VAR i, j, k, h: INTEGER;
ch: CHAR; ok: BOOLEAN;
pos, L, bdylen, tm, dt: LONGINT;
fname: Core.Name;
MF: Files. File; ^назначение*)
R, Q: Files.Rider;
mrtab: Core.MResTab;
mdir: Core.MailDir;
BEGIN Core.GetFileName(rno, fname); MF := Files.Old(fname);
IF MF # NIL THEN
Files.Set(Q, MF, 0); Files.ReadBytes(Q, mrtab, 32);
Files.ReadBytes(Q, mdir, SIZE(Core.MailDir))
ELSE (*создать новый файл почтового ящика*)
MF := Files.New(fname); Files.Set(Q, MF, 0); Files.Register(MF);
mdir[0].next := 0; mrtab[0] := {4 .. 31}; i := 1;
REPEAT mrtab[i] := {0 .. 31}; INC(i) UNTIL i = 7;
mrtab[7] := {0 .. 29}; i := 0;
REPEAT mdir[i]. len := 0; INC(i) UNTIL i = 31
END;
Files.Set(R, F, 0); bdylen := Files.Length(F);
ok := FALSE; i := 0;
REPEAT INC(i) UNTIL (i = 31) OR (mdir[i].len = 0);
IF i < 31 THEN (свободный слот найден, теперь ищем свободные блоки в файле*)
j := - 1;
REPEAT INC(j);
■■111
312
Выделенный сервер для распространения файлов, почты и печати
Почтовая служба
IF j MOD 32 IN mrtab[j DIV 32] THEN
h := j; к := SH0RT((bdylen + hdlen + 255) DIV 256) + j;
LOOP INC(h);
IF h = к THEN ok := TRUE; EXIT END;
IF(h = 256) OR "(h MOD 32 IN mrtab[h DIV 32]) THEN j := h
EXIT END
END
END
UNTIL ok OR (j >= 255)
END;
IF ok THEN (*вставить msg в блоки j .. k-1*)
pos := LONG(j) * 256; mdir[i].pos := j;
REPEAT EXCL(mrtab[j DIV 32], j MOD 32); INC(j) UNTIL j = k;
mdir[i].len ;= bdylen + hdlen;
Oberon.GetClock(tm, dt);
mdir[i].time := SH0RT(tm DIV 2); mdir[i].date := SHORT(dt);
j : = 0;
WHILE (j < 19) & (orig[j] > " ") DO mdir[i].originator[j] := orig[j];
INC(j) END;
mdir[i].originator[j] := OX;
mdir[i].next := mdir[0].next; mdir[0].next := i;
Files.Set(Q, MF, 0); Files.WriteBytes(Q, mrtab, 32);
Files.WriteBytes(Q, mdir, SIZE(Core.MailDir)); Files.Set(Q, MF, pos);
j := 0;
WHILE j < hdlen DO
Files.Write(Q, head[j]); INC(j)
END;
j := 0;
WHILE j < bdylen DO
Files.Read(R, ch); Files.Write(Q, ch); INC(j)
END;
L := ( - Files.Pos(Q)) MOD 256;
WHILE L > 0 DO Files.Write(Q, 0); DEC(L) END;
Files.Close(MF)
ELSIF (rno # sno) & (sno > 0) THEN (*вернуть отправителю*)
Dispatch(F, sno, sno, hdlen, orig, head)
ELSIF (rno # 0) & (sno # 0) THEN (*отправить почтмейстеру*)
Dispatch(F, 0, sno, hdlen, orig, head)
END
END Dispatch;
PROCEDURE* Serve;
VAR i, j, sno, rno, hdlen: INTEGER;
ch: CHAR;
pos, dt, tm: LONGINT;
F: Files.File; R: Files.Rider;
Id: Core.ShortName;
orig: Core.LongName;
head, recip: ARRAY 64 OF CHAR;
313
PROCEDURE Pair (ch: CHAR; x: LONGINT);
BEGIN head[j ] := ch; INC(j);
head[j] := CHR(x DIV 10 + ЗОН); INC(j); head[j] := CHR(x MOD 10 + ЗОН); iNC(j)
END Pair;
BEGIN
IF Core.MailQueue.n > 0 THEN
Core.GetTask(Core.MailQueue, F, Id, sno);
Core.GetUserName(sno, orig); Oberon.GetClock(tm, dt);
C0PY("From: ", head); i := 0; j := 6;
WHILE orig[i] > OX DO head[j] := origfi]; INC(i); INC(j) END;
head[j] := ODX; INC(j); head[j] := "A"; INC(j); head[j] := "t"; INC(j);
head[j] := ":"; INC(j);
Pair(" ", dt MOD 20H); Pair(".", dt DIV 20H MOD 10H);
Pair(".", dt DIV 200H MOD 80H);
Pair(” ", tm DIV 1000H MOD 20H); Pair(":", tm DIV 40H MOD 40H);
Pair(":", tm MOD 40H);
head[j] := ODX; hdlen := j + 1;
Files.Set(R, F, 0);
LOOP (следующая строчка*) pos := Files. Pos(R);
REPEAT Files.Read(R, ch) UNTIL (ch > " ") OR R.eof;
IF R.eof THEN EXIT END;
i := 0;
REPEAT recip[i] := ch; INC(i); Files.Read(R, ch) UNTIL ch <=
recip[i] := OX;
IF (recip # "To") & (recip # "cc") THEN EXIT END;
LOOP (*следующий получатель*)
WHILE " " <= ch DO Files.Read(R, ch) END;
IF ch < " " THEN EXIT END;
i := 0;
WHILE ch > " " DO recip[i] := ch; INC(i); Files.Read(R, ch) END;
recip[i] := OX;
IF recip = "all" THEN rno := Core.NofUsers();
WHILE rno > 1 DO (исключить почтмейстера*)
DEC(rno); Dispatch(F, rno, 0, hdlen, orig, head)
END
ELSE rno := Core.UserNum(recip);
IF rno < 0 THEN rno := sno END;
Dispatch(F, rno, sno, hdlen, orig, head)
END;
IF ch = THEN Files.Read(R, ch) END
END
END;
Core.RemoveTask(Core.MailQueue)
END
END Serve;
(* Команды *)
Выделенный сервер для распространения файлов, почты и печати
314
PROCEDURE Start*;
BEGIN Oberon.Install(handler);
Texts.WriteString(W, "Mailer started (NW 25.8.91)")
Texts.WriteLn(W); Texts.Append(Oberon.Log, W.buf)
END Start;
PROCEDURE State*;
BEGIN Texts.WriteString(W, "Mail queue:"); Texts.WriteInt(W, Core.MailQueue.n, 3);
Texts.WriteLn(W); Texts.Append(Oberon.Log, W.buf)
END State;
PROCEDURE Stop*;
BEGIN Oberon.Remove(handler); Texts.WriteString(W, "Mailer stopped");
Texts.WriteLn(W); Texts.Append(Oberon.Log, W.buf)
END Stop;
BEGIN Texts.OpenWriter(W); NEW(handler); handler.handle := Serve
END MailServer.
Возможно, читателю покажется, что добавление отдельного модуля MailSewer
вместе с новой задачей Оберона и механизмом почтовой очереди не оправдано
относительной простотой операции помещения сообщения в ящик и что она, как
и извлечение сообщения, могла бы быть встроена в модуль NetSewer. Однако кар¬
тина меняется, когда требуется добавить обработку внешней почты и когда доступ
к почтовым ящикам должен обеспечиваться по другим каналам, например по ли¬
нии RS-232. Предложенное решение основано на модульной структуре, которая
облегчает такие расширения без изменения существующих частей. Внешние поч¬
товые подпрограммы неизбежно должны справляться с форматами сообщений
принятых стандартов. Возникает необходимость в преобразовании формата - ко¬
дировании перед отправкой на внешний сервер и декодировании перед помеще¬
нием в ящик. На самом деле эти операции до крайней степени раздували модуль
MailSewer. И наконец, механизм очереди поддерживает простое добавление до¬
полнительных источников сообщений и обеспечивает приемлемое разделение и
ослабление ограничений по времени, особенно в случае таких низкоскоростных
передающих сред, как телефонные линии.
11.3. Служба печати
Выделенный сервер также используется как централизованное средство печа¬
ти для всех рабочих станций, связанных сетью. На рабочих станциях команды пе¬
чати - это часть различных инструментальных модулей систем редактирования,
например Edit.Print (глава 5) и Draw.Pnnt (глава 13). Документы, которые дожны
печататься, как правило, состоят из таких разных элементов, как строки символов,
линии, окружности и т. д. Команды печати перебирают эти элементы и для каж¬
дого элемента вызывают соответствующую процедуру модуля Printer, интерфейс
которого приведен в главе 5. Затем эти процедуры объединяют полученную ин-
Служба печати
[3151
формацию и отправляют ее на сервер печати в закодированном виде. Синтаксис
этого потока данных следующий:
PrintStream = Tag {element}.
element = string | continuation | line | xline | circle | ellipse | area | font | page.
string = 0 fno x у {char}.
continuation = 1 fno {char}.
line = 2 0 x у w h.
xline = 6 0 xO yO x1 y1.
circle = 9 0 x у r.
ellipse = 7 0 x у a b.
area = 5 patno x у w h.
font = 3 fno fontname.
page = 4 copies.
х, у, w, h, г, а, b - координаты позиции, ширина, высота, радиус, закодирован¬
ные в 2 байтах, /по - номер шрифта, patno - номер точечного шаблона, которым
должна заполняться прямоугольная область. Команда page говорит о том, что
предшествующие ей элементы образуют страницу, a copies задает число печатае¬
мых копий.
Поток печати передается на сервер как серия пакетов. Данные, получаемые
вызовами процедур печати, накапливаются в локальном буфере, пока не достиг¬
нут размера пакета. Каждая команда печати сначала должна установить связь
с сервером с помощью вызова Printer.Open. Кроме того, она должна указать разры¬
вы страниц вызовами Printer.Page и завершиться вызовом Printer. Close. Очевидно,
форматирование печатного документа - обязанность соответствующей команды
печати редактора. Приведенный ниже модуль Printer просто управляет кодирова¬
нием, буферизацией и передачей.
MODULE Printer; (*NW 27.6.88 / 11.3.91*)
IMPORT SCC, SYSTEM, Input;
CONST maxfonts = 16;
PakSize = 512; Broadcast = -1;
TO = 300; T1 = 1200;
ACK = 10H; NAK = 25H;
NRQ = 34H; NRS = 35H;
PRT = 43H; NPR = 26H; TOT = 7FH;
VAR res*: INTEGER; (*0 = выполнено, 1 = не выполнено*)
PageWidth*, PageHeight*: INTEGER;
nofonts: INTEGER;
seqno: SHORTINT;
headO: SCC.Header; (отправитель*)
headl: SCC.Header; (получатель*)
in: INTEGER;
PrinterName: ARRAY 10 OF CHAR;
Выделенный сервер для распространения файлов, почты и печати
316]
Служба печати
fontname: ARRAY maxfonts, 32 OF CHAR;
buf: ARRAY PakSize OF SYSTEM.BYTE;
PROCEDURE ReceiveHead;
VAR time: LONGINT;
BEGIN time := Input.Time() + TO;
LOOP SCC.ReceiveHead(head1);
IF headl.valid THEN
IF headl.sadr = headO.dadr THEN EXIT ELSE SCC.Skip(head1.len) END
ELSIF Input.Time() >= time THEN headl.typ := TOT; EXIT
END
END
END ReceiveHead;
PROCEDURE FindPrinter (VAR name: ARRAY OF CHAR);
VAR time: LONGINT;
id: ARRAY 10 OF CHAR;
BEGIN headO.typ := NRQ; headO.dadr := Broadcast; headO.len := 10;
headO.destLink := 0; C0PY(name, id); id[8] := 6X; id[9] := OX;
SCC.Skip(SCC.Available()); SCC.SendPacket(headO, id); time := Input.TimeO +
LOOP SCC.ReceiveHead(head1);
IF headl.valid THEN
IF headl.typ = NRS THEN headO.dadr := headl.sadr; res := 0; EXIT
ELSE SCC.Skip(head1.len)
END
ELSIF Input.TimeO >= time THEN res := 1; EXIT
END
END
END FindPrinter;
PROCEDURE SendPacket;
BEGIN headO.typ := seqno; headO.len := in;
REPEAT SCC.SendPacket(headO, buf); ReceiveHead;
UNTIL headl.typ # seqno + ACK;
seqno := (seqno + 1) MOD 8;
IF headl.typ # seqno + ACK THEN res := 1 END
END SendPacket;
PROCEDURE Send (x: SYSTEM.BYTE);
BEGIN buf[in] := x; INC(in);
IF in = PakSize THEN SendPacket; in := 0 END
ENDSend;
PROCEDURESendInt(k: INTEGER);
BEGIN Send(SHORT(k MOD 100H)); Send(SHORT(k DIV 100H))
END Sendlnt;
PROCEDURE SendBytes (VAR x: ARRAY OF SYSTEM.BYTE; n: INTEGER);
VAR i: INTEGER;
BEGIN i := 0;
[317]
WHILE i < n DO Send(x[i]); INC(i) END
END SendBytes;
PROCEDURE SendString (VAR s: ARRAY OF CHAR);
VAR 1: INTEGER;
EGIN i := 0;
WHILE s[i] > OX DO Send(s[i]); INC(i) END;
Send(O)
END SendString;
PROCEDURE Open* (VAR name, user: ARRAY OF CHAR; password: LONGINT);
BEGIN nofonts := 0; in := 0; seqno := 0; SCC. Skip(SCC. AvailableO);
IF name # PrinterName THEN FindPrinter(name) ELSE res := 0 END;
IF res = 0 THEN
SendString(user); SendBytes(password, 4);
headO.typ := PRT; headO.len := in; SCC.SendPacket(headO, buf); in := 0;
ReceiveHead;
IF headl.typ = ACK THEN Send(OFCX) (*printfileid*)
ELSIF headl.typ = NPR THEN res := 4 (*нет разрешения*)
ELSE res : = 2 (*нет принтера*)
END
END
END Open;
PROCEDURE ReplConst* (x, y, w, h: INTEGER);
BEGIN Send(2); Send(O);
Sendlnt(x); Sendlnt(y); Sendlnt(w); Sendlnt(h)
END ReplConst;
PROCEDURE fontno (VAR name: ARRAY OF CHAR): SHORTINT;
VAR i, j: INTEGER;
BEGIN i := 0;
WHILE (i < nofonts) & (fontname[i] # name) DO INC(i) END;
IF i = nofonts THEN
IF nofonts < maxfonts THEN
COPY(name, fontname[i]); INC(nofonts);
Send(3); Send(SHORT(i)); j := 0;
WHILE name[j] >= "0" DO Send(name[j]); INC(j) END;
Send(O)
ELSE i := 0
END
END;
RETURN SHORT(i)
END fontno;
PROCEDURE UseListFont* (VAR name: ARRAY OF CHAR);
VAR i: INTEGER;
listfont: ARRAY 10 OF CHAR;
Выделенный сервер для распространения файлов, почты и печати
318
BEGIN listfont := "GachalOl"; i := 0;
WHILE (i < nofonts) & (fontname[i] # name) DO INC(i) END;
IF i = nofonts THEN
C0PY(name, fontname[i]); INC(nofonts);
Send(3); Send(SHORT(i)); SendBytes(listfont, 9)
END;
END UseListFont;
PROCEDURE String* (x, y: INTEGER; VAR s, fname: ARRAY OF CHAR);
VAR fno: SHORTINT;
BEGIN fno := fontno(fname); Send(1); Send(fno); Sendlnt(x); Sendlnt(y);
SendString(s)
END String;
PROCEDURE ContString* (VAR s, fname: ARRAY OF CHAR);
VAR fno: SHORTINT;
BEGIN fno := fontno(fname); Send(0); Send(fno); SendString(s)
END ContString;
PROCEDURE ReplPattern* (x, y, w, h, col: INTEGER);
BEGIN Send(5); Send(SHORT(col)); Sendlnt(x); Sendlnt(y); Sendlnt(w); Sendlnt(h)
END ReplPattern;
PROCEDURE Line* (xO, yO, x1, y1: INTEGER);
BEGIN Send(6); Send(O); Sendlnt(xO); Sendlnt(yO); Sendlnt(xl); Sendlnt(yl)
END Line;
PROCEDURE Circle* (xO, yO, r: INTEGER);
BEGIN Send(9); Send(O); Sendlnt(xO); Sendlnt(yO); Sendlnt(r)
END Circle;
PROCEDURE Ellipse* (xO, yO, a, b: INTEGER);
BEGIN Send(7); Send(O); Sendlnt(xO); Sendlnt(yO); Sendlnt(a); Sendlnt(b)
END Ellipse;
PROCEDURE Picture* (x, y, w, h, mode: INTEGER; adr: LONGINT);
VAR aO, a1: LONGINT; b: SHORTINT;
BEGIN Send(8); Send(SHORT(mode));
Sendlnt(x); Sendlnt(y); Sendlnt(w); Sendlnt(h);
aO := adr; a1 := L0NG((w + 7) DIV 8) * h + aO;
WHILE (aO < a1) & (res = 0) DO SYSTEM.GET(a0, b); Send(b); INC(aO) END
END Picture;
PROCEDURE Page* (nofcopies: INTEGER);
BEGIN Send(4); Send(SHORT(nofcopies))
END Page;
PROCEDURE Close*;
BEGIN SendPacket;
WHILE nofonts > 0 DO DEC(nofonts); fontname[nofonts, 0] := " END
Служба печати
я и
END Close;
BEGIN PageWidth := 2336; PageHeight := 3425; in := 0; PrinterName[0] := OX
END Printer.
Модуль Piinteг действует как клиент передачи сообщений. Его сервер-парт¬
нер - модуль NetServer. Синтаксис запроса печати почти идентичен запросу на
отправку файла:
РrintStream = PRT username password (ACK datastream \ NAK | NPR).
datastream = DAT0data ACK1 {DATx data ACK.+1}.
Подпрограмма сервера для обработки запроса печати защищена условием
typ = PRT (см. NetSewer выше), и она почти такая же, как подпрограмма обработки
запроса на получение файла. Но вместо регистрации полученного файла файл по¬
мещается в очередь печати Core.Print Queue.
Задачи печати извлекаются из очереди обработчиком в модуле PrintSewer, ко¬
торый представляет задачу Оберона, защищенную условием Core.PrintQueue.n > 0,
то есть которая становится активной, когда очередь задач печати не пуста. Сервер,
который описан здесь, управляет лазерным принтером, способным печатать при¬
мерно 10 страниц в минуту. Поэтому самая короткая задача печати занимает, по
меньшей мере, 6 секунд. Так как каждой команде в системе Оберон свойственна
непрерываемость, задача печати, очевидно, должна разбиваться на части, когда
нужно избежать неприемлемо длительной приостановки всех других служб. Эго
достигается разбиением процесса печати на фазы и возвратом управления плани¬
ровщику Оберона после каждой фазы.
Обработка страницы состоит из двух этапов. Сна¬
чала элементы потока печати читаются и интерпрети¬
руются, приводя их представление к точечному растру
на листе страницы. Затем растр передается принте¬
ру для печати страницы. Во втором этапе процессор
компьютера не участвует; передача выполняется пря¬
мым обращением к памяти под управлением принте¬
ра. Процессор нужен только первому этапу, который
обычно отнимает гораздо меньше времени, поэтому на
втором этапе он уже доступен для принятия и интер¬
претации других запросов. Процесс печати документа
состоит из четырех фаз, возможный порядок которых
показан на диаграмме потока управления на рис. 11.5.
Каждая из этих четырех фаз представляется про¬
цедурой-обработчиком, одна из которых всякий раз
устанавливается как задача Оберона. Как только фаза
завершена, обработчик устанавливает своего выбран¬
ного преемника. Растр генерируется в фазе ProcessPcige процедурами, определен¬
ными в модуле Printmaps, интерфейс которого приводится ниже.
Рис. 11.5. Фазы процесса
печати
Выделенный сервер для распространения файлов, почты и печати
320
Служба печати
32Г
DEFINITION Printmaps; (*NW 9.7.89 / 17.11.90*)
VAR Pat*: ARRAY 10 OF LONGINT;
PROCEDURE Map*(): LONGINT;
PROCEDURE ClearPage*;
PROCEDURE CopyPattern*(pat: LONGINT; X, Y: INTEGER);
PROCEDURE ReplPattern*(pat: LONGINT; X, Y, W, H: INTEGER);
PROCEDURE ReplConst*(X, Y, W, H: INTEGER);
PROCEDURE Dot*(x, y: LONGINT);
END Printmaps.
Эти растровые операции очень схожи с процедурами из модуля Display (см.
главу 4), но имеют дело с битовой матрицей принтера, а не дисплея, и не имеют
параметров режима и цвета. Для отображения литер используется тог же формат
файла шрифта, что и для дисплея.
MODULE PrintServer; (*NW 17.4.89 / 25.8.91*)
IMPORT SYSTEM, Core, Display, Files, Fonts, Oberon, Printmaps, Texts;
CONST maxFnt =32; N = 20; (*максимальная размерность сплайнов*)
PRO = 0FFF600H;
proff = 0; prdy = 1; sbusy = 2; end = 3; (*состояние принтера*)
BMwidth = 2336; BMheight = 3425;
TYPE RealVector = ARRAY N OF REAL;
Poly = RECORD a, b, c, d, t: REAL END;
PolyVector = ARRAY N OF Poly;
VAR W: Texts.Writer;
handler: Oberon.Task;
uno, nofcopies, nofpages: INTEGER;
PR: Files.Rider; (*бегунок принтера*)
font: ARRAY maxFnt OF Fonts.Font;
PROCEDURE circle (xO, yO, r: LONGINT);
VAR x, y, u: LONGINT;
BEGIN u := 1 - r; x := г; у := 0;
WHILE у <= x DO
Printmaps.Dot(xO + x, yO + y); Printmaps.Dot(xO + y, yO + x);
Printmaps.Dot(xO - y, yO + x); Printmaps.Dot(xO - x, yO + y);
Printmaps.Dot(xO - x, yO - y); Printmaps.Dot(xO - y, yO - x);
Printmaps.Dot(xO + y, yO - x); Printmaps.Dot(xO + x, yO - y);
IF u < 0 THEN INC(u, 2 * у + 3) ELSE INC(u, 2 * (y - x) + 5); DEC(x) END;
INC(y)
END
END circle;
PROCEDURE ellipse (xO, yO, a, b: LONGINT);
BEGIN ...
END ellipse;
PROCEDURE** ProcessPage;
PROCEDURE" PrintPage;
PROCEDURE'4 WaitForCompletion;
PROCEDURE Terminate;
VAR 1: INTEGER;
BEGIN Core.RemoveTask(Core.PrintQueue); i := 0;
REPEAT font[i] := NIL; INC(i) UNTIL i = maxFnt (*освободить шрифты*)
END Terminate;
PROCEDURE Append (src: ARRAY OF CHAR;
VAR dst: ARRAY OF SYSTEM.BYTE; VAR k: INTEGER);
VAR i: INTEGER; ch: CHAR;
BEGIN i := 0;
REPEAT ch := src[i]; dst[k] := ch; INC(i); INC(k) UNTIL ch = OX
END Append;
PROCEDURE* PickTask;
VAR F: Files.File;
Id: Core.ShortName;
tag: CHAR;
BEGIN
IF (Core.PrintQueue.n > 0) & “SYSTEM.BIT(PR0, proff)
& SYSTEM.BIT(PRO, prdy) THEN
Core.GetTask(Core.PrintQueue, F, Id, uno); nofpages := 0;
Files.Set(PR, F, 0); Files.Read(PR, tag);
IF tag = OFCX THEN handler.handle := ProcessPage
ELSE Texts.WriteString(W, Id); Texts.WriteString(W, " not a print file");
Texts.WriteLn(W); Texts.Append(Oberon.Log, W.buf); Terminate
END
END
END PickTask;
PROCEDURE ProcessPage;
VAR i, x, y, w, h, xO, x1, yO, y1: INTEGER;
a, aO, a1: LONGINT;
d, u: INTEGER;
typ, sp: SHORTINT;
ch: CHAR;
fnt: Fonts.Font;
fname: Core.Name;
PROCEDURE String;
VAR ch: CHAR;
dx, xO, yO, w, h: INTEGER;
fnt: Fonts.Font;
pat: LONGINT;
322
Выделенный сервер для распространения файлов, почты и печати
BEGIN fnt := font[sp MOD maxFnt];
IF (x >= 0) & (y >= 0) & (fnt # NIL) & (y + fnt.height < BMheight) THEN
LOOP Files.Read(PR, ch);
IF ch = OX THEN EXIT END;
Display.GetChar(fnt.raster, ch, dx, xO, yO, w, h, pat);
IF (x + xO + w <= BMwidth) & (h > 0) THEN
Printmaps.CopyPattern(pat, x + xO, у + yO)
END;
INC(x, dx)
END
END
END String;
BEGIN Printmaps.ClearPage;
LOOP Files.Read(PR, typ);
IF PR.eof THEN
Core.IncPageCount(uno, nofpages); Terminate; handler.handle := PickTask;
EXIT
END;
Files.Read(PR, sp);
IF typ = 0 THEN String
ELSIF typ = 1 THEN
Files.ReadBytes(PR, x, 2); Files.ReadBytes(PR, y, 2); String
ELSIF typ = 2 THEN
Files.ReadBytes(PR, x, 2); Files.ReadBytes(PR, y, 2);
Files.ReadBytes(PR, w, 2); Files.ReadBytes(PR, h, 2);
IF x < 0 THEN INC(w, x); x := 0 END;
IF x + w > BMwidth THEN w := BMwidth - x END;
IF у < 0 THEN INC(h, у); у := 0 END;
IF у + h > BMheight THEN h := BMheight - у END;
Printmaps.ReplConst(x, y, w, h)
ELSIF typ = 3 THEN
i := 0;
REPEAT Files.Read(PR, fname[i]); INC(i) UNTIL fname[i - 1] < "0";
DEC(i); Append(".Pr3.Fnt”, fname, i);
fnt := Fonts.This(fname);
IF fnt = Fonts.Default THEN fnt := Fonts.This("Syntax10.Pr3.Fnt") END;
font[sp MOD maxFnt] := fnt
ELSIF typ = 4 THEN
nofcopies := sp; handler.handle := PrintPage; EXIT
ELSIF typ = 5 THEN (*штрихованная область*)
IF (sp < 0) OR (sp > 9) THEN sp := 2 END;
Files.ReadBytes(PR, x, 2); Files.ReadBytes(PR, y, 2);
Files.ReadBytes(PR, w, 2); Files.ReadBytes(PR, h, 2);
IF x < 0 THEN INC(w, x); x := 0 END;
IF x + w > BMwidth THEN w := BMwidth - x END;
IF у < 0 THEN INC(h, у); у := 0 END;
IF у + h > BMheight THEN h := BMheight - у END;
Printmaps.ReplPattern(Printmaps.Pat[sp], x, y, w, h)
Служба печати
323
Выделенный сервер для распространения файлов, почты и печаТи
ELSIF typ = 6 THEN (*линия*)
Files.ReadBytes(PR, xO, 2); Files.ReadBytes(PR, yO, 2);
Files.ReadBytes(PR, x1, 2); Files.ReadBytes(PR, y1, 2);
w := ABS(xl - xO); h := ABS(y1 - yO);
IF h <= w THEN
IF x1 < xO THEN u := xO; xO := x1; x1 := u; u := yO; yO : = y1; yl : =
END;
IF yO <= y1 THEN d := 1 ELSE d := - 1 END;
u := (h - w) DIV 2;
WHILE xO < x1 DO
Printmaps.Dot(xO, yO); INC(xO);
IF u < О THEN INC(u, h) ELSE INC(u, h - w); INC(yO, d) END
END
ELSE
IF y1 < yO THEN u := xO; xO := x1; x1 := u; u := yO; yO := yl; y1 :=
END;
IF xO <= x1 THEN d := 1 ELSE d := - 1 END;
u := (w - h) DIV 2;
WHILE yO < y1 DO
Printmaps.Dot(xO, yO); INC(yO);
IF u < О THEN INC(u, w) ELSE INC(u, w - h); INC(xO, d) END
END
END
ELSIF typ = 7 THEN (*эллипс*)
Files.ReadBytes(PR, x, 2); Files.ReadBytes(PR, y, 2);
Files.ReadBytes(PR, w, 2); Files.ReadBytes(PR, h, 2);
ellipse(x, y, w, h)
ELSIF typ = 8 THEN (*рисунок*)
Files.ReadBytes(PR, x, 2); Files.ReadBytes(PR, y, 2);
Files.ReadBytes(PR, w, 2); Files.ReadBytes(PR, h, 2);
ELSIF typ = 9 THEN (окружность*)
Files.ReadBytes(PR, x, 2); Files.ReadBytes(PR, y, 2);
Files.ReadBytes(PR, w, 2); circle(x, y, w)
ELSE Texts.WriteString(W, " error in print file at");
Texts.WriteInt(W, Files. Pos(PR), 6); Texts.WriteInt(W, typ, 5);
Texts.WriteLn(W); Texts.Append(Oberon.Log, W.buf);
Terminate; handler.handle := PickTask; EXIT
END
END
END ProcessPage;
PROCEDURE PrintPage;
BEGIN
IF SYSTEM.BIT(PRO, prdy) THEN
SYSTEM.PUT(PRO, Printmaps.Map()); handler.handle := WaitForCompletion;
REPEAT UNTIL SYSTEM.BIT(PRO, end)
END
END PrintPage;
324
Разные службы
PROCEDURE WaitForCompletion;
BEGIN
IF "SYSTEM.BIT(PRO, end) THEN
DEC(nofcopies); INC(nofpages);
IF nofcopies > 0 THEN handler.handle := PrintPage; DEC(nofcopies)
ELSE handler.handle := ProcessPage
END
END
END WaitForCompletion;
(* Команды *)
PROCEDURE Start*;
BEGIN
IF "SYSTEM.BIT(PRO, proff) THEN
handler.handle := PickTask;
Oberon.Remove(handler); Oberon.Install(handler);
Texts.WriteString(W, "Printer started (NW 25.8.91)")
ELSE Texts.WriteString(W, "Printer off")
END;
Texts.WriteLn(W); Texts.Append(Oberon.Log, W.buf)
END Start;
PROCEDURE State*;
VAR s: SHORTINT;
BEGIN Texts.WriteString(W, "Printer Queue:"); Texts.WriteInt(W, Core.PrintQueue.n, 4);
Texts.WriteLn(W); Texts.Append(Oberon.Log, W.buf)
END State;
PROCEDURE Reset*;
BEGIN; handler.handle := PickTask;
END Reset;
PROCEDURE Stop*;
BEGIN Oberon.Remove(handler); Texts.WriteString(W, "Printer stopped");
Texts.WriteLn(W); Texts.Append(Oberon.Log, W.buf)
END Stop;
BEGIN Texts.OpenWriter(W); NEW(handler)
END PrintServer.
11.4. Разные службы
Существует несколько дополнительных служб, которые весьма желательны
при наличии централизованных средств и в то же время легко добавляются. Они
кратко описываются в этом разделе.
Набор команд службы распространения файлов дополнен командами Net.
DeleteFiles и Net.Directory, допускающими дистанционное удаление файлов и про¬
кта
смотр каталога сервера. Процедуры команд приводятся ниже и должны рассма¬
триваться как часть модуля Net (раздел 10.4). Они взаимодействуют со своими
двойниками в модуле NetSewer (раздел 11.2) согласно следующему протоколу:
DeleteFile = DEL username password filename (ACK | NAK | NPR).
Directory = FDIR username password prefix (datastream \ NAK | NPR).
Запрос каталога предполагает наличие префикса; он использует процедуру
FileDir. Enumerate для получения всех имен файлов, начинающихся с данного пре¬
фикса. Таким образом, поиск может ограничиваться соответствующим разделом
каталога.
PROCEDURE DeleteFiles*;
VAR k: INTEGER;
S: Texts.Scanner;
buf: ARRAY 64 OF CHAR;
BEGIN GetParl(S);
IF S.class = Texts.Name THEN
FindPartner(S.s, k);
IF k = 0 THEN
LOOP Texts.Scan(S);
IF S.class # Texts.Name THEN EXIT END;
k := 0; AppendS(0beron.User, buf, k); AppendW(0beron.Password, buf, 4, k);
AppendS(S.s, buf, k); Send(DEL, k, buf);
Texts.WriteString(W, S.s); Texts.WriteString(W, " remote deleting");
ReceiveHead(T1);
IF headl.typ = ACK THEN reply(O)
ELSIF headl.typ = NAK THEN reply(3)
ELSIF headl.typ = NPR THEN reply(2); EXIT
ELSE reply(5); EXIT
END
END
ELSE reply(l)
END
END
END DeleteFiles;
PROCEDURE Directory*;
VAR k, X, Y: INTEGER;
T: Texts.Text;
V: Viewers.Viewer;
buf: ARRAY 32 OF CHAR;
S: Texts.Scanner;
BEGIN GetParl(S);
IF S.class = Texts.Name THEN
FindPartner(S.s, k);
IF k = 0 THEN
Texts.Scan(S);
326
Выделенный сервер для распространения файлов, почты и печати
Разные службы
327
IF S.class = Texts.Name THEN (*префикс*)
AppendS(Oberon.User, buf, k); AppendW(Oberon.Password, buf, 4, k);
AppendS(S.s, buf, k); Send(FDIR, k, buf); ReceiveHead(T1);
IF headl.typ = 0 THEN
T := TextFrames.Text(”");
Oberon.AllocateSystemViewer(Oberon.Par.frame.X, X, Y);
V := MenuViewers.New(
TextFrames.NewMenu("Net.Directory", "System.Close Edit.Store"),
TextFrames.NewText(T, 0), TextFrames.menuH, X, Y);
ReceiveText(T)
ELSIF headl.typ = NAK THEN reply(4)
ELSIF headl.typ = NPR THEN reply(2)
ELSE reply(5)
END
END
ELSE reply(1)
END
END
END Directory;
Так как запросы к серверу всегда защищены паролем, необходимо средство
установки и изменения сохраняемого на сервере пароля. Соответствующая коман¬
да - это Net. SetPassword, а ее обработчик на сервере защищен условием typ = NPW.
Соответствующий протокол:
NewPassword = NPW username oldpassword
(ACK DAT newpassword (ACK | NAK) | NAK | NPR).
PROCEDURE SetPassword*;
VAR k: INTEGER; oldpw; LONGINT;
S: Texts.Scanner;
buf: ARRAY 64 OF CHAR;
BEGIN GetParl(S);
IF S.class = Texts.Name THEN
FindPartner(S.s, k);
IF k = 0 THEN Texts.Scan(S);
IF S.class = Texts.String THEN
AppendS(Oberon.User, buf, k); AppendW(0beron.Password, buf, 4, k);
Send(NPW, k, buf); ReceiveHead(T1);
IF headl.typ = ACK THEN
k := 0; Oberon.SetUser(0beron.User, S.s);
AppendW(0beron.Password, buf, 4, k);
Send(0, 4, buf); ReceiveHead(TO);
IF headl.typ = ACK THEN reply(7) ELSE reply(3) END
ELSIF headl.typ = NPR THEN reply(2)
ELSE reply(3)
END
END
ELSE reply(1)
END
END
END SetPassword;
Наконец, процедура Net.GetTime позволяет подогнать таймер рабочей станции
под центральный сервер. Протокол таков:
GetTime = TRQ TIM time date.
PROCEDURE GetTime*;
VAR t, d: LONGINT; res: INTEGER;
S: Texts.Scanner;
BEGIN GetParl(S);
IF S.class = Texts.Name THEN
FindPartner(S.s, res);
IF res = 0 THEN
Send(TRQ, 0, dmy); ReceiveHead(T1);
IF headl.typ = TIM THEN
PickQ(t); PickQ(d); Oberon.SetClock(t, d); reply(6)
END
ELSE reply(1)
END
END
END GetTime;
В заключение соберем вместе все спецификации протоколов. Все серверные
возможности, включая службы распространения файлов, почтовую, печати и вре¬
мени, работают на компьютере Ceres-1 (1 Mips) с памятью 2 Мб, половина которой
используется для растровых изображений принтера.
Свод протоколов:
protocol = {request}.
request = ReceiveFile | SendFile | DeleteFile | Directory | MailBox | SendMail
ReceiveMail | DeleteMail | PrintStream | SendMsg | NameRequest |
NewPassword | GetTime.
ReceiveFile = SND username password filename (datastream | NAK | NPR).
datastream = DATO data ACK1 {DATi data ACKi+1}.
SendFile = REC username password filename (ACKO datastream | NAK | NPR).
datastream = DATO data ACK1 {DATi data ACKi+1}.
DeleteFile = DEL username password filename (ACK | NAK | NPR).
Directory = FDIR username password prefix (datastream | NAK | NPR).
MailBox = MDIR username password (datastream | NAK | NPR).
SendMail = RML username password (ACK datastream | NAK | NPR).
ReceiveMail = SML username password msgno (datastream | NAK | NPR).
DeleteMail = DML username password msgno (ACK | NAK | NPR).
PrintStream = PRT username password (ACK datastream | NAK | NPR).
SendMsg = MSG message ACK.
NameRequest = NRQ partnername [NRS].
328
Выделенный сервер для распространения файлов, почты и печати
NewPassword = NPW username oldpassword
(ACK DAT newpassword (ACK I NAK) | NAK | NPR).
GetTime = TRQ TIM time date.
11.5. Пользовательское
администрирование
Видимо, это универсальный закон, что централизация неизбежно требует ад¬
министрирования. Централизованные службы почты и печати не исключение.
Типичные обязанности администратора - учет (наблюдение) и защита от злоупо¬
треблений. Они должны гарантировать, что предоставленные службы действуют
и что неавторизовапные пользователи не пользуются сервером. Нередко его до¬
полнительная обязанность - сбор статистических данных. В нашем случае учет
играет незначительную роль, поэтому причина предлагаемого администрирова¬
ния - это, прежде всего, защита.
Мы различаем два вида защиты. Первая - защита ресурсов сервера вообще,
вторая - защита ресурсов отдельных пользователей от посягательств со стороны
других. Если в первом случае может хватить некоторой проверки правильности
идентификации пользователя, то второй случай требует увязки личных ресурсов
пользователей с их именами. В любом случае центральный сервер должен хранить
данные каждого члена сообщества зарегистрированных пользователей. Главное,
что он должен уметь проверять на основе хранимой информации допустимость
запроса пользователя.
Очевидно, администрирование защиты по своим целям и функциям схоже
с блокировкой. Весьма регулярно блокировки подвергаются попыткам взлома,
а взломщики - попыткам их перехитрить. Гонка между способами взлома блоки¬
ровок и способами наилучшего противодействия им хорошо известна, и мы даже
не пытаемся внести в нее свой вклад. Наш проект основан на предположении, что
сервер Оберона работает в гармоничной среде. Тем не менее минимальное коли¬
чество механизмов защиты в него было включено. Они повышают объем необхо¬
димых для взлома защиты усилий до уровня, который недостижим, если побуж¬
дением к этому служит лишь одно любопытство.
Данные о пользователях содержатся в таблице модуля Core. Как говори¬
лось раньше, Core действует как связующее звено между различными серверами
посредством очередей задач. Его вторая цель - обеспечение необходимого доступа
к данным пользователей посредством соответствующих процедур.
Простейшее решение - когда каждая запись в таблице содержит только имя
пользователя. Для каждого запроса администрирование просто проверяло бы на¬
личие в таблице имени пользователя этого запроса. Значительный шаг к безопас¬
ной защите - это введение пароля в дополнение к имени пользователя. Чтобы
запрос был разрешен, должно быть не только зарегистрировано имя, но должны
совпасть принимаемый и хранимый пароли. Очевидно, злоупотребления должны
иметь целью вскрытие хранимых паролей. Наше решение состоит в хранении шиф¬
Пользовательское администрирование
Г329
рованного пароля. Команда System.SetUser, которая запрашивает идентификацию
пользователя и пароль, немедленно шифрует пароль, а оригинал нигде не сохраня¬
ется. Алгоритм шифрования таков, что соответствующий декодер трудно создать.
Почтовая служба в дополнение к идентификации и шифрованному паролю
требует третий атрибут - имя пользователя, так как оно используется для адре¬
сации сообщений. Идентификация обычно состоит из инициалов пользователя;
для имени предлагается полная фамилия пользователя и отказ от загадочных со¬
кращений.
Для службы печати желательны средства учета. Четвертое поле в каждой
записи таблицы пользователей служит счетчиком числа печатаемых страниц.
В итоге имеем четыре поля: id, name, password и count. Таблица не экспортируется
и доступна только через процедуры. Core - хороший пример модуля сокрытия
ресурсов. Программа приведена ниже, а здесь - несколько дополнительных ком¬
ментариев.
Процедуры UserNo (id) и UserNum (пате) выдают индекс в таблице идентифи¬
цированного пользователя; он называется номером пользователя и используется
как краткий код получателей и отправителей для почтового сервера. В других сер¬
верах номер используется только для проверки законности запроса.
Пользовательская информация, конечно же, должна пережить любой перерыв
в работе сервера, будь то сбой программы, аппаратуры или питания. Это требует,
чтобы копия пользовательской информации сохранялась в резервной памяти (на
диске). Простейшим решением было бы использовать для этой цели файл. Но, по
сути, это сделало бы защиту слишком уязвимой, так как файл может быть легко¬
доступным, и мы воздержались от введения средств защиты файлов. Вместо этого
резервная копия пользовательской информации сохраняется в нескольких по¬
стоянно зарезервированных секторах на сервере, которые недоступны файловой
системе.
MODULE Core; (*NW 17.4.89 / 6.1.90*)
IMPORT Files, Kernel;
CONST
UTsize = 64; (*максимальное число зарегистрированных пользователей*)
UTsecO = ; (*адрес таблицы пользователя на диске*)
UTsecI = ;
TYPE
ShortName* = ARRAY 8 OF CHAR;
LongName* = ARRAY 16 OF CHAR;
Name* = ARRAY 32 OF CHAR;
MailEntry* = RECORD
pos*, next*: INTEGER;
len*: LONGINT;
time*, date*: INTEGER;
originator*: ARRAY 20 OF CHAR
■■Bill
Выделенный сервер для распространения файлов, почты и печати
330
END;
MResTab* = ARRAY 8 OF SET;
MailDir* = ARRAY 31 OF MailEntry;
User = RECORD
id: ShortName;
name: LongName;
password, count: LONGINT
END;
SectorBuf = RECORD (Kernel.Sector)
u: ARRAY 32 OF User
END;
Task = POINTER TO TaskDesc;
TaskDesc = RECORD
file: Files.File;
uno, class: INTEGER;
name: ShortName;
next: Task
END;
Queue = RECORD n*: INTEGER;
first, last: Task
END;
VAR PrintQueue*, MailQueue*: Queue;
NUsers: INTEGER;
UT: ARRAY UTsize OF User;
PROCEDURE RestoreUsers*;
VAR i: INTEGER; SB: SectorBuf;
BEGIN i := 0; Kernel.GetSector(UTsecO, SB);
WHILE (i < 32) & (SB.u[i].id[0] > OX) DO UT[i] := SB.u[i]; INC(i) END;
IF i = 32 THEN
Kernel.GetSector(UTsec1, SB);
WHILE (i < 64) & (SB.u[i - 32].id[0] > OX) DO UT[i] := SB.u[i - 32];
INC(i) END
END;
NUsers := i
END RestoreUsers;
PROCEDURE BackupUsers*;
VAR i: INTEGER; SB: SectorBuf;
BEGIN i := NUsers;
IF i >= 32 THEN
IF i < 64 THEN SB.u[i - 32].id[0] := OX END;
Пользовательское администрирование
ГззГ
WHILE i > 32 DO DEC(i); SB.u[i - 32] := UT[i] END;
Kernel.PutSector(UTsec1, SB)
END;
IF l < 32 THEN SB.u[i].id[0] := OX END;
WHILE i > О DO DEC(i); SB.u[i] := UT[i] END;
Kernel.PutSector(UTsecO, SB)
END BackupUsers;
PROCEDURE Uno (VAR Id: ShortName): INTEGER;
VAR i: INTEGER;
BEGIN i := 0;
WHILE (i < NUsers) & (UT[i].id # id) DO INC(i) END;
RETURN 1
END Uno;
PROCEDURE NofUsers* (): INTEGER;
BEGIN RETURN NUsers
END NofUsers;
PROCEDURE UserNo* (VAR id: ShortName; pw: LONGINT): INTEGER;
VAR i: INTEGER; (* -1 = пользователь защищен или не зарегистрирован*)
BEGIN i := Uno(id);
IF (i = NUsers) OR (UT[i].password # pw) & (UT[i].password # 0) THEN i := - 1
END;
RETURN i
END UserNo;
PROCEDURE UserNum* (VAR name: ARRAY OF CHAR): INTEGER;
VAR i, j: INTEGER;
BEGIN i := 0;
LOOP
IF i = UTsize THEN i := - 1; EXIT END;
j := 0;
WHILE (j < 4) & (CAP(name[j]) = CAP(UT[i].name[j])) DO INC(j) END;
IF j = 4 THEN EXIT END;
INC(i)
END;
RETURN i
END UserNum;
PROCEDURE GetUserName*(uno: INTEGER; VAR name: LongName);
BEGIN name := UT[uno].name
END GetUserName;
PROCEDURE GetFileName* (uno: INTEGER; VAR name: ARRAY OF CHAR);
VAR i: INTEGER; ch: CHAR;
BEGIN i := 0;
LOOP ch := UT[uno].name[ij;
IF ch = OX THEN EXIT END;
Выделенный сервер для распространения файлов, почты и печати
332
Пользовательское администрирование
name[i] := ch; INC(i)
END;
name[i] := name[i + 1] := "M"; name[i + 2] := "a”; name[i + 3] := "i
name[i + 4] := "1"; name[i + 5] := OX
END GetFileName;
PROCEDURE GetUser* (uno: INTEGER; VAR id: ShortName; VAR name: LongName;
VAR count: LONGINT; VAR protected: BOOLEAN);
BEGIN id := UT[uno].id; name := UT[uno].name; count := UT[uno].count;
protected := UT[uno].password # 0
END GetUser;
PR OCEDURE InsertUser* (VAR id: ShortName; VAR name: LongName);
VAR i: INTEGER;
BEGIN i := Uno(id);
IF (i = NUsers) & (i < UTsize - 1) THEN
UT[i].id := id; UT[i].name := name; INC(NUsers)
END
END InsertUser;
PROCEDURE DeleteUser* (VAR id: ShortName);
VAR i: INTEGER;
BEGIN i := Uno(id);
IF i < NUsers THEN DEC(NUsers);
WHILE i < NUsers DO UT[i] := UT[i + 1]; INC(i) END
END
END DeleteUser;
PROCEDURE ClearPassword* (VAR id: ShortName);
BEGIN UT[Uno(id)].password := 0
END ClearPassword;
PROCEDURE SetPassword* (uno: INTEGER; npw: LONGINT);
BEGIN UT[uno].password := npw; BackupUsers
END SetPassword;
PROCEDURE IncPageCount* (uno: INTEGER; n: LONGINT);
BEGIN INC(UT[uno].count, n); BackupUsers
END IncPageCount;
PROCEDURE SetCounts* (n: LONGINT);
VAR i: INTEGER;
BEGIN i := 0;
WHILE i < NUsers DO UT[i].count := n; INC(i) END
END SetCounts;
PROCEDURE PurgeUsers* (n: INTEGER);
BEGIN NUsers := 0
END PurgeUsers;
ззэ
Выделенный сервер для распространения файлов, почты и печати
PROCEDURE InsertTask* (VAR Q: Queue; F: Files.File;
VAR id: ARRAY OF CHAR; uno: INTEGER);
VAR T: Task;
BEGIN NEW(T); T.file := F; C0PY(id, T.name); T.uno := uno; T.next := NIL;
IF Q.last # NIL THEN Q.last.next := T ELSE Q.first := T END;
Q.last := T; INC(Q.n)
END InsertTask;
PROCEDURE GetTask* (VAR Q: Queue; VAR F: Files.File;
VAR id: ShortName; VAR uno: INTEGER);
BEGIN (*Q.first # NIL*)
F := Q.first.file; id := Q.first.name; uno := Q.first.uno
END GetTask;
PROCEDURE RemoveTask* (VAR Q: Queue);
BEGIN (*Q.first ft NIL*)
Files.Purge(Q.first.file); Q.first := Q.first.next; DEC(Q.n);
IF Q.first = NIL THEN Q.last := NIL END
END RemoveTask;
PROCEDURE Reset (VAR Q: Queue);
BEGIN Q.n := 0; Q.first := NIL; Q.last := NIL
END Reset;
PROCEDURE Collect*;
VAR n: LONGINT;
BEGIN
IF Kernel.allocated > 300000 THEN Kernel.GC END
END Collect;
BEGIN RestoreUsers; Reset(PrintQueue); Reset(MailQueue); Reset(LineQueue)
END Core.
Кроме процедур и переменных, образующих механизм очереди задач, все
процедуры, экспортируемые из модуля Core, относятся к администрированию
и могут быть разбиты на две категории. Первую категорию образуют процеду¬
ры, используемые тремя представленными в этой главе серверами, это - UserNo,
UserNum, IncPageCount, SetPassword, GetUserName и GetFileName. Вторую катего¬
рию образуют процедуры NofUsers и GetUser - для просмотра записей таблицы, и
InsertUser, DeleteUser, ClearPassword, ClearCounts и Init - для внесения изменений
в таблицу.
Клиент последней категории - это модуль Users, который нужен системному
администратору сервера.
MODULE Users; (*NW 2.2.89 / 25.8.91*)
IMPORT Core, MenuViewers, Oberon, TextFrames, Texts, Viewers;
CONST TAB = 9X;
334
Пользовательское администрирование
VAR W: Texts.Writer;
PROCEDURE List*;
VAR x, y, i: INTEGER;
protected: BOOLEAN;
count: LONGINT;
T: Texts.Text.;
V: Viewers.Viewer;
id: Core.ShortName; name: Core.LongName;
BEGIN i := 0; T := TextFrames.Text("");
Oberon.AllocateUserViewer(Oberon.Par.frame.X, y);
V := MenuViewers.New(
TextFrames.NewMenu("Users.Text", "System.Close Edit.Store"),
TextFrames.NewText(T, 0), TextFrames.menuH, x, y);
WHILE i < Core.NofUsersO DO
Core.GetUser(i, id, name, count, protected);
Texts.WriteInt(W, i, 4); Texts.Write(W, TAB);
IF protected THEN Texts.Write(W, "it") END;
Texts.WriteString(W, id); Texts.Write(W, TAB); Texts.WriteString(W, name);
Texts.WriteInt(W, count, 8); Texts.WriteLn(W); INC(i)
END;
Texts.Append(T, W.buf)
END List;
PROCEDURE Insert*;
VAR id: Core.ShortName; name: Core.LongName; S: Texts.Scanner;
BEGIN Texts.OpenScanner(S, Oberon.Par.text, Oberon.Par.pos); Texts.Scan(S);
IF S.class = Texts.Name THEN
C0PY(S.s, id); Texts.Scan(S);
IF S.class = Texts.Name THEN
C0PY(S.s, name); Core.InsertUser(id, name); Core.BackupUsers
END
END
END Insert;
PROCEDURE Delete*;
VAR id: Core.ShortName; S: Texts.Scanner;
BEGIN Texts.OpenScanner(S, Oberon.Par.text, Oberon.Par.pos); Texts.Scan(S);
IF S.class = Texts.Name THEN
C0PY(S.s, id); Core.DeleteUser(id); Core.BackupUsers
END
END Delete;
PROCEDURE ClearPassword*;
VAR id: Core.ShortName; S: Texts.Scanner;
BEGIN Texts.OpenScanner(S, Oberon.Par.text, Oberon.Par.pos); Texts.Scan(S);
IF S.class = Texts.Name THEN
C0PY(S.s, id); Core.ClearPassword(id); Core.BackupUsers
END
335
END ClearPassword;
PROCEDURE ClearCounts*;
BEGIN Core.SetCounts(O); Core.BackupUsers
END ClearCounts;
PROCEDURE Init*;
VAR id: Core.ShortName; name: Core.LongName; S: Texts.Scanner;
BEGIN Texts.OpenScanner(S, Oberon.Par.text, Oberon.Par.pos);
Core.PurgeUsers(O);
LOOP Texts.Scan(S);
IF S.class # Texts.Name THEN EXIT END;
C0PY(S.s, id); Texts.Scan(S);
IF S.class # Texts.Name THEN EXIT END;
C0PY(S.s, name); Core.InsertUser(id, name)
END;
Core.BackupUsers
END Init;
BEGIN Texts.OpenWriter(W)
END Users.
Тут читатель может удивиться, почему не было выбрано более широкое по¬
нятие администрирования, которое позволило бы системному администратору
удаленно управлять сервером. Быстрый анализ последствий этого широко при¬
меняемого подхода показывает, что потребовалось бы значительное количество
дополнений к нашей системе. Проблема безопасности и защиты стала бы раздутой
до таких размеров, которые едва оправданы в нашей локальной системе. Первым
последствием было бы деление на уровни защиты. Администратор стал бы так
называемым суперпользователем с такими сверхпривилегиями, как изменение та¬
блицы пользователей. А в этом случае игра в попытки взломать защиту начинает
становиться заманчивой проблемой.
Мы сопротивлялись искушению ввести дополнительную сложность. Вместо
этого мы предполагаем, что физический доступ к серверной станции закрепляет¬
ся за администратором. Естественно, модуль Users и в особенности символьный
файл Core не принадлежат общему домену. В заключение подчеркнем, что невоз¬
можность активации программ пользователей на серверной станции значительно
сокращает возможность причинения ущерба извне.
336
Выделенный сервер для распространения файлов, почты и печсп>
12. КОМПИЛЯТОР
12.1. Введение
Компилятор - главный инструмент создателя системы. Поэтому он играет за¬
метную роль в системе Оберон, хотя не является частью основной системы. На¬
оборот, он образует инструментальный модуль - приложение - с единственной
командой Compile. Он переводит тексты программ в машинный код. Поэтому как
программа он, конечно же, машинно зависим; он действует как интерфейс между
исходным языком и целевым компьютером.
Чтобы понять процесс компиляции, читатель должен быть знаком с исходным
языком Оберон и с целевым компьютером - архитектурой процессора NS-32000.
Язык определяется как бесконечное множество цепочек символов из слова¬
ря языка. Он описывается набором уравнений, называемых синтаксисом. Каждое
уравнение определяет синтаксическую конструкцию, точнее - множество цепочек
символов, принадлежащих этой конструкции. Оно определяет, как эта конструк¬
ция собирается из других синтаксических конструкций. Смысл программ опреде¬
ляется семантическими правилами, управляющими каждой такой конструкцией.
Компиляция текста программы выполняется путем синтаксического анализа
текста и, как следствие, рекурсивным его разложением на конструкции соглас¬
но синтаксису. Когда конструкция распознана, генерируется ее код согласно се¬
мантическому правилу, связанному с конструкцией. Компоненты распознанной
конструкции поставляют параметры для генерируемого кода.
Следовательно, мы различаем два вида действий - этап анализа и этап генера¬
ции кода. В первом приближении можно сказать, что первый зависит от исходного
языка и не зависит от целевого компьютера, тогда как последний не зависит от
исходного языка и зависит от целевого компьютера. Хотя в действительности все
несколько сложнее, структура модуля компилятора явно отражает это деление.
Инструментальный модуль Compiler прежде всего предназначен для синтаксиче¬
ского анализа. После распознавания синтаксической конструкции из модуля ге¬
нерации кода вызывается соответствующая процедура.
Тексты программ на языке Оберон рассматриваются как цепочки символов,
а не цепочки литер. Однако сами символы - это цепочки литер. Мы воздержимся
от объяснения причин такого деления, но напомним, что, кроме специальных ли¬
тер и их пар вроде +, &, <=, к символам также относятся идентификаторы, числа и
©N. Wirth, 5.8.91/15.11.91
строки. Кроме того, определенные цепочки прописных букв - это тоже символы,
например IF, END и т. д. Каждый раз, когда синтаксический анализатор намерен
прочитать следующий символ, он вызывает процедуру Get, которая представляет
так называемый сканер, находящийся в модуле OCS (от Oberon Compiler Scanner).
Она считывает из исходного текста столько литер, сколько необходимо для рас¬
познавания следующего символа.
Попутно отметим, что сам по себе сканер отражает определение символов
в терминах литер, тогда как синтаксический анализатор опирается только на по¬
нятие символа. Сканер реализует абстракцию символа. Распознавание символов
в последовательности литер называется лексическим анализом (поэтому сканер
называют еще и лексическим анализатором. - Прим. перев.)
В идеале распознавание любой синтаксической конструкции, скажем, Л, со¬
стоящей из подконструкций, скажем Bl, В2,..., Вп, приводит к генерации кода, ко¬
торая зависит только от (1) семантических правил, связанных с А, и (2) от (атри¬
бутов) Bl, В2,..., Вп. Если это условие выполнено, то говорят, что конструкция
контекстно-свободна, а если все конструкции языка контекстно-свободны, то и
язык контекстно-свободен. Синтаксис и семантика языка Оберон придержива¬
ются этого правила, но с существенным исключением. Это исключение вызвано
понятием объявления. Объявление идентификатора, скажем, х связывает с ним
постоянные свойства, например, что х обозначает переменную и что она имеет тип
Т. Эти свойства «невидимы» при синтаксическом анализе оператора, содержащего
х, потому что объявление х не является частью оператора.Таким образом, «смысл»
идентификаторов безусловно контекстно-зависим.
Контекстная зависимость от объявлений - прямой повод использовать гло¬
бальную структуру данных, которая представляет объявленные идентификаторы
и их свойства (атрибуты). Так как это понятие берет начало в ранних ассембле¬
рах, где идентификаторы (называвшиеся тогда символами) заносились в линей¬
ную таблицу, термин таблица символов так и закрепился за этой структурой, хотя
в этом компиляторе она значительно сложнее массива. Она заполняется в основ¬
ном при обработке объявлений, а просматривается при обработке выражений и
операторов. Процедуры заполнения и просмотра (поиска) содержатся в модуле
OCT.
Сложности возникают из-за понятий экспорта и импорта языка Оберон. Из
них следует, что объявление идентификатора х, скажем, в модуле М может от¬
личаться от того, где к х обращаются. Если х экспортируется, компилятор вклю¬
чает х вместе с его атрибутами в символьный файл откомпилированного модуля
М. При компиляции другого модуля, который импортирует М, этот символьный
файл читается, а его данные включаются в таблицу символов. Процедуры чтения
и записи символьных файлов находятся в модуле ОСТ, и никакой другой модуль
не располагает информацией о структуре символьных файлов.
Синтаксис точно и строго определяется небольшим набором синтаксических
уравнений. В результате синтаксический анализатор - это довольно прозрачная
и короткая программа. К сожалению, набор команд целевого компьютера сложен,
и в итоге программа генерации кода намного длиннее и труднее для понимания.
338
Компилятор
Это особенно ярко выражается в случае CISC-процессоров вроде NS-32000. Тем
не менее, его набор команд сравнительно регулярен.
В отличие от синтаксического анализатора, который полностью содержится
в одном модуле, процедуры генерации кода разнесены по трем модулям с целью
поддержания их размеров в разумных пределах (1000 строк). Процедуры моду¬
ля ОСЕ вызываются главным образом при разборе выражений. Кроме генерации
соответствующего кода, процедуры выполняют проверки совместимости типов
операндов и вычисляют атрибуты обработанной конструкции. Поскольку они вы¬
бирают соответствующие команды, они непосредственно отражают набор команд
целевого компьютера. Процедуры в модуле ОСН имеют ту же природу, но вызы¬
ваются прежде всего при разборе операторов, а не выражений.
Окончательная выдача кода выполняется процедурами модуля ОСС. Как пра¬
вило, они вызываются из ОСЕ и ОСН. По аналогии со сканером, преобразующим
цепочки литер в символы, ОСС-процедуры преобразуют (абстрактные) коман¬
ды в цепочки битов. Следовательно, этот модуль отражает двоичную кодировку
команд, то есть форматы машинных команд целевого компьютера.
Итоговая структура модуля компилятора показана на рис. 12.1 несколько
упрощенно. В действительности OCS импортируется всеми остальными модуля¬
ми из-за их потребности в процедуре OCSMark. По это будет объяснено позже.
Рис. 12.1. Структура модуля компилятора
12.2. Шаблоны кода
Чтобы можно было понять, как генерируется код, нужно знать, какой код гене¬
рируется. Другими словами, нам нужно знать цель, прежде чем искать путь, веду¬
щий к ней. Структура языка позволяет описать эту цель довольно кратко. Как объ¬
Шаблоны кода
ЕШ
яснялось раньше, семантика привязывается к каждой отдельной синтаксической
конструкции независимо от ее контекста. Поэтому вместо абстрактного семанти¬
ческого правила для каждой синтаксической конструкции достаточно привести
ожидаемый код.
Для понимания получающихся команд и, в частности, их параметров нам нуж¬
но знать, где хранятся объявленные переменные, то есть что представляют собой
их адреса. Этот компилятор использует простую схему последовательного распре¬
деления последовательно объявляемых переменных. Адрес - это пара, состоящая
из базового адреса (в регистре) и смещения. Глобальные переменные размещают¬
ся в разделе данных модуля, а соответствующий им регистр базы - это SB (см.
главу 6). Локальные переменные размещаются в записи активации процедуры
стека; соответствующий базовый регистр - FP, а их смещения - отрицательные
целые числа.
Объем памяти, необходимый для переменной (называемый ее размером),
определяется ее типом. Размеры основных типов предопределены представлени¬
ем данных целевого компьютера. Процессор NS-32000 поддерживает следующие
основные типы:
Тип Число байтов
SHORTINT, CHAR, BOOLEAN 1
INTEGER 2
LONGINT, REAL, SET, POINTER, PROCEDURE 4
LONGREAL 8
Размер массива - это размер типа его элемента, умноженный на число элемен¬
тов. Размер записи - это сумма размеров ее полей.
Сложности возникают из-за так называемого выравнивания. Под выравнива¬
нием понимается подгонка адреса под кратность размера переменной. Выравни¬
вание применяется как к адресам переменных, так и к смещениям полей записи.
Причина для выравнивания - предотвращение двукратных обращений к памяти
для переменных, «охватывающих» больше двух смежных слов. Надлежащее вы¬
равнивание весьма существенно увеличивает скорость обработки. Выделение па¬
мяти переменным с применением выравнивания показано в примере на рис. 12.2.
Рис. 12.2. Выравнивание переменных
340
Попутно отметим , что упорядочивание четырех переменных позволяет избе¬
жать появления неиспользуемых байтов, как показано на рис. 12.3.
Компилятор
Шаблоны кода
341
Рис. 12.3. Улучшенный порядок
переменных
Прежде чем начать обсуждение различных шаблонов кода, мы кратко пред¬
ставим наиболее важные режимы адресации процессора. сЮ и ell - целые числа,
так называемые смещения, или сдвиги. Rn обозначает регистр общего назначения
(О < п < 8), SB - регистр, содержащий статический базовый (Static Base) адрес
глобальных данных, и FP - регистр, содержащий указатель кадра (Frame Pointer),
то есть базовый адрес данных, локализованных в процедурах. Параметры команд
ветвления обозначают расстояния от самой команды до точки перехода (относи¬
тельно PC).
Режим адресации
Запись на ассемблере
Получаемый адрес
Косвенная
dO(Rn)
R[n] + dO
регистровая
dO(FP)
FP + dO
dO(SB)
SB + dO
Косвенная
dl(dO(FP))
Mem[FP + dO] + dl
dl(dO(SB))
Mem[SB + dO] + dl
Индексная
adr[Rx:W]
adr + 2*Rx
Стековая
TOS
SP, представляет операции «в стек»
и «из стека»
Прямая
n
п = операнд
Присваивание констант. Используемые в этом примере переменные - гло¬
бальные; их базовый регистр - SB. Каждое присваивание приводит к единствен¬
ной команде. Константа встроена в команду и использует прямой режим адре¬
сации. Если операнд адресата занимает больше байтов, чем исходный операнд,
включается распространение знака (MOVX). Для целых чисел в диапазоне -8 ... 7
используются специальные, более короткие команды (MOVQ).
MODULE Pattern-!;
VAR ch: CHAR; -1
i: SHORTINT; -2
j: INTEGER; -4
k: LONGINT; -8
x: REAL; -12
s: SET; -16
BEGIN О ENTER ОО 0
oh := «О»; 3 MOVB 48 -1(SB)
i := 10; 7 MOVB 10 -2(SB)
j := 1000; 11 MOVW 1000 -4(SB)
к := 0; 16 MOVQD 0 -8(SB)
x := 1.5; 19 MOVF 3FCOOOOO -12(SB)
s := {0, 5, 8}; 27 MOVD 00000121 -16(SB)
j := j; 34 MOVW -4(SB) -4(SB)
к ;= i; 38 MOVXBO -2(SB) -8(SB)
к ;= j; 43 MOVXWD -4(SB) -8(SB)
x ;= j 48 MOVWF -4(SB) -12(SB)
END Patternl. 53 EXIT 00
55 RXP 0
Компилятор
Простые выражения. Результат выражения, содержащего операции, всегда со¬
храняется в регистре, прежде чем будет присвоен переменной или использован
в другой операции. Вообще, это необходимо для машин с двухадресными коман¬
дами. Кроме того, это следует из концепции контекстно-свободной обработки,
например код для х + у один и тот же при разборе х := х + у или z := х + у, хотя
в двухадресной машине первый может быть представлен одной командой, а по¬
следний не может.
Регистры для промежуточных результатов выделяются последовательно но
порядку R7, R6,..., R0, а для операндов с плавающей точкой - F6, F4, F2, F0. Цело¬
численное умножение и деление на степени 2 представляются быстрыми ариф¬
метическими сдвигами (ASH). Аналогично модуль степеней 2 получается маски¬
рованием старших битов (BIC). Операции объединения, разности и пересечения
множеств представляются логическими операциями (OR, BIC, AND).
MODULE Pattern2;
VAR i, j: INTEGER; -2, -4
k, n: LONGINT; -8, -12
x, y: REAL; -16, -20
s, t, u: SET; -24, -28, -32
BEGIN 0 ENTER 00 0
i := (i + 1) * (i - 1); 3 MOVW -2(SB) R7
6 ADDQW 1 R7
8 MOVW -2(SB) R6
11 ADDQW -1 R6
13 MULW R6 R7
16 MOVW R7 -2(SB)
k := ABS(k) DIV 17; 19 ABSD -8(SB) R7
23 DIVD 17 R7
30 MOVD R7 -8(SB)
k := 8*n; 33 MOVD -12(SB) R7
36 ASHD 3 R7
40 MOVD R7 -8(SB)
k := n DIV 2; 43 MOVD -12(SB) R7
46 ASHD -1 R7
50 MOVD R7 -8(SB)
342
к := n MOD 16; 53 MOVD -12(SB) R7
56 BICD FFFFFFFO R7
62 MOVD R7 -8(SB)
x := -У / (x-1.5); 65 MOVF -16(SB) F6
69 SUBF 3FCOOOOO F6
76 MOVF -20(SB) F4
80 DIVF F6 F4
83 NEGF F4 F2
86 MOVF F2 -16(SB)
k := ENTIER(x); 90 FLOORFD -16(SB) R7
94 MOVD R7 -8(SB)
s := s + t * u 97 MOVD -28(SB) R7
100 ANDD -32(SB) R7
103 MOVD -24(SB) R6
106 ORD R7 R6
108 MOVD R6 -24(SB)
END Pattern2. 111 EXIT 00
113 RXP 0
Индексированные переменные. Обращения к элементам массивов используют
режим индексной адресации. Индекс должен находиться в регистре. Он загружа¬
ется командой CHECK, которая, кроме передачи значения индекса (с расширени¬
ем знака), проверяет также, лежит ли индекс в границах, заданных в объявлении
массива. Если индекс - вне границ, последующая команда FLAG вызывает пре¬
рывание. Граничные значения хранятся в области констант модуля и адресуются
по базе SB с положительным смещением.
Если обращаются к элементу многомерного массива (матрицы), при вычис¬
лении его исполнительного адреса используется команда INDEX. Адрес элемента
[ik.r.., it, i0] k-мерного массива А с длинами пк {,пу nQ:
adr (А) + ((... ((i^ * iy2) + ik,2) * ry3 + ...)* n, + * n0 + i0
Команда INDEX r, a} b вычисляет r := r * (a-1) + b. Поэтому адрес указателя
с к индексами может быть вычислен с помощью k-1 последовательных команд
INDEX. Если все индексы - константы, приведенный полином вычисляется ком¬
пилятором. Тогда получающийся код состоит всего из одной команды.
MODULE Pattern3;
VAR i, j, k, n: INTEGER; -2, -4, -6, -8
a: ARRAY 10 OF INTEGER; -28
b: ARRAY 10 OF LONGINT; -68
x: ARRAY 10, 10 OF INTEGER; -268
y: ARRAY 10, 10, 10 OF INTEGER; -2268
BEGIN 0 ENTER 00 0
k := a[i]; 3 CHECKW R7 O(SB) -2(SB)
8 FLAG
9 MOVW -28(SB)[R7:W] -6(SB)
Шаблоны кода
343
344
Компилятор
п := а[5]; 14 MOVW -18(SB) -8(SB)
b[i] := 0; 18 CHECKW R7 4(SB) -2(SB)
23 FLAG
24 MOVQD 0 -68(SB)[R7:D]
x[i, j] := 2; 29 CHECKW R7 8(SB) -2(SB)
34 FLAG
35 CHECKW R6 12(SB) -4(SB)
40 FLAG
41 INDEXW R7 9 R6
46 MOVQW 2 -268(SB)[R7:W]
y[i, j, k] := 3; 51 CHECKW R7 16(SB) -2(SB)
56 FLAG
57 CHECKW R6 20(SB) -4(SB)
62 FLAG
63 INDEXW R7 9 R6
68 CHECKW R5 24(SB) -6(SB)
73 FLAG
74 INDEXW R7 9 R5
79 MOVQW 3 -2268(SB)[R7:W]
у[3, 4, 5] : = 6 84 MOVQW 6 -1578(SB)
END Pattern3. 88 EXIT 00
90 RXP 0
границы индексов: О 0, 9; 0, 9; 0, 9; 0, 9; 0, 9; 0, 9; О,
Поля записей и указатели. К полям записей обращаются путем вычисления
суммы (базового) адреса записи и смещения поля. Если переменная записи объ¬
явлена статически, сумма вычисляется компилятором. В случае динамически вы¬
деляемой переменной база задается указателем, по которому ссылаются на пере¬
менную, а суммирование включается в косвенный режим адресации. (Операнд
вида dl(dO(SB)) обозначает адрес Mem[SB+dO] + dl.) Динамическое выделение
памяти по оператору NEW(p) представляется тремя командами
ADDR р, R0
MOVD dsc, R1
SVC О
где dsc обозначает дескриптор типа переменной (см. шаблон 13). Обращение к
операционной системе присваивает р адрес выделенной переменной. NIL пред¬
ставляется как 0.
MODULE Patteгп4;
TYPE Ptr = POINTER TO Node;
Node = RECORD num: INTEGER; 0
name: ARRAY 8 OF CHAR; 2
next: Ptr 12
END ;
VAR p, q: Ptr; -4, -8
Шаблоны кода
BEGIN 0 ENTER ОО О
NEW(p); 3 ADDRD -4(SB) RO
6 MOVD 4(SB) R1
9 SVC О
NEW(q); 11 ADDRD -8(SB) RO
14 MOVD 4(SB) R1
17 SVC О
p.num := 6; 19 MOVQW 6 0(-4(SB))
p.name[7] := "0"; 23 MOVB 48 9(-4(SB))
p.next := q; 28 MOVD -8(SB) 12(-4(SB))
p.next.next := NIL 33 MOVD 12(-4(SB)) R7
37 MOVQD О 12(R7)
END Pattern4. 40 EXIT 00
42 RXP 0
Булевы выражения, операторы IF, WHILE и REPEAT. Условные операторы
предполагают, что часть их пропускается. Это делается при помощи команд пере¬
хода, операнд которых задает расстояние перехода. Команды обращаются к регист¬
ру условия как к неявному операнду. Его значение определяется предыдущей ко¬
мандой, как правило, сравнения или проверки битов.
Булевы операции & и OR намеренно определяются не формулами, а уравне¬
ниями
р & q = if р then q else FALSE
p OR q = if p then TRUE else q
Следовательно, булевы операции тоже должны транслироваться в переходы.
Очевидно, переходы, берущие начало в условных операторах, и переходы, беру¬
щие начало в булевых операциях, должны по возможности объединяться. Поэто¬
му получающийся код не обязательно в точности отражает структуру условного
оператора, как можно видеть в коде Pattern 5. Мы должны сделать вывод, что гене¬
рация кода для булевых выражений в некотором роде отличается от таковой для
арифметических выражений.
Пример Pattem5 используется также для демонстрации получаемого кода для
стандартных процедур INC, DEC, INCL и EXCL. Эти процедуры дают возмож¬
ность использовать более короткий код в тех случаях, когда достаточно одной
двухадресной команды, то есть когда один из аргументов совпадает с адресом на¬
значения.
MODULE Pattern5;
VAR x: INTEGER; s: SET; -2, -8
BEGIN 0 ENTER 00 0
IF x = 0 THEN 3 CMPQW 0 -2(SB)
6 BNE 6
INC(x) 9 ADDQW 1 -2(SB)
END ;
IF (x >= 0) & (x < 100) THEN 12 CMPQW 0 -2(SB)
345
346
Компилятор
15 BGT 14
18 CMPW 100 -2(SB)
23 BLE 6 DEC(x)
DEC(x) 26 ADDQW -1 -2(SB)
END ;
IF ODD(x) OR (x IN s) THEN 29 TBITB 0 -2(SB)
33 BFS 10
36 TBITW -2(SB) -8(SB)
40 BFC 10
INCL(s, 4) 43 ORD 00000010 -8(SB)
END ;
IF x < 0 THEN 50 CMPQW 0 -2(SB)
53 BLE 13
EXCL(s, 0) 56 BICD 00000001 -8(SB)
63 BR 46
ELSIF x < 10 THEN 66 CMPW 10 -2(SB)
71 BLE 13
EXCL(s, 1) 74 BICD 00000002 -8(SB)
81 BR 28
ELSIF x < 100 THEN 84 CMPW 100 -2(SB)
89 BLE 13
EXCL(s, 2) 92 BICD 00000004 -8(SB)
ELSE 99 BR 10
EXCL(s, 3) 102 BICD 00000008 -8(SB)
END
END Pattern5. 109 EXIT 00
111 RXP 0
MODULE Pattern6;
VAR i: INTEGER;
BEGIN 0 ENTER 00 0
i := 0; 3 MOVQW 0 -2(SB)
WHILE l < 10 DO 6 CMPW 10 -2(SB)
11 BLE 8
INC(i) 14 ADDQW 1 -2(SB)
END ; 17 BR -11
REPEAT DEC(i) 19 ADDQW -1 -2(SB)
UNTIL i = 0 22 CMPQW 0 -2(SB)
25 BNE -6
END Pattern6. 27 EXIT 00
29 RXP 0
Операторы выбора служат для выбора одной последовательности операторов
из множества вариантов по значению индекса. Выбор представляется прямым
переходом к выбранному варианту; команда CASE выбирает расстояние перехода
из таблицы, используя режим индексной адресации. Из приводимого кода заклю¬
чаем, что несуществующие варианты дают вход таблицы, приводящий к команде
прерывания (ВРТ 16). Таблица смещений размещается в области констант модуля.
MODULE Pattern7;
VAR i: INTEGER; s: SET; -2, -8
BEGIN О ENTER ОО 0
CASE i OF 3 CHECKW R7 O(SB) -2(SB)
9 BFS 58
12 CASEW 4(SB)[R7:W]
0: s := {0, 31} 17 MOVD 80000001 -8(SB)
24 BR 45
I 1: s := {1, 30} 27 MOVD 40000002 -8(SB)
34 BR 35
I 2: s := {2, 29} 37 MOVD 20000004 -8(SB)
44 BR 25
I 4: s := {4, 27} 47 MOVD 08000010 -8(SB)
54 BR 15
I 5: s := {5, 26} 57 MOVD 04000020 -8(SB)
64 BR 5
67 BPT 16
END
END Pattern7. 69 EXIT 00
71 RXP 0
границы индексов: О 0, 5
массив смещений для переходов: 4 5, 15, 25, 55, 35, 45
Процедуры. Тела процедур ограничиваются командами ENTER и EXIT. Они
устанавливают и сбрасывают значения SP и FP (см. главу 6). Последний храпит
адрес записи активации процедуры в стеке. Второй параметр команды ENTER
задает размер области иод локальные переменные процедуры, округленный до
4 в большую сторону. Процедуры (которые не экспортируются) заканчиваются
командой RET; ее параметр задает область под параметры, которые адресуются
относительно FP с положительными смещениями.
Вызовы (внутри модуля) используют команду BSR. Параметры помещаются
в стек перед командой BSR, используя режим адресации TOS. Каждый параметр
занимает, по крайней мере, 4 байта (или кратное им). В случае параметров-зна¬
чений загружаются их значения, а в случае параметров-переменных - их адреса.
MODULE Patteгп8; О ENTER 00 0
VAR i: INTEGER; 3 BR 22
PROCEDURE P(x: INTEGER; VAR y: INTEGER);
VAR z: INTEGER;
BEGIN 8 ENTER 00 4
z := x; 12 MOVW 12(FP) -2(FP)
у := z 16 MOVW -2(FP) 0(8(FP))
END P; 21 EXIT 00
23 RET 8
BEGIN P(5, i) 25 M0VQD 5 TOS
27 ADDRD -2(SB) TOS
30 BSR -22
Шаблоны кода
347
Компилятор
END Pattern8. 32 EXIT 00
34 RXP 0
Процедуры-функции обрабатываются точно так же, как обычные процедуры,
за исключением того, что результат, заданный в операторе RETURN, возвраща¬
ется в регистре R0 или F0. Если функция вызывается в выражении, где промежу¬
точные результаты сохранены в регистрах, эти значения помещаются в стек перед
вызовом и восстанавливаются после него командами SAVE и RESTORE. (Коман¬
да ВРТ 17 оказывается в конце каждой процедуры-функции и принимает меры
в отношении ошибочных функций без выполняемого оператора RETURN.)
Динамические массивы как параметры передаются загрузкой дескриптора
в стек, независимо от того, передаются они по значению или по ссылке. Дескрип¬
тор состоит из фактического адреса переменной и границ его индексов (нижняя
граница всегда 0). В случае n-мерных массивов требуется п граничных пар.
Если динамический массив вызывается по значению, то при входе в процедуру
создается копия его значения. Длина вычисляется увеличением верхней границы
и делением суммы на размер элемента массива с помощью команды сдвига, полу¬
чая в итоге число элементов, которые нужно скопировать (R7). Копии заносятся
в стек быстрым циклом, использующим команду АСВ (Add, Compare, Branch).
После этого адрес массива в дескрипторе заменяется адресом копии (SP).
К элементам динамических массивов обращаются, как и к статическим, ис¬
пользуя команду CHECK для загрузки индекса в регистр. Даже если индекс -
константа, проверка не может быть выполнена компилятором. Функция LEN по¬
лучает длину добавлением 1 к верхней границе.
348
MODULE Pattern9; 0 ENTER 00 О
VAR х: REAL; 3 BR 39
PROCEDURE F(x: REAL): REAL;
BEGIN 8 ENTER 00 0
x := F(x * 0.5); 12 MOVF 8(FP) F6
16 MULF 3F000000 F6
23 MOVF F6 TOS
26 BSR -18
28 MOVF FO 8(FP)
RETURN x 32 MOVF 8(FP) FO
END F; 36 EXIT 00
38 RET 4
40 BPT 17
BEGIN x := F(F(10.0)) 42 MOVF 41200000 TOS
49 BSR -41
51 MOVF RO TOS
54 BSR -46
56 MOVF FO -4(SB)
END Pattern9. 60 EXIT 00
62 RXP 0
Шаблоны кода
MODULE PatternlO; О ENTER ОО 0
3 BR 94
VAR a: ARRAY 10 OF CHAR; -10
b: ARRAY 4, 8 OF INTEGER; -76
PROCEDURE PO(x: ARRAY OF CHAR);
VAR k: LONGINT;
BEGIN ‘ 8 ENTER 00 4
12 MOVD 12(FP) R7
15 ADDQD 4 R7
17 ASHD -2 R7
21 MOVD 8(FP) R6
24 MOVD -4( R6)[R7:D] TOS
28 ACBD -1 R7 -4
31 ADDRD O(SP) 8(FP)
к := LEN(x) 35 MOVD 12(FP) R7
38 ADDQD 1 R7
40 MOVD R7 -4(FP)
END PO; 43 EXIT 00
45 RET 8
PROCEDURE P1(VAR x: ARRAY OF CHAR);
BEGIN 47 ENTER 00 0
x[1] := "0" 51 CHECKW R7 12(FP) 0001
57 FLAG
58 MOVB 48 0(8(FP))[R7:B]
END PI; 64 EXIT 00
66 RET 8
PROCEDURE P2(VAR x: ARRAY OF ARRAY OF INTEGER);
VAR i, j: INTEGER;
BEGIN 68 ENTER 00 4 x[i, j] := 3
72 CHECKW R7 16(FP) -2(FP)
77 FLAG
78 CHECKW R6 12(FP) -4(FP)
83 FLAG
84 INDEXW R7 12(FP) R6
88 MOVQW 3 0(8(FP))[R7:W]
END P2; 93 EXIT 00
95 RET 12
BEGIN P0(a); 97 MOVD O(SB) TOS
100 ADDRD -10(SB) TOS
103 BSR -95
P1(a); 106 MOVD O(SB) TOS
109 ADDRD -10(SB) TOS
112 BSR -65
P0("ABCDE") 115 MOVQD 5 TOS
117 ADDRD 12(SB) TOS
120 BSR -112
P2(b) 123 MOVD 4(SB) TOS
ШЛ
Компилятор
126 MOVD 8(SB) TOS
129 ADDRD -76(SB) TOS
133 BSR -65
END PatternlO. 136 EXIT 00
138 RXP 0
индексные границы О 0, 9; О, 3; 0, 7
и константы:
12 "ABCDE"
Вложенные процедуры. Если к глобальным и локальным переменным обраща¬
ются по SB и FP, то к переменным промежуточных уровней обращаются, спуска¬
ясь по статической цепочке в стеке. Это тот случай, когда к переменной х обраща¬
ются из процедуры Q, которая локализована в другой процедуре Р с локальной
переменной х. При вызове локальной процедуры создается элемент статической
цепочки; он обозначает адрес записи активации процедуры, в которой локально
объявлена вызывающая процедура. Этого не делается, если вызывающая процеду¬
ра - глобальная, потому что тогда окружение имеет в качестве базы SB. Регистр
SB может считаться встроенным в архитектуру процессора средством оптимиза¬
ции доступа к глобальным переменным.
Обращение к переменной, локализованной в процедуре, непосредственно
включающей процедуру, обращающуюся к переменной, использует косвенный ре¬
жим адресации. Когда разность уровней между самой переменной и обращением
к ней больше 1, для спуска по цепочке требуется несколько команд. Однако это
происходит редко.
MODULE Patternl1; О ENTER 00 О
VAR u: INTEGER; 3 BR 62
PROCEDURE P; 8 ENTER 00 4
VAR x: INTEGER; 12 BR 44
PROCEDURE Q; 15 ENTER 00 4
VAR y: INTEGER; 19 BR 28
PROCEDURE R; 22 ENTER 00
VAR z: INTEGER;
BEGIN u := z + у + x 26 MOVW -2(FP) R7
29 ADDW -2(8(FP)) R7
33 MOVD 8(8(FP)) R6
37 ADDW -2( R6) R7
40 MOVW R7 -2(SB)
END R; 43 EXIT 00
45 RET 4
BEGIN R 47 ADDRD 0(FP) TOS static chain
50 BSR -28
END Q; 52 EXIT 00
350
54 RET 4
BEGIN Q 56 ADDRD O(FP) TOS static chain
59 BSR -44
END P; 61 EXIT 00
63 RET 0
BEGIN P 65 BSR -57
END Pattern11. 67 EXIT 00
69 RXP 0
Внешние переменные и процедуры. Если процедура импортируется из другого
модуля, ее адрес недоступен компилятору Поэтому процедура идентифицируется
номером, полученным из символьного файла импортируемого модуля. Для вы¬
зова внешней процедуры вместо команды BSR генерируется команда СХР (см.
главу 6). Ее параметр - это индекс в таблице связей вызывающего модуля. Запись
в таблице содержит базовый адрес дескриптора вызываемого модуля и смещение
процедуры в коде модуля. Эти значения вычисляются загрузчиком по номеру мо¬
дуля и номеру процедуры, которые помещаются компилятором в заголовок объ¬
ектного файла (см. главу 6). Экспортируемые процедуры заканчиваются коман¬
дой RXP вместо RET.
К импортируемым переменным обращаются, используя режим внешней адре¬
сации. Их смещение добавляется к базовому адресу области данных импорти¬
руемого модуля, который содержится в таблице связей. Если импортируется п
модулей, первые п входов таблицы содержат соответствующие базовые адреса.
Следовательно, первый параметр внешнего адреса - номер модуля, а второй -
смещение.
В следующем примере оба модуля Pattern 12а и Pattern 12b экспортируют про¬
цедуру и переменную. На них ссылаются из импортирующего модуля Pattern 12с.
Первые два входа таблицы связей - это входы данных (обозначенные специаль¬
ным значением 255), остальные входы ссылаются на внешние процедуры, а их ин¬
дексы оказываются параметрами команд СХР.
Шаблоны кода
35f
MODULE Patteгп12a; 0 ENTER 00 0
VAR k*: INTEGER; 3 BR 16
PROCEDURE P*; 8 ENTER 00 0
BEGIN k := 1 12 MOVQW 1 -2(SB)
END P; 15 EXIT 00 17 RXP 0
END Pattern12a. 19 EXIT 00
21 RXP 0
вход: 1, 8
MODULE Pattern12b; 0 ENTER 00 0
VAR x*: REAL; 3 BR 18
PROCEDURE P*; 8 ENTER 00 0
BEGIN* x : = 1 12 M0VBF 1 -4(SB)
END P; 17 EXIT 00 19 RXP 0
END Pattern12b. 21 EXIT 00 23 RXP 0
MODULE Pattern12c;
Компилятор
Расширения записей с указателями. Поля записи типа R1, который объявлен
как расширение типа R0, просто добавляются к полям R0, то есть их смещения
больше смещений полей R0. Если запись объявлена статически, ее тип известен
компилятору. Однако если к записи обращаются по указателю, дело обстоит ина¬
че. Указатель, связанный с исходным типом R0, может также ссылаться на запись
расширения R1. Проверка (и защита) типа позволяет проверить фактический тип,
а это требует, чтобы тип мог быть опознан при выполнении программы. Поскольку
в языке определена эквивалентность имен, а не структур типов, тип может иден¬
тифицироваться номером. Для этого мы используем адрес уникального дескрип¬
тора. Поэтому проверка типов состоит из простого и очень быстрого сравнения
адресов. Дескрипторы типа генерируются загрузчиком, а их адреса, называемые
тэгами типов, хранятся в области констант модуля. Тип (динамически выделяе¬
мой) переменной хранится в виде префикса записи (со смещением -4).
Дескриптор типа содержит - в дополнение к информации, сохраняемой для
использования сборщиком мусора, - таблицу тэгов всех основных типов. На¬
пример, если тип R2 - это расширение R1, которое является расширением R0, то
дескриптор R2 содержит тэги R1 и R0, как показано на рис. 12.4. Таблица имеет
7 фиксированных входов.
Рис. 12.4. Дескрипторы типов
IMPORT Pattern12a, Pattern12b;
VAR i: INTEGER; x: REAL;
BEGIN О ENTER ОО 0
i := Pattern12a.k; 3 MOVW EXT(1)-2 -2(SB)
x := Pattern12b.x; 8 MOVF EXT(2)-4 -8(SB)
Pattern12a.P; 14 CXP 3
Pattern12b.P 16 CXP 4
END Pattern12c. 18 EXIT 00
20 RXP 0
импорты 0 Pattern12a
1 Pattern12b
связи (данные: mno, 255):
1 1, 255
2 2, 255
(процедуры: inno, pno):
3 1,1
4 2, 1
352
Защита типа р(Т) равносильна оператору
iT^P IS Т) THEN HALT(18) END
но появляется внутри обозначений переменных. (Очевидно, прерывающая по
неравенству однобайтовая команда вроде FLAG была бы полезна на месте пары
команд BEQ4,BPT 18.)
MODULE Pattern13; О ENTER 00 0
TYPE
P0 = POINTER TO RO;
P1 = POINTER TO R1;
P2 = POINTER TO R2;
RO = RECORD x: INTEGER END ;
R1 = RECORD (RO) y: INTEGER END ;
R2 = RECORD (R1) z: INTEGER END ;
VAR
pO: P0; -4
p1: PI; -8
p2: P2; -12
BEGIN 3 MOVD 4(SB) 4(4(SB))
8 MOVD 8(SB) 8(8(SB))
13 MOVD 4(SB) 4(8(SB))
pO.x := 0; 18 MOVQW 0 0(-4(SB))
pl.y := 1; 22 MOVQW 1 4(-8(SB))
pO(P1).y := 2; 26 MOVD -4(-4(SB)) R7
30 CMPD 4( R7) 4(SB)
34 BEQ 4
36 BPT 18
38 MOVQW 2 4(-4(SB))
pO(P2).z := 3; 42 MOVD -4(-4(SB)) R7
46 CMPD 8( R7) 8(SB)
50 BEQ 4
52 BPT 18
54 MOVQW 3 8(-4(SB))
IF p1 IS P2 THEN 58 MOVD -4(-8(SB)) R7
62 CMPD 8( R7) 8(SB)
66 BNE 7
pO := p2 69 MOVD -12(SB) -4(SB)
END
END Pattern13. 73 EXIT 00
75 RXP 0
Адреса тэгов типов - 0, 4, 8 (SB)
Расширения записей как VAR-параметры. Записи в качестве VAR-параметров
тоже могут потребовать проверку типа при выполнении программы, потому что
VAR-параметры фактически представляют собой скрытые указатели. Проверка
и защита типа VAR-параметров выполняются так же, как для переменных, к ко-
ц]аблоны кода
353
торым обращаются по указателю, но с небольшим отличием. Статически объяв¬
ленные переменные-записи могут использоваться как фактические параметры, и
у них нет тэга как префикса типа. Поэтому тэг должен предоставляться вместе
с адресом переменной при вызове процедуры, то есть при передаче фактического
параметра. Поэтому VAR-параметры типа записей состоят из адреса и тэга типа и
похожи на дескрипторы динамических массивов, состоящие из адреса и границ.
Следующий пример показывает также присваивание записи, фактически
проекцию R1 на R0. Оно представлено одной командой пересылки блока байтов
(MOVM). Ее последний параметр - это число копируемых байтов минус 1.
Множества. Этот последний шаблон кода показывает конструкцию множеств.
Если заданные элементы - константы, значение множества вычисляется компи¬
лятором (см. шаблон 7). Иначе применяются последовательности команд пере¬
сылки и сдвига. Так как команды сдвига не проверяют, находится ли величина
сдвига в пределах допустимых границ, результаты становятся непредсказуемыми,
если встречаются элементы вне диапазона 0-31.
MODULE Patte rn15;
VAR s: SET; i, j: INTEGER; -4, -6, -8
BEGIN 0 ENTER 00 0
s := {i}; 3 M0VQD 1 R7
5 LSHD -6(SB) R7
9 MOVD R7 -4(SB)
354
Компилятор
MODULE Patteгп14; О ENTER 00 0
TYPE 3 BR 30
RO = RECORD a, b, c: LONGINT END ;
R1 = RECORD (RO) x, y: LONGINT END ;
VAR
rO: RO; -12
r1: R1; -32
PROCEDURE P(VAR r: RO); 8 ENTER 00 0
BEGIN r.a := 1; 12 MOVQD 1 0(8(FP))
r(R1).x := 2 16 CMPD 4(12(FP)) 4(SB)
21 BEQ 4
23 BPT 18
25 MOVQD 2 12(8(FP))
END P; 29 EXIT 00
31 RET 8
BEGIN 33 MOVD 4(SB) 4(4(SB))
rO := r1; 38 M0VMB -32(SB) -12(SB) 11
P(r1) 44 MOVD 4(SB) TOS
47 ADDRD -32(SB) TOS
50 BSR -42
END Pattern14. 52 EXIT 00
54 RXP 0
Адреса тэгов типов - 0, 4 (SB)
s := {0 .. i}; 12 MOVQD -2 R7
14 LSHD -6(SB) R7
18 COMD R7 R7
21 MOVD R7 -4(SB)
s := {i .. 27}; 24 MOVQD -1 R7
26 LSHD -6(SB) R7
30 BICD FOOOOOOO R7
36 MOVD R7 -4(SB)
s := (i j}; 39 MOVQD -1 R7
41 LSHD -6(SB) R7
45 MOVQD -2 R6
47 LSHD -8(SB) R6
51 BICD R6 R7
53 MOVD R7 -4(SB)
INCL(s, i) 56 MOVQD 1 R7
58 LSHD -6(SB) R7
62 ORD R7 -4(SB)
END Pattern15. 65 EXIT 00
67 RXP 0
12.3. Внутренние структуры данных
и интерфейсы
В разделе 12.1 объяснялось, что объявления неизбежно приводят к контекст¬
ной зависимости процесса перевода. Хотя синтаксический анализ все-таки прово¬
дится на основе контекстно-свободного синтаксиса и полагается на контекстную
информацию только из нескольких изолированных экземпляров класса, инфор¬
мация, предоставляемая объявлениями, существенно влияет на генерируемый
код. Во время обработки объявлений информация из них переносится в «таблицу
символов», структуру данных значительной сложности, из которой она извлека¬
ется для генерации кода.
Эта динамическая структура данных определена в модуле ОСТ двумя типами
записей с именами Object и Stmct (см. определение ОСТ). Эти типы распростра¬
няются на все прочие модули, за исключением сканера. Поэтому они объясняются
до обсуждения дальнейших подробностей компилятора.
Для каждого объявленного идентификатора создается запись типа Object.
Запись содержит идентификатор и свойства, заданные в его объявлении. Так как
язык Оберон — язык со статическими типами, у каждого объекта есть тип. Он
представлен в записи полем typ - указателем на запись типа Stmct. Поскольку
многие объекты могут иметь один и тот же тип, уместно записать атрибуты типа
только раз и обращаться к ним по указателю. Свойства типа Struct будут обсуж¬
даться ниже.
Вид объекта в записи таблицы указывается в поле mode. Его значения зада¬
ются именованными целыми константами. Так, Var указывает на то, что запись
описывает переменную, Соп - константу, Fid - поле записи, Ind - VAR-параметр
Внутренние структуры данных и интерфейсы
355
и xProc - процедуру. Разные виды записей имеют разные атрибуты. Переменная
или параметр имеют адрес, константа - значение, поле записи - смещение, а про¬
цедура - адрес входа, список параметров и тип результата. Казалось бы, для каж¬
дого вида было бы желательно ввести расширяемый тип записи. Однако этого не
было сделано по трем причинам. Во-первых, компилятор был сначала написан на под¬
множестве языка Модула-2, которому не свойственно расширение типа. Во-вторых,
без использования расширения типа проще переводить компилятор на другие
языки для переноса языка Оберон на другие компьютеры. И в-третьих, все рас¬
ширения были известны во время проектирования компилятора. Следовательно,
расширяемость не стала аргументом для введения большого разнообразия типов.
Простейшее решение - использование многоцелевых полей аО, а1, а2 и dsc для
различных атрибутов. Например, аО содержит адрес переменной, параметра и про¬
цедуры, а также смещение поля записи и значение константы.
Определение типа создает запись типа Stmct независимо от того, происходит
ли это при объявлении типа, когда создается еще и запись типа Object (mode =
= Тур), или при объявлении переменной, когда тип остается безымянным. Все типы
характеризуются формой и размером. Тип - это либо простой тип, либо состав¬
ной тип. В последнем случае он ссылается на другие типы. Составные типы - это
массивы, записи, указатели и процедурные типы. Атрибут формы form указывает
на эту классификацию. Его значение - это целое число, позволяющее применить
оператор CASE для быстрого выбора варианта.
Как разные виды объектов характеризуются разными атрибутами, так разные
формы типов имеют разные атрибуты. И здесь расширение типа Struct не приме¬
нялось. Вместо этого некоторые из полей типа Stmct оставались неиспользован¬
ными в случае простых типов, а другие поля использовались для зависящих от
формы атрибутов. Например, атрибут BaseTyp ссылается на тип элемента в случае
массива, на тип результата в случае процедуры, на связанный с указателем тип или
на базовый тип (расширенного) типа записи. Атрибут link ссылается на список
параметров в случае процедуры или на список полей в случае записи.
Для примера рассмотрим следующие объявления. Соответствующая структу¬
ра данных показана на рис. 12.5. За подробностями читатель отсылается к про¬
граммному тексту модуля ОСТ и пояснениям к нему
CONST N = 100;
TYPE Ptr = POINTER TO Rec;
Rec = RECORD n: INTEGER; p. q; Ptr END ;
VAR k; INTEGER;
a; ARRAY N OF INTEGER;
PROCEDURE P(x: INTEGER): INTEGER;
Во время компиляции создаются записи только составных типов. Записи для
каждого простого типа создаются при инициализации компилятора. Это записи
типа Object, содержащие идентификатор стандартного типа, и типа Stmct, указы¬
вающие на их форму, обозначаемую одним из значений Byte, Bool, Char, Sint, Int,
Lint, Real, LReal или Set. Записи типа Object простых типов закреплены в глобаль-
Компилятор
356
Внутренние структуры данных и интерфейсы
Рис. 12.5. Внутреннее представление объявлений
ных переменных-указателях (которые в действительности должны считаться кон¬
стантами).
При инициализации создаются записи не только для простых типов, но и для
всех стандартных процедур. Поэтому каждая компиляция начинается с таблицей
символов, отражающей все стандартные, общедоступные идентификаторы и соот¬
ветствующие им объекты.
Теперь вернемся к Objects. Если объекты основных видов (Con, Var, Ind, Fid,
Тур, xProc и Mod) непосредственно отражают объявленные идентификаторы и
образуют контекст, в котором компилируются операторы и выражения, то при
компиляции выражений, как правило, генерируются безымянные объекты допол¬
нительных, неосновных видов. Такие объекты отражают селекторы, множители,
слагаемые и т. д., то есть составляющие выражений и операторов. А раз так, то они
имеют временную природу и, следовательно, им не место среди основных объек¬
тов. Вместо этого они представляются переменными-записями, локализованными
ЕШ
Компилятор
в процедурах обработки, и потому заносятся в стек. Их тип называется Item и яв¬
ляется небольшой вариацией типа Object.
Допустим, например, что анализируется терм х * у. Пусть операция и оба ее
множителя уже разобраны. Множители х и у представлены двумя переменными
типа Item с видом Var. Получающийся терм снова описывается элементом, а так
как он - временный, то есть имеет значение только внутри выражения, состав¬
ляющей которого является, то должен сохраняться во временной памяти, на ре¬
гистре. Чтобы показать, что элемент помещен в регистр, вводится новый неос¬
новной вид Reg.
Фактически все неосновные виды отражают архитектуру целевого компью¬
тера, в частности ее режимы адресации. Чем больше режимов адресации имеет
компьютер, тем больше видов элементов нужно для их представления. Дополни¬
тельные виды элементов и соответствующие им режимы адресации, применяемые
в компиляторе для процессора NS-32000, таковы:
Использование типов Object, Item и Stmct для различных видов и форм, а так¬
же значения их атрибутов объясняет следующая таблица:
Объекты: Элементы:
358
Вид элемента
Режим процессора
VarX
Индексный
IndX
Косвенный индексный
Reg
Прямой регистровый
Regl
Косвенный регистровый
RegX
Косвенный индексный регистровый
Stk
Стековый (TOS)
Coc
Код условия
Abs
Абсолютный
mode
aO al
dsc
lev
aO
al
a2 obj
0
Undef
1
Var
adr
lev
adr
obj
2
VarX
lev
adr
RX
3
Ind
adr
lev
adr
off
4
IndX
lev
adr
off
RX
5
Regl
R
off
6
RegX
R
off
RX
7
Abs
adr
8
Con
val
val
sadr
val
leng
(строки)
9
Stk
(стек)
10
Coc
CC
Tjmp Fjmp
(код условия)
И
Ref
R
^утренние структуры данных и интерфейсы
BaseTvp link mno
adr
Элементы (записи типа Item) имеют атрибут lev, который является частью
адреса элемента. Его положительное значение - это уровень вложения процедуры,
в которой объявлен элемент; lev = 0 означает глобальный объект. Отрицательное
значение указывает на то, что объект импортирован из модуля с номером -lev.
Три типа Object, Item и Stmct определены в интерфейсе модуля ОСТ, который
содержит также процедуры доступа к таблице символов. Insert служит для регист¬
рации нового идентификатора и возвращает указатель на выделенную запись. Find
возвращает указатель на объект, чье имя равно значению глобальной переменной
сканера OCS.name, а также уровень найденного объекта.
Процедура Import служит для чтения заданного символьного файла и внесе¬
ния его идентификатора в таблицу символов (mode = Mod). Findlmpoit извлекает
объект с именем OCS.name из ранее импортированного модуля. Наконец, Export
создает символьный файл откомпилированного модуля, содержащий описания
всех объектов и структур, помеченных для экспорта.
DEFINITION ОСТ; ^Обработчик таблиц*)
ТУРЕ
Object = POINTER ТО ObjDesc;
Struct = POINTER TO StrDesc;
ObjDesc = RECORD
dsc, next: Object;
typ: Struct;
mode
aO
al
dsc
lev
aO
al
a2
.obj
12
Fid
off
off
obj
13
Typ
mno
tadr
obj
14
LProc
adr
pars
adr
obj
(локальная
процедура)
15
XProc
pno
Ladr
pars
mno
pno
Ladr
obj
(внешняя
процедура)
16
SProc
fno
fno
(стандартная
процедура)
17
CProc
CllO
pars
cno
obj
(код
процедуры)
18
IProc
pno
Ladr
adr
Ladr
obj
(обработчик
прерываний)
19
Mod
mno
key
mno
obj
20
Head
lev
psize
form
BaseTvp
link
mno
n adr
13
Pointer
PBaseTyp
14
ProcTyp ResTyp
param
15
Array
ElemTyp
mno
nofel границы
16
DynArr
ElemTvp
17
Record
BaseTyp
fileds
mno
descr
359
360
Компилятор
аО, а1: LONGINT;
а2: INTEGER;
mode: SHORTINT;
marked: BOOLEAN;
name: ARRAY 32 OF CHAR;
END;
StrDesc = RECORD
form, n, mno, ref: INTEGER;
size, adr: LONGINT;
BaseTyp: Struct;
link, strobj: Object;
END;
Item = RECORD
mode, lev: INTEGER;
aO, al, a2: LONGINT;
typ: Struct;
obj: Object;
END;
VAR topScope: Object;
undftyp, bytetyp, booltyp, chartyp, sinttyp, inttyp, linttyp, realtyp, lrltyp,
settyp, stringtyp, niltyp, notyp: Struct;
nofGmod: INTEGER;
GlbMod: ARRAY 24 OF Object;
PROCEDURE Init;
PROCEDURE Close;
PROCEDURE Findlmport (mod: Object; VAR res: Object);
PROCEDURE Find (VAR res: Object; VAR level: INTEGER);
PROCEDURE FindField (typ: Struct; VAR res: Object);
PROCEDURE Insert (VAR name: ARRAY OF CHAR; VAR res: Object);
PROCEDURE OpenScope (level: INTEGER);
PROCEDURE CloseScope;
PROCEDURE Import (VAR name, self, FileName: ARRAY OF CHAR);
PROCEDURE Export (VAR name, FileName: ARRAY OF CHAR;
VAR newSF: BOOLEAN; VAR key: LONGINT);
END OCT.
Прежде чем приступить к представлению основного модуля компилятора -
синтаксического анализатора, приведем краткий обзор остальных его модулей
в виде их интерфейсов. Читателю предлагается обращаться к ним при изучении
синтаксического анализатора.
Интерфейс сканера (OCS) прост; его главная составляющая - процедура Get.
Каждое обращение к ней дает следующий символ исходного текста в виде целого
числа. В определенных случаях глобальные переменные представляют атрибуты
прочитанного символа. Если прочитано число, numtyp указывает его тип, a intval,
realval или LrLval задают его числовое значение. Если прочитан идентификатор или
строка, пате содержит коды ASCII прочитанных литер.
Процедура Mark служит для генерации диагностического сообщения с ука¬
занием кода ошибки и текущей позиции сканера в исходном тексте. Процедура
локализована в сканере, потому что только сканер имеет доступ к его текущей по¬
зиции. Mark вызывается из всех прочих модулей.
DEFINITION 0CS; (*Сканер*)
IMPORT Texts;
VAR numtyp: INTEGER;
intval: LONGINT;
realval: REAL;
Irlval: LONGREAL;
scanerr: BOOLEAN;
name: ARRAY 128 OF CHAR;
PROCEDURE Mark (n: INTEGER);
PROCEDURE Get (VAR sym: INTEGER);
PROCEDURE Init (source: Texts.Text; pos: LONGINT);
END OCS.
Модуль ОСЕ содержит процедуры для выбора кода и проверки совместимо¬
сти типов выражений. Имена этих процедур явно указывают на соответствующие
конструкции, для которых должен выбираться код; тем не менее, несколько до¬
полнительных пояснений могут быть полезными.
SetlntType вызывается для определения точного числового типа элемента,
обозначающего константу; тип зависит от величины значения. TypeTest вызыва¬
ется для проверки и защиты типа. SetO создает элемент единичного множества,
состоящий из элемента, заданного вторым параметром у, a Set1 создает множество'
с элементами от у до г. МОр и Ор обрабатывают составляющие выражений с одно¬
местными и двуместными операциями соответственно. И наконец, StParl, StPar2,
StPar3 и StFct обрабатывают вызовы стандартных процедур и функций, генери¬
рующих встроенный код.
DEFINITION ОСЕ;
IMPORT ОСТ;
VAR inxchk: BOOLEAN;
PROCEDURE SetlntType (VAR x: OCT.Item);
PROCEDURE AssReal (VAR x: OCT.Item; y: REAL);
PROCEDURE AssLReal (VAR x: OCT.Item; y: LONGREAL);
PROCEDURE Index (VAR x, y: OCT.Item);
PROCEDURE Field (VAR x: OCT.Item; y: OCT.Object);
PROCEDURE DeRef (VAR x: OCT.Item);
PROCEDURE TypTest (VAR x, y: OCT.Item; test: BOOLEAN);
PROCEDURE In (VAR x, y: OCT.Item);
PROCEDURE SetO (VAR x, y: OCT.Item);
PROCEDURE Set1 (VAR x, y, z: OCT.Item);
Внутренние структуры данных и интерфейсы
361]
362
Компилятор
PROCEDURE MOp (op: INTEGER; VAR x: OCT.Item);
PROCEDURE Op (op: INTEGER; VAR x, y: OCT.Item);
PROCEDURE StParl (VAR x: OCT.Item; fctno: INTEGER);
PROCEDURE StPar2 (VAR p, x: OCT.Item; fctno: INTEGER);
PROCEDURE StPar3 (VAR p, x: OCT.Item; fctno: INTEGER);
PROCEDURE StFct (VAR p: OCT.Item; fctno, parno: INTEGER);
END OCE.
Процедуры обработки операторов содержатся в модуле ОСН. Присваивания и
вызовы процедур обрабатываются процедурами Assign, Prep Call, Call и Param . Про¬
цедуры Enter, Result и Return генерируют код в начале и в конце тела процедуры.
Операторы IF, WHILE, REPEAT и LOOP включают переходы в обход кода их
составляющих. Процедуры FJ (переход вперед), СЕ] (условный переход вперед),
BJ (переход назад), CBJ (условный переход назад) и LFJ(длинный переход вперед)
служат для выдачи таких обходов. Наконец, Casein и CaseOut генерируют код для
оператора CASE. Casein выдает команду перехода по индексу, используя таблицу
адресов, созданную CaseOut.
DEFINITION ОСИ;
IMPORT ОСТ;
TYPE LabelRange = RECORD low, high, label: INTEGER END ;
PROCEDURE Trap (n: INTEGER);
PROCEDURE CompareParLists (x, y: OCT.Object);
PROCEDURE Assign (VAR x, y: OCT.Item; param: BOOLEAN);
PROCEDURE FJ (VAR loc: INTEGER);
PROCEDURE CFJ (VAR x: OCT.Item; VAR loc: INTEGER);
PROCEDURE BJ (loc: INTEGER);
PROCEDURE CBJ (VAR x: OCT.Item; loc: INTEGER);
PROCEDURE LFJ (VAR loc: INTEGER);
PROCEDURE PrepCall (VAR x: OCT.Item; VAR fpar: OCT.Object);
PROCEDURE Param (VAR ap: OCT.Item; f: OCT.Object);
PROCEDURE Call (VAR x: OCT.Item);
PROCEDURE Enter (mode: SHORTINT; pno: LONGINT; VAR L: INTEGER);
PROCEDURE CopyDynArray (adr: LONGINT; typ: OCT.Struct);
PROCEDURE Result (VAR x: OCT.Item; typ: OCT.Struct);
PROCEDURE Return (mode: INTEGER; psize: LONGINT);
PROCEDURE Casein (VAR x: OCT.Item; VAR LO, L1: INTEGER);
PROCEDURE CaseOut (LO, L1, L2, L3, n: INTEGER; VAR tab: ARRAY OF LabelRange);
END OCH
12.4. Синтаксический анализатор
Основной модуль Compiler представляет собой синтаксический анализатор.
Его единственная команда Compile (в конце текста программы) задает исходный
текст согласно соглашениям о командах Оберона. Затем она вызывает процедуру
CompilationUnit с заданным исходным текстом в качестве параметра. Команда име¬
ет такие форматы:
Синтаксический анализатор
363
Compiler.Compile * Исходный текст содержится в помеченном окошке.
Compiler.Compile " Исходный файл задан самым последним выделением.
Compiler.Compile @ Начало исходного текста задано самым последним выделением.
Compiler.Compile fO f1... ~ fO, f1... - имена исходных файлов.
Имена файлов и символы * А и @ могут сопровождаться спецификацией оп¬
ций /s, /х, Д. Опция s разрешает компилятору перезапись существующего сим¬
вольного файла, нарушая тем самым согласованность модулей-клиентов. Опция х
подавляет проверку индексов, а опция t подавляет защиту типов.
Синтаксический анализатор разработан с применением проверенного мето¬
да разбора - нисходящего рекурсивного спуска с опережением в один символ.
Последний прочитанный символ представляется глобальной переменной sym.
Синтаксические объекты отображаются в одноименные с ними процедуры. Их за¬
дача - распознать данную конструкцию в исходном тексте. Начальный символ и
соответствующая ему процедура - CompilationUnit. Основные процедуры синтак¬
сического анализатора, а также иерархия их вызовов показаны на рис. 12.6. Циклы
Рис. 12.6. Иерархия процедур синтаксического анализатора
в диаграмме указывают на рекурсию в синтаксическом определении. (Процедура
qualident опущена; она вызывается многими другими процедурами.)
Правило разбора, основанное на опережающем чтении всего одного символа и
независимости от контекста, нарушается в трех местах. Первое заметное наруше¬
ние происходит в операторах. Если первый символ оператора - идентификатор,
то решение о том, что мы должны распознавать - присваивание или вызов про¬
цедуры, опирается на контекстную информацию, а именно на вид объекта, обо¬
значенного идентификатором. Второе нарушение происходит в qualident: если
идентификатор х перед точкой обозначает модуль, то он распознается вместе
с последующим идентификатором в качестве его квалификатора. В противном
случае х, возможно, обозначает переменную записи. Третье нарушение делается
в процедуре selector: если за идентификатором следует левая круглая скобка, то
решение о том, что должно распознаваться - вызов процедуры или защита типа,
снова принимается на основании контекстной информации, а именно по виду
идентифицируемого объекта.
Довольно большая часть программы посвящена выявлению ошибок. Их нужно
не только точно диагностировать. Гораздо труднее продолжить разбор дальше на
основе правильных предположений о наиболее вероятной структуре последующе¬
го текста. Процесс разбора должен быть продолжен с некоторым предположением
и, возможно, после пропуска небольшой части исходного текста. Следовательно,
этот аспект разбора опирается главным образом на эвристики. Неправильные
предположения о характере синтаксической ошибки приводят к вторичным со¬
общениям об ошибках. И способа избежать их нет. Приемлемо хороший резуль¬
тат получается, когда процедура OCS.Mark запрещает сообщение об ошибке, если
она находится ближе 10 литер от последней. Кроме того, язык Оберон спроекти¬
рован так, что наиболее крупные конструкции начинаются с таких уникальных
символов, как IF, WHILE, CASE, RECORD и т. д. Эти символы облегчают восста¬
новление процесса разбора в ошибочном тексте. Более проблематичны открытые
конструкции, у которых ни в начале, ни в конце нет ключевых символов, например
типы, множители и выражения. Полагаясь на эвристику, исходный текст пропу¬
скается до первого появления символа, которым может начинаться следующая за
ним конструкция. Используемая схема, наверное, не самая лучшая, но она приво¬
дит к весьма приемлемым результатам и удерживает объем программы обработки
ошибочных текстов в пределах допустимых границ.
Если проверку совместимости типов и генерацию кода синтаксический ана¬
лизатор поручает процедурам, определенным главным образом в модулях ОСЕ
и ОСП, то обработка объявлений большей частью выполняется подпрограммами
синтаксического анализа. Таким образом можно избежать неоправданно большо¬
го числа очень коротких процедур. Однако строгая независимость синтаксическо¬
го анализатора от целевого компьютера утрачивается. В модуле синтаксического
анализа используется информация о стратегии выделения памяти переменным,
включая выравнивание, и о размерах основных типов. Если первое нарушение
безопасно, потому что стратегия выделения памяти едва ли спорна, то послед¬
ний являет собой подлинную целевую зависимость, воплощенную во многих явно
364
Компилятор
объявленных константах. По большей части эти константы содержатся в соответ¬
ствующих определениях типов, представленных записями типа Stmct, инициали¬
зируемыми в ОСТ. Следующие процедуры создают объекты и генерируют элемен¬
ты таблицы символов:
Block
ProcedureDeclaration
FormalParameters
OCT.Import
RecordType
ArrayType
ProcType
Type
FormalType
Object(Con), Object(Typ), Object(Var)
Object(xProc)
Object(Var), Object(Ind)
Object(Mod)
Object(Fld), Struct(Record)
Struct(Array)
Struct(ProcTyp)
Struct(Pointer)
Struct(DynArr)
Язык Оберон определяет только один вид процедуры. Но компилятор обеспе¬
чивает некоторые варианты, отчасти по причинам, идущим от набора команд ком¬
пьютера. Для этих вариантов компилятор требует спецификатора в виде одной
литеры вслед за символом PROCEDURE, подобно стрелке (А) в случае будущих
объявлений. Варианты обозначаются разными видами в своих описателях:
1. Спецификатором «*» должны помечаться процедуры, которые присваива¬
ются переменным (если они не экспортируются). Это заставляет компи¬
лятор обрабатывать их как внешние процедуры (с RXP в конце) таким об¬
разом, что их тоже можно вызывать командой CXPD. Здесь mode = ХРгос.
2. Спецификатор «-» указывает, что процедура вызывается командой SVC.
(Отметим, что обращения к операционной системе обрабатываются ис¬
ключительно ядром. Так что в тексте Оберона объявляется только заголо¬
вок процедуры, сопровождаемый пустым телом.) Здесь mode = СРгос.
3. Спецификатор «+» указывает на то, что процедура без параметров долж¬
на использоваться как обработчик прерываний. Ее последняя команда -
RETT. Здесь mode = IProc.
Традиционно неприятная тема - это обработка ссылок вперед в однопроход¬
ном компиляторе. В языке Оберон есть два таких случая:
1. Предварительные объявления процедур. Они задаются явно посредством
литеры А вслед за символом PROCEDURE. Компилятор обрабатывает за¬
головок обычным образом и как внешнюю процедуру, полагая, что ее тело
отсутствует. Когда позже в тексте появляется полное объявление, оно
должно быть точно соотнесено с уже существующим объектом в таблице
символов. Поэтому для каждого объявления процедуры сначала выполня¬
ется просмотр таблицы. Если данный идентификатор найден и обознача¬
ет процедуру (с адресом 0), то связь устанавливается, а процедурой ОСН.
CompareParameters сравниваются списки параметров. В противном случае
имеет место повторное определение того же идентификатора.
2. Предварительные объявления ссылочных типов представляют более труд¬
ный случай, поскольку здесь нет явного указания на ссылку вперед, а не-
Синтаксический анализатор
365
определенный идентификатор не должен считаться ошибкой. Если в объ¬
явлении указателя исходный тип (с которым он связан) не найден в таблице
идентификаторов, автоматически предполагается ссылка вперед. Созда¬
ются записи и для типа указателя, и для его базового типа (см. процедуру
Туре). Предварительная запись типа Object с mode = Unde} и именем базо¬
вого типа связывается с типом указателя в поле link. Когда позже в тексте
появляется объявление типа записи или массива с тем же идентификато¬
ром, эта предварительная запись находится и в ней устанавливается окон¬
чательная связь (см. процедуру Block).
В обоих случаях компилятор проверяет неопределенные ссылки вперед, если
текущая область видимости объявления закрывается. Для процедур это про¬
исходит в конце компиляции (процедура ОСС.Out Code), так как заранее могут
объявляться только глобальные процедуры. Для типов указателей проверка вы¬
полняется в конце последовательности объявлений; процедура Block вызывает
Check UndefPointerTypes.
Оператор WITH
WITH x: T1 DO StatSeq END
устанавливает, что x в пределах последовательности операторов StatSeq имеет тип
Т1, который, возможно, является некоторым расширением типа ТО, с которым х
был объявлен. Компиляция оператора WITH приводит к локальной защите типа,
которая проверяет это утверждение, то есть действительно ли х - объект типа 77.
Оператор WITH представляет собой единственный случай, когда запись таблицы
символов - тин объекта х - изменяется при компиляции. По достижении конца
оператора WITH изменение типа должно отменяться.
MODULE Compiler; (*NW 7.6.87 / 16.3.91*)
IMPORT ОСС, ОСЕ, ОСН, OCS, ОСТ, Files, Oberon, TextFrames, Texts, Viewers;
CONST NofCases = 128; MaxEntry = 64; ModNameLen = 20;
RecDescSize = 8; AdrSize = 4; ProcSize = 4; PtrSize = 4;
XParOrg = 12; LParOrg = 8; LDataSize = 2000H;
(*значения символов*)
times = 1; slash = 2; div = 3; mod = 4;
and = 5; plus = 6; minus =7; or = 8; eql = 9;
neq = 10; lss = 11; leq = 12; gtr = 13; geq = 14;
in = 15; is = 16; arrow = 17; period = 18; comma = 19;
colon = 20; upto = 21; rparen = 22; rbrak = 23; rbrace = 24;
of = 25; then = 26; do = 27; to = 28; lparen = 29;
lbrak = 30; lbrace = 31; not = 32; becomes = 33; number = 34;
nil = 35; string = 36; ident = 37; semicolon = 38; bar = 39;
end = 40; else = 41; elsif = 42; until = 43; if = 44;
case = 45; while = 46; repeat = 47; loop = 48; with = 49;
exit = 50; return = 51; array = 52; record = 53; pointer = 54;
366
Компилятор
begin = 55; const = 56; type = 57; var = 58; procedure = 59;
import = 60; module = 61;
(*виды объектов и элементов*)
Var = 1; Ind = 3; Con = 8; Fid = 12; Typ = 13;
LProc = 14; XProc = 15; SProc = 16; CProc = 17; IProc = 18; Mod = 19;
(*формы структур*)
Undef = 0; Pointer = 13; ProcTyp = 14; Array = 15; DynArr = 16; Record = 17;
intSet = {4 .. 6}; labeltyps = {3 .. 6};
VAR W: Texts.Writer;
sym, entno: INTEGER;
newSF: BOOLEAN;
LoopLevel, ExitNo: INTEGER;
LoopExit: ARRAY 16 OF INTEGER;
PROCEDURE" Type (VAR typ: OCT.Struct);
PROCEDURE" FormalType (VAR typ: OCT.Struct);
PROCEDURE" Expression (VAR x: OCT.Item);
PROCEDURE" Block (VAR dsize: LONGINT);
PROCEDURE CheckSym (s: INTEGER);
BEGIN
IF sym = s THEN OCS.Get(sym) ELSE OCS.Mark(s) END
END CheckSym;
PROCEDURE qualident (VAR x: OCT.Item);
VAR mnolev: INTEGER; obj: OCT.Object;
BEGIN (*sym = ident*)
OCT.Find(obj, mnolev); OCS.Get(sym);
IF (sym = period) & (obj tt NIL) & (obj.mode = Mod) THEN
OCS.Get(sym); mnolev := SH0RT( - obj.aO);
IF sym = ident THEN
OCT. FindImport(obj, obj); OCS.Get(sym)
ELSE OCS.Mark(10); obj := NIL
END
END;
x.lev := mnolev; x.obj := obj;
IF obj ft NIL THEN
x.mode := obj.mode; x.typ := obj.typ; x.aO := obj.aO; x.al := obj.al
ELSE OCS.Mark(O); x.mode := Var;
x.typ := OCT.undftyp; x.aO : = 0; x.obj := NIL
END
END qualident;
PROCEDURE ConstExpression (VAR x: OCT.Item);
BEGIN Expression^);
IF x.mode tt Con THEN
OCS.Mark(50); x.mode := Con; x.typ := OCT.inttyp; x.aO := 1
Синтаксический анализатор
Еш
END
END ConstExpression;
PROCEDURE NewStr (form: INTEGER): OCT.Struct;
VAR typ: OCT.Struct;
BEGIN NEW(typ);
typ.form := form; typ.mno := 0; typ.size := 4; typ. ref := 0;
typ.BaseTyp := OCT.undftyp; typ.strobj := NIL; RETURN typ
END NewStr;
PROCEDURE CheckMark (VAR mk: BOOLEAN);
BEGIN OCS.Get(sym);
IF sym = times THEN
IF OCC.level = 0 THEN mk := TRUE ELSE mk := FALSE; 0CS.Mark(47) END;
OCS.Get(sym)
ELSE mk := FALSE
END
END CheckMark;
PROCEDURE CheckUndefPointerTypes;
VAR obj: OCT.Object;
BEGIN obj := OCT.topScope.next;
WHILE obj # NIL DO
IF obj.mode = Undef THEN 0CS.Mark(48) END;
obj := obj.next
END
END CheckUndefPointerTypes;
PROCEDURE RecordType (VAR typ: OCT.Struct);
VAR adr, size: LONGINT;
fid, fldO, fldl: OCT.Object;
ftyp, btyp: OCT.Struct;
base: OCT.Item;
BEGIN adr := 0; typ := NewStr(Record); typ.BaseTyp := NIL; typ.n := 0;
IF sym = lparen THEN
OCS.Get(sym); (‘расширение записи*)
IF sym = ident THEN
qualident(base);
IF (base.mode = Typ) & (base.typ. form = Record) THEN
typ.BaseTyp := base.typ; typ.n := base.typ.n + 1;
adr := base.tyu.size
ELSE OCS.Mark(52)
END
ELSE OCS.Mark(10)
END;
CheckSym(rparen)
END;
OCT.OpenScope(O); fid := NIL; fldl := OCT.topScope;
LOOP
368
Компилятор
Синтаксический анализатор
IF sym = ident THEN
LOOP
IF sym = ident THEN
IF typ.BaseTyp П NIL THEN
OCT.FindField(typ.BaseTyp, fldO);
IF fldO # NIL THEN OCS.Mark(1) END
END;
OCT.Insert(OCS.name, fid); CheckMark(fld.marked);
fid.mode := Fid
ELSE OCS.Mark(10)
END;
IF sym = comma THEN OCS.Get(sym)
ELSIF sym = ident THEN 0CS.Mark(19)
ELSE EXIT
END
END;
CheckSym(colon); Type(ftyp); size := ftyp.size; btyp := ftyp;
WHILE btyp.form = Array DO btyp := btyp.BaseTyp END;
IF btyp.size >= 4 THEN INC(adr, ( - adr) MOD 4)
ELSIF btyp.size = 2 THEN INC(adr, adr MOD 2)
END;
WHILE fldl.next # NIL DO
fldl := fldl.next; fldl.typ := ftyp; fldl.aO := adr;
INC(adr, size)
END
END;
IF sym = semicolon THEN OCS.Get(sym)
ELSIF sym = ident THEN OCS.Mark(38)
ELSE EXIT
END
END;
typ.size := ( - adr) MOD 4 + adr; typ.link := OCT.topScope.next;
CheckUndefPointerTypes; OCT.CloseScope
END RecordType;
PROCEDURE ArrayType (VAR typ: OCT.Struct);
VAR x: OCT.Item; f, n: INTEGER;
BEGIN typ := NewStr(Array); ConstExpression(x); f := x.typ.form;
IF f IN intSet THEN
IF (x.aO > 0) & (x.aO <= MAX(INTEGER)) THEN n := SHORT(x.aO)
ELSE n := 1; 0CS.Mark(63)
END
ELSE OCS.Mark(51); n := 1
END;
typ.n := n; OCC.AllocBounds(0, n - 1, typ.adr);
IF sym = of THEN
OCS.Get(sym); Type(typ.BaseTyp)
ELSIF sym = comma THEN
OCS.Get(sym); ArrayType(typ.BaseTyp)
369j
370
Компилятор
ELSE OCS.Mark(34)
END;
typ.size := n * typ.BaseTyp.size
END ArrayType;
PROCEDURE FormalParameters (VAR resTyp: OCT.Struct; VAR psize; LONGINT);
VAR mode: SHORTINT;
adr, size: LONGINT; res: OCT.Item;
par, pari: OCT.Object; typ: OCT.Struct; ,
BEGIN pari := OCT.topScope; adr := 0;
IF (sym = ident) OR (sym = var) THEN
LOOP
IF sym = var THEN OCS.Get(sym); mode := Ind ELSE mode := Var END;
LOOP
IF sym = ident THEN
OCT.Insert(OCS.name, par); OCS.Get(sym); par.mode := mode
ELSE OCS.Mark(10)
END;
IF sym = comma THEN OCS.Get(sym)
ELSIF sym = ident THEN 0CS.Mark(19)
ELSIF sym = var THEN OCS.Mark(19); OCS.Get(sym)
ELSE EXIT
END
END;
CheckSym(colon); FormalType(typ);
IF mode = Ind THEN (*VAR-napaMeTp*)
IF typ.form = Record THEN size := RecDescSize
ELSIF typ.form = DynArr THEN size := typ.size
ELSE size := AdrSize
END
ELSE size := ( - typ.size) MOD 4 + typ.size
END;
WHILE parl.next # NIL DO
pari := parl.next; parl.typ := typ; DEC(adr, size);
parl.aO := adr
END;
IF sym = semicolon THEN OCS.Get(sym)
ELSIF sym = ident THEN 0CS.Mark(38)
ELSE EXIT
END
END
END;
psize := psize - adr; par := OCT.topScope.next;
WHILE par # NIL DO INC(par.aO, psize); par := par.next END;
CheckSym(rparen);
IF sym = colon THEN
OCS.Get(sym); resTyp := OCT.undftyp;
IF sym = ident THEN qualident(res);
IF res.mode = Typ THEN
Синтаксический анализатор
371
IF res.typ.form <= ProcTyp THEN resTyp := res.typ ELSE
OCS.Mark(54) END
ELSE OCS.Mark(52)
END
ELSE OCS.Mark(10)
END
ELSE resTyp := OCT.notyp
END
END FormalParameters;
PROCEDURE ProcType (VAR typ: OCT.Struct);
VAR psize: LONGINT;
BEGIN typ := NewStr(ProcTyp); typ.size := ProcSize;
IF sym = lparen THEN
OCS.Get(sym); OCT.OpenScope(OCC.level); psize := XParOrg;
FormalParameters(typ.BaseTyp, psize); typ.link := OCT.topScope.next;
OCT.CloseScope
ELSE typ.BaseTyp := OCT.notyp; typ.link := NIL
END
END ProcType;
PROCEDURE HasPtr (typ: OCT.Struct): BOOLEAN;
VAR fid: OCT.Object;
BEGIN
IF typ.form = Pointer THEN RETURN TRUE
ELSIF typ.form = Array THEN RETURN HasPtr(typ.BaseTyp)
ELSIF typ.form = Record THEN
IF (typ.BaseTyp ft NIL) & HasPtr(typ.BaseTyp) THEN RETURN TRUE END;
fid := typ.link;
WHILE fid tt NIL DO
IF (fid.name = ’"’) OR HasPtr(fld.typ) THEN RETURN TRUE END;
fid := fid.next
END
END;
RETURN FALSE
END HasPtr;
PROCEDURE SetPtrBase (ptyp, btyp: OCT.Struct);
BEGIN
IF (btyp.form = Record) OR (btyp.form = Array) & “HasPtr(btyp.BaseTyp) THEN
ptyp.BaseTyp := btyp
ELSE ptyp.BaseTyp := OCT.undftyp; 0CS.Mark(57)
END
END SetPtrBase;
PROCEDURE Type (VAR typ: OCT.Struct);
VAR lev: INTEGER; obj: OCT.Object; x: OCT.Item;
BEGIN typ := OCT.undftyp;
IF sym < lparen THEN OCS.Mark(12);
372
REPEAT OCS.Get(sym) UNTIL sym >= lparen
END;
IF sym = ident THEN qualident(x);
IF x.mode = Typ THEN typ := x.typ;
IF typ = OCT.notyp THEN OCS.Mark(58) END
ELSE OCS.Mark(52)
END
ELSIF sym = array THEN
OCS.Get(sym); ArrayType(typ)
ELSIF sym = record THEN
OCS.Get(sym); RecordType(typ); OCC.AllocTypDesc(typ); CheckSym(end)
ELSIF sym = pointer THEN
OCS.Get(sym); typ := NewStr(Pointer); typ.link := NIL; typ.size := PtrSize;
CheckSym(to);
IF sym = ident THEN OCT.Find(obj, lev);
IF obj = NIL THEN (*ссылка вперед*)
OCT.Insert(OCS. name, obj); typ.BaseTyp := OCT.undftyp;
obj.mode := Undef; obj.typ := typ; OCS.Get(sym)
ELSE qualident(x);
IF x.mode = Typ THEN SetPtrBase(typ, x.typ)
ELSE typ.BaseTyp := OCT.undftyp; 0CS.Mark(52)
END
END
ELSE Type(x.typ); SetPtrBase(typ, x.typ)
END
ELSIF sym = procedure THEN
OCS.Get(sym); ProcType(typ)
ELSE OCS.Mark(12)
END;
IF(sym < semicolon) OR (else < sym) THEN OCS.Mark(15);
WHILE (sym < ident) OR (else < sym) & (sym < begin) DO
OCS.Get(sym)
END
END
END Type;
PROCEDURE FormalType (VAR typ: OCT.Struct);
VAR x: OCT.Item; typO: OCT.Struct; a, s: LONGINT;
BEGIN typ := OCT.undftyp; a :=0;
WHILE sym = array DO
OCS.Get(sym); CheckSym(of); INC(a, 4)
END;
IF sym = ident THEN qualident(x);
IF x.mode = Typ THEN typ := x.typ;
IF typ = OCT. notyp THEN 0CS.Mark(58) END
ELSE OCS.Mark(52)
END
ELSIF sym = procedure THEN OCS.Get(sym); ProcType(typ)
ELSE OCS.Mark(10)
Компилятор
Синтаксический анализатор
373
END;
s := a + 8;
WHILE a > 0 DO
typO := NewStr(DynArr); typO.BaseTyp := typ;
typO.size := s - a; typO.adr := typO.size - 4; typO.mno := 0;
typ. := typO; DEC(a, 4)
END
END FormalType;
PROCEDURE selector (VAR x: OCT.Item);
VAR fid: OCT.Object; y: OCT.Item;
BEGIN
LOOP
IF sym = lbrak THEN OCS.Get(sym);
LOOP
IF (x.typ # NIL) & (x.typ.form = Pointer) THEN OCE.DeRef(x) END;
Expression(y); OCE.Index(x, y);
IF sym = comma THEN OCS.Get(sym) ELSE EXIT END
END;
CheckSym(rbrak)
ELSIF sym = period THEN OCS.Get(sym);
IF sym = ident THEN
IF x.typ # NIL THEN
IF x.typ.form = Pointer THEN OCE.DeRef(x) END;
IF x.typ.form = Record THEN
OCT.FindField(x.typ, fid); OCE.Field(x, fid)
ELSE OCS.Mark(53)
END
ELSE OCS.Mark(52)
END;
OCS.Get(sym)
ELSE OCS.Mark(10)
END
ELSIF sym = arrow THEN
OCS.Get(sym); OCE.DeRef(x)
ELSIF (sym = lparen) & (x.mode < Typ) & (x.typ.form # ProcTyp) THEN
OCS.Get(sym);
IF sym = ident THEN
qualident(y);
IF y.mode = Typ THEN OCE.TypTest(x, y, FALSE)
ELSE OCS.Mark(52)
END
ELSE OCS.Mark(10)
END;
CheckSym(rparen)
ELSE EXIT
END
END
END selector;-
Компилятор
PROCEDURE IsParam (obj: OCT.Object): BOOLEAN;
BEGIN RETURN (obj # NIL) & (obj.mode <= Ind) & (obj.aO > 0)
END IsParam;
PROCEDURE ActualParameters (VAR x: OCT.Item; fpar: OCT.Object);
VAR apar: OCT.Item; R: SET;
BEGIN
IF sym # rparen THEN
R := OCC.RegSet;
LOOP Expression(apar);
IF IsParam(fpar) THEN
OCH.Param(apar, fpar); fpar := fpar.next
ELSE OCS.Mark(64)
END;
OCC.FreeRegs(R);
IF sym = comma THEN OCS.Get(sym)
ELSIF (lparen <= sym) & (sym <= ident) THEN 0CS.Mark(19)
ELSE EXIT
END
END
END;
IF IsParam(fpar) THEN 0CS.Mark(65) END
END ActualParameters;
PROCEDURE StandProcCall (VAR x: OCT.Item);
VAR y: OCT.Item; m, n: INTEGER;
BEGIN m := SHORT(x.aO); n := 0;
IF sym = lparen THEN OCS.Get(sym);
IF sym # rparen THEN
LOOP
IF n = 0 THEN Expression(x); OCE.StParl(x, m); n := 1
ELSIF n = 1 THEN Expression(y); OCE.StPar2(x, y, m); n := 2
ELSIF n = 2 THEN Expression(y); OCE.StPar3(x, y, m); n := 3
ELSE OCS.Mark(64); Expression(y)
END;
IF sym = comma THEN OCS.Get(sym)
ELSIF (lparen <= sym) & (sym <= ident) THEN 0CS.Mark(19)
ELSE EXIT
END
END;
CheckSym(rparen)
ELSE OCS.Get(sym)
END;
OCE.StFct(x, m, n)
ELSE OCS.Mark(29)
END
END StandProcCall;
PROCEDURE Element (VAR x: OCT.Item);
374
VAR e1, e2: OCT.Item;
BEGIN Expression(e1);
IF sym = upto THEN
OCS.Get(sym); Expression(e2); 0CE.Set1(x, e1, e2)
ELSE OCE.SetO(x, e1)
END;
END Element;
PROCEDURE Sets (VAR x: OCT.Item);
VAR y: OCT.Item;
BEGIN x.typ := OCT.settyp; y.typ := OCT.settyp;
IF sym # rbrace THEN
Element(x);
LOOP
IF sym = comma THEN OCS.Get(sym)
ELSIF (lparen <= sym) & (sym <= ident) THEN 0CS.Mark(19)
ELSE EXIT
END;
Element(y); OCE.Op(plus, x, y) (*x := x+y*)
END
ELSE x.mode := Con; x.aO := О
END;
CheckSym(rbrace)
END Sets;
PROCEDURE Factor (VAR x: OCT.Item);
VAR fpar: OCT.Object; gR, fR: SET;
BEGIN
IF sym < lparen THEN OCS.Mark(13);
REPEAT OCS.Get(sym) UNTIL sym >= lparen
END;
IF sym = ident THEN
qualident(x); selector(x);
IF x.mode = SProc THEN StandProcCall(x)
ELSIF sym = lparen THEN
OCS.Get(sym); OCH.PrepCall(x, fpar);
OCC.SaveRegisters(gR, fR, x); ActualParameters(x, fpar);
OCH.Call(x); OCC.RestoreRegisters(gR, fR, x);
CheckSym(rparen)
END
ELSIF sym = number THEN
OCS.Get(sym); x.mode := Con;
CASE OCS.numtyp OF
1: x.typ := OCT.chartyp; x.aO := OCS.intval
| 2: x.aO := OCS.intval; OCE.SetlntType(x)
| 3: x.typ := OCT.realtyp; OCE.AssReal(x, OCS.realval)
| 4: x.typ := OCT.1rltyp; OCE.AssLReal(x, OCS.lrlval)
END
ELSIF sym = string THEN
x.typ := OCT.stringtyp; x.mode := Con;
Синтаксический анализатор
Ш
376
ОСС.AllocString(OCS. name, x); OCS.Get(sym)
ELSIF sym = nil THEN
OCS.Get(sym); x.typ := OCT.niltyp; x.mode := Con; x.aO := 0
ELSIF sym = lparen THEN
OCS.Get(sym); Expression(x); CheckSym(rparen)
ELSIF sym = lbrak THEN
OCS.Get(sym); OCS.Mark(29); Expression(x); CheckSym(rparen)
ELSIF sym = lbrace THEN OCS.Get(sym); Sets(x)
ELSIF sym = not THEN
OCS.Get(sym); Factor(x); 0CE.M0p(not, x)
ELSE OCS.Mark(13); OCS.Get(sym); x.typ := OCT.undftyp; x.mode : =
x.aO := 0
END
END Factor;
PROCEDURE Term (VAR x: OCT.Item);
VAR y: OCT.Item; mulop: INTEGER;
BEGIN Factor(x);
WHILE (times <= sym) & (sym <= and) DO
mulop := sym; OCS.Get(sym);
IF mulop = and THEN 0CE.M0p(and, x) END;
Factor(y); OCE.Op(mulop, x, y)
END
END Term;
PROCEDURE SimpleExpression (VAR x: OCT.Item);
VAR y: OCT.Item; addop: INTEGER;
BEGIN
IF sym = minus THEN OCS.Get(sym); Term(x); OCE.MOp(minus, x)
ELSIF sym = plus THEN OCS.Get(sym); Term(x); OCE.MOp(plus, x)
ELSE Term(x)
END;
WHILE(plus <= sym) & (sym <= or) DO
addop := sym; OCS.Get(sym);
IF addop = or THEN OCE.MOp(or, x) END;
Term(y); OCE.Op(addop, x, y)
END
END SimpleExpression;
PROCEDURE Expression (VAR x: OCT.Item);
VAR y: OCT.Item; relation: INTEGER;
BEGIN SimpleExpression(x);
IF (eql <= sym) & (sym <= geq) THEN
relation := sym; OCS.Get(sym);
IF x.typ = OCT.booltyp THEN OCE.M0p(relation, x) END;
SimpleExpression(y); OCE.0p(relation, x, y)
ELSIF sym = in THEN
OCS.Get(sym); SimpleExpression(y); 0CE.In(x, y)
ELSIF sym = is THEN
Компилятор
IF x.mode >= Typ THEN OCS.Mark(112) END;
OCS.Get(sym);
IF sym = ident THEN
qualident(y);
IF y.mode = Typ THEN OCE.TypTest(x, y, TRUE) ELSE 0CS.Mark(52) END
ELSE OCS.Mark(IO)
END
END
END Expression;
PROCEDURE ProcedureDeclaration;
VAR proc, prod, par: OCT.Object;
L1: INTEGER;
mode: SHORTINT; body: BOOLEAN;
psize, dsize: LONGINT;
BEGIN dsize := 0; proc := NIL; body := TRUE;
IF (sym # ident) & (OCC.level = 0) THEN
IF sym = times THEN mode := XProc
ELSIF sym = arrow THEN (*вперед*) mode := XProc; body := FALSE
ELSIF sym = plus THEN mode := IProc
ELSIF sym = minus THEN mode := CProc; body := FALSE
ELSE mode := LProc; 0CS.Mark(10)
END;
OCS.Get(sym)
ELSE mode := LProc
END;
IF sym = ident THEN
IF OCC.level = 0 THEN OCT.Find(proc1, L1) ELSE prod := NIL END;
IF (prod # NIL) & (prod.mode = XProc) & (OCC.Entry(SH0RT(proc1 .aO))
= 0) THEN
(♦существует соответствующее предварительное объявление*)
IF mode = LProc THEN mode := XProc END;
NEW(proc); CheckMark(proc.marked)
ELSE
IF prod # NIL THEN OCS.Mark(1); prod := NIL END;
OCT.Insert(OCS.name, proc); CheckMark(proc.marked);
IF proc.marked & (mode = LProc) THEN mode := XProc END;
IF mode = LProc THEN proc.aO := OCC.pc
ELSIF mode # CProc THEN
IF entno < MaxEntry THEN proc.aO := entno; INC(entno)
ELSE proc.aO := 1; OCS.Mark(226)
END
END
END;
proc.mode := mode; proc.typ := OCT.notyp; proc.dsc := NIL; proc.al := 0;
INC(OCC.level); OCT.OpenScope(OCC.level);
IF (mode = LProc) & (OCC.level = 1) THEN psize := LParOrg
ELSE psize := XParOrg
END;
Синтаксический анализатор
ЕШ
378
Компилятор
IF sym = lparen THEN
OCS.Get(sym); FormalParameters(proc.typ, psize);
proc.dsc := OCT.topScope.next
END;
IF prod # NIL THEN (*вперед*)
ОСН.CompareParLists(proc.dsc, prod.dsc);
IF proc.typ # procl.typ THEN OCS.Mark(118) END;
proc := prod; proc.dsc := OCT. topScope. next
END;
IF mode = CProc THEN
IF sym = number THEN proc.aO := OCS.intval; OCS.Get(sym)
ELSE OCS.Mark(17)
END
END;
IF body THEN
CheckSym(semicolon); OCT.topScope.typ := proc.typ;
OCT.topScope.a1 := mode * 10000H + psize; (*для операторов RETURN*)
ОСН.Enter(mode, proc.aO, L1); par := proc.dsc;
WHILE par # NIL DO
(*код для значений параметров как динамических массивов*)
IF (par.typ.form = DynArr) & (par.mode = Var) THEN
OCH.CopyDynArray(par.aO, par.typ)
END;
par := par.next
END;
Block(dsize); proc.dsc := OCT.topScope.next; (*update*)
IF proc.typ = OCT.notyp THEN OCH.Return(proc.mode, psize)
ELSE ОСН.Trap(17)
END;
IF dsize >= LDataSize THEN OCS.Mark(209); dsize := 0 END;
OCC.FixupWith(L1, dsize); proc.a2 := OCC.pc;
IF sym = ident THEN
IF OCS.name # proc. name THEN 0CS.Mark(4) END;
OCS.Get(sym)
ELSE OCS.Mark(10)
END
END;
DEC(0CC.level); OCT.CloseScope
END
END ProcedureDeclaration;
PROCEDURE CaseLabelList (LabelForm: INTEGER;
VAR n: INTEGER; VAR tab: ARRAY OF OCH.LabelRange);
VAR x, y: OCT.Item; i, f: INTEGER;
BEGIN
IF “(LabelForm IN labeltyps) THEN 0CS.Mark(61) END;
LOOP ConstExpression(x); f := x.typ.form;
IF f IN intSet THEN
IF LabelForm < f THEN 0CS.Mark(60) END
ELSIF f tt LabelForm THEN 0CS.Mark(60)
END;
IF sym = upto THEN
OCS.Get(sym); ConstExpression(y);
IF (y.typ.form # f) & "((f IN intSet) & (y.typ.form IN intSet))
THEN OCS.Mark(60)
END;
IF y.aO < x.aO THEN OCS.Mark(63); y.aO := x.aO END
ELSE у := x
END;
(*занести ряд меток в упорядоченную таблицу*) i := п;
IF i < NofCases THEN
LOOP
IF i = 0 THEN EXIT END;
IF tab[i - 1].low <= y.aO THEN
IF tab[i - 1].high >= x.aO THEN 0CS.Mark(62) END;
EXIT
END;
tab[i] := tab[i - 1]; DEC(i)
END;
tab[i].low := SHORT(x.aO); tab[i].high := SHORT(y.aO);
tab[i].label := OCC.pc; INC(n)
ELSE OCS.Mark(213)
END;
IF sym = comma THEN OCS.Get(sym)
ELSIF (sym = number) OR (sym = ident) THEN 0CS.Mark(19)
ELSE EXIT
END
END
END CaseLabelList;
PROCEDURE StatSeq;
VAR fpar: OCT.Object; xtyp: OCT.Struct;
x, y: OCT.Item; LO, LI, Exitlndex: INTEGER;
PROCEDURE CasePart;
VAR x: OCT.Item; n, LO, L1, L2, L3: INTEGER;
tab: ARRAY NofCases OF OCH.LabelRange;
BEGIN n := 0; L3 := 0;
Expression(x); OCH.Caseln(x, LO, L1); OCC. FreeRegs(O);
CheckSym(of);
LOOP
IF sym < bar THEN
CaseLabelList(x.typ.form, n, tab);
CheckSym(colon); StatSeq; 0CH.FJ(L3)
END;
IF sym = bar THEN OCS.Get(sym) ELSE EXIT END
END;
L2 := OCC.pc;
Синтаксический анализатор
1379
380
Компилятор
IF sym = else THEN
OCS.Get(sym); StatSeq; 0CH.FJ(L3)
ELSE OCH.Trap(16)
END;
OCH.Case0ut(L0, LI, L2, L3, n, tab)
END CasePart;
BEGIN
LOOP
IF sym < ident THEN OCS.Mark(14);
REPEAT OCS.Get(sym) UNTIL sym >= ident
END;
IF sym = ident THEN
qualident(x); selector(x);
IF sym = becomes THEN
OCS.Get(sym); Expression(y); OCH.Assign(x, y, FALSE)
ELSIF sym = eql THEN
0CS.Mark(33); OCS.Get(sym); Expression(y); OCH.Assign(x, y, FALSE)
ELSIF x.mode = SProc THEN
StandProcCall(x);
IF x.typ # OCT.notyp THEN 0CS.Mark(55) END .
ELSE OCH.PrepCall(x, fpar);
IF sym = lparen THEN
OCS.Get(sym); ActualParameters(x, fpar);
CheckSym(rparen)
ELSIF IsParam(fpar) THEN 0CS.Mark(65)
END;
OCH.Call(x);
IF x.typ # OCT.notyp THEN 0CS.Mark(55) END
END
ELSIF sym = if THEN
OCS.Get(sym); Expression(x); OCH.CFJ(x, LO); OCC.FreeRegs({});
CheckSym(then); StatSeq; L1 := 0;
WHILE sym = elsif DO
OCS.Get(sym); 0CH.FJ(L1); OCC.FixLink(LO);
Expression(x); OCH.CFJ(x, LO); OCC.FreeRegs({});
CheckSym(then); StatSeq
END;
IF sym = else THEN
OCS.Get(sym); 0CH.FJ(L1); OCC.FixLink(LO); StatSeq
ELSE OCC.FixLink(LO)
END;
OCC.FixLink(LI); CheckSym(end)
ELSIF sym = case THEN
OCS.Get(sym); CasePart; CheckSym(end)
ELSIF sym = while THEN
OCS.Get(sym); L1 := OCC.pc;
Expression(x); OCH.CFJ(x, LO); OCC.FreeRegs({});
CheckSym(do); StatSeq; OCH.BJ(LI); OCC.FixLink(LO);
CheckSym(end)
Синтаксический анализатор
ELSIF sym = repeat THEN
OCS.Get(sym); LO := OCC.pc; StatSeq;
IF sym = until THEN
OCS.Get(sym); Expression(x); OCH.CBJ(x, LO)
ELSE OCS.Mark(43)
END
ELSIF sym = loop THEN
OCS.Get(sym); Exitlndex := ExitNo; INC(LoopLevel);
LO ;= OCC.pc; StatSeq; OCH.BJ(LO); DEC(LoopLevel);
WHILE ExitNo > Exitlndex DO
DEC(ExitNo); OCC.fixup(LoopExit[ExitNo])
END;
CheckSym(end)
ELSIF sym = with THEN
OCS.Get(sym); x.obj := NIL; xtyp := NIL;
IF sym = ident THEN
qualident(x); CheckSym(colon);
IF sym = ident THEN qualident(y);
IF y.mode = Typ THEN
IF x.obj # NIL THEN
xtyp := x.typ; OCE.TypTest(x, y, FALSE);
x.obj.typ := x.typ
ELSE OCS.Mark(130)
END
ELSE OCS.Mark(52)
END
ELSE OCS.Mark(10)
END
ELSE OCS.Mark(10)
END;
CheckSym(do); OCC.FreeRegs({}); StatSeq; CheckSym(end);
IF xtyp it NIL THEN x.obj.typ := xtyp END
ELSIF sym = exit THEN
OCS.Get(sym); OCH.FJ(LO);
IF LoopLevel = 0 THEN 0CS.Mark(45)
ELSIF ExitNo < 16 THEN LoopExit[ExitNo] := LO; INC(ExitNo)
ELSE OCS.Mark(214)
END
ELSIF sym = return THEN OCS.Get(sym);
IF OCC.level > 0 THEN
IF sym < semicolon THEN
Expression(x); OCH.Result(x, OCT.topScope.typ)
ELSIF OCT.topScope.typ tt OCT.notyp THEN OCS.Mark( 124)
END;
OCH.Return(SHORT(OCT.topScope.a1 DIV 10000H),
SH0RT(0CT.topScope.a1))
ELSE (*возврат из тела модуля*)
IF sym < semicolon THEN Expression(x); OCS.Mark(124) END;
OCH.Return(XProc, XParOrg)
END
382
Компилятор
END;
OCC.FreeRegs({});
IF sym = semicolon THEN OCS.Get(sym)
ELSIF (sym <= ident) OR (if <= sym) & (sym <= return) THEN OCS.Mark(38)
ELSE EXIT
END
END
END StatSeq;
PROCEDURE Block (VAR dsize: LONGINT);
VAR typ, forward: OCT.Struct;
obj, first: OCT.Object;
x: OCT.Item;
LO: INTEGER;
adr, size: LONGINT;
mk: BOOLEAN;
idO: ARRAY 32 OF CHAR;
BEGIN adr := - dsize; obj := OCT.topScope;
WHILE obj.next # NIL DO obj := obj.next END;
LOOP
IF sym = const THEN
OCS.Get(sym);
WHILE sym = ident DO
C0PY(0CS.name, idO); CheckMark(mk);
IF sym = eql THEN OCS.Get(sym); ConstExpression(x)
ELSIF sym = becomes THEN 0CS.Mark(9);
OCS.Get(sym); ConstExpression(x)
ELSE OCS.Mark(9)
END;
OCT.Insert(idO, obj); obj.mode := SHORT(x.mode);
obj.typ := x.typ; obj.aO := x.aO; obj.al := x.al;
obj.marked := mk;
CheckSym(semicolon)
END
END;
IF sym = type THEN
OCS.Get(sym);
WHILE sym = ident DO
typ : = OCT.undftyp; OCT.Insert(OCS.name, obj);
forward := obj.typ;
obj.mode := Typ; obj.typ := OCT.notyp; CheckMark(obj.marked);
IF sym = eql THEN OCS.Get(sym); Type(typ)
ELSIF (sym = becomes) OR (sym = colon) THEN
0CS.Mark(9); OCS.Get(sym); Type(typ)
ELSE OCS.Mark(9)
END;
obj.typ := typ;
IF typ.strobj = NIL THEN typ.strobj := obj END;
IF forward # NIL THEN (*закрепить*) SetPtrBase(forward, typ)
END;
Синтаксический анализатор
CheckSym(semicolon)
END
END;
IF sym = var THEN
OCS.Get(sym);
WHILE sym = ident DO
OCT.Insert(OCS.name, obj); first : = obj;
CheckMark(obj.marked); obj.mode := Var;
LOOP
IF sym = comma THEN OCS.Get(sym)
ELSIF sym = ident THEN 0CS.Mark(19)
ELSE EXIT
END;
IF sym = ident THEN
OCT.Insert(OCS.name, obj); CheckMark(obj.marked);
obj.mode := Var
ELSE 0CS.Mark(10)
END
END;
CheckSym(colon); Type(typ); size := typ.size;
IF size >= 4 THEN DEC(adr, adr MOD 4)
ELSIF size = 2 THEN DEC(adr, adr MOD 2)
END;
WHILE first # NIL DO
first.typ := typ; DEC(adr, size); first.aO := adr;
first := first.next
END;
CheckSym(semicolon)
END
END;
IF(sym < const) OR (sym > var) THEN EXIT END;
END;
CheckUndefPointerTypes;
IF OCC.level = 0 THEN OCH.LFJ(LO) ELSE OCH.FJ(LO) END;
WHILE sym = procedure DO
OCS.Get(sym); ProcedureDeclaration; CheckSym(semicolon)
END;
IF OCC.level = 0 THEN OCC.fixupL(LO); OCC.InitTypDescs
ELSE OCC.fixupC(LO)
END;
IF sym = begin THEN OCS.Get(sym); StatSeq END;
dsize := (adr MOD 4) - adr; CheckSym(end)
END Block;
PROCEDURE CompilationUnit (source: Texts.Text; pos: LONGINT);
VAR LO: INTEGER; ch: CHAR;
time, date, key, dsize: LONGINT;
modid, impid, FName: ARRAY 32 OF CHAR;
PROCEDURE MakeFileName (VAR name, FName: ARRAY OF CHAR;
ext: ARRAY OF CHAR);
p383
384
Компилятор
VAR i, j: INTEGER; ch: CHAR;
BEGIN i := 0;
LOOP ch := name[i];
IF ch = OX THEN EXIT END;
FName[i] := ch; INC(i)
END;
j := 0;
REPEAT ch := ext[j]; FName[i] := ch; INC(i); INC(j)
UNTIL ch = OX
END MakeFileName;
BEGIN entno := 1; dsize := 0; LoopLevel := 0; ExitNo := 0;
OCC.Init; OCT.Init; OCS.Init(source, pos); OCS.Get(sym);
Texts.WriteString(W, " compiling ");
IF sym = module THEN OCS.Get(sym) ELSE 0CS.Mark(16) END;
IF sym = ident THEN
Texts.WriteString(W, OCS.name); Texts.Append(Oberon.Log, W.buf);
LO := 0; ch := OCS.name[0];
WHILE (ch # OX) & (LO < ModNameLen - 1) DO
modid[L0] := ch; INC(LO); ch := 0CS.name[L0]
END;
modid[L0] := OX;
IF ch # OX THEN OCS.Mark(228) END;
OCT.OpenScope(O); OCS.Get(sym);
CheckSym(semicolon); OCH.Enter(Mod, 0, LO);
IF sym = import THEN
OCS.Get(sym);
LOOP
IF sym = ident THEN
C0PY(OCS.name, impid); OCS.Get(sym);
MakeFileName(impid, FName, ".Sym");
IF sym = becomes THEN OCS.Get(sym);
IF sym = ident THEN
MakeFileName(OCS.name, FName, ".Sym");
OCS.Get(sym)
ELSE OCS.Mark(10)
END
END;
OCT.Import(impid, modid, FName)
ELSE OCS.Mark(10)
END;
IF sym = comma THEN OCS.Get(sym)
ELSIF sym = ident THEN 0CS.Mark(19)
ELSE EXIT
END
END;
CheckSym(semicolon)
END;
IF 'OCS.scanerr THEN
OCC.SetLinkTable(OCT. nofGmod + 1);
Block(dsize); OCH.Return(XProc, 12);
Синтаксический анализатор
IF sym = ident THEN
IF OCS.name tt modid THEN 0CS.Mark(4) END;
OCS.Get(sym)
ELSE 0CS.Mark(10)
END;
IF sym ft period THEN 0CS.Mark(18) END;
IF "OCS.scanerr THEN
Oberon.GetClock(time, date);
key := (date MOD 4000H) * 20000H + time;
MakeFileName(modid, FName, ".Sym”);
OCT.Export(modid, FName, newSF, key);
IF newSF THEN Texts.WriteString(W, " new symbol file") END;
IF “OCS.scanerr THEN
MakeFileName(modid, FName, ".Obj");
OCC.OutCode(FName, modid, key, entno, dsize);
Texts.WriteInt(W, OCC.pc, 6); Texts.WriteInt(W, dsize, 6)
END
END
END;
OCT.CloseScope
ELSE OCS.Mark(10)
END;
OCC.Close; OCT.Close;
Texts.WriteLn(W); Texts.Append(Oberon.Log, W.buf)
END CompilationUnit;
PROCEDURE Compile*;
VAR beg, end, time: LONGINT;
T: Texts.Text;
S: Texts.Scanner;
v: Viewers.Viewer;
PROCEDURE Options;
VAR ch: CHAR;
BEGIN
IF S.nextCh = "/" THEN
LOOP Texts.Read(S, ch);
IF ch = "x" THEN OCE.inxchk := FALSE
ELSIF ch = "t" THEN OCC.typchk := FALSE
ELSIF ch = ”s" THEN newSF := TRUE
ELSE S.nextCh := ch; EXIT
END
END
END
END Options;
BEGIN OCE.inxchk := TRUE; OCC.typchk := TRUE; newSF := FALSE;
Texts.OpenScanner(S, Oberon.Par.text, Oberon.Par.pos); Texts.Scan(S);
IF S.class = Texts.Char THEN
IF S.с = THEN
ВсШ
MM
v := Oberon.MarkedVieweг();
IF (v.dsc # NIL) & (v.dsc.next IS TextFrames.Frame) THEN
Options; Compilationllnit(v. dsc. next (TextFrames. Frame), text, 0)
END
ELSIF S.c = THEN
Oberon.GetSelection(T, beg, end, time);
IF time >= 0 THEN
Texts.OpenScanner(S, T, beg); Texts.Scan(S);
IF S.class = Texts.Name THEN
Options; Texts.WriteString(W, S.s); NEW(T);
Texts.Open(T, S.s);
IF T.len # 0 THEN CompilationUnit(T, 0)
ELSE Texts.WriteString(W, " not found");
Texts.WriteLn(W); Texts.Append(Oberon.Log, W.buf)
END
END
END
ELSIF S.c = THEN
Oberon.GetSelection(T, beg, end, time);
IF time >= 0 THEN Options; CompilationUnit(T, beg) END
END
ELSE NEW(T);
WHILE S. class = Texts.Name DO
Options; Texts.WriteString(W, S.s); Texts.Open(T, S.s);
IF T.len # 0 THEN CompilationUnit(T, 0)
ELSE Texts.WriteString(W, " not found");
Texts.WriteLn(W); Texts.Append(Oberon.Log, W.buf)
END;
Texts.Scan(S)
END
END;
Oberon.Collect(O)
END Compile;
BEGIN Texts.OpenWriter(W);
Texts.WriteString(W, "Compiler NW 1.8.91"); Texts.WriteLn(W);
Texts.Append(Oberon.Log, W.buf)
END Compiler.
12.5. Сканер
(лексический анализатор)
Сканер реализует лексикографические определения языка, то есть определе¬
ние абстрактных символов в терминах литер. Сущность сканера - это процедура
Get, которая просматривает исходный текст и при каждом вызове распознает сле¬
дующий символ. Чрезвычайно важно, чтобы этот процесс был настолько быст¬
рым, насколько это возможно. Поэтому для определения различных классов ли¬
386]
Компилятор
тер, распознавания букв, указывающих на идентификатор (или ключевое слово),
и цифр, сообщающих о появлении числа, применяется оператор выбора CASE.
Кроме того, сканер распознает комментарии и пропускает их. Глобальная пере¬
менная ch содержит последнюю прочитанную литеру
Цепочка букв и цифр может обозначать или идентификатор, или ключевое
слово. Чтобы определиться с выбором, для каждого потенциального идентифика¬
тора выполняется поиск в таблице ключевых слов. По причинам эффективности
эта таблица организована как хэш-таблица. Хэш-функция - это сумма порядко¬
вых номеров всех литер плюс их количество по модулю размера таблицы. Для
обнаружения ключевого слова достаточно всего двух сравнений. Хэш-таблица за¬
полняется при загрузке компилятора.
Появление цифры говорит о числе. Процедура Number сначала просматривает
последующие цифры (и буквы) и сохраняет их в буфере. Это необходимо потому,
что шестнадцатеричные числа обозначаются буквой-постфиксом Н (а не префик¬
сом). Буква-посгфикс X указывает на то, что цифры обозначают литеру.
Существует единственный случай, когда опережения в один символ не доста¬
точно для распознавания следующего. Если следом за цепочкой цифр идет точка,
то эта точка может быть либо десятичной точкой вещественного числа, либо пер¬
вым элементом символа диапазона (..). К счастью, проблема может быть решена
локально следующим образом: если вслед за цепочкой цифр с точкой идет вторая
точка, возвращается символ числа, а опережающей переменной ch присваивается
специальное значение 7FX. Тогда следующий вызов Get даст символ диапазона.
В противном случае точка за цепочкой цифр относится к (вещественному) числу.
MODULE OCS; (*NW 7.6.87 / 20.12.90*)
IMPORT Files, Oberon, Reals, Texts;
(* символы
| 0 1 2 3 4
0 | null * / DIV MOD
5 | & + - OR
10 | # < <= > >=
15 | IN IS
20 | : .. ) ] }
25 | OF THEN DO TO (
30 | [ { ~ := number
35 | NIL string ident ; |
40 | END ELSE ELSIF UNTIL IF
45 | CASE WHILE REPEAT LOOP WITH
50 | EXIT RETURN ARRAY RECORD POINTER
55 | BEGIN CONST TYPE VAR PROCEDURE
60 | IMPORT MODULE eof*)
CONST KW = 43; (*размер хэш-таблицы*)
maxDig = 32;
maxlnt = 7FFFH;
Сканер (лексический анализатор)
387
388
Компилятор
maxShlnt = 7FH;
maxExp = 38; maxLExp = 308;
maxStrLen = 128;
(*name, numtyp, intval, realval, Irlval - это побочный результат Get*)
VAR numtyp*: INTEGER; (* 1 = char, 2 = integer, 3 = real, 4 = longreal*)
intval*: LONGINT;
realval*: REAL;
Irlval*: LONGREAL;
scanerr*: BOOLEAN;
name*: ARRAY maxStrLen OF CHAR;
R: Texts.Reader;
W: Texts.Writer;
ch: CHAR; (*текущий символ*)
lastpos: LONGINT; (*позиция ошибки в исходном файле*)
i: INTEGER;
keyTab: ARRAY KW OF
RECORD symb, alt: INTEGER; id: ARRAY 12 OF CHAR END;
PROCEDURE Mark* (n: INTEGER);
VAR pos: LONGINT;
BEGIN scanerr := TRUE; pos := Texts.Pos(R);
IF lastpos + 10 < pos THEN
Texts.WriteLn(W); Texts.WriteString(W, " pos");
Texts.WriteInt(W, pos, 6); Texts.WriteString(W, " err");
Texts.WriteInt(W, n, 4); Texts.Append(0beron.Log, W.buf); lastpos : = pos
END
END Mark;
PROCEDURE String (VAR sym: INTEGER);
VAR i: INTEGER;
BEGIN i := 0;
LOOP Texts.Read(R, ch);
IF ch = 22X THEN EXIT END;
IF ch < " " THEN Mark(3); EXIT END;
IF i < maxStrLen - 1 THEN name[i] := ch; INC(i) ELSE Mark(212); i := 0 END
END;
Texts.Read(R, ch);
IF i = 1 THEN sym := 34; numtyp := 1; intval := 0RD(name[0])
ELSE sym := 36; name[i] := OX (*строка*)
END
END String;
PROCEDURE Identifier (VAR sym: INTEGER);
VAR i, k: INTEGER;
BEGIN i := 0; k := 0;
REPEAT
IF i < 31 THEN name[i] := ch; INC(i); INC(k, ORD(ch)) END;
Texts.Read(R, ch)
UNTIL (ch < "0") OR ("9" < ch) & (CAP(ch) < "A") OR ("Z" < CAP(ch));
Сканер (лексический анализатор)
name[i] := ОХ;
к := (к + i) MOD KW; (*жеш-функция*)
IF (keyTab[k].symb tt 0) & (keyTab[k].id = name) THEN sym := keyTab[k].symb
ELSE k := keyTab[k].alt;
IF (keyTab[k].symb # 0) & (keyTab[k].id = name) THEN sym := keyTab[k].symb
ELSE sym := 37 (*иднтификатор*)
END
END
END Identifier;
PROCEDURE Hval (ch: CHAR): INTEGER;
VAR d: INTEGER;
BEGIN d := ORD(ch) - ЗОН; (*d >= 0*)
IF d >= 10 THEN
IF (d >= 17) & (d < 23) THEN DEC(d, 7) ELSE d := 0; Mark(2) END
END;
RETURN d
END Hval;
PROCEDURE Number;
VAR i, j, h, d, e, n: INTEGER;
x, f: REAL;
y, g: LONGREAL;
lastCh: CHAR; neg: BOOLEAN;
dig: ARRAY maxDig OF CHAR;
PROCEDURE ReadScaleFactor;
BEGIN Texts.Read(R, ch);
IF ch = THEN neg := TRUE; Texts.Read(R, ch)
ELSE neg := FALSE;
IF ch = THEN Texts.Read(R, ch) END
END;
IF("0" <= ch) & (ch <= "9") THEN
REPEAT e := e * 10 + ORD(ch) - ЗОН; Texts.Read(R, ch)
UNTIL (ch < "0") OR (ch > "9")
ELSE Mark(2)
END
END ReadScaleFactor;
BEGIN i := 0;
REPEAT dig[i] := ch; INC(i); Texts.Read(R, ch)
UNTIL (ch < "0") OR ("9’’ < ch) & (CAP(ch) < "A") OR ("Z" < CAP(ch));
lastCh := ch; j := 0;
WHILE (j < i - 1) & (dig[j] = "0") DO INC(j) END;
IF ch = V THEN Texts.Read(R, ch);
IF ch = THEN lastCh := OX; ch := 7FX END
END;
IF lastCh = THEN (^десятичная точка*)
h := i;
WHILE ("0" <= ch) & (ch <= "9") DO (*прочитать дробную часть*)
ш
390
Компилятор
IF i < maxDig THEN dig[i] := ch; INC(i) END;
Texts.Read(R, ch)
END;
IF ch = "D" THEN
у : = 0; g := 1; e : = 0;
WHILE j < h DO у := у * 10 + (ORD(dig[j]) - ЗОН); INC(j) END;
WHILE j < i DO g ;= g / 10; у := (ORD(dig[j]) - ЗОН) * g + y;
INC(j) END;
ReadScaleFactor;
IF neg THEN
IF e <= maxLExp THEN у := у / Reals.TenL(e) ELSE у := 0 END
ELSIF e > 0 THEN
IF e <= maxLExp THEN у := Reals.TenL(e) * у ELSE у := 0;
Mark(203) END
END;
numtyp := 4; Irlval ;= у
ELSE x := 0; f := 1; e := 0;
WHILE j < h DO x := x * 10 + (ORD(dig[j ]) - ЗОН); INC(j) END;
WHILE j < i DO f := f / 10; x := (ORD(dig[j ]) - ЗОН) * f + x;
INC(j) END;
IF ch = "E" THEN ReadScaleFactor END;
IF neg THEN
IF e <= maxExp THEN x := x / Reals.Ten(e) ELSE x := 0 END
ELSIF e > 0 THEN
IF e <= maxExp THEN x := Reals.Ten(e) * x ELSE x := 0;
Mark(203) END
END;
numtyp := 3; realval := x
END
ELSE (*целое число*)
lastCh := dig[i - 1]; intval := 0;
IF lastCh = "H" THEN
IF j < i THEN
DEC(i); intval := Hval(dig[j]); INC(j);
IF i - j <= 7 THEN
IF (i - j = 7) & (intval >= 8) THEN DEC(intval, 16) END;
WHILE j < i DO intval := Hval(dig[j]) + intval * 10H;
INC(j) END
ELSE Mark(203)
END
END
ELSIF lastCh = "X" THEN
DEC(i);
WHILE j < i DO
intval := Hval(dig[j]) + intval * 10H; INC(j);
IF intval > OFFH THEN Mark(203); intval := 0 END
END
ELSE (*десятичное число*)
WHILE j < l DO
d := ORD(dig[j]) - ЗОН;
Сканер (лексический анализатор)
IF d < 10 THEN
IF intval <= (MAX(LONGINT) - d) DIV 10 THEN
intval := intval * 10 + d
ELSE Mark(203); intval := 0
END
ELSE Mark(2); intval := 0
END;
INC(j)
END
END;
IF lastCh = "X" THEN numtyp := 1 ELSE numtyp : = 2 END
END
END Number;
PROCEDURE Get* (VAR sym: INTEGER);
VAR s: INTEGER; xch: CHAR;
PROCEDURE Comment; (* не читать за концом файла *)
BEGIN Texts.Read(R, ch);
LOOP
LOOP
WHILE ch = "(" DO Texts.Read(R, ch);
IF ch = THEN Comment END
END;
IF ch = THEN Texts.Read(R, ch); EXIT END;
IF ch = OX THEN EXIT END;
Texts.Read(R, ch)
END;
IF ch = ")" THEN Texts.Read(R, ch); EXIT END;
IF ch = OX THEN Mark(5); EXIT END
END
END Comment;
BEGIN
LOOP (^пропустить управляющие литеры*)
IF ch <= " " THEN
IF ch = OX THEN ch EXIT
ELSE Texts.Read(R, ch)
END
ELSIF ch > 7FX THEN Texts.Read(R, ch)
ELSE EXIT
END
END;
CASE ch OF (* " " <= ch <= 7FX *)
’’ ": s := 62; ch := OX (*eof*)
| "i.", , : s := 0; Texts.Read(R, ch)
| 22X: String(s)
| "#": s := 10; Texts.Read(R, ch)
| s := 5; Texts.Read(R, ch)
| "(": Texts.Read(R, ch);
IF ch = THEN Comment; Get(s)
ELSE s := 29
ШЯ1Ш
392
Компилятор
END
| s := 22; Texts.Read(R, ch)
| s := 1; Texts.Read(R, ch)
| s := 6; Texts.Read(R, ch)
| s := 19; Texts.Read(R, ch)
| s := 7; Texts.Read(R, ch)
| ".Texts.Read(R, ch);
IF ch = THEN Texts.Read(R, ch); s : = 21 ELSE s := 18 END
| "/": s := 2; Texts.Read(R, ch)
| "0".."9": Number; s := 34
| Texts.Read(R, ch);
IF ch = "=" THEN Texts.Read(R, ch); s := 33 ELSE s := 20 END
| s := 38; Texts.Read(R, ch)
| Texts.Read(R, ch);
IF ch = "=" THEN Texts.Read(R, ch); s := 12 ELSE s := 11 END
| "=": s := 9; Texts.Read(R, ch)
| ">": Texts.Read(R, ch);
IF ch = THEN Texts.Read(R, ch); s := 14 ELSE s := 13 END
| "A".."Z": Identifier(s)
| s := 30; Texts.Read(R, ch)
| s := 23; Texts.Read(R, ch)
| s := 17; Texts.Read(R, ch)
| "a".."z": Identifier(s)
| "{": s := 31; Texts.Read(R, ch)
| "I": s := 39; Texts.Read(R, ch)
| s := 24; Texts.Read(R, ch)
| s := 32; Texts.Read(R, ch)
| 7FX: s := 21; Texts.Read(R, ch)
END;
sym := s
END Get;
PROCEDURE Init* (source: Texts.Text; pos: LONGINT);
BEGIN
ch := "; scanerr := FALSE; lastpos := - 8;
Texts.OpenReader(R, source, pos)
END Init;
PROCEDURE EnterKW (sym: INTEGER; name: ARRAY OF CHAR);
VAR j, k: INTEGER;
BEGIN j := 0; к := 0;
REPEAT INC(к, 0RD(name[j])); INC(j)
UNTIL name[j] = OX;
к := (к + j) MOD KW; (*хеш-функция*)
IF keyTab[k].symb # 0 THEN
j := k;
REPEAT INC(k) UNTIL keyTab[k]. symb = 0;
keyTab[j].alt := k
END;
keyTab[k].symb :=sym; C0PY(name, keyTab[k],id)
Поиск в таблице символов и символьные файлы
END EnterKW;
BEGIN i := KW;
WHILE i > 0 DO
DEC(i); keyTab[i].symb := 0; keyTab[i].alt := 0
END;
keyTab[0].id :=
EnterKW(27, "DO"); EnterKW(44, "IF'); EnterKW(15, "IN"); EnterKW(16, "IS");
EnterKW(25, "OF"); EnterKW(8, "OR"); EnterKW(40, "END"); EnterKW(4, "MOD");
EnterKW(35, "NIL"); EnterKW(58, "VAR"); EnterKW(41, "ELSE"); EnterKW(50, "EXIT");
EnterKW(26, "THEN"); EnterKW(49, "WITH”); EnterKW(52, "ARRAY");
EnterKW(55, "BEGIN"); EnterKW(56, "CONST"); EnterKW(42, "ELSIF");
EnterKW(43, "UNTIL"); EnterKW(46, "WHILE"); EnterKW(53, "RECORD");
EnterKW(47, "REPEAT"); EnterKW(51, "RETURN"); EnterKW(59, "PROCEDURE");
EnterKW(28, "TO"); EnterKW(3, "DIV"); EnterKW(48, "LOOP"); EnterKW(57, "TYPE");
EnterKW(60, "IMPORT"); EnterKW(61, "MODULE"); EnterKW(54, "POINTER");
Texts.OpenWriter(W)
END OCS
12.6. Поиск в таблице символов
и символьные файлы
Таблица символов образует контекст, в котором анализируются операторы
и выражения. Каждая процедура устанавливает область видимости локальных
идентификаторов. Записи об идентификаторах, принадлежащих области видимо¬
сти, связываются в линейный список. Процедуры создания списка и поиска в нем
находятся в модуле ОСТ. Если нужно добавить новый идентификатор, процедура
Insert сначала просматривает список и, если идентификатор уже есть, диагности¬
рует повторное определение. В противном случае она добавляет новый элемент,
сохраняя при этом заданный исходным текстом порядок.
Процедуры, а также области видимости могут быть вложенными. Каждая об¬
ласть видимости представлена списком объявленных в ней идентификаторов,
а сами области видимости также соединяются в список. Процедура OpenScope до¬
бавляет в него элемент, а процедура CloseScope удаляет его. Начало списка обла¬
стей видимости - в глобальной переменной topScope, а сам список подобен стеку.
Он состоит из элементов типа Object, каждый из которых - заголовок (mode =
= Head) списка объявленных объектов. Снимок таблицы символов показан на
рис. 12.7. Он сделан в тот момент, когда следующие ниже объявления уже разо¬
браны и достигнут оператор S.
VAR х: INTEGER;
PROCEDURE P(u: INTEGER);
BEGIN ... END P;
PROCEDURE Q(v: INTEGER);
Г39Г
394
Компилятор
PROCEDURE R(w: INTEGER);
BEGIN S END R;
BEGIN ... END Q;
Рис. 12.7. Снимок таблицы символов
Поиск идентификатора ведется в списке областей видимости, и для каждого
заголовка просматривается список записей его объектов. Это отражает правило
видимости языка и гарантирует, что если несколько объектов имеют одно и то же
имя, то из них выбирается самый внутренний. Конечно, линейный список объ¬
ектов представляет простейшую реализацию. Древовидная структура во многом
была бы эффективней и потому казалась бы предпочтительней. Однако экспери¬
менты показали, что выигрыш в скорости крайне мал. Причина в том, что обыч¬
но списки довольно коротки. Преимущество древовидной структуры становится
заметным, только когда объявляется большое количество глобальных объектов.
Подчеркнем, что если каждая область видимости представлена деревом, линей¬
ные списки все равно должны присутствовать, потому что порядок следования
объявлений иногда обусловлен интерпретацией, например в списках параметров.
Свою локальную область видимости устанавливают не только процедуры, но
и записи. Список полей записи связывается полем link типа запись и просматрива¬
ется процедурой FindField. Если запись типа R1- расширение R0, то список полей
R1 содержит только поля расширения. На исходный тип R0 ссылается поле Base¬
Typ из R1. Следовательно, поиск поля, возможно, придется продолжить в списках
полей всей последовательности базовых типов записей.
Основная часть модуля ОСТ посвящается вводу и выводу символьных фай¬
лов. Символьный файл - это линеаризованная форма фрагмента таблицы сим¬
волов, содержащей описания всех экспортируемых (помеченных) объектов. Весь
экспорт объявляется в глобальной области видимости. Процедура Export прохо¬
дит по всему списку глобальных объектов и переносит их в символьный файл.
Главная проблема в том, чтобы найти подходящее представление указателей,
которые должны приводиться к виду, свободному от абсолютных адресов. Единст¬
венные такие указатели здесь - это те, что обращаются к типам, то есть к записям
типа Stmct. Решение заключается в присваивании уникального ссылочного номе¬
ра каждому появляющемуся тину Так как эффективность импорта важнее эффек¬
тивности экспорта, эти ссылочные номера никогда не должны ссылаться вперед,
то есть определение ссылки должно предшествовать ее появлению в файле. Это
соображение диктует метод, используемый при экспорте типов объектов.
Ссылочный номер типа заносится в поле ref. Его исходное значение 0 означа¬
ет, что тип еще не экспортирован. Если идентификатор должен экспортироваться
и ссылочный номер его типа равен 0, экспорт его типа (Stmct) предшествует экс¬
порту самого идентификатора (Object), который таким образом на свой тип всегда
ссылается назад (см. процедуры OutObjs и OutStr). Первый байт описания каж¬
дого объекта в файле указывает на его вид, а первый байт описания каждого типа
указывает на его форму. И в обоих случаях второй байт - это ссылочный номер
типа. Номера видов и форм различны, позволяя таким образом быстро распознать
следующий элемент в файле.
Структура символьного файла определяется приводимым ниже синтаксисом.
Терминальные символы занимают один байт, если иное не указано в «: 1еп». Сле¬
дующие терминальные символы - это спецификаторы вида и формы или ссылоч¬
ные номера основных типов с постоянными значениями:
Con =1, Тур = 2, Var = 4, XProc = 5, CProc = 7, Pointer = 8, ProcTyp = 9, Array = 10,
DynArr = 11, Record = 12, ParList = 13, ValPar = 14, VarPar = 15, FldList = 16,
Fid = 17, HPtr = 18, Fixup = 19, Mod = 22. Byte = 1, Bool = 2, Char = 3, Sint = 4,
Int = 5, Lint = 6, Real =7, LReal = 8, Set = 9, String = 10, Nil = 11, NoTyp = 12.
SymbolFile = SymTag modAnchor {element}
modAnchor = Mod key:4 name.
element = Con constant
| Typ ref modno name
| (Var | Fid) ref offset:2 name
| (ValPar | VarPar) ref offset:4 name
| ParList {element} (XProc ref pno | CProc ref len code) name
| Pointer ref mno
| ParList {element} ProcTyp ref mno
| Array ref mno size:4 bndadr:2 nofel:4
| DynArr ref mno size:4 lenoff:2
| FldList {element} Record ref mno size:4 dscadr:2
| HPtr offset:4
| Fixup ref ref
| modAnchor.
constant = (Byte | Bool j Char | Sint) val name
| Int val:2 name
| (Lint | Real | Set) val:4 name
[зЙГ
Поиск в таблице символов и символьные файлы
396
Компилятор
| LReal val:8 name
| String name name
| Nil name,
name = {char} OX.
Описанию процедуры со спецификатором вида XProc (или CProc) и описанию
процедурного типа со спецификатором формы РгосТур предшествует список пара¬
метров. Список начинается спецификатором ParList. Точно так же описанию типа
записи со спецификатором формы Record предшествует список описаний нолей.
Этот список начинается спецификатором FldList.
Спецификатор HPtr (в списке полей) обозначает поле с типом указателя. Само
имя поля не экспортируется; оно скрыто. Причина его вхождения в символьный
файл в следующем. Если объявляется расширение этого типа записи, то создается
соответствующий дескриптор типа. Этот дескриптор должен содержать смещения
всех полей-указателей для использования сборщиком мусора. Указатели, унасле¬
дованные от базового типа, не должны опускаться.
Спецификатор Fixup отражает ссылку вперед в объявлении ссылочного типа.
При чтении символьного файла он выполняет закрепление основного типа в соот¬
ветствующем ссылочном типе (см. процедуру Import).
Объекты, экспортируемые некоторым модулем МО, могут ссылаться в своих
объявлениях на какой-то другой модуль М1, импортируемый МО. Было бы не¬
допустимо, если импорт МО требовал бы также импорта М1, то есть предполагал
автоматическое чтение символьного файла М1. Это вызвало бы цепную реакцию
импортов, которой нужно избежать. К счастью, такой цепной реакции можно из¬
бежать, создавая замкнутые символьные файлы, то есть включая в каждый сим¬
вольный файл описание объектов, которые происходят из других модулей. Такие
объекты - это всегда типы.
Оказывается, что включение типов, импортированных из других модулей, до¬
статочно просто обрабатывать: описания типов должны включать ссылку на мо¬
дуль, из которого был импортирован тип. Эта ссылка - номер модуля (mno)] имя и
ключ соответствующего модуля задаются его привязкой, которая при чтении вы¬
зывает новый вход в массиве LocMod импортированных модулей (см. процедуру
Import). Однако есть одна дополнительная сложность, которую нельзя игнори¬
ровать. Рассмотрим модуль МО, импортирующий переменную х из модуля М1.
Пусть тип Т переменной х был определен в модуле М2. Пусть также МО содержит
переменную у типа М2.Т. Очевидно, х и у имеют одинаковый тип, и компилятор
должен распознать это. Следовательно, при импорте М1 во время компиляции МО
импортируемый элемент Т должен быть не просто занесен в таблицу символов, но
и распознан как идентичный типу Т, уже импортированному непосредственно из
М2. Довольно удачно, что язык определяет эквивалентность типов на основе имен,
а не структур, потому что это позволяет реализовать проверки типов во время вы¬
полнения простым сравнением адресов.
Для соответствия новым требованиям должны быть предприняты следующие
меры:
1. Каждому элементу типа в символьном файле дается номер модуля, ссы¬
лающийся на привязку модуля. До записи описания типа в файл сначала
вносится его привязка модуля, если этого не было сделано при более ран¬
нем его появлении.
2. Если экспортируемый тип имеет имя и берет начало в другом, импортируе¬
мом, модуле, то в файл выдается также элемент со спецификатором Тур.
Его имя получается из соответствующего объекта в таблице символов, до¬
ступного через поле strobj дескриптора типа. (Это единственная причина
наличия данного поля. Безымянные типы имеют strobj = NIL.)
3. При импорте модуля нужно проверить, появлялся ои раньше полностью
или частично. При импорте типа его наличие тоже должно проверяться.
Если он уже существует, то в структуре создается новый вход для ссылки
на уже существующий для этого типа вход (stmct[s] := obO.next.typ, см. про¬
цедуру Import).
Есть еще одно препятствие, которое нужно преодолеть. Типам можно давать
несколько имен; положим, (экспортируемый) тип 77должен объявляться как
Т1 = ТО. В этом случае элемент типа с именем Т1 должен быть записан с указате¬
лем (ссылочным номером) на структурный элемент, связанный с ТО и записанный
ранее (см. процедуру OutObjs). Следующая типовая программа может помочь чи¬
тателю понять структуру символьных файлов и способ их генерации. Следом идет
декодированное содержимое соответствующего символьного файла.
MODULE Sample;
CONST N* = 100;
TYPE PtrO* = POINTER TO RecO;
RecO* = RECORD x, y: INTEGER END ;
Red* = RECORD (RecO) z: LONGINT END ;
Ptr1* = PtrO;
VAR a*: ARRAY N OF RecO;
PROCEDURE P*(x: REAL; p: Ptr1): INTEGER;
BEGIN END P;
END Sample.
Mod key = 6E08D9E9 name = Sample
Con ref = 4 val = 100 name = N
Pointer ref = 16 base ref = 0 mno = 0
Typ ref = 16 mno = 0 name = PtrO
Record ref = 17 base ref = 12 mno = 0 size =4 adr = 0
Typ ref = 17 mno = 0 name = RecO
Record ref = 18 base ref = 17 mno = 0 size =8 adr = 4
Typ ref = 18 mno = 0 name = Red
Typ ref = 16 mno = 0 name = Ptr1
Array ref = 19 elem ref = 17 mno = 0 size = 400 adr = 8 nofel = 100
Var ref = 19 adr = -400 name = a
ValPar ref = 7 adr = 16 name - x
Поиск в таблице символов и символьные файлы
шм
398
Компилятор
ValPar ref = 16 adr = 12 name = p
XProc ref = 5 pno = 1 name = P
Fixup ref = 16 ref = 17
После создания символьного файла он сравнивается с файлом (если он есть)
предыдущей компиляции того же модуля. Новый файл заменяет старый только
тогда, когда эти два файла различны и включена опция \s компилятора. Сравне¬
ние выполняется побайтно без учета структуры файла. Этот грубоватый подход
был выбран из-за его простоты и привел к хорошим практическим результатам.
MODULE ОСТ; (*NW 28.5.87 / 5.3.91*)
IMPORT OCS, Files;
CONST maxlmps = 24; SFtag = OFAX; firstStr = 16;
maxStr = 80; maxUDP = 16; maxMod = 24; maxParLev = 6;
PtrSize = 4; ProcSize = 4; NotYetExp = 0;
(*виды объектов*)
Var = 1; Ind = 3; Con = 8; Fid = 12; Typ = 13;
XProc = 15; SProc = 16; CProc = 17; Mod = 19; Head = 20;
(*формы структур*)
Undef = 0; Byte = 1; Bool = 2; Char = 3; Sint = 4; Int = 5; Lint = 6;
Real = 7; LReal = 8; Set = 9; String = 10; NilTyp = 11; NoTyp = 12;
Pointer = 13; ProcTyp = 14; Array = 15; DynArr = 16; Record = 17;
TYPE
Object* = POINTER TO ObjDesc;
Struct* = POINTER TO StrDesc;
ObjDesc* = RECORD
dsc*, next*: Object;
typ*: Struct;
aO*, a1*: LONGINT;
a2*: INTEGER;
mode*: SHORTINT;
marked*: BOOLEAN;
name*: ARRAY 32 OF CHAR;
END;
StrDesc* = RECORD
form*, n*. mno*, ref*: INTEGER;
size*, adr*: LONGINT;
BaseTyp*: Struct;
link*, strobj*: Object
END;
Item* = RECORD
mode*, lev*: INTEGER;
a0*t al*, a2*: LONGINT;
typ*: Struct;
obj*: Object
(Поиск в таблице символов и символьные файлы
END;
VAR topScope*: Object;
undftyp*, bytetyp*, booltyp*, chartyp*, sinttyp*, inttyp*, linttyp*,
realtyp*, lrltyp*, settyp*, stringtyp*, niltyp*, notyp*: Struct;
nofGmod*: INTEGER; (*число импортов*)
GlbMod*: ARRAY maxlmps OF Object;
universe, syslink: Object;
strno, udpinx: INTEGER; (*для экспорта*)
nofExp: SHORTINT;
SR: Files.Rider;
undPtr: ARRAY maxUDP OF Struct;
PROCEDURE Init*;
BEGIN topScope := universe; strno := 0; udpinx := 0; nofGmod := 0
END Init;
PROCEDURE Close*;
VAR i: INTEGER;
BEGIN Files.Set(SR, NIL, 0); i := 0;
WHILE i < maxlmps DO GlbMod[i] := NIL; INC(i) END
END Close;
PROCEDURE Findlmport* (mod: Object; VAR res: Object);
VAR obj: Object;
BEGIN obj := mod.dsc;
WHILE (obj # NIL) & (obj.name ft OCS.name) DO obj := obj.next END;
IF(obj # NIL) & (obj.mode = Typ) & ~obj.marked THEN obj := NIL END;
res := obj
END Findlmport;
PROCEDURE Find* (VAR res: Object; VAR level: INTEGER);
VAR obj, head: Object;
BEGIN head := topScope;
LOOP obj := head.next;
WHILE (obj tt NIL) & (obj.name # OCS.name) DO obj := obj. next END;
IF obj ft NIL THEN level := SHORT(head.aO); EXIT END;
head := head.dsc;
IF head = NIL THEN level := 0; EXIT END
END;
res := obj
END Find;
PROCEDURE FindField* (typ: Struct; VAR res: Object);
VAR obj: Object;
BEGIN (*typ.form = Record*)
LOOP obj := typ.link;
WHILE (obj # NIL) & (obj.name # OCS.name) DO obj := obj. next END;
IF obj ft NIL THEN EXIT END;
typ := typ.BaseTyp;
400
Компилятор
IF typ = NIL THEN EXIT END
END;
res := obj
END FindField;
PROCEDURE Insert* (VAR name: ARRAY OF CHAR; VAR res: Object);
VAR obj, new: Object;
BEGIN obj := topScope;
WHILE (obj.next # NIL) & (obj.next.name # name) DO obj := obj.next END;
IF obj.next = NIL THEN NEW(new);
new.dsc := NIL; new.next := NIL; C0PY(name, new.name); obj.next := new;
res := new
ELSE res := obj.next;
IF obj.next.mode # Undef THEN 0CS.Mark(1) END
END
END Insert;
PROCEDURE OpenScope* (level: INTEGER);
VAR head: Object;
BEGIN NEW(head);
head.mode := Head; head.aO := level; head.typ := NIL;
head.dsc := topScope; head.next := NIL; topScope := head
END OpenScope;
PROCEDURE CloseScope*;
BEGIN topScope := topScope.dsc
END CloseScope;
(* импорт *)
PROCEDURE Readlnt (VAR i: INTEGER);
BEGIN Files.ReadBytes(SR, 1, 2)
END Readlnt;
PROCEDURE ReadXInt (VAR k: LONGINT);
VAR i: INTEGER;
BEGIN Files.ReadBytes(SR, i, 2); к := i
END ReadXInt;
PROCEDURE ReadLInt (VAR k: LONGINT);
BEGIN Files.ReadBytes(SR, k, 4)
END ReadLInt;
PROCEDURE Readld (VAR id: ARRAY OF CHAR);
VAR i: INTEGER; ch: CHAR;
BEGIN i := 0;
REPEAT Files.Read(SR, ch); id[i] := ch; INC(i)
UNTIL ch = OX
END Readld;
PROCEDURE Import* (VAR name, self, FileName: ARRAY OF CHAR);
VAR i, j, m, s, class: INTEGER; k: LONGINT;
nofLmod, strno, parlev, fldlev: INTEGER;
obj, obO: Object;
typ: Struct;
ch, chi. ch2: CHAR;
si: SHORTINT;
xval: REAL; yval: LONGREAL;
SymFile: Files.File;
modname: ARRAY 32 OF CHAR;
LocMod: ARRAY maxMod OF Object;
struct: ARRAY maxStr OF Struct;
lastpar, lastfld: ARRAY maxParLev OF Object;
PROCEDURE reversedList (p: Object): Object;
VAR q, r: Object;
BEGIN q := NIL;
WHILE p # NIL DO
r := p.next; p.next := q; q := p; p := r
END;
RETURN q
END reversedList;
BEGIN nofLmod := 0; strno := firstStr;
parlev := - 1; fldlev := - 1;
IF FileName = "SYSTEM.Sym" THEN
Insert(name, obj); obj.mode := Mod; obj.dsc := syslink;
obj.aO := 0; obj.typ := notyp
ELSE SymFile := Files.Old(FileName);
IF SymFile # NIL THEN
Files.Set(SR, SymFile, 0); Files.Read(SR, ch);
IF ch = SFtag THEN
struct[Undef] := undftyp; struct[Byte] := bytetyp;
struct[Bool] := booltyp; struct[Char] := chartyp;
struct[SInt] := sinttyp; structflnt] := inttyp;
struct[LInt] := linttyp; struct[Real] := realtyp;
struct[LReal] := lrltyp; struct[Set] := settyp;
struct[String] := stringtyp; struct[NilTyp] := niltyp;
struct[NoTyp] := notyp;
LOOP (*прочитать следующий элемент из символьного файла*)
Files.Read(SR, ch); class := ORD(ch);
IF SR.eof THEN EXIT END;
CASE class OF
0: OCS.Mark(151)
| 1..7: (*объект*) NEW(obj); m := 0;
Files.Read(SR, ch); s := ORD(ch); obj.typ := struct[s];
CASE class OF
1: obj.mode := Con;
CASE obj.typ.form OF
2, 4: Files.Read(SR, si); obj.aO := si
| 1, 3: Files.Read(SR, ch); obj.aO :=0RD(ch)
| 5: ReadXInt(obj.aO)
Поиск в таблице символов и символьные файлы
гщ
Компилятор
| 6, 7, 9: ReadLInt(obj.aO)
| 8: ReadLInt(obj.aO); ReadLInt(obj. a1)
| 10: ReadId(obj.name); OCS.Maгк(151)
| 11: (*NIL*)
END
|2, 3: obj.mode := Typ; Files.Read(SR, ch);
m := ORD(ch);
IF obj.typ.strobj = NIL THEN
obj.typ.strobj := obj END;
obj.marked := class = 2
|4: obj.mode := Var; ReadLInt(obj.aO)
|5, 6, 7: IF class # 7 THEN obj.mode := XProc;
Files.Read(SR, ch)
ELSE obj.mode := CProc;
Files.Read(SR, ch); Files.Read(SR, ch);
Files.Read(SR, ch)
END;
obj.aO := ORD(ch); obj.al := 0; (*адрес связи*)
obj.dsc := reversedList(lastpar[parlev]);
DEC(parlev)
END;
ReadId(obj.name); obO := LocMod[m];
WHILE (obO.next # NIL) & (obO.next.name # obj.name) DO
obO := obO.next
END;
IF obO.next = NIL THEN obO.next := obj;
obj.next := NIL (^вставить объект*)
ELSIF obj.mode = Typ THEN struct[s] := obO.next.typ
END
| 8.. 12: ^структура*)
NEW(typ); typ.strobj := NIL; typ.ref := 0;
Files.Read(SR, ch); typ.BaseTyp := struct[0RD(ch)];
Files.Read(SR, ch);
typ.mno := SHORT(LocMod[ORD(ch)].aO);
CASE class OF
8: typ.form := Pointer; typ.size := PtrSize;
typ.n := 0
| 9: typ.form := ProcTyp; typ.size := ProcSize;
typ.link := reversedList(lastpar[parlev]);
DEC(parlev)
| 10: typ.form := Array; ReadLInt(typ.size); •
ReadXInt(typ.adr); ReadLInt(k);
typ.n := SHORT(k)
| 11: typ.form := DynArr; ReadLInt(typ.size);
ReadXInt(typ.adr)
| 12: typ.form := Record; ReadLInt(typ.size);
typ.n := 0;
typ.link := reversedList(lastfld[fldlev]);
DEC(fldlev);
IF typ.BaseTyp = notyp THEN typ.BaseTyp := NIL;
402]
Поиск в таблице символов и символьные файлы
typ.n := О
ELSE typ.n := typ.BaseTyp.n + 1
END;
ReadXInt(typ.adr) (^...дескриптора*)
END;
struct[strno] ;= typ; INC(strno)
| 13; (*начало списка параметров*)
IF parlev < maxParLev - 1 THEN INC(parlev);
lastpar[parlev] := NIL
ELSE OCS.Mark(229)
END
| 14, 15; (*параметр*)
NEW(obj);
IF class = 14 THEN obj.mode := Var ELSE
obj.mode := Ind END;
Files.Read(SR, ch); obj.typ := struct[ORD(ch)];
ReadXInt(obj.aO); ReadId(obj.name);
obj.dsc := NIL; obj.next := lastpar[parlev];
lastpar[parlev] ;= obj
| 16: (*начало списка полей*)
IF fldlev < maxParLev - 1 THEN INC(fldlev);
lastfld[fldlev] := NIL
ELSE OCS.Mark(229)
END
| 17: (*поле*)
NEW(obj); obj.mode := Fid; Files.Read(SR, ch);
obj.typ := struct[0RD(ch)]; ReadLInt(obj.aO);
ReadId(obj.name); obj.marked := TRUE;
obj.dsc := NIL; obj.next := lastfld[fldlev];
lastfld[fldlev] := obj
| 18: (*поел скрытого указателя*)
NEW(obj); obj.mode := Fid; ReadLInt(obj.aO);
obj.name := obj.typ := notyp;
obj.marked := FALSE;
obj.d'sc := NIL; obj.next := lastfld[fldlev];
lastfld[fldlev] := obj
| 19: (*поле скрытой процедуры*)
ReadLInt(k)
| 20: (*закрепить typ указателя*)
Files.Read(SR, ch); typ := struct[0RD(ch)];
Files.Read(SR, ch1);
IF typ.BaseTyp = undftyp THEN
typ.BaseTyp := struct[0RD(ch1)] END
| 21, 23, 24: OCS.Mark(151); EXIT
| 22: (*привязка к модулю*)
ReadLInt(k); Readld(modname);
IF modname = self THEN 0CS.Mark(49) END;
l := 0;
WHILE (i < nofGmod) & (modname # GlbMod[i].name)
403
404
Компилятор
DO INC(i) END;
IF i < nofGmod THEN (*модуль уже присутствует*)
IF к # GlbMod[i].a1 THEN OCS.Mark(150) END;
obj := GlbMod[i]
ELSE NEW(obj);
IF nofGmod < maxlmps THEN
GlbMod[nofGmod] := obj; INC(nofGmod)
ELSE OCS.Mark(227)
END;
obj.mode := NotYetExp; COPY(modname, obj.name);
obj.al := k; obj.aO := nofGmod; obj.next := NIL
END;
IF nofLmod < maxMod THEN LocMod[nofLmod] := obj;
INC(nofLmod)
ELSE OCS.Mark(227)
END
END
END (*L00P*);
Insert(name, obj);
obj.mode := Mod; obj.dsc := LocMod[0].next;
obj.aO := LocMod[0].a0; obj.typ := notyp
ELSE OCS.Mark(151)
END
ELSE OCS.Maгк(152) ^символьный файл не найден*)
END
END
END Import;
(* экспорт *)
PROCEDURE WriteByte (i: INTEGER);
BEGIN Files.Write(SR, CHR(i))
END WriteByte;
PROCEDURE Writelnt (i: LONGINT);
BEGIN Files. WriteBytes(SR, i, 2)
END Writelnt;
PROCEDURE WriteLInt (k: LONGINT);
BEGIN Files.WriteBytes(SR, k, 4)
END WriteLInt;
PROCEDURE Writeld (VAR name: ARRAY OF CHAR);
VAR ch: CHAR; i: INTEGER;
BEGIN i := 0;
REPEAT ch := name[i]; Files.Write(SR, ch); INC(i)
UNTIL ch = OX
END Writeld;
PROCEDURE" OutStr (typ: Struct);
Поиск в таблице символов и символьные файлы
405
PROCEDURE OutPars (par: Object);
BEGIN WriteByte(13);
WHILE (par # NIL) & (par.mode <= Ind) & (par.aO > 0) DO
OutStr(par.typ);
IF par.mode = Var THEN WriteByte(14) ELSE WriteByte(15) END;
WriteByte(par.typ.ref); Writelnt(par.aO); Writeld(par.name);
par := par.next
END
END OutPars;
PROCEDURE OutFlds (fid; Object; adr: LONGINT; visible: BOOLEAN);
BEGIN
IF visible THEN WriteByte(16) END;
WHILE fid # NIL DO
IF fid.marked & visible THEN
OutStr(fId.typ); WriteByte(17); WriteByte(fld.typ.ref);
WriteLInt(fId.aO); Writeld(fid.name)
ELSIF fid.typ.form = Record THEN OutFlds(fld.typ.link, fld.aO + adr, FALSE)
ELSIF (fid.typ.form = Pointer) OR (fid.name = «») THEN
WriteByte(18); WriteLInt(fld.aO + adr)
END;
fid := fid.next
END
END OutFlds;
PROCEDURE OutStr (typ: Struct);
VAR m, em, r: INTEGER; btyp: Struct; mod: Object;
BEGIN
IF typ.ref = 0 THEN
m := typ.mno; btyp := typ.BaseTyp;
IF m > 0 THEN mod := GlbMod[m - 1]; em := mod.mode;
IF em = NotYetExp THEN
GlbMod[m - 1].mode := nofExp; m := nofExp; INC(nofExp);
WriteByte(22); WriteLInt(mod.al); WriteId(mod.name)
ELSE m := em
END
END;
CASE typ.form OF
Undef .. NoTyp:
| Pointer: WriteByte(8);
IF btyp.ref > 0 THEN WriteByte(btyp.ref)
ELSE WriteByte(Undef);
IF udpinx < maxUDP THEN undPtr[udpinx] := typ; INC(udpinx)
ELSE OCS.Mark(224)
END
END;
WriteByte(m)
| ProcTyp: OutStr(btyp); OutPars(typ.link);
WriteByte(9); WriteByte(btyp.ref); WriteByte(m)
406
I Array: OutStr(btyp);
WriteByte(IO); WriteByte(btyp.ref); WriteByte(m);
WriteLInt(typ.size); Writelnt(typ.adr); WriteLInt(typ.n)
| DynArr: OutStr(btyp);
WriteByte(11); WriteByte(btyp.ref); WriteByte(m);
WriteLInt(typ.size); Writelnt(typ.adr)
| Record:
IF btyp = NIL THEN r := NoTyp
ELSE OutStr(btyp); r := btyp.ref
END;
OutFlds(typ.link, 0, TRUE); WriteByte(12); WriteByte(r); WriteByte(m);
WriteLInt(typ.size); Writelnt(typ.adr)
END;
IF typ.strobj # NIL THEN
IF typ.strobj.marked THEN WriteByte(2) ELSE WriteByte(3) END;
WriteByte(strno); WriteByte(m); Writeld(typ.strobj.name)
END;
typ.ref := strno; INC(strno);
IF strno > maxStr THEN OCS.Mark(228) END
END
END OutStr;
PROCEDURE OutObjs;
VAR obj: Object;
f: INTEGER; xval: REAL; yval: LONGREAL;
BEGIN obj := topScope.next;
WHILE obj it NIL DO
IF obj.marked THEN
IF obj.mode = Con THEN
WriteByte(l); f := obj.typ. form; WriteByte(f);
CASE f OF
Undef:
| Byte, Bool, Char, Sint: WriteByte(SHORT(obj.aO))
| Int: WriteInt(SHORT(obj.aO))
| Lint, Real, Set: WriteLInt(obj.aO)
| LReal: WriteLInt(obj.aO); WriteLInt(obj.a1)
| String: WriteByte(O); OCS.Mark(221)
| NilTyp:
END;
WriteId(obj.name)
ELSIF obj.mode = Typ THEN
OutStr(obj.typ);
IF (obj. typ. strobj it obj) & (obj. typ. strobj tt NIL) THEN
WriteByte(2); WriteByte(obj.typ.ref); WriteByte(O);
WriteId(obj.name)
END
ELSIF obj.mode = Var THEN
OutStr(obj.typ); WriteByte(4);
WriteByte(obj.typ.ref); WriteLInt(obj.aO); WriteId(obj.name)
Компилятор
Поиск в таблице символов и символьные файлы
ELSIF obj.mode = XProc THEN
OutStr(obj.typ); OutPars(obj.dsc); WriteByte(5);
WriteByte(obj.typ.ref); WriteByte(SHORT(obj.aO));
WriteId(obj.name)
ELSIF obj.mode = CProc THEN
OutStr(obj.typ); OutPars(obj.dsc); WriteByte(7);
WriteByte(obj.typ.ref); WriteByte(2); WriteByte(226);
WriteByte(SHORT(obj.aO)); WriteId(obj.name)
END
END;
obj := obj.next
END
END OutObjs;
PROCEDURE Export* (VAR name, FileName: ARRAY OF CHAR;
VAR newSF: BOOLEAN; VAR key: LONGINT);
VAR i: INTEGER;
chO, ch1: CHAR;
oldkey: LONGINT;
typ: Struct;
oldFile, newFile: Files.File;
oldSR: Files.Rider;
BEGIN newFile := Files.New(FileName);
IF newFile ft NIL THEN
Files.Set(SR, newFile, 0); Files.Write(SR, SFtag); strno := firstStr;
WriteByte(22); WriteLInt(key); Writeld(name); nofExp := 1;
OutObjs; i := 0;
WHILE i < udpinx DO
typ := undPtr[i]; OutStr(typ.BaseTyp); undPtr[i] := NIL; INC(i);
WriteByte(20); (*закрепить*)
WriteByte(typ.ref); WriteByte(typ.BaseTyp.ref)
END;
IF “OCS.scanerr THEN
oldFile := Files.Old(FileName);
IF oldFile # NIL THEN («сравнить*)
Files.Set(oldSR, oldFile, 2); Files.ReadBytes(oldSR, oldkey, 4);
Files.Set(SR, newFile, 6);
REPEAT Files.Read(oldSR, chO); Files.Read(SR, chi)
UNTIL (chO # ch1) OR SR.eof;
IF oldSR.eof & SR.eof THEN (*равны*) newSF := FALSE;
key := oldkey
ELSIF newSF THEN Files.Register(newFile)
ELSE OCS.Mark(155)
END
ELSE Files.Register(newFile); newSF := TRUE
END
ELSE newSF := FALSE
END
ELSE OCS.Mark(153)
ш
408
Компилятор
END
END Export;
(* инициализация *)
PROCEDURE InitStruct (VAR typ: Struct; f: INTEGER);
BEGIN NEW(typ); typ.form := f; typ. ref := f; typ.size := 1
END InitStruct;
PROCEDURE EnterConst (name; ARRAY OF CHAR; value: INTEGER);
VAR obj: Object;
BEGIN Insert(name, obj); obj.mode := Con; obj.typ := booltyp; obj.aO := value
END EnterConst;
PROCEDURE EnterTyp (name: ARRAY OF CHAR; form,
size: INTEGER; VAR res: Struct);
VAR obj: Object; typ: Struct;
BEGIN Insert(name, obj);
NEW(typ); obj.mode := Typ; obj.typ := typ; obj.marked := TRUE;
typ.form := form; typ.strobj := obj; typ.size := size;
typ.mno := 0; typ. ref := form; res := typ
END EnterTyp;
PROCEDURE EnterProc (name: ARRAY OF CHAR; num: INTEGER);
VAR obj: Object;
BEGIN Insert(name, obj); obj.mode := SProc; obj.typ := notyp; obj.aO := num
END EnterProc;
BEGIN topScope := NIL; InitStruct(undftyp, Undef); InitStruct(notyp, NoTyp);
InitStruct(stringtyp, String); InitStruct(niltyp, NilTyp); OpenScope(O);
(«инициализация модуля SYSTEM*)
EnterProc("LSH", 22); EnterProc("ROT", 23); EnterProc("ADR", 9); EnterProc("OVFL", 15);
EnterProc("GET", 24); EnterProc("PUT", 25); EnterProc("BIT", 26); EnterProc("VAL", 27);
EnterProc("NEW", 28); EnterProc("MOVE", 30); EnterProc("CC", 2);
EnterTyp("BYTE", Byte, 1, bytetyp);
syslink := topScope. next; universe := topScope; topScope.next := NIL;
EnterTyp("CHAR", Char, 1, chartyp); EnterTypC'SET", Set, 4, settyp);
EnterTyp("REAL", Real, 4, realtyp); EnterTypC'INTEGER", Int, 2, inttyp);
EnterTyp("LONGINT", Lint, 4, linttyp); EnterTyp("LONGREAL", LReal, 8, lrltyp);
EnterTypC'SHORTINT", Sint, 1, sinttyp); EnterTyp("BOOLEAN", Bool, 1, booltyp);
EnterProc("INC", 16); EnterProc("DEC", 17); EnterConst("FALSE", 0);
EnterConst("TRUE", 1); EnterProc("HALT", 0); EnterProc("NEW", 1);
EnterProc("ABS", 3); EnterProc("CAP”, 4); EnterProc("ORD", 5);
EnterProc("ENTIER", 6); EnterProc("SIZE", 7); EnterProc("ODD", 8);
EnterProc("MIN", 10); EnterProc("MAX”, 11); EnterProc(”CHR", 12);
EnterProc("SH0RT", 13); EnterProc("LONG", 14); EnterProc("INCL", 18);
EnterProc("EXCL”, 19); EnterProc("LEN", 20); EnterProc("ASH", 21);
EnterProc("COPY", 29)
END OCT.
12.7. Выбор кода
Процедуры, которые определяют выбор команд, соответствующих различ¬
ным синтаксическим конструкциям, входят в модули ОСЕ и ОСН. Они отражают
двухадресную природу архитектуры целевого компьютера. Если, например, рас¬
познано простое выражение из двух слагаемых и операции сложения, то вызыва¬
ется процедура Ор с первым параметром, задающим сложение, и двумя другими,
обозначающими операнды. Сумма, представляющая простое выражение, при¬
сваивается первому аргументу и таким образом замещает его (х := х+у), отражая
двухадресную машинную команду компьютера (ADDW у, х).
Под выбором кода мы понимаем определение кодов операций, кодов длин опе¬
рандов и способов адресации. Генерация машинного кода возлагается на модуль
ОСС. Например, машинная команда ADDW у, х выбирается в процедуре ОСЕ.Ор,
которая вызывает генерирующую процедуру C)CC.PutF4(0+1, х, у), где 0 - это код
операции для ADDi, 1 - код длины для целых чисел, а х и у - параметры типа Item,
описывающие операнды. Ор могла бы, например, выбрать другую команду, будь
у не переменной, а короткой константой, скажем 3; ее выбором стала бы коман¬
да ADDQW 3, х. Тогда генерация машинного кода достигалась бы вызовом ОСС.
PutF2 (12+1, y.aO, х), где 12 - это код операции ADDQi, а у.аО имеет значение 3.
Давайте еще немного задержимся на приведенном примере. Как объяснялось
прежде, во время вычисления выражения ни одна объявленная переменная не
может менять своего значения. Следовательно, сумма не может быть сохранена
по адресу переменной х. Чтобы воспрепятствовать этому операнд-приемник дол¬
жен быть временной, вспомогательной переменной, размещенной в регистре. По¬
скольку первый аргумент и результат совпадают в двухадресной команде, перед
сложением аргумент должен быть перенесен в регистр. Следовательно, получаю¬
щаяся последовательность кодов такова:
MOVW X, г
ADDW у, г
где г представляет упомянутый регистр. Выделение регистров выполняется про¬
цедурой OCC.GetReg, которая выбирает свободный регистр и возвращает Item.
с mode = Reg, являющийся одним из промежуточных видов, генерируемых только
при вычислении выражений.
Если операнды выражения - целочисленные константы, то заданная операция
выполняется компилятором, результат представляется элементом-результатом и
никаких команд не генерируется. Это касается всех арифметических операций
в процедуре Ор и смены знака в процедуре МОр.
Примечание: проверки переполнения не включены в текст программы, а прос¬
то заменены комментарием. Они могут быть запрограммированы в машинно неза¬
висимом виде, как показано на примере сложения:
IF х < О THEN
IF (у < 0) & (х < min-y) THEN переполнение ELSE sum := х+у END
Выбор кода
ELSE
IF (у > 0) & (x > max-у) THEN переполнение ELSE sum := x+y END
END
Непосредственное вычисление выражений осуществляется также для ло¬
гического отрицания и для объединения множеств. Последнее неявно входит
в конструкцию множеств. Например, множество-константа {0, 2} вычисляется как
{0} + {2}. Констатные выражения не вычисляются для вещественных значений.
Одна причина - в том, что этот редкий и преодолимый случай неоправданно
усложняет компилятор, другая - в том, что прерывания по переполнению для опе¬
раций с плавающей точкой нельзя подавить.
Основные процедуры выбора кода для выражений с кратким описанием их
действия приводятся ниже.
Index(x, у)
X
:= х[у]
Field(х, у)
X
:= х. у
DeRef(х)
X
: = х~
TypTest(х, у,
TRUE)
X
:= х IS у
TypTest(х. у,
FALSE)
X
:= х(у)
1п(х, у)
X
: = х IN у
Set0(x, у)
X
:= (У)
Set1(х, у, z)
X
:= {у . . z)
М0р(ор, х)
X
:= ор у
0р(ор, х, у)
X
:= х ор у
Некоторые из этих процедур генерируют элементы с промежуточными вида¬
ми, отличными от упомянутого выше вида Reg. Прежде чем объяснить различные
переходы между видами элементов, которым они могут подвергаться, приведем
дополнительные виды элементов с формулами расчета исполнительного адреса
операнда по атрибутам аО, al и а2 из записи об элементе.
Вид
Получаемый адрес
Режим адресации
Var
aO
Прямой режим
VarX
aO + s*Reg [a2]
Индексированный режим
Ind
MemjaO] + al
Косвенный режим
IndX
IndX [aO] + al + s*Reg [a2J
Индексированный косвенный режим
Regl
Reg[a0] + al
Регистровый косвенный режим
RegX
Reg[a0] + al + s*Reg [a2]
Индексированный регистровый
косвенный режим
5 обозначает масштабный коэффициент, соответствующий типу операндов
(s = 1, 2, 4 или 8).
Цель хорошего компилятора - использовать все режимы адресации, предла¬
гаемые компьютером, избегая тем самым выдачи лишних команд для адресных
вычислений. Для этого требуется обнаружить возможность применения сложных
режимов адресации и не выдавать команды для вычисления адреса до тех пор,
пока не установлено, что к адресу не может быть применен ни один из доступных
410 I
Компилятор
Процедура Index выдает также проверку границ индекса (CHECKW, FLAG),
если для компилятора установлена опция проверки индексов. Если индекс у -
константа, то вычисляется адрес индексной переменной и никакого перехода вида
не происходит.
Динамические массивы как параметры обрабатываются так же. Косвенная
адресация через дескриптор необходима, даже если массив передается по значе¬
нию. Проверки границ индексов не могут выполняться компилятором, даже если
индекс - константа.
2. Index(x, у), х - динамический массив
Переход вида х
Выдаваемая
команда
Конструкция
Var —»IndX
Динамический массив
Ind -» IndX
Динамический массив, VAR-иараметр
Regl -> RegX
Разыменованный массив
IndX -> IndX
INDEX
Индексированный массив VAR-параметр
RegX -> RegX
INDEX
Разыменованный массив (матрица)
3. Field (x, y)
Переход вида x
Выдаваемая
команда
Конструкция
Var —> Var
Прибавить смещение поля к адресу записи
Ind -» Ind
Прибавить смещение поля к адресу записи
Regl -> Regl
Увеличить смещения поля
иные —> Regl
ADDR
Смещение становится смещением поля
4. DeRef (x)
Переход вида x
Выдаваемая
команда
Конструкция
Var —»Ind
Обращение по указателю
иные —> Regl
ADDR
offset := 0
Процедура DeRef вызывается из Compiler.selector. Вызов происходит по явной
операции разыменования (Л) или по указателям поля/?./или массиваp[i], где
р - указатель. Отметим, что переход Var —> Ind неприменим в случае внешне-
режимов адресации. Процедуры Index, Field и DeRef содержат необходимый ана¬
лиз вариантов. Осуществляемые переходы между видами приведены ниже.
1. Index(x, у), х - статический массив
Выбор кода
Г4П
Переход вида х
Выдаваемая
команда
Конструкция
Var —»VarX
Переменная-массив
Ind -»IndX
Массив, VAR-параметр
Regl -> RegX
Разыменованный массив
VarX -> VarX
INDEX
Индексированный массив (матрица)
IndX —> IndX
INDEX
Индексированный матричный параметр
RegX —> RegX
INDEX
Разыменованный массив (матрица)
го обращения, потому что процессору недостает косвенного внешнего режима
адресации.
Логические выражения, в частности сравнения, требуют еще одного проме¬
жуточного вида элемента - кода условия Сое. Этот вид означает, что значение
операнда хранится в регистре кода условия в закодированном виде. Для примера
рассмотрим выражение х < г/, которое транслируется в единственную команду
CMPi у, х. Получающийся логический элемент предполагает вид Сое, а его атри¬
бут аО указывает на то, что значение FALSE получается по команде Scond (или
Bcond) с аО в качестве его маски условия. Атрибут аО зависит от заданного отно¬
шения (<).
Случаи логической конъюнкции и дизъюнкции - более сложные. Как упоми¬
налось ранее, эти операции должны представляться условными переходами, а не
явными командами AND и OR.
Например, выражение
(х <= у) & (у <z)
приводит к последовательности машинных команд
CMPi у, х
L BLT ?
CMPi z, у
и элементу результата с видом Сое и аО, отражающим отношение <. В дополнение
к атрибуту аО атрибут а1 задает адрес L машинной команды BLT, которая выпол¬
няет переход, если у < х, то есть ~ (х <= у). Первые две команды выдаются про¬
цедурой МОр, вызываемой из Compiler. Тегтп, а последняя - процедурой Ор (также
вызываемой из Term).
Точно так же выражение
(х = 1) OR (у = 3)
приводит к последовательности машинных команд
CMPQi 1, х
L BEQ ?
CMPQi 3, у
и элементу результата с видом Сое и аО, отражающим отношение =. Адрес пере¬
хода L задается атрибутом а2 (вместо а1)у потому что переход выполняется, когда
первое сравнение приводит к TRUE (вместо FALSE).
Более общие случаи выражений;? & q Sc... & 2 ир OR q OR ... OR z приводят
к цепочке условных переходов, которые выполняются, если значение выражения
равно FALSE или TRUE соответственно. Адреса этих переходов заносятся в так
называемые F-список или Т-список соответственно; их начала сохраняются в атри-
412
Компилятор
бутах а 1 (или а2), а связи вносятся в код на место адресов перехода, которые будут
вставлены, когда адреса переходов будут известны.
В самом общем случае нужны и F-список, и Т-список одновременно. Это ил¬
люстрируется следующим выражением:
(а < Ь) & (с < d) OR (е < f) & (г < h)
которое представляется командами
CMPi b, а
BLE L1
CMPi d, с
LO BGT ?
L1 CMPi f, e
L2 BLE ?
CMPi h, г
F-список получающегося элемента содержит единственный элемент L2,
а Т-список - единственный элемент L0. За подробностями отсылаем читателя
к тексту модуля ОСЕ ниже; конструкция списков и замещение связей смещения¬
ми переходов обрабатываются процедурами модуля ОСС. Попутно отметим, что
логические выражения появляются также в операторах IF, WHILE pi REPEAT, где
адрес перехода становится известным только после обработки всего оператора.
Довольно значительный объем программы занимает, казалось бы, безобидное
включение типов. Это понятие - ослабление строгого требования равенства типов
операндов в выражении. Тем не менее, поскольку команды компьютера требуют,
чтобы оба операнда имели строго один и тот же тип, в случае «смешанных выра¬
жений» им должны предшествовать команды преобразования типа. Воздержимся
от подробностей и скажем только, что неявные преобразования целых чисел вы¬
полняются командами MOVXij, предполагающими размножение знакового разря¬
да, а преобразования, включающие операнды с плавающей точкой, - командами
MOVif и MOVfl
Еще большая часть модуля ОСЕ посвящена стандартным процедурам и функ¬
циям. Их вызовы генерируют не команды вызова подпрограмм, а прямой код. По¬
этому каждая стандартная процедура представляет собой особый случай, и у них
мало общего. Некоторые процедуры, а именно SIZE, ADR, MIN, MAX, CHR, SHORT,
LEN, CC и VAL, могут вообще не генерировать команд. Каждая из трех процедур
StParl, StPar2 и StPar3 служит для обработки одного параметра. Обычно команды
выдаются после того, как распознан последний параметр.
MODULE ОСЕ; (*NW 7.6.87 / 5.3.91*)
IMPORT ОСС, OCS, ОСТ, SYSTEM;
CONST (*префиксы форматов команд*)
F6 = 4ЕН; F7 = ОСЕЙ; F9 = ЗЕН; F11 = ОВЕН;
(♦распространенные коды операций: 5С, 5D, 5F = MOVQi, 14, 15, 17 = MOVi,
Выбор кода
[413
Компилятор
27 = ADDR*)
(*виды объектов и элементов*)
Var = 1; VarX = 2; Ind = 3; IndX = 4; Regl = 5;
RegX = 6; Abs = 7; Con = 8; Stk = 9; Coc = 10;
Reg = 11; Fid = 12; Typ = 13;
Оформы структур*)
Undef =-0; Byte = 1; Bool = 2; Char = 3; Sint = 4; Int = 5; Lint = 6;
Real = 7; LReal = 8; Set = 9; String = 10; NilTyp = 11; NoTyp = 12;
Pointer = 13; ProcTyp = 14; Array = 15; DynArr = 16; Record = 17;
VAR inxchk*: BOOLEAN;
log: INTEGER; (*побочный эффект процедуры mant*)
lengcode: ARRAY 18 OF INTEGER;
intSet, realSet: SET;
PROCEDURE inverted (x: LONGINT): LONGINT;
BEGIN (*обращение кода условия*)
IF ODD(x) THEN RETURN x - 1 ELSE RETURN x + 1 END
END inverted;
PROCEDURE load (VAR x: OCT.Item);
VAR y: OCT.Item;
BEGIN
IF x.mode < Reg THEN
у := x; OCC.GetReg(x);
IF (y.mode = Con) & (- 8 <= y.aO) & (y.aO <= 7) THEN
OCC.PutF2(lengcode[x.typ. form] + 5CH, y.aO, x)
ELSE OCC.PutF4(lengcode[x.typ.form] + 14H, x, y)
END
ELSIF x.mode > Reg THEN OCS.Mark(126)
END
END load;
PROCEDURE loadX (VAR x: OCT.Item);
VAR y: OCT.Item;
BEGIN
IF x.mode <= Reg THEN
у := x; OCC.GetReg(x);
IF (y.mode = Con) & (- 8 <= y.aO) & (y.aO <=
OCC.PutF2(5FH, y.aO, x) /*M0VXiD*)
ELSE 0CC.Put(F7, lengcode[x.typ.form] + ЮН, x, y)
END
ELSIF x.mode > Reg THEN OCS.Mark(126)
END
END loadX;
PROCEDURE loadF (VAR x: OCT.Item);
VAR y: OCT.Item;
BEGIN
IF x.mode < Reg THEN
414
у := х; ОСС.GetFReg(х); ОСС.Put(F11, lengcode[x.typ.form] + 4, x, у)
(*MOVf*)
ELSIF x.mode > Reg THEN OCS.Mark(126)
END
END loadF;
PROCEDURE loadB (VAR x: OCT.Item); (*вид Coc*)
VAR LO, L1: LONGINT;
BEGIN
IF (x.al = 0) & (x.a2 = 0) THEN
LO := x.aO; OCC.GetReg(x); OCC.PutF2(3CH, LO, x)
ELSE OCC.PutFO(inverted(x.aO)); OCC.PutWord(x.a2); LO := OCC.pc - 2;
OCC.FixLink(x.al); OCC.GetReg(x); OCC.PutF2(5CH, 1, x);
OCC.PutFO(14); L1 := OCC.pc; OCC.PutWord(O);
OCC.FixLink(LO); OCC.PutF2(5CH, 0, x); OCC.fixup(L1)
END
END loadB;
PROCEDURE loadAdr (VAR x; OCT.Item);
VAR y: OCT.Item;
BEGIN
IF x.mode < Con THEN
у := x; OCC.GetReg(x);
IF (y.mode = Ind) & (y.al = 0) THEN y.mode := Var; OCC.PutF4(17H, x, y)
ELSE OCC.PutF4(27H, x, y); x.al := 0
END;
x.mode := Regl; x.obj := NIL
ELSE OCS.Mark(127)
END
END loadAdr;
PROCEDURE setCC (VAR x; OCT.Item; cc: LONGINT);
BEGIN
x.typ := OCT.booltyp; x.mode := Coc; x.aO := cc; x.al := 0; x.a2 := 0
END setCC;
PROCEDURE cmp (L: INTEGER; VAR x, y: OCT.Item);
BEGIN
IF (y.mode = Con) & (y.aO <= 7) & (y.aO >= - 8) THEN
OCC.PutF2(L + 1CH, y.aO, x) (*CMPQi*)
ELSE OCC.PutF4(L + 4, x, y) (*CMPi*)
END
END cmp;
PROCEDURE add (L: INTEGER; VAR x, y: OCT.Item);
BEGIN
IF (y.mode = Con) & (y.aO <= 7) & (y.aO >= - 8) THEN
OCC.PutF2(L + OCH, y.aO, x) (*ADDQi*)
ELSE OCC.PutF4(L, x, y) (*ADDi*)
ЁШ
Выбор кода
416
Компилятор
END
END add;
PROCEDURE sub (L; INTEGER; VAR x, y; OCT.Item);
BEGIN
IF (y.mode = Con) & (y.aO <= 8) & (y.aO >= - 7) THEN
OCC.PutF2(L + OCH, - y.aO, x) (*ADDQi*)
ELSE OCC.PutF4(L + 20H, x, y) (*SUBi*)
END
END sub;
PROCEDURE mant (x: LONGINT): LONGINT; (*x DIV 2"log*)
BEGIN log := 0;
IF x > 0 THEN
WHILE 'ODD(x) DO x := x DIV 2; INC(log) END
END;
RETURN x
END mant;
PROCEDURE SetlntType* (VAR x: OCT.Item);
VAR v: LONGINT;
BEGIN v := x.aO;
IF (- 80H <= v) & (v <= 7FH) THEN x.typ := OCT.sinttyp
ELSIF (- 8000H <= v) & (v <= 7FFFH) THEN x.typ := OCT.inttyp
ELSE x.typ := OCT.linttyp
END
END SetlntType;
PROCEDURE AssReal* (VAR x: OCT.Item; y: REAL);
BEGIN SYSTEM.PUT(SYSTEM.ADR(x.aO), y)
END AssReal;
PROCEDURE AssLReal* (VAR x: OCT.Item; y: LONGREAL);
BEGIN SYSTEM.PUT(SYSTEM.ADR(x.aO), y)
END AssLReal;
PROCEDURE Index* (VAR x, y: OCT.Item);
VAR f, n: INTEGER; i: LONGINT;
eltyp: OCT.Struct; y1, z: OCT.Item;
BEGIN f := y.typ.form;
IF ~(f IN intSet) THEN OCS.Mark(80); y.typ := OCT.inttyp END;
IF x.typ = NIL THEN HALT(80) END;
IF x.typ.form = Array THEN
eltyp := x. typ. BaseTyp; n := x.typ.n;
IF eltyp = NIL THEN HALT(81) END;
IF y.mode = Con THEN
IF (0 <= y.aO) & (y.aO < n) THEN i := y.aO * eltyp.size
ELSE OCS.Mark(81); i := 0
END;
IF x.mode = Var THEN INC(x.aO, i)
ELSIF (x.mode = Ind) OR (x.mode = Regl) THEN INC(x.a1, i);
x.obj := NIL
ELSE loadAdr(x); x.al := i
END
ELSE
IF inxchk THEN (*z = дескриптор границ*)
z.mode := Var; z.aO := x.typ.adr; z.lev := - x.typ.mno;
IF y.mode = Reg THEN yl := у ELSE OCC.GetReg(y1) END;
IF f = Sint THEN OCC. Put(F7, ЮН, y1, у); у := y1 END;
(*MOVXBW*)
OCC.Put(OEEH, SHORT(yl.aO) * 8 + 1, y, z); OCC.PutF1(0D2H)
(*CHECK, FLAG*)
ELSE
IF f = Lint THEN load(y) ELSE loadX(y) END;
y1 : = у
END;
f := x.mode;
IF x.mode = Var THEN x.mode := VarX; x.a2 := yl.aO
ELSIF x.mode = Ind THEN x.mode := IndX; x.a2 := yl.aO
ELSIF x.mode = Regl THEN x.mode := RegX; x.a2 := yl.aO
ELSIF x.mode IN {VarX, IndX, RegX} THEN
z.mode := Con; z.typ := OCT.inttyp;
z.aO := (x.typ.size DIV eltyp.size) - 1;
OCC.Put(2EH, SH0RT(x.a2) *8+5, y1, z) (*INDEX*)
ELSE loadAdr(x); x.mode := RegX; x.al := 0; x.a2 := yl.aO
END
END;
x.typ := eltyp
ELSIF x.typ.form = DynArr THEN
IF inxchk THEN
z.mode := Var; z.aO := x.aO + x.typ.adr; z.lev := x.lev;
IF y.mode = Reg THEN y1 := у ELSE OCC.GetReg(y1) END;
IF f = Sint THEN
IF y.mode = Con THEN y.typ := OCT.inttyp
ELSE OCC. Put(F7, ЮН, y1, у); у := y1
END
END;
OCC.Put(OEEH, SHORT(yl.aO) * 8 + 1, y, z); OCC.PutF1(0D2H)
(*CHECK, FLAG*)
ELSE
IF f = Lint THEN load(y) ELSE loadX(y) END;
y1 := У
END;
IF x.mode IN {Var, Ind} THEN x.mode := IndX; x.a2 := yl.aO
ELSIF x.mode = Regl THEN x.mode := RegX; x.a2 := yl.aO
ELSIF x.mode IN {IndX, RegX} THEN
z.mode := Var; z.aO := x.aO + x.typ.adr; z.lev := x.lev;
OCC.Put(2EH, SH0RT(x.a2) *8+5, y1, z) (*INDEX*)
Выбор кода
шш
ELSE loadAdr(x); x.mode := RegX; x.al := 0; x.a2 := yl.aO
END;
x.typ := x.typ.BaseTyp
ELSE OCS.Mark(82)
END
END Index;
PROCEDURE Field* (VAR x: OCT.Item; y: OCT.Object);
BEGIN (*x.typ.form = Record*)
IF (y # NIL) & (y.mode = Fid) THEN
IF x.mode = Var THEN INC(x.aO, y.aO)
ELSIF (x.mode = Ind) OR (x.mode = Regl) THEN INC(x.a1, y.aO)
ELSE loadAdr(x); x.mode := Regl; x.al := y.aO
END;
x.typ := y.typ; x.obj := NIL
ELSE OCS.Mark(83); x.typ := OCT.undftyp; x.mode := Var
END
END Field;
PROCEDURE DeRef* (VAR x: OCT.Item);
BEGIN
IF x.typ.form = Pointer THEN
IF (x.mode = Var) & (x.lev >= 0) THEN x.mode := Ind
ELSE load(x); x.mode := Regl
END;
x.typ := x. typ. BaseTyp; x.obj := OCC.wasderef
ELSE OCS.Mark(84)
END;
x.al := 0
END DeRef;
PROCEDURE TypTest* (VAR x, y: OCT.Item; test: BOOLEAN);
PROCEDURE GTT (tO, t1: OCT.Struct; varpar: BOOLEAN);
VAR t: OCT.Struct; xt, tdes, p: OCT.Item;
BEGIN
IF tO # t1 THEN t := t1;
REPEAT t := t.BaseTyp UNTIL (t = NIL) OR (t = tO);
IF t # NIL THEN x.typ := y.typ;
IF OCC.typchk OR test THEN xt := x;
IF varpar THEN xt.mode := Ind; xt.aO := x.aO + 4
ELSIF (x.mode = Var) & (x.lev >= 0) THEN
xt.mode := Ind; xt.al := - 4; load(xt);
xt.mode := Regl
ELSE load(xt); p := xt; p.mode := Regl; p.al := - 4;
OCC.PutF4(17H, xt, p); (*MOVD -4(xt), xt *)
xt.mode := Regl
END;
xt.al := tl.n * 4; tdes.mode := Var;
tdes.lev := - tl.mno; tdes.aO := tl.adr;
Компилятор
Г4Т8
OCC.PutF4(7, tdes, xt); (*CMPD*)
IF "test THEN
OCC.PutFO(O); OCC.PutDisp(4); OCC.PutF1(0F2H);
OCC.PutByte(18)
ELSE setCC(x, 0)
END
END
ELSE 0CS.Mark(85);
IF test THEN x.typ := OCT.booltyp END
END
ELSIF test THEN setCC(x, 14)
END
END GTT;
BEGIN
IF x.typ.form = Pointer THEN
IF y.typ.form = Pointer THEN
GTT(x.typ.BaseTyp, y.typ.BaseTyp, FALSE)
ELSE OCS.Mark(86)
END
ELSIF (x.typ.form = Record) & (x.mode = Ind) & (x.obj tt NIL) &
(x.obj tt OCC.wasderef) & (y.typ.form = Record) THEN
GTT(x.typ, y.typ, TRUE)
ELSE OCS.Mark(87)
END
END TypTest;
PROCEDURE In* (VAR x, y: OCT.Item);
VAR f: INTEGER;
BEGIN f := x.typ.form;
IF (f IN intSet) & (y.typ.form = Set) THEN
IF y.mode = Con THEN load(y) END;
OCC.PutF4(lengcode[f] + 34H, y, x); setCC(x, 8) (*TBITi*)
ELSE OCS.Mark(92); x.mode := Reg
END;
x.typ := OCT.booltyp
END In;
PROCEDURE SetO* (VAR x, y: OCT.Item);
VAR one: LONGINT;
BEGIN x.mode := Reg; x.aO := 0; x.typ := OCT.settyp;
IF y.typ.form IN intSet THEN
IF y.mode = Con THEN x.mode := Con;
IF (0 <= y.aO) & (y.aO < 32) THEN one := 1;
x.aO := SYSTEM.LSH(one, y.aO)
ELSE OCS.Mark(202)
END
ELSE OCC.GetReg(x); OCC.PutF2(5FH, 1, x); 0CC.Put(F6, 17H, x, y) (* LSHD*)
END
Выбор кода
ты
ELSE OCS.Mark(93)
END
END SetO;
PROCEDURE Set1* (VAR x, y, z: OCT.Item);
VAR s: LONGINT;
BEGIN x.mode := Reg; x.aO := 0; x.typ := OCT.settyp;
IF (y.typ.form IN intSet) & (z.typ.form IN intSet) THEN
IF y.mode = Con THEN
IF (0 <= y.aO) & (y.aO < 32) THEN
y.typ := OCT.settyp; s := - 1; y.aO := SYSTEM.LSH(s, y.aO);
IF z.mode = Con THEN
x.mode := Con;
IF (y.aO <= z.aO) & (z.aO < 32) THEN s := - 2;
x.aO := y.aO - SYSTEM.LSH(s, z.aO)
ELSE OCS.Mark(202); x.aO := 0
END
ELSIF y.aO = - 1 THEN
OCC.GetReg(x); OCC.PutF2(5FH, - 2, x);
OCC.Put(F6, 17H, x, z);
OCC.Put(F6, 37H, x, x) (* LSHD, COMD*)
ELSE OCC.GetReg(x); OCC.PutF4(17H, x, y); OCC.GetReg(y);
OCC.PutF2(5FH, - 2, y); 0CC.Put(F6, 17H, y, z);
OCC.PutF4(OBH, x, y)
END
ELSE OCS.Mark(202)
END
ELSE OCC.GetReg(x); OCC.PutF2(5FH, - 1, x); OCC.Put(F6, 17H, x, y);
IF z.mode = Con THEN
IF (0 <= z.aO) & (z.aO < 32) THEN
y.typ := OCT.settyp; y.mode := Con; s := - 2;
y.aO := SYSTEM.LSH(s, z.aO)
ELSE OCS.Mark(202)
END
ELSE OCC.GetReg(y); OCC.PutF2(5FH, - 2, y);
OCC.Put(F6, 17H, y, z) (* LSHD*)
END;
OCC.PutF4(OBH, x, y) (*BICD*)
END
ELSE OCS.Mark(93)
END
END Set1;
PROCEDURE MOp* (op: INTEGER; VAR x: OCT.Item);
VAR f, L: INTEGER; a: LONGINT; y: OCT.Item;
BEGIN f := x.typ.form;
CASE op OF
5: (*&*)
IF x.mode = Coc THEN
| 420 I
Компилятор
OCC.PutFO(inverted(x.aO)); ОСС.PutWord(x.a2);
х.а2 := OCC.pc - 2; ОСС.FixLink(x.а1)
ELSIF (x.typ.form = Bool) & (x.mode # Con) THEN
OCC.PutF2(1CH, 1, x); setCC(x, 0);
OCC.PutF0(1); OCC.PutWord(x.a2); x.a2 := OCC.pc - 2;
OCC.FixLink(x.a1)
ELSIF x.typ.form # Bool THEN
0CS.Mark(94); x.mode := Con; x.typ := OCT.booltyp; x.aO := 0
END
| 6: (*+*)
IF ~(f IN intSet + realSet) THEN 0CS.Mark(96) END
I 7: (*-*)
у := x; L := lengcode[f];
IF f IN intSet THEN
IF x.mode = Con THEN x.aO := - x.aO; SetlntType(x)
ELSE OCC.GetReg(x); 0CC.Put(F6, L + 20H, x, y) (*NEGi*)
END
ELSIF f IN realSet THEN
OCC.GetFReg(x); 0CC.Put(F11, L + 14H, x, y) (*NEGf*)
ELSIF f = Set THEN OCC.GetReg(x); 0CC.Put(F6, 37H, x, y) (*C0MD*)
ELSE OCS.Mark(97)
END
| 8: (*0R*)
IF x.mode = Coc THEN
OCC.PutF0(x.aO); OCC.PutWord(x.a1); x.al := OCC.pc - 2;
OCC.FixLink(x.a2)
ELSIF (x.typ.form = Bool) & (x.mode # Con) THEN
OCC.PutF2(1CH, 1, x); setCC(x, 0);
OCC.PutFO(O); OCC.PutWord(x.al); x.al := OCC.pc - 2;
OCC.FixLink(x.a2)
ELSIF x.typ.form # Bool THEN
OCS.Mark(95); x.mode := Con; x.typ := OCT.booltyp; x.aO := 1
END
| 9 .. 14: (^сравнения*)
IF x.mode = Coc THEN loadB(x) END
I 32: (*~*)
IF x.typ.form = Bool THEN
IF x.mode = Coc THEN x.aO := inverted(x.aO);
a := x.al; x.al := x.a2; x.a2 := a
ELSE OCC.PutF2(1CH, 0, x); setCC(x, 0)
END
ELSE 0CS.Mark(98)
END
END
END MOp;
PROCEDURE convertl (VAR x: OCT.Item; typ: OCT.Struct);
VAR y: OCT.Item; op: INTEGER;
BEGIN
Выбор кода
421
422
Компилятор
IF x.mode # Con THEN
У := x;
IF typ.form = Int THEN op := 10H
ELSE op := lengcode[x.typ.form] + 1CH
END;
IF x.mode < Reg THEN OCC.GetReg(x) END;
OCC.Put(F7, op, x, y) (*M0Vij *)
END;
x.typ := typ
END convert"!;
PROCEDURE convert2 (VAR x: OCT.Item; typ: OCT.Struct);
VAR y: OCT.Item;
BEGIN у := x; OCC.GetFReg(x); (*M0Vif*)
OCC.Put(F9, lengcode[typ.form] * 4 + lengcode[x. typ.form], x, у); x.typ := typ
END convert2;
PROCEDURE convert3 (VAR x: OCT.Item);
VAR у: OCT.Item;
BEGIN у := x;
IF x.mode < Reg THEN OCC.GetFReg(x) END;
OCC.Put(F9, 1BH, x, y); x.typ :=OCT.lrltyp (*M0VFL*)
END convert3;
PROCEDURE Op* (op: INTEGER; VAR x, y: OCT.Item);
VAR f, g, L: INTEGER; p, q, r: OCT.Struct;
PROCEDURE strings (): BOOLEAN;
BEGIN RETURN
((((f = Array) OR (f = DynArr)) & (x. typ. BaseTyp.form = Char)) OR
(f = String)) &
((((g = Array) OR (g = DynArr)) & (y. typ. BaseTyp.form = Char)) OR
(g = String))
END strings
PROCEDURE CompStrings (cc: INTEGER; Q: BOOLEAN);
VAR z: OCT.Item;
BEGIN z.mode := Reg; z.aO := 2;
IF f = DynArr THEN OCC.DynArrAdr(z, x)
ELSE OCC.PutF4(27H, z, x)
END;
z.aO := 1;
IF g = DynArr THEN OCC. DynArrAdr(z, y)
ELSE OCC.PutF4(27H, z, y)
END;
z.aO := 0; OCC.PutF2(5FH, - 1, z); («MOVQD -1, RO*)
z.aO := 4; OCC.PutF2(5FH, 0, z); (*M0VQD 0, R4*)
OCC.PutFI(14); OCC.PutFI(4); OCC.PutFI(6); (*CMPSB 6*)
IF Q THEN (*сравнить также с нулевым байтом*)
ОСС. PutF0(9); ОСС.PutDisp(5); (*BFC*)
z.mode := Regl; z.aO := 2; z.al := 0; OCC.PutF2(1CH, 0, z) (*CMPQB*)
END;
setCC(x, oc)
END CompStrings
PROCEDURE CompBool (cc: INTEGER);
BEGIN
IF y.mode = Coc THEN loadB(y) END;
OCC.PutF4(4, x, y); setCC(x, cc)
END CompBool;
BEGIN
IF x.typ # y.typ THEN
g := y.typ.form;
CASE x.typ.form OF
Undef:
| Sint: IF g = Int THEN convert1(x, y.typ)
ELSIF g = Lint THEN convert1(x, y.typ)
ELSIF g = Real THEN convert2(x, y.typ)
ELSIF g = LReal THEN convert2(x, y.typ)
ELSE OCS.Mark(IOO)
END
| Int: IF g = Sint THEN convert1(y, x.typ)
ELSIF g = Lint THEN convert1(x, y.typ)
ELSIF g = Real THEN convert2(x, y.typ)
ELSIF g = LReal THEN convert2(x, y.typ)
ELSE OCS.Mark(100)
END
| Lint: IF g = Sint THEN convert1(y, x.typ)
ELSIF g = Int THEN convert1(y, x.typ)
ELSIF g = Real THEN convert2(x, y.typ)
ELSIF g = LReal THEN convert2(x, y.typ)
ELSE OCS.Mark(100)
END
| Real: IF g = Sint THEN convert2(y, x.typ)
ELSIF g = Int THEN convert2(y, x.typ)
ELSIF g = Lint THEN convert2(y, x.typ)
ELSIF g = LReal THEN convert3(x)
ELSE OCS.Mark(IOO)
END
| LReal: IF g = Sint THEN convert2(y, x.typ)
ELSIF g = Int THEN convert2(y, x.typ)
ELSIF g = Lint THEN convert2(y, x.typ)
ELSIF g = Real THEN convert3(y)
ELSE OCS.Mark(100)
END
| NilTyp: IF g # Pointer THEN OCS.Mark(100) END
| Pointer: IF g = Pointer THEN
p := x.typ.BaseTyp; q := y.typ.BaseTyp;
Выбор кода
wm
IF (p.form = Record) & (q.form = Record) THEN
IF p.n < q.n THEN r := p; p := q; q := r END;
WHILE (p tt q) & (p tt NIL) DO p := p. BaseTyp END;
IF p = NIL THEN OCS.Mark(IOO) END
ELSE OCS.Mark(100)
END
ELSIF g # NilTyp THEN OCS.Mark(100)
END
| ProcTyp: IF g # NilTyp THEN OCS.Mark(100) END
| Array, DynArr, String:
| Byte, Bool, Char, Set, NoTyp, Record: OCS.Mark(100)
END
END;
f := x.typ.form; g := y.typ.form; L := lengcode[f];
CASE op OF
1: IF f IN intSet THEN (***)
IF (x.mode = Con) & (y.mode = Con) THEN (*проверка переполнения
опущена*)
x.aO := x.aO * y.aO; SetlntType(x)
ELSIF (x.mode = Con) & (mant(x.aO) = 1) THEN
x.aO := log; x.typ := OCT.sinttyp;
load(y); 0CC.Put(F6, L + 4, y, x); (*ASHi*) x := у
ELSIF (y.mode = Con) & (mant(y.aO) = 1) THEN
y.aO := log; y.typ := OCT.sinttyp;
load(x); 0CC.Put(F6, L + 4, x, y) (*ASHi*)
ELSE load(x); 0CC.Put(F7, L + 20H, x, y) (*MULi*)
END
ELSIF f IN realSet THEN
loadF(x); OCC.Put(F11, ЗОН + L, x, y) (*MULf*)
ELSIF f = Set THEN
load(x); OCC.PutF4(2BH, x, y) (*ANDD*)
ELSIF f # Undef THEN OCS.Mark(101)
END
| 2: IF f IN realSet THEN (*/*)
loadF(x); OCC.Put(F11, 20H + L, x, y) (*DIVf*)
ELSIF f IN intSet THEN
convert2(x, OCT.realtyp); convert2(y, OCT.realtyp);
OCC.Put(F11, 21H, x, y) (*DIVF*)
ELSIF f = Set THEN
load(x); OCC.PutF4(3BH, x, y) (*XORD*)
ELSIF f # Undef THEN OCS.Mark(102)
END
| 3: IF f IN intSet THEN (*DIV*)
IF (x.mode = Con) & (y.mode = Con) THEN
IF y.aO # 0 THEN x.aO := x.aO DIV y.aO; SetlntType(x)
ELSE OCS.Mark(205)
END
ELSIF (y.mode = Con) & (mant(y.aO) = 1) THEN
y.aO := - log; y.typ := OCT.sinttyp;
424|
Компилятор
Выбор кода
load(х); ОСС.Put(F6, L + 4, х, у) (*ASHi*)
ELSE load(x); ОСС.Put(F7, L + ЗСН, x, у) (*DIVi*)
END
ELSIF f # Undef THEN OCS.Mark(103)
END
| 4: IF f IN intSet THEN (*M0D*)
IF (x.mode = Con) & (y.mode = Con) THEN
IF y.aO # 0 THEN x.aO := x.aO MOD y.aO; x.typ := y.typ
ELSE OCS.Mark(205)
END
ELSIF (y.mode = Con) & (mant(y.aO) = 1) THEN
y.aO := ASH( - 1, log); load(x); 0CC.PutF4(L + 8, x, y) (*BICi*)
ELSE load(x); 0CC.Put(F7, L + 38H, x, y) (*MODi*)
END
ELSIF f # Undef THEN OCS.Mark(104)
END
| 5: IF y.mode # Coc THEN (*&*)
IF y.mode = Con THEN
IF y.aO = 1 THEN setCC(y, 14) ELSE setCC(y, 15) END
ELSIF y.mode <= Reg THEN OCC.PutF2(1CH, 1, y); setCC(y, 0)
ELSE OCS.Mark(94); setCC(y, 0)
END
END;
IF x.mode = Con THEN
IF x.aO = 0 THEN OCC.FixLink(y.a1); OCC.FixLink(y.a2);
setCC(y, 15) END;
setCC(x, 0)
END;
IF y.a2 # 0 THEN x.a2 := OCC.MergedLinks(x.a2, y.a2) END;
x.aO ;= y.aO; x.al := y.al
| 6: IF f IN intSet THEN (*+*)
IF (x.mode = Con) & (y.mode = Con) THEN
INC(x.aO, y.aO); SetlntType(x) (^проверка переполнения опущена*)
ELSE load(x); add(L, x, y)
END
ELSIF f IN realSet THEN
loadF(x); OCC.Put(F11, L, x, y) (*ADDf*)
ELSIF f = Set THEN
IF (x.mode = Con) & (y.mode = Con) THEN x.aO := SYSTEM.VAL
(LONGINT, SYSTEM.VAL(SET, x.aO) + SYSTEM.VAL(SET, y.aO))
ELSE load(x); OCC.PutF4(1BH, x, y) (*ORD*)
END
ELSIF f # Undef THEN OCS.Mark(105)
END
| 7: IF f IN intSet THEN (*-*)
IF (x.mode = Con) & (y.mode = Con) THEN
DEC(x.aO, y.aO); SetlntType(x) ^проверка переполнения опущена*)
ELSE load(x); sub(L, x, y)
END
\ш
426
Компилятор
ELSIF f IN realSet THEN
loadF(x); OCC.Put(F11, 10H + L, x, y) (*SUBf*)
ELSIF f = Set THEN load(x); OCC.PutF4(0BH, x, y) (*BICD*)
ELSIF f ft Undef THEN OCS. Mark(106)
END
| 8: IF y.mode it Coc THEN (*0R*)
IF y.mode = Con THEN
IF y.aO = 1 THEN setCC(y, 14) ELSE setCC(y, 15) END
ELSIF y.mode <= Reg THEN OCC.PutF2(1CH, 1, y); setCC(y, 0)
ELSE OCS.Mark(95); setCC(y, 0)
END
END;
IF x.mode = Con THEN
IF x.aO = 1 THEN OCC.FixLink(y.al); OCC.FixLink(y.a2);
setCC(y, 14) END;
setCC(x, 0)
END;
IF y.al #0 THEN x.al ;= OCC.MergedLinks(x.a1, y.al) END;
x. aO ;= y.aO; x.a2 := y.a2
| 9; IF f IN {Undef, Char..Lint, Set, NilTyp, Pointer, ProcTyp} THEN
cmp(L, x, y); setCC(x, 0)
ELSIF f IN realSet THEN OCC.Put(F11, 8 + L, x, y); setCC(x, 0)
ELSIF f = Bool THEN CompBool(O)
ELSIF strings() THEN CompStrings(0, TRUE)
ELSE OCS.Mark(107)
END
|10: IF f IN {Undef, Char..Lint, Set, NilTyp, Pointer, ProcTyp} THEN
cmp(L, x, y); setCC(x, 1)
ELSIF f IN realSet THEN OCC.Put(F11, 8 + L, x, y); setCC(x, 1)
ELSIF f = Bool THEN CompBool(1)
ELSIF stringsO THEN CompStrings(1, TRUE)
ELSE OCS.Mark(107)
END
|11: IF f IN intSet THEN cmp(L, x, y); setCC(x, 6)
ELSIF f - Char THEN cmp(0, x, y); setCC(x, 4)
ELSIF f IN realSet THEN OCC.Put(F11, 8 + L, x, y); setCC(x, 6)
ELSIF stringsO THEN CompStrings(4, FALSE)
ELSE OCS.Mark(108)
END
|12: IF f IN intSet THEN cmp(L, x, y); setCC(x, 13)
ELSIF f = Char THEN cmp(0, x, y); setCC(x, 11)
ELSIF f IN realSet THEN OCC.Put(F11, 8 + L, x, y); setCC(x, 13)
ELSIF stringsO THEN CompStrings(11, TRUE)
ELSE OCS.Mark(108)
END
|13: IF f IN intSet THEN cmp(L, x, y); setCC(x, 12)
ELSIF f = Char THEN cmp(0, x, y); setCC(x, 10)
ELSIF f IN realSet THEN OCC.Put(F11, 8 + L, x, y); setCC(x, 12)
ELSIF stringsO THEN CompStrings(10, TRUE)
ELSE OCS.Mark(108)
END
114: IF f IN intSet THEN cmp(L, x, y); setCC(x, 7)
ELSIF f = Char THEN cmp(0, x, y); setCC(x, 5)
ELSIF f IN realSet THEN OCC.Put(F11, 8 + L, x, y); setCC(x, 7)
ELSIF stringsO THEN CompStrings(5, FALSE)
ELSE OCS.Mark(108)
END
END
END Op;
PROCEDURE StParl* (VAR x: OCT.Item; fctno: INTEGER);
VAR f, L: INTEGER; s; LONGINT; y: OCT.Item;
BEGIN f ;= x.typ.form;
CASE fctno OF
0; (*HALT*)
IF (f = Sint) & (x.mode = Con) THEN
IF x.aO >= 20 THEN OCC.PutFI(0F2H); OCC.PutByte(x.aO) (*BPT*)
ELSE OCS.Mark(218)
END
ELSE OCS.Mark(217)
END;
x.typ := OCT.notyp
| 1: (*NEW*) y.mode := Reg;
IF f = Pointer THEN
y.aO := 0; OCC.PutF4(27H, y, x);
x.typ := x.typ.BaseTyp; f := x.typ.form;
IF x.typ.size > 7FFF80H THEN OCS.Mark(227)
ELSIF f = Record THEN
y.aO := 1; x.mode := Var; x.lev := - x.typ.mno;
x.aO := x.typ.adr; OCC.PutF4(17H, y, x);
OCC.PutFI(0E2H); OCC.PutByte(O) (*SVC 0*)
ELSIF f = Array THEN
y.aO := 2; x.aO := x.typ.size; x.mode := Con;
x.typ := OCT.linttyp;
OCC.PutF4(17H, y, x); OCC.PutF1(0E2H); OCC.PutByte(1) (*SVC 1*)
ELSE OCS.Mark(lll)
END
ELSE OCS.Mark(111)
END;
x.typ := OCT.notyp
I 2: (*CC*)
IF (f = Sint) & (x.mode = Con) THEN
IF (0 <= x.aO) & (x.aO < 16) THEN setCC(x, x.aO)
ELSE OCS.Mark(219) END
ELSE OCS.Mark(217)
END
I 3: (*ABS*) у ;= x; L := lengcode[f];
IF f IN intSet THEN
Выбор кода
428
OCC.GetReg(x); 0CC.Put(F6, ЗОН + L, x, y) (*ABSi*)
ELSIF f IN realSet THEN
OCC.GetFReg(x); OCC.Put(F11, 34H + L, x, y) (*ABSf*)
ELSE OCS.Mark(111)
END
| 4: (*CAP*) y.mode := Con; y.typ := OCT.chartyp; y.aO := 5FH;
IF f = Char THEN load(x); OCC.PutF4(28H, x, y) (*ANDB*)
ELSE OCS.Mark(lll); x.typ := OCT.chartyp
END
| 5: (*ORD*)
IF (f = Char) OR (f = Byte) THEN (*MOVZBW*)
IF x.mode # Con THEN у ;= x; OCC.GetReg(x); 0CC.Put(F7, 14H, x, y) END
ELSE OCS.Mark(111)
END;
x.typ := OCT.inttyp
| 6: (*ENTIER*)
IF f IN realSet THEN
у := x; OCC.GetReg(x); OCC.Put(F9, lengcode[f] * 4 + 3BH, x, y)
(* FLOORfD*)
ELSE OCS.Mark(111)
END;
x.typ := OCT.linttyp
| 7: (* SIZE *)
IF x.mode = Typ THEN x.aO := x.typ.size
ELSE OCS.Mark(110); x.aO := 1
END;
x.mode := Con; SetlntType(x)
| 8: (*ODD*)
IF f IN intSet THEN
y.mode := Con; y.typ := OCT.sinttyp; y.aO := 0; OCC.PutF4(34H, x, y)
(*TBITB 0*)
ELSE OCS.Mark(111)
END;
setCC(x, 8)
| 9: (*ADR*)
IF f = DynArr THEN у := x; OCC.GetReg(x); OCC.DynArrAdr(x, y)
ELSE loadAdr(x); x.mode := Reg
END;
x.typ := OCT.linttyp
| 10: (*MIN*)
IF x.mode = Typ THEN x.mode := Con;
CASE f OF
Bool, Char: x.aO := 0
| Sint: x.aO := - 80H
| Int: x.aO := - 8000H
| Lint: x.aO := 80000000H
| Real: x.aO := 0FF7FFFFFH
| LReal: x.aO := OFFFFFFFFH; x.al := OFFEFFFFFH
| Set: x.aO := 0; x.typ := OCT.inttyp
Компилятор
I Undef, NilTyp .. Record: OCS.Mark(111)
END
ELSE OCS.Mark(110)
END
| 11: (*MAX*)
IF x.mode = Typ THEN x.mode := Con;
CASE f OF
Bool: x.aO := 1
| Char: x.aO := OFFH
| Sint: x.aO := 7FH
| Int: x.aO := 7FFFH
| Lint: x.aO := 7FFFFFFFH
| Real: x.aO := 7F7FFFFFH
| LReal: x.aO := OFFFFFFFFH; x.al := 7FEFFFFFH
| Set: x.aO := 31; x.typ := OCT.inttyp
| Undef, NilTyp .. Record: OCS.Mark(111)
END
ELSE OCS.Mark(110)
END |
| 12: (*CHR*)
IF ~(f IN {Undef, Byte, Sint, Int, Lint}) THEN OCS.Mark(111) END;
IF(x.mode = VarX) OR (x.mode = IndX) THEN load(x) END;
x.typ := OCT.chartyp
| 13: (*SHORT*)
IF f = Lint THEN (*проверка диапазона опущена*)
IF (x.mode = VarX) OR (x.mode = IndX) THEN load(x)
ELSIF x.mode = Con THEN SetlntType(x);
IF x.typ.form = Lint THEN OCS.Mark(203) END
END;
x.typ := OCT.inttyp
ELSIF f = LReal THEN (*M0VLF*)
у := x; OCC.GetFReg(x); OCC.Put(F9, 16H, x, y); x.typ := OCT.realtyp
ELSIF f = Int THEN (*проверка диапазона опущена*)
IF (x.mode = VarX) OR (x.mode = IndX) THEN load(x)
ELSIF x.mode = Con THEN SetlntType(x);
IF x.typ.form # Sint THEN OCS.Mark(203) END
END;
x.typ := OCT.sinttyp
ELSE OCS.Mark(111)
END
| 14: (*LONG*)
IF f = Int THEN convert1(x, OCT.linttyp)
ELSIF f = Real THEN convert3(x)
ELSIF f = Sint THEN convert1(x, OCT.inttyp)
ELSIF f = Char THEN
у := x; OCC.GetReg(x); OCC.Put(F7, 18H, x, y);
x.typ := OCT.linttyp (*MOVZBD*)
ELSE OCS.Mark(111)
END
Выбор кода
430
| 15: (*OVFL*)
IF (f = Bool) & (x.mode = Con) THEN (*BICPSRB 10H*)
OCC. PutFI(7CH); OCC.PutFI(SH0RT(x.aO) * 2 + 0A1H); OCC.PutFI(IOH)
ELSE OCS. Maгк(111)
END;
x.typ := OCT.notyp
| 16, 17: (*INC DEC*)
IF x.mode >= Con THEN OCS.Mark(112)
ELSIF ~(f IN intSet) THEN OCS.Mark(111)
END
| 18, 19: (*INCL EXCL*)
IF x.mode >= Con THEN OCS.Mark(112)
ELSIF x.typ tt OCT.settyp THEN OCS. Ma rk( 111); x.typ := OCT.settyp
END
| 20: (*LEN*)
IF (f tt DynArr) & (f tt Array) THEN OCS. Mark(131) END
| 21: (*ASH*)
IF f = Lint THEN load(x)
ELSIF f IN intSet THEN loadX(x); x.typ := OCT.linttyp
ELSE OCS.Mark(111)
END
| 22, 23: (*LSH ROT*)
IF f IN {Char, Sint, Int, Lint, Set} THEN load(x) ELSE OCS.Mark(111) END
| 24, 25, 26: (*GET, PUT, BIT*)
IF (f IN intSet) & (x.mode = Con) THEN x.mode := Abs
ELSIF f = Lint THEN
IF (x.mode = Var) & (x.lev >= 0) THEN x.mode := Ind; x.al := 0
ELSE load(x); x.mode := Regl; x.al := 0
END
ELSE OCS.Ma гк(111)
END
| 27: (*VAL*)
IF x.mode tt Typ THEN OCS. Mark( 110) END
| 28: (*SYSTEM.NEW*)
IF (f = Pointer) & (x.mode < Con) THEN
y.mode := Reg; y.aO := 0; OCC.PutF4(27H, y, x);
ELSE OCS.Mark(111)
END
| 29: (*C0PY*)
IF (((f = Array) OR (f = DynArr)) & (x.typ.BaseTyp.form = Char))
OR (f = String) THEN
y.mode := Reg; y.aO := 1;
IF f = DynArr THEN OCC.DynArrAdr(y, x)
ELSE OCC.PutF4(27H, y, x)
END
ELSE OCS.Mark(111)
END
| 30: (*M0VE*)
IF f = Lint THEN y.mode := Reg; y.aO := 1; OCC.PutF4(17H, y, x)
Компилятор
Выбор кода
ELSE OCS.Mark(111)
END
END
END StParl;
PROCEDURE StPar2* (VAR p, x: OCT.Item; fctno; INTEGER);
VAR f, L; INTEGER; y, z; OCT.Item; typ: OCT.Struct;
BEGIN f := x.typ.form;
IF fctno <16 THEN OCS.Mark(64); RETURN END;
CASE fctno OF
16, 17: (*INC DEC*)
IF x.typ # p.typ THEN
IF (x.mode = Con) & (x.typ.form IN intSet) THEN x.typ := p.typ
ELSE OCS.Mark(111)
END
END;
L := lengcode[p.typ.form];
IF fctno = 16 THEN add(L, p, x) ELSE sub(L, p, x) END;
p.typ := OCT.notyp
| 18: (*INCL*)
SetO(y, x); OCC.PutF4(1BH, p, y); p.typ := OCT.notyp (*ORD*)
| 19: (*EXCL*)
SetO(y, x); OCC.PutF4(OBH, p, y); p.typ := OCT.notyp (*BICD*)
| 20: (*LEN*)
IF (x.mode = Con) & (f = Sint) THEN
L := SHORT(x.aO); typ := p.typ;
WHILE (L > 0) & (typ.form IN {DynArr, Array}) DO
typ := typ.BaseTyp; DEC(L)
END;
IF (L # 0) OR "(typ.form IN {DynArr, Array}) THEN OCS.Mark(132)
ELSE
IF typ.form = DynArr THEN
p.mode := Var; p.typ := OCT.linttyp; INC(p.aO, typ.adr);
load(p); OCC.PutF2(0FH, 1, p) (* ADDQD 1, p *)
ELSE p := x; p.aO := typ.n; SetlntType(p)
END
END
ELSE 0CS.Mark(111)
END
| 21, 22, 23: (*ASH LSH ROT*)
IF f IN intSet THEN
IF fctno = 21 THEN L := 4 ELSIF fctno = 22 THEN L := 14H
ELSE L := 0 END;
IF(x.mode = VarX) OR (x.mode = IndX) THEN load(x) END;
x.typ := OCT.sinttyp; 0CC.Put(F6, lengcode[p.typ.form] + L, p, x)
ELSE 0CS.Mark(111)
END
| 24: (*GET*)
IF x.mode >= Con THEN OCS.Mark(112)
ELSIF f IN {Undef..Lint, Set, Pointer, ProcTyp} THEN
ЕШ
432
OCC.PutF4(lengcode[f] + 14H, x, p)
ELSIF f IN realSet THEN OCC. Put(F11, lengcode[f] + 4, x, p) (*MOVf*)
END;
p.typ := OCT. notyp
| 25: (*PUT*)
IF f IN {Undef..Lint, Set, Pointer, ProcTyp}
THEN OCC.PutF4(lengcode[f] + 14H, p, x)
ELSIF f IN realSet THEN OCC. Put(F11, lengcode[f] + 4, p, x) (*M0Vf*)
END;
p.typ := OCT. notyp
| 26: (*BIT*)
IF f IN intSet THEN OCC.PutF4(lengcode[f] + 34H, p, x) (*TBITi*)
ELSE OCS. Mark(111)
END;
setCC(p, 8)
| 27: (*VAL*)
x.typ := p.typ; p := x
| 28: (*SYSTEM.NEW*)
y.mode := Reg; y.aO := 2;
IF f = Lint THEN OCC.PutF4(17H, y, x)
ELSIF f = Int THEN 0CC.Put(F7, 1DH, y, x) (*MOVXWD*)
ELSIF f = Sint THEN 0CC.Put(F7, 1CH, y, x) (*MOVXBD*)
ELSE OCS. Mark(111)
END;
OCC.PutFI(0E2H); OCC.PutByte(1); (*SVC 1*)
p.typ := OCT.notyp
| 29: (*COPY*)
IF ((f = Array) OR (f = DynArr)) & (x.typ.BaseTyp.form = Char) THEN
y.mode := Reg; y.aO := 2; y.al := 0;
IF f = DynArr THEN p := x; OCC.DynArrAdr(y, x); y.aO := 0;
p.mode := Var; INC(p.aO, p.typ.adr); OCC.PutF4(17H, y, p)
ELSE OCC.PutF4(27H, y, x); y.aO := 0;
p. mode := Con; p.typ := OCT.inttyp; p.aO := x.typ.size - 1;
OCC.Put(F7, 19H, y, p); (*MOVZWD*)
END;
y.aO := 4; OCC.PutF2(5FH, 0, y); (*MOVQD*)
OCC. PutFI(14); OCC.PutFI(0); OCC.PutFI(6); (*MOVSB*)
y.mode := Regl; y.aO := 2; OCC. PutF2(5CH, 0, y) (*MOVQB*)
ELSE 0CS.Mark(111)
END;
p.typ := OCT.notyp
| 30: (*MOVE*)
IF f = Lint THEN y.mode := Reg; y.aO := 2; OCC.PutF4(17H, y, x)
ELSE OCS. Mark(111)
END
END
END St Pa r2;
PROCEDURE StPar3* (VAR p, x: OCT.Item; fctno: INTEGER);
VAR f: INTEGER; y: OCT.Item;
Компилятор
Выбор кода
BEGIN f : = x.typ.form;
IF fctno = 30 THEN (* MOVE*)
y.mode := Reg; y.aO := 0;
IF f = Int THEN OCC.Put(F7, 1DH, y, x)
ELSIF f = Sint THEN 0CC.Put(F7, 1CH, y, x)
ELSIF f = Lint THEN OCC.PutF4(17H, y, x)
ELSE 0CS.Mark(111)
END;
OCC.PutFI(14); OCC.PutFI(0); OCC.PutFI(0); p.typ := OCT.notyp (*M0VSB*)
ELSE OCS.Mark(64)
END
END StPar3;
PROCEDURE StFct* (VAR p: OCT.Item; fctno, parno; INTEGER);
BEGIN
IF fctno >= 16 THEN
IF (fctno = 16) & (parno = 1) THEN (*INC*)
OCC.PutF2(lengcode[p.typ.form] + OCH, 1, p); p.typ := OCT.notyp
ELSIF (fctno = 17) & (parno = 1) THEN (*DEC*)
OCC.PutF2(lengcode[p.typ.form] + OCH, - 1, p); p.typ := OCT.notyp
ELSIF (fctno = 20) & (parno = 1) THEN (* LEN *)
IF p.typ.form = DynArr THEN
p.mode := Var; INC(p.aO, p.typ.adr); p.typ := OCT.linttyp;
load(p); OCC.PutF2(OFH, 1, p) (*ADDQD 1 p*)
ELSE p.mode := Con; p.aO := p.typ.n; SetlntType(p)
END
ELSIF (parno < 2) OR (fctno = 30) & (parno < 3) THEN 0CS.Mark(65)
END
ELSIF parno < 1 THEN 0CS.Mark(65)
END
END StFct;
BEGIN intSet := {Sint, Int, Lint}; realSet := {Real, LReal}; lengcode[Undef] := 0;
lengcode[Byte] := 0; lengcode[Bool] := 0; lengcode[Char] := 0; lengcode[SInt] := 0;
lengcode[Int] := 1; lengcode[LInt] := 3; lengcode[Real] := 1; lengcode[LReal] := 0;
lengcode[Set] := 3; lengcode[String] := 0; lengcode[NilTyp] := 3;
lengcode[ProcTyp] := 3; lengcode[Pointer] := 3; lengcode[Array] := 1;
lengcode[DynArr] := 1; lengcode[Record] := 1
END OCE.
Модуль OC1I содержит процедуры для выбора кода и проверки совместимо¬
сти типов в операторах присваивания, вызовах процедур и операторах структур¬
ного управления. Процедура Assign выбирает различные типы переменной-прием¬
ника с помощью оператора CASE. Она вызывается как для самого присваивания
(~рагат), так и для передачи значений параметров (param). В последнем случае
режим адресации приемника - TOS; параметр заносится в стек. Если длина опе¬
ранда 1 или 2, то выполняется автоувеличение его длины, приводящее к правиль¬
ному выравниванию всех параметров.
кш
Присваивание массивов и записей выполняется командой пересылки блока
(MOVMB, если размер ие больше 16, и MOVSB - в противном случае, см. про¬
цедуру MoveBlock). Если приемник - это косвенно адресуемая запись, то есть либо
VAR-параметр, либо разыменованная переменная, то необходима неявная защита
типа. Рассмотрим тип записи R0 и его расширение R1. Пусть приемник - это либо
VAR-параметр гО типа R0, либорл, где/? - указатель, связанный с R0, и пусть пере¬
менная г1 имеет тип R1. Тогда присваивание гО := т1 является допустимым, лишь
когда фактический приемник имеет тип R0, но не некое, как это случается, расши¬
рение R0 (не обязательно R1). Подобное условие должно обеспечиваться неявно
вставляемой защитой. Это тот случай, когда такое довольно простое и фундамен¬
тальное понятие, как расширение типа, создает неожиданные побочные эффекты
и осложнения.
Присваивания динамическим массивам как единому целому не допускаются
правилами языка. Однако передаваемые по значению фактические параметры
на месте формального параметра, объявленного динамическим массивом, могут
быть массивами, динамическими массивами или строками. Так как такое неявное
присваивание реализуется процедурой Assign, она должна обработать этот случай,
создав соответствующий дескриптор массива. Дескриптор состоит из адреса фак¬
тического параметра и границ его индексов. Последние помещаются в стек первы¬
ми. В случае строки ее длина минус 1 дает верхнюю границу, а нижняя граница О
получается расширением верхней до 4 байтов (см. процедуру DynAirBnd).
Присваивание процедур переменным (и параметрам) процедурного типа об¬
рабатывается созданием дескриптора процедуры и присваиванием его приемнику.
Этот дескриптор состоит из адреса дескриптора модуля и смещения входа. Кроме
того, в этом случае довольно сложна проверка совместимости типов, потому что
язык допускает здесь вместо эквивалентности имен эквивалентность структур,
которая необходима из-за того, что тип объявленной процедуры не имеет имени.
Поэтому и тип результата, и типы параметров должны быть проверены на сов¬
местимость. Это делается процедурой Compare Parameters с привлечением типов
параметров и видов. Данная процедура вызывается также в случае предваритель¬
ных описаний (см. CompilerProcedureDeclaration).
Процедуры Prep Call, Рагат и Call используются при выборе кода для вызовов
процедуры. Первая проверяет, что элемент обозначает именно процедуру, и предо¬
ставляет список ее формальных параметров. Рагат просматривает параметры по
одному и в случае их передачи по значению отправляет их на обработку Assign; в
противном случае в стек помещается адрес фактического параметра. В случае ди¬
намических массивов и записей формируется дескриптор, содержащий, помимо
адреса, длину массива или тэг основного типа записи. Последний используется
для защиты и контроля типа. И наконец, процедура Call выбирает подходящую
команду перехода, а именно: BSR - для локальной, СХР - для внешней, CXPD -
для косвенно вызваемой, SVC - для встроенной процедур.
Машинная команда СХР требует в качестве параметра индекс в таблице связей
модуля. Вход по этому индексу содержит дескриптор, определяющий процедуру
(см. главу 6). Запись в таблице заводится, когда компилятор впервые встречает
434
Компилятор
вызов процедуры, а индекс затем сохраняется процедурой OCC.LinkAdr в атрибуте
а1 входа таблицы символов для этой процедуры.
Процедуры Enter, CopyDynArray, Result и Return выбирают команды для про¬
лога и эпилога тел процедуры. Пролог обычно состоит из команды ENTER, а эпи¬
лог - из команды EXIT и следующей за ней команды RET для локальной или RXP
для внешней процедур (см. шаблоны кода).
Процедуры FJ, CFJ, BJ, CBJ и LFJ вызываются для конструкций условия и по¬
вторения и генерируют переходы: F - вперед, В - назад, С - по условию и L - длин¬
ный. FJ, CFJ и LFJ присваивают адрес генерируемого перехода своему параметру
loc, который используется для последующего закрепления адреса.
Процедуры Casein и CaseOut обрабатывают операторы выбора CASE. Опе¬
ратор выбора, в отличие от каскадного условного оператора, представляет собой
единственный переход по индексу. Casein генерирует эту команду перехода по
индексу вместе с командой проверки границ индекса. CaseOut вызывается, когда
достигнут конец оператора выбора и известны адреса его отдельных вариантов и
поэтому может быть создана таблица переходов. Закрепление адресов команды
перехода по индексу неизбежно. Оставшимся неопределенными адресам вариан¬
тов присваивается адрес команды прерывания.
MODULE ОСИ; (*NW 7.6.87 / 15.2.91*)
IMPORT ОСС, OCS, ОСТ;
CONST (*префиксы форматов команд*)
F6 = 4ЕН; F7 = ОСЕЙ; F9 = ЗЕН; F11 = ОВЕН;
(*виды объектов и элементов*)
Var = 1; VarX = 2; Ind = 3; IndX = 4; Regl = 5;
RegX = 6; Abs = 7; Con = 8; Stk = 9; Coc = 10;
Reg = 11; Fid = 12; LProc = 14; XProc = 15;
CProc = 17; IProc = 18; Mod = 19;
(*формы структур*)
Undef = 0; Byte = 1; Bool = 2; Char = 3; Sint = 4; Int = 5; Lint = 6;
Real = 7; LReal = 8; Set = 9; String = 10; NilTyp = 11; NoTyp = 12;
Pointer = 13; ProcTyp = 14; Array = 15; DynArr = 16; Record = 17;
TYPE LabelRange* = RECORD low*, high*: INTEGER; label*: INTEGER END;
VAR lengcode: ARRAY 18 OF INTEGER;
PROCEDURE setCC (VAR x: OCT.Item; cc: LONGINT);
BEGIN x.typ := OCT.booltyp; x.mode := Coc; x.aO := cc; x.al := 0; x.a2 := 0
END setCC;
PROCEDURE AdjustSP (n: LONGINT);
BEGIN (*ADJSPB n*)
IF n <= 127 THEN OCC.PutF3( - 5A84H); OCC.PutByte(n)
ELSE OCC.PutF3( - 5A83H); OCC.PutWord(n)
Выбор кода
Ш
436
Компилятор
END
END AdjustSP;
PROCEDURE move (L: INTEGER; VAR x, y: OCT.Item);
BEGIN
IF (y.mode = Con) & (y.aO <= 7) & (y.aO >= - 8) THEN
OCC.PutF2(L + 5CH, y.aO, x) (*MOVQi*)
ELSE OCC. PutF4(L + 14H, x, y) (*MOVi*)
END
END move;
PROCEDURE load (VAR x: OCT.Item);
VAR y: OCT.Item;
BEGIN
IF x.mode # Reg THEN
у := x; OCC.GetReg(x); move(lengcode[x.typ.form], x, y)
END
END load;
PROCEDURE moveBW (VAR x, y: OCT.Item);
BEGIN
IF (y.mode = Con) & (y.aO <= 7) & (y.aO >= - 8) THEN
OCC.PutF2(5DH, y.aO, x)
ELSE OCC.Put(F7, 10H, x, y) (*MOVXBW*)
END
END moveBW;
PROCEDURE moveBD (VAR x, y; OCT.Item);
BEGIN
IF (y.mode = Con) & (y.aO <= 7) & (y.aO >= - 8) THEN
OCC.PutF2(5FH, y.aO, x)
ELSE OCC.Put(F7, 1CH, x, y) (*MOVXBD*)
END
END moveBD;
PROCEDURE moveWD (VAR x, y: OCT.Item);
BEGIN
IF (y.mode = Con) & (y.aO <= 7) & (y.aO >= - 8) THEN
OCC.PutF2(5FH, y.aO, x)
ELSE OCC.Put(F7, 1DH, x, y) (*MOVXWD*)
END
END moveWD;
PROCEDURE Leng (VAR x: OCT.Item; L: LONGINT);
VAR y: OCT.Item;
BEGIN
IF L <= 7 THEN OCC.PutF2(5FH, L, x) (*MOVQD*)
ELSE y.mode := Con; y.aO ;= L; (*MOVZBD*)
IF L <= 255 THEN y.typ := OCT.sinttyp; OCC.Put(F7, 18H, x, y)
ELSE y.typ := OCT.inttyp; 0CC.Put(F7, 19H, x, y)
END
END
END Leng;
PROCEDURE MoveBlock (VAR x, y: OCT.Item; s: LONGINT; param: BOOLEAN);
VAR L: INTEGER; z: OCT.Item;
BEGIN
IF s > 0 THEN
IF param THEN
s := (s + 3) DIV 4 * 4; AdjustSP(s)
END;
IF s <= 16 THEN
OCC.Put(F7, 0, x, y); OCC.PutDisp(s - 1) (*M0VMB*)
ELSE
z.mode := Reg; z.aO := 1; OCC.PutF4(27H, z, y); (*ADDR y,R1*)
z.aO := 2; OCC.PutF4(27H, z, x); z.aO := 0; (*ADDR x,R2*)
IF s MOD 4 = 0 THEN L := 3; s := s DIV 4
ELSIF s MOD 2=0 THEN L := 1; s := s DIV 2
ELSE L := 0
END;
Leng(z, s);
OCC.PutFI(14); OCC.PutByte(L); OCC.PutByte(O) (*MOVS*)
END
END
END MoveBlock;
PROCEDURE DynArrBnd (ftyp, atyp: OCT.Struct; lev: INTEGER;
adr: LONGINT; varpar: BOOLEAN);
VAR f, s: INTEGER; x, y, z: OCT.Item;
BEGIN (* ftyp.form = DynArr *)
x.mode := Stk; y.mode := Var;
IF varpar & (ftyp.BaseTyp = OCT.bytetyp) THEN
IF atyp.form # DynArr THEN Leng(x, atyp.size - 1)
ELSE y.lev := lev; y.aO := adr + atyp.adr; y.typ := OCT.linttyp;
atyp := atyp.BaseTyp;
IF atyp.form # DynArr THEN
IF atyp.size > 1 THEN
z.mode := Con; z.typ := OCT.linttyp; z.aO := atyp.size;
load(y); 0CC.Put(F7, 23H, y, z); (* MULD z, Ry *)
z.mode := Con; z.typ := OCT.linttyp;
z.aO := atyp.size - 1;
IF z.aO < 8 THEN OCC.PutF2(0FH, z.aO, y)
(* ADDQD size-1, Ry *)
ELSE OCC.PutF4(3, y, z) (* ADDD size-1, Ry *)
END
ELSE load(y); OCC.PutF2(OFH, 1, y);
REPEAT z.mode := Var; z.lev := lev;
z.aO := atyp.adr + adr; z.typ := OCT.linttyp;
Выбор кода
ЕШ
load(z); OCC.PutF2(0FH, 1, z); (* ADDQD 1, Rz *)
OCC.Put(F7, 23H, y, z); (* MULD Rz, Ry *)
atyp := atyp.BaseTyp
UNTIL atyp.form # DynArr;
IF atyp.size > 1 THEN
z.mode := Con; z.typ := OCT.linttyp;
z.aO := atyp.size;
OCC.Put(F7f 23H, y, z) (* MULD z, Ry *)
END;
OCC.PutF2(OFH, - 1, y) (* ADDQD -1, Ry *)
END
OCC.PutF4(17H, x, y) (* MOVD apdynarrlen-1, TOS *)
END
ELSE
LOOP f := atyp.form;
IF f = Array THEN y. lev := - atyp.mno; y.aO := atyp.adr
ELSIF f = DynArr THEN y.lev := lev; y.aO := atyp.adr + adr
ELSE OCS.Mark(66); EXIT
END;
OCC.PutF4(17H, x, y); ftyp := ftyp.BaseTyp; atyp := atyp.BaseTyp;
IF ftyp.form # DynArr THEN
IF ftyp # atyp THEN 0CS.Mark(67) END;
EXIT
END
END
END
END DynArrBnd;
PROCEDURE Trap* (n: INTEGER);
BEGIN OCC.PutFI(0F2H); OCC.PutByte(n) (*BPT n*)
END Trap;
PROCEDURE CompareParLists* (x, y: OCT.Object);
VAR xt, yt: OCT.Struct;
BEGIN
WHILE x # NIL DO
IF у # NIL THEN
xt := x.typ; yt := y.typ;
WHILE (xt.form = DynArr) & (yt.form = DynArr) DO
xt := xt.BaseTyp; yt := yt. BaseTyp
END;
IF x.mode # y.mode THEN OCS. Mark(115)
ELSIF xt # yt THEN
IF (xt.form = ProcTyp) & (yt.form = ProcTyp) THEN
CompareParLists(xt.link, yt. link)
ELSE OCS.Mark(115)
END
END;
у := у.next
Компилятор
438
Выбор кода
ELSE OCS.Mark(116)
END;
x := x.next
END;
IF(y ft NIL) & (y.mode <= Ind) & (y.aO > 0) THEN 0CS.Mark(117) END
END CompareParLists;
PROCEDURE Assign* (VAR x, y: OCT.Item; param: BOOLEAN);
VAR f, g, L, u: INTEGER; s, vsz: LONGINT;
p, q: OCT.Struct;
xp, yp: OCT.Object;
tag, tdes: OCT.Item;
BEGIN f := x.typ.form; g := y.typ.form;
IF x.mode = Con THEN 0CS.Mark(56) END;
CASE f OF
Undef, String:
| Byte: IF g IN {Undef, Byte, Char, Sint} THEN
IF param THEN moveBD(x, y) ELSE move(0, x, y) END
ELSE OCS.Mark(113)
END
| Bool: IF param THEN u := 3 ELSE u := 0 END;
IF y.mode = Coc THEN
IF (y.al = 0) & (y.a2 = 0) THEN 0CC.PutF2(u + 3CH, y.aO, x)
ELSE
IF ODD(y.aO) THEN OCC.PutF0(y.aO - 1)
ELSE OCC.PutFO(y.aO + 1) END;
OCC.PutWord(y.a2); y.a2 := OCC.pc - 2;
OCC.FixLink(y.a1); 0CC.PutF2(u + 5CH, 1, x);
OCC.PutFO(14); L := OCC.pc; OCC.PutWord(O);
OCC.FixLink(y.a2); 0CC.PutF2(u + 5CH, 0, x); OCC.fixup(L)
END
ELSIF g = Bool THEN
IF y.mode = Con THEN 0CC.PutF2(u + 5CH, y.aO, x)
ELSIF param THEN 0CC.Put(F7, 18H, x, y) (*MOVZBD*)
ELSE OCC.PutF4(14H, x, y)
END
ELSE OCS.Mark(113)
END
| Char, Sint:
IF g = f THEN
IF param THEN moveBD(x, y) ELSE move(0, x, y) END
ELSE OCS.Mark(113)
END
| Int: IF g = Int THEN
IF param THEN moveWD(x, y) ELSE move(1, x, y) END
ELSIF g = Sint THEN
IF param THEN moveBD(x, y) ELSE moveBW(x, y) END
ELSE OCS.Mark(113)
END
Ш
440
Компилятор
| Lint: IF g = Lint THEN move(3, x, y)
ELSIF g = Int THEN moveWD(x, y)
ELSIF g = Sint THEN moveBD(x, y)
ELSE OCS.Mark(113)
END
| Real: IF g = Real THEN 0CC.Put(F11, 5, x, y)
ELSIF (Sint <= g) & (g <= Lint)
THEN OCC.Put(F9, lengcode[g] + 4, x, y)
ELSE OCS.Mark(113)
END
| LReal: IF g = LReal THEN OCC.Put(F11, 4, x, y)
ELSIF g = Real THEN OCC.Put(F9, 1BH, x, y)
ELSIF (Sint <= g) & (g <= Lint) THEN 0CC.Put(F9, lengcodefg], x, y)
ELSE OCS.Mark(113)
END
| Set: IF g = f THEN move(3, x, y) ELSE OCS.Mark(113) END
| Pointer:
IF x.typ = y.typ THEN move(3, x, y)
ELSIF g = NilTyp THEN OCC.PutF2(5FH, 0, x)
ELSIF g = Pointer THEN
p := x.typ.BaseTyp; q := y.typ.BaseTyp;
IF (p.form = Record) & (q.form = Record) THEN
WHILE (q it p) & (q it NIL) DO q : = q.BaseTyp END;
IF q it NIL THEN move(3, x, y) ELSE OCS. Mark(113) END
ELSE OCS.Mark(113)
END
ELSE OCS.Mark(113)
END
| Array: s := x.typ.size;
IF x.typ = y.typ THEN MoveBlock(x, y, s, param)
ELSIF (g = String) & (x.typ.BaseTyp = OCT.chartyp) THEN
s := y.al; vsz := x.typ.n; ^проверить длину строки*)
IF s > vsz THEN OCS.Mark(114) END;
IF param THEN
vsz := (vsz + 3) DIV 4 - (s + 3) DIV 4;
IF vsz > 0 THEN AdjustSP(vsz * 4) END
END;
MoveBlock(x, y, s, param)
ELSE OCS.Mark(113)
END
| DynArr: s := x.typ.size;
IF param THEN (*формальный параметр - открытый массив*)
IF (g = String) & (x.typ.BaseTyp.form = Char)
THEN Leng(x, y.a1 - 1)
ELSIF y.mode >= Abs THEN 0CS.Mark(59)
ELSE DynArrBnd(x.typ, y.typ, y.lev, y.aO, FALSE)
END;
IF g = DynArr THEN OCC. DynArrAdr(x, y)
ELSE OCC.PutF4(27H, x, y)
Выбор кода
END
ELSE OCS.Mark(113)
END
| Record: s := x.typ.size;
IF x.typ # y.typ THEN
IF g = Record THEN
q := y.typ.BaseTyp;
WHILE (q ft NIL) & (q # x.typ) DO q := q.BaseTyp END;
IF q = NIL THEN 0CS.Mark(113) END
ELSE OCS.Mark(113)
END
END;
IF OCC.typchk & "param &
(((x.mode = Ind) OR (x.mode = Regl)) & (x.obj = OCC.wasderef)
(* P~ : = *)
OR (x.mode = Ind) & (x.obj ft NIL) & (x.obj tt OCC.wasderef))
THEN
tag := x; tdes.mode := Var; tdes.lev := - x.typ.mno;
tdes.aO := x.typ.adr;
IF x.obj = OCC.wasderef THEN tag.al := - 4
ELSE tag.mode := Var; INC(tag.aO, 4)
END;
0CC.PutF4(7, tdes, tag); (* CMPD tag, tdes *)
OCC.PutFO(O); OCC.PutDisp(4); (* продолжение BEQ *)
OCC.PutF1(0F2H); OCC.PutByte(19) (* BPT 19 *)
END;
MoveBlock(x, y, s, param)
| ProcTyp:
IF (x.typ = y.typ) OR (y.typ = OCT.niltyp) THEN OCC.PutF4(17H, x, y)
ELSIF (y.mode = XProc) OR (y.mode = IProc) THEN
(процедуру у - в процедурную переменную х; проверить
совместимость*)
IF х.typ.BaseTyp = y.typ THEN
CompareParLists(x.typ.link, y.obj.dsc);
IF y.al = 0 THEN
y.al := OCC.LinkAdr( - y.lev, y.aO); y.obj.al := y.al
END;
y.mode := Var; y.lev := SH0RT( - y.al); y.aO := 0;
OCC.PutF4(27H, x, y) (*LXPD*)
ELSE OCS.Mark(118)
END
ELSIF y.mode = LProc THEN OCS.Mark(119)
ELSE OCS.Mark(111)
END
| NoTyp, NilTyp: OCS.Mark(111)
END
END Assign;
PROCEDURE FJ* (VAR loc: INTEGER);
ЕШ
BEGIN OCC.Put FO(14); OCC.PutWord(loc); loc := OCC.pc - 2
END FJ;
PROCEDURE CFJ* (VAR x: OCT.Item; VAR loc: INTEGER);
BEGIN
IF x.typ.form = Bool THEN
IF x.mode # Coc THEN OCC.PutF2(1CH, 1, x); setCC(x, 0) END
ELSE OCS.Mark(120); setCC(x, 0)
END;
IF ODD(x.aO) THEN OCC.PutF0(x.aO - 1) ELSE OCC.PutF0(x.aO + 1) END;
loc := OCC.pc; OCC. PutWord(x. a2); OCC. FixJ_ink(x. a1)
END CFJ;
PROCEDURE BJ* (loc: INTEGER);
BEGIN OCC.Put FO(14); OCC.PutDisp(loc - OCC.pc + 1)
END BJ;
PROCEDURE CBJ* (VAR x: OCT.Item; loc: INTEGER);
BEGIN
IF x.typ,form = Bool THEN
IF x.mode # Coc THEN OCC.PutF2(1CH, 1, x); setCC(x, 0) END
ELSE OCS.Mark(120); setCC(x, 0)
END;
IF ODD(x.aO) THEN OCC.PutF0(x.aO - 1) ELSE OCC.PutF0(x.aO + 1) END;
OCC.PutDisp(loc - OCC.pc + 1);
OCC. FixLmkWith(x. a2, loc); OCC. FixLink(x. a1)
END CBJ;
PROCEDURE LFJ* (VAR loc: INTEGER);
BEGIN OCC.PutF0(14); OCC.PutWord( - 4000H); OCC.PutWord(O); loc := OCC.pc - 4
END LFJ;
PROCEDURE PrepCall* (VAR x: OCT.Item; VAR fpar: OCT.Object);
BEGIN
IF (x.mode = LProc) OR (x.mode = XProc) OR (x.mode = CProc) THEN
fpar := x.obj.dsc
ELSIF (x.typ # NIL) & (x.typ.form = ProcTyp) THEN
fpar := x.typ.link
ELSE OCS.Mark(121); fpar := NIL; x.typ := OCT.undftyp
END
END PrepCall;
PROCEDURE Param* (VAR ap: OCT.Item; f: OCT.Object);
VAR q: OCT.Struct; fp, tag: OCT.Item;
BEGIN fp.mode := Stk; fp.typ := f.typ;
IF f.mode = Ind THEN (WAR-параметр*)
IF ap.mode >= Con THEN OCS.Mark(122) END;
IF fp.typ.form = DynArr THEN
DynArrBnd(fp.typ, ap.typ, ap.lev, ap.aO, TRUE);
Компилятор
442
IF ap.typ.form = DynArr THEN OCC.DynArrAdr(fp, ap)
ELSE OCC.PutF4(27H, fp, ap)
END
ELSIF (fp.typ.form = Record) & (ap.typ.form = Record) THEN
q := ap.typ;
WHILE (q it fp.typ) & (q tt NIL) DO q := q. BaseTyp END;
IF q # NIL THEN
IF (ap.mode = Ind) & (ap.obj # NIL) & (ap.obj tt
OCC.wasderef) THEN
(*фактический параметр - VAR-параметр*)
ap.mode := Var; ap.aO := ap.aO + 4;
OCC.PutF4(17H, fp, ap); ap.aO := ap.aO - 4;
OCC.PutF4(17H, fp, ap)
ELSIF ((ap.mode = Ind) OR (ap.mode = Regl)) &
(ap.obj = OCC.wasderef) THEN
(★фактический параметр - p~*) ap.al := - 4;
OCC.PutF4(17H, fp, ap);
IF ap.mode = Ind THEN ap.mode := Var ELSE
ap.mode := Reg END;
OCC.PutF4(17H, fp, ap)
ELSE
tag.mode := Var; tag.lev := - ap.typ.mno;
tag.aO := ap.typ.adr;
OCC.PutF4(17H, fp, tag); OCC.PutF4(27H, fp, ap)
END
ELSE OCS.Mark(111)
END
ELSIF (ap.typ = fp.typ) OR ((fp.typ.form = Byte) &
(ap.typ.form IN {Char, Sint})) THEN
IF (ap.mode = Ind) & (ap.al = 0) THEN (*фактический var-параметр*)
ap.mode := Var; OCC.PutF4(17H, fp, ap)
ELSE OCC.PutF4(27H, fp, ap)
END
ELSE OCS.Mark(123)
END
ELSE Assign(fp, ap, TRUE)
END
END Param;
PROCEDURE Call* (VAR x: OCT.Item);
VAR stk, sL: OCT.Item;
BEGIN
IF x.mode = LProc THEN
IF x.lev > 0 THEN
sL.mode := Var; sL.typ := OCT.linttyp; sL.lev := x.lev;
sL.aO := 0;
stk.mode := Stk; OCC.PutF4(27H, stk, sL) (*статическая связь*)
END;
OCC.PutFI(2); OCC.PutDisp(x.aO - OCC.pc + 1) (*BSR*)
Выбор кода
Ш
444
Компилятор
ELSIF x.mode = XProc THEN
IF x.a1 =0 THEN
x.al := OCC.LinkAdr( - x.lev, x.aO); x.obj.al := x.al
END;
OCC.PutFI(22H); OCC.PutDisp(SHORT(x.a1)) (*CXP*)
ELSIF (x.mode < Con) & (x.typ # OCT.undftyp) THEN (*CXPD*)
OCC.PutF2(7FH, 0, x); x.typ := x.typ.BaseTyp
ELSIF x.mode = CProc THEN
OCC.PutFI(0E2H); OCC.PutByte(x.aO) (*SVC n*)
ELSE OCS.Mark(121)
END
(*результат функции помечается при восстановлении регистров*)
END Call;
PROCEDURE Enter* (mode: SHORTINT; pno: LONGINT; VAR L: INTEGER);
BEGIN
IF mode # LProc THEN OCC.SetEntry(SHORT(pno)) END;
OCC.PutFI(82H); (*ENTER*)
IF mode - IProc THEN OCC.PutByte(OCOH) ELSE OCC.PutByte(O) END;
IF mode ft Mod THEN L := OCC.pc; OCC.PutWord(O) ELSE OCC.PutByte(O) END
END Enter;
PROCEDURE CopyDynArray* (adr: LONGINT; typ: OCT.Struct);
VAR size, ptr, m2, tos: OCT.Item; add: SHORTINT;
PROCEDURE DynArrSize (typ: OCT. Struct);
VAR len: OCT.Item;
BEGIN
IF typ.form = DynArr THEN DynArrSize(typ.BaseTyp);
len.mode := Var; len.lev := OCC.level; len.typ := OCT.linttyp;
len.aO := adr + typ.adr; load(len);
IF (size.mode # Con) OR (size.aO # 1) THEN
IF add = 4 THEN OCC.PutF2(0FH, 1, size) END;
(* ADDQD 1, size *)
OCC.PutF2(0FH, 1, len); add := 3; (* ADDQD 1, len *)
0CC.Put(F7, 23H, len, size) (* MULD size, len *)
ELSE add := 4
END;
size := len
ELSE size.mode := Con; size.typ := OCT.linttyp; size.aO := typ.size
END
END DynArrSize;
BEGIN add := 3;
DynArrSize(typ);' (* загрузить общий размер в байтах динамического массива*!
ОСС.PutF2(0FH, add, size); (* ADDQD 3 or 4, size *)
m2.mode := Con; m2.typ := OCT.sinttyp;
m2. aO := - 2; 0CC.Put(F6, 7, size, m2); (* ASHD -2, size *)
ptr.mode := Var; ptr.lev := OCC.level; ptr.typ := OCT.linttyp;
Выбор кода
ptr.aO := adr; load(ptr);
ptr.mode := RegX; ptr.al := - 4; ptr.a2 := size.aO; tos.mode := Stk;
OCC.PutF4(17H, tos, ptr); (* loop: MOVD -4(ptr)[size:D], TOS *)
OCC.PutF2(4FH, - 1, size); OCC.PutDisp( - 4); (* ACBD -1, size, loop *)
OCC.PutF3( - 31D9H); OCC.PutDisp(O); OCC.PutDisp(adr); (* ADDR 0(SP),
adr(FP) *)
OCC.FreeRegs({})
END CopyDynArray;
PROCEDURE Result* (VAR x: OCT.Item; typ: OCT.Struct);
VAR res: OCT.Item;
BEGIN res.mode := Reg; res.typ := typ; res.aO := 0;
Assignees, x, FALSE)
END Result;
PROCEDURE Return* (mode: INTEGER; psize: LONGINT);
BEGIN OCC.PutF1(92H); (*EXIT*)
IF mode = LProc THEN
OCC.PutByte(O); OCC.PutF1(12H); OCC.PutDisp(psize - 8) (*RET*)
ELSIF mode = XProc THEN
OCC.PutByte(O); OCC.PutF1(32H); OCC.PutDisp(psize - 12) (*RXP*)
ELSIF mode = IProc THEN
OCC.PutByte(3); OCC.PutF1(42H); OCC.PutDisp(O) (*RETT 0*)
END
END Return;
PROCEDURE Casein* (VAR x: OCT.Item; VAR LO, L1: INTEGER);
VAR f: INTEGER; r, xO, lim: OCT.Item;
BEGIN f := x.typ.form;
IF f # Int THEN
IF f = Char THEN
xO := x; OCC.GetReg(x); 0CC.Put(F7, 14H, x, xO) (*M0VZBW*)
ELSIF f = Sint THEN
xO := x; OCC.GetReg(x); 0CC.Put(F7, 10H, x, xO) (*M0VXBW*)
ELSIF f # Lint THEN OCS.Mark(125)
END;
f := Int
END;
IF(x.mode IN {VarX, IndX, RegX}) OR
(x.mode # Reg) & (x.lev > 0) & (x.lev < OCC.level) THEN
xO := x; OCC.GetReg(x); OCC.PutF4(15H, x, xO) (*M0VW*)
END;
LO := OCC.pc + 3; (*закрепить положение границ адреса*)
lim.mode := Var; lim.typ := OCT.inttyp; lim.lev := 0; lim.aO := 100H;
OCC.GetReg(r); OCC.Put(0EEH, SHORT(r.aO) * 8 + 1, x, lim); (*CHECK*)
OCC.PutF0(8); OCC.PutWord(O); L1 := OCC.pc; (*BFS*)
lim.mode := VarX; lim.a2 := r.aO; OCC.PutF2(7DH, 14, lim) (*CASE*)
END Casein;
PROCEDURE CaseOut* (LO, L1, L2, L3, n: INTEGER;
ЕШ
VAR tab: ARRAY OF LabelRange);
VAR i, j, lim: INTEGER; k: LONGINT;
BEGIN (*создать таблицу переходов*)
IF n > 0 THEN OCC.AllocBounds(tab[0]. low, tab[n - 1].high, k)
ELSE (^вариантов нет*) OCC. AllocBouncls(1, 0, k)
END;
j := SHORT(k);
OCC.FixupWith(LO, j); (*контроль границ адресов*)
OCC. FixupWith(L1 - 2, L2 - L1 + 3); (*адрес перехода за пределами границ*)
ОСС.FixupWith(L1 + 3, j + 4); (*адрес перехода к таблице*)
i := 0; j := tab[0].low;
WHILE i < n DO
lim := tab[i].high;
WHILE j < tab[i].low DO
OCC.AllocInt(L2 - L1); INC(j) (*else*)
END;
WHILE j <= lim DO
OCC.AllocInt(tab[i].label - L1); INC(j)
END;
INC(i)
END;
OCC.FixLink(L3)
END CaseOut;
BEGIN lengcode[Undef] := 0;
lengcode[Byte] := 0; lengcode[Bool] := 0; lengcode[Char] := 0;
lengcode[SInt] := 0; lengcode[Int] := 1; lengcode[LInt] := 3;
lengcode[Real] := 1; lengcode[LReal] := 0; lengcode[Set] := 3;
lengcode[String] := 0; lengcode[NilTyp] := 3; lengcode[ProcTyp] := 3;
lengcode[Pointer] := 3; lengcode[Array] := 1; lengcode[DynArr] := 1;
lengcode[Record] := 1
END OCH.
12.8. Генерация кода
Предмет этого раздела - модуль ОСС, который генерирует двоичный код. Его
процедуры явно зависят от целевой архитектуры. Поскольку его подробности ис
так интересны, как уже представленные части компилятора, мы обойдемся здесь
только самыми краткими пояснениями. Тем не менее, чтобы дать читателю воз¬
можность понять основные подпрограммы ОСС, ниже будет дана краткая сводка
форматов машинных команд архитектуры NS-32000. Данная архитектура отно¬
сится к классу CISC с довольно сложным набором команд (из которых только
часть используется компилятором) и режимов адресации. Однако ей характерна
завидная регулярность. Например, независимо от конкретной машинной команды
одинаково применимы все режимы адресации.
Поток команд NS-32000 - байтовый, то есть каждая команда состоит из не¬
которого числа байтов. Первые 1, 2, или 3 байта составляют код команды, вклто-
Компилятор
446
чающий спецификаторы режима адресации. За ними следуют дополнительные
байты, зависящие от применяемых режимов адресации. Эти байты задают адреса
(называемые смещениями, потому что они относительны к находящемуся в ре¬
гистре базовому адресу), константы или индексные регистры. Представим снача¬
ла различные форматы ведущих байтов команды, так называемую основу коман¬
ды. Поля dst и src - это спецификаторы режимов адресации операндов, приемника
и источника соответственно; они и объясняются ниже.
Генерация кода
L
i 0
Format 0
cond
1010
Bcond
Format 1
op
0010
0
BSR
3
RXP
7
RESTORE
D
FLAG
1
RET
4
RETT
8
ENTER
E
SVC
2
CXP
6
SAVE
9
EXIT
F
BPT
и ;
7 4
! 0
Format 2
dst
val
op
11
i
0 ADDQi
3 Scand 5 MOVQi
1 CMPQi
4 ACBi
Format 3
dst
op
llllli
0 CXPD A ADISPi E CASE
11 (
3 ^
I 0
Format 4
dst
src
op
i
0
ADDi
6
Ori
A
ANDi
1
CMPi
8
SUBi
D
TBITi
2
BICi
9
ADDR
E
XORi
5
MOVi
Format 6
dst
src
op
i
4E
0
ROTi
8
NEGi
1
ASHi
С
ABSi
5
LSHi
D
COMi
Format 7
dst
src
op
i
CE
0
MOVMi
8
MULi
4
MOVXBW
E
MODi
5
MOVZBW
F
DIVi
7
MOVXiD
Format 8
dst
src
reg
001
EE
CHECKW
dst
src
reg
101
2E
INDEXW
Поля dst и src задают режим адресации m следующим образом; dO и d1 - сме¬
щения:
m
Адрес операнда
Режим
0-7
операнд = R [mj
Регистровый прямой
8-15
R [m-8]
Регистровый косвенный
16
Mem[FP+d01 +dl
Косвенный, база FP
18
MemfSB+dOl +dl
Косвенный, база SB
20
Непосредственный
21
do
Абсолютный
22
EXT(dO) +dl
Внешний
23
SP
TOS
24
FP+dO
База FP
26
SB+dO
База SB
28-31
Индексированный, масштабный коэффициент
1,2, 4, 8
Вслед за байтами основы команды, содержащими код операции и специфика¬
торы адреса, идут байты операндов в приведенном ниже порядке справа налево.
Поля операнда могут содержать одно или два значения смещения или непосредст¬
венное значение, или же все они могут опускаться.
implied
dst disp/imm
src disp/imm
dst index
src index
src
dst
op
Индексные байты присутствуют, только когда задается индексный режим.
Они указывают регистр, содержащий значение индекса, и режим, применяемый
при вычислении исполнительного адреса. Некоторые команды содержат допол¬
нительные, значимые (implied) операнды.
Format 9
dst
src
op
fi
3E
0
MOVif
3
MOVFL
2
MOVLF
7
FLOORfi
Format 11
dst
src
op
Of
BE
0
ADDf
5
NEGf
1
MOVf
8
DIVf
2
CMPf
С
MULf
4
SUBf
D
ABSf
3
0
mode
reg
448
Компилятор
Длина смещения кодируется следующим образом (значения хранятся как це¬
лые числа со знаком, начиная со знакового байта, в отличие от малозначного пред¬
ставления целых чисел, используемых этим процессором):
6 0
13 0
29 0
"о
Значение
10
Значение
11
Значение
0
0 1
0 12 3
Команды генерируются процедурами PutFO, PutFI, PutF2, PutF3, PutF4 и Put(F)
в зависимости от требуемого формата. Процедуры PutByte и PutWord используют¬
ся для добавления непосредственных операндов, a PutDisp - для кодирования и
вставки смещений. Команды, непосредственные значения и смещения вставляют¬
ся в кодовый массив - глобальную переменную. Такое решение сильно ограничи¬
вает размер модулей, но позволяет легко закреплять адреса (переходов) и очень
эффективно, так как не требует динамического выделения памяти.
Аналогично глобальные массивы constant, entry и link содержат константы,
адреса входов экспортируемых процедур и связи для импорта. Константы встав¬
ляются процедурами Alloclnt, AllocString, AllocTypDesc и AllocBounds. Адреса вхо¬
дов заносятся процедурой SetEntry, а связи вставляются процедурой LinkAdr. Раз¬
личные процедуры закрепления адресов обрабатывают вставку смещений для
переходов вперед. SaveRegisters и Restore Registers вызываются для сохранения и
восстановления регистров (содержащих промежуточные результаты) до и после
вызова процедуры-функции внутри выражения.
Объектный файл генерируется по окончании компиляции модуля процедурой
OutCode. За описанием формата объектного файла читатель отсылается к главе 6.
Сначала в глобальной области видимости таблицы символов просматриваются
переменные-указатели и командные процедуры. Затем записываются заголовок
и используемые загрузчиком различные таблицы, содержащие адреса входов,
команды, указатели, импорты и связи. За ними следует таблица глобальных конс¬
тант, код и, наконец, дескрипторы типов, используемые загрузчиком для генера¬
ции и выделения им динамической памяти (в куче).
После фактических данных объектного файла добавляется часть, которую на¬
зывают блоком справочной информации. Он игнорируется загрузчиком, но исполь¬
зуется в случае прерываний при выполнении программы для генерации «посмерт¬
ного дампа» в символьном виде (см. раздел 12.9). Для этих целей блок справочной
информации содержит имена переменных и процедур вместе с их адресами. Эта
информация получается полным обходом таблицы символов. (Отметим, что
в блок включаются только переменные простых, неструктурных, типов и корот¬
кие символьные массивы.)
По крайней мере, одна деталь реализации модуля ОСС заслуживает внима¬
ния. Она касается генерации кода для двухадресных команд (процедуры PutF4 и
Put). Из-за слишком сложного порядка следования полей операндов после основы
команды невозможно сначала выдать код операции, а затем сопроводить его эти¬
ми двумя операндами. Всем смещениям предшествуют не только спецификаторы
ГеиераЦия кода
449
адресов обоих операндов, содержащиеся в байтах основы команды, но и оба ин¬
дексных байта (если они есть). Поэтому все части спецификаций обоих операндов
должны быть доступны до каждой выдачи команды. Принятое решение состоит
в том, чтобы использовать две локальные переменные dst и src типа Argument
представляющие закодированные операнды, которые вычисляются процедурой
Operand по заданному элементу типа Item. После этого вычисления выдаются
байты основы команды, сопровождаемые байтами операндов. Последнее делается
процедурой PutArg. Ничего не поделаешь, но, видимо, выбор такого формата ма¬
шинных команд не самый лучший.
MODULE ОСС; (*NW 30.5.87 / 16.3.91*)
IMPORT OCS, ОСТ, Files;
CONST CodeLength = 18000; LinkLength = 250;
ConstLength = 3500; EntryLength = 64;
CodeLim = CodeLength - 100;
MaxPtrs = 64; MaxRecs = 32; MaxComs = 40; MaxExts = 7;
(★префиксы форматов команд*)
F6 = 4EH; F7 = ОСЕЙ; F9 = ЗЕН; F11 = ОВЕН;
(*виды объектов и элементов*)
Var = 1; VarX = 2; Ind = 3; IndX = 4; Regl = 5;
RegX = 6; Abs = 7; Con = 8; Stk = 9; Coc = 10;
Reg = 11; Fid = 12; Typ = 13; LProc = 14; XProc = 15;
SProc = 16; CProc = 17; IProc = 18; Mod = 19; Head = 20;
(*формы структур*)
Undef = 0; Byte = 1; Bool = 2; Char = 3; Sint = 4; Int = 5; Lint = 6;
Real = 7; LReal = 8; Set = 9; String = 10; NilTyp = 11; NoTyp = 12;
Pointer = 13; ProcTyp = 14; Array = 15; DynArr = 16; Record = 17;
TYPE Argument =
RECORD form, gen, inx: INTEGER;
d1, d2: LONGINT
END;
VAR pc*, level*: INTEGER;
wasderef*: OCT.Object;
typchk*: BOOLEAN;
RegSet*, FRegSet: SET;
lnkx, conx, nofptrs, nofrec: INTEGER;
PtrTab: ARRAY MaxPtrs OF LONGINT;
RecTab: ARRAY MaxRecs OF OCT.Struct;
constant: ARRAY ConstLength OF CHAR;
code: ARRAY CodeLength OF CHAR;
link: ARRAY LinkLength OF INTEGER;
entry: ARRAY EntryLength OF INTEGER;
PROCEDURE GetReg* (VAR x: OCT.Item);
450
Компилятор
VAR i: INTEGER;
BEGIN i := 7; x.mode := Reg;
LOOP IF "(i IN RegSet) THEN x.aO := i; INCL(RegSet, i); EXIT END;
IF l = 0 THEN x.aO := 0; OCS.Mark(215); EXIT ELSE DEC(i) END;
END
END GetReg;
PROCEDURE GetFReg* (VAR x: OCT.Item);
VAR i: INTEGER;
BEGIN i ;= 6; x.mode := Reg;
LOOP IF ~(i IN FRegSet) THEN x.aO := i; INCL(FRegSet, i); EXIT END;
IF i = 0 THEN x.aO := 0; OCS.Mark(216); EXIT ELSE l := i - 2 END
END
END GetFReg;
PROCEDURE FreeRegs* (r: SET);
BEGIN RegSet := r; FRegSet := {}
END FreeRegs;
PROCEDURE Alloclnt* (k: INTEGER);
BEGIN
IF conx < ConstLength - 1 THEN
constant[conx] := CHR(k); INC(conx);
constant[conx] := CHR(к DIV 100H); INC(conx)
ELSE OCS.Mark(230); conx := 0
END
END Alloclnt;
PROCEDURE AllocString* (VAR s: ARRAY OF CHAR; VAR x: OCT.Item);
VAR i: INTEGER; ch: CHAR;
BEGIN INC(conx, ( - conx) MOD 4); i := 0;
REPEAT ch := s[i]; INC(i);
IF conx >= ConstLength THEN OCS.Mark(230); conx := 0 END;
constant[conx] := ch; INC(conx)
UNTIL ch = OX;
x.lev := 0; x.aO := conx - i; x.al := i
END AllocString;
PROCEDURE AllocBounds* (min, max: INTEGER; VAR adr: LONGINT);
BEGIN INC(conx, ( - conx) MOD 4); adr := conx;
Alloclnt(max); Alloclnt(min)
END AllocBounds;
PROCEDURE PutByte* (x: LONGINT);
BEGIN code[pc] := CHR(x); INC(pc)
END PutByte;
PROCEDURE PutWord* (x: LONGINT);
BEGIN code[pc] := CHR(x DIV 100H); INC(pc); code[pc] := CHR(x); INC(pc)
Генерация кода
451
452
Компилятор
END PutWord;
PROCEDURE PutDbl (x; LONGINT);
VAR i: INTEGER;
BEGIN i := - 32;
REPEAT INC(i, 8); code[pc] := CHR(ASH(x, i)); INC(pc) UNTIL i = 0
END PutDbl;
PROCEDURE PutDisp* (x: LONGINT);
BEGIN
IF x < 0 THEN
IF x >= - 40H THEN code[pc] := CHR(x + 80H); INC(pc)
ELSIF x >= - 2000H THEN PutWord(x + 0C000H)
ELSE PutDbl(x)
END
ELSIF x < 40H THEN code[pc] := CHR(x); INC(pc)
ELSIF x < 2000H THEN PutWord(x + 8000H)
ELSE PutDbl(x - 40000000H)
END
END PutDisp;
PROCEDURE PutArg (VAR z: Argument);
BEGIN
CASE z.form OF
0; IF z.inx = 1 THEN code[pc] := CHR(z.dl); INC(pc)
ELSIF z.inx = 2 THEN PutWord(z.d1)
ELSIF z.inx = 4 THEN PutDbl(z.dl)
ELSE PutDbl(z.d2); PutDbl(z.dl)
END
| 1: PutDisp(z.d1)
I 2, 5:
| 3, 6; PutDisp(z.dl)
| 4, 7: PutDisp(z.d1); PutDisp(z.d2)
END
END PutArg;
PROCEDURE PutF3* (op: INTEGER);
BEGIN code[pc] := CHR(op); INC(pc); code[pc] := CHR(op DIV 100H); INC(pc)
END PutF3;
PROCEDURE Operand (VAR x: OCT.Item; VAR z: Argument);
VAR F: INTEGER;
PROCEDURE downlevel (VAR gen: INTEGER);
VAR n, op: INTEGER; b: OCT.Item;
BEGIN GetReg(b); n := level - x.lev; gen := SHORT(b.aO) + 8;
op := SHORT(b.aO) * 40H - 3FE9H;
IF n = 1 THEN PutF3(op); PutDisp(8); (*M0VD 8(FP) Rb*)
ELSE PutF3(op - 4000H); PutDisp(8); PutDisp(8); (*MOVD 8(8(FP)) Rb*)
WHILE n > 2 DO DEC(n);
PutF3((SH0RT(b.a0) * 20H + SHORT(b.aO)) * 40H + 4017H); PutOisp(8)
END
END;
END downlevel;
PROCEDURE index;
VAR s: LONGINT;
BEGIN s := x.typ.size;
IF s = 1 THEN z.gen := 1CH
ELSIF s - 2 THEN z.gen := 1DH
ELSIF s = 4 THEN z.gen := 1EH
ELSIF s = 8 THEN z.gen := 1FH
ELSE z.gen := 1CH; PutByte(F7); PutByte(x.a2 MOD 4 * 40H + 23H);
PutByte(x.a2 DIV 4 + OAOH); PutWord(O); PutWord(s) (*MUL r s
END;
END index;
BEGIN F := x.mode;
CASE x.mode OF
Var: IF x.lev = 0 THEN
z.gen := 1AH; z.dl := x.aO; z.form := 3
ELSIF x.lev < О THEN (*EXT*)
z.gen := 16H; z.dl := - x.lev; z.d2 := x.aO; z.form := 4
ELSIF x.lev = level THEN
z.gen := 18H; z.dl := x.aO; z.form := 3
ELSIF x.lev + 1 = level THEN
z.gen := 10H; z.dl := 8; z.d2 := x.aO; z.form := 4
ELSE downlevel(z.gen); z.dl := x.aO; z.form := 3
END
| Ind: IF x.lev = 0 THEN
z.gen := 12H; z.dl := x.aO; z.d2 := x.al; z.form := 4
ELSIF x.lev = level THEN
z.gen := 10H; z.dl := x.aO; z.d2 := x.al; z.form := 4
ELSE downlevel(z.gen);
PutF3((z.gen * 20H + z.gen - 8) * 40H + 17H); PutDisp(x.aO);
z.dl := x.al; z.form := 3
END
| Regl: z.gen := SHORT(x.aO) + 8; z.dl := x.al; z.form := 3
| VarX: index;
IF x.lev = О THEN
z.inx := 1AH; z.dl := x.aO; z.form := 6
ELSIF x.lev < 0 THEN (*EXT*)
z.inx := 16H; z.dl := - x.lev; z.d2 := x.aO; z.form := 7
ELSIF x.lev = level THEN
z.inx := 18H; z.dl := x.aO; z.form := 6
ELSIF x.lev + 1 = level THEN
z.inx := 10H; z.dl := 8; z.d2 := x.aO; z.form := 7
ELSE downlevel(z.inx); z.dl := x.aO; z.form := 6
END;
z.inx := z.inx * 8 + SH0RT(x.a2)
I IndX: index;
Генераиия кода
йШ
454
Компилятор
IF x.lev - 0 THEN
z.inx := 12H; z.dl := x.aO; z.d2 := x.al; z.form := 7
ELSIF x.lev = level THEN
z.inx := 10H; z.dl := x.aO; z.d2 := x.al; z.form := 7
ELSE downlevel(z.inx);
PutF3((z.inx * 20H + z.inx - 8) * 40H + 17H); PutDisp(x.aO);
z.d1 := x.a1; z.form := 6
END;
z.inx := z.inx * 8 + SH0RT(x.a2)
| RegX: index; z.inx := SHORT((x.aO + 8) * 8 + x.a2); z.dl := x.al;
z.form := 6
| Con: CASE x.typ.form OF
Undef, Byte, Bool, Char, Sint:
z.gen := 14H; z.inx := 1; z.dl := x.aO; z.form := 0
| Int: z.gen := 14H; z.inx := 2; z.dl := x.aO; z.form := 0
| Lint, Real, Set, Pointer, ProcTyp, NilTyp:
z.gen := 14H; z.inx := 4; z.dl := x.aO; z.form := 0
| LReal:
z.gen := 14H; z.inx := 8; z.dl := x.aO; z.d2 := x.al; z.form := 0
| String:
z.gen := 1AH; z.dl := x.aO; z.form := 3
END
| Reg: z.gen := SHORT(x.aO); z.form := 2
| Stk: z.gen := 17H; z.form := 2
| Abs: z.gen := 15H; z.form := 1; z.dl := x.aO
| Coc, Fid .. Head: OCS.Mark(126); x.mode := Var; z.form := 0
END
END Operand;
PROCEDURE PutFO* (cond: LONGINT);
BEGIN code[pc] := CHR(cond * 10H + 10); INC(pc)
END PutFO;
PROCEDURE PutFI* (op: INTEGER);
BEGIN code[pc] := CHR(op); INC(pc)
END PutFI;
PROCEDURE PutF2* (op: INTEGER; short: LONGINT; VAR x: OCT.Item);
VAR dst: Argument;
BEGIN Operand(x, dst);
code[pc] := CHR(SHORT(short) MOD 2 * 80H + op); INC(pc);
code[pc] := CHR(dst.gen * 8 + SHORT(short) MOD 10H DIV 2);
INC(pc);
IF dst.form > 4 THEN code[pc] := CHR(dst.inx); INC(pc) END;
PutArg(dst)
END PutF2;
PROCEDURE PutF4* (op: INTEGER; VAR x, y: OCT.Item);
VAR dst, src: Argument;
Генерация кода
BEGIN Operand(x, dst); Operand(y, src);
code[pc] ;= CHR(dst.gen MOD 4 * 40H + op); INC(pc);
code[pc] ;= CHR(src.gen * 8 + dst.gen DIV 4); INC(pc);
IF src.form > 4 THEN code[pc] := CHR(src.inx); INC(pc) END;
IF dst.form > 4 THEN code[pc] ;= CHR(dst.inx); INC(pc) END;
PutArg(src); PutArg(dst)
END PutF4;
PROCEDURE Put* (F, op; INTEGER; VAR x, y; OCT.Item);
VAR dst, src: Argument;
BEGIN Operand(x, dst); Operand(y, src); code[pc] := CHR(F); INC(pc);
code[pc] := CHR(dst.gen MOD 4 * 40H + op); INC(pc);
code[pc] := CHR(src.gen * 8 + dst.gen DIV 4); INC(pc);
IF src.form > 4 THEN code[pc] := CHR(src.inx); INC(pc) END;
IF dst.form > 4 THEN code[pc] := CHR(dst.inx); INC(pc) END;
PutArg(src); PutArg(dst)
END Put;
PROCEDURE AllocTypDesc* (typ: OCT.Struct); (* typ.form = Record *)
BEGIN INC(conx, ( - conx) MOD 4); typ.mno := 0; typ.adr := conx;
IF typ.n > MaxExts THEN OCS.Mark(233)
ELSIF nofrec < MaxRecs THEN
PtrTab[nofptrs] := conx; INC(nofptrs);
AllocInt(O); AllocInt(O)
ELSE OCS.Mark(223)
END
END AllocTypDesc;
PROCEDURE InitTypDescs*;
VAR x, y: OCT.Item; i: INTEGER; typ: OCT.Struct;
BEGIN
x.mode := Ind; x.lev := 0; y.mode := Var; i := 0;
WHILE i < nofrec DO typ := RecTab[i]; INC(i); x.aO := typ.adr;
WHILE typ.BaseTyp # NIL DO (^инициализация полей основных гэгов*)
x.al := typ.n * 4; y.lev := - typ.mno; y.aO := typ.adr;
PutF4(17H, x, y);
typ := typ.BaseTyp
END
END
END InitTypDescs;
PROCEDURE SaveRegisters* (VAR gR, fR: SET; VAR x: OCT.Item);
VAR i, r, m: INTEGER; t: SET;
BEGIN t := RegSet;
IF x.mode IN {Reg, Regl, RegX} THEN EXCL(RegSet, x.aO) END;
IF x.mode IN {VarX, IndX, RegX} THEN EXCL(RegSet, x.a2) END;
gR := RegSet; fR := FRegSet;
IF RegSet и {} THEN
i := 0; r := 1; m := 0;
ЕШ
456
Компилятор
REPEAT
IF i IN RegSet THEN INC(m, r) END;
INC(r, r); INC(i)
UNTIL i - 8;
PutFI(62H); PutByte(m)
END;
RegSet := t - RegSet; i := 0;
WHILE FRegSet # {} DO
IF i IN FRegSet THEN
PutFI(F11); PutF3(i * 800H + 5C4H); EXCL(FRegSet, i)
END;
INC(i, 2)
END
END SaveRegisters;
PROCEDURE RestoreRegisters* (gR, fR: SET; VAR x: OCT.Item);
VAR i, r, m: INTEGER; y: OCT.Item;
BEGIN RegSet := gR; FRegSet := fR; i := 8;
(*задать вид результата*) x.rnode := Reg; x.aO := 0;
IF (x.typ.form = Real) OR (x.typ.form = LReal) THEN
IF 0 IN fR THEN GetFReg(y); Put(F11, 4, y, x); x.aO := y.aO END;
INCL(FRegSet, 0)
ELSE
IF 0 IN gR THEN GetReg(y); PutF4(17H, y, x); x.aO := y.aO END;
INCL(RegSet, 0)
END;
WHILE fR # {} DO
DEC(i, 2);
IF i IN fR THEN
PutFI(F11); PutF3(i * 40H - 47FCH); EXCL(fR, i)
END
END;
IF gR # {} THEN
i : = 8; r : = 1; m : = 0;
REPEAT DEC(i);
IF i IN gR THEN INC(m, r) END;
INC(r, r)
UNTIL i = 0;
PutFI(72H); PutFI(m)
END
END RestoreRegisters;
PROCEDURE DynArrAdr* (VAR x, y: OCT.Item); (* x := ADR(y) *)
VAR 1, z: OCT.Item;
BEGIN
WHILE y.typ.form = DynArr DO (* индекст - с нуля*)
IF y.mode = IndX THEN
l.mode := Var; l.aO := y.aO + y.typ.adr; l.lev := y.lev;
(* 1 = фактическая размерность - 1 *)
z.mode := Con; z.aO := 0; z.typ := OCT.inttyp;
Put(2EH, SH0RT(y.a2) * 8 + 5, z, 1) (* INDEXW inxreg, 1, 0 *)
END;
y.typ := y.typ.BaseTyp
END;
IF (y.mode = Var) OR (y.mode = Ind) & (y.al = 0) THEN
y.mode := Var; PutF4(17H, x, y) (* MOVD *)
ELSE PutF4(27H, x, y); x.al := 0 (* ADDR *)
END
END DynArrAdr;
PROCEDURE Entry* (i: INTEGER): INTEGER;
BEGIN RETURN entry[i]
END Entry;
PROCEDURE SetEntry* (i: INTEGER);
BEGIN entry[i] := pc
END SetEntry;
PROCEDURE LinkAdr* (nr. INTEGER; n: LONGINT): INTEGER;
BEGIN
IF lnkx >= LinkLength THEN OCS.Mark(231); lnkx := 0 END;
linkClnkx] := m * 100H + SHORT(n); INC(lnkx); RETURN lnkx - 1
END LinkAdr;
PROCEDURE SetLinkTable* (n: INTEGER);
BEGIN (*базовые адреса импортированных модулей*) lnkx := 0;
WHILE lnkx < n DO link[lnkx] := lnkx * 100H + 255; INC(lnkx) END
END SetLinkTable;
PROCEDURE fixup* (loc: LONGINT); (*учесть pc в loc*)
VAR x: LONGINT;
BEGIN x := pc - loc + 8001H;
code[loc] := CHR(x DIV 100H); code[loc + 1] := CHR(x)
END fixup;
PROCEDURE fixupC* (loc: LONGINT);
VAR x: LONGINT;
BEGIN x := pc + 1 - loc;
IF x > 3 THEN
IF x < 2000H THEN
code[loc] := CHR(x DIV 100H + 80H); code[loc + 1] := CHR(x)
ELSE OCS.Mark(211)
END
ELSE DEC(pc, 3)
END
END fixupC;
PROCEDURE fixupL* (loc: LONGINT);
Генерация кода
457
VAR x: LONGINT;
BEGIN x := pc + 1 - loc;
IF x > 5 THEN
code[loc + 2] := CHR(x DIV 100H); code[loc + 3] := CHR(x)
ELSE DEC(pc, 5)
END
END fixupL;
PROCEDURE FixLink* (L: LONGINT);
VAR L1: LONGINT;
BEGIN
WHILE L # О DO
L1 := ORD(code[L]) * 100H + ORD(code[L + 1]);
fixup(L); L := L1
END
END FixLink;
PROCEDURE FixupWith* (L, val: LONGINT);
VAR x: LONGINT;
BEGIN x := val MOD 4000H + 8000H;
IF ABS(val) >= 2000H THEN OCS.Mark(208) END;
code[L] := CHR(x DIV 100H); code[L + 1] := CHR(x)
END FixupWith;
PROCEDURE FixLinkWith* (L, val: LONGINT);
VAR L1: LONGINT;
BEGIN
WHILE L # 0 DO
L1 := ORD(code[L]) * 100H + ORD(code[L + 1]);
FixupWith(L, val + 1 - L); L := L1
END
END FixLinkWith;
PROCEDURE MergedLinks* (LO, L1: LONGINT): LONGINT;
VAR L2, L3: LONGINT;
BEGIN (*слить цепочки двух операндов операций AND и OR *)
IF LO # О THEN L2 := LO;
LOOP L3 := 0RD(code[L2]) * 100H + 0RD(code[L2 + 1]);
IF L3 = О THEN EXIT END;
L2 : = L3
END;
code[L2] := CHR(L1 DIV 100H); code[L2 + 1] := CHR(LI);
RETURN LO
ELSE RETURN L1
END
END MergedLinks;
PROCEDURE Init*;
VAR i: INTEGER;
Компилятор
458 I
BEGIN pc := 0; level := 0; lnkx := 0; conx := 0; nofptrs := 0; nofrec := 0;
RegSet := {}; FRegSet := {}; i := 0;
REPEAT entry[i] := 0; INC(i) UNTIL i = EntryLength
END Init;
PROCEDURE OutCode* (VAR name, progid: ARRAY OF CHAR;
key: LONGINT; entno: INTEGER; datasize: LONGINT);
CONST ObjMark = 0F8X;
VAR ch: CHAR; f, i, m: INTEGER;
K, s, sO, refpos: LONGINT;
nofcom, comsize, align: INTEGER;
obj: OCT.Object;
typ: OCT.Struct;
Obj File: Files.File;
out: Files.Rider;
ComTab: ARRAY MaxComs OF OCT.Object;
PROCEDURE W (n: INTEGER);
BEGIN Files.Write(out, CHR(n)); Files.Write(out, CHR(n DIV 10ОН))
END W;
PROCEDURE WriteName (VAR name: ARRAY OF CHAR; n: INTEGER);
VAR i: INTEGER; ch: CHAR;
BEGIN i := 0;
REPEAT ch := name[i]; Files.Write(out, ch); INC(i) UNTIL ch = OX;
WHILE i < n DO Files.Write(out, OX); INC(i) END
END WriteName;
PROCEDURE FindPtrs (typ: OCT.Struct; adr: LONGINT);
VAR fid: OCT.Object; btyp: OCT.Struct;
i, n, s: LONGINT;
BEGIN
IF typ.form = Pointer THEN
IF nofptrs < MaxPtrs THEN PtrTab[nofptrs] := adr; INC(nofptrs)
ELSE OCS.Mark(222)
END
ELSIF typ.form = Record THEN
btyp := typ.BaseTyp;
IF btyp # NIL THEN FindPtrs(btyp, adr) END;
fid := typ.link;
WHILE fid # NIL DO
IF fid.name # "" THEN FindPtrs(fld.typ, fld.aO + adr)
ELSIF nofptrs < MaxPtrs THEN PtrTab[nofptrs] := fld.aO + adr;
INC(nofptrs)
ELSE OCS.Mark(222)
END;
fid :='fid.next
END
ELSIF typ.form = Array THEN
Генерация кода
460
Компилятор
btyp := typ.BaseTyp; n := typ.n;
WHILE btyp. form = Array DO n := btyp.n * n; btyp := btyp. BaseTyp END'
IF(btyp.form = Pointer) OR (btyp.form = Record) THEN
i := 0; s := btyp.size;
WHILE i < n DO FindPtrs(btyp, i * s + adr); INC(i) END
END
END
END FindPtrs;
PROCEDURE PtrsAndComs;
VAR obj, par: OCT.Object; u: INTEGER;
BEGIN obj := OCT.topScope.next;
WHILE obj # NIL DO
IF obj.mode = XProc THEN par := obj.dsc;
IF entry[SHORT(obj.aO)] = 0 THEN OCS.Mark(129)
ELSIF (obj.marked) & (obj.typ = OCT.notyp) &
((par = NIL) OR (par.mode > 3) OR (par.aO < 0)) THEN
(★команда*)
u := 0;
WHILE obj.name[u] > OX DO INC(comsize); INC(u) END;
INC(comsize, 3);
IF nofcom < MaxComs THEN ComTab[nofcom] := obj;
INC(nofcom)
ELSE OCS.Mark(232); nofcom := 0; comsize := 0
END
END
ELSIF obj.mode = Var THEN
FindPtrs(obj.typ, obj.aO)
END;
obj := obj.next
END
END PtrsAndComs;
PROCEDURE OutRefBlk (first: OCT.Object; pc: INTEGER; name: ARRAY OF CHAR);
VAR obj: OCT.Object;
BEGIN obj := first;
WHILE obj # NIL DO
IF obj.mode IN {LProc, XProc, IProc} THEN
OutRefBlk(obj.dsc, obj.a2, obj.name)
END;
obj := obj.next
END;
Files.Write(out, 0F8X); Files.WriteBytes(out, pc, 2); WriteName(name, 0);
obj := first;
WHILE obj # NIL DO
IF (obj.mode = Var) OR (obj.mode = Ind) THEN
f := obj.typ.form;
IF (f IN {Byte .. Set, Pointer})
OR (f = Array) & (obj.typ.BaseTyp.form = Char) THEN
Files.Write(out, CHR(obj.mode)); Files.Write(out, CHR(f));
Files.WriteBytes(out, obj.aO, 4); WriteName(obj.name, 0)
END
END;
obj := obj.next
END
END OutRefBlk;
BEGIN (*0utCode*) Obj File := Files.New(name);
IF ObjFile # NIL THEN
Files.Set(out, Obj File, 0);
WHILE pc MOD 4 # 0 DO PutF1(0A2H) END; (*N0P*)
INC(conx, ( - conx) MOD 4);
nofcom := 0; cornsize := 1;
PtrsAndComs; align := comsize MOD 2; INC(comsize, align);
(*блок заголовка*)
Files.Write(out, ObjMark); Files.Write(out, "6”); W(0); W(0);
W(entno); W(comsize); W(nofptrs); W(0CT.nofGmod);
W(lnkx); Files.WriteBytes(out, datasize, 4); W(conx); W(pc);
Files.WriteBytes(out, key, 4); WriteName(progid, 20);
(*блок входов*)
Files.Write(out, 82X); Files.WriteBytes(out, entry, 2 * entno);
(*блок команд*)
Files.Write(out, 83X);
i := 0; (*записать имена команд и адреса входов*)
WHILE i < nofcom DO
obj := ComTab[i]; WriteName(obj.name, 0); W(entry[obj.aO]); INC(i)
END;
Files.Write(out, OX);
IF align > 0 THEN Files.Write(out, OFFX) END;
(*блок указателей*)
Files.Write(out, 84X); i := 0;
WHILE i < nofptrs DO
IF PtrTab[i] < - 4000H THEN OCS.Mark(225) END;
Files.WriteBytes(out, PtrTab[i], 2); INC(i)
END;
(*блок импортов*)
Files.Write(out, 85X); i := 0;
WHILE i < OCT.nofGmod DO
obj := OCT.GlbMod[i];
Files.WriteBytes(out, obj.al, 4); WriteName(obj.name, 0);
Files.Write(out, OX);
INC(i)
END;
(*блок связей*)
Files.Write(out, 86X); Files.WriteBytes(out, link, 2 * lnkx);
(*блок данных*)
Files.Write(out, 87X); Files.WriteBytes(out, constant, conx);
(*блок кода*)
Генерация кода
46 Т
462
Компилятор
Files.Write(out, 88Х); Files.WriteBytes(out, code, pc);
(*блок типов*)
Files.Write(out, 89X); i := 0;
WHILE i < nofrec DO
typ := RecTab[i]; s := typ.size +4; m := 4; sO := 16;
WHILE (m > 0) & (s > sO) DO INC(sO, sO); DEC(m) END;
IF s > sO THEN sO := (s + 127) DIV 128 * 128 END;
nofptrs := 0; FindPtrs(typ, 0);
s := nofptrs * 2 + (MaxExts + 1) * 4; Files.WriteBytes(out, s, 2);
(*размер дескриптора типа*)
Files.WriteBytes(out, typ.adr, 2); (*адрес дескриптора типа*)
К := LONG(nofptrs) * ЮОООООН + sO; Files.WriteBytes(out, K, 4);
К := 0; m := 0;
REPEAT Files.WriteBytes(out, K, 4); INC(m) UNTIL m = MaxExts;
m : = 0;
WHILE m < nofptrs DO
Files.WriteBytes(out, PtrTab[m], 2); INC(m)
END;
INC(i)
END;
(*справочный блок*)
refpos := Files.Pos(out); Files.Write(out, 8AX);
OutRefBlk(OCT.topScope.next, pc, "$$");
Files.Set(out, Obj File, 2); Files.WriteBytes(out, refpos, 4);
IF ~0CS.scanerr THEN Files.Register(ObjFile) END
ELSE OCS.Mark(153)
END
END OutCode;
PROCEDURE Close*;
VAR i; INTEGER;
BEGIN l := 0;
WHILE i < MaxRecs DO RecTab[i] := NIL; INC(i) END
END Close;
BEGIN NEW(wasderef)
END OCC.
12.9. Средство символьной отладки
Средство, описанное в этом разделе, на самом деле не является частью ком¬
пилятора, но тем не менее глубоко связано с ним схемой распределения памяти.
Это средство используется для генерации текста, отображающего состояние вы¬
числений в случае аварийного завершения команды. Состояние представляется
цепочкой активированных процедур с их локальными переменными в момент
прерывания. Поскольку текущие значения переменных отображаются в том лее
виде, что и в исходной программе (то есть в символьном, а не в двоичном), та¬
кое средство обычно называют символьным отладчиком. Он представляет собой
командную процедуру Trap, которая, однако, не доступна пользователям, а вызы¬
вается системой всякий раз, когда в программе возникает аварийное состояние.
Конкретно, процедура определена в модуле System и устанавливается в перемен¬
ной-процедуре модуля Kernel.
В момент прерывания различные регистровые значения хранятся в экспор¬
тируемых переменных ядра. Kemel.err указывает на номер прерывания (опреде¬
ленного процессором). Приведем здесь только наболее часто встречающиеся пре¬
рывания:
Средство сивольной отладки
ШШ
2
Адресное прерывание
Обычно это обращение но указателю NIL
3
Вещественное прерывание
Переполнение
6
Деление на ноль
7
Прерывание по флагу
Недопустимый индекс
13
Целочисленное прерывание
(или недопустимый индекс)
Переполнение
18
Нарушение защиты типа
Для примера давайте рассмотрим следующую команду:
PROCEDURE Q(multiplier, count: INTEGER);
VAR sum: LONGINT; ch: CHAR;
BEGIN sum := 1234567; ch := «0»; Q(multiplier*100, count+1)
END Q;
PROCEDURE Trap*;
VAR s: ARRAY 32 OF CHAR;
BEGIN s := "This command never terminates!"); 0(1, 0)
END Trap;
Ниже приведен текст, сгенерированный и отображенный в окошке прерыва¬
ния после попытки умножения, вызвавшего арифметическое переполнение:
TRAP 13 FP = 002FFDD0 PC = 00443053
Demo.Q
multiplier = 10000
count = 2
sum = 1234567
ch = Q
Demo.Q
multiplier = 100
count = 1
sum = 1234567 ch = Q
Demo.Q
multiplier = 1
count = 0
sum = 1234567
ch = Q
Demo.T rap
Компилятор
msg = "This command never terminates!"
Oberon.Call
TextFrames.Call
TextFrames.Edit
TextFrames.Handle
MenuViewers.Handle
Oberon.Loop •
Modules.$$
Чтобы выявить текущие активные процедуры и привести список их локаль¬
ных переменных с их текущими значениями, программа обработки системных
прерываний должна иметь не только свободный доступ к стеку, где эти значения
размещены, но и возможность располагать информацией об отображении исход¬
ной программы в хранимый в памяти код. На самом деле это отображение должно
быть обратным. Необходимая информация содержится в справочной часты объ¬
ектного файла каждого модуля. Это последняя часть объектного файла, которая
игнорируется загрузчиком. Чтобы обеспечить к ней быстрый доступ, байты 2-5
задают позицию справочной части.
Справочная часть генерируется процедурой OutRefBlk, локализованной
в OCC.OutCode. Она генерирует вход в справочную часть объектного файла для
каждой процедуры и некоторых из ее локальных переменных. Так как процедуры
могут быть вложенными, OutRefBlk рекурсивна. Для процедуры указываются имя
и смещение в разделе кода блока модуля, для переменных - их имя, смещение
адреса и тип (форма). Синтаксис справочной части таков:
ReferencePart = {procedure}.
procedure = 0F8X offset:2 name {procedure | variable},
variable = form:1 mode:1 offset:4 name,
name = {character} OX.
Тела модулей обрабатываются подобно процедурам; вместо имени стоит «$$».
Маркеры со значением F8X служат для того, чтобы отличить вход процедуры от
входа переменной, form принимает одно из следующих значений:
Структурные переменные в справочную часть не входят, за исключением ко¬
ротких массивов литер, которые принимают вид строк, mode предполагает одно из
значений:
Реализация процесса генерации нужной информации может быть подробно
разобрана по приведенному ниже тексту программы. Прежде всего процедура
System.Trap определяет начало динамической цепочки записей активации про¬
1 прямая адресация 3 косвенная адресация (VAR-параметр)
464 |
2 BOOLEAN 6 LONGINT 13 POINTER
3 CHAR 7 REAL 14 Procedure type
4 SHORTINT 8 LONGREAL 15 Character array type
5 INTEGER 9 SET
цедур. Это значение содержится в регистре FP и теперь обозначается Kernelfp.
Адрес прерывания задается в Kernel.рс, а модуль с прерванной процедурой - в Ker¬
nel-mod. Теперь эту процедуру нужно обнаружить. Это достигается обращением
к объектному файлу соответствующего модуля, чье имя находится в дескрипторе
модуля. Справочная часть файла просматривается, пока не найдется процедура,
в пределах которой находится указанное значение рс (адрес прерывания). Если
процедура найдена, то ее имя вносится в перечень и просматривается список ее ло¬
кальных переменных. Для каждой из них из справочной части считывается имя и
вносится в перечень прерывания, затем считывается его смещение для получения
его текущего значения из стека и внесения его в перечень в формате, соответст¬
вующем указанному виду
Потом Trap продолжает просмотр по цепочке записей активации процедур и
для каждой записи повторяет этот процесс. Просмотр локальных переменных вы¬
полняется процедурой Locals, чей параметр задает базовый адрес соответствую¬
щей записи активации.
PROCEDURE Locals (VAR R: Files.Rider; base: LONGINT);
VAR adr, val: LONGINT;
sval, form: SHORTINT;
ch, mode: CHAR
ival, i: INTEGER;
rval: REAL;
lrval: LONGREAL;
BEGIN Texts.WriteLn(W); Files.Read(R, mode);
WHILE "R.eof & (mode < 0F8X) DO
Files.Read(R, form); Files.ReadBytes(R, adr, 4);
Texts.WriteString(W, " "); Files.Read(R, ch);
WHILE ch > OX DO Texts.Write(W, ch); Files.Read(R, ch) END;
Texts.WriteString(W, " = "); INC(adr, base);
IF mode = 3X THEN SYSTEM.GET(adr, adr) («косвенная адресация*) END;
CASE form OF
2: (*B00L*) SYSTEM.GET(adr, sval);
IF sval = 0 THEN Texts.WriteString(W, "FALSE")
ELSE Texts.WriteString(W, "TRUE")
END
| 1, 3: (*CHAR*) SYSTEM.GET(adr, ch);
IF (" " <= ch) & (ch <= "~") THEN Texts.Write(W, ch)
ELSE Texts.WriteHex(W, ORD(ch)); Texts.Write(W, "X")
END
| 4: (*SINT*) SYSTEM.GET(adr, sval); Texts.WriteInt(W, sval, 1)
| 5: (*INT*) SYSTEM.GET(adr, ival); Texts.WriteInt(W, ival, 1)
| 6: (*LINT*) SYSTEM.GET(adr, val); Texts.WriteInt(W, val, 1)
| 7: (*REAL*) SYSTEM.GET(adr, rval); Texts.WriteReal(W, rval, 14)
| 8: (* LREAL*) SYSTEM.GET(adr, lrval); Texts.WriteLongReal(W, lrval, 21)
| 9, 13, 14: (*SET, POINTER*)
SYSTEM.GET(adr, val); Texts.WriteHex(W, val); Texts.Write(W, "H")
| 15: (*Строка*) i := 0; Texts.Write(W, 22X);
Средство сивольной отладки
mm
LOOP SYSTEM.GET(adr, ch);
IF (ch < " ") OR (ch >= 90X) OR (i = 32) THEN EXIT END;
Texts.Write(W, ch); INC(i); INC(adr)
END;
Texts.Write(W, 22X)
END;
Texts.WriteLn(W); Files.Read(R, mode)
END
END Locals;
PROCEDURE* Trap;
VAR V: Viewers.Viewer;
RefFile: Files.File;
R: Files.Rider;
fp, pc, refpos, dmy: LONGINT;
ch, mode: CHAR;
X, Y, i: INTEGER;
mod, curmod: Modules.Module;
name: Modules.ModuleName;
BEGIN
IF "trapped THEN (*глобальная переменная как защита от рекурсивных прерываний*)
trapped := TRUE; Т := TextFrames.Text("");
Oberon.AllocateSystemViewer(0, X, Y);
V := MenuViewers.New(TextFrames.NewMenu("System.Trap", StandardMenu),
TextFrames.NewText(T, 0), TextFrames.menuH, X, Y);
IF V.state > 0 THEN
fp := Kernel.fp; pc := Kernel.pc; curmod := NIL;
mod := SYSTEM.VAL(Modules.Module, Kernel.mod MOD 10000H);
Texts.WriteString(W, "TRAP "); Texts.WriteInt(W, Kernel.err, 1);
Texts.WriteString(W, " FP ="); Texts.WriteHex(W, fp);
Texts.WriteString(W, " PC ="); Texts.WriteHex(W, pc);
IF Kernel.err = 2 THEN
Texts.WriteString(W, " EIA ="); Texts.WriteHex(W, Kernel.eia)
ELSIF Kernel.err = 20 THEN
Texts.WriteString(W, " sect ="); Texts.WriteHex(W, Kernel.SectNo)
END;
Texts.WriteLn(W);
LOOP Texts.WriteString(W, mod.name); Texts.Append(T, W.buf);
IF mod # curmod THEN
(★загрузить объектный файл*) i := 0;
WHILE mod.name[i] > OX DO name[i] := mod.name[i];
INC(i) END;
name[i] := name[i + 1] := ”0"; name[i + 2] := "b”;
name[i + 3] := "j"; name[i + 4] := OX;
RefFile := Files.Old(name);
IF RefFile = NIL THEN curmod := NIL; Texts.WriteLn(W)
ELSE curmod := mod; Files.Set(R, RefFile, 2);
Files.ReadBytes(R, refpos, 4);
Files.Set(R, RefFile, refpos); Files.Read(R, ch);
466
Компилятор
Средство сивольной отладки
IF ch = 8АХ THEN INC(refpos)
ELSE curmod ; = NIL;
Texts.WriteInt(W, pc - mod.PB, 7); Texts.WriteLn(W)
END
END
END;
IF curmod # NIL THEN (*найти процедуру*)
Files.Set(R, RefFile, refpos);
LOOP Files.Read(R, ch);
IF R.eof THEN EXIT END;
IF ch = 0F8X THEN (*начало процедуры*)
Files.ReadBytes(R, i, 2);
IF pc < mod.PB + i THEN EXIT END;
REPEAT Files.Read(R, ch) UNTIL ch = OX;
(пропустить имя*)
ELSIF ch < 0F8X THEN (пропустить объект*)
Files.Read(R, ch); Files.ReadBytes(R, dmy, 4);
REPEAT Files.Read(R, ch) UNTIL ch = OX;
(♦пропустить имя*)
END
END;
IF ~R.eof THEN
Texts.Write(W, "."); Files.Read(R, ch);
WHILE ch > OX DO Texts.Write(W, ch);
Files.Read(R, ch) END;
Texts.Append(T, W.buf); Locals(R, fp)
END
END;
SYSTEM.GET(fp + 4, pc); SYSTEM.GET(fp, fp);
IF fp >= Kernel.StackOrg THEN EXIT END;
mod := SYSTEM.VAL(Modules.Module, Kernel.ModList);
(*найти модуль следующей процедуры*)
WHILE (mod # NIL) &
((pc < mod.PB) OR (mod.size + mod.BB <= pc)) DO
mod := mod.link
END;
IF mod = NIL THEN EXIT END
END;
Texts.Append(T, W.buf)
END;
trapped := FALSE
END
END Trap;
Программа обработки прерываний работает в привилегированном режиме и
использует системный стек. Поэтому она работает правильно даже в случае пере¬
полнения стека. Мы предполагаем, что она сама не вызывает других прерываний,
за тем лишь исключением, когда возникает переполнение динамической памяти
при выполнении ею операций вывода. Глобальная переменная состояния trapped
шш
предотвращает возникновение рекурсивных прерываний. По окончании обработ¬
ки прерывания управление возвращается ядру, а стек сбрасывается.
Дополнительная выгода от наличия процедуры Locals - в том, что глобальные
переменные модуля тоже могут перечисляться таким же образом. Командная про¬
цедура System.State служит именно этой цели. Имя инспектируемого модуля зада¬
ется в качестве параметра, а соответствующий дескриптор модуля получается по¬
иском в списке дескрипторов модулей с заголовком Kemel.ModList. Базовый адрес
области глобальных переменных задается статической базой модуля mod.SB.
PROCEDURE OutState (VAR name: ARRAY OF CHAR; t: Texts.Text);
VAR mod: Modules.Module;
refpos: LONGINT;
ch: CHAR; X, Y, i: INTEGER;
F: Files.File; R: Files.Rider;
BEGIN
Texts. WriteString(W, name); mod := SYSTEM. VAL(Modules. Module, Kemel.ModList);
WHILE (mod # NIL) & (mod.name # name) DO mod := mod.link END;
IF mod # NIL THEN
i := 0;
WHILE (i < 28) & (name[i] > OX) DO INC(i) END;
name[i] := name[i + 1] := "0"; name[i + 2] := "b"; name[i + 3] := "j";
name[i + 4] := OX;
F := Files.Old(name);
IF F # NIL THEN
Texts.WriteString(W, " SB ="); Texts.WriteHex(W, mod.SB);
Files.Set(R, F, 2); Files.ReadBytes(R, refpos, 4); Files.Set(R, F, refpos + 1);
LOOP Files.Read(R, ch);
IF R.eof THEN EXIT END;
IF ch = 0F8X THEN
Files.ReadBytes(R, i, 2); Files.Read(R, ch);
IF ch = "$" THEN Files.Read(R, ch); Files.Read(R, ch); EXIT END;
REPEAT Files.Read(R, ch) UNTIL ch = OX ^пропустить имя*)
ELSIF ch < 0F8X THEN (*пропустить объект*)
Files.Read(R, ch); Files.Read(R, ch); Files.Read(R, ch);
REPEAT Files.Read(R, ch) UNTIL ch = OX; (*пропустить имя*)
END
END;
IF ~R.eof THEN Locals(R, mod.SB) END
ELSE Texts.WriteString(W, ‘‘.Obj not found”)
END
ELSE Texts.WriteString(W, “ not loaded")
END;
Texts.WriteLn(W); Texts.Append(t, W.buf)
END OutState;
PROCEDURE State*;
VAR T: Texts.Text;
S: Texts.Scanner;
468
Компилятор
Средство сивольнои отладки
V: Viewers.Viewer;
beg, end, time: LONGINT;
BEGIN Texts.OpenScanner(S, Oberon.Par.text, Oberon.Par.pos); Texts.Scan(S);
IF S.class = Texts.Name THEN
Oberon.AllocateSystemViewer(Oberon.Par.vwr.X, X, Y);
T := TextFrames.Text("");
V := MenuViewers.New(TextFrames.NewMenu("System.State", StandardMenu),
TextFrames.NewText(T, 0), TextFrames.menuH, X, Y);
0utState(S.s, T)
END
END State;
Ш-i
13. ГРАФИЧЕСКИЙ РЕДАКТОР
13.1. История и назначение
Возникновение графических систем, каковыми они являются теперь, было
тесно связано с появлением дисплея с битовой матрицей высокого разрешения
и мыши в качестве указывающего устройства. Первое знакомство автора с таким
оборудованием относится к 1976 году Компьютер Alto Исследовательского цент¬
ра Xerox в Пало-Альто (Xerox Palo Alto Research Center) справедливо называют
первой рабочей станцией с такими возможностями. Разработчиком ее первого
пакета графических подпрограмм был Ч. Тэкер (Ch. Thacker), который осознал
пригодность экрана с высокой разрешающей способностью для рисования и об¬
работки чертежей электронных схем. Данная система была умело приспособлена
к нуждам этой деятельности и отличалась компактностью и эффективностью из-
за отсутствия излишеств. И действительно, ее сокращение SIL (для Simple Illus¬
trator) значит «простой иллюстратор».
После тщательного изучения применявшихся методов автор разработал ва¬
риант, написанный на языке Модула-2 (вместо BCPL) для компьютера PDP-11,
упорядочив и точнее представив таким образом используемые структуры данных.
Примерно в течение двух лет эта система пересматривалась и постепенно превра¬
щалась в нынешнюю систему Draw. Главной целью оставалась простая система
рисования линий: упор делался на ясную структуру и повышение гибкости за счет
обобщения существующих возможностей, а не беспорядочного добавления новых.
В истории этой эволюции можно проследить три главных этапа. Первым был
переход от одного «окна», экрана, ко многим окнам, включая окна, показываю¬
щие различные фрагменты одного и того же рисунка. Этот этап был выполнен
на компьютере Lilith, который во многом напоминал Alto. Вторым, главным эта¬
пом было применение объектно-ориентированного стиля программирования,
который позволил добавить новые типы элементов к базовой системе, сделав ее
расширяемой. Третий этап касался надлежащей интеграции системы Draw с текс¬
товой системой Оберона. Последние два этапа были выполнены с использованием
языка Оберон и компьютера Ceres.
Воздержимся от подробностей этой эволюции и просто представим результат,
хотя ее история могла бы быть интересным отражением развития технологии про¬
граммирования вообще, заключая в себе множество полезных уроков. Подчерк¬
нем, однако, что настоящая система опирается на длительную историю разработ¬
ки, во время которой многие средства и методы вводились, а позже отбрасывались
©N. Wirth, 20.4.91 /20.11.91
или пересматривались. Объем описания системы - негодный измеритель усилий
по ее созданию; сокращение текста программы иногда знаменует больший успех,
чем его наращивание.
Целью исходной программы SIL была поддержка разработки чертежей элект¬
ронных схем. SIL была прежде всего системой рисования линий. Это предполагает,
что рисунки остаются без интерпретации. Однако в правильно интегрированной
системе добавление модулей, включающих операции интерпретации рисунков,
является довольно естественным предложением. Фактически система Оберон
идеально подходит для таких шагов, особенно благодаря ее командным средствам.
Поначалу не будем принимать во внимание средства, специально предназначен¬
ные для проектирования схем. Главное из них - макрос - будет обсуждено позже.
Базовая система состоит из модулей Draw, GraphicFrames и Graphics. Эти мо¬
дули содержат средства генерации и обработки горизонтальных и вертикальных
линий, текстовых надписей и макросов. Дополнительные модули служат для
введения других элементов, таких как прямоугольники и окружности, а значит,
система расширяема, то есть для обработки новых типов элементов могут добав¬
ляться новые модули.
13.2. Краткое руководство
по системе рисования линий
в Обероне
Чтобы подготовить почву для последующего описания реализации системы
Draw, предлагаем краткий ее обзор в виде руководства пользователя. В нем со¬
браны предлагаемые системой средства и дается представление о ее разносторон¬
ности.
Система под названием Draw служит для подготовки лииейных чертежей.
Они состоят из линий, текстовых надписей и других элементов и отображаются
в графических окошках (точнее, в графических кадрах окошек меню). Графиче¬
ское окошко показывает фрагмент плоскости чертежа, а несколько окошек могут
показывать различные части чертежа. Часто используемые команды реализованы
щелчками мыши и их комбинациями. Остальные команды выбираются из текс¬
тов - либо из окошек меню (полосок заголовков), либо из текста под названием
Draw.Tool. На рис. 13.1 показан дисплей с двумя графическими окошками слева
и текстом инструментов рисования справа. Когда курсор оказывается в графиче¬
ском кадре, кнопки мыши наделяются следующими основными функциями:
левая рисовать/установить символ вставки
средняя переместить/копировать
правая выделить
Команда мыши идентифицируется (1) изначально нажатой кнопкой кО, (2)
начальной позицией РО курсора, (3) набором нажатых кнопок kl, пока последняя
не отпущена, и (4) позицией курсора Р1 в момент отпускания.
Краткое руководство по системе рисования линий в Обероне
47 It
Графический редактор
Рис. 13.1
13.2.1. Основные команды
Команда Draw.Open открывает новое окошко и отображает граф с именем, дан¬
ным как параметр. Мы предполагаем, что имена файлов используют расширение
Graph.
□ Рисование линии. Чтобы нарисовать горизонтальную или вертикальную
линию от РО до Р1, нажимается левая кнопка с курсором в РО и, пока кноп¬
ка нажата, мышь и курсор перемещаются к Р1. Затем кнопка отпускается.
Если РО и Р1 отличаются по обеим координатам х и у, конечная точка кор¬
ректируется так, чтобы линия была или горизонтальной, или вертикальной.
□ Создание надписи. Сначала курсор помещается туда, где должна появиться
надпись. Затем нажимается левая кнопка, вызывая появление перекрестья.
Оно называется символом вставки. Потом набирается текст. Допускаются
только однострочные тексты. Клавиша Del может использоваться для уда¬
ления символов (возврата на один символ).
□ Выделение. Большинство команд требуют задания операндов, а многие
неявно предполагают, что ранее выделенные элементы - выделение (selec¬
472
tion) - являются их операндами. Отдельный элемент выделяется наведе¬
нием на него курсора с последующим нажатием правой кнопки мыши. Это
сразу вызывает сброс выделения ранее выделенных элементов. Но если
левая кнопка тоже нажата, они остаются выделенными. Это действие на¬
зывается соиажатием (interclick). Чтобы выделить сразу несколько элемен¬
тов, курсор перемещается из РО в Р1 с удержанием правой кнопки. Тогда
выделяются все элементы, лежащие внутри прямоугольника с диагональ¬
но противоположными углами РО и Р1. Выделенные линии отображаются
пунктиром, выделенные надписи (и макросы) - в инверсном видеорежиме.
Макрос выделяется указанием на его самый нижний левый угол. Этот угол
называют областью восприятия.
□ Перемещение. Чтобы передвинуть (переместить) набор элементов, они
сначала выделяются, а затем курсор перемещается из РО в Р1 при нажатой
средней кнопке. Вектор от РО до Р1 задает движение и называется вектором
смещения. РО и Р1 могут лежать в разных окошках, отображающих один и
тот же граф. Небольших смещений можно добиться, используя клавиши
управления курсором на клавиатуре.
□ Копирование. Таким же образом выделенные элементы могут копировать¬
ся (дублироваться). Вместе с нажатой средней кнопкой, задающей вектор
смещения, нажимается левая кнопка. Команда копирования может также
использоваться для копирования элементов одного графа в другой переме¬
щением курсора из одного окошка в другое, отображающее граф-приемник.
Текстовая надпись может копироваться из текстового кадра в графический
кадр, и наоборот. Есть два способа добиться этого: 1. Сначала символ встав¬
ки помещается в позицию приемника, затем выделяется текст и нажимает¬
ся (сонажатием) средняя кнопка. 2. Сначала выделяется текст, а затем в по¬
зицию приемника помещается символ вставки и нажимается (сонажатием)
средняя кнопка.
□ Смещение плоскости. Всю плоскость чертежа можно сдвинуть за пределы
окошка, задав нажатием средней кнопки (как в команде перемещения) век¬
тор смещения и нажав (сонажатием) правую кнопку.
Следующая таблица содержит сводку действий мыши:
Левая
Рисовать линию
Левая (без движения)
Установить символ вставки
Левая + средняя
Копировать выделенную надпись в символ вставки
Левая + правая
Установить вторичный символ вставки
Средняя
Переместить выделение
Средняя + левая
Копировать выделение
Средняя + правая
Сдвинуть плоскость чертежа
Правая
Выделить область
Правая (без движения)
Выделить объект
Правая + средняя
Копировать надпись в символ вставки
Правая + левая
Выделить без отмены выделения
Краткое руководство по системе рисования линий в Обероне
473
13.2.2. Команды меню
Следующие команды отображаются в меню (полосе заголовка) любого графи-
ческого окошка. Они активируются наведением па них курсора мыши и нажатием
средней кнопки.
Draw.Delete Удаляются выделенные элементы.
Draw.Store Чертеж записывается в файл под именем из полосы заголовка.
К имени исходного файла добавляется расширение «.Вак».
Два окошка на рис. 13.1 отображают различные части того же графа. Второй
вид был получен обобщенной командой System.Сору с последующим сдвигом
плоскости чертежа.
Рис. 13.2
13.2.3. Дополнительные команды
Следующие команды приводятся в тексте Draw.Tool, по могут появляться
в любом тексте.
474
Графический редактор
Краткое руководство по системе рисования линий в Обероне
Draw.Store пате Чертеж в помеченном окошке сохраняется как файл с заданным именем.
Draw.Print Server * Чертеж в помеченном окошке печатается на заданном сервере печати.
Draw.Print Server filenamel filename2. .. ". Печатаются названные файлы.
Следующие команды изменяют такие атрибуты элементов чертежа, как шири¬
на линии, шрифт текста, цвет, и применяются к самому последнему выделению.
Draw.SetWidth w значение по умолчанию =1, 0 < w < 7.
Draw.ChangeFont fontname
Draw.ChangeColor с
Draw.ChangeWidth w (0 < w <7)
Команда Change Color принимает в качестве параметра либо номер цвета в диа¬
пазоне 1-15, либо строку. Она служит для копирования цвета выделенного сим¬
вола (см. Draw.Tool).
Несколько действий выполняются управляющими символами клавиатуры.
Они относятся к текущему окошку.
DEL Удалить выделенные элементы
Символы курсора Переместить выделения на 1 шаг в указанном направлении
No Scrll Перерисовать
Cntl / No Scrll Переустановить начало координат и перерисовать
13.2.4. Макросы
Макрос - это (небольшой) чертеж, который может определяться как целое
и использоваться как элемент (большего) чертежа. Обычно макросы хранятся
в коллекциях, называемых библиотеками, из которых они могут по одному вы¬
бираться и копироваться.
Draw.Macro lib mac Макрос mac выбирается из библиотеки с именем lib и вставляется
в чертеж в позиции символа вставки.
Пример использования макросов - черчение диаграмм электронных схем.
Основной библиотечный файл, содержащий часто используемые TTL-комионеп-
ты, называется TTLO.Lib, а чертеж, показывающий его элементы, называется TTL0.
Graph.
13.2.5. Прямоугольники
Прямоугольники могут быть созданы как обособленные элементы. Они часто
используются для обрамления множеств элементов. Прямоугольники состоят
из четырех прямых линий, которые образуют одно целое. Атрибутные команды
Draw.SetWidth, System.SetColor, Draw.ChangeWidth и Draw.ChangeColor также при¬
менимы к прямоугольникам. Прямоугольники выделяются указанием их нижнего
правого угла и создаются следующими шагами:
w
1. Символ вставки помещается туда, где должен лежать угол нового прямо
угольника.
2. Второй символ вставки помещается туда, где должен лежать противопо¬
ложный угол (левая + правая).
3. Активируется команда Rectangle .Make.
Прямоугольники могут заполняться шаблоном штриховки. Штриховка зада¬
ется числом s (0 < s < 9).
Rectangles.SetShade s значение по умолчанию = 0: нет штриховки
Указав па нижний правый угол и нажав среднюю кнопку, угол прямоугольни¬
ка можно перетащить, изменив таким образом размеры прямоугольника.
13.2.6. Наклонные линии, окружности
и эллипсы
Следующие графические элементы - это (наклонные) линии, окружности и
эллипсы. Ообласть восприятия окружностей и эллипсов - в их самой нижней точ¬
ке. Они создаются следующими шагами:
Линии:
1. Символ вставки помещается туда, где должна лежать начальная точка.
2. Второй символ вставки помещается в конечную позицию.
3. Активируется команда Curves.Make Line.
Окружности:
1. Символ вставки помещается туда, где должен лежать центр.
2. Помещается второй символ вставки. Его горизонтальное расстояние от
первого символа вставки задает радиус.
3. Активируется команда Curves.Make Circle.
Эллипсы:
1. Символ вставки помещается туда, где должен лежать центр.
2. Помещается второй символ вставки. Его горизонтальное расстояние от
первого символа вставки задает одну ось.
3. Помещается третий символ вставки. Его вертикальное расстояние от пер¬
вого символа вставки задает другую ось.
4. Активируется команда Curves.Make Ellipse.
13.2.7. Сплайновые кривые
Сплайновые кривые создаются следующими шагами:
1. Символ вставки помещается туда, где должна лежать начальная точка.
2. Второй и последующие символы вставки помещаются в фиксированных
точках сплайна (не более 20).
3. Активируется команда Splines.Make Open или Splines.Make Closed.
476
Графический редактор
13.2.8. Построение нового макроса
Новый макрос создается и заносится в библиотеку lib под именем mac сле¬
дующим образом:
1. Выбраются все элементы, которые должны принадлежать новому макросу.
2. Символ вставки помещается в нижний левый угол области, которую будет
занимать макрос.
3. Второй символ вставки помещается в верхний правый угол области, кото¬
рую будет занимать макрос.
4. Активируется команда Draw.MakeMacro lib mac.
Существующий макрос может быть разбит на составные части (раскрыт) сле¬
дующим образом:
1. Макрос выделяется.
2. Символ вставки помещается в позицию, где должно появиться разбиение.
3. Активируется команда Draw.OpenMacro.
Команда Draw.StoreLibraiy lib file сохраняет библиотеку lib в заданном файле
file. Только текущий загруженный макрос считается принадлежащим библиотеке.
Если нужно добавить некоторый макрос к существующему файлу библиотеки, все
его элементы сначала должны быть загружены. Это лучше всего сделать, открыв
граф, содержащий все макросы нужного файла библиотеки.
13.3. Ядро и его структура
Как и текст, графика состоит из элементов, называемых далее объектами. В от¬
личие от текста, который является последовательностью элементов, графика -
это неупорядоченное множество объектов. В тексте позиция элемента не должна
явно задаваться (храниться); она всякий раз, если нужно, вычисляется по позиции
своего предшественника, например для отображения или выделения элемента.
В графике каждый объект должен явно хранить свою позицию, поскольку он не
зависит от любого другого объекта множества. Это существенное различие, тре¬
бующее различной обработки и гораздо большего объема памяти при том лее ко¬
личестве объектов.
Хотя самое важное - это выбор представления структуры данных, основные
решающие факторы - это вид включаемых объектов и набор применяемых к ним
операций. И здесь SIL задает разумную отправную точку Прежде всего, суще¬
ствует только два вида объектов, а именно: прямые линии (горизонтальные и
вертикальные) и короткие тексты для маркировки линий, называемые надписями
(captions). Удивляет, сколько полезных задач можно решить только с этими двумя
типами объектов.
Типичные операции, которые должны выполняться над объектами, - создание,
рисование, перемещение, копирование и стирание. Операции с графикой - встав¬
ка, поиск и удаление объекта. Для операций над объектами достаточно данных, за¬
дающих позицию объекта (и, возможно, цвет), его длину и ширину в случае линий
и строку символов в случае надписей. Для операций с графикой должна быть вы-
Ядро и его структура
Ш
Графический peAQKTOp
брана некоторая структура данных, представляющая набор объектов. Несомненно
динамическая структура является самой подходящей, и она требует добавления
некоторых связующих нолей в запись, представляющую объект. Без долгих разду.
мий и с мыслью о том, что графика, которая будет обрабатываться этой системой
содержит сотии, а не десятки тысяч объектов, мы выбрали самое простое решение -
линейный список. Надлежащая модульность вместе с сокрытием информации по¬
зволит изменить это решение, не затрагивая клиентских модулей.
Хотя характер пользовательского интерфейса, в общем, не должен влиять на
представление, выбранное для абстрактной структуры данных, нужно принять во
внимание способ, которым будут указываться параметры некоторых операций.
Например, в интерактивных графических системах объекты, к которым должна
применяться операция, принято выделять до вызова операции. Их выделение не¬
которым образом отражается на их изображении и дает пользователю возмож¬
ность проверить выбор (и, если нужно, изменить его) до применения операции
(такой как удаление). Для объекта быть выделяемым значит «помнить» свое со¬
стояние (выделен/не выделен). Важно помнить, что это состояние отражается на
изображении объекта.
Как следствие, в каждую запись объекта добавляется свойство selected. Теперь
определим типы данных для представления линий и надписей и отметим, что оба
типа должны быть расширениями одного и того же базового типа, чтобы быть чле¬
нами одной и той же структуры данных.
TYPE Object = POINTER TO ObjectDesc;
ObjectDesc = RECORD
x, y, w, h, col: INTEGER;
selected: BOOLEAN;
next: Object
END ;
Line = POINTER TO LineDesc;
LineDesc = RECORD (Object) END ;
Caption = POINTER TO CaptionDesc
CaptionDesc = RECORD (Object)
pos, len: INTEGER
END
Выделение отдельного элемента, как правило, достигается указанием на объ¬
ект мышыо и курсором. Выделение набора объектов достигается заданием прямо¬
угольной области, подразумевая выделение всех объектов, лежащих внутри нее.
В обоих случаях поиск выбранных элементов идет по связному списку и полагает¬
ся на позицию и размер, хранимые в дескрипторе каждого объекта. Как следствие
было принято правило, что каждый объект задает не только координаты х, у своего
положения, но и прямоугольную область, в которой он находится (ширина w, вы¬
сота И). Именно так легко определить, идентифицирует ли данная точка объект,
а также лежит ли объект целиком внутри прямоугольной области.
478
В принципе, каждый дескриптор надписи содержит последовательность сим¬
волов (строку), представляющую надпись. Простейшей реализацией было бы
поле в виде массива, ограничивающего длину надписи некоторым постоянным
предопределенным значением. Во-первых, это крайне нежелательно (хотя при¬
менялось в ранних версиях системы). А во-вторых, тексты имеют атрибуты (цвет,
шрифт). Поэтому лучше использовать глобальный «временный текст» и хранить
надпись в виде позиции и длины строки в этом неизменном тексте.
Процедура drawGraphic для рисования всех объектов графики принимает те¬
перь следующий вид:
PROCEDURE drawObj(obj: Object);
BEGIN
IF obj IS Line THEN drawLine(obj(Line))
ELSIF obj IS Caption THEN drawCaption(obj(Caption))
ELSE (* другие типы объектов, если есть *)
END
END drawObj;
PROCEDURE drawGraphic(first: Object);
VAR obj: Object;
BEGIN obj := first;
WHILE obj # NIL DO drawObj(obj); obj := obj.next END
END drawGraphic;
Эти две процедуры обычно помещаются в разные модули: один содержит опе¬
рации над объектами, другой - над графикой. Здесь первый - сервер, второй -
клиент первого. Например, процедуры копирования элементов или определения,
является ли объект выделяемым, отвечают тому же шаблону, что и drawGraphic.
У этого решения есть неприятное свойство: все типы объектов прикреплены
к основному модулю. Если нужно добавить какой-то новый тип, придется менять
основной модуль (а все клиенты, но меньшей мере, заново компилировать). Объ¬
ектно-ориентированная парадигма устраняет это препятствие, меняя ролями эти
два модуля. Она основана на привязке операций, относящихся к типу объекта,
к каждому отдельному объекту в виде нолей записи процедурного типа, как по¬
казано в следующем примерном объявлении:
ObjectDesc = RECORD
х, у, w, h, col: INTEGER; selected: BOOLEAN;
draw: PROCEDURE (obj: Object);
write: PROCEDURE (obj: Object; VAR R: Files.Rider);
next: Object
END
Процедура drawGraphic теперь будет выглядеть следующим образом:
PROCEDURE jdrawGraphic(first: Object);
VAR obj : Object;
Ядро И его структура
480
Графический редакТор
BEGIN obj := first;
WHILE obj # NIL DO obj.draw(obj); obj := obj.next END
END drawGraphic;
Отдельные процедуры - в объектно-ориентированной терминологии назвае-
мые методами - присваиваются полям записи при их создании. Они не нуждают¬
ся в дальнейшем уточнении типов, так как эту функцию при их установке выпол¬
няет присваивание процедур. Отметим здесь, что процедурные поля никогда не
меняются; они выполняют роль констант, а не переменных, связанных с каждым
объектом.
Этот пример в двух словах показывает суть объектно-ориентированного про¬
граммирования - расширяемость как цель и процедурный тип полей записи как
метод.
Данное решение, как оно принято, обладает тем недостатком, что каждый объ¬
ект (экземпляр, переменная) содержит несколько процедур (три из которых при¬
ведены) и потому ведет к расходам памяти, которых следовало бы избегать. Кро¬
ме того, оно раз и навсегда определяет число операций, применимых к объектам,
а также их параметры и типы результатов. Эти недостатки устраняет другой под¬
ход с тем же основополагающим принципом. Он использует единственную пред¬
установленную процедуру, которая сама различает операции согласно различным
типам параметров. Параметры предыдущего решения объединяются в одной
записи, названной сообщением (message). Обобщенная процедура называется об¬
работчиком (handler), а сообщения - это, как правило, расширения единственного
базового типа (Msg).
TYPE Msg = RECORD END;
DrawMsg = RECORD (Msg) END;
WriteMsg = RECORD (Msg) R: Files.Rider END ;
ObjectDesc = RECORD
x, y, w, h, col: INTEGER; selected: BOOLEAN;
handle: PROCEDURE (obj: Object; VAR M: Msg);
next:Object
END ;
PROCEDURE Handler (obj: Object; VAR M: Msg);
(* эта процедура присваивается полю handle любого линейного объекта*)
BEGIN
IF М IS DrawMsg THEN drawLine(obj(Line))
ELSIF M IS WriteMsg THEN writeLine(obj(Line), M(WriteMsg).R)
ELSE ...
END
END ;
PROCEDURE drawGraphic(first: Objec; VAR M: Msg);
VARobj: Object;
BEGIN obj : = first;
WHILE obj # NIL DO obj.handle(obj, M); obj := obj.next END
END drawGraphics
В настоящей системе используется комбинация двух представленных выше
схем. Она избавляет как от необходимости отдельных полей для методов в каж¬
дой записи объекта, так и от каскадного оператора IF для выбора одного из мно¬
гих типов сообщений. При этом она позволяет и дальше добавлять новые методы
для последующих расширений без изменения объявления объекта. Примененный
здесь прием - это включить в каждую запись (подобно обработчику) одно иоле
(с именем do). Это поле - указатель на запись методов, содержащую процедуры,
объявленные для базового типа. По крайней мере, один из них использует пара¬
метр-сообщение, то есть параметр структурной записи, которая расширяема.
TYPE Method = POINTER ТО MethodDesc;
Msg = RECORD END;
Context = RECORD END;
Object = POINTER TO ObjectDesc;
ObjectDesc = RECORD
x, y, w, h, col: INTEGER; selected: BOOLEAN;
do: Method; next: Object
END;
MethodDesc = RECORD
new: Modules.Command;
copy: PROCEDURE (obj, to: Object);
draw, handle: PROCEDURE (obj: Object; VAR M: Msg);
selectable: PROCEDURE (obj: Object; x, y: INTEGER): BOOLEAN;
read: PROCEDURE (obj: Object; VAR R: Files.Rider; VAR C: Context);
write: PROCEDURE (obj: Object; cno: SHORTINT; VAR R: Files.Rider;
VAR C: Context);
print: PROCEDURE (obj: Object; x, y: INTEGER)
_____ END
При создании нового типа объектов генерируется один экземпляр метода, как
правило, в блоке инициализации соответствующего модуля. При создании ново¬
го объекта нолю do нового дескриптора объекта присваивается указатель на этот
экземпляр. Тогда вызов метода принимает вид obj.do.write (obj, R). Этот пример
очень хорошо демонстрирует гибкость расширения типов в Обероне и возмож¬
ности процедурных переменных, причем делает это, не скрывая структур данных,
включенных в необязательный, встроенный механизм времени выполнения.
Предыдущие обсуждения предполагают модульную структуру системы, при¬
веденную на рис. 13.3.
Модули верхнего ряда реализуют методы отдельных типов объектов и допол-
нительнообеспечивают команды, в частности Make, для создания новых объектов.
Ядро и его структура
Рис. 13.3. Клиенты модуля Graphics
Основной модуль определяет базовые типы и процедуры, работающие с графикой
в целом.
Однако наша система слегка отходит от этой схемы по нескольким причинам:
1. Реализация нескольких методов требует относительно коротких программ
для основных объектов. Несмотря на стремление к осмысленной модуль¬
ности, мы хотим избежать распыления и поэтому объединяем с основным
модулем те части, которые приводят к крошечным модулям.
2. Элементы графики ссылаются на шрифты в надписях и на библиотеки
в макросах. Поэтому процедуры записи и чтения имеют дополнительный
параметр для контекста, содержащего шрифты и библиотеки. Подпрограм¬
мы для отображения шрифта (библиотеки) в номер, отвечающий данному
контексту, при выводе и номера в шрифт (библиотеку) при вводе содер¬
жатся в модуле Graphics.
3. В проекте системы Оберон иерархия четырех модулей оказалась самой
подходящей:
0. Модуль с базовым типом, управляющий абстрактной структурой дан¬
ных.
1. Модуль, содержащий процедуры для представления объектов в кадрах
(управление отображением).
2. Модуль, содержащий интерпретатор основных команд и связывающий
кадры с окошками.
3. Модуль команд, просматривающий строки команд и вызывающий соот¬
ветствующие интерпретаторы.
Иерархия модулей системы Draw показана здесь вместе с ее аналогом в систе¬
ме Text:
3. Просмотр команд
2. Управление окошками
1. Управление кадрами
0. Базовый
Draw
MenuViewers
GraphicFrames
Graphics
Edit
MenuViewers
TextFrames
Texts
482
Графический редаКТОр
В результате модуль Graphics содержит не только базовый тип Object, но и его
расширения Line и Caption. Однако их методы определены в GraphicFrames, если
они обращаются к кадрам (например, draw), и в Graphics в противном случае.
До сих пор мы обсуждали операции над отдельными объектами и структуру,
исходящую из желания иметь возможность добавлять новые типы объектов, не
затрагивая основного модуля. Теперь вкратце уделим внимание операциям над
графикой в целом. Их можно свести к двум группам, а именно: те операции, где
графика участвует как множество, и те, что применяются к выделению, то есть
только к подмножеству.
Первая группа состоит из процедур: Add, которая вставляет новый объект;
Draw, которая перебирает набор объектов и вызывает их методы рисования;
ThisObj, которая ищет объект в данной позиции; SelectObj, которая помечает выде¬
ляемый объект; SelectArea, которая выявляет все объекты, лежащие внутри данной
прямоугольной области, и помечает их; логическая функция Selectable; Enumerate,
которая применяет параметрическую процедуру обработки ко всем объектам гра¬
фики. Кроме того, к этой группе относятся процедуры Load, Store, Pnnt и WriteFile.
Набор операций, применяющихся только к выделенным объектам, состоит из
следующих процедур: Deselect, DrawSel (рисование выделения согласно заданно¬
му режиму), Change (изменение определенных атрибутов выделенных объектов,
таких как ширина, шрифт, цвет), Move, Copy, Copy Over (копирование из одной
графики в другую) и, наконец, Delete. Кроме того, существует важная процедура
Open, которая создает новую графику, загружая ее из файла или генерируя пустую.
Объявление типов и процедур, которые появились до сих пор, собраны в сле¬
дующем фрагменте определения интерфейса модуля.
DEFINITION Graphics; («фрагмент*)
IMPORT Files, Fonts, Texts, Modules, Display;
CONST NameLen = 16;
TYPE Graph = POINTER TO GraphDesc;
GraphDesc = RECORD sel: Object; time: LONGINT END ;
Object = POINTER TO ObjectDesc;
Method = POINTER TO MethodDesc;
ObjectDesc = RECORD
x, y,w, h, col: INTEGER;
selected, marked: BOOLEAN;
do: Method
END ;
Name = ARRAY NameLen OF CHAR;
Msg = RECORD END ;
Context = RECORD END ;
MethodDesc = RECORD module, allocator: Name;
Ядро и его структура
ЕШ
new:Modules.Command;
copy: PROCEDURE (obj, to: Object);
draw, handle: PROCEDURE (obj: Object; VAR msg: Msg);
selectable: PROCEDURE (obj: Object; x, y: INTEGER): BOOLEAN;
raed: PROCEDURE (obj: Object; VAR R: Files.Rider; VAR C: Context);
write: PROCEDURE (obj: Object; cno: SHORTINT;
VAR R: Files.Rider; VAR C: Context);
print: PROCEDURE (obj: Object; x,y: INTEGER);
END ;
Line = POINTER TO LineDesc;
LineDesc = RECORD (ObjectDesc) END ;
Caption = POINTER TO CaptionDesc;
CaptionDesc = RECORD (ObjectDesc) pos, len: INTEGER END ;
WidMsg = RECORD (Msg) w: INTEGER END ;
ColorMsg = RECORD (Msg) col: INTEGER END ;
FontMsg = RECORD (Msg) fnt: Fonts.Font END ;
VAR new: Object;
width, res: INTEGER;
T: Texts.Text;
LineMethod, CapMethod, MacMethod: Method;
PROCEDURE Add (G: Graph; obj: Object);
PROCEDURE Draw (G: Graph; VAR M: Msg);
PROCEDURE ThisObj (G: Graph; x, y: INTEGER): Object;
PROCEDURE SelectObj (G: Graph; obj: Object);
PROCEDURE SelectArea (G: Graph; xO, yO, x1, y1: INTEGER);
PROCEDURE Enumerate (G: Graph; handle: PROCEDURE (obj: Object; VAR done: BOOLEAN));
PROCEDURE Deselect (G: Graph);
PROCEDURE DrawSel (G: Graph; VAR M: Msg);
PROCEDURE Change (G: Graph; VAR M: Msg);
PROCEDURE Move (G: Graph; dx, dy: INTEGER);
PROCEDURE Copy (Gs, Gd: Graph; dx, dy: INTEGER);
PROCEDURE Delete (G: Graph);
PROCEDURE FontNo (VAR W: Files.Rider; VAR C: Context; fnt: Fonts.Font): SHORTINT;
PROCEDURE WriteObj (VAR W: Files.Rider; cno: SHORTINT; obj: Object);
PROCEDURE Store (G: Graph; VAR W: Files.Rider);
PROCEDURE WriteFile (G: Graph; name: ARRAY OF CHAR);
PROCEDURE Print (G: Graph; xO, yO: INTEGER);
PROCEDURE Font (VAR R: Files.Rider; VAR C: Context): Fonts.Font;
PROCEDURE Load (G: Graph; VAR R: Files.Rider);
PROCEDURE Open (G: Graph; name: ARRAY OF CHAR);
END Graphics.
484
Графический редаКт0р
13.4. Отображение графики
Основной модуль Graphics определяет представление множества объектов
с точки зрения структуры данных. Частности скрыты и позволяют менять струк¬
турное представление путем замены этого модуля, не затрагивая его клиентов.
Задачи отображения графики на экране или печатной странице этим модулем не
решаются; они делегированы клиентскому модулю GraphicFrames, который опре¬
деляет тип кадра для графики, являющийся расширением Display.Frame, точно так
же, как расширением Display.Frame является TextFrames.Frame. Однако, в отличие
от текстовых кадров, вместо текста с ним связывается графика.
FrameDesc = RECORD (Display.Frame)
graph: Graphics.Graph;
Xg, Yg, XI, Yl, x, y, col: INTEGER;
marked, ticked: BOOLEAN;
mark: LocDesc
Каждый кадр определяет его координаты X, Y внутри области отображения,
его размер, атрибуты W (ширина) и Я (высота) и цвет фона со/. Так же как кадр
представляет (прямоугольный) участок всего экрана, он тоже показывает фраг¬
мент плоскости рисунка графики. Начало координат не должно совпадать ни
с началом координат кадра, ни с началом координат дисплея. Позиция кадра от¬
носительно начала координат графической плоскости записывается в дескриптор
кадра координатами Xg, Yg.
Дополнительные, избыточные атрибуты х, у, Х1, Y1 задаются следующими
инвариантами и сохраняются для того, чтобы избежать их частого повторного вы¬
числения.
X1 = X + W, Yl = Y + Н
х = X + Xg, у = Y1 + Yg
X и У (а значит, Х1 и Y1 тоже) изменяются, когда изменяется окошко, то есть
когда кадр перемещается или изменяется. Xg и Yg изменяются, когда начало ко¬
ординат рисунка перемещается в пределах кадра. Смысл различных значений по¬
казан на рис. 13.4.
Как следствие, координаты дисплея и, v объекта z графа, изображенного в кад¬
ре /, вычисляются как
и — Z.X + f.x, V = z.y + f.y.
Чтобы определить, лежит ли объект z внутри кадра /, должно выполняться
следующее условие:
(f.X <= и) & (и + z.w <= f.Xl) & (f.Y <= v) & (v + z.h <= f.Yl).
Поле записи marked указывает, содержит ли кадр символ вставки. Позиция
его отображения записана в поле с именем mark. Кадр может содержать несколько
(вторичных) символов вставки; они образуют список дескрипторов позиций.
Отображение графики
486
Графический редОКтор
Рис. 13.4. Кадр и графические координаты
При отображении (рисовании) объекта должно приниматься во внимание его со¬
стояние, чтобы обеспечить пользователя видимой обратной связью. Однако способ
задания выделения может быть разным для разных типов объектов. Это может быть
легко реализовано, потому что каждому объекту (типу) соответствует своя процеду¬
ра рисования. Были выбраны следующие способы визуализации выделения:
□ выделенные линии показываются в серых тонах (растровый шаблон);
□ выделенные надписи показываются в инверсном видеорежиме.
Смена состояния - относительно частая операция, и из соображений эффек¬
тивности нужно по возможности избегать полной перерисовки затронутых объ¬
ектов. Поэтому процедурам рисования объекта, помимо очевидных параметров
объекта и кадра, передается параметр режима mode. Параметры собраны в сообще¬
ние типа DrawMsg.
DrawMsg = RECORD (Graphics.Msg)
f: Frame;
mode, x, y, col: INTEGER
END
Вот смысл четырех значений параметра режима:
mode = 0: рисовать объект согласно его состоянию;
mode = 1: рисовать, отражая переход из нормального состояния в выделенное;
mode = 2: рисовать, отражая переход из выделенного состояния в нормальное;
mode = 3: стереть.
В случае надписей, например, переходы состояния обозначаются простым ин¬
вертированием прямоугольной области, образующей надпись. Перезапись сим¬
вольных шаблонов надписей не нужна.
Параметр режима также необходим для отражения удаления объекта. Сначала
выделенные объекты отрисовываются с mode, задающим стирание. И только по¬
том они удаляются из связного списка графики.
Кроме того, параметр-сообщение процедуры рисования содержит два смеще¬
ния х и у. Они добавляются к координатам объекта, и их важность станет очевид¬
ной в связи с макросами. То же самое относится к параметру цвета.
Процедуры рисования являются довольно простыми и используют четыре ос¬
новные растровые операции модуля Display. Единственное осложнение возникает
из-за необходимости обрывать рисование на границах кадра. В случае надписей
символ рисуется, только если он целиком входит в кадр. Растровые операции не
проверяют (к тому же), верна ли заданная позиция.
Тут мы напомним, что копии окошка (и его кадра) могут быть созданы
командой System.Copy. Эти копии изображают один и тот же рисунок, но, возмож¬
но, разные его фрагменты. Если в некотором месте рисунка с помощью вставки,
удаления или любой другой операции выполняется изменение, то оно должно
отображаться во всех затронутых кадрах, где видно это место. Поэтому прямо¬
го вызова процедуры рисования с указанием кадра и изменения недостаточно.
И здесь снова проблему изящно решает объектно-ориентированный стиль: вмес¬
то прямого вызова всем кадрам передается сообщение, задающее характер необ¬
ходимых обновлений.
Оповещение осуществляется общей процедурой Viewers.Broadcast(М). Она
вызывает обработчики всех окошек с параметром М. Обработчики окошек или
интерпретируют сообщение, или распространяют его по обработчикам своих под-
кадров. Если указать на объект мышью и нажать ее среднюю кнопку, вызовется
процедура obj.handle с управляющим сообщением в качестве параметра. Эго по¬
зволяет передать управление обработчику отдельного объекта.
В итоге получается следующий интерфейс модуля GraphicFrames:
DEFINITION GraphicFrames;
IMPORT Display, Graphics;
TYPE Frame = POINTER TO FrameDesc;
Location = POINTER TO LocDesc;
LocDesc = RECORD
x, y: INTEGER;
next: Location
END ;
FrameDesc = RECORD (Display.FrameDesc)
graph:Graphics.Graph;
Xg, Yg, XI, Y1, x, y, col: INTEGER;
marked, ticked:BOOLEAN;
mark: LocDesc
END ;
(*mode = 0: рисовать согласно выделению, 1: нормальное -> выделенное,
Отображение графики
ЕШ
2: выделенное -> нормальное, 3: стереть*)
DrawMsg = REC0RD(G raphics.Msg)
f: Frame;
x, y, col, mode: INTEGER
END ;
CtrlMsg = RECORD (Graphics.Msg)
f: Frame; res: INTEGER
END
PROCEDURE Restore (F: Frame);
PROCEDURE Focus (): Frame;
PROCEDURE Selected (): Frame;
PROCEDURE This(x, y: INTEGER): Frame;
PROCEDURE Draw (F: Frame);
PROCEDURE Erase (F: Frame);
PROCEDURE DrawObj (F: Frame; obj: Graphics.Object);
PROCEDURE EraseObj (F: Frame; obj: Graphics.Object);
PROCEDURE Handle (F: Frame; VAR msg: Graphics.Msg);
PROCEDURE Defocus (F: Frame);
PROCEDURE Deselect (F: Frame);
PROCEDURE Macro (VAR Lname, Mname: ARRAY OF CHAR);
PROCEDURE New (graph: Graphics.Graph; X, Y, col: INTEGER; ticked: BOOLEAN): Frame;
END GraphicFrames.
Focus и Selected определяют графический кадр, содержащий символ вставки
или последнее выделение. Draw, Erase и Handle применяются к выделению задан¬
ного графического кадра. A New генерирует кадр, отображающий заданную графи¬
ку с началом координат X и Y.
13.5. Пользовательский интерфейс
Хотя отображение - это главная составляющая интерфейса между компьюте¬
ром и его пользователем, мы выбрали такой заголовок раздела, чтобы сосредото¬
читься в нашем представлении прежде всего на вводе данных, то есть на действиях
компьютера в ответ на действия пользователя с клавиатурой и мышью, на опе¬
рации редактирования. Дизайн пользовательского интерфейса играет решающую
роль в принятии системы пользователями. Не существует неизменного свода пра¬
вил, которые определяют оптимальный выбор интерфейса. Многие выводы - пло¬
ды субъективного мнения, и все слишком часто путают соглашение с удобством.
Тем не менее несколько критериев стали довольно общепринятыми.
Мы основываем наше обсуждение на предпосылке, что ввод обеспечивается
клавиатурой и мышью и что ввод с клавиатуры должен по существу резервиро¬
ваться для текстового ввода. Острый вопрос заключается в том, что мышь, кро¬
ме обеспечения позиции курсора, позволяет сообщать о действиях состоянием се
488
Графический редОКТор
кнопок. Как правило, действий гораздо больше, чем кнопок. Некоторые мышки
снабжены только одной кнопкой - ситуация, которую мы считаем очень неудач¬
ной. Однако есть несколько способов «обогатить» состояния кнопок:
1. Позиция. Состояния кнопок интерпретируются в зависимости от текуще¬
го положения курсора мыши. Как правило, интерпретация производится
обработчиком, установленным в окошке, куда попал курсор, а с разными
типами окошек связаны разные обработчики. Выбранный для интерпрета¬
ции обработчик может быть связан даже с отдельным (графическим) объ¬
ектом и зависеть от типа этого объекта.
2. Многократные щелчки. Интерпретация может зависеть от числа повтор¬
ных щелчков (одной и той же кнопкой) и/или от длительности щелчков.
3. Сонажатия (Interclicks). Интерпретация может зависеть от комбинации
нажатых кнопок, пока последняя еще не отпущена. Очевидно, этот метод
не подходит для однокнопочиой мышки.
Кроме зависимости от позиции, мы весьма успешно использовали сонажатия.
Основное правило, которое должно соблюдаться, состоит в том, что частые дейст¬
вия должны включаться единственным щелчком кнопки, и только их варианты
должны запускаться сонажатиями. Главное искусство - избежать перегрузки
(overloading) этого метода.
Мепее частые операции могут выполняться также с помощью текстуальных
команд, то есть указанием на текст команды и нажатием средней кнопки. Даже для
такого рода активации Оберон предлагает два варианта:
1. Команда входит в меню (полоса заголовка). Такому решению отдается
предпочтение, когда окошко представляет собой параметр команды, и ре¬
комендуется, когда команда применяется довольно часто, потому что не¬
обходимое перемещение мыши относительно короткое.
2. Команда находится в другом месте, обычно в окошке, содержащем инстру¬
ментальный текст.
В заключение отметим, что любой пакет, такой как Draw, вместе с другими
пакетами интегрируется в единую систему. Следовательно, важно, чтобы прави¬
ла, определяющие пользовательские интерфейсы различных пакетов, не слишком
отличались друг от друга, но при этом отражали общие основополагающие прин¬
ципы и общую «философию» проекта. Соглашения Draw, насколько возможно и
целесообразно, были адаптированы к соглашениям текстовой системы. Правая
кнопка служит для выделения, левая - для установки символа вставки, а средняя
кнопка - для активации общих команд, в данном случае - для перемещения и
копирования всего рисунка. Конечно, рисование включает некоторые команды,
с которыми нельзя обращаться так, как в текстах. Символ создается нажатием на
клавиатуре; линия создается движением мыши с удержанием левой кнопки. Со¬
нажатия левая-средняя и правая-средняя обрабатываются так же, как в текстовой
системе (копирование надписи из выделения в позицию символа вставки), и это
не удивительно, потому что текст и графика должным образом интегрируются,
то есть надписи могут копироваться из текстов в графику, и наоборот. Использо-
Пользовсггельский интерфейс
1489
вание разных соглашений в зависимости от того, была ли команда активирована
указанием па надпись в текстовом или графическом кадре, действительно сбивало
бы с толку
13.6. Макросы
Для многих приложений необходимо, чтобы некоторым наборам объектов
можно было давать имена и использовать их самих как объекты. Подобный имено¬
ванный подграф называется макросом. Таким образом, макрос очень напоминает
последовательность операторов в тексте программы, которой дается имя для обра¬
щения к ней из других операторов, то есть процедуру. Понятие графического объ¬
екта тоже становится рекурсивным. Возможность рекурсии объектов настолько
важна, что она была включена в базовый модуль Graphic как третий класс объектов.
Представление макроса очевидно: к общим для всех объектов атрибутам до¬
бавляется поле для хранения заголовка списка элементов, которые составляют
макрос. В настоящей системе вводится специальный узел, представляющий за¬
головок списка элементов. Он имеет тип MacHeaclDesc и содержит имя макроса,
а также ширину и высоту прямоугольника, охватывающего все элементы. Эти зна¬
чения служат для ускорения процесса выделения без их повторного вычисления
при просмотре всего списка элементов.
Рекурсивная природа макроса проявляет себя в рекурсивных вызовах про¬
цедур отображения. Чтобы нарисовать макрос, вызываются процедуры рисования
для типов элементов макроса (которые тоже могут быть макросами). Координаты
каждого элемента складываются с координатами макроса, которые играют роль
смещений. Цвет макроса, тоже поле параметра типа DrawMsg, подавляет цвета
элементов. Это значит, что макрос всегда бывает одного цвета.
Применение макросов - это построение чертежей электронных схем. Компо¬
ненты схем соответствуют макросам. Большинство компонентов представлено
прямоугольным кадром и помеченными контактами (штырьками). Некоторые
из самых простых компонентов, таких как вентиль, диод, транзистор, резистор и
конденсатор, представляются стандартными символами. Такие символы, которые
можно считать алфавитом для «записи» электронных схем, удобно представить
в виде специального шрифта, то есть коллекции растровых шаблонов. На рис. 13.3
показаны три таких макроса вместе с компонентами, из которых они собраны.
Определения типов данных, связанных с макросами, следующие:
Macro = POINTER ТО MacroDesc;
MacroDesc = RECORD (ObjectDesc) mac: MacHead END ;
MacHead = POINTER TO MacHeadDesc;
MacHeadDesc = RECORD name: Name;
w, h: INTEGER; lib: Library
END ;
Library = POINTER TO LibraryDesc;
LibraryDesc = RECORD name: Name END
490
Графический редактор
Процедура DrawMac(mh} М) отображает макрос с заголовком mh согласно па¬
раметру М - сообщению о рисовании, которое задает кадр, позицию в нем, режим
отображения и замещающий цвет.
В огромном большинстве приложений макросы не создаются их пользователя¬
ми, а скорее поступают из другого источника, в случае электронных схем обычно
от производителя компонентов, представленных макросами. Как следствие мак¬
росы берутся из коллекции, (неудачно) названной библиотекой. В нашей системе
макрос выбирается из такой коллекции вызовом процедуры ThisMac, которая по¬
лучает в качестве параметров имена библиотеки и макроса. Команда Draw.Macro
вставляет заданный макрос, как положено, на место символа вставки.
В заключение напомним, что при выделении макроса его цвет инвертируется
во всей прямоугольной области, охватывающей макрос. Этим подчеркивается, что
макрос - это единый объект.
Разработка новых макросов - дело относительно редкое. Они скорее исполь¬
зуются как символы шрифта; разработку новых макросов и шрифтов оставляют
специалисту. Тем не менее было решено включить необходимые для разработки
макросов инструменты в базовую систему. Эти инструменты состоят всего из не¬
скольких процедур. MakeMac объединяет все элементы, лежащие внутри заданной
прямоугольной области, в новый макрос. ОрепМас обращает этот процесс, разъ¬
единяя макрос на его составляющие. InsertMac вставляет заданный макрос в биб¬
лиотеку. NewLib создает новую, пустую библиотеку, a Store Lib создает файл биб¬
лиотеки, содержащий все макросы, загруженные в настоящее время в заданную
библиотеку. Подробности этих операций можно выяснить из текстов программ,
приведенных далее в этой главе.
Несмотря на то что поразительно много приложений вполне могут охваты¬
ваться описанными выше немногими типами объектов и немногими средствами,
тем не менее хочется, чтобы современная графическая система позволяла добав¬
ление новых типов объектов. Здесь упор делается на добавлении, а не на измене¬
нии. Новые возможности должны обеспечиваться включением новых модулей, не
требуя разного рода подгонок и даже перекомпиляции существующих модулей.
Вполне возможно, что их исходный код будет практически недоступен. Триумф
технологии объектно-ориентированного программирования - в том, что это воз-
Рис. 13.5. Макросы и их компоненты
13.7. Классы объектов
Классы объектов
’491:
можно столь изящно. Ее средства - это расширяемый тип записи и процедурная
переменная, как свойства языка программирования, и возможность загружать мо¬
дули по требованию программы, как средство операционной среды.
Неформально любое расширение типа Object мы называем классом. Следова¬
тельно, типы Line, Caption и Macro образуют классы. Дополнительные классы мо¬
гут определяться в других модулях, импортирующих тип Object. В каждом таком
случае нужно объявить ряд методов и присвоить их переменной типа MethodDesc.
Они образуют так называемый набор методов (method suite). Каждый такой мо¬
дуль должен содержать также процедуру (обычно команду) для генерации нового
экземпляра нового класса. Эта команда, наверное, называемая Make, присваивает
набор методов полю do нового объекта.
Этой удачной развязки дополнений и ядра системы почти хватает. 11о одной
новой связи не избежать: если новый рисунок, содержащий объекты класса, не
определенного в ядре системы, загружается из файла, то этот класс должен быть
идентифицирован, соответствующий модуль с его обработчиками загружен (это
называется динамической загрузкой), а объект создан (размещен). Поскольку объ¬
ект, о котором идет речь, еще не существует при чтении значений его атрибутов,
процедура его создания не может быть размещена именно в этом объекте, то есть
она не может быть элементом набора методов. Мы выбрали следующее решение
этой проблемы:
1. Каждый новый класс реализуется в виде модуля, и каждый класс определя¬
ется именем модуля. Каждый такой модуль содержит команду чей смысл
в том, чтобы выделить память объекту класса, присвоить ему набор сооб¬
щений и присвоить объект глобальной переменной Graphics.пего.
2. При чтении графического файла определяется класс каждого объекта,
а вызов процедуры размещения соответствующего модуля предоставля¬
ет нужный объект. Вызов состоит из двух частей: вызов Modules.ThisMod,
который может выполнить загрузку модуля соответствующего класса М,
и вызов Modules. This Command. Затем читаются данные базового типа Ob¬
ject, и, наконец, вызовом метода read этого класса читаются данные рас¬
ширения.
В качестве шаблона любого модуля, определяющего новый класс объектов X,
может служить следующий:
MODULE Xs;
IMPORT Files, GraphicFrames, Graphics, Oberon, Printer;
TYPE X* = POINTER TO XDesc;
XDesc = RECORD(Graphics.ObjectDesc)
(«дополнительные поля данных*)
END;
VAR method: Graphics.Method;
PROCEDURE New*
492
Графический редактор
Классы объектов
VAR х: X;
BEGIN NEW(x); x.do := method; Graphics.new := x
END New;
PROCEDURE* Copy (obj, to: Graphics.Object);
BEGIN to(X)~ := obj(X)"
END Copy;
PROCEDURE* Draw (obj: Graphics.Object; VAR msg: Graphics.Msg);
BEGIN ...
END Draw;
PROCEDURE* Selectable (obj: Graphics.Object; x, y: INTEGER): BOOLEAN;
BEGIN ...
END Selectable;
PROCEDURE* Handle (obj: Graphics.Object; VAR msg: Graphics.Msg);
BEGIN
IF msg IS Graphics.ColorMsg THEN obj.col := msg(Graphics.ColorMsg).col
ELSIF msg IS ... THEN ...
END
END Handle;
PROCEDURE* Read (obj: Graphics.Object; VAR W: Files.Rider; VAR C: Context);
BEGIN (*чтение специфических для X данных*)
END Write;
PROCEDURE* Write (obj: Graphics.Object; cno: SHORTINT;
VAR W: Files.Rider; VAR C: Context);
EGIN Graphics.WriteObj(W, cno, obj); (*запись специфических для X данных*)
END Write;
PROCEDURE* Print (obj: Graphics.Object; x, y: INTEGER);
BEGIN (*вывод объекта с использованием программы модуля Printer*)
END Print;
PROCEDURE Make*; (*команда*)
VAR x: X; F: GraphicFrames.Frame;
BEGIN F := GraphicFrames.FocusO;
IF F # NIL THEN
GraphicFrames.Deselect(F);
NEW(x); x.x := F.mark.x - F.x; x.y := F.mark.у - F.y; x.w := ...; x.h := ...;
x.col := Oberon.CurCol; x.do := method;
GraphicFrames.Defocus(F); Graphics.Add(F.graph, x);
GraphicFrames.DrawObj(F, x)
END
END Make;
BEGIN NEW(method); method.module := «Xs»; method.allocator := «New»;
method.copy := Copy; method.draw := Draw; method.selectable := Selectable;
method.handle := Handle; method, read := Read; method.write := Write;
method.print := Print
END Xs.
Графический редактор
Хотим обратить внимание, что макросы и библиотечные средства тоже могут
включать объекты новых классов, то есть типов, не встречающихся в объявлениях
макросов и библиотек. Полное определение интерфейса модуля Graphics получа¬
ется из его фрагмента, приведенного в разделе 13.3, путем добавления объявлений
типов и процедур из разделов 13.6 и 13.7.
13.8. Реализация
13.8.1. Модуль Draw
Модуль Draw - типично командный модуль, чьи экспортируемые процедуры
перечислены в инструментальном тексте. Его задача - в том, чтобы просмотреть
текст, содержащий параметры команды, проверить их правильность и активиро¬
вать соответствующие процедуры, которые находятся главным образом в модулях
Graphics и GraphicFrames. Самая известная среди них - команда Open. Она создает
новое окошко, содержащее два кадра, а именно текстовый кадр, служащий в ка¬
честве меню, и графический кадр.
Подчеркнем здесь, что графические кадры могут открываться и управляться
и другими модулями, помимо Draw. В частности, редакторы документов, объеди¬
няющие тексты и графику, а возможно и другие объекты, должны обращаться не¬
посредственно к Graphics и GraphicFrames, а не пытаться использовать Draw, кото¬
рый как командный модуль не может иметь клиентов.
MODULE Draw; (*NW 29.6.88 / 22.11.91*)
IMPORT Files, Fonts, GraphicFrames, Graphics, MenuViewers, Oberon,
Printer, TextFrames, Texts, Viewers;
VAR W: Texts.Writer;
(♦Экспортируемые команды:
Open, Delete,
SetWidth, ChangeColor, ChangeWidth, ChangeFont,
Store, Print
Macro, OpenMacro, MakeMacro, LoadLibrary, StoreLibrary*)
PROCEDURE Open*;
VAR X, Y: INTEGER;
beg, end, t: LONGINT;
G: Graphics.Graph;
V: Viewers.Viewer;
text: Texts.Text;
S: Texts.Scanner;
BEGIN Texts.OpenScanner(S, Oberon.Par.text, Oberon.Par.pos); Texts.Scan(S);
494
реализация
IF (S.class = Texts.Char) & (S.c = """) THEN
Oberon.GetSelection(text, beg, end, t);
IF t >= 0 THEN Texts.OpenScanner(S, text, beg); Texts.Scan(S) END
END;
IF S.class = Texts.Name THEN
NEW(G); Graphics.Open(G, S.s);
Oberon.AllocateUserViewer(Oberon.Par.vwr.X, X, Y);
V := MenuViewers.New(
TextFrames.NewMenu(S.s,
"System.Close System.Copy System.Grow Draw.Delete Draw.Store"),
GraphicFrames.New(G, 0, 0, 0, TRUE), TextFrames.menuH, X, Y)
END
END Open;
PROCEDURE Delete*;
VAR F: GraphicFrames.Frame;
EGIN
IF Oberon.Par.frame = Oberon.Par.vwr.dsc THEN
F := Oberon.Par.vwr.dsc.next(GraphicFrames.Frame);
GraphicFrames.Erase(F); Graphics.Delete(F.graph)
END
END Delete;
PROCEDURE SetWidth*;
VARTexts.Scanner;
BEGIN Texts.OpenScanner(S, Oberon.Par.text, Oberon.Par.pos); Texts.Scan(S);
IF (S.class = Texts.Int) & (S.i > 0) & (S.i < 7) THEN
Graphics.width := SHORT(S.i) END
END SetWidth;
PROCEDURE ChangeColor*;
VAR ch: CHAR;
CM: Graphics.ColorMsg;
S: Texts.Scanner;
BEGIN
IF Oberon.Par.frame(TextFrames.Frame).sel > 0 THEN
Texts.OpenScanner(S, Oberon.Par.text,
Oberon.Par.frame(TextFrames.Frame).selbeg.pos);
Texts.Read(S, ch); CM.col := S.col
ELSE Texts.OpenScanner(S, Oberon.Par.text, Oberon.Par.pos); Texts.Scan(S);
IF S.class = Texts.Int THEN CM.col := SHORT(S.i) ELSE CM.col := S.col END
END;
GraphicFrames.Change(GraphicFrames.Selected(), CM)
END ChangeColor;
PROCEDURE ChangeWidth*;
VAR WM: Graphics.WidMsg;
S: Texts.Scanner;
BEGIN Texts.OpenScanner(S, Oberon.Par.text, Oberon.Par.pos); Texts.Scan(S);
шш
IF S.class = Texts.Int THEN
WM.w := SHORT(S.i); GraphicFrames.Change(GraphicFrames.Selected(), WM)
END
END ChangeWidth;
PROCEDURE ChangeFont*;
VARFM: Graphics.FontMsg;
S: Texts.Scanner;
BEGIN Texts.OpenScanner(S, Oberon.Par.text, Oberon.Par.pos); Texts.Scan(S);
IF S.class = Texts.Name THEN
FM.fnt := Fonts.This(S.s);
IF FM.fnt # NIL THEN GraphicFrames.Change(GraphicFrames.Selected(), FM) END
END
END ChangeFont;
PROCEDURE Backup (VAR name: ARRAY OF CHAR);
VAR res, i: INTEGER; ch: CHAR;
bak: ARRAY 32 OF CHAR;
BEGIN i := 0; ch := name[0];
WHILE ch > OX DO bak[i] := ch; INC(i); ch := name[i] END;
IF i < 28 THEN
bak[i] := bak[i + 1] := "B"; bak[i + 2] := "a"; bak[i + 3] := "k";
bak[i + 4] := OX;
Files.Rename(name, bak, res)
END
END Backup;
PROCEDURE Store*;
VAR par: Oberon.ParList; S: Texts.Scanner;
Menu: TextFrames.Frame; G: GraphicFrames. Frame;
v: Viewers.Viewer;
BEGIN par := Oberon.Par;
IF par.frame = par.vwr. dsc THEN
Menu := par.vwr.dsc(TextFrames.Frame); G := Menu.next(GraphicFrames.Frame);
Texts.OpenScanner(S, Menu.text, 0); Texts.Scan(S);
IF S.class = Texts.Name THEN
Texts.WriteString(W, S.s); Texts.WriteString(W, " storing");
Texts.WriteLn(W); Texts.Append(Oberon. Log, W.buf);
Backup(S.s); Graphics.WriteFile(G.graph, S.s)
END
ELSE
Texts.OpenScanner(S, par.text, par.pos); Texts.Scan(S);
IF S.class = Texts.Name THEN
v := Oberon.MarkedViewer();
IF (v.dsc # NIL) & (v.dsc.next IS GraphicFrames.Frame) THEN
G := v.dsc.next(GraphicFrames.Frame);
Texts.WriteString(W, S.s); Texts.WriteString(W, " storing");
Texts.WriteLn(W); Texts.Append(Oberon. Log, W.buf);
Backup(S.s); Graphics.WriteFile(G.graph, S.s)
Графический редактор
496
Реализация
END
END
END
END Store;
PROCEDURE Print*;
VAR nofcopies: INTEGER;
S: Texts.Scanner;
G: Graphics.Graph;
V: Viewers.Viewer;
PROCEDURE Copies;
VAR ch: CHAR;
BEGIN nofcopies := 1;
IF S. nextCh ■= "/" THEN
Texts.Read(S, ch);
IF (ch >= "0") & (ch <= "9") THEN nofcopies := ORD(ch) - ЗОН END;
WHILE ch > " " DO Texts.Read(S, ch) END;
S.nextCh := ch
END
END Copies;
BEGIN Texts.OpenScanner(S, Oberon.Par.text, Oberon.Par.pos); Texts.Scan(S);
IF S.class = Texts.Name THEN
Printer.Open(S.s, Oberon.User, Oberon.Password);
IF Printer.res = 0 THEN
Texts.Scan(S);
WHILE S.class = Texts.Name DO
Texts.WriteString(W, S.s); Copies; Graphics.Open(G, S.s);
IF Graphics.res = 0 THEN
Texts.WriteString(W, " printing");
Texts.WriteInt(W, nofcopies, 3); Texts.Append(Oberon.Log, W.buf);
Graphics.Print(G, 0, Printer.PageHeight - 128);
Printer.Page(nofcopies)
ELSE Texts.WriteString(W, " not found")
END;
Texts.WriteLn(W); Texts.Append(Oberon.Log, W.buf); Texts.Scan(S)
END;
IF(S.class = Texts.Char) & (S.c = "*") THEN
Copies; V := Oberon.MarkedViewer();
IF (V.dsc # NIL) & (V.dsc.next IS GraphicFrames.Frame) THEN
Texts.OpenScanner(S, V.dsc(TextFrames.Frame).text, 0);
Texts.Scan(S);
IF S.class = Texts.Name THEN
Texts.WriteString(W, S.s); Texts.WriteString(W, " printing");
Texts.WriteInt(W, nofcopies, 3);
Texts.Append(0beron.Log, W.buf);
Graphics.Print(V.dsc.next(GraphicFrames.Frame).graph, 0,
Printer.PageHeight - 128);
Printer.Page(nofcopies)
шш
Графический редактор,
END
END
END;
Printer.Close
ELSIF Printer.res = 1 THEN Texts.WriteString(W, " no printer")
ELSIF Printer.res = 2 THEN Texts.WriteString(W, " no link")
ELSIF Printer.res = 3 THEN Texts.WriteString(W, " bad response")
ELSIF Printer.res = 4 THEN Texts.WriteStnng(W, " no permission")
END
END;
Texts.WriteLn(W); Texts.Append(Oberon.Log, W.buf)
END Print;
PROCEDURE Macro*;
VARTexts.Scanner;
T: Texts.Text;
time, beg, end: LONGINT;
Lname: ARRAY 32 OF CHAR;
BEGIN Texts.OpenScanner(S, Oberon.Par.text, Oberon.Par.pos); Texts.Scan(S);
IF S.class = Texts.Name THEN
C0PY(S.s, Lname); Texts.Scan(S);
IF (S.class = Texts.Char) & (S.c = "**") THEN
Oberon.GetSelection(T, beg, end, time);
IF time >= 0 THEN Texts.OpenScanner(S, T, beg); Texts.Scan(S) END
END;
IF(S.class = Texts.Name) OR (S.class = Texts.String) THEN
GraphicFrames.Macro(Lname, S.s)
END
END
END Macro;
PROCEDURE OpenMacro*;
VAR F: GraphicFrames.Frame; sel: Graphics.Object;
EGIN F := GraphicFrames. SelectedO;
IF F tt NIL THEN
sel := F.graph.sel;
IF (sel tt NIL) & (sel IS Graphics. Macro) THEN
GraphicFrames.Deselect(F);
Graphics.OpenMac(sel(Graphics.Macro).mac, F.graph, F.mark.x- F.x,
F.mark.у - F.y);
GraphicFrames.Draw(F)
END
END
END OpenMacro;
PROCEDURE MakeMacro*;
VAR new: BOOLEAN;
F: GraphicFrames.Frame;
S: Texts.Scanner;
498
Реализация
Lname: ARRAY 32 OF CHAR;
PROCEDURE MakeMac;
VAR xO, yO, x1, yl, w, h: INTEGER;
mh: Graphics.MacHead;
L: Graphics.Library;
BEGIN
L := Graphics.ThisLib(Lname, FALSE);
IF L = NIL THEN L := Graphics.NewLib(Lname) END;
xO := F.mark.x; у0 := F.mark.у; х1 := F.mark.next.x; y1 := F.mark.next.y;
w := ABS(x1 - xO); h := ABS(y1 - yO);
IF xO < x1 THEN xO := xO - F.x ELSE xO := x1 - F.x END;
IF yO < у1 THEN yO := yO - F.y ELSE yO := y1 - F.y END;
mh := Graphics.MakeMac(F.graph, xO, yO, w, h, S.s);
Graphics.InsertMac(mh, L, new)
END MakeMac;
BEGIN Texts.OpenScanner(S, Oberon.Par.text, Oberon.Par.pos); Texts.Scan(S);
IF S.class = Texts.Name THEN
COPY(S.s, Lname); Texts.Scan(S);
IF (S.class = Texts.Name) OR (S.class = Texts.String) & (S.len <= 8) THEN
F := GraphicFrames.Focus();
IF (F # NIL) & (F.graph.sel # NIL) THEN
MakeMac; Texts.WriteString(W, S.s);
IF new THEN Texts.WriteSt ring(W, " inserted in ")
ELSE Texts.WriteString(W, " replaced in ")
END;
Texts.WriteString(W, Lname); Texts.WriteLn(W);
Texts.Append(Oberon.Log, W.buf)
END
END
END
END MakeMacro;
PROCEDURE LoadLibrary*;
VAR S: Texts.Scanner; L: Graphics.Library;
BEGIN Texts.OpenScanner(S, Oberon.Par.text, Oberon.Par.pos); Texts.Scan(S);
IF S.class = Texts.Name THEN
L := Graphics.ThisLib(S.s, TRUE);
Texts.WriteString(W, S.s); Texts.WriteString(W, " loaded");
Texts.WriteLn(W); Texts.Append(Oberon.Log, W.buf)
END
END LoadLibrary;
PROCEDURE StoreLibrary*;
VAR i: INTEGER; S: Texts.Scanner; L: Graphics.Library;
Lname: ARRAY 32 OF CHAR;
BEGIN Texts.OpenScanner(S, Oberon.Par.text, Oberon.Par.pos); Texts.Scan(S);
IF S.class = Texts.Name THEN i := 0;
WHILE S.s[i] >= "0” DO Lname[i] := S.s[i]; INC(i) END;
еш
Lname[i] := OX;
L := Graphics.ThisLib(Lname, FALSE);
IF L ft NIL THEN
Texts.WriteString(W, S.s); Texts.WriteString(W, " storing");
Texts.WriteLn(W); Texts.Append(Oberon.Log, W.buf);
Graphics.StoreLib(L, S.s)
END
END
END StoreLibrary;
BEGIN Texts.OpenWriter(W)
END Draw.
13.8.2. Модуль GraphicFrames
Модуль GraphicFrames содержит все подпрограммы, касающиеся отображе¬
ния, визуализации графических кадров и их содержимого, то есть графики. Ои
также содержит подпрограммы для создания новых объектов базовых классов, то
есть линий, надписей и макросов. И самое главное он определяет соответствую¬
щий обработчик кадра, который интерпретирует входные действия и таким обра¬
зом определяет пользовательский интерфейс. Обработчик различает следующие
типы сообщений;
1. Сообщения обновления. Согласно полю id записи сообщения, в соответст¬
вии с режимом перерисовывается либо отдельный объект, либо целое вы¬
деление рисунка. Случай id = 0 означает обновление всего кадра, включая
все объекты графики.
2. Запросы выделения, фокусирования и позиционирования. Они служат для
идентификации графического кадра, содержащего последнее выделение,
содержащее символ вставки (пометку) или указанную позицию. Чтобы
определить последнее выделение, при каждом новом выделении или при
вставке нового объекта в дескриптор графики заносится время.
3. Сообщения ввода. Они исходят из центрального цикла модуля Oberon и
указывают или на действие мыши (сообщение о движении), или на собы¬
тие клавиатуры (сообщение о поглощении).
4. Управляющие сообщения модуля Oberon. Они указывают, что все пометки
(выделение, символ вставки, звездочка) должны быть удалены (нейтрали¬
зованы) или что фокус должен быть отменен (расфокусировка).
5. Сообщения выделения, копирования и межокошечного копирования из
модуля Oberon. Они образуют интерфейс между графической и текстовой
системами и делают возможными идентификацию и копирование надпи¬
сей между графическими и текстовыми кадрами.
6. Сообщения модификации из MenuViewers. Они указывают, что кадр дол¬
жен изменить свой размер и положение в связи с изменением соседнего
окошка или своего собственного.
500
Графический редактор
7. Сообщения отображения. Они исходят из процедуры InsertChar и управля¬
ют отображением отдельных символов при создании надписи (см. ниже).
Обработчик кадра, принимающий сообщение о поглощении, интерпретирует
запрос процедурой InsertChar (за исключением символов движения и отмены),
а принимающий сообщение о движении - процедурой Edit. Если ни одна кноп¬
ка мыши не нажата, курсор просто перерисовывается, и таким образом просле¬
живается движение мыши. В качестве шаблона курсора вместо обычной стрелки
используется крестик. Таким образом обеспечивается немедленная визуальная
обратная связь, указывающая на то, что теперь действия мыши интерпретируют¬
ся графическим обработчиком (а не текстовым, например). Такая обратная связь
полезна, когда графические кадры оказываются не только частью окошка меню, но
и подкадрами многоуровневого кадра документа.
Процедура Edit в первую очередь отслеживает движение мыши, записывая
при этом последующие нажатия кнопок (сонажатия), пока все кнопки не будут
отпущены. Следующее за этим действие определяется воспринятыми нажатиями
кнопок. Эти действия таковы (вторая кнопка обозначает сонажатис):
реализация
Р»тч1
Кнопки
Действие
Левая
Если мышь не двигалась, установить символ вставки, иначе
нарисовать новую линию
Левая, средняя
Копировать выделение текста в позицию символа вставки
Левая, правая
Установить вторичный символ вставки (маркер)
Средняя
Переместить выделение
Средняя,левая
Копировать выделение
Средняя,правая
Сместить начало координат рисунка
Правая
Выделить (объект или объекты в области)
Правая, средняя
Копировать выделенную надпись в позицию символа вставки
При копировании или перемещении множества выделенных объектов нужно
различать случаи, когда источник и приемник - это один и тот же рисунок или
разные. В первом случае позиции источника и приемника могут лежать в одном
кадре или в разных.
Процедура InsertChar обрабатывает создание новых надписей. Новая строка
символов добавляется к глобальному тексту Г, а новый объект сохраняет ее по¬
зицию внутри Т и ее длину.
Сложность в том, что процесс ввода включает столько действий пользователя,
сколько символов вводится, и что он может перемежаться с другими действия¬
ми. Поэтому необходимо записывать состояние добавления, которое сохраняется
в глобальной переменной newcap. Если символ введен при newcap = NIL, то соз¬
дается новая надпись, состоящая из одного набранного символа. Последующий
набор приводит к добавлению символов в строку (и в newcap). Переменная сбра¬
сывается в NIL, когда символ вставки меняет позицию. Символ DEL интерпрети¬
руется процедурой DeleteChar как возврат на шаг (backspace).
Так как создаваемая надпись может быть видима одновременно в нескольких
кадрах, ее отображением должно руководить сообщение. Но этой причине введено
специальное сообщение DispMsg, в результате чего процесс добавления символа
оказывается довольно сложным действием. Во избежание еще большей сложно¬
сти принято ограничение, что все символы надписи должны использовать одина¬
ковые атрибуты (шрифт, цвет).
MODULE GraphicFrames; (*NW 18.4.88 / 22.11.91*)
IMPORT Display, Fonts, Graphics, Input, MenuViewers, Oberon, Texts, Viewers;
CONST (*обновить идентификаторы сообщений*)
restore = 0;
drawobj = 1; drawobjs = 2; drawobjd = 3;
drawnorm = 4; drawsel = 5; drawdel = 6;
markW = 5;
TYPE
Frame* = POINTER TO FrameDesc;
Location* = POINTER TO LocDesc;
LocDesc* = RECORD
x*, y*: INTEGER;
next*: Location
END;
FrameDesc* = RECORD (Display.FrameDesc)
graph*: Graphics.Graph;
Xg*, Yg*: INTEGER; (*позиция относительно начала координат рисунка*)
XI*, Y1*: INTEGER; (*правая и верхняя границы*)
X*, у*, col*: INTEGER; (*х = X + Xg, у = Y + Yg*)
marked*, ticked*: BOOLEAN;
mark*: LocDesc
END;
DrawMsg* = RECORD (Graphics.Msg)
f*: Frame;
x*, y*. col*, mode*: INTEGER
END;
CtrlMsg* = RECORD (Graphics.Msg)
f*: Frame; res*: INTEGER
END;
UpdateMsg = RECORD (Display.FrameMsg)
id: INTEGER;
graph: Graphics.Graph;
obj: Graphics.Object
502
Графический редактор
реализация
END;
SelQuery = RECORD (Display.FrameMsg)
f: Frame; time: LONGINT
END;
FocusQuery = RECORD (Display.FrameMsg)
f: Frame
END;
PosQuery = RECORD (Display.FrameMsg)
f: Frame; x, y: INTEGER
END;
DispMsg = RECORD (Display.FrameMsg)
x1, y1, w: INTEGER;
pat: Display.Pattern;
graph: Graphics.Graph
END;
VAR Crosshair*: Oberon.Marker;
newcap: Graphics.Caption;
DW, DH, CL: INTEGER;
W: Texts.Writer;
^Экспортируемые процедуры:
Restore, Focus, Selected, This, Draw, Erase,
DrawObj, EraseObj, Change, Defocus, Deselect, Macro, New*)
PROCEDURE Restore* (F: Frame);
VAR M: DrawMsg; x, y, col: INTEGER;
BEGIN F.X1 := F.X + F.W; F.Y1 := F.Y + F.H;
F.x := F.X + F.Xg; F.y := F.Y1 + F.Yg; F.marked := FALSE; F.mark.next := NIL;
IF F.X < CL THEN col := Display.black ELSE col := F.col END;
Oberon.RemoveMarks(F.X, F.Y, F.W, F.H);
Display.ReplConst(col, F.X, F.Y, F.W, F.H, 0);
IF F.ticked THEN
у := F.Yg MOD 16 + F.Y1 - 16;
WHILE у >= F.Y DO (*нарисовать пунктир*)
x := F.Xg MOD 16 + F.X;
WHILE x < F.X1 DO Display.Dot(Display.white, x, y, 0); INC(x, 16) END;
DEC(y, 16)
END
END;
M.f := F; M.x := F.x; M.y := F.y; M.col := 0; M.mode := 0; Graphics.Draw(F.graph, M)
END Restore;
PROCEDURE Focus* (): Frame;
VAR FQ: FocusQuery;
BEGIN FQ.f := NIL; Viewers.Broadcast(FQ); RETURN FQ.f
Графический редаКт0р
END Focus;
PROCEDURE Selected* (): Frame;
VAR SQ: SelQuery;
BEGIN SQ.f := NIL; SQ.time ;= 0; Viewers.Broadcast(SQ); RETURN SQ.f
END Selected;
PROCEDURE This* (x, y: INTEGER): Frame;
VAR PQ: PosQuery;
BEGIN PQ.f := NIL; PQ.x := x; PQ.y := y; Viewers.Broadcast(PQ); RETURN PQ.f
END This;
PROCEDURE Draw* (F: Frame);
VAR UM: UpdateMsg;
BEGIN UM.id := drawsel; UM.graph := F.graph; Viewers.Broadcast(UM)
END Draw:
PROCEDURE DrawNorm (F: Frame);
VAR UM: UpdateMsg;
BEGIN UM.id := drawnorm; UM.graph := F.graph; Viewers.Broadcast(UM)
END DrawNorm;
PROCEDURE Erase* (F: Frame);
VAR UM: UpdateMsg;
BEGIN UM.id := drawdel; UM.graph := F.graph; Viewers.Broadcast(UM)
END Erase;
PROCEDURE DrawObj* (F: Frame; obj: Graphics.Object);
VAR UM: UpdateMsg;
BEGIN UM.id := drawobj; UM.graph := F.graph; UM.obj := obj; Viewers.Broadcast(UM)
END DrawObj;
PROCEDURE EraseObj* (F: Frame; obj: Graphics.Object);
VAR UM: UpdateMsg;
BEGIN UM.id := drawobjd; UM.graph := F.graph; UM.obj := obj; Viewers.Broadcast(UM)
END EraseObj;
PROCEDURE Change* (F: Frame; VAR msg: Graphics.Msg);
BEGIN
IF F # NIL THEN Erase(F); Graphics.Handle(F.graph, msg); Draw(F) END
END Change;
PROCEDURE FlipMark (x, y: INTEGER);
BEGIN
Display.ReplConst(Display.white, x - 7, y, 15, 1, 2);
Display.ReplConst(Display.white, x, у - 7, 1, 15, 2)
END FlipMark;
PROCEDURE Defocus* (F: Frame);
504
реализация
VAR m: Location;
BEGIN newcap := NIL;
IF F.marked THEN
FlipMark(F.mark.x, F.mark.y); m := F.mark.next;
WHILE m # NIL DO FlipMark(m.x, m.y); m := m.next END;
F.marked := FALSE; F.mark.next := NIL
END
END Defocus;
PROCEDURE Deselect* (F: Frame);
VAR UM: UpdateMsg;
BEGIN
IF F ft NIL THEN
UM.id := drawnorm; UM.graph := F.graph; Viewers.Broadcast(UM);
Graphics.Deselect(F.graph)
END
END Deselect;
PROCEDURE Macro* (VAR Lname, Mname: ARRAY OF CHAR);
VAR x, y: INTEGER;
F: Frame;
mac: Graphics.Macro; mh: Graphics.MacHead;
L: Graphics.Library;
BEGIN F := FocusQ;
IF F # NIL THEN
x := F.mark.x - F.x; у := F.mark.y - F.y;
L := Graphics.ThisLib(Lname, FALSE);
IF L # NIL THEN
mh := Graphics.ThisMac(L, Mname);
IF mh ft NIL THEN
Deselect(F); Defocus(F);
NEW(mac); mac.x := x; mac.у := у; mac.w := mh.w; mac.h := mh.h;
mac.mac := mh; mac.do := Graphics.MacMethod; mac.col := Oberon.CurCol;
Graphics.Add(F.graph, mac); DrawObj(F, mac)
END
END
END
END Macro;
PROCEDURE CaptionCopy (F: Frame;
x1, y1: INTEGER; T: Texts.Text; beg, end: LONGINT): Graphics.Caption;
VAR ch: CHAR;
dx, w, x2, y2, w1, hi: INTEGER;
cap: Graphics.Caption;
pat: Display.Pattern;
R: Texts.Reader;
BEGIN Texts.Write(W, ODX);
NEW(cap); cap.len := SH0RT(end - beg);
cap.pos := SHORT(Graphics.T.len) + 1; cap.do := Graphics.CapMethod;
Texts.OpenReader(R, T, beg); Texts.Read(R, ch); W.fnt := R.fnt; W.col := R.col; w := 0;
mm
сар.х := х1 - F.x; cap.у := у1 - F.y + R.fnt.minY;
WHILE beg < end DO
Display.GetChar(R. fnt. raster, ch, dx, x2, y2, w1, hi, pat);
INC(w, dx); INC(beg); Texts.Write(W, ch); Texts.Read(R, ch)
END;
cap.w := w; cap.h := W. fnt. height; cap.col := W.col;
Texts.Append(Graphics.T, W.buf); Graphics.Add(F.graph, cap); RETURN cap
END CaptionCopy;
PROCEDURE SendCaption (cap: Graphics.Caption);
VAR M: Oberon.CopyOverMsg;
BEGIN
M. text := Graphics.T; M.beg := cap.pos; M.end := M.beg + cap.len; Viewers.Broadcast(M)
END SendCaption;
PROCEDURE Edit (F: Frame; xO, yO: INTEGER; kO: SET);
VAR obj: Graphics.Object;
x1, y1, w, h, t, pos: INTEGER;
beg, end, time: LONGINT;
k1, k2: SET; ch: CHAR;
mark, newmark: Location;
T: Texts.Text;
Fd: Frame;
G: Graphics.Graph;
CM: CtrlMsg;
name: ARRAY 32 OF CHAR;
PROCEDURE NewLine (x, y, w, h: INTEGER);
VAR line: Graphics.Line;
BEGIN NEW(line); line.col := Oberon.CurCol; line.x := x - F.x; line.у := у - F.y;
line.w := w; line.h := h; line.do := Graphics.LineMethod; Graphics.Add(G, line)
END NewLine;
BEGIN 1<1 := kO; G := F. graph;
IF kO = {1} THEN
obj := Graphics.ThisObj(G, xO - F.x, yO - F.y);
IF (obj # NIL) & ~obj.selected THEN
CM.f := F; CM.res := 0; obj.do.handle(obj, CM);
IF CM. res tt 0 THEN (*готово*) kO := {} END
END
END;
REPEAT Input.Mouse(k2, x1, y1); k1 := k1 + k2;
DEC(x1, (x1 - F.x) MOD 4); DEC(y1, (y1 - F.y) MOD 4);
Oberon.DrawCursor(Oberon.Mouse, Crosshair, x1, y1)
UNTIL k2 = {};
Oberon.FadeCursor(Oberon.Mouse);
IF kO = {2} THEN (*левая кнопка*)
w := ABS(x1 - xO); h := ABS(y1 - yO);
Графический редактор
[506
IF к1 = {2} THEN
IF (w < 7) & (h < 7) THEN (*установить пометку*)
IF (x1 - markW >= F.X) & (x1 + markW < F.X1) &
(y1 - markW >= F.Y) & (y1 + markW < F.Y1) THEN
Defocus(F); Oberon.PassFocus(Viewers.This(F.X, F.Y));
F.mark.x := x1; F.mark.у := y1; F.marked := TRUE; FlipMark(x1, y1)
END
ELSE (*рисовать линию*) Deselect(F);
IF w < h THEN
IF y1 < yO THEN yO := y1 END;
NewLine(xO, yO, Graphics.width, h)
ELSE
IF x1 < xO THEN xO := x1 END;
NewLine(xO, yO, w, Graphics.width)
END;
Draw(F)
END
ELSIF k1 = {2, 1} THEN Скопировать выделение в символ вставки*)
Deselect(F); Oberon.GetSelection(T, beg, end, time);
IF time >= 0 THEN DrawObj(F, CaptionCopy(F, x1, y1, T, beg, end)) END
ELSIF k1 = {2, 0} THEN
IF F.marked THEN (*установить вторичную пометку*)
NEW(newmark); newmark.x := x1; newmark.y := y1; newmark.next := NIL;
FlipMark(x1, у1); mark := F.mark.next;
IF mark = NIL THEN F.mark.next := newmark ELSE
WHILE mark.next # NIL DO mark := mark.next END;
mark.next := newmark
END
END
END
ELSIF kO = {1} THEN (*средняя кнопка*)
IF k1 = {1} THEN (*движение*)
IF (xO # x1) OR (yO # y1) THEN
Fd := This(x1, y1); Erase(F);
IF Fd = F THEN Graphics.Move(G, x1 - xO, y1 - yO)
ELSIF (Fd # NIL) & (Fd.graph = G) THEN
Graphics.Move(G, (x1 - Fd.x - xO + F.x) DIV 4*4, (y1 - Fd.y - yO + F.y)
DIV 4 * 4)
END;
Draw(F)
END
ELSIF k1 = {1, 2} THEN (копировать*)
Fd := This(x1, у1);
IF Fd # NIL THEN DrawNorm(F);
IF Fd = F THEN Graphics.Copy(G, G, x1 - xO, y1 - yO)
ELSE Deselect(Fd);
Graphics.Copy(G, Fd.graph, (x1 - Fd.x - xO + F.x) DIV 4*4,
(yl - Fd.y - yO + F.y) DIV 4 * 4)
END;
Реализация
Ш
508
Графический редактор
Draw(Fd)
END
ELSIF k1 = {1, 0} THEN (*сместить начало координат рисунка*)
INC(F.Xg, x1 - xO); INC(F.Yg, y1 - yO); Restore(F)
END
ELSIF kO = {0} THEN (*правая кнопка: выделение*)
newcap := NIL;
IF (ABS(xO - x1) < 7) & (ABS(yO - y1) < 7) THEN
IF “(2 IN k1) THEN Deselect(F) END;
obj := Graphics.ThisObj(G, x1 - F.x, y1 - F.y);
IF obj # NIL THEN
Graphics.SelectObj(G, obj); DrawObj(F, obj);
IF (k1 = {0, 1}) & (obj IS Graphics.Caption) THEN
SendCaption(obj(Graphics. Caption))
END
END
ELSE Deselect(F);
IF x1 < xO THEN t := xO; xO := x1; x1 := t END;
IF y1 < yO THEN t := yO; yO := yl; y1 := t END;
Graphics.SelectArea(G, xO - F.x, yO - F.y, x1 - F.x, y1 - F.y); Draw(F)
END
END
END Edit;
PROCEDURE NewCaption (F: Frame; col: INTEGER; font: Fonts.Font);
BEGIN Texts.Write(W, ODX);
NEW(newcap); newcap.x := F.mark.x - F.x; newcap.у := F.mark.y - F.y + font.minY;
newcap.w := 0; newcap.h := font.height; newcap.col := col;
newcap.pos := SHORT(Graphics.T.len + 1); newcap.len := 0;
newcap.do := Graphics.CapMethod; Graphics.Add(F.graph, newcap); W.fnt := font
END NewCaption;
PROCEDURE InsertChar (F: Frame; ch: CHAR);
VAR w1, hi: INTEGER; DM: DispMsg;
BEGIN DM.graph := F.graph;
Display.GetChar(W.fnt.raster, ch, DM.w, DM.x1, DM.y1, w1, hi, DM.pat);
DEC(DM.y1, W.fnt.minY);
IF newcap.x + newcap.w + DM.w + F.x < F.X1 THEN
Viewers.Broadcast(DM); INC(newcap.w, DM.w); INC(newcap.len); Texts.Write(W, ch)
END;
Texts.Append(Graphics.T, W.buf)
END InsertChar;
PROCEDURE DeleteChar (F: Frame);
VAR w1, hi: INTEGER; ch: CHAR; pos: LONGINT;
DM: DispMsg; R: Texts.Reader;
BEGIN DM.graph := F.graph;
IF newcap.len > 0 THEN
pos := Graphics.T.len; Texts.OpenReader(R, Graphics.T, pos - 1); (*возврат на шаг*)
реализация
Texts.Read(R, ch);
IF ch >= " " THEN
Display.GetChar(R.fnt.raster, ch, DM.w, DM.x1, DM.yl, w1, hi, DM.pat);
DEC(newcap.w, DM.w); DEC(newcap.len); DEC(DM.y1, R.fnt.minY);
Viewers.Broadcast(DM); Texts.Delete(Graphics.T, pos - 1, pos)
END
END
END DeleteChar;
PROCEDURE GetSelection (F: Frame; VAR text: Texts.Text; VAR beg, end, time: LONGINT);
VAR obj: Graphics.Object;
BEGIN obj := F.graph.sel;
IF (obj # NIL) & (obj IS Graphics.Caption) & (F.graph.time >= time) THEN
WITH obj: Graphics.Caption DO beg := obj.pos; end := obj.pos + obj.len END;
text := Graphics.T; time := F.graph.time
END
END GetSelection;
PROCEDURE* Handle (G: Display.Frame; VAR M: Display.FrameMsg);
VAR i: LONGINT; ch: CHAR;
x, y: INTEGER;
DM: DispMsg; dM: DrawMsg;
G1: Frame;
PROCEDURE move (G: Frame; dx, dy: INTEGER);
VAR M: UpdateMsg;
BEGIN Defocus(G); Oberon.FadeCursor(Oberon.Mouse);
M.id := drawdel; M.graph := G.graph; Viewers.Broadcast(M);
Graphics.Move(G.graph, dx, dy); M.id := drawsel; Viewers.Broadcast(M)
END move;
BEGIN
WITH G: Frame DO
IF M IS Oberon.InputMsg THEN
WITH M: Oberon.InputMsg DO
IF M.id = Oberon.track THEN
x := M.X - (M.X - G.x) MOD 4; у := M.Y - (M.Y - G.y) MOD 4;
IF M.keys # {} THEN Edit(G, x, y, M.keys)
ELSE Oberon.DrawCursor(Oberon.Mouse, Crosshair, x, y)
END
ELSIF M.id = Oberon.consume THEN
IF M.ch = 7FX THEN
IF newcap # NIL THEN DeleteChar(G)
ELSE Oberon.FadeCursor(Oberon.Mouse);
Defocus(G); Erase(G); Graphics.Delete(G.graph)
END
ELSIF M.ch = 91X THEN Restore(G)
ELSIF M.ch = 93X THEN G.Xg := - 1; G.Yg := 0; Restore(G) (*восстановить*)
ELSIF M.ch = 0C1X THEN move(G, 0, 1)
ш
ELSIF M.ch = 0C2X THEN move(G, 0,-1)
ELSIF M.ch = 0C3X THEN move(G, 1, 0)
ELSIF M.ch = 0C4X THEN move(G, -1,0)
ELSIF (M.ch >= 20X) & (M.ch <= 86X) THEN
IF newcap tt NIL THEN InsertChar(G, M.ch)
ELSIF G.marked THEN
Defocus(G); Deselect(G);
NewCaption(G, M.col, M.fnt); InsertChar(G, M.ch)
END
END
END
END
ELSIF M IS UpdateMsg THEN
WITH M: UpdateMsg DO
IF M.graph = G.graph THEN
dM.f := G; dM.x := G.x; dM.y := G.y; dM.col := 0;
CASE M.id OF
restore: Restore(G)
| drawobj: dM.mode := 0; M.obj.do.draw(M.obj, dM)
| drawobjs: dM.mode := 1; M.obj.do.draw(M.obj, dM)
| drawobjd: dM.mode := 3; M.obj.do.draw(M.obj, dM)
| drawsel: dM.mode := 0; Graphics.DrawSel(G.graph, dM)
| drawnorm: dM.mode := 2; Graphics.DrawSel(G.graph, dM)
| drawdel: dM.mode := 3; Graphics.DrawSel(G.graph, dM)
END
END
END
ELSIF M IS SelQuery THEN
WITH M: SelQuery DO
IF (G.graph.sel # NIL) & (M.time < G.graph.time) THEN
M.f := G; M.time := G.graph.time
END
END
ELSIF M IS FocusQuery THEN
IF G.marked THEN M(FocusQuery).f := G END
ELSIF M IS PosQuery THEN
WITH M: PosQuery DO
IF (G.X <= M.x) & (M.x < G.X1) & (G.Y <= M.y) & (M.y < G.Y1) THEN
M.f := G
END
END
ELSIF M IS DispMsg THEN
DM := M(DispMsg);
x := G.x + newcap.x + newcap.w; у := G.y + newcap.y;
IF (DM.graph = G.graph) & (x >= G.X) & (x + DM.w < G.X1)
& (y >= G.Y) & (y < G.Y1) THEN
Display.CopyPattern(Oberon.CurCol, DM.pat, x + DM.xl, у + DM.yl, 2);
Display. ReplConst(Display.white, x, y, DM.w, newcap. h, 2)
END
510
Графический редаКТОр
ELSIF M IS Oberon.ControlMsg THEN
WITH M: Oberon.ControlMsg DO
IF M.id = Oberon.neutralize THEN
Oberon.RemoveMarks(G.X, G.Y, G.W, G.H); Defocus(G);
DrawNorm(G); Graphics.Deselect(G.graph)
ELSIF M.id = Oberon.defocus THEN Defocus(G)
END
END
ELSIF M IS Oberon.SelectionMsg THEN
WITH M: Oberon.SelectionMsg DO GetSelection(G, M.text, M.beg, M.end, M.time) END
ELSIF M IS Oberon.CopyMsg THEN
Oberon.RemoveMarks(G.X, G.Y, G.W, G.H); Defocus(G);
NEW(G1); Gr := G"; M(0beron.CopyMsg). F := G1
ELSIF M IS MenuViewers.ModifyMsg THEN
WITH M: MenuViewers.ModifyMsg DO G.Y := M.Y; G.H := M.H; Restore(G) END
ELSIF M IS Oberon.CopyOverMsg THEN
WITH M: Oberon.CopyOverMsg DO
IF G.marked THEN
DrawObj(G, CaptionCopy(G, G.mark.x, G.mark.y, M.text, M.beg, M.end))
END
END
END
END
END Handle;
(* Методы *)
PROCEDURE* DrawLine (obj: Graphics.Object; VAR M: Graphics.Msg);
(*M.mode = 0: рисовать согласно состоянию,
= 1: нормальное -> выделенное,
= 2: выделенное -> нормальное,
= 3: стереть*)
VAR х, у, w, h, col: INTEGER; f: Frame;
BEGIN
WITH M: DrawMsg DO
x := obj.x + M.x; у := obj.у + M.y; w := obj.w; h := obj.h; f := M.f;
IF (x + w > f.X) & (x < f.X1) & (y + h > f.Y) & (y < f.Y1) THEN
IF x < f.X THEN DEC(w, f.X - x); x := f.X END;
IF x + w > f.X1 THEN w := f.X1 - x END;
IF у < f.Y THEN DEC(h, f.Y - у); у := f.Y END;
IF у + h > f.Y1 THEN h := f.Y1 - у END;
IF M.col = Display.black THEN col := obj.col ELSE col := M.col (*макрос*) END;
IF(M.mode = 0) & obj.selected OR (M.mode = 1) THEN
Display.ReplPattern(col, Display.grey2, x, y, w, h, 0)
ELSIF M.mode = 3 THEN Display.ReplConst(Display.black, x, y, w, h, 0) (*стереть*)
ELSE Display.ReplConst(col, x, y, w, h, 0)
END
END
END
реализация
Г'-m
Графический редактор
END DrawLine;
PROCEDURE* DrawCaption (obj: Graphics.Object; VAR M: Graphics.Msg);
VAR x, y, dx, xO, x1, у0, yl, w, h, w1, hi, col: INTEGER;
f: Frame;
ch: CHAR; pat: Display.Pattern; fnt: Fonts.Font;
R: Texts.Reader;
BEGIN
WITH M: DrawMsg DO
x := obj.x + M.x; у := obj.у + M.y; w := obj.w; h := obj.h; f := M.f;
IF (f.X <= x) & (x <= f.X1) & (f.Y <= y) & (y + h <= f.Y1) THEN
IF x + w > f.XI THEN w := f.X1 - x END;
Texts.OpenReader(R, Graphics.T, obj(Graphics.Caption).pos); Texts.Read(R, ch);
IF M.mode = 0 THEN
IF ch >= " " THEN
IF M.col = Display.black THEN col := obj.col ELSE col := M.col (*макрос*) END;
fnt := R.fnt; xO := x; yO := у - fnt.minY;
LOOP
Display.GetChar(fnt.raster, ch, dx, x1, yl, w1, hi, pat);
IF xO + x1 + w1 <= f.XI THEN Display.CopyPattern(col, pat, xO + x1,
yO + y1, 1)
ELSE EXIT
END;
INC(xO, dx); Texts.Read(R, ch);
IF ch < '• " THEN EXIT END
END;
IF obj.selected THEN Display.ReplConst(Display.white, x, y, w, h, 2) END
END
ELSIF M.mode < 3 THEN Display.ReplConst(Display.white, x, y, w, h, 2)
ELSE Display.ReplConst(Display.black, x, y, w, h, 0)
END
END
END
END DrawCaption;
PROCEDURE* DrawMacro (obj: Graphics.Object; VAR M: Graphics.Msg);
VAR x, y, w, h: INTEGER;
f: Frame; M1: DrawMsg;
BEGIN
WITH M: DrawMsg DO
x := obj.x + M.x; у := obj.у + M.y; w := obj.w; h := obj.h; f := M.f;
IF (x + w > f.X) & (x < f.X1) & (y + h > f.Y) & (y < f.Y1) THEN
M1. x : = x; M1. у : = у;
IF x < f.X THEN DEC(w, f.X - x); x := f.X END;
IF x + w > f.X1 THEN w := f.X1 - x END;
IF у < f.Y THEN DEC(h, f.Y - у); у := f.Y END;
IF у + h > f.Y1 THEN h := f.Y1 - у END;
IF M.mode = 0 THEN
M1.f := f; Ml.col := obj.col; Ml.mode := 0;
512
Реализация
Graphics.DrawMac(obj(Graphics.Macro).mac, Ml);
IF obj.selected THEN Display.ReplConst(Display.white, x, y, w, h, 2) END
ELSIF M.mode < 3 THEN Display.ReplConst(Display.white, x, y, w, h, 2)
ELSE Display.ReplConst(Display.black, x, y, w, h, 0)
END
END
END
END DrawMacro;
PROCEDURE New* (graph: Graphics.Graph; X, Y, col: INTEGER; ticked: BOOLEAN): Frame;
VAR G: Frame;
BEGIN NEW(G); G.graph := graph; G.Xg := X; G.Yg := Y; G.col := col; G.marked := FALSE;
G.mark.next := NIL; G.ticked := ticked; G.handle := Handle; RETURN G
END New;
PROCEDURE* DrawCrosshair (x, y: INTEGER);
BEGIN
IF x < CL THEN
IF x < markW THEN x := markW ELSIF x > DW THEN x := DW - markW END
ELSE
IF x < CL + markW THEN x := CL + markW
ELSIF x > CL + DW THEN x := CL + DW - markW
END
END;
IF у < markW THEN у := markW ELSIF у > DH THEN у := DH - markW END;
Display.CopyPattern(Display.white, Display.cross, x - markW, у - markW, 2)
END DrawCrosshair;
BEGIN DW := Display.Width - 8; DH := Display.Height - 8; CL := Display.ColLeft;
Crosshair.Draw := DrawCrosshair; Crosshair.Fade := DrawCrosshair; Texts.OpenWriter(W);
Graphics.LineMethod.draw := DrawLine; Graphics.CapMethod.draw := DrawCaption;
Graphics.MacMethod.draw := DrawMacro
END GraphicFrames.
13.8.3. Модуль Graphics
Предыдущие представления определений интерфейса объясняли структуру
графической системы и ставили цели ее реализации. Напомним, что ядро модуля
Graphics обрабатывает структуры данных, представляющие множества объектов
безотносительно к спецификациям отдельных объектов. Интерфейсом не фик¬
сируются даже структурные аспекты множеств объектов. И можно представлять
себе различные решения и, следовательно, различные реализации.
Здесь предлагается самое простое решение для представления абстрактно¬
го, неупорядоченного множества - линейный связный список. Оно заключается
в добавлении в запись объекта скрытого поля next. В результате рисунок пред¬
ставляется заголовком списка, а тип GraphDesc получает скрытое поле first (см.
текст модуля Graphics). Кроме этого, дескриптор содержит экспортируемое ноле
ш
sel, обозначающее выделенный элемент, и поле time, указывающее время его вы-
деления. Последнее используется для определения самого последнего выделения
в различных окошках.
При наличии макросов и классов становятся необходимыми дополнительные
структуры данных. Макрос, как и рисунок, представляется списком его элемен¬
тов. Его заголовок имеет тип MacHeadDesc по аналогии с GraphDesc. Кроме имени
ширины и высоты, макрос содержит поле first, указывающее на первый элемент
списка, и поле lib, ссылающееся на библиотеку, из которой берутся макросы.
Дескриптор библиотеки устроен так же: кроме его имени, поле first указывает
на список элементов (макросов) библиотеки, которые между собой связаны полем
next. На рис. 13.6 показана структура данных, содержащая две библиотеки. Она
задается глобальной неремепной FirstLib.
Рис. 13.6. Структура данных библиотек и макросов
Библиотеки хранятся постоянно в виде файлов. Явно неприемлемо, чтобы
каждое обращение к макросу нуждалось в обращении к файлу, например при каж¬
дой перерисовке макроса. Поэтому библиотека загружается в основную память
Графический редаКТОр
514
при первом же обращении к одному из ее элементов. Процедура ThisMac ищет
структуру данных, представляющую заданную библиотеку, и определяет местона¬
хождение заголовка требуемого макроса.
Подчеркнем, что используемые для представления макросов и библиотек
структуры остаются скрытыми от клиентов, так же как структура рисунка остает¬
ся скрытой внутри модуля Graphics. Таким образом, ни одно из связующих полей
записей (first, next, sel) не экспортируется из основного модуля. Эта мера сохраня¬
ет возможность изменить структурные проектные решения, не затрагивая клиент¬
ских модулей. Но отчасти она несет ответственность за необходимость включать
в основной модуль еще и макросы.
Значительную часть модуля Graphics занимают процедуры чтения и записи
файлов, представляющих графику и библиотеки. Они преобразуют их внутрен¬
нюю структуру данных в линейную форму, и наоборот. Это было бы довольно
тривиальной задачей, если бы не наличие указателей, ссылающихся па макросы и
классы. Эти указатели должны быть преобразованы в описания, которые являют¬
ся позиционно независимыми, как имена. Та же проблема возникает со шрифтами
(которые тоже представлены указателями).
Очевидно, замена каждого указателя явным именем была бы неэкономным ре¬
шением в отношении пространства памяти, равно как и скорости чтения и запнсп.
Поэтому указатели на шрифты и библиотеки - сами представленные файлами -
заменяются индексами в словарях шрифтов и библиотек. Эти словари устанавли¬
вают контекст и создаются при чтении файла. Они используются только во время
этого процесса и, следовательно, локальны по отношению к процедуре Load (или
Open). Словарь классов, представляющий собой список соответствующих про¬
цедур выделения памяти, создается для того, чтобы избежать повторных обраще¬
ний за нужной процедурой размещения.
При формировании процедурой Store графического файла создаются локаль¬
ные словари шрифтов, библиотек и классов объектов, которые должны быть запи¬
саны в файл. Встретив надпись, макрос или иной элемент, шрифт, библиотека или
класс которого не содержится в соответствующем словаре, в файл заносится пара,
состоящая из индекса и имени, назначая тем самым каждому имени его номер. Эти
пары разбросаны по последовательности описаний объектов.
При чтении графического файла эти пары вызывают добавление шрифта, биб¬
лиотеки или класса в соответствующий словарь, посредством чего имя преобра¬
зуется в указатель на объект, который получается в процессе загрузки, осуществ¬
ляемой процедурами Font.This, ThisLib и This Class. Обе процедуры Load и Store
проходят по файлу только раз. Файлы являются самодостаточными в том смысле,
что все внешние величины представлены их именами. Формат графического фай¬
ла определяется синтаксисом РБНФ следующим образом:
file = tag stretch,
stretch = {item >-1.
item = 0 0 fontno fontname | 0 1 libno libname | 0 2 classno classname allocname |
1 data | 2 data fontno string | 3 data libno macname [ classno data extension,
data = x у w h color.
реализация
Число всех классов, по крайней мере, 4; значения 1, 2 и 3 назначены линиям
надписям и макросам, х, у, w, h, и color являются двухбайтовыми целочисленны¬
ми атрибутами базового типа Object.
Одни и те же процедуры используются для загрузки и сохранения файла
библиотеки. Фактически Load и Store читают и записывают раскладку (stretch)
файла, представляющюю собой последовательность элементов, которая заканчи¬
вается специальным значением (-1). В файле библиотеки каждому макросу соот¬
ветствует раскладка, которая заканчивается значениями, задающими предельные
ширину и высоту, а также имя макроса. Структура файлов библиотек определяет¬
ся следующим синтаксисом:
libfile = libtag {macro},
macro = stretch w h name.
Первый байт каждого элемента - это номер класса в пределах файла, задаю¬
щий класс, к которому относится элемент. Объект данного класса размещается
вызовом процедуры размещения объекта класса, которая берется из словаря клас¬
сов в данном контексте. Номер класса используется как индекс в словаре. Нали¬
чие в словаре необходимой процедуры размещения объекта гарантируется тем,
что соответствующая пара иидекс/имя предшествует элементу в файле.
При встрече с такой парой запускается загрузка модуля, определяющего класс
и его методы. Имя пары состоит из двух частей. Первая задает модуль, в котором
определен класс, и он становится параметром вызова загрузчика (см. процедуру
This Class). Вторая часть - имя соответствующей процедуры размещения объектов,
которая возвращает новый объект в переменной Graphics.new. После этого чита¬
ются данные, определенные в базовом типе Object.
За данными базового типа следуют данные его расширения, которые читаются
методом read этого расширения. Эта часть должна всегда начинаться с байта, за¬
дающего число последующих байтов. Подобная информация используется в том
случае, когда нужный модуль отсутствует; она указывает на число байтов, которые
должны быть пропущены, чтобы продолжить чтение последующих элементов.
Последние заслуживающие внимания детали касаются операции Move, кото¬
рая кажется на удивление сложной, особенно в сравнении с родственной опера¬
цией копирования. Причина - в нашем отступлении от принципа, что графиче¬
ский редактор должен избегать интерпретации рисунков. Ответственным за это
отступление было то обстоятельство, что изначально редактор использовался
главным образом для подготовки чертежей электронных схем. Они предполагали,
что примыкающие перпендикулярные линии имеют контакт. Следовательно, го¬
ризонтальное или вертикальное смещение линии должно было сохранять контакт,
Поэтому процедура Move должна выявить все контактирующие линии, а потом
удлинить или укоротить их.
MODULE Graphics; (*NW 21.12.89 / 3.2.92*)
IMPORT Display, Files, Fonts, Modules, Oberon, Printer, Texts;
CONST NameLen* = 16; GraphFileld = 0F9X; LibFileld = OFDX;
Графический редактор
516 1
TYPE
Graph* = POINTER TO GraphDesc;
Object* = POINTER TO ObjectDesc;
Method* = POINTER TO MethodDesc;
Line* = POINTER TO LineDesc;
Caption* = POINTER TO CaptionDesc;
Macro* = POINTER TO MacroDesc;
ObjectDesc* = RECORD
x*, y*. w*, h*, col*: INTEGER;
selected*, marked*: BOOLEAN;
do*: Method;
next, dmy: Object
END;
Msg* = RECORD END;
WidMsg* = RECORD (Msg) w*: INTEGER END;
ColorMsg* = RECORD (Msg) col*: INTEGER END;
FontMsg* = RECORD (Msg) fnt*: Fonts.Font END;
Name* = ARRAY NameLen OF CHAR;
GraphDesc* = RECORD
time*: LONGINT;
sel*, first: Object
END;
MacHead* = POINTER TO MacHeadDesc;
MacExt* = POINTER TO MacExtDesc;
Library* = POINTER TO LibraryDesc;
MacHeadDesc* = RECORD
name*: Name;
w*, h*: INTEGER;
ext*: MacExt;
lib*: Library;
first: Object;
next: MacHead
END;
LibraryDesc* = RECORD
name*: Name;
first: MacHead;
next: Library
END;
MacExtDesc* = RECORD END;
Context* = RECORD
реализация
шт
518
Графический редактор
nofonts, noflibs, nofclasses: INTEGER;
font; ARRAY 10 OF Fonts.Font;
lib; ARRAY 4 OF Library;
class: ARRAY 10 OF Modules.Command
END;
MethodDesc* = RECORD
module*, allocator*: Name;
new*: Modules.Command;
copy*: PROCEDURE (from, to: Object);
draw*, handle*: PROCEDURE (obj: Object; VAR msg: Msg);
selectable*: PROCEDURE (obj: Object; x, y: INTEGER): BOOLEAN;
read*: PROCEDURE (obj: Object; VAR R: Files.Rider; VAR C: Context);
write*: PROCEDURE (obj: Object; cno: SHORTINT;
VAR R: Files.Rider; VAR C: Context);
print*: PROCEDURE (obj: Object; x, y: INTEGER)
END;
LineDesc* = RECORD (ObjectDesc)
END;
CaptionDesc* = RECORD (ObjectDesc)
pos*, len*: INTEGER
END;
MacroDesc* = RECORD (ObjectDesc)
mac*: MacHead
END;
VAR new*: Object;
width*, res*: INTEGER;
T*: Texts.Text; (*надписи*)
LineMethod*, CapMethod*, MacMethod*: Method;
FirstLib: Library;
W, TW: Texts.Writer;
PROCEDURE Add* (G: Graph; obj: Object);
BEGIN obj.marked := FALSE; obj.selected := TRUE; obj.next := G.first;
G.first := obj; G.sel := obj; G.time := Oberon.Time()
END Add;
PROCEDURE Draw* (G: Graph; VAR M: Msg);
VARobj: Object;
BEGIN obj := G.first;
WHILE obj # NIL DO obj.do.draw(obj, M); obj := obj.next END
END Draw;
PROCEDURE ThisObj* (G: Graph; x, y: INTEGER): Object;
VARobj: Object;
BEGIN obj := G.first;
WHILE (obj # NIL) & "obj.do.selectable(obj, x, y) DO obj := obj.next END;
RETURN obj
END ThisObj;
PROCEDURE SelectObj* (G: Graph; obj; Object);
BEGIN
IF obj # NIL THEN obj.selected := TRUE; G.sel := obj; G.time := Oberon.TiineO END
END SelectObj;
PROCEDURE SelectArea* (G: Graph; xO, yO, x1, y1: INTEGER);
VAR obj: Object; t: INTEGER;
BEGIN obj := G.first;
IF x1 < xO THEN t := xO; xO := x1; x1 := t END;
IF y1 < yO THEN t := yO; yO := y1; y1 := t END;
WHILE obj # NIL DO
IF (xO <= obj.x) & (obj.x + obj.w <= x1) & (yO <= obj.y) & (obj.у +
obj.h <= y1) THEN
obj.selected := TRUE; G.sel := obj
END;
obj := obj.next
END;
IF G.sel # NIL THEN G.time := Oberon.Time() END
END SelectArea;
PROCEDURE Enumerate* (G: Graph;
handle: PROCEDURE (obj: Object; VAR done: BOOLEAN));
VAR obj: Object; done: BOOLEAN;
BEGIN done := FALSE; obj := G.first;
WHILE (obj # NIL) & "done DO handle(obj, done); obj := obj.next END
END Enumerate;
(* процедуры операций выделения *)
PROCEDURE Deselect* (G: Graph);
VAR obj: Object;
BEGIN obj := G.first; G.sel := NIL; G.time := 0;
WHILE obj # NIL DO obj.selected := FALSE; obj := obj.next END
END Deselect;
PROCEDURE DrawSel* (G: Graph; VAR M: Msg);
VAR obj: Object;
BEGIN obj := G.first;
WHILE obj # NIL DO
IF obj.selected THEN obj.do.draw(obj, M) END;
obj := obj.next
END
END DrawSel;
PROCEDURE Handle* (G: Graph; VAR M: Msg);
реализация
520
Графический редактор
VAR obj: Object;
BEGIN obj := G.first;
WHILE obj # NIL DO
IF obj.selected THEN obj.do.handle(obj, M) END;
obj := obj.next
END
END Handle;
PROCEDURE Move* (G: Graph; dx, dy: INTEGER);
VAR obj, obO: Object; xO, x1, yO, y1: INTEGER;
BEGIN obj := G.first;
WHILE obj # NIL DO
IF obj.selected & ~(obj IS Caption) THEN
xO := obj.x; x1 := obj.w + xO; yO := obj.y; y1 := obj.h + yO;
IF dx = 0 THEN (*вертикальное перемещение*)
obO := G.first;
WHILE obO # NIL DO
IF “obO.selected & (obO IS Line) & (xO <= obO.x)
& (obO.x <= x1) & (obO.w < obO.h) THEN
IF (yO <= obO.y) & (obO.y <= y1) THEN
INC(obO.y, dy); DEC(ob0.h, dy); obO.marked := TRUE
ELSIF (yO <= obO.y + obO.h) & (obO.y + obO.h <= y1) THEN
INC(ob0.h, dy); obO.marked := TRUE
END
END;
obO := obO.next
END
ELSIF dy = 0 THEN (горизонтальное перемещение*)
obO := G.first;
WHILE obO # NIL DO
IF ~obO.selected & (obO IS Line) & (yO <= obO.y)
& (obO.y <= y1) & (obO.h < obO.w) THEN
IF (xO <= obO.x) & (obO.x <= x1) THEN
INC(ob0.x, dx); DEC(ob0.w, dx); obO.marked := TRUE
ELSIF (xO <= obO.x + obO.w) & (obO.x + obO.w <= x1) THEN
INC(ob0.w, dx); obO.marked := TRUE
END
END;
obO := obO.next
END
END
END;
obj := obj.next
END;
obj := G.first; (*теперь перемещение*)
WHILE obj # NIL DO
IF obj.selected THEN INC(obj.x, dx); INC(obj.y, dy) END;
obj.marked := FALSE; obj := obj.next
END
Реализация
END Move;
PROCEDURE Copy* (Gs, Gd; Graph; dx, dy: INTEGER);
VARobj: Object;
BEGIN obj := Gs.first;
WHILE obj # NIL DO
IF obj.selected THEN
obj.do.new; obj.do.copy(obj, new); INC(new.x, dx); INC(new.y, dy);
obj.selected := FALSE; Add(Gd, new)
END;
obj := obj.next
END;
new := NIL
END Copy;
PROCEDURE Delete* (G: Graph);
VAR obj, pred: Object;
BEGIN G.sel := NIL; obj := G.first;
WHILE (obj # NIL) & obj.selected DO obj := obj.next END;
G.first := obj;
IF obj # NIL THEN
pred := obj; obj := obj.next;
WHILE obj # NIL DO
IF obj.selected THEN pred.next := obj.next ELSE pred := obj END;
obj := obj.next
END
END
END Delete;
(* Ввод/вывод файлов *)
PROCEDURE Readlnt* (VAR R: Files.Rider; VAR x: INTEGER);
VAR cO: CHAR; s1: SHORTINT;
BEGIN Files.Read(R, cO); Files.Read(R, si); x := si; x := x * 100H + ORD(cO)
END Readlnt;
PROCEDURE ReadLInt* (VAR R: Files.Rider; VAR x: LONGINT);
VAR cO, cl, c2: CHAR; s3: SHORTINT;
BEGIN Files.Read(R, cO); Files.Read(R, cl); Files.Read(R, c2); Files.Read(R, s3);
x := s3; x := ((x * 100H + L0NG(c2)) * 100H + L0NG(c1)) * 100H + LONG(cO)
END ReadLInt;
PROCEDURE ReadString* (VAR R: Files.Rider; VAR s: ARRAY OF CHAR);
VAR i: INTEGER; ch: CHAR;
BEGIN i := 0;
REPEAT Files.Read(R, ch); s[i] := ch; INC(i) UNTIL ch = OX
END ReadString;
PROCEDURE ReadObj (VAR R: Files.Rider; obj: Object);
Ш1
522
Графический редактор
BEGIN ReadInt(R, obj.x); ReadInt(R, obj.y);
ReadInt(R, obj.w); ReadInt(R, obj.h); ReadInt(R, obj.col)
END ReadObj;
PROCEDURE Writelnt* (VAR W; Files.Rider; x: INTEGER);
BEGIN Files.Write(W, CHR(x)); Files.Write(W, CHR(x DIV 100H))
END Writelnt;
PROCEDURE WriteLInt* (VAR W: Files.Rider; x: LONGINT);
BEGIN Files.Write(W, CHR(x)); Files.Write(W, CHR(x DIV 100H));
Files.Write(W, CHR(x DIV 10000H)); Files.Write(W, CHR(x DIV 1000000H))
END WriteLInt;
PROCEDURE WriteString* (VAR W: Files.Rider; VAR s: ARRAY OF CHAR);
VAR 1: INTEGER; ch: CHAR;
BEGIN i := 0;
REPEAT ch := s[i]; INC(i); Files.Write(W, ch) UNTIL ch = OX
END WriteString;
PROCEDURE WriteObj* (VAR W: Files.Rider; cno: SHORTINT; obj: Object);
BEGIN Files.Write(W, cno); WriteInt(W, obj.x); WriteInt(W, obj.y);
WriteInt(W, obj.w); WriteInt(W, obj.h); WriteInt(W, obj.col)
END WriteObj;
(* Сохранение *)
PROCEDURE WMsg (sO. si: ARRAY OF CHAR);
BEGIN Texts.WriteString(W, sO); Texts.WriteString(W, s1);
Texts.WriteLn(W); Texts.Append(Oberon.Log, W.buf)
END WMsg;
PROCEDURE InitContext (VAR C: Context);
BEGIN C.nofonts := 0; C.noflibs := 0; C.nofclasses := 4;
C.class[1] := LineMethod.new; C.class[2] := CapMethod.new;
C.class[3] := MacMethod.new
END InitContext;
PROCEDURE FontNo* (VAR W: Files.Rider; VAR C: Context; fnt: Fonts.Font): SHORTINT;
VAR fno: SHORTINT;
BEGIN fno := 0;
WHILE (fno < C.nofonts) & (C.font[fno] # fnt) DO INC(fno) END;
IF fno = C.nofonts THEN
Files.Write(W, 0); Files.Write(W, 0); Files.Write(W, fno);
WriteString(W, fnt.name); C.font[fno] := fnt; INC(C. nofonts)
END;
RETURN fno
END FontNo;
PROCEDURE StoreElems (VAR W: Files.Rider; VAR C: Context; obj: Object);
реализация
VAR cno: INTEGER;
BEGIN
WHILE obj # NIL DO
cno := 1;
WHILE (cno < C.nofclasses) & (obj.do.new # C.class[cno]) DO INC(cno) END;
IF cno = C.nofclasses THEN
Files.Write(W, 0); Files.Write(W, 2); Files.Write(W, SHORT(cno));
WriteString(W, obj.do.module); WriteString(W, obj.do.allocator);
C.class[cno] := obj.do.new; INC(C.nofclasses)
END;
obj.do.write(obj, SHORT(cno), W, C); obj := obj.next
END;
Files.Write(W, - 1)
END StoreElems;
PROCEDURE Store* (G: Graph; VAR W: Files.Rider);
VAR C: Context;
BEGIN InitContext(C); StoreElems(W, C, G.first)
END Store;
PROCEDURE WriteFile* (G: Graph; name: ARRAY OF CHAR);
VAR F: Files.File; W: Files.Rider; C: Context;
BEGIN F := Files.New(name); Files.Set(W, F, 0); Files.Write(W, GraphFileld);
InitContext(C); StoreElems(W, C, G.first); Files.Register(F)
END WriteFile;
PROCEDURE Print* (G: Graph; xO, yO: INTEGER);
VARobj: Object;
BEGIN obj := G.first;
WHILE obj # NIL DO obj.do.print(obj, xO, yO); obj := obj.next END
END Print;
(* Загрузка *)
PROCEDURE ThisClass* (VAR module, allocator: ARRAY OF CHAR): Modules.Command;
VAR mod: Modules.Module; com: Modules.Command;
BEGIN mod := Modules.ThisMod(module);
IF mod # NIL THEN
com := Modules.ThisCommand(mod, allocator);
IF com = NIL THEN WMsg(allocator, " unknown") END
ELSE WMsg(module, " not available"); com := NIL
END;
RETURN com
END ThisClass;
PROCEDURE Font* (VAR R: Files.Rider; VAR C: Context): Fonts.Font;
VAR fno: SHORTINT;
BEGIN Files.Read(R, fno); RETURN C.font[fno]
END Font;
ш
PROCEDURE" ThisLib* (VAR name: ARRAY OF CHAR; replace: BOOLEAN): Library;
PROCEDURE LoadElems (VAR R: Files.Rider; VAR C: Context; VAR obj: Object);
VAR cno, len, k: SHORTINT;
name, namel: ARRAY 32 OF CHAR;
BEGIN obj := NIL; Files.Read(R, cno);
WHILE "R.eof & (cno >= 0) DO
IF cno = 0 THEN
Files.Read(R, cno); Files.Read(R, k); ReadString(R, name);
IF cno = 0 THEN C.font[k] := Fonts.This(name)
ELSIF cno = 1 THEN C.lib[k] := ThisLib(name, FALSE)
ELSE ReadString(R, namel); C.class[k] := ThisClass(name, namel)
END
ELSIF C.class[cno] # NIL THEN
C.class[cno]; ReadObj(R, new);
new.selected := FALSE; new.marked := FALSE; new.next := obj; obj := new;
new.do.read(new, R, C)
ELSE Files.Set(R, Files.Base(R), Files.Pos(R) + 10);
Files.Read(R, len); Files.Set(R, Files.Base(R), Files.Pos(R) + len)
END;
Files.Read(R, cno)
END;
new := NIL
END LoadElems;
PROCEDURE Load* (G: Graph; VAR R: Files.Rider);
VAR C: Context;
BEGIN G.sel := NIL; InitContext(C); LoadElems(R, C, G.first)
END Load;
PROCEDURE Open* (G: Graph; name: ARRAY OF CHAR);
VAR tag: CHAR;
F: Files.File; R: Files.Rider; C: Context;
BEGIN G.first := NIL; G.sel := NIL; G.time := 0; F := Files.Old(name);
IF F # NIL THEN
Files.Set(R, F, 0); Files.Read(R, tag);
IF tag = GraphFileld THEN InitContext(C); LoadElems(R, C, G.first); res := 0
ELSE res := 1
END
ELSE res := 2
END
END Open;
(* Макросы / Библиотеки *)
PROCEDURE ThisLib* (VAR name: ARRAY OF CHAR; replace: BOOLEAN): Library;
VAR l, j: INTEGER; ch: CHAR;
L: Library; mh: MacHead;
F: Files.File; R: Files.Rider; C: Context;
Графический редактор
524
реализация
Lname, Fname: ARRAY 32 OF CHAR;
BEGIN L := FirstLib; i := 0;
WHILE name[i] >= "0" DO Lname[i] := name[i]; INC(i) END;
Lname[i] := OX;
WHILE (L # NIL) & (L. name tt Lname) DO L := L.next END;
IF(L = NIL) OR replace THEN
(*загрузка библиотеки*) j := 0;
WHILE name[j] > OX DO Fname[j] := name[j]; INC(j) END;
IF i = j THEN
Fname[j] := Fname[j + 1] := "L"; Fname[j + 2] := ’i";
Fname[j + 3] := "b"; INC(j, 4)
END;
Fname[j] := OX; F := Files.Old(Fname);
IF F # NIL THEN
WMsg("3arpy3Ka ", name); Files.Set(R, F, 0); Files.Read(R, ch);
IF ch = LibFileld THEN
IF L = NIL THEN
NEW(L); COPY(Lname, L.name); L.next := FirstLib; FirstLib :
END;
L.first := NIL; InitContext(C);
WHILE "R.eof DO
NEW(mh); LoadElems(R, C, mh.first);
ReadInt(R, mh.w); ReadInt(R, mli.h); ReadString(R, mh.name);
mh.lib := L; mh.next := L.first; L.first := mh;
END
ELSE L := NIL; WMsg(name, ” плохая библиотека")
END
ELSE WMsg(name, " не найдено")
END
END;
RETURN L
END ThisLib;
PROCEDURE NewLib* (VAR Lname: ARRAY OF CHAR): Library;
VAR L: Library;
BEGIN NEW(L); COPY(Lname, L.name); L.first := NIL;
L.next := FirstLib; FirstLib := L; RETURN L
ENDNewLib;
PROCEDUREStoreLib*(L: Library; VAR Fname: ARRAY OF CHAR);
VAR mh: MacHead;
F: Files.File; W: Files.Rider;
C: Context;
BEGIN F := Files.New(Fname); Files.Set(W, F, 0); Files.Write(W, LibFileld);
InitContext(C); mh := L.first;
WHILE mh # NIL DO
WriteInt(W, mh.w); WriteInt(W, mh.h); WriteString(W, mh.name);
StoreElems(W, C, mh.first); mh := mh.next
END
т*
END StoreLib;
PROCEDURE RemoveLibraries*;
BEGIN FirstLib : = NIL
END RemoveLibraries;
PROCEDURE ThisMac* (L: Library; VAR Mnam$: ARRAY OF CHAR): MacHead;
VAR mh: MacHead;
BEGIN mh := L.first;
WHILE (mh # NIL) & (mh.name # Mname) DO mh := mh.next END;
RETURN mh
END ThisMac;
PROCEDURE OpenMac* (mh: MacHead; G: Graph; x, y: INTEGER);
VARobj: Object;
BEGIN obj := mh.first;
WHILE obj # NIL DO
obj.do.new; obj.do.copy(obj, new); INC(new.x, x); INC(new.y, y);
new.selected := TRUE;
Add(G, new); obj := obj.next
END;
new := NIL
END OpenMac;
PROCEDURE DrawMac* (mh: MacHead; VAR M: Msg);
VAR elem: Object;
BEGIN elem := mh.first;
WHILE elem tt NIL DO elem.do.draw(elem, M); elem := elem. next END
END DrawMac;
PROCEDURE MakeMac* (G: Graph; x, y, w, h: INTEGER;
VAR Mname: ARRAY OF CHAR): MacHead;
VAR obj, last: Object; mh: MacHead;
BEGIN obj : = G.first; last := NIL;
WHILE obj # NIL DO
IF obj.selected THEN
obj.do.new; obj.do.copy(obj, new); new.next := last;
new.selected := FALSE;
DEC(new.x, x); DEC(new.y, y); last := new
END;
obj := obj.next
END;
NEW(mh); mh.w := w; mh.h := h; mh.first := last; mh.ext := NIL;
COPY(Mname, mh.name); new := NIL; RETURN mh
END MakeMac;
PROCEDURE InsertMac* (mh: MacHead; L: Library; VAR new: BOOLEAN);
VAR mh1: MacHead;
BEGIN mh.lib := L; mh1 := L.first;
Графический редактор
526
Реализация
WHILE (mh1 it NIL) & (mhl.name # mh.name) DO mh1 := mhl.next END;
IF mh1 = NIL THEN
new := TRUE; mh.next := L.first; L.first := mh
ELSE
new := FALSE; mhl.w := mh.w; mhl.h := mh.h; mh1.first := mh.first
END
END InsertMac;
(* Методы линий *)
PROCEDURE* NewLine;
VAR line: Line;
BEGIN NEW(line); new := line; line.do := LineMethod
END NewLine;
PROCEDURE* CopyLine (src, dst: Object);
BEGIN dst.x := src.x; dst.у := src.у; dst.w := src.w; dst.h := src.h;
dst.col := src.col
END CopyLine;
PROCEDURE* HandleLine (obj: Object; VAR M: Msg);
BEGIN
IF M IS WidMsg THEN
IF obj.w < obj.h THEN
IF obj.w <= 7 THEN obj.w := M(WidMsg).w END
ELSIF obj.h <= 7 THEN obj.h := M(WidMsg).w
END
ELSIF M IS ColorMsg THEN obj.col := M(ColorMsg).col
END
END HandleLine;
PROCEDURE* LineSelectable (obj: Object; x, y: INTEGER): BOOLEAN;
BEGIN
RETURN (obj.x <= x) & (x < obj.x + obj.w) & (obj.y <= y) & (y < obj.y + obj.h)
END LineSelectable;
PROCEDURE* ReadLine (obj: Object; VAR R: Files.Rider; VAR C: Context);
BEGIN
END ReadLine;
PROCEDURE* WriteLine (obj: Object; cno: SHORTINT;
VAR W: Files.Rider; VAR C: Context);
BEGIN WriteObj(W, cno, obj)
END WriteLine;
PROCEDURE* PrintLine (obj: Object; x, y: INTEGER);
VAR w, h: INTEGER;
BEGIN w := obj.w * 2; h := obj.h * 2;
IF w < h THEN h := 2 * h ELSE w := 2 * w END;
ш
Графический редактор
Printer.ReplConst(obj.x * 4 + x, obj.y * 4 + y, w, h)
END PrintLine;
(* Методы надписей *)
PROCEDURE* NewCaption;
VAR cap: Caption;
BEGIN NEW(cap); new := cap; cap.do := CapMethod
END NewCaption;
PROCEDURE* CopyCaption (src, dst: Object);
VAR ch: CHAR; R: Texts.Reader;
BEGIN
WITH src: Caption DO
WITH dst: Caption DO
dst.x := src.x; dst.у := src.у; dst.w := src.w; dst.h := src.h;
dst.col := src.col;
.dst.pos := SHORT(T.len + 1); dst.len := src.len;
Texts.Write(TW, ODX); Texts.OpenReader(R, T, src.pos);
Texts.Read(R, ch); TW.fnt := R.fnt;
WHILE ch > ODX DO Texts.Write(TW, ch); Texts.Read(R, ch) END
END
END;
Texts.Append(T, TW.buf)
END CopyCaption;
PROCEDURE* HandleCaption (obj: Object; VAR M: Msg);
VAR dx, x1, dy, yl, w, w1, hi, len: INTEGER;
pos: LONGINT;
ch: CHAR; pat: Display.Pattern; fnt: Fonts.Font;
R: Texts.Reader;
BEGIN
IF M IS FontMsg THEN
fnt := M(FontMsg).fnt; w := 0; len := 0; pos := obj(Caption).pos;
Texts.OpenReader(R, T, pos); Texts. Read(R, ch); dy := R. fnt.minY;
WHILE ch > ODX DO
Display.GetChar(fnt.raster, ch, dx, x1, yl, w1, hi, pat);
INC(w, dx); INC(len); Texts.Read(R, ch)
END;
INC(obj.y, fnt.minY - dy); obj.w := w; obj.h := fnt.height;
Texts.ChangeLooks(T, pos, pos + len, {0}, fnt, 0, 0)
ELSIF M IS ColorMsg THEN obj.col := M(ColorMsg).col
END
END HandleCaption;
PROCEDURE* CaptionSelectable (obj: Object; x, y: INTEGER): BOOLEAN;
BEGIN
RETURN (obj.x <= x) & (x < obj.x + obj.w) & (obj.y <= y) & (y < obj.y + obj.h)
END CaptionSelectable;
528
реализация
PROCEDURE ReadCaption (obj: Object; VAR R: Files.Rider; VAR C: Context);
VAR ch: CHAR; fno: SHORTINT; len: INTEGER;
BEGIN obj(Caption).pos := SH0RT(T.len + 1); Texts.Write(TW, ODX);
Files.Read(R, fno); TW.fnt := C.font[fno]; len := 0; Files.Read(R, ch);
WHILE ch > ODX DO Texts.Write(TW, ch); INC(len); Files.Read(R, ch) END;
obj(Caption).len := len; Texts.Append(T, TW.buf)
END ReadCaption;
PROCEDURE* WriteCaption (obj: Object; cno: SHORTINT;
VAR W: Files.Rider; VAR C: Context);
VAR ch: CHAR; fno: SHORTINT;
TR: Texts.Reader;
BEGIN Texts.OpenReader(TR, T, obj(Caption).pos); Texts.Read(TR, ch);
fno := FontNo(W, C, TR.fnt);
WriteObj(W, cno, obj); Files.Write(W, fno);
WHILE ch > ODX DO Files.Write(W, ch); Texts.Read(TR, ch) END;
Files.Write(W, OX)
END WriteCaption;
PROCEDURE* PrintCaption (obj: Object; x, y: INTEGER);
VAR fnt: Fonts.Font;
i: INTEGER; ch: CHAR;
R: Texts.Reader;
s: ARRAY 128 OF CHAR;
BEGIN Texts.OpenReader(R, T, obj(Caption).pos); Texts.Read(R, ch);
fnt := R.fnt; DEC(y, fnt.minY * 4); i := 0;
WHILE ch >= « « DO s[i] := ch; INC(i); Texts.Read(R, ch) END;
s[i] := OX;
IF i > 0 THEN Printer.St ring(obj.x * 4 + x, obj.y * 4 + y, s, fnt.name) END
END PrintCaption;
(* Методы макросов *)
PROCEDURE* NewMacro;
VAR mac: Macro;
BEGIN NEW(mac); new := mac; mac.do := MacMethod
END NewMacro;
PROCEDURE CopyMacro (src, dst: Object);
BEGIN dst.x := src,x; dst.у := src.у; dst.w := src.w; dst.h := src.h;
dst.col := src.col; dst(Macro).mac := src(Macro).mac
END CopyMacro;
PROCEDURE HandleMacro (obj: Object; VAR M: Msg);
BEGIN
IF M IS ColorMsg THEN obj.col := M(ColorMsg).col END
END HandleMacro;
PROCEDURE MacroSelectable (obj: Object; x, y: INTEGER): BOOLEAN;
BEGIN
RETURN (obj.x <= x) & (x <= obj.x + 8) & (obj.y <= y) & (y <= obj.y + 8)
END MacroSelectable;
PROCEDURE ReadMacro (obj: Object; VAR R: Files.Rider; VAR C: Context);
VAR lno: SHORTINT; name: ARRAY 32 OF CHAR;
BEGIN Files.Read(R, lno);
ReadString(R, name); obj(Macro).mac := ThisMac(C.lib[lno], name)
END ReadMacro;
PROCEDURE WriteMacro (obj: Object; cno: SHORTINT;
VAR W1: Files.Rider; VAR C: Context);
VAR ch: CHAR; lno: SHORTINT; TR: Texts.Reader;
BEGIN lno := 0;
WITH obj: Macro DO
WHILE (lno < C.noflibs) & (obj.mac.lib tt C.lib[lno]) DO INC(lno) END;
IF lno = C.noflibs THEN
Files.Write(W1, 0); Files.Write(W1, 1); Files.Write(W1, lno);
WriteString(W1, obj.mac.lib.name); C.lib[lno] := obj.mac.lib;
INC(C.noflibs)
END;
WriteObj(W1, cno, obj); Files.Write(W1, lno); WriteString(W1, obj.mac.name)
END
END WriteMacro;
PROCEDURE PrintMacro (obj: Object; x, y: INTEGER);
VAR elem: Object; mh: MacHead;
BEGIN mh := obj(Macro).mac;
IF mh tf NIL THEN elem := mh. first;
WHILE elem tt NIL DO
elem.do.print(elem, obj.x * 4 + x, obj.y * 4 + y); elem := elem.next
END
END
END PrintMacro;
PROCEDURE Notify (T: Texts.Text; op: INTEGER; beg, end: LONGINT);
BEGIN
END Notify;
BEGIN Texts.OpenWriter(W); Texts.OpenWriter(TW); width := 1;
NEW(T); Texts.0pen(T, «»); T.notify := Notify;
NEW(LineMethod); LineMethod.new := NewLine; LineMethod.copy := CopyLine;
LineMethod.selectable := LineSelectable; LineMethod.handle := HandleLine;
LineMethod.read := ReadLine; LineMethod.write := WriteLine;
LineMethod.print := PrintLine;
NEW(CapMethod); CapMethod.new := NewCaption; CapMethod.copy := CopyCaption;
CapMethod.selectable := CaptionSelectable; CapMethod.handle := HandleCaption;
CapMethod.read := ReadCaption; CapMethod.write := WriteCaption;
CapMethod.print := PrintCaption;
Графический редактор
530
NEW(MacMethod); MacMethod.new := NewMacro; MacMethod.copy := CopyMacro;
MacMethod.selectable ;= MacroSelectable; MacMethod.handle ;= HandleMacro;
MacMethod.read := ReadMacro; MacMethod.write := WriteMacro; MacMethod.print :=
PrintMacro
END Graphics.
13.9. Прямоугольники и кривые
13.9.1. Прямоугольники
В этом разделе мы представим два расширения базовой графической системы,
|которые вводят новые классы объектов. Первое реализует прямоугольники, кото¬
рые обычно используются для обрамления набора объектов. Они используются,
например, в представлении электронных компонентов. Их реализация следует
схеме, представленной в конце раздела 13.7, и довольно проста, полагая, что каж¬
дый прямоугольник состоит просто из четырех линий. Кроме того, может зада¬
ваться цвет фона.
Одно из проектных решений для любого нового класса касается способа
изображения выделения. В отличие от надписей и макросов, для этого случая
мы выбрали не инверсный видеорежим, а маленькую квадратную точку в правом
нижнем углу прямоугольника.
Тип данных Rectangle содержит два дополнительных поля: lw задаст ширину
линии, a vers - шаблон фона.
Несмотря на простоту представления прямоугольников, метод их рисования
гораздо сложнее, чем можно ожидать. Причина состоит в том, что методы рисова¬
ния ответственны за правильную обрезку по границам кадра. В этом случае некото¬
рые из составляющих линий могут стать короче, а некоторые - вообще исчезнуть.
Процедура Handle является примером приемника управляющего сообщения.
Она активируется по нажатии средней кнопки мыши, в отличие от прочих дейст¬
вий, которые начинаются после освобождения всех кнопок. Следовательно, это
сообщение позволяет реализовать действия под управлением отдельных обработ¬
чиков, интерпретирующих дальнейшие движения мыши. В этом примере дейст¬
вие служит для изменения размера прямоугольника, то есть путем перемещения
его левого нижнего угла.
MODULE Rectangles; (*NW 25.2.90 / 1.2.92*)
IMPORT Display, Files, GraphicFrames, Graphics, Input, Oberon, Printer, Texts;
TYPE Rectangle* = POINTER TO RectDesc;
RectDesc* = RECORD (Graphics.ObjectDesc)
lw*, vers*; INTEGER
END;
VAR method*; Graphics.Method;
Прямоугольники и кривые
ЕР
shade: INTEGER;
PROCEDURE New*;
VAR r: Rectangle;
BEGIN NEW(r); r.do := method; Graphics.new := r
END
PROCEDURE* Copy (src, dst: Graphics.Object);
BEGIN dst(Rectangle)" := src(Rectangle)"
END Copy;
PROCEDURE mark (col, x, y: INTEGER);
BEGIN Display.ReplConst(col, x - 4, y, 4, 4, 0)
END mark;
PROCEDURE* Draw (obj: Graphics.Object; VAR M: Graphics.Msg);
VAR x, y, w, h, Iw, col: INTEGER; s: SET; f: GraphicFrames.Frame;
PROCEDURE draw (col: INTEGER);
BEGIN
IF 0 IN s THEN Display.ReplConst(col, x, y, w, lw, 0) END;
IF 1 IN s THEN Display.ReplConst(col, x + w - lw, y, lw, h, 0) END;
IF 2 IN s THEN Display. ReplConst(col, x, у + h - lw, w, lw, 0) END;
IF 3 IN s THEN Display.ReplConst(col, x, y, lw, h, 0) END
END draw;
BEGIN
WITH M: GraphicFrames.DrawMsg DO
x := obj.x + M.x; у := obj.y + M.y; w := obj.w; h := obj.h; f := M.f;
lw := obj(Rectangle).lw; s := {0..3};
IF x + w < f.X THEN s := {}
ELSIF x < f.X THEN DEC(w, f.X - x); x := f.X; EXCL(s, 3)
END;
IF x >= f.XI THEN s := {}
ELSIF x + w > f.XI THEN w := f.X1 - x; EXCL(s, 1)
END;
IF у + h < f.Y THEN s := {}
ELSIF у < f.Y THEN DEC(h, f.Y - у); у := f.Y; EXCL(s, 0)
END;
IF у >= f.Yl THEN s := {}
ELSIF у + h > f.Y1 THEN h := f.Y1 - y; EXCL(s, 2)
END;
IF s # {} THEN
IF M.col = Display.black THEN col := obj.col ELSE col := M.col END;
IF M.mode = 0 THEN
draw(col);
IF obj.selected THEN mark(Display.white, x + w - lw, у + lw) END;
IF obj(Rectangle).vers # 0 THEN
Display.ReplPattern(col, Display.greyO, x, y, w, h, 1)
END
532
Графический редактор
ELSIF M.mode = 1 THEN mark(Display.white, x + w - lw, у + lw)
ELSIF M.mode = 2 THEN mark(Dlsplay.black, x + w - lw, у + lw)
ELSIF obj(Rectangle).vers = 0 THEN
draw(Display.black); mark(Display.black, x + w - lw, у + lw)
ELSE Display.ReplConst(Display.black, x, y, w, h, 0)
END
END
END
END Draw;
PROCEDURE* Selectable (obj; Graphics.Object; x, y: INTEGER): BOOLEAN;
BEGIN
RETURN (obj.x + obj.w - 4 <= x) & (x <= obj.x + obj.w) & (obj.y <= y)
& (y <= obj.y + 4)
END Selectable;
PROCEDURE* Handle (obj: Graphics.Object; VAR M: Graphics.Msg);
VAR xO, yO, x1, y1, dx, dy; INTEGER; k: SET;
BEGIN
IF M IS Graphics.WidMsg THEN obj(Rectangle).lw := M(Graphics.WidMsg).w
ELSIF M IS Graphics.ColorMsg THEN obj.col := M(Graphics.ColorMsg).col
ELSIF M IS GraphicFrames.CtrlMsg THEN
WITH M: GraphicFrames.CtrlMsg DO
WITH obj: Rectangle DO
M.res := 1; xO := obj.x + obj.w + M.f.x; yO := obj.y + M.f.y;
mark(Display.white, xO - obj.lw, yO + obj.lw);
REPEAT Input.Mouse(k, x1, y1);
DEC(x1, (x1 - M.f.x) MOD 4); DEC(y1, (y1 - M.f.y) MOD 4);
Oberon.DrawCursor(Oberon.Mouse, GraphicFrames.Crosshair, x1, y1)
UNTIL к = {};
mark(Display.black, xO - obj.lw, yO + obj.lw);
IF (xO - obj.w < x1) & (y1 < yO + obj.h) THEN
GraphicFrames.EraseObj(M.f, obj);
dx := x1 - xO; dy := y1 - yO;
INC(obj.y, dy); INC(obj.w, dx); DEC(obj.h, dy);
GraphicFrames.DrawObj(M.f, obj)
END
END
END
END
END Handle;
PROCEDURE* Read (obj: Graphics.Object; VAR R: Files.Rider; VAR C: Graphics.Context);
VAR w, v, len: SHORTINT;
BEGIN Files.Read(R, len); Files.Read(R, w); Files.Read(R, v);
obj(Rectangle).lw := w; obj(Rectangle).vers := v
END Read;
Прямоугольники и кривые
Ш
PROCEDURE* Write (obj: Graphics.Object; cno: SHORTINT;
VAR W: Files.Rider; VAR C: Graphics.Context);
BEGIN Graphics.WriteObj(W, cno, obj); Files.Write(W, 2);
Files.Write(W, SH0RT(obj(Rectangle).lw));
Files.Write(W, SH0RT(obj(Rectangle).vers))
END Write;
PROCEDURE* Print (obj: Graphics.Object; x, y: INTEGER);
VAR w, h, lw, s: INTEGER;
BEGIN INC(x, obj.x * 4); INC(y, obj.y * 4); w := obj.w * 4; h := obj.h * 4;
lw := obj(Rectangle).lw * 2; s := obj(Rectangle).vers;
Printer.ReplConst(x, y, w, lw);
Printer.ReplConst(x + w - lw, y, lw, h);
Printer.ReplConst(x, у + h - lw, w, lw);
Printer.ReplConst(x, y, lw, h);
IF s > 0 THEN Printer.ReplPattern(x, y, w, h, s) END
END Print;
PROCEDURE Make*; (*команда*)
VAR xO, x1, yO, y1: INTEGER;
R: Rectangle;
G: GraphicFrames. Frame;
BEGIN G := GraphicFrames. Focus();
IF (G # NIL) & (G.mark.next # NIL) THEN
GraphicFrames. Deselect(G);
xO := G.mark.x; yO := G.mark.y; x1 := G.mark.next.x; y1 := G.mark.next.y;
NEW(R); R.col := Oberon.CurCol;
R.w := ABS(x1 - xO); R.h := ABS(y1 - yO);
IF x1 < xO THEN xO := x1 END;
IF y1 < yO THEN yO : = y1 END;
R.x := xO - G.x; R.y : = yO - G.y;
R.lw := Graphics.width; R.vers := shade; R.do := method;
Graphics.Add(G.graph, R);
GraphicFrames. Defocus(G); GraphicFrames.DrawObj(G, R)
END
END Make;
PROCEDURE SetShade*;
VAR Texts.Scanner;
BEGIN Texts.OpenScanner(S, Oberon.Par.text, Oberon.Par.pos); Texts.Scan(S);
IF S.class = Texts.Int THEN shade := SHORT(S.i) END
END SetShade;
BEGIN shade := 0; NEW(method);
method.module := "Rectangles”; method.allocator := "New";
method.new := New; method.copy := Copy; method.draw := Draw;
method.selectable := Selectable; method.handle := Handle;
method.read := Read; method.write := Write; method.print := Print
END Rectangles.
Графический редактор
534
Прямоугольники и кривые
13.9.2. Наклонные линии, окружности
и эллипсы
Второе расширение - это модуль Curves. Он вводит три новых вида объектов:
линии, которые не обязательно горизонтальны или вертикальны, окружности и
эллипсы (с горизонтальными и вертикальными осями). Все они считаются вари¬
антами одного и того же типа Curve, а вариант определяется полем kind записи
объекта. Выделение опять обозначается маленькой квадратной точкой в конце
линии и в самой нижней точке окружности или эллипса.
Чтобы избежать вычислений над числами с плавающей запятой и повысить
производительность, применяются алгоритмы Брезенхэма (Bresenham). Алго¬
ритм для линии, заданной уравнением bx - ay = 0 (для b < а), сводится к следую¬
щим операторам:
х := 0; у := 0; h : = (b - a) DIV 2;
WHILE х <= a DO Dot(х, у);
IF h <= 0 THEN INC(h, b) ELSE INC(h, b-a); INC(y) END ;
INC(x)
END
Алгоритм Брезенхэма для окружности, заданной уравнением х2 + у2 = г2, сле¬
дующий:
х := г ; у := 0 ; h : = 1 — г ;
WHILE у <= х DO Dot(х. у);
IF h < О THEN INC(h, 2*y + 3) ELSE INC(h, 2*(y-x)+5); DEC(x) END ;
INC(y)
END
MODULE Curves; (*NW 8.11.90 / 1.2.91*)
IMPORT Display, Files, GraphicFrames, Graphics, Oberon, Printer;
TYPE Curve* = POINTER TO CurveDesc;
CurveDesc* = RECORD (Graphics.ObjectDesc)
kind*, lw*; INTEGER
END;
(*вид: 0 = линия-вверх, 1 = линия-вниз, 2 = окружность, 3 = эллипс*)
VAR method*: Graphics.Method;
PROCEDURE dot (f: GraphicFrames.Frame; col; INTEGER; x, y: LONGINT);
BEGIN
IF (f.X <= x) & (x < f.X1) & (f.Y <= y) & (y < f,Y1) THEN
Display.Dot(col, x, y, 0) END
END dot;
PROCEDURE mark (f: GraphicFrames.Frame; col, x, y: INTEGER);
Ш
536
Графический редактор
BEGIN
IF (f.X <= x) & (x + 4 < f.X1) & (f.Y <= y) & (y + 4 < f.Y1) THEN
Display.ReplConst(col, x, y, 4, 4, 0)
END
END mark;
PROCEDURE line (f: GraphicFrames.Frame; col: INTEGER; x, y, w, h, d: LONGINT);
VAR x1, y1, u: LONGINT;
BEGIN
IF h < w THEN
x1 := x + w; и := (h - w) DIV 2;
IF d = - 1 THEN INC(y, h) END;
WHILE x < x1 DO
dot(f, col, x, y); INC(x);
IF u < 0 THEN INC(u, h) ELSE INC(u, h - w); INC(y, d) END
END
ELSE y1 := у + h; u := (w - h) DIV 2;
IF d = - 1 THEN INC(x, w) END;
WHILE у < yl DO
dot(f, col, x, y); INC(y);
IF u < 0 THEN INC(u, w) ELSE INC(u, w - h); INC(x, d) END
END
END
END line;
PROCEDURE circle (f: GraphicFrames.Frame; col: INTEGER; xO, yO, r: LONGINT);
VAR x, y, u: LONGINT;
BEGIN u := 1 - r; x := г; у := 0;
WHILE у <= x DO
dot(f, col, xO + x, yO + y); dot(f, col, xO + y, yO + x);
dot(f, col, xO - y, yO + x); dot(f, col, xO - x, yO + y);
dot(f. col, xO - x, yO - y); dot(f, col, xO - y, yO - x);
dot(f, col, xO + y, yO - x); dot(f, col, xO + x, yO - y);
IF u < 0 THEN INC(u, 2 * у + 3) ELSE INC(u, 2 * (y - x) + 5); DEC(x) END;
INC(у)
END
END circle;
PROCEDURE ellipse (f: GraphicFrames.Frame; col: INTEGER; xO, yO, a, b: LONGINT);
VAR x, y, y1, aa, bb, d, g, h: LONGINT;
BEGIN aa := a * a; bb := b * b;
h := (aa DIV 4) - b * aa + bb; g := (9 * aa DIV 4) - 3 * b * aa + bb; x := 0;
У := b;
WHILE g < 0 DO
dot(f, col, xO + x, yO + y); dot(f, col, xO - x, yO + y);
dot(f, col, xO - x, yO - y); dot(f, col, xO + x, yO - y);
IF h < 0 THEN d := (2 * x + 3) * bb; INC(g, d)
ELSE d : = (2 * x + 3) * bb - 2 * (y - 1) * aa; INC(g, d + 2 * aa); DEC(y)
END;
Прямоугольники и кривые
INC(h, d); INC(x)
END;
y1 := y; h := (bb DIV 4) - a * bb + aa; x := a; y:=0;
WHILE у <= y1 DO
dot(f, col, xO + x, yO + y); dot(f, col, xO - x, yO + y);
dot(f, col, xO - x, yO - y); dot(f, col, xO + x, yO - y);
IF h < 0 THEN INC(h, (2 * у + 3) * aa) ELSE
INC(h, (2 * у + 3) * aa - 2 * (x - 1) * bb); DEC(x) END;
INC(y)
END
END ellipse;
PROCEDURE New*;
VAR c: Curve;
BEGIN NEW(c); c.do ;= method; Graphics.new := с
END
PROCEDURE Copy (src, dst; Graphics.Object);
BEGIN dst(Curve)~ := src(Curve)~
END Copy;
PROCEDURE Draw (obj: Graphics.Object; VAR M: Graphics.Msg);
VAR x, y, w, h, col: INTEGER; f: GraphicFrames.Frame;
BEGIN
WITH M: GraphicFrames.DrawMsg DO
x := obj.x + M.x; у := obj.y + M.y; w := obj.w; h := obj.h; f := M.f;
IF M.col = Display.black THEN col := obj.col ELSE col := M.col END;
IF(x < f.X1) & (f.X <= x + w) & (y < f.Y1) & (f.Y <= у + h) THEN
IF obj(Curve).kind = 0 THEN (*up-line*)
IF M.mode = 0 THEN
IF obj.selected THEN mark(f, Display.white, x, y) END;
line(f, col, x, y, w, h, 1)
ELSIF M.mode = 1 THEN mark(f, Display.white, x, y)
ELSIF M.mode = 2 THEN mark(f, Display.black, x, y)
ELSE mark(f, Display.black, x, y);
line(f, Display.black, x, y, w, h, 1)
END
ELSIF obj(Curve).kind = 1 THEN (*down-line*)
IF M.mode = 0 THEN
IF obj.selected THEN mark(f, Display.white, x, у + h) END;
line(f, col, x, y, w, h, - 1)
ELSIF M.mode = 1 THEN mark(f, Display.white, x, у + h)
ELSIF M.mode = 2 THEN mark(f, Display.black, x, у + h)
ELSE mark(f, Display.black, x, у + h);
line(f, Display.black, x, y, w, h, - 1)
END
ELSIF obj(Curve).kind = 2 THEN (*circle*)
w := w DIV 2;
IF M.mode = 0 THEN
КсЯ
IF obj.selected THEN mark(f, Display.white, x + w, у - 4) END;
circle(f, col, x + w, у + w, w)
ELSIF M.mode = 1 THEN mark(f, Display.white, x + w, у - 4)
ELSIF M.mode = 2 THEN mark(f, Display.black, x + w, у - 4)
ELSE mark(f, Display.black, x + w, у - 4);
circle(f, Display.black, x + w, у + w, w)
END
ELSIF obj(Curve).kind = 3 THEN (^ellipse*)
w := w DIV 2; h := h DIV 2;
IF M.mode = 0 THEN
IF obj.selected THEN mark(f, Display.white, x + w, у - 4) END;
ellipse(f, col, x + w, у + h, w, h)
ELSIF M.mode = 1 THEN mark(f, Display.white, x + w, у - 4)
ELSIF M.mode = 2 THEN mark(f, Display.black, x + w, у - 4)
ELSE mark(f, Display.black, x + w, у - 4);
ellipse(f, Display.black, x + w, у + h, w, h)
END
END
END
END
END Draw;
PROCEDURE Selectable (obj: Graphics.Object; x, y: INTEGER): BOOLEAN;
VAR xm, yO, w, h: INTEGER;
BEGIN
IF obj(Curve).kind <= 1 THEN (*line*)
w : = obj. w; h : = obj. h;
IF obj (Curve), kind = 1 THEN yO := obj.y + h; h : = - h ELSE yO := obj.y END;
RETURN
(obj.x <= x) & (x < obj.x + w) & (ABS(L0NG(y - yO) * w - L0NG(x - obj.x)
* h) < w * 4)
ELSE (*circle or ellipse*)
xm := obj.w DIV 2 + obj.x;
RETURN (xm - 4 <= x) & (x <= xm + 4) & (obj.y - 4 <= y) & (y <= obj.y + 4)
END
END Selectable;
PROCEDURE Handle (obj: Graphics.Object; VAR M: Graphics.Msg);
BEGIN
IF M IS Graphics.ColorMsg THEN obj.col := M(Graphics.ColorMsg).col END
END Handle;
PROCEDURE Read (obj: Graphics. Object; VAR R: Files.Rider; VAR C: Graphics.Context);
VAR len: SHORTINT;
BEGIN Files.Read(R, len); Graphics.ReadInt(R, obj(Curve).kind);
Graphics.Readlnt(R, obj(Curve).lw)
END Read;
PROCEDURE Write (obj: Graphics.Object; cno: SHORTINT;
Графический редактор
538
VAR W: Files.Rider; VAR C: Graphics.Context);
BEGIN Graphics.WriteObj(W, cno, obj);
Files.Write(W, 4); Graphics.WriteInt(W, obj(Curve).kind);
Graphics.Writelnt(W, obj(Curve).lw)
END Write;
PROCEDURE Print (obj: Graphics.Object; x, y: INTEGER);
VAR xO, yO: INTEGER;
BEGIN
IF obj(Curve).kind = 0 THEN
xO := obj.x * 4 + x; yO := obj.y * 4 + y;
Printer.Line(xO, yO, obj.w * 4 + xO, obj. h * 4 + yO)
ELSIF obj(Curve).kind = 1 THEN
xO := obj.x * 4 + x; yO := obj.у * 4 + y;
Printer.Line(xO, obj.h * 4 + yO, obj.w * 4 + xO, yO)
ELSIF obj(Curve).kind = 2 THEN
Printer.Circle((obj.x * 2 + obj.w) * 2 + x, (obj.y * 2 + obj.h) * 2 + y,
obj.w * 2)
ELSE
Printer.Ellipse((obj.x * 2 + obj.w) * 2 + x, (obj.y * 2 + obj.h) * 2 + y,
obj.w * 2, obj.h * 2)
END
END Print;
PROCEDURE MakeLine*; (*команда*)
VAR xO, x1, yO, y1: INTEGER;
с: Curve;
G: GraphicFrames.Frame;
BEGIN G := GraphicFrames.Focus();
IF (G # NIL) & (G.mark.next # NIL) THEN
GraphicFrames.Deselect(G);
xO := G.mark.x; yO := G.mark.y; x1 := G.mark.next.x; y1 := G.mark.next.y;
NEW(c); c.col := Oberon.CurCol;
c.w := ABS(x1 - xO); c.h := ABS(y1 - yO); c.lw := Graphics.width;
IF xO <= x1 THEN c.x := xO;
IF yO <= y1 THEN c.kind := 0; c.y := yO ELSE c.kind := 1; c.y := y1 END
ELSE c.x := x1;
IF y1 < yO THEN c.kind := 0; c.y := y1 ELSE c.kind := 1; c.y := yO END
END;
DEC(c.x, G.x); DEC(c.y, G.y); c.do := method;
Graphics.Add(G.graph, c);
GraphicFrames.Defocus(G); GraphicFrames.DrawObj(G, c)
END
END MakeLine;
PROCEDURE MakeCircle*; (*команда*)
VAR xO, yO, r: INTEGER;
c: Curve;
G: GraphicFrames.Frame;
Прямоугольники и кривые
Ш
BEGIN G := GraphicFrames.Focus();
IF (G tt NIL) & (G. mark, next tt NIL) THEN
GraphicFrames.Deselect(G);
xO := G.mark.x; yO := G.mark.y; r := ABS(G.mark.next.x - xO);
IF r > 4 THEN
NEW(c); c.x := xO - r - G.x; c.y ;= yO - r - G.y; c.w := 2 * r + 1;
c.h := c.w;
c.kind := 2; c.col := Oberon.CurCol;
c.lw := Graphics.width; c.do := method;
Graphics.Add(G.graph, c);
GraphicFrames.Defocus(G); GraphicFrames.DrawObj(G, c)
END
END
END MakeCircle;
PROCEDURE MakeEllipse*; (*команда*)
VAR xO, у0, a, b: INTEGER;
c: Curve;
G: GraphicFrames.Frame;
BEGIN G := GraphicFrames.Focus();
IF (G tt NIL) & (G. mark, next tt NIL) & (G. mark. next, next tt NIL) THEN
GraphicFrames.Deselect(G);
xO := G.mark.x; yO := G.mark.y;
a := ABS(G.mark.next, x - xO); b := ABS(G.mark.next.next.у - yO);
IF (a > 4) & (b > 4) THEN
NEW(c); c.x : = xO - a - G.x; c.y := yO - b - G.y; c.w := 2 * a + 1;
c.h := 2 * b + 1;
c.kind := 3; c.col := Oberon.CurCol;
c.lw := Graphics.width; c.do := method;
Graphics.Add(G.graph, c);
GraphicFrames.Defocus(G); GraphicFrames.DrawObj(G, c)
END
END
END MakeEllipse;
BEGIN NEW(method); method.module := "Curves"; method.allocator := "New”;
method.new := New; method.copy := Copy; method.draw := Draw;
method.selectable := Selectable; method.handle := Handle;
method.read := Read; method.write := Write; method.print := Print
END Curves.
Графический редактор
540
14. ИНСТРУМЕНТЫ СОЗДАНИЯ
И ПОДДЕРЖКИ СИСТЕМЫ
14.1 .Процесс запуска
Аспект, которому обычно уделяется мало внимания в системных описаниях, -
это процесс запуска системы. Однако выбор его сам по себе интересен и весьма да¬
лек от тривиальных проектных решений и будет описан здесь довольно подробно.
Более того, он в точности определяет этапы разработки системы с нуля, отражая
этапы самоустановки - от пустой памяти до работающего тела.
Процесс запуска, как правило, проходит в несколько этапов, каждый из кото¬
рых приводит в действие новые возможности, поднимая систему на более высо¬
кий уровень совершенства. Название этой стратегии - первоначальная загрузка,
или, на современном компьютерном жаргоне, раскрутка.
Этап 1 начинается, когда включается питание или когда нажата и отпущена
кнопка сброса. Чтобы быть точным, включение питания подает сигнал сброса всем
частям компьютера и удерживает его в течение определенного времени. Таким об¬
разом, отпущенная кнопка сброса проявляет себя как включение питания без его
выключения. Подача сигнала сброса заставляет процессор запустить так называе¬
мый загрузчик. Эта программа постоянно находится в памяти только для чтения
(ROM) и, следовательно, всегда присутствует, даже на «голой» машине. Она за¬
гружает в память данные, которые на этапе 2 интерпретируются как код. Чтобы
сохранить загрузчик настолько простым, насколько это возможно, вспомним, что
он прошивается в ROM на каждой рабочей станции и потому не может быть из¬
менен без значительных усилий - формат его данных должен быть простым. Мы
выбрали следующую структуру, которая никогда не менялась в течение всей раз¬
работки системы Оберон, и из-за ее простоты, и из-за ее общности:
BootFile = {block}.
block = size:4 address:4 {byte}.
Адрес последнего блока с размером size = 0 интерпретируется как адрес от¬
правной точки этапа 2. Размер загрузчика Ceres - около 250 байтов.
Обычно источник загружаемых данных - это фиксированное место на диске.
В нашем случае данные занимают меньше одной дорожки, которая поэтому назы¬
вается загрузочной дорожкой и постоянно остается резервной.
© N. Wirth, 30.8.91 /22.11.91
542
Инструменты создания и поддержки системы
Загруженные на этапе 1 данные интерпретируются как код на этапе 2, пред¬
ставляя модули Kernel, FileDir, Files и Modules, которые, как говорят, составляют
внутреннее ядро системы. Управление передается блоку инициализации модуля
Kernel. Сначала инициализируются регистры базовых адресов процессора, за¬
тем формируется цепочка пустых дескрипторов модулей. Вслед за этим на тех
машинах, где есть блок управления памятью, инициализируются необходимые
страницы виртуальных адресов. Инициализируются таблица прерываний и блок
управления прерываниями (ICU), и, наконец, выполняются блоки инициали¬
зации остальных трех модулей, последний из которых, - Modules. Отметим, что
во внутреннем ядре находится только один драйвер устройства - драйвер диска
в модуле Kernel.
Присутствие модуля Modules означает, что регулярный загрузчик доступен
для дальнейшего наращивания системы. Модуль Files присутствует во внутрен¬
нем ядре, потому что он импортируется Modules, a FileDir, в свою очередь, импор¬
тируется Files. Инициализация модуля FileDir создает таблицу занятости секто¬
ров, записывая все файлы, зарегистрированные в каталоге файлов. Этот процесс
требует обхода всего каталога и чтения всех заголовков файлов. Его можно счи¬
тать процессом сборки мусора в секторах диска. Блок инициализации Modules со¬
держит оператор
М : = ThisMod("Oberon")
который вызывает загрузку модуля Oberon и автоматически вместе с ним - всех
импортируемых им модулей. В этом состоит этап 3 процесса загрузки. В частно¬
сти, этап 3 загружает и инициализирует драйверы дисплея, клавиатуры и мыши,
а также поддержку дисплея, текста и шрифта. Он заканчивается инициализацией
самого модуля Oberon, который содержит оператор
М := Modules.ThisModC'System")
Он начинает этап 4 процесса раскрутки и пополняет систему, загружая первый
инструментальный модуль. Инициализация System открывает одно окошко для
файла журнала и другое для текста инструмента. В дополнение к System загружа¬
ются модули MenuViewers и TextFrames, потому что они импортируются System.
Загруженные до сих пор модули образуют внешнее ядро. Попутно отметим, что на
этапе 4 нужны также шрифт по умолчанию и текст из System.Tool. По завершении
этапа 4 управление возвращается операторам
Р := ThisCommand(М, "Loop"); Р
в блоке инициализации Modules. Таким образом, управление передается централь¬
ному циклу системы Оберон для опроса входящих событий. Началась нормальная
работа.
Давайте подытожим необходимые условия для всех четырех этапов:
0. Системный загрузчик должен постоянно находиться на ROM.
1. Загрузочный файл должен постоянно находиться на загрузочной дорожке
диска.
2. Модули внешнего ядра должны постоянно находиться в файловой системе.
Обычно эти условия соблюдаются. Но это не так, если у нас либо новая, «го¬
лая» машина, либо испорченный диск. В этих случаях необходимые условия, ко¬
нечно, должны создаваться с помощью подходящих инструментальных средств.
Инструментальные средства, необходимые для случая «голой» машины или неза¬
полненной файловой памяти, называются инструментами создания, а те, что нуж¬
ны в случае дефектов, называются инструментами поддержки (сопровождения).
14.2. Инструменты создания
Инструменты создания системы позволяют устанавливать три предваритель¬
ных условия для процесса раскрутки на «голой» машине. Условие 0 требует ассемб¬
лера для программирования загрузчика и так называемого ROM-программатора,
как правило, внешнего устройства, подключаемого по каналу связи RS-232 (V24).
Не будем далее обсуждать эти инструментальные средства. Условие 1 требует ин¬
струментов для составления загрузочного файла, а также записи его на загрузоч¬
ную дорожку. Условие 2 требует инструмента, который создает каталог файлов pi
в состоянии загрузить файлы. Инструмент, который создает загрузочный файл,
называется загрузочным компоновщиком; этот модуль назван Boot. Инструмент,
у которого есть возможность записать на загрузочную дорожку и загрузить фай¬
лы, - это модуль OberonO.
Остается главный вопрос: как OberonO загружается на «голую» машину. Час¬
тичный ответ: с помощью процесса загрузки, состоящего только из этапов 1 и 2,
используя загрузочный файл, в котором модуль Modules заменен на OberonO. Но
этого недостаточно. Ключевое средство - это загрузчик загрузчика, который до¬
пускает внешний источник в качестве альтернативы загрузочной дорожке диска.
В качестве альтернативного источника мы используем (загрузочную дорожку)
дискеты. Выбор источника определяется переключателем. Он исключает в фазе
загрузки использование любых устройств ввода-вывода, кроме драйвера дискеты.
Тогда ритуал инициализации «голой» машины состоит из следующих шагов:
1. Выбрать альтернативный источник загрузки установкой переключателя.
2. Сброс. Читается загрузочный файл и стартует OberonO.
3. Вызвать команду, читающую все файлы с дискеты, которая предположи¬
тельно содержит все файлы, необходимые для внешнего ядра.
4. Восстановить переключатель и повторить загрузку. Это инициирует обыч¬
ный процесс загрузки.
Более современное решение состоит в том, чтобы выбрать сеть в качестве аль¬
тернативного источника файла загрузки. Мы отказались от такой возможности,
чтобы оставить подпрограммы доступа к сети за пределами ROM и запуск систе¬
мы на компьютере независимым от наличия сервера, а также с учетом того, что
есть машины, работающие в автономном режиме. Как оказалось, необходимость
в альтернативном источнике загрузочного файла возникает очень редко.
Инструменты создания
Ш
Инструменты создания и поддержки системы
Загрузочный компоновщик почти идентичен загрузчику модулей, за исклю¬
чением того, что объектный код размещается не во вновь выделяемых блоках,
а в определенном буфере, который, в конце концов, выводится для формирования
загрузочного файла. Его имя подставляется в качестве второго параметра коман¬
ды Boot.Link. Первый параметр задает модуль, который является вершиной иерар¬
хии, образующей внутреннее ядро
Boot.Link Modules Ceres2.Boot
Boot.Link OberonO Ceres2.BootO
Загрузочный файл состоит из четырех блоков (см. раздел 14.1). Первый блок
содержит дескрипторы модулей (см. главу 6) внутреннего ядра. Второй блок со¬
стоит из их кода и глобальных разделов данных. Третий блок содержит длины
первых двух блоков. Четвертый блок задает начальный адрес Kernel. Адреса за¬
грузки первых трех блоков - фиксированные константы в программе Boot (4000Н,
8000Н, 0).
Из приведенного выше описания процесса запуска на «голой» машине модуль
OberonO должен сначала инициализировать каталог файлов, а затем загрузить все
файлы, содержащиеся на загрузочной дискете. Мы решили расширить OberonO до
гораздо более универсального инструмента. Это решение было не просто мудрым
предвидением, а возникло благодаря появлению OberonO из самого процесса раз¬
вития системы Оберон, который, естественно, включал значительное количество
выявленных ошибок и их исправлений [1]. Поэтому OberonO содержит настоящий
интерпретатор команд, где есть команды просмотра областей памяти, секторов
диска, просмотра каталога файлов и даже загрузки модулей. Наличие интерпре¬
татора команд требует средств ввода (клавиатура) и вывода (дисплей). Они были
сведены к минимуму и собраны в модуле /О.
DEFINITION 10;
PROCEDURE Read (VAR ch: CHAR);
PROCEDURE WriteLn;
PROCEDURE Write (ch: CHAR);
PROCEDURE WriteString (s: ARRAY OF CHAR);
PROCEDURE WriteHex (x: LONGINT);
PROCEDURE Writelnt (x, n: LONGINT);
END 10.
Интерпретатор команд - это простой цикл, допускающий однобуквенные
команды, сопровождаемые параметрами - шестнадцатеричными числами или
именами. Здесь не придавалось особого значения удобству пользователя, и это,
конечно, несправедливо. Воздержимся от погружения в дальнейшие подробности
и сосредоточимся на списке доступных команд. Они должны дать читателю пред¬
ставление о возможностях этого инструментального модуля по инициализации
системы и поиску ошибок.
544
Инструменты поддержки
г
паше
Прочитать файл с дискеты
W
пате
Записать файл на дискету
d
пате
Удалить файл с дискеты
Z
Прочитать все файлы дискеты
е
Перечислить файлы дискеты
!i
Инициализировать каталог дискеты
!f
Отформатировать дискету
Е
Перечислить каталог файлов
D
пате
Удалить файл
N
патеО namel
Переименовать файл
М
пате
Загрузить и инициализировать модуль
С
пате
Вызвать команду
О
Загрузить Oberon и вызвать Loop
а
address
Показать блок памяти (256 байтов) в шестнадцатеричном виде
А
address
Показать блок памяти (256 байтов) в символьном виде
к
number
Показать сектор диска в шестнадцатеричном виде
К
number
Показать сектор диска в символьном виде
1
Очистить дисплей
?
Перечислить доступные команды
t
Получить системные время и дату с таймера
Т
time date
Задать системные дату и время в таймере
!В
name
Загрузить файл на загрузочную дорожку
!Y
Инициализировать файл сбойных секторов
!1
Инициализировать каталог файлов
Все эти дополнительные команды придают модулю OberonO характер инстру¬
мента поддержки. В частности, возможность читать отдельные файлы с дискеты
позволяет восстановить их, когда файл, необходимый на этапах 3 или 4 процесса
загрузки, был поврежден. Команда О позволяет обнаружить, в каком месте про¬
цесс дал сбой. Однако первоначальная цель OberonO - инициализировать «голую»
машину командами /1, !В и z.
14.3. Инструменты поддержки
Выше не было упомянуто важное необходимое условие этапа 2 (и последую¬
щих) процесса загрузки. Напомним, что инициализация модуля FileDir строит
в Kernel таблицу занятости секторов диска по информации, содержащейся на дис¬
ке. Очевидно, необходимое для этого условие - неповрежденный, непротиворе¬
чивый каталог файлов. Единственный нечитаемый, поврежденный каталог файла
или сектор заголовка файла приводит к сбою этого процесса, и загрузка становит¬
Еш
Сектора всегда считываются в буфер, а именно в буфер секторов, буфер ката¬
лога, буфер заголовков или буфер дорожки, а номер сектора запоминается в соот¬
ся невозможной. Чтобы справиться с этой (к счастью, редкой) ситуацией, был раз¬
работай инструмент поддержки системы - модуль DiskCheck. Он включен в осо¬
бый загрузочный файл, создаваемый командой
Boot.Link DiskCheck Ceres2.CheckBoot
DiskCheck организован подобно OberonO, как простой интерпретатор команд, но
он импортирует только Kernel и /О. Следовательно, загрузка затрагивает лишь эта¬
пы 1 и 2 без всякого обращения к диску. Работа с DiskCheck требует осторожности
и знания структуры файловой системы (глава 7). Доступные команды приведены
ниже; те из них, что записывают на диск, начинаются с восклицательного знака.
546
Инструменты создания и поддержки системы
г
n
Считать сектор n в буфер секторов, показать в шестнадцатеричном виде
R
n
Считать сектор п в буфер секторов, показать в символьном виде
е
n
Считать расширенный индексный сектор п в буфер секторов
!W
Записать буфер секторов
d
n
Считать сектор каталога п в буфер каталога
!D
Записать буфер каталога
h
11
Считать сектор заголовка в буфер заголовка
!II
Записать буфер заголовка
X
11
Считать дорожку, содержащую сектор п, в буфер дорожки
!Y
Форматировать дорожку
!Z
Записать буфер дорожки
S
111 n
Вставить сектор п как адрес заголовка входа in в буфере каталога
s
in n
Вставить сектор п в точку входа m таблицы секторов в буфере заголовка
L
11
Установить длину п файла в буфере заголовка
i
adr val
Вставить значение val по адресу adr в буфере секторов
f
name
Считать сектор заголовка файла name в буфер заголовка
q
n
Найти все файлы, частью которых является сектор п
с
Проверить совместимость файлов и каталога
b
li
Добавить поврежденный сектор в таблицу сбойных секторов
1
Очистить дисплей
Q
Перезапустить дисковод
?
Перечень доступных команд
!0
n
Очистить сектор п (записать нули)
!1
Инициализировать каталог файлов
!2
Инициализировать таблицу сбойных секторов
!?
Читать все сектора диска и регистрировать дефектные сектора
!*
Форматировать диск
ветствующем буфере. Изменения производятся в данных, сохраненных в соответ¬
ствующем буфере, который отображается после каждого чтения или изменения в
соответствующим образом декодированном формате. Каждое изменение должно
быть подтверждено, потому что только команда записи помещает данные из бу¬
фера на диск.
Типичная обработка при наличии поврежденного сектора в файле состоит из
следующих шагов:
1. Читается дорожка, содержащая нечитаемый сектор (х).
2. Дорожка переформатируется (IY).
3. Дорожка восстанавливается (!Z). (Ошибочные данные сектора теряются.)
4. Дорожка считывается вновь (х), а шаги повторяются, если состояние не
меняется.
5. Если после нескольких попыток сектор не может быть исправлен, файл
должен быть удален. Чтобы сделать возможным обход каталога без изме¬
нения данных каталога, соответствующая его запись изменяется (S). Прос¬
тейший способ - сделать ее равной соседней записи, вводя таким образом
несоответствие (задвоенная ссылка), которое должно быть устранено пу¬
тем удаления файла, как только система Оберон заработает.
6. Безнадежно испорченный сектор нужно сделать «невидимым». Это дела¬
ется добавлением его в файл с именем BadSectors, который, безусловно, не¬
читабелен, но который позволяет помечать его сектора как используемые
в процессе инициализации таблицы занятости секторов на этапе 2 раскрут¬
ки. Сектор добавляется в этот файл командой Ь.
7. Когда система Оберон опять доступна, восстановленные файлы должны
быть или удалены, или просмотрены и исправлены, если возможно.
Программа DiskCheck должна быть чрезвычайно устойчивой. Она не может до¬
пустить, чтобы чтение данных было некорректным, чтобы индекс лежал за преде¬
лами объявленных границ, чтобы номер сектора был неправильным и чтобы ката¬
лог или страница заголовка имели не тот формат. Защита и диагностика ошибок
занимают в ней заметное место. Поскольку любой отказ программы должен быть
исключен, использовать дисковые процедуры модуля Kernel бесполезно. Они пе¬
реписаны с дополнительной защитой и отчетами о состояниях.
Если поврежденный, нечитаемый сектор в файле в худшем случае приводит
к потере этого файла, то ошибка в секторе со страницей каталога вовсе губительна.
Потому что становятся недоступными не только файлы, на которые она ссылает¬
ся, но и страницы-потомки, которые ссылаются на нее. Повреждение в корневой
Странице вызывает потерю вообще всех файлов. Катастрофа может иметь такие
масштабы, что меры должны быть приняты, даже если подобный случай почти
невозможен. В конце концов, это может случиться, и действительно случалось.
Единственный способ восстановить файлы, которые больше не доступны из
каталога, - это сканирование всего диска. Чтобы сделать поиск вообще возмож¬
ным, каждый заголовок файла имеет поле метки, которому дают фиксированное,
постоянное значение. Почти невероятно, но не исключено, что сектора данных,
Которые, случается, имеют одинаковые значения в позиции, соответствующей
значению метки, могут по ошибке считаться заголовками.
Инструменты поддержки
Инструмент, выполняющий такой просмотр, называют Scavenger (Мусорщик),
Подобно DiskCheck, это простой интерпретатор команд, а загрузочный файл соз¬
дается командой
Boot.Link Scavenger Ceres2.ScavBoot
Доступные команды:
s п Просмотреть первые п секторов и собрать заголовки
d Показать имена собранных файлов
W Создать новый каталог
L Очистить дисплей
? Показать доступные команды
Во время просмотра новый каталог постепенно создается в оперативной памя¬
ти. Сектора, отмеченные как заголовки, регистрируются по имени и дате создания.
Мусорщик - причина регистрации имени файла в заголовке, хотя оно остается
неиспользованным системой Оберон. Восстановление даты является основным,
потому что может быть найдено несколько файлов с одним и тем же именем. Если
найден файл с более поздней датой создания, старая запись перезаписывается.
Команда W переносит новый каталог на диск. Для этого нужно иметь в нали¬
чии свободные сектора. Они были собраны при просмотре: в качестве свободных
используются и старый сектор каталога (определяемый меткой каталога, подобно
метке заголовка), и перезаписанные заголовки.
Мусорщик доказал свою ценность в более чем одном случае. Его основной не¬
достаток - в том, что он может вновь открыть уже удаленные файлы. Операция
удаления по определению влияет только на каталог, по пе на сам файл. Поэтому
заголовок с именем файла остается неизменным и обнаруживается при просмот¬
ре. Однако в общем и целом это небольшой недостаток.
Литература
1. N. Wirth. Designing a System from Scratch. Stnictured Programming, 1, (1989),
11-19.
Инструменты создания и поддержки системы
548
А. ДЕСЯТЬ ЛЕТ СПУСТЯ:
ОТ ОБЪЕКТОВ К КОМПОНЕНТАМ
Операционная модель проекта Оберон, описанная в главах 3, 4 и 5, в основном
доказала свою безупречность и жизнеспособность на практике. Однако более
поздние разработки постепенно раскрывали некоторые неиспользованные воз¬
можности. Основным недостатком было отсутствие обобщенного типа объекта,
который служил бы абстрактным корнем всей иерархии объектов Оберона. Для
его устранения позже мы добавили модуль под названием Objects и два абстракт¬
ных типа Object и Library, из которых через расширение типа мы затем вывели
некоторые ранее независимые типы. На рис. А.1 изображена итоговая иерархия
типов. Это простое расширение ядра Оберона оказало поразительно благотворное
влияние и позволило нам значительно усовершенствовать исходную систему Обе¬
рон, включая:
□ обобщенный механизм постоянства для объектов;
□ обобщенное понятие текста как последовательности произвольных объ¬
ектов;
□ полностью иерархическую структуру компонентов;
□ расширенный графический интерфейс пользователя (GUI), названный
Gadgets.
На рис. А.5 в конце этой главы показана модульная структура усовершенство¬
ванной системы Оберон.
В следующих разделах мы коротко обсудим разумные доводы в ее пользу и
проиллюстрируем ее применение.
Рис. А. 1. Иерархия типов Оберона
А. 1. Библиотеки объектов
Модель постоянных (persistent) объектов определяется в Обероне единствен¬
ным модулем под названием Objects, который экспортирует два абстрактных по¬
нятия, представленных типами Object и Library.
Библиотека объектов - это индексированная коллекция объектов (точнее, эк¬
земпляров объектов). Библиотека бывает либо общей (public), либо личной (pri¬
vate) для какого-то главного компьютера. Имена общих библиотек доступны при
любых полномочиях в системе. Например, к объекту О, входящему в общую биб¬
лиотеку L, можно обратиться просто по его составному имени L.O. Кроме того, на
рис. А.2 показано, что библиотеки объектов могут ссылаться друг на друга. Все
вместе они образуют иерархию, которая в каком-то смысле двойственна иерархии
Рис. А.2. Двойственные иерархии библиотеки объектов и модулей
550
Десять лет спустя: от объектов к компонентам
Библиотеки объектов
модулей системы. Личные библиотеки не имеют имен и скрыты более высокими
полномочиями, обычно в документе. Этот случай также показан на рис. А.2.
Библиотеки объектов используются в Обероне для управления постоянными
объектами. По сути, они служат двум разным целям:
□ представлению логически связанных групп объектов как индексированных
коллекций;
□ оказанию общей поддержки для линеаризации и делинеаризации пред¬
ставлений объектов. Линеаризация/делинеаризация применяется для вы¬
грузки и загрузки постоянных объектов в постоянную память или в сеть и
обратно.
Функциональный интерфейс библиотек объектов включает множество опе¬
раций для извлечения, добавления и удаления объектов (при выполнении) и для
выгрузки их содержимого в последовательный файл и загрузки из него.
Объекты обычно (рекурсивно) собираются из компонент и внутренне пред¬
ставляются как граф связанных узлов. Отсюда следует, что алгоритмы выгрузки и
загрузки объектов должны быть достаточно общими, чтобы линеаризовать и дели-
неаризовать любую произвольную динамически связанную неоднородную струк¬
туру данных. Поэтому интересно изучить эти алгоритмы несколько подробнее.
Ради простоты допустим простую, бескомпромиссную схему сохранения/
загрузки. Заметим, однако, что определение типа Library допускает различные
реализации своего функционального интерфейса, такие, например, как изящная
стратегия порционного сохранения/загрузки в комбинации с буферизацией.
Обобщенный алгоритм выгрузки
Это двухпроходный процесс, в основе которого - (рекурсивная) фаза связы¬
вания, сопровождаемая фазой фактического сохранения:
Привязать (объект) = begin
for all компонент объекта do Привязать (компонент) end;
if объект не привязан then назначить индекс объекту end
end
Сохранить (библиотека) = begin
for all объект в библиотеке do Привязать(текущий объект) end;
for all индекс в библиотеке do
with объект для этого индекса do
сохранить генератор;
(*) сохранить основной узел, где указатели заменены индексами
end
end
end
Оператор, помеченный (*), не может быть выполнен универсальным методом
библиотеки, потому что внутренняя структура объекта библиотеке неизвестна.
Вместо него нужен вызов метода экземпляра.
lilili
Обобщенный алгоритм загрузки
Это тоже двухироходный процесс:
Загрузить (библиотека) = begin
for index := 0 to max do загрузить генератор; сгенерировать основной узел end;
for index := 0 to max do
(*) загрузить основной узел, где указатели заменены индексами
end
end
Помеченный оператор тоже должен быть реализован как вызов метода экземп¬
ляра. Кроме того, заметим, что индексы в узлах объектов могут ссылаться к раз¬
ным библиотекам и поэтому могут привести к рекурсивному процессу загрузки.
Теперь давайте оставим на мгновение обсуждение библиотек и обратимся
к объектам. На уровне определения объекты абстрактны (или «виртуальны») и не
имеют никаких конкретных функциональных возможностей. Однако считается,
что любой объект-участник соблюдает основной предопределенный протокол со¬
общений, который в каком-то смысле определяет структуру постоянных объектов
Оберона. По аналогии с известным понятием аппаратной шины мы могли бы на¬
звать такую архитектуру программной шиной: компоненты-участники включают¬
ся, просто соблюдая определенный протокол сообщений.
Вот краткий обзор набора предопределенных типов сообщений:
□ Сообщение «Привязка». Используется для привязки объектов к данной
библиотеке. Точнее, если мы назовем свободным всякий объект, который
либо не привязан, либо привязан к безымянной библиотеке, то сообщение
Привязка требует, чтобы получатель и все его свободные компоненты при¬
вязали себя.
□ Сообщение «Файл». Используется для выгрузки и загрузки объектов в и из
последовательного файла.
□ Сообщение «Атрибут». Атрибуты объектов задаются своим именем и зна¬
чением (обычно строкой или числом). Используя сообщение Атрибут,
атрибуты могут добавляться, а их значения могут извлекаться или изме¬
няться. Gen и Name - предопределенные атрибуты. Они задают генератор
объекта (процедуру) и ее встроенный идентификатор соответственно.
□ Сообщение «Связь». Используется для создания и извлечения именован¬
ных связей с другими объектами. Позволяет «связать» компоненты при
выполнении.
□ Сообщение «Поиск». Используется для поиска и извлечения компоненты
по их именам в пределах области видимости получателя.
□ Сообщение «Копия». Используется для создания точной копии (двойника)
получателя. В случае составного исходного объекта мы различаем поверх¬
ностные и глубокие копии. Если поверхностные копии все еще обращаются
к компонентам исходного объекта, то глубокие копии состоят из новых ко¬
пий компонентов исходного объекта.
Десять лет спустя: от объектов к компонентам
552
А.2. Кадры как визуальные объекты
В главе 4 мы познакомились с очень важным реальным классом объектов -
кадрами на экране дисплея. Кадры - это визуальные объекты, потому что они, как
предполагается, обеспечивают функциональные возможности для некоторого ви¬
зуального представления в пределах прямоугольной области экрана (или принте¬
ра). Как правило, кадр представляет вид некоторой модели объекта и появляется
вместе со встроенным контроллером, как правило, интерпретатором взаимодейст¬
вий. Другими словами, типичный кадр объединяет УС-компоиенты схемы MVC.
С технической точки зрения, кадры - это экземпляры объектов типа Frame,
который, в свою очередь, является расширением исходного типа Object. В итоге
кадры в Обероне - это визуальные постоянные объекты, которые, как считается,
подчиняются основному протоколу сообщений и набору специальных сообщений
кадров, управляющих их отображением. Набор сообщений кадров включает за¬
просы: отобразить себя; изменить чье-то состояние (видимый/невидимый), размер
или положение; включить в себя другой объект или какую-то текстовую надпись;
вернуть выделенную часть содержимого; пометить себя как выбранный; обновить
содержимое вместе с его моделью.
В некотором смысле естественно считать саму область отображения глобаль¬
ным визуальным контейнером, который иерархически включает в себя меньшие
контейнеры или объекты. Такой взгляд имеет некоторые интересные следствия.
Во-первых, как показано на рис. А.З, это ведет к непрерывному расширению
иерархической структуры «мозаичного» экрана дисплея Оберона, два первых
уровня которого образуют (вертикальные) дорожки и (горизонтальные) окошки
соответственно.
Второе следствие иерархической структуры пространства отображения - это
возможность схемы передачи сообщений, которая подчиняется строгому роди¬
тельскому управлению. Поскольку каждый визуальный объект - это, наверное,
косвенный компонент пространства отображения, сообщения, направленные
любому визуальному объекту, можно просто послать глобальному пространству
отображения с неявным распространением предписаний его компонентам. Точ¬
ная стратегия распространения предписаний зависит от вида сообщения. Если со¬
общение направлено некоторому определенному объекту (цели) в пространстве
отображения, применяется целенаправленная стратегия, тогда как широковеща¬
тельная стратегия применяется в случаях неизвестного конечного получателя
или неизвестной группы конечных получателей. Типичное применение широко¬
вещательной стратегии - это запросы на обновление представлений, посланные
моделями объектов, с существенной выгодой от освобождения моделей от бреме¬
ни слежения за их видами (например, в виде списков откатов).
Две стратегии распространения подобны в том смысле, что обе они контекст¬
но-ориентированные. Однако они различаются в деталях. В то время как ши¬
роковещательная стратегия просто распространяет сообщение в пространстве
отображения, целенаправленная стратегия распространения нацелена на передачу
сообщения по пути, ведущему к нужному целевому объекту. Мы должны разъ¬
Кадры как визуальные объекты
Еш
554
Десять лет спустя: от объектов к компонентам
яснить, что стратегия распространения сообщений вниз по иерархии отображе¬
ний - это часть расширенного протокола сообщений, который обязателен для всех
членов пространства отображения.
Теперь давайте проследим за сообщением, которое проходит по пространству
отображения и, наконец, прибывает но назначению. Мы знаем, что к моменту свое¬
го прибытия сообщение шаг за шагом прошло по всему контексту. Из этого факта
можно извлечь выгоду в двух отношениях: (а) любая контектно-ориентированная
обработка может выполняться инкрементально и (б) возможна контекстно-зави¬
симая обработка сообщений. Типичное применение (а) - накопление относитель¬
ных координат и вычисление масок перекрытия в контексте визуального объекта.
Типичное использование (б) - визуальные объекты, демонстрирующие различное
поведение в контексте разработчика и в контексте пользователя.
Возможное осложнение возникает из того, что мы позволяем обозрения видов,
так называемые обозрения камер (рис. А.З). Как следствие пути могут соединять¬
ся в пространстве отображения, и мы больше не можем утверждать о его древо¬
видной структуре. В комбинации со стратегией контекстно-ориентированного
распространения это может привести к ошибкам из-за возможно невыявленного
многократного поступления сообщения одному и тому же объекту. Например, со¬
общение о копии, поступающее дважды общему компоненту составного объекта,
может привести к созданию двух разных копий этого компонента. Чтобы избежать
проблем такого рода, сообщения Оберона имеют отметки времени (time-stamped),
и тогда получателю в пространстве отображения для обнаружения многократного
поступления одного и того же сообщения требуется сравнить отметки времени.
Подвести итог всевозможным правилам обработки и передачи сообщений
в пространстве отображения можно лучше всего, представив грубый набросок об¬
работчика сообщений:
Обработчик сообщения М, полученного кадром F = begin
Сохранить указатель на контекст в F; обновить указатель контекста в М;
if есть отметка времени в Н, то обновить отметку времени в F then
сохранить отметку времени в F;
накопить координаты в М;
if целевой кадр М = F then (*целевой кадр достигнут*) обработать М
else
if целевой кадр М = NIL then ^распространить сообщение*) обработать М end;
while есть потомки do
передать М следующему потомку
end
end
else специальная обработка в новом контексте
end
end
На самом деле обработка сообщений несколько сложнее, потому что (ради оп¬
тимизации) получатели имеют право (досрочно) завершать обработку сообщения
и останавливать дальнейшее его распространение.
Встроенные объекты
Рис. А.З. Иерархия пространства отображения Оберона
Теперь кратко вернемся к комментарию, который мы привели в более ранней
главе о значении открытых интерфейсов объектов. Как легко видеть, любая кон¬
текстно-ориентированная стратегия распространения фактически требует откры¬
тых интерфейсов объектов. Причина в том, что промежуточные станции на пути
сообщения должны быть способны передавать (и даже обрабатывать) сообщения,
возможно, неизвестного типа, например запросы на обновление вида экзотиче¬
ских компонентов.
А.З. Встроенные объекты
Можно различать два вида контейнеров для объектов: (а) объекты-контейне¬
ры и (б) текст. Очевидно, случай (а) относится к иерархическому принципу по¬
строения составных объектов, который достигает кульминации в конструкции
шт
556
Десять лет спустя: от объектов к компонентам
глобального пространства отображения. Для случая (б) существует иное, но не
менее изящное решение. Сначала давайте вспомним исходную модель текста Обе¬
рона. Текст Оберона - это последовательность символов с атрибутами, или, чуть
проще, последовательность пар (код символа, шрифт).
Теперь ключевая идея нашего решения - это смещение акцента на интерпре¬
тацию атрибута font. Просто иначе истолковывая font как коллекцию символов,
мы приходим к представлению текста как последовательности пар (код символа,
коллекция символов). Теперь остается небольшой шаг от «коллекции символов»
к «коллекции объектов» или «библиотеке объектов». С учетом этого сейчас наши
обобщенные тексты - это последовательности пар (индекс, библиотека объектов),
которые являются последовательностями общих объектов. В зависимости от вида
библиотеки встроенный объект является либо общим (и возможно, содержащимся
и в других документах тоже), либо личным по отношению к содержащемуся тексту.
Типичные примеры несимвольных объектов - это картинки, формулы и любые
визуальные объекты. Однако возможны совсем другие виды невизуальных встро¬
енных объектов, например управляющие символы и ссылки.
А.4. Аксессуары
Аксессуары (gadgets) в Обероне - это объекты, которые служат элементами
графического интерфейса пользователя (GUI). Визуальные аксессуары имеют
большое разнообразие - от простых кнопок, переключателей, ползунков, тексто¬
вых полей, списков, значков и т. д. до таких более сложных элементов, как ри¬
сунки, линейная графика, панели управления, тексты и весь рабочий стол. Кроме
того, существуют такие невизуальные образцовые аксессуары, как Boolean, Integer,
Real и т. д. Некоторые аксессуары представляют собой полосу заголовка вместе
с табличкой с именем и набором кнопок. Они называются документами и счита¬
ются автономными объектами, которые могут храниться под своими именами и
погружаться в произвольный контекст. Сам рабочий стол - это документ, который
показывает, что документы могут (рекурсивно) содержать другие документы как
элементы. На рис. А.4 показан снимок рабочего стола с аксессуарами.
Набор встроенных аксессуаров может быть легко расширен программирова¬
нием заказных аксессуаров. Сложность заказных аксессуаров весьма существен¬
но зависит от их структуры. Контейнерные аксессуары вроде панелей на порядок
сложнее атомарных аксессуаров вроде кнопок, списков и столбчатых диаграмм.
Это неудивительно, потому что контейнерные аксессуары должны быть в состоя¬
нии управлять объектами-наполнителями произвольного типа. Их обработчики
сообщений должны точно соблюдать родительское управление, включая распрост¬
ранение сообщений к их содержимому. Кроме того, они должны быть готовы к об¬
ратным запросам от своего содержимого (например, если объект содержимого
требует расширения).
Инструмент Gadgets используется для создания и соединения аксессуаров
в интерактивном режиме. Оно само - тот же аксессуар (документ), который содер¬
жит два списка и несколько кнопок. В списках приводится обширная коллекция
Аксессуары
Рис. АЛ. Рабочий стол GUI Gadgets Оберона
предопределенных визуальных и образцовых аксессуаров соответственно. Кроме
того, инструмент Gadgets обеспечивает другую полезную поддержку для интерак¬
тивного конструирования, например автоматическое выравнивание в жестко раз¬
мечаемых панелях и связывание просмотровых моделей со встраиваемым в них
содержимым. Например, текстовое поле и ползунок можно было бы связать с од¬
ной и той же моделью типа Real или три ползунка red, green, blue можно было бы
связать с моделью Color.
Инструмент Inspector - очень разносторонний инструмент, который может
применяться к любому аксессуару (визуальному или образцовому) для просмотра
его сущности, атрибутов и свойств. Примененный к определенному аксессуару,
инструмент тут же изменяет свою форму так, чтобы представить вид атрибута для
этого аксессуара. Отметим, что виды атрибутов - это тоже документы, но на сей
раз создаваемые программно.
В некоторых случаях (таких как только что обсужденные адаптивные формы
атрибута) интерактивный метод конструирования аксессуаров неприменим или, по
крайней мере, не подходит, и более предпочтительным мог бы стать описательный
подход. Конструирование программированием возможно, но не очень удобно. 11аи-
лучшее решение - это удобный язык сценариев компоновки и его интерпретатор.
Вот пример сценария компоновки в функциональном стиле программирования:
(LIB GUI
(FRAME MediaPanel (OBJ Panels.NewPanel)
(Volume (OBJ BasicGadgets.Newlnteger (Value 100)))
(Brightness (OBJ BasicGadgets.Newlnteger (Value 200)))
(GRID 2:50 1:* @ 1:25% 1:50% 1:25%) (PAD 2 @ 2)
(FRAME (POS 1 @ 1) (OBJ TextFields.NewCaption) (Value «Brightness»))
(FRAME (POS 1 @ 2) (OBJ BasicGadgets.NewSlider)
(Max 255) (Model Brightness) (Cmd «Movie.SetBright #Value Movie»)
)
(FRAME (POS 1 @ 3) (OBJ TextFields.NewTextField)
)
Рис. A. 5. Иерархия модулей Оберона
558
Десять лет спустя: от объектов к компонентам
Книги издательства «ДМК Пресс» можно заказать в торгово-издатель¬
ском холдинге «АЛЬЯНС-КНИГА» наложенным платежом, выслав от¬
крытку или письмо по почтовому адресу: 123242, Москва, а/я 20 или по
электронному адресу: orders@alians-kniga.ru.
При оформлении заказа следует указать адрес (полностью), по которо¬
му должны быть высланы книги; фамилию, имя и отчество получателя. Же¬
лательно также указать свой телефон и электронный адрес.
Эти книги вы можете заказать и в Интернет-магазине: www.alians-kniga.ru.
Оптовые закупки: тел. (495) 258-91-94, 258-91-95; электронный адрес
books@alians-kniga.ru.
Никлаус Вирт, Юрг Гуткнехт
Разработка операционной системы и компилятора
Проект Оберон
Главный редактор МовчанД.А.
dm@dmk-press.ru
Перевод с английского Борисов Е. В., Чернышов JI. Я.
Корректор Сыняева Г. И.
Верстка Чат шва А. А.
Дизайн обложки Мовчан А. Г.
OCR Дмитрий Сарыч
Подписано в печать 23.01.2012. Формат 60x90 1/16 .
Гарнитура «Петербург». Печать офсетная.
Уел. неч. л. 34,5. Тираж 200 экз.
Web-сайт издательства: www.dmk-press.ru