diff options
author | Gaius Mulley <gaius.mulley@southwales.ac.uk> | 2022-06-25 15:13:53 +0100 |
---|---|---|
committer | Gaius Mulley <gaius.mulley@southwales.ac.uk> | 2022-06-25 15:13:53 +0100 |
commit | 6c02f7ca5c93f4ea57fb7701b5daebc9e5cd3e94 (patch) | |
tree | fa917f351dd7a85ed8f36595e86b7ceb83fce140 | |
parent | dbd4f352dac26b84eec4ff0d6324a50f4a630e1e (diff) |
Further driver cleanup and allow forced linking of ctors.
This patch further cleans up the driver gm2. It also moves
some of the C support libraries into C++ mimicing m2 ctor
behaviour. -fuselist= is also implemented which forces
module ctors to be referenced in the scaffold.
2022-06-25 Gaius Mulley <gaius.mulley@southwales.ac.uk>
gcc/ChangeLog:
* doc/gm2.texi (-fobject-path=): Removed. (-fmakeinit)
Removed. (-fmakelist) Removed. (-fuselist) Removed.
(-fuselist=@file{filename}) Added.
gcc/m2/ChangeLog:
* m2/gm2-compiler/Lists.mod: Corrected spacing.
* m2/gm2-compiler/M2Options.def (SetUselist): New procedure.
(GetUselist) New procedure function.
* m2/gm2-compiler/M2Options.mod (UselistFilename): New
variable. (SetUselist) New procedure implementation.
(GetUselist) New procedure implementation.
* m2/gm2-compiler/M2Quads.mod (BuildM2LinkFunction)
New procedure. (BuildM2MainFunction) build call to
linkFunction. (BuildScaffold) call BuildM2MainFunction.
(MakeLengthConst) Re-implemented.
* m2/gm2-compiler/M2Scaffold.def (linkFunction):
New variable. (PopulateCtorArray) New procedure.
* m2/gm2-compiler/M2Scaffold.mod (DeclareCtorArrayType):
New procedure function. (DeclareCtorGlobal) New procedure.
(PopulateCtorArray) New procedure. (ReadModules) New
procedure. (CreateCtorList) New procedure function.
(DeclareCtorModuleExtern) New procedure.
(DeclareScaffoldFunctions) Declare the ctor global array and
declare all external modules ctors.
* m2/gm2-compiler/PCSymBuild.mod: Remove stop.
* m2/gm2-compiler/SymbolTable.def (MakeProcedureCtorExtern)
New procedure function. (PutExtern) New procedure function.
(IsExtern) New procedure function. (MakeConstant) New
procedure function.
* m2/gm2-compiler/SymbolTable.mod (Procedure): New field IsExtern.
(MakeProcedureCtorExtern) New procedure function.
(PutExtern) New procedure. (IsExtern) New procedure function.
(MakeConstant) New procedure function implemented.
* m2/gm2-gcc/m2options.h (SetUselist): New procedure.
* m2/gm2-lang.cc (fuselist): Removed. (fmakelist) Removed.
(fmodules) Removed. (fuselist_) Added.
* m2/gm2spec.cc (fuselist): Removed.
* m2/lang.opt (fuselist): Removed. (fmakelist) Removed.
(fmodules) Removed. (fuselist=) Added.
libgm2/Changelog:
* libm2pim/Makefile.am (M2MODS): Add M2Dependent.mod
(M2DEFS) Add M2Dependent.def.
* libm2iso/ErrnoCategory.cc (Renamed from ErrnoCategory.c).
Converted to C++.
* libm2iso/Makefile.am: Changed .c extensions to .cc.
* libm2iso/RTco.cc (Renamed from RTco.c): Converted to C++.
* libm2pim/Makefile.am: Changed .c extensions to .cc.
* libm2pim/SysExceptions.cc (Renamed from SysExceptions.c):
Converted to C++.
* libm2pim/errno.cc (Renamed from errno.c): Converted to C++.
* libm2pim/termios.cc (Renamed from termios.c): Converted to C++.
Signed-off-by: Gaius Mulley <gaius.mulley@southwales.ac.uk>
28 files changed, 624 insertions, 227 deletions
diff --git a/gcc/doc/gm2.texi b/gcc/doc/gm2.texi index 0491b044f63..91e2bf0259b 100644 --- a/gcc/doc/gm2.texi +++ b/gcc/doc/gm2.texi @@ -588,20 +588,6 @@ If this option is not specified then the default path is added which consists of the current directory followed by the appropriate language dialect library directories. -@item -fobject-path= -used to specify the path for objects during the linking stage. An -example is: @code{gm2 -g -fobject-path=.:../../libs/O2 -I.:../../libs -foo.mod}. The combination of @code{-I} and @code{-fobject-path=} -allows projects to keep various styles of objects separate from their -source counterparts. For example it would be possible to compile -implementation modules with different levels of optimization and -with/without debugging and keep them in separate directories. If the -@code{-fobject-path=} option is not specified then it is set -internally by using the path as specified by the @code{-I} option. If -the @code{-I} was also not specified then it uses the current -directory. In all cases the appropriate language dialect library -directories are appended to the end of the path. - @item -fdebug-builtins call a real function, rather than the builtin equivalent. This can be useful for debugging parameter values to a builtin function as @@ -617,11 +603,6 @@ generate a swig interface file. @item -fshared generate a shared library from the module. -@item -fmakeinit -generate the start up C++ code for the module, a file -@file{modulename_m2.cpp} is created. This is an internal command -line option. - @item -fruntime-modules= specify, using a comma separated list, the runtime modules and their order. These modules will initialized first before any other modules @@ -731,18 +712,6 @@ where multiple @code{END} keywords are mapped onto a sequence of @item -fm2-lower-case render keywords in error messages using lower case. -@item -fmakelist -this option is only applicable when linking a program module. The -compiler will generate a @file{modulename.lst} file which contains a -list indicating the initialisation order of all modules which are to -be linked. The actual link does not occur. The GNU Modula-2 linker -scans all @code{IMPORT}s, generates a list of dependencies and -produces an ordered list for initialization. -This might be useful should your project has cyclic dependencies as the -@file{.lst} file is plain text and can be modified if required. Once -the @file{.lst} file is created it can be used by the compiler to link -your project via the @samp{-fuselist} option. - @item fno-pthread do not automatically link against the pthread library. This option is likely useful if gm2 is configured as a cross compiler targetting @@ -750,10 +719,11 @@ embedded systems. By default GNU Modula-2 uses the GCC pthread libraries to implement coroutines (see the SYSTEM implementation module). -@item -fuselist -providing @samp{gm2} has been told to link the program module this -option uses the file @file{modulename.lst} for the initialization -order of modules. +@item -fuselist=@file{filename} +if @samp{-fscaffold-static} is enabled then use the file +@file{filename} for the initialization order of modules. Whereas if +@samp{-fscaffold-dynamic} is enabled then use this file to force +linking of all module ctors. @item -fscaffold-static the option ensures that @samp{gm2} will generate a static scaffold diff --git a/gcc/m2/gm2-compiler/Lists.mod b/gcc/m2/gm2-compiler/Lists.mod index 9df9f2ac33f..c9b54b4ac61 100644 --- a/gcc/m2/gm2-compiler/Lists.mod +++ b/gcc/m2/gm2-compiler/Lists.mod @@ -41,7 +41,7 @@ TYPE PROCEDURE InitList (VAR l: List) ; BEGIN - NEW(l) ; + NEW (l) ; WITH l^ DO NoOfElements := 0 ; Next := NIL diff --git a/gcc/m2/gm2-compiler/M2Options.def b/gcc/m2/gm2-compiler/M2Options.def index a470e3a317c..ab16cf64c38 100644 --- a/gcc/m2/gm2-compiler/M2Options.def +++ b/gcc/m2/gm2-compiler/M2Options.def @@ -52,7 +52,7 @@ EXPORT QUALIFIED SetReturnCheck, SetNilCheck, SetCaseCheck, SetWholeValueCheck, GetWholeValueCheck, SetLowerCaseKeywords, SetIndex, SetRange, SetWholeDiv, SetStrictTypeChecking, - Setc, Getc, + Setc, Getc, SetUselist, GetUselist, Iso, Pim, Pim2, Pim3, Pim4, cflag, @@ -240,6 +240,20 @@ PROCEDURE GetRuntimeModuleOverride () : ADDRESS ; (* + SetUselist - set the uselist to filename. +*) + +PROCEDURE SetUselist (filename: ADDRESS) ; + + +(* + GetUselist - return the uselist filename as a String. +*) + +PROCEDURE GetUselist () : String ; + + +(* SetWholeProgram - sets the WholeProgram flag (-fwhole-program). *) diff --git a/gcc/m2/gm2-compiler/M2Options.mod b/gcc/m2/gm2-compiler/M2Options.mod index f513f52f533..00df4ddde94 100644 --- a/gcc/m2/gm2-compiler/M2Options.mod +++ b/gcc/m2/gm2-compiler/M2Options.mod @@ -51,6 +51,7 @@ CONST Debugging = FALSE ; VAR + UselistFilename, RuntimeModuleOverride, CppProgram, CppArgs : String ; @@ -403,7 +404,28 @@ END Getc ; (* - SetM2g - returns TRUE if the -fm2-g flags was used. + SetUselist - set the uselist to filename. +*) + +PROCEDURE SetUselist (filename: ADDRESS) ; +BEGIN + UselistFilename := InitStringCharStar (filename) +END SetUselist ; + + +(* + GetUselist - return the uselist filename as a String. +*) + +PROCEDURE GetUselist () : String ; +BEGIN + RETURN UselistFilename +END GetUselist ; + + +(* + SetM2g - set GenerateStatementNote to value and return value. + Corresponds to the -fm2-g flag. *) PROCEDURE SetM2g (value: BOOLEAN) : BOOLEAN ; @@ -1170,5 +1192,6 @@ BEGIN SaveTemps := FALSE ; ScaffoldDynamic := TRUE ; ScaffoldStatic := FALSE ; - ScaffoldMain := FALSE + ScaffoldMain := FALSE ; + UselistFilename := NIL END M2Options. diff --git a/gcc/m2/gm2-compiler/M2Quads.mod b/gcc/m2/gm2-compiler/M2Quads.mod index d5dc6d164a9..c3263657b19 100644 --- a/gcc/m2/gm2-compiler/M2Quads.mod +++ b/gcc/m2/gm2-compiler/M2Quads.mod @@ -28,7 +28,7 @@ FROM NameKey IMPORT Name, NulName, MakeKey, GetKey, makekey, KeyToCharStar, Writ FROM FormatStrings IMPORT Sprintf0, Sprintf1, Sprintf2, Sprintf3 ; FROM M2DebugStack IMPORT DebugStack ; FROM M2Scaffold IMPORT DeclareScaffold, mainFunction, initFunction, - finiFunction ; + finiFunction, linkFunction, PopulateCtorArray ; FROM M2MetaError IMPORT MetaError0, MetaError1, MetaError2, MetaError3, MetaErrors1, MetaErrors2, MetaErrors3, @@ -49,7 +49,7 @@ FROM SymbolTable IMPORT ModeOfAddr, GetMode, PutMode, GetSymName, IsUnknown, MakeTemporaryFromExpression, MakeTemporaryFromExpressions, MakeConstLit, MakeConstLitString, - MakeConstString, + MakeConstString, MakeConstant, Make2Tuple, RequestSym, MakePointer, PutPointer, SkipType, @@ -2352,6 +2352,34 @@ END BuildM2DepFunction ; (* + BuildM2LinkFunction - creates the _M2_link procedure which will + cause the linker to pull in all the module ctors. +*) + +PROCEDURE BuildM2LinkFunction (tokno: CARDINAL; modulesym: CARDINAL) ; +BEGIN + IF ScaffoldDynamic AND (linkFunction # NulSym) + THEN + (* void + _M2_link (void) + { + for each module in uselist do + PROC foo_%d = _M2_module_ctor + done + }. *) + PushT (linkFunction) ; + BuildProcedureStart ; + BuildProcedureBegin ; + StartScope (linkFunction) ; + PopulateCtorArray (tokno) ; + EndScope ; + BuildProcedureEnd ; + PopN (1) + END +END BuildM2LinkFunction ; + + +(* BuildM2MainFunction - creates the main function with appropriate calls to the scaffold. *) @@ -2421,6 +2449,15 @@ BEGIN StartScope (initFunction) ; IF ScaffoldDynamic THEN + IF linkFunction # NulSym + THEN + (* _M2_link (); *) + PushTtok (linkFunction, tok) ; + PushT (0) ; + BuildProcedureCall (tok) + END ; + + (* Lookup ConstructModules and call it. *) constructModules := GetQualidentImport (tok, MakeKey ("ConstructModules"), MakeKey ("M2RTS")) ; @@ -2571,6 +2608,7 @@ BEGIN (* There are module init/fini functions and application init/fini functions. Here we create the application pair. *) + BuildM2LinkFunction (tok, moduleSym) ; BuildM2MainFunction (tok, moduleSym) ; BuildM2InitFunction (tok, moduleSym) ; (* Application init. *) BuildM2FiniFunction (tok, moduleSym) ; (* Application fini. *) @@ -7989,16 +8027,8 @@ END GetQualidentImport ; *) PROCEDURE MakeLengthConst (tok: CARDINAL; sym: CARDINAL) : CARDINAL ; -VAR - l: CARDINAL ; - s: String ; - c: CARDINAL ; BEGIN - l := GetStringLength (sym) ; - s := Sprintf1 (Mark (InitString("%d")), l) ; - c := MakeConstLit (tok, makekey (string (s)), Cardinal) ; - s := KillString (s) ; - RETURN c + RETURN MakeConstant (tok, GetStringLength (sym)) END MakeLengthConst ; diff --git a/gcc/m2/gm2-compiler/M2Scaffold.def b/gcc/m2/gm2-compiler/M2Scaffold.def index f16575f6eb3..adf7effed48 100644 --- a/gcc/m2/gm2-compiler/M2Scaffold.def +++ b/gcc/m2/gm2-compiler/M2Scaffold.def @@ -23,6 +23,7 @@ DEFINITION MODULE M2Scaffold ; VAR + linkFunction, finiFunction, initFunction, mainFunction: CARDINAL ; @@ -42,4 +43,13 @@ PROCEDURE DeclareScaffold (tokno: CARDINAL) ; PROCEDURE DeclareArgEnvParams (tokno: CARDINAL; proc: CARDINAL) ; +(* + PopulateCtorArray - assign each element of the ctorArray to the external module ctor. + This is only used to force the linker to pull in the ctors from + a library. +*) + +PROCEDURE PopulateCtorArray (tok: CARDINAL) ; + + END M2Scaffold. diff --git a/gcc/m2/gm2-compiler/M2Scaffold.mod b/gcc/m2/gm2-compiler/M2Scaffold.mod index e27ccf26c36..e7c5fdee19f 100644 --- a/gcc/m2/gm2-compiler/M2Scaffold.mod +++ b/gcc/m2/gm2-compiler/M2Scaffold.mod @@ -23,14 +23,39 @@ IMPLEMENTATION MODULE M2Scaffold ; FROM SymbolTable IMPORT NulSym, MakeProcedure, PutFunction, PutPublic, PutCtor, PutParam, IsProcedure, - StartScope, - EndScope ; + MakeConstant, PutExtern, MakeArray, PutArray, + MakeSubrange, PutSubrange, + MakeSubscript, PutSubscript, PutArraySubscript, + MakeVar, PutVar, MakeProcedureCtorExtern, + GetMainModule, + GetSymName, StartScope, EndScope ; -FROM NameKey IMPORT MakeKey ; -FROM M2Base IMPORT Integer ; +FROM NameKey IMPORT NulName, Name, MakeKey, makekey, KeyToCharStar ; +FROM M2Base IMPORT Integer, Cardinal ; FROM M2System IMPORT Address ; FROM M2LexBuf IMPORT GetTokenNo ; FROM Assertion IMPORT Assert ; +FROM Lists IMPORT List, InitList, IncludeItemIntoList, NoOfItemsInList, GetItemFromList ; +FROM M2MetaError IMPORT MetaErrorT0 ; + +FROM SFIO IMPORT OpenToWrite, WriteS, ReadS, OpenToRead, Exists ; +FROM FIO IMPORT File, EOF, IsNoError, Close ; +FROM M2Options IMPORT GetUselist ; +FROM M2Base IMPORT Proc ; +FROM M2Quads IMPORT PushTFtok, PushTtok, BuildDesignatorArray, BuildAssignment ; + +FROM DynamicStrings IMPORT String, InitString, KillString, ConCat, RemoveWhitePrefix, + EqualArray, Mark, Assign, Fin, InitStringChar, Length, Slice, Equal, + RemoveComment, string ; + +CONST + Comment = '#' ; (* Comment leader *) + +VAR + ctorModules, + ctorGlobals : List ; + ctorArray, + ctorArrayType: CARDINAL ; (* The dynamic scaffold takes the form: @@ -58,13 +83,158 @@ main (int argc, char *argv[], char *envp[]) (* + DeclareCtorArrayType - declare an ARRAY [0..high] OF PROC which will + be used to reference every module ctor. +*) + +PROCEDURE DeclareCtorArrayType (tokenno: CARDINAL; high: CARDINAL) : CARDINAL ; +VAR + subscript, + subrange : CARDINAL ; +BEGIN + (* ctorArrayType = ARRAY [0..n] OF PROC ; *) + ctorArrayType := MakeArray (tokenno, MakeKey ('ctorGlobalType')) ; + PutArray (ctorArrayType, Proc) ; + subrange := MakeSubrange (tokenno, NulName) ; + PutSubrange (subrange, + MakeConstant (tokenno, 0), + MakeConstant (tokenno, high), + Cardinal) ; + subscript := MakeSubscript () ; + PutSubscript (subscript, subrange) ; + PutArraySubscript (ctorArrayType, subscript) ; + RETURN ctorArrayType +END DeclareCtorArrayType ; + + +(* + DeclareCtorGlobal - declare the ctorArray variable. +*) + +PROCEDURE DeclareCtorGlobal (tokenno: CARDINAL) ; +VAR + n: CARDINAL ; +BEGIN + n := NoOfItemsInList (ctorGlobals) ; + ctorArrayType := DeclareCtorArrayType (tokenno, n) ; + ctorArray := MakeVar (tokenno, MakeKey ('_M2_ctorArray')) ; + PutVar (ctorArray, ctorArrayType) +END DeclareCtorGlobal ; + + +(* + PopulateCtorArray - assign each element of the ctorArray to the external module ctor. + This is only used to force the linker to pull in the ctors from + a library. +*) + +PROCEDURE PopulateCtorArray (tok: CARDINAL) ; +VAR + i, n: CARDINAL ; +BEGIN + n := NoOfItemsInList (ctorModules) ; + i := 1 ; + WHILE i <= n DO + PushTFtok (ctorArray, ctorArrayType, tok) ; + PushTtok (MakeConstant (tok, i), tok) ; + BuildDesignatorArray ; + PushTtok (GetItemFromList (ctorModules, i), tok) ; + BuildAssignment (tok) ; + INC (i) + END +END PopulateCtorArray ; + + +(* + ReadModules - populate ctorGlobals with the modules specified by -fuselist=filename. +*) + +PROCEDURE ReadModules (filename: String) ; +VAR + f: File ; + s: String ; +BEGIN + InitList (ctorGlobals) ; + f := OpenToRead (filename) ; + WHILE NOT EOF (f) DO + s := ReadS (f) ; + s := RemoveComment (RemoveWhitePrefix (s), Comment) ; + IF (NOT Equal (Mark (InitStringChar (Comment)), + Mark (Slice (s, 0, Length (Mark (InitStringChar (Comment)))-1)))) AND + (NOT EqualArray (s, '')) + THEN + IncludeItemIntoList (ctorGlobals, makekey (string (s))) + END ; + s := KillString (s) + END ; + Close (f) +END ReadModules ; + + +(* + CreateCtorList - uses GetUselist as the filename and then reads the list of modules. +*) + +PROCEDURE CreateCtorList (tok: CARDINAL) : BOOLEAN ; +VAR + filename: String ; +BEGIN + filename := GetUselist () ; + IF filename = NIL + THEN + RETURN FALSE + ELSE + IF Exists (filename) + THEN + ReadModules (filename) + ELSE + MetaErrorT0 (tok, + '{%E}the filename specified by the -fuselist= option does not exist') ; + RETURN FALSE + END + END ; + RETURN TRUE +END CreateCtorList ; + + +(* + DeclareCtorModuleExtern - declare an extern _M2_modulename_ctor procedure for each module. +*) + +PROCEDURE DeclareCtorModuleExtern (tokenno: CARDINAL) ; +VAR + name: Name ; + n, i: CARDINAL ; +BEGIN + InitList (ctorModules) ; + i := 1 ; + n := NoOfItemsInList (ctorGlobals) ; + WHILE i <= n DO + name := GetItemFromList (ctorGlobals, i) ; + IF name # GetSymName (GetMainModule ()) + THEN + IncludeItemIntoList (ctorModules, MakeProcedureCtorExtern (tokenno, name)) + END ; + INC (i) + END +END DeclareCtorModuleExtern ; + + +(* DeclareScaffoldFunctions - declare main, _M2_init,_M2_finish - and _M2_DependencyGraph to the modula-2 + and _M2_link to the modula-2 front end. *) PROCEDURE DeclareScaffoldFunctions (tokenno: CARDINAL) ; BEGIN + IF CreateCtorList (tokenno) + THEN + DeclareCtorGlobal (tokenno) ; + DeclareCtorModuleExtern (tokenno) ; + linkFunction := MakeProcedure (tokenno, MakeKey ("_M2_link")) + END ; + mainFunction := MakeProcedure (tokenno, MakeKey ("main")) ; StartScope (mainFunction) ; PutFunction (mainFunction, Integer) ; @@ -95,7 +265,6 @@ BEGIN END DeclareArgEnvParams ; - (* DeclareScaffold - declare scaffold related entities. *) @@ -109,5 +278,8 @@ END DeclareScaffold ; BEGIN finiFunction := NulSym ; initFunction := NulSym ; - mainFunction := NulSym + mainFunction := NulSym ; + linkFunction := NulSym ; + ctorGlobals := NIL ; + ctorModules := NIL END M2Scaffold. diff --git a/gcc/m2/gm2-compiler/PCSymBuild.mod b/gcc/m2/gm2-compiler/PCSymBuild.mod index 96ca83862ca..7e11b0ea014 100644 --- a/gcc/m2/gm2-compiler/PCSymBuild.mod +++ b/gcc/m2/gm2-compiler/PCSymBuild.mod @@ -585,9 +585,6 @@ BEGIN END PCBuildImportInnerModule ; -PROCEDURE stop ; BEGIN END stop ; - - (* StartBuildProcedure - Builds a Procedure. @@ -611,10 +608,6 @@ VAR BEGIN PopTtok(name, tok) ; PushTtok(name, tok) ; (* Name saved for the EndBuildProcedure name check *) - IF name=1181 - THEN - stop - END ; ProcSym := RequestSym (tok, name) ; Assert (IsProcedure (ProcSym)) ; PushTtok (ProcSym, tok) ; @@ -1884,10 +1877,6 @@ BEGIN RETURN( FALSE ) ELSE WITH e^.eleaf DO - IF sym=13 - THEN - stop - END ; IF IsConst(sym) AND (GetType(sym)#NulSym) THEN type := GetSkippedType(sym) ; diff --git a/gcc/m2/gm2-compiler/SymbolTable.def b/gcc/m2/gm2-compiler/SymbolTable.def index 8bea7f1e934..a25c2bfb21b 100644 --- a/gcc/m2/gm2-compiler/SymbolTable.def +++ b/gcc/m2/gm2-compiler/SymbolTable.def @@ -57,6 +57,8 @@ EXPORT QUALIFIED NulSym, MakeModule, MakeDefImp, MakeInnerModule, MakeModuleCtor, MakeProcedure, + MakeProcedureCtorExtern, + MakeConstant, MakeConstLit, MakeConstVar, MakeConstLitString, @@ -194,7 +196,7 @@ EXPORT QUALIFIED NulSym, PutAlignment, PutDefaultRecordFieldAlignment, PutUnused, IsUnused, PutVariableSSA, IsVariableSSA, - PutPublic, IsPublic, PutCtor, IsCtor, + PutPublic, IsPublic, PutCtor, IsCtor, PutExtern, IsExtern, IsDefImp, IsModule, @@ -573,6 +575,27 @@ PROCEDURE MakeProcedure (tok: CARDINAL; ProcedureName: Name) : CARDINAL ; (* + MakeProcedureCtorExtern - creates an extern ctor procedure +*) + +PROCEDURE MakeProcedureCtorExtern (tokenno: CARDINAL; modulename: Name) : CARDINAL ; + + +(* + PutExtern - changes the extern boolean inside the procedure. +*) + +PROCEDURE PutExtern (sym: CARDINAL; value: BOOLEAN) ; + + +(* + IsExtern - returns the public boolean associated with a procedure. +*) + +PROCEDURE IsExtern (sym: CARDINAL) : BOOLEAN ; + + +(* PutPublic - changes the public boolean inside the procedure. *) @@ -677,6 +700,13 @@ PROCEDURE MakeHiddenType (tok: CARDINAL; TypeName: Name) : CARDINAL ; (* + MakeConstant - create a constant cardinal and return the symbol. +*) + +PROCEDURE MakeConstant (tok: CARDINAL; value: CARDINAL) : CARDINAL ; + + +(* MakeConstLit - returns a constant literal of type, constType, with a constName, at location, tok. *) @@ -1365,7 +1395,7 @@ PROCEDURE IsConstSet (Sym: CARDINAL) : BOOLEAN ; (* - PutConstructor - informs the symbol, sym, that this will be + PutConstructor - informs the symbol sym that this will be a constructor constant. *) @@ -1373,8 +1403,8 @@ PROCEDURE PutConstructor (Sym: CARDINAL) ; (* - PutConstructorFrom - sets the from type field in constructor, - Sym, to, from. + PutConstructorFrom - sets the from type field in constructor + Sym to from. *) PROCEDURE PutConstructorFrom (Sym: CARDINAL; from: CARDINAL) ; diff --git a/gcc/m2/gm2-compiler/SymbolTable.mod b/gcc/m2/gm2-compiler/SymbolTable.mod index 5c068022ef0..665e12aace7 100644 --- a/gcc/m2/gm2-compiler/SymbolTable.mod +++ b/gcc/m2/gm2-compiler/SymbolTable.mod @@ -358,6 +358,7 @@ TYPE BuiltinName : Name ; (* name of equivalent builtin *) IsInline : BOOLEAN ; (* Was it declared __INLINE__ ? *) ReturnOptional: BOOLEAN ; (* Is the return value optional? *) + IsExtern : BOOLEAN ; (* Make this procedure extern. *) IsPublic : BOOLEAN ; (* Make this procedure visible. *) IsCtor : BOOLEAN ; (* Is this procedure a ctor? *) Unresolved : SymbolTree ; (* All symbols currently *) @@ -3013,6 +3014,20 @@ END IsImplicityExported ; (* + MakeProcedureCtorExtern - creates an extern ctor procedure +*) + +PROCEDURE MakeProcedureCtorExtern (tokenno: CARDINAL; modulename: Name) : CARDINAL ; +VAR + ctor: CARDINAL ; +BEGIN + ctor := MakeProcedure (tokenno, GenName ('_M2_', modulename, '_ctor')) ; + PutExtern (ctor, TRUE) ; + RETURN ctor +END MakeProcedureCtorExtern ; + + +(* GenName - returns a new name consisting of pre, name, post concatenation. *) @@ -3503,6 +3518,7 @@ BEGIN BuiltinName := NulName ; (* name of equivalent builtin *) IsInline := FALSE ; (* Was is declared __INLINE__ ? *) ReturnOptional := FALSE ; (* Is the return value optional? *) + IsExtern := FALSE ; (* Make this procedure external. *) IsPublic := FALSE ; (* Make this procedure visible. *) IsCtor := FALSE ; (* Is this procedure a ctor? *) Scope := GetCurrentScope() ; (* Scope of procedure. *) @@ -3550,6 +3566,48 @@ END MakeProcedure ; (* + PutExtern - changes the extern boolean inside the procedure. +*) + +PROCEDURE PutExtern (sym: CARDINAL; value: BOOLEAN) ; +VAR + pSym: PtrToSymbol ; +BEGIN + pSym := GetPsym (sym) ; + WITH pSym^ DO + CASE SymbolType OF + + ProcedureSym: Procedure.IsExtern := value + + ELSE + InternalError ('expecting ProcedureSym symbol') + END + END +END PutExtern ; + + +(* + IsExtern - returns the public boolean associated with a procedure. +*) + +PROCEDURE IsExtern (sym: CARDINAL) : BOOLEAN ; +VAR + pSym: PtrToSymbol ; +BEGIN + pSym := GetPsym (sym) ; + WITH pSym^ DO + CASE SymbolType OF + + ProcedureSym: RETURN Procedure.IsExtern + + ELSE + InternalError ('expecting ProcedureSym symbol') + END + END +END IsExtern ; + + +(* PutPublic - changes the public boolean inside the procedure. *) @@ -4266,6 +4324,23 @@ BEGIN END PutConstIntoTypeTree ; *) + +(* + MakeConstant - create a constant cardinal and return the symbol. +*) + +PROCEDURE MakeConstant (tok: CARDINAL; value: CARDINAL) : CARDINAL ; +VAR + str: String ; + sym: CARDINAL ; +BEGIN + str := Sprintf1 (Mark (InitString ("%d")), value) ; + sym := MakeConstLit (tok, makekey (string (str)), Cardinal) ; + str := KillString (str) ; + RETURN sym +END MakeConstant ; + + (* MakeConstLit - returns a constant literal of type, constType, with a constName, at location, tok. diff --git a/gcc/m2/gm2-gcc/m2options.h b/gcc/m2/gm2-gcc/m2options.h index 2e79328be50..c5ed3bdb271 100644 --- a/gcc/m2/gm2-gcc/m2options.h +++ b/gcc/m2/gm2-gcc/m2options.h @@ -63,6 +63,7 @@ EXTERN int M2Options_GetWholeValueCheck (void); EXTERN void M2Options_Setc (int value); EXTERN int M2Options_Getc (void); +EXTERN void M2Options_SetUselist (const char *filename); EXTERN void M2Options_SetAutoInit (int value); EXTERN void M2Options_SetPositiveModFloor (int value); EXTERN void M2Options_SetNilCheck (int value); diff --git a/gcc/m2/gm2-lang.cc b/gcc/m2/gm2-lang.cc index da43a1acb5f..fd03d9c5387 100644 --- a/gcc/m2/gm2-lang.cc +++ b/gcc/m2/gm2-lang.cc @@ -319,14 +319,8 @@ gm2_langhook_handle_option ( case OPT_fm2_lower_case: M2Options_SetLowerCaseKeywords (value); return 1; - case OPT_fuselist: - /* handled in the driver. */ - return 1; - case OPT_fmakelist: - /* handled in the driver. */ - return 1; - case OPT_fmodules: - /* handled in the driver. */ + case OPT_fuselist_: + M2Options_SetUselist (arg); return 1; case OPT_fruntime_modules_: M2Options_SetRuntimeModuleOverride (arg); diff --git a/gcc/m2/gm2-libs-ch/SysExceptions.c b/gcc/m2/gm2-libs-ch/SysExceptions.c index 1760fd2df46..ffe41f31708 100644 --- a/gcc/m2/gm2-libs-ch/SysExceptions.c +++ b/gcc/m2/gm2-libs-ch/SysExceptions.c @@ -84,11 +84,11 @@ extern "C" { #endif -/* note o wholeDivException and realDivException are caught by SIGFPE +/* note wholeDivException and realDivException are caught by SIGFPE and depatched to the appropriate Modula-2 runtime routine upon - testing FPE_INTDIV or FPE_FLTDIV. o realValueException is also + testing FPE_INTDIV or FPE_FLTDIV. realValueException is also caught by SIGFPE and dispatched by testing FFE_FLTOVF or - FPE_FLTUND or FPE_FLTRES or FPE_FLTINV. o indexException is + FPE_FLTUND or FPE_FLTRES or FPE_FLTINV. indexException is caught by SIGFPE and dispatched by FPE_FLTSUB. */ #if defined(HAVE_SIGNAL_H) diff --git a/gcc/m2/gm2spec.cc b/gcc/m2/gm2spec.cc index 9263bf709c0..8d834252eef 100644 --- a/gcc/m2/gm2spec.cc +++ b/gcc/m2/gm2spec.cc @@ -636,10 +636,6 @@ lang_specific_driver (struct cl_decoded_option **in_decoded_options, continue; /* Avoid examining arguments of options missing them. */ switch ((*in_decoded_options)[i].opt_index) { - case OPT_fuselist: - /* Modula-2 link time option, which is used to direct the specs. */ - (*in_decoded_options)[i].errors = 0; - break; case OPT_fexceptions: seen_fexceptions = ((*in_decoded_options)[i].value); break; @@ -737,6 +733,11 @@ lang_specific_driver (struct cl_decoded_option **in_decoded_options, if (linking) { + if (strcmp (dialect, "iso") == 0) + (*in_added_libraries) + += add_library ("m2pim", in_decoded_options_count, + in_decoded_options, *in_decoded_options_count); + (*in_added_libraries) += add_default_archives ( libpath, libraries, in_decoded_options_count, in_decoded_options, *in_decoded_options_count); diff --git a/gcc/m2/lang.opt b/gcc/m2/lang.opt index 817500bf609..01f6a9ad188 100644 --- a/gcc/m2/lang.opt +++ b/gcc/m2/lang.opt @@ -130,17 +130,9 @@ fextended-opaque Modula-2 allows opaque types to be implemented as any type (a GNU Modula-2 extension) -fuselist -Modula-2 -use the ordered list of modules to order the initialization/finalialization (--unimplemented--) - -fmakelist -Modula-2 -create a topologically ordered list of modules called modulename.lst (--unimplemented--) - -fmodules -Modula-2 -display the list of modules and their location +fuselist= +Modula-2 Joined +orders the initialization/finalializations for scaffold-static or force linking of modules if scaffold-dynamic fno-pthread Modula-2 diff --git a/gcc/testsuite/gm2/complex/run/pass/complex-run-pass.exp b/gcc/testsuite/gm2/complex/run/pass/complex-run-pass.exp index de6528db313..c8fe55265a1 100644 --- a/gcc/testsuite/gm2/complex/run/pass/complex-run-pass.exp +++ b/gcc/testsuite/gm2/complex/run/pass/complex-run-pass.exp @@ -28,7 +28,6 @@ load_lib gm2-torture.exp set gm2src ${srcdir}/../gm2 gm2_init_iso "${srcdir}/gm2/complex/run/pass" -gm2_link_with "-lm2iso -lm2pim -lpthread" foreach testcase [lsort [glob -nocomplain $srcdir/$subdir/*.mod]] { # If we're only testing specific files and this isn't one of them, skip it. diff --git a/gcc/testsuite/gm2/examples/callingC/run/pass/examples-callingC-run-pass.exp b/gcc/testsuite/gm2/examples/callingC/run/pass/examples-callingC-run-pass.exp index 3bef316bcdf..976c23ae0e9 100644 --- a/gcc/testsuite/gm2/examples/callingC/run/pass/examples-callingC-run-pass.exp +++ b/gcc/testsuite/gm2/examples/callingC/run/pass/examples-callingC-run-pass.exp @@ -28,7 +28,7 @@ load_lib gm2-torture.exp set gm2src ${srcdir}/../m2 gm2_init_iso "$srcdir/$subdir" -gm2_link_with "c.o -lm2iso -lm2pim -lpthread" +gm2_link_with "c.o" set output [target_compile $srcdir/$subdir/c.c c.o object "-g"] diff --git a/gcc/testsuite/gm2/exceptions/run/pass/exceptions-run-pass.exp b/gcc/testsuite/gm2/exceptions/run/pass/exceptions-run-pass.exp index 0c4665543cc..729c63f2d38 100644 --- a/gcc/testsuite/gm2/exceptions/run/pass/exceptions-run-pass.exp +++ b/gcc/testsuite/gm2/exceptions/run/pass/exceptions-run-pass.exp @@ -39,7 +39,6 @@ set output [target_compile $srcdir/$subdir/mycpp.cpp mycpp.o object "-g"] set gm2src ${srcdir}/../m2 gm2_init_pim "${srcdir}/gm2/exceptions/run/pass" -gm2_link_with "-lm2pim -lm2iso -lpthread" foreach testcase [lsort [glob -nocomplain $srcdir/$subdir/*.mod]] { # If we're only testing specific files and this isn't one of them, skip it. diff --git a/gcc/testsuite/gm2/imports/run/pass/imports-run-pass.exp b/gcc/testsuite/gm2/imports/run/pass/imports-run-pass.exp index ddd733a6719..10b471f9e0a 100644 --- a/gcc/testsuite/gm2/imports/run/pass/imports-run-pass.exp +++ b/gcc/testsuite/gm2/imports/run/pass/imports-run-pass.exp @@ -28,7 +28,6 @@ load_lib gm2-torture.exp set gm2src ${srcdir}/../m2 gm2_init_pim "${srcdir}/gm2/imports/run/pass" -gm2_link_with "-lm2pim -lm2iso -lpthread" foreach testcase [lsort [glob -nocomplain $srcdir/$subdir/*.mod]] { set output [gm2_target_compile ${srcdir}/${subdir}/c.mod c.o object "-g -I${gccpath}/libgm2/libpim:${gm2src}/gm2-libs:${srcdir}/${subdir} -fpim"] diff --git a/gcc/testsuite/gm2/iso/run/pass/iso-run-pass.exp b/gcc/testsuite/gm2/iso/run/pass/iso-run-pass.exp index 82713d7332e..ba6ebc6dc79 100644 --- a/gcc/testsuite/gm2/iso/run/pass/iso-run-pass.exp +++ b/gcc/testsuite/gm2/iso/run/pass/iso-run-pass.exp @@ -25,7 +25,6 @@ if $tracelevel then { load_lib gm2-torture.exp gm2_init_iso "${srcdir}/gm2/iso/run/pass" -fsoft-check-all -gm2_link_with "-lm2iso -lm2pim -lpthread" foreach testcase [lsort [glob -nocomplain $srcdir/$subdir/*.mod]] { # If we're only testing specific files and this isn't one of them, skip it. diff --git a/gcc/testsuite/lib/gm2-torture.exp b/gcc/testsuite/lib/gm2-torture.exp index 46b87c878ae..907174e72be 100644 --- a/gcc/testsuite/lib/gm2-torture.exp +++ b/gcc/testsuite/lib/gm2-torture.exp @@ -286,7 +286,6 @@ proc gm2-torture-execute { sources args success } { # now link the test set options ${option}; - lappend options "-fonlylink" if { [llength ${args}] > 0 } { lappend options "additional_flags=[lindex ${args} 0]" diff --git a/libgm2/libm2iso/ErrnoCategory.c b/libgm2/libm2iso/ErrnoCategory.c index a64478fbcb5..ce673135dbe 100644 --- a/libgm2/libm2iso/ErrnoCategory.c +++ b/libgm2/libm2iso/ErrnoCategory.c @@ -1,4 +1,4 @@ -/* ErrnoCatogory.c categorizes values of errno maps onto ChanConsts.h. +/* ErrnoCatogory.cc categorizes values of errno maps onto ChanConsts.h. Copyright (C) 2008-2022 Free Software Foundation, Inc. Contributed by Gaius Mulley <gaius.mulley@southwales.ac.uk>. @@ -36,6 +36,8 @@ see the files COPYING3 and COPYING.RUNTIME respectively. If not, see #include "sys/errno.h" #endif +#include "m2rts.h" + #if !defined(FALSE) #define FALSE (1 == 0) #endif @@ -47,7 +49,7 @@ see the files COPYING3 and COPYING.RUNTIME respectively. If not, see /* IsErrnoHard - returns TRUE if the value of errno is associated with a hard device error. */ -int +extern "C" int ErrnoCategory_IsErrnoHard (int e) { #if defined(HAVE_ERRNO_H) || defined(HAVE_SYS_ERRNO_H) @@ -62,7 +64,7 @@ ErrnoCategory_IsErrnoHard (int e) /* IsErrnoSoft - returns TRUE if the value of errno is associated with a soft device error. */ -int +extern "C" int ErrnoCategory_IsErrnoSoft (int e) { #if defined(HAVE_ERRNO_H) || defined(HAVE_SYS_ERRNO_H) @@ -76,7 +78,7 @@ ErrnoCategory_IsErrnoSoft (int e) #endif } -int +extern "C" int ErrnoCategory_UnAvailable (int e) { #if defined(HAVE_ERRNO_H) || defined(HAVE_SYS_ERRNO_H) @@ -90,7 +92,7 @@ ErrnoCategory_UnAvailable (int e) /* GetOpenResults - maps errno onto the ISO Modula-2 enumerated type, OpenResults. */ -openResults +extern "C" openResults ErrnoCategory_GetOpenResults (int e) { if (e == 0) @@ -154,12 +156,25 @@ ErrnoCategory_GetOpenResults (int e) /* GNU Modula-2 linking fodder. */ -void -_M2_ErrnoCategory_init (void) +extern "C" void +_M2_ErrnoCategory_init (int, char *argv[], char *env[]) +{ +} + +extern "C" void +_M2_ErrnoCategory_finish (int, char *argv[], char *env[]) { } -void -_M2_ErrnoCategory_finish (void) +extern "C" void +_M2_ErrnoCategory_dep (void) +{ +} + +struct _M2_ErrnoCategory_ctor { _M2_ErrnoCategory_ctor (); } _M2_ErrnoCategory_ctor; + +_M2_ErrnoCategory_ctor::_M2_ErrnoCategory_ctor (void) { + M2RTS_RegisterModule ("ErrnoCategory", _M2_ErrnoCategory_init, _M2_ErrnoCategory_finish, + _M2_ErrnoCategory_dep); } diff --git a/libgm2/libm2iso/Makefile.am b/libgm2/libm2iso/Makefile.am index 3d47d967365..fa546172b4e 100644 --- a/libgm2/libm2iso/Makefile.am +++ b/libgm2/libm2iso/Makefile.am @@ -179,8 +179,8 @@ M2MODS = ChanConsts.mod CharClass.mod \ toolexeclib_LTLIBRARIES = libm2iso.la libm2iso_la_SOURCES = $(M2MODS) \ - ErrnoCategory.c wrapsock.c \ - wraptime.c RTco.c + ErrnoCategory.cc wrapsock.c \ + wraptime.c RTco.cc C_INCLUDES = -I.. -I$(toplevel_srcdir)/libiberty -I$(toplevel_srcdir)/include @@ -209,6 +209,9 @@ SYSTEM.def: Makefile .c.lo: $(LIBTOOL) --tag=CC --mode=compile $(CC) -c $(CFLAGS) $(LIBCFLAGS) $(libm2iso_la_CFLAGS) $< -o $@ +.cc.lo: + $(LIBTOOL) --tag=CXX --mode=compile $(CXX) -c -I$(srcdir) $(CXXFLAGS) $(LIBCFLAGS) $(libm2iso_la_CFLAGS) $< -o $@ + install-data-local: force mkdir -p $(DESTDIR)$(inst_libdir)/$(MULTIDIR)$(M2LIBDIR) $(INSTALL_DATA) .libs/libm2iso.la $(DESTDIR)$(inst_libdir)/$(MULTIDIR)$(M2LIBDIR) diff --git a/libgm2/libm2iso/RTco.c b/libgm2/libm2iso/RTco.c index c011f2d5b05..f97e7dad299 100644 --- a/libgm2/libm2iso/RTco.c +++ b/libgm2/libm2iso/RTco.c @@ -29,9 +29,7 @@ see the files COPYING3 and COPYING.RUNTIME respectively. If not, see #include <pthread.h> #include <sys/select.h> #include <stdlib.h> - -extern void M2RTS_Halt (const char *, int, const char *, const char *); -int RTco_init (void); +#include <m2rts.h> // #define TRACEON @@ -89,10 +87,29 @@ static threadCB *threadArray = NULL; static unsigned int nSemaphores = 0; static threadSem **semArray = NULL; -/* used to lock the above module data structures. */ +/* These are used to lock the above module data structures. */ static threadSem lock; static int initialized = FALSE; + +extern "C" int RTco_init (void); + + +extern "C" void +_M2_RTco_dep (void) +{ +} + +extern "C" void +_M2_RTco_init (int argc, char *argv[], char *envp[]) +{ +} + +extern "C" void +_M2_RTco_finish (int argc, char *argv[], char *envp[]) +{ +} + static void initSem (threadSem *sem, int value) { @@ -130,7 +147,7 @@ signalSem (threadSem *sem) void stop (void) {} -void +extern "C" void RTco_wait (int sid) { RTco_init (); @@ -138,7 +155,7 @@ RTco_wait (int sid) waitSem (semArray[sid]); } -void +extern "C" void RTco_signal (int sid) { RTco_init (); @@ -160,7 +177,7 @@ newSem (void) threadSem *sem = (threadSem *)malloc (sizeof (threadSem)); - /* we need to be careful when using realloc as the lock (semaphore) + /* We need to be careful when using realloc as the lock (semaphore) operators use the semaphore address. So we keep an array of pointer to semaphores. */ if (nSemaphores == 0) @@ -189,7 +206,7 @@ initSemaphore (int value) return sid; } -int +extern "C" int RTco_initSemaphore (int value) { int sid; @@ -203,7 +220,7 @@ RTco_initSemaphore (int value) /* signalThread signal the semaphore associated with thread tid. */ -void +extern "C" void RTco_signalThread (int tid) { int sem; @@ -217,7 +234,7 @@ RTco_signalThread (int tid) /* waitThread wait on the semaphore associated with thread tid. */ -void +extern "C" void RTco_waitThread (int tid) { RTco_init (); @@ -225,7 +242,7 @@ RTco_waitThread (int tid) RTco_wait (threadArray[tid].execution); } -int +extern "C" int currentThread (void) { int tid; @@ -237,7 +254,7 @@ currentThread (void) "failed to find currentThread"); } -int +extern "C" int RTco_currentThread (void) { int tid; @@ -252,7 +269,7 @@ RTco_currentThread (void) /* currentInterruptLevel returns the interrupt level of the current thread. */ -unsigned int +extern "C" unsigned int RTco_currentInterruptLevel (void) { RTco_init (); @@ -264,7 +281,7 @@ RTco_currentInterruptLevel (void) /* turninterrupts returns the old interrupt level and assigns the interrupt level to newLevel. */ -unsigned int +extern "C" unsigned int RTco_turnInterrupts (unsigned int newLevel) { int tid = RTco_currentThread (); @@ -292,10 +309,10 @@ execThread (void *t) tprintf ("exec thread tid = %d function = 0x%p arg = 0x%p\n", tp->tid, tp->proc, t); RTco_waitThread ( - tp->tid); /* forcing this thread to block, waiting to be scheduled. */ + tp->tid); /* Forcing this thread to block, waiting to be scheduled. */ tprintf (" exec thread [%d] function = 0x%p arg = 0x%p\n", tp->tid, tp->proc, t); - tp->proc (); /* now execute user procedure. */ + tp->proc (); /* Now execute user procedure. */ #if 0 M2RTS_CoroutineException ( __FILE__, __LINE__, __COLUMN__, __FUNCTION__, "coroutine finishing"); #endif @@ -365,7 +382,7 @@ initThread (void (*proc) (void), unsigned int stackSize, return tid; } -int +extern "C" int RTco_initThread (void (*proc) (void), unsigned int stackSize, unsigned int interrupt) { @@ -381,7 +398,7 @@ RTco_initThread (void (*proc) (void), unsigned int stackSize, /* transfer unlocks thread p2 and locks the current thread. p1 is updated with the current thread id. */ -void +extern "C" void RTco_transfer (int *p1, int p2) { int tid = currentThread (); @@ -406,14 +423,14 @@ RTco_transfer (int *p1, int p2) } } -int -RTco_select (int p1, void *p2, void *p3, void *p4, void *p5) +extern "C" int +RTco_select (int p1, fd_set *p2, fd_set *p3, fd_set *p4, const timespec *p5) { tprintf ("[%x] RTco.select (...)\n", pthread_self ()); return pselect (p1, p2, p3, p4, p5, NULL); } -int +extern "C" int RTco_init (void) { if (!initialized) @@ -422,18 +439,18 @@ RTco_init (void) tprintf ("RTco initialized\n"); initSem (&lock, 0); - /* create initial thread container. */ + /* Create initial thread container. */ #if defined(POOL) threadArray = (threadCB *)malloc (sizeof (threadCB) * THREAD_POOL); semArray = (threadSem **)malloc (sizeof (threadSem *) * SEM_POOL); #endif - tid = newThread (); /* for the current initial thread. */ + tid = newThread (); /* For the current initial thread. */ threadArray[tid].tid = tid; threadArray[tid].execution = initSemaphore (0); threadArray[tid].p = pthread_self (); threadArray[tid].interruptLevel = 0; threadArray[tid].proc - = never; /* this shouldn't happen as we are already running. */ + = never; /* This shouldn't happen as we are already running. */ initialized = TRUE; tprintf ("RTco initialized completed\n"); signalSem (&lock); @@ -441,12 +458,10 @@ RTco_init (void) return 0; } -void -_M2_RTco_init () -{ -} +struct _M2_RTco_ctor { _M2_RTco_ctor (); } _M2_RTco_ctor; -void -_M2_RTco_finish () +_M2_RTco_ctor::_M2_RTco_ctor (void) { + M2RTS_RegisterModule ("RTco", _M2_RTco_init, _M2_RTco_finish, + _M2_RTco_dep); } diff --git a/libgm2/libm2pim/Makefile.am b/libgm2/libm2pim/Makefile.am index 218e2605c0d..72cfe19e71a 100644 --- a/libgm2/libm2pim/Makefile.am +++ b/libgm2/libm2pim/Makefile.am @@ -159,14 +159,14 @@ M2DEFS = Args.def ASCII.def \ libm2pim_la_SOURCES = $(M2MODS) \ UnixArgs.c \ Selective.c sckt.c \ - errno.c dtoa.c \ - ldtoa.c termios.c \ - SysExceptions.c target.c \ + errno.cc dtoa.c \ + ldtoa.c termios.cc \ + SysExceptions.cc target.c \ wrapc.c cgetopt.c libm2pimdir = libm2pim libm2pim_la_DEPENDENCIES = SYSTEM.def $(addsuffix .lo, $(basename $(libm2pim_la_SOURCES))) -libm2pim_la_CFLAGS = -I. -I$(GM2_SRC)/gm2-libs -I$(GM2_SRC)/gm2-libs-iso -DBUILD_GM2_LIBS -I@srcdir@/../ +libm2pim_la_CFLAGS = -I. -I.. -I$(GM2_SRC)/gm2-libs -I$(GM2_SRC)/gm2-libs-iso -DBUILD_GM2_LIBS -I@srcdir@/../ -I@srcdir@/../libm2iso libm2pim_la_M2FLAGS = -I. -I$(GM2_SRC)/gm2-libs -I$(GM2_SRC)/gm2-libs-iso -fm2-g -g libm2pim_la_LINK = $(LINK) -version-info $(libtool_VERSION) BUILT_SOURCES = SYSTEM.def @@ -184,6 +184,9 @@ SYSTEM.def: Makefile .mod.lo: SYSTEM.def $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(GM2_FOR_TARGET) -c $(CFLAGS_FOR_TARGET) $(LIBCFLAGS) $(libm2pim_la_M2FLAGS) $< -o $@ +.cc.lo: + $(LIBTOOL) --tag=CXX --mode=compile $(CXX) -c -I$(srcdir) $(CXXFLAGS) $(LIBCFLAGS) $(libm2pim_la_CFLAGS) $< -o $@ + install-data-local: force mkdir -p $(DESTDIR)$(inst_libdir)/$(MULTIDIR)$(M2LIBDIR) $(INSTALL_DATA) .libs/libm2pim.la $(DESTDIR)$(inst_libdir)/$(MULTIDIR)$(M2LIBDIR) diff --git a/libgm2/libm2pim/SysExceptions.c b/libgm2/libm2pim/SysExceptions.c index 50779b55f00..859bb6303eb 100644 --- a/libgm2/libm2pim/SysExceptions.c +++ b/libgm2/libm2pim/SysExceptions.c @@ -42,6 +42,7 @@ see the files COPYING3 and COPYING.RUNTIME respectively. If not, see #include <stdio.h> #endif +#include "m2rts.h" #if 0 /* Signals. */ @@ -91,14 +92,12 @@ see the files COPYING3 and COPYING.RUNTIME respectively. If not, see #endif -/* Note: - - o wholeDivException and realDivException are caught by SIGFPE and - depatched to the appropriate Modula-2 runtime routine upon testing - FPE_INTDIV or FPE_FLTDIV. - o realValueException is also caught by SIGFPE and dispatched by - testing FFE_FLTOVF or FPE_FLTUND or FPE_FLTRES or FPE_FLTINV. - o indexException is caught by SIGFPE and dispatched by FPE_FLTSUB. */ +/* Note: wholeDivException and realDivException are caught by SIGFPE + and depatched to the appropriate Modula-2 runtime routine upon + testing FPE_INTDIV or FPE_FLTDIV. realValueException is also + caught by SIGFPE and dispatched by testing FFE_FLTOVF or FPE_FLTUND + or FPE_FLTRES or FPE_FLTINV. indexException is caught by SIGFPE + and dispatched by FPE_FLTSUB. */ #if defined(HAVE_SIGNAL_H) static struct sigaction sigbus; @@ -172,7 +171,7 @@ sigfpeDespatcher (int signum, siginfo_t *info, void *ucontext) } } -void +extern "C" void SysExceptions_InitExceptionHandlers ( void (*indexf) (void *), void (*range) (void *), void (*casef) (void *), void (*invalidloc) (void *), void (*function) (void *), @@ -223,7 +222,7 @@ SysExceptions_InitExceptionHandlers ( } #else -void +extern "C" void SysExceptions_InitExceptionHandlers (void *indexf, void *range, void *casef, void *invalidloc, void *function, void *wholevalue, void *wholediv, @@ -235,14 +234,26 @@ SysExceptions_InitExceptionHandlers (void *indexf, void *range, void *casef, } #endif -/* GNU Modula-2 linking fodder. */ -void -_M2_SysExceptions_init (void) +extern "C" void +_M2_SysExceptions_init (int, char *[], char *[]) +{ +} + +extern "C" void +_M2_SysExceptions_finish (int, char *[], char *[]) +{ +} + +extern "C" void +_M2_SysExceptions_dep (void) { } -void -_M2_SysExceptions_finish (void) +struct _M2_SysExceptions_ctor { _M2_SysExceptions_ctor (); } _M2_SysExceptions_ctor; + +_M2_SysExceptions_ctor::_M2_SysExceptions_ctor (void) { + M2RTS_RegisterModule ("SysExceptions", _M2_SysExceptions_init, _M2_SysExceptions_finish, + _M2_SysExceptions_dep); } diff --git a/libgm2/libm2pim/errno.c b/libgm2/libm2pim/errno.c index 54d93b2b90f..e1a5400174e 100644 --- a/libgm2/libm2pim/errno.c +++ b/libgm2/libm2pim/errno.c @@ -34,7 +34,9 @@ see the files COPYING3 and COPYING.RUNTIME respectively. If not, see #include <errno.h> #endif -int +#include "m2rts.h" + +extern "C" int errno_geterrno (void) { #if defined(HAVE_ERRNO_H) || defined(HAVE_SYS_ERRNO_H) @@ -44,12 +46,25 @@ errno_geterrno (void) #endif } -void -_M2_errno_init (void) +extern "C" void +_M2_errno_init (int, char *[], char *[]) +{ +} + +extern "C" void +_M2_errno_finish (int, char *[], char *[]) { } -void -_M2_errno_finish (void) +extern "C" void +_M2_errno_dep (void) +{ +} + +struct _M2_errno_ctor { _M2_errno_ctor (); } _M2_errno_ctor; + +_M2_errno_ctor::_M2_errno_ctor (void) { + M2RTS_RegisterModule ("errno", _M2_errno_init, _M2_errno_finish, + _M2_errno_dep); } diff --git a/libgm2/libm2pim/termios.c b/libgm2/libm2pim/termios.c index 740cad5f9ca..d3b3ebcf589 100644 --- a/libgm2/libm2pim/termios.c +++ b/libgm2/libm2pim/termios.c @@ -1,4 +1,4 @@ -/* termios.c provide access to the terminal. +/* termios.cc provide access to the terminal. Copyright (C) 2010-2022 Free Software Foundation, Inc. Contributed by Gaius Mulley <gaius.mulley@southwales.ac.uk>. @@ -25,6 +25,7 @@ see the files COPYING3 and COPYING.RUNTIME respectively. If not, see <http://www.gnu.org/licenses/>. */ #include <config.h> +#include <m2rts.h> #if defined(HAVE_STDIO_H) #include <stdio.h> @@ -186,37 +187,38 @@ typedef enum { } Flag; /* Prototypes. */ -void *EXPORT (InitTermios) (void); -void *EXPORT (KillTermios) (struct termios *p); -int EXPORT (cfgetospeed) (struct termios *t); -int EXPORT (cfgetispeed) (struct termios *t); -int EXPORT (cfsetospeed) (struct termios *t, unsigned int b); -int EXPORT (cfsetispeed) (struct termios *t, unsigned int b); -int EXPORT (cfsetspeed) (struct termios *t, unsigned int b); -int EXPORT (tcgetattr) (int fd, struct termios *t); -int EXPORT (tcsetattr) (int fd, int option, struct termios *t); -void EXPORT (cfmakeraw) (struct termios *t); -int EXPORT (tcsendbreak) (int fd, int duration); -int EXPORT (tcdrain) (int fd); -int EXPORT (tcflushi) (int fd); -int EXPORT (tcflusho) (int fd); -int EXPORT (tcflushio) (int fd); -int EXPORT (tcflowoni) (int fd); -int EXPORT (tcflowoffi) (int fd); -int EXPORT (tcflowono) (int fd); -int EXPORT (tcflowoffo) (int fd); -int EXPORT (GetFlag) (struct termios *t, Flag f, int *b); -int EXPORT (SetFlag) (struct termios *t, Flag f, int b); -int EXPORT (GetChar) (struct termios *t, ControlChar c, char *ch); -int EXPORT (SetChar) (struct termios *t, ControlChar c, char ch); -int EXPORT (tcsnow) (void); -int EXPORT (tcsflush) (void); -int EXPORT (tcsdrain) (void); -int doSetUnset (unsigned int *bitset, unsigned int mask, int value); +extern "C" void *EXPORT (InitTermios) (void); +extern "C" void *EXPORT (KillTermios) (struct termios *p); +extern "C" int EXPORT (cfgetospeed) (struct termios *t); +extern "C" int EXPORT (cfgetispeed) (struct termios *t); +extern "C" int EXPORT (cfsetospeed) (struct termios *t, unsigned int b); +extern "C" int EXPORT (cfsetispeed) (struct termios *t, unsigned int b); +extern "C" int EXPORT (cfsetspeed) (struct termios *t, unsigned int b); +extern "C" int EXPORT (tcgetattr) (int fd, struct termios *t); +extern "C" int EXPORT (tcsetattr) (int fd, int option, struct termios *t); +extern "C" void EXPORT (cfmakeraw) (struct termios *t); +extern "C" int EXPORT (tcsendbreak) (int fd, int duration); +extern "C" int EXPORT (tcdrain) (int fd); +extern "C" int EXPORT (tcflushi) (int fd); +extern "C" int EXPORT (tcflusho) (int fd); +extern "C" int EXPORT (tcflushio) (int fd); +extern "C" int EXPORT (tcflowoni) (int fd); +extern "C" int EXPORT (tcflowoffi) (int fd); +extern "C" int EXPORT (tcflowono) (int fd); +extern "C" int EXPORT (tcflowoffo) (int fd); +extern "C" int EXPORT (GetFlag) (struct termios *t, Flag f, int *b); +extern "C" int EXPORT (SetFlag) (struct termios *t, Flag f, int b); +extern "C" int EXPORT (GetChar) (struct termios *t, ControlChar c, char *ch); +extern "C" int EXPORT (SetChar) (struct termios *t, ControlChar c, char ch); +extern "C" int EXPORT (tcsnow) (void); +extern "C" int EXPORT (tcsflush) (void); +extern "C" int EXPORT (tcsdrain) (void); +extern "C" int doSetUnset (unsigned int *bitset, unsigned int mask, int value); /* InitTermios new data structure. */ -void *EXPORT (InitTermios) (void) +extern "C" void +*EXPORT (InitTermios) (void) { struct termios *p = (struct termios *)malloc (sizeof (struct termios)); @@ -226,7 +228,8 @@ void *EXPORT (InitTermios) (void) /* KillTermios delete data structure. */ -void *EXPORT (KillTermios) (struct termios *p) +extern "C" void* +EXPORT (KillTermios) (struct termios *p) { free (p); return NULL; @@ -234,41 +237,49 @@ void *EXPORT (KillTermios) (struct termios *p) /* tcsnow return the value of TCSANOW. */ -int EXPORT (tcsnow) (void) { return TCSANOW; } +extern "C" int +EXPORT (tcsnow) (void) { return TCSANOW; } /* tcsdrain return the value of TCSADRAIN. */ -int EXPORT (tcsdrain) (void) { return TCSADRAIN; } +extern "C" int +EXPORT (tcsdrain) (void) { return TCSADRAIN; } /* tcsflush return the value of TCSAFLUSH. */ -int EXPORT (tcsflush) (void) { return TCSAFLUSH; } +extern "C" int +EXPORT (tcsflush) (void) { return TCSAFLUSH; } /* cfgetospeed return output baud rate. */ -int EXPORT (cfgetospeed) (struct termios *t) { return cfgetospeed (t); } +extern "C" int +EXPORT (cfgetospeed) (struct termios *t) { return cfgetospeed (t); } /* cfgetispeed return input baud rate. */ -int EXPORT (cfgetispeed) (struct termios *t) { return cfgetispeed (t); } +extern "C" int +EXPORT (cfgetispeed) (struct termios *t) { return cfgetispeed (t); } /* cfsetospeed set output baud rate. */ -int EXPORT (cfsetospeed) (struct termios *t, unsigned int b) +extern "C" int +EXPORT (cfsetospeed) (struct termios *t, unsigned int b) { return cfsetospeed (t, b); } /* cfsetispeed set input baud rate. */ -int EXPORT (cfsetispeed) (struct termios *t, unsigned int b) +extern "C" int +EXPORT (cfsetispeed) (struct termios *t, unsigned int b) { return cfsetispeed (t, b); } /* cfsetspeed set input and output baud rate. */ -int EXPORT (cfsetspeed) (struct termios *t, unsigned int b) +extern "C" int +EXPORT (cfsetspeed) (struct termios *t, unsigned int b) { int val = cfsetispeed (t, b); if (val == 0) @@ -279,7 +290,8 @@ int EXPORT (cfsetspeed) (struct termios *t, unsigned int b) /* tcgetattr get state of, fd, into, t. */ -int EXPORT (tcgetattr) (int fd, struct termios *t) +extern "C" int +EXPORT (tcgetattr) (int fd, struct termios *t) { return tcgetattr (fd, t); } @@ -293,7 +305,8 @@ int EXPORT (tcsetattr) (int fd, int option, struct termios *t) /* cfmakeraw sets the terminal to raw mode. */ -void EXPORT (cfmakeraw) (struct termios *t) +extern "C" void +EXPORT (cfmakeraw) (struct termios *t) { #if defined(HAVE_CFMAKERAW) return cfmakeraw (t); @@ -302,18 +315,21 @@ void EXPORT (cfmakeraw) (struct termios *t) /* tcsendbreak send zero bits for duration. */ -int EXPORT (tcsendbreak) (int fd, int duration) +extern "C" int +EXPORT (tcsendbreak) (int fd, int duration) { return tcsendbreak (fd, duration); } /* tcdrain waits for pending output to be written on, fd. */ -int EXPORT (tcdrain) (int fd) { return tcdrain (fd); } +extern "C" int +EXPORT (tcdrain) (int fd) { return tcdrain (fd); } /* tcflushi flush input. */ -int EXPORT (tcflushi) (int fd) +extern "C" int +EXPORT (tcflushi) (int fd) { #if defined(TCIFLUSH) return tcflush (fd, TCIFLUSH); @@ -324,7 +340,8 @@ int EXPORT (tcflushi) (int fd) /* tcflusho flush output. */ -int EXPORT (tcflusho) (int fd) +extern "C" int +EXPORT (tcflusho) (int fd) { #if defined(TCOFLUSH) return tcflush (fd, TCOFLUSH); @@ -335,7 +352,8 @@ int EXPORT (tcflusho) (int fd) /* tcflushio flush input and output. */ -int EXPORT (tcflushio) (int fd) +extern "C" int +EXPORT (tcflushio) (int fd) { #if defined(TCIOFLUSH) return tcflush (fd, TCIOFLUSH); @@ -346,7 +364,8 @@ int EXPORT (tcflushio) (int fd) /* tcflowoni restart input on, fd. */ -int EXPORT (tcflowoni) (int fd) +extern "C" int +EXPORT (tcflowoni) (int fd) { #if defined(TCION) return tcflow (fd, TCION); @@ -357,7 +376,8 @@ int EXPORT (tcflowoni) (int fd) /* tcflowoffi stop input on, fd. */ -int EXPORT (tcflowoffi) (int fd) +extern "C" int +EXPORT (tcflowoffi) (int fd) { #if defined(TCIOFF) return tcflow (fd, TCIOFF); @@ -368,7 +388,8 @@ int EXPORT (tcflowoffi) (int fd) /* tcflowono restart output on, fd. */ -int EXPORT (tcflowono) (int fd) +extern "C" int +EXPORT (tcflowono) (int fd) { #if defined(TCOON) return tcflow (fd, TCOON); @@ -379,7 +400,8 @@ int EXPORT (tcflowono) (int fd) /* tcflowoffo stop output on, fd. */ -int EXPORT (tcflowoffo) (int fd) +extern "C" int +EXPORT (tcflowoffo) (int fd) { #if defined(TCOOFF) return tcflow (fd, TCOOFF); @@ -390,7 +412,7 @@ int EXPORT (tcflowoffo) (int fd) /* doSetUnset applies mask or undoes mask depending upon value. */ -int +extern "C" int doSetUnset (unsigned int *bitset, unsigned int mask, int value) { if (value) @@ -403,7 +425,8 @@ doSetUnset (unsigned int *bitset, unsigned int mask, int value) /* GetFlag sets a flag value from, t, in, b, and returns TRUE if, t, supports, f. */ -int EXPORT (GetFlag) (struct termios *t, Flag f, int *b) +extern "C" int +EXPORT (GetFlag) (struct termios *t, Flag f, int *b) { switch (f) { @@ -1087,7 +1110,8 @@ int EXPORT (GetFlag) (struct termios *t, Flag f, int *b) /* SetFlag sets a flag value in, t, to, b, and returns TRUE if this flag value is supported. */ -int EXPORT (SetFlag) (struct termios *t, Flag f, int b) +extern "C" int +EXPORT (SetFlag) (struct termios *t, Flag f, int b) { switch (f) { @@ -1675,7 +1699,8 @@ int EXPORT (SetFlag) (struct termios *t, Flag f, int b) /* GetChar sets a CHAR, ch, value from, t, and returns TRUE if this value is supported. */ -int EXPORT (GetChar) (struct termios *t, ControlChar c, char *ch) +extern "C" int +EXPORT (GetChar) (struct termios *t, ControlChar c, char *ch) { switch (c) { @@ -1807,7 +1832,8 @@ int EXPORT (GetChar) (struct termios *t, ControlChar c, char *ch) /* SetChar sets a CHAR value in, t, and returns TRUE if, c, is supported. */ -int EXPORT (SetChar) (struct termios *t, ControlChar c, char ch) +extern "C" int +EXPORT (SetChar) (struct termios *t, ControlChar c, char ch) { switch (c) { @@ -1937,12 +1963,25 @@ int EXPORT (SetChar) (struct termios *t, ControlChar c, char ch) } #endif -void -_M2_termios_init (void) +extern "C" void +_M2_termios_init (int, char *[], char *[]) { } -void -_M2_termios_finish (void) +extern "C" void +_M2_termios_finish (int, char *[], char *[]) { } + +extern "C" void +_M2_termios_dep (void) +{ +} + +struct _M2_termios_ctor { _M2_termios_ctor (); } _M2_termios_ctor; + +_M2_termios_ctor::_M2_termios_ctor (void) +{ + M2RTS_RegisterModule ("termios", _M2_termios_init, _M2_termios_finish, + _M2_termios_dep); +} |