Преглед изворни кода

m2comp step 2 — SymTab semantic analysis (19/19 tests green)

Eric Streit пре 3 недеља
родитељ
комит
66e6274ac6
80 измењених фајлова са 5733 додато и 484 уклоњено
  1. BIN
      M2comp
  2. 3 3
      build.sh
  3. BIN
      docs/AST.pdf
  4. 0 0
      docs/BenjaminKowarsh.txt
  5. 10 0
      docs/oberon-master/.gitignore
  6. 106 0
      docs/oberon-master/HISTORY
  7. 674 0
      docs/oberon-master/LICENSE
  8. 48 0
      docs/oberon-master/Makefile
  9. 10 0
      docs/oberon-master/Mod/Chmod.Mod
  10. 22 0
      docs/oberon-master/Mod/Compiler.Mod
  11. 144 0
      docs/oberon-master/Mod/Generator.Mod
  12. 10 0
      docs/oberon-master/Mod/Makefile
  13. 460 0
      docs/oberon-master/Mod/Parser.Mod
  14. 177 0
      docs/oberon-master/Mod/Scanner.Mod
  15. 251 0
      docs/oberon-master/Mod/SymTable.Mod
  16. 5 0
      docs/oberon-master/Mod/c_chmod/c_chmod.c
  17. 6 0
      docs/oberon-master/Mod/c_chmod/c_chmod.h
  18. 74 0
      docs/oberon-master/README.md
  19. 4 0
      docs/oberon-master/TODO
  20. 22 0
      docs/oberon-master/Test.Mod
  21. 25 0
      docs/oberon-master/etc/Moduel_Ilja.Mod
  22. 201 0
      docs/oberon-master/etc/Moduel_RealUpto.Mod
  23. 58 0
      docs/oberon-master/etc/docs/Parser_WorkOrder.txt
  24. 33 0
      docs/oberon-master/etc/docs/Parser_and_Generator.txt
  25. BIN
      docs/oberon-master/etc/docs/schemes/00_varChar.png
  26. BIN
      docs/oberon-master/etc/docs/schemes/01_Bukva.png
  27. BIN
      docs/oberon-master/etc/docs/schemes/02_MyProc.png
  28. BIN
      docs/oberon-master/etc/docs/schemes/03_Import.png
  29. 0 0
      docs/oberon-master/etc/docs/schemes/src/00_varChar.xml
  30. 0 0
      docs/oberon-master/etc/docs/schemes/src/01_Bukva.xml
  31. 0 0
      docs/oberon-master/etc/docs/schemes/src/02_MyProc.xml
  32. 0 0
      docs/oberon-master/etc/docs/schemes/src/03_Import.xml
  33. 13 0
      docs/oberon-master/etc/docs/schemes/src/README.md
  34. 72 0
      docs/summary_m2comp_step2.md
  35. 16 1
      run_tests.sh
  36. 638 150
      src/M2comp.atg
  37. 21 21
      src/M2comp.err
  38. 3 3
      src/M2comp.lst
  39. 21 21
      src/M2comp.mod
  40. BIN
      src/M2comp.o
  41. 792 187
      src/M2compP.mod
  42. BIN
      src/M2compP.o
  43. 20 20
      src/M2compS.mod
  44. BIN
      src/M2compS.o
  45. 312 0
      src/SymTab.def
  46. 1104 0
      src/SymTab.mod
  47. BIN
      src/SymTab.o
  48. 1 0
      src/modules.lst
  49. 88 76
      tests/showcase.LST
  50. 14 2
      tests/showcase.mod
  51. 13 0
      tests/t_arith.LST
  52. 6 0
      tests/t_arith.mod
  53. 13 0
      tests/t_assign.LST
  54. 6 0
      tests/t_assign.mod
  55. 12 0
      tests/t_bool.LST
  56. 5 0
      tests/t_bool.mod
  57. 15 0
      tests/t_call.LST
  58. 8 0
      tests/t_call.mod
  59. 15 0
      tests/t_call2.LST
  60. 8 0
      tests/t_call2.mod
  61. 12 0
      tests/t_cond.LST
  62. 5 0
      tests/t_cond.mod
  63. 12 0
      tests/t_dup.LST
  64. 5 0
      tests/t_dup.mod
  65. 11 0
      tests/t_exit.LST
  66. 4 0
      tests/t_exit.mod
  67. 12 0
      tests/t_field.LST
  68. 5 0
      tests/t_field.mod
  69. 13 0
      tests/t_for.LST
  70. 6 0
      tests/t_for.mod
  71. 12 0
      tests/t_index.LST
  72. 5 0
      tests/t_index.mod
  73. 12 0
      tests/t_ptr.LST
  74. 5 0
      tests/t_ptr.mod
  75. 12 0
      tests/t_rel.LST
  76. 5 0
      tests/t_rel.mod
  77. 14 0
      tests/t_return.LST
  78. 7 0
      tests/t_return.mod
  79. 12 0
      tests/t_undecl.LST
  80. 5 0
      tests/t_undecl.mod

+ 3 - 3
build.sh

@@ -22,17 +22,17 @@ echo "=== Deleting all o files ==="
 rm -f ./*.o
 
 echo "=== Compiling the needed modules ==="
-for m in FileIO M2compS M2compP M2comp; do
+for m in FileIO SymTab M2compS M2compP M2comp; do
   gm2 -fiso -c "$m.mod" || exit 1
 done
 
 echo "=== Phase 1: generating the module list ==="
 gm2 -fiso -fgen-module-list=modules.lst -o /dev/null \
-    M2compS.o M2compP.o FileIO.o M2comp.mod || exit 1
+    M2compS.o M2compP.o FileIO.o SymTab.o M2comp.mod || exit 1
 
 echo "=== Phase 2: compiling main module and linking using the module list ==="
 gm2 -fiso -fuse-list=modules.lst -o ../M2comp \
-    M2compS.o M2compP.o FileIO.o M2comp.mod || exit 1
+    M2compS.o M2compP.o FileIO.o SymTab.o M2comp.mod || exit 1
 cd ..
 
 echo "=== M2comp built ==="


+ 0 - 0
docs/Document 1 sans titre → docs/BenjaminKowarsh.txt


+ 10 - 0
docs/oberon-master/.gitignore

@@ -0,0 +1,10 @@
+/*.c
+/*.h
+*.o
+*.sym
+.*.tmp
+*.swp
+*.bak
+*.BAK
+Compiler
+Test

+ 106 - 0
docs/oberon-master/HISTORY

@@ -0,0 +1,106 @@
+27 апреля 2020 г.
+Контекстный анализ конструкции вызова процедур: вар-параметры.
+
+22 апреля 2020 г.
+150-я годовщина со дня рождения В. И. Ленина.
+Контекстный анализ: проверка типов параметров процедуры. Добавлен класс
+объекта Par, означающий вар-параметр. Реализован импорт псевдомодулей
+In и Out и процедур In.Int, Out.Int, Out.Char, Out.Ln, для чего созданы
+процедуры SymTable.AddProc, SymTable.AddParam.
+
+19 апреля 2020 г.
+Реализован импорт модуля Out в SymTable.Import, а также процедуры
+Parser.QualIdent и SymTable.ThisObjInModule, позволяющие обращаться
+к объектам в других модулях.
+Реализован синтаксический анализ вызова процедуры, а частично и
+контекстный анализ (но типы параметров пока не проверяются).
+Появилась процедура Gen.MakeItem, переводящая Object в Item и процедура
+Gen.Call, вызываемая при обработке вызова процедуры.
+Вызов SymTable.Init перенесён из модуля Compiler в Parser.Init, в Parser
+добавлен объект dummy, который выдаёт QualIdent в случае ошибки.
+
+17 апреля 2020 г.
+Процедура Parser.Type упрощена, теперь она возвращает результат в виде
+SymTable.Type, а не Generator.Item. Реализована синтаксическая
+структура IMPORT.
+
+15 апреля 2020 г.
+Factor теперь устанавливает значение Item.val. SimpleExpression и Term
+во время компиляции производят арифметические операции над константами.
+При объявлении переменных распределяются их адреса (см. varsize, dc).
+Исправлено: При обработке целочисленных и других литералов Factor
+выдавал Item.mode = Var вместо Const. Добавлен класс/режим Const.
+
+13 апреля 2020 г.
+Изменены константы лексического анализатора. Добавлена обработка
+литерного типа в процедуре Factor (41X или "A"). Строки иной длины
+обрабатываются лексическим анализатором, но отвергаются синтаксическим.
+Завершён семантический анализ. Начато добавление val в Object и Item.
+
+12 апреля 2020 г.
+Добавлен тип CHAR (но Factor ещё не обрабатывает строковой литерал).
+Ошибки выводятся красным цветом. Переделан оператор присваивания, в его
+левой части теперь «обозначение», обрабатываемое процедурой Designator,
+производится проверка согласования типов. Expression, SimpleExpression,
+Term и Factor теперь передают друг другу данные через x: Item, проверяя
+типы, где необходимо.
+
+5 апреля 2020 г.
+Новая процедура символьной таблицы ThisObj ищет текущий идентификатор.
+Она используется в нетерминале Type. Начальные объекты символьной
+таблицы теперь все имеют какое-либо имя (иначе был бы невозможен
+поиск). Добавлена чисто отладочная процедура OutType.
+
+25 марта 2020 г.
+Доисаны процедуры Factor, Term и SimpleExpression, выполняющие
+теперь синтаксический анализ.
+
+18 февраля 2020 г.
+Синтаксический анализ выражений: Expression, SimpleExpression, Term,
+Factor (не закончено). Обработка присваивания вынесена за пределы
+Statements. Исправлена обработка строковых литералов.
+
+29 января 2020 г.
+Слегка изменена процедура Statements (добавлен цикл). Добавлены
+отсутствовавшие лексемы операций: деление, умножение, сравнение, а
+также строковой литерал. Есть проверка на максимальную длину строки.
+
+4 апреля 2019 г.
+Исправлена процедура WriteDummy, теперь она создаёт работающий
+исполнимый файл. Процедура WriteProgramHeader в качестве размера
+программного сегмента выводила 30 вместо 38, также было две опечатки.
+
+2 апреля 2019 г.
+Добавлена процедура Generator.WriteDummy - создаёт исполнимый файл Test
+с простейшей программой, выводящей на экран "Hi!". Хардкод.
+Файл не работает, но и не вылетает с ошибкой.
+Подключен модуль Chmod для того, чтобы отмечать файл как исполнимый.
+
+2 апреля 2019 г.
+Реализовано объявление переменных:
+Написана процедура Parser.Declarations.
+Добавлена процедура Parser.Type (пока хардкод).
+Написана процедура SymTable.NewObj и диагнозтическая процедура SymTable.Display.
+Исправлен синтаксический разбор модуля.
+
+26 марта 2019 г.
+Добавлены модули SymTable и Generator.
+Модуль символьной таблицы содержит типы Object и Type, а также экспортированные процедуры NewObj и Init.
+Модуль кодогенератора содержит только определение типа Item.
+В модуле синтаксического анализатора (Parser) написать псевдокод считывания объявления переменных в процедуре Declarations.
+
+12 марта 2019 г.
+Исправлена обработка пустого оператора (;).
+
+5 марта 2019 г.
+Компилятор разделён на три модуля: Compiler, Scanner, Parser.
+
+5 марта 2019 г.
+Показан пример считывания диапазона множества {11..15}, лексема upto, приём 7FX
+
+26 февраля 2019 г.
+Начат синтаксический анализатор.
+
+26 февраля 2019 г.
+Лексический анализатор (сканер) частично готов.
+Можно переходить к синтаксическому анализатору (парсеру).

+ 674 - 0
docs/oberon-master/LICENSE

@@ -0,0 +1,674 @@
+                    GNU GENERAL PUBLIC LICENSE
+                       Version 3, 29 June 2007
+
+ Copyright (C) 2007 Free Software Foundation, Inc. <https://fsf.org/>
+ Everyone is permitted to copy and distribute verbatim copies
+ of this license document, but changing it is not allowed.
+
+                            Preamble
+
+  The GNU General Public License is a free, copyleft license for
+software and other kinds of works.
+
+  The licenses for most software and other practical works are designed
+to take away your freedom to share and change the works.  By contrast,
+the GNU General Public License is intended to guarantee your freedom to
+share and change all versions of a program--to make sure it remains free
+software for all its users.  We, the Free Software Foundation, use the
+GNU General Public License for most of our software; it applies also to
+any other work released this way by its authors.  You can apply it to
+your programs, too.
+
+  When we speak of free software, we are referring to freedom, not
+price.  Our General Public Licenses are designed to make sure that you
+have the freedom to distribute copies of free software (and charge for
+them if you wish), that you receive source code or can get it if you
+want it, that you can change the software or use pieces of it in new
+free programs, and that you know you can do these things.
+
+  To protect your rights, we need to prevent others from denying you
+these rights or asking you to surrender the rights.  Therefore, you have
+certain responsibilities if you distribute copies of the software, or if
+you modify it: responsibilities to respect the freedom of others.
+
+  For example, if you distribute copies of such a program, whether
+gratis or for a fee, you must pass on to the recipients the same
+freedoms that you received.  You must make sure that they, too, receive
+or can get the source code.  And you must show them these terms so they
+know their rights.
+
+  Developers that use the GNU GPL protect your rights with two steps:
+(1) assert copyright on the software, and (2) offer you this License
+giving you legal permission to copy, distribute and/or modify it.
+
+  For the developers' and authors' protection, the GPL clearly explains
+that there is no warranty for this free software.  For both users' and
+authors' sake, the GPL requires that modified versions be marked as
+changed, so that their problems will not be attributed erroneously to
+authors of previous versions.
+
+  Some devices are designed to deny users access to install or run
+modified versions of the software inside them, although the manufacturer
+can do so.  This is fundamentally incompatible with the aim of
+protecting users' freedom to change the software.  The systematic
+pattern of such abuse occurs in the area of products for individuals to
+use, which is precisely where it is most unacceptable.  Therefore, we
+have designed this version of the GPL to prohibit the practice for those
+products.  If such problems arise substantially in other domains, we
+stand ready to extend this provision to those domains in future versions
+of the GPL, as needed to protect the freedom of users.
+
+  Finally, every program is threatened constantly by software patents.
+States should not allow patents to restrict development and use of
+software on general-purpose computers, but in those that do, we wish to
+avoid the special danger that patents applied to a free program could
+make it effectively proprietary.  To prevent this, the GPL assures that
+patents cannot be used to render the program non-free.
+
+  The precise terms and conditions for copying, distribution and
+modification follow.
+
+                       TERMS AND CONDITIONS
+
+  0. Definitions.
+
+  "This License" refers to version 3 of the GNU General Public License.
+
+  "Copyright" also means copyright-like laws that apply to other kinds of
+works, such as semiconductor masks.
+
+  "The Program" refers to any copyrightable work licensed under this
+License.  Each licensee is addressed as "you".  "Licensees" and
+"recipients" may be individuals or organizations.
+
+  To "modify" a work means to copy from or adapt all or part of the work
+in a fashion requiring copyright permission, other than the making of an
+exact copy.  The resulting work is called a "modified version" of the
+earlier work or a work "based on" the earlier work.
+
+  A "covered work" means either the unmodified Program or a work based
+on the Program.
+
+  To "propagate" a work means to do anything with it that, without
+permission, would make you directly or secondarily liable for
+infringement under applicable copyright law, except executing it on a
+computer or modifying a private copy.  Propagation includes copying,
+distribution (with or without modification), making available to the
+public, and in some countries other activities as well.
+
+  To "convey" a work means any kind of propagation that enables other
+parties to make or receive copies.  Mere interaction with a user through
+a computer network, with no transfer of a copy, is not conveying.
+
+  An interactive user interface displays "Appropriate Legal Notices"
+to the extent that it includes a convenient and prominently visible
+feature that (1) displays an appropriate copyright notice, and (2)
+tells the user that there is no warranty for the work (except to the
+extent that warranties are provided), that licensees may convey the
+work under this License, and how to view a copy of this License.  If
+the interface presents a list of user commands or options, such as a
+menu, a prominent item in the list meets this criterion.
+
+  1. Source Code.
+
+  The "source code" for a work means the preferred form of the work
+for making modifications to it.  "Object code" means any non-source
+form of a work.
+
+  A "Standard Interface" means an interface that either is an official
+standard defined by a recognized standards body, or, in the case of
+interfaces specified for a particular programming language, one that
+is widely used among developers working in that language.
+
+  The "System Libraries" of an executable work include anything, other
+than the work as a whole, that (a) is included in the normal form of
+packaging a Major Component, but which is not part of that Major
+Component, and (b) serves only to enable use of the work with that
+Major Component, or to implement a Standard Interface for which an
+implementation is available to the public in source code form.  A
+"Major Component", in this context, means a major essential component
+(kernel, window system, and so on) of the specific operating system
+(if any) on which the executable work runs, or a compiler used to
+produce the work, or an object code interpreter used to run it.
+
+  The "Corresponding Source" for a work in object code form means all
+the source code needed to generate, install, and (for an executable
+work) run the object code and to modify the work, including scripts to
+control those activities.  However, it does not include the work's
+System Libraries, or general-purpose tools or generally available free
+programs which are used unmodified in performing those activities but
+which are not part of the work.  For example, Corresponding Source
+includes interface definition files associated with source files for
+the work, and the source code for shared libraries and dynamically
+linked subprograms that the work is specifically designed to require,
+such as by intimate data communication or control flow between those
+subprograms and other parts of the work.
+
+  The Corresponding Source need not include anything that users
+can regenerate automatically from other parts of the Corresponding
+Source.
+
+  The Corresponding Source for a work in source code form is that
+same work.
+
+  2. Basic Permissions.
+
+  All rights granted under this License are granted for the term of
+copyright on the Program, and are irrevocable provided the stated
+conditions are met.  This License explicitly affirms your unlimited
+permission to run the unmodified Program.  The output from running a
+covered work is covered by this License only if the output, given its
+content, constitutes a covered work.  This License acknowledges your
+rights of fair use or other equivalent, as provided by copyright law.
+
+  You may make, run and propagate covered works that you do not
+convey, without conditions so long as your license otherwise remains
+in force.  You may convey covered works to others for the sole purpose
+of having them make modifications exclusively for you, or provide you
+with facilities for running those works, provided that you comply with
+the terms of this License in conveying all material for which you do
+not control copyright.  Those thus making or running the covered works
+for you must do so exclusively on your behalf, under your direction
+and control, on terms that prohibit them from making any copies of
+your copyrighted material outside their relationship with you.
+
+  Conveying under any other circumstances is permitted solely under
+the conditions stated below.  Sublicensing is not allowed; section 10
+makes it unnecessary.
+
+  3. Protecting Users' Legal Rights From Anti-Circumvention Law.
+
+  No covered work shall be deemed part of an effective technological
+measure under any applicable law fulfilling obligations under article
+11 of the WIPO copyright treaty adopted on 20 December 1996, or
+similar laws prohibiting or restricting circumvention of such
+measures.
+
+  When you convey a covered work, you waive any legal power to forbid
+circumvention of technological measures to the extent such circumvention
+is effected by exercising rights under this License with respect to
+the covered work, and you disclaim any intention to limit operation or
+modification of the work as a means of enforcing, against the work's
+users, your or third parties' legal rights to forbid circumvention of
+technological measures.
+
+  4. Conveying Verbatim Copies.
+
+  You may convey verbatim copies of the Program's source code as you
+receive it, in any medium, provided that you conspicuously and
+appropriately publish on each copy an appropriate copyright notice;
+keep intact all notices stating that this License and any
+non-permissive terms added in accord with section 7 apply to the code;
+keep intact all notices of the absence of any warranty; and give all
+recipients a copy of this License along with the Program.
+
+  You may charge any price or no price for each copy that you convey,
+and you may offer support or warranty protection for a fee.
+
+  5. Conveying Modified Source Versions.
+
+  You may convey a work based on the Program, or the modifications to
+produce it from the Program, in the form of source code under the
+terms of section 4, provided that you also meet all of these conditions:
+
+    a) The work must carry prominent notices stating that you modified
+    it, and giving a relevant date.
+
+    b) The work must carry prominent notices stating that it is
+    released under this License and any conditions added under section
+    7.  This requirement modifies the requirement in section 4 to
+    "keep intact all notices".
+
+    c) You must license the entire work, as a whole, under this
+    License to anyone who comes into possession of a copy.  This
+    License will therefore apply, along with any applicable section 7
+    additional terms, to the whole of the work, and all its parts,
+    regardless of how they are packaged.  This License gives no
+    permission to license the work in any other way, but it does not
+    invalidate such permission if you have separately received it.
+
+    d) If the work has interactive user interfaces, each must display
+    Appropriate Legal Notices; however, if the Program has interactive
+    interfaces that do not display Appropriate Legal Notices, your
+    work need not make them do so.
+
+  A compilation of a covered work with other separate and independent
+works, which are not by their nature extensions of the covered work,
+and which are not combined with it such as to form a larger program,
+in or on a volume of a storage or distribution medium, is called an
+"aggregate" if the compilation and its resulting copyright are not
+used to limit the access or legal rights of the compilation's users
+beyond what the individual works permit.  Inclusion of a covered work
+in an aggregate does not cause this License to apply to the other
+parts of the aggregate.
+
+  6. Conveying Non-Source Forms.
+
+  You may convey a covered work in object code form under the terms
+of sections 4 and 5, provided that you also convey the
+machine-readable Corresponding Source under the terms of this License,
+in one of these ways:
+
+    a) Convey the object code in, or embodied in, a physical product
+    (including a physical distribution medium), accompanied by the
+    Corresponding Source fixed on a durable physical medium
+    customarily used for software interchange.
+
+    b) Convey the object code in, or embodied in, a physical product
+    (including a physical distribution medium), accompanied by a
+    written offer, valid for at least three years and valid for as
+    long as you offer spare parts or customer support for that product
+    model, to give anyone who possesses the object code either (1) a
+    copy of the Corresponding Source for all the software in the
+    product that is covered by this License, on a durable physical
+    medium customarily used for software interchange, for a price no
+    more than your reasonable cost of physically performing this
+    conveying of source, or (2) access to copy the
+    Corresponding Source from a network server at no charge.
+
+    c) Convey individual copies of the object code with a copy of the
+    written offer to provide the Corresponding Source.  This
+    alternative is allowed only occasionally and noncommercially, and
+    only if you received the object code with such an offer, in accord
+    with subsection 6b.
+
+    d) Convey the object code by offering access from a designated
+    place (gratis or for a charge), and offer equivalent access to the
+    Corresponding Source in the same way through the same place at no
+    further charge.  You need not require recipients to copy the
+    Corresponding Source along with the object code.  If the place to
+    copy the object code is a network server, the Corresponding Source
+    may be on a different server (operated by you or a third party)
+    that supports equivalent copying facilities, provided you maintain
+    clear directions next to the object code saying where to find the
+    Corresponding Source.  Regardless of what server hosts the
+    Corresponding Source, you remain obligated to ensure that it is
+    available for as long as needed to satisfy these requirements.
+
+    e) Convey the object code using peer-to-peer transmission, provided
+    you inform other peers where the object code and Corresponding
+    Source of the work are being offered to the general public at no
+    charge under subsection 6d.
+
+  A separable portion of the object code, whose source code is excluded
+from the Corresponding Source as a System Library, need not be
+included in conveying the object code work.
+
+  A "User Product" is either (1) a "consumer product", which means any
+tangible personal property which is normally used for personal, family,
+or household purposes, or (2) anything designed or sold for incorporation
+into a dwelling.  In determining whether a product is a consumer product,
+doubtful cases shall be resolved in favor of coverage.  For a particular
+product received by a particular user, "normally used" refers to a
+typical or common use of that class of product, regardless of the status
+of the particular user or of the way in which the particular user
+actually uses, or expects or is expected to use, the product.  A product
+is a consumer product regardless of whether the product has substantial
+commercial, industrial or non-consumer uses, unless such uses represent
+the only significant mode of use of the product.
+
+  "Installation Information" for a User Product means any methods,
+procedures, authorization keys, or other information required to install
+and execute modified versions of a covered work in that User Product from
+a modified version of its Corresponding Source.  The information must
+suffice to ensure that the continued functioning of the modified object
+code is in no case prevented or interfered with solely because
+modification has been made.
+
+  If you convey an object code work under this section in, or with, or
+specifically for use in, a User Product, and the conveying occurs as
+part of a transaction in which the right of possession and use of the
+User Product is transferred to the recipient in perpetuity or for a
+fixed term (regardless of how the transaction is characterized), the
+Corresponding Source conveyed under this section must be accompanied
+by the Installation Information.  But this requirement does not apply
+if neither you nor any third party retains the ability to install
+modified object code on the User Product (for example, the work has
+been installed in ROM).
+
+  The requirement to provide Installation Information does not include a
+requirement to continue to provide support service, warranty, or updates
+for a work that has been modified or installed by the recipient, or for
+the User Product in which it has been modified or installed.  Access to a
+network may be denied when the modification itself materially and
+adversely affects the operation of the network or violates the rules and
+protocols for communication across the network.
+
+  Corresponding Source conveyed, and Installation Information provided,
+in accord with this section must be in a format that is publicly
+documented (and with an implementation available to the public in
+source code form), and must require no special password or key for
+unpacking, reading or copying.
+
+  7. Additional Terms.
+
+  "Additional permissions" are terms that supplement the terms of this
+License by making exceptions from one or more of its conditions.
+Additional permissions that are applicable to the entire Program shall
+be treated as though they were included in this License, to the extent
+that they are valid under applicable law.  If additional permissions
+apply only to part of the Program, that part may be used separately
+under those permissions, but the entire Program remains governed by
+this License without regard to the additional permissions.
+
+  When you convey a copy of a covered work, you may at your option
+remove any additional permissions from that copy, or from any part of
+it.  (Additional permissions may be written to require their own
+removal in certain cases when you modify the work.)  You may place
+additional permissions on material, added by you to a covered work,
+for which you have or can give appropriate copyright permission.
+
+  Notwithstanding any other provision of this License, for material you
+add to a covered work, you may (if authorized by the copyright holders of
+that material) supplement the terms of this License with terms:
+
+    a) Disclaiming warranty or limiting liability differently from the
+    terms of sections 15 and 16 of this License; or
+
+    b) Requiring preservation of specified reasonable legal notices or
+    author attributions in that material or in the Appropriate Legal
+    Notices displayed by works containing it; or
+
+    c) Prohibiting misrepresentation of the origin of that material, or
+    requiring that modified versions of such material be marked in
+    reasonable ways as different from the original version; or
+
+    d) Limiting the use for publicity purposes of names of licensors or
+    authors of the material; or
+
+    e) Declining to grant rights under trademark law for use of some
+    trade names, trademarks, or service marks; or
+
+    f) Requiring indemnification of licensors and authors of that
+    material by anyone who conveys the material (or modified versions of
+    it) with contractual assumptions of liability to the recipient, for
+    any liability that these contractual assumptions directly impose on
+    those licensors and authors.
+
+  All other non-permissive additional terms are considered "further
+restrictions" within the meaning of section 10.  If the Program as you
+received it, or any part of it, contains a notice stating that it is
+governed by this License along with a term that is a further
+restriction, you may remove that term.  If a license document contains
+a further restriction but permits relicensing or conveying under this
+License, you may add to a covered work material governed by the terms
+of that license document, provided that the further restriction does
+not survive such relicensing or conveying.
+
+  If you add terms to a covered work in accord with this section, you
+must place, in the relevant source files, a statement of the
+additional terms that apply to those files, or a notice indicating
+where to find the applicable terms.
+
+  Additional terms, permissive or non-permissive, may be stated in the
+form of a separately written license, or stated as exceptions;
+the above requirements apply either way.
+
+  8. Termination.
+
+  You may not propagate or modify a covered work except as expressly
+provided under this License.  Any attempt otherwise to propagate or
+modify it is void, and will automatically terminate your rights under
+this License (including any patent licenses granted under the third
+paragraph of section 11).
+
+  However, if you cease all violation of this License, then your
+license from a particular copyright holder is reinstated (a)
+provisionally, unless and until the copyright holder explicitly and
+finally terminates your license, and (b) permanently, if the copyright
+holder fails to notify you of the violation by some reasonable means
+prior to 60 days after the cessation.
+
+  Moreover, your license from a particular copyright holder is
+reinstated permanently if the copyright holder notifies you of the
+violation by some reasonable means, this is the first time you have
+received notice of violation of this License (for any work) from that
+copyright holder, and you cure the violation prior to 30 days after
+your receipt of the notice.
+
+  Termination of your rights under this section does not terminate the
+licenses of parties who have received copies or rights from you under
+this License.  If your rights have been terminated and not permanently
+reinstated, you do not qualify to receive new licenses for the same
+material under section 10.
+
+  9. Acceptance Not Required for Having Copies.
+
+  You are not required to accept this License in order to receive or
+run a copy of the Program.  Ancillary propagation of a covered work
+occurring solely as a consequence of using peer-to-peer transmission
+to receive a copy likewise does not require acceptance.  However,
+nothing other than this License grants you permission to propagate or
+modify any covered work.  These actions infringe copyright if you do
+not accept this License.  Therefore, by modifying or propagating a
+covered work, you indicate your acceptance of this License to do so.
+
+  10. Automatic Licensing of Downstream Recipients.
+
+  Each time you convey a covered work, the recipient automatically
+receives a license from the original licensors, to run, modify and
+propagate that work, subject to this License.  You are not responsible
+for enforcing compliance by third parties with this License.
+
+  An "entity transaction" is a transaction transferring control of an
+organization, or substantially all assets of one, or subdividing an
+organization, or merging organizations.  If propagation of a covered
+work results from an entity transaction, each party to that
+transaction who receives a copy of the work also receives whatever
+licenses to the work the party's predecessor in interest had or could
+give under the previous paragraph, plus a right to possession of the
+Corresponding Source of the work from the predecessor in interest, if
+the predecessor has it or can get it with reasonable efforts.
+
+  You may not impose any further restrictions on the exercise of the
+rights granted or affirmed under this License.  For example, you may
+not impose a license fee, royalty, or other charge for exercise of
+rights granted under this License, and you may not initiate litigation
+(including a cross-claim or counterclaim in a lawsuit) alleging that
+any patent claim is infringed by making, using, selling, offering for
+sale, or importing the Program or any portion of it.
+
+  11. Patents.
+
+  A "contributor" is a copyright holder who authorizes use under this
+License of the Program or a work on which the Program is based.  The
+work thus licensed is called the contributor's "contributor version".
+
+  A contributor's "essential patent claims" are all patent claims
+owned or controlled by the contributor, whether already acquired or
+hereafter acquired, that would be infringed by some manner, permitted
+by this License, of making, using, or selling its contributor version,
+but do not include claims that would be infringed only as a
+consequence of further modification of the contributor version.  For
+purposes of this definition, "control" includes the right to grant
+patent sublicenses in a manner consistent with the requirements of
+this License.
+
+  Each contributor grants you a non-exclusive, worldwide, royalty-free
+patent license under the contributor's essential patent claims, to
+make, use, sell, offer for sale, import and otherwise run, modify and
+propagate the contents of its contributor version.
+
+  In the following three paragraphs, a "patent license" is any express
+agreement or commitment, however denominated, not to enforce a patent
+(such as an express permission to practice a patent or covenant not to
+sue for patent infringement).  To "grant" such a patent license to a
+party means to make such an agreement or commitment not to enforce a
+patent against the party.
+
+  If you convey a covered work, knowingly relying on a patent license,
+and the Corresponding Source of the work is not available for anyone
+to copy, free of charge and under the terms of this License, through a
+publicly available network server or other readily accessible means,
+then you must either (1) cause the Corresponding Source to be so
+available, or (2) arrange to deprive yourself of the benefit of the
+patent license for this particular work, or (3) arrange, in a manner
+consistent with the requirements of this License, to extend the patent
+license to downstream recipients.  "Knowingly relying" means you have
+actual knowledge that, but for the patent license, your conveying the
+covered work in a country, or your recipient's use of the covered work
+in a country, would infringe one or more identifiable patents in that
+country that you have reason to believe are valid.
+
+  If, pursuant to or in connection with a single transaction or
+arrangement, you convey, or propagate by procuring conveyance of, a
+covered work, and grant a patent license to some of the parties
+receiving the covered work authorizing them to use, propagate, modify
+or convey a specific copy of the covered work, then the patent license
+you grant is automatically extended to all recipients of the covered
+work and works based on it.
+
+  A patent license is "discriminatory" if it does not include within
+the scope of its coverage, prohibits the exercise of, or is
+conditioned on the non-exercise of one or more of the rights that are
+specifically granted under this License.  You may not convey a covered
+work if you are a party to an arrangement with a third party that is
+in the business of distributing software, under which you make payment
+to the third party based on the extent of your activity of conveying
+the work, and under which the third party grants, to any of the
+parties who would receive the covered work from you, a discriminatory
+patent license (a) in connection with copies of the covered work
+conveyed by you (or copies made from those copies), or (b) primarily
+for and in connection with specific products or compilations that
+contain the covered work, unless you entered into that arrangement,
+or that patent license was granted, prior to 28 March 2007.
+
+  Nothing in this License shall be construed as excluding or limiting
+any implied license or other defenses to infringement that may
+otherwise be available to you under applicable patent law.
+
+  12. No Surrender of Others' Freedom.
+
+  If conditions are imposed on you (whether by court order, agreement or
+otherwise) that contradict the conditions of this License, they do not
+excuse you from the conditions of this License.  If you cannot convey a
+covered work so as to satisfy simultaneously your obligations under this
+License and any other pertinent obligations, then as a consequence you may
+not convey it at all.  For example, if you agree to terms that obligate you
+to collect a royalty for further conveying from those to whom you convey
+the Program, the only way you could satisfy both those terms and this
+License would be to refrain entirely from conveying the Program.
+
+  13. Use with the GNU Affero General Public License.
+
+  Notwithstanding any other provision of this License, you have
+permission to link or combine any covered work with a work licensed
+under version 3 of the GNU Affero General Public License into a single
+combined work, and to convey the resulting work.  The terms of this
+License will continue to apply to the part which is the covered work,
+but the special requirements of the GNU Affero General Public License,
+section 13, concerning interaction through a network will apply to the
+combination as such.
+
+  14. Revised Versions of this License.
+
+  The Free Software Foundation may publish revised and/or new versions of
+the GNU General Public License from time to time.  Such new versions will
+be similar in spirit to the present version, but may differ in detail to
+address new problems or concerns.
+
+  Each version is given a distinguishing version number.  If the
+Program specifies that a certain numbered version of the GNU General
+Public License "or any later version" applies to it, you have the
+option of following the terms and conditions either of that numbered
+version or of any later version published by the Free Software
+Foundation.  If the Program does not specify a version number of the
+GNU General Public License, you may choose any version ever published
+by the Free Software Foundation.
+
+  If the Program specifies that a proxy can decide which future
+versions of the GNU General Public License can be used, that proxy's
+public statement of acceptance of a version permanently authorizes you
+to choose that version for the Program.
+
+  Later license versions may give you additional or different
+permissions.  However, no additional obligations are imposed on any
+author or copyright holder as a result of your choosing to follow a
+later version.
+
+  15. Disclaimer of Warranty.
+
+  THERE IS NO WARRANTY FOR THE PROGRAM, TO THE EXTENT PERMITTED BY
+APPLICABLE LAW.  EXCEPT WHEN OTHERWISE STATED IN WRITING THE COPYRIGHT
+HOLDERS AND/OR OTHER PARTIES PROVIDE THE PROGRAM "AS IS" WITHOUT WARRANTY
+OF ANY KIND, EITHER EXPRESSED OR IMPLIED, INCLUDING, BUT NOT LIMITED TO,
+THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
+PURPOSE.  THE ENTIRE RISK AS TO THE QUALITY AND PERFORMANCE OF THE PROGRAM
+IS WITH YOU.  SHOULD THE PROGRAM PROVE DEFECTIVE, YOU ASSUME THE COST OF
+ALL NECESSARY SERVICING, REPAIR OR CORRECTION.
+
+  16. Limitation of Liability.
+
+  IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING
+WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MODIFIES AND/OR CONVEYS
+THE PROGRAM AS PERMITTED ABOVE, BE LIABLE TO YOU FOR DAMAGES, INCLUDING ANY
+GENERAL, SPECIAL, INCIDENTAL OR CONSEQUENTIAL DAMAGES ARISING OUT OF THE
+USE OR INABILITY TO USE THE PROGRAM (INCLUDING BUT NOT LIMITED TO LOSS OF
+DATA OR DATA BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY YOU OR THIRD
+PARTIES OR A FAILURE OF THE PROGRAM TO OPERATE WITH ANY OTHER PROGRAMS),
+EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE POSSIBILITY OF
+SUCH DAMAGES.
+
+  17. Interpretation of Sections 15 and 16.
+
+  If the disclaimer of warranty and limitation of liability provided
+above cannot be given local legal effect according to their terms,
+reviewing courts shall apply local law that most closely approximates
+an absolute waiver of all civil liability in connection with the
+Program, unless a warranty or assumption of liability accompanies a
+copy of the Program in return for a fee.
+
+                     END OF TERMS AND CONDITIONS
+
+            How to Apply These Terms to Your New Programs
+
+  If you develop a new program, and you want it to be of the greatest
+possible use to the public, the best way to achieve this is to make it
+free software which everyone can redistribute and change under these terms.
+
+  To do so, attach the following notices to the program.  It is safest
+to attach them to the start of each source file to most effectively
+state the exclusion of warranty; and each file should have at least
+the "copyright" line and a pointer to where the full notice is found.
+
+    <one line to give the program's name and a brief idea of what it does.>
+    Copyright (C) <year>  <name of author>
+
+    This program is free software: you can redistribute it and/or modify
+    it under the terms of the GNU General Public License as published by
+    the Free Software Foundation, either version 3 of the License, or
+    (at your option) any later version.
+
+    This program is distributed in the hope that it will be useful,
+    but WITHOUT ANY WARRANTY; without even the implied warranty of
+    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+    GNU General Public License for more details.
+
+    You should have received a copy of the GNU General Public License
+    along with this program.  If not, see <https://www.gnu.org/licenses/>.
+
+Also add information on how to contact you by electronic and paper mail.
+
+  If the program does terminal interaction, make it output a short
+notice like this when it starts in an interactive mode:
+
+    <program>  Copyright (C) <year>  <name of author>
+    This program comes with ABSOLUTELY NO WARRANTY; for details type `show w'.
+    This is free software, and you are welcome to redistribute it
+    under certain conditions; type `show c' for details.
+
+The hypothetical commands `show w' and `show c' should show the appropriate
+parts of the General Public License.  Of course, your program's commands
+might be different; for a GUI interface, you would use an "about box".
+
+  You should also get your employer (if you work as a programmer) or school,
+if any, to sign a "copyright disclaimer" for the program, if necessary.
+For more information on this, and how to apply and follow the GNU GPL, see
+<https://www.gnu.org/licenses/>.
+
+  The GNU General Public License does not permit incorporating your program
+into proprietary programs.  If your program is a subroutine library, you
+may consider it more useful to permit linking proprietary applications with
+the library.  If this is what you want to do, use the GNU Lesser General
+Public License instead of this License.  But first, please read
+<https://www.gnu.org/licenses/why-not-lgpl.html>.

+ 48 - 0
docs/oberon-master/Makefile

@@ -0,0 +1,48 @@
+PROG=Compiler
+
+VOC=/opt/voc/bin/voc
+CC=gcc
+VOCPATH=/opt/voc
+VOCLIBS=$(VOCPATH)/lib/libvoc-OC.a
+COMPILE=$(VOC) -OC -cesF
+
+all: $(PROG)
+
+$(PROG): $(PROG).sym
+	$(CC) -fPIC -g -I $(VOCPATH)/C/include \
+		-o $(PROG) Parser.o Scanner.o \
+		SymTable.o Generator.o \
+		Chmod.o \
+		c_chmod.o \
+		$(PROG).o \
+    $(VOCLIBS)
+
+$(PROG).sym: Mod/$(PROG).Mod Parser.sym
+	$(COMPILE) -m Mod/$(PROG).Mod
+
+Parser.sym: Mod/Parser.Mod Scanner.sym SymTable.sym Generator.sym
+	$(COMPILE) Mod/Parser.Mod
+
+Scanner.sym: Mod/Scanner.Mod
+	$(COMPILE) Mod/Scanner.Mod
+
+Generator.sym: Mod/Generator.Mod SymTable.sym Chmod.sym
+	$(COMPILE) Mod/Generator.Mod
+
+SymTable.sym: Mod/SymTable.Mod
+	$(COMPILE) Mod/SymTable.Mod
+
+Chmod.sym: Mod/Chmod.Mod c_chmod.o
+	$(VOC) -OC -fF Mod/Chmod.Mod
+
+c_chmod.o: Mod/c_chmod/c_chmod.c Mod/c_chmod/c_chmod.h
+	$(CC) -c Mod/c_chmod/c_chmod.c -o c_chmod.o
+	cp Mod/c_chmod/c_chmod.h .
+
+.PHONY: run clean
+
+run: $(PROG)
+	@clear; nl Test.Mod; ./$(PROG)
+
+clean:
+	@rm -f *.c *.h *.o *.sym .tmp..* Test $(PROG)

+ 10 - 0
docs/oberon-master/Mod/Chmod.Mod

@@ -0,0 +1,10 @@
+MODULE Chmod;
+IMPORT SYSTEM;
+
+PROCEDURE -AAIncludeChmodh* '#include "c_chmod.h"';
+
+PROCEDURE -MakeExecutable*
+  (path: ARRAY OF CHAR): INTEGER
+  "MakeExecutable(path)";
+
+END Chmod.

+ 22 - 0
docs/oberon-master/Mod/Compiler.Mod

@@ -0,0 +1,22 @@
+(* Главный файл компилятора.
+Открывает файл с исходным кодом, подлежащим компиляции,
+передаёт его лексическому (Scanner) и синтаксическому анализатору (Parser).
+Запускает главную процедуру синтаксического анализатора. *)
+
+MODULE Compiler;
+IMPORT Out, Files, S := Scanner, P := Parser, ST := SymTable;
+CONST filename = "Test.Mod";
+VAR F: Files.File;
+BEGIN
+  F := Files.Old(filename); (* В будущем название будет браться из консоли *)
+  IF F = NIL THEN
+    Out.String("Файл '"); Out.String(filename); Out.String("' не найден.")
+  ELSE
+    S.Init(F);
+    IF P.Compile() THEN Out.String("Компиляция прошла успешно.")
+    ELSE Out.String("В ходе компиляции возникли ошибки.")
+    END;
+    Files.Close(F)
+  END;
+  Out.Ln
+END Compiler.

+ 144 - 0
docs/oberon-master/Mod/Generator.Mod

@@ -0,0 +1,144 @@
+MODULE Generator;
+IMPORT ST := SymTable, Out, Files, Chmod;
+CONST fname = "Test";
+TYPE
+  Item* = RECORD
+    mode*: INTEGER; (*Режим предмета, используются константы из SymTable*)
+    type*: ST.Type;
+    val*: INTEGER
+  END;
+VAR
+  F: Files.File;
+  r: Files.Rider;
+
+PROCEDURE Byte(n: INTEGER);
+BEGIN
+  Files.Write(r, CHR(n))
+END Byte;
+
+PROCEDURE Word(n: INTEGER);
+BEGIN
+  Files.Write(r, CHR(n MOD 100H));
+  Files.Write(r, CHR(n DIV 100H))
+END Word;
+
+PROCEDURE DWord(n: INTEGER);
+BEGIN
+  Files.Write(r, CHR(n MOD 100H));
+  Files.Write(r, CHR(n DIV 100H MOD 100H));
+  Files.Write(r, CHR(n DIV 10000H MOD 100H));
+  Files.Write(r, CHR(n DIV 1000000H))
+END DWord;
+
+(* Выводит в файл первые 16 байтов заголовка ELF-файла *)
+PROCEDURE WriteElfIdent;
+BEGIN
+  Byte(7FH); (* Магическое значение - ASCII DEL *)
+  Byte(ORD("E")); (* Магические значения - слово "ELF" *)
+  Byte(ORD("L"));
+  Byte(ORD("F"));
+  Byte(1); (* Класс ELF-файла: 32-разрядный (бывает ещё 64) *)
+  Byte(1); (* Способ кодирования данных: порядок от младшего к старшему (LSB) *)
+  Byte(1); (* Версия ELF-файла: бывает только 1 *)
+  Byte(0); DWord(0); DWord(0) (* Набивка: просто 9 нулевых байтов *)
+END WriteElfIdent;
+
+(* Выводит в файл заголовок ELF-файла *)
+PROCEDURE WriteElfHeader;
+BEGIN
+  WriteElfIdent; (* Выводит первые 16 байтов *)
+  Word(2); (* Тип файла: исполнимый файл (бывает ещё .o и .so) *)
+  Word(3); (* Архитектура процессора: Intel 386 *)
+  DWord(1); (* Версия ELF-файла (ещё раз) *)
+  DWord(08040054H); (* Вход в программу. Виртуальный адрес начала исполнения *)
+  DWord(52); (* Смещение на начало таблицы программных заголовков *)
+  DWord(0); (* Смещение на начало таблицы секций (в исполнимом - не нужны) *)
+  DWord(0); (* Флаги процессора (для Intel 386 отсутствуют) *)
+  Word(52); (* Размер заголовка ELF-файла в байтах *)
+  Word(32); (* Размер одного программного заголовка *)
+  Word(1); (* Количество программных заголовков *)
+  Word(0); (* Размер заголовка секции (в исполнимом файле они не нужны) *)
+  Word(0); (* Количество заголовков секций *)
+  Word(0) (* Номер секции с таблицей строк (в исполнимом файле не нужны) *)
+END WriteElfHeader;
+
+PROCEDURE WriteProgramHeader;
+BEGIN
+  DWord(1); (* Вид данного сегмента - сегмент для загрузки *)
+  DWord(54H); (* Смещение на начало данного сегмента = 84 *)
+  DWord(08040054H); (* Виртуальный адрес первого байта в сегменте *)
+  DWord(08040054H); (* Физический адрес - не используется !FIXME Проверить, нужен ли здесь 0 *)
+  DWord(38); (* Сколько сегмент занимает в файле *)
+  DWord(38); (* Сколько сегмент занимает в файле *)
+  DWord(5); (* Флаги сегмента: 4 + 1 = чтение + исполнение *)
+  DWord(1000H) (* Выравнивание для виртуального адреса и смещения в файле *)
+END WriteProgramHeader;
+
+PROCEDURE WriteTextSegment;
+BEGIN
+  Byte(0B9H); (* MOV ECX, DWORD ... *)
+  DWord(08040054H + 34); (* Откуда брать строку *)
+
+  Byte(0BAH); (* MOV EDX, DWORD ... *)
+  DWord(04H); (* Длина строки *)
+
+  Byte(0BBH); (* MOV EBX, DWORD ... *)
+  DWord(01H); (* Куда писать: стандартное устройство вывода STDOUT *)
+
+  Byte(0B8H); (* MOV EAX, DWORD ... *)
+  DWord(04H); (* Системный вызов: write *)
+
+  Byte(0CDH); (* Прерывание: INT *)
+  Byte(080H); (* Номер прерывания *)
+
+  Byte(0BBH); (* MOV EBX, DWORD ... *)
+  DWord(01H); (* Код возврата (exit code) *)
+
+  Byte(0B8H); (* MOV EAX, DWORD ... *)
+  DWord(01H); (* Системный вызов: exit *)
+
+  Byte(0CDH); (* Прерывание: INT *)
+  Byte(080H); (* Номер прерывания *)
+
+  Byte(ORD("H")); (* Строка *)
+  Byte(ORD("i"));
+  Byte(ORD("!"));
+  Byte(0AH)
+END WriteTextSegment;
+
+PROCEDURE WriteElf;
+BEGIN
+  WriteElfHeader;
+  WriteProgramHeader;
+  WriteTextSegment
+END WriteElf;
+
+PROCEDURE WriteDummy*;
+BEGIN
+  F := Files.New(fname);
+  IF F # NIL THEN
+    Files.Set(r, F, 0);
+    WriteElf;
+    Files.Register(F);
+    Files.Close(F);
+    IF Chmod.MakeExecutable(fname) = 0 THEN END
+  ELSE
+    Out.String("Не могу создать файл ");
+    Out.String(fname); Out.Ln
+  END
+END WriteDummy;
+
+PROCEDURE MakeItem*(VAR x: Item; o: ST.Object);
+BEGIN
+  x.mode := o.class;
+  x.type := o.type;
+  x.val := o.val
+END MakeItem;
+
+PROCEDURE Call*(VAR x: Item);
+BEGIN
+  Out.String("Вызвана процедура ");
+  Out.Int(x.val, 0); Out.Ln
+END Call;
+
+END Generator.

+ 10 - 0
docs/oberon-master/Mod/Makefile

@@ -0,0 +1,10 @@
+all:
+	@$(MAKE) -C ..
+
+.PHONY: run clean
+
+run: $(PROG)
+	@$(MAKE) -C .. run
+
+clean:
+	@$(MAKE) -C .. clean

+ 460 - 0
docs/oberon-master/Mod/Parser.Mod

@@ -0,0 +1,460 @@
+MODULE Parser;
+IMPORT Out, Files, S := Scanner, ST := SymTable, Gen := Generator;
+VAR sym: INTEGER;
+  dc: INTEGER; (*Счётчик данных (data counter)*)
+  dummy: ST.Object; (*Болванка, см. QualIdent*)
+
+PROCEDURE ^Expression(VAR x: Gen.Item);
+
+(*импорт = идент [":=" идент].*)
+PROCEDURE Import;
+VAR ident1, ident2: ARRAY 32 OF CHAR;
+BEGIN
+  IF sym = S.ident THEN
+    ident1 := S.id;
+    S.Get(sym);
+    IF sym = S.becomes THEN
+      S.Get(sym);
+      IF sym = S.ident THEN
+        ident2 := S.id;
+        S.Get(sym)
+      ELSE
+        S.Mark("Ожидается идентификатор")
+      END
+    ELSE
+      ident2 := ident1
+    END;
+    ST.Import(ident1, ident2)
+  ELSE
+    S.Mark("Ожидается идентификатор")
+  END
+END Import;
+
+(*СписокИмпорта = IMPORT импорт {"," импорт} ";".*)
+PROCEDURE ImportList;
+BEGIN
+  IF sym = S.import THEN
+    S.Get(sym);
+    Import;
+    WHILE sym = S.comma DO
+      S.Get(sym);
+      Import
+    END;
+    IF sym = S.semicolon THEN
+      S.Get(sym)
+    ELSE
+      S.Mark("Ожидается точка с запятой")
+    END
+  END
+END ImportList;
+
+PROCEDURE Type(VAR tp: ST.Type);
+VAR o: ST.Object;
+BEGIN
+  tp := ST.intType; (*Тип по умолчанию, используется в случае ошибки*)
+
+  IF sym = S.ident THEN
+    o := ST.ThisObj();
+    S.Get(sym);
+    IF o = NIL THEN
+      S.Mark("Нет такого типа")
+    ELSIF o.class # ST.Typ THEN
+      S.Mark("Это не тип")
+    ELSE
+      tp := o.type
+    END
+  ELSE (*!TODO учесть ARRAY, RECORD и др.*)
+    S.Mark("Ожидается тип")
+  END
+END Type;
+
+(*Объявления = [CONST {ОбъявлениеКонстант ";"}]
+    [TYPE {ОбъявлениеТипов ";"}]
+    [VAR {ОбъявлениеПеременных ";"}]
+    {ОбъявлениеПроцедуры ";"}.
+ОбъявлениеПеременных = Идентификаторы ":" Тип.
+Идентификаторы = Идентификатор {"," Идентификатор}.
+Тип = уточнИдент | ТипМассив | ТипЗапись | ТипУказатель | ПроцедурныйТип.
+Но в начале будет только VAR, поэтому используется упрощённый вариант:
+Объявления = [VAR {ОбъявлениеПеременных ";"}].
+ОбъявлениеПеременных = Идентификаторы ":" Тип.
+Идентификаторы = Идентификатор {"," Идентификатор}.
+Тип = Идентификатор.*)
+PROCEDURE Declarations(VAR varsize: INTEGER);
+VAR tp: ST.Type;
+    i, n: INTEGER;
+    o: ST.Object;
+    names: ARRAY 30, 32 OF CHAR;
+BEGIN
+  IF sym = S.var THEN (*1. Если считано слово VAR, то:*)
+    S.Get(sym); (*Переходим к названию первой переменной*)
+    WHILE sym = S.ident DO
+      names[0] := S.id;
+      S.Get(sym); (*Переходим к запятой или к двоеточию*)
+      n := 1;
+      WHILE sym = S.comma DO
+        S.Get(sym); (*Переходим к названию следующей перменной*)
+        IF sym = S.ident THEN
+          IF n < LEN(names) THEN
+            names[n] := S.id;
+            INC(n)
+          ELSE
+            S.Mark("Слишком много переменных")
+          END
+        ELSE
+          S.Mark("Ожидается идентификатор")
+        END;
+        S.Get(sym) (*Переходим к запятой или к двоеточию*)
+      END;
+      IF sym = S.colon THEN
+        S.Get(sym);
+        Type(tp);
+        FOR i := 0 TO n - 1 DO
+          o := ST.NewObj(names[i], ST.Var);
+          o.type := tp;
+          o.val := varsize;
+          INC(varsize, 4);(*!TODO учитывать размер типа и выравнивание*)
+          Out.String("Объявлена переменная "); Out.String(names[i]);
+          Out.String(" типа "); ST.OutType(o.type);
+          Out.String(" (адрес "); Out.Int(o.val, 0); Out.String(").");
+          Out.Ln
+        END;
+        IF sym = S.semicolon THEN
+          S.Get(sym)
+        ELSE
+          S.Mark("Ожидается точка с запятой")
+        END
+      ELSE
+        S.Mark("Ожидается двоеточие")
+      END
+    END
+  END
+END Declarations;
+
+(*УПРОЩЕНО: множитель = число | литера | идент | "(" выражение ")".*)
+PROCEDURE Factor(VAR x: Gen.Item);
+VAR o: ST.Object;
+BEGIN
+  IF sym = S.int THEN
+    x.mode := ST.Const;
+    x.type := ST.intType;
+    x.val := S.ival;
+    Out.String("Прочитано число ");
+    Out.Int(S.ival, 0); Out.Ln;
+    S.Get(sym)
+  ELSIF sym = S.char THEN
+    x.mode := ST.Const;
+    x.type := ST.charType;
+    x.val := S.ival;
+    Out.String("Прочитана литера ");
+    Out.Char(CHR(S.ival)); Out.Ln;
+    S.Get(sym)
+  ELSIF sym = S.string THEN
+    x.mode := ST.Const;
+    x.type := ST.charType;
+    x.val := ORD(S.sval[0]);
+    IF S.slen = 1 THEN
+      Out.String("Прочитана литера ");
+      Out.Char(S.sval[0]); Out.Ln
+    ELSE
+      S.Mark("Допускается только CHAR")
+    END;
+    S.Get(sym)
+  ELSIF sym = S.ident THEN
+    o := ST.ThisObj();
+    S.Get(sym);
+    IF o = NIL THEN
+      S.Mark("Идентификатор не объявлен")
+    ELSE
+      x.mode := o.class;
+      x.type := o.type;
+      x.val := o.val
+    END
+  ELSIF sym = S.lparen THEN
+    S.Get(sym);
+    Expression(x);
+    IF sym = S.rparen THEN S.Get(sym)
+    ELSE S.Mark("Ожидается )")
+    END
+  ELSE
+    S.Mark("Ожидается число, идентификатор или (")
+  END
+END Factor;
+
+(*слагаемое = множитель {ОперацияУмножения множитель}.*)
+PROCEDURE Term(VAR x: Gen.Item);
+VAR op: INTEGER;
+  y: Gen.Item;
+BEGIN
+  Factor(x);
+  WHILE (sym = S.times) OR (sym = S.div) OR (sym = S.mod) DO
+    op := sym;
+    S.Get(sym);
+    Factor(y);
+    IF (x.type.form = ST.Int) & (y.type.form = ST.Int) THEN
+      IF (x.mode = ST.Const) & (y.mode = ST.Const) THEN
+        IF op = S.times THEN
+          x.val := x.val * y.val (*!TODO проверить переполнение*)
+        ELSE (*DIV OR MOD*)
+          IF op = S.div THEN (*!TODO проверить деление на нуль*)
+            x.val := x.val DIV y.val
+          ELSE
+            x.val := x.val MOD y.val
+          END
+        END
+      ELSE
+        IF op = S.times THEN
+          Out.String("умножение")
+        ELSIF op = S.div THEN
+          Out.String("деление")
+        ELSE
+          Out.String("остаток от деления")
+        END
+      END
+    ELSE
+      S.Mark("Операция неприменима")
+    END;
+    Out.Ln
+  END
+END Term;
+
+(*ПростоеВыражение = ["+"|"-"] слагаемое {ОператорСложения слагаемое}.*)
+PROCEDURE SimpleExpression(VAR x: Gen.Item);
+VAR minus: BOOLEAN;
+  op: INTEGER;
+  y: Gen.Item;
+BEGIN
+  minus := FALSE;
+  IF sym = S.plus THEN
+    S.Get(sym)
+  ELSIF sym = S.minus THEN
+    minus := TRUE;
+    S.Get(sym)
+  END;
+  Term(x);
+  IF minus THEN
+    IF x.type.form = ST.Int THEN
+      IF x.mode = ST.Const THEN
+        x.val := -x.val
+      ELSE
+        Out.String("Унарный минус"); Out.Ln
+      END
+    ELSE
+      S.Mark("Операция унарного минуса неприменима")
+    END
+  END;
+  WHILE (sym = S.plus) OR (sym = S.minus) DO
+    op := sym;
+    S.Get(sym);
+    Term(y);
+    IF (x.type.form = ST.Int) & (y.type.form = ST.Int) THEN
+      IF (x.mode = ST.Const) & (y.mode = ST.Const) THEN
+        IF op = S.plus THEN
+          INC(x.val, y.val) (*!TODO проверить переполнение*)
+        ELSE
+          DEC(x.val, y.val) (*!TODO проверить переполнение*)
+        END
+      ELSE
+        IF op = S.plus THEN
+          Out.String("плюс")
+        ELSE
+          Out.String("минус")
+        END
+      END
+    ELSE
+      S.Mark("Операция неприменима")
+    END;
+    Out.Ln
+  END
+END SimpleExpression;
+
+(*выражение = ПростоеВыражение [отношение ПростоеВыражение].*)
+PROCEDURE Expression(VAR x: Gen.Item);
+BEGIN
+  SimpleExpression(x)
+END Expression;
+
+(*Присваивание = идент ":=" выражение.
+x - то, что слева от знака присваивания,
+y - то, что справа от знака присваивания.*)
+PROCEDURE Assignment(VAR x: Gen.Item);
+VAR y: Gen.Item;
+BEGIN
+  S.Get(sym); (*пропускаем :=*)
+  Expression(y);
+  IF x.type = y.type THEN
+    Out.String("Переменной по адресу ");
+    Out.Int(x.val, 0);
+    Out.String(" присвоено значение ");
+    Out.Int(y.val, 0); Out.Char("."); Out.Ln
+  ELSE
+    S.Mark("Не совпадают типы")
+  END
+END Assignment;
+
+(*уточнИдент = [идент "."] идент.
+Первый идент - это модуль. *)
+PROCEDURE QualIdent(VAR o: ST.Object);
+BEGIN
+  o := ST.ThisObj();
+  S.Get(sym);
+  IF o = NIL THEN
+    S.Mark("Нет такого объекта")
+  ELSE (*Объект найден...*)
+    IF (sym = S.period) & (o.class = ST.Mod) THEN (*...и это модуль*)
+      S.Get(sym);
+      o := ST.ThisObjInModule(o);
+      S.Get(sym);
+      IF o = NIL THEN S.Mark("В модуле нет такого объекта") END
+    END
+  END;
+  IF o = NIL THEN o := dummy END
+END QualIdent;
+
+(*Designator - обозначение.
+Обозначение = уточнИдент {селектор}.
+селектор = "[" выражение "]" | ...
+Но здесь упрощено: Обозначение = уточнИдент.*)
+PROCEDURE Designator(VAR o: ST.Object);
+BEGIN
+  QualIdent(o) (*!TODO обработать селекторы*)
+END Designator;
+
+PROCEDURE Parameter(par: ST.Object);
+VAR x: Gen.Item;
+BEGIN
+  Expression(x);
+  IF par # NIL THEN
+    IF x.type.form # par.type.form THEN
+      S.Mark("Несогласование типов")
+      (*!TODO вывести типы формального и фактического параметров*)
+    ELSIF (par.class = ST.Par) & (x.mode # ST.Var) THEN
+      S.Mark("Требуется вар-параметр")
+    ELSE
+      Out.String("Параметр "); Out.Int(x.val, 0); Out.Char("."); Out.Ln
+    END
+  END
+END Parameter;
+
+(*ФактическиеПараметры = "(" [выражение {"," выражение}] ")".
+Предусловие: sym = S.lparen. Обрабатывает до ")" включительно.*)
+PROCEDURE ActualParameters(VAR x: Gen.Item);
+VAR y: Gen.Item;
+  par: ST.Object;
+  n: INTEGER; (*Фактическое количество параметров*)
+BEGIN
+  S.Get(sym);(*Пропускаем "("*)
+  n := 0;
+  IF sym # S.rparen THEN
+    par := x.type.dsc;
+    Parameter(par);
+    INC(n);
+    WHILE sym = S.comma DO
+      S.Get(sym); (*Пропускаем ","*)
+      IF par # NIL THEN par := par.next END;
+      Parameter(par);
+      INC(n)
+    END
+  END;
+  IF sym = S.rparen THEN S.Get(sym)
+  ELSE S.Mark("Не закрыта скобка")
+  END;
+  (*Проверка совпадения количества параметров*)
+  IF n > x.type.nofpar THEN
+    S.Mark("Слишком много фактических параметров")
+  ELSIF n < x.type.nofpar THEN
+    S.Mark("Недостаточно фактических параметров")
+  END
+END ActualParameters;
+
+(*Операторы = Оператор {";" Оператор}.
+Оператор = [Присваивание | ВызовПроцедуры | ОператорIf |
+           ОператорCase | ОператорWhile | ОператорRepeat | ОператорFor].
+Statements/Операторы означает последовательность операторов.*)
+PROCEDURE Statements;
+VAR x: Gen.Item;
+  o: ST.Object;
+BEGIN
+  REPEAT
+    WHILE sym = S.semicolon DO S.Get(sym) END;
+    IF sym = S.ident THEN
+      Designator(o);
+      Gen.MakeItem(x, o);
+      IF sym = S.eql THEN sym := S.becomes; S.Mark("Ожидается :=") END;
+      IF sym = S.becomes THEN Assignment(x)
+      ELSIF sym = S.lparen THEN (*Например: Out.Int(... *)
+        IF x.type.form = ST.Proc THEN (*Это действительно процедура*)
+          IF x.type.base.form # ST.NoTyp THEN (*Функциональная*)
+            S.Mark("Не используется возвращаемое значение")
+          ELSE
+            ActualParameters(x); (*Обрабатывает до ")" включительно*)
+            Gen.Call(x)
+          END
+        ELSE S.Mark("Это не процедура")
+        END
+      ELSIF x.type.form = ST.Proc THEN(*Вызов процедуры без параметров*)
+        IF x.type.nofpar > 0 THEN S.Mark("Требуются параметры") END;
+        IF x.type.base.form # ST.NoTyp THEN (*Функциональная*)
+          S.Mark("Не используется возвращаемое значение")
+        ELSE
+          Gen.Call(x)
+        END
+      ELSE S.Mark("Инструкция неопознана")
+      END
+    END
+  UNTIL sym # S.semicolon
+END Statements;
+
+(*Модуль = MODULE идент ";" [СписокИмпорта] Объявления
+[BEGIN Операторы] END идент ".".*)
+PROCEDURE Module;
+VAR name: ARRAY 32 OF CHAR;
+BEGIN
+  IF sym = S.module THEN
+    S.Get(sym);
+    IF sym = S.ident THEN name := S.id; S.Get(sym)
+    ELSE S.Mark("Ожидается идентификатор"); name[0] := 0X
+    END;
+    IF sym = S.semicolon THEN S.Get(sym)
+    ELSE S.Mark("Ожидается точка с запятой")
+    END;
+    ImportList;
+    dc := 80002000;
+    Declarations(dc);
+    IF sym = S.begin THEN S.Get(sym); Statements END;
+    IF sym = S.end THEN
+      S.Get(sym);
+      IF sym = S.ident THEN
+        IF name # S.id THEN S.Mark("Название модуля не совпадает") END;
+        S.Get(sym)
+      ELSE
+        S.Mark("Ожидается название модуля")
+      END;
+      IF sym # S.period THEN S.Mark("Нет точки в конце модуля") END
+    ELSE S.Mark("Ожидается END")
+    END
+  ELSE S.Mark("Ожидается модуль")
+  END
+END Module;
+
+PROCEDURE Init;
+BEGIN
+  ST.Init;
+  NEW(dummy); dummy.class := ST.Var; dummy.type := ST.intType
+END Init;
+
+(*Разбирает лексемы, получаемые из модуля Scanner, в соответствии
+с синтаксисом языка Оберон. Возвращает TRUE в случае
+успешной компиляции. Вызывается из модуля Compiler.
+В будущем будет вызывать кодогенератор (из отдельного модуля). *)
+PROCEDURE Compile*(): BOOLEAN;
+BEGIN
+  Init;
+  Gen.WriteDummy; (*Сгенерировать исполнимый файл. Хардкод.*)
+  S.Get(sym); (* олучить наперёд одну лексему*)
+  Module; (*Запустить разбор синтаксической структуры МОДУЛЬ*)
+  ST.Display;
+  RETURN ~S.error
+END Compile;
+
+END Parser.

+ 177 - 0
docs/oberon-master/Mod/Scanner.Mod

@@ -0,0 +1,177 @@
+MODULE Scanner;
+IMPORT Out, Files;
+CONST
+  (*Лексемы*)
+  null = 0; times* = 1; rdiv* = 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;
+  char* = 20; int* = 21; real* = 22; false* = 23; true* = 24;
+  nil* = 25; string* = 26; not* = 27; lparen* = 28; lbrak* = 29;
+  lbrace* = 30; ident* = 31;
+  if* = 32; while* = 34; repeat* = 35; case* = 36; for* = 37;
+  comma* = 40; colon* = 41; becomes* = 42; upto* = 43; rparen* = 44;
+  rbrak* = 45; rbrace* = 46; then* = 47; of* = 48; do* = 49;
+  to* = 50; by* = 51; semicolon* = 52; end* = 53; bar* = 54;
+  else* = 55; elsif* = 56; until* = 57; return* = 58;
+  array* = 60; record* = 61; pointer* = 62; const* = 63; type* = 64;
+  var* = 65; procedure* = 66; begin* = 67; import* = 68; module* = 69;
+  eot = 70;
+
+VAR r: Files.Rider;
+    ch: CHAR;
+    id*: ARRAY 32 OF CHAR;
+    idlen*: INTEGER;
+    ival*: INTEGER;
+    sval*: ARRAY 1024 OF CHAR;
+    slen*: INTEGER;
+    error*: BOOLEAN;
+
+PROCEDURE Color(n: INTEGER);
+BEGIN
+  Out.Char(CHR(27)); Out.Char("[");
+  Out.Int(n, 0); Out.Char("m")
+END Color;
+
+PROCEDURE Mark*(msg: ARRAY OF CHAR);
+BEGIN
+  error := TRUE;
+  Color(41); Color(97);
+  Out.String("Ошибка на поз. ");
+  Out.Int(SHORT(Files.Pos(r)), 0);
+  Out.String(": "); Out.String(msg);
+  Out.Char("."); Color(0); Out.Ln
+END Mark;
+
+PROCEDURE ReadCh;
+BEGIN
+  IF r.eof THEN ch := 0X
+  ELSE Files.Read(r, ch)
+  END
+END ReadCh;
+
+PROCEDURE Get*(VAR sym: INTEGER);
+VAR d: ARRAY 30 OF INTEGER; (*digits*)
+  i, dlen, base: INTEGER;
+BEGIN
+  WHILE (ch # 0X) & (ch <= " ") DO
+    ReadCh
+  END;
+
+  IF r.eof THEN sym := eot
+  ELSIF ch = "," THEN sym := comma; ReadCh
+  ELSIF ch = "." THEN sym := period; ReadCh
+  ELSIF ch = ";" THEN sym := semicolon; ReadCh
+  ELSIF ch = "+" THEN sym := plus; ReadCh
+  ELSIF ch = "-" THEN sym := minus; ReadCh
+  ELSIF ch = "*" THEN sym := times; ReadCh
+  ELSIF ch = "/" THEN sym := rdiv; ReadCh
+  ELSIF ch = "&" THEN sym := and; ReadCh
+  ELSIF ch = "~" THEN sym := not; ReadCh
+  ELSIF ch = "(" THEN sym := lparen; ReadCh
+  ELSIF ch = ")" THEN sym := rparen; ReadCh
+  ELSIF ch = "[" THEN sym := lbrak; ReadCh
+  ELSIF ch = "]" THEN sym := rbrak; ReadCh
+  ELSIF ch = "{" THEN sym := lbrace; ReadCh
+  ELSIF ch = "}" THEN sym := rbrace; ReadCh
+  ELSIF ch = "=" THEN sym := eql; ReadCh
+  ELSIF ch = "#" THEN sym := neq; ReadCh
+  ELSIF ch = "<" THEN ReadCh;
+    IF ch = "=" THEN sym := leq; ReadCh
+    ELSE sym := lss
+    END
+  ELSIF ch = ">" THEN ReadCh;
+    IF ch = "=" THEN sym := geq; ReadCh
+    ELSE sym := gtr
+    END
+  ELSIF ch = ":" THEN
+    ReadCh;
+    IF ch = "=" THEN sym := becomes; ReadCh
+    ELSE sym := colon
+    END
+  ELSIF ("A" <= ch) & (ch <= "Z") OR ("a" <= ch) & (ch <= "z") THEN
+    id[0] := ch; idlen := 1; ReadCh;
+    WHILE ("A" <= ch) & (ch <= "Z") OR
+          ("a" <= ch) & (ch <= "z") OR
+          ("0" <= ch) & (ch <= "9") DO
+      IF idlen < LEN(id) - 1 THEN
+        id[idlen] := ch;
+        INC(idlen)
+      END;
+      ReadCh
+    END;
+    id[idlen] := 0X;
+    IF id = "MODULE" THEN sym := module
+    ELSIF id = "IMPORT" THEN sym := import
+    ELSIF id = "CONST" THEN sym := const
+    ELSIF id = "VAR" THEN sym := var
+    ELSIF id = "BEGIN" THEN sym := begin
+    ELSIF id = "END" THEN sym := end
+    ELSIF id = "IF" THEN sym := if
+    ELSIF id = "THEN" THEN sym := then
+    ELSIF id = "ELSE" THEN sym := else
+    ELSIF id = "ELSIF" THEN sym := elsif
+    ELSIF id = "WHILE" THEN sym := while
+    ELSIF id = "DIV" THEN sym := div
+    ELSIF id = "MOD" THEN sym := mod
+    ELSIF id = "OR" THEN sym := or
+    ELSE sym := ident
+    END
+  ELSIF ("0" <= ch) & (ch <= "9") THEN
+    d[0] := ORD(ch) - ORD("0"); ReadCh;
+    dlen := 1;
+    WHILE ("0" <= ch) & (ch <= "9") OR
+          ("A" <= ch) & (ch <= "F") DO
+      IF dlen < LEN(d) THEN
+        IF ("0" <= ch) & (ch <= "9") THEN d[dlen] := ORD(ch) - ORD("0")
+        ELSE d[dlen] := ORD(ch) - ORD("A") + 10
+        END;
+        INC(dlen)
+      ELSE Mark("Слишком длинное число")
+      END;
+      ReadCh
+    END;
+    sym := int;
+    IF (ch = "X") OR (ch = "H") THEN
+      base := 16;
+      IF ch = "X" THEN sym := char END;
+      ReadCh
+    ELSE base := 10
+    END;
+    ival := 0; i := 0;
+    WHILE i < dlen DO
+      IF (base = 10) & (d[i] >= 10) THEN
+        Mark("Некорректное число")
+      END;
+      ival := ival * base + d[i];
+      INC(i)
+    END
+  ELSIF ch = 22X THEN ReadCh; sym := string;
+    slen := 0;
+    WHILE (ch # 22X) & (ch >= " ") & (slen < LEN(sval) - 1) DO
+      sval[slen] := ch;
+      INC(slen);
+      ReadCh
+    END;
+    IF ch = 0X THEN Mark("Неожиданный конец файла")
+    ELSIF ch < " " THEN Mark("Недопустимая литера в строке")
+    ELSIF ch # 22X THEN Mark("Слишком длинная строка")
+    END;
+    sval[slen] := 0X;
+      (*Промотка до ближайшей кавычки*)
+    WHILE (ch # 0X) & (ch # 22X) DO ReadCh END;
+    ReadCh
+  ELSE
+    sym := null;
+    ReadCh
+  END
+END Get;
+
+PROCEDURE Init*(F: Files.File);
+BEGIN
+  Files.Set(r, F, 0);
+  ReadCh;
+  error := FALSE
+END Init;
+
+END Scanner.

+ 251 - 0
docs/oberon-master/Mod/SymTable.Mod

@@ -0,0 +1,251 @@
+MODULE SymTable;
+IMPORT Out, S := Scanner;
+CONST
+  (* Классы объектов (и одновременно режимы предметов) *)
+  Head* = 0; Const* = 1; Var* = 2; Par* = 3; Typ* = 5; Mod* = 8;
+          (*Par - это вар-параметр*)
+
+  (* Формы типов *)
+  Char* = 3;
+  Int* = 4;
+  NoTyp* = 9;
+  Proc* = 10;
+
+TYPE
+  Object* = POINTER TO ObjDesc;
+  Type* = POINTER TO TypeDesc;
+  TypeDesc* = RECORD
+    form*: INTEGER; (* Форма типа *)
+    size*: INTEGER; (* Размер типа в байтах *)
+    nofpar*: INTEGER; (* Количество параметров *)
+    base*: Type; (* Тип возвращаемого значения процедуры *)
+    dsc*: Object (* Список формальных параметров процедуры *)
+  END;
+
+  ObjDesc* = RECORD
+    class*: INTEGER; (* Класс объекта *)
+    type*: Type;
+    name*: ARRAY 32 OF CHAR;
+    val*: INTEGER;
+    next*, dsc*: Object
+  END;
+
+(* Назначение поля val в зависимости от значения поля class (в Object):
+class | val
+------+-----------------------
+Var   | адрес переменной
+Const | значение константы
+Type  | не используется (пока)   *)
+
+VAR
+  curScope: Object;
+
+  charType*, intType*, noType*: Type;
+
+(*Для удобочитаемой отладки*)
+PROCEDURE OutType*(t: Type);
+BEGIN
+  IF t.form = Int THEN Out.String("целое число")
+  ELSIF t.form = Char THEN Out.String("литера")
+  ELSE Out.Int(t.form, 0)
+  END
+END OutType;
+
+PROCEDURE MakeType(form, size: INTEGER): Type;
+VAR t: Type;
+BEGIN
+  NEW(t);
+  t.form := form;
+  t.size := size;
+  RETURN t
+END MakeType;
+
+PROCEDURE NewObj*(name: ARRAY OF CHAR; class: INTEGER): Object;
+VAR o, p: Object;
+BEGIN
+  p := curScope;
+  WHILE (p.next # NIL) & (p.next.name # name) DO p := p.next END;
+  IF p.next = NIL THEN
+    NEW(o);
+    o.class := class;
+    o.name := name;
+    o.next := NIL;
+    p.next := o
+  ELSE
+    o := p.next;
+    S.Mark("Такой объект уже есть")
+  END;
+  RETURN o
+END NewObj;
+
+PROCEDURE ThisObjInModule*(mod: Object): Object;
+VAR o: Object;
+BEGIN
+  o := mod.dsc;
+  WHILE (o # NIL) & (o.name # S.id) DO o := o.next END;
+  RETURN o
+END ThisObjInModule;
+
+(*Предусловие: sym = S.ident*)
+PROCEDURE ThisObj*(): Object;
+VAR o, p: Object;
+BEGIN
+  p := curScope;
+  WHILE p # NIL DO
+    o := p.next;
+    WHILE (o # NIL) & (o.name # S.id) DO
+      o := o.next
+    END;
+    IF o = NIL THEN p := p.dsc
+    ELSE p := NIL
+    END
+  END;
+  RETURN o
+END ThisObj;
+
+(*Добавить процедуру в модуль*)
+PROCEDURE AddProc(m: Object; name: ARRAY OF CHAR; key: INTEGER): Object;
+VAR o, g: Object;
+BEGIN
+  NEW(o);
+  IF m.dsc = NIL THEN
+    m.dsc := o
+  ELSE
+    g := m.dsc;
+    WHILE g.next # NIL DO g := g.next END;
+    g.next := o
+  END;
+  o.class := Const;
+  o.name := name;
+  o.val := key;
+  o.next := NIL;
+  o.dsc := NIL;
+  o.type := MakeType(Proc, 4);
+  o.type.nofpar := 0;
+  o.type.base := noType;
+  RETURN o
+END AddProc;
+
+(*Добавить формальный параметр в процедуру*)
+PROCEDURE AddParam(proc: Object; name: ARRAY OF CHAR; varParam: BOOLEAN;
+    type: Type; offset: INTEGER);
+VAR o, p: Object;
+BEGIN
+  NEW(p);
+  IF proc.type.dsc = NIL THEN
+    proc.type.dsc := p
+  ELSE
+    o := proc.type.dsc;
+    WHILE o.next # NIL DO o := o.next END;
+    o.next := p
+  END;
+  INC(proc.type.nofpar);
+  IF varParam THEN p.class := Par ELSE p.class := Var END;
+  p.name := name;
+  p.val := offset; (*?*)
+  p.type := type;
+  p.next := NIL;
+  p.dsc := NIL
+END AddParam;
+
+PROCEDURE Import*(alias, modname: ARRAY OF CHAR);
+VAR m, o, p: Object;
+  tp: Type;
+BEGIN
+  IF modname = "Out" THEN
+    NEW(m);
+    curScope.next := m;
+    m.class := Mod;
+    m.name := alias;
+    m.val := 1; (*!FIXME*)
+    m.type := NIL;
+    m.dsc := NIL;
+    (*Out.Char(ch)*)
+    o := AddProc(m, "Char", 0);
+    AddParam(o, "ch", FALSE, charType, 4);
+    (*Out.Int(n, w)*)
+    o := AddProc(m, "Int", 1);
+    AddParam(o, "n", FALSE, intType, 4);
+    AddParam(o, "w", FALSE, intType, 8);
+    (*Out.Ln*)
+    o := AddProc(m, "Ln", 2)
+  ELSIF modname = "In" THEN
+    NEW(m);
+    m.next := curScope.next;
+    curScope.next := m;
+    m.class := Mod;
+    m.name := alias;
+    m.val := 2; (*!FIXME*)
+    m.type := NIL;
+    m.dsc := NIL;
+    (*In.Int(n)*)
+    o := AddProc(m, "Int", 0);
+    AddParam(o, "n", TRUE, intType, 4)
+  ELSE
+    S.Mark("Такого модуля не существует")
+  END;
+  Out.String("Импортируем "); Out.String(modname);
+  Out.String(" под псевдонимом "); Out.String(alias);
+  Out.Char("."); Out.Ln
+END Import;
+
+PROCEDURE Init*;
+VAR o: Object;
+BEGIN
+  NEW(curScope);
+  curScope.class := Head;
+  curScope.name[0] := 0X;
+  curScope.next := NIL;
+
+  NEW(curScope.dsc);
+  curScope.dsc.class := Head;
+  curScope.dsc.name[0] := 0X;
+  curScope.dsc.dsc := NIL;
+
+  NEW(o);
+  o.class := Typ;
+  o.name := "CHAR";
+  o.next := NIL;
+  o.dsc := NIL;
+  charType := MakeType(Char, 1);
+  o.type := charType;
+  curScope.dsc.next := o;
+
+  NEW(o);
+  o.class := Typ;
+  o.name := "INTEGER";
+  o.next := NIL;
+  o.dsc := NIL;
+  intType := MakeType(Int, 4);
+  o.type := intType;
+  curScope.dsc.next.next := o;
+
+  noType := MakeType(NoTyp, 4)
+END Init;
+
+PROCEDURE Display*;
+VAR h, p: Object;
+BEGIN
+  Out.String("Содержимое символьной таблицы:"); Out.Ln;
+  h := curScope;
+  WHILE h # NIL DO
+    p := h.next;
+    WHILE p # NIL DO
+      Out.String("  "); Out.String(p.name); Out.String(": ");
+      IF p.class = Head THEN Out.String("заголовочный")
+      ELSIF p.class = Var THEN
+        Out.String("переменная типа "); OutType(p.type)
+      ELSIF p.class = Typ THEN Out.String("тип")
+      ELSIF p.class = Mod THEN Out.String("модуль")
+      END;
+      Out.Ln;
+      p := p.next
+    END;
+    IF h.dsc # NIL THEN
+      Out.String("Следующая область видимости:"); Out.Ln
+    END;
+    h := h.dsc
+  END
+END Display;
+
+END SymTable.

+ 5 - 0
docs/oberon-master/Mod/c_chmod/c_chmod.c

@@ -0,0 +1,5 @@
+#include <sys/stat.h>
+
+int MakeExecutable(const char *path) {
+  chmod(path, 0755); // S_IXUSR | S_IXGRP | S_IROTH
+}

+ 6 - 0
docs/oberon-master/Mod/c_chmod/c_chmod.h

@@ -0,0 +1,6 @@
+#ifndef CHMOD_H
+#define CHMOD_H
+
+int MakeExecutable(const char *path);
+
+#endif

+ 74 - 0
docs/oberon-master/README.md

@@ -0,0 +1,74 @@
+*English text below*
+
+# Компилятор языка программирования Оберон
+
+* Проект по созданию компилятора Оберона и написанию соответствующей книги
+* Сайт проекта: [freeoberon.su](https://freeoberon.su)
+* Репозиторий с книгой: [https://github.com/kekcleader/OberonBook] [читать PDF](https://github.com/kekcleader/OberonBook/blob/master/oberon.pdf)
+
+Исходные файлы находятся в каталоге [Mod](Mod).
+
+Желающим погрузиться в тему построения компиляторов рекомендуется ознакамливаться с исходным кодом данного проекта по нарастающей, начиная с самых первых коммитов (для более развёрнутого описания изменений см. файл [HISTORY](HISTORY)), а также с книгами Николая Вальтеровича Вирта, Сергея Залмановича Свердлова и других авторов на данную тему, с кодом компилятора в [Project Oberon](http://projectoberon.com), с сайтом [Free Oberon](https://freeoberon.su) (на этом сайте есть контактная информация).
+
+Для того, чтобы скомпилировать компилятор, необходим компилятор VOC,
+входящий в комплект [Free Oberon](https://freeoberon.su). Компилятор VOC
+находится в подкаталоге `data/bin/voc/bin` (файл `voc` на Линуксе или
+`voc.exe` на ОС Windows). Для Линукса также подойдёт
+[оригинальный компилятор VOC](https://github.com/vishaps/voc).
+Также можно использовать компиляторы
+[Ofront](https://github.com/jtempl/ofront) и
+[Ofront+](https://github.com/Oleg-N-Cher/OfrontPlus).
+
+При смене компилятора, пожалуйста, отредактируйте файл [Makefile](Makefile)
+(а именно, переменную `VOCPATH` наверху, и, возможно, другие).
+
+В будущем компилятор будет компилировать себя сам.
+
+Зайдите в каталог с исходным кодом компилятора (можно зайти как в `oberon`, так и в `oberon/Mod`) и выполните:
+```
+make
+```
+
+Затем запустите файл `Compiler`, или воспользуйтесь командой `make run` для теста.
+
+Для компиляции также понадобятся пакеты `make` и `gcc`:
+```
+sudo apt-get install -y make gcc
+```
+
+![Oberon compiler screenshot](https://github.com/kekcleader/oberon/raw/master/etc/docs/schemes/03_Import.png)
+
+# Oberon Programming Language Compiler
+
+* A project to create an Oberon compiler and write a book about it
+* Project website: [freeoberon.su](https://freeoberon.su/en)
+* Repository of the book: [https://github.com/kekcleader/OberonBook] [read PDF](https://github.com/kekcleader/OberonBook/blob/master/oberon.pdf)
+
+The source files are in the [Mod](Mod) directory.
+
+Those wishing to dive into the topic of building compilers are advised to familiarize themselves with the source code of this project on an increasing basis, starting with the very first commits (for a more detailed description of the changes, see the [HISTORY](HISTORY) file), as well as read books by Niklaus Wirth, S. Z. Sverdlov and other authors on this topic, as well as familiarize with the compiler code of the [Project Oberon](http://projectoberon.com) and with the [Free Oberon](https://freeoberon.su/en) website (see this website for the contact information).
+
+In order to compile the compiler, you need the VOC compiler included with
+[Free Oberon](https://freeoberon.su/en). The VOC compiler is located in the
+`data/bin/voc/bin` (the file name on Linux is `voc`, and `voc.exe` on Windows).
+For Linux, [the original VOC compiler](https://github.com/vishaps/voc) is also
+suitable. You can also use
+[Ofront](https://github.com/jtempl/ofront) and
+[Ofront+](https://github.com/Oleg-N-Cher/OfrontPlus) compilers.
+
+When changing the compiler for another one, please edit the [Makefile](Makefile)
+(namely, the VOCPATH variable at the top, and possibly others).
+
+In the future, the compiler will compile itself.
+
+Go to the directory with the source code of the compiler (you can go into any of `oberon` or `oberon/Mod`) and run:
+```
+make
+```
+
+Then run the file `Compiler`, or type `make run` to test it.
+
+You will also need `make` and `gcc` packages for compilation:
+```
+sudo apt-get install -y make gcc
+```

+ 4 - 0
docs/oberon-master/TODO

@@ -0,0 +1,4 @@
+* Генерация машинного кода для присваивания.
+* Генерация машинного кода для сложения и вычитания, смены знака.
+* Генерация машинного кода для умножения и деления.
+* Генерация машинного кода для вызова процедуры.

+ 22 - 0
docs/oberon-master/Test.Mod

@@ -0,0 +1,22 @@
+MODULE Test;
+IMPORT Out;
+VAR c: CHAR;
+BEGIN
+  a := a + b;
+  c := "!";
+  Out.Char("H");
+  Out.Char("i");
+  Out.Char(c);
+  Out.Ln
+END Test.
+
+(*Пример*)
+SUM EAX, EBX
+
+MOV [0x80002000], DWORD 70 (* c := "F" *)
+
+MOV EAX, [0x80002000]      (* (c) *)
+PUSH EAX
+
+CALL 0x80004000            (* Out.Char *)
+CALL 0x80004100            (* Out.Ln *)

+ 25 - 0
docs/oberon-master/etc/Moduel_Ilja.Mod

@@ -0,0 +1,25 @@
+MODULE Moduel;
+IMPORT Out, Files;
+VAR
+  F: Files.File;
+  r: Files.Rider;
+
+PROCEDURE ReadAll;
+VAR ch: CHAR;
+BEGIN
+  Files.Read(r, ch);
+  WHILE ~r.eof DO
+    Out.Char(ch);
+    Files.Read(r, ch)
+  END
+END ReadAll;
+
+BEGIN
+  F := Files.Old('Test.Mod');
+  IF F = NIL THEN
+    Out.String('Файл не найден.'); Out.Ln
+  ELSE
+    Files.Set(r, F, 0);
+    ReadAll
+  END
+END Moduel.

+ 201 - 0
docs/oberon-master/etc/Moduel_RealUpto.Mod

@@ -0,0 +1,201 @@
+MODULE Moduel;
+IMPORT In, Out, Files;
+CONST
+  null = 0; module = 1; import = 2; const = 3; var = 4; begin = 5;
+  end = 6; if = 7; then = 8; else = 9; elsif = 10; while = 11;
+  ident = 12; semicol = 13; colon = 14; comma = 15; period = 16;
+  becomes = 17; equ = 18; neq = 19; les = 20; leq = 21; gtr = 22; geq = 23;
+  lparen = 24; rparen = 25; lbrak = 26; rbrak = 27; lbrace = 28; rbrace = 29;
+  int = 30; string = 31; not = 32; and = 33; or = 34; plus = 35; minus = 36;
+  rdiv = 37; div = 38; mod = 39; times = 40; real = 41; upto = 42; eot = 64;
+VAR f: Files.File; 
+    r: Files.Rider;
+    ch: CHAR;
+    sym: INTEGER;
+    id: ARRAY 32 OF CHAR;
+    idlen: INTEGER;
+    ival: INTEGER;
+    rval: REAL;
+    error: BOOLEAN;
+    
+PROCEDURE ReadCh;
+BEGIN
+  IF r.eof THEN ch := 0X
+  ELSE Files.Read(r, ch)
+  END
+END ReadCh;
+
+PROCEDURE Get;
+VAR k: REAL;
+BEGIN
+  WHILE (ch # 0X) & (ch <= " ") DO
+    ReadCh
+  END;
+
+  IF r.eof THEN sym := eot
+  ELSIF ch = "," THEN sym := comma; ReadCh
+  ELSIF ch = "." THEN sym := period; ReadCh
+  ELSIF ch = ";" THEN sym := semicol; ReadCh
+  ELSIF ch = "+" THEN sym := plus; ReadCh
+  ELSIF ch = "-" THEN sym := minus; ReadCh
+  ELSIF ch = "&" THEN sym := and; ReadCh
+  ELSIF ch = "~" THEN sym := not; ReadCh
+  ELSIF ch = "(" THEN sym := lparen; ReadCh
+  ELSIF ch = ")" THEN sym := rparen; ReadCh
+  ELSIF ch = "[" THEN sym := lbrak; ReadCh
+  ELSIF ch = "]" THEN sym := rbrak; ReadCh
+  ELSIF ch = "{" THEN sym := lbrace; ReadCh
+  ELSIF ch = "}" THEN sym := rbrace; ReadCh
+  ELSIF ch = ":" THEN
+    ReadCh;
+    IF ch = "=" THEN sym := becomes; ReadCh
+    ELSE sym := colon
+    END
+  ELSIF ("A" <= ch) & (ch <= "Z") OR ("a" <= ch) & (ch <= "z") THEN
+    id[0] := ch; idlen := 1; ReadCh;
+    WHILE ("A" <= ch) & (ch <= "Z") OR
+          ("a" <= ch) & (ch <= "z") OR
+          ("0" <= ch) & (ch <= "9") DO
+      IF idlen < LEN(id) - 1 THEN
+        id[idlen] := ch;
+        INC(idlen)
+      END;
+      ReadCh
+    END;
+    id[idlen] := 0X;
+    IF id = "MODULE" THEN sym := module
+    ELSIF id = "IMPORT" THEN sym := import
+    ELSIF id = "CONST" THEN sym := const
+    ELSIF id = "VAR" THEN sym := var
+    ELSIF id = "BEGIN" THEN sym := begin
+    ELSIF id = "END" THEN sym := end
+    ELSIF id = "IF" THEN sym := if
+    ELSIF id = "THEN" THEN sym := then
+    ELSIF id = "ELSE" THEN sym := else
+    ELSIF id = "ELSIF" THEN sym := elsif
+    ELSIF id = "WHILE" THEN sym := while
+    ELSIF id = "DIV" THEN sym := div
+    ELSIF id = "MOD" THEN sym := mod
+    ELSIF id = "OR" THEN sym := or
+    ELSE sym := ident
+    END
+  ELSIF ("0" <= ch) & (ch <= "9") THEN
+    ival := 0;
+    REPEAT
+      ival := ival * 10 + ORD(ch) - ORD("0");
+      ReadCh
+    UNTIL (ch < "0") OR (ch > "9");
+    (*UNTIL ~(("0" <= ch) & (ch <= "9"));*)
+
+    IF ch = '.' THEN (* REAL или ".." *)
+      ReadCh;
+      IF ("0" <= ch) & (ch <= "9") THEN
+        rval := ival; k := 0.1;
+        REPEAT  32.51  +  9/1000 = 32.519
+          rval := rval + (ORD(ch) - ORD("0")) * k;
+          k := k * 0.1;
+          ReadCh
+        UNTIL (ch < "0") OR (ch > "9");
+        sym := real
+      ELSIF ch = '.' THEN
+        sym := int;
+        ch := 7FX
+      ELSE sym := null
+      END
+    END
+  ELSIF ch = 7FX THEN sym := upto; ReadCh
+  ELSE
+    sym := null;
+    ReadCh
+  END
+END Get;
+
+PROCEDURE Mark(msg: ARRAY OF CHAR);
+BEGIN
+  error := TRUE;
+
+  Out.String("Ошибка на поз. ");
+  Out.Int(SHORT(Files.Pos(r)), 0);
+  Out.String(": "); Out.String(msg);
+  Out.Char("."); Out.Ln
+END Mark;
+
+PROCEDURE Declarations;
+BEGIN
+  (*Пусто*)
+END Declarations;
+
+PROCEDURE StatSeq;
+VAR name: ARRAY 32 OF CHAR;
+BEGIN
+  WHILE (sym = ident) OR (sym = semicol) DO
+    IF sym = ident THEN name := id; Get;
+      IF sym = equ THEN Get; sym := becomes; Mark("Ожидается :=") END;
+      IF sym = becomes THEN Get;
+        IF sym = int THEN
+          Out.String("Переменной "); Out.String(name);
+          Out.String(" присвоено значение "); Out.Int(ival, 0); Out.Ln;
+          Get
+        ELSE Get;
+          Mark("Можно присваивать только числа")
+        END
+      END
+    ELSE Get
+    END
+  END
+END StatSeq;
+
+PROCEDURE Module;
+VAR name: ARRAY 32 OF CHAR;
+BEGIN
+  IF sym = module THEN
+    Get;
+    IF sym = ident THEN name := id; Get
+    ELSE Mark("Ожидается идентификатор"); name[0] := 0X
+    END;
+    IF sym = semicol THEN Get
+    ELSE Mark("Ожидается точка с запятой")
+    END;
+    Declarations;
+    IF sym = begin THEN Get; StatSeq END;
+    IF sym = end THEN
+      Get;
+      IF sym = ident THEN
+        IF name # id THEN Mark("Название модуля не совпадает") END;
+        Get;
+        IF sym # period THEN Mark("Нет точки в конце модуля") END
+      END
+    ELSE Mark("Ожидается END")
+    END
+  ELSE Mark("Ожидается модуль")
+  END
+END Module;
+
+BEGIN
+  f := Files.Old("Test.Mod");
+  IF f = NIL THEN
+    Out.String("No file");
+    Out.Ln
+  ELSE
+    Files.Set(r, f, 0);
+    ReadCh;
+    Get;
+    error := FALSE;
+    Module;
+    IF error THEN Out.String("Были ошибки."); Out.Ln END
+  END
+END Moduel.
+
+Пример работы лексического анализатора (# обозначает литеру 7FX).
+x := {12..15}
+x := {12..#15}
+
+x  ident (id="x",idlen=1)
+:= becomes
+{  lbrace
+12 int (ival=12)
+.. upto
+15 int (ival=15)
+}  rbrace
+*)
+

+ 58 - 0
docs/oberon-master/etc/docs/Parser_WorkOrder.txt

@@ -0,0 +1,58 @@
+MODULE Z;
+VAR x: INTEGER;
+BEGIN
+	a := 4;
+	b := a;
+	Out.Ln;
+	Out.Int(b, 5)
+END Z.
+
+Лексич. анализатор:  (scanner)
+	ReadCh
+	Get
+
+Кодогенератор:
+	Процедуры генерации машинного кода
+
+Символьная таблица:
+	NewObj
+	ThisObj
+
+Синтаксич. анализатор: (parser)
+Module
+	Imports	
+	Declarations
+	StatSeq
+		Qualident
+			Ident
+			Selector
+		Assignment
+			Expression
+				SimpleExpr
+					Term
+						Factor
+			Generator.Assign(x, y)
+
+		Qualident
+			Ident
+			Selector
+		Assignment
+			Expression
+				SimpleExpr
+					Term
+						Factor
+							Qualident
+								Ident
+									Selector
+
+			Generator.Assign(x, y)
+
+
+StatSeq = Statement {";" Statement}.
+
+Statement = IfStatement | WhileStatement | Assignment | ProcedureCall.
+
+
+Scanner.Mod -> Scanner.o Scanner.sym
+Parser.Mod -> Parser.o Parser.sym
+

+ 33 - 0
docs/oberon-master/etc/docs/Parser_and_Generator.txt

@@ -0,0 +1,33 @@
+VAR a, c: INTEGER;
+    --- создан Object (name="a",class=Var,type=intType,val=8001200)
+    --- создан Object (name="c",class=Var,type=intType,val=8001204)
+BEGIN
+
+                op = +
+             x         y
+  a    :=    c    +    5
+  |          |         |
+  |          |         '-Item(mode=Const,type=intType,val=5)
+  |          '-Item(mode=Var,type=intType,val=8001204)
+  |
+  |           LDR R0, 8001204
+  |           ADD R0, R0, 5
+  |          ._____ _____,
+  |                v
+  |               Item(mode=Reg,type=intType,val=R0)
+  |
+  '-Item(mode=Var,type=intType,val=8001200)
+  
+  STR R0, 8001200
+
+
+LDR R0, 8001204
+ADD R0, R0, 5
+STR R0, 8001200
+
+mode бывает Const, Var и Reg (пока).
+  
+  
+intType - это такой Object
+charType - это такой Object
+(глобальные переменные в модуле SymTable)

BIN
docs/oberon-master/etc/docs/schemes/00_varChar.png


BIN
docs/oberon-master/etc/docs/schemes/01_Bukva.png


BIN
docs/oberon-master/etc/docs/schemes/02_MyProc.png


BIN
docs/oberon-master/etc/docs/schemes/03_Import.png


Разлика између датотеке није приказан због своје велике величине
+ 0 - 0
docs/oberon-master/etc/docs/schemes/src/00_varChar.xml


Разлика између датотеке није приказан због своје велике величине
+ 0 - 0
docs/oberon-master/etc/docs/schemes/src/01_Bukva.xml


Разлика између датотеке није приказан због своје велике величине
+ 0 - 0
docs/oberon-master/etc/docs/schemes/src/02_MyProc.xml


Разлика између датотеке није приказан због своје велике величине
+ 0 - 0
docs/oberon-master/etc/docs/schemes/src/03_Import.xml


+ 13 - 0
docs/oberon-master/etc/docs/schemes/src/README.md

@@ -0,0 +1,13 @@
+*English text below*
+
+# Как редактировать схемы
+XML-файлы можно редактировать с помощью данного веб-редактора схем:
+https://www.diagrameditor.com/
+
+Затем их можно экспортировать в формате PNG в масштабе 300% и толщину рамки в 50 единиц.
+
+# How to edit the schemes
+The XML files can be edited using this web-based scheme editor:
+https://www.diagrameditor.com/
+
+Then they can be exported as PNG using 300% zoom and a border width of 50.

+ 72 - 0
docs/summary_m2comp_step2.md

@@ -0,0 +1,72 @@
+# m2comp step 2 — SymTab semantic analysis (tag: `m2comp-step2`)
+
+Coco/R lexer/parser (step 1) + static type checking, still no codegen.
+Follows Blaise Phase 2 (type system) with the semantic pass folded
+into grammar actions, Wirth single-pass style.
+
+## What was built
+
+- `src/SymTab.def/.mod` — ported from CocoGm2 `Test1` (proven under
+  `gm2 -fiso`) and extended for procedures and local modules:
+  - procedures: nested, value/`VAR` params (pending-list entry),
+    function results; signatures persist in `procs[]`/`params[]`
+    after body scopes pop (no `FORWARD` headings, so no 231);
+  - local modules (Wirth form): body scope + `(module, name)` export
+    table; `M.x` resolves via exports, or the live body scope from
+    inside `M` itself (`SelfKind/SelfType/SelfProc`);
+  - call checking with an 8-deep frame stack (nested calls safe);
+    invalid callees get a dead frame to suppress cascades;
+  - open arrays (formal-only): `NewOpen/WrapArray/IsOpen`;
+    `VAR`/`value` rules enforced at declaration (230 otherwise);
+  - loop-depth tracking for `EXIT` validation (230).
+- `src/M2comp.atg` — full attribution: every `Type`/`Expr`/`Stat`
+  production carries `SymTab.TypeIndex` attributes; `Designator`
+  returns type + kind + proc number with record/field (`215/216`),
+  array (`217/218`, per-index stepping), pointer (`219`) checks;
+  `AssignOrCall` checks storability + `Assignable` (210) and call
+  arity/formals (233, incl. proper-proc-in-expression);
+  `RETURN` checked against function context (232); conditions (214);
+  `FOR` control/bounds (220); sets via `222`; cycles (223);
+  ordinals (224); `MODULE/END` match (202); dup/undeclared (200/201).
+- Checks NOT yet done (no codegen info): `WITH` (no grammar support),
+  enum/set-literal construction (kept in `SymTab`, grammar later),
+  `HIGH`, range checks, `NIL` dereference.
+
+## Tests — 19/19 (`run_tests.sh`)
+
+Accept: `ok_minimal`, `ok_proc`, `showcase` (extended with real
+`y`/`z` declarations — calls to merely-imported names are now
+rightly 233 — plus `Chars`/`sa` for a `VAR` open-formal call),
+`bad_mismatch` still rejected. Reject (one per code):
+`t_dup` 200, `t_undecl` 201, `t_assign` 210, `t_arith` 211,
+`t_bool` 212, `t_rel` 213, `t_cond` 214, `t_field` 216,
+`t_index` 217, `t_ptr` 219, `t_for` 220, `t_call`/`t_call2` 233,
+`t_return` 232, `t_exit` 230.
+
+## Bugs found by the tests (both fixed, both covered)
+
+- EBNF grouping trap: in `A | B | C {loop}` Coco/R binds the loop
+  to the LAST alternative only, so `-v + 1` broke after step-2
+  rewrite. Fixed with a parenthesized group + shared loop.
+- Leaked call frames: `Fact` pushed a dead frame for every bare
+  designator but popped only on the call path, silently shifting all
+  later arity checks (e.g. `P(i)` vs 2 formals passed). Fixed with
+  balanced push/pop (`pushed` flag); verified `P()/P(i)/P(i,TRUE)/
+  P(i,TRUE,i)` behave correctly.
+
+## Docs added (reference for next steps)
+
+- `docs/AST.pdf` (Mössenböck: ASTs via plain Coco/R output
+  attributes — recipe for the step-3 AST layer),
+- `docs/oberon-master/` (freeoberon Oberon compiler: hand-written
+  recursive descent + `Item`-technique generator; pointer-linked
+  `SymTable` studied but NOT mimicked — flat `TypeIndex` design
+  stays, since the future MC64 `MGen` needs it),
+- `docs/Document 1 sans titre` renamed to `BenjaminKowarsh.txt`.
+
+## Next
+
+Step 3: AST layer per `AST.pdf` (node modules, output attributes;
+pointer-record tree à la Oberon `dsc`/`next`), then MC64 `MGen`
+backend behind it. `SymTab` API is already backend-ready
+(`ProcNum`, `ByNum` queries, export tables).

+ 16 - 1
run_tests.sh

@@ -1,5 +1,5 @@
 #!/bin/sh
-# Regression for M2comp step 1 (Coco/R syntax front end).
+# Regression for M2comp step 2 (Coco/R + SymTab semantic analysis).
 # Usage: ./run_tests.sh   (from the m2comp directory)
 pass=0; fail=0
 expect_ok() {
@@ -20,5 +20,20 @@ expect_ok tests/ok_minimal.mod
 expect_ok tests/ok_proc.mod
 expect_ok tests/showcase.mod
 expect_fail tests/bad_mismatch.mod
+expect_fail tests/t_dup.mod
+expect_fail tests/t_undecl.mod
+expect_fail tests/t_assign.mod
+expect_fail tests/t_arith.mod
+expect_fail tests/t_bool.mod
+expect_fail tests/t_rel.mod
+expect_fail tests/t_cond.mod
+expect_fail tests/t_field.mod
+expect_fail tests/t_index.mod
+expect_fail tests/t_ptr.mod
+expect_fail tests/t_for.mod
+expect_fail tests/t_call.mod
+expect_fail tests/t_call2.mod
+expect_fail tests/t_return.mod
+expect_fail tests/t_exit.mod
 echo "--- $pass passed, $fail failed ---"
 [ "$fail" -eq 0 ]

+ 638 - 150
src/M2comp.atg

@@ -1,21 +1,20 @@
 COMPILER M2comp
-(* Step 1 — Coco/R lexer + parser for Modula-2 program modules.
+(* Step 2 — Coco/R lexer/parser + SymTab semantic analysis (no codegen).
    Lexer/scanner and parser are FULLY generated by Coco/R (CR):
      M2comp.atg  --CR-->  M2compS (scanner) + M2compP (parser)
                           + M2comp (driver from compiler.frm)
-   No hand-written lexer (replaces src/M2Lex). gm2 -fiso build.
-   Subset: MODULE, IMPORT/FROM..IMPORT, CONST/TYPE/VAR, PROCEDURE
-   (nested, value/VAR params, function result), LOCAL MODULES per Wirth
-   (MODULE ident [Priority] [Import] [Export] Block ident, pimmod2 form),
-   statements (assign, call, IF, WHILE, REPEAT, LOOP/EXIT, FOR, RETURN),
-   expressions with Kowarsch unary-minus rule (3.3: '-' takes a Factor)
-   and abbreviated multi-dim arrays (3.1 strict: comma index list).
-   Semantic checking + codegen arrive later; only MODULE/END name
-   matches are checked (error 202). Synonym "<>" kept for now (2.2 open);
-   octal B/C suffixes already absent (2.1); (*$ *) directives treated
-   as comments until a PRAGMAS section is added (2.3/2.4 open). *)
+   Static checks (SymTab): 200 duplicate, 201 undeclared, 202 name
+   mismatch, 210 bad assignment, 211 arithmetic, 212 boolean operand,
+   213 comparison, 214 condition, 215 not a record, 216 unknown field,
+   217 not an array, 218 bad index, 219 not a pointer, 220 FOR misuse,
+   221 not a type, 222 set mismatch, 223 cyclical type, 224 ordinal
+   required, 230 unsupported (EXIT outside LOOP, open array outside
+   formal), 232 bad RETURN, 233 invalid call. 231 unused (no FORWARD).
+   Kowarsch rules kept from step 1: local MODULEs in Wirth form,
+   unary minus takes a Factor (3.3), abbreviated arrays (3.1),
+   no octal B/C (2.1). "~" never added (2.2); "<>" still accepted. *)
 
-IMPORT Strings;
+IMPORT SymTab;
 
 CHARACTERS
   eol      = CHR(13) .
@@ -47,24 +46,33 @@ PRODUCTIONS
      the messages still name the right tokens. *)
   M2comp
     = Module "." .
-  Module                              (. VAR m1, m2: ARRAY [0..63] OF CHAR; .)
-    = "MODULE"
+  Module                              (. VAR m1, m2: SymTab.Name; .)
+    =                                 (. SymTab.Init; .)
+      "MODULE"
       GetIdent<m1>
       ";"
       { Import }
       Block
-      GetIdent<m2>                    (. IF ~Strings.Equal(m1, m2) THEN SemError(202) END; .) .
-  Import                              (. VAR n: ARRAY [0..63] OF CHAR; .)
+      GetIdent<m2>                    (. IF ~SymTab.Equal(m1, m2) THEN
+                                         SemError(202) END;
+                                        SymTab.PrintTable; .) .
+  Import                              (. VAR n: SymTab.Name; .)
     = [ "FROM"
-        GetIdent<n> ]
+        GetIdent<n>                   (. IF ~SymTab.Enter(n,
+                                           SymTab.KindImport)
+                                         THEN SemError(200) END; .) ]
       "IMPORT"
       IdentList
       ";" .
-  IdentList
-    = ident
+  IdentList                           (. VAR n: SymTab.Name; .)
+    = GetIdent<n>                     (. IF ~SymTab.Enter(n,
+                                           SymTab.KindImport)
+                                         THEN SemError(200) END; .)
       { ","
-        ident } .
-  GetIdent<VAR n: ARRAY OF CHAR>
+        GetIdent<n>                   (. IF ~SymTab.Enter(n,
+                                           SymTab.KindImport)
+                                         THEN SemError(200) END; .) } .
+  GetIdent<VAR n: SymTab.Name>
     = ident                           (. LexName(n); .) .
   Block
     = { Declaration }
@@ -73,102 +81,264 @@ PRODUCTIONS
       "END" .
   Declaration
     = "CONST"
-      { ident
-        "="
-        Expr
-        ";" }
+      { ConstDecl ";" }
     | "TYPE"
-      { ident
-        "="
-        Type
-        ";" }
+      { TypeDecl ";" }
     | "VAR"
-      { IdentList
-        ":"
-        Type
-        ";" }
+      { VarDecl ";" }
     | ProcDecl
       ";"
     | ModuleDecl
       ";" .
-  ModuleDecl                          (. VAR m1, m2: ARRAY [0..63] OF CHAR; .)
-    = "MODULE"                        (* local module, Wirth form *)
-      GetIdent<m1>
-      [ Priority ]
-      ";"
-      { Import }
-      [ Export ]
-      Block
-      GetIdent<m2>                    (. IF ~Strings.Equal(m1, m2) THEN SemError(202) END; .) .
-  Priority
-    = "["
-      Expr
-      "]" .
-  Export
-    = "EXPORT"
-      [ "QUALIFIED" ]
-      IdentList
-      ";" .
-  ProcDecl                            (. VAR m1, m2: ARRAY [0..63] OF CHAR; .)
+  ConstDecl                           (. VAR n: SymTab.Name;
+                                           t: SymTab.TypeIndex; .)
+    = GetIdent<n>                     (. IF ~SymTab.Enter(n,
+                                           SymTab.KindConst)
+                                         THEN SemError(200) END; .)
+      "="
+      ConstExpr<t>                    (. SymTab.SetSymType(n, t); .) .
+  ConstExpr<VAR t: SymTab.TypeIndex>
+                                      (. VAR vD: BOOLEAN; .)
+    = Expr<t, vD> .
+  TypeDecl                            (. VAR n: SymTab.Name;
+                                           t0, t1: SymTab.TypeIndex; .)
+    = GetIdent<n>                     (. IF ~SymTab.Enter(n,
+                                           SymTab.KindType)
+                                         THEN SemError(200) END;
+                                        t0 := SymTab.NewAlias();
+                                        SymTab.SetSymType(n, t0); .)
+      "="
+      Type<t1>                        (. IF t1 = t0 THEN SemError(223);
+                                         SymTab.SetTarget(t0,
+                                           SymTab.InvalidType)
+                                       ELSE SymTab.SetTarget(t0, t1) END; .) .
+  VarDecl                             (. VAR t: SymTab.TypeIndex; .)
+    = VarIdents ":"
+      Type<t>                         (. IF SymTab.IsOpen(t) THEN
+                                         SemError(230) END;
+                                        SymTab.FixPending(t); .) .
+  VarIdents                           (. VAR n: SymTab.Name; .)
+    = GetIdent<n>                     (. IF ~SymTab.EnterPending(n,
+                                           SymTab.KindVar)
+                                         THEN SemError(200) END; .)
+      { ","
+        GetIdent<n>                   (. IF ~SymTab.EnterPending(n,
+                                           SymTab.KindVar)
+                                         THEN SemError(200) END; .) } .
+  ProcDecl                            (. VAR m1, m2: SymTab.Name;
+                                           rt: SymTab.TypeIndex; .)
     = "PROCEDURE"
-      GetIdent<m1>
+      GetIdent<m1>                    (. IF ~SymTab.EnterProc(m1) THEN
+                                         SemError(200) END;
+                                        SymTab.OpenProcScope; .)
       [ FormalParams ]
       [ ":"
-        QualIdent ]
+        QualIdent<rt>                 (. SymTab.SetProcRet(rt); .) ]
       ";"
       Block
-      GetIdent<m2>                    (. IF ~Strings.Equal(m1, m2) THEN SemError(202) END; .) .
+      GetIdent<m2>                    (. IF ~SymTab.Equal(m1, m2) THEN
+                                         SemError(202) END;
+                                        SymTab.CloseProc; .) .
   FormalParams
     = "("
       [ FPSection
         { ";"
           FPSection } ]
       ")" .
-  FPSection
-    = [ "VAR" ]
-      IdentList
-      ":"
-      Type .
-  Type
-    = QualIdent
-      [ "[" Expr ".." Expr "]" ]
-    | "["
-      Expr
-      ".."
-      Expr
-      "]"
-    | "ARRAY"                         (* abbreviated form only (3.1):
-                                         comma index list; a nested
-                                         ARRAY OF ARRAY long form is
-                                         flagged in step 2 semantic check *)
-      [ IndexType { "," IndexType } ]
+  FPSection                           (. VAR isV: BOOLEAN;
+                                           t: SymTab.TypeIndex; .)
+    =                                 (. isV := FALSE; .)
+      [ "VAR"                         (. isV := TRUE; .) ]
+      FPIdents<isV> ":"
+      Type<t>                         (. IF SymTab.IsOpen(t) & ~isV THEN
+                                         SemError(230) END;
+                                        IF ~SymTab.FixParamPending(t) THEN
+                                          SemError(200) END; .) .
+  FPIdents<isV: BOOLEAN>              (. VAR n: SymTab.Name; .)
+    = GetIdent<n>                     (. IF ~SymTab.EnterParamPending(n,
+                                           isV) THEN
+                                         SemError(200) END; .)
+      { ","
+        GetIdent<n>                   (. IF ~SymTab.EnterParamPending(n,
+                                           isV) THEN
+                                         SemError(200) END; .) } .
+  ModuleDecl                          (. VAR m1, m2: SymTab.Name; .)
+    = "MODULE"                        (* local module, Wirth form *)
+      GetIdent<m1>                    (. IF ~SymTab.EnterModule(m1) THEN
+                                         SemError(200) END; .)
+      [ Priority ]
+      ";"
+      { Import }
+      [ Export ]
+      Block
+      GetIdent<m2>                    (. IF ~SymTab.Equal(m1, m2) THEN
+                                         SemError(202) END;
+                                        IF ~SymTab.ExitModule() THEN
+                                          SemError(201) END; .) .
+  Priority                            (. VAR t: SymTab.TypeIndex;
+                                           vD: BOOLEAN; .)
+    = "["
+      Expr<t, vD>
+      "]" .
+  Export                              (. VAR n: SymTab.Name; .)
+    = "EXPORT"
+      [ "QUALIFIED" ]
+      GetIdent<n>                     (. IF ~SymTab.ModuleAddExp(n) THEN
+                                         SemError(200) END; .)
+      { ","
+        GetIdent<n>                   (. IF ~SymTab.ModuleAddExp(n) THEN
+                                         SemError(200) END; .) }
+      ";" .
+  Type<VAR t: SymTab.TypeIndex>
+                                      (. VAR c: CARDINAL;
+                                           e, s: SymTab.TypeIndex; .)
+    = BoundedBase<t>
+    | "ARRAY"                         (* abbreviated form only (3.1);
+                                         nested ARRAY OF ARRAY long form
+                                         flagged in step 3 sizing *)
+                                      (. c := 0; .)
+      [ IdxList<c> ]
       "OF"
-      Type
-    | "RECORD"
-      FieldSeq
+      Type<e>                         (. t := SymTab.WrapArray(e, c); .)
+    | "RECORD"                        (. t := SymTab.NewRecord(); .)
+      FieldSeq<t>
       "END"
     | "SET"
       "OF"
-      QualIdent
+      QualIdent<s>                    (. IF (s # SymTab.InvalidType)
+                                           & (SymTab.ClassOf(s) #
+                                              SymTab.ClInt)
+                                           & (SymTab.ClassOf(s) #
+                                              SymTab.ClChar)
+                                           & (SymTab.ClassOf(s) #
+                                              SymTab.ClEnum) THEN
+                                          SemError(224) END;
+                                        t := SymTab.NewSet(s); .)
     | "POINTER"
       "TO"
-      Type .
-  IndexType
-    = QualIdent
-      [ "[" Expr ".." Expr "]" ]
+      Type<e>                         (. t := SymTab.NewPtr(e); .) .
+  BoundedBase<VAR t: SymTab.TypeIndex>
+                                      (. VAR t1, t2: SymTab.TypeIndex;
+                                           vD, vD2: BOOLEAN; .)
+    = QualIdent<t>
+      [ "["
+        Expr<t1, vD>                  (. IF (t1 # SymTab.InvalidType)
+                                         & (SymTab.ClassOf(t1) #
+                                            SymTab.ClInt)
+                                         & (SymTab.ClassOf(t1) #
+                                            SymTab.ClChar)
+                                         & (SymTab.ClassOf(t1) #
+                                            SymTab.ClEnum) THEN
+                                         SemError(224) END; .)
+        ".."
+        Expr<t2, vD2>                 (. IF (t2 # SymTab.InvalidType)
+                                         & (SymTab.ClassOf(t2) #
+                                            SymTab.ClInt)
+                                         & (SymTab.ClassOf(t2) #
+                                            SymTab.ClChar)
+                                         & (SymTab.ClassOf(t2) #
+                                            SymTab.ClEnum) THEN
+                                         SemError(224) END; .)
+        "]"                           (. t := SymTab.NewSub(t1); .) ]
     | "["
-      Expr
+      Expr<t1, vD>                    (. IF (t1 # SymTab.InvalidType)
+                                         & (SymTab.ClassOf(t1) #
+                                            SymTab.ClInt)
+                                         & (SymTab.ClassOf(t1) #
+                                            SymTab.ClChar)
+                                         & (SymTab.ClassOf(t1) #
+                                            SymTab.ClEnum) THEN
+                                         SemError(224) END; .)
       ".."
-      Expr
-      "]" .
-  FieldSeq
-    = Field { ";" Field } .
-  Field
-    = [ IdentList ":" Type ] .
-  QualIdent
-    = ident
+      Expr<t2, vD2>                   (. IF (t2 # SymTab.InvalidType)
+                                         & (SymTab.ClassOf(t2) #
+                                            SymTab.ClInt)
+                                         & (SymTab.ClassOf(t2) #
+                                            SymTab.ClChar)
+                                         & (SymTab.ClassOf(t2) #
+                                            SymTab.ClEnum) THEN
+                                         SemError(224) END; .)
+      "]"                             (. t := SymTab.NewSub(t1); .) .
+  IdxList<VAR c: CARDINAL>            (. VAR s: SymTab.TypeIndex; .)
+    = IndexType<s>                    (. c := 1;
+                                        IF (s # SymTab.InvalidType)
+                                           & (SymTab.ClassOf(s) #
+                                              SymTab.ClInt)
+                                           & (SymTab.ClassOf(s) #
+                                              SymTab.ClChar)
+                                           & (SymTab.ClassOf(s) #
+                                              SymTab.ClEnum) THEN
+                                          SemError(224) END; .)
+      { ","
+        IndexType<s>                  (. IF (s # SymTab.InvalidType)
+                                           & (SymTab.ClassOf(s) #
+                                              SymTab.ClInt)
+                                           & (SymTab.ClassOf(s) #
+                                              SymTab.ClChar)
+                                           & (SymTab.ClassOf(s) #
+                                              SymTab.ClEnum) THEN
+                                          SemError(224) END;
+                                        INC(c); .) } .
+  IndexType<VAR t: SymTab.TypeIndex>
+    = BoundedBase<t> .
+  FieldSeq<rt: SymTab.TypeIndex>
+    = Field<rt>
+      { ";"
+        Field<rt> } .
+  Field<rt: SymTab.TypeIndex>         (. VAR et: SymTab.TypeIndex; .)
+    = [ FieldIdents<rt> ":"
+        Type<et>                      (. SymTab.FixPendingF(rt, et); .) ] .
+  FieldIdents<rt: SymTab.TypeIndex>   (. VAR n: SymTab.Name; .)
+    = GetIdent<n>                     (. IF ~SymTab.FieldPending(rt, n)
+                                         THEN SemError(200) END; .)
+      { ","
+        GetIdent<n>                   (. IF ~SymTab.FieldPending(rt, n)
+                                         THEN SemError(200) END; .) } .
+  QualIdent<VAR t: SymTab.TypeIndex>
+                                      (. VAR n, m: SymTab.Name;
+                                           modHead: BOOLEAN; .)
+    =                                 (. modHead := FALSE; .)
+      GetIdent<n>                     (. IF ~SymTab.Lookup(n) THEN
+                                          SemError(201);
+                                          t := SymTab.InvalidType
+                                        ELSIF SymTab.SymKind(n)
+                                           = SymTab.KindModule THEN
+                                          t := SymTab.InvalidType;
+                                          modHead := TRUE
+                                        ELSIF (SymTab.SymKind(n) #
+                                               SymTab.KindType)
+                                           & (SymTab.SymKind(n) #
+                                              SymTab.KindPredef)
+                                           & (SymTab.SymKind(n) #
+                                              SymTab.KindImport) THEN
+                                          SemError(221);
+                                          t := SymTab.InvalidType
+                                        ELSE t := SymTab.SymType(n) END; .)
       { "."
-        ident } .
+        GetIdent<m>                   (. IF modHead THEN
+                                          modHead := FALSE;
+                                          IF SymTab.ExpKind(n, m)
+                                             = SymTab.KindType THEN
+                                            t := SymTab.ExpType(n, m)
+                                          ELSIF SymTab.SelfKind(n, m)
+                                             = SymTab.KindType THEN
+                                            t := SymTab.SelfType(n, m)
+                                          ELSE
+                                            IF SymTab.ExpKind(n, m) < 0 THEN
+                                              IF SymTab.SelfKind(n, m)
+                                                 < 0 THEN
+                                                SemError(201)
+                                              ELSE SemError(221)
+                                              END
+                                            ELSE SemError(221)
+                                            END;
+                                            t := SymTab.InvalidType
+                                          END
+                                        ELSIF t #
+                                           SymTab.InvalidType THEN
+                                          SemError(221);
+                                          t := SymTab.InvalidType
+                                        END; .) } .
   StatSeq
     = Stat
       { ";"
@@ -181,89 +351,407 @@ PRODUCTIONS
       | LoopStat
       | ForStat
       | ReturnStat
-      | "EXIT" ] .
-  AssignOrCall
-    = Designator
+      | "EXIT"                        (. IF ~SymTab.InLoop() THEN
+                                         SemError(230) END; .) ] .
+  AssignOrCall                        (. VAR dt, et: SymTab.TypeIndex;
+                                           dk, pn: INTEGER;
+                                           ev: BOOLEAN;
+                                           nn: CARDINAL;
+                                           hadP: BOOLEAN; .)
+    = Designator<dt, dk, pn>
       ( ":="
-        Expr
-      | [ ActParams ] ) .
-  Designator
-    = QualIdent
-      { "[" Expr { "," Expr } "]"
-      | "^" } .
-  ActParams
-    = "("
-      [ Expr { "," Expr } ]
+        Expr<et, ev>                  (. IF dt = SymTab.InvalidType THEN
+                                          (* cascade *)
+                                        ELSIF (dk # SymTab.KindVar)
+                                           & (dk # SymTab.KindParam)
+                                           & (dk # SymTab.KindVarPar)
+                                           & (dk # SymTab.KindField) THEN
+                                          SemError(210)
+                                        ELSIF ~SymTab.Assignable(et,
+                                           dt) THEN
+                                          SemError(210) END; .)
+      |                               (. hadP := FALSE; nn := 0;
+                                         IF dk = SymTab.KindProc THEN
+                                           SymTab.CallBeginNum(pn)
+                                         ELSE
+                                           SymTab.CallBeginNum(-1)
+                                         END;
+                                         IF (dk # SymTab.KindProc)
+                                            & (dk # -1) THEN
+                                           SemError(233) END; .)
+        [ ActParams<nn>               (. hadP := TRUE; .) ]
+        (. IF ~SymTab.CallEndNum(nn) THEN
+             SemError(233) END; .) ) .
+  Designator<VAR t: SymTab.TypeIndex; VAR k: INTEGER;
+             VAR pn: INTEGER>         (. VAR n, m: SymTab.Name;
+                                           it, it2: SymTab.TypeIndex;
+                                           iv, iv2: BOOLEAN;
+                                           ek, sk, p2: INTEGER;
+                                           modHead: BOOLEAN; .)
+    = GetIdent<n>                     (. modHead := FALSE;
+                                        IF ~SymTab.Lookup(n) THEN
+                                          SemError(201);
+                                          t := SymTab.InvalidType;
+                                          k := -1; pn := -1
+                                        ELSIF SymTab.SymKind(n)
+                                           = SymTab.KindModule THEN
+                                          t := SymTab.InvalidType;
+                                          k := SymTab.KindModule;
+                                          pn := -1; modHead := TRUE
+                                        ELSE
+                                          t := SymTab.SymType(n);
+                                          k := SymTab.SymKind(n);
+                                          IF k = SymTab.KindProc THEN
+                                            pn := SymTab.ProcNum(n)
+                                          ELSE pn := -1
+                                          END
+                                        END; .)
+      { "." GetIdent<m>               (. IF modHead THEN
+                                          modHead := FALSE;
+                                          ek := SymTab.ExpKind(n, m);
+                                          sk := SymTab.SelfKind(n, m);
+                                          IF ek = SymTab.KindType THEN
+                                            t := SymTab.ExpType(n,
+                                                     m);
+                                            k := SymTab.KindType
+                                          ELSIF sk =
+                                             SymTab.KindType THEN
+                                            t := SymTab.SelfType(n,
+                                                     m);
+                                            k := SymTab.KindType
+                                          ELSIF ek =
+                                             SymTab.KindProc THEN
+                                            t := SymTab.ProcRetByNum(
+                                                     SymTab.ExpProc(
+                                                       n, m));
+                                            k := SymTab.KindProc;
+                                            pn := SymTab.ExpProc(
+                                                     n, m)
+                                          ELSIF sk =
+                                             SymTab.KindProc THEN
+                                            p2 := SymTab.SelfProc(
+                                                     n, m);
+                                            t := SymTab.ProcRetByNum(
+                                                     p2);
+                                            k := SymTab.KindProc;
+                                            pn := p2
+                                          ELSIF ek >= 0 THEN
+                                            t := SymTab.ExpType(n,
+                                                     m);
+                                            k := ek; pn := -1
+                                          ELSIF sk >= 0 THEN
+                                            t := SymTab.SelfType(n,
+                                                     m);
+                                            k := sk; pn := -1
+                                          ELSE
+                                            SemError(201);
+                                            t := SymTab.InvalidType;
+                                            k := -1; pn := -1
+                                          END
+                                        ELSIF t =
+                                           SymTab.InvalidType THEN
+                                          (* cascade *)
+                                        ELSIF SymTab.ClassOf(t) #
+                                           SymTab.ClRecord THEN
+                                          SemError(215);
+                                          t := SymTab.InvalidType;
+                                          k := -1; pn := -1
+                                        ELSIF ~SymTab.FieldExists(t,
+                                           m) THEN
+                                          SemError(216);
+                                          t := SymTab.InvalidType;
+                                          k := -1; pn := -1
+                                        ELSE
+                                          t := SymTab.FieldType(t,
+                                            m);
+                                          k := SymTab.KindField;
+                                          pn := -1
+                                        END; .)
+      | "[" Expr<it, iv>              (. IF t = SymTab.InvalidType THEN
+                                          (* cascade *)
+                                        ELSIF SymTab.ClassOf(t) #
+                                           SymTab.ClArray THEN
+                                          SemError(217);
+                                          t := SymTab.InvalidType;
+                                          k := -1; pn := -1
+                                        ELSIF (it #
+                                           SymTab.InvalidType)
+                                           & ~SymTab.IsIntFamily(
+                                              it) THEN
+                                          SemError(218);
+                                          t := SymTab.InvalidType;
+                                          k := -1; pn := -1
+                                        ELSE t := SymTab.ArrayElem(
+                                            t);
+                                          pn := -1
+                                        END; .)
+        { "," Expr<it2, iv2>          (. IF t = SymTab.InvalidType THEN
+                                          (* cascade *)
+                                        ELSIF SymTab.ClassOf(t) #
+                                           SymTab.ClArray THEN
+                                          SemError(217);
+                                          t := SymTab.InvalidType;
+                                          k := -1; pn := -1
+                                        ELSIF (it2 #
+                                           SymTab.InvalidType)
+                                           & ~SymTab.IsIntFamily(
+                                              it2) THEN
+                                          SemError(218)
+                                        ELSE t := SymTab.ArrayElem(
+                                            t) END; .) }
+        "]"
+      | "^"                           (. IF t = SymTab.InvalidType THEN
+                                          (* cascade *)
+                                        ELSIF SymTab.ClassOf(t) #
+                                           SymTab.ClPtr THEN
+                                          SemError(219);
+                                          t := SymTab.InvalidType;
+                                          k := -1; pn := -1
+                                        ELSE t := SymTab.PtrBase(t);
+                                          pn := -1
+                                        END; .) } .
+  ActParams<VAR n: CARDINAL>          (. VAR at: SymTab.TypeIndex;
+                                           av: BOOLEAN; .)
+    = "("                             (. n := 0; .)
+      [ Expr<at, av>                  (. IF ~SymTab.CallActual(at,
+                                           av) THEN
+                                         SemError(233) END;
+                                        n := 1; .)
+        { "," Expr<at, av>            (. IF ~SymTab.CallActual(at,
+                                           av) THEN
+                                         SemError(233) END;
+                                        INC(n); .) } ]
       ")" .
-  IfStat
+  IfStat                              (. VAR t: SymTab.TypeIndex;
+                                           vD: BOOLEAN; .)
     = "IF"
-      Expr
+      Expr<t, vD>                     (. IF ~SymTab.BoolCheck(t) THEN
+                                         SemError(214) END; .)
       "THEN"
       StatSeq
       { "ELSIF"
-        Expr
+        Expr<t, vD>                   (. IF ~SymTab.BoolCheck(t) THEN
+                                         SemError(214) END; .)
         "THEN"
         StatSeq }
       [ "ELSE"
         StatSeq ]
       "END" .
-  WhileStat
+  WhileStat                           (. VAR t: SymTab.TypeIndex;
+                                           vD: BOOLEAN; .)
     = "WHILE"
-      Expr
+      Expr<t, vD>                     (. IF ~SymTab.BoolCheck(t) THEN
+                                         SemError(214) END; .)
       "DO"
       StatSeq
       "END" .
-  RepeatStat
+  RepeatStat                          (. VAR t: SymTab.TypeIndex;
+                                           vD: BOOLEAN; .)
     = "REPEAT"
       StatSeq
       "UNTIL"
-      Expr .
+      Expr<t, vD>                     (. IF ~SymTab.BoolCheck(t) THEN
+                                         SemError(214) END; .) .
   LoopStat
-    = "LOOP"
+    = "LOOP"                          (. SymTab.LoopEnter; .)
       StatSeq
-      "END" .
-  ForStat
+      "END"                           (. SymTab.LoopExit; .) .
+  ForStat                             (. VAR n: SymTab.Name;
+                                           lo, hi, by: SymTab.TypeIndex;
+                                           lv, lv2, lv3: BOOLEAN; .)
     = "FOR"
-      ident
+      GetIdent<n>                     (. IF ~SymTab.Lookup(n) THEN
+                                          SemError(201)
+                                        ELSIF (SymTab.SymKind(n) #
+                                               SymTab.KindVar)
+                                           & (SymTab.SymKind(n) #
+                                              SymTab.KindParam)
+                                           & (SymTab.SymKind(n) #
+                                              SymTab.KindVarPar)
+                                           & (SymTab.SymKind(n) #
+                                              SymTab.KindField) THEN
+                                          SemError(220)
+                                        ELSIF (SymTab.SymType(n) #
+                                               SymTab.InvalidType)
+                                           & ~SymTab.IsIntFamily(
+                                              SymTab.SymType(n)) THEN
+                                          SemError(220) END; .)
       ":="
-      Expr
+      Expr<lo, lv>                    (. IF (lo # SymTab.InvalidType)
+                                         & ~SymTab.IsIntFamily(lo) THEN
+                                         SemError(220) END; .)
       "TO"
-      Expr
+      Expr<hi, lv2>                   (. IF (hi # SymTab.InvalidType)
+                                         & ~SymTab.IsIntFamily(hi) THEN
+                                         SemError(220) END; .)
       [ "BY"
-        Expr ]
+        Expr<by, lv3>                 (. IF (by # SymTab.InvalidType)
+                                         & ~SymTab.IsIntFamily(by) THEN
+                                         SemError(220) END; .) ]
       "DO"
       StatSeq
       "END" .
-  ReturnStat
-    = "RETURN"
-      [ Expr ] .
-  Expr
-    = SimpleExpr
-      [ Relation SimpleExpr ] .
-  Relation
-    = "=" | "#" | "<>" | "<" | "<=" | ">" | ">=" | "IN" .
-  SimpleExpr
-    = [ "+" ]                         (* Kowarsch 3.3: unary '+' takes a Term,
-                                         unary '-' takes a Factor, so -a*b+c
-                                         needs parens: (-a)*b+c or -(a*b+c) *)
-      Term
-      { AddOp Term }
-    | "-"
-      Factor
-      { AddOp Term } .
-  AddOp
-    = "+" | "-" | "OR" .
-  Term
-    = Factor
-      { MulOp Factor } .
-  MulOp
-    = "*" | "/" | "DIV" | "MOD" | "AND" .
-  Factor
-    = integer
-    | real
-    | string
-    | Designator
-      [ ActParams ]
-    | "(" Expr ")"
-    | "NOT" Factor .
+  ReturnStat                          (. VAR et: SymTab.TypeIndex;
+                                           ev, hasE: BOOLEAN; .)
+    =                                 (. hasE := FALSE; .)
+      "RETURN"
+      [ Expr<et, ev>                  (. hasE := TRUE; .) ]
+      (. IF ~SymTab.InProc() THEN SemError(232)
+         ELSIF SymTab.InFunction() & ~hasE THEN SemError(232)
+         ELSIF ~SymTab.InFunction() & hasE THEN
+           SemError(232) END; .) .
+  Expr<VAR t: SymTab.TypeIndex; VAR v: BOOLEAN>
+                                      (. VAR t2: SymTab.TypeIndex;
+                                           v2: BOOLEAN;
+                                           op: INTEGER; .)
+    = SimExpr<t, v>
+      [ Relation<op> SimExpr<t2, v2>
+        (. v := FALSE;
+           IF op = SymTab.OpIn THEN
+             IF SymTab.InCheck(t, t2) THEN
+               t := SymTab.BoolType()
+             ELSE SemError(222); t := SymTab.InvalidType END
+           ELSE
+             IF SymTab.RelCheck(t, t2, op) THEN
+               t := SymTab.BoolType()
+             ELSE SemError(213); t := SymTab.InvalidType END
+           END; .) ] .
+  Relation<VAR op: INTEGER>
+    = "="                             (. op := SymTab.OpEq; .)
+    | "#"                             (. op := SymTab.OpNeq1; .)
+    | "<>"                            (. op := SymTab.OpNeq2; .)
+    | "<"                             (. op := SymTab.OpLt; .)
+    | "<="                            (. op := SymTab.OpLe; .)
+    | ">"                             (. op := SymTab.OpGt; .)
+    | ">="                            (. op := SymTab.OpGe; .)
+    | "IN"                            (. op := SymTab.OpIn; .) .
+  SimExpr<VAR t: SymTab.TypeIndex; VAR v: BOOLEAN>
+                                      (. VAR t2, res2: SymTab.TypeIndex;
+                                           v2: BOOLEAN;
+                                           op: INTEGER; .)
+    = ( "+" Term<t, v>                (. IF ~SymTab.UnaryCheck(t,
+                                           res2) THEN
+                                         SemError(211);
+                                         t := SymTab.InvalidType
+                                       ELSE t := res2 END;
+                                        v := FALSE; .)
+      | "-" Fact<t, v>                (. IF ~SymTab.UnaryCheck(t,
+                                           res2) THEN
+                                         SemError(211);
+                                         t := SymTab.InvalidType
+                                       ELSE t := res2 END;
+                                        v := FALSE; .)
+      | Term<t, v> )
+      { AddOp<op> Term<t2, v2>
+        (. v := FALSE;
+           IF op = SymTab.OpOr THEN
+             IF SymTab.BoolCheck(t) & SymTab.BoolCheck(t2) THEN
+               t := SymTab.BoolType()
+             ELSE SemError(212); t := SymTab.InvalidType END
+           ELSE
+             IF SymTab.ArithCheck(t, t2, FALSE, res2) THEN
+               t := res2
+             ELSE SemError(211); t := SymTab.InvalidType END
+           END; .) } .
+  AddOp<VAR op: INTEGER>
+    = "+"                             (. op := SymTab.OpAdd; .)
+    | "-"                             (. op := SymTab.OpSub; .)
+    | "OR"                            (. op := SymTab.OpOr; .) .
+  Term<VAR t: SymTab.TypeIndex; VAR v: BOOLEAN>
+                                      (. VAR t2, res2: SymTab.TypeIndex;
+                                           v2: BOOLEAN;
+                                           op: INTEGER; .)
+    = Fact<t, v>
+      { MulOp<op> Fact<t2, v2>
+        (. v := FALSE;
+           IF op = SymTab.OpAnd THEN
+             IF SymTab.BoolCheck(t) & SymTab.BoolCheck(t2) THEN
+               t := SymTab.BoolType()
+             ELSE SemError(212); t := SymTab.InvalidType END
+           ELSE
+             IF SymTab.ArithCheck(t, t2,
+                  (op = SymTab.OpDiv) OR (op = SymTab.OpMod),
+                  res2) THEN t := res2
+             ELSE SemError(211); t := SymTab.InvalidType END
+           END; .) } .
+  MulOp<VAR op: INTEGER>
+    = "*"                             (. op := SymTab.OpTimes; .)
+    | "/"                             (. op := SymTab.OpSlash; .)
+    | "DIV"                           (. op := SymTab.OpDiv; .)
+    | "MOD"                           (. op := SymTab.OpMod; .)
+    | "AND"                           (. op := SymTab.OpAnd; .) .
+  Fact<VAR t: SymTab.TypeIndex; VAR v: BOOLEAN>
+                                      (. VAR s: ARRAY [0 .. 255] OF CHAR;
+                                           t2, et, dt: SymTab.TypeIndex;
+                                           dk, pn: INTEGER;
+                                           nn: CARDINAL;
+                                           hadP, ce, pushed: BOOLEAN;
+                                           ev, v2: BOOLEAN; .)
+    = integer                         (. LexString(s);
+                                        t := SymTab.IntType();
+                                        v := FALSE; .)
+    | real                            (. LexString(s);
+                                        t := SymTab.RealType();
+                                        v := FALSE; .)
+    | string                          (. LexString(s);
+                                        IF SymTab.StrLen(s) <= 3 THEN
+                                          t := SymTab.CharType()
+                                        ELSE t := SymTab.NewStr()
+                                        END;
+                                        v := FALSE; .)
+    | Designator<dt, dk, pn>          (. hadP := FALSE; nn := 0;
+                                        IF dk = SymTab.KindProc THEN
+                                          SymTab.CallBeginNum(pn);
+                                          pushed := TRUE
+                                        ELSE pushed := FALSE
+                                        END; .)
+      [                               (. IF ~pushed THEN
+                                          SymTab.CallBeginNum(-1);
+                                          pushed := TRUE
+                                        END; .)
+        ActParams<nn>                 (. hadP := TRUE; .) ]
+                                      (. IF pushed THEN
+                                          ce := SymTab.CallEndNum(nn)
+                                        END;
+                                        IF hadP THEN
+                                          v := FALSE;
+                                          IF dk # SymTab.KindProc THEN
+                                            SemError(233);
+                                            t := SymTab.InvalidType
+                                          ELSIF SymTab.ProcRetByNum(
+                                             pn) =
+                                             SymTab.InvalidType THEN
+                                            SemError(233);
+                                            t := SymTab.InvalidType
+                                          ELSIF ~ce THEN
+                                            SemError(233);
+                                            t := SymTab.InvalidType
+                                          ELSE t :=
+                                            SymTab.ProcRetByNum(pn)
+                                          END
+                                        ELSE
+                                          IF dk = SymTab.KindProc THEN
+                                            SemError(233);
+                                            t := SymTab.InvalidType;
+                                            v := FALSE
+                                          ELSE
+                                            t := dt;
+                                            v := (dt #
+                                              SymTab.InvalidType)
+                                              & ((dk =
+                                                 SymTab.KindVar)
+                                              OR (dk =
+                                                 SymTab.KindParam)
+                                              OR (dk =
+                                                 SymTab.KindVarPar)
+                                              OR (dk =
+                                                 SymTab.KindField))
+                                          END
+                                        END; .)
+    | "(" Expr<et, ev> ")"            (. t := et; v := FALSE; .)
+    | "NOT" Fact<t2, v2>              (. IF SymTab.BoolCheck(t2) THEN
+                                         t := SymTab.BoolType()
+                                       ELSE SemError(212);
+                                         t := SymTab.InvalidType END;
+                                        v := FALSE; .) .
 END M2comp.

+ 21 - 21
src/M2comp.err

@@ -12,24 +12,24 @@
 | 11: Msg("'BEGIN' expected")
 | 12: Msg("'END' expected")
 | 13: Msg("'CONST' expected")
-| 14: Msg("'=' expected")
-| 15: Msg("'TYPE' expected")
-| 16: Msg("'VAR' expected")
+| 14: Msg("'TYPE' expected")
+| 15: Msg("'VAR' expected")
+| 16: Msg("'=' expected")
 | 17: Msg("':' expected")
-| 18: Msg("'[' expected")
-| 19: Msg("']' expected")
-| 20: Msg("'EXPORT' expected")
-| 21: Msg("'QUALIFIED' expected")
-| 22: Msg("'PROCEDURE' expected")
-| 23: Msg("'(' expected")
-| 24: Msg("')' expected")
-| 25: Msg("'..' expected")
-| 26: Msg("'ARRAY' expected")
-| 27: Msg("'OF' expected")
-| 28: Msg("'RECORD' expected")
-| 29: Msg("'SET' expected")
-| 30: Msg("'POINTER' expected")
-| 31: Msg("'TO' expected")
+| 18: Msg("'PROCEDURE' expected")
+| 19: Msg("'(' expected")
+| 20: Msg("')' expected")
+| 21: Msg("'[' expected")
+| 22: Msg("']' expected")
+| 23: Msg("'EXPORT' expected")
+| 24: Msg("'QUALIFIED' expected")
+| 25: Msg("'ARRAY' expected")
+| 26: Msg("'OF' expected")
+| 27: Msg("'RECORD' expected")
+| 28: Msg("'SET' expected")
+| 29: Msg("'POINTER' expected")
+| 30: Msg("'TO' expected")
+| 31: Msg("'..' expected")
 | 32: Msg("'EXIT' expected")
 | 33: Msg("':=' expected")
 | 34: Msg("'^' expected")
@@ -63,11 +63,11 @@
 | 62: Msg("'NOT' expected")
 | 63: Msg("not expected")
 | 64: Msg("invalid MulOp")
-| 65: Msg("invalid Factor")
-| 66: Msg("invalid AddOp")
+| 65: Msg("invalid AddOp")
+| 66: Msg("invalid Fact")
 | 67: Msg("invalid Relation")
-| 68: Msg("invalid SimpleExpr")
+| 68: Msg("invalid SimExpr")
 | 69: Msg("invalid AssignOrCall")
-| 70: Msg("invalid IndexType")
+| 70: Msg("invalid BoundedBase")
 | 71: Msg("invalid Type")
 | 72: Msg("invalid Declaration")

+ 3 - 3
src/M2comp.lst

@@ -18,10 +18,10 @@ LL(1) conditions:         --  ok  --
 Statistics:
 
   nr of terminals:        64 (limit   400)
-  nr of non-terminals:    36 (limit   210)
+  nr of non-terminals:    45 (limit   210)
   nr of pragmas:           0 (limit   436)
-  nr of symbolnodes:     100 (limit   500)
-  nr of graphnodes:      317 (limit  1500)
+  nr of symbolnodes:     109 (limit   500)
+  nr of graphnodes:      423 (limit  1500)
   nr of conditionsets:     6 (limit   100)
   nr of charactersets:     9 (limit   250)
 

+ 21 - 21
src/M2comp.mod

@@ -109,24 +109,24 @@ MODULE M2comp;
         | 11: Msg("'BEGIN' expected")
         | 12: Msg("'END' expected")
         | 13: Msg("'CONST' expected")
-        | 14: Msg("'=' expected")
-        | 15: Msg("'TYPE' expected")
-        | 16: Msg("'VAR' expected")
+        | 14: Msg("'TYPE' expected")
+        | 15: Msg("'VAR' expected")
+        | 16: Msg("'=' expected")
         | 17: Msg("':' expected")
-        | 18: Msg("'[' expected")
-        | 19: Msg("']' expected")
-        | 20: Msg("'EXPORT' expected")
-        | 21: Msg("'QUALIFIED' expected")
-        | 22: Msg("'PROCEDURE' expected")
-        | 23: Msg("'(' expected")
-        | 24: Msg("')' expected")
-        | 25: Msg("'..' expected")
-        | 26: Msg("'ARRAY' expected")
-        | 27: Msg("'OF' expected")
-        | 28: Msg("'RECORD' expected")
-        | 29: Msg("'SET' expected")
-        | 30: Msg("'POINTER' expected")
-        | 31: Msg("'TO' expected")
+        | 18: Msg("'PROCEDURE' expected")
+        | 19: Msg("'(' expected")
+        | 20: Msg("')' expected")
+        | 21: Msg("'[' expected")
+        | 22: Msg("']' expected")
+        | 23: Msg("'EXPORT' expected")
+        | 24: Msg("'QUALIFIED' expected")
+        | 25: Msg("'ARRAY' expected")
+        | 26: Msg("'OF' expected")
+        | 27: Msg("'RECORD' expected")
+        | 28: Msg("'SET' expected")
+        | 29: Msg("'POINTER' expected")
+        | 30: Msg("'TO' expected")
+        | 31: Msg("'..' expected")
         | 32: Msg("'EXIT' expected")
         | 33: Msg("':=' expected")
         | 34: Msg("'^' expected")
@@ -160,12 +160,12 @@ MODULE M2comp;
         | 62: Msg("'NOT' expected")
         | 63: Msg("not expected")
         | 64: Msg("invalid MulOp")
-        | 65: Msg("invalid Factor")
-        | 66: Msg("invalid AddOp")
+        | 65: Msg("invalid AddOp")
+        | 66: Msg("invalid Fact")
         | 67: Msg("invalid Relation")
-        | 68: Msg("invalid SimpleExpr")
+        | 68: Msg("invalid SimExpr")
         | 69: Msg("invalid AssignOrCall")
-        | 70: Msg("invalid IndexType")
+        | 70: Msg("invalid BoundedBase")
         | 71: Msg("invalid Type")
         | 72: Msg("invalid Declaration")
         


Разлика између датотеке није приказан због своје велике величине
+ 792 - 187
src/M2compP.mod



+ 20 - 20
src/M2compS.mod

@@ -103,7 +103,7 @@ PROCEDURE Get (VAR sym: CARDINAL);
     BEGIN
       CASE CurrentCh(bp0) OF
         "A": IF Equal("AND") THEN sym := 61; 
-             ELSIF Equal("ARRAY") THEN sym := 26; 
+             ELSIF Equal("ARRAY") THEN sym := 25; 
              END
       | "B": IF Equal("BEGIN") THEN sym := 11; 
              ELSIF Equal("BY") THEN sym := 45; 
@@ -117,7 +117,7 @@ PROCEDURE Get (VAR sym: CARDINAL);
              ELSIF Equal("ELSIF") THEN sym := 37; 
              ELSIF Equal("END") THEN sym := 12; 
              ELSIF Equal("EXIT") THEN sym := 32; 
-             ELSIF Equal("EXPORT") THEN sym := 20; 
+             ELSIF Equal("EXPORT") THEN sym := 23; 
              END
       | "F": IF Equal("FOR") THEN sym := 44; 
              ELSIF Equal("FROM") THEN sym := 8; 
@@ -133,27 +133,27 @@ PROCEDURE Get (VAR sym: CARDINAL);
              END
       | "N": IF Equal("NOT") THEN sym := 62; 
              END
-      | "O": IF Equal("OF") THEN sym := 27; 
+      | "O": IF Equal("OF") THEN sym := 26; 
              ELSIF Equal("OR") THEN sym := 56; 
              END
-      | "P": IF Equal("POINTER") THEN sym := 30; 
-             ELSIF Equal("PROCEDURE") THEN sym := 22; 
+      | "P": IF Equal("POINTER") THEN sym := 29; 
+             ELSIF Equal("PROCEDURE") THEN sym := 18; 
              END
-      | "Q": IF Equal("QUALIFIED") THEN sym := 21; 
+      | "Q": IF Equal("QUALIFIED") THEN sym := 24; 
              END
-      | "R": IF Equal("RECORD") THEN sym := 28; 
+      | "R": IF Equal("RECORD") THEN sym := 27; 
              ELSIF Equal("REPEAT") THEN sym := 41; 
              ELSIF Equal("RETURN") THEN sym := 46; 
              END
-      | "S": IF Equal("SET") THEN sym := 29; 
+      | "S": IF Equal("SET") THEN sym := 28; 
              END
       | "T": IF Equal("THEN") THEN sym := 36; 
-             ELSIF Equal("TO") THEN sym := 31; 
-             ELSIF Equal("TYPE") THEN sym := 15; 
+             ELSIF Equal("TO") THEN sym := 30; 
+             ELSIF Equal("TYPE") THEN sym := 14; 
              END
       | "U": IF Equal("UNTIL") THEN sym := 42; 
              END
-      | "V": IF Equal("VAR") THEN sym := 16; 
+      | "V": IF Equal("VAR") THEN sym := 15; 
              END
       | "W": IF Equal("WHILE") THEN sym := 39; 
              END
@@ -229,15 +229,15 @@ PROCEDURE Get (VAR sym: CARDINAL);
             END;
       | 15: sym := 7; RETURN
       | 16: sym := 10; RETURN
-      | 17: sym := 14; RETURN
+      | 17: sym := 16; RETURN
       | 18: IF (ch = "=") THEN state := 24; 
             ELSE sym := 17; RETURN
             END;
-      | 19: sym := 18; RETURN
-      | 20: sym := 19; RETURN
-      | 21: sym := 23; RETURN
-      | 22: sym := 24; RETURN
-      | 23: sym := 25; RETURN
+      | 19: sym := 19; RETURN
+      | 20: sym := 20; RETURN
+      | 21: sym := 21; RETURN
+      | 22: sym := 22; RETURN
+      | 23: sym := 31; RETURN
       | 24: sym := 33; RETURN
       | 25: sym := 34; RETURN
       | 26: sym := 47; RETURN
@@ -333,7 +333,7 @@ BEGIN
   start[ 28] := 37; start[ 29] := 37; start[ 30] := 37; start[ 31] := 37; 
   start[ 32] := 37; start[ 33] := 37; start[ 34] := 10; start[ 35] := 26; 
   start[ 36] := 37; start[ 37] := 37; start[ 38] := 37; start[ 39] :=  9; 
-  start[ 40] := 21; start[ 41] := 22; start[ 42] := 34; start[ 43] := 32; 
+  start[ 40] := 19; start[ 41] := 20; start[ 42] := 34; start[ 43] := 32; 
   start[ 44] := 16; start[ 45] := 33; start[ 46] := 14; start[ 47] := 35; 
   start[ 48] := 12; start[ 49] := 12; start[ 50] := 12; start[ 51] := 12; 
   start[ 52] := 12; start[ 53] := 12; start[ 54] := 12; start[ 55] := 12; 
@@ -345,8 +345,8 @@ BEGIN
   start[ 76] :=  1; start[ 77] :=  1; start[ 78] :=  1; start[ 79] :=  1; 
   start[ 80] :=  1; start[ 81] :=  1; start[ 82] :=  1; start[ 83] :=  1; 
   start[ 84] :=  1; start[ 85] :=  1; start[ 86] :=  1; start[ 87] :=  1; 
-  start[ 88] :=  1; start[ 89] :=  1; start[ 90] :=  1; start[ 91] := 19; 
-  start[ 92] := 37; start[ 93] := 20; start[ 94] := 25; start[ 95] := 37; 
+  start[ 88] :=  1; start[ 89] :=  1; start[ 90] :=  1; start[ 91] := 21; 
+  start[ 92] := 37; start[ 93] := 22; start[ 94] := 25; start[ 95] := 37; 
   start[ 96] := 37; start[ 97] :=  1; start[ 98] :=  1; start[ 99] :=  1; 
   start[100] :=  1; start[101] :=  1; start[102] :=  1; start[103] :=  1; 
   start[104] :=  1; start[105] :=  1; start[106] :=  1; start[107] :=  1; 


+ 312 - 0
src/SymTab.def

@@ -0,0 +1,312 @@
+DEFINITION MODULE SymTab;
+(* Symbol table with static type checking for the M2comp compiler
+   (Modula-2 program modules, step 2: semantic analysis, no codegen).
+
+   Base: Test1 SimpleMod2 table (flat scopes with levels, type
+   descriptors with aliases, integer-family leniency, InvalidType
+   cascade suppression). Extensions for step 2:
+   - procedures: nested, value/VAR params, function results; signatures
+     persist in procs[] after body scopes pop (no FORWARD headings)
+   - local modules (Wirth form): body scope + export table for M.x
+   - call checking with an 8-deep frame stack (nested calls safe);
+     invalid callees get a dead frame to suppress cascades
+   - open arrays (formal-only) + WrapArray/IsOpen helpers
+   - loop-depth tracking for EXIT validation (230)
+
+   Error codes follow m2c/Test1: 200 duplicate, 201 undeclared,
+   202 name mismatch, 210 bad assignment, 211 arithmetic, 212 boolean
+   operand, 213 comparison, 214 condition, 215 not a record,
+   216 unknown field, 217 not an array, 218 bad index, 219 not a
+   pointer, 220 FOR misuse, 221 not a type, 222 set mismatch,
+   223 cyclical type, 224 ordinal required, 230 unsupported construct
+   (EXIT outside LOOP, open array outside formal), 232 bad RETURN,
+   233 invalid call. 231 (forward mismatch) unused: no FORWARD.
+
+   - flat scopes with levels: globals at level 0 (duplicates within
+     one level rejected, shadowing allowed in nested scopes)
+   - every symbol carries a type descriptor index (InvalidType if
+     unknown, e.g. imported names); unknown types suppress follow-on
+     errors to avoid cascades *)
+
+CONST
+  MaxSyms = 256;
+  InvalidType = -1;
+
+  (* symbol kinds *)
+  KindConst  = 0;
+  KindType   = 1;
+  KindVar    = 2;
+  KindImport = 3;
+  KindModule = 4;
+  KindPredef = 5;
+  KindField  = 6;
+  KindProc   = 7;
+  KindParam  = 8;
+  KindVarPar = 9;
+
+  (* type classes returned by ClassOf *)
+  ClInvalid = 0;
+  ClInt     = 1;
+  ClReal    = 2;
+  ClChar    = 3;
+  ClBool    = 4;
+  ClEnum    = 5;
+  ClArray   = 6;
+  ClRecord  = 7;
+  ClSet     = 8;
+  ClPtr     = 9;
+  ClStr     = 10;
+
+  (* operator codes for RelCheck *)
+  OpEq = 0; OpNeq1 = 1; OpNeq2 = 2;
+  OpLt = 3; OpLe  = 4; OpGt   = 5; OpGe = 6;
+  OpIn = 7;
+  (* operator codes for AddOp / MulOp *)
+  OpAdd = 0; OpSub = 1; OpOr = 2;
+  OpTimes = 0; OpSlash = 1; OpDiv = 2; OpMod = 3; OpAnd = 4;
+
+TYPE
+  Name = ARRAY [0 .. 63] OF CHAR;
+  TypeIndex = INTEGER;
+
+(* ---------------- symbols and scopes ---------------- *)
+
+PROCEDURE Init;
+(* Clears the table and enters predefined identifiers
+   (INTEGER, CARDINAL, SHORTINT, LONGINT, REAL, LONGREAL, CHAR,
+   BOOLEAN, TRUE, FALSE, NIL). *)
+
+PROCEDURE Enter (name: ARRAY OF CHAR; kind: INTEGER): BOOLEAN;
+(* Enters name at the current scope level (type InvalidType).
+   Returns FALSE on duplicate within the same level. *)
+
+PROCEDURE EnterPending (name: ARRAY OF CHAR; kind: INTEGER): BOOLEAN;
+(* Like Enter, but remembers the entry for a later FixPending call
+   (used for VAR identifier lists whose type is parsed afterwards).
+   Returns FALSE on duplicate (entry not recorded). *)
+
+PROCEDURE FixPending (t: TypeIndex);
+(* Assigns type t to all pending entries, clears the buffer. *)
+
+PROCEDURE FieldPending (rec: TypeIndex; name: ARRAY OF CHAR): BOOLEAN;
+(* Records a field name for record descriptor rec (type fixed later
+   with FixPendingF). Returns FALSE on duplicate field. *)
+
+PROCEDURE FixPendingF (rec: TypeIndex; t: TypeIndex);
+(* Assigns type t to pending fields owned by rec. *)
+
+PROCEDURE Lookup (name: ARRAY OF CHAR): BOOLEAN;
+(* TRUE if name is visible (innermost scope wins). *)
+
+PROCEDURE SymType (name: ARRAY OF CHAR): TypeIndex;
+(* Type of innermost visible entry, InvalidType if absent. *)
+
+PROCEDURE SetSymType (name: ARRAY OF CHAR; t: TypeIndex);
+(* Sets type of innermost visible entry. *)
+
+PROCEDURE SymKind (name: ARRAY OF CHAR): INTEGER;
+(* Kind of innermost visible entry, -1 if absent. *)
+
+PROCEDURE Equal (a, b: ARRAY OF CHAR): BOOLEAN;
+
+PROCEDURE PushScope;
+PROCEDURE PopScope;
+(* WITH statement support: PushRecord pushes a record's fields. *)
+
+PROCEDURE PushRecord (t: TypeIndex): BOOLEAN;
+(* Pushes a scope containing t's fields (as KindField). FALSE if t
+   is not a record type (or invalid). Caller must PopScope after.
+   Kept for a future WITH statement; unused by the step-2 grammar. *)
+
+PROCEDURE PrintTable;
+
+(* ---------------- procedures ---------------- *)
+(* Signatures live in procs[]/params[] keyed by a per-procedure number
+   stored on the symbol, so they survive PopScope (nested and exported
+   procedures stay callable). No FORWARD headings in step 2. *)
+
+PROCEDURE EnterProc (name: ARRAY OF CHAR): BOOLEAN;
+(* Enters a KindProc name in the current scope, assigns the next proc
+   number with an empty signature. FALSE on duplicate or table full.
+   Sets the current-proc context for EnterParamPending calls. *)
+
+PROCEDURE OpenProcScope;
+(* Pushes a body scope for the current procedure (depth + 1, fresh
+   return-type context). *)
+
+PROCEDURE CloseProc;
+(* Pops the procedure body scope, restores the enclosing context. *)
+
+PROCEDURE EnterParamPending (name: ARRAY OF CHAR; isVar: BOOLEAN): BOOLEAN;
+(* Like EnterPending for FPSection identifier lists whose type is
+   parsed afterwards. FALSE on duplicate (not recorded). *)
+
+PROCEDURE FixParamPending (t: TypeIndex): BOOLEAN;
+(* Enters all pending parameters of the current procedure with type t
+   (KindParam or KindVarPar), appends them to its signature. FALSE if
+   any entry failed (duplicate or table full). *)
+
+PROCEDURE SetProcRet (t: TypeIndex);
+(* Sets the return type of the current procedure (InvalidType =
+   proper procedure) and of the current return-type context. *)
+
+PROCEDURE ProcNum (name: ARRAY OF CHAR): INTEGER;
+(* Proc number of the visible procedure, or -1 if absent / not one. *)
+
+PROCEDURE ProcRet (name: ARRAY OF CHAR): TypeIndex;
+PROCEDURE ProcNPar (name: ARRAY OF CHAR): CARDINAL;
+PROCEDURE ParamType (name: ARRAY OF CHAR; i: CARDINAL): TypeIndex;
+PROCEDURE ParamIsVar (name: ARRAY OF CHAR; i: CARDINAL): BOOLEAN;
+(* Signature queries by name (InvalidType/0/FALSE if absent). *)
+
+PROCEDURE ProcRetByNum (num: INTEGER): TypeIndex;
+PROCEDURE ProcNParByNum (num: INTEGER): CARDINAL;
+PROCEDURE ParamTypeByNum (num: INTEGER; i: CARDINAL): TypeIndex;
+PROCEDURE ParamIsVarByNum (num: INTEGER; i: CARDINAL): BOOLEAN;
+(* Same queries keyed by procedure number (exported module procs). *)
+
+PROCEDURE InProc (): BOOLEAN;
+(* TRUE inside a procedure body. *)
+
+PROCEDURE InFunction (): BOOLEAN;
+(* TRUE inside a function (non-InvalidType return) body. *)
+
+PROCEDURE CurRet (): TypeIndex;
+(* Current return type (InvalidType = proper procedure or outside). *)
+
+(* ---------------- local modules (Wirth form) ---------------- *)
+(* Local MODULEs nest at any level. EXPORT names resolve at END into
+   the export table keyed by (module, name); M.x qualified access
+   consults it, or the live body scope from inside M itself. *)
+
+PROCEDURE EnterModule (name: ARRAY OF CHAR): BOOLEAN;
+(* Enters KindModule + pushes the body scope + module context.
+   FALSE on duplicate. *)
+
+PROCEDURE ModuleAddExp (name: ARRAY OF CHAR): BOOLEAN;
+(* Records an export name for the current module. FALSE if not in a
+   module, on duplicate, or when the export list is full. *)
+
+PROCEDURE ExitModule (): BOOLEAN;
+(* Resolves exports against the body scope into the export table,
+   pops scope + context. FALSE when an EXPORT name was not declared
+   (ghost export). *)
+
+PROCEDURE InModule (): BOOLEAN;
+(* TRUE inside a local MODULE body (including its procedures). *)
+
+PROCEDURE CurModName (VAR m: Name);
+(* Innermost module name, empty if none. *)
+
+PROCEDURE ExpKind (mod, exp: ARRAY OF CHAR): INTEGER;
+(* Exported kind, -1 if absent. *)
+
+PROCEDURE ExpType (mod, exp: ARRAY OF CHAR): TypeIndex;
+(* Exported type (InvalidType if absent / not a typed export). *)
+
+PROCEDURE ExpProc (mod, exp: ARRAY OF CHAR): INTEGER;
+(* Exported proc number, -1 if absent / not a procedure. *)
+
+PROCEDURE SelfKind (mod, exp: ARRAY OF CHAR): INTEGER;
+(* Kind of exp as M.exp from inside M itself (live body scope at
+   body level, since exports resolve only at END). -1 if absent. *)
+
+PROCEDURE SelfType (mod, exp: ARRAY OF CHAR): TypeIndex;
+(* Type of an M.exp self reference (InvalidType if absent). *)
+
+PROCEDURE SelfProc (mod, exp: ARRAY OF CHAR): INTEGER;
+(* Proc number of an M.exp self reference (-1 if absent). *)
+
+(* ---------------- call checking ---------------- *)
+(* An 8-deep frame stack keeps nested calls (f(g(x))) safe. A dead
+   frame (proc -1) accepts everything: the grammar pushes one for
+   invalid callees so actuals parse without cascade errors. *)
+
+PROCEDURE CallBeginNum (num: INTEGER);
+(* Opens a call frame for procedure num (-1 = dead frame). *)
+
+PROCEDURE CallActual (t: TypeIndex; isVar: BOOLEAN): BOOLEAN;
+(* Checks one actual against the current formal (VAR formals need a
+   storable designator of identical type, value formals need
+   assignment compatibility) and advances. FALSE on mismatch. *)
+
+PROCEDURE CallEndNum (n: CARDINAL): BOOLEAN;
+(* Closes the frame; FALSE on arity mismatch (n # formals). *)
+
+(* ---------------- loops ---------------- *)
+
+PROCEDURE LoopEnter;
+PROCEDURE LoopExit;
+PROCEDURE InLoop (): BOOLEAN;
+(* Innermost LOOP tracking for EXIT validation (error 230). *)
+
+(* ---------------- type descriptors ---------------- *)
+
+PROCEDURE NewAlias (): TypeIndex;
+PROCEDURE NewSub (base: TypeIndex): TypeIndex;
+PROCEDURE NewEnum (): TypeIndex;
+PROCEDURE NewArray (elem: TypeIndex): TypeIndex;
+PROCEDURE NewOpen (elem: TypeIndex): TypeIndex;
+PROCEDURE WrapArray (elem: TypeIndex; dims: CARDINAL): TypeIndex;
+(* WrapArray nests elem in dims ARRAY levels (dims = 0 gives an open
+   array). Open arrays are formal-only (grammar reports 230). *)
+PROCEDURE IsOpen (t: TypeIndex): BOOLEAN;
+PROCEDURE NewRecord (): TypeIndex;
+PROCEDURE NewSet (base: TypeIndex): TypeIndex;
+PROCEDURE NewPtr (base: TypeIndex): TypeIndex;
+PROCEDURE NewStr (): TypeIndex;
+(* Fresh descriptors; base/elem may be InvalidType. InvalidType is
+   returned when the table is full. *)
+
+PROCEDURE SetTarget (t, base: TypeIndex);
+(* Sets an alias target (TYPE declaration completion). *)
+
+PROCEDURE IntType (): TypeIndex;
+PROCEDURE RealType (): TypeIndex;
+PROCEDURE CharType (): TypeIndex;
+PROCEDURE BoolType (): TypeIndex;
+
+PROCEDURE ClassOf (t: TypeIndex): INTEGER;
+(* Resolves aliases; InvalidType maps to ClInvalid. *)
+
+PROCEDURE IsIntFamily (t: TypeIndex): BOOLEAN;
+(* INTEGER, CARDINAL or subrange thereof (Invalid suppresses). *)
+
+PROCEDURE SameType (a, b: TypeIndex): BOOLEAN;
+(* Same resolved descriptor (Invalid suppresses). *)
+
+PROCEDURE FieldExists (rec: TypeIndex; name: ARRAY OF CHAR): BOOLEAN;
+PROCEDURE FieldType (rec: TypeIndex; name: ARRAY OF CHAR): TypeIndex;
+PROCEDURE ArrayElem (t: TypeIndex): TypeIndex;
+PROCEDURE PtrBase (t: TypeIndex): TypeIndex;
+
+(* ---------------- predicates used by grammar checks ---------------- *)
+(* All return TRUE if either operand is InvalidType (no cascades). *)
+
+PROCEDURE Assignable (src, dst: TypeIndex): BOOLEAN;
+(* Assignment compatibility (210). *)
+
+PROCEDURE ArithCheck (l, r: TypeIndex; divmod: BOOLEAN;
+                      VAR res: TypeIndex): BOOLEAN;
+(* + - * / (divmod FALSE) or DIV MOD (TRUE); res is result type (211). *)
+
+PROCEDURE UnaryCheck (t: TypeIndex; VAR res: TypeIndex): BOOLEAN;
+(* Unary + - (part of 211). *)
+
+PROCEDURE BoolCheck (t: TypeIndex): BOOLEAN;
+(* BOOLEAN required: NOT/AND/OR operands (212), conditions (214). *)
+
+PROCEDURE RelCheck (l, r: TypeIndex; op: INTEGER): BOOLEAN;
+(* = # <> < <= > >= IN (213/222 chosen by caller via op). *)
+
+PROCEDURE EqCheck (l, r: TypeIndex): BOOLEAN;
+(* = # compatibility, also reused for CASE label matching. *)
+
+PROCEDURE InCheck (l, set: TypeIndex): BOOLEAN;
+PROCEDURE SetElemCheck (first, elem: TypeIndex): BOOLEAN;
+PROCEDURE SetFor (elem: TypeIndex): TypeIndex;
+(* Fresh SET OF elem descriptor for set literals. *)
+
+PROCEDURE StrLen (s: ARRAY OF CHAR): CARDINAL;
+
+END SymTab.

+ 1104 - 0
src/SymTab.mod

@@ -0,0 +1,1104 @@
+IMPLEMENTATION MODULE SymTab;
+
+IMPORT FileIO;
+
+CONST
+  MaxTypes  = 256;
+  MaxFields = 512;
+  MaxPend   = 64;
+  MaxMarks  = 16;
+  ResDepth  = 64;
+  MaxProcs  = 64;
+  MaxParams = 256;
+  MaxPDepth = 8;
+  MaxPPend  = 16;
+  MaxMods   = 8;
+  MaxModExps = 32;
+  MaxExps   = 128;
+  MaxCallDepth = 8;
+
+  (* descriptor forms *)
+  FNone = 0; FAlias = 1; FSub = 2; FEnum = 3; FArray = 4;
+  FRecord = 5; FSet = 6; FPtr = 7; FStr = 8;
+  FInt = 9; FReal = 10; FChar = 11; FBool = 12;
+  FOpen = 13;
+
+TYPE
+  Symbol = RECORD
+    name : Name;
+    kind : INTEGER;
+    typ  : TypeIndex;
+    lev  : CARDINAL;
+    pnum : INTEGER;   (* proc table index for KindProc, else -1 *)
+  END;
+  Field = RECORD
+    name  : Name;
+    typ   : TypeIndex;
+    owner : TypeIndex;
+    next  : INTEGER;  (* index of next field of same owner, -1 = end *)
+  END;
+  ProcRec = RECORD
+    ret  : TypeIndex;
+    head : INTEGER;   (* first param index, -1 = none *)
+    tail : INTEGER;   (* last param index *)
+  END;
+  ParamRec = RECORD
+    typ   : TypeIndex;
+    isVar : BOOLEAN;
+    next  : INTEGER;
+  END;
+
+VAR
+  syms : ARRAY [0 .. MaxSyms - 1] OF Symbol;
+  nSyms : CARDINAL;
+  curLev : CARDINAL;
+  marks : ARRAY [0 .. MaxMarks - 1] OF CARDINAL;
+  mtop : CARDINAL;
+  pend : ARRAY [0 .. MaxPend - 1] OF CARDINAL;
+  nPend : CARDINAL;
+  pendF : ARRAY [0 .. MaxPend - 1] OF CARDINAL;
+  nPendF : CARDINAL;
+  tform : ARRAY [0 .. MaxTypes - 1] OF INTEGER;
+  tref : ARRAY [0 .. MaxTypes - 1] OF TypeIndex;
+  nTypes : CARDINAL;
+  fields : ARRAY [0 .. MaxFields - 1] OF Field;
+  nFields : CARDINAL;
+  dInt, dCard, dReal, dChar, dBool : TypeIndex;
+  procs : ARRAY [1 .. MaxProcs] OF ProcRec;
+  nProcs : CARDINAL;
+  params : ARRAY [0 .. MaxParams - 1] OF ParamRec;
+  nParams : CARDINAL;
+  curProc : INTEGER;
+  pdep : CARDINAL;
+  procSt : ARRAY [0 .. MaxPDepth] OF INTEGER;
+  retSt : ARRAY [0 .. MaxPDepth] OF TypeIndex;
+  pPendN : ARRAY [0 .. MaxPPend - 1] OF Name;
+  pPendV : ARRAY [0 .. MaxPPend - 1] OF BOOLEAN;
+  nPPend : CARDINAL;
+  modNames : ARRAY [0 .. MaxMods - 1] OF Name;
+  modTop : CARDINAL;
+  modLevs : ARRAY [0 .. MaxMods - 1] OF CARDINAL;
+  modExps : ARRAY [0 .. MaxMods - 1] OF ARRAY [0 .. MaxModExps - 1] OF Name;
+  modNExps : ARRAY [0 .. MaxMods - 1] OF CARDINAL;
+  expMod : ARRAY [0 .. MaxExps - 1] OF Name;
+  expName : ARRAY [0 .. MaxExps - 1] OF Name;
+  expKindA : ARRAY [0 .. MaxExps - 1] OF INTEGER;
+  expTypeA : ARRAY [0 .. MaxExps - 1] OF TypeIndex;
+  expProcA : ARRAY [0 .. MaxExps - 1] OF INTEGER;
+  nExps : CARDINAL;
+  callProc : ARRAY [0 .. MaxCallDepth - 1] OF INTEGER;
+  callIdx : ARRAY [0 .. MaxCallDepth - 1] OF CARDINAL;
+  callErr : ARRAY [0 .. MaxCallDepth - 1] OF BOOLEAN;
+  callTop : CARDINAL;
+  callFull : BOOLEAN;
+  loopDep : CARDINAL;
+
+(* ---------------- strings ---------------- *)
+
+PROCEDURE Assign (VAR dest: ARRAY OF CHAR; src: ARRAY OF CHAR);
+  VAR i : CARDINAL;
+  BEGIN
+    i := 0;
+    WHILE (i < HIGH(dest)) & (src[i] # 0C) DO
+      dest[i] := src[i]; INC(i)
+    END;
+    dest[i] := 0C
+  END Assign;
+
+PROCEDURE Equal (a, b: ARRAY OF CHAR): BOOLEAN;
+  VAR i : CARDINAL;
+  BEGIN
+    i := 0;
+    LOOP
+      IF a[i] # b[i] THEN RETURN FALSE END;
+      IF a[i] = 0C THEN RETURN TRUE END;
+      INC(i)
+    END
+  END Equal;
+
+PROCEDURE StrLen (s: ARRAY OF CHAR): CARDINAL;
+  VAR i : CARDINAL;
+  BEGIN
+    i := 0;
+    WHILE (i < HIGH(s)) & (s[i] # 0C) DO INC(i) END;
+    RETURN i
+  END StrLen;
+
+(* ---------------- symbols and scopes ---------------- *)
+
+PROCEDURE Find (name: ARRAY OF CHAR): INTEGER;
+(* innermost visible index or -1 *)
+  VAR i : CARDINAL;
+  BEGIN
+    i := nSyms;
+    WHILE i > 0 DO
+      DEC(i);
+      IF Equal(syms[i].name, name) THEN RETURN VAL(INTEGER, i) END
+    END;
+    RETURN -1
+  END Find;
+
+PROCEDURE RawEnter (name: ARRAY OF CHAR; kind: INTEGER): INTEGER;
+(* index or -1 when full *)
+  BEGIN
+    IF nSyms >= MaxSyms THEN RETURN -1 END;
+    Assign(syms[nSyms].name, name);
+    syms[nSyms].kind := kind;
+    syms[nSyms].typ := InvalidType;
+    syms[nSyms].lev := curLev;
+    syms[nSyms].pnum := -1;
+    INC(nSyms);
+    RETURN VAL(INTEGER, nSyms - 1)
+  END RawEnter;
+
+PROCEDURE DupInLevel (name: ARRAY OF CHAR): BOOLEAN;
+  VAR i : CARDINAL;
+  BEGIN
+    i := nSyms;
+    WHILE (i > 0) & (syms[i - 1].lev = curLev) DO
+      DEC(i);
+      IF Equal(syms[i].name, name) THEN RETURN TRUE END
+    END;
+    RETURN FALSE
+  END DupInLevel;
+
+PROCEDURE Enter (name: ARRAY OF CHAR; kind: INTEGER): BOOLEAN;
+  BEGIN
+    IF DupInLevel(name) THEN RETURN FALSE END;
+    RETURN RawEnter(name, kind) # -1
+  END Enter;
+
+PROCEDURE EnterPending (name: ARRAY OF CHAR; kind: INTEGER): BOOLEAN;
+  VAR idx : INTEGER;
+  BEGIN
+    IF DupInLevel(name) THEN RETURN FALSE END;
+    idx := RawEnter(name, kind);
+    IF (idx # -1) & (nPend < MaxPend) THEN
+      pend[nPend] := VAL(CARDINAL, idx); INC(nPend)
+    END;
+    RETURN idx # -1
+  END EnterPending;
+
+PROCEDURE FixPending (t: TypeIndex);
+  VAR i : CARDINAL;
+  BEGIN
+    i := 0;
+    WHILE i < nPend DO
+      syms[pend[i]].typ := t; INC(i)
+    END;
+    nPend := 0
+  END FixPending;
+
+PROCEDURE FindField (rec: TypeIndex; name: ARRAY OF CHAR): INTEGER;
+  VAR i : INTEGER;
+  BEGIN
+    IF (rec < 0) OR (rec >= VAL(INTEGER, nTypes)) THEN RETURN -1 END;
+    IF tform[rec] # FRecord THEN RETURN -1 END;
+    i := tref[rec];
+    WHILE i # -1 DO
+      IF Equal(fields[i].name, name) THEN RETURN i END;
+      i := fields[i].next
+    END;
+    RETURN -1
+  END FindField;
+
+PROCEDURE FieldPending (rec: TypeIndex; name: ARRAY OF CHAR): BOOLEAN;
+  BEGIN
+    IF FindField(rec, name) # -1 THEN RETURN FALSE END;
+    IF nFields >= MaxFields THEN RETURN FALSE END;
+    Assign(fields[nFields].name, name);
+    fields[nFields].typ := InvalidType;
+    fields[nFields].owner := rec;
+    fields[nFields].next := tref[rec];
+    tref[rec] := VAL(INTEGER, nFields);
+    IF nPendF < MaxPend THEN
+      pendF[nPendF] := nFields; INC(nPendF)
+    END;
+    INC(nFields);
+    RETURN TRUE
+  END FieldPending;
+
+PROCEDURE FixPendingF (rec: TypeIndex; t: TypeIndex);
+  VAR i, j : CARDINAL;
+  BEGIN
+    i := 0;
+    WHILE i < nPendF DO
+      IF fields[pendF[i]].owner = rec THEN
+        fields[pendF[i]].typ := t;
+        (* remove by swap with last *)
+        j := nPendF - 1;
+        pendF[i] := pendF[j];
+        DEC(nPendF)
+      ELSE
+        INC(i)
+      END
+    END
+  END FixPendingF;
+
+PROCEDURE Lookup (name: ARRAY OF CHAR): BOOLEAN;
+  BEGIN
+    RETURN Find(name) # -1
+  END Lookup;
+
+PROCEDURE SymType (name: ARRAY OF CHAR): TypeIndex;
+  VAR idx : INTEGER;
+  BEGIN
+    idx := Find(name);
+    IF idx = -1 THEN RETURN InvalidType END;
+    RETURN syms[idx].typ
+  END SymType;
+
+PROCEDURE SetSymType (name: ARRAY OF CHAR; t: TypeIndex);
+  VAR idx : INTEGER;
+  BEGIN
+    idx := Find(name);
+    IF idx # -1 THEN syms[idx].typ := t END
+  END SetSymType;
+
+PROCEDURE SymKind (name: ARRAY OF CHAR): INTEGER;
+  VAR idx : INTEGER;
+  BEGIN
+    idx := Find(name);
+    IF idx = -1 THEN RETURN -1 END;
+    RETURN syms[idx].kind
+  END SymKind;
+
+PROCEDURE PushScope;
+  BEGIN
+    IF mtop < MaxMarks THEN marks[mtop] := nSyms; INC(mtop) END;
+    INC(curLev)
+  END PushScope;
+
+PROCEDURE PopScope;
+  BEGIN
+    IF mtop > 0 THEN DEC(mtop); nSyms := marks[mtop] END;
+    IF curLev > 0 THEN DEC(curLev) END
+  END PopScope;
+
+(* ---------------- type descriptors ---------------- *)
+
+PROCEDURE NewDesc (form: INTEGER; ref: TypeIndex): TypeIndex;
+  BEGIN
+    IF nTypes >= MaxTypes THEN RETURN InvalidType END;
+    tform[nTypes] := form;
+    tref[nTypes] := ref;
+    INC(nTypes);
+    RETURN VAL(INTEGER, nTypes - 1)
+  END NewDesc;
+
+PROCEDURE NewAlias (): TypeIndex;
+  BEGIN
+    RETURN NewDesc(FAlias, InvalidType)
+  END NewAlias;
+
+PROCEDURE NewSub (base: TypeIndex): TypeIndex;
+  BEGIN
+    RETURN NewDesc(FSub, base)
+  END NewSub;
+
+PROCEDURE NewEnum (): TypeIndex;
+  BEGIN
+    RETURN NewDesc(FEnum, InvalidType)
+  END NewEnum;
+
+PROCEDURE NewArray (elem: TypeIndex): TypeIndex;
+  BEGIN
+    RETURN NewDesc(FArray, elem)
+  END NewArray;
+
+PROCEDURE NewOpen (elem: TypeIndex): TypeIndex;
+  BEGIN
+    RETURN NewDesc(FOpen, elem)
+  END NewOpen;
+
+PROCEDURE WrapArray (elem: TypeIndex; dims: CARDINAL): TypeIndex;
+(* Nests elem in dims ARRAY levels; dims = 0 gives an open array. *)
+  VAR t : TypeIndex;
+  BEGIN
+    t := elem;
+    IF dims = 0 THEN RETURN NewOpen(t) END;
+    WHILE dims > 0 DO
+      t := NewArray(t);
+      IF t = InvalidType THEN RETURN InvalidType END;
+      DEC(dims)
+    END;
+    RETURN t
+  END WrapArray;
+
+PROCEDURE IsOpen (t: TypeIndex): BOOLEAN;
+  VAR r : TypeIndex;
+  BEGIN
+    r := Resolve(t);
+    IF r = InvalidType THEN RETURN FALSE END;
+    RETURN tform[r] = FOpen
+  END IsOpen;
+
+PROCEDURE NewRecord (): TypeIndex;
+  BEGIN
+    RETURN NewDesc(FRecord, -1)
+  END NewRecord;
+
+PROCEDURE NewSet (base: TypeIndex): TypeIndex;
+  BEGIN
+    RETURN NewDesc(FSet, base)
+  END NewSet;
+
+PROCEDURE NewPtr (base: TypeIndex): TypeIndex;
+  BEGIN
+    RETURN NewDesc(FPtr, base)
+  END NewPtr;
+
+PROCEDURE NewStr (): TypeIndex;
+  BEGIN
+    RETURN NewDesc(FStr, InvalidType)
+  END NewStr;
+
+PROCEDURE SetTarget (t, base: TypeIndex);
+  BEGIN
+    IF (t >= 0) & (t < VAL(INTEGER, nTypes)) & (tform[t] = FAlias) THEN
+      tref[t] := base
+    END
+  END SetTarget;
+
+PROCEDURE Resolve (t: TypeIndex): TypeIndex;
+  VAR n : CARDINAL;
+  BEGIN
+    n := 0;
+    WHILE (n < ResDepth) & (t >= 0) & (t < VAL(INTEGER, nTypes))
+          & (tform[t] = FAlias) DO
+      t := tref[t]; INC(n)
+    END;
+    IF (t < 0) OR (t >= VAL(INTEGER, nTypes)) THEN
+      RETURN InvalidType
+    END;
+    RETURN t
+  END Resolve;
+
+PROCEDURE IntType (): TypeIndex;
+  BEGIN RETURN dInt END IntType;
+PROCEDURE RealType (): TypeIndex;
+  BEGIN RETURN dReal END RealType;
+PROCEDURE CharType (): TypeIndex;
+  BEGIN RETURN dChar END CharType;
+PROCEDURE BoolType (): TypeIndex;
+  BEGIN RETURN dBool END BoolType;
+
+PROCEDURE ClassOf (t: TypeIndex): INTEGER;
+  VAR r : TypeIndex;
+  BEGIN
+    r := Resolve(t);
+    IF r = InvalidType THEN RETURN ClInvalid END;
+    CASE tform[r] OF
+      FInt : RETURN ClInt
+    | FReal : RETURN ClReal
+    | FChar : RETURN ClChar
+    | FBool : RETURN ClBool
+    | FEnum : RETURN ClEnum
+    | FArray : RETURN ClArray
+    | FOpen : RETURN ClArray
+    | FRecord : RETURN ClRecord
+    | FSet : RETURN ClSet
+    | FPtr : RETURN ClPtr
+    | FStr : RETURN ClStr
+    | FSub : RETURN ClassOf(tref[r])
+    ELSE RETURN ClInvalid
+    END
+  END ClassOf;
+
+PROCEDURE IsIntFamily (t: TypeIndex): BOOLEAN;
+  BEGIN
+    RETURN ClassOf(t) = ClInt
+  END IsIntFamily;
+
+PROCEDURE SameType (a, b: TypeIndex): BOOLEAN;
+  BEGIN
+    IF (a = InvalidType) OR (b = InvalidType) THEN RETURN TRUE END;
+    RETURN Resolve(a) = Resolve(b)
+  END SameType;
+
+PROCEDURE FieldExists (rec: TypeIndex; name: ARRAY OF CHAR): BOOLEAN;
+  BEGIN
+    RETURN FindField(Resolve(rec), name) # -1
+  END FieldExists;
+
+PROCEDURE FieldType (rec: TypeIndex; name: ARRAY OF CHAR): TypeIndex;
+  VAR i : INTEGER;
+  BEGIN
+    i := FindField(Resolve(rec), name);
+    IF i = -1 THEN RETURN InvalidType END;
+    RETURN fields[i].typ
+  END FieldType;
+
+PROCEDURE ArrayElem (t: TypeIndex): TypeIndex;
+  VAR r : TypeIndex;
+  BEGIN
+    r := Resolve(t);
+    IF r = InvalidType THEN RETURN InvalidType END;
+    IF (tform[r] # FArray) & (tform[r] # FOpen) THEN
+      RETURN InvalidType
+    END;
+    RETURN tref[r]
+  END ArrayElem;
+
+PROCEDURE PtrBase (t: TypeIndex): TypeIndex;
+  VAR r : TypeIndex;
+  BEGIN
+    r := Resolve(t);
+    IF (r = InvalidType) OR (tform[r] # FPtr) THEN
+      RETURN InvalidType
+    END;
+    RETURN tref[r]
+  END PtrBase;
+
+PROCEDURE PushRecord (t: TypeIndex): BOOLEAN;
+(* Pushes a scope with t's fields; caller must PopScope afterwards. *)
+  VAR r, i : INTEGER;
+  BEGIN
+    r := Resolve(t);
+    IF (r < 0) OR (tform[r] # FRecord) THEN RETURN FALSE END;
+    PushScope;
+    i := tref[r];
+    WHILE i # -1 DO
+      IF Enter(fields[i].name, KindField) THEN
+        SetSymType(fields[i].name, fields[i].typ)
+      END;
+      i := fields[i].next
+    END;
+    RETURN TRUE
+  END PushRecord;
+
+(* ---------------- predicates ---------------- *)
+
+PROCEDURE SetBasesOk (a, b: TypeIndex): BOOLEAN;
+(* base compatibility for two SET types *)
+  BEGIN
+    IF SameType(a, b) THEN RETURN TRUE END;
+    IF IsIntFamily(a) & IsIntFamily(b) THEN RETURN TRUE END;
+    IF (ClassOf(a) = ClChar) & (ClassOf(b) = ClChar) THEN
+      RETURN TRUE
+    END;
+    RETURN FALSE
+  END SetBasesOk;
+
+PROCEDURE Assignable (src, dst: TypeIndex): BOOLEAN;
+  VAR rs, rd : TypeIndex;
+  BEGIN
+    IF (src = InvalidType) OR (dst = InvalidType) THEN RETURN TRUE END;
+    rs := Resolve(src); rd := Resolve(dst);
+    IF rs = rd THEN RETURN TRUE END;
+    IF (rs = InvalidType) OR (rd = InvalidType) THEN RETURN TRUE END;
+    IF (tform[rs] = FSet) & (tform[rd] = FSet) THEN
+      RETURN SetBasesOk(tref[rs], tref[rd])
+    END;
+    IF (ClassOf(src) = ClInt) & (ClassOf(dst) = ClInt) THEN
+      RETURN TRUE
+    END;
+    IF (ClassOf(src) = ClInt) & (ClassOf(dst) = ClReal) THEN
+      RETURN TRUE
+    END;
+    IF (ClassOf(src) = ClStr) & (ClassOf(dst) = ClArray) THEN
+      RETURN TRUE
+    END;
+    RETURN FALSE
+  END Assignable;
+
+PROCEDURE ArithCheck (l, r: TypeIndex; divmod: BOOLEAN;
+                      VAR res: TypeIndex): BOOLEAN;
+  BEGIN
+    res := InvalidType;
+    IF (l = InvalidType) OR (r = InvalidType) THEN RETURN TRUE END;
+    IF IsIntFamily(l) & IsIntFamily(r) THEN
+      res := dInt; RETURN TRUE
+    END;
+    IF ~divmod & (ClassOf(l) = ClReal) & (ClassOf(r) = ClReal) THEN
+      res := dReal; RETURN TRUE
+    END;
+    RETURN FALSE
+  END ArithCheck;
+
+PROCEDURE UnaryCheck (t: TypeIndex; VAR res: TypeIndex): BOOLEAN;
+  BEGIN
+    res := InvalidType;
+    IF t = InvalidType THEN RETURN TRUE END;
+    IF IsIntFamily(t) THEN res := dInt; RETURN TRUE END;
+    IF ClassOf(t) = ClReal THEN res := dReal; RETURN TRUE END;
+    RETURN FALSE
+  END UnaryCheck;
+
+PROCEDURE BoolCheck (t: TypeIndex): BOOLEAN;
+  BEGIN
+    IF t = InvalidType THEN RETURN TRUE END;
+    RETURN ClassOf(t) = ClBool
+  END BoolCheck;
+
+PROCEDURE EqCheck (l, r: TypeIndex): BOOLEAN;
+  VAR rl, rr : TypeIndex;
+  BEGIN
+    IF (l = InvalidType) OR (r = InvalidType) THEN RETURN TRUE END;
+    IF SameType(l, r) THEN RETURN TRUE END;
+    IF IsIntFamily(l) & IsIntFamily(r) THEN RETURN TRUE END;
+    IF (ClassOf(l) = ClReal) & (ClassOf(r) = ClReal) THEN
+      RETURN TRUE
+    END;
+    IF (ClassOf(l) = ClChar) & (ClassOf(r) = ClChar) THEN
+      RETURN TRUE
+    END;
+    IF (ClassOf(l) = ClBool) & (ClassOf(r) = ClBool) THEN
+      RETURN TRUE
+    END;
+    IF (ClassOf(l) = ClStr) & (ClassOf(r) = ClStr) THEN
+      RETURN TRUE
+    END;
+    rl := Resolve(l); rr := Resolve(r);
+    IF (rl = InvalidType) OR (rr = InvalidType) THEN RETURN TRUE END;
+    IF (tform[rl] = FSet) & (tform[rr] = FSet) THEN
+      RETURN SetBasesOk(tref[rl], tref[rr])
+    END;
+    RETURN FALSE
+  END EqCheck;
+
+PROCEDURE OrdCheck (l, r: TypeIndex): BOOLEAN;
+  BEGIN
+    IF (l = InvalidType) OR (r = InvalidType) THEN RETURN TRUE END;
+    IF IsIntFamily(l) & IsIntFamily(r) THEN RETURN TRUE END;
+    IF (ClassOf(l) = ClReal) & (ClassOf(r) = ClReal) THEN
+      RETURN TRUE
+    END;
+    IF (ClassOf(l) = ClChar) & (ClassOf(r) = ClChar) THEN
+      RETURN TRUE
+    END;
+    IF (ClassOf(l) = ClEnum) & SameType(l, r) THEN RETURN TRUE END;
+    RETURN FALSE
+  END OrdCheck;
+
+PROCEDURE InCheck (l, set: TypeIndex): BOOLEAN;
+  VAR rs, b : TypeIndex;
+  BEGIN
+    IF (l = InvalidType) OR (set = InvalidType) THEN RETURN TRUE END;
+    rs := Resolve(set);
+    IF (rs = InvalidType) OR (tform[rs] # FSet) THEN RETURN FALSE END;
+    b := tref[rs];
+    IF SameType(l, b) THEN RETURN TRUE END;
+    IF IsIntFamily(l) & IsIntFamily(b) THEN RETURN TRUE END;
+    IF (ClassOf(l) = ClChar) & (ClassOf(b) = ClChar) THEN
+      RETURN TRUE
+    END;
+    RETURN FALSE
+  END InCheck;
+
+PROCEDURE RelCheck (l, r: TypeIndex; op: INTEGER): BOOLEAN;
+  BEGIN
+    IF (l = InvalidType) OR (r = InvalidType) THEN RETURN TRUE END;
+    IF op = OpIn THEN RETURN InCheck(l, r) END;
+    IF (op = OpEq) OR (op = OpNeq1) OR (op = OpNeq2) THEN
+      RETURN EqCheck(l, r)
+    END;
+    RETURN OrdCheck(l, r)
+  END RelCheck;
+
+PROCEDURE SetElemCheck (first, elem: TypeIndex): BOOLEAN;
+  BEGIN
+    IF (first = InvalidType) OR (elem = InvalidType) THEN
+      RETURN TRUE
+    END;
+    IF SameType(first, elem) THEN RETURN TRUE END;
+    IF IsIntFamily(first) & IsIntFamily(elem) THEN RETURN TRUE END;
+    RETURN FALSE
+  END SetElemCheck;
+
+PROCEDURE SetFor (elem: TypeIndex): TypeIndex;
+  VAR e : TypeIndex;
+  BEGIN
+    e := Resolve(elem);
+    IF e = InvalidType THEN e := dInt END;
+    RETURN NewSet(e)
+  END SetFor;
+
+(* ---------------- procedures ---------------- *)
+
+PROCEDURE NewParamRec (t: TypeIndex; isVar: BOOLEAN): INTEGER;
+  BEGIN
+    IF nParams >= MaxParams THEN RETURN -1 END;
+    params[nParams].typ := t;
+    params[nParams].isVar := isVar;
+    params[nParams].next := -1;
+    INC(nParams);
+    RETURN VAL(INTEGER, nParams - 1)
+  END NewParamRec;
+
+PROCEDURE AppParam (pi: INTEGER);
+  BEGIN
+    IF (curProc < 1) OR (curProc > VAL(INTEGER, nProcs)) THEN
+      RETURN
+    END;
+    IF pi < 0 THEN RETURN END;
+    IF procs[curProc].head = -1 THEN
+      procs[curProc].head := pi
+    ELSE
+      params[procs[curProc].tail].next := pi
+    END;
+    procs[curProc].tail := pi
+  END AppParam;
+
+PROCEDURE EnterProc (name: ARRAY OF CHAR): BOOLEAN;
+  VAR idx : INTEGER;
+  BEGIN
+    IF DupInLevel(name) THEN RETURN FALSE END;
+    IF nProcs >= MaxProcs THEN RETURN FALSE END;
+    idx := RawEnter(name, KindProc);
+    IF idx = -1 THEN RETURN FALSE END;
+    INC(nProcs);
+    syms[idx].pnum := VAL(INTEGER, nProcs);
+    procs[nProcs].ret := InvalidType;
+    procs[nProcs].head := -1;
+    procs[nProcs].tail := -1;
+    curProc := VAL(INTEGER, nProcs);
+    RETURN TRUE
+  END EnterProc;
+
+PROCEDURE OpenProcScope;
+  BEGIN
+    IF pdep < MaxPDepth THEN INC(pdep) END;
+    PushScope;
+    procSt[pdep] := curProc;
+    retSt[pdep] := InvalidType
+  END OpenProcScope;
+
+PROCEDURE CloseProc;
+  BEGIN
+    PopScope;
+    IF pdep > 0 THEN DEC(pdep) END;
+    curProc := procSt[pdep]
+  END CloseProc;
+
+PROCEDURE EnterParamPending (name: ARRAY OF CHAR;
+                             isVar: BOOLEAN): BOOLEAN;
+  BEGIN
+    IF DupInLevel(name) THEN RETURN FALSE END;
+    IF nPPend >= MaxPPend THEN RETURN FALSE END;
+    Assign(pPendN[nPPend], name);
+    pPendV[nPPend] := isVar;
+    INC(nPPend);
+    RETURN TRUE
+  END EnterParamPending;
+
+PROCEDURE FixParamPending (t: TypeIndex): BOOLEAN;
+  VAR i : CARDINAL;
+    idx, pi : INTEGER;
+    ok : BOOLEAN;
+  BEGIN
+    ok := TRUE;
+    i := 0;
+    WHILE i < nPPend DO
+      IF DupInLevel(pPendN[i]) THEN ok := FALSE
+      ELSE
+        IF pPendV[i] THEN idx := RawEnter(pPendN[i], KindVarPar)
+        ELSE idx := RawEnter(pPendN[i], KindParam)
+        END;
+        IF idx = -1 THEN ok := FALSE
+        ELSE
+          syms[idx].typ := t;
+          pi := NewParamRec(t, pPendV[i]);
+          IF pi = -1 THEN ok := FALSE ELSE AppParam(pi) END
+        END
+      END;
+      INC(i)
+    END;
+    nPPend := 0;
+    RETURN ok
+  END FixParamPending;
+
+PROCEDURE SetProcRet (t: TypeIndex);
+  BEGIN
+    IF (curProc < 1) OR (curProc > VAL(INTEGER, nProcs)) THEN
+      RETURN
+    END;
+    procs[curProc].ret := t;
+    IF pdep > 0 THEN retSt[pdep] := t END
+  END SetProcRet;
+
+PROCEDURE ProcNum (name: ARRAY OF CHAR): INTEGER;
+  VAR idx : INTEGER;
+  BEGIN
+    idx := Find(name);
+    IF idx = -1 THEN RETURN -1 END;
+    IF syms[idx].kind # KindProc THEN RETURN -1 END;
+    RETURN syms[idx].pnum
+  END ProcNum;
+
+PROCEDURE ProcRetByNum (num: INTEGER): TypeIndex;
+  BEGIN
+    IF (num < 1) OR (num > VAL(INTEGER, nProcs)) THEN
+      RETURN InvalidType
+    END;
+    RETURN procs[num].ret
+  END ProcRetByNum;
+
+PROCEDURE ProcNParByNum (num: INTEGER): CARDINAL;
+  VAR i, n : INTEGER;
+  BEGIN
+    IF (num < 1) OR (num > VAL(INTEGER, nProcs)) THEN RETURN 0 END;
+    n := 0; i := procs[num].head;
+    WHILE i # -1 DO INC(n); i := params[i].next END;
+    RETURN VAL(CARDINAL, n)
+  END ProcNParByNum;
+
+PROCEDURE ParamTypeByNum (num: INTEGER; i: CARDINAL): TypeIndex;
+  VAR p : INTEGER;
+  BEGIN
+    IF (num < 1) OR (num > VAL(INTEGER, nProcs)) THEN
+      RETURN InvalidType
+    END;
+    p := procs[num].head;
+    WHILE (p # -1) & (i > 0) DO p := params[p].next; DEC(i) END;
+    IF p = -1 THEN RETURN InvalidType END;
+    RETURN params[p].typ
+  END ParamTypeByNum;
+
+PROCEDURE ParamIsVarByNum (num: INTEGER; i: CARDINAL): BOOLEAN;
+  VAR p : INTEGER;
+  BEGIN
+    IF (num < 1) OR (num > VAL(INTEGER, nProcs)) THEN
+      RETURN FALSE
+    END;
+    p := procs[num].head;
+    WHILE (p # -1) & (i > 0) DO p := params[p].next; DEC(i) END;
+    IF p = -1 THEN RETURN FALSE END;
+    RETURN params[p].isVar
+  END ParamIsVarByNum;
+
+PROCEDURE ProcRet (name: ARRAY OF CHAR): TypeIndex;
+  BEGIN
+    RETURN ProcRetByNum(ProcNum(name))
+  END ProcRet;
+
+PROCEDURE ProcNPar (name: ARRAY OF CHAR): CARDINAL;
+  BEGIN
+    RETURN ProcNParByNum(ProcNum(name))
+  END ProcNPar;
+
+PROCEDURE ParamType (name: ARRAY OF CHAR; i: CARDINAL): TypeIndex;
+  BEGIN
+    RETURN ParamTypeByNum(ProcNum(name), i)
+  END ParamType;
+
+PROCEDURE ParamIsVar (name: ARRAY OF CHAR; i: CARDINAL): BOOLEAN;
+  BEGIN
+    RETURN ParamIsVarByNum(ProcNum(name), i)
+  END ParamIsVar;
+
+PROCEDURE InProc (): BOOLEAN;
+  BEGIN
+    RETURN pdep > 0
+  END InProc;
+
+PROCEDURE InFunction (): BOOLEAN;
+  BEGIN
+    IF pdep = 0 THEN RETURN FALSE END;
+    RETURN retSt[pdep] # InvalidType
+  END InFunction;
+
+PROCEDURE CurRet (): TypeIndex;
+  BEGIN
+    IF pdep = 0 THEN RETURN InvalidType END;
+    RETURN retSt[pdep]
+  END CurRet;
+
+(* ---------------- local modules ---------------- *)
+
+PROCEDURE EnterModule (name: ARRAY OF CHAR): BOOLEAN;
+  BEGIN
+    IF DupInLevel(name) THEN RETURN FALSE END;
+    IF RawEnter(name, KindModule) = -1 THEN RETURN FALSE END;
+    IF modTop > MaxMods - 1 THEN RETURN TRUE END;
+    Assign(modNames[modTop], name);
+    modNExps[modTop] := 0;
+    INC(modTop);
+    PushScope;
+    modLevs[modTop - 1] := curLev;
+    RETURN TRUE
+  END EnterModule;
+
+PROCEDURE ModuleAddExp (name: ARRAY OF CHAR): BOOLEAN;
+  VAR i : CARDINAL;
+  BEGIN
+    IF modTop = 0 THEN RETURN FALSE END;
+    i := 0;
+    WHILE i < modNExps[modTop - 1] DO
+      IF Equal(modExps[modTop - 1][i], name) THEN RETURN FALSE END;
+      INC(i)
+    END;
+    IF modNExps[modTop - 1] > MaxModExps - 1 THEN RETURN FALSE END;
+    Assign(modExps[modTop - 1][modNExps[modTop - 1]], name);
+    INC(modNExps[modTop - 1]);
+    RETURN TRUE
+  END ModuleAddExp;
+
+PROCEDURE ExitModule (): BOOLEAN;
+  VAR mi, k : CARDINAL;
+    idx : INTEGER;
+    en : Name;
+    ok : BOOLEAN;
+  BEGIN
+    IF modTop = 0 THEN RETURN TRUE END;
+    mi := modTop - 1;
+    ok := TRUE;
+    k := 0;
+    WHILE k < modNExps[mi] DO
+      Assign(en, modExps[mi][k]);
+      idx := Find(en);
+      IF idx = -1 THEN ok := FALSE
+      ELSIF nExps <= MaxExps - 1 THEN
+        Assign(expMod[nExps], modNames[mi]);
+        Assign(expName[nExps], en);
+        expKindA[nExps] := syms[idx].kind;
+        expTypeA[nExps] := syms[idx].typ;
+        IF syms[idx].kind = KindProc THEN
+          expProcA[nExps] := syms[idx].pnum
+        ELSE
+          expProcA[nExps] := -1
+        END;
+        INC(nExps)
+      END;
+      INC(k)
+    END;
+    PopScope;
+    DEC(modTop);
+    RETURN ok
+  END ExitModule;
+
+PROCEDURE InModule (): BOOLEAN;
+  BEGIN
+    RETURN modTop > 0
+  END InModule;
+
+PROCEDURE CurModName (VAR m: Name);
+  BEGIN
+    IF modTop = 0 THEN m[0] := 0C
+    ELSE Assign(m, modNames[modTop - 1])
+    END
+  END CurModName;
+
+PROCEDURE ExpFind (mod, exp: ARRAY OF CHAR): INTEGER;
+  VAR i : CARDINAL;
+  BEGIN
+    i := 0;
+    WHILE i < nExps DO
+      IF Equal(expMod[i], mod) & Equal(expName[i], exp) THEN
+        RETURN VAL(INTEGER, i)
+      END;
+      INC(i)
+    END;
+    RETURN -1
+  END ExpFind;
+
+PROCEDURE ExpKind (mod, exp: ARRAY OF CHAR): INTEGER;
+  VAR i : INTEGER;
+  BEGIN
+    i := ExpFind(mod, exp);
+    IF i = -1 THEN RETURN -1 END;
+    RETURN expKindA[i]
+  END ExpKind;
+
+PROCEDURE ExpType (mod, exp: ARRAY OF CHAR): TypeIndex;
+  VAR i : INTEGER;
+  BEGIN
+    i := ExpFind(mod, exp);
+    IF i = -1 THEN RETURN InvalidType END;
+    RETURN expTypeA[i]
+  END ExpType;
+
+PROCEDURE ExpProc (mod, exp: ARRAY OF CHAR): INTEGER;
+  VAR i : INTEGER;
+  BEGIN
+    i := ExpFind(mod, exp);
+    IF i = -1 THEN RETURN -1 END;
+    RETURN expProcA[i]
+  END ExpProc;
+
+PROCEDURE SelfKind (mod, exp: ARRAY OF CHAR): INTEGER;
+(* Kind of exp as M.exp from inside M itself (live body scope at
+   body level, since exports resolve only at END). *)
+  VAR idx : INTEGER;
+  BEGIN
+    IF modTop = 0 THEN RETURN -1 END;
+    IF ~Equal(modNames[modTop - 1], mod) THEN RETURN -1 END;
+    idx := Find(exp);
+    IF idx = -1 THEN RETURN -1 END;
+    IF syms[idx].lev # modLevs[modTop - 1] THEN RETURN -1 END;
+    RETURN syms[idx].kind
+  END SelfKind;
+
+PROCEDURE SelfType (mod, exp: ARRAY OF CHAR): TypeIndex;
+  VAR idx : INTEGER;
+  BEGIN
+    IF modTop = 0 THEN RETURN InvalidType END;
+    IF ~Equal(modNames[modTop - 1], mod) THEN
+      RETURN InvalidType
+    END;
+    idx := Find(exp);
+    IF idx = -1 THEN RETURN InvalidType END;
+    IF syms[idx].lev # modLevs[modTop - 1] THEN
+      RETURN InvalidType
+    END;
+    RETURN syms[idx].typ
+  END SelfType;
+
+PROCEDURE SelfProc (mod, exp: ARRAY OF CHAR): INTEGER;
+  VAR idx : INTEGER;
+  BEGIN
+    IF modTop = 0 THEN RETURN -1 END;
+    IF ~Equal(modNames[modTop - 1], mod) THEN RETURN -1 END;
+    idx := Find(exp);
+    IF idx = -1 THEN RETURN -1 END;
+    IF syms[idx].lev # modLevs[modTop - 1] THEN RETURN -1 END;
+    IF syms[idx].kind # KindProc THEN RETURN -1 END;
+    RETURN syms[idx].pnum
+  END SelfProc;
+
+(* ---------------- call checking ---------------- *)
+
+PROCEDURE CallBeginNum (num: INTEGER);
+  BEGIN
+    IF callTop > MaxCallDepth - 1 THEN callFull := TRUE; RETURN END;
+    callProc[callTop] := num;
+    callIdx[callTop] := 0;
+    callErr[callTop] := FALSE;
+    INC(callTop)
+  END CallBeginNum;
+
+PROCEDURE CallActual (t: TypeIndex; isVar: BOOLEAN): BOOLEAN;
+  VAR p : INTEGER;
+    i : CARDINAL;
+    ft : TypeIndex;
+    fv : BOOLEAN;
+    ok : BOOLEAN;
+  BEGIN
+    IF callFull THEN RETURN TRUE END;
+    IF callTop = 0 THEN RETURN TRUE END;
+    p := callProc[callTop - 1];
+    IF (p < 1) OR (p > VAL(INTEGER, nProcs)) THEN RETURN TRUE END;
+    i := callIdx[callTop - 1];
+    IF i >= ProcNParByNum(p) THEN
+      callErr[callTop - 1] := TRUE;
+      INC(callIdx[callTop - 1]);
+      RETURN FALSE
+    END;
+    ft := ParamTypeByNum(p, i);
+    fv := ParamIsVarByNum(p, i);
+    IF fv THEN ok := isVar & SameType(t, ft)
+    ELSE ok := Assignable(t, ft)
+    END;
+    IF ~ok THEN callErr[callTop - 1] := TRUE END;
+    INC(callIdx[callTop - 1]);
+    RETURN ok
+  END CallActual;
+
+PROCEDURE CallEndNum (n: CARDINAL): BOOLEAN;
+  VAR p : INTEGER;
+    e : BOOLEAN;
+  BEGIN
+    IF callFull THEN callFull := FALSE; RETURN TRUE END;
+    IF callTop = 0 THEN RETURN TRUE END;
+    DEC(callTop);
+    p := callProc[callTop];
+    e := callErr[callTop];
+    IF (p < 1) OR (p > VAL(INTEGER, nProcs)) THEN RETURN TRUE END;
+    IF e THEN RETURN TRUE END;
+    RETURN n = ProcNParByNum(p)
+  END CallEndNum;
+
+(* ---------------- loops ---------------- *)
+
+PROCEDURE LoopEnter;
+  BEGIN
+    INC(loopDep)
+  END LoopEnter;
+
+PROCEDURE LoopExit;
+  BEGIN
+    IF loopDep > 0 THEN DEC(loopDep) END
+  END LoopExit;
+
+PROCEDURE InLoop (): BOOLEAN;
+  BEGIN
+    RETURN loopDep > 0
+  END InLoop;
+
+(* ---------------- init ---------------- *)
+
+PROCEDURE Predef (name: ARRAY OF CHAR; kind: INTEGER; t: TypeIndex);
+  BEGIN
+    IF Enter(name, kind) THEN SetSymType(name, t) END
+  END Predef;
+
+PROCEDURE Init;
+  BEGIN
+    nSyms := 0; curLev := 0; mtop := 0;
+    nPend := 0; nPendF := 0;
+    nTypes := 0; nFields := 0;
+    nProcs := 0; nParams := 0; curProc := 0; pdep := 0;
+    procSt[0] := 0; retSt[0] := InvalidType;
+    nPPend := 0;
+    modTop := 0; nExps := 0;
+    callTop := 0; callFull := FALSE;
+    loopDep := 0;
+    dInt := NewDesc(FInt, InvalidType);
+    dCard := NewDesc(FInt, InvalidType);
+    dReal := NewDesc(FReal, InvalidType);
+    dChar := NewDesc(FChar, InvalidType);
+    dBool := NewDesc(FBool, InvalidType);
+    Predef("INTEGER", KindPredef, dInt);
+    Predef("CARDINAL", KindPredef, dCard);
+    Predef("SHORTINT", KindPredef, dInt);
+    Predef("LONGINT", KindPredef, dInt);
+    Predef("REAL", KindPredef, dReal);
+    Predef("LONGREAL", KindPredef, dReal);
+    Predef("CHAR", KindPredef, dChar);
+    Predef("BOOLEAN", KindPredef, dBool);
+    Predef("TRUE", KindConst, dBool);
+    Predef("FALSE", KindConst, dBool);
+    Predef("NIL", KindConst, InvalidType)
+  END Init;
+
+(* ---------------- listing ---------------- *)
+
+PROCEDURE WriteKind (kind: INTEGER);
+  BEGIN
+    CASE kind OF
+      KindConst  : FileIO.WriteString(FileIO.StdOut, "CONST")
+    | KindType   : FileIO.WriteString(FileIO.StdOut, "TYPE")
+    | KindVar    : FileIO.WriteString(FileIO.StdOut, "VAR")
+    | KindImport : FileIO.WriteString(FileIO.StdOut, "IMPORT")
+    | KindModule : FileIO.WriteString(FileIO.StdOut, "MODULE")
+    | KindPredef : FileIO.WriteString(FileIO.StdOut, "PREDEF")
+    | KindField  : FileIO.WriteString(FileIO.StdOut, "FIELD")
+    | KindProc   : FileIO.WriteString(FileIO.StdOut, "PROC")
+    | KindParam  : FileIO.WriteString(FileIO.StdOut, "PARAM")
+    | KindVarPar : FileIO.WriteString(FileIO.StdOut, "VARPAR")
+    ELSE FileIO.WriteString(FileIO.StdOut, "???")
+    END
+  END WriteKind;
+
+PROCEDURE PrintTable;
+  VAR i : CARDINAL;
+  BEGIN
+    FileIO.WriteLn(FileIO.StdOut);
+    FileIO.WriteString(FileIO.StdOut, "--- Symbol table ---");
+    FileIO.WriteLn(FileIO.StdOut);
+    i := 0;
+    WHILE i < nSyms DO
+      FileIO.WriteString(FileIO.StdOut, "  ");
+      FileIO.WriteString(FileIO.StdOut, syms[i].name);
+      FileIO.WriteString(FileIO.StdOut, " : ");
+      WriteKind(syms[i].kind);
+      FileIO.WriteString(FileIO.StdOut, " #");
+      FileIO.WriteInt(FileIO.StdOut, syms[i].typ, 1);
+      FileIO.WriteLn(FileIO.StdOut);
+      INC(i)
+    END
+  END PrintTable;
+
+BEGIN
+  Init
+END SymTab.


+ 1 - 0
src/modules.lst

@@ -61,5 +61,6 @@ RndFile
 TermFile
 FileIO
 M2compS
+SymTab
 M2compP
 M2comp

+ 88 - 76
tests/showcase.LST

@@ -3,7 +3,7 @@ Listing:
     1  MODULE Showcase;
     2  (* Exercises every syntax form of M2comp.atg step 1. *)
     3  FROM In IMPORT x;
-    4  IMPORT y, z;
+    4  IMPORT w, dbg;
     5  
     6  CONST
     7    N = 10;
@@ -24,84 +24,96 @@ Listing:
    22    Ptr = POINTER TO Rec;
    23    St = SET OF Sub;
    24    Boo = BOOLEAN;
-   25  
-   26  VAR
-   27    i, j : INTEGER;
-   28    v : Vec;
-   29    m : Mat;
-   30    r : Rec;
-   31    p : Ptr;
-   32    s : St;
-   33    b : BOOLEAN;
-   34    ch : CHAR;
-   35  
-   36  PROCEDURE Min(a, b : INTEGER) : INTEGER;
-   37  BEGIN
-   38    IF a < b THEN RETURN a ELSE RETURN b END
-   39  END Min;
-   40  
-   41  PROCEDURE Work(VAR v : Vec; n : CARDINAL; flag : BOOLEAN);
-   42  VAR k : INTEGER;
+   25    Chars = ARRAY [0 .. 15] OF CHAR;
+   26  
+   27  VAR
+   28    i, j : INTEGER;
+   29    v : Vec;
+   30    m : Mat;
+   31    r : Rec;
+   32    p : Ptr;
+   33    s : St;
+   34    b : BOOLEAN;
+   35    ch : CHAR;
+   36    sa : Chars;
+   37  
+   38  PROCEDURE y(a : INTEGER; VAR s : Chars; w : INTEGER);
+   39  BEGIN
+   40    s[0] := ch;
+   41    a := a + w
+   42  END y;
    43  
-   44    PROCEDURE Nested(t : INTEGER) : INTEGER;
-   45    BEGIN
-   46      RETURN t * 2
-   47    END Nested;
-   48  
+   44  PROCEDURE z;
+   45  BEGIN
+   46  END z;
+   47  
+   48  PROCEDURE Min(a, b : INTEGER) : INTEGER;
    49  BEGIN
-   50    k := +n - 1;
-   51    k := -k + 1;
-   52    v[0] := k;
-   53    v[N - 1] := Nested(k);
-   54    m[1, 2] := R;
-   55    r.a := k;
-   56    p^ := r;
-   57    s := s;
-   58    b := (k <= 0) OR (k >= N) OR NOT flag;
-   59    IF k = 0 THEN k := 1
-   60    ELSIF k # 1 THEN k := 2
-   61    ELSE k := 3
-   62    END;
-   63    WHILE k < N DO
-   64      k := k + 1
-   65    END;
-   66    REPEAT
-   67      k := k - 1
-   68    UNTIL k = 0;
-   69    LOOP
-   70      k := k + 1;
-   71      IF k > N THEN EXIT END
-   72    END;
-   73    FOR k := 1 TO N BY 2 DO
-   74      Work(v, k, flag)
-   75    END;
-   76    FOR k := N TO 1 DO
-   77      k := k DIV 2
-   78    END;
-   79    b := (k IN s) AND (H <> 0) AND (Q = Q);
-   80    j := k MOD 3;
-   81    r := r
-   82  END Work;
-   83  
-   84  MODULE Local [3];
-   85  FROM In IMPORT w;
-   86  EXPORT QUALIFIED q;
-   87  VAR q : INTEGER;
-   88  PROCEDURE Init;
-   89  BEGIN
-   90    q := 0
-   91  END Init;
-   92  BEGIN
-   93    q := 1
-   94  END Local;
+   50    IF a < b THEN RETURN a ELSE RETURN b END
+   51  END Min;
+   52  
+   53  PROCEDURE Work(VAR v : Vec; n : CARDINAL; flag : BOOLEAN);
+   54  VAR k : INTEGER;
+   55  
+   56    PROCEDURE Nested(t : INTEGER) : INTEGER;
+   57    BEGIN
+   58      RETURN t * 2
+   59    END Nested;
+   60  
+   61  BEGIN
+   62    k := +n - 1;
+   63    k := -k + 1;
+   64    v[0] := k;
+   65    v[N - 1] := Nested(k);
+   66    m[1, 2] := R;
+   67    r.a := k;
+   68    p^ := r;
+   69    s := s;
+   70    b := (k <= 0) OR (k >= N) OR NOT flag;
+   71    IF k = 0 THEN k := 1
+   72    ELSIF k # 1 THEN k := 2
+   73    ELSE k := 3
+   74    END;
+   75    WHILE k < N DO
+   76      k := k + 1
+   77    END;
+   78    REPEAT
+   79      k := k - 1
+   80    UNTIL k = 0;
+   81    LOOP
+   82      k := k + 1;
+   83      IF k > N THEN EXIT END
+   84    END;
+   85    FOR k := 1 TO N BY 2 DO
+   86      Work(v, k, flag)
+   87    END;
+   88    FOR k := N TO 1 DO
+   89      k := k DIV 2
+   90    END;
+   91    b := (k IN s) AND (H <> 0) AND (Q = Q);
+   92    j := k MOD 3;
+   93    r := r
+   94  END Work;
    95  
-   96  BEGIN
-   97    i := Min(3, 4) + (2 * 3 - 4 / 2);
-   98    Work(v, N, TRUE);
-   99    Local.q := i;
-  100    y(i, S, x);
-  101    z
-  102  END Showcase.
+   96  MODULE Local [3];
+   97  FROM In IMPORT w;
+   98  EXPORT QUALIFIED q;
+   99  VAR q : INTEGER;
+  100  PROCEDURE Init;
+  101  BEGIN
+  102    q := 0
+  103  END Init;
+  104  BEGIN
+  105    q := 1
+  106  END Local;
+  107  
+  108  BEGIN
+  109    i := Min(3, 4) + (2 * 3 - 4 / 2);
+  110    Work(v, N, TRUE);
+  111    Local.q := i;
+  112    y(i, sa, x);
+  113    z
+  114  END Showcase.
 
     0 errors
 

+ 14 - 2
tests/showcase.mod

@@ -1,7 +1,7 @@
 MODULE Showcase;
 (* Exercises every syntax form of M2comp.atg step 1. *)
 FROM In IMPORT x;
-IMPORT y, z;
+IMPORT w, dbg;
 
 CONST
   N = 10;
@@ -22,6 +22,7 @@ TYPE
   Ptr = POINTER TO Rec;
   St = SET OF Sub;
   Boo = BOOLEAN;
+  Chars = ARRAY [0 .. 15] OF CHAR;
 
 VAR
   i, j : INTEGER;
@@ -32,6 +33,17 @@ VAR
   s : St;
   b : BOOLEAN;
   ch : CHAR;
+  sa : Chars;
+
+PROCEDURE y(a : INTEGER; VAR s : Chars; w : INTEGER);
+BEGIN
+  s[0] := ch;
+  a := a + w
+END y;
+
+PROCEDURE z;
+BEGIN
+END z;
 
 PROCEDURE Min(a, b : INTEGER) : INTEGER;
 BEGIN
@@ -97,6 +109,6 @@ BEGIN
   i := Min(3, 4) + (2 * 3 - 4 / 2);
   Work(v, N, TRUE);
   Local.q := i;
-  y(i, S, x);
+  y(i, sa, x);
   z
 END Showcase.

+ 13 - 0
tests/t_arith.LST

@@ -0,0 +1,13 @@
+Listing:
+
+    1  MODULE T;
+    2  VAR i : INTEGER;
+    3      r : REAL;
+    4  BEGIN
+    5    i := i + r
+*****             ^ arithmetic operand must be numeric
+    6  END T.
+
+    1 error
+
+

+ 6 - 0
tests/t_arith.mod

@@ -0,0 +1,6 @@
+MODULE T;
+VAR i : INTEGER;
+    r : REAL;
+BEGIN
+  i := i + r
+END T.

+ 13 - 0
tests/t_assign.LST

@@ -0,0 +1,13 @@
+Listing:
+
+    1  MODULE T;
+    2  VAR i : INTEGER;
+    3      r : REAL;
+    4  BEGIN
+    5    i := r
+*****         ^ incompatible assignment
+    6  END T.
+
+    1 error
+
+

+ 6 - 0
tests/t_assign.mod

@@ -0,0 +1,6 @@
+MODULE T;
+VAR i : INTEGER;
+    r : REAL;
+BEGIN
+  i := r
+END T.

+ 12 - 0
tests/t_bool.LST

@@ -0,0 +1,12 @@
+Listing:
+
+    1  MODULE T;
+    2  VAR b : BOOLEAN;
+    3  BEGIN
+    4    b := NOT 1
+*****             ^ boolean operand required
+    5  END T.
+
+    1 error
+
+

+ 5 - 0
tests/t_bool.mod

@@ -0,0 +1,5 @@
+MODULE T;
+VAR b : BOOLEAN;
+BEGIN
+  b := NOT 1
+END T.

+ 15 - 0
tests/t_call.LST

@@ -0,0 +1,15 @@
+Listing:
+
+    1  MODULE T;
+    2  VAR i : INTEGER;
+    3  PROCEDURE P(a : INTEGER; b : BOOLEAN);
+    4  BEGIN
+    5  END P;
+    6  BEGIN
+    7    P(i)
+*****       ^ invalid procedure call
+    8  END T.
+
+    1 error
+
+

+ 8 - 0
tests/t_call.mod

@@ -0,0 +1,8 @@
+MODULE T;
+VAR i : INTEGER;
+PROCEDURE P(a : INTEGER; b : BOOLEAN);
+BEGIN
+END P;
+BEGIN
+  P(i)
+END T.

+ 15 - 0
tests/t_call2.LST

@@ -0,0 +1,15 @@
+Listing:
+
+    1  MODULE T;
+    2  VAR i : INTEGER;
+    3  PROCEDURE P(VAR v : INTEGER);
+    4  BEGIN
+    5  END P;
+    6  BEGIN
+    7    P(1 + 2)
+*****          ^ invalid procedure call
+    8  END T.
+
+    1 error
+
+

+ 8 - 0
tests/t_call2.mod

@@ -0,0 +1,8 @@
+MODULE T;
+VAR i : INTEGER;
+PROCEDURE P(VAR v : INTEGER);
+BEGIN
+END P;
+BEGIN
+  P(1 + 2)
+END T.

+ 12 - 0
tests/t_cond.LST

@@ -0,0 +1,12 @@
+Listing:
+
+    1  MODULE T;
+    2  VAR i : INTEGER;
+    3  BEGIN
+    4    WHILE i DO i := i + 1 END
+*****          ^ BOOLEAN condition required
+    5  END T.
+
+    1 error
+
+

+ 5 - 0
tests/t_cond.mod

@@ -0,0 +1,5 @@
+MODULE T;
+VAR i : INTEGER;
+BEGIN
+  WHILE i DO i := i + 1 END
+END T.

+ 12 - 0
tests/t_dup.LST

@@ -0,0 +1,12 @@
+Listing:
+
+    1  MODULE T;
+    2  VAR i : INTEGER;
+    3  VAR i : REAL;
+*****      ^ duplicate identifier
+    4  BEGIN
+    5  END T.
+
+    1 error
+
+

+ 5 - 0
tests/t_dup.mod

@@ -0,0 +1,5 @@
+MODULE T;
+VAR i : INTEGER;
+VAR i : REAL;
+BEGIN
+END T.

+ 11 - 0
tests/t_exit.LST

@@ -0,0 +1,11 @@
+Listing:
+
+    1  MODULE T;
+    2  BEGIN
+    3    EXIT
+*****    ^ not supported in this phase
+    4  END T.
+
+    1 error
+
+

+ 4 - 0
tests/t_exit.mod

@@ -0,0 +1,4 @@
+MODULE T;
+BEGIN
+  EXIT
+END T.

+ 12 - 0
tests/t_field.LST

@@ -0,0 +1,12 @@
+Listing:
+
+    1  MODULE T;
+    2  VAR r : RECORD f : INTEGER END;
+    3  BEGIN
+    4    r.nope := 1
+*****      ^ unknown field
+    5  END T.
+
+    1 error
+
+

+ 5 - 0
tests/t_field.mod

@@ -0,0 +1,5 @@
+MODULE T;
+VAR r : RECORD f : INTEGER END;
+BEGIN
+  r.nope := 1
+END T.

+ 13 - 0
tests/t_for.LST

@@ -0,0 +1,13 @@
+Listing:
+
+    1  MODULE T;
+    2  VAR r : REAL;
+    3      i : INTEGER;
+    4  BEGIN
+    5    FOR r := 1 TO 10 DO i := i + 1 END
+*****        ^ FOR needs integer variable and bounds
+    6  END T.
+
+    1 error
+
+

+ 6 - 0
tests/t_for.mod

@@ -0,0 +1,6 @@
+MODULE T;
+VAR r : REAL;
+    i : INTEGER;
+BEGIN
+  FOR r := 1 TO 10 DO i := i + 1 END
+END T.

+ 12 - 0
tests/t_index.LST

@@ -0,0 +1,12 @@
+Listing:
+
+    1  MODULE T;
+    2  VAR i : INTEGER;
+    3  BEGIN
+    4    i[0] := 1
+*****      ^ not an ARRAY type
+    5  END T.
+
+    1 error
+
+

+ 5 - 0
tests/t_index.mod

@@ -0,0 +1,5 @@
+MODULE T;
+VAR i : INTEGER;
+BEGIN
+  i[0] := 1
+END T.

+ 12 - 0
tests/t_ptr.LST

@@ -0,0 +1,12 @@
+Listing:
+
+    1  MODULE T;
+    2  VAR i : INTEGER;
+    3  BEGIN
+    4    i^ := 1
+*****     ^ not a POINTER type
+    5  END T.
+
+    1 error
+
+

+ 5 - 0
tests/t_ptr.mod

@@ -0,0 +1,5 @@
+MODULE T;
+VAR i : INTEGER;
+BEGIN
+  i^ := 1
+END T.

+ 12 - 0
tests/t_rel.LST

@@ -0,0 +1,12 @@
+Listing:
+
+    1  MODULE T;
+    2  VAR b : BOOLEAN;
+    3  BEGIN
+    4    b := 1 = TRUE
+*****             ^ incompatible comparison
+    5  END T.
+
+    1 error
+
+

+ 5 - 0
tests/t_rel.mod

@@ -0,0 +1,5 @@
+MODULE T;
+VAR b : BOOLEAN;
+BEGIN
+  b := 1 = TRUE
+END T.

+ 14 - 0
tests/t_return.LST

@@ -0,0 +1,14 @@
+Listing:
+
+    1  MODULE T;
+    2  PROCEDURE P;
+    3  BEGIN
+    4    RETURN 1
+*****           ^ bad RETURN
+    5  END P;
+    6  BEGIN
+    7  END T.
+
+    1 error
+
+

+ 7 - 0
tests/t_return.mod

@@ -0,0 +1,7 @@
+MODULE T;
+PROCEDURE P;
+BEGIN
+  RETURN 1
+END P;
+BEGIN
+END T.

+ 12 - 0
tests/t_undecl.LST

@@ -0,0 +1,12 @@
+Listing:
+
+    1  MODULE T;
+    2  VAR i : INTEGER;
+    3  BEGIN
+    4    i := nope + 1
+*****         ^ undeclared identifier
+    5  END T.
+
+    1 error
+
+

+ 5 - 0
tests/t_undecl.mod

@@ -0,0 +1,5 @@
+MODULE T;
+VAR i : INTEGER;
+BEGIN
+  i := nope + 1
+END T.

Неке датотеке нису приказане због велике количине промена