This chapter covers details of the XDS implementation of the Modula-2 language. In the standard modeWhen options M2EXTENSIONS and M2ADDTYPES are OFF XDS Modula-2 complies with ISO 10514 (See the statement of compliance and further details in ISO Standard compliance). The compatibility rules are described in Compatibility. The differences between ISO Modula-2 and the language described in the 4th edition of Wirth's ``Programming in Modula-2'' are listed in New language's features. Language extensions are described in Language extensions.
XDS Modula-2 partially complies with the requirements of ISO 10514. The details of non-conformities are as follows:
XDS Modula-2 is a so-called `single-pass' implementation. It means that all identifiers must be declared before use. According to the International Standard this declare-before-use approach is perfectly valid. The alternative approach, (declare-before-use-in-declarations), can be used in so-called `multi-pass' implementations.
A forward declaration must be used to allow forward references to a procedure which actual declaration appears later in the source text.
PROCEDURE a(x: INTEGER); FORWARD; (* FORWARD declaration *) PROCEDURE b(x: INTEGER); BEGIN a(x-1); END b; PROCEDURE a(n: INTEGER); (* proper procedure declaration *) BEGIN b(n-1); END a;
To provide source compatibility between `single-pass' and `multi-pass' implementations, the Standard requires that all conforming `multi-pass' implementations accept and correctly process the FORWARD directive.
The language described in the International Standard varies in many details from the one described in Wirth's ``Programming in Modula-2''.
The most important innovations are
Note: The system modules (except the module SYSTEM) are not embedded in the compiler and are implemented as separate modules.
The ISO Modula-2 has some new keywords and pervasive identifiers , and provides alternatives for some symbols . It also introduces the syntax for source code directives (or pragmas):
Pragma = "<*" pragma_body "*>"
The Standard does not specify a syntax of pragma_body. In XDS, source code directives are used for in-line option setting and for conditional compilation. See Inline options and equations for further details.
Table 8. Modula-2 keywords
AND
ARRAY
BEGIN
BY
CASE
CONST
DEFINITION
DIV
DO
ELSE
ELSIF
END
EXIT
EXCEPT
EXPORT
FINALLY
FOR
FORWARD
FROM
IF
IMPLEMENTATION
IMPORT
IN
LOOP
MOD
MODULE
NOT
OF
OR
PACKEDSET
POINTER
PROCEDURE
QUALIFIED
RECORD
REM
RETRY
REPEAT
RETURN
SET
THEN
TO
TYPE
UNTIL
VAR
WHILE
WITH
Table 9. Modula-2 pervasive identifiers
ABS
BITSET
BOOLEAN
CARDINAL
CAP
CHR
CHAR
COMPLEX (Complex types)
CMPLX (Complex types)
DEC
DISPOSE
EXCL
FALSE
FLOAT
HALT
HIGH
IM (Complex types)
INC
INCL
INT (Type conversions)
INTERRUPTIBLE (Protection)
INTEGER
LENGTH (Strings)
LFLOAT (Type conversions)
LONGCOMPLEX (Complex types)
LONGREAL
MAX
MIN
NEW
NIL
ODD
ORD
PROC
PROTECTION (Protection)
RE (Complex types)
REAL
SIZE
TRUE
TRUNC
UNINTERRUPTIBLE (Protection)
VAL
Table 10. Modula-2 alternative symbols
Symbol | Meaning | Alternative |
[ | left bracket | (! |
] | right bracket | !) |
{ | left brace | (: |
} | right brace | :) |
| | case separator | ! |
^ | dereference | @ |
Types COMPLEX and LONGCOMPLEX can be used to represent complex numbers. These types differ in a the range and precision. The COMPLEX type is defined as a (REAL,REAL) pair, while LONGCOMPLEX consists of a pair of LONGREAL values.
There is no notation for a complex literal. A complex value can be obtained by applying the standard function CMPLX to two reals. If both CMPLX arguments are real constants the result is the complex constant.
CONST i = CMPLX(0.0,1.0);
If both expressions are of the REAL type, or if one is of the REAL type and the other is a real constant, the function returns a COMPLEX value. If both expressions are of the LONGREAL type, or if one is of the LONGREAL type and the other is a real constant the function returns a LONGCOMPLEX value. The following table summarizes the permitted types and the result type:
REAL
LONGREAL
real constant
REAL
REAL
error
COMPLEX
LONGREAL
error
LONGCOMPLEX
LONGCOMPLEX
real constant
COMPLEX
LONGCOMPLEX
complex constant
Standard functions RE and IM can be used to obtain a real or imaginary part of a value of a complex type. Both functions have one formal parameter. If the actual parameter is of the COMPLEX type, both functions return a REAL value; if the parameter is of the LONGCOMPLEX type, functions return a LONGREAL value; otherwise the parameter should be a complex constant and functions return a real constant.
CONST one = IM(CMPLX(0.0,1.0));
There are four arithmetic binary operators for operands of a complex type: addition (+), subtraction (-), multiplication (*), and division (/). The following table indicates the result of an operation for permitted combinations:
COMPLEX
LONGCOMPLEX
complex constant
COMPLEX
COMPLEX
error
COMPLEX
LONGCOMPLEX
error
LONGCOMPLEX
LONGCOMPLEX
complex constant
COMPLEX
LONGCOMPLEX
complex constant
There are two arithmetic unary operators that can be applied to the values of a complex type: identity (+) and negation (-). The result is of the operand's type.
Two complex comparison operators are provided for operands of complex type: equality (=) and inequality (<>).
PROCEDURE abs(z: COMPLEX): REAL; BEGIN RETURN RealMath.sqrt(RE(z)*RE(z)+IM(z)*IM(z)) END abs;
A set or packedsetPackedset types are innovated in the Standard. type defines a new elementary type whose set of values is the power set of an associated ordinal type called the base type of the set or packedset type.
SetType = SET OF Type; PackedsetType = PACKEDSET OF Type;
The International Standard does not require a specific representation for set types. Packedset types representation has to be mapped to the individual bits of a particular underlying architecture. The standard type BITSET is a predefined packedset type.
The current XDS implementation does not distinguish between set and packedset types. A set of at least 256 elements can be defined.
All set operators, namely union (+), difference (-), intersection (*), and symmetrical difference (/), can be applied to the values of both set and packedset types.
TYPE CharSet = SET OF CHAR; ByteSet = PACKEDSET OF [-127..128]; VAR letters, digits, alphanum: CharSet; neg, pos, zero : ByteSet; . . . letters := CharSet{'a'..'z','A'..'Z'}; digits := CharSet{'0'..'9'}; alphanum := letters + digits; neg := ByteSet{-127..-1}; pos := ByteSet{1..127}; zero := ByteSet{-127..128}-neg-pos;
For operands of the string literal type, the string concatenation operation is defined, denoted by the symbol "+". Note: a character number literal (e.g. 15C) denotes a value of a literal string type of length 1. The empty string is compatible with the type CHAR and has a value equal to the string terminator (0C).
CONST CR = 15C; LF = 12C; LineEnd = CR + LF; Greeting = "hello " + "world" + LineEnd;
The new standard function LENGTH can be used to obtain the length of a string value.
PROCEDURE LENGTH(s: ARRAY OF CHAR): CARDINAL;
A value constructor is an expression denoting a value of an array type, a record type, or a set type. In case of array constructors and record constructors a list of values, known as structure components, is specified to define the values of components of an array value or the fields of a record value. In case of a set constructor, a list of members is specified, whose elements define the elements of the set value.
ValueConstructor = ArrayValue | RecordValue | SetValue. ArrayValue = TypeIdentifier "{" ArrayComponent { "," ArrayComponent } "}". ArrayComponent = Component [ BY RepeatCount ]. Component = Expression. RepeatCount = ConstExpression. RecordValue = TypeIdentifier "{" Component { "," Component } "}".
Set constructors are described in PIM.
The total number of components of an array constructor must be exactly the same as the number of array's elements (taking into account repetition factors). Each component must be assignment compatible with the array base type.
The number of components of a record constructor must be exactly the same as the number of fields. Each component must be an assignment compatible with the type of the field.
A special case is a record constructor for a record with variant parts. If the n-th field is the tag field the n-th component must be a constant expression. If there is no ELSE variant part associated with the tag field, then the variant associated with the value of expression should exist. If no variant is associated with the value, then the fields of the ELSE variant part should be included in the sequence of components.
The constructor's components may themselves contain lists of elements, and such nested constructs need not specify a type identifier. This relaxation is necessary for multi-dimensional arrays, where the types of the inner components may be anonymous.
TYPE String = ARRAY [0..15] OF CHAR; Person = RECORD name: String; age : CARDINAL; END; Vector = ARRAY [0..2] OF INTEGER; Matrix = ARRAY [0..2] OF Vector; VAR string: String; person: Person; vector: Vector; matrix: Matrix; . . . BEGIN . . . string:=String{" " BY 16}; person:=Person{"Alex",32}; vector:=Vector{1,2,3}; matrix:=Matrix{vector,{4,5,6},Vector{7,8,9}}; matrix:=Matrix{vector BY 3};
According to the International Standard, parameters of a multi-dimensional open array type are allowed:
PROCEDURE Foo(VAR matrix: ARRAY OF ARRAY OF REAL); VAR i,j: CARDINAL; BEGIN FOR i:=0 TO HIGH(matrix) DO FOR j:=0 TO HIGH(matrix[i]) DO ... matrix[i,j] ... END; END; END Foo; VAR a: ARRAY [0..2],[0..2] OF REAL; BEGIN Foo(a); END ...
A procedure type identifier may be used in declaration of the type itself. This feature is used in the Standard Library. See, for example, modules ConvTypes and WholeConv.
TYPE Scan = PROCEDURE (CHAR; VAR Scan); Func = PROCEDURE (INTEGER): Func;
A constant expression may contain values of procedure types, or structured values whose components are values of procedure types. Procedure constants may be used as a mechanism for procedure renaming. In a definition module it is possible to export a renamed version of the imported procedure.
TYPE ProcTable = ARRAY [0..3] OF PROC; CONST WS = STextIO.WriteString; Table = ProcTable{Up,Down,Left,Right};
Along with DIV and MOD the International Standard includes two additional operators for whole number division: `/' and REM.
Operators DIV and MOD are defined for positive divisors only, while `/' and REM can be used for both negative and positive divisors.
The language exception wholeDivException (See Exceptions) is raised if:
For the given lval and rval
quotient := lval / rval;
remainder := lval REM rval;
the following is true (for all non-zero values of rval):
For the given lval and rval
quotient := lval DIV rval;
modulus := lval MOD rval;
the following is true (for all positive values of rval):
Operations are exemplified in the following table:
op | 31 op 10 | 31 op (-10) | (-31) op 10 | (-31) op (-10) |
/ | 3 | -3 | -3 | 3 |
REM | 1 | 1 | -1 | -1 |
DIV | 3 | exception | -4 | exception |
MOD | 1 | exception | 9 | exception |
The language includes the following type conversion functions: CHR, FLOAT, INT, LFLOAT, ORD, TRUNC and VAL. The functions INT and LFLOAT are not described in PIM.
All the type conversion functions (except VAL) have a single parameter and can be expressed in terms of the VAL function.
Function | Parameter | Equals to |
CHR(x) | whole | VAL(CHAR,x) |
FLOAT(x) | real or whole | VAL(REAL,x) |
INT(x) | real or ordinal | VAL(INTEGER,x) |
LFLOAT(x) | real or whole | VAL(LONGREAL,x) |
ORD(x) | ordinal | VAL(CARDINAL,x) |
TRUNC(x) | real | VAL(CARDINAL,x) |
The function VAL can be used to obtain a value of the specified scalar type from an expression of a scalar type. The function has two parameters. The first parameter should be a type parameter that denotes a scalar type. If the type is a subrange type, the result of VAL has the host type of the subrange type, otherwise it has the type denoted by the type parameter.
The second parameter should be an expression of a scalar type and at least one of the restriction shall hold:
In the following table, denotes a valid combination of types and · denotes an invalid combination:
the type of | 5cthe type denoted by the type parameter | ||||
expression | whole | real | CHAR | BOOLEAN | enumeration |
whole type | ![]() |
![]() |
![]() |
![]() |
![]() |
real type | ![]() |
![]() |
· | · | · |
CHAR | ![]() |
· | ![]() |
· | · |
BOOLEAN | ![]() |
· | · | ![]() |
· |
enumeration | ![]() |
· | · | · | ![]() |
An exception is raised if the value of x is outside the range of the type T in the call VAL(T,x). If x is of a real type, the calls VAL(INTEGER,x) and VAL(CARDINAL,x) both truncate the value of x.
The standard procedures NEW and DISPOSE are back in the language. Calls of NEW and DISPOSE are substituted by calls of ALLOCATE and DEALLOCATE which should be visible at the current scope. The compiler checks compatibility of these substitution procedures with the expected formal type:
PROCEDURE ALLOCATE(VAR a: ADDRESS; size: CARDINAL);
PROCEDURE DEALLOCATE(VAR a: ADDRESS; size: CARDINAL);
As a rule, the procedures ALLOCATE and DEALLOCATE declared in the module Storage are used. These procedures are made visible by including the import list:
FROM Storage IMPORT ALLOCATE, DEALLOCATE;
When language extensions are enabled, the procedures NEW and DISPOSE can be applied to dynamic arrays. See NEW and DISPOSE for dynamic arrays for further details.
See also the STORAGE option.
A special mechanism called finalization is provided to perform certain operations during program termination.
A module declaration contains an optional finalization body, which is executed during program termination for static modules (See Termination) or dynamic module finalization.
ModuleBody = [ BEGIN BlockBody [ FINALLY BlockBody ] ] END BlockBody = NormalPart [ EXCEPT ExceptionalPart ]. NormalPart = StatementSequence. ExceptionalPart = StatementSequence.
Note: the RETURN statement can be used in a BlockBody.
Consider the following example:
MODULE Test; . . . VAR cid: StreamFile.ChanId; BEGIN StreamFile.Open(cid,"tmp",flags,res); Process(cid); FINALLY StreamFile.Close(cid); END Test
If the Test module is declared in a procedure block, then the initialization body will be executed on a call of the procedure, while the finalization body is executed upon return from the procedure.
If the Test module is a static module, its finalization will be executed during program termination.
In any case, finalization bodies are executed in reverse order with respect to their initializations.
In the following example, finalization of a local module is used to restore context:
VAR state: State; PROCEDURE Foo; MODULE AutoSave; IMPORT state, State; VAR save: State; BEGIN save:=state; (* save state *) state:=fooState; FINALLY state:=save; (* restore state *) END AutoSave; BEGIN ... process ... END Foo;
The initialization part of the AutoSave module will be executed before any statement in the Foo body and finalization part will be executed directly before returning from a call of Foo.
An exception handling mechanism is now included in the language. Both user-defined exceptions and language exceptions can be handled. There is no special exception type; an exception is identified by a pair: exception source value and cardinal value. Two keywords (EXCEPT and RETRY) are added to the language. The essential part of exception handling is provided in two system modules: EXCEPTIONS and M2EXCEPTION.
The EXCEPTIONS module provides facilities for raising and identifying the user-defined exceptions, for reporting their occurrence, and for making enquiries concerning the execution state of the current coroutine.
The M2EXCEPTION module provides facilities for identifying language exceptions that have been raised.
A procedure body, an initialization or finalization part of a module body may contain an exceptional part.
BlockBody = NormalPart [ EXCEPT ExceptionalPart ]. NormalPart = StatementSequence. ExceptionalPart = StatementSequence.
Example:
PROCEDURE Div(a,b: INTEGER): INTEGER; BEGIN RETURN a DIV b (* try to divide *) EXCEPT RETURN MAX(INTEGER) (* if exception *) END Fly;
When an exception is raised (explicitly or implicitly) the `nearest' (in terms of procedure calls) exceptional part in the current coroutine receives control. Each coroutine is executed initially in the normal state. If an exception is raised, the coroutine state switches to the exceptional state. If there is no exceptional part, raising of an exception is a termination event (See Termination).
A procedure with an exceptional part is executed in the normal state. The state is restored after block execution. A procedure without an exceptional part is executed in the state of the caller.
If an exception is raised in the state of exceptional execution it is re-raised in the calling context. In this case finalization of local modules and restoring protection (See Protection) will not take place.
An additional statement (RETRY) can be used in the exceptional part. Execution of the RETRY statement causes the normal part to be re-executed in the normal state.
Execution of the RETURN statement in the exceptional part causes switch to the normal state.
If neither RETURN nor RETRY was executed in the exceptional part, the exceptional completion will occur. In this case after finalization of local modules (if any) and restoring protection state (if necessary), the exception will be re-raised.
PROCEDURE Foo; BEGIN TryFoo(...); EXCEPT IF CanBeRepaired() THEN Repair; RETRY; (* re-execute the normal part *) ELSIF CanBeProcessed() THEN Process; RETURN; (* exception is handled *) ELSE (* exception will be automatically re-raised *) END; END Foo;
The module EXCEPTIONS provides facilities for raising user's exceptions and for making enquiries concerning the current execution state.
User-defined exceptions are identified uniquely by a pair (exception source, number). When the source of a used-defined exception is a separate module, it prevents the defined exceptions of the module from being raised directly by other sources. See e.g. the module Storage.
TYPE ExceptionSource;
Values of the opaque type ExceptionSource are used to identify the source of exceptions raised; they should be allocated before usage.
TYPE ExceptionNumber = CARDINAL;
Values of the type ExceptionNumber are used to distinguish between different exceptions of one source.
PROCEDURE AllocateSource(VAR newSource: ExceptionSource);
The procedure allocates an unique value of the type ExceptionSource. The procedure is normally called during initialization of a module, and the resulting value is then used in all calls of RAISE. If an unique value cannot be allocated the language exception exException is raised (See The system module M2EXCEPTION).
PROCEDURE RAISE(source: ExceptionSource; number: ExceptionNumber; message: ARRAY OF CHAR);
A call to RAISE associates the given values of exception source, number, and message with the current context and raises an exception.
The function CurrentNumber can be used to obtain the exception number for the current exception.
PROCEDURE CurrentNumber (source: ExceptionSource): ExceptionNumber;
If the calling coroutine is in the exceptional execution state because of raising an exception from source, the procedure returns the corresponding number, and otherwise raises an exception.
The procedure GetMessage can be used to obtain the message passed when an exception was raised. This may give further information about the nature of the exception.
PROCEDURE GetMessage(VAR text: ARRAY OF CHAR);
If the calling coroutine is in the exceptional execution state, the procedure returns the (possibly truncated) string associated with the current context. Otherwise, in the normal execution state, it returns the empty string.
PROCEDURE IsCurrentSource (source: ExceptionSource): BOOLEAN;
If the current coroutine is in the exceptional execution state because of raising an exception from source, the procedure returns TRUE, and FALSE otherwise.
PROCEDURE IsExceptionalExecution (): BOOLEAN;
If the current coroutine is in the exceptional execution state because of raising an exception, the procedure returns TRUE, and FALSE otherwise.
The following example illustrates the recommended form of a library module and usage of procedures from EXCEPTIONS.
DEFINITION MODULE FooLib; PROCEDURE Foo; (* Raises Foo exception if necessary *) PROCEDURE IsFooException(): BOOLEAN; (* Returns TRUE, if the calling coroutine is in exceptional state because of the raising of an exception from Foo, and otherwise returns FALSE. *) END FooLib. IMPLEMENTATION MODULE FooLib; IMPORT EXCEPTIONS; VAR source: EXCEPTIONS.ExceptionSource; PROCEDURE Foo; BEGIN TryFoo(...); IF NOT done THEN EXCEPTIONS.RAISE(source,0,"Foo exception"); END; END Foo; PROCEDURE IsFooException(): BOOLEAN; BEGIN RETURN EXCEPTIONS.IsCurrentSource(source) END IsLibException; BEGIN EXCEPTIONS.AllocateSource(source) END FooLib.
If we want to distinguish the exceptions raised in the FooLib we will append an enumeration type and an additional enquiry procedure in the FooLib definition:
TYPE FooExceptions = (fault, problem); PROCEDURE FooException(): FooExceptions;
The FooException procedure can be implemented as follows:
PROCEDURE FooException(): FooExceptions; BEGIN RETURN VAL(FooExceptions, EXCEPTIONS.CurrentNumber(source)) END FooException;
The Client module illustrates the usage of the library module FooLib:
MODULE Client; IMPORT FooLib, EXCEPTIONS, STextIO; PROCEDURE ReportException; VAR s: ARRAY [0..63] OF CHAR; BEGIN EXCEPTIONS.GetMessage(s); STextIO.WriteString(s); STextIO.WriteLn; END ReportException; PROCEDURE TryFoo; BEGIN FooLib.Foo; EXCEPT IF FooLib.IsFooException() THEN ReportException; RETURN; (* exception is handled *) ELSE (* Exception will be re-raised *) END END TryFoo; END Client.
The system module M2EXCEPTION provides language exceptions identification facilities. The language (which includes the system modules) is regarded as one source of exceptions.
The module exports the enumeration type M2Exceptions, used to distinguish language exceptions, and two enquiry functions.
TYPE M2Exceptions = (indexException, rangeException, caseSelectException, invalidLocation, functionException, wholeValueException, wholeDivException, realValueException, realDivException, complexValueException, complexDivException, protException, sysException, coException, exException );
PROCEDURE IsM2Exception(): BOOLEAN;
If the current coroutine is in the exceptional execution state because of the raising of a language exception, the procedure returns TRUE, and FALSE otherwise.
PROCEDURE M2Exception(): M2Exceptions;
If the current coroutine is in the exceptional execution state because of the raising of a language exception, the procedure returns the corresponding enumeration value, and otherwise raises an exception.
The following description lists all language exceptions (in alphabetical order) along with the circumstances under which they are detected. Note: Compiler options can be used to control detection of some exceptions (See Chapter Compiler options and equations). Detection of some exceptions is not required by the Standard, however such exceptions can be detected on some platforms (See Chapter Limitations and restrictions).
Case selector is out of range and the ELSE clause does not exist.
The system module COROUTINES exceptions:
Divide by zero in a complex number expression.
Overflow in evaluation of a complex number expression.
A system module EXCEPTIONS or M2EXCEPTION exception:
No RETURN statement before the end of a function.
Array index out of range. See options CHECKINDEX and CHECKDINDEX.
Attempt to dereference NIL or an uninitialized pointer. See the option CHECKNIL.
The given protection is less restrictive than the current protection.
Range exception (See the CHECKRANGE option):
Divide by zero in a real number expression.
Overflow in evaluation of a real number expression.
The system module SYSTEM exceptions. Note: All these exceptions are non-mandatory.
Whole division exception:
Overflow in evaluation of a whole number expression.
PROCEDURE Div(a,b: INTEGER): INTEGER; BEGIN RETURN a DIV b EXCEPT IF IsM2Exception() THEN IF M2Exception() = wholeDivException THEN IF a < 0 THEN RETURN MIN(INTEGER) ELSE RETURN MAX(INTEGER) END; END; END; END Div;
During the program termination, finalizations of those static modules that have started initialization are executed in reverse order with respect to their initializations (See also Finalization). The static modules are the program module, the implementation modules, and any local modules declared in the module blocks of these modules.
Program termination starts from the first occurrence of the following event:
The system module TERMINATION provides facilities for enquiries concerning the occurrence of termination events.
PROCEDURE IsTerminating(): BOOLEAN;
Returns TRUE if any coroutine has inititated program termination and FALSE otherwise.
PROCEDURE HasHalted(): BOOLEAN;
Returns TRUE if a call of HALT has been made and FALSE otherwise.
The system module COROUTINES provides facilities for coroutines creation, explicit control transfer between coroutines, and interrupts handling. Note: Some features can be unavailable in the current release. See Chapter Limitations and restrictions for details.
Values of the type COROUTINE are created dynamically by a call of NEWCOROUTINE and identify the coroutine in subsequent operations. A particular coroutine is identified by the same value of the coroutine type throughout the lifetime of that coroutine.
TYPE COROUTINE;
The correspondent type was called PROCESS in PIM. From the third edition of PIM, the ADDRESS type was used to identify a coroutine.
PROCEDURE NEWCOROUTINE( procBody: PROC; workspace: SYSTEM.ADDRESS; size: CARDINAL; VAR cr: COROUTINE [; initProtection: PROTECTION]);
Creates a new coroutine whose body is given by procBody, and returns the identity of the coroutine in cr. workspace is a pointer to the work space allocated to the coroutine; size specifies the size of that workspace in terms of SYSTEM.LOC. initProtection is an optional parameter that specifies the initial protection level of the coroutine.
An exception is raised (See coException) if the value of size is less than the minimum workspace size.
If the optional parameter is omitted, the initial protection of the coroutine is given by the current protection of the caller.
The created coroutine is initialized in such a way that when control is first transferred to that coroutine, the procedure given by procBody is called in a normal state. The exception (coException) is raised when the procBody procedure attempts to return to its caller. Since the caller has no exception handler, raising this exception is a termination event.
The procedure TRANSFER can be used to transfer control from one coroutine to another.
PROCEDURE TRANSFER (VAR from: COROUTINE; to: COROUTINE);
Returns the identity of the calling coroutine in from and transfers control to the coroutine specified by to.
PROCEDURE CURRENT (): COROUTINE;
Returns the identity of the calling coroutine.
The INTERRUPTSOURCE type is used to identify interrupts.
TYPE INTERRUPTSOURCE = INTEGER;
Programs that use the interrupt handling facilities may be non-portable since the type is implementation-defined.
PROCEDURE ATTACH(source: INTERRUPTSOURCE);
Associates the specified source of interrupts with the calling coroutine. More than one source of interrupts may be associated with a single coroutine.
PROCEDURE DETACH(source: INTERRUPTSOURCE);
Dissociates the specified source of interrupts from the calling coroutine. The call has no effect if the coroutine is not associated with source.
PROCEDURE IsATTACHED(source: INTERRUPTSOURCE): BOOLEAN;
Returns TRUE if and only if the specified source of interrupts is currently associated with a coroutine; otherwise returns FALSE.
PROCEDURE HANDLER(source: INTERRUPTSOURCE): COROUTINE;
Returns the coroutine, if any, that is associated with the source of interrupts. The result is undefined if there is no coroutine associated with the source.
PROCEDURE IOTRANSFER(VAR from: COROUTINE;
to: COROUTINE);
Returns the identity of the calling coroutine in from and transfers control to the coroutine specified by to. On occurrence of an interrupt, associated with the caller, control is transferred back to the caller, and from returns the identity of the interrupted coroutine. An exception is raised if the calling coroutine is not associated with a source of interrupts.
See section Protection for information about the type PROTECTION.
PROCEDURE LISTEN(prot: PROTECTION);
Momentarily changes protection of the calling coroutine to prot, usually lowering it so as to allow an interrupt request to be granted.
PROCEDURE PROT(): PROTECTION;
Returns protection of the calling coroutine.
A program module, implementation module or local module may specify, by including protection in its heading, that execution of the enclosed statement sequence is protected.
ModuleHeading = MODULE ident [ Protection ] ";". Protection = [ ConstExpression ].
A module with protection in its heading is called a directly protected module. A directly protected procedure is an exported procedure declared in a protected module.
Protection of a module is provided by surrounding the externally accessible procedures and module body by calls of access control procedures. The value of the protection expression is passed to the call of access control procedures as an actual parameter.
The protection expression should be of the PROTECTION type. The PROTECTION type is an elementary type with at least two values: INTERRUPTIBLE and UNINTERRUPTIBLE.
Operators <, >, <= and >= can be used to compare values of the PROTECTION type. If x is a value of PROTECTION type, then x satisfies the conditions:
UNINTERRUPTIBLE x
INTERRUPTIBLE
Table 11. Modula-2 proper procedures
Procedure | Meaning | |
![]() |
ASSERT(x[,n]) | Terminates the program if x![]() |
![]() |
COPY(x,v) | Copies a string: v := x |
DEC(v[,n]) | v := v - n, default n=1 | |
DISPOSE(v) | Deallocates v^ (See NEW and DISPOSE) | |
EXCL(v,n) | v := v - {n} | |
HALT | Terminates program execution (See HALT) | |
INC(v[,n]) | v := v + n, default n=1 | |
INCL(v,n) | v := v + {n} | |
NEW(v) | Allocates v^ (See NEW and DISPOSE) | |
![]() |
NEW(v,x0...xn) | Allocates v^ of length x0...xn (See NEW and DISPOSE for dynamic arrays) |
Table 12. Modula-2 function procedures
Function | Meaning | |
ABS(x) | Absolute value of x | |
![]() |
ASH(x,n) | Arithmetic shift |
CAP(x) | Corresponding capital letter | |
CHR(x) | Character with the ordinal number x | |
CMPLX(x,y) | Complex number with real part x and imaginary part y | |
![]() |
ENTIER(x) | Largest integer not greater than x |
FLOAT(x) | VAL(REAL,x) | |
HIGH(v) | High bound of the index of v | |
IM(x) | Imaginary part of a complex x | |
INT(x) | VAL(INTEGER,x) | |
![]() |
LEN(v[,n]) | Length of an array in the dimension n (default=0) |
LENGTH(x) | String length | |
LFLOAT(x) | VAL(LONGREAL,x) | |
MAX(T) | Maximum value of type T | |
MIN(T) | Minimum value of type T | |
ODD(x) | x MOD 2 = 1 | |
ORD(x) | VAL(CARDINAL,x) | |
RE(x) | Real part of a complex x | |
SIZE(T) | The number of storage units, required by a variable of type T | |
TRUNC(x) | Truncation to the integral part | |
VAL(T,x) | Type conversion |
This section briefly describes the set of standard procedures and functions. Some of them are not defined in the International Standard and are available only if the option M2EXTENSIONS is set. The procedure HALT may have an additional parameter, if the extensions are enabled .
In the tables (11. Modula-2 proper procedures and 12. Modula-2 function procedures) of predefined procedures, v stands for a designator, x, y and n --- for expressions, T --- for a type. Non-standard procedures are marked with .
The procedure COPY and the functions ASH, ENTIER and LEN are described in The Oberon-2 Report.
This section describes compatibility between entities of different types. There are three forms of compatibility:
In most cases the compatibility rules are the same as described in PIM. However, we suppose to explicitly list all the rules.
Two expressions a and b of types Ta and Tb are expression compatible if any of the following statement is true:
VAR char: CHAR; ... WHILE (char # '') & (char # ".") DO ...
An expression e of type Te is assignment compatible with the variable v of type Tv if one of the following conditions holds For an expression of a subrange type only host type matters. :
A formal type is value parameter compatible with an actual expression if any of the following statements is true:
A formal type is variable parameter compatible with an actual variable if any of the following statements is true:
A formal type is system parameter compatible with an actual parameter if any of the following statements is true:
ARRAY [0..n-1] OF SYSTEM.LOC
and the actual parameter is of any type T such that SIZE(T) is equal to n.
ARRAY OF SYSTEM.LOC
and the actual parameter is of any type but not numeric literal.
ARRAY OF ARRAY [0..n-1] OF SYSTEM.LOC
and the actual parameter is of any type T such that SIZE(T) is a multiple of n.
The module SYSTEM provides the low-level facilities for gaining an access to the address and underlying storage of variables, performing address arithmetic operations and manipulating the representation of values. Program that use these facilities may be non-portable.
This module does not exist in the same sense as other libraries but is hard-coded into the compiler itself. To use the facilities provided, however, identifiers must be imported in a usual way.
Some of the SYSTEM module procedures are generic procedures that cannot be explicitly declared, i.e. they apply to classes of operand types or have several possible forms of a parameter list .
The SYSTEM module is the only module specified in the International Standard that can be extended in the implementation. The XDS SYSTEM module provides additional types and procedures.
Note: The module SYSTEM is different in Oberon-2. See The Oberon-2 module SYSTEM for details.
DEFINITION MODULE SYSTEM;
CONST
BITSPERLOC = 8;
LOCSPERWORD = 4;
LOCSPERBYTE = 1;
TYPE
LOC;
ADDRESS = POINTER TO LOC;
WORD = ARRAY [0 .. LOCSPERWORD-1] OF LOC;
BYTE = LOC;
PROCEDURE ADDADR(addr: ADDRESS; offset: CARDINAL): ADDRESS;
PROCEDURE SUBADR(addr: ADDRESS; offset: CARDINAL): ADDRESS;
PROCEDURE DIFADR(addr1, addr2: ADDRESS): INTEGER;
PROCEDURE MAKEADR(val: <whole type>): ADDRESS;
PROCEDURE ADR(VAR v: <anytype>): ADDRESS;
PROCEDURE REF(VAR v: <anytype>): POINTER TO <type of the parameter>;
PROCEDURE ROTATE(val: <a packedset type>;
num: INTEGER): <type of the first parameter>;
PROCEDURE SHIFT(val: <a packedset type>;
num: INTEGER): <type of the first parameter>;
PROCEDURE CAST(<targettype>;
val: <anytype>): <targettype>;
PROCEDURE TSIZE (<type>; ... ): CARDINAL;
(*------------------------------------------------------- *)
(* -------------- non-standard features ----------------- *)
TYPE
INT8 = <integer 8-bits type>;
INT16 = <integer 16-bits type>;
INT32 = <integer 32-bits type>;
CARD8 = <cardinal 8-bits type>;
CARD16 = <cardinal 16-bits type>;
CARD32 = <cardinal 32-bits type>;
BOOL8 = <boolean 8-bits type>;
BOOL16 = <boolean 16-bits type>;
BOOL32 = <boolean 32-bits type>;
INDEX = <type of index>
DIFADR_TYPE = <type that DIFADR function returns>
TYPE (* for use in Oberon *)
INT = <Modula-2 INTEGER type>;
CARD = <Modula-2 CARDINAL type>;
TYPE (* for interfacing to C *)
int = <C int type>;
unsigned = <C unsigned type>;
size_t = <C size_t type>;
void = <C void type>;
PROCEDURE MOVE(src,dest: ADDRESS; size: CARDINAL);
PROCEDURE FILL(adr : ADDRESS; val : BYTE; size : CARDINAL;);
PROCEDURE GET(adr: ADDRESS; VAR var: SimpleType);
PROCEDURE PUT(adr: ADDRESS; var: SimpleType);
PROCEDURE CC(n: CARDINAL): BOOLEAN;
END SYSTEM.
Values of the LOC type are the uninterpreted contents of the smallest addressable unit of a storage in implementation. The value of the call TSIZE(LOC) is therefore equal to one.
The type LOC was introduced as a mechanism to resolve the problems with BYTE and WORD types. Its introduction allows a consistent handling of both these types, and enables also WORD-like types to be further introduced, eg:
TYPE WORD16 = ARRAY [0..1] OF SYSTEM.LOC;
The only operation directly defined for the LOC type is an assignment. There are special rules affecting parameter compatibility for system storage types. See System parameter compatibility for further details.
BYTE is defined as LOC and has all the properties of the type LOC.
The type WORD is defined as
CONST LOCSPERWORD = 4;
TYPE WORD = ARRAY [0..LOCSPERWORD-1] OF LOC;
and the value of the call TSIZE(WORD) is equal to LOCSPERWORD.
The only operation directly defined for the WORD type is an assignment. There are special rules affecting parameter compatibility for system storage types. See System parameter compatibility for further details.
The type ADDRESS is defined as
TYPE ADDRESS = POINTER TO LOC;
The ADDRESS type is an assignment compatible with all pointer types and vice versa (See Assignment compatibility). A formal variable parameter of the ADDRESS type is a parameter compatible with an actual parameter of any pointer type.
Variables of type ADDRESS are no longer expression compatible with CARDINAL (as it was in PIM) and they cannot directly occur in expressions that include arithmetic operators. Functions ADDADR, SUBADR and DIFADR were introduced for address arithmetic.
Types INT8, CARD8, INT16, CARD16, INT32, CARD32 are guaranteed to contain 8, 16, or 32 bits respectively.
These types are introduced to simplify constructing the interfaces for foreign libraries (See Chapter Multilanguage programming). Types SHORTINT, LONGINT, SHORTCARD, LONGCARD are synonyms of INT8, INT32, CARD8, CARD32, respectively (See also the M2ADDTYPES option). Types INTEGER and CARDINAL are synonyms of INT16/INT32, CARD16/CARD32, depending on the target platform. See also the M2BASE16 option.
These types are not described in the International Standard.
Types BOOL8, BOOL16, and BOOL32 are guaranteed to contain 8,16 and 32 bits respectively. By default the compiler uses BOOL8 type for BOOLEAN. In some cases (e.g. in the interface to the Windows API) BOOL16 or BOOL32 should be used instead.
These types are not described in the International Standard.
Types SET8, SET16, and SET32 are guaranteed to contain 8,16 and 32 bits respectively. The predefined type BITSET is a synonym for SYSTEM.SET16 or SYSTEM.SET32, depending on the target platform. See also the M2BASE16 option.
These types are not described in the International Standard.
Types INT and CARD are equal to Modula-2 INTEGER and CARDINAL types, respectively. These types can be used in Oberon-2 in order to use Modula-2 procedures in a portable way. See Modula-2 and Oberon-2 for further details.
These types are not described in the International Standard.
Types int, unsigned, size_t and void are introduced to simplify interfacing to C libraries. See Interfacing to C for further details.
PROCEDURE ADDADR(addr: ADDRESS;
offs: CARDINAL): ADDRESS;
Returns an address given by (addr + offs). The subsequent use of the calculated address may raise an exception.
PROCEDURE SUBADR(addr: ADDRESS;
offs: CARDINAL): ADDRESS;
Returns an address given by (addr - offs). The subsequent use of the calculated address may raise an exception.
PROCEDURE DIFADR(addr1,addr2: ADDRESS): INTEGER;
Returns the difference between addresses (addr1 - addr2).
PROCEDURE MAKEADR(val: <whole type>): ADDRESS;
The function is used to construct a value of the ADDRESS type from the value of a whole type.
Note: The International Standard does not define the number and types of the parameters. Programs that use this procedure may be non-portable.
PROCEDURE ADR(VAR v: <any type>): ADDRESS;
Returns the address of the variable v.
PROCEDURE CAST(<type>; x: <any type>): <type>;
The function CAST can be used (as a type transfer function) to interpret a value of any type other than a numeric literal value as a value of another type The International Standard forbids the use of the PIM style type transfer, like CARDINAL(x)..
The value of the call CAST(Type,val) is an unchecked conversion of val to the type Type. If SIZE(val) = TSIZE(Type), the bit pattern representation of the result is the same as the bit pattern representation of val; otherwise the result and the value of val have the same bit pattern representation for a size equal to the smaller of the numbers of storage units.
The given implementation may forbid some combinations of parameter types.
Note: In Oberon-2 module SYSTEM, the respective procedure is called VAL.
PROCEDURE TSIZE(Type; ... ): CARDINAL;
Returns the number of storage units (LOCs) used to store the value of the specified type. The extra parameters, if present, are used to distinguish variants in a variant record and must be constant expressionsThose constant expressions are ignored in the current release..
TYPE R = RECORD CASE i: INTEGER OF |1: r: REAL; |2: b: BOOLEAN; END; END; ... TSIZE(R,1) ...
The value of TSIZE(T) is equal to SIZE(T).
Values of packedset types are represented as sequences of bitsThe current implementation does not distinguish between set and packedset types.. The bit number 0 is the least significant bit for a given platform. The following is true, where v is a variable of the type CARDINAL:
CAST(CARDINAL,BITSET{0}) = VAL(CARDINAL,1) SHIFT(CAST(BITSET,v),1) = v * 2 SHIFT(CAST(BITSET,v),-1) = v DIV 2
Note: The functions ROTATE and SHIFT can be applied to a set with size less than or equal to the size of BITSET.
PROCEDURE ROTATE(x: T; n: integer): T;
Returns the value of x rotated n bits to the left (for positive n) or to the right (for negative n).
PROCEDURE SHIFT(x: T; n: integer): T;
Returns the value of x logically shifted n bits to the left (for positive n) or to the right (for negative n).
Warning: The result of SHIFT(x,n) , where n is greater than the number of elements in T, is undefined.
PROCEDURE CC(n: whole constant): BOOLEAN;
Returns TRUE if the corresponding condition flag is set. The function is not implemented in the current release.
PROCEDURE REF(VAR v: <anytype>):
POINTER TO <type of the parameter>;
Returns the pointer to the variable v. See also Parameter compatibility.
PROCEDURE BIT(adr: T; bit: INTEGER): BOOLEAN;
Returns bit n of Mem[adr]. T is either ADDRESS or whole type.
Note: all these procedures are non-standard.
PROCEDURE MOVE (src, dst: ADDRESS; size: CARDINAL);
Copies size bytes from the memory location specified by src to the memory location specified by dst.
Warning: No check for area overlap is performed. The behaviour of SYSTEM.MOVE in case of overlapping areas is undefined.
PROCEDURE FILL(adr : ADDRESS; val : BYTE; size : CARDINAL;);
Fills the memory block of size size starting from the memory location specified by adr with the value of val using a very efficient code.
PROCEDURE GET (adr: ADDRESS; VAR v: SimpleType);
PROCEDURE PUT (adr: ADDRESS; x: SimpleType);
Gets/puts a value from/to address specified by adr. The second parameter cannot be of a record or array type.
VAR i: INTEGER; GET (128, i); (* get system cell value *) i := i+20; (* change it *) PUT (128, i); (* and put back *)
PROCEDURE CODE(...);
The procedure is intended to embed a sequence of machine instructions directly into the generated code. The procedure is not implemented in the current release.
Warning: Using extensions may cause problems with software portability to other compilers.
In the standard mode the XDS Modula-2 compiler is ISO compliant (See ISO Standard compliance). A set of language extensions may be enabled using the M2EXTENSIONS and M2ADDTYPES options.
The main purposes of supporting the language extensions are:
NOTE: Only valid when option M2EXTENSIONS is set.
As well as (**), there is another valid format for comments in the source texts. The portion of a line from ``--'' to the end is considered as a comment.
VAR i: INTEGER; -- this is a comment --(* i:=0; (* this line will be compiled *) --*)
NOTE: Only valid when option M2EXTENSIONS is set.
Both Modula-2 and Oberon-2 syntax rules for the numeric and character representations may be used.
Number = [ "+" | "-" ] Integer | Real. Integer = digit { digit } | octalDigit { octalDigit } "B" | digit { hexDigit } "X". Real = digit { digit } "." { digit } [ ScaleFactor ]. ScaleFactor = ( "E" | "D" ) [ "+" | "-" ] digit {digit}. Character = '"' char '"' | "'" char "'" | digit {hexDigit} "H" | octalDigit {octalDigit} "C".
1991 1991 (decimal) 0DH 13 (decimal) 15B 13 (decimal) 41X "A" 101C "A"
Note: the symbol "D" in a ScaleFactor denotes a LONGREAL value.
NOTE: Only valid when option M2ADDTYPES is set.
The compiler option M2ADDTYPES introduces the following additional numeric types:
1. | SHORTINT | integers between -128 and 127 |
2. | LONGINT | integers between -2**31 and 2**31-1 |
3. | SHORTCARD | unsigned integers between 0 and 255 |
4. | LONGCARD | unsigned integers between 0 and 2**32-1 |
The following terms for groups of types will be used:
Real types for (REAL, LONGREAL)
Integer types for (SHORTINT, INTEGER, LONGINT)
Cardinal types for (SHORTCARD, CARDINAL, LONGCARD)
Whole types for integer and cardinal types
Numeric types for whole and real types
All integer types are implemented as subranges of internal compiler integer types. Therefore, according to the compatibility rules (See Compatibility), the values of different integer types can be mixed in the expressions. The same holds for cardinal types. A mixture of integer and cardinal types is not allowed in expressions. As in Oberon-2, the numeric types form a hierarchy, and larger types include (i.e. can accept the values of) smaller types: LONGREAL REAL
whole types
Type compatibility in expressions is extended according to the following rules (See Expression compatibility):
For instance, if the following variables are defined:
s: SHORTCARD; c: CARDINAL; i: INTEGER; l: LONGINT; r: REAL; lr: LONGREAL;
then
Expression | Meaning | Result type |
s + c | VAL(CARDINAL,s) + c | CARDINAL |
l * i | l * VAL(LONGINT,i) | LONGINT |
r + 1 | r + VAL(REAL,1) | REAL |
r = s | r = VAL(REAL,s) | BOOLEAN |
r + lr | VAL(LONGREAL,r) + lr | LONGREAL |
c + i | not allowed |
The assignment compatibility rules are also extended (See Assignment compatibility), so an expression e of type Te is assignment compatible with a variable v of type Tv if Te and Tv are of numeric types and Tv includes Te. Cardinal types and integer types are assignment compatible. The compiler generates the range checks whenever necessary.
Statement | Comment |
i:=c; | INTEGER and CARDINAL are assignment compatible |
i:=s; | INTEGER and SHORTCARD are assignment compatible |
l:=i; | LONGINT and INTEGER are subranges of the same host type |
r:=i; | REAL![]() |
r:=c; | REAL![]() |
lr:=r; | LONGREAL![]() |
NOTE: Only valid when option M2EXTENSIONS is set.
In ISO Modula-2, the second parameter of the SYSTEM.CAST procedure can not be a numeric literal. XDS provides numeric literal casting as an extension:
VAR c: CARDINAL; BEGIN (* Ok if M2EXTENSIONS is ON *) c := SYSTEM.CAST(CARDINAL,-1);
NOTE: Only valid when option M2EXTENSIONS is set.
An expression of type CHAR, BOOLEAN, SHORTCARD, SHORTINT, SYSTEM.INT8, or SYSTEM.CARD8 can be assigned to a variable of type BYTE or passed as an actual parameters to a formal parameter of type BYTE.
NOTE: Only valid when option M2EXTENSIONS is set.
XDS allows Oberon-2 style dynamic arrays to be used according to the Oberon-2 rules.
An open array is an array type with no lower and upper bound specified, i.e. ARRAY OF SomeType. Open arrays may be used only in procedure parameter lists or as a pointer base type.
TYPE String = POINTER TO ARRAY OF CHAR;
Neither variables nor record fields may be of open array type.
If the designator type is formally an open array, then the only operations allowed with it are indexing and passing it to a procedure.
The extended versions of standard procedures NEW and DISPOSE can be used to create and delete the dynamic arrays (See NEW and DISPOSE for dynamic arrays).
TYPE VECTOR = ARRAY OF REAL; (* 1-dim open array *) Vector = POINTER TO VECTOR; (* pointer to open array *) MATRIX = ARRAY OF VECTOR; (* 2-dim open array *) Matrix = POINTER TO MATRIX; (* pointer to this *) VAR v: Vector; m: Matrix; PROCEDURE ClearVector(VAR v: VECTOR); VAR i: CARDINAL; BEGIN FOR i := 0 TO HIGH (v) DO v[i] := 0 END; END ClearVector; PROCEDURE ClearMatrix(VAR m: Matrix); VAR i: CARDINAL; BEGIN FOR i := 0 TO HIGH (m) DO ClearVector(m[i]) END; END ClearMatrix; PROCEDURE Test; BEGIN NEW(v, 10); NEW(m, 10, 20); ClearVector(v^); ClearMatrix(m^); v^[0] := 1; m^[1][1] := 2; m^[2,2] := 1000; DISPOSE(v); DISPOSE(m); END Test;
XDS allows the declaration of constant arrays in the form
ARRAY OF QualIdent "{" ExprList "}"
QualIdent should refer to a basic type, range or enumeration type, and all expressions within ExprList should be of that type.
Note: structured types and non-constant expressions are not allowed.
The actual type of such a constant is ARRAY [0..n] OF QualIdent, where n+1 is the number of expressions in ExprList.
CONST table = ARRAY OF INTEGER {1, 2+3, 3};
Constant arrays are subject to the same rules as all other constants, and may be read as a normal array.
In some cases constructors of this form are more convenient than ISO standard value constructors (See Value constructors), because you do not need to declare a type and to calculate manually the number of expressions. However, to make your programs more portable, we recommend to use the standard features.
NOTE: Only valid when option M2EXTENSIONS is set.
As in Oberon-2, an unary minus applied to a set denotes the complement of that set, i.e. -x is the set of all values which are not the elements of x.
TYPE SmallSet = SET OF [0..5]; VAR x, y: SmallSet; BEGIN x := SmallSet{1,3,5}; y := -x; (* y = {0, 2, 4} *) y := SmallSet{0..5} - x; (* y = {0, 2, 4} *) END;
NOTE: Only valid when option M2EXTENSIONS is set.
In a formal parameter section, the symbol "-" may be placed after the name of a value parameter. Such a parameter is called read-only; its value can not be changed in the procedure body. Read-only parameters do not need to be copied before procedure activation; this enables procedures with structured parameters to be more effective.
For ARRAY and RECORD read-only parameters, the array elements and record fields are protected. Read-only parameters cannot be used in definition modules.
We recommend to use read-only parameters with care. The compiler does not check that the read-only parameter is not modified via another parameter or a global variable.
PROCEDURE Foo(VAR dest: ARRAY OF CHAR; source-: ARRAY OF CHAR); BEGIN dest[0]:='a'; dest[1]:=source[0]; END Foo;
The call Foo(x,x) would produce a wrong result, because the first Foo statement changes the value of source[0] (source is not copied and points to the same location as dest).
NOTE: Only valid when option M2EXTENSIONS is set.
The last formal parameter of a procedure may be declared as a ``sequence of bytes'' (SEQ-parameter). In a procedure call, any (possibly empty) sequence of actual parameters of any types may be substituted in place of that parameter. Only the declaration
SEQ name: SYSTEM.BYTE
is allowed. A procedure may have only one SEQ parameter, and it must be the last element of the formal parameters list.
Within the procedure, sequence parameters are very similar to open array parameters. This means that :
An array of bytes, which is passed to a procedure as a formal SEQ-parameter, is formed as follows:
See Sequence parameters for further information.
NOTE: Only valid when option M2EXTENSIONS is set.
The Oberon-2 read-only export symbol "-", being specified after a variable or field identifier in a definition module will define the identifier as read-only for any client. Only the module in which a read-only variable or field is declared may change its value.
The compiler will not allow the value of a read-only exported object to be changed explicitly (by an assignment) or implicitly (by passing it as a VAR parameter).
For read-only variables of an array or record type, both array elements and record fields are also read-only.
TYPE Rec = RECORD n-: INTEGER; m : INTEGER; END; VAR in-: FILE; x-: Rec;
An imported module can be renamed inside the importing module. The real name of the module becomes invisible.
Import = IMPORT [ Ident ":=" ] Ident { "," [ Ident ":=" ] ident } ";".
MODULE test; IMPORT vw := VirtualWorkstation; VAR ws: vw.Station; BEGIN ws := vw.open(); END test.
Standard procedures NEW and DISPOSE can be applied to variables of a dynamic array type (See Dynamic arrays). Procedures DYNALLOCATE and DYNDEALLOCATE have to be visible in the calling context. Their headers and semantics are described below.
PROCEDURE DYNALLOCATE(VAR a: ADDRESS; size: CARDINAL; len: ARRAY OF CARDINAL);
The procedure must allocate a dynamic array and return its address in a. size is the size of the array base type (the size of an element) and len[i] is the length of the array in i-th dimension.
PROCEDURE DYNDEALLOCATE(VAR a: ADDRESS; size,dim: CARDINAL);
The procedure must deallocate a dynamic array, where size is the size of an element and dim is the number of dimensions.
Note: In most cases, default implementation of these procedures may be used. The STORAGE option controls whether the default memory management should be enabled.
A dynamic array is represented as a pointer to a so-called array descriptor (See Array types).
An optional integer parameter is allowed for the HALT procedure.
PROCEDURE HALT ([code: INTEGER]);
HALT terminates the program execution with an optional return code. Consult your operating system/environment documentation for more details.
The procedure ASSERT checks its boolean parameter and terminates the program if it is not TRUE. The second optional parameter denotes task termination code. If it is omitted, a standard value is assumed.
PROCEDURE ASSERT(cond: BOOLEAN [; code: INTEGER]);
A call ASSERT(expr,code) is equivalent to
IF NOT expr THEN HALT(code) END;
Source code directives (or pragmas) are used to set compilation options in the source text and to select specific pieces of the source text to be compiled (conditional compilation). The ISO Modula-2 standard does not describe pragma syntax. XDS supports source code directives in both Modula-2 and Oberon-2. The syntax described in The Oakwood Guidelines for the Oberon-2 Compiler Developers is used.
In some cases it is more desirable to set a compiler option or equation within the source text. Some compiler options, such as MAIN, are more meaningful in the source file before the module header, and some, such as run-time checks, even between statements.
XDS allows options to be changed in the source text by using standard ISO pseudo comments <* ... *>The old pragma style (*$..*) is supported to provide backward compatibility, but the compiler reports the ``obsolete syntax'' warning. Some options can only be placed in the source text before the module header (i.e. before keywords IMPLEMENTATION, DEFINITION, and MODULE). These options will be ignored if found elsewhere in the source text. See Options reference for more details.
The format of an inline option or equation setting is described by the following syntax:
Pragma = "<*" PragmaBody "*>" PragmaBody = PUSH | POP | NewStyle | OldStyle NewStyle = [ NEW ] name [ "+" | "-" | "=" string ] OldStyle = ("+" | "-") name
NewStyle is proposed as the Oakwood standard for Oberon-2, OldStyle is the style used in the previous XDS releases. All option names are case-independent. If OldStyle is used, there should be no space between <* and + or - OldStyle does not allow to declare a new option or equation and to change an equation value.
In all cases, the symbol + sets the corresponding option ON, and the symbol - sets it OFF.
PUSH and POP keywords may be used to save and restore the whole state of options and equations.
PROCEDURE Length(VAR a: ARRAY OF CHAR): CARDINAL; VAR i: CARDINAL; BEGIN <* PUSH *> (* save state *) <* CHECKINDEX - *> (* turn CHECKINDEX off *) i := 0; WHILE (i<=HIGH(a)) & (a[i]#0C) DO INC(i) END; <* POP *> (* restore state *) RETURN i; END Length;
<* ALIGNMENT = "2" *> TYPE R = RECORD (* This record is 6 bytes long *) f1: CHAR; f2: CARDINAL; END;
It is possible to use conditional compilation with Modula-2 and Oberon-2only if the O2ISOPRAGMA option is set ON compilers via the standard ISO pragma notation <* *>. Conditional compilation statements can be placed anywhere in the source code. The syntax of the conditional compilation IF statement follows:
IfStatement = <* IF Expression THEN *> text { <* ELSIF Expression THEN *> text } [ <* ELSE *> text ] <* END *> Expression = SimpleExpression [ ("=" | "#") SimpleExpression]. SimpleExpression = Term { "OR" Term}. Term = Factor { "&" Factor}. Factor = Ident | string | "DEFINED" "(" Ident ")" | "(" Expression ")" | "~" Factor | "NOT" Factor. Ident = option | equation.
An operand in an expression is either a name of an option or equation or a string literal. An option has the string value "TRUE", if it is currently set ON and "FALSE", if it is currently set off or was not defined at all. The compiler will report a warning if an undeclared option or equation is used as a conditional compilation identifier.
The comparison operators "=" and "#" are not case sensitive.
See also the section The system module COMPILER.
IMPORT lib := <* IF __GEN_X86__ THEN *> MyX86Lib; <* ELSIF __GEN_C__ THEN *> MyCLib; <* ELSE *> *** Unknown *** <* END *>
CONST Win = <* IF Windows THEN *> TRUE <* ELSE *> FALSE <* END *>;
<* IF DEFINED(Debug) & (DebugLevel = "2") THEN *> PrintDebugInformation; <* END *>;
<* IF target_os = "OS2" THEN *> Strings.Capitalize(filename); <* IF NOT HPFS THEN *> TruncateFileName(filename); <* END *> <* END *>