* Linking:: Linking options in more detail.
* Elementary data types:: Data types supported by GNU Modula-2.
* Standard procedures:: Permanently accessible base procedures.
+* High procedure function:: Behavior of the high procedure function.
* Dialect:: GNU Modula-2 supported dialects.
* Exceptions:: Exception implementation
* Semantic checking:: How to detect run time problems at compile time.
foo('hello')
END
- will cause the local variable c to contain the value 4
+ will cause the local variable c to contain the value 5
*)
@findex HIGH
PROCEDURE RE (c: <any complex type>) : <floating point type> ;
@end example
-@node Dialect, Exceptions, Standard procedures, Using
+@node High procedure function, Dialect, Standard procedures, Using
+
+@section Behavior of the high procedure function
+
+This section describes the behavior of the standard procedure function
+@code{HIGH} and it includes a table of parameters with the expected
+return result. The standard procedure function will return the last
+accessible indice of an @code{ARRAY}. If the parameter to @code{HIGH}
+is a static array then the result will be a @code{CARDINAL} value
+matching the upper bound in the @code{ARRAY} declaration.
+
+The section also describes the behavior of a string literal actual
+parameter and how it relates to @code{HIGH}.
+The PIM2, PIM3, PIM4 and ISO standard is silent on the issue of
+whether a @code{nul} is present in an @code{ARRAY} @code{OF}
+@code{CHAR} actual parameter.
+
+If the first parameter to @code{HIGH} is an unbounded @code{ARRAY} the
+return value from @code{HIGH} will be the last accessible element in
+the array. If a constant string literal is passed as an actual
+parameter then it will be @code{nul} terminated. The table and
+example code below describe the effect of passing an actual parameter
+and the expected @code{HIGH} value.
+
+@example
+MODULE example1 ;
+
+PROCEDURE test (a: ARRAY OF CHAR) ;
+VAR
+ x: CARDINAL ;
+BEGIN
+ x := HIGH (a) ;
+ ...
+END test ;
+
+
+BEGIN
+ test ('') ;
+ test ('1') ;
+ test ('12') ;
+ test ('123') ;
+END example1.
+
+
+Actual parameter | HIGH (a) | a[HIGH (a)] = nul
+===============================================
+ '' | 0 | TRUE
+ '1' | 1 | TRUE
+ '12' | 2 | TRUE
+ '123' | 3 | TRUE
+@end example
+
+A constant string literal will be passed to an @code{ARRAY} @code{OF}
+@code{CHAR} with an appended @code{nul} @code{CHAR}. Thus if the
+constant string literal @code{''} is passed as an actual parameter (in
+example1) then the result from @code{HIGH(a)} will be @code{0}.
+
+@example
+MODULE example2 ;
+
+PROCEDURE test (a: ARRAY OF CHAR) ;
+VAR
+ x: CARDINAL ;
+BEGIN
+ x := HIGH (a) ;
+ ...
+END test ;
+
+VAR
+ str0: ARRAY [0..0] OF CHAR ;
+ str1: ARRAY [0..1] OF CHAR ;
+ str2: ARRAY [0..2] OF CHAR ;
+ str3: ARRAY [0..3] OF CHAR ;
+BEGIN
+ str0 := 'a' ; (* No room for the nul terminator. *)
+ test (str0) ;
+ str1 := 'ab' ; (* No room for the nul terminator. *)
+ test (str1) ;
+ str2 := 'ab' ; (* Terminated with a nul. *)
+ test (str2) ;
+ str2 := 'abc' ; (* Terminated with a nul. *)
+ test (str3) ;
+END example2.
+
+Actual parameter | HIGH (a) | a[HIGH (a)] = nul
+===============================================
+ str0 | 0 | FALSE
+ str1 | 1 | FALSE
+ atr2 | 2 | TRUE
+ str3 | 3 | TRUE
+@end example
+
+@node Dialect, Exceptions, High procedure function, Using
@section GNU Modula-2 supported dialects
This section describes the dialects understood by GNU Modula-2.
-# Make-maintainer.in build support tools for GNU M2.
+# Make-maintainer.in subsidiary -*- makefile -*- build support for GNU M2 tools.
# Copyright (C) 2022-2023 Free Software Foundation, Inc.
NoOfParam, GetParent, GetDimension, IsAModula2Type,
IsModule, IsDefImp, IsType, IsModuleWithinProcedure,
IsConstString, GetString, GetStringLength,
+ IsConstStringCnul, IsConstStringM2nul,
IsConst, IsConstSet, IsProcedure, IsProcType,
IsVar, IsVarParam, IsTemporary,
IsEnumeration,
location: location_t ;
BEGIN
location := TokenToLocation(GetDeclaredMod(operand)) ;
- RETURN( GetCardinalZero(location) )
+ IF IsConstString (operand) AND
+ (IsConstStringM2nul (operand) OR IsConstStringCnul (operand))
+ THEN
+ RETURN GetCardinalOne (location)
+ END ;
+ RETURN GetCardinalZero (location)
END BuildHighFromChar ;
ELSE
MetaError1('not expecting this function inside a constant expression {%1Dad}', func)
END
- END
+ END ;
+ RETURN( TRUE )
END
END WalkFunction ;
*)
PROCEDURE Init ;
+VAR
+ fdi: CARDINAL ;
BEGIN
- WITH fdState[0] DO
- IsEof := FALSE ;
- IsRaw := FALSE
- END ;
- WITH fdState[1] DO
- IsEof := FALSE ;
- IsRaw := FALSE
- END ;
- WITH fdState[2] DO
- IsEof := FALSE ;
- IsRaw := FALSE
+ FOR fdi := 0 TO HIGH (fdState) DO
+ fdState[fdi].IsEof := FALSE ;
+ fdState[fdi].IsRaw := FALSE
END
END Init ;
* gm2-libs/LegacyReal::LegacyReal.def
* gm2-libs/M2Dependent::M2Dependent.def
* gm2-libs/M2EXCEPTION::M2EXCEPTION.def
-* gm2-libs/M2LINK::M2LINK.def
* gm2-libs/M2RTS::M2RTS.def
* gm2-libs/MathLib0::MathLib0.def
* gm2-libs/MemUtils::MemUtils.def
@findex ConstructModules
-PROCEDURE ConstructModules (applicationmodule, libname: ADDRESS;
+PROCEDURE ConstructModules (applicationmodule, libname,
+ overrideliborder: ADDRESS;
argc: INTEGER; argv, envp: ADDRESS) ;
@findex DeconstructModules
@end example
@page
-@node gm2-libs/M2EXCEPTION, gm2-libs/M2LINK, gm2-libs/M2Dependent, Base libraries
+@node gm2-libs/M2EXCEPTION, gm2-libs/M2RTS, gm2-libs/M2Dependent, Base libraries
@subsection gm2-libs/M2EXCEPTION
@example
@end example
@page
-@node gm2-libs/M2LINK, gm2-libs/M2RTS, gm2-libs/M2EXCEPTION, Base libraries
-@subsection gm2-libs/M2LINK
-
-@example
-DEFINITION MODULE FOR "C" M2LINK ;
-
-
-TYPE
-@findex PtrToChar (type)
- PtrToChar = POINTER TO CHAR ;
-
-(* These variables are set by the compiler in the program module
- according to linking command line options. *)
-
-VAR
-@findex ForcedModuleInitOrder (var)
- ForcedModuleInitOrder: PtrToChar ;
-@findex StaticInitialization (var)
- StaticInitialization : BOOLEAN ;
-
-
-@findex END M2LINK. (var)
-END M2LINK.
-@end example
-@page
-
-@node gm2-libs/M2RTS, gm2-libs/MathLib0, gm2-libs/M2LINK, Base libraries
+@node gm2-libs/M2RTS, gm2-libs/MathLib0, gm2-libs/M2EXCEPTION, Base libraries
@subsection gm2-libs/M2RTS
@example
@findex ConstructModules
-PROCEDURE ConstructModules (applicationmodule, libname: ADDRESS;
+PROCEDURE ConstructModules (applicationmodule, libname,
+ overrideliborder: ADDRESS;
argc: INTEGER; argv, envp: ADDRESS) ;
@findex DeconstructModules
* gm2-libs-iso/TERMINATION::TERMINATION.def
* gm2-libs-iso/TermFile::TermFile.def
* gm2-libs-iso/TextIO::TextIO.def
+* gm2-libs-iso/TextUtil::TextUtil.def
* gm2-libs-iso/WholeConv::WholeConv.def
* gm2-libs-iso/WholeIO::WholeIO.def
* gm2-libs-iso/WholeStr::WholeStr.def
@findex ConstructModules
PROCEDURE ConstructModules (applicationmodule, libname: ADDRESS;
+ overrideliborder: ADDRESS;
argc: INTEGER; argv, envp: ADDRESS) ;
@findex DeconstructModules
@end example
@page
-@node gm2-libs-iso/TextIO, gm2-libs-iso/WholeConv, gm2-libs-iso/TermFile, M2 ISO Libraries
+@node gm2-libs-iso/TextIO, gm2-libs-iso/TextUtil, gm2-libs-iso/TermFile, M2 ISO Libraries
@subsection gm2-libs-iso/TextIO
@example
@end example
@page
-@node gm2-libs-iso/WholeConv, gm2-libs-iso/WholeIO, gm2-libs-iso/TextIO, M2 ISO Libraries
+@node gm2-libs-iso/TextUtil, gm2-libs-iso/WholeConv, gm2-libs-iso/TextIO, M2 ISO Libraries
+@subsection gm2-libs-iso/TextUtil
+
+@example
+DEFINITION MODULE TextUtil ;
+
+(*
+ Description: provides text manmipulation routines.
+*)
+
+IMPORT IOChan ;
+
+
+(*
+ SkipSpaces - skips any spaces.
+*)
+
+@findex SkipSpaces
+PROCEDURE SkipSpaces (cid: IOChan.ChanId) ;
+
+
+(* The following procedures do not read past line marks. *)
+
+@findex CharAvailable
+PROCEDURE CharAvailable (cid: IOChan.ChanId) : BOOLEAN ;
+
+
+@findex EofOrEoln
+PROCEDURE EofOrEoln (cid: IOChan.ChanId) : BOOLEAN ;
+
+
+END TextUtil.
+@end example
+@page
+
+@node gm2-libs-iso/WholeConv, gm2-libs-iso/WholeIO, gm2-libs-iso/TextUtil, M2 ISO Libraries
@subsection gm2-libs-iso/WholeConv
@example
--- /dev/null
+MODULE hightests ;
+
+
+FROM libc IMPORT printf, exit ;
+FROM StrLib IMPORT StrCopy ;
+
+PROCEDURE testhigh (a: ARRAY OF CHAR; expected: CARDINAL; first: CHAR; checkNul: BOOLEAN) ;
+VAR
+ copy: ARRAY [0..10] OF CHAR ;
+BEGIN
+ StrCopy (a, copy) ;
+ IF HIGH (a) # expected
+ THEN
+ printf ("unexpected high value, HIGH(%s) should be %d but was passed %d\n",
+ copy, expected, HIGH (a)) ;
+ code := 1
+ END ;
+ IF a[0] # first
+ THEN
+ printf ("unexpected first value in open array, %s, a[0] should be %c but was passed %c\n",
+ a, first, a[0]) ;
+ code := 2
+ END ;
+ IF checkNul AND (a[HIGH(a)] # 0C)
+ THEN
+ printf ("expected the array to contain a 0C terminator\n") ;
+ code := 3
+ END
+END testhigh ;
+
+
+VAR
+ str0: ARRAY [0..0] OF CHAR ;
+ str1: ARRAY [0..1] OF CHAR ;
+ str2: ARRAY [0..2] OF CHAR ;
+ str3: ARRAY [0..3] OF CHAR ;
+ ch : CHAR ;
+ code: INTEGER ;
+BEGIN
+ testhigh ('1', 1, '1', TRUE) ;
+ str0 := '_' ;
+ str1 := '_1' ;
+ str2 := '_2' ;
+ str3 := '_3' ;
+ code := 0 ;
+ testhigh ('', 0, 0C, TRUE) ;
+ testhigh ('1', 1, '1', TRUE) ;
+ testhigh ('12', 2, '1', TRUE) ;
+ testhigh ('123', 3, '1', TRUE) ;
+ testhigh ('1234', 4, '1', TRUE) ;
+ testhigh (str0, 0, '_', FALSE) ;
+ testhigh (str1, 1, '_', FALSE) ;
+ testhigh (str2, 2, '_', TRUE) ;
+ testhigh (str3, 3, '_', TRUE) ;
+ IF code = 0
+ THEN
+ printf ("all tests pass\n")
+ ELSE
+ exit (1)
+ END
+END hightests.
projects / thirdparty / gcc.git / commitdiff
