The ModulaTor logo 7KB

The ModulaTor

Oberon-2 and Modula-2 Technical Publication

The ModulaTor
Erlangen's First Independent Modula_2 Journal! Nr. 4/May-1992 
_____________________________________________________________

Yet Another Approach for Exception Handling in Modula-2 

by Igor I. Egorov, Ruslan P. Bogatyrev, Dmitry L. Petrovichev, Moscow Aviation Institute, 
Moscow, Russia 

From:     "Igor I. Egorov" <egor@air.mai.msk.su>
Date:     Wed, 8 Apr 1992 02:55:34 +0200

Abstract 

In this paper we describe our exception handling mechanism (EHM) approach and its 
implementation in a Modula-2 multiprocess environment. A comparative analysis of the 
various EHMs implemented in programming languages such as Ada, Modula-3, Eiffel and 
Clu is also presented. The goal of the approach and its implementation features are 
revealed on the base of this analysis. 

Key Words: exception handling, parallel processes, resource, finalization, Modula-2, Ada, 
Modula-3, Eiffel, Clu. 

Introduction 

Exception handling is an important programming language feature. Modula-2 as defined in 
[8] doesn't include EHM. It is important to note that the activities of the ISO-group 
SC22/WG13 are completing. The Modula-2 ISO Standard introduces new EHM. 
Nevertheless, we want to present our solution based on the experience made when 
implementing EHM in Modula-2.
 

For us as authors, it is most important to state the goal of our approach, which is not a 
survey of EHMs in programming languages. At first the notion of exception is discussed. 
Then the principal requirements for the proposed EHM are formulated, because they 
formed the base of our research. Then we give concise historical notes about other 
languages with build-in EHM. The main part of this paper presents the key aspects of our 
EHM. This includes an analysis of the positive and negative aspects of EHM's. Finally a 
concise description of a new closely related concept, the so-called resource guard is 
presented. As an illustration of the discussed ideas, the Modula-2 source code of some 
modules from our library is listed in the appendix. The code clarifies some implementation 
details. 

Notion of Exception 

The notion of exception plays an important role in programming, caused by need for 
facilities that allow to recognize and to correct various errors (non-standard situations) 
regardless of their nature. These errors can be hardware errors, incorrect input data and 
programming errors. Moreover, due to limited resources of computer systems, various 
non-standard situations may occur (out of representation range, shortage of RAM, out of 
space on peripheral devices, etc). 

A complication of the problem consists in the fact that exceptions may occur in any place of 
program at any time, and the number of possible exceptions may be very large. Non- 
ordinary nature of the situations pins a particular responsibility on the programmer who 
must foresee their occurence and possible consequences. So one of the most important 
requirement of EHM is simplicity. Only what can be understood in detail can be used 
properly. 

A principle for operation of EHM consists in the following. At first (before an execution of the 
program) a list of all possible exceptions is formed. This list may be linear or structured. 
Then, every possible "nets, traps and snares" that are responsible for an exception 
handling are spreaded at the program. They somehow are associated with a zone of 
occurence of the correspondent exceptions. Then (after running of the program), when an 
exception ha occured (independently or by calling special raising facilities) "freezing" of 
program execution is carried out, and the control is coercively transferred to the area of an 
exception handling that corresponds to the zone of "conflict". In this area which is distinctly 
separated from other program parts, the recognition of the exception is carried out. The 
reaction on the exception may be either immediate or delayed. In case of the delayed 
reaction, an exception is propagated "upward" where its fate will be decided. 

This principle is invariant for the various EHMs. It is not difficult to pay attention to one 
interesting thing. Since when an exception has occured, the normal program execution is 
interrupted and an exception may be considered as a software interrupt (analogously to 
notion of a hardware interrupt). Our approach is based on such (more expanded by 
comparison with conventional) treatment for notion of an exception. Under such treatment 
the using of exceptions can be both passive and active. In other words, we accentuate not 
only on an exception handling, but also on raising of exceptions. 

Principal Requirements for EHM 

One of the important reasons for the development of own EHM was the absence of such 
facilities in Modula-2. The point is not only our attachment to Modula-2. We merely didn't 
find any other programming language with acceptable EHM. 

What are the requirements for EHM? 

(1) EHM must be very simple and clear.
 

(2) EHM must allow an effective implementation in Modula-2.
 

(3) EHM must offer the convenient facilities for exception handling in a parallel environment 
(parallel/quasi-parallel processes). Yet another requirement is a portability of this EHM. 

Historical Notes 

In this survey, we cover the four most interesting programming languages (from our 
viewpoint), that have embedded EHMs: Ada, Modula-3, Eiffel and Clu. 

Ada [2] was developed by the United States Department of Defence at 1980 and took the 
present form at 1983 after affirmation of the correspondent ANSI Standard. The primary 
aim of the language is for the development of the large embedded systems. 

Modula-3 [5] is the result of collaboration of DEC Systems Research Center, Palo Alto, 
California and of Olivetti Research Center, Menlo Park, California (SRC). This language 
expands the possibilities of Modula-2 towards object-oriented programming, and features 
exception handling and reliable tools. Modula-3 was designed on the base of the 
experimental programming language Modula-2+ [4], that was designed at DEC Western 
Research Lab (WRL). A first description of Modula-3 have appeared in August 1988. The 
language is not stable, but it is developing permanently. The reference [7] presents one of 
the latest definition. 

Eiffel [6] was designed by Bertrand Meyer. The principal ideas of this language was 
formulated in the University of California, Santa Barbara. First description of Eiffel appeared 
in 1987. Along with an object-oriented approach and exception handling, this language 
presents an attempt in designing a language for reliable programming which is oriented to 
formal proving of program correctness. 

Clu [3] was burned due to Barbara Liskov. This language was directed on the teaching of 
the advanced programming techniques. Its name was formed due to the concept of cluster. 
The ideas of this language was formulated during the MAC Project, at the Massachusetts 
Institute of Technology. 

Key Aspects of EHM 

To ease the task of comparison of EHMs we notice the following key aspects. First aspect is 
a method for identification of exceptions. An exception handling directly depends on form 
for the designation of an exceptional situation. Then it is worth to mention the approaches 
for raising of exceptions. An exception as a rule can be raised both explicitly (by a 
raise-statement) and implicitly (as a result of an execution of embedded operators that have 
a fixed set of exceptions). The major aspect is recognition of exceptions and an exception 
handling. 

Recognition and handling are closely coupled with each other, next to the list of 
recognizable exceptions the associated handler is used for. Another aspect is resuming the 
of computation process after raising an exception. Here it is important to single out the 
resumption principle used in Eiffel. Yet another aspect is a propagation of exceptions. All 
reviewed languages support an hierarchy of exception handling, but ways of achieving of 
this goal vary. Finally, we discuss the behaviour of EHM in parallel environment which 
brings many other associated problems. 

This list of EHM aspects is far from complete. Thus, in our paper the problems of exception 
handling in object-oriented environments is not dealed with to keep the paper short. 

Before we start to describe our EHM, a few words about terminology. Unfortunately, a fixed 
terminology for exception handling is absent. So we use our own terminology. 

One of the most important notion is the difference between synchronous and asynchronous 
exceptions. The synchronous (internal) exceptions are exceptions that are raised by 
procedures or by embedded statements/operators belonged to the process. These 
exceptions are a consequence of an execution of computational process under concrete 
input data. The asynchronous (external) exceptions are exceptions that occur due to 
hardware events or are triggered by other processes. The hardware exceptions as a rule 
are handled by the special system-depended processes, and they don't occure in ordinary 
processes. 

Yet another notion is the exception level. It represents the pair consisting of two blocks 
(control block and block of exception handling). A control block is a syntactically separated 
program fragment where an occurence of the exception is controlled. A block of exception 
handling is a syntactically separated program fragment where the exceptions raised in the 
control block is handled. 

In our implementation most of facilities oriented to exception handling are concentrated in 
library module "Ex" (Appendix 1). 

Identification of Exceptions 

In our approach, an exception is denoted by a pair of identifiers. The first identifier is 
responsible for the module number, and second one is responsible for the error, that may 
occure inside this module. The module identifiers are CARDINAL constants defined in a 
special interface modules. Each module is intended for a description of one library layer. 
The module identifiers of the layer must be inside the fixed range, so that such ranges don't 
intersect. An error identifier is a CARDINAL constant that is defined for the exception raised 
by procedures of the module. In other words, the (absolute) identifier of exception consists 
of the module number and of the (relative) number of the associated exceptional situation. 
As parameter, the message string (for debugging purposes) may be associated with any 
exception, and also an exception can possess a LONGCARD argument. 

In Ada the reserved type "exception" is used. There is a number from the predefined 
exceptions: CONSTRAINT_ERROR, NUMERIC_ERROR, PROGRAMM_ERROR, 
STORAGE_ERROR, TASKING_ERROR. 

Exceptions in Modula-3 are defined not only as items of that data type - they can be 
parameterized by a data type. This way if "id" is an exception identifier and if "T" is a data 
type other than an open array type, then 

     EXCEPTION id(T)

 declares "id" as an exception with argument type "T". If "(T)" is omitted, the exception takes 
no arguments. The exceptions declarations are allowed at the top level of interfaces and 
modules only. 

In Eiffel the special class EXCEPTIONS is offered for an exception handling. Each 
exception is represented by an integer code. There are reserved exceptions, e.g. Overflow, 
No_more_memory, that are described in class EXCEPTIONS as symbolic constants 
(constant attributes in terms of Eiffel). 

In Clu exceptions are considered as optional attributes of procedures. So they are declared 
at procedure header. The keyword "signals" is used for this purpose. 

Raising of Exceptions 

Except for reserved exceptions generated by Modula-2 run-time system (the module 
identifier for such exceptions is 0), an explicit raising may be produced by following 
procedures (quasi- statements): 

  Raise (mod, err: CARDINAL; msg: ARRAY OF CHAR);

  RaiseArg (arg: LONGCARD; mod, err: CARDINAL; msg: ARRAY OF CHAR);

  RaisePos (pos: ADDRESS ; mod, err: CARDINAL; msg: ARRAY OF CHAR);

 The procedure "Raise" raises the exception with the identifier "mod, err" and with the 
message string "msg". The procedure "RaiseArg" is a kind of procedure "Raise" that allow 
to indicate additional parameter of occured exception (arg: LONGCARD). The procedure 
"RaisePos" is also a kind of "Raise". It is intended for the raising of exception with indication 
of occuring point (that is the place where it allegedly occured). 

In Ada exception raising is accomplished by following raising statement: 

  raise [exception_name]

 When statement "raise" has exception name, the indicated exception is raising. Statement 
"raise" without an exception name can be used only in an exception handler, and only if the 
handler is not placed in nested subroutine/package/task. This statement re-raises the same 
exception that caused an activation of the exception handler with this statement. 

In Modula-3 explicit raising of exceptions is achieved by special statement RAISE that can 
use an exception name both with argument and without one. 

For raising of exceptions in Eiffel, procedure "raise" is used which is declared in class 
EXCEPTIONS. As input parameter, the exception code is transmitted in this procedure. 

In Clu the statement "signal" is used for raising of exceptions. The statement "signal" is 
allowed to apply only when the name of associated exception is indicated in procedure 
header. This statement can be placed at any place of procedure body. An execution of 
statement "signal" is started by evaluation of expressions (if present) from the left to the 
right. As result, the list of results of the exception is formed. The evaluations are continued 
by calling procedure. 

Recognizing of Exceptions and Exception Handling 

The syntax of exception level in our implementation are as follows:  

  CASE  Ex.Case (ex)  OF
    Ex.TRY:      (* control_block *)
       . . .
  | Ex.INTERNAL: (* block_of_handling_of_internal_exceptions *)
      IF Ex.Name (mod1,err1) THEN handler_I1 END
      . . .
      IF Ex.Name (modN,errN) THEN handler_IN END
  | Ex.EXTERNAL: (* block_of_handling_of_external_exceptions *)
      IF Ex.Name (m1,e1) THEN handler_E1 END
      . . .
      IF Ex.Name (mM,eM) THEN handler_EM END
  END;  Ex.EndCase (ex);

An exception level is enclosed by the procedures "Case" and "EndCase", so that each level 
has its own header (variable "ex" of type "Ex.Ptr"). The function procedure "Case" evaluates 
a variable parameter which is the initialized header of the exception level, and returns as 
function result the name of the block of the exception level. 

The procedure "EndCase" controls the sequence of execution of blocks of the exception 
level. After completing of the level, it frees the header of this level. The breaking of the pair 
Case-EndCase by such statements as RETURN and EXIT is not allowed. Recognition of 
exceptions is performed in the corresponding exception handling blocks. For recognition 
purposes the following procedures can be used: 

     Name (mod,err: CARDINAL): BOOLEAN;
     NameMod  (mod: CARDINAL): BOOLEAN;
     Others (): BOOLEAN;

All procedures must be used in an IF-statement without ELSE-part. The procedure "Name" 
compares the identifier of the occured exception with the identifier defined by actual 
parameters of this procedure. In case of their identity the exception is marked as 
"recognized". If this exception wa recognized already before then procedure "Name" will 
always return "FALSE". The procedure "NameMod" is similar to procedure "Name". 
"NameMod" is useful in cases when it must be recognized that an exception was raised by 
procedures of the module. The procedure "Others" is also similar to "Name". It marks any 
occured exception as "recognized". This procedure has to be used carefully! 

The exception handling is defined in THEN-part of corresponding IF-statement. If 
THEN-part is empty then the exception is absorbed. Moreover, in the place it is allowed to 
use all procedures of exception raising and to define new nested exception levels. The 
module "Ex" also exports the procedure 

     Arg (): LONGCARD;

 that returns the argument value of the occured exception. If an argument was absent then, 
in turn, the exception "Ex.NotArg" is raised. 

The semantics of an exception level is as follows: At first the control block is executing. If no 
exception has occured during execution then the blocks of handling are ignored. Otherwise, 
the normal execution is suspended and the control is transfered to the corresponding block 
of handling (INTERNAL or EXTERNAL). In this block the recognition of an exception is 
performed. If one of exceptions whose identifier is defined by the actual parameters of 
procedure "Name" has occured, then the correspondent handler is executed. If the occured 
exception is not handled there then the exception "Ex.FatalExcept" is raised automatically. 
If in the exception handling block, yet another exception is raised before recognition of the 
occured exception, then it is transformed to "Ex.FatalExcept" and propagated "upwards". At 
that point both exception are lost. 

In Ada the recognition of exception is accomplished by the statement "when". It defines the 
handler corresponded to the exception. The handler area is syntactically separated from 
ordinary statements: 

     begin
       Body
     exception
       when id1    => Handler1
       . . .
       when idn    => Handlern
       when others => Handler0
     end

For recognizing of exceptions and for exception handling in Modula-3 the statement 
TRY-EXCEPT is used: 

     TRY
       Body
     EXCEPT
       id1 (v1) => Handler1
     | . . .
     | idn (vn) => Handlern
     ELSE          Handler0
     END;

Here, Body and each Handler are statement sequences, "id" is an exception identifier, and 
"v" is an exception argument. The "(vi)" and "ELSE Handler0" are optional. It is a static error 
(recognized at compilation) for an exception to be named more than once in the list of id's. 
The semantics of TRY-EXCEPT is defined as follows: 

At first Body is executed. If the outcome is normal, the EXCEPT clause is ignored. 
Otherwise, the normal execution is stopped, and the control is transferred to the EXCEPT 
clause. If Body raises any listed exception "idi", then the correspondent handler (Handleri) 
is executed. If an unlisted exception was raised, then ELSE-part is executed (Handler0). If 
the ELSE-part is omitted, then the exception is propagated upwards. Each "(vi)" declares a 
variable whose type is the argument type of the exception "idi" and whose scope is 
Handleri. When an exception "idi" paired with an argument "x" is handled, "vi" is initialized to 
"x" before Handleri is executed. It is a static error to include "vi" if exception "idi" doesn't 
take an argument. For generality the statement EXIT (exit from LOOP, WHILE, REPEAT, 
FOR) and the statement RETURN (return from procedure/function) are considered as 
exceptions. 

Also Modula-3 offers the finalization mechanism coupled with exception handling. The 
finalization statement is: 

     TRY s1 FINALLY s2 END;
 At first the statement sequence s1 is executed, and then s2 is executed regardless of 
possible exceptions (in s1). The main purpose of this statement consists of an execution of 
final actions directed to deallocate the seized resources. However, one question is open: 
What happens if an exception has occured not only in s1, but also in s2? In this case the 
information about first exception (in s1) is lost. 

In Eiffel the keyword "rescue" is used to syntactically separate the area where the 
recognition and the exception handling is accomplished. 

Thus, only one area of exception handling can be defined in a routine. The statement "if" 
can be used, for the recognition of exceptions in the rescue-part. 

For recognition of exceptions and for exception handling in Clu the statement "except" is 
used. The structure of the "except"-statement is: 

     Body
     except
       when id1: Handler1
       . . .
       when idn: Handlern
       others:   Handler0
     end

 Let's examine the semantics of this statement in detail. Body is the statement associated 
with the exception handlers. Each "when"- handler is associated with the name(s) of 
exceptions. Its body is executed only when the execution of Body generates an exception 
whose name is a listed name. All listed names must be different. The "others"-handler is 
used for handling of exceptions that are absent in the "when"-part. Any statement can be 
used as Body (including "except"). If during the execution of Body an exception is raised 
that isn't recognized in the "when"-part, and if the "others"-part is omitted, then the reserved 
exception "failure" is raised. In accordance with the Clu ideology it is mandatory that all 
occured exceptions must be handled (except for those exceptions that can't occur). So 
"failure" means that a program/system error has happened. This error must be analyzed by 
programmer. 

Resuming of computational process 

In reference [1] three possible types of actions are associated with the resuming of 
computational process. They are called "leave", "mark" and "analyze". The principle "leave" 
means that after the handling of the occured exception is completed, the control is 
transferred to the statement followed this exception level. The principle "mark" means that 
after completing of exception handling the control returns to the point followed the 
statement where the exception was raised. Finally, the principle "analyze" combines the 
above principles into one. Here, the statement "resume" can be used in the block of 
handling; its execution is equivalent to the principle "mark". In [1] it is clearly shown that the 
principle "leave" is the most acceptable one. Our approach (as well as Ada, Modula-3, and 
Clu's) supports this principle. 

In Eiffel the principle "leave" is expanded by the resumption mechanism, which essentialy is 
the attempt to fix the reasons for the exception and trying to execute the whole routine 
again. For this purpose, the statement "retry" is used at the end of "rescue"-section. 

Propagation of Exceptions 

Propagation of exceptions means nesting of the exception levels. In our approach the 
creation of new levels is allowed in both control block and block of exception handling. 
Propagation of exceptions (from our viewpoint) is raising of exceptions in the nearest 
enclosing exception level. It can is carried out three ways. 

(1) by explicitly raising an exception in the handler body.
 

(2) by re-raising an exception in the handler body (the procedure "RaiseNext").
 

(3) by implicitly raising the exception "Ex.FatalExcept" (if the occured exception was not 
recognized in block of exception handling). 

In Ada the propagation of exceptions can be both explicit and implicit. An explicit 
propagation is carried out by using the correspondent raising statements in area of 
exception handling. An implicit propagation of exceptions is carried out when a handler area 
is absent for the exception level or when the exceptions has occured in the handler. Actions 
in such situation depend on environment. One of the features of Ada is that an exception 
may occur not only in program block, but also in the predeclaration section of current 
environment. 

In Modula-3 exceptions are propagated upwards through nested contexts until the 
correspondent handler is found. This is carried out also in the EXCEPT-part of statement 
TRY-EXCEPT, when an explicit recognition of the occured exception or the ELSE-part is 
absent, 

In Eiffel propagation of exceptions is carried out according to the principle of "organized 
panic": bring all affected objects to a coherent state, and report failure. An important feature 
of the Eiffel EHM is that after completion of exception handling the "rescue"-part is called at 
the point where the procedure was raised. A procedure (routine in terms of Eiffel) which has 
no "rescue"-part is considered to have an empty one. 

In Clu propagation of exceptions can be carried out in different ways: 

(1) by explicitly raising an exception in the handler body.
 

(2) by an implicitly raising when the appropriate handler is absent (the exception "failure").
 

(3) by the statement "resignal". 

Parallel Processes 

In our approach the communication of parallel processes (analogous to Modula-2 
coroutines) is carried out by the special mechanism of the intermediate data areas (IDA) 
those are similar (for purpose) with Mascot-3 IDA. So an immediate interaction of 
processes by exception raising is used as a last resort (for example, killing of "rabid" 
processes, support of process hierarchy, etc). In our approach all exceptions are divided on 
two types: external exceptions and internal ones. Raising of an external exception is done 
by the procedure "Raise" from the module "LowProcess". 

An external exception can occur at any time. So a process can be either be in protected or 
unprotected mode. In protected mode raising of external exceptions is blocked; these 
exceptions are delayed until the process leaves protected mode. In unprotected mode 
occurence of external exceptions is allowed. These modes don't have influence on 
synchronous (internal) exceptions. An explicit control of these modes is carried out by the 
procedures "Protect" and "Unprotect" from module "LowProcess". An implicit control is 
carried out during a control transfer from the control block to the handling block. In doing so 
it is guaranteed that the whole handling block is in protected mode. When an exit from 
handling block is carried out, the old mode (at the time of creation of this exception level) is 
restored. 

In Ada there are two kinds of exceptions: 

(1) the exceptions that occur during a task activation, and
 

(2) those that occur during task execution. 

An activation of the tasks (and also an execution of the tasks) is carried out in parallel. If a 
task object is defined in the declaration section, then its activation will be started after 
pre-execution of declaration. If during an activation of a task an exception occurs, then the 
task is completed, and after an (successful or unsuccessful) activation of other tasks the 
exception TASKING_ERROR is raised. This exception is raised once even if a few tasks 
were completed in such way. An exception can influence on a task interaction and on an 
attempt of a task interaction. If an exception was raised during a rendez-vouz, then it can 
influence the calling task. 

Mechanism of parallel processes ("threads" in terms of Modula-3) is outside the language. 
This mechanism is supported by the module "Thread". The module can be modified 
depending on implementation. For support of asynchronous interrupts "Thread" offers 
single exception named "Alerted". To raise this exception in another process the procedure 
Alert is used: 

     Alert (thread:T);

 When the procedure is completed the process "thread" is marked "alerted". If one 
proceeds then, according to the definition of the module "Thread" in [5], it can be assumed 
that the exception "Alerted" is a non-ordinary exception. The module offers the procedure 

     TestAlert (): BOOLEAN;
 which returns TRUE, if the current process is marked "alerted". On the other hand, the 
procedures "AlertWait" and "AlertJoin" apparently raise the "genuine" exception "Alerted". 

In Eiffel and Clu the notion of parallel process is absent, so the problems of exception 
handling in such environment also are absent. 

Comparison of Languages 

It is obvious that most balanced EHM is presented in Modula-3. Its advantages are the 
enhanced facilities for identification of exceptions, the possibility if having more than one 
declaration exception handling area in the procedure body (as in Clu), and powerful 
facilities for exception handling in a parallel environment. 

One of the interesting features of Modula-3 is its finalization mechanism. By its introduction 
an attempt for simplification of exception handling is carried out. However, an 
implementation of finalization mechanism is not an advantage of this language. The point is 
that when an exception occurs in finalization part, the primary exception is lost. This way it 
is difficult to know the cause of execution of finalization part. As for environment of parallel 
processes, such an approach can't be considered successful. The idea of an associated 
recovery procedure with the areas of possible occurence of exceptions (not with resources) 
is also not considered successful. 

In this comparison, Ada can be considered to be placed at the opposite direction. In Ada it is 
difficult to find some interesting decisions for EHM. Ada has a strict attachment of the 
exception handling area to complete procedure. Due to many program units and 
predeclarations, Ada has a very complicated logic of exception handling and a primitive 
approach for the environment of parallel processes. 

Clu and Eiffel (from our viewpoint) are placed between the leader (Modula-3) and outsider 
(Ada). Clu is interesting due to clear decision and design of EHM. Eiffel offers the 
resumption mechanism (RETRY-mechanism)and is difficult to reject considering the 
improved program readability. However, the possibility that an infinite cycle could occur, is a 
serious argument against this mechanism. 

Advantages and Drawbacks of our EHM 

The experience with our implementation of EHM shows that there are several advantages: 

(1) Our EHM is a convenient framework of exception level. The CASE- and IF-statements 
are easy to use and to understand.
 

(2) Our approach did not require language changes to Modula-2. Now a punctual 
observance of agreements is needed.
 

(3) Our EHM allows to expand EHM to the domain of parallel processes by powerful 
mechanism of asynchronous interrupts. 

Moreover, our EHM inherits the most successful decisions of the languages Ada, Modula-3, 
Clu and Eiffel. After carefuly analysing the advantages and drawbacks, we intentionally 
abandoned such features as finalization and RETRY-mechanism. 

Certainly, the principal drawback comes from the decision to implement EHM without 
language extension. So static (i.e. compile time) control is absent. The identification of 
exceptions is unconvenient. Any change of the module numbers requires the recompilation 
of all modules at the correspondent library level. Also the parameterisation of exceptions is 
very limited. 

Notion of Resource Guard 

As it was noted above, we have moved the finalization problem on another level. For this 
purpose the notion of resource was introduced. Resource is set of components, that consist 
of data and associated procedures. These procedures allow to create, manipulate, and 
delete resources. All functions is primarilly oriented to work under normal conditions 
(without exceptions). For exceptions the notion of resource guard is introduced. A resource 
guard represents an additional set of data and special procedure that is responsible for 
putting of the resource in coherent state. The module "Guard" exports four procedures (see 
also Appendix 1): 

     New (life: Global.Life; size: CARDINAL; proc: Proc): Object;
     Del (VAR obj: Object);
     Exist (obj: Object): BOOLEAN;
     My    (obj: Object): BOOLEAN;

The procedure "New" is serves to create a resource guard. The input parameters are the 
guard existence area, size of guard descriptor in bytes (it is needed for an implicit automatic 
deallocation) and the resource procedure. The procedure "Del" is used for deletion of the 
guard. The procedure "Exist" can be used for checking of the fact that the guard is not 
destroyed. The procedure "My" is needed in cases when it is required to know that the 
guard belongs to current process. 

For each resource the notion of area of its existence is very important (parameter "life" for 
procedure "New"). We select two area types: "tmp" and "process", those are closly coupled 
with exception handling. Tmp-resource is intended for creation of temporary data that will 
be implicitly deallocated after completing of a control block. In this case, the connection 
before the deallocation of the guard procedure of this resource is called. 

Process-resource differs from tmp-resource in two aspects. 

(1) when the control block (this resource belongs to) is completed normally, then this 
resource is not deallocated, but is associated with the enveloping exception level.
 

(2) when the process is completed, all its process-resources are deallocated. 

Unfortunately, the framework of this paper doesn't allow to describe the resource 
mechanism in detail. Nevertheless, it is easy to see that the resource mechanism more 
precisely gives an idea of finalization. In our approach the recovery actions for an individual 
resource is collected in one place (guard procedure), and in a TRY-FINALLY mechanism 
the actions are dispersed. 

Comments for Appendices 

Below source code of some of our library modules is presented. These modules are in close 
relationship with exception handling. Our implementation was devloped under the MS-DOS 
environment (JPI TopSpeed V2.0). Certainly, the TopSpeed run-time library needed 
modifications. 

Appendix 1 includes the interfaces of the following modules: 

  Ex         (exception handling);
  ExReport   (reports about exceptions);
  Context    (low-level support of context switching);
  LowProcess (low-level scheduling of processes);
  LowGuard   (low-level support of resource guards);
  Guard      (resource management).

In Appendix 2, the source code of implementation module "Ex" is shown. Appendix 3 shows 
an example using our EHM method (computing of factorial). 

Conclusion 

Theoretical investigations and the practice of using of our EHM showed that our method is 
not optimal but oyr EHM shows some interesting features. Its principal advantage is that 
prvides new color to Modula-2 faded due to its young rivals - Modula-3 and Oberon-2. Our 
mechanism isn't part of the language Modula-2, so it can be implemented in other 
languages. 

During practical experiments with EHM, we discovered that it is possible to unify the reply 
on errors in library modules, do finalization and supporta mechanism for garbage collection. 
It is important to note the advantages gained by using the fullfledged EHM in (possibly 
distributed) environment of asynchronous processes. 

Unfortunately we were not able to review the EHM of the emerging Modula-2 ISO Standard, 
because at the time of writing only some working papers of ISO Group SC22/WG13 were 
available. 

References 

1. Young S.J. (1982) Real Time Languages: Design and Development. Ellis Horwood Ltd. 

2. Gehani N. (1984) Ada: An Advanced Introduction including Reference Manual for the 
Ada Programming Language. Prentice-Hall. 

3. Liskov B., Guttag J. (1986) Abstraction and Specification in Program Development. The 
MIT Press, Massachusetts. 

4. Rovner P., Levin R., Wick J. (1985) On Extending Modula-2 for Building Large, 
Integrated Systems. DEC SRC Report #3. 

5. Cardelli L., Donahue J., Glassman L., Jordan M., Kalsow B., Nelson G. (1989) Modula-3 
Report (revised). DEC SRC Report #52. 

6. Meyer B. (1989) From Structured Programming to Object-Oriented Design: The Road to 
Eiffel. Structured Programming, 10(1):19-39 

7. Nelson G. (1991) Systems Programming with Modula-3. Prentice-Hall. 

8. Wirth N. (1989) Programming in Modula-2. Springer Verlag. 

Appendix 1 

(* ------------------------------- *)
(*  All modules \251  1991,1992  AIR  *)
(* ------------------------------- *)

(*# call  (o_a_copy => off) *)

DEFINITION MODULE Ex;

  FROM    SYSTEM     IMPORT  ADDRESS;
  IMPORT  KernelLib;
  FROM    Global     IMPORT  Debug;
  IMPORT  ExReport;

  IMPORT  Context;
  IMPORT  LowGuard;

  CONST
    MODNUM  = KernelLib.Ex;
    MODNAME = "Ex";

    TRY      = 0;
    INTERNAL = 1;
    EXTERNAL = 2;

  TYPE
    Block   = [TRY..EXTERNAL];

    State  = ( external,                (* external exception                 *)
               begin_fn,                (* search of exception had began      *)
               argument,                (* exception with argument            *)
               raise,                   (* exception was happened             *)
               report,                  (* report done                        *)
               find );                  (* exception handler was found        *)
    Status = SET OF State;

    Ptr = POINTER TO Rec;
    Rec = RECORD
            context : Context.Rec;      (* context of beginning of ex level   *)
            control : Ptr;              (* previous ex level                  *)
            handler : Ptr;              (* ex handling block                  *)
            module  : CARDINAL;         (* module number                      *)
            error   : CARDINAL;         (* error number                       *)
            source  : ADDRESS;          (* point of ex raising                *)
            point   : CARDINAL;         (* depth of source                    *)
            message : ExReport.MessPtr; (* message about error                *)
            arg     : LONGCARD;         (* ex argument                        *)
            status  : Status;           (* status of ex level                 *)
            resource: LowGuard.Ptr;     (* list of Process-resources          *)
            tmp_res : LowGuard.Ptr;     (* list of Tmp-resources              *)
          END;

    ExceptProc = PROCEDURE ( Ptr );     (* procedure for exception handling   *)

(* -------------------------  PROCEDURES  ----------------------------------- *)

(*# call(reg_saved=>(st1,st2), set_jmp=>on) *)

  PROCEDURE  Case    ( VAR exc: Ptr ): Block;

(*# call(reg_saved=>(si,di,ds,st1,st2), set_jmp=>off) *)

  PROCEDURE  EndCase ( VAR exc: Ptr );

  PROCEDURE  Raise     ( mod: CARDINAL; err: CARDINAL; msg: ARRAY OF CHAR );
  PROCEDURE  RaiseArg  ( arg: LONGCARD; mod: CARDINAL; err: CARDINAL;
                         msg: ARRAY OF CHAR );
  PROCEDURE  RaisePos  ( pos: ADDRESS;  mod: CARDINAL; err: CARDINAL;
                         msg: ARRAY OF CHAR );
  PROCEDURE  RaiseExt  ( pos: ADDRESS;  mod: CARDINAL; err: CARDINAL );
  PROCEDURE  RaiseNext ;

  PROCEDURE  Name    ( mod, err: CARDINAL ): BOOLEAN;
  PROCEDURE  NameMod ( mod     : CARDINAL ): BOOLEAN;
  PROCEDURE  Other   (                    ): BOOLEAN;

  PROCEDURE  Arg (): LONGCARD;

  PROCEDURE  PointPush;
  PROCEDURE  PointPop;

  PROCEDURE  SetDebugProc   ( ep: ExceptProc );
  PROCEDURE  SetReportProc  ( ep: ExceptProc );

  PROCEDURE  Init;

(* ========================================================================== *)
(*                        MODULE Ex SUMMARY                                   *)
(* -------------------------------------------------------------------------- *)
(*                       Exception Handling                                   *)
(* -------------------------------------------------------------------------- *)
(*   PROCEDURES                                                               *)
(* .......................................................................... *)
(*     Case        - begin the exception level                                *)
(*       IN                                                                   *)
(*         exc       uninitialized header of ex level                         *)
(*       OUT                                                                  *)
(*         exc       initialized header of ex level                           *)
(*         return    identifier of ex level block                             *)
(*       REQUIRES    Procedure must be used only as parameter of              *)
(*                   CASE-statement. Inside CASE all possible variants must   *)
(*                   be presented ( TRY, INTERNAL, EXTERNAL )                 *)
(*       EFFECTS     Proc inits the header of ex level and controls sequence  *)
(*                   of execution of ex handling blocks by returning value    *)
(*       RAISE       SmallMem, FatalGuard                                     *)
(* .......................................................................... *)
(*     EndCase     - complete the exception level                             *)
(*       IN                                                                   *)
(*         exc       header of ex level                                       *)
(*       OUT                                                                  *)
(*         exc       free header of ex level                                  *)
(*       REQUIRES    Procedure must be called immediately after CASE-statement*)
(*                   The header of this ex level must be transfered as        *)
(*                   its parameter.                                           *)
(*       EFFECTS     Proc controls sequence of execution of ex level blocks   *)
(*                   and frees the header of ex level after level completing. *)
(*                   If ex handling block was completed, but the exception    *)
(*                   is not identified then FatalExcept raises (for internal  *)
(*                   ex) or this exception is reraised (for external ex).     *)
(*       RAISE       BadPtr, FatalGuard, FatalExcept                          *)
(* -------------------------------------------------------------------------- *)
(*     Raise       - raise the exception                                      *)
(*       IN                                                                   *)
(*         mod       module number                                            *)
(*         err       error  number                                            *)
(*         msg       message string                                           *)
(*       REQUIRES    As parameter "mod", "MODNUM" of current module must be   *)
(*                   used. "err" must be in the range [BeginEX..EndEX] for    *)
(*                   current module.                                          *)
(*       EFFECTS     Normal execution of program is suspended,                *)
(*                   debug  procedure is called (SetDebugProc ),              *)
(*                   report procedure is called (SetReportProc), and          *)
(*                   IF    it is called in control block   THEN               *)
(*                     block of handling for current ex level is executed     *)
(*                   ELSIF it is called in handling block  THEN               *)
(*                     IF exception is identified  THEN                       *)
(*                       the exception is propagated,                         *)
(*                       that is the current exception level is destructed,   *)
(*                       the level in whose destructed level was nested is    *)
(*                       becomimg the new current level,                      *)
(*                       the exception handling is carried out on the new     *)
(*                       current level (WITHOUT calls of debug procedure and  *)
(*                       of report procedure.                                 *)
(*                     ELSE                                                   *)
(*                       the exception "FatalExcept" is raised,               *)
(*                       that is the current exception level is destructed,   *)
(*                       the level in whose destructed level was nested is    *)
(*                       becomimg the new current level,                      *)
(*                       the exception handling is carried out on the new     *)
(*                       current level (WITH calls of debug procedure and     *)
(*                       of report procedure.                                 *)
(*                     END                                                    *)
(*                   END                                                      *)
(*       RAISE       FatalExcept                                              *)
(* .......................................................................... *)
(*     RaiseArg    - raise the exception with argument                        *)
(*       IN                                                                   *)
(*         arg       argument of exception                                    *)
(*         mod       module number                                            *)
(*         err       error  number                                            *)
(*         msg       message string                                           *)
(*       REQUIRES    See Raise                                                *)
(*       EFFECTS     See Raise                                                *)
(*       RAISE       FatalExcept                                              *)
(* .......................................................................... *)
(*     RaisePos    - raise the exception with indication of place             *)
(*       IN                                                                   *)
(*         pos       place of exception occurence                             *)
(*         mod       module number                                            *)
(*         err       error  number                                            *)
(*         msg       message string                                           *)
(*       REQUIRES    See Raise                                                *)
(*       EFFECTS     See Raise                                                *)
(*       RAISE       FatalExcept                                              *)
(* .......................................................................... *)
(*     RaiseExt    - raise the external exception                             *)
(*       IN                                                                   *)
(*         pos       place of exception occurence                             *)
(*         mod       module number                                            *)
(*         err       error  number                                            *)
(*       REQUIRES    See Raise                                                *)
(*                   it must be called from LowProcess only.                  *)
(*       EFFECTS     See Raise                                                *)
(*       RAISE       FatalExcept                                              *)
(* .......................................................................... *)
(*     RaiseNext   - propagate the exception                                  *)
(*       REQUIRES    It must be used in handling block ONLY                   *)
(*       EFFECTS     Normal execution of program is suspended,                *)
(*                   debug  procedure is called (SetDebugProc ),              *)
(*                   report procedure is called (SetReportProc), and          *)
(*                       the exception is propagated,                         *)
(*                       that is the current exception level is destructed,   *)
(*                       the level in whose destructed level was nested is    *)
(*                       becomimg the new current level,                      *)
(*                       the exception handling is carried out on the new     *)
(*                       current level.                                       *)
(*                   However, if occured exception was not identified, then   *)
(*                   the exception FatalExcept will be raised.                *)
(*       RAISE       BadCall, FatalExcept                                     *)
(* -------------------------------------------------------------------------- *)
(*     Name        - identify the occured exception                           *)
(*       IN                                                                   *)
(*         mod       module number                                            *)
(*         err       error  number                                            *)
(*       OUT                                                                  *)
(*         return    TRUE, if occured exception is identified by "mod" and    *)
(*                   "err".                                                   *)
(*       REQUIRES    It must be used in handling block ONLY                   *)
(*       EFFECTS     It compares the identifier of occured exception and the  *)
(*                   identifier defined by actual parameters of Name.         *)
(*                   If identification of an exception carried out already    *)
(*                   (by Name, NameMod, Other), then this procedure returns   *)
(*                   FALSE.                                                   *)
(*       RAISE       BadCall                                                  *)
(* .......................................................................... *)
(*     NameMod     - identify the occured exception by the module number      *)
(*       IN                                                                   *)
(*         mod       module number                                            *)
(*       OUT                                                                  *)
(*         return    TRUE, if occured exception is identified by "mod" and    *)
(*                   "err".                                                   *)
(*       REQUIRES    It must be used in handling block ONLY                   *)
(*       EFFECTS     It compares the identifier of occured exception and the  *)
(*                   identifier defined by actual parameter of NameMod.       *)
(*                   If identification of an exception carried out already    *)
(*                   (by Name, NameMod, Other), then this procedure returns   *)
(*                   FALSE.                                                   *)
(*       RAISE       BadCall                                                  *)
(* .......................................................................... *)
(*     Other       - identify any occured exception                           *)
(*       OUT                                                                  *)
(*         return    TRUE                                                     *)
(*       REQUIRES    It must be used in handling block ONLY                   *)
(*                   and very CAREFULLY !                                     *)
(*       EFFECTS     If identification of an exception carried out already    *)
(*                   (by Name, NameMod, Other), then this procedure returns   *)
(*                   FALSE.                                                   *)
(*       RAISE       BadCall                                                  *)
(* -------------------------------------------------------------------------- *)
(*     Arg         - get argument of exception                                *)
(*       OUT                                                                  *)
(*         return    argument of occured exception                            *)
(*       REQUIRES    It must be used in handling block ONLY                   *)
(*       EFFECTS     If the exception was raised by RaiseArg, then            *)
(*                   Arg returns the actual parameter ("arg") of procedure.   *)
(*       RAISE       BadCall, NotArg                                          *)
(* -------------------------------------------------------------------------- *)
(*     PointPush   - increment the nesting level for point of exception       *)
(*                   raising                                                  *)
(*       EFFECTS     When an exception is raised (by Raise or RaiseArg) the   *)
(*                   report procedure can know the point of exception         *)
(*                   occurence by access to field "source".                   *)
(*                   Usually this point is a place in program from whose the  *)
(*                   call of Raise was carried out (zero nesting level).      *)
(*                   When nesting level is incremented the value of field     *)
(*                   "source" points to the place from whose the procedure    *)
(*                   (where the exception was raised) was called.             *)
(*                   PointPush increments a nesting level, and                *)
(*                   PointPop  decrements it.                                 *)
(*       RAISE       none                                                     *)
(* .......................................................................... *)
(*     PointPop    - decrement the nesting level for point of exception       *)
(*       EFFECTS     See PointPush                                            *)
(*       RAISE       none                                                     *)
(* -------------------------------------------------------------------------- *)
(*     SetDebugProc  define the debug procedure                               *)
(*       IN                                                                   *)
(*         ep        the debug procedure                                      *)
(*       REQUIRES    No actions must be executed by the debug procedure, and  *)
(*                   all checkings (stack overflow, out of range, etc) must be*)
(*                   absent.                                                  *)
(*       EFFECTS     Just past an exception is raised, the debug procedure is *)
(*                   called. This possibility can be used during debugging by *)
(*                   setting of breakpoint in this procedure.                 *)
(*       RAISE       none                                                     *)
(* .......................................................................... *)
(*     SetReportProc define the report procedure                              *)
(*       IN                                                                   *)
(*         ep        the report procedure                                     *)
(*       EFFECTS     The report procedure is called when the exception is     *)
(*                   occured BEFORE its handling.                            *)
(*                   If during execution of the report procedure an exception *)
(*                   is occured, then execution is interrupted, second call is*)
(*                   not carried out, and information about this exception is *)
(*                   lost.                                                    *)
(*       RAISE       none                                                     *)
(* -------------------------------------------------------------------------- *)
(*     Init       -  initialize this module                                   *)
(*       REQUIRES    It must be called when RTS is initialized.               *)
(*                   The next calls are ignored.                              *)
(*       EFFECTS     It initializes this module.                              *)
(*       RAISE       none                                                     *)
(* ========================================================================== *)
(*   NOTES                                                                    *)
(*     1.  Example of using:                                                  *)
(*                                                                            *)
(*    VAR  ex: Ex.Ptr;               (* header of exception level          *) *)
(*    .  .  .                                                                 *)
(*    TTIO.RdStr (s);                                                         *)
(*    CASE  Ex.Case(ex)  OF          (* beginning of exception level       *) *)
(*      Ex.TRY:                      (*   control block                    *) *)
(*         .  .  .                                                            *)
(*        StrNum.StrToCard (s,n);                                             *)
(*        IF (n > N) THEN Ex.Raise(MODNUM,255,"!!!") END;                     *)
(*         .  .  .                                                            *)
(*    | Ex.INTERNAL:                  (*   handling block for internal exs *) *)
(*         .  .  .                                                            *)
(*        IF Ex.Name    ( MODNUM, 255 )   THEN . . . END;                     *)
(*        IF Ex.NameMod ( StrNum.MODNUM ) THEN . . . END;                     *)
(*         .  .  .                                                            *)
(*    | Ex.EXTERNAL:                  (*   handling block for external exs *) *)
(*         .  .  .                                                            *)
(*    END;  Ex.EndCase(ex);          (* end of exception level             *) *)
(*    .  .  .                                                                 *)
(*                                                                            *)
(* ========================================================================== *)

  CONST
(* -------------------------  EXCEPTIONS  ----------------------------------- *)
  BeginEX          = 1;(*                                                     *)
  SmallMem       = 1;(* Too small memory for exception level initialisation   *)
  FatalGuard     = 2;(* Exception in guard procedure                          *)
  FatalExcept    = 3;(* Exception handling is absent                          *)
  BadCall        = 4;(* Wrong call (outside exception handling block)         *)
  BadPtr         = 5;(* Wrong header of the exception level                   *)
  NotArg         = 6;(* Exception has not arguments                           *)
  EndEX            = 6;(*                                                     *)
(* -------------------------------------------------------------------------- *)

(*%T Debug *)
  TYPE
    ExType    = ARRAY [BeginEX..EndEX] OF ExReport.Message;

  CONST
    ExMSG =  ExType(
                "Too small memory for exception level initialisation",
                "Exception in guard procedure",
                "Exception handling is absent",
                "Wrong call (outside exception handling block)",
                "Wrong header of the exception level",
                "Exception has not arguments");
(*%E *)

END  Ex.

DEFINITION MODULE  ExReport;

  IMPORT  KernelLib;

  CONST
    MODNUM  = KernelLib.ExReport;
    MODNAME = "ExReport";

  TYPE
    Message = ARRAY [0..59] OF CHAR;
    MessPtr = POINTER TO Message;

(* --------------------------  PROCEDURES  ---------------------------------- *)

  PROCEDURE  Type  ( modnum: CARDINAL; modname: ARRAY OF CHAR;
                     err   : CARDINAL; message: ARRAY OF Message);

  PROCEDURE  Init;

(* ---------------------  GLOBAL RECONFIGURATION  --------------------------- *)
  VAR
    show : BOOLEAN; (* must be showed the message?                            *)
    first: PROC;    (* the procedure executed BEFORE an output of message     *)
(* -------------------------------------------------------------------------- *)

(* ---------------------  LOCAL  RECONFIGURATION  --------------------------- *)

  PROCEDURE  Show  ( new: BOOLEAN; VAR old: BOOLEAN );

(* ========================================================================== *)
(*                     MODULE ExReport SUMMARY                                *)
(* -------------------------------------------------------------------------- *)
(*                    Reports about exceptions                                *)
(* -------------------------------------------------------------------------- *)
(*   VARS                                                                     *)
(*     show        - must be showed the message?                              *)
(*     first       - the procedure executed BEFORE an output of message       *)
(* -------------------------------------------------------------------------- *)
(*   PROCEDURES                                                               *)
(*     Type        - type (on screen) the message about exception occurence   *)
(*       IN                                                                   *)
(*         modnum    module number                                            *)
(*         modname   module name                                              *)
(*         err       error number                                             *)
(*         message   message                                                  *)
(*       EFFECTS     If an output is allowed (see "show" and "Show"), it types*)
(*                   the message about exception.                             *)
(*                   The procedure "first" is called immediately BEFORE       *)
(*                   an output of message.                                    *)
(*       RAISE       none                                                     *)
(* .......................................................................... *)
(*     Show        - must be showed the message?                              *)
(*       IN                                                                   *)
(*         new       new state (TRUE/FALSE)                                   *)
(*       OUT                                                                  *)
(*         old       old state (TRUE/FALSE)                                   *)
(*       EFFECTS     It sets the new state of message output and returns old  *)
(*                   state. It changes the state for current process ONLY.    *)
(*       RAISE       none                                                     *)
(* -------------------------------------------------------------------------- *)
(*     Init       -  initialize this module                                   *)
(*       REQUIRES    It must be called when RTS is initialized.               *)
(*                   The next calls are ignored.                              *)
(*       EFFECTS     It initializes this module.                              *)
(*       RAISE       none                                                     *)
(* ========================================================================== *)
(*   NOTES                                                                    *)
(*     1. Global reconfiguration must be carried out BEFORE using of this     *)
(*        module by many processes, because the prior preparation of local    *)
(*        states (for the individual process) is carried out on the base of   *)
(*        the global reconfiguration.                                         *)
(*     2. An output of the messages is carried out regardless of suppression  *)
(*        of the correspondent exception.                                     *)
(*     3. The procedure "first" will be called once and only when an output of*)
(*        messages is allowed.                                                *)
(*     4. The procedure "Init" is intended for special purposes, for support  *)
(*        of the exact order of kernel module initialization.                 *)
(*              .         *)
(*        Ordinary call of this procedure will be ignored.                    *)
(* ========================================================================== *)

END  ExReport.

DEFINITION MODULE  Context;

  IMPORT  SYSTEM;
  IMPORT  KernelLib;

  CONST     MODNUM  = KernelLib.Context;
(*  MODNAME = "Context"; *)

  TYPE
    TBYTEREAL = ARRAY [0..9] OF BYTE;
    Ptr       = POINTER TO Rec;
    Rec       = RECORD
                  e_sp   : CARDINAL; (* -*                                   0*)
                  e_flag : CARDINAL; (*  |                                   2*)
                  e_cs   : CARDINAL; (*  |                                   4*)
                  e_ip   : CARDINAL; (*  |                                   6*)
                  e_bp   : CARDINAL; (*  |- area for saving of registers     8*)
                  st1    : TBYTEREAL;(*  |                                  10*)
                  st2    : TBYTEREAL;(* -*                                  20*)
                  old_cs : CARDINAL; (* -*                                  30*)
                  old_ip : CARDINAL; (*  |- area for saving of stack frame  32*)
                  old_bp : CARDINAL; (* -*                                  34*)
                  dll_sp : CARDINAL; (*  sp for DLL                         36*)
                  pri    : CARDINAL; (* level of hardware priority          38*)
                  protect: CARDINAL; (* level of protection from extrn.excs 40*)
                END; (*RECORD*)

(* -------------------------  PROCEDURES  ----------------------------------- *)
(*# call(reg_saved=>(st1,st2), set_jmp=>on) *)
  PROCEDURE  Save    ( rec: Ptr ): BOOLEAN;

(*# call(reg_saved=>(si,di,ds,st1,st2), set_jmp=>off) *)
  PROCEDURE  Restore ( rec: Ptr );

  PROCEDURE  Src     ( VAR bp: CARDINAL; VAR src: SYSTEM.ADDRESS );
  PROCEDURE  SrcPrev ( VAR bp: CARDINAL; VAR src: SYSTEM.ADDRESS );

(* ========================================================================== *)
(*                     MODULE Context SUMMARY                                 *)
(* -------------------------------------------------------------------------- *)
(*              Low-level support of context switching                        *)
(* -------------------------------------------------------------------------- *)
(*     Save        - save the context                                         *)
(*       IN                                                                   *)
(*         res     - area for saving of context                               *)
(*       OUT                                                                  *)
(*         return    TRUE , if the context is saved                           *)
(*                   FALSE, if the context is restored                        *)
(*       EFFECTS     It saves the current context of process in pointed area  *)
(*       RAISE       none                                                     *)
(* .......................................................................... *)
(*     Restore     - restore the context                                      *)
(*       IN                                                                   *)
(*         res     - area contained the saved context                         *)
(*       EFFECTS     The return from procedure is made in the point of context*)
(*                   saving where "return" = FALSE.                           *)
(*       RAISE       none                                                     *)
(* -------------------------------------------------------------------------- *)
(*     Src         - get the record for procedure calling                     *)
(*       OUT                                                                  *)
(*         bp        pointer to the previous record ( register bp )           *)
(*         src       point of calling of current procedure ( cs:ip )          *)
(*       RAISE       none                                                     *)
(* .......................................................................... *)
(*     SrcPrev     - get the previous record for procedure calling            *)
(*       IN                                                                   *)
(*         bp        pointer to the current record                            *)
(*       OUT                                                                  *)
(*         bp        pointer to the previous record ( register bp )           *)
(*         src       point of calling of current procedure ( cs:ip )          *)
(*       RAISE       none                                                     *)
(* ========================================================================== *)
(*   NOTES                                                                    *)
(*     1. This module is system-dependent.                                    *)
(*     2. This module is intended for the module Ex only.                     *)
(* ========================================================================== *)

END  Context.

DEFINITION MODULE  LowProcess;

  FROM    SYSTEM  IMPORT  ADDRESS;
  IMPORT  KernelLib;
  IMPORT  Ex;

  CONST
    MODNUM  = KernelLib.LowProcess;
(*  MODNAME = "LowProcess"; *)

  TYPE
    RaisePtr = POINTER TO RaiseRec;
    RaiseRec = RECORD
                 next: RaisePtr;
                 mod : CARDINAL;
                 err : CARDINAL;
               END;

    Ptr = POINTER TO Rec;
    Rec = RECORD
            reserv : CARDINAL;       (* reserve       (    -1 )               *)
            call   : CARDINAL;       (* call far      ( 9A90H )               *)
            call_ip: CARDINAL;       (* sc:ip of procedure for prior handling *)
            call_cs: CARDINAL;       (* the exceptions LowProcess$IntHandler  *)
            swap_sp: CARDINAL;       (* ss:sp of process in switching moment  *)
            swap_ss: CARDINAL;       (*                                       *)
            pri    : CARDINAL;       (* level of hardware priority            *)
            protect: CARDINAL;       (* level of protection from processes    *)
            ext    : ADDRESS;        (* extentions of process descriptor      *)
            raise  : RaisePtr;       (* list of external exceptions of process*)
            control: Ex.Ptr;         (* previous exception level              *)
            handler: Ex.Ptr;         (* block of exception handling           *)
            except : Ex.Ptr;         (* process handles an exception          *)
          END;

    PtrPtr = POINTER TO RecPtr;
    RecPtr = RECORD
               cp: Ptr;
             END;

  VAR
    cpp: PtrPtr;

(* --------------------------  PROCEDURES  ---------------------------------- *)

(*# call(reg_saved=>(es,ds,si,di,st1,st2),reg_param=>()) *)

  PROCEDURE New     (p: PROC; adr  : ADDRESS; size: CARDINAL; VAR id: Ptr);

(*# call(reg_saved=>(es,ds,si,di,st1,st2),reg_param=>(ax,bx,cx,dx)) *)

  PROCEDURE Transfer   ( to: Ptr );
  PROCEDURE IoTransfer ( to: Ptr; vec: CARDINAL );

(*# call(reg_saved=>(si,di,ds,st1,st2)) *)

  PROCEDURE  di;
  PROCEDURE  ei;

  PROCEDURE  Protect;
  PROCEDURE  Unprotect;

  PROCEDURE  Raise ( process: Ptr; raise: RaisePtr );

(* ========================================================================== *)
(*                       MODULE LowProcess SUMMARY                            *)
(* -------------------------------------------------------------------------- *)
(*            Low-level scheduling of processes ( coroutines )                *)
(* -------------------------------------------------------------------------- *)
(*   VARS                                                                     *)
(*     cpp         - pointer to pointer to current process                    *)
(* -------------------------------------------------------------------------- *)
(*   PROCEDURES                                                               *)
(*     New         - create the new process                                   *)
(*       IN                                                                   *)
(*         p         base procedure                                           *)
(*         adr       address of memory where both descriptor of process and   *)
(*                   its stack will be placed                                 *)
(*         size      size of memory (in bytes)                                *)
(*       OUT                                                                  *)
(*         id        process identifier (pointer to process descriptor)       *)
(*       REQUIRES    Size of memory must be sufficient for descriptor         *)
(*                   (TSIZE(Rec)) and for stack ( min : 452 - for coprocessor *)
(*                   emulator + 100H - for stack of low-level procedures.     *)
(*                   The size is not checked.                                 *)
(*       EFFECTS     It creates process descriptor, initializes stack of this *)
(*                   process, and returns the pointer. Switching of control   *)
(*                   new process is not occured.                              *)
(*       RAISE       none                                                     *)
(* -------------------------------------------------------------------------- *)
(*     Transfer    - switch control to pointed process                        *)
(*       IN                                                                   *)
(*         to        process identifier                                       *)
(*       EFFECTS     Switching of control to pointed process is produced      *)
(*       RAISE       CorruptProcess                                           *)
(* .......................................................................... *)
(*     IoTransfer  - attach the interrupt vector                              *)
(*       IN                                                                   *)
(*         to        process identifier                                       *)
(*         vec       interrupt vector                                         *)
(*       EFFECTS     Current process is suspended and the control switches to *)
(*                   the process "to". Resuming of interrupted process was    *)
(*                   happened when the correspondent interrupt is occured or  *)
(*                   when the explicit transfer was produced by procedures    *)
(*                   Transfer/IoTransfer.                                     *)
(*       RAISE       CorruptProcess                                           *)
(* -------------------------------------------------------------------------- *)
(*     di          - disable hardware interrupts (take in consideration the   *)
(*                   nesting )                                                *)
(*       EFFECTS     Hardware interrupt (in current process) are disable and  *)
(*                   field "pri" is incremented.                              *)
(*       RAISE       none                                                     *)
(* .......................................................................... *)
(*     ei          - enable hardware interrupts (take in consideration the    *)
(*                   nesting )                                                *)
(*       EFFECTS     Field "pri" is decremented, and if its value is 0, then  *)
(*                   the hardware interrupts in current process is enabled.   *)
(*                   If "pri" is 0 before calling of "ei", then it is not     *)
(*                   changed, and the hardware interrupts is enabled.         *)
(*       RAISE       none                                                     *)
(* -------------------------------------------------------------------------- *)
(*     Protect     - protect the process from external influences (take in    *)
(*                   consideration the nesting)                               *)
(*       EFFECTS     Raising of external exceptions in current process is     *)
(*                   blocked, field "protect" in descriptor is incremented.   *)
(*       RAISE       none                                                     *)
(* .......................................................................... *)
(*     Unprotect   - allow the external influences                            *)
(*       EFFECTS     Field "protect" is decremented, and if its value is 0,   *)
(*                   then the external exceptions in current process is       *)
(*                   enabled.                                                 *)
(*                   If "protect" is 0 before calling of "Unprotect", then it *)
(*                   is not changed, and the external influences is enabled.  *)
(*       RAISE       none                                                     *)
(* .......................................................................... *)
(*     Raise       - raise the exception                                      *)
(*       IN                                                                   *)
(*         process   process identifier (pointer to process descriptor)       *)
(*         raise     pointer to structure contained exception identifier      *)
(*       REQUIRES    "raise" must point to segment boundary                   *)
(*       EFFECTS     Structure "raise" is added to the end of list "raise"    *)
(*                   that started in descriptor of process "process".         *)
(*                   When the control switching to the pointed process is     *)
(*                   occured, if field "protect" is 0 and the process don't   *)
(*                   handle an exception ("except" = NIL), then first item of *)
(*                   list "raise" is taken, the exception is raised, and the  *)
(*                   memory of descriptor is deallocated.                     *)
(*                   If the pointer "process" is invalid, then no actions are *)
(*                   executed.                                                *)
(*       RAISE       none                                                     *)
(* ========================================================================== *)
(*   NOTES                                                                    *)
(*     1. This module is system-dependent.                                    *)
(* ========================================================================== *)

  CONST
(* -------------------------  EXCEPTIONS  ----------------------------------- *)
  BeginEX      = 72;  (*                                                      *)
    StopProcess      = 72;   (* StopProcess - Corrupt Process                 *)
    CorruptProcess   = 73;   (* TRANSFER - Corrupt Process                    *)
  EndEX        = 73;  (*                                                      *)
(* -------------------------------------------------------------------------- *)

END  LowProcess.

DEFINITION MODULE  LowGuard;

  FROM    SYSTEM  IMPORT  ADDRESS;
  IMPORT  KernelLib;

  CONST
    MODNUM  = KernelLib.LowGuard;
    MODNAME = "LowGuard";

  CONST
    TmpId     = 1;
    ProcessId = 2;

  TYPE
    Proc   = PROCEDURE  ( ADDRESS );  (* guard procedure                      *)
    Ptr    = POINTER TO Rec;
    Rec    = RECORD
               ident : CARDINAL;   (* identifier of guard type (MAGIC)        *)
               size  : CARDINAL;   (* total size of guard data                *)
               next  : Ptr;        (* pointer to the next guard               *)
               proc  : Proc;       (* guard procedure                         *)
               object: ADDRESS;    (* pointer to header of guard list         *)
             END;

(* -------------------------  PROCEDURES  ----------------------------------- *)

  PROCEDURE  Add ( tmp: BOOLEAN; guard: Ptr );
  PROCEDURE  Rem ( guard: Ptr );

(* ========================================================================== *)
(*                     MODULE LowGuard SUMMARY                                *)
(* -------------------------------------------------------------------------- *)
(*                Low-level support of resource guards                        *)
(* -------------------------------------------------------------------------- *)
(*   PROCEDURES                                                               *)
(*     Add         - add the guard of "tmp/process"-resource                  *)
(*       IN                                                                   *)
(*         tmp       TRUE , if it is tmp-resource                             *)
(*                   FALSE, if it is process-resource                         *)
(*         guard     pointer to guard structure                               *)
(*       REQUIRES    Fields "ident", "size", "proc", "object"  must be        *)
(*                   initialized already                                      *)
(*       EFFECTS     The "guard" is inserted in beginning of list consisted   *)
(*                   from the guards belonged to the associated tmp/process-  *)
(*                   object                                                   *)
(*       RAISE       none                                                     *)
(* .......................................................................... *)
(*     Rem         - remove the guard of "tmp/process"-resource               *)
(*       IN                                                                   *)
(*         guard     pointer to guard                                         *)
(*       EFFECTS     It searches the pointed resource, and if the resource is *)
(*                   found, then it is removed from the list                  *)
(*       RAISE       none                                                     *)
(* ========================================================================== *)
(*   NOTES                                                                    *)
(*     1. This module is intended for the module Guard.                       *)
(*     2. The procedures Add and Rem is not responsible for                   *)
(*        the allocation/deallocation of memory.                              *)
(*     3. In the addition of resource guard, it is bound to current exception *)
(*        level.                                                              *)
(* ========================================================================== *)

END  LowGuard.

DEFINITION MODULE  Guard;     (* CLASS *)

  IMPORT  SYSTEM;
  IMPORT  KernelLib;
  IMPORT  Global;
  FROM    Global  IMPORT  Debug;

(*%T Debug *)
  IMPORT  ExReport;
(*%E       *)

  CONST
    MODNUM  = KernelLib.Guard;
    MODNAME = "Guard";

  TYPE
    Object = SYSTEM.ADDRESS;
    Proc   = PROCEDURE  ( Object );            (* guard procedure         *)

(* --------------------------  PROCEDURES  ---------------------------------- *)

  PROCEDURE  New  ( life: Global.Life; size: CARDINAL; proc: Proc ): Object;
  PROCEDURE  Del  ( VAR obj: Object );
  PROCEDURE  Exist(     obj: Object ): BOOLEAN;
  PROCEDURE  My   (     obj: Object ): BOOLEAN;

(* ========================================================================== *)
(*                         MODULE Guard SUMMARY                               *)
(* -------------------------------------------------------------------------- *)
(*                         Resource Management                                *)
(* -------------------------------------------------------------------------- *)
(*   PROCEDURES                                                               *)
(*     New         - create new object                                        *)
(*       IN                                                                   *)
(*         life      life time of object                                      *)
(*         size      size of object (in bytes)                                *)
(*         proc      guard procedure                                          *)
(*       OUT                                                                  *)
(*         return    pointer to object                                        *)
(*       REQUIRES    "proc" = NIL may be used,                                *)
(*                   call of such procedure is ignored,                       *)
(*                   max size of object is MAX(CARDINAL)-TSIZE(LowGuard.Rec)  *)
(*       EFFECTS     It creates an object and returns the pointer             *)
(*       RAISE       BadSize, SmallMem                                        *)
(* .......................................................................... *)
(*     Exist       - check existence of object                                *)
(*       IN                                                                   *)
(*         self      pointer to object                                        *)
(*       OUT                                                                  *)
(*         return    TRUE  if the object exists                               *)
(*       EFFECTS     It checks existence of the object                        *)
(*       RAISE       none                                                     *)
(* .......................................................................... *)
(*     My          - identify the object                                      *)
(*       IN                                                                   *)
(*         obj       pointer to object                                        *)
(*       OUT                                                                  *)
(*         return    TRUE, if the object belongs to current exception level   *)
(*                   or to current process                                    *)
(*       EFFECTS     It identifies an object                                  *)
(*       RAISE       BadObj                                                   *)
(* .......................................................................... *)
(*     Del         - delete the object                                        *)
(*       IN                                                                   *)
(*         obj       pointer to object                                        *)
(*       OUT                                                                  *)
(*         obj       empty pointer (NIL)                                      *)
(*       REQUIRES    "obj" must be the pointer to an existing object          *)
(*       EFFECTS     It deletes the object and frees the memory allocated for *)
(*                   object descriptor                                        *)
(*       RAISE       BadObj                                                   *)
(* ========================================================================== *)

  CONST
(* -------------------------  EXCEPTIONS  ----------------------------------- *)
  BeginEX        = 1;  (*                                                     *)
    BadObj     = 1;    (* Invalid object                                      *)
    SmallMem   = 2;    (* Too small memory for creation of object             *)
    BadSize    = 3;    (* Incorrect size of object                            *)
  EndEX          = 3;  (*                                                     *)
(* -------------------------------------------------------------------------- *)

(*%T Debug *)
  TYPE
    ExType = ARRAY [BeginEX..EndEX] OF ExReport.Message;

  CONST
    ExMSG =  ExType(
               "Invalid object",
               "Too small memory for creation of object",
               "Incorrect size of object");
(*%E       *)

END  Guard.

Appendix 2

(*# call  (o_a_copy => off) *)
(*# check (stack    => off,
           index    => on,
           range    => on,
           overflow => on,
           nil_ptr  => on)  *)

IMPLEMENTATION MODULE  Ex;

  IMPORT  SYSTEM;
  FROM    SYSTEM   IMPORT  ADDRESS;
  FROM    Global   IMPORT  Debug;
  IMPORT  ExReport;
  IMPORT  Context;
  IMPORT  LowProcess;
  IMPORT  LowGuard;
  IMPORT  Storage;
  IMPORT  Adr;

  VAR
    preport: ExceptProc;
    debug  : ExceptProc;
    free   : Ptr;
    oldFree: Storage.FreeProc;

(* ---------------------  INTERNAL  PROCEDURES  ----------------------------- *)

  PROCEDURE  WrErr (error: CARDINAL);
  BEGIN
(*%T Debug *)  ExReport.Type(MODNUM,MODNAME,error,ExMSG);  (*%E*)
(*%F Debug *)  ExReport.Type(MODNUM,MODNAME,error,"   ");  (*%E*)
  END  WrErr;

  PROCEDURE  MyExceptProc ( prt: Ptr );
  BEGIN
  END  MyExceptProc;

  PROCEDURE  Get (): Ptr;
    VAR ptr: Ptr;
  BEGIN
    LowProcess.di;
    IF free # NIL  THEN
      ptr  := free;
      free := free^.control;
    ELSE
      ptr := NIL;
    END;
    LowProcess.ei;
    IF ptr = NIL  THEN
      Storage.Allocate(ptr,SYSTEM.TSIZE(Rec));
    END;
    RETURN ptr;
  END  Get;

  PROCEDURE  Put ( ptr: Ptr );
  BEGIN
    LowProcess.di;
    ptr^.control := free;
    free := ptr;
    LowProcess.ei;
  END  Put;

  PROCEDURE  Free (): BOOLEAN;
    VAR
      ptr: Ptr;
      res: BOOLEAN;
  BEGIN
    IF oldFree()  THEN  RETURN  TRUE  END;
    LowProcess.di;
    IF free # NIL  THEN
      ptr := free;
      free := ptr^.control;
      LowProcess.ei;
      Storage.Deallocate(ptr,SYSTEM.TSIZE(Rec));
      res := TRUE;
    ELSE
      LowProcess.ei;
      res := FALSE;
    END;
    RETURN res;
  END  Free;

  PROCEDURE  DelGuard ( tmp: BOOLEAN; ex: Ptr; VAR raised: BOOLEAN );
    VAR
      guard: LowGuard.Ptr;
      magic: CARDINAL;
      adr  : SYSTEM.ADDRESS;
  BEGIN
    raised := FALSE;
    LOOP
      IF tmp  THEN  guard := ex^.tmp_res;
              ELSE  guard := ex^.resource;
      END;
      IF guard = NIL  THEN  EXIT  END;
      IF tmp  THEN  ex^.tmp_res  := guard^.next;
              ELSE  ex^.resource := guard^.next;
      END;
      magic := guard^.ident;
      IF guard^.proc # LowGuard.Proc(NIL)  THEN
        adr := SYSTEM.ADDRESS(guard);
        Adr.Inc(adr,SYSTEM.TSIZE(LowGuard.Rec));
        IF Context.Save(Context.Ptr(ex)) THEN
          guard^.proc(adr);    (* The exceptions those were raised when such *)
                               (* procedure as LowGuard.Proc was executing   *)
                               (* (that is at moment of handling of occured  *)
                               (* exceptions) doesn't propagate.             *)
                               (* (Correspondent information losts.)         *)
        ELSE
          raised := TRUE;
        END;
      END;
      IF (magic # 0) & (guard^.ident = magic)  THEN
        guard^.ident := MAX(CARDINAL);
        adr := guard;
        Storage.Deallocate(adr,guard^.size);
      END;
    END;
  END  DelGuard;

  PROCEDURE  MoveGuard ( ex: Ptr );
    VAR guard: LowGuard.Ptr;
  BEGIN
    IF ex^.resource # NIL  THEN
      guard := ex^.resource;
      LOOP
        IF guard^.next = NIL  THEN  EXIT  END;
        guard := guard^.next;
      END;
      guard^.next := ex^.control^.resource;
      ex^.control^.resource := ex^.resource;
    END;
  END  MoveGuard;

  PROCEDURE  CommonRaise ( ex: Ptr );
    VAR
      exh   : Ptr;
      finded: BOOLEAN;
  BEGIN
    debug (ex);
    finded := TRUE;
    IF NOT(ex^.status >= Status{raise}) THEN
      ex^.status := ex^.status + Status{raise};
      IF LowProcess.cpp^.cp^.except = NIL  THEN
        LowProcess.cpp^.cp^.except := ex;
      END;
      IF    (LowProcess.cpp^.cp^.handler # NIL) &
         NOT(LowProcess.cpp^.cp^.handler^.status >= Status{find})  THEN
        finded := FALSE;
      END;
      LOOP
        IF LowProcess.cpp^.cp^.handler = NIL  THEN  EXIT  END;
        exh := LowProcess.cpp^.cp^.handler;
        IF exh = LowProcess.cpp^.cp^.except THEN
          LowProcess.cpp^.cp^.except := ex;
        END;
        LowProcess.cpp^.cp^.handler := exh^.handler;
        Put(exh);
      END;
    END;
    IF NOT( ex^.status >= Status{report} )  THEN
      ex^.status := ex^.status + Status{report};
      preport(ex);
    END;
    ex^.status := ex^.status - Status{report};
    IF \272inded  THEN
      PointPush;
      ex^.status := ex^.status - Status{raise};
      WrErr(FatalExcept);
    END;
    Context.Restore(Context.Ptr(ex));
  END  CommonRaise;

(* ---------------------  EXTERNAL  PROCEDURES  ----------------------------- *)

(*# check(stack => on) *)

  PROCEDURE  Case ( VAR exx: Ptr ): Block;
    VAR
      ex        : Ptr;
      raised_tmp: BOOLEAN;
      raised_pro: BOOLEAN;
  BEGIN
    LowProcess.Protect;
    ex := Get();
    IF ex = NIL  THEN  WrErr(SmallMem)  END;
    WITH ex^ DO
      point    := 0;
      resource := NIL;
      tmp_res  := NIL;
      status   := Status{};
    END;
    IF Context.Save(Context.Ptr(ex)) THEN
        DEC(ex^.context.protect);
        ex^.control  := LowProcess.cpp^.cp^.control;
        LowProcess.cpp^.cp^.control := ex;
        IF LowProcess.cpp^.cp^.handler # NIL THEN
          ex^.handler := LowProcess.cpp^.cp^.handler;
          LowProcess.cpp^.cp^.handler := NIL;
        ELSE
          ex^.handler := NIL;
        END;
      LowProcess.Unprotect;
      exx  := ex;
      RETURN TRY
    END;
    ex := LowProcess.cpp^.cp^.control;
    DelGuard(TRUE ,ex,raised_tmp);
    DelGuard(FALSE,ex,raised_pro);
    LowProcess.cpp^.cp^.control := ex^.control;
    LowProcess.cpp^.cp^.handler := ex;
    IF raised_tmp OR raised_pro THEN  WrErr(FatalGuard)  END;
    IF ex^.status >= Status{external} THEN
      RETURN EXTERNAL
    ELSE
      RETURN INTERNAL
    END;
  END  Case;

  PROCEDURE  EndCase ( VAR ex: Ptr );
    VAR
      raised_tmp: BOOLEAN;
      raised_pro: BOOLEAN;
  BEGIN
    IF (ex # LowProcess.cpp^.cp^.control) &
       (ex # LowProcess.cpp^.cp^.handler) THEN  WrErr(BadPtr)  END;
    IF    (ex^.status >= Status{raise}) &
       NOT(ex^.status >= Status{find} ) THEN
      ex^.status := ex^.status + Status{find};
      IF    (ex^.status >= Status{external}) &
         NOT(ex^.status >= Status{begin_fn}) THEN
        RaiseNext;
      ELSE
        WrErr(FatalExcept);
      END;
    END;
    LowProcess.Protect;
    IF NOT(ex^.status >= Status{raise}) THEN   (*   END  TRY    *)
      DelGuard(TRUE ,ex,raised_tmp);
      IF raised_tmp THEN
        DelGuard(FALSE,ex,raised_pro);
      ELSE
        MoveGuard( ex );
      END;
      LowProcess.cpp^.cp^.control := ex^.control;
      LowProcess.cpp^.cp^.handler := ex^.handler;
    ELSE                                       (*   END  INTERNAL/EXTERNAL  *)
      raised_tmp := FALSE;
      LowProcess.cpp^.cp^.handler := ex^.handler;
      IF ex = LowProcess.cpp^.cp^.except  THEN
        LowProcess.cpp^.cp^.except := NIL;
      END;
    END;
    Put(ex);
    ex := NIL;
    IF raised_tmp THEN  WrErr(FatalGuard)  END;
    LowProcess.Unprotect;
  END  EndCase;

(*# check(stack => off) *)

  PROCEDURE  Raise ( mod: CARDINAL; err: CARDINAL; msg: ARRAY OF CHAR );
    VAR
      bp : CARDINAL;
      ex : Ptr;
  BEGIN
    LowProcess.Protect;
    ex := LowProcess.cpp^.cp^.control;
    IF NOT(ex^.status >= Status{raise}) THEN
      WITH ex^ DO
        module  := mod;
        error   := err;
        message := ExReport.MessPtr(SYSTEM.ADR(msg));
                                 (* valid when it is a VAR-parameter *)
        Context.Src(bp,source);
        LOOP
          IF point = 0  THEN  EXIT  END;
          Context.SrcPrev(bp,source);
          DEC(point);
        END;
      END;
    END;
    CommonRaise(ex);
  END  Raise;

  PROCEDURE  RaiseArg ( ar: LONGCARD; mod: CARDINAL; err: CARDINAL;
                       msg: ARRAY OF CHAR );
    VAR
      bp : CARDINAL;
      ex : Ptr;
  BEGIN
    LowProcess.Protect;
    ex := LowProcess.cpp^.cp^.control;
    IF NOT(ex^.status >= Status{raise}) THEN
      WITH ex^ DO
        module   := mod;
        error    := err;
        status   := Status{argument};
        arg      := ar;
        message  := ExReport.MessPtr(SYSTEM.ADR(msg));
                                 (* valid when it is a VAR-parameter *)
        Context.Src(bp,source);
        LOOP
          IF point = 0  THEN  EXIT  END;
          Context.SrcPrev(bp,source);
          DEC(point);
        END;
      END;
    END;
    CommonRaise(ex);
  END  RaiseArg;

  PROCEDURE  RaisePos ( pos: ADDRESS;  mod: CARDINAL; err: CARDINAL;
                        msg: ARRAY OF CHAR );
    VAR ex: Ptr;
  BEGIN
    LowProcess.Protect;
    ex := LowProcess.cpp^.cp^.control;
    IF NOT(ex^.status >= Status{raise}) THEN
      WITH ex^ DO
        module  := mod;
        error   := err;
        message := ExReport.MessPtr(SYSTEM.ADR(msg));
                                 (* valid when it is a VAR-parameter *)
        source  := pos;
      END;
    END;
    CommonRaise(ex);
  END  RaisePos;

  VAR ext_msg: ExReport.Message;

  PROCEDURE  RaiseExt ( pos: ADDRESS;  mod: CARDINAL; err: CARDINAL );
    VAR ex: Ptr;
  BEGIN
    LowProcess.Protect;
    ex := LowProcess.cpp^.cp^.control;
    IF NOT(ex^.status >= Status{raise}) THEN
      WITH ex^ DO
        module   := mod;
        error    := err;
        status   := Status{external};
        message  := ExReport.MessPtr(SYSTEM.ADR(ext_msg));
        source   := pos;
      END;
    END;
    CommonRaise(ex);
  END  RaiseExt;

  PROCEDURE  RaiseNext;
    VAR
      exc: Ptr;
      ex : Ptr;
  BEGIN
    exc := LowProcess.cpp^.cp^.handler;
    IF exc = NIL  THEN  WrErr(BadCall)  END;
    LowProcess.Protect;
    ex := LowProcess.cpp^.cp^.control;
    IF NOT(ex^.status >= Status{raise}) THEN
      ex^.module   := exc^.module;
      ex^.error    := exc^.error;
      ex^.arg      := exc^.arg;
      ex^.message  := exc^.message;
      ex^.source   := exc^.source;
      ex^.status   := exc^.status - Status{begin_fn,raise,report,find};
    END;
    CommonRaise(ex);
  END  RaiseNext;

  PROCEDURE  Name ( mod, err: CARDINAL ): BOOLEAN;
  BEGIN
    IF LowProcess.cpp^.cp^.handler = NIL  THEN  WrErr(BadCall)  END;
    WITH LowProcess.cpp^.cp^.handler^ DO
      status := status + status{begin_fn};
      IF status >= Status{find}  THEN  RETURN  FALSE  END;
      IF (module = mod) & (error = err) THEN
        status := status + Status{find};
        RETURN TRUE;
      ELSE
        RETURN FALSE;
      END;
    END;
  END  Name;

  PROCEDURE  NameMod ( mod: CARDINAL ): BOOLEAN;
  BEGIN
    IF LowProcess.cpp^.cp^.handler = NIL  THEN  WrErr(BadCall)  END;
    WITH LowProcess.cpp^.cp^.handler^ DO
      status := status + status{begin_fn};
      IF status >= Status{find}  THEN  RETURN  FALSE  END;
      IF (module = mod) THEN
        status := status + Status{find};
        RETURN TRUE;
      ELSE
        RETURN FALSE;
      END;
    END;
  END  NameMod;

  PROCEDURE  Other (): BOOLEAN;
  BEGIN
    IF LowProcess.cpp^.cp^.handler = NIL  THEN  WrErr(BadCall)  END;
    WITH LowProcess.cpp^.cp^.handler^ DO
      status := status + status{begin_fn};
      IF status >= Status{find}  THEN  RETURN  FALSE  END;
      status := status + Status{find};
      RETURN TRUE;
    END;
  END  Other;

  PROCEDURE  Arg (): LONGCARD;
  BEGIN
    IF LowProcess.cpp^.cp^.handler = NIL  THEN  WrErr(BadCall)  END;
    IF NOT(LowProcess.cpp^.cp^.handler^.status >= Status{argument})  THEN
      WrErr(NotArg)
    END;
    RETURN LowProcess.cpp^.cp^.handler^.arg;
  END  Arg;

  PROCEDURE  PointPush;
  BEGIN
    LowProcess.Protect;
    INC(LowProcess.cpp^.cp^.control^.point);
    LowProcess.Unprotect;
  END  PointPush;

  PROCEDURE  PointPop;
  BEGIN
    LowProcess.Protect;
    IF LowProcess.cpp^.cp^.control^.point # 0  THEN
      DEC(LowProcess.cpp^.cp^.control^.point)
    END;
    LowProcess.Unprotect;
  END  PointPop;

  PROCEDURE  SetReportProc ( ep: ExceptProc );
  BEGIN
    preport := ep;
  END  SetReportProc;

  PROCEDURE  SetDebugProc ( ep: ExceptProc );
  BEGIN
    debug := ep;
  END  SetDebugProc;

  CONST
     INIT = SYSTEM.A2(0,0);

  PROCEDURE  Init;
  BEGIN
    IF INIT[0] # 0  THEN  RETURN  END;
    SYSTEM.ADR(INIT[0])^ := 1;
    preport := MyExceptProc;
    debug   := MyExceptProc;
    free    := NIL;
    ext_msg := "External Signal";
    oldFree := Storage.AddFree(Free);
  END  Init;

END  Ex.

Appendix 3

MODULE  D_Except;   (*  IIE 24/02/91  15:10  *)
                    (*  R$  26/10/91  23:43  *)

(*# data(stack_size => 2000) *)

  IMPORT  ExRTS;
  IMPORT  Ex;

  IMPORT  StrNum;
  IMPORT  TTIO;

(*# check(stack => off) *)
  PROCEDURE  DebugProc ( ex: Ex.Ptr );
  BEGIN
  END  DebugProc;
(*# check(stack => on) *)

  PROCEDURE  ExecCard (card: CARDINAL): CARDINAL;
  BEGIN
    IF  (card = 1)
      THEN  RETURN 1
      ELSE  RETURN card*ExecCard(card-1)
    END;
  END  ExecCard;

  PROCEDURE  ExecReal (real: REAL): REAL;
  BEGIN
    IF  (real = 1.)
      THEN  RETURN 1.
      ELSE  RETURN real*ExecReal(real-1.)
    END;
  END  ExecReal;

  PROCEDURE  Exec (card: CARDINAL);
    VAR ex0,ex1: Ex.Ptr;
        result : ARRAY [0..29] OF CHAR;
        real   : REAL;
  BEGIN
    CASE  Ex.Case(ex0)  OF
      Ex.TRY:

        CASE  Ex.Case(ex1)  OF
          Ex.TRY:
            card := ExecCard (card);
            StrNum.CardToStr (card, result);
        | Ex.INTERNAL:
            IF Ex.Name(0,ExRTS.MathOverflow) THEN
              real := ExecReal(FLOAT(card));
              StrNum.RealToStr( real, result );
            END;
            IF Ex.Name(0,ExRTS.StackOverflow) THEN
              Ex.Raise(0,ExRTS.StackOverflow,"  ");
            END;
        | Ex.EXTERNAL:
        END;  Ex.EndCase(ex1);
        TTIO.WrStr ("      N! : ");   TTIO.WrStr (result);

    | Ex.INTERNAL:
        IF Ex.Name(0,ExRTS.StackOverflow) THEN
          TTIO.WrStr (" Stack Overflow");
        END;
    | Ex.EXTERNAL:
    END;  Ex.EndCase(ex0);
  END  Exec;

  VAR
    n  : CARDINAL;
    str: ARRAY [0..29] OF CHAR;

BEGIN
  Ex.SetDebugProc(DebugProc);
  LOOP
    TTIO.WrStr ("      N  > ");
    TTIO.RdStr (str);   StrNum.StrToCard (str,n);
    TTIO.WrLn;
    IF  (n = 0)  THEN
      TTIO.WrLn;
      EXIT;
    END;
    Exec (n);
    TTIO.WrLn;
  END;
END  D_Except.

 Edited by g_dotzel@ame.nbg.sub.org, 13-Apr-1992. If there are any questions, please directly contact the 
author(s) at the address given in the header of this article. 

__________________________________________________________________________________________________ 


IMPRESSUM: The ModulaTor is an unrefereed journal. Technical papers are to be taken as working papers and personal rather than organizational statements. Items are printed at the discretion of the Editor based upon his judgement on the interest and relevancy to the readership. Letters, announcements, and other items of professional interest are selected on the same basis. Office of publication: The Editor of The ModulaTor is Guenter Dotzel; he can be reached by tel/fax: [removed due to abuse] or by mailto:[email deleted due to spam]
  ModulaWare home page   The ModulaTor download    [Any browser]

Webdesign by www.otolo.com/webworx, 14-Jul-1998