public inbox for gcc-cvs@sourceware.org
help / color / mirror / Atom feed
* [gcc r13-6343] modula-2 module registration process seems to fail with shared libraries [PR108261]
@ 2023-02-25 16:29 Gaius Mulley
0 siblings, 0 replies; only message in thread
From: Gaius Mulley @ 2023-02-25 16:29 UTC (permalink / raw)
To: gcc-cvs
https://gcc.gnu.org/g:05652ac4e8b8685fe0c0f4ee2f75516d28bbf892
commit r13-6343-g05652ac4e8b8685fe0c0f4ee2f75516d28bbf892
Author: Gaius Mulley <gaiusmod2@gmail.com>
Date: Sat Feb 25 16:28:19 2023 +0000
modula-2 module registration process seems to fail with shared libraries [PR108261]
The commit adds pathnames to modula-2 which in turn appears in any
external symbol. This is necessary to allow different dialects of
libraries to coexist (different implementations of SYSTEM and Storage
for example in libm2pim and libm2iso). It also makes it easier to
debug as the library name forms part of the external mangled name.
By default pathnames are not user facing. This commit fixes
PR108261.
gcc/ChangeLog:
PR modula2/108261
* doc/gm2.texi (-fm2-pathname): New option documented.
(-fm2-pathnameI): New option documented.
(-fm2-prefix=): New option documented.
(-fruntime-modules=): Update default module list.
gcc/m2/ChangeLog:
PR modula2/108261
* Make-lang.in (GM2-COMP-BOOT-DEFS): DynamicStringPath.def
remove. DynamicPath.def add.
(GM2-COMP-BOOT-MODS): DynamicStringPath.mod remove.
DynamicPath.mod add.
* Make-maintainer.in (BUILD-BOOT-PPG-H): New dependency.
(m2/gm2-ppg-boot/$(SRC_PREFIX)%.o): $(BUILD-BOOT-PPG-H) Add
dependency.
(PGE-DEF): New definition.
(BUILD-BOOT-PG-H): New dependency.
(m2/gm2-pg-boot/$(SRC_PREFIX)%.o): $(BUILD-BOOT-PG-H) Add
dependency.
(BUILD-BOOT-PGE-H): New dependency.
(m2/gm2-pge-boot/$(SRC_PREFIX)%.o): $(BUILD-BOOT-PGE-H) Add
dependency.
(GM2PATH): Add pathname entries.
(m2/boot-bin/mc-devel$(exeext)): Add m2/mc-boot-ch/Gm2rtsdummy.o
dependency.
(m2/boot-bin/mc-opt$(exeext)): Fix -I path.
* gm2-compiler/DynamicStringPath.def: Renamed module to
DynamicPath.
(GetUserPath): Remove.
(GetSystemPath): Remove.
(SetUserPath): Remove.
(SetSystemPath): Remove.
(DumpPath): New procedure definition.
* gm2-compiler/DynamicStringPath.mod: Renamed module to
DynamicPath.
(GetUserPath): Remove.
(GetSystemPath): Remove.
(SetUserPath): Remove.
(SetSystemPath): Remove.
(DumpPath): Remove Debugging conditional.
* gm2-compiler/M2AsmUtil.mod: Import EqualArray, NulName and
GetLibName.
(Debugging): New declaration.
(GetFullSymName): Re-implemented to prefix (mange) libname
to any extern variable/procedure which is IsExportQualified.
* gm2-compiler/M2Comp.mod (qprintLibName): New procedure.
* gm2-compiler/M2Graph.mod (resolveImports): Add libname.
* gm2-compiler/M2Options.def (SetM2Prefix): New procedure.
(GetM2Prefix): New procedure function.
(SetM2PathName): New procedure.
(GetM2PathName): New procedure function.
* gm2-compiler/M2Options.mod: (SetM2Prefix): New procedure implemented.
(GetM2Prefix): New procedure function implemented.
(SetM2PathName): New procedure implemented.
(GetM2PathName): New procedure function implemented.
(RuntimeModuleOverride): Set to DefaultRuntimeModuleOverride.
* gm2-compiler/M2Quads.mod: Import GetLibName.
(SafeRequestSym) Pass result of GetLibName to RequestDependant.
(callRequestDependant): Add libname as a parameter.
(BuildM2InitFunction): Add libname as a parameter.
(BuildM2FiniFunction): Add libname as a parameter.
(BuildM2CtorFunction): Add libname as a parameter.
* gm2-compiler/M2Scaffold.mod (LookupModuleSym): Set LibName
if a definition source was found.
* gm2-compiler/M2Search.def (FindSourceFile): Add named library parameter.
(FindSourceDefFile): Add named library parameter.
(FindSourceModFile): Add named library parameter.
* gm2-compiler/M2Search.mod (FindSourceFile): Reimplement.
(FindSourceDefFile): Add named library parameter.
(FindSourceModFile): Add named library parameter.
* gm2-compiler/SymbolTable.def (MakeProcedureCtorExtern): Add
libname parameter.
(PutLibName): New procedure.
(GetLibName): New procedure function.
* gm2-compiler/SymbolTable.mod (MakeProcedureCtorExtern): Add
libname parameter.
(GenName): Add libname parameter.
(InitCtorFields): Add moduleSym as a parameter.
(PutCtorExtern): Add libname parameter to GenName.
* gm2-gcc/init.cc (_M2_DynamicStringPath_init): Rename function...
(_M2_DynamicPath_init): ...to this.
(_M2_PathName_init): Added.
* gm2-gcc/m2decl.cc (m2decl_DeclareM2linkStaticInitialization):
Add m2pim as the manged component of the exported symbol.
(m2decl_DeclareM2linkForcedModuleInitOrder): Add m2pim mangle prefix.
* gm2-gcc/m2options.h (M2Options_SetM2Prefix): New function.
(M2Options_GetM2Prefix): New function.
(M2Options_SetM2PathName): New function.
(M2Options_GetM2PathName): New function.
* gm2-lang.cc (push_back_Ipath): New function.
(add_one_import_path): New function.
(gm2_langhook_handle_option): Record -I component. Call
SetM2PathName when -fm2-pathname= is seen. Record -fm2-pathnameI
component. Call SetM2Prefix when -fm2-prefix= is seen.
(gm2_langhook_post_options): Iterative over pathname entries
and call SetM2PathName, SetSearchPath as appropriate.
* gm2-libs-iso/M2RTS.def (ConstructModules): Add libname parameter.
(DeconstructModules): Add libname parameter.
(RegisterModule): Add libname parameter.
(RequestDependant): Add libname parameter.
* gm2-libs-iso/M2RTS.mod (ConstructModules): Add libname parameter.
(DeconstructModules): Add libname parameter.
(RegisterModule): Add libname parameter.
(RequestDependant): Add libname parameter.
* gm2-libs-min/M2RTS.def (ConstructModules): Add libname parameter.
(DeconstructModules): Add libname parameter.
(RegisterModule): Add libname parameter.
(RequestDependant): Add libname parameter.
* gm2-libs-min/M2RTS.mod (ConstructModules): Add libname parameter.
(DeconstructModules): Add libname parameter.
(RegisterModule): Add libname parameter.
(RequestDependant): Add libname parameter.
* gm2-libs/M2Dependent.def (ConstructModules): Add libname parameter.
(DeconstructModules): Add libname parameter.
(RegisterModule): Add libname parameter.
(RequestDependant): Add libname parameter.
* gm2-libs/M2Dependent.mod (ConstructModules): Add libname parameter.
(DeconstructModules): Add libname parameter.
(RegisterModule): Add libname parameter.
(RequestDependant): Add libname parameter.
* gm2-libs/M2RTS.def (ConstructModules): Add libname parameter.
(DeconstructModules): Add libname parameter.
(RegisterModule): Add libname parameter.
(RequestDependant): Add libname parameter.
* gm2-libs/M2RTS.mod (ConstructModules): Add libname parameter.
(DeconstructModules): Add libname parameter.
(RegisterModule): Add libname parameter.
(RequestDependant): Add libname parameter.
* gm2-libs/RTint.mod (FindVector): Rename variables.
(initInputVector): Rename variables.
(initOutputVector): Rename variables.
(InitTimeVector): Rename variables.
(FindVectorNo): Rename variables.
(FindPendingVector): Rename variables.
(ReArmTimeVector): Rename variables.
(GetTimeVector): Rename variables.
(AttachVector): Rename variables.
(AttachVector): Rename variables.
(IncludeVector): Rename variables.
(ExcludeVector): Rename variables.
(AddFd): Rename variables.
(AddFd): Rename variables.
(DumpPendingQueue): Rename variables.
(stop): Remove.
(activatePending): Rename variables.
(Listen): Rename variables.
* gm2-libs/libc.def (snprintf): New function.
* gm2-libs/sckt.def: Change all exported identifiers to be
export qualified.
* gm2spec.cc (push_back_Ipath): New function.
(add_m2_I_path): New function.
(lang_specific_driver): Skip -fm2-pathname= and remember pathname.
Skip -I and record the path and current pathname. Call add_m2_I_path.
* lang-specs.h: Replace %{I*} with %{fm2-pathname*}.
* lang.opt (-fm2-pathname=): New entry.
(-fm2-pathname): New entry.
(-fm2-prefix=): New entry.
* mc-boot-ch/GUnixArgs.cc (_M2_UnixArgs_dep): New function.
(_M2_UnixArgs_ctor::_M2_UnixArgs_ctor): New method.
* mc-boot-ch/Glibc.c (libc_snprintf): New function.
* mc-boot-ch/m2rts.h (M2RTS_RequestDependant): Changed prototype.
(M2RTS_RegisterModule): Changed prototype.
* mc-boot/GDynamicStrings.c: Rebuild.
* mc-boot/GFIO.c: Rebuild.
* mc-boot/GIndexing.c: Rebuild.
* mc-boot/GM2Dependent.c: Rebuild.
* mc-boot/GM2Dependent.h: Rebuild.
* mc-boot/GM2EXCEPTION.c: Rebuild.
* mc-boot/GM2RTS.c: Rebuild.
* mc-boot/GM2RTS.h: Rebuild.
* mc-boot/GPushBackInput.c: Rebuild.
* mc-boot/GRTExceptions.c: Rebuild.
* mc-boot/GRTint.c: Rebuild.
* mc-boot/GStdIO.c: Rebuild.
* mc-boot/GStringConvert.c: Rebuild.
* mc-boot/GSysStorage.c: Rebuild.
* mc-boot/Gdecl.c: Rebuild.
* mc-boot/Gkeyc.c: Rebuild.
* mc-boot/Glibc.h: Rebuild.
* mc-boot/GmcComment.c: Rebuild.
* mc-boot/GmcComp.c: Rebuild.
* mc-boot/GmcDebug.c: Rebuild.
* mc-boot/GmcMetaError.c: Rebuild.
* mc-boot/GmcStack.c: Rebuild.
* mc-boot/GnameKey.c: Rebuild.
* mc-boot/GsymbolKey.c: Rebuild.
* pge-boot/GASCII.c: Rebuild.
* pge-boot/GArgs.c: Rebuild.
* pge-boot/GAssertion.c: Rebuild.
* pge-boot/GDebug.c: Rebuild.
* pge-boot/GDynamicStrings.c: Rebuild.
* pge-boot/GFIO.c: Rebuild.
* pge-boot/GIO.c: Rebuild.
* pge-boot/GIndexing.c: Rebuild.
* pge-boot/GLists.c: Rebuild.
* pge-boot/GM2Dependent.c: Rebuild.
* pge-boot/GM2Dependent.h: Rebuild.
* pge-boot/GM2EXCEPTION.c: Rebuild.
* pge-boot/GM2RTS.c: Rebuild.
* pge-boot/GM2RTS.h: Rebuild.
* pge-boot/GNameKey.c: Rebuild.
* pge-boot/GNumberIO.c: Rebuild.
* pge-boot/GOutput.c: Rebuild.
* pge-boot/GPushBackInput.c: Rebuild.
* pge-boot/GRTExceptions.c: Rebuild.
* pge-boot/GSFIO.c: Rebuild.
* pge-boot/GStdIO.c: Rebuild.
* pge-boot/GStorage.c: Rebuild.
* pge-boot/GStrCase.c: Rebuild.
* pge-boot/GStrIO.c: Rebuild.
* pge-boot/GStrLib.c: Rebuild.
* pge-boot/GSymbolKey.c: Rebuild.
* pge-boot/GSysExceptions.c (_M2_SysExceptions_finish): Rename this...
(_M2_SysExceptions_fini): ... to this.
* pge-boot/GSysStorage.c: Rebuild.
(_M2_SysStorage_finish): Rename this...
(_M2_SysStorage_fini): ... to this.
* pge-boot/GUnixArgs.cc: New file.
* pge-boot/Gbnflex.c (_M2_bnflex_finish): Rename this...
(_M2_bnflex_fini): ... to this.
* pge-boot/Gerrno.c (_M2_errno_finish): Rename this...
(_M2_errno_fini): ... to this.
* pge-boot/Glibc.c (libc_snprintf): New function.
* pge-boot/Glibc.h (libc_snprintf): New prototype.
* pge-boot/Gpge.c (_M2_pge_finish): Rename this...
(_M2_pge_fini): ... to this.
* pge-boot/Gtermios.cc (_M2_termios_finish): Rename this...
(_M2_termios_fini): ... to this.
* pge-boot/main.c (_M2_RTExceptions_finish): Rename this...
(_M2_RTExceptions_fini): ... to this.
(_M2_M2EXCEPTION_finish): Rename this...
(_M2_M2EXCEPTION_fini): ... to this.
(_M2_M2RTS_finish): Rename this...
(_M2_M2RTS_fini): ... to this.
(_M2_SysExceptions_finish): Rename this...
(_M2_SysExceptions_fini): ... to this.
(_M2_StrLib_finish): Rename this...
(_M2_StrLib_fini): ... to this.
(_M2_errno_finish): Rename this...
(_M2_errno_fini): ... to this.
(_M2_termios_finish): Rename this...
(_M2_termios_fini): ... to this.
(_M2_IO_finish): Rename this...
(_M2_IO_fini): ... to this.
(_M2_StdIO_finish): Rename this...
(_M2_StdIO_fini): ... to this.
(_M2_Debug_finish): Rename this...
(_M2_Debug_fini): ... to this.
(_M2_SysStorage_finish): Rename this...
(_M2_SysStorage_fini): ... to this.
(_M2_Storage_finish): Rename this...
(_M2_Storage_fini): ... to this.
(_M2_StrIO_finish): Rename this...
(_M2_StrIO_fini): ... to this.
(_M2_DynamicStrings_finish): Rename this...
(_M2_DynamicStrings_fini): ... to this.
(_M2_Assertion_finish): Rename this...
(_M2_Assertion_fini): ... to this.
(_M2_Indexing_finish): Rename this...
(_M2_Indexing_fini): ... to this.
(_M2_NameKey_finish): Rename this...
(_M2_NameKey_fini): ... to this.
(_M2_NumberIO_finish): Rename this...
(_M2_NumberIO_fini): ... to this.
(_M2_PushBackInput_finish): Rename this...
(_M2_PushBackInput_fini): ... to this.
(_M2_SymbolKey_finish): Rename this...
(_M2_SymbolKey_fini): ... to this.
(_M2_UnixArgs_finish): Rename this...
(_M2_UnixArgs_fini): ... to this.
(_M2_FIO_finish): Rename this...
(_M2_FIO_fini): ... to this.
(_M2_SFIO_finish): Rename this...
(_M2_SFIO_fini): ... to this.
(_M2_StrCase_finish): Rename this...
(_M2_StrCase_fini): ... to this.
(_M2_bnflex_finish): Rename this...
(_M2_bnflex_fini): ... to this.
(_M2_Lists_finish): Rename this...
(_M2_Lists_fini): ... to this.
(_M2_Args_finish): Rename this...
(_M2_Args_fini): ... to this.
(_M2_Output_finish): Rename this...
(_M2_Output_fini): ... to this.
(_M2_pge_finish): Rename this...
(_M2_pge_fini): ... to this.
* plugin/m2rte.cc (m2_runtime_error_calls): Change all runtime
procedure names to their name mangled counterparts.
* gm2-libs-iso/wrapsock.c: Removed.
* gm2-libs-iso/wraptime.c: Removed.
* mc-boot/Gpth.h: Removed.
* gm2-compiler/PathName.def: New file.
* gm2-compiler/PathName.mod: New file.
libgm2/ChangeLog:
PR modula2/108261
* libm2cor/KeyBoardLEDs.cc (EXPORT): New define.
(M2EXPORT): New define.
(M2LIBNAME): New define.
(KeyBoardLEDs_SwitchScroll): EXPORT.
(KeyBoardLEDs_SwitchNum): EXPORT.
(KeyBoardLEDs_SwitchCaps): EXPORT.
(KeyBoardLEDs_SwitchLeds): EXPORT.
(_M2_KeyBoardLEDs_init): M2EXPORT.
(_M2_KeyBoardLEDs_finish): M2EXPORT.
(_M2_KeyBoardLEDs_dep): M2EXPORT.
* libm2cor/Makefile.am (libm2cor_la_M2FLAGS): Define
path names.
* libm2cor/Makefile.in: Rebuild.
* libm2iso/ErrnoCategory.cc (EXPORT): New define.
(M2EXPORT): New define.
(M2LIBNAME): New define.
(ErrnoCategory_IsErrnoHard): EXPORT.
(ErrnoCategory_IsErrnoSoft): EXPORT.
(ErrnoCategory_UnAvailable): EXPORT.
(ErrnoCategory_GetOpenResults): EXPORT.
(_M2_ErrnoCategory_init): M2EXPORT.
(_M2_ErrnoCategory_fini): M2EXPORT.
(_M2_ErrnoCategory_dep): M2EXPORT.
(_M2_ErrnoCategory_ctor): M2EXPORT.
* libm2iso/Makefile.am (libm2iso_la_M2FLAGS): Define
path names.
* libm2iso/Makefile.in: Rebuild.
* libm2iso/RTco.cc (EXPORT): New define.
(M2EXPORT): New define.
(M2LIBNAME): New define.
(newSem): Add module libname prefix to HaltC.
(currentThread): Remove variable and replace with a function.
(never): Add module libname prefix to HaltC.
(initThread): Add module libname prefix to HaltC.
* libm2iso/m2rts.h (str): New define.
(M2RTS_RequestDependant): Change to the mangled name equivalent.
(M2RTS_RegisterModule): Change to the mangled name equivalent.
(m2iso_M2RTS_RequestDependant): Add libname parameter.
(m2iso_M2RTS_RegisterModule): Add libname parameter.
(m2pim_M2RTS_RegisterModule): Add libname parameter.
(_M2_M2RTS_init): Rename this...
(m2iso_M2_M2RTS_init): ...to this.
(M2RTS_ConstructModules): Change to the mangled name equivalent.
(M2RTS_Terminate): Change to the mangled name equivalent.
(M2RTS_DeconstructModules): Change to the mangled name equivalent.
(m2iso_M2RTS_ConstructModules): Add libname parameter.
(m2iso_M2RTS_Terminate): Add libname parameter.
(m2iso_M2RTS_DeconstructModules): Add libname parameter.
(M2RTS_HaltC): Rename this...
(m2iso_M2RTS_HaltC): ...to this.
* libm2iso/wrapsock.c (EXPORT): New define.
(IMPORT): New define.
(M2EXPORT): New define.
(M2LIBNAME): New define.
(m2iso_M2RTS_RequestDependant): Add prototype.
(wrapsock_clientOpen): EXPORT.
(wrapsock_clientOpenIP): EXPORT.
(wrapsock_getClientPortNo): EXPORT.
(wrapsock_getClientHostname): EXPORT.
(wrapsock_getClientSocketFd): EXPORT.
(wrapsock_getClientIP): EXPORT.
(wrapsock_getPushBackChar): EXPORT.
(wrapsock_setPushBackChar): EXPORT.
(wrapsock_getSizeOfClientInfo): EXPORT.
(_M2_wrapsock_init): M2EXPORT.
(_M2_wrapsock_fini): M2EXPORT.
(ctor): M2EXPORT. New function.
* libm2iso/wraptime.c: Rename to...
* libm2iso/wraptime.cc: ...this.
(EXPORT): New define.
(M2EXPORT): New define.
(M2LIBNAME): New define.
(wraptime_InitTimeval): EXPORT.
(wraptime_KillTimeval): EXPORT.
(wraptime_InitTimezone): EXPORT.
(wraptime_KillTimezone): EXPORT.
(wraptime_InitTM): EXPORT.
(wraptime_KillTM): EXPORT.
(wraptime_gettimeofday): EXPORT.
(wraptime_settimeofday): EXPORT.
(wraptime_GetFractions): EXPORT.
(wraptime_localtime_r): EXPORT.
(wraptime_GetYear): EXPORT.
(wraptime_GetMonth): EXPORT.
(wraptime_GetDay): EXPORT.
(wraptime_GetHour): EXPORT.
(wraptime_GetMinute): EXPORT.
(wraptime_GetSecond): EXPORT.
(wraptime_GetSummerTime): EXPORT.
(wraptime_GetDST): EXPORT.
(wraptime_SetTimezone): EXPORT.
(wraptime_SetTimeval): EXPORT.
(_M2_wraptime_init): M2EXPORT.
(_M2_wraptime_fini): M2EXPORT.
(ctor): M2EXPORT. New function.
* libm2log/Makefile.am (libm2log_la_M2FLAGS): Define
path names.
* libm2log/Makefile.in:
* libm2min/Makefile.am (libm2min_la_M2FLAGS): Define
path names.
* libm2min/Makefile.in:
* libm2pim/Makefile.am (libm2pim_la_M2FLAGS): Define
path names.
* libm2pim/Makefile.in:
* libm2pim/Selective.cc (EXPORT): New define.
(M2EXPORT): New define.
(M2LIBNAME): New define.
(Selective_Select): EXPORT.
(Selective_InitTime): EXPORT.
(Selective_GetTime): EXPORT.
(Selective_SetTime): EXPORT.
(Selective_KillTime): EXPORT.
(Selective_InitSet): EXPORT.
(Selective_KillSet): EXPORT.
(Selective_FdZero): EXPORT.
(Selective_FdSet): EXPORT.
(Selective_FdClr): EXPORT.
(Selective_FdIsSet): EXPORT.
(Selective_GetTimeOfDay): EXPORT.
(Selective_MaxFdsPlusOne): EXPORT.
(Selective_WriteCharRaw): EXPORT.
(Selective_ReadCharRaw): EXPORT.
(_M2_Selective_init): M2EXPORT.
(_M2_Selective_fini): M2EXPORT.
(_M2_Selective_dep): M2EXPORT.
(_M2_Selective_ctor): M2EXPORT.
* libm2pim/SysExceptions.cc (EXPORT): New define.
(M2EXPORT): New define.
(M2LIBNAME): New define.
(SysExceptions_InitExceptionHandlers): EXPORT.
(_M2_SysExceptions_init): M2EXPORT.
(_M2_SysExceptions_fini): M2EXPORT.
(_M2_SysExceptions_dep): M2EXPORT.
(_M2_SysExceptions_ctor): M2EXPORT.
* libm2pim/UnixArgs.cc (EXPORT): New define.
(M2EXPORT): New define.
(M2LIBNAME): New define.
(UnixArgs_GetArgC): EXPORT.
(UnixArgs_GetArgV): EXPORT.
(UnixArgs_GetEnvV): EXPORT.
(_M2_UnixArgs_init): M2EXPORT.
(_M2_UnixArgs_fini): M2EXPORT.
(_M2_UnixArgs_dep): M2EXPORT.
(_M2_UnixArgs_ctor): M2EXPORT.
* libm2pim/cgetopt.cc (EXPORT): New define.
(M2EXPORT): New define.
(M2LIBNAME): New define.
(cgetopt_getopt): EXPORT.
(cgetopt_getopt_long): EXPORT.
(cgetopt_getopt_long_only): EXPORT.
(cgetopt_InitOptions): EXPORT.
(cgetopt_KillOptions): EXPORT.
(cgetopt_SetOption): EXPORT.
(cgetopt_GetLongOptionArray): EXPORT.
(_M2_cgetopt_init): M2EXPORT.
(_M2_cgetopt_fini): M2EXPORT.
(_M2_cgetopt_dep): M2EXPORT.
(_M2_cgetopt_ctor): M2EXPORT.
* libm2pim/dtoa.cc (EXPORT): New define.
(M2EXPORT): New define.
(M2LIBNAME): New define.
(dtoa_strtod): EXPORT.
(dtoa_calcmaxsig): EXPORT.
(dtoa_calcdecimal): EXPORT.
(dtoa_calcsign): EXPORT.
(dtoa_dtoa): EXPORT.
(_M2_dtoa_init): M2EXPORT.
(_M2_dtoa_fini): M2EXPORT.
(_M2_dtoa_dep): M2EXPORT.
(_M2_dtoa_ctor): M2EXPORT.
* libm2pim/errno.cc (EXPORT): New define.
(M2EXPORT): New define.
(M2LIBNAME): New define.
(errno_geterrno): EXPORT.
(_M2_errno_init): M2EXPORT.
(_M2_errno_fini): M2EXPORT.
(_M2_errno_dep): M2EXPORT.
(_M2_errno_ctor): M2EXPORT.
* libm2pim/ldtoa.cc (EXPORT): New define.
(IMPORT): New define.
(M2EXPORT): New define.
(M2LIBNAME): New define.
(dtoa_calcmaxsig): EXPORT.
(dtoa_calcdecimal): EXPORT.
(dtoa_calcsign): EXPORT.
(ldtoa_strtold): EXPORT.
(ldtoa_ldtoa): EXPORT.
(_M2_ldtoa_init): M2EXPORT.
(_M2_ldtoa_fini): M2EXPORT.
(_M2_ldtoa_dep): M2EXPORT.
(_M2_ldtoa_ctor): M2EXPORT.
* libm2pim/sckt.cc (EXPORT): New define.
(M2EXPORT): New define.
(M2LIBNAME): New define.
(tcpServerEstablishPort): EXPORT.
(tcpServerEstablish): EXPORT.
(tcpServerAccept): EXPORT.
(tcpServerPortNo): EXPORT.
(tcpServerSocketFd): EXPORT.
(getLocalIP): EXPORT.
(tcpServerIP): EXPORT.
(tcpServerClientIP): EXPORT.
(tcpServerClientPortNo): EXPORT.
(tcpClientSocket): EXPORT.
(tcpClientSocketIP): EXPORT.
(tcpClientConnect): EXPORT.
(tcpClientPortNo): EXPORT.
(tcpClientSocketFd): EXPORT.
(tcpClientIP): EXPORT.
(_M2_sckt_init): M2EXPORT.
(_M2_sckt_finish): M2EXPORT.
(_M2_sckt_dep): M2EXPORT.
(_M2_sckt_ctor): M2EXPORT.
* libm2pim/termios.cc (EXPORT): New define.
(M2EXPORT): New define.
(M2LIBNAME): New define.
(_M2_termios_init): M2EXPORT.
(_M2_termios_fini): M2EXPORT.
(_M2_termios_dep): M2EXPORT.
(_M2_termios_ctor): M2EXPORT.
* libm2pim/wrapc.c (EXPORT): New define.
(M2EXPORT): New define.
(M2LIBNAME): New define.
(wrapc_strtime): EXPORT.
(wrapc_filesize): EXPORT.
(wrapc_filemtime): EXPORT.
(wrapc_fileinode): EXPORT.
(wrapc_getrand): EXPORT.
(wrapc_getusername): EXPORT.
(wrapc_getnameuidgid): EXPORT.
(wrapc_signbit): EXPORT.
(wrapc_signbitl): EXPORT.
(wrapc_signbitf): EXPORT.
(wrapc_isfinite): EXPORT.
(wrapc_isfinitel): EXPORT.
(wrapc_isfinitef): EXPORT.
(_M2_wrapc_init): M2EXPORT.
(_M2_wrapc_fini): M2EXPORT.
(_M2_wrapc_ctor): M2EXPORT.
gcc/testsuite/ChangeLog:
PR modula2/108261
* gm2/examples/callingC/pass/examples-callingC-pass.exp: Tidy up
variable access.
* gm2/examples/callingC/run/pass/examples-callingC-run-pass.exp: Tidy up
variable access.
* gm2/examples/cpp/pass/examples-cpp-pass.exp: Tidy up
variable access.
* gm2/examples/cppDef/pass/examples-cppDef-pass.exp: Tidy up
variable access.
* gm2/examples/hello/pass/examples-hello-pass.exp: Tidy up
variable access.
* gm2/examples/map/pass/examples-map-pass.exp: Tidy up
variable access.
* gm2/iso/check/fail/iso-check-fail.exp: Add pathname.
* gm2/link/externalscaffold/pass/link-externalscaffold-pass.exp:
Add pathname.
* gm2/link/externalscaffold/pass/scaffold.c: Add mangled export name.
* gm2/pimlib/base/run/pass/FIO.mod: Updated test code.
* gm2/pimlib/base/run/pass/StrLib.mod: Updated test code.
* gm2/pimlib/base/run/pass/pimlib-base-run-pass.exp: Remove path.
* gm2/projects/pim/run/pass/random/projects-pim-run-pass-random.exp:
Tidy up variable access.
* gm2/switches/auto-init/fail/switches-auto-init-fail.exp: Add pathname.
* gm2/switches/check-all/pim2/fail/switches-check-all-pim2-fail.exp:
Add pathname.
* gm2/switches/makeall/fail/switches-makeall-fail.exp: Remove -fmakeall.
* gm2/switches/makeall/pass/switches-makeall-pass.exp: Remove -fmakeall.
* lib/gm2-simple.exp (gm2_keep_executable): New global variable.
(gm2_simple_execute): Keep executable if global is true.
* lib/gm2-torture.exp: Add ; after global variable access.
* lib/gm2.exp: Set up pathnames.
* gm2/projects/pim/run/pass/tower/AdvCmd.def: New test.
* gm2/projects/pim/run/pass/tower/AdvCmd.mod: New test.
* gm2/projects/pim/run/pass/tower/AdvIntroduction.def: New test.
* gm2/projects/pim/run/pass/tower/AdvIntroduction.mod: New test.
* gm2/projects/pim/run/pass/tower/AdvMap.def: New test.
* gm2/projects/pim/run/pass/tower/AdvMap.mod: New test.
* gm2/projects/pim/run/pass/tower/AdvMath.def: New test.
* gm2/projects/pim/run/pass/tower/AdvMath.mod: New test.
* gm2/projects/pim/run/pass/tower/AdvParse.bnf: New test.
* gm2/projects/pim/run/pass/tower/AdvParse.def: New test.
* gm2/projects/pim/run/pass/tower/AdvParse.mod: New test.
* gm2/projects/pim/run/pass/tower/AdvSound.def: New test.
* gm2/projects/pim/run/pass/tower/AdvSound.mod: New test.
* gm2/projects/pim/run/pass/tower/AdvSystem.def: New test.
* gm2/projects/pim/run/pass/tower/AdvSystem.mod: New test.
* gm2/projects/pim/run/pass/tower/AdvTreasure.def: New test.
* gm2/projects/pim/run/pass/tower/AdvTreasure.mod: New test.
* gm2/projects/pim/run/pass/tower/AdvUtil.def: New test.
* gm2/projects/pim/run/pass/tower/AdvUtil.mod: New test.
* gm2/projects/pim/run/pass/tower/DrawG.def: New test.
* gm2/projects/pim/run/pass/tower/DrawG.mod: New test.
* gm2/projects/pim/run/pass/tower/DrawL.def: New test.
* gm2/projects/pim/run/pass/tower/DrawL.mod: New test.
* gm2/projects/pim/run/pass/tower/Dungeon.mod: New test.
* gm2/projects/pim/run/pass/tower/Lock.def: New test.
* gm2/projects/pim/run/pass/tower/Lock.mod: New test.
* gm2/projects/pim/run/pass/tower/ProcArgs.def: New test.
* gm2/projects/pim/run/pass/tower/ProcArgs.mod: New test.
* gm2/projects/pim/run/pass/tower/Screen.def: New test.
* gm2/projects/pim/run/pass/tower/Screen.mod: New test.
* gm2/projects/pim/run/pass/tower/SocketControl.c: New test.
* gm2/projects/pim/run/pass/tower/SocketControl.def: New test.
* gm2/projects/pim/run/pass/tower/Window.def: New test.
* gm2/projects/pim/run/pass/tower/Window.mod: New test.
* gm2/projects/pim/run/pass/tower/adv.flex: New test.
* gm2/projects/pim/run/pass/tower/advflex.c: New test.
* gm2/projects/pim/run/pass/tower/advflex.def: New test.
* gm2/projects/pim/run/pass/tower/projects-pim-run-pass-tower.exp:
New test.
* gm2/projects/pim/run/pass/tower/star: New test.
Signed-off-by: Gaius Mulley <gaiusmod2@gmail.com>
Diff:
---
gcc/doc/gm2.texi | 27 +-
gcc/m2/Make-lang.in | 12 +-
gcc/m2/Make-maintainer.in | 97 +-
.../{DynamicStringPath.def => DynamicPath.def} | 45 +-
.../{DynamicStringPath.mod => DynamicPath.mod} | 82 +-
gcc/m2/gm2-compiler/M2AsmUtil.mod | 46 +-
gcc/m2/gm2-compiler/M2Comp.mod | 64 +-
gcc/m2/gm2-compiler/M2Graph.mod | 12 +-
gcc/m2/gm2-compiler/M2Options.def | 32 +-
gcc/m2/gm2-compiler/M2Options.mod | 61 +-
gcc/m2/gm2-compiler/M2Quads.mod | 47 +-
gcc/m2/gm2-compiler/M2Scaffold.mod | 34 +-
gcc/m2/gm2-compiler/M2Search.def | 10 +-
gcc/m2/gm2-compiler/M2Search.mod | 40 +-
gcc/m2/gm2-compiler/PathName.def | 104 +
gcc/m2/gm2-compiler/PathName.mod | 279 +++
gcc/m2/gm2-compiler/SymbolTable.def | 17 +-
gcc/m2/gm2-compiler/SymbolTable.mod | 87 +-
gcc/m2/gm2-gcc/init.cc | 6 +-
gcc/m2/gm2-gcc/m2decl.cc | 4 +-
gcc/m2/gm2-gcc/m2options.h | 4 +
gcc/m2/gm2-lang.cc | 62 +-
gcc/m2/gm2-libs-iso/M2RTS.def | 9 +-
gcc/m2/gm2-libs-iso/M2RTS.mod | 20 +-
gcc/m2/gm2-libs-iso/wrapsock.c | 260 ---
gcc/m2/gm2-libs-iso/wraptime.c | 292 ---
gcc/m2/gm2-libs-min/M2RTS.def | 26 +-
gcc/m2/gm2-libs-min/M2RTS.mod | 43 +-
gcc/m2/gm2-libs/M2Dependent.def | 14 +-
gcc/m2/gm2-libs/M2Dependent.mod | 381 +++-
gcc/m2/gm2-libs/M2RTS.def | 9 +-
gcc/m2/gm2-libs/M2RTS.mod | 20 +-
gcc/m2/gm2-libs/RTint.mod | 399 ++--
gcc/m2/gm2-libs/libc.def | 10 +-
gcc/m2/gm2-libs/sckt.def | 16 +-
gcc/m2/gm2spec.cc | 64 +-
gcc/m2/lang-specs.h | 7 +-
gcc/m2/lang.opt | 14 +-
gcc/m2/mc-boot-ch/GUnixArgs.cc | 4 +-
gcc/m2/mc-boot-ch/Glibc.c | 36 +
gcc/m2/mc-boot-ch/m2rts.h | 5 +-
gcc/m2/mc-boot/GDynamicStrings.c | 32 +-
gcc/m2/mc-boot/GFIO.c | 20 +-
gcc/m2/mc-boot/GIndexing.c | 6 +-
gcc/m2/mc-boot/GM2Dependent.c | 450 ++++-
gcc/m2/mc-boot/GM2Dependent.h | 13 +-
gcc/m2/mc-boot/GM2EXCEPTION.c | 4 +-
gcc/m2/mc-boot/GM2RTS.c | 24 +-
gcc/m2/mc-boot/GM2RTS.h | 8 +-
gcc/m2/mc-boot/GPushBackInput.c | 6 +-
gcc/m2/mc-boot/GRTExceptions.c | 34 +-
gcc/m2/mc-boot/GRTint.c | 20 +-
gcc/m2/mc-boot/GStdIO.c | 4 +-
gcc/m2/mc-boot/GStringConvert.c | 4 +-
gcc/m2/mc-boot/GSysStorage.c | 6 +-
gcc/m2/mc-boot/Gdecl.c | 141 +-
gcc/m2/mc-boot/Gkeyc.c | 2 +-
gcc/m2/mc-boot/Glibc.h | 1 +
| 2 +-
gcc/m2/mc-boot/GmcComp.c | 4 +-
gcc/m2/mc-boot/GmcDebug.c | 2 +-
gcc/m2/mc-boot/GmcMetaError.c | 8 +-
gcc/m2/mc-boot/GmcStack.c | 4 +-
gcc/m2/mc-boot/GnameKey.c | 4 +-
gcc/m2/mc-boot/Gpth.h | 43 -
gcc/m2/mc-boot/GsymbolKey.c | 6 +-
gcc/m2/pge-boot/GASCII.c | 2 +-
gcc/m2/pge-boot/GArgs.c | 2 +-
gcc/m2/pge-boot/GAssertion.c | 2 +-
gcc/m2/pge-boot/GDebug.c | 2 +-
gcc/m2/pge-boot/GDynamicStrings.c | 34 +-
gcc/m2/pge-boot/GFIO.c | 22 +-
gcc/m2/pge-boot/GIO.c | 2 +-
gcc/m2/pge-boot/GIndexing.c | 8 +-
gcc/m2/pge-boot/GLists.c | 2 +-
gcc/m2/pge-boot/GM2Dependent.c | 454 ++++-
gcc/m2/pge-boot/GM2Dependent.h | 15 +-
gcc/m2/pge-boot/GM2EXCEPTION.c | 6 +-
gcc/m2/pge-boot/GM2RTS.c | 76 +-
gcc/m2/pge-boot/GM2RTS.h | 73 +-
gcc/m2/pge-boot/GNameKey.c | 6 +-
gcc/m2/pge-boot/GNumberIO.c | 2 +-
gcc/m2/pge-boot/GOutput.c | 2 +-
gcc/m2/pge-boot/GPushBackInput.c | 8 +-
gcc/m2/pge-boot/GRTExceptions.c | 42 +-
gcc/m2/pge-boot/GSFIO.c | 2 +-
gcc/m2/pge-boot/GStdIO.c | 6 +-
gcc/m2/pge-boot/GStorage.c | 2 +-
gcc/m2/pge-boot/GStrCase.c | 2 +-
gcc/m2/pge-boot/GStrIO.c | 2 +-
gcc/m2/pge-boot/GStrLib.c | 2 +-
gcc/m2/pge-boot/GSymbolKey.c | 8 +-
gcc/m2/pge-boot/GSysExceptions.c | 2 +-
gcc/m2/pge-boot/GSysStorage.c | 8 +-
gcc/m2/pge-boot/GUnixArgs.cc | 4 +-
gcc/m2/pge-boot/Gbnflex.c | 2 +-
gcc/m2/pge-boot/Gerrno.c | 2 +-
gcc/m2/pge-boot/Glibc.c | 37 +
gcc/m2/pge-boot/Glibc.h | 1 +
gcc/m2/pge-boot/Gpge.c | 2 +-
gcc/m2/pge-boot/Gtermios.cc | 2 +-
gcc/m2/pge-boot/main.c | 116 +-
gcc/m2/plugin/m2rte.cc | 73 +-
.../callingC/pass/examples-callingC-pass.exp | 2 +-
.../run/pass/examples-callingC-run-pass.exp | 2 +-
.../gm2/examples/cpp/pass/examples-cpp-pass.exp | 2 +-
.../examples/cppDef/pass/examples-cppDef-pass.exp | 2 +-
.../examples/hello/pass/examples-hello-pass.exp | 2 +-
.../gm2/examples/map/pass/examples-map-pass.exp | 2 +-
.../gm2/iso/check/fail/iso-check-fail.exp | 2 +-
.../pass/link-externalscaffold-pass.exp | 2 +-
.../gm2/link/externalscaffold/pass/scaffold.c | 26 +-
gcc/testsuite/gm2/pimlib/base/run/pass/FIO.mod | 181 +-
gcc/testsuite/gm2/pimlib/base/run/pass/StrLib.mod | 99 +-
.../pimlib/base/run/pass/pimlib-base-run-pass.exp | 2 +-
.../pass/random/projects-pim-run-pass-random.exp | 2 +-
.../gm2/projects/pim/run/pass/tower/AdvCmd.def | 10 +
.../gm2/projects/pim/run/pass/tower/AdvCmd.mod | 294 +++
.../pim/run/pass/tower/AdvIntroduction.def | 7 +
.../pim/run/pass/tower/AdvIntroduction.mod | 275 +++
.../gm2/projects/pim/run/pass/tower/AdvMap.def | 82 +
.../gm2/projects/pim/run/pass/tower/AdvMap.mod | 57 +
.../gm2/projects/pim/run/pass/tower/AdvMath.def | 120 ++
.../gm2/projects/pim/run/pass/tower/AdvMath.mod | 220 ++
.../gm2/projects/pim/run/pass/tower/AdvParse.bnf | 379 ++++
.../gm2/projects/pim/run/pass/tower/AdvParse.def | 18 +
.../gm2/projects/pim/run/pass/tower/AdvParse.mod | 873 ++++++++
.../gm2/projects/pim/run/pass/tower/AdvSound.def | 70 +
.../gm2/projects/pim/run/pass/tower/AdvSound.mod | 143 ++
.../gm2/projects/pim/run/pass/tower/AdvSystem.def | 189 ++
.../gm2/projects/pim/run/pass/tower/AdvSystem.mod | 574 ++++++
.../projects/pim/run/pass/tower/AdvTreasure.def | 22 +
.../projects/pim/run/pass/tower/AdvTreasure.mod | 1632 +++++++++++++++
.../gm2/projects/pim/run/pass/tower/AdvUtil.def | 57 +
.../gm2/projects/pim/run/pass/tower/AdvUtil.mod | 1573 +++++++++++++++
.../gm2/projects/pim/run/pass/tower/DrawG.def | 36 +
.../gm2/projects/pim/run/pass/tower/DrawG.mod | 327 +++
.../gm2/projects/pim/run/pass/tower/DrawL.def | 23 +
.../gm2/projects/pim/run/pass/tower/DrawL.mod | 422 ++++
.../gm2/projects/pim/run/pass/tower/Dungeon.mod | 34 +
.../gm2/projects/pim/run/pass/tower/Lock.def | 27 +
.../gm2/projects/pim/run/pass/tower/Lock.mod | 75 +
.../gm2/projects/pim/run/pass/tower/ProcArgs.def | 15 +
.../gm2/projects/pim/run/pass/tower/ProcArgs.mod | 58 +
.../gm2/projects/pim/run/pass/tower/Screen.def | 55 +
.../gm2/projects/pim/run/pass/tower/Screen.mod | 303 +++
.../projects/pim/run/pass/tower/SocketControl.c | 27 +
.../projects/pim/run/pass/tower/SocketControl.def | 6 +
.../gm2/projects/pim/run/pass/tower/Window.def | 16 +
.../gm2/projects/pim/run/pass/tower/Window.mod | 62 +
.../gm2/projects/pim/run/pass/tower/adv.flex | 266 +++
.../gm2/projects/pim/run/pass/tower/advflex.c | 2107 ++++++++++++++++++++
.../gm2/projects/pim/run/pass/tower/advflex.def | 32 +
.../run/pass/tower/projects-pim-run-pass-tower.exp | 110 +
gcc/testsuite/gm2/projects/pim/run/pass/tower/star | 71 +
.../auto-init/fail/switches-auto-init-fail.exp | 2 +-
.../pim2/fail/switches-check-all-pim2-fail.exp | 2 +-
.../makeall/fail/switches-makeall-fail.exp | 2 +-
.../makeall/pass/switches-makeall-pass.exp | 1 -
gcc/testsuite/lib/gm2-simple.exp | 9 +-
gcc/testsuite/lib/gm2-torture.exp | 18 +-
gcc/testsuite/lib/gm2.exp | 52 +-
libgm2/libm2cor/KeyBoardLEDs.cc | 42 +-
libgm2/libm2cor/Makefile.am | 6 +-
libgm2/libm2cor/Makefile.in | 7 +-
libgm2/libm2iso/ErrnoCategory.cc | 27 +-
libgm2/libm2iso/Makefile.am | 19 +-
libgm2/libm2iso/Makefile.in | 33 +-
libgm2/libm2iso/RTco.cc | 117 +-
libgm2/libm2iso/m2rts.h | 26 +-
libgm2/libm2iso/wrapsock.c | 52 +-
libgm2/libm2iso/{wraptime.c => wraptime.cc} | 189 +-
libgm2/libm2log/Makefile.am | 7 +-
libgm2/libm2log/Makefile.in | 8 +-
libgm2/libm2min/Makefile.am | 6 +-
libgm2/libm2min/Makefile.in | 6 +-
libgm2/libm2pim/Makefile.am | 7 +-
libgm2/libm2pim/Makefile.in | 19 +-
libgm2/libm2pim/Selective.cc | 77 +-
libgm2/libm2pim/SysExceptions.cc | 22 +-
libgm2/libm2pim/UnixArgs.cc | 30 +-
libgm2/libm2pim/cgetopt.cc | 63 +-
libgm2/libm2pim/dtoa.cc | 35 +-
libgm2/libm2pim/errno.cc | 19 +-
libgm2/libm2pim/ldtoa.cc | 36 +-
libgm2/libm2pim/sckt.cc | 49 +-
libgm2/libm2pim/termios.cc | 18 +-
libgm2/libm2pim/{wrapc.c => wrapc.cc} | 92 +-
188 files changed, 14335 insertions(+), 2438 deletions(-)
diff --git a/gcc/doc/gm2.texi b/gcc/doc/gm2.texi
index 5b1858bfa50..07729f84e7b 100644
--- a/gcc/doc/gm2.texi
+++ b/gcc/doc/gm2.texi
@@ -484,9 +484,21 @@ where multiple @code{END} keywords are mapped onto a sequence of
@item -fm2-lower-case
render keywords in error messages using lower case.
+@item -fm2-pathname=
+specify the module mangled prefix name for all modules in the
+following include paths.
+
+@item -fm2-pathnameI
+for internal use only: used by the driver to copy the user facing -I
+option.
+
@item -fm2-plugin
insert plugin to identify run time errors at compile time (default on).
+@item -fm2-prefix=
+specify the module mangled prefix name. All exported symbols from a
+definition module will have the prefix name.
+
@item -fm2-statistics
generates quadruple information: number of quadruples generated,
number of quadruples remaining after optimization and number of source
@@ -567,12 +579,13 @@ via @samp{-fno-return}.
@item -fruntime-modules=
specify, using a comma separated list, the run time modules and their
order. These modules will initialized first before any other modules
-in the application dependency. By default the run time modules list is
-set to @code{Storage,SYSTEM,M2RTS,RTExceptions,IOLink}. Note that
-these modules will only be linked into your executable if they are
-required. So adding a long list of dependent modules will not effect
-the size of the executable it merely states the initialization order
-should they be required.
+in the application dependency. By default the run time modules list
+is set to @code{m2iso:RTentity,m2iso:Storage,m2iso:SYSTEM,}
+@code{m2iso:M2RTS,m2iso:RTExceptions,m2iso:IOLink}. Note that these
+modules will only be linked into your executable if they are required.
+Adding a long list of dependent modules will not effect the size of
+the executable it merely states the initialization order should they
+be required.
@item -fscaffold-dynamic
the option ensures that @samp{gm2} will generate a dynamic scaffold
@@ -740,6 +753,8 @@ value | meaning
=================
all | turn on all flags below
module | trace modules as they register themselves
+hex | display the hex address of the init/fini functions
+warning | show any warnings
pre | generate module list prior to dependency resolution
dep | trace module dependency resolution
post | generate module list after dependency resolution
diff --git a/gcc/m2/Make-lang.in b/gcc/m2/Make-lang.in
index d1d02a0d78e..92a413b86be 100644
--- a/gcc/m2/Make-lang.in
+++ b/gcc/m2/Make-lang.in
@@ -714,7 +714,8 @@ GM2-COMP-BOOT-DEFS = \
M2DebugStack.def \
M2Defaults.def \
M2DriverOptions.def \
- DynamicStringPath.def \
+ DynamicPath.def \
+ PathName.def \
M2Emit.def \
M2Error.def \
M2EvalSym.def \
@@ -786,7 +787,8 @@ GM2-COMP-BOOT-MODS = \
M2DebugStack.mod \
M2Defaults.mod \
M2DriverOptions.mod \
- DynamicStringPath.mod \
+ DynamicPath.mod \
+ PathName.mod \
M2Emit.mod \
M2Error.mod \
M2FileName.mod \
@@ -991,7 +993,8 @@ GM2-COMP-DEFS = \
M2DebugStack.def \
M2Defaults.def \
M2DriverOptions.def \
- DynamicStringPath.def \
+ DynamicPath.def \
+ PathName.def \
M2Emit.def \
M2Error.def \
M2FileName.def \
@@ -1059,7 +1062,8 @@ GM2-COMP-MODS = \
M2DebugStack.mod \
M2Defaults.mod \
M2DriverOptions.mod \
- DynamicStringPath.mod \
+ DynamicPath.mod \
+ PathName.mod \
M2Emit.mod \
M2Error.mod \
M2FileName.mod \
diff --git a/gcc/m2/Make-maintainer.in b/gcc/m2/Make-maintainer.in
index d2339b370f2..f6b12ac59f6 100644
--- a/gcc/m2/Make-maintainer.in
+++ b/gcc/m2/Make-maintainer.in
@@ -95,26 +95,30 @@ BUILD-PPG-LIBS-H = $(PPG-LIB-DEFS:%.def=m2/gm2-ppg-boot/$(SRC_PREFIX)%.h)
BUILD-PPG-H = m2/boot-bin/mc$(exeext) $(BUILD-PPG-LIBS-H)
+BUILD-BOOT-PPG-H: $(BUILD-BOOT-H) \
+ m2/gm2-ppg-boot/$(SRC_PREFIX)M2RTS.h \
+ m2/gm2-ppg-boot/$(SRC_PREFIX)M2Dependent.h
+
m2/gm2-ppg-boot/$(SRC_PREFIX)%.h: $(srcdir)/m2/gm2-libs/%.def $(MCDEPS)
-test -d m2/gm2-ppg-boot || $(mkinstalldirs) m2/gm2-ppg-boot
$(MCC) -o=$@ $(srcdir)/m2/gm2-libs/$*.def
-m2/gm2-ppg-boot/$(SRC_PREFIX)%.o: m2/mc-boot-ch/$(SRC_PREFIX)%.c m2/gm2-libs/gm2-libs-host.h
+m2/gm2-ppg-boot/$(SRC_PREFIX)%.o: m2/mc-boot-ch/$(SRC_PREFIX)%.c m2/gm2-libs/gm2-libs-host.h $(BUILD-BOOT-PPG-H)
-test -d m2/gm2-ppg-boot || $(mkinstalldirs) m2/gm2-ppg-boot
$(CXX) -I. -I$(srcdir)/../include -I$(srcdir) -I$(srcdir)/m2/mc-boot-ch -Im2/gm2-libs $(INCLUDES) -g -c $< -o $@
-m2/gm2-ppg-boot/$(SRC_PREFIX)%.o: m2/mc-boot-ch/$(SRC_PREFIX)%.cc m2/gm2-libs/gm2-libs-host.h
+m2/gm2-ppg-boot/$(SRC_PREFIX)%.o: m2/mc-boot-ch/$(SRC_PREFIX)%.cc m2/gm2-libs/gm2-libs-host.h $(BUILD-BOOT-PPG-H)
-test -d m2/gm2-ppg-boot || $(mkinstalldirs) m2/gm2-ppg-boot
$(CXX) -I. -I$(srcdir)/../include -I$(srcdir) -I$(srcdir)/m2/mc-boot-ch -Im2/gm2-libs $(INCLUDES) -g -c $< -o $@
-m2/gm2-ppg-boot/$(SRC_PREFIX)%.o: $(srcdir)/m2/gm2-libs/%.mod $(MCDEPS) $(BUILD-BOOT-H)
+m2/gm2-ppg-boot/$(SRC_PREFIX)%.o: $(srcdir)/m2/gm2-libs/%.mod $(MCDEPS) $(BUILD-BOOT-PPG-H)
-test -d m2/gm2-ppg-boot || $(mkinstalldirs) m2/gm2-ppg-boot
$(MCC) -o=m2/gm2-ppg-boot/$(SRC_PREFIX)$*.c $(srcdir)/m2/gm2-libs/$*.mod
$(CXX) -I. -I$(srcdir)/../include -I$(srcdir) \
-Im2/gm2-ppg-boot -I$(srcdir)/m2/mc-boot -Im2/gm2-libs-boot \
-I$(srcdir)/m2/mc-boot-ch $(INCLUDES) -g -c m2/gm2-ppg-boot/$(SRC_PREFIX)$*.c -o $@
-m2/gm2-ppg-boot/$(SRC_PREFIX)%.o: $(srcdir)/m2/gm2-compiler/%.mod $(MCDEPS) $(BUILD-BOOT-H)
+m2/gm2-ppg-boot/$(SRC_PREFIX)%.o: $(srcdir)/m2/gm2-compiler/%.mod $(MCDEPS) $(BUILD-BOOT-PPG-H)
-test -d m2/gm2-ppg-boot || $(mkinstalldirs) m2/gm2-ppg-boot
$(MCC) -o=m2/gm2-ppg-boot/$(SRC_PREFIX)$*.c $(srcdir)/m2/gm2-compiler/$*.mod
$(CXX) -I. -I$(srcdir)/../include -I$(srcdir) \
@@ -142,6 +146,51 @@ m2/gm2-auto:
# without error recovery
PG-SRC = pg.mod
+PGE-DEF = ASCII.def \
+ Args.def \
+ Assertion.def \
+ Break.def \
+ COROUTINES.def \
+ CmdArgs.def \
+ Debug.def \
+ DynamicStrings.def \
+ Environment.def \
+ FIO.def \
+ FormatStrings.def \
+ FpuIO.def \
+ IO.def \
+ M2Dependent.def \
+ M2EXCEPTION.def \
+ M2LINK.def \
+ M2RTS.def \
+ MemUtils.def \
+ NumberIO.def \
+ PushBackInput.def \
+ RTExceptions.def \
+ RTco.def \
+ RTentity.def \
+ RTint.def \
+ SArgs.def \
+ SFIO.def \
+ SYSTEM.def \
+ Selective.def \
+ StdIO.def \
+ Storage.def \
+ StrCase.def \
+ StrIO.def \
+ StrLib.def \
+ StringConvert.def \
+ SysExceptions.def \
+ SysStorage.def \
+ TimeString.def \
+ UnixArgs.def \
+ dtoa.def \
+ errno.def \
+ ldtoa.def \
+ libc.def \
+ libm.def \
+ termios.def \
+ wrapc.def \
BUILD-PG-O = $(PPG-INTERFACE-C:%.c=m2/gm2-pg-boot/$(SRC_PREFIX)%.o) \
$(PPG-INTERFACE-CC:%.cc=m2/gm2-pg-boot/$(SRC_PREFIX)%.o) \
@@ -149,19 +198,23 @@ BUILD-PG-O = $(PPG-INTERFACE-C:%.c=m2/gm2-pg-boot/$(SRC_PREFIX)%.o) \
$(PPG-LIB-MODS:%.mod=m2/gm2-pg-boot/$(SRC_PREFIX)%.o) \
$(PG-SRC:%.mod=m2/gm2-pg-boot/$(SRC_PREFIX)%.o)
+BUILD-BOOT-PG-H: $(BUILD-BOOT-H) \
+ m2/gm2-pg-boot/$(SRC_PREFIX)M2RTS.h \
+ m2/gm2-pg-boot/$(SRC_PREFIX)M2Dependent.h
+
m2/gm2-pg-boot/$(SRC_PREFIX)%.h: $(srcdir)/m2/gm2-libs/%.def $(MCDEPS)
-test -d m2/gm2-pg-boot || $(mkinstalldirs) m2/gm2-pg-boot
$(MCC) -o=$@ $(srcdir)/m2/gm2-libs/$*.def
-m2/gm2-pg-boot/$(SRC_PREFIX)%.o: m2/mc-boot-ch/$(SRC_PREFIX)%.c m2/gm2-libs/gm2-libs-host.h
+m2/gm2-pg-boot/$(SRC_PREFIX)%.o: m2/mc-boot-ch/$(SRC_PREFIX)%.c m2/gm2-libs/gm2-libs-host.h $(BUILD-BOOT-PG-H)
-test -d m2/gm2-pg-boot || $(mkinstalldirs) m2/gm2-pg-boot
$(CXX) -I. -I$(srcdir)/../include -I$(srcdir) -I$(srcdir)/m2/mc-boot-ch -Im2/gm2-libs $(INCLUDES) -g -c $< -o $@
-m2/gm2-pg-boot/$(SRC_PREFIX)%.o: m2/mc-boot-ch/$(SRC_PREFIX)%.cc m2/gm2-libs/gm2-libs-host.h
+m2/gm2-pg-boot/$(SRC_PREFIX)%.o: m2/mc-boot-ch/$(SRC_PREFIX)%.cc m2/gm2-libs/gm2-libs-host.h $(BUILD-BOOT-PG-H)
-test -d m2/gm2-pg-boot || $(mkinstalldirs) m2/gm2-pg-boot
$(CXX) -I. -I$(srcdir)/../include -I$(srcdir) -I$(srcdir)/m2/mc-boot-ch -Im2/gm2-libs $(INCLUDES) -g -c $< -o $@
-m2/gm2-pg-boot/$(SRC_PREFIX)%.o: $(srcdir)/m2/gm2-libs/%.mod $(MCDEPS) $(BUILD-BOOT-H)
+m2/gm2-pg-boot/$(SRC_PREFIX)%.o: $(srcdir)/m2/gm2-libs/%.mod $(MCDEPS) $(BUILD-BOOT-PG-H)
-test -d m2/gm2-pg-boot || $(mkinstalldirs) m2/gm2-pg-boot
$(MCC) -o=m2/gm2-pg-boot/$(SRC_PREFIX)$*.c $(srcdir)/m2/gm2-libs/$*.mod
$(CXX) -I. -I$(srcdir)/../include -I$(srcdir) -Im2/gm2-pg-boot -I$(srcdir)/m2/mc-boot \
@@ -169,13 +222,13 @@ m2/gm2-pg-boot/$(SRC_PREFIX)%.o: $(srcdir)/m2/gm2-libs/%.mod $(MCDEPS) $(BUILD-B
-Im2/gm2-libs-boot $(INCLUDES) \
-g -c m2/gm2-pg-boot/$(SRC_PREFIX)$*.c -o $@
-m2/gm2-pg-boot/$(SRC_PREFIX)%.o: $(srcdir)/m2/gm2-compiler/%.mod $(MCDEPS) $(BUILD-BOOT-H)
+m2/gm2-pg-boot/$(SRC_PREFIX)%.o: $(srcdir)/m2/gm2-compiler/%.mod $(MCDEPS) $(BUILD-BOOT-PG-H)
-test -d m2/gm2-pg-boot || $(mkinstalldirs) m2/gm2-pg-boot
$(MCC) -o=m2/gm2-pg-boot/$(SRC_PREFIX)$*.c $(srcdir)/m2/gm2-compiler/$*.mod
$(CXX) -I. -I$(srcdir)/../include -I$(srcdir) -Im2/mc-boot -Im2/gm2-compiler-boot -Im2/gm2-libs-boot \
-I$(srcdir)/m2/mc-boot-ch $(INCLUDES) -g -c m2/gm2-pg-boot/$(SRC_PREFIX)$*.c -o $@
-m2/gm2-pg-boot/$(SRC_PREFIX)pg.o: m2/gm2-auto/pg.mod $(MCDEPS) $(BUILD-BOOT-H)
+m2/gm2-pg-boot/$(SRC_PREFIX)pg.o: m2/gm2-auto/pg.mod $(MCDEPS) $(BUILD-BOOT-PG-H)
-test -d m2/gm2-pg-boot || $(mkinstalldirs) m2/gm2-pg-boot
$(MCC) -o=m2/gm2-pg-boot/$(SRC_PREFIX)pg.c m2/gm2-auto/pg.mod
$(CXX) -I. -I$(srcdir)/../include -I$(srcdir) -Im2/mc-boot -Im2/gm2-compiler-boot -Im2/gm2-libs-boot \
@@ -227,6 +280,9 @@ BUILD-PGE-O = $(PPG-INTERFACE-C:%.c=m2/gm2-pge-boot/$(SRC_PREFIX)%.o) \
$(PPG-LIB-MODS:%.mod=m2/gm2-pge-boot/$(SRC_PREFIX)%.o) \
$(PGE-SRC:%.mod=m2/gm2-pge-boot/$(SRC_PREFIX)%.o)
+BUILD-BOOT-PGE-H: $(BUILD-BOOT-H) $(PGE-DEF:%.def=m2/gm2-pge-boot/$(SRC_PREFIX)%.h) \
+ m2/gm2-pge-boot/GM2RTS.h m2/gm2-pge-boot/GM2Dependent.h
+
m2/gm2-auto/pge.mod: m2/pg$(exeext)
-test -d m2/gm2-auto || $(mkinstalldirs) m2/gm2-auto
$(SHELL) $(srcdir)/m2/tools-src/buildpg $(srcdir)/m2/gm2-compiler/ppg.mod pge > m2/gm2-auto/pge.bnf
@@ -272,7 +328,7 @@ m2/gm2-pge-boot/$(SRC_PREFIX)wrapc.o: $(srcdir)/m2/mc-boot-ch/Gwrapc.c m2/gm2-l
-test -d m2/gm2-pge-boot || $(mkinstalldirs) m2/gm2-pge-boot
$(CXX) -I. -I$(srcdir)/../include -I$(srcdir) -I$(srcdir)/m2/mc-boot-ch -Im2/gm2-libs $(INCLUDES) -g -c $< -o $@
-m2/gm2-pge-boot/$(SRC_PREFIX)SYSTEM.o: $(srcdir)/m2/mc-boot-ch/GSYSTEM.c
+m2/gm2-pge-boot/$(SRC_PREFIX)SYSTEM.o: $(srcdir)/m2/mc-boot-ch/GSYSTEM.c $(BUILD-BOOT-PGE-H)
-test -d m2/gm2-pge-boot || $(mkinstalldirs) m2/gm2-pge-boot
$(CXX) -I. -I$(srcdir)/../include -I$(srcdir) -I$(srcdir)/m2/mc-boot-ch $(INCLUDES) -g -c $< -o $@
@@ -280,21 +336,21 @@ m2/gm2-pge-boot/$(SRC_PREFIX)errno.o: $(srcdir)/m2/mc-boot-ch/Gerrno.c
-test -d m2/gm2-pge-boot || $(mkinstalldirs) m2/gm2-pge-boot
$(CXX) -I. -I$(srcdir)/../include -I$(srcdir) -I$(srcdir)/m2/mc-boot-ch $(INCLUDES) -g -c $< -o $@
-m2/gm2-pge-boot/$(SRC_PREFIX)%.o: $(srcdir)/m2/gm2-libs/%.mod $(MCDEPS) $(BUILD-BOOT-H)
+m2/gm2-pge-boot/$(SRC_PREFIX)%.o: $(srcdir)/m2/gm2-libs/%.mod $(MCDEPS) $(BUILD-BOOT-PGE-H)
-test -d m2/gm2-pge-boot || $(mkinstalldirs) m2/gm2-pge-boot
$(MCC) -o=m2/gm2-pge-boot/$(SRC_PREFIX)$*.c $(srcdir)/m2/gm2-libs/$*.mod
$(CXX) -I. -I$(srcdir)/../include -I$(srcdir) -Im2/gm2-pge-boot -I$(srcdir)/m2/mc-boot \
-I$(srcdir)/m2/mc-boot-ch -Im2/gm2-libs-boot \
$(INCLUDES) -g -c m2/gm2-pge-boot/$(SRC_PREFIX)$*.c -o $@
-m2/gm2-pge-boot/$(SRC_PREFIX)%.o: $(srcdir)/m2/gm2-compiler/%.mod $(MCDEPS) $(BUILD-BOOT-H)
+m2/gm2-pge-boot/$(SRC_PREFIX)%.o: $(srcdir)/m2/gm2-compiler/%.mod $(MCDEPS) $(BUILD-BOOT-PGE-H)
-test -d m2/gm2-pge-boot || $(mkinstalldirs) m2/gm2-pge-boot
$(MCC) -o=m2/gm2-pge-boot/$(SRC_PREFIX)$*.c $(srcdir)/m2/gm2-compiler/$*.mod
$(CXX) -I. -I$(srcdir)/../include -I$(srcdir) -Im2/mc-boot -Im2/gm2-compiler-boot \
-Im2/gm2-libs-boot \
-I$(srcdir)/m2/mc-boot-ch $(INCLUDES) -g -c m2/gm2-pge-boot/$(SRC_PREFIX)$*.c -o $@
-m2/gm2-pge-boot/$(SRC_PREFIX)pge.o: m2/gm2-auto/pge.mod $(MCDEPS) $(BUILD-BOOT-H)
+m2/gm2-pge-boot/$(SRC_PREFIX)pge.o: m2/gm2-auto/pge.mod $(MCDEPS) $(BUILD-BOOT-PGE-H)
-test -d m2/gm2-pge-boot || $(mkinstalldirs) m2/gm2-pge-boot
$(MCC) -o=m2/gm2-pge-boot/$(SRC_PREFIX)pge.c m2/gm2-auto/pge.mod
$(CXX) -I. -I$(srcdir)/../include -I$(srcdir) \
@@ -409,8 +465,11 @@ MCLINK=-g # use -g -fmodules -c if you are debugging and wish to see missing
# This is only needed in maintainer mode by 'make mc-maintainer' when regenerating the C
# version of mc. We need a working Modula-2 compiler to run mc-maintainer.
-GM2SYS=${HOME}/opt/lib/gcc/x86_64-pc-linux-gnu/12.0.0/m2/m2pim
-GM2PATH=-I$(srcdir)/m2/mc -I$(GM2SYS) -I$(srcdir)/m2 -Im2/gm2-auto -I$(srcdir)/m2/gm2-libs -I$(srcdir)/m2/gm2-libs-iso
+# GM2SYS=${HOME}/opt/lib/gcc/x86_64-pc-linux-gnu/13.0.0/m2/m2pim
+GM2PATH=-I$(srcdir)/m2/mc \
+ -I$(srcdir)/m2 -Im2/gm2-auto \
+ -fm2-pathname=m2pim -I$(srcdir)/m2/gm2-libs -I$(srcdir)/m2/gm2-libs-ch \
+ -fm2-pathname=m2iso -I$(srcdir)/m2/gm2-libs-iso -fm2-pathname=-
mc: mc-clean mc-devel
@@ -479,7 +538,8 @@ m2/boot-bin/mc-devel$(exeext): m2/mc-obj/mcp1.mod \
m2/mc-obj/mcp4.mod \
m2/mc-obj/mcp5.mod \
mcflex.c \
- m2/mc-boot-ch/Gabort.o
+ m2/mc-boot-ch/Gabort.o \
+ m2/mc-boot-ch/Gm2rtsdummy.o
$(RM) -rf mc-obj
$(mkinstalldirs) mc-obj
$(CC) -I$(srcdir)/m2/mc -c -g mcflex.c -o mc-obj/mcflex.o
@@ -515,7 +575,8 @@ m2/boot-bin/mc-devel$(exeext): m2/mc-obj/mcp1.mod \
$(BOOTGM2) $(MCLINK) -I. -fscaffold-static -fscaffold-main $(GM2PATH) \
-fuse-list=$(srcdir)/m2/init/mcinit $(srcdir)/m2/mc/top.mod -o mc \
m2/gm2-libs-boot/RTcodummy.o \
- m2/gm2-libs-boot/dtoa.o m2/gm2-libs-boot/ldtoa.o mc-obj/*o m2/mc-boot-ch/Gabort.o
+ m2/gm2-libs-boot/dtoa.o m2/gm2-libs-boot/ldtoa.o mc-obj/*o \
+ m2/mc-boot-ch/Gabort.o m2/mc-boot-ch/Gm2rtsdummy.o
m2/boot-bin/mc-opt$(exeext): m2/mc-obj/mcp1.mod \
m2/mc-obj/mcp2.mod \
@@ -525,7 +586,7 @@ m2/boot-bin/mc-opt$(exeext): m2/mc-obj/mcp1.mod \
mcflex.c
-test -d m2/boot-bin || $(mkinstalldirs) m2/boot-bin
g++ -I$(srcdir)/m2/mc -c -g mcflex.c
- $(BOOTGM2) -fsources -fm2-whole-program -g -I$(srcdir)/m2/mc:$(objdir)/m2/mc-obj -I$(srcdir)/m2/gm2-libs -I$(srcdir)/m2/mc $(srcdir)/m2/mc/top.mod
+ $(BOOTGM2) -fsources -fm2-whole-program -g -I$(srcdir)/m2/mc -I$(objdir)/m2/mc-obj -I$(srcdir)/m2/gm2-libs -I$(srcdir)/m2/mc $(srcdir)/m2/mc/top.mod
m2/mc/decl.o: $(srcdir)/m2/mc/decl.mod
-test -d m2/mc || $(mkinstalldirs) m2/mc
diff --git a/gcc/m2/gm2-compiler/DynamicStringPath.def b/gcc/m2/gm2-compiler/DynamicPath.def
similarity index 73%
rename from gcc/m2/gm2-compiler/DynamicStringPath.def
rename to gcc/m2/gm2-compiler/DynamicPath.def
index e9fdff7ee14..f3bc85adaca 100644
--- a/gcc/m2/gm2-compiler/DynamicStringPath.def
+++ b/gcc/m2/gm2-compiler/DynamicPath.def
@@ -1,4 +1,4 @@
-(* DynamicStringPath.def implements a path for DynamicStrings.
+(* DynamicPath.def implements a path for DynamicStrings.
Copyright (C) 2001-2023 Free Software Foundation, Inc.
Contributed by Gaius Mulley <gaius.mulley@southwales.ac.uk>.
@@ -24,7 +24,7 @@ a copy of the GCC Runtime Library Exception along with this program;
see the files COPYING3 and COPYING.RUNTIME respectively. If not, see
<http://www.gnu.org/licenses/>. *)
-DEFINITION MODULE DynamicStringPath ; (*!m2iso+gm2*)
+DEFINITION MODULE DynamicPath ; (*!m2iso+gm2*)
FROM DynamicStrings IMPORT String ;
@@ -32,34 +32,6 @@ TYPE
PathList ;
-(*
- GetUserPath - returns the current UserPath.
-*)
-
-PROCEDURE GetUserPath () : PathList ;
-
-
-(*
- GetSystemPath - returns the current SystemPath.
-*)
-
-PROCEDURE GetSystemPath () : PathList ;
-
-
-(*
- SetUserPath - assigns UserPath to pl.
-*)
-
-PROCEDURE SetUserPath (pl: PathList) ;
-
-
-(*
- SetSystemPath - assigns SystemPath to pl.
-*)
-
-PROCEDURE SetSystemPath (pl: PathList) ;
-
-
(*
InitPathList - creates a new empty path list.
*)
@@ -86,10 +58,6 @@ PROCEDURE Cons (pl: PathList; str: String) : PathList ;
(*
ConsList - concatenates path list left and right together.
- It always returns NIL which should be assigned
- to the callers right parameter after ConsList
- has been completed signifying that right should
- no longer be accessed.
*)
PROCEDURE ConsList (left, right: PathList) : PathList ;
@@ -110,4 +78,11 @@ PROCEDURE Stash (VAR pl: PathList) : PathList ;
PROCEDURE FindFileName (filename: String; pl: PathList) : String ;
-END DynamicStringPath.
+(*
+ DumpPath - debugging dump of the pathlist.
+*)
+
+PROCEDURE DumpPath (name: String; pl: PathList) ;
+
+
+END DynamicPath.
diff --git a/gcc/m2/gm2-compiler/DynamicStringPath.mod b/gcc/m2/gm2-compiler/DynamicPath.mod
similarity index 72%
rename from gcc/m2/gm2-compiler/DynamicStringPath.mod
rename to gcc/m2/gm2-compiler/DynamicPath.mod
index 601456e0787..3eba52f5ffc 100644
--- a/gcc/m2/gm2-compiler/DynamicStringPath.mod
+++ b/gcc/m2/gm2-compiler/DynamicPath.mod
@@ -1,4 +1,4 @@
-(* DynamicStringPath.def implements a path for DynamicStrings.
+(* DynamicPath.mod implements a path for DynamicStrings.
Copyright (C) 2001-2023 Free Software Foundation, Inc.
Contributed by Gaius Mulley <gaius.mulley@southwales.ac.uk>.
@@ -24,11 +24,11 @@ a copy of the GCC Runtime Library Exception along with this program;
see the files COPYING3 and COPYING.RUNTIME respectively. If not, see
<http://www.gnu.org/licenses/>. *)
-IMPLEMENTATION MODULE DynamicStringPath ; (*!m2iso+gm2*)
+IMPLEMENTATION MODULE DynamicPath ; (*!m2iso+gm2*)
FROM Storage IMPORT ALLOCATE, DEALLOCATE ;
FROM DynamicStrings IMPORT InitString, ConCat, ConCatChar, char, Dup,
- KillString, Length ;
+ KillString, Length, EqualArray ;
FROM SFIO IMPORT Exists ;
FROM FIO IMPORT StdErr ;
FROM M2Printf IMPORT fprintf0, fprintf1 ;
@@ -46,51 +46,7 @@ TYPE
VAR
- FreeList,
- DefaultUserPath,
- DefaultSystemPath: PathList ;
-
-
-(*
- GetUserPath - returns the current UserPath.
-*)
-
-PROCEDURE GetUserPath () : PathList ;
-BEGIN
- RETURN DefaultUserPath
-END GetUserPath ;
-
-
-(*
- GetSystemPath - returns the current SystemPath.
-*)
-
-PROCEDURE GetSystemPath () : PathList ;
-BEGIN
- RETURN DefaultSystemPath
-END GetSystemPath ;
-
-
-(*
- SetUserPath - assigns UserPath to pl.
-*)
-
-PROCEDURE SetUserPath (pl: PathList) ;
-BEGIN
- DefaultUserPath := pl ;
- DumpPath ('DefaultUserPath', DefaultUserPath)
-END SetUserPath ;
-
-
-(*
- SetSystemPath - assigns SystemPath to pl.
-*)
-
-PROCEDURE SetSystemPath (pl: PathList) ;
-BEGIN
- DefaultSystemPath := pl ;
- DumpPath ('DefaultSystemPath', DefaultSystemPath)
-END SetSystemPath ;
+ FreeList: PathList ;
(*
@@ -148,10 +104,6 @@ END Cons ;
(*
ConsList - concatenates path list left and right together.
- It always returns NIL which should be assigned
- to the callers right parameter after ConsList
- has been completed signifying that right should
- no longer be accessed.
*)
PROCEDURE ConsList (left, right: PathList) : PathList ;
@@ -241,25 +193,19 @@ END FindFileName ;
DumpPath - debugging dump of the pathlist.
*)
-PROCEDURE DumpPath (name: ARRAY OF CHAR; pl: PathList) ;
+PROCEDURE DumpPath (name: String; pl: PathList) ;
BEGIN
- IF Debugging
- THEN
- fprintf0 (StdErr, name) ;
- fprintf0 (StdErr, ":") ;
- WHILE pl # NIL DO
- fprintf0 (StdErr, " {") ;
- fprintf1 (StdErr, "%s", pl^.entry) ;
- fprintf0 (StdErr, "}") ;
- pl := pl^.next
- END ;
- fprintf0 (StdErr, "\n")
- END
+ fprintf1 (StdErr, "%s:", name) ;
+ WHILE pl # NIL DO
+ fprintf0 (StdErr, " {") ;
+ fprintf1 (StdErr, "%s", pl^.entry) ;
+ fprintf0 (StdErr, "}") ;
+ pl := pl^.next
+ END ;
+ fprintf0 (StdErr, "\n")
END DumpPath ;
BEGIN
- DefaultSystemPath := NIL ;
- DefaultUserPath := NIL ;
FreeList := NIL
-END DynamicStringPath.
+END DynamicPath.
diff --git a/gcc/m2/gm2-compiler/M2AsmUtil.mod b/gcc/m2/gm2-compiler/M2AsmUtil.mod
index da4241468a5..85bbceba3ea 100644
--- a/gcc/m2/gm2-compiler/M2AsmUtil.mod
+++ b/gcc/m2/gm2-compiler/M2AsmUtil.mod
@@ -24,14 +24,15 @@ IMPLEMENTATION MODULE M2AsmUtil ;
FROM SFIO IMPORT WriteS ;
FROM FIO IMPORT StdOut ;
-FROM DynamicStrings IMPORT String, string, ConCat, KillString, InitString, Mark, InitStringCharStar, ConCatChar ;
+FROM DynamicStrings IMPORT String, string, ConCat, KillString, InitString, Mark, InitStringCharStar, ConCatChar, EqualArray ;
FROM StdIO IMPORT Write ;
FROM StrIO IMPORT WriteString ;
-FROM NameKey IMPORT WriteKey, GetKey, MakeKey, makekey, KeyToCharStar ;
+FROM NameKey IMPORT WriteKey, GetKey, MakeKey, makekey, KeyToCharStar, NulName ;
FROM M2Options IMPORT WholeProgram ;
+FROM M2Printf IMPORT printf1 ;
FROM SymbolTable IMPORT NulSym,
- GetSymName,
+ GetSymName, GetLibName,
GetScope,
GetBaseModule,
IsInnerModule,
@@ -47,6 +48,10 @@ FROM M2Error IMPORT InternalError ;
FROM m2configure IMPORT UseUnderscoreForC ;
+CONST
+ Debugging = FALSE ;
+
+
(*
StringToKey - returns a Name, from a string and destroys the string.
*)
@@ -97,8 +102,10 @@ END GetFullScopeAsmName ;
PROCEDURE GetFullSymName (sym: CARDINAL) : Name ;
VAR
- module: String ;
- scope : CARDINAL ;
+ libname,
+ fullsymname,
+ module : String ;
+ scope : CARDINAL ;
BEGIN
IF IsProcedure (sym) AND IsMonoName (sym)
THEN
@@ -106,7 +113,34 @@ BEGIN
ELSE
scope := GetScope (sym) ;
module := GetModulePrefix (InitString (''), sym, scope) ;
- RETURN StringToKey (ConCat (module, InitStringCharStar (KeyToCharStar (GetSymName (sym)))))
+ fullsymname := ConCat (module, InitStringCharStar (KeyToCharStar (GetSymName (sym)))) ;
+ IF (IsVar (sym) OR IsProcedure (sym)) AND IsExportQualified (sym)
+ THEN
+ WHILE NOT IsDefImp (scope) DO
+ scope := GetScope (scope)
+ END ;
+ IF GetLibName (scope) # NulName
+ THEN
+ IF Debugging
+ THEN
+ printf1 ("before sym = %s , ", fullsymname)
+ END ;
+ libname := InitStringCharStar (KeyToCharStar (GetLibName (scope))) ;
+ IF NOT EqualArray (libname, '')
+ THEN
+ IF Debugging
+ THEN
+ printf1 ("libname = %s , ", libname)
+ END ;
+ fullsymname := ConCat (ConCatChar (libname, '_'), fullsymname) ;
+ END ;
+ IF Debugging
+ THEN
+ printf1 ("after sym = %s\n", fullsymname)
+ END
+ END
+ END ;
+ RETURN StringToKey (fullsymname)
END
END GetFullSymName ;
diff --git a/gcc/m2/gm2-compiler/M2Comp.mod b/gcc/m2/gm2-compiler/M2Comp.mod
index 3c2c3643b18..a2a7797397d 100644
--- a/gcc/m2/gm2-compiler/M2Comp.mod
+++ b/gcc/m2/gm2-compiler/M2Comp.mod
@@ -59,14 +59,17 @@ FROM M2Batch IMPORT GetSource, GetModuleNo, GetDefinitionModuleFile, GetModuleFi
FROM SymbolTable IMPORT GetSymName, IsDefImp, NulSym,
IsHiddenTypeDeclared, GetFirstUsed, GetMainModule, SetMainModule,
ResolveConstructorTypes, SanityCheckConstants, IsDefinitionForC,
- IsBuiltinInModule, PutModLink, IsDefLink, IsModLink ;
+ IsBuiltinInModule, PutModLink, IsDefLink, IsModLink,
+ PutLibName ;
FROM FIO IMPORT StdErr, StdOut ;
FROM NameKey IMPORT Name, GetKey, KeyToCharStar, makekey ;
FROM M2Printf IMPORT fprintf1 ;
FROM M2Quiet IMPORT qprintf0, qprintf1, qprintf2 ;
-FROM DynamicStrings IMPORT String, InitString, KillString, InitStringCharStar, Dup, Mark, string ;
-FROM M2Options IMPORT Verbose ;
+FROM DynamicStrings IMPORT String, InitString, KillString, InitStringCharStar, Dup, Mark, EqualArray, string ;
+FROM M2Options IMPORT Verbose, GetM2Prefix ;
+FROM PathName IMPORT DumpPathName ;
+
CONST
Debugging = FALSE ;
@@ -225,6 +228,19 @@ BEGIN
END PeepInto ;
+(*
+ qprintLibName - print the libname
+*)
+
+PROCEDURE qprintLibName (LibName: String) ;
+BEGIN
+ IF (LibName # NIL) AND (NOT EqualArray (LibName, ''))
+ THEN
+ qprintf1 (' [%s]', LibName)
+ END
+END qprintLibName ;
+
+
(*
DoPass0 -
*)
@@ -236,6 +252,7 @@ VAR
i : CARDINAL ;
SymName,
FileName,
+ LibName,
PPSource: String ;
BEGIN
P0Init ;
@@ -251,27 +268,34 @@ BEGIN
i := 1 ;
Sym := GetModuleNo(i) ;
qprintf1('Compiling: %s\n', PPSource) ;
+ IF Debugging
+ THEN
+ DumpPathName ('DoPass0')
+ END ;
IF Verbose
THEN
- fprintf1(StdOut, 'Compiling: %s\n', PPSource) ;
+ fprintf1 (StdOut, 'Compiling: %s\n', PPSource)
END ;
qprintf0('Pass 0: lexical analysis, parsing, modules and associated filenames\n') ;
WHILE Sym#NulSym DO
- SymName := InitStringCharStar(KeyToCharStar(GetSymName(Sym))) ;
- IF IsDefImp(Sym)
+ SymName := InitStringCharStar (KeyToCharStar (GetSymName (Sym))) ;
+ IF IsDefImp (Sym)
THEN
- IF FindSourceDefFile(SymName, FileName)
+ LibName := NIL ;
+ IF FindSourceDefFile (SymName, FileName, LibName)
THEN
ModuleType := Definition ;
- IF OpenSource(AssociateDefinition(PreprocessModule(FileName, FALSE), Sym))
+ IF OpenSource (AssociateDefinition (PreprocessModule (FileName, FALSE), Sym))
THEN
- IF NOT P0SyntaxCheck.CompilationUnit()
+ IF NOT P0SyntaxCheck.CompilationUnit ()
THEN
- WriteFormat0('compilation failed') ;
+ WriteFormat0 ('compilation failed') ;
CloseSource ;
RETURN
END ;
qprintf2 (' Module %-20s : %s', SymName, FileName) ;
+ qprintLibName (LibName) ;
+ PutLibName (Sym, makekey (string (LibName))) ;
IF IsDefinitionForC (Sym)
THEN
qprintf0 (' (for C)')
@@ -298,13 +322,17 @@ BEGIN
IF (Main=Sym) OR NeedToParseImplementation(Sym)
THEN
(* only need to read implementation module if hidden types are declared or it is the main module *)
+ LibName := NIL ;
IF Main=Sym
THEN
- FileName := Dup (PPSource)
+ FileName := Dup (PPSource) ;
+ LibName := InitStringCharStar (GetM2Prefix ()) ;
+ PutLibName (Sym, makekey (string (LibName)))
ELSE
- IF FindSourceModFile (SymName, FileName)
+ IF FindSourceModFile (SymName, FileName, LibName)
THEN
- FileName := PreprocessModule (FileName, FALSE)
+ FileName := PreprocessModule (FileName, FALSE) ;
+ PutLibName (Sym, makekey (string (LibName)))
END
END ;
IF FileName#NIL
@@ -318,6 +346,7 @@ BEGIN
RETURN
END ;
qprintf2 (' Module %-20s : %s', SymName, FileName) ;
+ qprintLibName (LibName) ;
IF IsModLink (Sym)
THEN
qprintf0 (' (linking)')
@@ -343,9 +372,13 @@ BEGIN
THEN
(* The implementation is only useful if -fgen-module-list= is
used and we do not insist upon it. *)
- IF FindSourceModFile (SymName, FileName)
+ LibName := NIL ;
+ IF FindSourceModFile (SymName, FileName, LibName)
THEN
- qprintf2 (' Module %-20s : %s (linking)\n', SymName, FileName) ;
+ PutLibName (Sym, makekey (string (LibName))) ;
+ qprintf2 (' Module %-20s : %s' , SymName, FileName) ;
+ qprintLibName (LibName) ;
+ qprintf0 (' (linking)\n') ;
IF OpenSource (AssociateModule (PreprocessModule (FileName, FALSE), Sym))
THEN
PutModLink (Sym, TRUE) ; (* This source is only used to determine link time info. *)
@@ -362,6 +395,7 @@ BEGIN
END ;
SymName := KillString (SymName) ;
FileName := KillString (FileName) ;
+ LibName := KillString (LibName) ;
INC (i) ;
Sym := GetModuleNo (i)
END ;
diff --git a/gcc/m2/gm2-compiler/M2Graph.mod b/gcc/m2/gm2-compiler/M2Graph.mod
index 7140d285a81..f574981f5fc 100644
--- a/gcc/m2/gm2-compiler/M2Graph.mod
+++ b/gcc/m2/gm2-compiler/M2Graph.mod
@@ -29,8 +29,8 @@ FROM StrIO IMPORT WriteString, WriteLn ;
FROM NameKey IMPORT Name, WriteKey ;
FROM Lists IMPORT InitList, KillList, IncludeItemIntoList, RemoveItemFromList ;
FROM Indexing IMPORT Index, HighIndice, IncludeIndiceIntoIndex, InitIndex, KillIndex, GetIndice ;
-FROM M2Printf IMPORT printf0, printf1, printf2 ;
-FROM SymbolTable IMPORT GetSymName, IsDefinitionForC, IsModule ;
+FROM M2Printf IMPORT printf0, printf1, printf2, printf3 ;
+FROM SymbolTable IMPORT GetSymName, GetLibName, IsDefinitionForC, IsModule ;
CONST
@@ -189,18 +189,20 @@ END SortGraph ;
PROCEDURE resolveImports (sorted: List; nptr: node) ;
VAR
- i, n: CARDINAL ;
- name: Name ;
+ i, n: CARDINAL ;
+ libname,
+ name : Name ;
BEGIN
IF nptr^.nstate = initial
THEN
nptr^.nstate := started ;
name := GetSymName (nptr^.moduleSym) ;
+ libname := GetLibName (nptr^.moduleSym) ;
i := 1 ;
n := HighIndice (nptr^.deps) ;
IF Debugging
THEN
- printf2 ("resolving %a %d dependents\n", name, n)
+ printf3 ("resolving %a [%a] %d dependents\n", name, libname, n)
END ;
WHILE i <= n DO
resolveImports (sorted, GetIndice (nptr^.deps, i)) ;
diff --git a/gcc/m2/gm2-compiler/M2Options.def b/gcc/m2/gm2-compiler/M2Options.def
index dd269843005..67b92fa46f6 100644
--- a/gcc/m2/gm2-compiler/M2Options.def
+++ b/gcc/m2/gm2-compiler/M2Options.def
@@ -94,7 +94,8 @@ EXPORT QUALIFIED SetReturnCheck, SetNilCheck, SetCaseCheck,
SetRuntimeModuleOverride, GetRuntimeModuleOverride,
SetGenModuleList, GetGenModuleFilename, SharedFlag,
SetB, GetB, SetMD, GetMD, SetMMD, GetMMD, SetObj, GetObj,
- GetMQ, SetMQ ;
+ GetMQ, SetMQ, SetM2Prefix, GetM2Prefix,
+ SetM2PathName, GetM2PathName ;
VAR
@@ -177,6 +178,35 @@ VAR
Coding,
Profiling : BOOLEAN ;
+
+(*
+ SetM2Prefix - assign arg to M2Prefix.
+*)
+
+PROCEDURE SetM2Prefix (arg: ADDRESS) ;
+
+
+(*
+ GetM2Prefix - return M2Prefix as a C string.
+*)
+
+PROCEDURE GetM2Prefix () : ADDRESS ;
+
+
+(*
+ SetM2PathName - assign arg to M2PathName.
+*)
+
+PROCEDURE SetM2PathName (arg: ADDRESS) ;
+
+
+(*
+ GetM2PathName - return M2PathName as a C string.
+*)
+
+PROCEDURE GetM2PathName () : ADDRESS ;
+
+
(*
SetPPOnly - set the PPonly to value (on E, M, MM).
*)
diff --git a/gcc/m2/gm2-compiler/M2Options.mod b/gcc/m2/gm2-compiler/M2Options.mod
index 865b8578367..95dc6070330 100644
--- a/gcc/m2/gm2-compiler/M2Options.mod
+++ b/gcc/m2/gm2-compiler/M2Options.mod
@@ -25,7 +25,7 @@ IMPLEMENTATION MODULE M2Options ;
IMPORT CmdArgs ;
FROM SArgs IMPORT GetArg, Narg ;
FROM M2Search IMPORT SetDefExtension, SetModExtension ;
-FROM DynamicStringPath IMPORT Cons, GetUserPath, SetUserPath, Cons ;
+FROM PathName IMPORT DumpPathName, AddInclude ;
FROM M2Printf IMPORT printf0, printf1, fprintf1 ;
FROM FIO IMPORT StdErr ;
FROM libc IMPORT exit ;
@@ -33,6 +33,7 @@ FROM Debug IMPORT Halt ;
FROM m2linemap IMPORT location_t ;
FROM m2configure IMPORT FullPathCPP ;
+
FROM DynamicStrings IMPORT String, Length, InitString, Mark, Slice, EqualArray,
InitStringCharStar, ConCatChar, ConCat, KillString,
Dup, string,
@@ -51,8 +52,11 @@ FROM DynamicStrings IMPORT String, Length, InitString, Mark, Slice, EqualArray,
CONST
Debugging = FALSE ;
+ DefaultRuntimeModuleOverride = "m2iso:RTentity,m2iso:Storage,m2iso:SYSTEM,m2iso:M2RTS,m2iso:RTExceptions,m2iso:IOLink" ;
VAR
+ M2Prefix,
+ M2PathName,
Barg,
MDarg,
MMDarg,
@@ -116,6 +120,49 @@ END DSdbExit ;
*)
+(*
+ SetM2Prefix - assign arg to M2Prefix.
+*)
+
+PROCEDURE SetM2Prefix (arg: ADDRESS) ;
+BEGIN
+ M2Prefix := KillString (M2Prefix) ;
+ M2Prefix := InitStringCharStar (arg)
+END SetM2Prefix ;
+
+
+(*
+ GetM2Prefix - return M2Prefix as a C string.
+*)
+
+PROCEDURE GetM2Prefix () : ADDRESS ;
+BEGIN
+ RETURN string (M2Prefix)
+END GetM2Prefix ;
+
+
+(*
+ SetM2PathName - assign arg to M2PathName.
+*)
+
+PROCEDURE SetM2PathName (arg: ADDRESS) ;
+BEGIN
+ M2PathName := KillString (M2PathName) ;
+ M2PathName := InitStringCharStar (arg) ;
+ (* fprintf1 (StdErr, "M2PathName = %s\n", M2PathName) *)
+END SetM2PathName ;
+
+
+(*
+ GetM2PathName - return M2PathName as a C string.
+*)
+
+PROCEDURE GetM2PathName () : ADDRESS ;
+BEGIN
+ RETURN string (M2PathName)
+END GetM2PathName ;
+
+
(*
SetB - assigns Barg to arg.
*)
@@ -900,12 +947,12 @@ PROCEDURE SetSearchPath (arg: ADDRESS) ;
VAR
s: String ;
BEGIN
- s := InitStringCharStar(arg) ;
+ s := InitStringCharStar (arg) ;
+ AddInclude (M2PathName, s) ;
IF Debugging
THEN
- fprintf1 (StdErr, "M2Search.SetSearchPath setting search path to: %s\n", s)
+ DumpPathName ("path name entries: ")
END ;
- SetUserPath (Cons (GetUserPath (), s)) ;
s := KillString (s)
END SetSearchPath ;
@@ -1315,7 +1362,7 @@ END SetShared ;
BEGIN
cflag := FALSE ; (* -c. *)
- RuntimeModuleOverride := NIL ;
+ RuntimeModuleOverride := InitString (DefaultRuntimeModuleOverride) ;
CppArgs := InitString ('') ;
Pim := TRUE ;
Pim2 := FALSE ;
@@ -1382,5 +1429,7 @@ BEGIN
MMDarg := NIL ;
MQarg := NIL ;
SaveTempsDir := NIL ;
- DumpDir := NIL
+ DumpDir := NIL ;
+ M2Prefix := InitString ('') ;
+ M2PathName := InitString ('')
END M2Options.
diff --git a/gcc/m2/gm2-compiler/M2Quads.mod b/gcc/m2/gm2-compiler/M2Quads.mod
index 17062b9a278..3802b99b443 100644
--- a/gcc/m2/gm2-compiler/M2Quads.mod
+++ b/gcc/m2/gm2-compiler/M2Quads.mod
@@ -126,7 +126,7 @@ FROM SymbolTable IMPORT ModeOfAddr, GetMode, PutMode, GetSymName, IsUnknown,
GetUnboundedHighOffset,
ForeachFieldEnumerationDo, ForeachLocalSymDo,
- GetExported, PutImported, GetSym,
+ GetExported, PutImported, GetSym, GetLibName,
IsUnused,
NulSym ;
@@ -2259,7 +2259,8 @@ END SafeRequestSym ;
(*
callRequestDependant - create a call:
- RequestDependant (GetSymName (modulesym), GetSymName (depModuleSym));
+ RequestDependant (GetSymName (modulesym), GetLibName (modulesym),
+ GetSymName (depModuleSym), GetLibName (depModuleSym));
*)
PROCEDURE callRequestDependant (tokno: CARDINAL;
@@ -2273,17 +2274,28 @@ BEGIN
PushT (1) ;
BuildAdrFunction ;
+ PushTF (Adr, Address) ;
+ PushTtok (MakeConstLitString (tokno, GetLibName (moduleSym)), tokno) ;
+ PushT (1) ;
+ BuildAdrFunction ;
+
IF depModuleSym = NulSym
THEN
+ PushTF (Nil, Address) ;
PushTF (Nil, Address)
ELSE
PushTF (Adr, Address) ;
PushTtok (MakeConstLitString (tokno, GetSymName (depModuleSym)), tokno) ;
PushT (1) ;
+ BuildAdrFunction ;
+
+ PushTF (Adr, Address) ;
+ PushTtok (MakeConstLitString (tokno, GetLibName (depModuleSym)), tokno) ;
+ PushT (1) ;
BuildAdrFunction
END ;
- PushT (2) ;
+ PushT (4) ;
BuildProcedureCall (tokno)
END callRequestDependant ;
@@ -2344,8 +2356,8 @@ END ForeachImportedModuleDo ;
static void
dependencies (void)
{
- M2RTS_RequestDependant (module_name, "b");
- M2RTS_RequestDependant (module_name, NULL);
+ M2RTS_RequestDependant (module_name, libname, "b", "b libname");
+ M2RTS_RequestDependant (module_name, libname, NULL, NULL);
}
*)
@@ -2519,7 +2531,7 @@ BEGIN
(* int
_M2_init (int argc, char *argv[], char *envp[])
{
- M2RTS_ConstructModules (module_name, argc, argv, envp);
+ M2RTS_ConstructModules (module_name, libname, argc, argv, envp);
} *)
PushT (initFunction) ;
BuildProcedureStart ;
@@ -2549,10 +2561,15 @@ BEGIN
PushT(1) ;
BuildAdrFunction ;
+ PushTF(Adr, Address) ;
+ PushTtok (MakeConstLitString (tok, GetLibName (moduleSym)), tok) ;
+ PushT(1) ;
+ BuildAdrFunction ;
+
PushTtok (SafeRequestSym (tok, MakeKey ("argc")), tok) ;
PushTtok (SafeRequestSym (tok, MakeKey ("argv")), tok) ;
PushTtok (SafeRequestSym (tok, MakeKey ("envp")), tok) ;
- PushT (4) ;
+ PushT (5) ;
BuildProcedureCall (tok) ;
END
ELSIF ScaffoldStatic
@@ -2604,10 +2621,15 @@ BEGIN
PushT(1) ;
BuildAdrFunction ;
+ PushTF(Adr, Address) ;
+ PushTtok (MakeConstLitString (tok, GetLibName (moduleSym)), tok) ;
+ PushT(1) ;
+ BuildAdrFunction ;
+
PushTtok (SafeRequestSym (tok, MakeKey ("argc")), tok) ;
PushTtok (SafeRequestSym (tok, MakeKey ("argv")), tok) ;
PushTtok (SafeRequestSym (tok, MakeKey ("envp")), tok) ;
- PushT (4) ;
+ PushT (5) ;
BuildProcedureCall (tok)
END
ELSIF ScaffoldStatic
@@ -2630,7 +2652,7 @@ END BuildM2FiniFunction ;
void
ctorFunction ()
{
- M2RTS_RegisterModule (GetSymName (moduleSym),
+ M2RTS_RegisterModule (GetSymName (moduleSym), GetLibName (moduleSym),
init, fini, dependencies);
}
*)
@@ -2663,10 +2685,15 @@ BEGIN
PushT (1) ;
BuildAdrFunction ;
+ PushTF (Adr, Address) ;
+ PushTtok (MakeConstLitString (tok, GetLibName (moduleSym)), tok) ;
+ PushT (1) ;
+ BuildAdrFunction ;
+
PushTtok (init, tok) ;
PushTtok (fini, tok) ;
PushTtok (dep, tok) ;
- PushT (4) ;
+ PushT (5) ;
BuildProcedureCall (tok)
END ;
EndScope ;
diff --git a/gcc/m2/gm2-compiler/M2Scaffold.mod b/gcc/m2/gm2-compiler/M2Scaffold.mod
index a2a625005b3..c0f0efd6bb7 100644
--- a/gcc/m2/gm2-compiler/M2Scaffold.mod
+++ b/gcc/m2/gm2-compiler/M2Scaffold.mod
@@ -35,7 +35,8 @@ FROM SymbolTable IMPORT NulSym, MakeProcedure, PutFunction,
GetSymName, StartScope, EndScope,
GetModuleDefImportStatementList,
GetModuleModImportStatementList,
- GetImportModule, GetImportStatementList ;
+ GetImportModule, GetImportStatementList,
+ PutLibName ;
FROM NameKey IMPORT NulName, Name, MakeKey, makekey, KeyToCharStar ;
FROM M2Base IMPORT Integer, Cardinal ;
@@ -44,9 +45,11 @@ FROM M2LexBuf IMPORT GetTokenNo ;
FROM Assertion IMPORT Assert ;
FROM Lists IMPORT List, InitList, IncludeItemIntoList, NoOfItemsInList, GetItemFromList, KillList, IsItemInList ;
FROM M2MetaError IMPORT MetaErrorT0, MetaErrorStringT0 ;
+FROM M2Search IMPORT FindSourceDefFile ;
FROM SFIO IMPORT OpenToWrite, WriteS, ReadS, OpenToRead, Exists ;
FROM FIO IMPORT File, EOF, IsNoError, Close ;
+FROM FormatStrings IMPORT Sprintf1 ;
FROM M2Options IMPORT GetUselist, ScaffoldStatic, ScaffoldDynamic, GenModuleList,
GetGenModuleFilename, GetUselistFilename, GetUselist, cflag,
@@ -84,14 +87,14 @@ VAR
static void _M2_init (int argc, char *argv[], char *envp[])
{
- M2RTS_ConstructModules (module_name, argc, argv, envp);
+ M2RTS_ConstructModules (module_name, libname, argc, argv, envp);
}
static void _M2_fini (int argc, char *argv[], char *envp[])
{
M2RTS_Terminate ();
- M2RTS_DeconstructModules (module_name, argc, argv, envp);
+ M2RTS_DeconstructModules (module_name, libname, argc, argv, envp);
}
@@ -244,16 +247,29 @@ END PopulateCtorArray ;
PROCEDURE LookupModuleSym (tok: CARDINAL; name: Name) : CARDINAL ;
VAR
- sym: CARDINAL ;
+ sym : CARDINAL ;
+ FileName,
+ LibName : String ;
BEGIN
sym := Get (name) ;
IF sym = NulSym
THEN
- sym := MakeDefImp (tok, name)
- END ;
- IF sym # GetMainModule ()
- THEN
- PutModuleCtorExtern (tok, sym, NOT WholeProgram)
+ LibName := NIL ;
+ FileName := NIL ;
+ IF FindSourceDefFile (InitStringCharStar (KeyToCharStar (name)),
+ FileName, LibName)
+ THEN
+ sym := MakeDefImp (tok, name) ;
+ PutLibName (sym, makekey (string (LibName))) ;
+ IF sym # GetMainModule ()
+ THEN
+ PutModuleCtorExtern (tok, sym, NOT WholeProgram)
+ END
+ ELSE
+ MetaErrorStringT0 (tok,
+ Sprintf1 (InitString ('the definition module file for {%%1a} cannot be found'),
+ name))
+ END
END ;
RETURN sym
END LookupModuleSym ;
diff --git a/gcc/m2/gm2-compiler/M2Search.def b/gcc/m2/gm2-compiler/M2Search.def
index 3d172378cf5..e77c75477ee 100644
--- a/gcc/m2/gm2-compiler/M2Search.def
+++ b/gcc/m2/gm2-compiler/M2Search.def
@@ -42,11 +42,13 @@ FROM DynamicStrings IMPORT String ;
FullPath will be totally overwritten and should
not be initialized by InitString before this function
is called.
+ FullPath is set to NIL if this function returns FALSE.
FindSourceFile sets FullPath to a new string if successful.
+ The string FileName is not altered.
*)
PROCEDURE FindSourceFile (FileName: String;
- VAR FullPath: String) : BOOLEAN ;
+ VAR FullPath, named: String) : BOOLEAN ;
(*
@@ -56,7 +58,7 @@ PROCEDURE FindSourceFile (FileName: String;
then FALSE is returned and FullPath is set to NIL.
*)
-PROCEDURE FindSourceDefFile (Stem: String; VAR FullPath: String) : BOOLEAN ;
+PROCEDURE FindSourceDefFile (Stem: String; VAR FullPath, named: String) : BOOLEAN ;
(*
@@ -66,7 +68,7 @@ PROCEDURE FindSourceDefFile (Stem: String; VAR FullPath: String) : BOOLEAN ;
then FALSE is returned and FullPath is set to NIL.
*)
-PROCEDURE FindSourceModFile (Stem: String; VAR FullPath: String) : BOOLEAN ;
+PROCEDURE FindSourceModFile (Stem: String; VAR FullPath, named: String) : BOOLEAN ;
(*
@@ -87,4 +89,6 @@ PROCEDURE SetDefExtension (ext: String) ;
PROCEDURE SetModExtension (ext: String) ;
+
+
END M2Search.
diff --git a/gcc/m2/gm2-compiler/M2Search.mod b/gcc/m2/gm2-compiler/M2Search.mod
index 9c78c800f6f..80806bf8084 100644
--- a/gcc/m2/gm2-compiler/M2Search.mod
+++ b/gcc/m2/gm2-compiler/M2Search.mod
@@ -24,7 +24,7 @@ IMPLEMENTATION MODULE M2Search ;
FROM M2FileName IMPORT CalculateFileName ;
FROM Assertion IMPORT Assert ;
-FROM DynamicStringPath IMPORT GetUserPath, GetSystemPath, FindFileName ;
+FROM PathName IMPORT FindNamedPathFile ;
FROM DynamicStrings IMPORT InitString, InitStringChar,
KillString, ConCat, ConCatChar, Index, Slice,
@@ -55,7 +55,9 @@ VAR
(*
doDSdbEnter - called when compiled with -fcpp to enable runtime garbage
collection debugging.
+*)
+(*
PROCEDURE doDSdbEnter ;
BEGIN
PushAllocation
@@ -67,7 +69,9 @@ END doDSdbEnter ;
doDSdbExit - called when compiled with -fcpp to enable runtime garbage
collection debugging. The parameter string s is exempt from
garbage collection analysis.
+*)
+(*
PROCEDURE doDSdbExit (s: String) ;
BEGIN
(* Check to see whether no strings have been lost since the PushAllocation. *)
@@ -120,17 +124,13 @@ END DSdbExit ;
is called.
FullPath is set to NIL if this function returns FALSE.
FindSourceFile sets FullPath to a new string if successful.
- The string, FileName, is not altered.
+ The string FileName is not altered.
*)
PROCEDURE FindSourceFile (FileName: String;
- VAR FullPath: String) : BOOLEAN ;
+ VAR FullPath, named: String) : BOOLEAN ;
BEGIN
- FullPath := FindFileName (FileName, GetUserPath ()) ;
- IF FullPath = NIL
- THEN
- FullPath := FindFileName (FileName, GetSystemPath ())
- END ;
+ FullPath := FindNamedPathFile (FileName, named) ;
RETURN FullPath # NIL
END FindSourceFile ;
@@ -142,22 +142,22 @@ END FindSourceFile ;
then FALSE is returned and FullPath is set to NIL.
*)
-PROCEDURE FindSourceDefFile (Stem: String; VAR FullPath: String) : BOOLEAN ;
+PROCEDURE FindSourceDefFile (Stem: String; VAR FullPath, named: String) : BOOLEAN ;
VAR
f: String ;
BEGIN
IF Def # NIL
THEN
f := CalculateFileName (Stem, Def) ;
- IF FindSourceFile (f, FullPath)
+ IF FindSourceFile (f, FullPath, named)
THEN
RETURN TRUE
END ;
f := KillString (f)
END ;
(* Try the GNU Modula-2 default extension. *)
- f := CalculateFileName (Stem, Mark(InitString ('def'))) ;
- RETURN FindSourceFile (f, FullPath)
+ f := CalculateFileName (Stem, Mark (InitString ('def'))) ;
+ RETURN FindSourceFile (f, FullPath, named)
END FindSourceDefFile ;
@@ -168,22 +168,22 @@ END FindSourceDefFile ;
then FALSE is returned and FullPath is set to NIL.
*)
-PROCEDURE FindSourceModFile (Stem: String; VAR FullPath: String) : BOOLEAN ;
+PROCEDURE FindSourceModFile (Stem: String; VAR FullPath, named: String) : BOOLEAN ;
VAR
f: String ;
BEGIN
IF Mod#NIL
THEN
f := CalculateFileName (Stem, Mod) ;
- IF FindSourceFile (f, FullPath)
+ IF FindSourceFile (f, FullPath, named)
THEN
RETURN TRUE
END ;
f := KillString (f)
END ;
(* Try the GNU Modula-2 default extension. *)
- f := CalculateFileName (Stem, Mark(InitString ('mod'))) ;
- RETURN FindSourceFile (f, FullPath)
+ f := CalculateFileName (Stem, Mark (InitString ('mod'))) ;
+ RETURN FindSourceFile (f, FullPath, named)
END FindSourceModFile ;
@@ -195,8 +195,8 @@ END FindSourceModFile ;
PROCEDURE SetDefExtension (ext: String) ;
BEGIN
- Def := KillString(Def) ;
- Def := Dup(ext)
+ Def := KillString (Def) ;
+ Def := Dup (ext)
END SetDefExtension ;
@@ -208,8 +208,8 @@ END SetDefExtension ;
PROCEDURE SetModExtension (ext: String) ;
BEGIN
- Mod := KillString(Mod) ;
- Mod := Dup(ext)
+ Mod := KillString (Mod) ;
+ Mod := Dup (ext)
END SetModExtension ;
diff --git a/gcc/m2/gm2-compiler/PathName.def b/gcc/m2/gm2-compiler/PathName.def
new file mode 100644
index 00000000000..39d9b15bb3a
--- /dev/null
+++ b/gcc/m2/gm2-compiler/PathName.def
@@ -0,0 +1,104 @@
+DEFINITION MODULE PathName ;
+
+(*
+ Title : PathName
+ Author : Gaius Mulley
+ System : GNU Modula-2
+ Date : Wed Feb 8 09:59:46 2023
+ Revision : $Version$
+ Description: maintains a dictionary of named paths.
+*)
+
+FROM DynamicStrings IMPORT String ;
+FROM DynamicPath IMPORT PathList ;
+
+
+TYPE
+ NamedPath ;
+
+
+(*
+ FindNamedPathFile - returns NIL if a file cannot be found otherwise
+ it returns the path including the filename.
+ It also returns the name of the path.
+*)
+
+PROCEDURE FindNamedPathFile (filename: String; VAR name: String) : String ;
+
+
+(*
+ AddInclude - adds include path to the named path. If named path
+ is the same as the previous call then the include path
+ is appended to the named path PathList otherwise a new
+ named path is created and placed at the end of the
+ named path list.
+
+ However if named is NIL or empty string then this is treated
+ as a user path and it will be appended to the first user
+ named list entry. The user entry will always be the
+ first node in the dictionary of named paths.
+*)
+
+PROCEDURE AddInclude (named, directory: String) ;
+
+
+(*
+ InitNamedPath - creates a new path name with an associated pathlist.
+*)
+
+PROCEDURE InitNamedPath (name: String; pl: PathList) : NamedPath ;
+
+
+(*
+ KillNamedPath - places list np onto the freelist.
+ Postcondition: np will be NIL.
+*)
+
+PROCEDURE KillNamedPath (VAR np: NamedPath) ;
+
+
+(*
+ Cons - appends pl to the end of a named path.
+ If np is NIL a new list is created and returned
+ containing named and pl.
+*)
+
+PROCEDURE Cons (np: NamedPath; named: String; pl: PathList) : NamedPath ;
+
+
+(*
+ ConsList - concatenates named path left and right together.
+*)
+
+PROCEDURE ConsList (left, right: NamedPath) : NamedPath ;
+
+
+(*
+ Stash - returns np before setting np to NIL.
+*)
+
+PROCEDURE Stash (VAR np: NamedPath) : NamedPath ;
+
+
+(*
+ SetNamedPath - assigns the named path to the default path.
+*)
+
+PROCEDURE SetNamedPath (named: NamedPath) ;
+
+
+(*
+ GetNamedPath - returns the default named path.
+*)
+
+PROCEDURE GetNamedPath () : NamedPath ;
+
+
+(*
+ DumpPathName - display the dictionary of names and all path entries.
+*)
+
+PROCEDURE DumpPathName (name: ARRAY OF CHAR) ;
+
+
+END PathName.
diff --git a/gcc/m2/gm2-compiler/PathName.mod b/gcc/m2/gm2-compiler/PathName.mod
new file mode 100644
index 00000000000..6fc7612d08f
--- /dev/null
+++ b/gcc/m2/gm2-compiler/PathName.mod
@@ -0,0 +1,279 @@
+IMPLEMENTATION MODULE PathName ;
+
+FROM Storage IMPORT ALLOCATE, DEALLOCATE ;
+FROM DynamicStrings IMPORT InitString, ConCat, ConCatChar, char, Dup,
+ KillString, Length, EqualArray, Equal, Mark ;
+FROM SFIO IMPORT Exists ;
+FROM FIO IMPORT StdErr ;
+FROM M2Printf IMPORT fprintf0, fprintf1, fprintf2 ;
+FROM FormatStrings IMPORT Sprintf1 ;
+
+FROM DynamicPath IMPORT InitPathList, FindFileName ;
+
+IMPORT DynamicPath ;
+
+
+CONST
+ Debugging = FALSE ;
+
+TYPE
+ NamedPath = POINTER TO RECORD
+ pathList: PathList ;
+ name : String ;
+ tail,
+ next : NamedPath ;
+ END ;
+
+
+VAR
+ FreeList,
+ NamedPathHead: NamedPath ;
+
+
+
+(*
+ AddSystem -
+*)
+
+PROCEDURE AddSystem (named, directory: String) ;
+BEGIN
+ IF NamedPathHead = NIL
+ THEN
+ (* Empty dictionary add single entry. *)
+ SetNamedPath (InitNamedPath (named, InitPathList (directory)))
+ ELSIF Equal (NamedPathHead^.tail^.name, named)
+ THEN
+ NamedPathHead^.tail^.pathList := DynamicPath.Cons (NamedPathHead^.tail^.pathList,
+ directory)
+ ELSE
+ SetNamedPath (ConsList (NamedPathHead,
+ InitNamedPath (named, InitPathList (directory))))
+ END
+END AddSystem ;
+
+
+(*
+ AddUser -
+*)
+
+PROCEDURE AddUser (named, directory: String) ;
+BEGIN
+ IF NamedPathHead = NIL
+ THEN
+ (* Empty dictionary add single entry. *)
+ SetNamedPath (InitNamedPath (named, InitPathList (directory)))
+ ELSIF EqualArray (NamedPathHead^.name, '')
+ THEN
+ (* Found user node. *)
+ NamedPathHead^.pathList := DynamicPath.Cons (NamedPathHead^.pathList,
+ directory)
+ ELSE
+ (* No user node yet, so we will create one. *)
+ NamedPathHead := ConsList (InitNamedPath (named, InitPathList (directory)),
+ NamedPathHead) ;
+ SetNamedPath (NamedPathHead)
+ END
+END AddUser ;
+
+
+(*
+ AddInclude - adds include path to the named path. If named path
+ is the same as the previous call then the include path
+ is appended to the named path PathList otherwise a new
+ named path is created and placed at the end of the
+ named path list.
+*)
+
+PROCEDURE AddInclude (named, directory: String) ;
+BEGIN
+ IF Debugging
+ THEN
+ fprintf2 (StdErr, "named = %s, directory =%s\n",
+ named, directory)
+ END ;
+ IF (named = NIL) OR EqualArray (named, '')
+ THEN
+ AddUser (named, directory) ;
+ IF Debugging
+ THEN
+ DumpPathName ('User pathname')
+ END
+ ELSE
+ AddSystem (named, directory) ;
+ IF Debugging
+ THEN
+ DumpPathName ('System pathname')
+ END
+ END
+END AddInclude ;
+
+
+(*
+ SetNamedPath - assigns the named path to the default path.
+*)
+
+PROCEDURE SetNamedPath (named: NamedPath) ;
+BEGIN
+ NamedPathHead := named
+END SetNamedPath ;
+
+
+(*
+ GetNamedPath - returns the default named path.
+*)
+
+PROCEDURE GetNamedPath () : NamedPath ;
+BEGIN
+ RETURN NamedPathHead
+END GetNamedPath ;
+
+
+(*
+ KillNamedPath - places list np onto the freelist.
+ Postcondition: np will be NIL.
+*)
+
+PROCEDURE KillNamedPath (VAR np: NamedPath) ;
+BEGIN
+ IF np # NIL
+ THEN
+ np^.tail^.next := FreeList ;
+ FreeList := np ;
+ np := NIL
+ END
+END KillNamedPath ;
+
+
+(*
+ ConsList - concatenates named path left and right together.
+*)
+
+PROCEDURE ConsList (left, right: NamedPath) : NamedPath ;
+BEGIN
+ IF right # NIL
+ THEN
+ left^.tail^.next := right ;
+ left^.tail := right^.tail
+ END ;
+ RETURN left
+END ConsList ;
+
+
+(*
+ Cons - appends pl to the end of a named path.
+ If np is NIL a new list is created and returned
+ containing named and pl.
+*)
+
+PROCEDURE Cons (np: NamedPath; named: String; pl: PathList) : NamedPath ;
+BEGIN
+ IF np = NIL
+ THEN
+ np := InitNamedPath (named, pl)
+ ELSE
+ np := ConsList (np, InitNamedPath (named, pl))
+ END ;
+ RETURN np
+END Cons ;
+
+
+(*
+ Stash - returns np before setting np to NIL.
+*)
+
+PROCEDURE Stash (VAR np: NamedPath) : NamedPath ;
+VAR
+ old: NamedPath ;
+BEGIN
+ old := np ;
+ np := NIL ;
+ RETURN old
+END Stash ;
+
+
+(*
+ InitNamedPath - creates a new path name with an associated pathlist.
+*)
+
+PROCEDURE InitNamedPath (name: String; pl: PathList) : NamedPath ;
+VAR
+ np: NamedPath ;
+BEGIN
+ NEW (np) ;
+ IF np = NIL
+ THEN
+ HALT
+ ELSE
+ np^.pathList := pl ;
+ np^.name := Dup (name) ;
+ np^.next := NIL ;
+ np^.tail := np
+ END ;
+ RETURN np
+END InitNamedPath ;
+
+
+(*
+ FindNamedPathFile - Post-condition: returns NIL if a file cannot be found otherwise
+ it returns the path including the filename.
+ It also returns a new string the name of the path.
+ Pre-condition: if name = NIL then it searches
+ user path first, followed by any
+ named path.
+ elsif name = ''
+ then
+ search user path
+ else
+ search named path
+ fi
+*)
+
+PROCEDURE FindNamedPathFile (filename: String; VAR name: String) : String ;
+VAR
+ foundFile: String ;
+ np : NamedPath ;
+BEGIN
+ np := NamedPathHead ;
+ WHILE np # NIL DO
+ IF (name = NIL) OR Equal (np^.name, name)
+ THEN
+ foundFile := FindFileName (filename, np^.pathList) ;
+ IF foundFile # NIL
+ THEN
+ name := Dup (np^.name) ;
+ RETURN foundFile
+ END
+ END ;
+ np := np^.next
+ END ;
+ name := NIL ;
+ RETURN NIL
+END FindNamedPathFile ;
+
+
+(*
+ DumpPathName - display the dictionary of names and all path entries.
+*)
+
+PROCEDURE DumpPathName (name: ARRAY OF CHAR) ;
+VAR
+ np : NamedPath ;
+ leader: String ;
+BEGIN
+ fprintf0 (StdErr, name) ;
+ fprintf0 (StdErr, " = {\n") ;
+ np := NamedPathHead ;
+ WHILE np # NIL DO
+ leader := Sprintf1 (Mark (InitString (" %s")), np^.name) ;
+ DynamicPath.DumpPath (leader, np^.pathList) ;
+ leader := KillString (leader) ;
+ np := np^.next
+ END ;
+ fprintf0 (StdErr, "}\n")
+END DumpPathName ;
+
+
+BEGIN
+ NamedPathHead := NIL ;
+ FreeList := NIL
+END PathName.
diff --git a/gcc/m2/gm2-compiler/SymbolTable.def b/gcc/m2/gm2-compiler/SymbolTable.def
index c6c39d92962..c7f584bfb09 100644
--- a/gcc/m2/gm2-compiler/SymbolTable.def
+++ b/gcc/m2/gm2-compiler/SymbolTable.def
@@ -336,6 +336,7 @@ EXPORT QUALIFIED NulSym,
PutModuleContainsBuiltin, IsBuiltinInModule,
HasVarParameters,
GetErrorScope,
+ GetLibName, PutLibName,
IsSizeSolved,
IsOffsetSolved,
@@ -588,7 +589,21 @@ PROCEDURE MakeProcedure (tok: CARDINAL; ProcedureName: Name) : CARDINAL ;
MakeProcedureCtorExtern - creates an extern ctor procedure
*)
-PROCEDURE MakeProcedureCtorExtern (tokenno: CARDINAL; modulename: Name) : CARDINAL ;
+PROCEDURE MakeProcedureCtorExtern (tokenno: CARDINAL; libname, modulename: Name) : CARDINAL ;
+
+
+(*
+ PutLibName - places libname into defimp or module sym.
+*)
+
+PROCEDURE PutLibName (sym: CARDINAL; libname: Name) ;
+
+
+(*
+ GetLibName - returns libname associated with a defimp or module sym.
+*)
+
+PROCEDURE GetLibName (sym: CARDINAL) : Name ;
(*
diff --git a/gcc/m2/gm2-compiler/SymbolTable.mod b/gcc/m2/gm2-compiler/SymbolTable.mod
index cc1a874b791..92f1f1e83f7 100644
--- a/gcc/m2/gm2-compiler/SymbolTable.mod
+++ b/gcc/m2/gm2-compiler/SymbolTable.mod
@@ -615,6 +615,7 @@ TYPE
RECORD
name : Name ; (* Index into name array, name *)
(* of record field. *)
+ libname : Name ; (* Library (dialect) with module *)
ctors : ModuleCtor ; (* All the ctor functions. *)
DefListOfDep,
ModListOfDep : List ; (* Vector of SymDependency. *)
@@ -714,6 +715,7 @@ TYPE
RECORD
name : Name ; (* Index into name array, name *)
(* of record field. *)
+ libname : Name ; (* Library (dialect) with module *)
ctors : ModuleCtor ; (* All the ctor functions. *)
ModListOfDep : List ; (* Vector of SymDependency. *)
LocalSymbols : SymbolTree ; (* The LocalSymbols hold all the *)
@@ -3030,11 +3032,11 @@ END IsImplicityExported ;
MakeProcedureCtorExtern - creates an extern ctor procedure
*)
-PROCEDURE MakeProcedureCtorExtern (tokenno: CARDINAL; modulename: Name) : CARDINAL ;
+PROCEDURE MakeProcedureCtorExtern (tokenno: CARDINAL; libname, modulename: Name) : CARDINAL ;
VAR
ctor: CARDINAL ;
BEGIN
- ctor := MakeProcedure (tokenno, GenName ('_M2_', modulename, '_ctor')) ;
+ ctor := MakeProcedure (tokenno, GenName (libname, '_M2_', modulename, '_ctor')) ;
PutExtern (ctor, TRUE) ;
RETURN ctor
END MakeProcedureCtorExtern ;
@@ -3044,12 +3046,13 @@ END MakeProcedureCtorExtern ;
GenName - returns a new name consisting of pre, name, post concatenation.
*)
-PROCEDURE GenName (pre: ARRAY OF CHAR; name: Name; post: ARRAY OF CHAR) : Name ;
+PROCEDURE GenName (libname: Name; pre: ARRAY OF CHAR; name: Name; post: ARRAY OF CHAR) : Name ;
VAR
str : String ;
result: Name ;
BEGIN
- str := InitString (pre) ;
+ str := InitStringCharStar (KeyToCharStar (libname)) ;
+ str := ConCat (str, Mark (InitString (pre))) ;
str := ConCat (str, Mark (InitStringCharStar (KeyToCharStar (name)))) ;
str := ConCat (str, InitString (post)) ;
result := makekey (string (str)) ;
@@ -3086,10 +3089,12 @@ BEGIN
IF IsDefImp (moduleSym)
THEN
InitCtorFields (moduleTok, beginTok, finallyTok,
+ moduleSym,
pSym^.DefImp.ctors, GetSymName (moduleSym),
FALSE, TRUE)
ELSE
InitCtorFields (moduleTok, beginTok, finallyTok,
+ moduleSym,
pSym^.Module.ctors, GetSymName (moduleSym),
IsInnerModule (moduleSym), TRUE)
END
@@ -3102,32 +3107,41 @@ END MakeModuleCtor ;
*)
PROCEDURE InitCtorFields (moduleTok, beginTok, finallyTok: CARDINAL;
+ moduleSym: CARDINAL;
VAR ctor: ModuleCtor; name: Name;
inner, pub: BOOLEAN) ;
BEGIN
IF ScaffoldDynamic AND (NOT inner)
THEN
(* The ctor procedure must be public. *)
- ctor.ctor := MakeProcedure (moduleTok, GenName ("_M2_", name, "_ctor")) ;
+ ctor.ctor := MakeProcedure (moduleTok,
+ GenName (GetLibName (moduleSym),
+ "_M2_", name, "_ctor")) ;
PutCtor (ctor.ctor, TRUE) ;
Assert (pub) ;
PutPublic (ctor.ctor, pub) ;
PutExtern (ctor.ctor, NOT pub) ;
PutMonoName (ctor.ctor, TRUE) ;
(* The dep procedure is local to the module. *)
- ctor.dep := MakeProcedure (moduleTok, GenName ("_M2_", name, "_dep")) ;
+ ctor.dep := MakeProcedure (moduleTok,
+ GenName (GetLibName (moduleSym),
+ "_M2_", name, "_dep")) ;
PutMonoName (ctor.dep, TRUE)
ELSE
ctor.ctor := NulSym ;
ctor.dep := NulSym
END ;
(* The init/fini procedures must be public. *)
- ctor.init := MakeProcedure (beginTok, GenName ("_M2_", name, "_init")) ;
+ ctor.init := MakeProcedure (beginTok,
+ GenName (GetLibName (moduleSym),
+ "_M2_", name, "_init")) ;
PutPublic (ctor.init, pub) ;
PutExtern (ctor.init, NOT pub) ;
PutMonoName (ctor.init, NOT inner) ;
DeclareArgEnvParams (beginTok, ctor.init) ;
- ctor.fini := MakeProcedure (finallyTok, GenName ("_M2_", name, "_fini")) ;
+ ctor.fini := MakeProcedure (finallyTok,
+ GenName (GetLibName (moduleSym),
+ "_M2_", name, "_fini")) ;
PutPublic (ctor.fini, pub) ;
PutExtern (ctor.fini, NOT pub) ;
PutMonoName (ctor.fini, NOT inner) ;
@@ -3190,6 +3204,7 @@ BEGIN
WITH Module DO
name := ModuleName ; (* Index into name array, name *)
(* of record field. *)
+ libname := NulName ; (* Library association. *)
InitCtor (ctors) ; (* Init all ctor functions. *)
InitList(ModListOfDep) ; (* Vector of SymDependency. *)
InitTree(LocalSymbols) ; (* The LocalSymbols hold all the *)
@@ -3456,6 +3471,7 @@ BEGIN
WITH Module DO
name := ModuleName ; (* Index into name array, name *)
(* of record field. *)
+ libname := NulName ; (* Library association. *)
InitCtor (ctors) ; (* Init all ctor functions. *)
InitTree(LocalSymbols) ; (* The LocalSymbols hold all the *)
(* variables declared local to *)
@@ -3551,6 +3567,7 @@ BEGIN
WITH DefImp DO
name := DefImpName ; (* Index into name array, name *)
(* of record field. *)
+ libname := NulName ; (* Library association. *)
InitCtor (ctors) ;
(* Init all ctor functions. *)
InitList(DefListOfDep) ; (* Vector of SymDependency. *)
@@ -3653,6 +3670,52 @@ BEGIN
END MakeDefImp ;
+(*
+ PutLibName - places libname into defimp or module sym.
+*)
+
+PROCEDURE PutLibName (sym: CARDINAL; libname: Name) ;
+VAR
+ pSym: PtrToSymbol ;
+BEGIN
+ Assert (IsModule (sym) OR IsDefImp (sym)) ;
+ pSym := GetPsym (sym) ;
+ WITH pSym^ DO
+ CASE SymbolType OF
+
+ DefImpSym: DefImp.libname := libname |
+ ModuleSym: Module.libname := libname
+
+ ELSE
+ InternalError ('expecting DefImp or Module symbol')
+ END
+ END
+END PutLibName ;
+
+
+(*
+ GetLibName - returns libname associated with a defimp or module sym.
+*)
+
+PROCEDURE GetLibName (sym: CARDINAL) : Name ;
+VAR
+ pSym: PtrToSymbol ;
+BEGIN
+ Assert (IsModule (sym) OR IsDefImp (sym)) ;
+ pSym := GetPsym (sym) ;
+ WITH pSym^ DO
+ CASE SymbolType OF
+
+ DefImpSym: RETURN DefImp.libname |
+ ModuleSym: RETURN Module.libname
+
+ ELSE
+ InternalError ('expecting DefImp or Module symbol')
+ END
+ END
+END GetLibName ;
+
+
(*
PutProcedureExternPublic - if procedure is not NulSym set extern
and public booleans.
@@ -3678,7 +3741,7 @@ BEGIN
(* If the ctor does not exist then make it extern/ (~extern) public. *)
IF ctor.ctor = NulSym
THEN
- ctor.ctor := MakeProcedure (tok, GenName ("_M2_", GetSymName (sym), "_ctor")) ;
+ ctor.ctor := MakeProcedure (tok, GenName (GetLibName (sym), "_M2_", GetSymName (sym), "_ctor")) ;
PutMonoName (ctor.ctor, TRUE)
END ;
PutProcedureExternPublic (ctor.ctor, extern, NOT extern) ;
@@ -3686,21 +3749,21 @@ BEGIN
(* If the ctor does not exist then make it extern/ (~extern) public. *)
IF ctor.dep = NulSym
THEN
- ctor.dep := MakeProcedure (tok, GenName ("_M2_", GetSymName (sym), "_dep")) ;
+ ctor.dep := MakeProcedure (tok, GenName (GetLibName (sym), "_M2_", GetSymName (sym), "_dep")) ;
PutMonoName (ctor.dep, TRUE)
END ;
PutProcedureExternPublic (ctor.dep, extern, NOT extern) ;
(* If init/fini do not exist then create them. *)
IF ctor.init = NulSym
THEN
- ctor.init := MakeProcedure (tok, GenName ("_M2_", GetSymName (sym), "_init")) ;
+ ctor.init := MakeProcedure (tok, GenName (GetLibName (sym), "_M2_", GetSymName (sym), "_init")) ;
DeclareArgEnvParams (tok, ctor.init) ;
PutMonoName (ctor.init, NOT IsInnerModule (sym))
END ;
PutProcedureExternPublic (ctor.init, extern, NOT extern) ;
IF ctor.fini = NulSym
THEN
- ctor.fini := MakeProcedure (tok, GenName ("_M2_", GetSymName (sym), "_fini")) ;
+ ctor.fini := MakeProcedure (tok, GenName (GetLibName (sym), "_M2_", GetSymName (sym), "_fini")) ;
DeclareArgEnvParams (tok, ctor.fini) ;
PutMonoName (ctor.fini, NOT IsInnerModule (sym))
END ;
diff --git a/gcc/m2/gm2-gcc/init.cc b/gcc/m2/gm2-gcc/init.cc
index a9dfcc70069..834a84e1cf7 100644
--- a/gcc/m2/gm2-gcc/init.cc
+++ b/gcc/m2/gm2-gcc/init.cc
@@ -55,7 +55,8 @@ EXTERN void _M2_CmdArgs_init (int argc, char *argv[], char *envp[]);
EXTERN void _M2_M2Preprocess_init (int argc, char *argv[], char *envp[]);
EXTERN void _M2_M2Error_init (int argc, char *argv[], char *envp[]);
EXTERN void _M2_M2Search_init (int argc, char *argv[], char *envp[]);
-EXTERN void _M2_DynamicStringPath_init (int argc, char *argv[], char *envp[]);
+EXTERN void _M2_DynamicPath_init (int argc, char *argv[], char *envp[]);
+EXTERN void _M2_PathName_init (int argc, char *argv[], char *envp[]);
EXTERN void _M2_Indexing_init (int argc, char *argv[], char *envp[]);
EXTERN void _M2_NameKey_init (int argc, char *argv[], char *envp[]);
EXTERN void _M2_NumberIO_init (int argc, char *argv[], char *envp[]);
@@ -142,7 +143,8 @@ init_FrontEndInit (void)
_M2_StrLib_init (0, NULL, NULL);
_M2_dtoa_init (0, NULL, NULL);
_M2_ldtoa_init (0, NULL, NULL);
- _M2_DynamicStringPath_init (0, NULL, NULL);
+ _M2_DynamicPath_init (0, NULL, NULL);
+ _M2_PathName_init (0, NULL, NULL);
_M2_M2Search_init (0, NULL, NULL);
_M2_M2Options_init (0, NULL, NULL);
}
diff --git a/gcc/m2/gm2-gcc/m2decl.cc b/gcc/m2/gm2-gcc/m2decl.cc
index ab409378673..eb3d98d0783 100644
--- a/gcc/m2/gm2-gcc/m2decl.cc
+++ b/gcc/m2/gm2-gcc/m2decl.cc
@@ -48,7 +48,7 @@ m2decl_DeclareM2linkStaticInitialization (location_t location,
m2block_pushGlobalScope ();
/* Generate: int M2LINK_StaticInitialization = ScaffoldStatic; */
tree init = m2decl_BuildIntegerConstant (ScaffoldStatic);
- tree static_init = m2decl_DeclareKnownVariable (location, "M2LINK_StaticInitialization",
+ tree static_init = m2decl_DeclareKnownVariable (location, "m2pim_M2LINK_StaticInitialization",
integer_type_node,
TRUE, FALSE, FALSE, TRUE, NULL_TREE, init);
m2block_popGlobalScope ();
@@ -65,7 +65,7 @@ m2decl_DeclareM2linkForcedModuleInitOrder (location_t location,
tree ptr_to_char = build_pointer_type (char_type_node);
TYPE_READONLY (ptr_to_char) = TRUE;
tree init = m2decl_BuildPtrToTypeString (location, RuntimeOverride, ptr_to_char);
- tree forced_order = m2decl_DeclareKnownVariable (location, "M2LINK_ForcedModuleInitOrder",
+ tree forced_order = m2decl_DeclareKnownVariable (location, "m2pim_M2LINK_ForcedModuleInitOrder",
ptr_to_char,
TRUE, FALSE, FALSE, TRUE, NULL_TREE, init);
m2block_popGlobalScope ();
diff --git a/gcc/m2/gm2-gcc/m2options.h b/gcc/m2/gm2-gcc/m2options.h
index 92b4fd5b64c..7f5173ca474 100644
--- a/gcc/m2/gm2-gcc/m2options.h
+++ b/gcc/m2/gm2-gcc/m2options.h
@@ -132,6 +132,10 @@ EXTERN void M2Options_SetMQ (const char *arg);
EXTERN char *M2Options_GetMQ (void);
EXTERN void M2Options_SetObj (const char *arg);
EXTERN char *M2Options_GetObj (void);
+EXTERN void M2Options_SetM2Prefix (const char *arg);
+EXTERN char *M2Options_GetM2Prefix (void);
+EXTERN void M2Options_SetM2PathName (const char *arg);
+EXTERN char *M2Options_GetM2PathName (void);
#undef EXTERN
#endif /* m2options_h. */
diff --git a/gcc/m2/gm2-lang.cc b/gcc/m2/gm2-lang.cc
index d9b63bee655..162baf75c3f 100644
--- a/gcc/m2/gm2-lang.cc
+++ b/gcc/m2/gm2-lang.cc
@@ -49,12 +49,18 @@ static int insideCppArgs = FALSE;
/* We default to pim in the absence of fiso. */
static bool iso = false;
+typedef struct named_path_s {
+ std::vector<const char*>path;
+ const char *name;
+} named_path;
+
+
/* The language include paths are based on the libraries in use. */
static bool allow_libraries = true;
static const char *flibs = nullptr;
static const char *iprefix = nullptr;
static const char *imultilib = nullptr;
-static std::vector<const char*>Ipaths;
+static std::vector<named_path>Ipaths;
static std::vector<const char*>isystem;
static std::vector<const char*>iquote;
@@ -319,6 +325,31 @@ is_cpp_filename (unsigned int i)
return filename_cpp[i];
}
+static void
+push_back_Ipath (const char *arg)
+{
+ if (Ipaths.empty ())
+ {
+ named_path np;
+ np.path.push_back (arg);
+ np.name = xstrdup (M2Options_GetM2PathName ());
+ Ipaths.push_back (np);
+ }
+ else
+ {
+ if (strcmp (Ipaths.back ().name,
+ M2Options_GetM2PathName ()) == 0)
+ Ipaths.back ().path.push_back (arg);
+ else
+ {
+ named_path np;
+ np.path.push_back (arg);
+ np.name = xstrdup (M2Options_GetM2PathName ());
+ Ipaths.push_back (np);
+ }
+ }
+}
+
/* Handle gm2 specific options. Return 0 if we didn't do anything. */
bool
@@ -337,7 +368,7 @@ gm2_langhook_handle_option (
switch (code)
{
case OPT_I:
- Ipaths.push_back (arg);
+ push_back_Ipath (arg);
return 1;
case OPT_fiso:
M2Options_SetISO (value);
@@ -517,6 +548,24 @@ gm2_langhook_handle_option (
M2Options_SetM2g (value);
return 1;
break;
+ case OPT_fm2_pathname_:
+ if (strcmp (arg, "-") == 0)
+ M2Options_SetM2PathName ("");
+ else
+ M2Options_SetM2PathName (arg);
+ return 1;
+ break;
+ case OPT_fm2_pathnameI:
+ push_back_Ipath (arg);
+ return 1;
+ break;
+ case OPT_fm2_prefix_:
+ if (strcmp (arg, "-") == 0)
+ M2Options_SetM2Prefix ("");
+ else
+ M2Options_SetM2Prefix (arg);
+ return 1;
+ break;
case OPT_iprefix:
iprefix = arg;
return 1;
@@ -608,6 +657,7 @@ add_one_import_path (const char *libname)
strcat (lib, "m2");
strcat (lib, dir_sep);
strcat (lib, libname);
+ M2Options_SetM2PathName (libname);
M2Options_SetSearchPath (lib);
}
@@ -669,8 +719,12 @@ gm2_langhook_post_options (const char **pfilename)
for (auto *s : iquote)
M2Options_SetSearchPath (s);
iquote.clear();
- for (auto *s : Ipaths)
- M2Options_SetSearchPath (s);
+ for (auto np : Ipaths)
+ {
+ M2Options_SetM2PathName (np.name);
+ for (auto *s : np.path)
+ M2Options_SetSearchPath (s);
+ }
Ipaths.clear();
for (auto *s : isystem)
M2Options_SetSearchPath (s);
diff --git a/gcc/m2/gm2-libs-iso/M2RTS.def b/gcc/m2/gm2-libs-iso/M2RTS.def
index cca4ae64189..343dab7fd20 100644
--- a/gcc/m2/gm2-libs-iso/M2RTS.def
+++ b/gcc/m2/gm2-libs-iso/M2RTS.def
@@ -33,10 +33,10 @@ TYPE
ArgCVEnvP = PROCEDURE (INTEGER, ADDRESS, ADDRESS) ;
-PROCEDURE ConstructModules (applicationmodule: ADDRESS;
+PROCEDURE ConstructModules (applicationmodule, libname: ADDRESS;
argc: INTEGER; argv, envp: ADDRESS) ;
-PROCEDURE DeconstructModules (applicationmodule: ADDRESS;
+PROCEDURE DeconstructModules (applicationmodule, libname: ADDRESS;
argc: INTEGER; argv, envp: ADDRESS) ;
@@ -46,7 +46,7 @@ PROCEDURE DeconstructModules (applicationmodule: ADDRESS;
explored to determine initialization order.
*)
-PROCEDURE RegisterModule (name: ADDRESS;
+PROCEDURE RegisterModule (name, libname: ADDRESS;
init, fini: ArgCVEnvP;
dependencies: PROC) ;
@@ -56,7 +56,8 @@ PROCEDURE RegisterModule (name: ADDRESS;
module dependantmodule.
*)
-PROCEDURE RequestDependant (modulename, dependantmodule: ADDRESS) ;
+PROCEDURE RequestDependant (modulename, libname,
+ dependantmodule, dependantlibname: ADDRESS) ;
(*
diff --git a/gcc/m2/gm2-libs-iso/M2RTS.mod b/gcc/m2/gm2-libs-iso/M2RTS.mod
index cbe70a958d1..a59735a0c32 100644
--- a/gcc/m2/gm2-libs-iso/M2RTS.mod
+++ b/gcc/m2/gm2-libs-iso/M2RTS.mod
@@ -71,10 +71,11 @@ VAR
module constructor in turn.
*)
-PROCEDURE ConstructModules (applicationmodule: ADDRESS;
+PROCEDURE ConstructModules (applicationmodule, libname: ADDRESS;
argc: INTEGER; argv, envp: ADDRESS) ;
BEGIN
- M2Dependent.ConstructModules (applicationmodule, argc, argv, envp)
+ M2Dependent.ConstructModules (applicationmodule, libname,
+ argc, argv, envp)
END ConstructModules ;
@@ -83,10 +84,11 @@ END ConstructModules ;
module constructor in turn.
*)
-PROCEDURE DeconstructModules (applicationmodule: ADDRESS;
+PROCEDURE DeconstructModules (applicationmodule, libname: ADDRESS;
argc: INTEGER; argv, envp: ADDRESS) ;
BEGIN
- M2Dependent.DeconstructModules (applicationmodule, argc, argv, envp)
+ M2Dependent.DeconstructModules (applicationmodule, libname,
+ argc, argv, envp)
END DeconstructModules ;
@@ -96,11 +98,11 @@ END DeconstructModules ;
explored to determine initialization order.
*)
-PROCEDURE RegisterModule (name: ADDRESS;
+PROCEDURE RegisterModule (name, libname: ADDRESS;
init, fini: ArgCVEnvP;
dependencies: PROC) ;
BEGIN
- M2Dependent.RegisterModule (name, init, fini, dependencies)
+ M2Dependent.RegisterModule (name, libname, init, fini, dependencies)
END RegisterModule ;
@@ -109,9 +111,11 @@ END RegisterModule ;
module dependantmodule.
*)
-PROCEDURE RequestDependant (modulename, dependantmodule: ADDRESS) ;
+PROCEDURE RequestDependant (modulename, libname,
+ dependantmodule, dependantlibname: ADDRESS) ;
BEGIN
- M2Dependent.RequestDependant (modulename, dependantmodule)
+ M2Dependent.RequestDependant (modulename, libname,
+ dependantmodule, dependantlibname)
END RequestDependant ;
diff --git a/gcc/m2/gm2-libs-iso/wrapsock.c b/gcc/m2/gm2-libs-iso/wrapsock.c
deleted file mode 100644
index 6d032ee446c..00000000000
--- a/gcc/m2/gm2-libs-iso/wrapsock.c
+++ /dev/null
@@ -1,260 +0,0 @@
-/* wrapsock.c implements access to low level client socket primitives.
-
-Copyright (C) 2008-2023 Free Software Foundation, Inc.
-Contributed by Gaius Mulley <gaius.mulley@southwales.ac.uk>.
-
-This file is part of GNU Modula-2.
-
-GNU Modula-2 is free software; you can redistribute it and/or modify
-it under the terms of the GNU General Public License as published by
-the Free Software Foundation; either version 3, or (at your option)
-any later version.
-
-GNU Modula-2 is distributed in the hope that it will be useful, but
-WITHOUT ANY WARRANTY; without even the implied warranty of
-MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
-General Public License for more details.
-
-Under Section 7 of GPL version 3, you are granted additional
-permissions described in the GCC Runtime Library Exception, version
-3.1, as published by the Free Software Foundation.
-
-You should have received a copy of the GNU General Public License and
-a copy of the GCC Runtime Library Exception along with this program;
-see the files COPYING3 and COPYING.RUNTIME respectively. If not, see
-<http://www.gnu.org/licenses/>. */
-
-#include <p2c/p2c.h>
-
-#if defined(HAVE_SYS_TYPES_H)
-# include <sys/types.h>
-#endif
-
-#if defined(HAVE_SYS_SOCKET_H)
-# include <sys/socket.h>
-#endif
-
-#include <netinet/in.h>
-#include <netdb.h>
-
-#if defined(HAVE_UNISTD_H)
-# include <unistd.h>
-#endif
-
-#if defined(HAVE_SIGNAL_H)
-# include <signal.h>
-#endif
-
-#if defined(HAVE_SYS_ERRNO_H)
-# include <sys/errno.h>
-#endif
-
-#if defined(HAVE_ERRNO_H)
-# include <errno.h>
-#endif
-
-#if defined(HAVE_MALLOC_H)
-# include <malloc.h>
-#endif
-
-#if defined(HAVE_SIGNAL_H)
-# include <signal.h>
-#endif
-
-#if defined(HAVE_STRING_H)
-# include <string.h>
-#endif
-
-#if defined(HAVE_STDLIB_H)
-# include <stdlib.h>
-#endif
-
-#if !defined(TRUE)
-# define TRUE (1==1)
-#endif
-#if !defined(FALSE)
-# define FALSE (1==0)
-#endif
-
-#include "ChanConsts.h"
-
-#define MAXHOSTNAME 1024
-#define MAXPBBUF 1024
-
-
-typedef struct {
- char hostname[MAXHOSTNAME];
- struct hostent *hp;
- struct sockaddr_in sa;
- int sockFd;
- int portNo;
- int hasChar;
- char pbChar[MAXPBBUF];
-} clientInfo;
-
-static openResults clientConnect (clientInfo *c);
-
-
-/*
- * clientOpen - returns an ISO Modula-2 OpenResult.
- * It attempts to connect to: hostname:portNo.
- * If successful then the data structure, c,
- * will have its fields initialized.
- */
-
-openResults wrapsock_clientOpen (clientInfo *c, char *hostname,
- unsigned int length, int portNo)
-{
- /* remove SIGPIPE which is raised on the server if the client is killed */
- signal(SIGPIPE, SIG_IGN);
-
- c->hp = gethostbyname(hostname);
- if (c->hp == NULL)
- return noSuchFile;
-
- memset((void *)&c->sa, 0, sizeof(c->sa));
- c->sa.sin_family = AF_INET;
- memcpy((void *)&c->sa.sin_addr, (void *)c->hp->h_addr, c->hp->h_length);
- c->portNo = portNo;
- c->sa.sin_port = htons(portNo);
- c->hasChar = 0;
- /*
- * Open a TCP socket (an Internet stream socket)
- */
-
- c->sockFd = socket(c->hp->h_addrtype, SOCK_STREAM, 0);
- return clientConnect(c);
-}
-
-/*
- * clientOpenIP - returns an ISO Modula-2 OpenResult.
- * It attempts to connect to: ipaddress:portNo.
- * If successful then the data structure, c,
- * will have its fields initialized.
- */
-
-openResults wrapsock_clientOpenIP (clientInfo *c, unsigned int ip, int portNo)
-{
- /* remove SIGPIPE which is raised on the server if the client is killed */
- signal(SIGPIPE, SIG_IGN);
-
- memset((void *)&c->sa, 0, sizeof(c->sa));
- c->sa.sin_family = AF_INET;
- memcpy((void *)&c->sa.sin_addr, (void *)&ip, sizeof(ip));
- c->portNo = portNo;
- c->sa.sin_port = htons(portNo);
-
- /*
- * Open a TCP socket (an Internet stream socket)
- */
-
- c->sockFd = socket(PF_INET, SOCK_STREAM, 0);
- return clientConnect(c);
-}
-
-/*
- * clientConnect - returns an ISO Modula-2 OpenResult
- * once a connect has been performed.
- * If successful the clientInfo will
- * include the file descriptor ready
- * for read/write operations.
- */
-
-static openResults clientConnect (clientInfo *c)
-{
- if (connect(c->sockFd, (struct sockaddr *)&c->sa, sizeof(c->sa)) < 0)
- return noSuchFile;
-
- return opened;
-}
-
-/*
- * getClientPortNo - returns the portNo from structure, c.
- */
-
-int wrapsock_getClientPortNo (clientInfo *c)
-{
- return c->portNo;
-}
-
-/*
- * getClientHostname - fills in the hostname of the server
- * the to which the client is connecting.
- */
-
-void wrapsock_getClientHostname (clientInfo *c,
- char *hostname, unsigned int high)
-{
- strncpy(hostname, c->hostname, high+1);
-}
-
-/*
- * getClientSocketFd - returns the sockFd from structure, c.
- */
-
-int wrapsock_getClientSocketFd (clientInfo *c)
-{
- return c->sockFd;
-}
-
-/*
- * getClientIP - returns the sockFd from structure, s.
- */
-
-unsigned int wrapsock_getClientIP (clientInfo *c)
-{
-#if 0
- printf("client ip = %s\n", inet_ntoa (c->sa.sin_addr.s_addr));
-#endif
- return c->sa.sin_addr.s_addr;
-}
-
-/*
- * getPushBackChar - returns TRUE if a pushed back character
- * is available.
- */
-
-unsigned int wrapsock_getPushBackChar (clientInfo *c, char *ch)
-{
- if (c->hasChar > 0) {
- c->hasChar--;
- *ch = c->pbChar[c->hasChar];
- return TRUE;
- }
- return FALSE;
-}
-
-/*
- * setPushBackChar - returns TRUE if it is able to push back a
- * character.
- */
-
-unsigned int wrapsock_setPushBackChar (clientInfo *c, char ch)
-{
- if (c->hasChar == MAXPBBUF)
- return FALSE;
- c->pbChar[c->hasChar] = ch;
- c->hasChar++;
- return TRUE;
-}
-
-/*
- * getSizeOfClientInfo - returns the sizeof (opaque data type).
- */
-
-unsigned int wrapsock_getSizeOfClientInfo (void)
-{
- return sizeof (clientInfo);
-}
-
-/*
- * GNU Modula-2 link fodder.
- */
-
-void _M2_wrapsock_init (void)
-{
-}
-
-void _M2_wrapsock_finish (void)
-{
-}
diff --git a/gcc/m2/gm2-libs-iso/wraptime.c b/gcc/m2/gm2-libs-iso/wraptime.c
deleted file mode 100644
index dafdb665ed5..00000000000
--- a/gcc/m2/gm2-libs-iso/wraptime.c
+++ /dev/null
@@ -1,292 +0,0 @@
-/* wraptime.c provides access to time functions.
-
-Copyright (C) 2009-2023 Free Software Foundation, Inc.
-Contributed by Gaius Mulley <gaius@glam.ac.uk>.
-
-This file is part of GNU Modula-2.
-
-GNU Modula-2 is free software; you can redistribute it and/or modify
-it under the terms of the GNU General Public License as published by
-the Free Software Foundation; either version 3, or (at your option)
-any later version.
-
-GNU Modula-2 is distributed in the hope that it will be useful, but
-WITHOUT ANY WARRANTY; without even the implied warranty of
-MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
-General Public License for more details.
-
-Under Section 7 of GPL version 3, you are granted additional
-permissions described in the GCC Runtime Library Exception, version
-3.1, as published by the Free Software Foundation.
-
-You should have received a copy of the GNU General Public License and
-a copy of the GCC Runtime Library Exception along with this program;
-see the files COPYING3 and COPYING.RUNTIME respectively. If not, see
-<http://www.gnu.org/licenses/>. */
-
-#include "gm2-libs-host.h"
-
-#if defined(HAVE_SYS_TYPES_H)
-# include <sys/types.h>
-#endif
-
-#if defined(HAVE_SYS_TIME_H)
-# include <sys/time.h>
-#endif
-
-#if defined(HAVE_TIME_H)
-# include <time.h>
-#endif
-
-#if defined(HAVE_MALLOC_H)
-# include <malloc.h>
-#endif
-
-#if !defined(TRUE)
-# define TRUE (1==1)
-#endif
-#if !defined(FALSE)
-# define FALSE (1==0)
-#endif
-
-/* InitTimeval returns a newly created opaque type. */
-
-struct timeval *
-wraptime_InitTimeval (void)
-{
-#if defined(HAVE_TIMEVAL)
- return (struct timeval *) malloc (sizeof (struct timeval));
-#else
- return NULL;
-#endif
-}
-
-/* KillTimeval deallocates the memory associated with an
- opaque type. */
-
-struct timeval *
-wraptime_KillTimeval (void *tv)
-{
- free (tv);
- return NULL;
-}
-
-/* InitTimezone returns a newly created opaque type. */
-
-struct timezone *
-wraptime_InitTimezone (void)
-{
- return (struct timezone *) malloc (sizeof (struct timezone));
-}
-
-/* KillTimezone deallocates the memory associated with an
- opaque type. */
-
-struct timezone *
-wraptime_KillTimezone (struct timezone *tv)
-{
- free (tv);
- return NULL;
-}
-
-/* InitTM returns a newly created opaque type. */
-
-struct tm *
-wraptime_InitTM (void)
-{
- return (struct tm *) malloc (sizeof (struct tm));
-}
-
-/* KillTM deallocates the memory associated with an opaque type. */
-
-struct tm *
-wraptime_KillTM (struct tm *tv)
-{
- free (tv);
- return NULL;
-}
-
-/* gettimeofday calls gettimeofday(2) with the same parameters, tv,
- and, tz. It returns 0 on success. */
-
-int
-wraptime_gettimeofday (void *tv, struct timezone *tz)
-{
- return gettimeofday (tv, tz);
-}
-
-/* settimeofday calls settimeofday(2) with the same parameters, tv,
- and, tz. It returns 0 on success. */
-
-int
-wraptime_settimeofday (void *tv, struct timezone *tz)
-{
- return settimeofday (tv, tz);
-}
-
-/* wraptime_GetFractions returns the tv_usec field inside the timeval
- structure. */
-
-#if defined(HAVE_TIMEVAL)
-unsigned int
-wraptime_GetFractions (struct timeval *tv)
-{
- return (unsigned int) tv->tv_usec;
-}
-#else
-unsigned int
-wraptime_GetFractions (void *tv)
-{
- return 0;
-}
-#endif
-
-/* localtime_r returns the tm parameter, m, after it has been assigned
- with appropriate contents determined by, tv. Notice that this
- procedure function expects, timeval, as its first parameter and not
- a time_t (as expected by the posix equivalent). */
-
-#if defined(HAVE_TIMEVAL)
-struct tm *
-wraptime_localtime_r (struct timeval *tv, struct tm *m)
-{
- return localtime_r (&tv->tv_sec, m);
-}
-#else
-struct tm *
-wraptime_localtime_r (void *tv, struct tm *m)
-{
- return m;
-}
-#endif
-
-/* wraptime_GetYear returns the year from the structure, m. */
-
-unsigned int
-wraptime_GetYear (struct tm *m)
-{
- return m->tm_year;
-}
-
-/* wraptime_GetMonth returns the month from the structure, m. */
-
-unsigned int
-wraptime_GetMonth (struct tm *m)
-{
- return m->tm_mon;
-}
-
-/* wraptime_GetDay returns the day of the month from the structure, m. */
-
-unsigned int
-wraptime_GetDay (struct tm *m)
-{
- return m->tm_mday;
-}
-
-/* wraptime_GetHour returns the hour of the day from the structure, m. */
-
-unsigned int
-wraptime_GetHour (struct tm *m)
-{
- return m->tm_hour;
-}
-
-/* wraptime_GetMinute returns the minute within the hour from the structure, m. */
-
-unsigned int
-wraptime_GetMinute (struct tm *m)
-{
- return m->tm_min;
-}
-
-/* wraptime_GetSecond returns the seconds in the minute from the
- structure, m. The return value will always be in the range 0..59.
- A leap minute of value 60 will be truncated to 59. */
-
-unsigned int
-wraptime_GetSecond (struct tm *m)
-{
- if (m->tm_sec == 60)
- return 59;
- else
- return m->tm_sec;
-}
-
-/* wraptime_GetSummerTime returns true if summer time is in effect. */
-
-unsigned int
-wraptime_GetSummerTime (struct timezone *tz)
-{
- return tz->tz_dsttime != 0;
-}
-
-/* wraptime_GetDST returns the number of minutes west of GMT. */
-
-int
-wraptime_GetDST (struct timezone *tz)
-{
- return tz->tz_minuteswest;
-}
-
-/* SetTimezone set the timezone field inside timeval, tv. */
-
-void
-wraptime_SetTimezone (struct timezone *tz,
- int zone, int minuteswest)
-{
- tz->tz_dsttime = zone;
- tz->tz_minuteswest = minuteswest;
-}
-
-/* SetTimeval sets the fields in tm, t, with:
- second, minute, hour, day, month, year, fractions. */
-
-#if defined(HAVE_TIMEVAL)
-void
-wraptime_SetTimeval (struct tm *t,
- unsigned int second,
- unsigned int minute,
- unsigned int hour,
- unsigned int day,
- unsigned int month,
- unsigned int year,
- unsigned int yday,
- unsigned int wday,
- unsigned int isdst)
-{
- t->tm_sec = second;
- t->tm_min = minute;
- t->tm_hour = hour;
- t->tm_mday = day;
- t->tm_mon = month;
- t->tm_year = year;
- t->tm_yday = yday;
- t->tm_wday = wday;
- t->tm_isdst = isdst;
-}
-#else
-wraptime_SetTimeval (void *t,
- unsigned int second,
- unsigned int minute,
- unsigned int hour,
- unsigned int day,
- unsigned int month,
- unsigned int year,
- unsigned int yday,
- unsigned int wday,
- unsigned int isdst)
-{
- return t;
-}
-#endif
-
-/* init/finish functions for the module. */
-
-void
-_M2_wraptime_init ()
-{}
-
-void
-_M2_wraptime_finish ()
-{}
diff --git a/gcc/m2/gm2-libs-min/M2RTS.def b/gcc/m2/gm2-libs-min/M2RTS.def
index 65ffa8c5367..1952d9107f6 100644
--- a/gcc/m2/gm2-libs-min/M2RTS.def
+++ b/gcc/m2/gm2-libs-min/M2RTS.def
@@ -34,18 +34,36 @@ FROM SYSTEM IMPORT ADDRESS ;
TYPE
ArgCVEnvP = PROCEDURE (INTEGER, ADDRESS, ADDRESS) ;
+
(*
all these procedures do nothing except satisfy the linker.
*)
-PROCEDURE ConstructModules (applicationmodule: ADDRESS;
+PROCEDURE ConstructModules (applicationmodule, libname: ADDRESS;
argc: INTEGER; argv, envp: ADDRESS) ;
-PROCEDURE DeconstructModules (applicationmodule: ADDRESS;
+
+PROCEDURE DeconstructModules (applicationmodule, libname: ADDRESS;
argc: INTEGER; argv, envp: ADDRESS) ;
-PROCEDURE RegisterModule (name: ADDRESS;
+
+
+(*
+ RegisterModule - adds module name to the list of outstanding
+ modules which need to have their dependencies
+ explored to determine initialization order.
+*)
+
+PROCEDURE RegisterModule (name, libname: ADDRESS;
init, fini: ArgCVEnvP;
dependencies: PROC) ;
-PROCEDURE RequestDependant (modulename, dependantmodule: ADDRESS) ;
+
+(*
+ RequestDependant - used to specify that modulename is dependant upon
+ module dependantmodule.
+*)
+
+PROCEDURE RequestDependant (modulename, libname,
+ dependantmodule, dependantlibname: ADDRESS) ;
+
PROCEDURE ExecuteTerminationProcedures ;
PROCEDURE ExecuteInitialProcedures ;
PROCEDURE HALT <* noreturn *> ;
diff --git a/gcc/m2/gm2-libs-min/M2RTS.mod b/gcc/m2/gm2-libs-min/M2RTS.mod
index e6043bc4bd3..1765531ce85 100644
--- a/gcc/m2/gm2-libs-min/M2RTS.mod
+++ b/gcc/m2/gm2-libs-min/M2RTS.mod
@@ -30,18 +30,31 @@ IMPORT libc, SYSTEM ;
(* we reference these to ensure they are dragged in to the link *)
-PROCEDURE ConstructModules (applicationmodule: ADDRESS;
+PROCEDURE ConstructModules (applicationmodule, libname: ADDRESS;
argc: INTEGER; argv, envp: ADDRESS) ;
BEGIN
END ConstructModules ;
-PROCEDURE DeconstructModules (applicationmodule: ADDRESS;
+PROCEDURE DeconstructModules (applicationmodule, libname: ADDRESS;
argc: INTEGER; argv, envp: ADDRESS) ;
BEGIN
END DeconstructModules ;
+(*
+ RegisterModule - adds module name to the list of outstanding
+ modules which need to have their dependencies
+ explored to determine initialization order.
+*)
+
+PROCEDURE RegisterModule (name, libname: ADDRESS;
+ init, fini: ArgCVEnvP;
+ dependencies: PROC) ;
+BEGIN
+END RegisterModule ;
+
+
(* all these procedures do nothing except satisfy the linker. *)
PROCEDURE ExecuteTerminationProcedures ;
@@ -65,27 +78,15 @@ BEGIN
END NoException ;
-PROCEDURE RequestDependant (modulename, dependantmodule: ADDRESS) ;
-BEGIN
-END RequestDependant ;
-
+(*
+ RequestDependant - used to specify that modulename is dependant upon
+ module dependantmodule.
+*)
-PROCEDURE ConstructModules (applicationmodule: ADDRESS;
- argc: INTEGER; argv, envp: ADDRESS) ;
+PROCEDURE RequestDependant (modulename, libname,
+ dependantmodule, dependantlibname: ADDRESS) ;
BEGIN
-END ConstructModules ;
-
-
-PROCEDURE DeconstructModules (applicationmodule: ADDRESS;
- argc: INTEGER; argv, envp: ADDRESS) ;
-BEGIN
-END DeconstructModules ;
-
+END RequestDependant ;
-PROCEDURE RegisterModule (name: ADDRESS;
- init, fini: ArgCVEnvP;
- dependencies: PROC) ;
-BEGIN
-END RegisterModule ;
END M2RTS.
diff --git a/gcc/m2/gm2-libs/M2Dependent.def b/gcc/m2/gm2-libs/M2Dependent.def
index 5345708d23c..4b77a0704c9 100644
--- a/gcc/m2/gm2-libs/M2Dependent.def
+++ b/gcc/m2/gm2-libs/M2Dependent.def
@@ -33,10 +33,10 @@ TYPE
ArgCVEnvP = PROCEDURE (INTEGER, ADDRESS, ADDRESS) ;
-PROCEDURE ConstructModules (applicationmodule: ADDRESS;
+PROCEDURE ConstructModules (applicationmodule, libname: ADDRESS;
argc: INTEGER; argv, envp: ADDRESS) ;
-PROCEDURE DeconstructModules (applicationmodule: ADDRESS;
+PROCEDURE DeconstructModules (applicationmodule, libname: ADDRESS;
argc: INTEGER; argv, envp: ADDRESS) ;
@@ -46,17 +46,19 @@ PROCEDURE DeconstructModules (applicationmodule: ADDRESS;
explored to determine initialization order.
*)
-PROCEDURE RegisterModule (name: ADDRESS;
+PROCEDURE RegisterModule (modulename, libname: ADDRESS;
init, fini: ArgCVEnvP;
dependencies: PROC) ;
(*
- RequestDependant - used to specify that modulename is dependant upon
- module dependantmodule.
+ RequestDependant - used to specify that modulename:libname
+ is dependant upon
+ module dependantmodule:dependantlibname
*)
-PROCEDURE RequestDependant (modulename, dependantmodule: ADDRESS) ;
+PROCEDURE RequestDependant (modulename, libname,
+ dependantmodule, dependantlibname: ADDRESS) ;
END M2Dependent.
diff --git a/gcc/m2/gm2-libs/M2Dependent.mod b/gcc/m2/gm2-libs/M2Dependent.mod
index f343ac3f185..cc7e9cf3703 100644
--- a/gcc/m2/gm2-libs/M2Dependent.mod
+++ b/gcc/m2/gm2-libs/M2Dependent.mod
@@ -27,11 +27,11 @@ see the files COPYING3 and COPYING.RUNTIME respectively. If not, see
IMPLEMENTATION MODULE M2Dependent ;
-FROM libc IMPORT abort, exit, write, getenv, printf ;
+FROM libc IMPORT abort, exit, write, getenv, printf, snprintf, strncpy ;
(* FROM Builtins IMPORT strncmp, strcmp ; not available during bootstrap. *)
FROM M2LINK IMPORT ForcedModuleInitOrder, StaticInitialization, PtrToChar ;
FROM ASCII IMPORT nul, nl ;
-FROM SYSTEM IMPORT ADR ;
+FROM SYSTEM IMPORT ADR, SIZE ;
FROM Storage IMPORT ALLOCATE ;
FROM StrLib IMPORT StrCopy, StrLen, StrEqual ;
@@ -52,7 +52,8 @@ TYPE
END ;
ModuleChain = POINTER TO RECORD
- name : ADDRESS ;
+ name,
+ libname : ADDRESS ;
init,
fini : ArgCVEnvP ;
dependency: DependencyList ;
@@ -63,7 +64,9 @@ TYPE
VAR
Modules : ARRAY DependencyState OF ModuleChain ;
Initialized,
+ WarningTrace,
ModuleTrace,
+ HexTrace,
DependencyTrace,
PreTrace,
PostTrace,
@@ -75,20 +78,27 @@ VAR
ModuleChain.
*)
-PROCEDURE CreateModule (name: ADDRESS;
+PROCEDURE CreateModule (name, libname: ADDRESS;
init, fini: ArgCVEnvP;
dependencies: PROC) : ModuleChain ;
VAR
- mptr: ModuleChain ;
+ mptr : ModuleChain ;
+ p0, p1: ADDRESS ;
BEGIN
NEW (mptr) ;
mptr^.name := name ;
+ mptr^.libname := libname ;
mptr^.init := init ;
mptr^.fini := fini ;
mptr^.dependency.proc := dependencies ;
mptr^.dependency.state := unregistered ;
mptr^.prev := NIL ;
mptr^.next := NIL ;
+ IF HexTrace
+ THEN
+ printf (" (init: %p fini: %p", init, fini) ;
+ printf (" dep: %p)", dependencies)
+ END ;
RETURN mptr
END CreateModule ;
@@ -157,12 +167,43 @@ END onChain ;
(*
- LookupModuleN - lookup module from the state list. The string is limited
- to nchar.
+ max -
+*)
+
+PROCEDURE max (a, b: CARDINAL) : CARDINAL ;
+BEGIN
+ IF a > b
+ THEN
+ RETURN a
+ ELSE
+ RETURN b
+ END
+END max ;
+
+
+(*
+ min -
+*)
+
+PROCEDURE min (a, b: CARDINAL) : CARDINAL ;
+BEGIN
+ IF a < b
+ THEN
+ RETURN a
+ ELSE
+ RETURN b
+ END
+END min ;
+
+
+(*
+ LookupModuleN - lookup module from the state list.
+ The strings lengths are known.
*)
PROCEDURE LookupModuleN (state: DependencyState;
- name: ADDRESS; nchar: CARDINAL) : ModuleChain ;
+ name: ADDRESS; namelen: CARDINAL;
+ libname: ADDRESS; libnamelen: CARDINAL) : ModuleChain ;
VAR
ptr: ModuleChain ;
BEGIN
@@ -170,7 +211,10 @@ BEGIN
THEN
ptr := Modules[state] ;
REPEAT
- IF strncmp (ptr^.name, name, nchar) = 0
+ IF (strncmp (ptr^.name, name,
+ max (namelen, strlen (ptr^.name))) = 0) AND
+ (strncmp (ptr^.libname, libname,
+ max (libnamelen, strlen (ptr^.libname))) = 0)
THEN
RETURN ptr
END ;
@@ -186,9 +230,11 @@ END LookupModuleN ;
module name from a particular list.
*)
-PROCEDURE LookupModule (state: DependencyState; name: ADDRESS) : ModuleChain ;
+PROCEDURE LookupModule (state: DependencyState; name, libname: ADDRESS) : ModuleChain ;
BEGIN
- RETURN LookupModuleN (state, name, strlen (name))
+ RETURN LookupModuleN (state,
+ name, strlen (name),
+ libname, strlen (libname))
END LookupModule ;
@@ -254,7 +300,10 @@ END strcmp ;
PROCEDURE strncmp (a, b: PtrToChar; n: CARDINAL) : INTEGER ;
BEGIN
- IF (a # NIL) AND (b # NIL) AND (n > 0)
+ IF n = 0
+ THEN
+ RETURN 0
+ ELSIF (a # NIL) AND (b # NIL)
THEN
IF a = b
THEN
@@ -316,15 +365,49 @@ END traceprintf ;
*)
PROCEDURE traceprintf2 (flag: BOOLEAN; str: ARRAY OF CHAR; arg: ADDRESS) ;
+VAR
+ ch: CHAR ;
BEGIN
IF flag
THEN
toCString (str) ;
+ IF arg = NIL
+ THEN
+ ch := 0C ;
+ arg := ADR (ch)
+ END ;
printf (str, arg)
END
END traceprintf2 ;
+(*
+ traceprintf3 - wrap printf with a boolean flag.
+*)
+
+PROCEDURE traceprintf3 (flag: BOOLEAN; str: ARRAY OF CHAR;
+ arg1, arg2: ADDRESS) ;
+VAR
+ ch: CHAR ;
+BEGIN
+ IF flag
+ THEN
+ toCString (str) ;
+ IF arg1 = NIL
+ THEN
+ ch := 0C ;
+ arg1 := ADR (ch)
+ END ;
+ IF arg2 = NIL
+ THEN
+ ch := 0C ;
+ arg2 := ADR (ch)
+ END ;
+ printf (str, arg1, arg2)
+ END
+END traceprintf3 ;
+
+
(*
moveTo - moves mptr to the new list determined by newstate.
It updates the mptr state appropriately.
@@ -345,22 +428,24 @@ END moveTo ;
ResolveDependant -
*)
-PROCEDURE ResolveDependant (mptr: ModuleChain; currentmodule: ADDRESS) ;
+PROCEDURE ResolveDependant (mptr: ModuleChain; currentmodule, libname: ADDRESS) ;
BEGIN
IF mptr = NIL
THEN
- traceprintf (DependencyTrace, " module has not been registered via a global constructor\n");
+ traceprintf3 (DependencyTrace,
+ " module %s [%s] has not been registered via a global constructor\n",
+ currentmodule, libname);
ELSE
IF onChain (started, mptr)
THEN
traceprintf (DependencyTrace, " processing...\n");
ELSE
moveTo (started, mptr) ;
- traceprintf2 (DependencyTrace, " starting: %s\n",
- currentmodule);
+ traceprintf3 (DependencyTrace, " starting: %s [%s]\n",
+ currentmodule, libname);
mptr^.dependency.proc ; (* Invoke and process the dependency graph. *)
- traceprintf2 (DependencyTrace, " finished: %s\n",
- currentmodule);
+ traceprintf3 (DependencyTrace, " finished: %s [%s]\n",
+ currentmodule, libname);
moveTo (ordered, mptr)
END
END
@@ -373,12 +458,14 @@ END ResolveDependant ;
if we are not using StaticInitialization.
*)
-PROCEDURE RequestDependant (modulename, dependantmodule: ADDRESS) ;
+PROCEDURE RequestDependant (modulename, libname,
+ dependantmodule, dependantlibname: ADDRESS) ;
BEGIN
CheckInitialized ;
IF NOT StaticInitialization
THEN
- PerformRequestDependant (modulename, dependantmodule)
+ PerformRequestDependant (modulename, libname,
+ dependantmodule, dependantlibname)
END
END RequestDependant ;
@@ -390,66 +477,73 @@ END RequestDependant ;
resolved.
*)
-PROCEDURE PerformRequestDependant (modulename, dependantmodule: ADDRESS) ;
+PROCEDURE PerformRequestDependant (modulename, libname,
+ dependantmodule, dependantlibname: ADDRESS) ;
VAR
mptr: ModuleChain ;
BEGIN
- traceprintf2 (DependencyTrace, " module %s", modulename) ;
+ traceprintf3 (DependencyTrace, " module %s [%s]", modulename, libname) ;
IF dependantmodule = NIL
THEN
- traceprintf2 (DependencyTrace, " has finished its import graph\n", modulename) ;
- mptr := LookupModule (unordered, modulename) ;
+ traceprintf (DependencyTrace, " has finished its import graph\n") ;
+ mptr := LookupModule (unordered, modulename, libname) ;
IF mptr # NIL
THEN
- traceprintf2 (DependencyTrace, " module %s is now ordered\n", modulename) ;
+ traceprintf3 (DependencyTrace, " module %s [%s] is now ordered\n",
+ modulename, libname) ;
moveTo (ordered, mptr)
END
ELSE
- traceprintf2 (DependencyTrace, " imports from %s\n", dependantmodule) ;
- mptr := LookupModule (ordered, dependantmodule) ;
+ traceprintf3 (DependencyTrace, " imports from %s [%s]\n",
+ dependantmodule, dependantlibname) ;
+ mptr := LookupModule (ordered, dependantmodule, dependantlibname) ;
IF mptr = NIL
THEN
- traceprintf2 (DependencyTrace, " module %s is not ordered\n", dependantmodule) ;
- mptr := LookupModule (unordered, dependantmodule) ;
+ traceprintf3 (DependencyTrace, " module %s [%s] is not ordered\n",
+ dependantmodule, dependantlibname) ;
+ mptr := LookupModule (unordered, dependantmodule, dependantlibname) ;
IF mptr = NIL
THEN
- traceprintf2 (DependencyTrace, " module %s is not unordered\n", dependantmodule) ;
- mptr := LookupModule (started, dependantmodule) ;
+ traceprintf3 (DependencyTrace, " module %s [%s] is not unordered\n",
+ dependantmodule, dependantlibname) ;
+ mptr := LookupModule (started, dependantmodule, dependantlibname) ;
IF mptr = NIL
THEN
- traceprintf2 (DependencyTrace, " module %s has not started\n", dependantmodule) ;
- traceprintf2 (DependencyTrace, " module %s attempting to import from",
- modulename) ;
- traceprintf2 (DependencyTrace, " %s which has not registered itself via a constructor\n",
- dependantmodule)
+ traceprintf3 (DependencyTrace, " module %s [%s] has not started\n",
+ dependantmodule, dependantlibname) ;
+ traceprintf3 (DependencyTrace, " module %s [%s] attempting to import from",
+ modulename, libname) ;
+ traceprintf3 (DependencyTrace, " %s [%s] which has not registered itself via a constructor\n",
+ dependantmodule, dependantlibname)
ELSE
- traceprintf2 (DependencyTrace, " module %s has registered itself and has started\n", dependantmodule)
+ traceprintf3 (DependencyTrace, " module %s [%s] has registered itself and has started\n",
+ dependantmodule, dependantlibname)
END
ELSE
- traceprintf2 (DependencyTrace, " module %s resolving\n", dependantmodule) ;
- ResolveDependant (mptr, dependantmodule)
+ traceprintf3 (DependencyTrace, " module %s [%s] resolving\n", dependantmodule, dependantlibname) ;
+ ResolveDependant (mptr, dependantmodule, dependantlibname)
END
ELSE
- traceprintf2 (DependencyTrace, " module %s ", modulename) ;
- traceprintf2 (DependencyTrace, " dependant %s is ordered\n", dependantmodule)
+ traceprintf3 (DependencyTrace, " module %s [%s]", modulename, libname) ;
+ traceprintf3 (DependencyTrace, " dependant %s [%s] is ordered\n", dependantmodule, dependantlibname)
END
END
END PerformRequestDependant ;
(*
- ResolveDependencies - resolve dependencies for currentmodule.
+ ResolveDependencies - resolve dependencies for currentmodule, libname.
*)
-PROCEDURE ResolveDependencies (currentmodule: ADDRESS) ;
+PROCEDURE ResolveDependencies (currentmodule, libname: ADDRESS) ;
VAR
mptr: ModuleChain ;
BEGIN
- mptr := LookupModule (unordered, currentmodule) ;
+ mptr := LookupModule (unordered, currentmodule, libname) ;
WHILE mptr # NIL DO
- traceprintf2 (DependencyTrace, " attempting to resolve the dependants for %s\n",
- currentmodule);
- ResolveDependant (mptr, currentmodule) ;
+ traceprintf3 (DependencyTrace, " attempting to resolve the dependants for %s [%s]\n",
+ currentmodule, libname);
+ ResolveDependant (mptr, currentmodule, libname) ;
mptr := Modules[unordered]
END
END ResolveDependencies ;
@@ -459,18 +553,23 @@ END ResolveDependencies ;
DisplayModuleInfo - displays all module in the state.
*)
-PROCEDURE DisplayModuleInfo (state: DependencyState; name: ARRAY OF CHAR) ;
+PROCEDURE DisplayModuleInfo (state: DependencyState; desc: ARRAY OF CHAR) ;
VAR
mptr : ModuleChain ;
count: CARDINAL ;
BEGIN
IF Modules[state] # NIL
THEN
- printf ("%s modules\n", ADR (name)) ;
+ printf ("%s modules\n", ADR (desc)) ;
mptr := Modules[state] ;
count := 0 ;
REPEAT
- printf (" %d %s", count, mptr^.name) ;
+ IF mptr^.name = NIL
+ THEN
+ printf (" %d %s []", count, mptr^.name)
+ ELSE
+ printf (" %d %s [%s]", count, mptr^.name, mptr^.libname)
+ END ;
INC (count) ;
IF mptr^.dependency.appl
THEN
@@ -528,6 +627,50 @@ BEGIN
END combine ;
+(*
+ tracemodule -
+*)
+
+PROCEDURE tracemodule (flag: BOOLEAN; modname: ADDRESS; modlen: CARDINAL; libname: ADDRESS; liblen: CARDINAL) ;
+VAR
+ buffer: ARRAY [0..100] OF CHAR ;
+ len : CARDINAL ;
+BEGIN
+ IF flag
+ THEN
+ len := min (modlen, SIZE (buffer)-1) ;
+ strncpy (ADR(buffer), modname, len) ;
+ buffer[len] := 0C ;
+ printf ("%s ", ADR (buffer)) ;
+ len := min (liblen, SIZE (buffer)-1) ;
+ strncpy (ADR(buffer), libname, len) ;
+ buffer[len] := 0C ;
+ printf (" [%s]", ADR (buffer))
+ END
+END tracemodule ;
+
+
+(*
+ ForceModule -
+*)
+
+PROCEDURE ForceModule (modname: ADDRESS; modlen: CARDINAL;
+ libname: ADDRESS; liblen: CARDINAL) ;
+VAR
+ mptr: ModuleChain ;
+BEGIN
+ traceprintf (ForceTrace, "forcing module: ") ;
+ tracemodule (ForceTrace, modname, modlen, libname, liblen) ;
+ traceprintf (ForceTrace, "\n") ;
+ mptr := LookupModuleN (ordered, modname, modlen, libname, liblen) ;
+ IF mptr # NIL
+ THEN
+ mptr^.dependency.forced := TRUE ;
+ moveTo (user, mptr)
+ END
+END ForceModule ;
+
+
(*
ForceDependencies - if the user has specified a forced order then we override
the dynamic ordering with the preference.
@@ -535,42 +678,48 @@ END combine ;
PROCEDURE ForceDependencies ;
VAR
- mptr,
- userChain: ModuleChain ;
- count : CARDINAL ;
+ len,
+ modlen,
+ liblen : CARDINAL ;
+ modname,
+ libname,
pc, start: PtrToChar ;
BEGIN
IF ForcedModuleInitOrder # NIL
THEN
- userChain := NIL ;
+ traceprintf2 (ForceTrace, "user forcing order: %s\n", ForcedModuleInitOrder) ;
pc := ForcedModuleInitOrder ;
start := pc ;
- count := 0 ;
+ len := 0 ;
+ modname := NIL ;
+ modlen := 0 ;
+ libname := NIL ;
+ liblen := 0 ;
WHILE pc^ # nul DO
- IF pc^ = ','
- THEN
- mptr := LookupModuleN (ordered, start, count) ;
- IF mptr # NIL
- THEN
- mptr^.dependency.forced := TRUE ;
- moveTo (user, mptr)
- END ;
- INC (pc) ;
- start := pc ;
- count := 0
+ CASE pc^ OF
+
+ ':': libname := start ;
+ liblen := len ;
+ len := 0 ;
+ INC (pc) ;
+ start := pc |
+ ',': modname := start ;
+ modlen := len ;
+ ForceModule (modname, modlen, libname, liblen) ;
+ libname := NIL ;
+ liblen := 0 ;
+ modlen := 0 ;
+ len := 0 ;
+ INC (pc) ;
+ start := pc
ELSE
INC (pc) ;
- INC (count)
+ INC (len)
END
END ;
IF start # pc
THEN
- mptr := LookupModuleN (ordered, start, count) ;
- IF mptr # NIL
- THEN
- mptr^.dependency.forced := TRUE ;
- moveTo (user, mptr)
- END
+ ForceModule (start, len, libname, liblen)
END ;
combine (user, ordered)
END
@@ -601,7 +750,8 @@ BEGIN
UNTIL (appl # NIL) OR (mptr=Modules[ordered]) ;
IF appl # NIL
THEN
- Modules[ordered] := appl^.next
+ RemoveModule (Modules[ordered], appl) ;
+ AppendModule (Modules[ordered], appl)
END
END
END CheckApplication ;
@@ -612,22 +762,23 @@ END CheckApplication ;
module constructor in turn.
*)
-PROCEDURE ConstructModules (applicationmodule: ADDRESS;
+PROCEDURE ConstructModules (applicationmodule, libname: ADDRESS;
argc: INTEGER; argv, envp: ADDRESS) ;
VAR
mptr: ModuleChain ;
nulp: ArgCVEnvP ;
BEGIN
CheckInitialized ;
- traceprintf2 (ModuleTrace, "application module: %s\n", applicationmodule);
- mptr := LookupModule (unordered, applicationmodule) ;
+ traceprintf3 (ModuleTrace, "application module: %s [%s]\n",
+ applicationmodule, libname);
+ mptr := LookupModule (unordered, applicationmodule, libname) ;
IF mptr # NIL
THEN
mptr^.dependency.appl := TRUE
END ;
traceprintf (PreTrace, "Pre resolving dependents\n");
DumpModuleData (PreTrace) ;
- ResolveDependencies (applicationmodule) ;
+ ResolveDependencies (applicationmodule, libname) ;
traceprintf (PreTrace, "Post resolving dependents\n");
DumpModuleData (PostTrace) ;
ForceDependencies ;
@@ -638,7 +789,8 @@ BEGIN
DumpModuleData (ForceTrace) ;
IF Modules[ordered] = NIL
THEN
- traceprintf2 (ModuleTrace, " module: %s has not registered itself using a global constructor\n", applicationmodule);
+ traceprintf3 (ModuleTrace, " module: %s [%s] has not registered itself using a global constructor\n",
+ applicationmodule, libname);
traceprintf2 (ModuleTrace, " hint try compile and linking using: gm2 %s.mod\n", applicationmodule);
traceprintf2 (ModuleTrace, " or try using: gm2 -fscaffold-static %s.mod\n",
applicationmodule);
@@ -647,13 +799,13 @@ BEGIN
REPEAT
IF mptr^.dependency.forc
THEN
- traceprintf2 (ModuleTrace, "initializing module: %s for C\n", mptr^.name);
+ traceprintf3 (ModuleTrace, "initializing module: %s [%s] for C\n", mptr^.name, mptr^.libname)
ELSE
- traceprintf2 (ModuleTrace, "initializing module: %s\n", mptr^.name);
+ traceprintf3 (ModuleTrace, "initializing module: %s [%s]\n", mptr^.name, mptr^.libname);
END ;
IF mptr^.dependency.appl
THEN
- traceprintf2 (ModuleTrace, "application module: %s\n", mptr^.name);
+ traceprintf3 (ModuleTrace, "application module: %s [%s]\n", mptr^.name, mptr^.libname);
traceprintf (ModuleTrace, " calling M2RTS_ExecuteInitialProcedures\n");
M2RTS.ExecuteInitialProcedures ;
traceprintf (ModuleTrace, " calling application module\n");
@@ -670,12 +822,13 @@ END ConstructModules ;
module constructor in turn.
*)
-PROCEDURE DeconstructModules (applicationmodule: ADDRESS;
+PROCEDURE DeconstructModules (applicationmodule, libname: ADDRESS;
argc: INTEGER; argv, envp: ADDRESS) ;
VAR
mptr: ModuleChain ;
BEGIN
- traceprintf2 (ModuleTrace, "application module finishing: %s\n", applicationmodule);
+ traceprintf3 (ModuleTrace, "application module finishing: %s [%s]\n",
+ applicationmodule, libname);
IF Modules[ordered] = NIL
THEN
traceprintf (ModuleTrace, " no ordered modules found during finishing\n")
@@ -687,9 +840,11 @@ BEGIN
REPEAT
IF mptr^.dependency.forc
THEN
- traceprintf2 (ModuleTrace, "finalizing module: %s for C\n", mptr^.name);
+ traceprintf3 (ModuleTrace, "finalizing module: %s [%s] for C\n",
+ mptr^.name, mptr^.libname)
ELSE
- traceprintf2 (ModuleTrace, "finalizing module: %s\n", mptr^.name);
+ traceprintf3 (ModuleTrace, "finalizing module: %s [%s]\n",
+ mptr^.name, mptr^.libname)
END ;
mptr^.fini (argc, argv, envp) ;
mptr := mptr^.prev
@@ -698,23 +853,52 @@ BEGIN
END DeconstructModules ;
+(*
+ warning3 - write format arg1 arg2 to stderr.
+*)
+
+PROCEDURE warning3 (format: ARRAY OF CHAR; arg1, arg2: ADDRESS) ;
+VAR
+ buffer: ARRAY [0..4096] OF CHAR ;
+ len : INTEGER ;
+BEGIN
+ IF WarningTrace
+ THEN
+ len := snprintf (ADR (buffer), SIZE (buffer), "warning: ") ;
+ write (2, ADR (buffer), len) ;
+ len := snprintf (ADR (buffer), SIZE (buffer), format, arg1, arg2) ;
+ write (2, ADR (buffer), len)
+ END
+END warning3 ;
+
+
(*
RegisterModule - adds module name to the list of outstanding
modules which need to have their dependencies
explored to determine initialization order.
*)
-PROCEDURE RegisterModule (name: ADDRESS;
+PROCEDURE RegisterModule (modulename, libname: ADDRESS;
init, fini: ArgCVEnvP;
dependencies: PROC) ;
+VAR
+ mptr: ModuleChain ;
BEGIN
CheckInitialized ;
IF NOT StaticInitialization
THEN
- traceprintf2 (ModuleTrace, "module: %s registering\n",
- name);
- moveTo (unordered,
- CreateModule (name, init, fini, dependencies))
+ mptr := LookupModule (unordered, modulename, libname) ;
+ IF mptr = NIL
+ THEN
+ traceprintf3 (ModuleTrace, "module: %s [%s] registering",
+ modulename, libname);
+ moveTo (unordered,
+ CreateModule (modulename, libname, init, fini, dependencies)) ;
+ traceprintf (ModuleTrace, "\n") ;
+ ELSE
+ warning3 ("module: %s [%s] (ignoring duplicate registration)\n",
+ modulename, libname)
+ END
END
END RegisterModule ;
@@ -733,11 +917,12 @@ END equal ;
SetupDebugFlags - By default assigns ModuleTrace, DependencyTrace,
DumpPostInit to FALSE. It checks the environment
GCC_M2LINK_RTFLAG which can contain
- "all,module,pre,post,dep,force". all turns them all on.
+ "all,module,hex,pre,post,dep,force". all turns them all on.
The flag meanings are as follows and flags the are in
execution order.
module generate trace info as the modules are registered.
+ hex dump the modules ctor functions address in hex.
pre generate a list of all modules seen prior to having
their dependancies resolved.
dep display a trace as the modules are resolved.
@@ -756,6 +941,8 @@ BEGIN
PostTrace := FALSE ;
PreTrace := FALSE ;
ForceTrace := FALSE ;
+ HexTrace := FALSE ;
+ WarningTrace := FALSE ;
pc := getenv (ADR ("GCC_M2LINK_RTFLAG")) ;
WHILE (pc # NIL) AND (pc^ # nul) DO
IF equal (pc, "all")
@@ -765,11 +952,21 @@ BEGIN
PreTrace := TRUE ;
PostTrace := TRUE ;
ForceTrace := TRUE ;
+ HexTrace := TRUE ;
+ WarningTrace := TRUE ;
INC (pc, 3)
ELSIF equal (pc, "module")
THEN
ModuleTrace := TRUE ;
INC (pc, 6)
+ ELSIF equal (pc, "warning")
+ THEN
+ WarningTrace := TRUE ;
+ INC (pc, 7)
+ ELSIF equal (pc, "hex")
+ THEN
+ HexTrace := TRUE ;
+ INC (pc, 3)
ELSIF equal (pc, "dep")
THEN
DependencyTrace := TRUE ;
diff --git a/gcc/m2/gm2-libs/M2RTS.def b/gcc/m2/gm2-libs/M2RTS.def
index 167f96423e2..ca6010b42c3 100644
--- a/gcc/m2/gm2-libs/M2RTS.def
+++ b/gcc/m2/gm2-libs/M2RTS.def
@@ -33,10 +33,10 @@ TYPE
ArgCVEnvP = PROCEDURE (INTEGER, ADDRESS, ADDRESS) ;
-PROCEDURE ConstructModules (applicationmodule: ADDRESS;
+PROCEDURE ConstructModules (applicationmodule, libname: ADDRESS;
argc: INTEGER; argv, envp: ADDRESS) ;
-PROCEDURE DeconstructModules (applicationmodule: ADDRESS;
+PROCEDURE DeconstructModules (applicationmodule, libname: ADDRESS;
argc: INTEGER; argv, envp: ADDRESS) ;
@@ -46,7 +46,7 @@ PROCEDURE DeconstructModules (applicationmodule: ADDRESS;
explored to determine initialization order.
*)
-PROCEDURE RegisterModule (name: ADDRESS;
+PROCEDURE RegisterModule (name, libname: ADDRESS;
init, fini: ArgCVEnvP;
dependencies: PROC) ;
@@ -56,7 +56,8 @@ PROCEDURE RegisterModule (name: ADDRESS;
module dependantmodule.
*)
-PROCEDURE RequestDependant (modulename, dependantmodule: ADDRESS) ;
+PROCEDURE RequestDependant (modulename, libname,
+ dependantmodule, dependantlibname: ADDRESS) ;
(*
diff --git a/gcc/m2/gm2-libs/M2RTS.mod b/gcc/m2/gm2-libs/M2RTS.mod
index 4280fec7dc7..d01f6a68f92 100644
--- a/gcc/m2/gm2-libs/M2RTS.mod
+++ b/gcc/m2/gm2-libs/M2RTS.mod
@@ -70,10 +70,11 @@ VAR
module constructor in turn.
*)
-PROCEDURE ConstructModules (applicationmodule: ADDRESS;
+PROCEDURE ConstructModules (applicationmodule, libname: ADDRESS;
argc: INTEGER; argv, envp: ADDRESS) ;
BEGIN
- M2Dependent.ConstructModules (applicationmodule, argc, argv, envp)
+ M2Dependent.ConstructModules (applicationmodule, libname,
+ argc, argv, envp)
END ConstructModules ;
@@ -82,10 +83,11 @@ END ConstructModules ;
module constructor in turn.
*)
-PROCEDURE DeconstructModules (applicationmodule: ADDRESS;
+PROCEDURE DeconstructModules (applicationmodule, libname: ADDRESS;
argc: INTEGER; argv, envp: ADDRESS) ;
BEGIN
- M2Dependent.DeconstructModules (applicationmodule, argc, argv, envp)
+ M2Dependent.DeconstructModules (applicationmodule, libname,
+ argc, argv, envp)
END DeconstructModules ;
@@ -95,11 +97,11 @@ END DeconstructModules ;
explored to determine initialization order.
*)
-PROCEDURE RegisterModule (name: ADDRESS;
+PROCEDURE RegisterModule (name, libname: ADDRESS;
init, fini: ArgCVEnvP;
dependencies: PROC) ;
BEGIN
- M2Dependent.RegisterModule (name, init, fini, dependencies)
+ M2Dependent.RegisterModule (name, libname, init, fini, dependencies)
END RegisterModule ;
@@ -108,9 +110,11 @@ END RegisterModule ;
module dependantmodule.
*)
-PROCEDURE RequestDependant (modulename, dependantmodule: ADDRESS) ;
+PROCEDURE RequestDependant (modulename, libname,
+ dependantmodule, dependantlibname: ADDRESS) ;
BEGIN
- M2Dependent.RequestDependant (modulename, dependantmodule)
+ M2Dependent.RequestDependant (modulename, libname,
+ dependantmodule, dependantlibname)
END RequestDependant ;
diff --git a/gcc/m2/gm2-libs/RTint.mod b/gcc/m2/gm2-libs/RTint.mod
index d8ca8dd5694..97fdee24760 100644
--- a/gcc/m2/gm2-libs/RTint.mod
+++ b/gcc/m2/gm2-libs/RTint.mod
@@ -97,21 +97,21 @@ END Min ;
(*
- FindVector - searches the exists list for a vector of type, t,
+ FindVector - searches the exists list for a vector of type
which is associated with file descriptor, fd.
*)
-PROCEDURE FindVector (fd: INTEGER; t: VectorType) : Vector ;
+PROCEDURE FindVector (fd: INTEGER; type: VectorType) : Vector ;
VAR
- v: Vector ;
+ vec: Vector ;
BEGIN
- v := Exists ;
- WHILE v#NIL DO
- IF (v^.type=t) AND (v^.File=fd)
+ vec := Exists ;
+ WHILE vec#NIL DO
+ IF (vec^.type=type) AND (vec^.File=fd)
THEN
- RETURN v
+ RETURN vec
END ;
- v := v^.exists
+ vec := vec^.exists
END ;
RETURN NIL
END FindVector ;
@@ -124,19 +124,19 @@ END FindVector ;
PROCEDURE InitInputVector (fd: INTEGER; pri: CARDINAL) : CARDINAL ;
VAR
- v: Vector ;
+ vptr: Vector ;
BEGIN
IF Debugging
THEN
printf("InitInputVector fd = %d priority = %d\n", fd, pri)
END ;
wait (lock) ;
- v := FindVector(fd, input) ;
- IF v=NIL
+ vptr := FindVector(fd, input) ;
+ IF vptr = NIL
THEN
- NEW(v) ;
- INC(VecNo) ;
- WITH v^ DO
+ NEW (vptr) ;
+ INC (VecNo) ;
+ WITH vptr^ DO
type := input ;
priority := pri ;
arg := NIL ;
@@ -145,12 +145,12 @@ BEGIN
no := VecNo ;
File := fd
END ;
- Exists := v ;
+ Exists := vptr ;
signal (lock) ;
RETURN VecNo
ELSE
signal (lock) ;
- RETURN v^.no
+ RETURN vptr^.no
END
END InitInputVector ;
@@ -162,19 +162,19 @@ END InitInputVector ;
PROCEDURE InitOutputVector (fd: INTEGER; pri: CARDINAL) : CARDINAL ;
VAR
- v: Vector ;
+ vptr: Vector ;
BEGIN
wait (lock) ;
- v := FindVector (fd, output) ;
- IF v=NIL
+ vptr := FindVector (fd, output) ;
+ IF vptr = NIL
THEN
- NEW (v) ;
- IF v = NIL
+ NEW (vptr) ;
+ IF vptr = NIL
THEN
HALT
ELSE
INC (VecNo) ;
- WITH v^ DO
+ WITH vptr^ DO
type := output ;
priority := pri ;
arg := NIL ;
@@ -183,13 +183,13 @@ BEGIN
no := VecNo ;
File := fd
END ;
- Exists := v ;
+ Exists := vptr ;
signal (lock) ;
RETURN VecNo
END
ELSE
signal (lock) ;
- RETURN v^.no
+ RETURN vptr^.no
END
END InitOutputVector ;
@@ -201,28 +201,28 @@ END InitOutputVector ;
PROCEDURE InitTimeVector (micro, secs: CARDINAL; pri: CARDINAL) : CARDINAL ;
VAR
- v: Vector ;
+ vptr: Vector ;
BEGIN
wait (lock) ;
- NEW (v) ;
- IF v = NIL
+ NEW (vptr) ;
+ IF vptr = NIL
THEN
HALT
ELSE
INC (VecNo) ;
Assert (micro<Microseconds) ;
- WITH v^ DO
+ WITH vptr^ DO
type := time ;
priority := pri ;
arg := NIL ;
pending := NIL ;
exists := Exists ;
no := VecNo ;
- rel := InitTime(secs+DebugTime, micro) ;
- abs := InitTime(0, 0) ;
+ rel := InitTime (secs+DebugTime, micro) ;
+ abs := InitTime (0, 0) ;
queued := FALSE
END ;
- Exists := v
+ Exists := vptr
END ;
signal (lock) ;
RETURN VecNo
@@ -230,18 +230,18 @@ END InitTimeVector ;
(*
- FindVectorNo - searches the Exists list for vector, vec.
+ FindVectorNo - searches the Exists list for vector vec.
*)
PROCEDURE FindVectorNo (vec: CARDINAL) : Vector ;
VAR
- v: Vector ;
+ vptr: Vector ;
BEGIN
- v := Exists ;
- WHILE (v#NIL) AND (v^.no#vec) DO
- v := v^.exists
+ vptr := Exists ;
+ WHILE (vptr#NIL) AND (vptr^.no#vec) DO
+ vptr := vptr^.exists
END ;
- RETURN v
+ RETURN vptr
END FindVectorNo ;
@@ -251,17 +251,17 @@ END FindVectorNo ;
PROCEDURE FindPendingVector (vec: CARDINAL) : Vector ;
VAR
- i: CARDINAL ;
- v: Vector ;
+ pri : CARDINAL ;
+ vptr: Vector ;
BEGIN
- FOR i := MIN(PROTECTION) TO MAX(PROTECTION) DO
- v := Pending[i] ;
- WHILE (v#NIL) AND (v^.no#vec) DO
- v := v^.pending
+ FOR pri := MIN(PROTECTION) TO MAX(PROTECTION) DO
+ vptr := Pending[pri] ;
+ WHILE (vptr#NIL) AND (vptr^.no#vec) DO
+ vptr := vptr^.pending
END ;
- IF (v#NIL) AND (v^.no=vec)
+ IF (vptr#NIL) AND (vptr^.no=vec)
THEN
- RETURN v
+ RETURN vptr
END
END ;
RETURN NIL
@@ -276,17 +276,17 @@ END FindPendingVector ;
PROCEDURE ReArmTimeVector (vec: CARDINAL;
micro, secs: CARDINAL) ;
VAR
- v: Vector ;
+ vptr: Vector ;
BEGIN
- Assert(micro<Microseconds) ;
+ Assert (micro<Microseconds) ;
wait (lock) ;
- v := FindVectorNo(vec) ;
- IF v=NIL
+ vptr := FindVectorNo (vec) ;
+ IF vptr = NIL
THEN
- Halt(__FILE__, __LINE__, __FUNCTION__,
- 'cannot find vector supplied')
+ Halt (__FILE__, __LINE__, __FUNCTION__,
+ 'cannot find vector supplied')
ELSE
- WITH v^ DO
+ WITH vptr^ DO
SetTime (rel, secs + DebugTime, micro)
END
END ;
@@ -303,16 +303,16 @@ END ReArmTimeVector ;
PROCEDURE GetTimeVector (vec: CARDINAL; VAR micro, secs: CARDINAL) ;
VAR
- v: Vector ;
+ vptr: Vector ;
BEGIN
wait (lock) ;
- v := FindVectorNo (vec) ;
- IF v=NIL
+ vptr := FindVectorNo (vec) ;
+ IF vptr=NIL
THEN
- Halt(__FILE__, __LINE__, __FUNCTION__,
- 'cannot find vector supplied')
+ Halt (__FILE__, __LINE__, __FUNCTION__,
+ 'cannot find vector supplied')
ELSE
- WITH v^ DO
+ WITH vptr^ DO
GetTime (rel, secs, micro) ;
Assert (micro < Microseconds)
END
@@ -322,31 +322,31 @@ END GetTimeVector ;
(*
- AttachVector - adds the pointer, p, to be associated with the interrupt
+ AttachVector - adds the pointer ptr to be associated with the interrupt
vector. It returns the previous value attached to this
vector.
*)
-PROCEDURE AttachVector (vec: CARDINAL; p: ADDRESS) : ADDRESS ;
+PROCEDURE AttachVector (vec: CARDINAL; ptr: ADDRESS) : ADDRESS ;
VAR
- v: Vector ;
- l: ADDRESS ;
+ vptr : Vector ;
+ prevArg: ADDRESS ;
BEGIN
wait (lock) ;
- v := FindVectorNo (vec) ;
- IF v=NIL
+ vptr := FindVectorNo (vec) ;
+ IF vptr = NIL
THEN
Halt (__FILE__, __LINE__, __FUNCTION__, 'cannot find vector supplied')
ELSE
- l := v^.arg ;
- v^.arg := p ;
+ prevArg := vptr^.arg ;
+ vptr^.arg := ptr ;
IF Debugging
THEN
- printf ("AttachVector %d with 0x%x\n", vec, p);
+ printf ("AttachVector %d with %p\n", vec, ptr);
DumpPendingQueue ;
END ;
signal (lock) ;
- RETURN l
+ RETURN prevArg
END
END AttachVector ;
@@ -358,42 +358,41 @@ END AttachVector ;
PROCEDURE IncludeVector (vec: CARDINAL) ;
VAR
- v : Vector ;
- m, s: CARDINAL ;
- r : INTEGER ;
+ vptr : Vector ;
+ micro, sec: CARDINAL ;
+ result : INTEGER ;
BEGIN
wait (lock) ;
- v := FindPendingVector (vec) ;
- IF v=NIL
+ vptr := FindPendingVector (vec) ;
+ IF vptr = NIL
THEN
- v := FindVectorNo (vec) ;
- IF v = NIL
+ vptr := FindVectorNo (vec) ;
+ IF vptr = NIL
THEN
Halt (__FILE__, __LINE__, __FUNCTION__,
'cannot find vector supplied') ;
ELSE
(* printf('including vector %d (fd = %d)\n', vec, v^.File) ; *)
- v^.pending := Pending[v^.priority] ;
- Pending[v^.priority] := v ;
- IF (v^.type = time) AND (NOT v^.queued)
+ vptr^.pending := Pending[vptr^.priority] ;
+ Pending[vptr^.priority] := vptr ;
+ IF (vptr^.type = time) AND (NOT vptr^.queued)
THEN
- v^.queued := TRUE ;
- r := GetTimeOfDay (v^.abs) ;
- Assert (r=0) ;
- GetTime (v^.abs, s, m) ;
- Assert (m<Microseconds) ;
- AddTime (v^.abs, v^.rel) ;
- GetTime (v^.abs, s, m) ;
- Assert (m<Microseconds)
+ vptr^.queued := TRUE ;
+ result := GetTimeOfDay (vptr^.abs) ;
+ Assert (result=0) ;
+ GetTime (vptr^.abs, sec, micro) ;
+ Assert (micro<Microseconds) ;
+ AddTime (vptr^.abs, vptr^.rel) ;
+ GetTime (vptr^.abs, sec, micro) ;
+ Assert (micro<Microseconds)
END
END
ELSE
IF Debugging
THEN
- printf ('odd vector (%d) type (%d) arg (0x%x) is already attached to the pending queue\n',
- vec, v^.type, v^.arg)
- END ;
- stop
+ printf ('odd vector (%d) type (%d) arg (%p) is already attached to the pending queue\n',
+ vec, vptr^.type, vptr^.arg)
+ END
END ;
signal (lock)
END IncludeVector ;
@@ -406,29 +405,29 @@ END IncludeVector ;
PROCEDURE ExcludeVector (vec: CARDINAL) ;
VAR
- v, u: Vector ;
+ vptr, uptr: Vector ;
BEGIN
wait (lock) ;
- v := FindPendingVector(vec) ;
- IF v=NIL
+ vptr := FindPendingVector (vec) ;
+ IF vptr = NIL
THEN
Halt (__FILE__, __LINE__, __FUNCTION__,
'cannot find pending vector supplied')
ELSE
(* printf('excluding vector %d\n', vec) ; *)
- IF Pending[v^.priority]=v
+ IF Pending[vptr^.priority] = vptr
THEN
- Pending[v^.priority] := Pending[v^.priority]^.pending
+ Pending[vptr^.priority] := Pending[vptr^.priority]^.pending
ELSE
- u := Pending[v^.priority] ;
- WHILE u^.pending#v DO
- u := u^.pending
+ uptr := Pending[vptr^.priority] ;
+ WHILE uptr^.pending#vptr DO
+ uptr := uptr^.pending
END ;
- u^.pending := v^.pending
+ uptr^.pending := vptr^.pending
END ;
- IF v^.type=time
+ IF vptr^.type=time
THEN
- v^.queued := FALSE
+ vptr^.queued := FALSE
END
END ;
signal (lock)
@@ -436,18 +435,18 @@ END ExcludeVector ;
(*
- AddFd - adds the file descriptor, fd, to set, s, updating, max.
+ AddFd - adds the file descriptor fd to set updating max.
*)
-PROCEDURE AddFd (VAR s: SetOfFd; VAR max: INTEGER; fd: INTEGER) ;
+PROCEDURE AddFd (VAR set: SetOfFd; VAR max: INTEGER; fd: INTEGER) ;
BEGIN
max := Max (fd, max) ;
- IF s = NIL
+ IF set = NIL
THEN
- s := InitSet () ;
- FdZero (s)
+ set := InitSet () ;
+ FdZero (set)
END ;
- FdSet (fd, s)
+ FdSet (fd, set)
(* printf('%d, ', fd) *)
END AddFd ;
@@ -458,36 +457,33 @@ END AddFd ;
PROCEDURE DumpPendingQueue ;
VAR
- p : PROTECTION ;
- v : Vector ;
- s, m: CARDINAL ;
+ pri : PROTECTION ;
+ vptr : Vector ;
+ sec,
+ micro: CARDINAL ;
BEGIN
printf ("Pending queue\n");
- FOR p := MIN (PROTECTION) TO MAX (PROTECTION) DO
- printf ("[%d] ", p);
- v := Pending[p] ;
- WHILE v#NIL DO
- IF (v^.type=input) OR (v^.type=output)
+ FOR pri := MIN (PROTECTION) TO MAX (PROTECTION) DO
+ printf ("[%d] ", pri);
+ vptr := Pending[pri] ;
+ WHILE vptr # NIL DO
+ IF (vptr^.type=input) OR (vptr^.type=output)
THEN
- printf ("(fd=%d) (vec=%d)", v^.File, v^.no)
- ELSIF v^.type=time
+ printf ("(fd=%d) (vec=%d)", vptr^.File, vptr^.no)
+ ELSIF vptr^.type=time
THEN
- GetTime(v^.rel, s, m) ;
- Assert (m<Microseconds) ;
- printf ("time (%u.%06u secs) (arg = 0x%x)\n", s, m, v^.arg)
+ GetTime (vptr^.rel, sec, micro) ;
+ Assert (micro < Microseconds) ;
+ printf ("time (%u.%06u secs) (arg = %p)\n",
+ sec, micro, vptr^.arg)
END ;
- v := v^.pending
+ vptr := vptr^.pending
END ;
printf (" \n")
END
END DumpPendingQueue ;
-PROCEDURE stop ;
-BEGIN
-END stop ;
-
-
(*
AddTime - t1 := t1 + t2
*)
@@ -565,63 +561,64 @@ END SubTime ;
*)
PROCEDURE activatePending (untilInterrupt: BOOLEAN; call: DispatchVector; pri: CARDINAL;
- maxFd: INTEGER; VAR i, o: SetOfFd; VAR t: Timeval; b4, after: Timeval) : BOOLEAN ;
+ maxFd: INTEGER; VAR inSet, outSet: SetOfFd; VAR timeval: Timeval; b4, after: Timeval) : BOOLEAN ;
VAR
- r : INTEGER ;
- p : CARDINAL ;
- v : Vector ;
+ result: INTEGER ;
+ p : CARDINAL ;
+ vec : Vector ;
b4s,
b4m,
afs,
afm,
- s, m: CARDINAL ;
+ sec,
+ micro : CARDINAL ;
BEGIN
wait (lock) ;
p := MAX (PROTECTION) ;
WHILE p > pri DO
- v := Pending[p] ;
- WHILE v # NIL DO
- WITH v^ DO
+ vec := Pending[p] ;
+ WHILE vec # NIL DO
+ WITH vec^ DO
CASE type OF
- input : IF (File < maxFd) AND (i # NIL) AND FdIsSet (File, i)
+ input : IF (File < maxFd) AND (inSet # NIL) AND FdIsSet (File, inSet)
THEN
IF Debugging
THEN
printf ('read (fd=%d) is ready (vec=%d)\n', File, no) ;
DumpPendingQueue
END ;
- FdClr (File, i) ; (* so we dont activate this again from our select. *)
+ FdClr (File, inSet) ; (* so we dont activate this again from our select. *)
signal (lock) ;
call (no, priority, arg) ;
RETURN TRUE
END |
- output: IF (File < maxFd) AND (o#NIL) AND FdIsSet (File, o)
+ output: IF (File < maxFd) AND (outSet#NIL) AND FdIsSet (File, outSet)
THEN
IF Debugging
THEN
printf ('write (fd=%d) is ready (vec=%d)\n', File, no) ;
DumpPendingQueue
END ;
- FdClr (File, o) ; (* so we dont activate this again from our select. *)
+ FdClr (File, outSet) ; (* so we dont activate this again from our select. *)
signal (lock) ;
call (no, priority, arg) ;
RETURN TRUE
END |
- time : IF untilInterrupt AND (t # NIL)
+ time : IF untilInterrupt AND (timeval # NIL)
THEN
- r := GetTimeOfDay (after) ;
- Assert (r=0) ;
+ result := GetTimeOfDay (after) ;
+ Assert (result=0) ;
IF Debugging
THEN
- GetTime (t, s, m) ;
- Assert (m < Microseconds) ;
+ GetTime (timeval, sec, micro) ;
+ Assert (micro < Microseconds) ;
GetTime (after, afs, afm) ;
Assert (afm < Microseconds) ;
GetTime (b4, b4s, b4m) ;
Assert (b4m < Microseconds) ;
printf ("waited %u.%06u + %u.%06u now is %u.%06u\n",
- s, m, b4s, b4m, afs, afm) ;
+ sec, micro, b4s, b4m, afs, afm) ;
END ;
IF IsGreaterEqual (after, abs)
THEN
@@ -630,7 +627,7 @@ BEGIN
DumpPendingQueue ;
printf ("time has expired calling dispatcher\n")
END ;
- t := KillTime (t) ; (* so we dont activate this again from our select. *)
+ timeval := KillTime (timeval) ; (* so we dont activate this again from our select. *)
signal (lock) ;
IF Debugging
THEN
@@ -645,7 +642,7 @@ BEGIN
END
END
END ;
- v := v^.pending
+ vec := vec^.pending
END ;
DEC (p)
END ;
@@ -667,20 +664,22 @@ PROCEDURE Listen (untilInterrupt: BOOLEAN;
call: DispatchVector;
pri: CARDINAL) ;
VAR
- found: BOOLEAN ;
- r : INTEGER ;
+ found : BOOLEAN ;
+ result : INTEGER ;
after,
b4,
- t : Timeval ;
- v : Vector ;
- i, o : SetOfFd ;
+ timeval: Timeval ;
+ vec : Vector ;
+ inSet,
+ outSet : SetOfFd ;
b4s,
b4m,
afs,
afm,
- s, m : CARDINAL ;
- maxFd: INTEGER ;
- p : CARDINAL ;
+ sec,
+ micro : CARDINAL ;
+ maxFd : INTEGER ;
+ p : CARDINAL ;
BEGIN
wait (lock) ;
IF pri < MAX (PROTECTION)
@@ -690,120 +689,120 @@ BEGIN
DumpPendingQueue
END ;
maxFd := -1 ;
- t := NIL ;
- i := NIL ;
- o := NIL ;
- t := InitTime (MAX (INTEGER), 0) ;
+ timeval := NIL ;
+ inSet := NIL ;
+ outSet := NIL ;
+ timeval := InitTime (MAX (INTEGER), 0) ;
p := MAX (PROTECTION) ;
found := FALSE ;
WHILE p>pri DO
- v := Pending[p] ;
- WHILE v#NIL DO
- WITH v^ DO
+ vec := Pending[p] ;
+ WHILE vec#NIL DO
+ WITH vec^ DO
CASE type OF
- input : AddFd (i, maxFd, File) |
- output: AddFd (o, maxFd, File) |
- time : IF IsGreaterEqual (t, abs)
+ input : AddFd (inSet, maxFd, File) |
+ output: AddFd (outSet, maxFd, File) |
+ time : IF IsGreaterEqual (timeval, abs)
THEN
- GetTime (abs, s, m) ;
- Assert (m<Microseconds) ;
+ GetTime (abs, sec, micro) ;
+ Assert (micro < Microseconds) ;
IF Debugging
THEN
- printf ("shortest delay is %u.%06u\n", s, m)
+ printf ("shortest delay is %u.%06u\n", sec, micro)
END ;
- SetTime (t, s, m) ;
+ SetTime (timeval, sec, micro) ;
found := TRUE
END
END
END ;
- v := v^.pending
+ vec := vec^.pending
END ;
DEC (p)
END ;
IF NOT untilInterrupt
THEN
- SetTime (t, 0, 0)
+ SetTime (timeval, 0, 0)
END ;
- IF untilInterrupt AND (i=NIL) AND (o=NIL) AND (NOT found)
+ IF untilInterrupt AND (inSet=NIL) AND (outSet=NIL) AND (NOT found)
THEN
Halt (__FILE__, __LINE__, __FUNCTION__,
'deadlock found, no more processes to run and no interrupts active')
END ;
- (* printf('timeval = 0x%x\n', t) ; *)
+ (* printf('timeval = 0x%x\n', timeval) ; *)
(* printf('}\n') ; *)
- IF (NOT found) AND (maxFd=-1) AND (i=NIL) AND (o=NIL)
+ IF (NOT found) AND (maxFd=-1) AND (inSet=NIL) AND (outSet=NIL)
THEN
(* no file descriptors to be selected upon. *)
- t := KillTime (t) ;
+ timeval := KillTime (timeval) ;
signal (lock) ;
RETURN
ELSE
- GetTime (t, s, m) ;
- Assert (m<Microseconds) ;
+ GetTime (timeval, sec, micro) ;
+ Assert (micro < Microseconds) ;
b4 := InitTime (0, 0) ;
after := InitTime (0, 0) ;
- r := GetTimeOfDay (b4) ;
- Assert (r=0) ;
- SubTime (s, m, t, b4) ;
- SetTime (t, s, m) ;
+ result := GetTimeOfDay (b4) ;
+ Assert (result=0) ;
+ SubTime (sec, micro, timeval, b4) ;
+ SetTime (timeval, sec, micro) ;
IF Debugging
THEN
- printf ("select waiting for %u.%06u seconds\n", s, m)
+ printf ("select waiting for %u.%06u seconds\n", sec, micro)
END ;
signal (lock) ;
REPEAT
IF Debugging
THEN
- printf ("select (.., .., .., %u.%06u)\n", s, m)
+ printf ("select (.., .., .., %u.%06u)\n", sec, micro)
END ;
- r := select (maxFd+1, i, o, NIL, t) ;
- IF r=-1
+ result := select (maxFd+1, inSet, outSet, NIL, timeval) ;
+ IF result=-1
THEN
perror ("select") ;
- r := select (maxFd+1, i, o, NIL, NIL) ;
- IF r=-1
+ result := select (maxFd+1, inSet, outSet, NIL, NIL) ;
+ IF result=-1
THEN
perror ("select timeout argument is faulty")
END ;
- r := select (maxFd+1, i, NIL, NIL, t) ;
- IF r=-1
+ result := select (maxFd+1, inSet, NIL, NIL, timeval) ;
+ IF result=-1
THEN
perror ("select output fd argument is faulty")
END ;
- r := select (maxFd+1, NIL, o, NIL, t) ;
- IF r=-1
+ result := select (maxFd+1, NIL, outSet, NIL, timeval) ;
+ IF result=-1
THEN
perror ("select input fd argument is faulty")
ELSE
perror ("select maxFD+1 argument is faulty")
END
END
- UNTIL r#-1
+ UNTIL result#-1
END ;
WHILE activatePending (untilInterrupt, call, pri,
- maxFd+1, i, o, t, b4, after) DO
+ maxFd+1, inSet, outSet, timeval, b4, after) DO
END ;
- IF t#NIL
+ IF timeval#NIL
THEN
- t := KillTime (t)
+ timeval := KillTime (timeval)
END ;
IF after#NIL
THEN
- t := KillTime (after)
+ after := KillTime (after)
END ;
IF b4#NIL
THEN
- t := KillTime (b4)
+ b4 := KillTime (b4)
END ;
- IF i#NIL
+ IF inSet#NIL
THEN
- i := KillSet (i)
+ inSet := KillSet (inSet)
END ;
- IF o#NIL
+ IF outSet#NIL
THEN
- o := KillSet (o)
+ outSet := KillSet (outSet)
END
END ;
signal (lock)
diff --git a/gcc/m2/gm2-libs/libc.def b/gcc/m2/gm2-libs/libc.def
index 120a9d0c319..21c790edd24 100644
--- a/gcc/m2/gm2-libs/libc.def
+++ b/gcc/m2/gm2-libs/libc.def
@@ -42,7 +42,8 @@ EXPORT UNQUALIFIED time_t, timeb, tm, ptrToTM,
memcpy, memset, memmove, printf, realloc,
rand, srand,
time, localtime, ftime,
- shutdown, rename, setjmp, longjmp, atexit,
+ shutdown, snprintf,
+ rename, setjmp, longjmp, atexit,
ttyname, sleep, execv ;
@@ -360,6 +361,13 @@ PROCEDURE memmove (dest, src: ADDRESS; size: CSIZE_T) : [ ADDRESS ] ;
PROCEDURE printf (format: ARRAY OF CHAR; ...) : [ INTEGER ] ;
+(*
+ int snprintf(char *str, size_t size, const char *format, ...);
+*)
+
+PROCEDURE snprintf (dest: ADDRESS; size: CSIZE_T;
+ format: ARRAY OF CHAR; ...) : [ INTEGER ] ;
+
(*
setenv - sets environment variable, name, to value.
It will overwrite an existing value if, overwrite,
diff --git a/gcc/m2/gm2-libs/sckt.def b/gcc/m2/gm2-libs/sckt.def
index 6be7db89713..ac5111025fb 100644
--- a/gcc/m2/gm2-libs/sckt.def
+++ b/gcc/m2/gm2-libs/sckt.def
@@ -27,14 +27,14 @@ see the files COPYING3 and COPYING.RUNTIME respectively. If not, see
DEFINITION MODULE sckt ;
FROM SYSTEM IMPORT ADDRESS ;
-EXPORT UNQUALIFIED tcpServerState,
- tcpServerEstablish, tcpServerEstablishPort,
- tcpServerAccept, getLocalIP,
- tcpServerPortNo, tcpServerIP, tcpServerSocketFd,
- tcpServerClientIP, tcpServerClientPortNo,
- tcpClientState,
- tcpClientSocket, tcpClientSocketIP, tcpClientConnect,
- tcpClientPortNo, tcpClientIP, tcpClientSocketFd ;
+EXPORT QUALIFIED tcpServerState,
+ tcpServerEstablish, tcpServerEstablishPort,
+ tcpServerAccept, getLocalIP,
+ tcpServerPortNo, tcpServerIP, tcpServerSocketFd,
+ tcpServerClientIP, tcpServerClientPortNo,
+ tcpClientState,
+ tcpClientSocket, tcpClientSocketIP, tcpClientConnect,
+ tcpClientPortNo, tcpClientIP, tcpClientSocketFd ;
TYPE
tcpServerState = ADDRESS ;
diff --git a/gcc/m2/gm2spec.cc b/gcc/m2/gm2spec.cc
index 0645be9fe02..a118a8818f6 100644
--- a/gcc/m2/gm2spec.cc
+++ b/gcc/m2/gm2spec.cc
@@ -31,6 +31,8 @@ along with GNU Modula-2; see the file COPYING3. If not see
#include "gcc.h"
#include "opts.h"
#include "vec.h"
+#include <vector>
+#include <string>
#include "m2/gm2config.h"
@@ -149,7 +151,40 @@ static void append_arg (const struct cl_decoded_option *);
static unsigned int gm2_newargc;
static struct cl_decoded_option *gm2_new_decoded_options;
static const char *libraries = NULL; /* Abbreviated libraries. */
+static const char *m2_path_name = "";
+typedef struct named_path_s {
+ std::vector<const char*>path;
+ const char *name;
+} named_path;
+
+static std::vector<named_path>Ipaths;
+
+
+static void
+push_back_Ipath (const char *arg)
+{
+ if (Ipaths.empty ())
+ {
+ named_path np;
+ np.path.push_back (arg);
+ np.name = m2_path_name;
+ Ipaths.push_back (np);
+ }
+ else
+ {
+ if (strcmp (Ipaths.back ().name,
+ m2_path_name) == 0)
+ Ipaths.back ().path.push_back (arg);
+ else
+ {
+ named_path np;
+ np.path.push_back (arg);
+ np.name = m2_path_name;
+ Ipaths.push_back (np);
+ }
+ }
+}
/* Return whether strings S1 and S2 are both NULL or both the same
string. */
@@ -342,6 +377,24 @@ convert_abbreviations (const char *libraries)
return full_libraries;
}
+/* add_m2_I_path appends -fm2-pathname and -fm2-pathnameI options to
+ the command line which are contructed in the saved Ipaths. */
+
+static void
+add_m2_I_path (void)
+{
+ for (auto np : Ipaths)
+ {
+ if (strcmp (np.name, "") == 0)
+ append_option (OPT_fm2_pathname_, safe_strdup ("-"), 1);
+ else
+ append_option (OPT_fm2_pathname_, safe_strdup (np.name), 1);
+ for (auto *s : np.path)
+ append_option (OPT_fm2_pathnameI, safe_strdup (s), 1);
+ }
+ Ipaths.clear();
+}
+
void
lang_specific_driver (struct cl_decoded_option **in_decoded_options,
@@ -429,6 +482,7 @@ lang_specific_driver (struct cl_decoded_option **in_decoded_options,
fprintf (stderr, "\n");
#endif
+ // add_spec_function ("m2I", add_m2_I_path);
gm2_xargc = argc;
gm2_x_decoded_options = decoded_options;
gm2_newargc = 0;
@@ -514,7 +568,14 @@ lang_specific_driver (struct cl_decoded_option **in_decoded_options,
seen_uselist = true;
uselist = decoded_options[i].value;
break;
-
+ case OPT_fm2_pathname_:
+ args[i] |= SKIPOPT; /* We will add the option if it is needed. */
+ m2_path_name = decoded_options[i].arg;
+ break;
+ case OPT_I:
+ args[i] |= SKIPOPT; /* We will add the option if it is needed. */
+ push_back_Ipath (decoded_options[i].arg);
+ break;
case OPT_nostdlib:
case OPT_nostdlib__:
case OPT_nodefaultlibs:
@@ -670,6 +731,7 @@ lang_specific_driver (struct cl_decoded_option **in_decoded_options,
#endif
}
+ add_m2_I_path ();
/* We now add in extra arguments to facilitate a successful link.
Note that the libraries are added to the end of the link here
and also placed earlier into the link by lang-specs.h. Possibly
diff --git a/gcc/m2/lang-specs.h b/gcc/m2/lang-specs.h
index 65004e1cabd..a564779d2e7 100644
--- a/gcc/m2/lang-specs.h
+++ b/gcc/m2/lang-specs.h
@@ -41,9 +41,9 @@ along with GCC; see the file COPYING3. If not see
{"@modula-2",
/* For preprocessing we use cc1 but wrap it in cc1gm2. */
"%{E|M|MM:\
- cc1gm2 " M2CPP " %{!fcpp:-fcpp;:%{fcpp}} %{I*} %i } \
+ cc1gm2 " M2CPP " %{!fcpp:-fcpp;:%{fcpp}} %{fm2-pathname*} %i } \
%{!E:%{!M:%{!MM:\
- cc1gm2 " M2CPP " %(cc1_options) %{I*} %i %{c} \
+ cc1gm2 " M2CPP " %(cc1_options) %{fm2-pathname*} %i %{c} \
%{!fcpp:%{MD|MMD|MF*: \
%eto generate dependencies you must specify '-fcpp' }} \
%{!fsyntax-only:%(invoke_as)} \
@@ -51,6 +51,7 @@ along with GCC; see the file COPYING3. If not see
{".m2i", "@modula-2-cpp-output", 0, 0, 0},
{"@modula-2-cpp-output",
"%{!M:%{!MM:%{!E: \
- cc1gm2 %<fcpp %(cc1_options) %{v} %I -fmod=.mod.m2i -fdef=.def.m2i %{I*} \
+ cc1gm2 %<fcpp %(cc1_options) %{v} %I -fmod=.mod.m2i -fdef=.def.m2i \
+ %{fm2-pathname*} \
-fpreprocessed %i %{c} \
%{!fsyntax-only:%(invoke_as)}}}}", 0, 0, 0},
diff --git a/gcc/m2/lang.opt b/gcc/m2/lang.opt
index b6ef8161d90..691a75f2e4e 100644
--- a/gcc/m2/lang.opt
+++ b/gcc/m2/lang.opt
@@ -134,9 +134,21 @@ fm2-lower-case
Modula-2
generate error messages which render keywords in lower case
+fm2-pathname=
+Modula-2 Joined
+specify the module mangled prefix name for all modules in the following include paths
+
+fm2-pathnameI
+Modula-2 Joined
+; For internal use only: used by the driver to copy the user facing -I option
+
fm2-plugin
Modula-2
-insert plugin to identify runtime errors at compiletime (default on)
+insert plugin to identify runtime errors at compiletime
+
+fm2-prefix=
+Modula-2 Joined
+specify the module mangled prefix name
fm2-statistics
Modula-2
diff --git a/gcc/m2/mc-boot-ch/GUnixArgs.cc b/gcc/m2/mc-boot-ch/GUnixArgs.cc
index 29b8ec27323..815abc3b371 100644
--- a/gcc/m2/mc-boot-ch/GUnixArgs.cc
+++ b/gcc/m2/mc-boot-ch/GUnixArgs.cc
@@ -25,7 +25,7 @@ see the files COPYING3 and COPYING.RUNTIME respectively. If not, see
<http://www.gnu.org/licenses/>. */
#include <config.h>
-#include "m2rts.h"
+// #include "m2rts.h"
extern "C" int UnixArgs_GetArgC (void);
@@ -82,6 +82,7 @@ _M2_UnixArgs_dep (void)
{
}
+#if 0
struct _M2_UnixArgs_ctor { _M2_UnixArgs_ctor (); } _M2_UnixArgs_ctor;
_M2_UnixArgs_ctor::_M2_UnixArgs_ctor (void)
@@ -89,3 +90,4 @@ _M2_UnixArgs_ctor::_M2_UnixArgs_ctor (void)
M2RTS_RegisterModule ("UnixArgs", _M2_UnixArgs_init, _M2_UnixArgs_fini,
_M2_UnixArgs_dep);
}
+#endif
diff --git a/gcc/m2/mc-boot-ch/Glibc.c b/gcc/m2/mc-boot-ch/Glibc.c
index 7a37fef6150..b94aae3322a 100644
--- a/gcc/m2/mc-boot-ch/Glibc.c
+++ b/gcc/m2/mc-boot-ch/Glibc.c
@@ -125,7 +125,43 @@ libc_printf (char *_format, unsigned int _format_high, ...)
va_start (arg, _format_high);
done = vfprintf (stdout, format, arg);
va_end (arg);
+ return done;
+}
+
+EXTERN
+int
+libc_snprintf (char *dest, size_t length, char *_format, unsigned int _format_high, ...)
+{
+ va_list arg;
+ int done;
+ char format[_format_high + 1];
+ unsigned int i = 0;
+ unsigned int j = 0;
+ char *c;
+
+ do
+ {
+ c = index (&_format[i], '\\');
+ if (c == NULL)
+ strcpy (&format[j], &_format[i]);
+ else
+ {
+ memcpy (&format[j], &_format[i], (c - _format) - i);
+ i = c - _format;
+ j += c - _format;
+ if (_format[i + 1] == 'n')
+ format[j] = '\n';
+ else
+ format[j] = _format[i + 1];
+ j++;
+ i += 2;
+ }
+ }
+ while (c != NULL);
+ va_start (arg, _format_high);
+ done = vsnprintf (dest, length, format, arg);
+ va_end (arg);
return done;
}
diff --git a/gcc/m2/mc-boot-ch/m2rts.h b/gcc/m2/mc-boot-ch/m2rts.h
index 09d55f41d3b..d9f3be4a09b 100644
--- a/gcc/m2/mc-boot-ch/m2rts.h
+++ b/gcc/m2/mc-boot-ch/m2rts.h
@@ -28,8 +28,9 @@ see the files COPYING3 and COPYING.RUNTIME respectively. If not, see
typedef void (*proc_con) (int, char **, char **);
typedef void (*proc_dep) (void);
-extern "C" void M2RTS_RequestDependant (const char *modulename, const char *dependancy);
-extern "C" void M2RTS_RegisterModule (const char *modulename,
+extern "C" void M2RTS_RequestDependant (const char *modulename, const char *libname,
+ const char *dependancy, const char *deplib);
+extern "C" void M2RTS_RegisterModule (const char *modulename, const char *libname,
proc_con init, proc_con fini, proc_dep dependencies);
extern "C" void _M2_M2RTS_init (void);
diff --git a/gcc/m2/mc-boot/GDynamicStrings.c b/gcc/m2/mc-boot/GDynamicStrings.c
index dfc163646bb..2099c2b420b 100644
--- a/gcc/m2/mc-boot/GDynamicStrings.c
+++ b/gcc/m2/mc-boot/GDynamicStrings.c
@@ -1214,7 +1214,7 @@ static void ConcatContents (DynamicStrings_Contents *c, const char *a_, unsigned
(*c).next->contents.next = NULL;
ConcatContents (&(*c).next->contents, (const char *) a, _a_high, h, o);
AddDebugInfo ((*c).next);
- (*c).next = AssignDebug ((*c).next, (const char *) "../../gcc-read-write/gcc/m2/gm2-libs/DynamicStrings.mod", 55, 722, (const char *) "ConcatContents", 14);
+ (*c).next = AssignDebug ((*c).next, (const char *) "../../gcc/m2/gm2-libs/DynamicStrings.mod", 40, 722, (const char *) "ConcatContents", 14);
}
else
{
@@ -1312,7 +1312,7 @@ static void ConcatContentsAddress (DynamicStrings_Contents *c, void * a, unsigne
AddDebugInfo ((*c).next);
if (TraceOn)
{
- (*c).next = AssignDebug ((*c).next, (const char *) "../../gcc-read-write/gcc/m2/gm2-libs/DynamicStrings.mod", 55, 917, (const char *) "ConcatContentsAddress", 21);
+ (*c).next = AssignDebug ((*c).next, (const char *) "../../gcc/m2/gm2-libs/DynamicStrings.mod", 40, 917, (const char *) "ConcatContentsAddress", 21);
}
}
else
@@ -1537,7 +1537,7 @@ extern "C" DynamicStrings_String DynamicStrings_InitString (const char *a_, unsi
AddDebugInfo (s);
if (TraceOn)
{
- s = AssignDebug (s, (const char *) "../../gcc-read-write/gcc/m2/gm2-libs/DynamicStrings.mod", 55, 758, (const char *) "InitString", 10);
+ s = AssignDebug (s, (const char *) "../../gcc/m2/gm2-libs/DynamicStrings.mod", 40, 758, (const char *) "InitString", 10);
}
return s;
/* static analysis guarentees a RETURN statement will be used before here. */
@@ -1640,7 +1640,7 @@ extern "C" DynamicStrings_String DynamicStrings_InitStringCharStar (void * a)
AddDebugInfo (s);
if (TraceOn)
{
- s = AssignDebug (s, (const char *) "../../gcc-read-write/gcc/m2/gm2-libs/DynamicStrings.mod", 55, 957, (const char *) "InitStringCharStar", 18);
+ s = AssignDebug (s, (const char *) "../../gcc/m2/gm2-libs/DynamicStrings.mod", 40, 957, (const char *) "InitStringCharStar", 18);
}
return s;
/* static analysis guarentees a RETURN statement will be used before here. */
@@ -1665,7 +1665,7 @@ extern "C" DynamicStrings_String DynamicStrings_InitStringChar (char ch)
s = DynamicStrings_InitString ((const char *) &a.array[0], 1);
if (TraceOn)
{
- s = AssignDebug (s, (const char *) "../../gcc-read-write/gcc/m2/gm2-libs/DynamicStrings.mod", 55, 977, (const char *) "InitStringChar", 14);
+ s = AssignDebug (s, (const char *) "../../gcc/m2/gm2-libs/DynamicStrings.mod", 40, 977, (const char *) "InitStringChar", 14);
}
return s;
/* static analysis guarentees a RETURN statement will be used before here. */
@@ -1823,7 +1823,7 @@ extern "C" DynamicStrings_String DynamicStrings_Dup (DynamicStrings_String s)
s = DynamicStrings_Assign (DynamicStrings_InitString ((const char *) "", 0), s);
if (TraceOn)
{
- s = AssignDebug (s, (const char *) "../../gcc-read-write/gcc/m2/gm2-libs/DynamicStrings.mod", 55, 1173, (const char *) "Dup", 3);
+ s = AssignDebug (s, (const char *) "../../gcc/m2/gm2-libs/DynamicStrings.mod", 40, 1173, (const char *) "Dup", 3);
}
return s;
/* static analysis guarentees a RETURN statement will be used before here. */
@@ -1845,7 +1845,7 @@ extern "C" DynamicStrings_String DynamicStrings_Add (DynamicStrings_String a, Dy
a = DynamicStrings_ConCat (DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "", 0), a), b);
if (TraceOn)
{
- a = AssignDebug (a, (const char *) "../../gcc-read-write/gcc/m2/gm2-libs/DynamicStrings.mod", 55, 1193, (const char *) "Add", 3);
+ a = AssignDebug (a, (const char *) "../../gcc/m2/gm2-libs/DynamicStrings.mod", 40, 1193, (const char *) "Add", 3);
}
return a;
/* static analysis guarentees a RETURN statement will be used before here. */
@@ -1910,7 +1910,7 @@ extern "C" unsigned int DynamicStrings_EqualCharStar (DynamicStrings_String s, v
t = DynamicStrings_InitStringCharStar (a);
if (TraceOn)
{
- t = AssignDebug (t, (const char *) "../../gcc-read-write/gcc/m2/gm2-libs/DynamicStrings.mod", 55, 1250, (const char *) "EqualCharStar", 13);
+ t = AssignDebug (t, (const char *) "../../gcc/m2/gm2-libs/DynamicStrings.mod", 40, 1250, (const char *) "EqualCharStar", 13);
}
t = AddToGarbage (t, s);
if (DynamicStrings_Equal (t, s))
@@ -1948,7 +1948,7 @@ extern "C" unsigned int DynamicStrings_EqualArray (DynamicStrings_String s, cons
t = DynamicStrings_InitString ((const char *) a, _a_high);
if (TraceOn)
{
- t = AssignDebug (t, (const char *) "../../gcc-read-write/gcc/m2/gm2-libs/DynamicStrings.mod", 55, 1280, (const char *) "EqualArray", 10);
+ t = AssignDebug (t, (const char *) "../../gcc/m2/gm2-libs/DynamicStrings.mod", 40, 1280, (const char *) "EqualArray", 10);
}
t = AddToGarbage (t, s);
if (DynamicStrings_Equal (t, s))
@@ -1986,7 +1986,7 @@ extern "C" DynamicStrings_String DynamicStrings_Mult (DynamicStrings_String s, u
}
if (TraceOn)
{
- s = AssignDebug (s, (const char *) "../../gcc-read-write/gcc/m2/gm2-libs/DynamicStrings.mod", 55, 1312, (const char *) "Mult", 4);
+ s = AssignDebug (s, (const char *) "../../gcc/m2/gm2-libs/DynamicStrings.mod", 40, 1312, (const char *) "Mult", 4);
}
return s;
/* static analysis guarentees a RETURN statement will be used before here. */
@@ -2065,7 +2065,7 @@ extern "C" DynamicStrings_String DynamicStrings_Slice (DynamicStrings_String s,
AddDebugInfo (t->contents.next);
if (TraceOn)
{
- t->contents.next = AssignDebug (t->contents.next, (const char *) "../../gcc-read-write/gcc/m2/gm2-libs/DynamicStrings.mod", 55, 1380, (const char *) "Slice", 5);
+ t->contents.next = AssignDebug (t->contents.next, (const char *) "../../gcc/m2/gm2-libs/DynamicStrings.mod", 40, 1380, (const char *) "Slice", 5);
}
}
t = t->contents.next;
@@ -2083,7 +2083,7 @@ extern "C" DynamicStrings_String DynamicStrings_Slice (DynamicStrings_String s,
}
if (TraceOn)
{
- d = AssignDebug (d, (const char *) "../../gcc-read-write/gcc/m2/gm2-libs/DynamicStrings.mod", 55, 1397, (const char *) "Slice", 5);
+ d = AssignDebug (d, (const char *) "../../gcc/m2/gm2-libs/DynamicStrings.mod", 40, 1397, (const char *) "Slice", 5);
}
return d;
/* static analysis guarentees a RETURN statement will be used before here. */
@@ -2211,7 +2211,7 @@ extern "C" DynamicStrings_String DynamicStrings_RemoveComment (DynamicStrings_St
}
if (TraceOn)
{
- s = AssignDebug (s, (const char *) "../../gcc-read-write/gcc/m2/gm2-libs/DynamicStrings.mod", 55, 1509, (const char *) "RemoveComment", 13);
+ s = AssignDebug (s, (const char *) "../../gcc/m2/gm2-libs/DynamicStrings.mod", 40, 1509, (const char *) "RemoveComment", 13);
}
return s;
/* static analysis guarentees a RETURN statement will be used before here. */
@@ -2236,7 +2236,7 @@ extern "C" DynamicStrings_String DynamicStrings_RemoveWhitePrefix (DynamicString
s = DynamicStrings_Slice (s, (int ) (i), 0);
if (TraceOn)
{
- s = AssignDebug (s, (const char *) "../../gcc-read-write/gcc/m2/gm2-libs/DynamicStrings.mod", 55, 1621, (const char *) "RemoveWhitePrefix", 17);
+ s = AssignDebug (s, (const char *) "../../gcc/m2/gm2-libs/DynamicStrings.mod", 40, 1621, (const char *) "RemoveWhitePrefix", 17);
}
return s;
/* static analysis guarentees a RETURN statement will be used before here. */
@@ -2261,7 +2261,7 @@ extern "C" DynamicStrings_String DynamicStrings_RemoveWhitePostfix (DynamicStrin
s = DynamicStrings_Slice (s, 0, i+1);
if (TraceOn)
{
- s = AssignDebug (s, (const char *) "../../gcc-read-write/gcc/m2/gm2-libs/DynamicStrings.mod", 55, 1643, (const char *) "RemoveWhitePostfix", 18);
+ s = AssignDebug (s, (const char *) "../../gcc/m2/gm2-libs/DynamicStrings.mod", 40, 1643, (const char *) "RemoveWhitePostfix", 18);
}
return s;
/* static analysis guarentees a RETURN statement will be used before here. */
@@ -2630,7 +2630,7 @@ extern "C" DynamicStrings_String DynamicStrings_PopAllocationExemption (unsigned
{
stop ();
/* writeString ("mismatched number of PopAllocation's compared to PushAllocation's") */
- M2RTS_Halt ((const char *) "../../gcc-read-write/gcc/m2/gm2-libs/DynamicStrings.mod", 55, 176, (const char *) "PopAllocationExemption", 22, (const char *) "mismatched number of PopAllocation's compared to PushAllocation's", 65);
+ M2RTS_Halt ((const char *) "../../gcc/m2/gm2-libs/DynamicStrings.mod", 40, 176, (const char *) "PopAllocationExemption", 22, (const char *) "mismatched number of PopAllocation's compared to PushAllocation's", 65);
}
else
{
diff --git a/gcc/m2/mc-boot/GFIO.c b/gcc/m2/mc-boot/GFIO.c
index 1ae6bb63f20..4a6056f35e3 100644
--- a/gcc/m2/mc-boot/GFIO.c
+++ b/gcc/m2/mc-boot/GFIO.c
@@ -555,7 +555,7 @@ static FIO_File GetNextFreeDescriptor (void)
return f; /* create new slot */
}
}
- ReturnException ("../../gcc-read-write/gcc/m2/gm2-libs/FIO.def", 25, 1);
+ ReturnException ("../../gcc/m2/gm2-libs/FIO.def", 25, 1);
__builtin_unreachable ();
}
@@ -726,7 +726,7 @@ static int ReadFromBuffer (FIO_File f, void * a, unsigned int nBytes)
(*p) = static_cast<unsigned char> ((*fd->buffer->contents).array[fd->buffer->position]);
fd->buffer->left -= 1; /* remove consumed bytes */
fd->buffer->position += 1; /* move onwards n bytes */
- nBytes = 0; /* reduce the amount for future direct */
+ nBytes = 0;
/* read */
return 1;
}
@@ -821,7 +821,6 @@ static int BufferedRead (FIO_File f, unsigned int nBytes, void * a)
if (f != Error)
{
- /* avoid dangling else. */
fd = static_cast<FIO_FileDescriptor> (Indexing_GetIndice (FileInfo, f));
total = 0; /* how many bytes have we read */
if (fd != NULL) /* how many bytes have we read */
@@ -891,16 +890,9 @@ static int BufferedRead (FIO_File f, unsigned int nBytes, void * a)
}
return total;
}
- else
- {
- return -1;
- }
}
}
- else
- {
- return -1;
- }
+ return -1;
/* static analysis guarentees a RETURN statement will be used before here. */
__builtin_unreachable ();
}
@@ -2266,7 +2258,8 @@ extern "C" void * FIO_getFileName (FIO_File f)
return fd->name.address;
}
}
- ReturnException ("../../gcc-read-write/gcc/m2/gm2-libs/FIO.def", 25, 1);
+ return NULL;
+ /* static analysis guarentees a RETURN statement will be used before here. */
__builtin_unreachable ();
}
@@ -2293,7 +2286,8 @@ extern "C" unsigned int FIO_getFileNameLength (FIO_File f)
return fd->name.size;
}
}
- ReturnException ("../../gcc-read-write/gcc/m2/gm2-libs/FIO.def", 25, 1);
+ return 0;
+ /* static analysis guarentees a RETURN statement will be used before here. */
__builtin_unreachable ();
}
diff --git a/gcc/m2/mc-boot/GIndexing.c b/gcc/m2/mc-boot/GIndexing.c
index 0817ff36ca2..f6ec58272c0 100644
--- a/gcc/m2/mc-boot/GIndexing.c
+++ b/gcc/m2/mc-boot/GIndexing.c
@@ -222,7 +222,7 @@ extern "C" unsigned int Indexing_InBounds (Indexing_Index i, unsigned int n)
{
return (n >= i->Low) && (n <= i->High);
}
- ReturnException ("../../gcc-read-write/gcc/m2/mc/Indexing.def", 20, 1);
+ ReturnException ("../../gcc/m2/mc/Indexing.def", 20, 1);
__builtin_unreachable ();
}
@@ -242,7 +242,7 @@ extern "C" unsigned int Indexing_HighIndice (Indexing_Index i)
{
return i->High;
}
- ReturnException ("../../gcc-read-write/gcc/m2/mc/Indexing.def", 20, 1);
+ ReturnException ("../../gcc/m2/mc/Indexing.def", 20, 1);
__builtin_unreachable ();
}
@@ -262,7 +262,7 @@ extern "C" unsigned int Indexing_LowIndice (Indexing_Index i)
{
return i->Low;
}
- ReturnException ("../../gcc-read-write/gcc/m2/mc/Indexing.def", 20, 1);
+ ReturnException ("../../gcc/m2/mc/Indexing.def", 20, 1);
__builtin_unreachable ();
}
diff --git a/gcc/m2/mc-boot/GM2Dependent.c b/gcc/m2/mc-boot/GM2Dependent.c
index 0057018c979..64441fff642 100644
--- a/gcc/m2/mc-boot/GM2Dependent.c
+++ b/gcc/m2/mc-boot/GM2Dependent.c
@@ -83,6 +83,7 @@ struct M2Dependent_DependencyList_r {
struct M2Dependent__T3_a { M2Dependent_ModuleChain array[M2Dependent_user-M2Dependent_unregistered+1]; };
struct M2Dependent__T2_r {
void *name;
+ void *libname;
M2Dependent_ArgCVEnvP init;
M2Dependent_ArgCVEnvP fini;
M2Dependent_DependencyList dependency;
@@ -92,7 +93,9 @@ struct M2Dependent__T2_r {
static M2Dependent__T3 Modules;
static unsigned int Initialized;
+static unsigned int WarningTrace;
static unsigned int ModuleTrace;
+static unsigned int HexTrace;
static unsigned int DependencyTrace;
static unsigned int PreTrace;
static unsigned int PostTrace;
@@ -103,14 +106,14 @@ static unsigned int ForceTrace;
module constructor in turn.
*/
-extern "C" void M2Dependent_ConstructModules (void * applicationmodule, int argc, void * argv, void * envp);
+extern "C" void M2Dependent_ConstructModules (void * applicationmodule, void * libname, int argc, void * argv, void * envp);
/*
DeconstructModules - resolve dependencies and then call each
module constructor in turn.
*/
-extern "C" void M2Dependent_DeconstructModules (void * applicationmodule, int argc, void * argv, void * envp);
+extern "C" void M2Dependent_DeconstructModules (void * applicationmodule, void * libname, int argc, void * argv, void * envp);
/*
RegisterModule - adds module name to the list of outstanding
@@ -118,7 +121,7 @@ extern "C" void M2Dependent_DeconstructModules (void * applicationmodule, int ar
explored to determine initialization order.
*/
-extern "C" void M2Dependent_RegisterModule (void * name, M2Dependent_ArgCVEnvP init, M2Dependent_ArgCVEnvP fini, PROC dependencies);
+extern "C" void M2Dependent_RegisterModule (void * modulename, void * libname, M2Dependent_ArgCVEnvP init, M2Dependent_ArgCVEnvP fini, PROC dependencies);
/*
RequestDependant - used to specify that modulename is dependant upon
@@ -126,14 +129,14 @@ extern "C" void M2Dependent_RegisterModule (void * name, M2Dependent_ArgCVEnvP i
if we are not using StaticInitialization.
*/
-extern "C" void M2Dependent_RequestDependant (void * modulename, void * dependantmodule);
+extern "C" void M2Dependent_RequestDependant (void * modulename, void * libname, void * dependantmodule, void * dependantlibname);
/*
CreateModule - creates a new module entry and returns the
ModuleChain.
*/
-static M2Dependent_ModuleChain CreateModule (void * name, M2Dependent_ArgCVEnvP init, M2Dependent_ArgCVEnvP fini, PROC dependencies);
+static M2Dependent_ModuleChain CreateModule (void * name, void * libname, M2Dependent_ArgCVEnvP init, M2Dependent_ArgCVEnvP fini, PROC dependencies);
/*
AppendModule - append chain to end of the list.
@@ -154,18 +157,30 @@ static void RemoveModule (M2Dependent_ModuleChain *head, M2Dependent_ModuleChain
static unsigned int onChain (M2Dependent_DependencyState state, M2Dependent_ModuleChain mptr);
/*
- LookupModuleN - lookup module from the state list. The string is limited
- to nchar.
+ max -
*/
-static M2Dependent_ModuleChain LookupModuleN (M2Dependent_DependencyState state, void * name, unsigned int nchar);
+static unsigned int max (unsigned int a, unsigned int b);
+
+/*
+ min -
+*/
+
+static unsigned int min (unsigned int a, unsigned int b);
+
+/*
+ LookupModuleN - lookup module from the state list.
+ The strings lengths are known.
+*/
+
+static M2Dependent_ModuleChain LookupModuleN (M2Dependent_DependencyState state, void * name, unsigned int namelen, void * libname, unsigned int libnamelen);
/*
LookupModule - lookup and return the ModuleChain pointer containing
module name from a particular list.
*/
-static M2Dependent_ModuleChain LookupModule (M2Dependent_DependencyState state, void * name);
+static M2Dependent_ModuleChain LookupModule (M2Dependent_DependencyState state, void * name, void * libname);
/*
toCString - replace any character sequence
@@ -206,6 +221,12 @@ static void traceprintf (unsigned int flag, const char *str_, unsigned int _str_
static void traceprintf2 (unsigned int flag, const char *str_, unsigned int _str_high, void * arg);
+/*
+ traceprintf3 - wrap printf with a boolean flag.
+*/
+
+static void traceprintf3 (unsigned int flag, const char *str_, unsigned int _str_high, void * arg1, void * arg2);
+
/*
moveTo - moves mptr to the new list determined by newstate.
It updates the mptr state appropriately.
@@ -217,7 +238,7 @@ static void moveTo (M2Dependent_DependencyState newstate, M2Dependent_ModuleChai
ResolveDependant -
*/
-static void ResolveDependant (M2Dependent_ModuleChain mptr, void * currentmodule);
+static void ResolveDependant (M2Dependent_ModuleChain mptr, void * currentmodule, void * libname);
/*
PerformRequestDependant - the current modulename has a dependancy upon
@@ -226,19 +247,19 @@ static void ResolveDependant (M2Dependent_ModuleChain mptr, void * currentmodule
resolved.
*/
-static void PerformRequestDependant (void * modulename, void * dependantmodule);
+static void PerformRequestDependant (void * modulename, void * libname, void * dependantmodule, void * dependantlibname);
/*
- ResolveDependencies - resolve dependencies for currentmodule.
+ ResolveDependencies - resolve dependencies for currentmodule, libname.
*/
-static void ResolveDependencies (void * currentmodule);
+static void ResolveDependencies (void * currentmodule, void * libname);
/*
DisplayModuleInfo - displays all module in the state.
*/
-static void DisplayModuleInfo (M2Dependent_DependencyState state, const char *name_, unsigned int _name_high);
+static void DisplayModuleInfo (M2Dependent_DependencyState state, const char *desc_, unsigned int _desc_high);
/*
DumpModuleData -
@@ -255,6 +276,18 @@ static void DumpModuleData (unsigned int flag);
static void combine (M2Dependent_DependencyState src, M2Dependent_DependencyState dest);
+/*
+ tracemodule -
+*/
+
+static void tracemodule (unsigned int flag, void * modname, unsigned int modlen, void * libname, unsigned int liblen);
+
+/*
+ ForceModule -
+*/
+
+static void ForceModule (void * modname, unsigned int modlen, void * libname, unsigned int liblen);
+
/*
ForceDependencies - if the user has specified a forced order then we override
the dynamic ordering with the preference.
@@ -269,6 +302,12 @@ static void ForceDependencies (void);
static void CheckApplication (void);
+/*
+ warning3 - write format arg1 arg2 to stderr.
+*/
+
+static void warning3 (const char *format_, unsigned int _format_high, void * arg1, void * arg2);
+
/*
equal - return TRUE if C string cstr is equal to str.
*/
@@ -279,11 +318,12 @@ static unsigned int equal (void * cstr, const char *str_, unsigned int _str_high
SetupDebugFlags - By default assigns ModuleTrace, DependencyTrace,
DumpPostInit to FALSE. It checks the environment
GCC_M2LINK_RTFLAG which can contain
- "all,module,pre,post,dep,force". all turns them all on.
+ "all,module,hex,pre,post,dep,force". all turns them all on.
The flag meanings are as follows and flags the are in
execution order.
module generate trace info as the modules are registered.
+ hex dump the modules ctor functions address in hex.
pre generate a list of all modules seen prior to having
their dependancies resolved.
dep display a trace as the modules are resolved.
@@ -316,18 +356,26 @@ static void CheckInitialized (void);
ModuleChain.
*/
-static M2Dependent_ModuleChain CreateModule (void * name, M2Dependent_ArgCVEnvP init, M2Dependent_ArgCVEnvP fini, PROC dependencies)
+static M2Dependent_ModuleChain CreateModule (void * name, void * libname, M2Dependent_ArgCVEnvP init, M2Dependent_ArgCVEnvP fini, PROC dependencies)
{
M2Dependent_ModuleChain mptr;
+ void * p0;
+ void * p1;
Storage_ALLOCATE ((void **) &mptr, sizeof (M2Dependent__T2));
mptr->name = name;
+ mptr->libname = libname;
mptr->init = init;
mptr->fini = fini;
mptr->dependency.proc = dependencies;
mptr->dependency.state = M2Dependent_unregistered;
mptr->prev = NULL;
mptr->next = NULL;
+ if (HexTrace)
+ {
+ libc_printf ((const char *) " (init: %p fini: %p", 22, init, fini);
+ libc_printf ((const char *) " dep: %p)", 10, dependencies);
+ }
return mptr;
/* static analysis guarentees a RETURN statement will be used before here. */
__builtin_unreachable ();
@@ -404,11 +452,49 @@ static unsigned int onChain (M2Dependent_DependencyState state, M2Dependent_Modu
/*
- LookupModuleN - lookup module from the state list. The string is limited
- to nchar.
+ max -
+*/
+
+static unsigned int max (unsigned int a, unsigned int b)
+{
+ if (a > b)
+ {
+ return a;
+ }
+ else
+ {
+ return b;
+ }
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ min -
*/
-static M2Dependent_ModuleChain LookupModuleN (M2Dependent_DependencyState state, void * name, unsigned int nchar)
+static unsigned int min (unsigned int a, unsigned int b)
+{
+ if (a < b)
+ {
+ return a;
+ }
+ else
+ {
+ return b;
+ }
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ LookupModuleN - lookup module from the state list.
+ The strings lengths are known.
+*/
+
+static M2Dependent_ModuleChain LookupModuleN (M2Dependent_DependencyState state, void * name, unsigned int namelen, void * libname, unsigned int libnamelen)
{
M2Dependent_ModuleChain ptr;
@@ -416,7 +502,7 @@ static M2Dependent_ModuleChain LookupModuleN (M2Dependent_DependencyState state,
{
ptr = Modules.array[state-M2Dependent_unregistered];
do {
- if ((strncmp (reinterpret_cast<M2LINK_PtrToChar> (ptr->name), reinterpret_cast<M2LINK_PtrToChar> (name), nchar)) == 0)
+ if (((strncmp (reinterpret_cast<M2LINK_PtrToChar> (ptr->name), reinterpret_cast<M2LINK_PtrToChar> (name), max (namelen, static_cast<unsigned int> (strlen_ (reinterpret_cast<M2LINK_PtrToChar> (ptr->name)))))) == 0) && ((strncmp (reinterpret_cast<M2LINK_PtrToChar> (ptr->libname), reinterpret_cast<M2LINK_PtrToChar> (libname), max (libnamelen, static_cast<unsigned int> (strlen_ (reinterpret_cast<M2LINK_PtrToChar> (ptr->libname)))))) == 0))
{
return ptr;
}
@@ -434,9 +520,9 @@ static M2Dependent_ModuleChain LookupModuleN (M2Dependent_DependencyState state,
module name from a particular list.
*/
-static M2Dependent_ModuleChain LookupModule (M2Dependent_DependencyState state, void * name)
+static M2Dependent_ModuleChain LookupModule (M2Dependent_DependencyState state, void * name, void * libname)
{
- return LookupModuleN (state, name, static_cast<unsigned int> (strlen_ (reinterpret_cast<M2LINK_PtrToChar> (name))));
+ return LookupModuleN (state, name, static_cast<unsigned int> (strlen_ (reinterpret_cast<M2LINK_PtrToChar> (name))), libname, static_cast<unsigned int> (strlen_ (reinterpret_cast<M2LINK_PtrToChar> (libname))));
/* static analysis guarentees a RETURN statement will be used before here. */
__builtin_unreachable ();
}
@@ -515,9 +601,13 @@ static int strcmp (M2LINK_PtrToChar a, M2LINK_PtrToChar b)
static int strncmp (M2LINK_PtrToChar a, M2LINK_PtrToChar b, unsigned int n)
{
- if (((a != NULL) && (b != NULL)) && (n > 0))
+ if (n == 0)
{
- /* avoid gcc warning by using compound statement even if not strictly necessary. */
+ return 0;
+ }
+ else if ((a != NULL) && (b != NULL))
+ {
+ /* avoid dangling else. */
if (a == b)
{
return 0;
@@ -594,6 +684,7 @@ static void traceprintf (unsigned int flag, const char *str_, unsigned int _str_
static void traceprintf2 (unsigned int flag, const char *str_, unsigned int _str_high, void * arg)
{
+ char ch;
char str[_str_high+1];
/* make a local copy of each unbounded array. */
@@ -602,11 +693,46 @@ static void traceprintf2 (unsigned int flag, const char *str_, unsigned int _str
if (flag)
{
toCString ((char *) str, _str_high);
+ if (arg == NULL)
+ {
+ ch = (char) 0;
+ arg = &ch;
+ }
libc_printf ((const char *) str, _str_high, arg);
}
}
+/*
+ traceprintf3 - wrap printf with a boolean flag.
+*/
+
+static void traceprintf3 (unsigned int flag, const char *str_, unsigned int _str_high, void * arg1, void * arg2)
+{
+ char ch;
+ char str[_str_high+1];
+
+ /* make a local copy of each unbounded array. */
+ memcpy (str, str_, _str_high+1);
+
+ if (flag)
+ {
+ toCString ((char *) str, _str_high);
+ if (arg1 == NULL)
+ {
+ ch = (char) 0;
+ arg1 = &ch;
+ }
+ if (arg2 == NULL)
+ {
+ ch = (char) 0;
+ arg2 = &ch;
+ }
+ libc_printf ((const char *) str, _str_high, arg1, arg2);
+ }
+}
+
+
/*
moveTo - moves mptr to the new list determined by newstate.
It updates the mptr state appropriately.
@@ -627,11 +753,11 @@ static void moveTo (M2Dependent_DependencyState newstate, M2Dependent_ModuleChai
ResolveDependant -
*/
-static void ResolveDependant (M2Dependent_ModuleChain mptr, void * currentmodule)
+static void ResolveDependant (M2Dependent_ModuleChain mptr, void * currentmodule, void * libname)
{
if (mptr == NULL)
{
- traceprintf (DependencyTrace, (const char *) " module has not been registered via a global constructor\\n", 60);
+ traceprintf3 (DependencyTrace, (const char *) " module %s [%s] has not been registered via a global constructor\\n", 68, currentmodule, libname);
}
else
{
@@ -642,9 +768,9 @@ static void ResolveDependant (M2Dependent_ModuleChain mptr, void * currentmodule
else
{
moveTo (M2Dependent_started, mptr);
- traceprintf2 (DependencyTrace, (const char *) " starting: %s\\n", 17, currentmodule);
+ traceprintf3 (DependencyTrace, (const char *) " starting: %s [%s]\\n", 22, currentmodule, libname);
(*mptr->dependency.proc.proc) (); /* Invoke and process the dependency graph. */
- traceprintf2 (DependencyTrace, (const char *) " finished: %s\\n", 17, currentmodule); /* Invoke and process the dependency graph. */
+ traceprintf3 (DependencyTrace, (const char *) " finished: %s [%s]\\n", 22, currentmodule, libname); /* Invoke and process the dependency graph. */
moveTo (M2Dependent_ordered, mptr);
}
}
@@ -658,73 +784,73 @@ static void ResolveDependant (M2Dependent_ModuleChain mptr, void * currentmodule
resolved.
*/
-static void PerformRequestDependant (void * modulename, void * dependantmodule)
+static void PerformRequestDependant (void * modulename, void * libname, void * dependantmodule, void * dependantlibname)
{
M2Dependent_ModuleChain mptr;
- traceprintf2 (DependencyTrace, (const char *) " module %s", 11, modulename);
+ traceprintf3 (DependencyTrace, (const char *) " module %s [%s]", 16, modulename, libname);
if (dependantmodule == NULL)
{
/* avoid dangling else. */
- traceprintf2 (DependencyTrace, (const char *) " has finished its import graph\\n", 32, modulename);
- mptr = LookupModule (M2Dependent_unordered, modulename);
+ traceprintf (DependencyTrace, (const char *) " has finished its import graph\\n", 32);
+ mptr = LookupModule (M2Dependent_unordered, modulename, libname);
if (mptr != NULL)
{
- traceprintf2 (DependencyTrace, (const char *) " module %s is now ordered\\n", 28, modulename);
+ traceprintf3 (DependencyTrace, (const char *) " module %s [%s] is now ordered\\n", 33, modulename, libname);
moveTo (M2Dependent_ordered, mptr);
}
}
else
{
- traceprintf2 (DependencyTrace, (const char *) " imports from %s\\n", 18, dependantmodule);
- mptr = LookupModule (M2Dependent_ordered, dependantmodule);
+ traceprintf3 (DependencyTrace, (const char *) " imports from %s [%s]\\n", 23, dependantmodule, dependantlibname);
+ mptr = LookupModule (M2Dependent_ordered, dependantmodule, dependantlibname);
if (mptr == NULL)
{
- traceprintf2 (DependencyTrace, (const char *) " module %s is not ordered\\n", 28, dependantmodule);
- mptr = LookupModule (M2Dependent_unordered, dependantmodule);
+ traceprintf3 (DependencyTrace, (const char *) " module %s [%s] is not ordered\\n", 33, dependantmodule, dependantlibname);
+ mptr = LookupModule (M2Dependent_unordered, dependantmodule, dependantlibname);
if (mptr == NULL)
{
- traceprintf2 (DependencyTrace, (const char *) " module %s is not unordered\\n", 30, dependantmodule);
- mptr = LookupModule (M2Dependent_started, dependantmodule);
+ traceprintf3 (DependencyTrace, (const char *) " module %s [%s] is not unordered\\n", 35, dependantmodule, dependantlibname);
+ mptr = LookupModule (M2Dependent_started, dependantmodule, dependantlibname);
if (mptr == NULL)
{
- traceprintf2 (DependencyTrace, (const char *) " module %s has not started\\n", 29, dependantmodule);
- traceprintf2 (DependencyTrace, (const char *) " module %s attempting to import from", 37, modulename);
- traceprintf2 (DependencyTrace, (const char *) " %s which has not registered itself via a constructor\\n", 55, dependantmodule);
+ traceprintf3 (DependencyTrace, (const char *) " module %s [%s] has not started\\n", 34, dependantmodule, dependantlibname);
+ traceprintf3 (DependencyTrace, (const char *) " module %s [%s] attempting to import from", 42, modulename, libname);
+ traceprintf3 (DependencyTrace, (const char *) " %s [%s] which has not registered itself via a constructor\\n", 60, dependantmodule, dependantlibname);
}
else
{
- traceprintf2 (DependencyTrace, (const char *) " module %s has registered itself and has started\\n", 51, dependantmodule);
+ traceprintf3 (DependencyTrace, (const char *) " module %s [%s] has registered itself and has started\\n", 56, dependantmodule, dependantlibname);
}
}
else
{
- traceprintf2 (DependencyTrace, (const char *) " module %s resolving\\n", 23, dependantmodule);
- ResolveDependant (mptr, dependantmodule);
+ traceprintf3 (DependencyTrace, (const char *) " module %s [%s] resolving\\n", 28, dependantmodule, dependantlibname);
+ ResolveDependant (mptr, dependantmodule, dependantlibname);
}
}
else
{
- traceprintf2 (DependencyTrace, (const char *) " module %s ", 12, modulename);
- traceprintf2 (DependencyTrace, (const char *) " dependant %s is ordered\\n", 26, dependantmodule);
+ traceprintf3 (DependencyTrace, (const char *) " module %s [%s]", 16, modulename, libname);
+ traceprintf3 (DependencyTrace, (const char *) " dependant %s [%s] is ordered\\n", 31, dependantmodule, dependantlibname);
}
}
}
/*
- ResolveDependencies - resolve dependencies for currentmodule.
+ ResolveDependencies - resolve dependencies for currentmodule, libname.
*/
-static void ResolveDependencies (void * currentmodule)
+static void ResolveDependencies (void * currentmodule, void * libname)
{
M2Dependent_ModuleChain mptr;
- mptr = LookupModule (M2Dependent_unordered, currentmodule);
+ mptr = LookupModule (M2Dependent_unordered, currentmodule, libname);
while (mptr != NULL)
{
- traceprintf2 (DependencyTrace, (const char *) " attempting to resolve the dependants for %s\\n", 48, currentmodule);
- ResolveDependant (mptr, currentmodule);
+ traceprintf3 (DependencyTrace, (const char *) " attempting to resolve the dependants for %s [%s]\\n", 53, currentmodule, libname);
+ ResolveDependant (mptr, currentmodule, libname);
mptr = Modules.array[M2Dependent_unordered-M2Dependent_unregistered];
}
}
@@ -734,22 +860,29 @@ static void ResolveDependencies (void * currentmodule)
DisplayModuleInfo - displays all module in the state.
*/
-static void DisplayModuleInfo (M2Dependent_DependencyState state, const char *name_, unsigned int _name_high)
+static void DisplayModuleInfo (M2Dependent_DependencyState state, const char *desc_, unsigned int _desc_high)
{
M2Dependent_ModuleChain mptr;
unsigned int count;
- char name[_name_high+1];
+ char desc[_desc_high+1];
/* make a local copy of each unbounded array. */
- memcpy (name, name_, _name_high+1);
+ memcpy (desc, desc_, _desc_high+1);
if (Modules.array[state-M2Dependent_unregistered] != NULL)
{
- libc_printf ((const char *) "%s modules\\n", 12, &name);
+ libc_printf ((const char *) "%s modules\\n", 12, &desc);
mptr = Modules.array[state-M2Dependent_unregistered];
count = 0;
do {
- libc_printf ((const char *) " %d %s", 8, count, mptr->name);
+ if (mptr->name == NULL)
+ {
+ libc_printf ((const char *) " %d %s []", 11, count, mptr->name);
+ }
+ else
+ {
+ libc_printf ((const char *) " %d %s [%s]", 13, count, mptr->name, mptr->libname);
+ }
count += 1;
if (mptr->dependency.appl)
{
@@ -808,6 +941,52 @@ static void combine (M2Dependent_DependencyState src, M2Dependent_DependencyStat
}
+/*
+ tracemodule -
+*/
+
+static void tracemodule (unsigned int flag, void * modname, unsigned int modlen, void * libname, unsigned int liblen)
+{
+ typedef struct tracemodule__T4_a tracemodule__T4;
+
+ struct tracemodule__T4_a { char array[100+1]; };
+ tracemodule__T4 buffer;
+ unsigned int len;
+
+ if (flag)
+ {
+ len = min (modlen, sizeof (buffer)-1);
+ libc_strncpy (&buffer, modname, len);
+ buffer.array[len] = (char) 0;
+ libc_printf ((const char *) "%s ", 3, &buffer);
+ len = min (liblen, sizeof (buffer)-1);
+ libc_strncpy (&buffer, libname, len);
+ buffer.array[len] = (char) 0;
+ libc_printf ((const char *) " [%s]", 5, &buffer);
+ }
+}
+
+
+/*
+ ForceModule -
+*/
+
+static void ForceModule (void * modname, unsigned int modlen, void * libname, unsigned int liblen)
+{
+ M2Dependent_ModuleChain mptr;
+
+ traceprintf (ForceTrace, (const char *) "forcing module: ", 16);
+ tracemodule (ForceTrace, modname, modlen, libname, liblen);
+ traceprintf (ForceTrace, (const char *) "\\n", 2);
+ mptr = LookupModuleN (M2Dependent_ordered, modname, modlen, libname, liblen);
+ if (mptr != NULL)
+ {
+ mptr->dependency.forced = TRUE;
+ moveTo (M2Dependent_user, mptr);
+ }
+}
+
+
/*
ForceDependencies - if the user has specified a forced order then we override
the dynamic ordering with the preference.
@@ -815,46 +994,58 @@ static void combine (M2Dependent_DependencyState src, M2Dependent_DependencyStat
static void ForceDependencies (void)
{
- M2Dependent_ModuleChain mptr;
- M2Dependent_ModuleChain userChain;
- unsigned int count;
+ unsigned int len;
+ unsigned int modlen;
+ unsigned int liblen;
+ M2LINK_PtrToChar modname;
+ M2LINK_PtrToChar libname;
M2LINK_PtrToChar pc;
M2LINK_PtrToChar start;
if (M2LINK_ForcedModuleInitOrder != NULL)
{
- userChain = NULL;
+ traceprintf2 (ForceTrace, (const char *) "user forcing order: %s\\n", 24, reinterpret_cast<void *> (M2LINK_ForcedModuleInitOrder));
pc = M2LINK_ForcedModuleInitOrder;
start = pc;
- count = 0;
+ len = 0;
+ modname = NULL;
+ modlen = 0;
+ libname = NULL;
+ liblen = 0;
while ((*pc) != ASCII_nul)
{
- if ((*pc) == ',')
- {
- mptr = LookupModuleN (M2Dependent_ordered, reinterpret_cast<void *> (start), count);
- if (mptr != NULL)
- {
- mptr->dependency.forced = TRUE;
- moveTo (M2Dependent_user, mptr);
- }
- pc += 1;
- start = pc;
- count = 0;
- }
- else
+ switch ((*pc))
{
- pc += 1;
- count += 1;
+ case ':':
+ libname = start;
+ liblen = len;
+ len = 0;
+ pc += 1;
+ start = pc;
+ break;
+
+ case ',':
+ modname = start;
+ modlen = len;
+ ForceModule (reinterpret_cast<void *> (modname), modlen, reinterpret_cast<void *> (libname), liblen);
+ libname = NULL;
+ liblen = 0;
+ modlen = 0;
+ len = 0;
+ pc += 1;
+ start = pc;
+ break;
+
+
+ default:
+ pc += 1;
+ len += 1;
+ break;
}
}
if (start != pc)
{
- mptr = LookupModuleN (M2Dependent_ordered, reinterpret_cast<void *> (start), count);
- if (mptr != NULL)
- {
- mptr->dependency.forced = TRUE;
- moveTo (M2Dependent_user, mptr);
- }
+ ForceModule (reinterpret_cast<void *> (start), len, reinterpret_cast<void *> (libname), liblen);
}
combine (M2Dependent_user, M2Dependent_ordered);
}
@@ -887,12 +1078,39 @@ static void CheckApplication (void)
} while (! ((appl != NULL) || (mptr == Modules.array[M2Dependent_ordered-M2Dependent_unregistered])));
if (appl != NULL)
{
- Modules.array[M2Dependent_ordered-M2Dependent_unregistered] = appl->next;
+ RemoveModule (&Modules.array[M2Dependent_ordered-M2Dependent_unregistered], appl);
+ AppendModule (&Modules.array[M2Dependent_ordered-M2Dependent_unregistered], appl);
}
}
}
+/*
+ warning3 - write format arg1 arg2 to stderr.
+*/
+
+static void warning3 (const char *format_, unsigned int _format_high, void * arg1, void * arg2)
+{
+ typedef struct warning3__T5_a warning3__T5;
+
+ struct warning3__T5_a { char array[4096+1]; };
+ warning3__T5 buffer;
+ int len;
+ char format[_format_high+1];
+
+ /* make a local copy of each unbounded array. */
+ memcpy (format, format_, _format_high+1);
+
+ if (WarningTrace)
+ {
+ len = libc_snprintf (&buffer, static_cast<size_t> (sizeof (buffer)), (const char *) "warning: ", 9);
+ libc_write (2, &buffer, static_cast<size_t> (len));
+ len = libc_snprintf (&buffer, static_cast<size_t> (sizeof (buffer)), (const char *) format, _format_high, arg1, arg2);
+ libc_write (2, &buffer, static_cast<size_t> (len));
+ }
+}
+
+
/*
equal - return TRUE if C string cstr is equal to str.
*/
@@ -914,11 +1132,12 @@ static unsigned int equal (void * cstr, const char *str_, unsigned int _str_high
SetupDebugFlags - By default assigns ModuleTrace, DependencyTrace,
DumpPostInit to FALSE. It checks the environment
GCC_M2LINK_RTFLAG which can contain
- "all,module,pre,post,dep,force". all turns them all on.
+ "all,module,hex,pre,post,dep,force". all turns them all on.
The flag meanings are as follows and flags the are in
execution order.
module generate trace info as the modules are registered.
+ hex dump the modules ctor functions address in hex.
pre generate a list of all modules seen prior to having
their dependancies resolved.
dep display a trace as the modules are resolved.
@@ -939,6 +1158,8 @@ static void SetupDebugFlags (void)
PostTrace = FALSE;
PreTrace = FALSE;
ForceTrace = FALSE;
+ HexTrace = FALSE;
+ WarningTrace = FALSE;
pc = static_cast<SetupDebugFlags__T1> (libc_getenv (const_cast<void*> (reinterpret_cast<const void*>("GCC_M2LINK_RTFLAG"))));
while ((pc != NULL) && ((*pc) != ASCII_nul))
{
@@ -949,6 +1170,8 @@ static void SetupDebugFlags (void)
PreTrace = TRUE;
PostTrace = TRUE;
ForceTrace = TRUE;
+ HexTrace = TRUE;
+ WarningTrace = TRUE;
pc += 3;
}
else if (equal (reinterpret_cast<void *> (pc), (const char *) "module", 6))
@@ -957,6 +1180,18 @@ static void SetupDebugFlags (void)
ModuleTrace = TRUE;
pc += 6;
}
+ else if (equal (reinterpret_cast<void *> (pc), (const char *) "warning", 7))
+ {
+ /* avoid dangling else. */
+ WarningTrace = TRUE;
+ pc += 7;
+ }
+ else if (equal (reinterpret_cast<void *> (pc), (const char *) "hex", 3))
+ {
+ /* avoid dangling else. */
+ HexTrace = TRUE;
+ pc += 3;
+ }
else if (equal (reinterpret_cast<void *> (pc), (const char *) "dep", 3))
{
/* avoid dangling else. */
@@ -1028,21 +1263,21 @@ static void CheckInitialized (void)
module constructor in turn.
*/
-extern "C" void M2Dependent_ConstructModules (void * applicationmodule, int argc, void * argv, void * envp)
+extern "C" void M2Dependent_ConstructModules (void * applicationmodule, void * libname, int argc, void * argv, void * envp)
{
M2Dependent_ModuleChain mptr;
M2Dependent_ArgCVEnvP nulp;
CheckInitialized ();
- traceprintf2 (ModuleTrace, (const char *) "application module: %s\\n", 24, applicationmodule);
- mptr = LookupModule (M2Dependent_unordered, applicationmodule);
+ traceprintf3 (ModuleTrace, (const char *) "application module: %s [%s]\\n", 29, applicationmodule, libname);
+ mptr = LookupModule (M2Dependent_unordered, applicationmodule, libname);
if (mptr != NULL)
{
mptr->dependency.appl = TRUE;
}
traceprintf (PreTrace, (const char *) "Pre resolving dependents\\n", 26);
DumpModuleData (PreTrace);
- ResolveDependencies (applicationmodule);
+ ResolveDependencies (applicationmodule, libname);
traceprintf (PreTrace, (const char *) "Post resolving dependents\\n", 27);
DumpModuleData (PostTrace);
ForceDependencies ();
@@ -1053,7 +1288,7 @@ extern "C" void M2Dependent_ConstructModules (void * applicationmodule, int argc
DumpModuleData (ForceTrace);
if (Modules.array[M2Dependent_ordered-M2Dependent_unregistered] == NULL)
{
- traceprintf2 (ModuleTrace, (const char *) " module: %s has not registered itself using a global constructor\\n", 67, applicationmodule);
+ traceprintf3 (ModuleTrace, (const char *) " module: %s [%s] has not registered itself using a global constructor\\n", 72, applicationmodule, libname);
traceprintf2 (ModuleTrace, (const char *) " hint try compile and linking using: gm2 %s.mod\\n", 50, applicationmodule);
traceprintf2 (ModuleTrace, (const char *) " or try using: gm2 -fscaffold-static %s.mod\\n", 46, applicationmodule);
}
@@ -1063,15 +1298,15 @@ extern "C" void M2Dependent_ConstructModules (void * applicationmodule, int argc
do {
if (mptr->dependency.forc)
{
- traceprintf2 (ModuleTrace, (const char *) "initializing module: %s for C\\n", 31, mptr->name);
+ traceprintf3 (ModuleTrace, (const char *) "initializing module: %s [%s] for C\\n", 36, mptr->name, mptr->libname);
}
else
{
- traceprintf2 (ModuleTrace, (const char *) "initializing module: %s\\n", 25, mptr->name);
+ traceprintf3 (ModuleTrace, (const char *) "initializing module: %s [%s]\\n", 30, mptr->name, mptr->libname);
}
if (mptr->dependency.appl)
{
- traceprintf2 (ModuleTrace, (const char *) "application module: %s\\n", 24, mptr->name);
+ traceprintf3 (ModuleTrace, (const char *) "application module: %s [%s]\\n", 29, mptr->name, mptr->libname);
traceprintf (ModuleTrace, (const char *) " calling M2RTS_ExecuteInitialProcedures\\n", 42);
M2RTS_ExecuteInitialProcedures ();
traceprintf (ModuleTrace, (const char *) " calling application module\\n", 30);
@@ -1088,11 +1323,11 @@ extern "C" void M2Dependent_ConstructModules (void * applicationmodule, int argc
module constructor in turn.
*/
-extern "C" void M2Dependent_DeconstructModules (void * applicationmodule, int argc, void * argv, void * envp)
+extern "C" void M2Dependent_DeconstructModules (void * applicationmodule, void * libname, int argc, void * argv, void * envp)
{
M2Dependent_ModuleChain mptr;
- traceprintf2 (ModuleTrace, (const char *) "application module finishing: %s\\n", 34, applicationmodule);
+ traceprintf3 (ModuleTrace, (const char *) "application module finishing: %s [%s]\\n", 39, applicationmodule, libname);
if (Modules.array[M2Dependent_ordered-M2Dependent_unregistered] == NULL)
{
traceprintf (ModuleTrace, (const char *) " no ordered modules found during finishing\\n", 45);
@@ -1106,11 +1341,11 @@ extern "C" void M2Dependent_DeconstructModules (void * applicationmodule, int ar
do {
if (mptr->dependency.forc)
{
- traceprintf2 (ModuleTrace, (const char *) "finalizing module: %s for C\\n", 29, mptr->name);
+ traceprintf3 (ModuleTrace, (const char *) "finalizing module: %s [%s] for C\\n", 34, mptr->name, mptr->libname);
}
else
{
- traceprintf2 (ModuleTrace, (const char *) "finalizing module: %s\\n", 23, mptr->name);
+ traceprintf3 (ModuleTrace, (const char *) "finalizing module: %s [%s]\\n", 28, mptr->name, mptr->libname);
}
(*mptr->fini.proc) (argc, argv, envp);
mptr = mptr->prev;
@@ -1125,13 +1360,24 @@ extern "C" void M2Dependent_DeconstructModules (void * applicationmodule, int ar
explored to determine initialization order.
*/
-extern "C" void M2Dependent_RegisterModule (void * name, M2Dependent_ArgCVEnvP init, M2Dependent_ArgCVEnvP fini, PROC dependencies)
+extern "C" void M2Dependent_RegisterModule (void * modulename, void * libname, M2Dependent_ArgCVEnvP init, M2Dependent_ArgCVEnvP fini, PROC dependencies)
{
+ M2Dependent_ModuleChain mptr;
+
CheckInitialized ();
if (! M2LINK_StaticInitialization)
{
- traceprintf2 (ModuleTrace, (const char *) "module: %s registering\\n", 24, name);
- moveTo (M2Dependent_unordered, CreateModule (name, init, fini, dependencies));
+ mptr = LookupModule (M2Dependent_unordered, modulename, libname);
+ if (mptr == NULL)
+ {
+ traceprintf3 (ModuleTrace, (const char *) "module: %s [%s] registering", 27, modulename, libname);
+ moveTo (M2Dependent_unordered, CreateModule (modulename, libname, init, fini, dependencies));
+ traceprintf (ModuleTrace, (const char *) "\\n", 2);
+ }
+ else
+ {
+ warning3 ((const char *) "module: %s [%s] (ignoring duplicate registration)\\n", 51, modulename, libname);
+ }
}
}
@@ -1142,12 +1388,12 @@ extern "C" void M2Dependent_RegisterModule (void * name, M2Dependent_ArgCVEnvP i
if we are not using StaticInitialization.
*/
-extern "C" void M2Dependent_RequestDependant (void * modulename, void * dependantmodule)
+extern "C" void M2Dependent_RequestDependant (void * modulename, void * libname, void * dependantmodule, void * dependantlibname)
{
CheckInitialized ();
if (! M2LINK_StaticInitialization)
{
- PerformRequestDependant (modulename, dependantmodule);
+ PerformRequestDependant (modulename, libname, dependantmodule, dependantlibname);
}
}
diff --git a/gcc/m2/mc-boot/GM2Dependent.h b/gcc/m2/mc-boot/GM2Dependent.h
index 903f10db844..068bbfe3f7c 100644
--- a/gcc/m2/mc-boot/GM2Dependent.h
+++ b/gcc/m2/mc-boot/GM2Dependent.h
@@ -53,8 +53,8 @@ typedef struct M2Dependent_ArgCVEnvP_p M2Dependent_ArgCVEnvP;
typedef void (*M2Dependent_ArgCVEnvP_t) (int, void *, void *);
struct M2Dependent_ArgCVEnvP_p { M2Dependent_ArgCVEnvP_t proc; };
-EXTERN void M2Dependent_ConstructModules (void * applicationmodule, int argc, void * argv, void * envp);
-EXTERN void M2Dependent_DeconstructModules (void * applicationmodule, int argc, void * argv, void * envp);
+EXTERN void M2Dependent_ConstructModules (void * applicationmodule, void * libname, int argc, void * argv, void * envp);
+EXTERN void M2Dependent_DeconstructModules (void * applicationmodule, void * libname, int argc, void * argv, void * envp);
/*
RegisterModule - adds module name to the list of outstanding
@@ -62,14 +62,15 @@ EXTERN void M2Dependent_DeconstructModules (void * applicationmodule, int argc,
explored to determine initialization order.
*/
-EXTERN void M2Dependent_RegisterModule (void * name, M2Dependent_ArgCVEnvP init, M2Dependent_ArgCVEnvP fini, PROC dependencies);
+EXTERN void M2Dependent_RegisterModule (void * modulename, void * libname, M2Dependent_ArgCVEnvP init, M2Dependent_ArgCVEnvP fini, PROC dependencies);
/*
- RequestDependant - used to specify that modulename is dependant upon
- module dependantmodule.
+ RequestDependant - used to specify that modulename:libname
+ is dependant upon
+ module dependantmodule:dependantlibname
*/
-EXTERN void M2Dependent_RequestDependant (void * modulename, void * dependantmodule);
+EXTERN void M2Dependent_RequestDependant (void * modulename, void * libname, void * dependantmodule, void * dependantlibname);
# ifdef __cplusplus
}
# endif
diff --git a/gcc/m2/mc-boot/GM2EXCEPTION.c b/gcc/m2/mc-boot/GM2EXCEPTION.c
index 387b0476462..a7b88652858 100644
--- a/gcc/m2/mc-boot/GM2EXCEPTION.c
+++ b/gcc/m2/mc-boot/GM2EXCEPTION.c
@@ -57,13 +57,13 @@ extern "C" M2EXCEPTION_M2Exceptions M2EXCEPTION_M2Exception (void)
n = RTExceptions_GetNumber (e);
if (n == (UINT_MAX))
{
- RTExceptions_Raise ( ((unsigned int) (M2EXCEPTION_exException)), const_cast<void*> (reinterpret_cast<const void*>("../../gcc-read-write/gcc/m2/gm2-libs/M2EXCEPTION.mod")), 47, 6, const_cast<void*> (reinterpret_cast<const void*>("M2Exception")), const_cast<void*> (reinterpret_cast<const void*>("current coroutine is not in the exceptional execution state")));
+ RTExceptions_Raise ( ((unsigned int) (M2EXCEPTION_exException)), const_cast<void*> (reinterpret_cast<const void*>("../../gcc/m2/gm2-libs/M2EXCEPTION.mod")), 47, 6, const_cast<void*> (reinterpret_cast<const void*>("M2Exception")), const_cast<void*> (reinterpret_cast<const void*>("current coroutine is not in the exceptional execution state")));
}
else
{
return (M2EXCEPTION_M2Exceptions) (n);
}
- ReturnException ("../../gcc-read-write/gcc/m2/gm2-libs/M2EXCEPTION.def", 25, 1);
+ ReturnException ("../../gcc/m2/gm2-libs/M2EXCEPTION.def", 25, 1);
__builtin_unreachable ();
}
diff --git a/gcc/m2/mc-boot/GM2RTS.c b/gcc/m2/mc-boot/GM2RTS.c
index 8a65ae2a116..2e8680ccb96 100644
--- a/gcc/m2/mc-boot/GM2RTS.c
+++ b/gcc/m2/mc-boot/GM2RTS.c
@@ -96,14 +96,14 @@ static unsigned int Initialized;
module constructor in turn.
*/
-extern "C" void M2RTS_ConstructModules (void * applicationmodule, int argc, void * argv, void * envp);
+extern "C" void M2RTS_ConstructModules (void * applicationmodule, void * libname, int argc, void * argv, void * envp);
/*
DeconstructModules - resolve dependencies and then call each
module constructor in turn.
*/
-extern "C" void M2RTS_DeconstructModules (void * applicationmodule, int argc, void * argv, void * envp);
+extern "C" void M2RTS_DeconstructModules (void * applicationmodule, void * libname, int argc, void * argv, void * envp);
/*
RegisterModule - adds module name to the list of outstanding
@@ -111,14 +111,14 @@ extern "C" void M2RTS_DeconstructModules (void * applicationmodule, int argc, vo
explored to determine initialization order.
*/
-extern "C" void M2RTS_RegisterModule (void * name, M2RTS_ArgCVEnvP init, M2RTS_ArgCVEnvP fini, PROC dependencies);
+extern "C" void M2RTS_RegisterModule (void * name, void * libname, M2RTS_ArgCVEnvP init, M2RTS_ArgCVEnvP fini, PROC dependencies);
/*
RequestDependant - used to specify that modulename is dependant upon
module dependantmodule.
*/
-extern "C" void M2RTS_RequestDependant (void * modulename, void * dependantmodule);
+extern "C" void M2RTS_RequestDependant (void * modulename, void * libname, void * dependantmodule, void * dependantlibname);
/*
InstallTerminationProcedure - installs a procedure, p, which will
@@ -434,9 +434,9 @@ static void CheckInitialized (void)
module constructor in turn.
*/
-extern "C" void M2RTS_ConstructModules (void * applicationmodule, int argc, void * argv, void * envp)
+extern "C" void M2RTS_ConstructModules (void * applicationmodule, void * libname, int argc, void * argv, void * envp)
{
- M2Dependent_ConstructModules (applicationmodule, argc, argv, envp);
+ M2Dependent_ConstructModules (applicationmodule, libname, argc, argv, envp);
}
@@ -445,9 +445,9 @@ extern "C" void M2RTS_ConstructModules (void * applicationmodule, int argc, void
module constructor in turn.
*/
-extern "C" void M2RTS_DeconstructModules (void * applicationmodule, int argc, void * argv, void * envp)
+extern "C" void M2RTS_DeconstructModules (void * applicationmodule, void * libname, int argc, void * argv, void * envp)
{
- M2Dependent_DeconstructModules (applicationmodule, argc, argv, envp);
+ M2Dependent_DeconstructModules (applicationmodule, libname, argc, argv, envp);
}
@@ -457,9 +457,9 @@ extern "C" void M2RTS_DeconstructModules (void * applicationmodule, int argc, vo
explored to determine initialization order.
*/
-extern "C" void M2RTS_RegisterModule (void * name, M2RTS_ArgCVEnvP init, M2RTS_ArgCVEnvP fini, PROC dependencies)
+extern "C" void M2RTS_RegisterModule (void * name, void * libname, M2RTS_ArgCVEnvP init, M2RTS_ArgCVEnvP fini, PROC dependencies)
{
- M2Dependent_RegisterModule (name, (M2Dependent_ArgCVEnvP) {(M2Dependent_ArgCVEnvP_t) init.proc}, (M2Dependent_ArgCVEnvP) {(M2Dependent_ArgCVEnvP_t) fini.proc}, dependencies);
+ M2Dependent_RegisterModule (name, libname, (M2Dependent_ArgCVEnvP) {(M2Dependent_ArgCVEnvP_t) init.proc}, (M2Dependent_ArgCVEnvP) {(M2Dependent_ArgCVEnvP_t) fini.proc}, dependencies);
}
@@ -468,9 +468,9 @@ extern "C" void M2RTS_RegisterModule (void * name, M2RTS_ArgCVEnvP init, M2RTS_A
module dependantmodule.
*/
-extern "C" void M2RTS_RequestDependant (void * modulename, void * dependantmodule)
+extern "C" void M2RTS_RequestDependant (void * modulename, void * libname, void * dependantmodule, void * dependantlibname)
{
- M2Dependent_RequestDependant (modulename, dependantmodule);
+ M2Dependent_RequestDependant (modulename, libname, dependantmodule, dependantlibname);
}
diff --git a/gcc/m2/mc-boot/GM2RTS.h b/gcc/m2/mc-boot/GM2RTS.h
index 8e95e9c79b8..eb1025c7922 100644
--- a/gcc/m2/mc-boot/GM2RTS.h
+++ b/gcc/m2/mc-boot/GM2RTS.h
@@ -53,8 +53,8 @@ typedef struct M2RTS_ArgCVEnvP_p M2RTS_ArgCVEnvP;
typedef void (*M2RTS_ArgCVEnvP_t) (int, void *, void *);
struct M2RTS_ArgCVEnvP_p { M2RTS_ArgCVEnvP_t proc; };
-EXTERN void M2RTS_ConstructModules (void * applicationmodule, int argc, void * argv, void * envp);
-EXTERN void M2RTS_DeconstructModules (void * applicationmodule, int argc, void * argv, void * envp);
+EXTERN void M2RTS_ConstructModules (void * applicationmodule, void * libname, int argc, void * argv, void * envp);
+EXTERN void M2RTS_DeconstructModules (void * applicationmodule, void * libname, int argc, void * argv, void * envp);
/*
RegisterModule - adds module name to the list of outstanding
@@ -62,14 +62,14 @@ EXTERN void M2RTS_DeconstructModules (void * applicationmodule, int argc, void *
explored to determine initialization order.
*/
-EXTERN void M2RTS_RegisterModule (void * name, M2RTS_ArgCVEnvP init, M2RTS_ArgCVEnvP fini, PROC dependencies);
+EXTERN void M2RTS_RegisterModule (void * name, void * libname, M2RTS_ArgCVEnvP init, M2RTS_ArgCVEnvP fini, PROC dependencies);
/*
RequestDependant - used to specify that modulename is dependant upon
module dependantmodule.
*/
-EXTERN void M2RTS_RequestDependant (void * modulename, void * dependantmodule);
+EXTERN void M2RTS_RequestDependant (void * modulename, void * libname, void * dependantmodule, void * dependantlibname);
/*
InstallTerminationProcedure - installs a procedure, p, which will
diff --git a/gcc/m2/mc-boot/GPushBackInput.c b/gcc/m2/mc-boot/GPushBackInput.c
index e15b3eb9007..895130edb30 100644
--- a/gcc/m2/mc-boot/GPushBackInput.c
+++ b/gcc/m2/mc-boot/GPushBackInput.c
@@ -274,7 +274,7 @@ extern "C" char PushBackInput_PutCh (char ch)
}
else
{
- Debug_Halt ((const char *) "max push back stack exceeded, increase MaxPushBackStack", 55, 150, (const char *) "../../gcc-read-write/gcc/m2/gm2-libs/PushBackInput.mod", 54);
+ Debug_Halt ((const char *) "max push back stack exceeded, increase MaxPushBackStack", 55, 150, (const char *) "../../gcc/m2/gm2-libs/PushBackInput.mod", 39);
}
return ch;
/* static analysis guarentees a RETURN statement will be used before here. */
@@ -300,7 +300,7 @@ extern "C" void PushBackInput_PutString (const char *a_, unsigned int _a_high)
l -= 1;
if ((PushBackInput_PutCh (a[l])) != a[l])
{
- Debug_Halt ((const char *) "assert failed", 13, 132, (const char *) "../../gcc-read-write/gcc/m2/gm2-libs/PushBackInput.mod", 54);
+ Debug_Halt ((const char *) "assert failed", 13, 132, (const char *) "../../gcc/m2/gm2-libs/PushBackInput.mod", 39);
}
}
}
@@ -321,7 +321,7 @@ extern "C" void PushBackInput_PutStr (DynamicStrings_String s)
i -= 1;
if ((PushBackInput_PutCh (DynamicStrings_char (s, static_cast<int> (i)))) != (DynamicStrings_char (s, static_cast<int> (i))))
{
- Debug_Halt ((const char *) "assert failed", 13, 113, (const char *) "../../gcc-read-write/gcc/m2/gm2-libs/PushBackInput.mod", 54);
+ Debug_Halt ((const char *) "assert failed", 13, 113, (const char *) "../../gcc/m2/gm2-libs/PushBackInput.mod", 39);
}
}
}
diff --git a/gcc/m2/mc-boot/GRTExceptions.c b/gcc/m2/mc-boot/GRTExceptions.c
index 23f8fede117..f78a3cb7ab8 100644
--- a/gcc/m2/mc-boot/GRTExceptions.c
+++ b/gcc/m2/mc-boot/GRTExceptions.c
@@ -721,7 +721,7 @@ static void AddHandler (RTExceptions_EHBlock e, RTExceptions_Handler h)
static void indexf (void * a)
{
- RTExceptions_Raise ( ((unsigned int) (M2EXCEPTION_indexException)), const_cast<void*> (reinterpret_cast<const void*>("../../gcc-read-write/gcc/m2/gm2-libs/RTExceptions.mod")), 613, 9, const_cast<void*> (reinterpret_cast<const void*>("indexf")), const_cast<void*> (reinterpret_cast<const void*>("array index out of bounds")));
+ RTExceptions_Raise ( ((unsigned int) (M2EXCEPTION_indexException)), const_cast<void*> (reinterpret_cast<const void*>("../../gcc/m2/gm2-libs/RTExceptions.mod")), 613, 9, const_cast<void*> (reinterpret_cast<const void*>("indexf")), const_cast<void*> (reinterpret_cast<const void*>("array index out of bounds")));
}
@@ -731,7 +731,7 @@ static void indexf (void * a)
static void range (void * a)
{
- RTExceptions_Raise ( ((unsigned int) (M2EXCEPTION_rangeException)), const_cast<void*> (reinterpret_cast<const void*>("../../gcc-read-write/gcc/m2/gm2-libs/RTExceptions.mod")), 625, 9, const_cast<void*> (reinterpret_cast<const void*>("range")), const_cast<void*> (reinterpret_cast<const void*>("assignment out of range")));
+ RTExceptions_Raise ( ((unsigned int) (M2EXCEPTION_rangeException)), const_cast<void*> (reinterpret_cast<const void*>("../../gcc/m2/gm2-libs/RTExceptions.mod")), 625, 9, const_cast<void*> (reinterpret_cast<const void*>("range")), const_cast<void*> (reinterpret_cast<const void*>("assignment out of range")));
}
@@ -741,7 +741,7 @@ static void range (void * a)
static void casef (void * a)
{
- RTExceptions_Raise ( ((unsigned int) (M2EXCEPTION_caseSelectException)), const_cast<void*> (reinterpret_cast<const void*>("../../gcc-read-write/gcc/m2/gm2-libs/RTExceptions.mod")), 637, 9, const_cast<void*> (reinterpret_cast<const void*>("casef")), const_cast<void*> (reinterpret_cast<const void*>("case selector out of range")));
+ RTExceptions_Raise ( ((unsigned int) (M2EXCEPTION_caseSelectException)), const_cast<void*> (reinterpret_cast<const void*>("../../gcc/m2/gm2-libs/RTExceptions.mod")), 637, 9, const_cast<void*> (reinterpret_cast<const void*>("casef")), const_cast<void*> (reinterpret_cast<const void*>("case selector out of range")));
}
@@ -751,7 +751,7 @@ static void casef (void * a)
static void invalidloc (void * a)
{
- RTExceptions_Raise ( ((unsigned int) (M2EXCEPTION_invalidLocation)), const_cast<void*> (reinterpret_cast<const void*>("../../gcc-read-write/gcc/m2/gm2-libs/RTExceptions.mod")), 649, 9, const_cast<void*> (reinterpret_cast<const void*>("invalidloc")), const_cast<void*> (reinterpret_cast<const void*>("invalid address referenced")));
+ RTExceptions_Raise ( ((unsigned int) (M2EXCEPTION_invalidLocation)), const_cast<void*> (reinterpret_cast<const void*>("../../gcc/m2/gm2-libs/RTExceptions.mod")), 649, 9, const_cast<void*> (reinterpret_cast<const void*>("invalidloc")), const_cast<void*> (reinterpret_cast<const void*>("invalid address referenced")));
}
@@ -761,7 +761,7 @@ static void invalidloc (void * a)
static void function (void * a)
{
- RTExceptions_Raise ( ((unsigned int) (M2EXCEPTION_functionException)), const_cast<void*> (reinterpret_cast<const void*>("../../gcc-read-write/gcc/m2/gm2-libs/RTExceptions.mod")), 661, 9, const_cast<void*> (reinterpret_cast<const void*>("function")), const_cast<void*> (reinterpret_cast<const void*>("... function ... "))); /* --fixme-- what has happened ? */
+ RTExceptions_Raise ( ((unsigned int) (M2EXCEPTION_functionException)), const_cast<void*> (reinterpret_cast<const void*>("../../gcc/m2/gm2-libs/RTExceptions.mod")), 661, 9, const_cast<void*> (reinterpret_cast<const void*>("function")), const_cast<void*> (reinterpret_cast<const void*>("... function ... "))); /* --fixme-- what has happened ? */
}
@@ -771,7 +771,7 @@ static void function (void * a)
static void wholevalue (void * a)
{
- RTExceptions_Raise ( ((unsigned int) (M2EXCEPTION_wholeValueException)), const_cast<void*> (reinterpret_cast<const void*>("../../gcc-read-write/gcc/m2/gm2-libs/RTExceptions.mod")), 673, 9, const_cast<void*> (reinterpret_cast<const void*>("wholevalue")), const_cast<void*> (reinterpret_cast<const void*>("illegal whole value exception")));
+ RTExceptions_Raise ( ((unsigned int) (M2EXCEPTION_wholeValueException)), const_cast<void*> (reinterpret_cast<const void*>("../../gcc/m2/gm2-libs/RTExceptions.mod")), 673, 9, const_cast<void*> (reinterpret_cast<const void*>("wholevalue")), const_cast<void*> (reinterpret_cast<const void*>("illegal whole value exception")));
}
@@ -781,7 +781,7 @@ static void wholevalue (void * a)
static void wholediv (void * a)
{
- RTExceptions_Raise ( ((unsigned int) (M2EXCEPTION_wholeDivException)), const_cast<void*> (reinterpret_cast<const void*>("../../gcc-read-write/gcc/m2/gm2-libs/RTExceptions.mod")), 685, 9, const_cast<void*> (reinterpret_cast<const void*>("wholediv")), const_cast<void*> (reinterpret_cast<const void*>("illegal whole value exception")));
+ RTExceptions_Raise ( ((unsigned int) (M2EXCEPTION_wholeDivException)), const_cast<void*> (reinterpret_cast<const void*>("../../gcc/m2/gm2-libs/RTExceptions.mod")), 685, 9, const_cast<void*> (reinterpret_cast<const void*>("wholediv")), const_cast<void*> (reinterpret_cast<const void*>("illegal whole value exception")));
}
@@ -791,7 +791,7 @@ static void wholediv (void * a)
static void realvalue (void * a)
{
- RTExceptions_Raise ( ((unsigned int) (M2EXCEPTION_realValueException)), const_cast<void*> (reinterpret_cast<const void*>("../../gcc-read-write/gcc/m2/gm2-libs/RTExceptions.mod")), 697, 9, const_cast<void*> (reinterpret_cast<const void*>("realvalue")), const_cast<void*> (reinterpret_cast<const void*>("illegal real value exception")));
+ RTExceptions_Raise ( ((unsigned int) (M2EXCEPTION_realValueException)), const_cast<void*> (reinterpret_cast<const void*>("../../gcc/m2/gm2-libs/RTExceptions.mod")), 697, 9, const_cast<void*> (reinterpret_cast<const void*>("realvalue")), const_cast<void*> (reinterpret_cast<const void*>("illegal real value exception")));
}
@@ -801,7 +801,7 @@ static void realvalue (void * a)
static void realdiv (void * a)
{
- RTExceptions_Raise ( ((unsigned int) (M2EXCEPTION_realDivException)), const_cast<void*> (reinterpret_cast<const void*>("../../gcc-read-write/gcc/m2/gm2-libs/RTExceptions.mod")), 709, 9, const_cast<void*> (reinterpret_cast<const void*>("realdiv")), const_cast<void*> (reinterpret_cast<const void*>("real number division by zero exception")));
+ RTExceptions_Raise ( ((unsigned int) (M2EXCEPTION_realDivException)), const_cast<void*> (reinterpret_cast<const void*>("../../gcc/m2/gm2-libs/RTExceptions.mod")), 709, 9, const_cast<void*> (reinterpret_cast<const void*>("realdiv")), const_cast<void*> (reinterpret_cast<const void*>("real number division by zero exception")));
}
@@ -811,7 +811,7 @@ static void realdiv (void * a)
static void complexvalue (void * a)
{
- RTExceptions_Raise ( ((unsigned int) (M2EXCEPTION_complexValueException)), const_cast<void*> (reinterpret_cast<const void*>("../../gcc-read-write/gcc/m2/gm2-libs/RTExceptions.mod")), 721, 9, const_cast<void*> (reinterpret_cast<const void*>("complexvalue")), const_cast<void*> (reinterpret_cast<const void*>("illegal complex value exception")));
+ RTExceptions_Raise ( ((unsigned int) (M2EXCEPTION_complexValueException)), const_cast<void*> (reinterpret_cast<const void*>("../../gcc/m2/gm2-libs/RTExceptions.mod")), 721, 9, const_cast<void*> (reinterpret_cast<const void*>("complexvalue")), const_cast<void*> (reinterpret_cast<const void*>("illegal complex value exception")));
}
@@ -821,7 +821,7 @@ static void complexvalue (void * a)
static void complexdiv (void * a)
{
- RTExceptions_Raise ( ((unsigned int) (M2EXCEPTION_complexDivException)), const_cast<void*> (reinterpret_cast<const void*>("../../gcc-read-write/gcc/m2/gm2-libs/RTExceptions.mod")), 733, 9, const_cast<void*> (reinterpret_cast<const void*>("complexdiv")), const_cast<void*> (reinterpret_cast<const void*>("complex number division by zero exception")));
+ RTExceptions_Raise ( ((unsigned int) (M2EXCEPTION_complexDivException)), const_cast<void*> (reinterpret_cast<const void*>("../../gcc/m2/gm2-libs/RTExceptions.mod")), 733, 9, const_cast<void*> (reinterpret_cast<const void*>("complexdiv")), const_cast<void*> (reinterpret_cast<const void*>("complex number division by zero exception")));
}
@@ -831,7 +831,7 @@ static void complexdiv (void * a)
static void protection (void * a)
{
- RTExceptions_Raise ( ((unsigned int) (M2EXCEPTION_protException)), const_cast<void*> (reinterpret_cast<const void*>("../../gcc-read-write/gcc/m2/gm2-libs/RTExceptions.mod")), 745, 9, const_cast<void*> (reinterpret_cast<const void*>("protection")), const_cast<void*> (reinterpret_cast<const void*>("protection exception")));
+ RTExceptions_Raise ( ((unsigned int) (M2EXCEPTION_protException)), const_cast<void*> (reinterpret_cast<const void*>("../../gcc/m2/gm2-libs/RTExceptions.mod")), 745, 9, const_cast<void*> (reinterpret_cast<const void*>("protection")), const_cast<void*> (reinterpret_cast<const void*>("protection exception")));
}
@@ -841,7 +841,7 @@ static void protection (void * a)
static void systemf (void * a)
{
- RTExceptions_Raise ( ((unsigned int) (M2EXCEPTION_sysException)), const_cast<void*> (reinterpret_cast<const void*>("../../gcc-read-write/gcc/m2/gm2-libs/RTExceptions.mod")), 757, 9, const_cast<void*> (reinterpret_cast<const void*>("systemf")), const_cast<void*> (reinterpret_cast<const void*>("system exception")));
+ RTExceptions_Raise ( ((unsigned int) (M2EXCEPTION_sysException)), const_cast<void*> (reinterpret_cast<const void*>("../../gcc/m2/gm2-libs/RTExceptions.mod")), 757, 9, const_cast<void*> (reinterpret_cast<const void*>("systemf")), const_cast<void*> (reinterpret_cast<const void*>("system exception")));
}
@@ -851,7 +851,7 @@ static void systemf (void * a)
static void coroutine (void * a)
{
- RTExceptions_Raise ( ((unsigned int) (M2EXCEPTION_coException)), const_cast<void*> (reinterpret_cast<const void*>("../../gcc-read-write/gcc/m2/gm2-libs/RTExceptions.mod")), 769, 9, const_cast<void*> (reinterpret_cast<const void*>("coroutine")), const_cast<void*> (reinterpret_cast<const void*>("coroutine exception")));
+ RTExceptions_Raise ( ((unsigned int) (M2EXCEPTION_coException)), const_cast<void*> (reinterpret_cast<const void*>("../../gcc/m2/gm2-libs/RTExceptions.mod")), 769, 9, const_cast<void*> (reinterpret_cast<const void*>("coroutine")), const_cast<void*> (reinterpret_cast<const void*>("coroutine exception")));
}
@@ -861,7 +861,7 @@ static void coroutine (void * a)
static void exception (void * a)
{
- RTExceptions_Raise ( ((unsigned int) (M2EXCEPTION_exException)), const_cast<void*> (reinterpret_cast<const void*>("../../gcc-read-write/gcc/m2/gm2-libs/RTExceptions.mod")), 781, 9, const_cast<void*> (reinterpret_cast<const void*>("exception")), const_cast<void*> (reinterpret_cast<const void*>("exception exception")));
+ RTExceptions_Raise ( ((unsigned int) (M2EXCEPTION_exException)), const_cast<void*> (reinterpret_cast<const void*>("../../gcc/m2/gm2-libs/RTExceptions.mod")), 781, 9, const_cast<void*> (reinterpret_cast<const void*>("exception")), const_cast<void*> (reinterpret_cast<const void*>("exception exception")));
}
@@ -1180,13 +1180,13 @@ extern "C" RTExceptions_EHBlock RTExceptions_GetBaseExceptionBlock (void)
{
if (currentEHB == NULL)
{
- M2RTS_Halt ((const char *) "../../gcc-read-write/gcc/m2/gm2-libs/RTExceptions.mod", 53, 599, (const char *) "GetBaseExceptionBlock", 21, (const char *) "currentEHB has not been initialized yet", 39);
+ M2RTS_Halt ((const char *) "../../gcc/m2/gm2-libs/RTExceptions.mod", 38, 599, (const char *) "GetBaseExceptionBlock", 21, (const char *) "currentEHB has not been initialized yet", 39);
}
else
{
return currentEHB;
}
- ReturnException ("../../gcc-read-write/gcc/m2/gm2-libs/RTExceptions.def", 25, 1);
+ ReturnException ("../../gcc/m2/gm2-libs/RTExceptions.def", 25, 1);
__builtin_unreachable ();
}
diff --git a/gcc/m2/mc-boot/GRTint.c b/gcc/m2/mc-boot/GRTint.c
index bc83e46c279..65c8c8af06f 100644
--- a/gcc/m2/mc-boot/GRTint.c
+++ b/gcc/m2/mc-boot/GRTint.c
@@ -595,7 +595,7 @@ static unsigned int activatePending (unsigned int untilInterrupt, RTint_Dispatch
default:
- CaseException ("../../gcc-read-write/gcc/m2/gm2-libs/RTint.def", 25, 1);
+ CaseException ("../../gcc/m2/gm2-libs/RTint.def", 25, 1);
__builtin_unreachable ();
}
v = v->pending;
@@ -708,7 +708,7 @@ extern "C" unsigned int RTint_InitOutputVector (int fd, unsigned int pri)
RTco_signal (lock);
return v->no;
}
- ReturnException ("../../gcc-read-write/gcc/m2/gm2-libs/RTint.def", 25, 1);
+ ReturnException ("../../gcc/m2/gm2-libs/RTint.def", 25, 1);
__builtin_unreachable ();
}
@@ -765,7 +765,7 @@ extern "C" void RTint_ReArmTimeVector (unsigned int vec, unsigned int micro, uns
v = FindVectorNo (vec);
if (v == NULL)
{
- M2RTS_Halt ((const char *) "../../gcc-read-write/gcc/m2/gm2-libs/RTint.mod", 46, 286, (const char *) "ReArmTimeVector", 15, (const char *) "cannot find vector supplied", 27);
+ M2RTS_Halt ((const char *) "../../gcc/m2/gm2-libs/RTint.mod", 31, 286, (const char *) "ReArmTimeVector", 15, (const char *) "cannot find vector supplied", 27);
}
else
{
@@ -790,7 +790,7 @@ extern "C" void RTint_GetTimeVector (unsigned int vec, unsigned int *micro, unsi
v = FindVectorNo (vec);
if (v == NULL)
{
- M2RTS_Halt ((const char *) "../../gcc-read-write/gcc/m2/gm2-libs/RTint.mod", 46, 312, (const char *) "GetTimeVector", 13, (const char *) "cannot find vector supplied", 27);
+ M2RTS_Halt ((const char *) "../../gcc/m2/gm2-libs/RTint.mod", 31, 312, (const char *) "GetTimeVector", 13, (const char *) "cannot find vector supplied", 27);
}
else
{
@@ -816,7 +816,7 @@ extern "C" void * RTint_AttachVector (unsigned int vec, void * p)
v = FindVectorNo (vec);
if (v == NULL)
{
- M2RTS_Halt ((const char *) "../../gcc-read-write/gcc/m2/gm2-libs/RTint.mod", 46, 339, (const char *) "AttachVector", 12, (const char *) "cannot find vector supplied", 27);
+ M2RTS_Halt ((const char *) "../../gcc/m2/gm2-libs/RTint.mod", 31, 339, (const char *) "AttachVector", 12, (const char *) "cannot find vector supplied", 27);
}
else
{
@@ -830,7 +830,7 @@ extern "C" void * RTint_AttachVector (unsigned int vec, void * p)
RTco_signal (lock);
return l;
}
- ReturnException ("../../gcc-read-write/gcc/m2/gm2-libs/RTint.def", 25, 1);
+ ReturnException ("../../gcc/m2/gm2-libs/RTint.def", 25, 1);
__builtin_unreachable ();
}
@@ -855,7 +855,7 @@ extern "C" void RTint_IncludeVector (unsigned int vec)
v = FindVectorNo (vec);
if (v == NULL)
{
- M2RTS_Halt ((const char *) "../../gcc-read-write/gcc/m2/gm2-libs/RTint.mod", 46, 372, (const char *) "IncludeVector", 13, (const char *) "cannot find vector supplied", 27);
+ M2RTS_Halt ((const char *) "../../gcc/m2/gm2-libs/RTint.mod", 31, 372, (const char *) "IncludeVector", 13, (const char *) "cannot find vector supplied", 27);
}
else
{
@@ -902,7 +902,7 @@ extern "C" void RTint_ExcludeVector (unsigned int vec)
v = FindPendingVector (vec);
if (v == NULL)
{
- M2RTS_Halt ((const char *) "../../gcc-read-write/gcc/m2/gm2-libs/RTint.mod", 46, 415, (const char *) "ExcludeVector", 13, (const char *) "cannot find pending vector supplied", 35);
+ M2RTS_Halt ((const char *) "../../gcc/m2/gm2-libs/RTint.mod", 31, 415, (const char *) "ExcludeVector", 13, (const char *) "cannot find pending vector supplied", 35);
}
else
{
@@ -1003,7 +1003,7 @@ extern "C" void RTint_Listen (unsigned int untilInterrupt, RTint_DispatchVector
default:
- CaseException ("../../gcc-read-write/gcc/m2/gm2-libs/RTint.def", 25, 1);
+ CaseException ("../../gcc/m2/gm2-libs/RTint.def", 25, 1);
__builtin_unreachable ();
}
v = v->pending;
@@ -1016,7 +1016,7 @@ extern "C" void RTint_Listen (unsigned int untilInterrupt, RTint_DispatchVector
}
if (((untilInterrupt && (i == NULL)) && (o == NULL)) && ! found)
{
- M2RTS_Halt ((const char *) "../../gcc-read-write/gcc/m2/gm2-libs/RTint.mod", 46, 731, (const char *) "Listen", 6, (const char *) "deadlock found, no more processes to run and no interrupts active", 65);
+ M2RTS_Halt ((const char *) "../../gcc/m2/gm2-libs/RTint.mod", 31, 731, (const char *) "Listen", 6, (const char *) "deadlock found, no more processes to run and no interrupts active", 65);
}
/* printf('}
') ; */
diff --git a/gcc/m2/mc-boot/GStdIO.c b/gcc/m2/mc-boot/GStdIO.c
index 41affe2a054..e5cc572be9e 100644
--- a/gcc/m2/mc-boot/GStdIO.c
+++ b/gcc/m2/mc-boot/GStdIO.c
@@ -193,7 +193,7 @@ extern "C" StdIO_ProcWrite StdIO_GetCurrentOutput (void)
M2RTS_HALT (-1);
__builtin_unreachable ();
}
- ReturnException ("../../gcc-read-write/gcc/m2/gm2-libs/StdIO.def", 25, 1);
+ ReturnException ("../../gcc/m2/gm2-libs/StdIO.def", 25, 1);
__builtin_unreachable ();
}
@@ -252,7 +252,7 @@ extern "C" StdIO_ProcRead StdIO_GetCurrentInput (void)
M2RTS_HALT (-1);
__builtin_unreachable ();
}
- ReturnException ("../../gcc-read-write/gcc/m2/gm2-libs/StdIO.def", 25, 1);
+ ReturnException ("../../gcc/m2/gm2-libs/StdIO.def", 25, 1);
__builtin_unreachable ();
}
diff --git a/gcc/m2/mc-boot/GStringConvert.c b/gcc/m2/mc-boot/GStringConvert.c
index faa5e34459e..8858afc7a1c 100644
--- a/gcc/m2/mc-boot/GStringConvert.c
+++ b/gcc/m2/mc-boot/GStringConvert.c
@@ -1916,7 +1916,7 @@ extern "C" DynamicStrings_String StringConvert_ToSigFig (DynamicStrings_String s
int point;
unsigned int poTen;
- Assert ((IsDigit (DynamicStrings_char (s, 0))) || ((DynamicStrings_char (s, 0)) == '.'), (const char *) "../../gcc-read-write/gcc/m2/gm2-libs/StringConvert.mod", 54, 1222, (const char *) "ToSigFig", 8);
+ Assert ((IsDigit (DynamicStrings_char (s, 0))) || ((DynamicStrings_char (s, 0)) == '.'), (const char *) "../../gcc/m2/gm2-libs/StringConvert.mod", 39, 1222, (const char *) "ToSigFig", 8);
point = DynamicStrings_Index (s, '.', 0);
if (point < 0)
{
@@ -1968,7 +1968,7 @@ extern "C" DynamicStrings_String StringConvert_ToDecimalPlaces (DynamicStrings_S
{
int point;
- Assert ((IsDigit (DynamicStrings_char (s, 0))) || ((DynamicStrings_char (s, 0)) == '.'), (const char *) "../../gcc-read-write/gcc/m2/gm2-libs/StringConvert.mod", 54, 1069, (const char *) "ToDecimalPlaces", 15);
+ Assert ((IsDigit (DynamicStrings_char (s, 0))) || ((DynamicStrings_char (s, 0)) == '.'), (const char *) "../../gcc/m2/gm2-libs/StringConvert.mod", 39, 1069, (const char *) "ToDecimalPlaces", 15);
point = DynamicStrings_Index (s, '.', 0);
if (point < 0)
{
diff --git a/gcc/m2/mc-boot/GSysStorage.c b/gcc/m2/mc-boot/GSysStorage.c
index 98c03f66c35..3d37ecf9518 100644
--- a/gcc/m2/mc-boot/GSysStorage.c
+++ b/gcc/m2/mc-boot/GSysStorage.c
@@ -93,7 +93,7 @@ extern "C" void SysStorage_ALLOCATE (void * *a, unsigned int size)
(*a) = libc_malloc (static_cast<size_t> (size));
if ((*a) == NULL)
{
- Debug_Halt ((const char *) "out of memory error", 19, 50, (const char *) "../../gcc-read-write/gcc/m2/gm2-libs/SysStorage.mod", 51);
+ Debug_Halt ((const char *) "out of memory error", 19, 50, (const char *) "../../gcc/m2/gm2-libs/SysStorage.mod", 36);
}
if (enableTrace && trace)
{
@@ -118,7 +118,7 @@ extern "C" void SysStorage_DEALLOCATE (void * *a, unsigned int size)
}
if ((libc_memset ((*a), 0, static_cast<size_t> (size))) != (*a))
{
- Debug_Halt ((const char *) "memset should have returned the first parameter", 47, 76, (const char *) "../../gcc-read-write/gcc/m2/gm2-libs/SysStorage.mod", 51);
+ Debug_Halt ((const char *) "memset should have returned the first parameter", 47, 76, (const char *) "../../gcc/m2/gm2-libs/SysStorage.mod", 36);
}
}
if (enableDeallocation)
@@ -163,7 +163,7 @@ extern "C" void SysStorage_REALLOCATE (void * *a, unsigned int size)
(*a) = libc_realloc ((*a), static_cast<size_t> (size));
if ((*a) == NULL)
{
- Debug_Halt ((const char *) "out of memory error", 19, 119, (const char *) "../../gcc-read-write/gcc/m2/gm2-libs/SysStorage.mod", 51);
+ Debug_Halt ((const char *) "out of memory error", 19, 119, (const char *) "../../gcc/m2/gm2-libs/SysStorage.mod", 36);
}
if (enableTrace && trace)
{
diff --git a/gcc/m2/mc-boot/Gdecl.c b/gcc/m2/mc-boot/Gdecl.c
index ff8298c73cc..08eba89167a 100644
--- a/gcc/m2/mc-boot/Gdecl.c
+++ b/gcc/m2/mc-boot/Gdecl.c
@@ -1027,10 +1027,10 @@ extern "C" void SYSTEM_ShiftRight (unsigned int *s, unsigned int _s_high, unsign
extern "C" void SYSTEM_RotateVal (unsigned int *s, unsigned int _s_high, unsigned int *d, unsigned int _d_high, unsigned int SetSizeInBits, int RotateCount);
extern "C" void SYSTEM_RotateLeft (unsigned int *s, unsigned int _s_high, unsigned int *d, unsigned int _d_high, unsigned int SetSizeInBits, unsigned int RotateCount);
extern "C" void SYSTEM_RotateRight (unsigned int *s, unsigned int _s_high, unsigned int *d, unsigned int _d_high, unsigned int SetSizeInBits, unsigned int RotateCount);
-extern "C" void M2RTS_ConstructModules (void * applicationmodule, int argc, void * argv, void * envp);
-extern "C" void M2RTS_DeconstructModules (void * applicationmodule, int argc, void * argv, void * envp);
-extern "C" void M2RTS_RegisterModule (void * name, M2RTS_ArgCVEnvP init, M2RTS_ArgCVEnvP fini, PROC dependencies);
-extern "C" void M2RTS_RequestDependant (void * modulename, void * dependantmodule);
+extern "C" void M2RTS_ConstructModules (void * applicationmodule, void * libname, int argc, void * argv, void * envp);
+extern "C" void M2RTS_DeconstructModules (void * applicationmodule, void * libname, int argc, void * argv, void * envp);
+extern "C" void M2RTS_RegisterModule (void * name, void * libname, M2RTS_ArgCVEnvP init, M2RTS_ArgCVEnvP fini, PROC dependencies);
+extern "C" void M2RTS_RequestDependant (void * modulename, void * libname, void * dependantmodule, void * dependantlibname);
extern "C" unsigned int M2RTS_InstallTerminationProcedure (PROC p);
extern "C" void M2RTS_ExecuteInitialProcedures (void);
extern "C" unsigned int M2RTS_InstallInitialProcedure (PROC p);
@@ -2782,6 +2782,7 @@ extern "C" void * libc_memcpy (void * dest, void * src, size_t size);
extern "C" void * libc_memset (void * s, int c, size_t size);
extern "C" void * libc_memmove (void * dest, void * src, size_t size);
extern "C" int libc_printf (const char *format_, unsigned int _format_high, ...);
+extern "C" int libc_snprintf (void * dest, size_t size, const char *format_, unsigned int _format_high, ...);
extern "C" int libc_setenv (void * name, void * value, int overwrite);
extern "C" void libc_srand (int seed);
extern "C" int libc_rand (void);
@@ -6679,7 +6680,7 @@ static decl_node newNode (decl_nodeT k)
d->at.firstUsed = 0;
return d;
}
- ReturnException ("../../gcc-read-write/gcc/m2/mc/decl.def", 20, 1);
+ ReturnException ("../../gcc/m2/mc/decl.def", 20, 1);
__builtin_unreachable ();
}
@@ -7039,7 +7040,7 @@ static decl_node addToScope (decl_node n)
}
M2RTS_HALT (-1);
__builtin_unreachable ();
- ReturnException ("../../gcc-read-write/gcc/m2/mc/decl.def", 20, 1);
+ ReturnException ("../../gcc/m2/mc/decl.def", 20, 1);
__builtin_unreachable ();
}
@@ -7117,7 +7118,7 @@ static void setUnary (decl_node u, decl_nodeT k, decl_node a, decl_node t)
default:
- CaseException ("../../gcc-read-write/gcc/m2/mc/decl.def", 20, 1);
+ CaseException ("../../gcc/m2/mc/decl.def", 20, 1);
__builtin_unreachable ();
}
}
@@ -7400,7 +7401,7 @@ static void putFieldVarient (decl_node f, decl_node v)
default:
- CaseException ("../../gcc-read-write/gcc/m2/mc/decl.def", 20, 1);
+ CaseException ("../../gcc/m2/mc/decl.def", 20, 1);
__builtin_unreachable ();
}
switch (f->kind)
@@ -7411,7 +7412,7 @@ static void putFieldVarient (decl_node f, decl_node v)
default:
- CaseException ("../../gcc-read-write/gcc/m2/mc/decl.def", 20, 1);
+ CaseException ("../../gcc/m2/mc/decl.def", 20, 1);
__builtin_unreachable ();
}
}
@@ -7462,7 +7463,7 @@ static decl_node putFieldRecord (decl_node r, nameKey_Name tag, decl_node type,
default:
- CaseException ("../../gcc-read-write/gcc/m2/mc/decl.def", 20, 1);
+ CaseException ("../../gcc/m2/mc/decl.def", 20, 1);
__builtin_unreachable ();
}
/* fill in, n. */
@@ -7520,7 +7521,7 @@ static void putVarientTag (decl_node v, decl_node tag)
default:
- CaseException ("../../gcc-read-write/gcc/m2/mc/decl.def", 20, 1);
+ CaseException ("../../gcc/m2/mc/decl.def", 20, 1);
__builtin_unreachable ();
}
}
@@ -7544,7 +7545,7 @@ static decl_node getParent (decl_node n)
default:
- CaseException ("../../gcc-read-write/gcc/m2/mc/decl.def", 20, 1);
+ CaseException ("../../gcc/m2/mc/decl.def", 20, 1);
__builtin_unreachable ();
}
/* static analysis guarentees a RETURN statement will be used before here. */
@@ -7572,7 +7573,7 @@ static decl_node getRecord (decl_node n)
default:
- CaseException ("../../gcc-read-write/gcc/m2/mc/decl.def", 20, 1);
+ CaseException ("../../gcc/m2/mc/decl.def", 20, 1);
__builtin_unreachable ();
}
/* static analysis guarentees a RETURN statement will be used before here. */
@@ -7752,7 +7753,7 @@ static unsigned int getConstExpComplete (decl_node n)
default:
- CaseException ("../../gcc-read-write/gcc/m2/mc/decl.def", 20, 1);
+ CaseException ("../../gcc/m2/mc/decl.def", 20, 1);
__builtin_unreachable ();
}
/* static analysis guarentees a RETURN statement will be used before here. */
@@ -7857,7 +7858,7 @@ static decl_node makeVal (decl_node params)
M2RTS_HALT (-1);
__builtin_unreachable ();
}
- ReturnException ("../../gcc-read-write/gcc/m2/mc/decl.def", 20, 1);
+ ReturnException ("../../gcc/m2/mc/decl.def", 20, 1);
__builtin_unreachable ();
}
@@ -7878,7 +7879,7 @@ static decl_node makeCast (decl_node c, decl_node p)
M2RTS_HALT (-1);
__builtin_unreachable ();
}
- ReturnException ("../../gcc-read-write/gcc/m2/mc/decl.def", 20, 1);
+ ReturnException ("../../gcc/m2/mc/decl.def", 20, 1);
__builtin_unreachable ();
}
@@ -8388,7 +8389,7 @@ static decl_node makeUnary (decl_nodeT k, decl_node e, decl_node res)
default:
- CaseException ("../../gcc-read-write/gcc/m2/mc/decl.def", 20, 1);
+ CaseException ("../../gcc/m2/mc/decl.def", 20, 1);
__builtin_unreachable ();
}
}
@@ -8482,7 +8483,7 @@ static DynamicStrings_String getStringContents (decl_node n)
}
M2RTS_HALT (-1);
__builtin_unreachable ();
- ReturnException ("../../gcc-read-write/gcc/m2/mc/decl.def", 20, 1);
+ ReturnException ("../../gcc/m2/mc/decl.def", 20, 1);
__builtin_unreachable ();
}
@@ -8618,7 +8619,7 @@ static decl_node doMakeBinary (decl_nodeT k, decl_node l, decl_node r, decl_node
default:
- CaseException ("../../gcc-read-write/gcc/m2/mc/decl.def", 20, 1);
+ CaseException ("../../gcc/m2/mc/decl.def", 20, 1);
__builtin_unreachable ();
}
return n;
@@ -9218,12 +9219,12 @@ static decl_node doGetExprType (decl_node n)
default:
- CaseException ("../../gcc-read-write/gcc/m2/mc/decl.def", 20, 1);
+ CaseException ("../../gcc/m2/mc/decl.def", 20, 1);
__builtin_unreachable ();
}
M2RTS_HALT (-1);
__builtin_unreachable ();
- ReturnException ("../../gcc-read-write/gcc/m2/mc/decl.def", 20, 1);
+ ReturnException ("../../gcc/m2/mc/decl.def", 20, 1);
__builtin_unreachable ();
}
@@ -9362,12 +9363,12 @@ static decl_node getSymScope (decl_node n)
default:
- CaseException ("../../gcc-read-write/gcc/m2/mc/decl.def", 20, 1);
+ CaseException ("../../gcc/m2/mc/decl.def", 20, 1);
__builtin_unreachable ();
}
M2RTS_HALT (-1);
__builtin_unreachable ();
- ReturnException ("../../gcc-read-write/gcc/m2/mc/decl.def", 20, 1);
+ ReturnException ("../../gcc/m2/mc/decl.def", 20, 1);
__builtin_unreachable ();
}
@@ -9679,7 +9680,7 @@ static unsigned int needsParen (decl_node n)
default:
- CaseException ("../../gcc-read-write/gcc/m2/mc/decl.def", 20, 1);
+ CaseException ("../../gcc/m2/mc/decl.def", 20, 1);
__builtin_unreachable ();
}
return TRUE;
@@ -9788,7 +9789,7 @@ static void doPolyBinary (mcPretty_pretty p, decl_nodeT op, decl_node left, decl
default:
- CaseException ("../../gcc-read-write/gcc/m2/mc/decl.def", 20, 1);
+ CaseException ("../../gcc/m2/mc/decl.def", 20, 1);
__builtin_unreachable ();
}
}
@@ -9814,7 +9815,7 @@ static void doPolyBinary (mcPretty_pretty p, decl_nodeT op, decl_node left, decl
default:
- CaseException ("../../gcc-read-write/gcc/m2/mc/decl.def", 20, 1);
+ CaseException ("../../gcc/m2/mc/decl.def", 20, 1);
__builtin_unreachable ();
}
}
@@ -10092,7 +10093,7 @@ static decl_node doGetLastOp (decl_node a, decl_node b)
default:
- CaseException ("../../gcc-read-write/gcc/m2/mc/decl.def", 20, 1);
+ CaseException ("../../gcc/m2/mc/decl.def", 20, 1);
__builtin_unreachable ();
}
/* static analysis guarentees a RETURN statement will be used before here. */
@@ -10732,7 +10733,7 @@ static void doExprC (mcPretty_pretty p, decl_node n)
default:
- CaseException ("../../gcc-read-write/gcc/m2/mc/decl.def", 20, 1);
+ CaseException ("../../gcc/m2/mc/decl.def", 20, 1);
__builtin_unreachable ();
}
}
@@ -10937,7 +10938,7 @@ static void doExprM2 (mcPretty_pretty p, decl_node n)
default:
- CaseException ("../../gcc-read-write/gcc/m2/mc/decl.def", 20, 1);
+ CaseException ("../../gcc/m2/mc/decl.def", 20, 1);
__builtin_unreachable ();
}
}
@@ -11109,7 +11110,7 @@ static DynamicStrings_String replaceChar (DynamicStrings_String s, char ch, cons
return s;
}
}
- ReturnException ("../../gcc-read-write/gcc/m2/mc/decl.def", 20, 1);
+ ReturnException ("../../gcc/m2/mc/decl.def", 20, 1);
__builtin_unreachable ();
}
@@ -11169,7 +11170,7 @@ static unsigned int countChar (DynamicStrings_String s, char ch)
return c;
}
}
- ReturnException ("../../gcc-read-write/gcc/m2/mc/decl.def", 20, 1);
+ ReturnException ("../../gcc/m2/mc/decl.def", 20, 1);
__builtin_unreachable ();
}
@@ -12228,7 +12229,7 @@ static decl_node doMin (decl_node n)
M2RTS_HALT (-1); /* finish the cacading elsif statement. */
__builtin_unreachable ();
}
- ReturnException ("../../gcc-read-write/gcc/m2/mc/decl.def", 20, 1);
+ ReturnException ("../../gcc/m2/mc/decl.def", 20, 1);
__builtin_unreachable ();
}
@@ -12309,7 +12310,7 @@ static decl_node doMax (decl_node n)
M2RTS_HALT (-1); /* finish the cacading elsif statement. */
__builtin_unreachable ();
}
- ReturnException ("../../gcc-read-write/gcc/m2/mc/decl.def", 20, 1);
+ ReturnException ("../../gcc/m2/mc/decl.def", 20, 1);
__builtin_unreachable ();
}
@@ -12598,7 +12599,7 @@ static void doBaseC (mcPretty_pretty p, decl_node n)
default:
- CaseException ("../../gcc-read-write/gcc/m2/mc/decl.def", 20, 1);
+ CaseException ("../../gcc/m2/mc/decl.def", 20, 1);
__builtin_unreachable ();
}
mcPretty_setNeedSpace (p);
@@ -12688,7 +12689,7 @@ static void doSystemC (mcPretty_pretty p, decl_node n)
default:
- CaseException ("../../gcc-read-write/gcc/m2/mc/decl.def", 20, 1);
+ CaseException ("../../gcc/m2/mc/decl.def", 20, 1);
__builtin_unreachable ();
}
}
@@ -16042,7 +16043,7 @@ static void doCreal (mcPretty_pretty p, decl_node t)
default:
- CaseException ("../../gcc-read-write/gcc/m2/mc/decl.def", 20, 1);
+ CaseException ("../../gcc/m2/mc/decl.def", 20, 1);
__builtin_unreachable ();
}
}
@@ -16073,7 +16074,7 @@ static void doCimag (mcPretty_pretty p, decl_node t)
default:
- CaseException ("../../gcc-read-write/gcc/m2/mc/decl.def", 20, 1);
+ CaseException ("../../gcc/m2/mc/decl.def", 20, 1);
__builtin_unreachable ();
}
}
@@ -16204,7 +16205,7 @@ static void doIntrinsicC (mcPretty_pretty p, decl_node n)
default:
- CaseException ("../../gcc-read-write/gcc/m2/mc/decl.def", 20, 1);
+ CaseException ("../../gcc/m2/mc/decl.def", 20, 1);
__builtin_unreachable ();
}
outText (p, (const char *) ";", 1);
@@ -17366,7 +17367,7 @@ static void dbs (decl_dependentState s, decl_node n)
default:
- CaseException ("../../gcc-read-write/gcc/m2/mc/decl.def", 20, 1);
+ CaseException ("../../gcc/m2/mc/decl.def", 20, 1);
__builtin_unreachable ();
}
if (n != NULL)
@@ -18259,10 +18260,10 @@ static decl_dependentState doDependants (alists_alist l, decl_node n)
default:
- CaseException ("../../gcc-read-write/gcc/m2/mc/decl.def", 20, 1);
+ CaseException ("../../gcc/m2/mc/decl.def", 20, 1);
__builtin_unreachable ();
}
- ReturnException ("../../gcc-read-write/gcc/m2/mc/decl.def", 20, 1);
+ ReturnException ("../../gcc/m2/mc/decl.def", 20, 1);
__builtin_unreachable ();
}
@@ -18359,7 +18360,7 @@ static void visitIntrinsicFunction (alists_alist v, decl_node n, decl_nodeProced
default:
- CaseException ("../../gcc-read-write/gcc/m2/mc/decl.def", 20, 1);
+ CaseException ("../../gcc/m2/mc/decl.def", 20, 1);
__builtin_unreachable ();
}
}
@@ -19358,7 +19359,7 @@ static void visitDependants (alists_alist v, decl_node n, decl_nodeProcedure p)
default:
- CaseException ("../../gcc-read-write/gcc/m2/mc/decl.def", 20, 1);
+ CaseException ("../../gcc/m2/mc/decl.def", 20, 1);
__builtin_unreachable ();
}
}
@@ -19705,12 +19706,12 @@ static DynamicStrings_String genKind (decl_node n)
default:
- CaseException ("../../gcc-read-write/gcc/m2/mc/decl.def", 20, 1);
+ CaseException ("../../gcc/m2/mc/decl.def", 20, 1);
__builtin_unreachable ();
}
M2RTS_HALT (-1);
__builtin_unreachable ();
- ReturnException ("../../gcc-read-write/gcc/m2/mc/decl.def", 20, 1);
+ ReturnException ("../../gcc/m2/mc/decl.def", 20, 1);
__builtin_unreachable ();
}
@@ -20885,7 +20886,7 @@ static void doBaseM2 (mcPretty_pretty p, decl_node n)
default:
- CaseException ("../../gcc-read-write/gcc/m2/mc/decl.def", 20, 1);
+ CaseException ("../../gcc/m2/mc/decl.def", 20, 1);
__builtin_unreachable ();
}
mcPretty_setNeedSpace (p);
@@ -20911,7 +20912,7 @@ static void doSystemM2 (mcPretty_pretty p, decl_node n)
default:
- CaseException ("../../gcc-read-write/gcc/m2/mc/decl.def", 20, 1);
+ CaseException ("../../gcc/m2/mc/decl.def", 20, 1);
__builtin_unreachable ();
}
}
@@ -22122,10 +22123,10 @@ static decl_node doDupExpr (decl_node n)
default:
- CaseException ("../../gcc-read-write/gcc/m2/mc/decl.def", 20, 1);
+ CaseException ("../../gcc/m2/mc/decl.def", 20, 1);
__builtin_unreachable ();
}
- ReturnException ("../../gcc-read-write/gcc/m2/mc/decl.def", 20, 1);
+ ReturnException ("../../gcc/m2/mc/decl.def", 20, 1);
__builtin_unreachable ();
}
@@ -22455,7 +22456,7 @@ extern "C" unsigned int decl_isVisited (decl_node n)
default:
- CaseException ("../../gcc-read-write/gcc/m2/mc/decl.def", 20, 1);
+ CaseException ("../../gcc/m2/mc/decl.def", 20, 1);
__builtin_unreachable ();
}
/* static analysis guarentees a RETURN statement will be used before here. */
@@ -22485,7 +22486,7 @@ extern "C" void decl_unsetVisited (decl_node n)
default:
- CaseException ("../../gcc-read-write/gcc/m2/mc/decl.def", 20, 1);
+ CaseException ("../../gcc/m2/mc/decl.def", 20, 1);
__builtin_unreachable ();
}
}
@@ -22513,7 +22514,7 @@ extern "C" void decl_setVisited (decl_node n)
default:
- CaseException ("../../gcc-read-write/gcc/m2/mc/decl.def", 20, 1);
+ CaseException ("../../gcc/m2/mc/decl.def", 20, 1);
__builtin_unreachable ();
}
}
@@ -22541,7 +22542,7 @@ extern "C" void decl_setEnumsComplete (decl_node n)
default:
- CaseException ("../../gcc-read-write/gcc/m2/mc/decl.def", 20, 1);
+ CaseException ("../../gcc/m2/mc/decl.def", 20, 1);
__builtin_unreachable ();
}
}
@@ -22569,7 +22570,7 @@ extern "C" unsigned int decl_getEnumsComplete (decl_node n)
default:
- CaseException ("../../gcc-read-write/gcc/m2/mc/decl.def", 20, 1);
+ CaseException ("../../gcc/m2/mc/decl.def", 20, 1);
__builtin_unreachable ();
}
/* static analysis guarentees a RETURN statement will be used before here. */
@@ -22790,7 +22791,7 @@ extern "C" decl_node decl_lookupInScope (decl_node scope, nameKey_Name n)
default:
- CaseException ("../../gcc-read-write/gcc/m2/mc/decl.def", 20, 1);
+ CaseException ("../../gcc/m2/mc/decl.def", 20, 1);
__builtin_unreachable ();
}
/* static analysis guarentees a RETURN statement will be used before here. */
@@ -23165,12 +23166,12 @@ extern "C" decl_node decl_getType (decl_node n)
default:
- CaseException ("../../gcc-read-write/gcc/m2/mc/decl.def", 20, 1);
+ CaseException ("../../gcc/m2/mc/decl.def", 20, 1);
__builtin_unreachable ();
}
M2RTS_HALT (-1);
__builtin_unreachable ();
- ReturnException ("../../gcc-read-write/gcc/m2/mc/decl.def", 20, 1);
+ ReturnException ("../../gcc/m2/mc/decl.def", 20, 1);
__builtin_unreachable ();
}
@@ -23564,7 +23565,7 @@ extern "C" decl_node decl_getScope (decl_node n)
default:
- CaseException ("../../gcc-read-write/gcc/m2/mc/decl.def", 20, 1);
+ CaseException ("../../gcc/m2/mc/decl.def", 20, 1);
__builtin_unreachable ();
}
/* static analysis guarentees a RETURN statement will be used before here. */
@@ -24219,7 +24220,7 @@ extern "C" decl_node decl_makeVarient (decl_node r)
default:
- CaseException ("../../gcc-read-write/gcc/m2/mc/decl.def", 20, 1);
+ CaseException ("../../gcc/m2/mc/decl.def", 20, 1);
__builtin_unreachable ();
}
return n;
@@ -24686,7 +24687,7 @@ extern "C" nameKey_Name decl_getSymName (decl_node n)
__builtin_unreachable ();
break;
}
- ReturnException ("../../gcc-read-write/gcc/m2/mc/decl.def", 20, 1);
+ ReturnException ("../../gcc/m2/mc/decl.def", 20, 1);
__builtin_unreachable ();
}
@@ -24724,7 +24725,7 @@ extern "C" decl_node decl_import (decl_node m, decl_node n)
default:
- CaseException ("../../gcc-read-write/gcc/m2/mc/decl.def", 20, 1);
+ CaseException ("../../gcc/m2/mc/decl.def", 20, 1);
__builtin_unreachable ();
}
importEnumFields (m, n);
@@ -24853,7 +24854,7 @@ extern "C" void decl_setSource (decl_node n, nameKey_Name s)
default:
- CaseException ("../../gcc-read-write/gcc/m2/mc/decl.def", 20, 1);
+ CaseException ("../../gcc/m2/mc/decl.def", 20, 1);
__builtin_unreachable ();
}
}
@@ -24881,7 +24882,7 @@ extern "C" nameKey_Name decl_getSource (decl_node n)
default:
- CaseException ("../../gcc-read-write/gcc/m2/mc/decl.def", 20, 1);
+ CaseException ("../../gcc/m2/mc/decl.def", 20, 1);
__builtin_unreachable ();
}
/* static analysis guarentees a RETURN statement will be used before here. */
@@ -25324,7 +25325,7 @@ extern "C" void decl_addParameter (decl_node proc, decl_node param)
default:
- CaseException ("../../gcc-read-write/gcc/m2/mc/decl.def", 20, 1);
+ CaseException ("../../gcc/m2/mc/decl.def", 20, 1);
__builtin_unreachable ();
}
}
@@ -25417,7 +25418,7 @@ extern "C" decl_node decl_makeBinaryTok (mcReserved_toktype op, decl_node l, dec
M2RTS_HALT (-1); /* most likely op needs a clause as above. */
__builtin_unreachable ();
}
- ReturnException ("../../gcc-read-write/gcc/m2/mc/decl.def", 20, 1);
+ ReturnException ("../../gcc/m2/mc/decl.def", 20, 1);
__builtin_unreachable ();
}
@@ -25449,7 +25450,7 @@ extern "C" decl_node decl_makeUnaryTok (mcReserved_toktype op, decl_node e)
M2RTS_HALT (-1); /* most likely op needs a clause as above. */
__builtin_unreachable ();
}
- ReturnException ("../../gcc-read-write/gcc/m2/mc/decl.def", 20, 1);
+ ReturnException ("../../gcc/m2/mc/decl.def", 20, 1);
__builtin_unreachable ();
}
@@ -25887,7 +25888,7 @@ extern "C" void decl_setConstExpComplete (decl_node n)
default:
- CaseException ("../../gcc-read-write/gcc/m2/mc/decl.def", 20, 1);
+ CaseException ("../../gcc/m2/mc/decl.def", 20, 1);
__builtin_unreachable ();
}
}
@@ -26252,7 +26253,7 @@ extern "C" void decl_putBegin (decl_node b, decl_node s)
default:
- CaseException ("../../gcc-read-write/gcc/m2/mc/decl.def", 20, 1);
+ CaseException ("../../gcc/m2/mc/decl.def", 20, 1);
__builtin_unreachable ();
}
}
@@ -26279,7 +26280,7 @@ extern "C" void decl_putFinally (decl_node b, decl_node s)
default:
- CaseException ("../../gcc-read-write/gcc/m2/mc/decl.def", 20, 1);
+ CaseException ("../../gcc/m2/mc/decl.def", 20, 1);
__builtin_unreachable ();
}
}
@@ -26907,7 +26908,7 @@ extern "C" void decl_out (void)
default:
- CaseException ("../../gcc-read-write/gcc/m2/mc/decl.def", 20, 1);
+ CaseException ("../../gcc/m2/mc/decl.def", 20, 1);
__builtin_unreachable ();
}
closeOutput ();
diff --git a/gcc/m2/mc-boot/Gkeyc.c b/gcc/m2/mc-boot/Gkeyc.c
index e089ac95250..4adcf300abb 100644
--- a/gcc/m2/mc-boot/Gkeyc.c
+++ b/gcc/m2/mc-boot/Gkeyc.c
@@ -908,7 +908,7 @@ static unsigned int mangleN (nameKey_Name n, DynamicStrings_String *m, unsigned
return TRUE;
}
}
- ReturnException ("../../gcc-read-write/gcc/m2/mc/keyc.def", 20, 1);
+ ReturnException ("../../gcc/m2/mc/keyc.def", 20, 1);
__builtin_unreachable ();
}
diff --git a/gcc/m2/mc-boot/Glibc.h b/gcc/m2/mc-boot/Glibc.h
index daa0a1c66ad..8c6cfd83a54 100644
--- a/gcc/m2/mc-boot/Glibc.h
+++ b/gcc/m2/mc-boot/Glibc.h
@@ -305,6 +305,7 @@ EXTERN void * libc_memset (void * s, int c, size_t size);
EXTERN void * libc_memmove (void * dest, void * src, size_t size);
EXTERN int libc_printf (const char *format_, unsigned int _format_high, ...);
+EXTERN int libc_snprintf (void * dest, size_t size, const char *format_, unsigned int _format_high, ...);
/*
setenv - sets environment variable, name, to value.
--git a/gcc/m2/mc-boot/GmcComment.c b/gcc/m2/mc-boot/GmcComment.c
index 2e60c7aa567..c14beb17714 100644
--- a/gcc/m2/mc-boot/GmcComment.c
+++ b/gcc/m2/mc-boot/GmcComment.c
@@ -257,7 +257,7 @@ static void dumpComment (mcComment_commentDesc cd)
default:
- CaseException ("../../gcc-read-write/gcc/m2/mc/mcComment.def", 20, 1);
+ CaseException ("../../gcc/m2/mc/mcComment.def", 20, 1);
__builtin_unreachable ();
}
if (cd->used)
diff --git a/gcc/m2/mc-boot/GmcComp.c b/gcc/m2/mc-boot/GmcComp.c
index 8a79413add4..9362f90f5a3 100644
--- a/gcc/m2/mc-boot/GmcComp.c
+++ b/gcc/m2/mc-boot/GmcComp.c
@@ -294,7 +294,7 @@ static decl_node examineCompilationUnit (void)
}
mcflex_mcError (DynamicStrings_string (DynamicStrings_InitString ((const char *) "failed to find module name", 26)));
libc_exit (1);
- ReturnException ("../../gcc-read-write/gcc/m2/mc/mcComp.def", 20, 1);
+ ReturnException ("../../gcc/m2/mc/mcComp.def", 20, 1);
__builtin_unreachable ();
}
@@ -324,7 +324,7 @@ static decl_node peepInto (DynamicStrings_String s)
mcPrintf_fprintf1 (FIO_StdErr, (const char *) "failed to open %s\\n", 19, (const unsigned char *) &s, (sizeof (s)-1));
libc_exit (1);
}
- ReturnException ("../../gcc-read-write/gcc/m2/mc/mcComp.def", 20, 1);
+ ReturnException ("../../gcc/m2/mc/mcComp.def", 20, 1);
__builtin_unreachable ();
}
diff --git a/gcc/m2/mc-boot/GmcDebug.c b/gcc/m2/mc-boot/GmcDebug.c
index db45ae8ac87..26d8efd8d38 100644
--- a/gcc/m2/mc-boot/GmcDebug.c
+++ b/gcc/m2/mc-boot/GmcDebug.c
@@ -54,7 +54,7 @@ extern "C" void mcDebug_assert (unsigned int q)
{
if (! q)
{
- mcError_internalError ((const char *) "assert failed", 13, (const char *) "../../gcc-read-write/gcc/m2/mc/mcDebug.mod", 42, 35);
+ mcError_internalError ((const char *) "assert failed", 13, (const char *) "../../gcc/m2/mc/mcDebug.mod", 27, 35);
}
}
diff --git a/gcc/m2/mc-boot/GmcMetaError.c b/gcc/m2/mc-boot/GmcMetaError.c
index 4d406851d0b..e56cad7868b 100644
--- a/gcc/m2/mc-boot/GmcMetaError.c
+++ b/gcc/m2/mc-boot/GmcMetaError.c
@@ -408,7 +408,7 @@ static void internalFormat (DynamicStrings_String s, int i, const char *m_, unsi
s = DynamicStrings_ConCatChar (s, '^');
s = SFIO_WriteS (FIO_StdOut, s);
FIO_WriteLine (FIO_StdOut);
- mcError_internalError ((const char *) m, _m_high, (const char *) "../../gcc-read-write/gcc/m2/mc/mcMetaError.mod", 46, 97);
+ mcError_internalError ((const char *) m, _m_high, (const char *) "../../gcc/m2/mc/mcMetaError.mod", 31, 97);
}
@@ -420,7 +420,7 @@ static DynamicStrings_String x (DynamicStrings_String a, DynamicStrings_String b
{
if (a != b)
{
- mcError_internalError ((const char *) "different string returned", 25, (const char *) "../../gcc-read-write/gcc/m2/mc/mcMetaError.mod", 46, 109);
+ mcError_internalError ((const char *) "different string returned", 25, (const char *) "../../gcc/m2/mc/mcMetaError.mod", 31, 109);
}
return a;
/* static analysis guarentees a RETURN statement will be used before here. */
@@ -734,7 +734,7 @@ static mcError_error doError (mcError_error e, mcMetaError_errorType t, unsigned
case mcMetaError_chained:
if (e == NULL)
{
- mcError_internalError ((const char *) "should not be chaining an error onto an empty error note", 56, (const char *) "../../gcc-read-write/gcc/m2/mc/mcMetaError.mod", 46, 355);
+ mcError_internalError ((const char *) "should not be chaining an error onto an empty error note", 56, (const char *) "../../gcc/m2/mc/mcMetaError.mod", 31, 355);
}
else
{
@@ -758,7 +758,7 @@ static mcError_error doError (mcError_error e, mcMetaError_errorType t, unsigned
default:
- mcError_internalError ((const char *) "unexpected enumeration value", 28, (const char *) "../../gcc-read-write/gcc/m2/mc/mcMetaError.mod", 46, 369);
+ mcError_internalError ((const char *) "unexpected enumeration value", 28, (const char *) "../../gcc/m2/mc/mcMetaError.mod", 31, 369);
break;
}
return e;
diff --git a/gcc/m2/mc-boot/GmcStack.c b/gcc/m2/mc-boot/GmcStack.c
index 95d31a5037b..146c79d61c0 100644
--- a/gcc/m2/mc-boot/GmcStack.c
+++ b/gcc/m2/mc-boot/GmcStack.c
@@ -165,7 +165,7 @@ extern "C" void * mcStack_pop (mcStack_stack s)
Indexing_DeleteIndice (s->list, Indexing_HighIndice (s->list));
return a;
}
- ReturnException ("../../gcc-read-write/gcc/m2/mc/mcStack.def", 20, 1);
+ ReturnException ("../../gcc/m2/mc/mcStack.def", 20, 1);
__builtin_unreachable ();
}
@@ -215,7 +215,7 @@ extern "C" void * mcStack_access (mcStack_stack s, unsigned int i)
{
return Indexing_GetIndice (s->list, i);
}
- ReturnException ("../../gcc-read-write/gcc/m2/mc/mcStack.def", 20, 1);
+ ReturnException ("../../gcc/m2/mc/mcStack.def", 20, 1);
__builtin_unreachable ();
}
diff --git a/gcc/m2/mc-boot/GnameKey.c b/gcc/m2/mc-boot/GnameKey.c
index b00a59868e4..7bb1e8fe76f 100644
--- a/gcc/m2/mc-boot/GnameKey.c
+++ b/gcc/m2/mc-boot/GnameKey.c
@@ -323,7 +323,7 @@ extern "C" nameKey_Name nameKey_makeKey (const char *a_, unsigned int _a_high)
(*p) = ASCII_nul;
return doMakeKey (n, higha);
}
- ReturnException ("../../gcc-read-write/gcc/m2/mc/nameKey.def", 20, 1);
+ ReturnException ("../../gcc/m2/mc/nameKey.def", 20, 1);
__builtin_unreachable ();
}
@@ -373,7 +373,7 @@ extern "C" nameKey_Name nameKey_makekey (void * a)
return doMakeKey (n, higha);
}
}
- ReturnException ("../../gcc-read-write/gcc/m2/mc/nameKey.def", 20, 1);
+ ReturnException ("../../gcc/m2/mc/nameKey.def", 20, 1);
__builtin_unreachable ();
}
diff --git a/gcc/m2/mc-boot/Gpth.h b/gcc/m2/mc-boot/Gpth.h
deleted file mode 100644
index 7619d7d55e0..00000000000
--- a/gcc/m2/mc-boot/Gpth.h
+++ /dev/null
@@ -1,43 +0,0 @@
-
-
-#if !defined (_pth_H)
-# define _pth_H
-
-# ifdef __cplusplus
-extern "C" {
-# endif
-# if !defined (PROC_D)
-# define PROC_D
- typedef void (*PROC_t) (void);
- typedef struct { PROC_t proc; } PROC;
-# endif
-
-# include "GSYSTEM.h"
-
-# if defined (_pth_C)
-# define EXTERN
-# else
-# define EXTERN extern
-# endif
-
-typedef struct pth_proc_p pth_proc;
-
-typedef unsigned int pth_size_t;
-
-typedef void *pth_pth_uctx_t;
-
-typedef void (*pth_proc_t) (void *);
-struct pth_proc_p { pth_proc_t proc; };
-
-EXTERN int pth_pth_select (int p1, void * p2, void * p3, void * p4, void * p5);
-EXTERN int pth_pth_uctx_create (void * p);
-EXTERN int pth_pth_uctx_make (pth_pth_uctx_t p1, void * p2, pth_size_t p3, void * p4, pth_proc p5, void * p6, pth_pth_uctx_t p7);
-EXTERN int pth_pth_uctx_save (pth_pth_uctx_t p1);
-EXTERN int pth_pth_uctx_switch (pth_pth_uctx_t p1, pth_pth_uctx_t p2);
-EXTERN int pth_pth_init (void);
-# ifdef __cplusplus
-}
-# endif
-
-# undef EXTERN
-#endif
diff --git a/gcc/m2/mc-boot/GsymbolKey.c b/gcc/m2/mc-boot/GsymbolKey.c
index 8c16a63474e..c993097dff0 100644
--- a/gcc/m2/mc-boot/GsymbolKey.c
+++ b/gcc/m2/mc-boot/GsymbolKey.c
@@ -142,7 +142,7 @@ static void findNodeAndParentInTree (symbolKey_symbolTree t, nameKey_Name n, sym
(*father) = t;
if (t == NULL)
{
- Debug_Halt ((const char *) "parameter t should never be NIL", 31, 203, (const char *) "../../gcc-read-write/gcc/m2/mc/symbolKey.mod", 44);
+ Debug_Halt ((const char *) "parameter t should never be NIL", 31, 203, (const char *) "../../gcc/m2/mc/symbolKey.mod", 29);
}
(*child) = t->left;
if ((*child) != NULL)
@@ -285,7 +285,7 @@ extern "C" void symbolKey_putSymKey (symbolKey_symbolTree t, nameKey_Name name,
}
else
{
- Debug_Halt ((const char *) "symbol already stored", 21, 119, (const char *) "../../gcc-read-write/gcc/m2/mc/symbolKey.mod", 44);
+ Debug_Halt ((const char *) "symbol already stored", 21, 119, (const char *) "../../gcc/m2/mc/symbolKey.mod", 29);
}
}
@@ -352,7 +352,7 @@ extern "C" void symbolKey_delSymKey (symbolKey_symbolTree t, nameKey_Name name)
}
else
{
- Debug_Halt ((const char *) "trying to delete a symbol that is not in the tree - the compiler never expects this to occur", 92, 186, (const char *) "../../gcc-read-write/gcc/m2/mc/symbolKey.mod", 44);
+ Debug_Halt ((const char *) "trying to delete a symbol that is not in the tree - the compiler never expects this to occur", 92, 186, (const char *) "../../gcc/m2/mc/symbolKey.mod", 29);
}
}
diff --git a/gcc/m2/pge-boot/GASCII.c b/gcc/m2/pge-boot/GASCII.c
index f9779c03cbc..077cdffb613 100644
--- a/gcc/m2/pge-boot/GASCII.c
+++ b/gcc/m2/pge-boot/GASCII.c
@@ -79,6 +79,6 @@ extern "C" void _M2_ASCII_init (__attribute__((unused)) int argc,__attribute__((
{
}
-extern "C" void _M2_ASCII_finish (__attribute__((unused)) int argc,__attribute__((unused)) char *argv[],__attribute__((unused)) char *envp[])
+extern "C" void _M2_ASCII_fini (__attribute__((unused)) int argc,__attribute__((unused)) char *argv[],__attribute__((unused)) char *envp[])
{
}
diff --git a/gcc/m2/pge-boot/GArgs.c b/gcc/m2/pge-boot/GArgs.c
index 69fbdd00633..819a46f2806 100644
--- a/gcc/m2/pge-boot/GArgs.c
+++ b/gcc/m2/pge-boot/GArgs.c
@@ -113,6 +113,6 @@ extern "C" void _M2_Args_init (__attribute__((unused)) int argc,__attribute__((u
{
}
-extern "C" void _M2_Args_finish (__attribute__((unused)) int argc,__attribute__((unused)) char *argv[],__attribute__((unused)) char *envp[])
+extern "C" void _M2_Args_fini (__attribute__((unused)) int argc,__attribute__((unused)) char *argv[],__attribute__((unused)) char *envp[])
{
}
diff --git a/gcc/m2/pge-boot/GAssertion.c b/gcc/m2/pge-boot/GAssertion.c
index 30bbe385475..5088db4068d 100644
--- a/gcc/m2/pge-boot/GAssertion.c
+++ b/gcc/m2/pge-boot/GAssertion.c
@@ -64,6 +64,6 @@ extern "C" void _M2_Assertion_init (__attribute__((unused)) int argc,__attribute
{
}
-extern "C" void _M2_Assertion_finish (__attribute__((unused)) int argc,__attribute__((unused)) char *argv[],__attribute__((unused)) char *envp[])
+extern "C" void _M2_Assertion_fini (__attribute__((unused)) int argc,__attribute__((unused)) char *argv[],__attribute__((unused)) char *envp[])
{
}
diff --git a/gcc/m2/pge-boot/GDebug.c b/gcc/m2/pge-boot/GDebug.c
index a4733248e60..431068492ee 100644
--- a/gcc/m2/pge-boot/GDebug.c
+++ b/gcc/m2/pge-boot/GDebug.c
@@ -163,6 +163,6 @@ extern "C" void _M2_Debug_init (__attribute__((unused)) int argc,__attribute__((
{
}
-extern "C" void _M2_Debug_finish (__attribute__((unused)) int argc,__attribute__((unused)) char *argv[],__attribute__((unused)) char *envp[])
+extern "C" void _M2_Debug_fini (__attribute__((unused)) int argc,__attribute__((unused)) char *argv[],__attribute__((unused)) char *envp[])
{
}
diff --git a/gcc/m2/pge-boot/GDynamicStrings.c b/gcc/m2/pge-boot/GDynamicStrings.c
index 7507eca9055..ed917cfae2e 100644
--- a/gcc/m2/pge-boot/GDynamicStrings.c
+++ b/gcc/m2/pge-boot/GDynamicStrings.c
@@ -1217,7 +1217,7 @@ static void ConcatContents (DynamicStrings_Contents *c, const char *a_, unsigned
(*c).next->contents.next = NULL;
ConcatContents (&(*c).next->contents, (const char *) a, _a_high, h, o);
AddDebugInfo ((*c).next);
- (*c).next = AssignDebug ((*c).next, (const char *) "../../gcc-read-write/gcc/m2/gm2-libs/DynamicStrings.mod", 55, 722, (const char *) "ConcatContents", 14);
+ (*c).next = AssignDebug ((*c).next, (const char *) "../../gcc/m2/gm2-libs/DynamicStrings.mod", 40, 722, (const char *) "ConcatContents", 14);
}
else
{
@@ -1315,7 +1315,7 @@ static void ConcatContentsAddress (DynamicStrings_Contents *c, void * a, unsigne
AddDebugInfo ((*c).next);
if (TraceOn)
{
- (*c).next = AssignDebug ((*c).next, (const char *) "../../gcc-read-write/gcc/m2/gm2-libs/DynamicStrings.mod", 55, 917, (const char *) "ConcatContentsAddress", 21);
+ (*c).next = AssignDebug ((*c).next, (const char *) "../../gcc/m2/gm2-libs/DynamicStrings.mod", 40, 917, (const char *) "ConcatContentsAddress", 21);
}
}
else
@@ -1540,7 +1540,7 @@ extern "C" DynamicStrings_String DynamicStrings_InitString (const char *a_, unsi
AddDebugInfo (s);
if (TraceOn)
{
- s = AssignDebug (s, (const char *) "../../gcc-read-write/gcc/m2/gm2-libs/DynamicStrings.mod", 55, 758, (const char *) "InitString", 10);
+ s = AssignDebug (s, (const char *) "../../gcc/m2/gm2-libs/DynamicStrings.mod", 40, 758, (const char *) "InitString", 10);
}
return s;
/* static analysis guarentees a RETURN statement will be used before here. */
@@ -1643,7 +1643,7 @@ extern "C" DynamicStrings_String DynamicStrings_InitStringCharStar (void * a)
AddDebugInfo (s);
if (TraceOn)
{
- s = AssignDebug (s, (const char *) "../../gcc-read-write/gcc/m2/gm2-libs/DynamicStrings.mod", 55, 957, (const char *) "InitStringCharStar", 18);
+ s = AssignDebug (s, (const char *) "../../gcc/m2/gm2-libs/DynamicStrings.mod", 40, 957, (const char *) "InitStringCharStar", 18);
}
return s;
/* static analysis guarentees a RETURN statement will be used before here. */
@@ -1668,7 +1668,7 @@ extern "C" DynamicStrings_String DynamicStrings_InitStringChar (char ch)
s = DynamicStrings_InitString ((const char *) &a.array[0], 1);
if (TraceOn)
{
- s = AssignDebug (s, (const char *) "../../gcc-read-write/gcc/m2/gm2-libs/DynamicStrings.mod", 55, 977, (const char *) "InitStringChar", 14);
+ s = AssignDebug (s, (const char *) "../../gcc/m2/gm2-libs/DynamicStrings.mod", 40, 977, (const char *) "InitStringChar", 14);
}
return s;
/* static analysis guarentees a RETURN statement will be used before here. */
@@ -1826,7 +1826,7 @@ extern "C" DynamicStrings_String DynamicStrings_Dup (DynamicStrings_String s)
s = DynamicStrings_Assign (DynamicStrings_InitString ((const char *) "", 0), s);
if (TraceOn)
{
- s = AssignDebug (s, (const char *) "../../gcc-read-write/gcc/m2/gm2-libs/DynamicStrings.mod", 55, 1173, (const char *) "Dup", 3);
+ s = AssignDebug (s, (const char *) "../../gcc/m2/gm2-libs/DynamicStrings.mod", 40, 1173, (const char *) "Dup", 3);
}
return s;
/* static analysis guarentees a RETURN statement will be used before here. */
@@ -1848,7 +1848,7 @@ extern "C" DynamicStrings_String DynamicStrings_Add (DynamicStrings_String a, Dy
a = DynamicStrings_ConCat (DynamicStrings_ConCat (DynamicStrings_InitString ((const char *) "", 0), a), b);
if (TraceOn)
{
- a = AssignDebug (a, (const char *) "../../gcc-read-write/gcc/m2/gm2-libs/DynamicStrings.mod", 55, 1193, (const char *) "Add", 3);
+ a = AssignDebug (a, (const char *) "../../gcc/m2/gm2-libs/DynamicStrings.mod", 40, 1193, (const char *) "Add", 3);
}
return a;
/* static analysis guarentees a RETURN statement will be used before here. */
@@ -1913,7 +1913,7 @@ extern "C" unsigned int DynamicStrings_EqualCharStar (DynamicStrings_String s, v
t = DynamicStrings_InitStringCharStar (a);
if (TraceOn)
{
- t = AssignDebug (t, (const char *) "../../gcc-read-write/gcc/m2/gm2-libs/DynamicStrings.mod", 55, 1250, (const char *) "EqualCharStar", 13);
+ t = AssignDebug (t, (const char *) "../../gcc/m2/gm2-libs/DynamicStrings.mod", 40, 1250, (const char *) "EqualCharStar", 13);
}
t = AddToGarbage (t, s);
if (DynamicStrings_Equal (t, s))
@@ -1951,7 +1951,7 @@ extern "C" unsigned int DynamicStrings_EqualArray (DynamicStrings_String s, cons
t = DynamicStrings_InitString ((const char *) a, _a_high);
if (TraceOn)
{
- t = AssignDebug (t, (const char *) "../../gcc-read-write/gcc/m2/gm2-libs/DynamicStrings.mod", 55, 1280, (const char *) "EqualArray", 10);
+ t = AssignDebug (t, (const char *) "../../gcc/m2/gm2-libs/DynamicStrings.mod", 40, 1280, (const char *) "EqualArray", 10);
}
t = AddToGarbage (t, s);
if (DynamicStrings_Equal (t, s))
@@ -1989,7 +1989,7 @@ extern "C" DynamicStrings_String DynamicStrings_Mult (DynamicStrings_String s, u
}
if (TraceOn)
{
- s = AssignDebug (s, (const char *) "../../gcc-read-write/gcc/m2/gm2-libs/DynamicStrings.mod", 55, 1312, (const char *) "Mult", 4);
+ s = AssignDebug (s, (const char *) "../../gcc/m2/gm2-libs/DynamicStrings.mod", 40, 1312, (const char *) "Mult", 4);
}
return s;
/* static analysis guarentees a RETURN statement will be used before here. */
@@ -2068,7 +2068,7 @@ extern "C" DynamicStrings_String DynamicStrings_Slice (DynamicStrings_String s,
AddDebugInfo (t->contents.next);
if (TraceOn)
{
- t->contents.next = AssignDebug (t->contents.next, (const char *) "../../gcc-read-write/gcc/m2/gm2-libs/DynamicStrings.mod", 55, 1380, (const char *) "Slice", 5);
+ t->contents.next = AssignDebug (t->contents.next, (const char *) "../../gcc/m2/gm2-libs/DynamicStrings.mod", 40, 1380, (const char *) "Slice", 5);
}
}
t = t->contents.next;
@@ -2086,7 +2086,7 @@ extern "C" DynamicStrings_String DynamicStrings_Slice (DynamicStrings_String s,
}
if (TraceOn)
{
- d = AssignDebug (d, (const char *) "../../gcc-read-write/gcc/m2/gm2-libs/DynamicStrings.mod", 55, 1397, (const char *) "Slice", 5);
+ d = AssignDebug (d, (const char *) "../../gcc/m2/gm2-libs/DynamicStrings.mod", 40, 1397, (const char *) "Slice", 5);
}
return d;
/* static analysis guarentees a RETURN statement will be used before here. */
@@ -2214,7 +2214,7 @@ extern "C" DynamicStrings_String DynamicStrings_RemoveComment (DynamicStrings_St
}
if (TraceOn)
{
- s = AssignDebug (s, (const char *) "../../gcc-read-write/gcc/m2/gm2-libs/DynamicStrings.mod", 55, 1509, (const char *) "RemoveComment", 13);
+ s = AssignDebug (s, (const char *) "../../gcc/m2/gm2-libs/DynamicStrings.mod", 40, 1509, (const char *) "RemoveComment", 13);
}
return s;
/* static analysis guarentees a RETURN statement will be used before here. */
@@ -2239,7 +2239,7 @@ extern "C" DynamicStrings_String DynamicStrings_RemoveWhitePrefix (DynamicString
s = DynamicStrings_Slice (s, (int ) (i), 0);
if (TraceOn)
{
- s = AssignDebug (s, (const char *) "../../gcc-read-write/gcc/m2/gm2-libs/DynamicStrings.mod", 55, 1621, (const char *) "RemoveWhitePrefix", 17);
+ s = AssignDebug (s, (const char *) "../../gcc/m2/gm2-libs/DynamicStrings.mod", 40, 1621, (const char *) "RemoveWhitePrefix", 17);
}
return s;
/* static analysis guarentees a RETURN statement will be used before here. */
@@ -2264,7 +2264,7 @@ extern "C" DynamicStrings_String DynamicStrings_RemoveWhitePostfix (DynamicStrin
s = DynamicStrings_Slice (s, 0, i+1);
if (TraceOn)
{
- s = AssignDebug (s, (const char *) "../../gcc-read-write/gcc/m2/gm2-libs/DynamicStrings.mod", 55, 1643, (const char *) "RemoveWhitePostfix", 18);
+ s = AssignDebug (s, (const char *) "../../gcc/m2/gm2-libs/DynamicStrings.mod", 40, 1643, (const char *) "RemoveWhitePostfix", 18);
}
return s;
/* static analysis guarentees a RETURN statement will be used before here. */
@@ -2633,7 +2633,7 @@ extern "C" DynamicStrings_String DynamicStrings_PopAllocationExemption (unsigned
{
stop ();
/* writeString ("mismatched number of PopAllocation's compared to PushAllocation's") */
- M2RTS_Halt ((const char *) "../../gcc-read-write/gcc/m2/gm2-libs/DynamicStrings.mod", 55, 176, (const char *) "PopAllocationExemption", 22, (const char *) "mismatched number of PopAllocation's compared to PushAllocation's", 65);
+ M2RTS_Halt ((const char *) "../../gcc/m2/gm2-libs/DynamicStrings.mod", 40, 176, (const char *) "PopAllocationExemption", 22, (const char *) "mismatched number of PopAllocation's compared to PushAllocation's", 65);
}
else
{
@@ -2674,6 +2674,6 @@ extern "C" void _M2_DynamicStrings_init (__attribute__((unused)) int argc,__attr
Init ();
}
-extern "C" void _M2_DynamicStrings_finish (__attribute__((unused)) int argc,__attribute__((unused)) char *argv[],__attribute__((unused)) char *envp[])
+extern "C" void _M2_DynamicStrings_fini (__attribute__((unused)) int argc,__attribute__((unused)) char *argv[],__attribute__((unused)) char *envp[])
{
}
diff --git a/gcc/m2/pge-boot/GFIO.c b/gcc/m2/pge-boot/GFIO.c
index adcbae3567b..d3e6b4dacc6 100644
--- a/gcc/m2/pge-boot/GFIO.c
+++ b/gcc/m2/pge-boot/GFIO.c
@@ -558,7 +558,7 @@ static FIO_File GetNextFreeDescriptor (void)
return f; /* create new slot */
}
}
- ReturnException ("../../gcc-read-write/gcc/m2/gm2-libs/FIO.def", 25, 1);
+ ReturnException ("../../gcc/m2/gm2-libs/FIO.def", 25, 1);
__builtin_unreachable ();
}
@@ -729,7 +729,7 @@ static int ReadFromBuffer (FIO_File f, void * a, unsigned int nBytes)
(*p) = static_cast<unsigned char> ((*fd->buffer->contents).array[fd->buffer->position]);
fd->buffer->left -= 1; /* remove consumed bytes */
fd->buffer->position += 1; /* move onwards n bytes */
- nBytes = 0; /* reduce the amount for future direct */
+ nBytes = 0;
/* read */
return 1;
}
@@ -824,7 +824,6 @@ static int BufferedRead (FIO_File f, unsigned int nBytes, void * a)
if (f != Error)
{
- /* avoid dangling else. */
fd = static_cast<FIO_FileDescriptor> (Indexing_GetIndice (FileInfo, f));
total = 0; /* how many bytes have we read */
if (fd != NULL) /* how many bytes have we read */
@@ -894,16 +893,9 @@ static int BufferedRead (FIO_File f, unsigned int nBytes, void * a)
}
return total;
}
- else
- {
- return -1;
- }
}
}
- else
- {
- return -1;
- }
+ return -1;
/* static analysis guarentees a RETURN statement will be used before here. */
__builtin_unreachable ();
}
@@ -2269,7 +2261,8 @@ extern "C" void * FIO_getFileName (FIO_File f)
return fd->name.address;
}
}
- ReturnException ("../../gcc-read-write/gcc/m2/gm2-libs/FIO.def", 25, 1);
+ return NULL;
+ /* static analysis guarentees a RETURN statement will be used before here. */
__builtin_unreachable ();
}
@@ -2296,7 +2289,8 @@ extern "C" unsigned int FIO_getFileNameLength (FIO_File f)
return fd->name.size;
}
}
- ReturnException ("../../gcc-read-write/gcc/m2/gm2-libs/FIO.def", 25, 1);
+ return 0;
+ /* static analysis guarentees a RETURN statement will be used before here. */
__builtin_unreachable ();
}
@@ -2325,7 +2319,7 @@ extern "C" void _M2_FIO_init (__attribute__((unused)) int argc,__attribute__((un
Init ();
}
-extern "C" void _M2_FIO_finish (__attribute__((unused)) int argc,__attribute__((unused)) char *argv[],__attribute__((unused)) char *envp[])
+extern "C" void _M2_FIO_fini (__attribute__((unused)) int argc,__attribute__((unused)) char *argv[],__attribute__((unused)) char *envp[])
{
FIO_FlushOutErr ();
}
diff --git a/gcc/m2/pge-boot/GIO.c b/gcc/m2/pge-boot/GIO.c
index 532b0a4002c..1d670569c2a 100644
--- a/gcc/m2/pge-boot/GIO.c
+++ b/gcc/m2/pge-boot/GIO.c
@@ -474,6 +474,6 @@ extern "C" void _M2_IO_init (__attribute__((unused)) int argc,__attribute__((unu
Init ();
}
-extern "C" void _M2_IO_finish (__attribute__((unused)) int argc,__attribute__((unused)) char *argv[],__attribute__((unused)) char *envp[])
+extern "C" void _M2_IO_fini (__attribute__((unused)) int argc,__attribute__((unused)) char *argv[],__attribute__((unused)) char *envp[])
{
}
diff --git a/gcc/m2/pge-boot/GIndexing.c b/gcc/m2/pge-boot/GIndexing.c
index 81c66fc316c..428f22bfce1 100644
--- a/gcc/m2/pge-boot/GIndexing.c
+++ b/gcc/m2/pge-boot/GIndexing.c
@@ -227,7 +227,7 @@ extern "C" unsigned int Indexing_InBounds (Indexing_Index i, unsigned int n)
{
return (n >= i->Low) && (n <= i->High);
}
- ReturnException ("../../gcc-read-write/gcc/m2/gm2-libs/Indexing.def", 25, 1);
+ ReturnException ("../../gcc/m2/gm2-libs/Indexing.def", 25, 1);
__builtin_unreachable ();
}
@@ -247,7 +247,7 @@ extern "C" unsigned int Indexing_HighIndice (Indexing_Index i)
{
return i->High;
}
- ReturnException ("../../gcc-read-write/gcc/m2/gm2-libs/Indexing.def", 25, 1);
+ ReturnException ("../../gcc/m2/gm2-libs/Indexing.def", 25, 1);
__builtin_unreachable ();
}
@@ -267,7 +267,7 @@ extern "C" unsigned int Indexing_LowIndice (Indexing_Index i)
{
return i->Low;
}
- ReturnException ("../../gcc-read-write/gcc/m2/gm2-libs/Indexing.def", 25, 1);
+ ReturnException ("../../gcc/m2/gm2-libs/Indexing.def", 25, 1);
__builtin_unreachable ();
}
@@ -488,6 +488,6 @@ extern "C" void _M2_Indexing_init (__attribute__((unused)) int argc,__attribute_
{
}
-extern "C" void _M2_Indexing_finish (__attribute__((unused)) int argc,__attribute__((unused)) char *argv[],__attribute__((unused)) char *envp[])
+extern "C" void _M2_Indexing_fini (__attribute__((unused)) int argc,__attribute__((unused)) char *argv[],__attribute__((unused)) char *envp[])
{
}
diff --git a/gcc/m2/pge-boot/GLists.c b/gcc/m2/pge-boot/GLists.c
index 38538bdaaea..45f0ffcb3d3 100644
--- a/gcc/m2/pge-boot/GLists.c
+++ b/gcc/m2/pge-boot/GLists.c
@@ -422,6 +422,6 @@ extern "C" void _M2_Lists_init (__attribute__((unused)) int argc,__attribute__((
{
}
-extern "C" void _M2_Lists_finish (__attribute__((unused)) int argc,__attribute__((unused)) char *argv[],__attribute__((unused)) char *envp[])
+extern "C" void _M2_Lists_fini (__attribute__((unused)) int argc,__attribute__((unused)) char *argv[],__attribute__((unused)) char *envp[])
{
}
diff --git a/gcc/m2/pge-boot/GM2Dependent.c b/gcc/m2/pge-boot/GM2Dependent.c
index 32c777c2402..0e0e3eadcc3 100644
--- a/gcc/m2/pge-boot/GM2Dependent.c
+++ b/gcc/m2/pge-boot/GM2Dependent.c
@@ -42,7 +42,9 @@ see the files COPYING3 and COPYING.RUNTIME respectively. If not, see
#include <stddef.h>
#include <string.h>
#include <limits.h>
+#include <stdlib.h>
# include "GStorage.h"
+#include <unistd.h>
#if defined(__cplusplus)
# undef NULL
# define NULL 0
@@ -84,6 +86,7 @@ struct M2Dependent_DependencyList_r {
struct M2Dependent__T3_a { M2Dependent_ModuleChain array[M2Dependent_user-M2Dependent_unregistered+1]; };
struct M2Dependent__T2_r {
void *name;
+ void *libname;
M2Dependent_ArgCVEnvP init;
M2Dependent_ArgCVEnvP fini;
M2Dependent_DependencyList dependency;
@@ -93,7 +96,9 @@ struct M2Dependent__T2_r {
static M2Dependent__T3 Modules;
static unsigned int Initialized;
+static unsigned int WarningTrace;
static unsigned int ModuleTrace;
+static unsigned int HexTrace;
static unsigned int DependencyTrace;
static unsigned int PreTrace;
static unsigned int PostTrace;
@@ -104,14 +109,14 @@ static unsigned int ForceTrace;
module constructor in turn.
*/
-extern "C" void M2Dependent_ConstructModules (void * applicationmodule, int argc, void * argv, void * envp);
+extern "C" void M2Dependent_ConstructModules (void * applicationmodule, void * libname, int argc, void * argv, void * envp);
/*
DeconstructModules - resolve dependencies and then call each
module constructor in turn.
*/
-extern "C" void M2Dependent_DeconstructModules (void * applicationmodule, int argc, void * argv, void * envp);
+extern "C" void M2Dependent_DeconstructModules (void * applicationmodule, void * libname, int argc, void * argv, void * envp);
/*
RegisterModule - adds module name to the list of outstanding
@@ -119,7 +124,7 @@ extern "C" void M2Dependent_DeconstructModules (void * applicationmodule, int ar
explored to determine initialization order.
*/
-extern "C" void M2Dependent_RegisterModule (void * name, M2Dependent_ArgCVEnvP init, M2Dependent_ArgCVEnvP fini, PROC dependencies);
+extern "C" void M2Dependent_RegisterModule (void * modulename, void * libname, M2Dependent_ArgCVEnvP init, M2Dependent_ArgCVEnvP fini, PROC dependencies);
/*
RequestDependant - used to specify that modulename is dependant upon
@@ -127,14 +132,14 @@ extern "C" void M2Dependent_RegisterModule (void * name, M2Dependent_ArgCVEnvP i
if we are not using StaticInitialization.
*/
-extern "C" void M2Dependent_RequestDependant (void * modulename, void * dependantmodule);
+extern "C" void M2Dependent_RequestDependant (void * modulename, void * libname, void * dependantmodule, void * dependantlibname);
/*
CreateModule - creates a new module entry and returns the
ModuleChain.
*/
-static M2Dependent_ModuleChain CreateModule (void * name, M2Dependent_ArgCVEnvP init, M2Dependent_ArgCVEnvP fini, PROC dependencies);
+static M2Dependent_ModuleChain CreateModule (void * name, void * libname, M2Dependent_ArgCVEnvP init, M2Dependent_ArgCVEnvP fini, PROC dependencies);
/*
AppendModule - append chain to end of the list.
@@ -155,18 +160,30 @@ static void RemoveModule (M2Dependent_ModuleChain *head, M2Dependent_ModuleChain
static unsigned int onChain (M2Dependent_DependencyState state, M2Dependent_ModuleChain mptr);
/*
- LookupModuleN - lookup module from the state list. The string is limited
- to nchar.
+ max -
*/
-static M2Dependent_ModuleChain LookupModuleN (M2Dependent_DependencyState state, void * name, unsigned int nchar);
+static unsigned int max (unsigned int a, unsigned int b);
+
+/*
+ min -
+*/
+
+static unsigned int min (unsigned int a, unsigned int b);
+
+/*
+ LookupModuleN - lookup module from the state list.
+ The strings lengths are known.
+*/
+
+static M2Dependent_ModuleChain LookupModuleN (M2Dependent_DependencyState state, void * name, unsigned int namelen, void * libname, unsigned int libnamelen);
/*
LookupModule - lookup and return the ModuleChain pointer containing
module name from a particular list.
*/
-static M2Dependent_ModuleChain LookupModule (M2Dependent_DependencyState state, void * name);
+static M2Dependent_ModuleChain LookupModule (M2Dependent_DependencyState state, void * name, void * libname);
/*
toCString - replace any character sequence
@@ -207,6 +224,12 @@ static void traceprintf (unsigned int flag, const char *str_, unsigned int _str_
static void traceprintf2 (unsigned int flag, const char *str_, unsigned int _str_high, void * arg);
+/*
+ traceprintf3 - wrap printf with a boolean flag.
+*/
+
+static void traceprintf3 (unsigned int flag, const char *str_, unsigned int _str_high, void * arg1, void * arg2);
+
/*
moveTo - moves mptr to the new list determined by newstate.
It updates the mptr state appropriately.
@@ -218,7 +241,7 @@ static void moveTo (M2Dependent_DependencyState newstate, M2Dependent_ModuleChai
ResolveDependant -
*/
-static void ResolveDependant (M2Dependent_ModuleChain mptr, void * currentmodule);
+static void ResolveDependant (M2Dependent_ModuleChain mptr, void * currentmodule, void * libname);
/*
PerformRequestDependant - the current modulename has a dependancy upon
@@ -227,19 +250,19 @@ static void ResolveDependant (M2Dependent_ModuleChain mptr, void * currentmodule
resolved.
*/
-static void PerformRequestDependant (void * modulename, void * dependantmodule);
+static void PerformRequestDependant (void * modulename, void * libname, void * dependantmodule, void * dependantlibname);
/*
- ResolveDependencies - resolve dependencies for currentmodule.
+ ResolveDependencies - resolve dependencies for currentmodule, libname.
*/
-static void ResolveDependencies (void * currentmodule);
+static void ResolveDependencies (void * currentmodule, void * libname);
/*
DisplayModuleInfo - displays all module in the state.
*/
-static void DisplayModuleInfo (M2Dependent_DependencyState state, const char *name_, unsigned int _name_high);
+static void DisplayModuleInfo (M2Dependent_DependencyState state, const char *desc_, unsigned int _desc_high);
/*
DumpModuleData -
@@ -256,6 +279,18 @@ static void DumpModuleData (unsigned int flag);
static void combine (M2Dependent_DependencyState src, M2Dependent_DependencyState dest);
+/*
+ tracemodule -
+*/
+
+static void tracemodule (unsigned int flag, void * modname, unsigned int modlen, void * libname, unsigned int liblen);
+
+/*
+ ForceModule -
+*/
+
+static void ForceModule (void * modname, unsigned int modlen, void * libname, unsigned int liblen);
+
/*
ForceDependencies - if the user has specified a forced order then we override
the dynamic ordering with the preference.
@@ -270,6 +305,12 @@ static void ForceDependencies (void);
static void CheckApplication (void);
+/*
+ warning3 - write format arg1 arg2 to stderr.
+*/
+
+static void warning3 (const char *format_, unsigned int _format_high, void * arg1, void * arg2);
+
/*
equal - return TRUE if C string cstr is equal to str.
*/
@@ -280,11 +321,12 @@ static unsigned int equal (void * cstr, const char *str_, unsigned int _str_high
SetupDebugFlags - By default assigns ModuleTrace, DependencyTrace,
DumpPostInit to FALSE. It checks the environment
GCC_M2LINK_RTFLAG which can contain
- "all,module,pre,post,dep,force". all turns them all on.
+ "all,module,hex,pre,post,dep,force". all turns them all on.
The flag meanings are as follows and flags the are in
execution order.
module generate trace info as the modules are registered.
+ hex dump the modules ctor functions address in hex.
pre generate a list of all modules seen prior to having
their dependancies resolved.
dep display a trace as the modules are resolved.
@@ -317,18 +359,26 @@ static void CheckInitialized (void);
ModuleChain.
*/
-static M2Dependent_ModuleChain CreateModule (void * name, M2Dependent_ArgCVEnvP init, M2Dependent_ArgCVEnvP fini, PROC dependencies)
+static M2Dependent_ModuleChain CreateModule (void * name, void * libname, M2Dependent_ArgCVEnvP init, M2Dependent_ArgCVEnvP fini, PROC dependencies)
{
M2Dependent_ModuleChain mptr;
+ void * p0;
+ void * p1;
Storage_ALLOCATE ((void **) &mptr, sizeof (M2Dependent__T2));
mptr->name = name;
+ mptr->libname = libname;
mptr->init = init;
mptr->fini = fini;
mptr->dependency.proc = dependencies;
mptr->dependency.state = M2Dependent_unregistered;
mptr->prev = NULL;
mptr->next = NULL;
+ if (HexTrace)
+ {
+ libc_printf ((const char *) " (init: %p fini: %p", 22, init, fini);
+ libc_printf ((const char *) " dep: %p)", 10, dependencies);
+ }
return mptr;
/* static analysis guarentees a RETURN statement will be used before here. */
__builtin_unreachable ();
@@ -405,11 +455,49 @@ static unsigned int onChain (M2Dependent_DependencyState state, M2Dependent_Modu
/*
- LookupModuleN - lookup module from the state list. The string is limited
- to nchar.
+ max -
+*/
+
+static unsigned int max (unsigned int a, unsigned int b)
+{
+ if (a > b)
+ {
+ return a;
+ }
+ else
+ {
+ return b;
+ }
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ min -
*/
-static M2Dependent_ModuleChain LookupModuleN (M2Dependent_DependencyState state, void * name, unsigned int nchar)
+static unsigned int min (unsigned int a, unsigned int b)
+{
+ if (a < b)
+ {
+ return a;
+ }
+ else
+ {
+ return b;
+ }
+ /* static analysis guarentees a RETURN statement will be used before here. */
+ __builtin_unreachable ();
+}
+
+
+/*
+ LookupModuleN - lookup module from the state list.
+ The strings lengths are known.
+*/
+
+static M2Dependent_ModuleChain LookupModuleN (M2Dependent_DependencyState state, void * name, unsigned int namelen, void * libname, unsigned int libnamelen)
{
M2Dependent_ModuleChain ptr;
@@ -417,7 +505,7 @@ static M2Dependent_ModuleChain LookupModuleN (M2Dependent_DependencyState state,
{
ptr = Modules.array[state-M2Dependent_unregistered];
do {
- if ((strncmp (reinterpret_cast<M2LINK_PtrToChar> (ptr->name), reinterpret_cast<M2LINK_PtrToChar> (name), nchar)) == 0)
+ if (((strncmp (reinterpret_cast<M2LINK_PtrToChar> (ptr->name), reinterpret_cast<M2LINK_PtrToChar> (name), max (namelen, static_cast<unsigned int> (strlen_ (reinterpret_cast<M2LINK_PtrToChar> (ptr->name)))))) == 0) && ((strncmp (reinterpret_cast<M2LINK_PtrToChar> (ptr->libname), reinterpret_cast<M2LINK_PtrToChar> (libname), max (libnamelen, static_cast<unsigned int> (strlen_ (reinterpret_cast<M2LINK_PtrToChar> (ptr->libname)))))) == 0))
{
return ptr;
}
@@ -435,9 +523,9 @@ static M2Dependent_ModuleChain LookupModuleN (M2Dependent_DependencyState state,
module name from a particular list.
*/
-static M2Dependent_ModuleChain LookupModule (M2Dependent_DependencyState state, void * name)
+static M2Dependent_ModuleChain LookupModule (M2Dependent_DependencyState state, void * name, void * libname)
{
- return LookupModuleN (state, name, static_cast<unsigned int> (strlen_ (reinterpret_cast<M2LINK_PtrToChar> (name))));
+ return LookupModuleN (state, name, static_cast<unsigned int> (strlen_ (reinterpret_cast<M2LINK_PtrToChar> (name))), libname, static_cast<unsigned int> (strlen_ (reinterpret_cast<M2LINK_PtrToChar> (libname))));
/* static analysis guarentees a RETURN statement will be used before here. */
__builtin_unreachable ();
}
@@ -516,9 +604,13 @@ static int strcmp (M2LINK_PtrToChar a, M2LINK_PtrToChar b)
static int strncmp (M2LINK_PtrToChar a, M2LINK_PtrToChar b, unsigned int n)
{
- if (((a != NULL) && (b != NULL)) && (n > 0))
+ if (n == 0)
{
- /* avoid gcc warning by using compound statement even if not strictly necessary. */
+ return 0;
+ }
+ else if ((a != NULL) && (b != NULL))
+ {
+ /* avoid dangling else. */
if (a == b)
{
return 0;
@@ -595,6 +687,7 @@ static void traceprintf (unsigned int flag, const char *str_, unsigned int _str_
static void traceprintf2 (unsigned int flag, const char *str_, unsigned int _str_high, void * arg)
{
+ char ch;
char str[_str_high+1];
/* make a local copy of each unbounded array. */
@@ -603,11 +696,46 @@ static void traceprintf2 (unsigned int flag, const char *str_, unsigned int _str
if (flag)
{
toCString ((char *) str, _str_high);
+ if (arg == NULL)
+ {
+ ch = (char) 0;
+ arg = &ch;
+ }
libc_printf ((const char *) str, _str_high, arg);
}
}
+/*
+ traceprintf3 - wrap printf with a boolean flag.
+*/
+
+static void traceprintf3 (unsigned int flag, const char *str_, unsigned int _str_high, void * arg1, void * arg2)
+{
+ char ch;
+ char str[_str_high+1];
+
+ /* make a local copy of each unbounded array. */
+ memcpy (str, str_, _str_high+1);
+
+ if (flag)
+ {
+ toCString ((char *) str, _str_high);
+ if (arg1 == NULL)
+ {
+ ch = (char) 0;
+ arg1 = &ch;
+ }
+ if (arg2 == NULL)
+ {
+ ch = (char) 0;
+ arg2 = &ch;
+ }
+ libc_printf ((const char *) str, _str_high, arg1, arg2);
+ }
+}
+
+
/*
moveTo - moves mptr to the new list determined by newstate.
It updates the mptr state appropriately.
@@ -628,11 +756,11 @@ static void moveTo (M2Dependent_DependencyState newstate, M2Dependent_ModuleChai
ResolveDependant -
*/
-static void ResolveDependant (M2Dependent_ModuleChain mptr, void * currentmodule)
+static void ResolveDependant (M2Dependent_ModuleChain mptr, void * currentmodule, void * libname)
{
if (mptr == NULL)
{
- traceprintf (DependencyTrace, (const char *) " module has not been registered via a global constructor\\n", 60);
+ traceprintf3 (DependencyTrace, (const char *) " module %s [%s] has not been registered via a global constructor\\n", 68, currentmodule, libname);
}
else
{
@@ -643,9 +771,9 @@ static void ResolveDependant (M2Dependent_ModuleChain mptr, void * currentmodule
else
{
moveTo (M2Dependent_started, mptr);
- traceprintf2 (DependencyTrace, (const char *) " starting: %s\\n", 17, currentmodule);
+ traceprintf3 (DependencyTrace, (const char *) " starting: %s [%s]\\n", 22, currentmodule, libname);
(*mptr->dependency.proc.proc) (); /* Invoke and process the dependency graph. */
- traceprintf2 (DependencyTrace, (const char *) " finished: %s\\n", 17, currentmodule); /* Invoke and process the dependency graph. */
+ traceprintf3 (DependencyTrace, (const char *) " finished: %s [%s]\\n", 22, currentmodule, libname); /* Invoke and process the dependency graph. */
moveTo (M2Dependent_ordered, mptr);
}
}
@@ -659,73 +787,73 @@ static void ResolveDependant (M2Dependent_ModuleChain mptr, void * currentmodule
resolved.
*/
-static void PerformRequestDependant (void * modulename, void * dependantmodule)
+static void PerformRequestDependant (void * modulename, void * libname, void * dependantmodule, void * dependantlibname)
{
M2Dependent_ModuleChain mptr;
- traceprintf2 (DependencyTrace, (const char *) " module %s", 11, modulename);
+ traceprintf3 (DependencyTrace, (const char *) " module %s [%s]", 16, modulename, libname);
if (dependantmodule == NULL)
{
/* avoid dangling else. */
- traceprintf2 (DependencyTrace, (const char *) " has finished its import graph\\n", 32, modulename);
- mptr = LookupModule (M2Dependent_unordered, modulename);
+ traceprintf (DependencyTrace, (const char *) " has finished its import graph\\n", 32);
+ mptr = LookupModule (M2Dependent_unordered, modulename, libname);
if (mptr != NULL)
{
- traceprintf2 (DependencyTrace, (const char *) " module %s is now ordered\\n", 28, modulename);
+ traceprintf3 (DependencyTrace, (const char *) " module %s [%s] is now ordered\\n", 33, modulename, libname);
moveTo (M2Dependent_ordered, mptr);
}
}
else
{
- traceprintf2 (DependencyTrace, (const char *) " imports from %s\\n", 18, dependantmodule);
- mptr = LookupModule (M2Dependent_ordered, dependantmodule);
+ traceprintf3 (DependencyTrace, (const char *) " imports from %s [%s]\\n", 23, dependantmodule, dependantlibname);
+ mptr = LookupModule (M2Dependent_ordered, dependantmodule, dependantlibname);
if (mptr == NULL)
{
- traceprintf2 (DependencyTrace, (const char *) " module %s is not ordered\\n", 28, dependantmodule);
- mptr = LookupModule (M2Dependent_unordered, dependantmodule);
+ traceprintf3 (DependencyTrace, (const char *) " module %s [%s] is not ordered\\n", 33, dependantmodule, dependantlibname);
+ mptr = LookupModule (M2Dependent_unordered, dependantmodule, dependantlibname);
if (mptr == NULL)
{
- traceprintf2 (DependencyTrace, (const char *) " module %s is not unordered\\n", 30, dependantmodule);
- mptr = LookupModule (M2Dependent_started, dependantmodule);
+ traceprintf3 (DependencyTrace, (const char *) " module %s [%s] is not unordered\\n", 35, dependantmodule, dependantlibname);
+ mptr = LookupModule (M2Dependent_started, dependantmodule, dependantlibname);
if (mptr == NULL)
{
- traceprintf2 (DependencyTrace, (const char *) " module %s has not started\\n", 29, dependantmodule);
- traceprintf2 (DependencyTrace, (const char *) " module %s attempting to import from", 37, modulename);
- traceprintf2 (DependencyTrace, (const char *) " %s which has not registered itself via a constructor\\n", 55, dependantmodule);
+ traceprintf3 (DependencyTrace, (const char *) " module %s [%s] has not started\\n", 34, dependantmodule, dependantlibname);
+ traceprintf3 (DependencyTrace, (const char *) " module %s [%s] attempting to import from", 42, modulename, libname);
+ traceprintf3 (DependencyTrace, (const char *) " %s [%s] which has not registered itself via a constructor\\n", 60, dependantmodule, dependantlibname);
}
else
{
- traceprintf2 (DependencyTrace, (const char *) " module %s has registered itself and has started\\n", 51, dependantmodule);
+ traceprintf3 (DependencyTrace, (const char *) " module %s [%s] has registered itself and has started\\n", 56, dependantmodule, dependantlibname);
}
}
else
{
- traceprintf2 (DependencyTrace, (const char *) " module %s resolving\\n", 23, dependantmodule);
- ResolveDependant (mptr, dependantmodule);
+ traceprintf3 (DependencyTrace, (const char *) " module %s [%s] resolving\\n", 28, dependantmodule, dependantlibname);
+ ResolveDependant (mptr, dependantmodule, dependantlibname);
}
}
else
{
- traceprintf2 (DependencyTrace, (const char *) " module %s ", 12, modulename);
- traceprintf2 (DependencyTrace, (const char *) " dependant %s is ordered\\n", 26, dependantmodule);
+ traceprintf3 (DependencyTrace, (const char *) " module %s [%s]", 16, modulename, libname);
+ traceprintf3 (DependencyTrace, (const char *) " dependant %s [%s] is ordered\\n", 31, dependantmodule, dependantlibname);
}
}
}
/*
- ResolveDependencies - resolve dependencies for currentmodule.
+ ResolveDependencies - resolve dependencies for currentmodule, libname.
*/
-static void ResolveDependencies (void * currentmodule)
+static void ResolveDependencies (void * currentmodule, void * libname)
{
M2Dependent_ModuleChain mptr;
- mptr = LookupModule (M2Dependent_unordered, currentmodule);
+ mptr = LookupModule (M2Dependent_unordered, currentmodule, libname);
while (mptr != NULL)
{
- traceprintf2 (DependencyTrace, (const char *) " attempting to resolve the dependants for %s\\n", 48, currentmodule);
- ResolveDependant (mptr, currentmodule);
+ traceprintf3 (DependencyTrace, (const char *) " attempting to resolve the dependants for %s [%s]\\n", 53, currentmodule, libname);
+ ResolveDependant (mptr, currentmodule, libname);
mptr = Modules.array[M2Dependent_unordered-M2Dependent_unregistered];
}
}
@@ -735,22 +863,29 @@ static void ResolveDependencies (void * currentmodule)
DisplayModuleInfo - displays all module in the state.
*/
-static void DisplayModuleInfo (M2Dependent_DependencyState state, const char *name_, unsigned int _name_high)
+static void DisplayModuleInfo (M2Dependent_DependencyState state, const char *desc_, unsigned int _desc_high)
{
M2Dependent_ModuleChain mptr;
unsigned int count;
- char name[_name_high+1];
+ char desc[_desc_high+1];
/* make a local copy of each unbounded array. */
- memcpy (name, name_, _name_high+1);
+ memcpy (desc, desc_, _desc_high+1);
if (Modules.array[state-M2Dependent_unregistered] != NULL)
{
- libc_printf ((const char *) "%s modules\\n", 12, &name);
+ libc_printf ((const char *) "%s modules\\n", 12, &desc);
mptr = Modules.array[state-M2Dependent_unregistered];
count = 0;
do {
- libc_printf ((const char *) " %d %s", 8, count, mptr->name);
+ if (mptr->name == NULL)
+ {
+ libc_printf ((const char *) " %d %s []", 11, count, mptr->name);
+ }
+ else
+ {
+ libc_printf ((const char *) " %d %s [%s]", 13, count, mptr->name, mptr->libname);
+ }
count += 1;
if (mptr->dependency.appl)
{
@@ -809,6 +944,52 @@ static void combine (M2Dependent_DependencyState src, M2Dependent_DependencyStat
}
+/*
+ tracemodule -
+*/
+
+static void tracemodule (unsigned int flag, void * modname, unsigned int modlen, void * libname, unsigned int liblen)
+{
+ typedef struct tracemodule__T4_a tracemodule__T4;
+
+ struct tracemodule__T4_a { char array[100+1]; };
+ tracemodule__T4 buffer;
+ unsigned int len;
+
+ if (flag)
+ {
+ len = min (modlen, sizeof (buffer)-1);
+ libc_strncpy (&buffer, modname, len);
+ buffer.array[len] = (char) 0;
+ libc_printf ((const char *) "%s ", 3, &buffer);
+ len = min (liblen, sizeof (buffer)-1);
+ libc_strncpy (&buffer, libname, len);
+ buffer.array[len] = (char) 0;
+ libc_printf ((const char *) " [%s]", 5, &buffer);
+ }
+}
+
+
+/*
+ ForceModule -
+*/
+
+static void ForceModule (void * modname, unsigned int modlen, void * libname, unsigned int liblen)
+{
+ M2Dependent_ModuleChain mptr;
+
+ traceprintf (ForceTrace, (const char *) "forcing module: ", 16);
+ tracemodule (ForceTrace, modname, modlen, libname, liblen);
+ traceprintf (ForceTrace, (const char *) "\\n", 2);
+ mptr = LookupModuleN (M2Dependent_ordered, modname, modlen, libname, liblen);
+ if (mptr != NULL)
+ {
+ mptr->dependency.forced = TRUE;
+ moveTo (M2Dependent_user, mptr);
+ }
+}
+
+
/*
ForceDependencies - if the user has specified a forced order then we override
the dynamic ordering with the preference.
@@ -816,46 +997,58 @@ static void combine (M2Dependent_DependencyState src, M2Dependent_DependencyStat
static void ForceDependencies (void)
{
- M2Dependent_ModuleChain mptr;
- M2Dependent_ModuleChain userChain;
- unsigned int count;
+ unsigned int len;
+ unsigned int modlen;
+ unsigned int liblen;
+ M2LINK_PtrToChar modname;
+ M2LINK_PtrToChar libname;
M2LINK_PtrToChar pc;
M2LINK_PtrToChar start;
if (M2LINK_ForcedModuleInitOrder != NULL)
{
- userChain = NULL;
+ traceprintf2 (ForceTrace, (const char *) "user forcing order: %s\\n", 24, reinterpret_cast<void *> (M2LINK_ForcedModuleInitOrder));
pc = M2LINK_ForcedModuleInitOrder;
start = pc;
- count = 0;
+ len = 0;
+ modname = NULL;
+ modlen = 0;
+ libname = NULL;
+ liblen = 0;
while ((*pc) != ASCII_nul)
{
- if ((*pc) == ',')
- {
- mptr = LookupModuleN (M2Dependent_ordered, reinterpret_cast<void *> (start), count);
- if (mptr != NULL)
- {
- mptr->dependency.forced = TRUE;
- moveTo (M2Dependent_user, mptr);
- }
- pc += 1;
- start = pc;
- count = 0;
- }
- else
+ switch ((*pc))
{
- pc += 1;
- count += 1;
+ case ':':
+ libname = start;
+ liblen = len;
+ len = 0;
+ pc += 1;
+ start = pc;
+ break;
+
+ case ',':
+ modname = start;
+ modlen = len;
+ ForceModule (reinterpret_cast<void *> (modname), modlen, reinterpret_cast<void *> (libname), liblen);
+ libname = NULL;
+ liblen = 0;
+ modlen = 0;
+ len = 0;
+ pc += 1;
+ start = pc;
+ break;
+
+
+ default:
+ pc += 1;
+ len += 1;
+ break;
}
}
if (start != pc)
{
- mptr = LookupModuleN (M2Dependent_ordered, reinterpret_cast<void *> (start), count);
- if (mptr != NULL)
- {
- mptr->dependency.forced = TRUE;
- moveTo (M2Dependent_user, mptr);
- }
+ ForceModule (reinterpret_cast<void *> (start), len, reinterpret_cast<void *> (libname), liblen);
}
combine (M2Dependent_user, M2Dependent_ordered);
}
@@ -888,12 +1081,39 @@ static void CheckApplication (void)
} while (! ((appl != NULL) || (mptr == Modules.array[M2Dependent_ordered-M2Dependent_unregistered])));
if (appl != NULL)
{
- Modules.array[M2Dependent_ordered-M2Dependent_unregistered] = appl->next;
+ RemoveModule (&Modules.array[M2Dependent_ordered-M2Dependent_unregistered], appl);
+ AppendModule (&Modules.array[M2Dependent_ordered-M2Dependent_unregistered], appl);
}
}
}
+/*
+ warning3 - write format arg1 arg2 to stderr.
+*/
+
+static void warning3 (const char *format_, unsigned int _format_high, void * arg1, void * arg2)
+{
+ typedef struct warning3__T5_a warning3__T5;
+
+ struct warning3__T5_a { char array[4096+1]; };
+ warning3__T5 buffer;
+ int len;
+ char format[_format_high+1];
+
+ /* make a local copy of each unbounded array. */
+ memcpy (format, format_, _format_high+1);
+
+ if (WarningTrace)
+ {
+ len = libc_snprintf (&buffer, static_cast<size_t> (sizeof (buffer)), (const char *) "warning: ", 9);
+ libc_write (2, &buffer, static_cast<size_t> (len));
+ len = libc_snprintf (&buffer, static_cast<size_t> (sizeof (buffer)), (const char *) format, _format_high, arg1, arg2);
+ libc_write (2, &buffer, static_cast<size_t> (len));
+ }
+}
+
+
/*
equal - return TRUE if C string cstr is equal to str.
*/
@@ -915,11 +1135,12 @@ static unsigned int equal (void * cstr, const char *str_, unsigned int _str_high
SetupDebugFlags - By default assigns ModuleTrace, DependencyTrace,
DumpPostInit to FALSE. It checks the environment
GCC_M2LINK_RTFLAG which can contain
- "all,module,pre,post,dep,force". all turns them all on.
+ "all,module,hex,pre,post,dep,force". all turns them all on.
The flag meanings are as follows and flags the are in
execution order.
module generate trace info as the modules are registered.
+ hex dump the modules ctor functions address in hex.
pre generate a list of all modules seen prior to having
their dependancies resolved.
dep display a trace as the modules are resolved.
@@ -940,6 +1161,8 @@ static void SetupDebugFlags (void)
PostTrace = FALSE;
PreTrace = FALSE;
ForceTrace = FALSE;
+ HexTrace = FALSE;
+ WarningTrace = FALSE;
pc = static_cast<SetupDebugFlags__T1> (libc_getenv (const_cast<void*> (reinterpret_cast<const void*>("GCC_M2LINK_RTFLAG"))));
while ((pc != NULL) && ((*pc) != ASCII_nul))
{
@@ -950,6 +1173,8 @@ static void SetupDebugFlags (void)
PreTrace = TRUE;
PostTrace = TRUE;
ForceTrace = TRUE;
+ HexTrace = TRUE;
+ WarningTrace = TRUE;
pc += 3;
}
else if (equal (reinterpret_cast<void *> (pc), (const char *) "module", 6))
@@ -958,6 +1183,18 @@ static void SetupDebugFlags (void)
ModuleTrace = TRUE;
pc += 6;
}
+ else if (equal (reinterpret_cast<void *> (pc), (const char *) "warning", 7))
+ {
+ /* avoid dangling else. */
+ WarningTrace = TRUE;
+ pc += 7;
+ }
+ else if (equal (reinterpret_cast<void *> (pc), (const char *) "hex", 3))
+ {
+ /* avoid dangling else. */
+ HexTrace = TRUE;
+ pc += 3;
+ }
else if (equal (reinterpret_cast<void *> (pc), (const char *) "dep", 3))
{
/* avoid dangling else. */
@@ -1029,21 +1266,21 @@ static void CheckInitialized (void)
module constructor in turn.
*/
-extern "C" void M2Dependent_ConstructModules (void * applicationmodule, int argc, void * argv, void * envp)
+extern "C" void M2Dependent_ConstructModules (void * applicationmodule, void * libname, int argc, void * argv, void * envp)
{
M2Dependent_ModuleChain mptr;
M2Dependent_ArgCVEnvP nulp;
CheckInitialized ();
- traceprintf2 (ModuleTrace, (const char *) "application module: %s\\n", 24, applicationmodule);
- mptr = LookupModule (M2Dependent_unordered, applicationmodule);
+ traceprintf3 (ModuleTrace, (const char *) "application module: %s [%s]\\n", 29, applicationmodule, libname);
+ mptr = LookupModule (M2Dependent_unordered, applicationmodule, libname);
if (mptr != NULL)
{
mptr->dependency.appl = TRUE;
}
traceprintf (PreTrace, (const char *) "Pre resolving dependents\\n", 26);
DumpModuleData (PreTrace);
- ResolveDependencies (applicationmodule);
+ ResolveDependencies (applicationmodule, libname);
traceprintf (PreTrace, (const char *) "Post resolving dependents\\n", 27);
DumpModuleData (PostTrace);
ForceDependencies ();
@@ -1054,7 +1291,7 @@ extern "C" void M2Dependent_ConstructModules (void * applicationmodule, int argc
DumpModuleData (ForceTrace);
if (Modules.array[M2Dependent_ordered-M2Dependent_unregistered] == NULL)
{
- traceprintf2 (ModuleTrace, (const char *) " module: %s has not registered itself using a global constructor\\n", 67, applicationmodule);
+ traceprintf3 (ModuleTrace, (const char *) " module: %s [%s] has not registered itself using a global constructor\\n", 72, applicationmodule, libname);
traceprintf2 (ModuleTrace, (const char *) " hint try compile and linking using: gm2 %s.mod\\n", 50, applicationmodule);
traceprintf2 (ModuleTrace, (const char *) " or try using: gm2 -fscaffold-static %s.mod\\n", 46, applicationmodule);
}
@@ -1064,15 +1301,15 @@ extern "C" void M2Dependent_ConstructModules (void * applicationmodule, int argc
do {
if (mptr->dependency.forc)
{
- traceprintf2 (ModuleTrace, (const char *) "initializing module: %s for C\\n", 31, mptr->name);
+ traceprintf3 (ModuleTrace, (const char *) "initializing module: %s [%s] for C\\n", 36, mptr->name, mptr->libname);
}
else
{
- traceprintf2 (ModuleTrace, (const char *) "initializing module: %s\\n", 25, mptr->name);
+ traceprintf3 (ModuleTrace, (const char *) "initializing module: %s [%s]\\n", 30, mptr->name, mptr->libname);
}
if (mptr->dependency.appl)
{
- traceprintf2 (ModuleTrace, (const char *) "application module: %s\\n", 24, mptr->name);
+ traceprintf3 (ModuleTrace, (const char *) "application module: %s [%s]\\n", 29, mptr->name, mptr->libname);
traceprintf (ModuleTrace, (const char *) " calling M2RTS_ExecuteInitialProcedures\\n", 42);
M2RTS_ExecuteInitialProcedures ();
traceprintf (ModuleTrace, (const char *) " calling application module\\n", 30);
@@ -1089,11 +1326,11 @@ extern "C" void M2Dependent_ConstructModules (void * applicationmodule, int argc
module constructor in turn.
*/
-extern "C" void M2Dependent_DeconstructModules (void * applicationmodule, int argc, void * argv, void * envp)
+extern "C" void M2Dependent_DeconstructModules (void * applicationmodule, void * libname, int argc, void * argv, void * envp)
{
M2Dependent_ModuleChain mptr;
- traceprintf2 (ModuleTrace, (const char *) "application module finishing: %s\\n", 34, applicationmodule);
+ traceprintf3 (ModuleTrace, (const char *) "application module finishing: %s [%s]\\n", 39, applicationmodule, libname);
if (Modules.array[M2Dependent_ordered-M2Dependent_unregistered] == NULL)
{
traceprintf (ModuleTrace, (const char *) " no ordered modules found during finishing\\n", 45);
@@ -1107,11 +1344,11 @@ extern "C" void M2Dependent_DeconstructModules (void * applicationmodule, int ar
do {
if (mptr->dependency.forc)
{
- traceprintf2 (ModuleTrace, (const char *) "finalizing module: %s for C\\n", 29, mptr->name);
+ traceprintf3 (ModuleTrace, (const char *) "finalizing module: %s [%s] for C\\n", 34, mptr->name, mptr->libname);
}
else
{
- traceprintf2 (ModuleTrace, (const char *) "finalizing module: %s\\n", 23, mptr->name);
+ traceprintf3 (ModuleTrace, (const char *) "finalizing module: %s [%s]\\n", 28, mptr->name, mptr->libname);
}
(*mptr->fini.proc) (argc, argv, envp);
mptr = mptr->prev;
@@ -1126,13 +1363,24 @@ extern "C" void M2Dependent_DeconstructModules (void * applicationmodule, int ar
explored to determine initialization order.
*/
-extern "C" void M2Dependent_RegisterModule (void * name, M2Dependent_ArgCVEnvP init, M2Dependent_ArgCVEnvP fini, PROC dependencies)
+extern "C" void M2Dependent_RegisterModule (void * modulename, void * libname, M2Dependent_ArgCVEnvP init, M2Dependent_ArgCVEnvP fini, PROC dependencies)
{
+ M2Dependent_ModuleChain mptr;
+
CheckInitialized ();
if (! M2LINK_StaticInitialization)
{
- traceprintf2 (ModuleTrace, (const char *) "module: %s registering\\n", 24, name);
- moveTo (M2Dependent_unordered, CreateModule (name, init, fini, dependencies));
+ mptr = LookupModule (M2Dependent_unordered, modulename, libname);
+ if (mptr == NULL)
+ {
+ traceprintf3 (ModuleTrace, (const char *) "module: %s [%s] registering", 27, modulename, libname);
+ moveTo (M2Dependent_unordered, CreateModule (modulename, libname, init, fini, dependencies));
+ traceprintf (ModuleTrace, (const char *) "\\n", 2);
+ }
+ else
+ {
+ warning3 ((const char *) "module: %s [%s] (ignoring duplicate registration)\\n", 51, modulename, libname);
+ }
}
}
@@ -1143,12 +1391,12 @@ extern "C" void M2Dependent_RegisterModule (void * name, M2Dependent_ArgCVEnvP i
if we are not using StaticInitialization.
*/
-extern "C" void M2Dependent_RequestDependant (void * modulename, void * dependantmodule)
+extern "C" void M2Dependent_RequestDependant (void * modulename, void * libname, void * dependantmodule, void * dependantlibname)
{
CheckInitialized ();
if (! M2LINK_StaticInitialization)
{
- PerformRequestDependant (modulename, dependantmodule);
+ PerformRequestDependant (modulename, libname, dependantmodule, dependantlibname);
}
}
@@ -1157,6 +1405,6 @@ extern "C" void _M2_M2Dependent_init (__attribute__((unused)) int argc,__attribu
CheckInitialized ();
}
-extern "C" void _M2_M2Dependent_finish (__attribute__((unused)) int argc,__attribute__((unused)) char *argv[],__attribute__((unused)) char *envp[])
+extern "C" void _M2_M2Dependent_fini (__attribute__((unused)) int argc,__attribute__((unused)) char *argv[],__attribute__((unused)) char *envp[])
{
}
diff --git a/gcc/m2/pge-boot/GM2Dependent.h b/gcc/m2/pge-boot/GM2Dependent.h
index 903f10db844..c820ae14a8f 100644
--- a/gcc/m2/pge-boot/GM2Dependent.h
+++ b/gcc/m2/pge-boot/GM2Dependent.h
@@ -29,8 +29,6 @@ see the files COPYING3 and COPYING.RUNTIME respectively. If not, see
#if !defined (_M2Dependent_H)
# define _M2Dependent_H
-#include "config.h"
-#include "system.h"
# ifdef __cplusplus
extern "C" {
# endif
@@ -53,8 +51,8 @@ typedef struct M2Dependent_ArgCVEnvP_p M2Dependent_ArgCVEnvP;
typedef void (*M2Dependent_ArgCVEnvP_t) (int, void *, void *);
struct M2Dependent_ArgCVEnvP_p { M2Dependent_ArgCVEnvP_t proc; };
-EXTERN void M2Dependent_ConstructModules (void * applicationmodule, int argc, void * argv, void * envp);
-EXTERN void M2Dependent_DeconstructModules (void * applicationmodule, int argc, void * argv, void * envp);
+EXTERN void M2Dependent_ConstructModules (void * applicationmodule, void * libname, int argc, void * argv, void * envp);
+EXTERN void M2Dependent_DeconstructModules (void * applicationmodule, void * libname, int argc, void * argv, void * envp);
/*
RegisterModule - adds module name to the list of outstanding
@@ -62,14 +60,15 @@ EXTERN void M2Dependent_DeconstructModules (void * applicationmodule, int argc,
explored to determine initialization order.
*/
-EXTERN void M2Dependent_RegisterModule (void * name, M2Dependent_ArgCVEnvP init, M2Dependent_ArgCVEnvP fini, PROC dependencies);
+EXTERN void M2Dependent_RegisterModule (void * modulename, void * libname, M2Dependent_ArgCVEnvP init, M2Dependent_ArgCVEnvP fini, PROC dependencies);
/*
- RequestDependant - used to specify that modulename is dependant upon
- module dependantmodule.
+ RequestDependant - used to specify that modulename:libname
+ is dependant upon
+ module dependantmodule:dependantlibname
*/
-EXTERN void M2Dependent_RequestDependant (void * modulename, void * dependantmodule);
+EXTERN void M2Dependent_RequestDependant (void * modulename, void * libname, void * dependantmodule, void * dependantlibname);
# ifdef __cplusplus
}
# endif
diff --git a/gcc/m2/pge-boot/GM2EXCEPTION.c b/gcc/m2/pge-boot/GM2EXCEPTION.c
index 5a3ba4c3362..10de9b98d64 100644
--- a/gcc/m2/pge-boot/GM2EXCEPTION.c
+++ b/gcc/m2/pge-boot/GM2EXCEPTION.c
@@ -56,13 +56,13 @@ extern "C" M2EXCEPTION_M2Exceptions M2EXCEPTION_M2Exception (void)
n = RTExceptions_GetNumber (e);
if (n == (UINT_MAX))
{
- RTExceptions_Raise ( ((unsigned int) (M2EXCEPTION_exException)), const_cast<void*> (reinterpret_cast<const void*>("../../gcc-read-write/gcc/m2/gm2-libs/M2EXCEPTION.mod")), 47, 6, const_cast<void*> (reinterpret_cast<const void*>("M2Exception")), const_cast<void*> (reinterpret_cast<const void*>("current coroutine is not in the exceptional execution state")));
+ RTExceptions_Raise ( ((unsigned int) (M2EXCEPTION_exException)), const_cast<void*> (reinterpret_cast<const void*>("../../gcc/m2/gm2-libs/M2EXCEPTION.mod")), 47, 6, const_cast<void*> (reinterpret_cast<const void*>("M2Exception")), const_cast<void*> (reinterpret_cast<const void*>("current coroutine is not in the exceptional execution state")));
}
else
{
return (M2EXCEPTION_M2Exceptions) (n);
}
- ReturnException ("../../gcc-read-write/gcc/m2/gm2-libs/M2EXCEPTION.def", 25, 1);
+ ReturnException ("../../gcc/m2/gm2-libs/M2EXCEPTION.def", 25, 1);
__builtin_unreachable ();
}
@@ -83,6 +83,6 @@ extern "C" void _M2_M2EXCEPTION_init (__attribute__((unused)) int argc,__attribu
RTExceptions_SetExceptionBlock (RTExceptions_InitExceptionBlock ());
}
-extern "C" void _M2_M2EXCEPTION_finish (__attribute__((unused)) int argc,__attribute__((unused)) char *argv[],__attribute__((unused)) char *envp[])
+extern "C" void _M2_M2EXCEPTION_fini (__attribute__((unused)) int argc,__attribute__((unused)) char *argv[],__attribute__((unused)) char *envp[])
{
}
diff --git a/gcc/m2/pge-boot/GM2RTS.c b/gcc/m2/pge-boot/GM2RTS.c
index 1fdd5eb8ce7..c6eb399bba4 100644
--- a/gcc/m2/pge-boot/GM2RTS.c
+++ b/gcc/m2/pge-boot/GM2RTS.c
@@ -99,14 +99,14 @@ static unsigned int Initialized;
module constructor in turn.
*/
-extern "C" void M2RTS_ConstructModules (void * applicationmodule, int argc, void * argv, void * envp);
+extern "C" void M2RTS_ConstructModules (void * applicationmodule, void * libname, int argc, void * argv, void * envp);
/*
DeconstructModules - resolve dependencies and then call each
module constructor in turn.
*/
-extern "C" void M2RTS_DeconstructModules (void * applicationmodule, int argc, void * argv, void * envp);
+extern "C" void M2RTS_DeconstructModules (void * applicationmodule, void * libname, int argc, void * argv, void * envp);
/*
RegisterModule - adds module name to the list of outstanding
@@ -114,14 +114,14 @@ extern "C" void M2RTS_DeconstructModules (void * applicationmodule, int argc, vo
explored to determine initialization order.
*/
-extern "C" void M2RTS_RegisterModule (void * name, M2RTS_ArgCVEnvP init, M2RTS_ArgCVEnvP fini, PROC dependencies);
+extern "C" void M2RTS_RegisterModule (void * name, void * libname, M2RTS_ArgCVEnvP init, M2RTS_ArgCVEnvP fini, PROC dependencies);
/*
RequestDependant - used to specify that modulename is dependant upon
module dependantmodule.
*/
-extern "C" void M2RTS_RequestDependant (void * modulename, void * dependantmodule);
+extern "C" void M2RTS_RequestDependant (void * modulename, void * libname, void * dependantmodule, void * dependantlibname);
/*
InstallTerminationProcedure - installs a procedure, p, which will
@@ -191,7 +191,7 @@ extern "C" void M2RTS_Halt (const char *filename_, unsigned int _filename_high,
to stderr and calls exit (1).
*/
-extern "C" void M2RTS_HaltC (void * filename, unsigned int line, void * function, void * description);
+extern "C" void M2RTS_HaltC (void * filename, unsigned int line, void * function, void * description) __attribute__ ((noreturn));
/*
ExitOnHalt - if HALT is executed then call exit with the exit code, e.
@@ -212,30 +212,30 @@ extern "C" void M2RTS_ErrorMessage (const char *message_, unsigned int _message_
*/
extern "C" unsigned int M2RTS_Length (const char *a_, unsigned int _a_high);
-extern "C" void M2RTS_AssignmentException (void * filename, unsigned int line, unsigned int column, void * scope, void * message);
-extern "C" void M2RTS_ReturnException (void * filename, unsigned int line, unsigned int column, void * scope, void * message);
-extern "C" void M2RTS_IncException (void * filename, unsigned int line, unsigned int column, void * scope, void * message);
-extern "C" void M2RTS_DecException (void * filename, unsigned int line, unsigned int column, void * scope, void * message);
-extern "C" void M2RTS_InclException (void * filename, unsigned int line, unsigned int column, void * scope, void * message);
-extern "C" void M2RTS_ExclException (void * filename, unsigned int line, unsigned int column, void * scope, void * message);
-extern "C" void M2RTS_ShiftException (void * filename, unsigned int line, unsigned int column, void * scope, void * message);
-extern "C" void M2RTS_RotateException (void * filename, unsigned int line, unsigned int column, void * scope, void * message);
-extern "C" void M2RTS_StaticArraySubscriptException (void * filename, unsigned int line, unsigned int column, void * scope, void * message);
-extern "C" void M2RTS_DynamicArraySubscriptException (void * filename, unsigned int line, unsigned int column, void * scope, void * message);
-extern "C" void M2RTS_ForLoopBeginException (void * filename, unsigned int line, unsigned int column, void * scope, void * message);
-extern "C" void M2RTS_ForLoopToException (void * filename, unsigned int line, unsigned int column, void * scope, void * message);
-extern "C" void M2RTS_ForLoopEndException (void * filename, unsigned int line, unsigned int column, void * scope, void * message);
-extern "C" void M2RTS_PointerNilException (void * filename, unsigned int line, unsigned int column, void * scope, void * message);
-extern "C" void M2RTS_NoReturnException (void * filename, unsigned int line, unsigned int column, void * scope, void * message);
-extern "C" void M2RTS_CaseException (void * filename, unsigned int line, unsigned int column, void * scope, void * message);
-extern "C" void M2RTS_WholeNonPosDivException (void * filename, unsigned int line, unsigned int column, void * scope, void * message);
-extern "C" void M2RTS_WholeNonPosModException (void * filename, unsigned int line, unsigned int column, void * scope, void * message);
-extern "C" void M2RTS_WholeZeroDivException (void * filename, unsigned int line, unsigned int column, void * scope, void * message);
-extern "C" void M2RTS_WholeZeroRemException (void * filename, unsigned int line, unsigned int column, void * scope, void * message);
-extern "C" void M2RTS_WholeValueException (void * filename, unsigned int line, unsigned int column, void * scope, void * message);
-extern "C" void M2RTS_RealValueException (void * filename, unsigned int line, unsigned int column, void * scope, void * message);
-extern "C" void M2RTS_ParameterException (void * filename, unsigned int line, unsigned int column, void * scope, void * message);
-extern "C" void M2RTS_NoException (void * filename, unsigned int line, unsigned int column, void * scope, void * message);
+extern "C" void M2RTS_AssignmentException (void * filename, unsigned int line, unsigned int column, void * scope, void * message) __attribute__ ((noreturn));
+extern "C" void M2RTS_ReturnException (void * filename, unsigned int line, unsigned int column, void * scope, void * message) __attribute__ ((noreturn));
+extern "C" void M2RTS_IncException (void * filename, unsigned int line, unsigned int column, void * scope, void * message) __attribute__ ((noreturn));
+extern "C" void M2RTS_DecException (void * filename, unsigned int line, unsigned int column, void * scope, void * message) __attribute__ ((noreturn));
+extern "C" void M2RTS_InclException (void * filename, unsigned int line, unsigned int column, void * scope, void * message) __attribute__ ((noreturn));
+extern "C" void M2RTS_ExclException (void * filename, unsigned int line, unsigned int column, void * scope, void * message) __attribute__ ((noreturn));
+extern "C" void M2RTS_ShiftException (void * filename, unsigned int line, unsigned int column, void * scope, void * message) __attribute__ ((noreturn));
+extern "C" void M2RTS_RotateException (void * filename, unsigned int line, unsigned int column, void * scope, void * message) __attribute__ ((noreturn));
+extern "C" void M2RTS_StaticArraySubscriptException (void * filename, unsigned int line, unsigned int column, void * scope, void * message) __attribute__ ((noreturn));
+extern "C" void M2RTS_DynamicArraySubscriptException (void * filename, unsigned int line, unsigned int column, void * scope, void * message) __attribute__ ((noreturn));
+extern "C" void M2RTS_ForLoopBeginException (void * filename, unsigned int line, unsigned int column, void * scope, void * message) __attribute__ ((noreturn));
+extern "C" void M2RTS_ForLoopToException (void * filename, unsigned int line, unsigned int column, void * scope, void * message) __attribute__ ((noreturn));
+extern "C" void M2RTS_ForLoopEndException (void * filename, unsigned int line, unsigned int column, void * scope, void * message) __attribute__ ((noreturn));
+extern "C" void M2RTS_PointerNilException (void * filename, unsigned int line, unsigned int column, void * scope, void * message) __attribute__ ((noreturn));
+extern "C" void M2RTS_NoReturnException (void * filename, unsigned int line, unsigned int column, void * scope, void * message) __attribute__ ((noreturn));
+extern "C" void M2RTS_CaseException (void * filename, unsigned int line, unsigned int column, void * scope, void * message) __attribute__ ((noreturn));
+extern "C" void M2RTS_WholeNonPosDivException (void * filename, unsigned int line, unsigned int column, void * scope, void * message) __attribute__ ((noreturn));
+extern "C" void M2RTS_WholeNonPosModException (void * filename, unsigned int line, unsigned int column, void * scope, void * message) __attribute__ ((noreturn));
+extern "C" void M2RTS_WholeZeroDivException (void * filename, unsigned int line, unsigned int column, void * scope, void * message) __attribute__ ((noreturn));
+extern "C" void M2RTS_WholeZeroRemException (void * filename, unsigned int line, unsigned int column, void * scope, void * message) __attribute__ ((noreturn));
+extern "C" void M2RTS_WholeValueException (void * filename, unsigned int line, unsigned int column, void * scope, void * message) __attribute__ ((noreturn));
+extern "C" void M2RTS_RealValueException (void * filename, unsigned int line, unsigned int column, void * scope, void * message) __attribute__ ((noreturn));
+extern "C" void M2RTS_ParameterException (void * filename, unsigned int line, unsigned int column, void * scope, void * message) __attribute__ ((noreturn));
+extern "C" void M2RTS_NoException (void * filename, unsigned int line, unsigned int column, void * scope, void * message) __attribute__ ((noreturn));
/*
ExecuteReverse - execute the procedure associated with procptr
@@ -437,9 +437,9 @@ static void CheckInitialized (void)
module constructor in turn.
*/
-extern "C" void M2RTS_ConstructModules (void * applicationmodule, int argc, void * argv, void * envp)
+extern "C" void M2RTS_ConstructModules (void * applicationmodule, void * libname, int argc, void * argv, void * envp)
{
- M2Dependent_ConstructModules (applicationmodule, argc, argv, envp);
+ M2Dependent_ConstructModules (applicationmodule, libname, argc, argv, envp);
}
@@ -448,9 +448,9 @@ extern "C" void M2RTS_ConstructModules (void * applicationmodule, int argc, void
module constructor in turn.
*/
-extern "C" void M2RTS_DeconstructModules (void * applicationmodule, int argc, void * argv, void * envp)
+extern "C" void M2RTS_DeconstructModules (void * applicationmodule, void * libname, int argc, void * argv, void * envp)
{
- M2Dependent_DeconstructModules (applicationmodule, argc, argv, envp);
+ M2Dependent_DeconstructModules (applicationmodule, libname, argc, argv, envp);
}
@@ -460,9 +460,9 @@ extern "C" void M2RTS_DeconstructModules (void * applicationmodule, int argc, vo
explored to determine initialization order.
*/
-extern "C" void M2RTS_RegisterModule (void * name, M2RTS_ArgCVEnvP init, M2RTS_ArgCVEnvP fini, PROC dependencies)
+extern "C" void M2RTS_RegisterModule (void * name, void * libname, M2RTS_ArgCVEnvP init, M2RTS_ArgCVEnvP fini, PROC dependencies)
{
- M2Dependent_RegisterModule (name, (M2Dependent_ArgCVEnvP) {(M2Dependent_ArgCVEnvP_t) init.proc}, (M2Dependent_ArgCVEnvP) {(M2Dependent_ArgCVEnvP_t) fini.proc}, dependencies);
+ M2Dependent_RegisterModule (name, libname, (M2Dependent_ArgCVEnvP) {(M2Dependent_ArgCVEnvP_t) init.proc}, (M2Dependent_ArgCVEnvP) {(M2Dependent_ArgCVEnvP_t) fini.proc}, dependencies);
}
@@ -471,9 +471,9 @@ extern "C" void M2RTS_RegisterModule (void * name, M2RTS_ArgCVEnvP init, M2RTS_A
module dependantmodule.
*/
-extern "C" void M2RTS_RequestDependant (void * modulename, void * dependantmodule)
+extern "C" void M2RTS_RequestDependant (void * modulename, void * libname, void * dependantmodule, void * dependantlibname)
{
- M2Dependent_RequestDependant (modulename, dependantmodule);
+ M2Dependent_RequestDependant (modulename, libname, dependantmodule, dependantlibname);
}
@@ -817,6 +817,6 @@ extern "C" void _M2_M2RTS_init (__attribute__((unused)) int argc,__attribute__((
CheckInitialized ();
}
-extern "C" void _M2_M2RTS_finish (__attribute__((unused)) int argc,__attribute__((unused)) char *argv[],__attribute__((unused)) char *envp[])
+extern "C" void _M2_M2RTS_fini (__attribute__((unused)) int argc,__attribute__((unused)) char *argv[],__attribute__((unused)) char *envp[])
{
}
diff --git a/gcc/m2/pge-boot/GM2RTS.h b/gcc/m2/pge-boot/GM2RTS.h
index 698f1427679..37cbb1a13d7 100644
--- a/gcc/m2/pge-boot/GM2RTS.h
+++ b/gcc/m2/pge-boot/GM2RTS.h
@@ -29,8 +29,6 @@ see the files COPYING3 and COPYING.RUNTIME respectively. If not, see
#if !defined (_M2RTS_H)
# define _M2RTS_H
-#include "config.h"
-#include "system.h"
# ifdef __cplusplus
extern "C" {
# endif
@@ -53,8 +51,8 @@ typedef struct M2RTS_ArgCVEnvP_p M2RTS_ArgCVEnvP;
typedef void (*M2RTS_ArgCVEnvP_t) (int, void *, void *);
struct M2RTS_ArgCVEnvP_p { M2RTS_ArgCVEnvP_t proc; };
-EXTERN void M2RTS_ConstructModules (void * applicationmodule, int argc, void * argv, void * envp);
-EXTERN void M2RTS_DeconstructModules (void * applicationmodule, int argc, void * argv, void * envp);
+EXTERN void M2RTS_ConstructModules (void * applicationmodule, void * libname, int argc, void * argv, void * envp);
+EXTERN void M2RTS_DeconstructModules (void * applicationmodule, void * libname, int argc, void * argv, void * envp);
/*
RegisterModule - adds module name to the list of outstanding
@@ -62,14 +60,14 @@ EXTERN void M2RTS_DeconstructModules (void * applicationmodule, int argc, void *
explored to determine initialization order.
*/
-EXTERN void M2RTS_RegisterModule (void * name, M2RTS_ArgCVEnvP init, M2RTS_ArgCVEnvP fini, PROC dependencies);
+EXTERN void M2RTS_RegisterModule (void * name, void * libname, M2RTS_ArgCVEnvP init, M2RTS_ArgCVEnvP fini, PROC dependencies);
/*
RequestDependant - used to specify that modulename is dependant upon
module dependantmodule.
*/
-EXTERN void M2RTS_RequestDependant (void * modulename, void * dependantmodule);
+EXTERN void M2RTS_RequestDependant (void * modulename, void * libname, void * dependantmodule, void * dependantlibname);
/*
InstallTerminationProcedure - installs a procedure, p, which will
@@ -126,10 +124,19 @@ EXTERN void M2RTS_HALT (int exitcode) __attribute__ ((noreturn));
/*
Halt - provides a more user friendly version of HALT, which takes
- four parameters to aid debugging.
+ four parameters to aid debugging. It writes an error message
+ to stderr and calls exit (1).
*/
-EXTERN void M2RTS_Halt (const char *file_, unsigned int _file_high, unsigned int line, const char *function_, unsigned int _function_high, const char *description_, unsigned int _description_high) __attribute__ ((noreturn));
+EXTERN void M2RTS_Halt (const char *filename_, unsigned int _filename_high, unsigned int line, const char *function_, unsigned int _function_high, const char *description_, unsigned int _description_high) __attribute__ ((noreturn));
+
+/*
+ HaltC - provides a more user friendly version of HALT, which takes
+ four parameters to aid debugging. It writes an error message
+ to stderr and calls exit (1).
+*/
+
+EXTERN void M2RTS_HaltC (void * filename, unsigned int line, void * function, void * description) __attribute__ ((noreturn));
/*
ExitOnHalt - if HALT is executed then call exit with the exit code, e.
@@ -141,7 +148,7 @@ EXTERN void M2RTS_ExitOnHalt (int e);
ErrorMessage - emits an error message to stderr and then calls exit (1).
*/
-EXTERN void M2RTS_ErrorMessage (const char *message_, unsigned int _message_high, const char *file_, unsigned int _file_high, unsigned int line, const char *function_, unsigned int _function_high) __attribute__ ((noreturn));
+EXTERN void M2RTS_ErrorMessage (const char *message_, unsigned int _message_high, const char *filename_, unsigned int _filename_high, unsigned int line, const char *function_, unsigned int _function_high) __attribute__ ((noreturn));
/*
Length - returns the length of a string, a. This is called whenever
@@ -150,30 +157,30 @@ EXTERN void M2RTS_ErrorMessage (const char *message_, unsigned int _message_high
*/
EXTERN unsigned int M2RTS_Length (const char *a_, unsigned int _a_high);
-EXTERN void M2RTS_AssignmentException (void * filename, unsigned int line, unsigned int column, void * scope, void * message);
-EXTERN void M2RTS_ReturnException (void * filename, unsigned int line, unsigned int column, void * scope, void * message);
-EXTERN void M2RTS_IncException (void * filename, unsigned int line, unsigned int column, void * scope, void * message);
-EXTERN void M2RTS_DecException (void * filename, unsigned int line, unsigned int column, void * scope, void * message);
-EXTERN void M2RTS_InclException (void * filename, unsigned int line, unsigned int column, void * scope, void * message);
-EXTERN void M2RTS_ExclException (void * filename, unsigned int line, unsigned int column, void * scope, void * message);
-EXTERN void M2RTS_ShiftException (void * filename, unsigned int line, unsigned int column, void * scope, void * message);
-EXTERN void M2RTS_RotateException (void * filename, unsigned int line, unsigned int column, void * scope, void * message);
-EXTERN void M2RTS_StaticArraySubscriptException (void * filename, unsigned int line, unsigned int column, void * scope, void * message);
-EXTERN void M2RTS_DynamicArraySubscriptException (void * filename, unsigned int line, unsigned int column, void * scope, void * message);
-EXTERN void M2RTS_ForLoopBeginException (void * filename, unsigned int line, unsigned int column, void * scope, void * message);
-EXTERN void M2RTS_ForLoopToException (void * filename, unsigned int line, unsigned int column, void * scope, void * message);
-EXTERN void M2RTS_ForLoopEndException (void * filename, unsigned int line, unsigned int column, void * scope, void * message);
-EXTERN void M2RTS_PointerNilException (void * filename, unsigned int line, unsigned int column, void * scope, void * message);
-EXTERN void M2RTS_NoReturnException (void * filename, unsigned int line, unsigned int column, void * scope, void * message);
-EXTERN void M2RTS_CaseException (void * filename, unsigned int line, unsigned int column, void * scope, void * message);
-EXTERN void M2RTS_WholeNonPosDivException (void * filename, unsigned int line, unsigned int column, void * scope, void * message);
-EXTERN void M2RTS_WholeNonPosModException (void * filename, unsigned int line, unsigned int column, void * scope, void * message);
-EXTERN void M2RTS_WholeZeroDivException (void * filename, unsigned int line, unsigned int column, void * scope, void * message);
-EXTERN void M2RTS_WholeZeroRemException (void * filename, unsigned int line, unsigned int column, void * scope, void * message);
-EXTERN void M2RTS_WholeValueException (void * filename, unsigned int line, unsigned int column, void * scope, void * message);
-EXTERN void M2RTS_RealValueException (void * filename, unsigned int line, unsigned int column, void * scope, void * message);
-EXTERN void M2RTS_ParameterException (void * filename, unsigned int line, unsigned int column, void * scope, void * message);
-EXTERN void M2RTS_NoException (void * filename, unsigned int line, unsigned int column, void * scope, void * message);
+EXTERN void M2RTS_AssignmentException (void * filename, unsigned int line, unsigned int column, void * scope, void * message) __attribute__ ((noreturn));
+EXTERN void M2RTS_ReturnException (void * filename, unsigned int line, unsigned int column, void * scope, void * message) __attribute__ ((noreturn));
+EXTERN void M2RTS_IncException (void * filename, unsigned int line, unsigned int column, void * scope, void * message) __attribute__ ((noreturn));
+EXTERN void M2RTS_DecException (void * filename, unsigned int line, unsigned int column, void * scope, void * message) __attribute__ ((noreturn));
+EXTERN void M2RTS_InclException (void * filename, unsigned int line, unsigned int column, void * scope, void * message) __attribute__ ((noreturn));
+EXTERN void M2RTS_ExclException (void * filename, unsigned int line, unsigned int column, void * scope, void * message) __attribute__ ((noreturn));
+EXTERN void M2RTS_ShiftException (void * filename, unsigned int line, unsigned int column, void * scope, void * message) __attribute__ ((noreturn));
+EXTERN void M2RTS_RotateException (void * filename, unsigned int line, unsigned int column, void * scope, void * message) __attribute__ ((noreturn));
+EXTERN void M2RTS_StaticArraySubscriptException (void * filename, unsigned int line, unsigned int column, void * scope, void * message) __attribute__ ((noreturn));
+EXTERN void M2RTS_DynamicArraySubscriptException (void * filename, unsigned int line, unsigned int column, void * scope, void * message) __attribute__ ((noreturn));
+EXTERN void M2RTS_ForLoopBeginException (void * filename, unsigned int line, unsigned int column, void * scope, void * message) __attribute__ ((noreturn));
+EXTERN void M2RTS_ForLoopToException (void * filename, unsigned int line, unsigned int column, void * scope, void * message) __attribute__ ((noreturn));
+EXTERN void M2RTS_ForLoopEndException (void * filename, unsigned int line, unsigned int column, void * scope, void * message) __attribute__ ((noreturn));
+EXTERN void M2RTS_PointerNilException (void * filename, unsigned int line, unsigned int column, void * scope, void * message) __attribute__ ((noreturn));
+EXTERN void M2RTS_NoReturnException (void * filename, unsigned int line, unsigned int column, void * scope, void * message) __attribute__ ((noreturn));
+EXTERN void M2RTS_CaseException (void * filename, unsigned int line, unsigned int column, void * scope, void * message) __attribute__ ((noreturn));
+EXTERN void M2RTS_WholeNonPosDivException (void * filename, unsigned int line, unsigned int column, void * scope, void * message) __attribute__ ((noreturn));
+EXTERN void M2RTS_WholeNonPosModException (void * filename, unsigned int line, unsigned int column, void * scope, void * message) __attribute__ ((noreturn));
+EXTERN void M2RTS_WholeZeroDivException (void * filename, unsigned int line, unsigned int column, void * scope, void * message) __attribute__ ((noreturn));
+EXTERN void M2RTS_WholeZeroRemException (void * filename, unsigned int line, unsigned int column, void * scope, void * message) __attribute__ ((noreturn));
+EXTERN void M2RTS_WholeValueException (void * filename, unsigned int line, unsigned int column, void * scope, void * message) __attribute__ ((noreturn));
+EXTERN void M2RTS_RealValueException (void * filename, unsigned int line, unsigned int column, void * scope, void * message) __attribute__ ((noreturn));
+EXTERN void M2RTS_ParameterException (void * filename, unsigned int line, unsigned int column, void * scope, void * message) __attribute__ ((noreturn));
+EXTERN void M2RTS_NoException (void * filename, unsigned int line, unsigned int column, void * scope, void * message) __attribute__ ((noreturn));
# ifdef __cplusplus
}
# endif
diff --git a/gcc/m2/pge-boot/GNameKey.c b/gcc/m2/pge-boot/GNameKey.c
index 13511cb0132..37d8c961e49 100644
--- a/gcc/m2/pge-boot/GNameKey.c
+++ b/gcc/m2/pge-boot/GNameKey.c
@@ -330,7 +330,7 @@ extern "C" NameKey_Name NameKey_MakeKey (const char *a_, unsigned int _a_high)
(*p) = ASCII_nul;
return DoMakeKey (n, higha);
}
- ReturnException ("../../gcc-read-write/gcc/m2/gm2-compiler/NameKey.def", 20, 1);
+ ReturnException ("../../gcc/m2/gm2-compiler/NameKey.def", 20, 1);
__builtin_unreachable ();
}
@@ -380,7 +380,7 @@ extern "C" NameKey_Name NameKey_makekey (void * a)
return DoMakeKey (n, higha);
}
}
- ReturnException ("../../gcc-read-write/gcc/m2/gm2-compiler/NameKey.def", 20, 1);
+ ReturnException ("../../gcc/m2/gm2-compiler/NameKey.def", 20, 1);
__builtin_unreachable ();
}
@@ -607,6 +607,6 @@ extern "C" void _M2_NameKey_init (__attribute__((unused)) int argc,__attribute__
BinaryTree->Left = NULL;
}
-extern "C" void _M2_NameKey_finish (__attribute__((unused)) int argc,__attribute__((unused)) char *argv[],__attribute__((unused)) char *envp[])
+extern "C" void _M2_NameKey_fini (__attribute__((unused)) int argc,__attribute__((unused)) char *argv[],__attribute__((unused)) char *envp[])
{
}
diff --git a/gcc/m2/pge-boot/GNumberIO.c b/gcc/m2/pge-boot/GNumberIO.c
index f65de59b849..0e058df5d64 100644
--- a/gcc/m2/pge-boot/GNumberIO.c
+++ b/gcc/m2/pge-boot/GNumberIO.c
@@ -772,6 +772,6 @@ extern "C" void _M2_NumberIO_init (__attribute__((unused)) int argc,__attribute_
{
}
-extern "C" void _M2_NumberIO_finish (__attribute__((unused)) int argc,__attribute__((unused)) char *argv[],__attribute__((unused)) char *envp[])
+extern "C" void _M2_NumberIO_fini (__attribute__((unused)) int argc,__attribute__((unused)) char *argv[],__attribute__((unused)) char *envp[])
{
}
diff --git a/gcc/m2/pge-boot/GOutput.c b/gcc/m2/pge-boot/GOutput.c
index ddbc491c17a..22ec0e7b8cf 100644
--- a/gcc/m2/pge-boot/GOutput.c
+++ b/gcc/m2/pge-boot/GOutput.c
@@ -310,6 +310,6 @@ extern "C" void _M2_Output_init (__attribute__((unused)) int argc,__attribute__(
outputFile = FIO_StdOut;
}
-extern "C" void _M2_Output_finish (__attribute__((unused)) int argc,__attribute__((unused)) char *argv[],__attribute__((unused)) char *envp[])
+extern "C" void _M2_Output_fini (__attribute__((unused)) int argc,__attribute__((unused)) char *argv[],__attribute__((unused)) char *envp[])
{
}
diff --git a/gcc/m2/pge-boot/GPushBackInput.c b/gcc/m2/pge-boot/GPushBackInput.c
index 70cb2721e5e..612e94a6b6a 100644
--- a/gcc/m2/pge-boot/GPushBackInput.c
+++ b/gcc/m2/pge-boot/GPushBackInput.c
@@ -275,7 +275,7 @@ extern "C" char PushBackInput_PutCh (char ch)
}
else
{
- Debug_Halt ((const char *) "max push back stack exceeded, increase MaxPushBackStack", 55, 150, (const char *) "../../gcc-read-write/gcc/m2/gm2-libs/PushBackInput.mod", 54);
+ Debug_Halt ((const char *) "max push back stack exceeded, increase MaxPushBackStack", 55, 150, (const char *) "../../gcc/m2/gm2-libs/PushBackInput.mod", 39);
}
return ch;
/* static analysis guarentees a RETURN statement will be used before here. */
@@ -301,7 +301,7 @@ extern "C" void PushBackInput_PutString (const char *a_, unsigned int _a_high)
l -= 1;
if ((PushBackInput_PutCh (a[l])) != a[l])
{
- Debug_Halt ((const char *) "assert failed", 13, 132, (const char *) "../../gcc-read-write/gcc/m2/gm2-libs/PushBackInput.mod", 54);
+ Debug_Halt ((const char *) "assert failed", 13, 132, (const char *) "../../gcc/m2/gm2-libs/PushBackInput.mod", 39);
}
}
}
@@ -322,7 +322,7 @@ extern "C" void PushBackInput_PutStr (DynamicStrings_String s)
i -= 1;
if ((PushBackInput_PutCh (DynamicStrings_char (s, static_cast<int> (i)))) != (DynamicStrings_char (s, static_cast<int> (i))))
{
- Debug_Halt ((const char *) "assert failed", 13, 113, (const char *) "../../gcc-read-write/gcc/m2/gm2-libs/PushBackInput.mod", 54);
+ Debug_Halt ((const char *) "assert failed", 13, 113, (const char *) "../../gcc/m2/gm2-libs/PushBackInput.mod", 39);
}
}
}
@@ -484,6 +484,6 @@ extern "C" void _M2_PushBackInput_init (__attribute__((unused)) int argc,__attri
Init ();
}
-extern "C" void _M2_PushBackInput_finish (__attribute__((unused)) int argc,__attribute__((unused)) char *argv[],__attribute__((unused)) char *envp[])
+extern "C" void _M2_PushBackInput_fini (__attribute__((unused)) int argc,__attribute__((unused)) char *argv[],__attribute__((unused)) char *envp[])
{
}
diff --git a/gcc/m2/pge-boot/GRTExceptions.c b/gcc/m2/pge-boot/GRTExceptions.c
index 84f6ccab1d3..8c2d35d8880 100644
--- a/gcc/m2/pge-boot/GRTExceptions.c
+++ b/gcc/m2/pge-boot/GRTExceptions.c
@@ -107,7 +107,7 @@ static void * currentSource;
and message in the EHBlock for later use.
*/
-extern "C" void RTExceptions_Raise (unsigned int number, void * file, unsigned int line, unsigned int column, void * function, void * message);
+extern "C" void RTExceptions_Raise (unsigned int number, void * file, unsigned int line, unsigned int column, void * function, void * message) __attribute__ ((noreturn));
/*
SetExceptionBlock - sets, source, as the active EHB.
@@ -242,7 +242,7 @@ static RTExceptions_Handler findHandler (RTExceptions_EHBlock e, unsigned int nu
exception in the active EHB.
*/
-static void InvokeHandler (void);
+static void InvokeHandler (void) __attribute__ ((noreturn));
/*
DoThrow - throw the exception number in the exception block.
@@ -488,6 +488,8 @@ static void InvokeHandler (void)
else
{
(*h->p.proc) ();
+ M2RTS_HALT (-1);
+ __builtin_unreachable ();
}
}
@@ -722,7 +724,7 @@ static void AddHandler (RTExceptions_EHBlock e, RTExceptions_Handler h)
static void indexf (void * a)
{
- RTExceptions_Raise ( ((unsigned int) (M2EXCEPTION_indexException)), const_cast<void*> (reinterpret_cast<const void*>("../../gcc-read-write/gcc/m2/gm2-libs/RTExceptions.mod")), 612, 9, const_cast<void*> (reinterpret_cast<const void*>("indexf")), const_cast<void*> (reinterpret_cast<const void*>("array index out of bounds")));
+ RTExceptions_Raise ( ((unsigned int) (M2EXCEPTION_indexException)), const_cast<void*> (reinterpret_cast<const void*>("../../gcc/m2/gm2-libs/RTExceptions.mod")), 613, 9, const_cast<void*> (reinterpret_cast<const void*>("indexf")), const_cast<void*> (reinterpret_cast<const void*>("array index out of bounds")));
}
@@ -732,7 +734,7 @@ static void indexf (void * a)
static void range (void * a)
{
- RTExceptions_Raise ( ((unsigned int) (M2EXCEPTION_rangeException)), const_cast<void*> (reinterpret_cast<const void*>("../../gcc-read-write/gcc/m2/gm2-libs/RTExceptions.mod")), 624, 9, const_cast<void*> (reinterpret_cast<const void*>("range")), const_cast<void*> (reinterpret_cast<const void*>("assignment out of range")));
+ RTExceptions_Raise ( ((unsigned int) (M2EXCEPTION_rangeException)), const_cast<void*> (reinterpret_cast<const void*>("../../gcc/m2/gm2-libs/RTExceptions.mod")), 625, 9, const_cast<void*> (reinterpret_cast<const void*>("range")), const_cast<void*> (reinterpret_cast<const void*>("assignment out of range")));
}
@@ -742,7 +744,7 @@ static void range (void * a)
static void casef (void * a)
{
- RTExceptions_Raise ( ((unsigned int) (M2EXCEPTION_caseSelectException)), const_cast<void*> (reinterpret_cast<const void*>("../../gcc-read-write/gcc/m2/gm2-libs/RTExceptions.mod")), 636, 9, const_cast<void*> (reinterpret_cast<const void*>("casef")), const_cast<void*> (reinterpret_cast<const void*>("case selector out of range")));
+ RTExceptions_Raise ( ((unsigned int) (M2EXCEPTION_caseSelectException)), const_cast<void*> (reinterpret_cast<const void*>("../../gcc/m2/gm2-libs/RTExceptions.mod")), 637, 9, const_cast<void*> (reinterpret_cast<const void*>("casef")), const_cast<void*> (reinterpret_cast<const void*>("case selector out of range")));
}
@@ -752,7 +754,7 @@ static void casef (void * a)
static void invalidloc (void * a)
{
- RTExceptions_Raise ( ((unsigned int) (M2EXCEPTION_invalidLocation)), const_cast<void*> (reinterpret_cast<const void*>("../../gcc-read-write/gcc/m2/gm2-libs/RTExceptions.mod")), 648, 9, const_cast<void*> (reinterpret_cast<const void*>("invalidloc")), const_cast<void*> (reinterpret_cast<const void*>("invalid address referenced")));
+ RTExceptions_Raise ( ((unsigned int) (M2EXCEPTION_invalidLocation)), const_cast<void*> (reinterpret_cast<const void*>("../../gcc/m2/gm2-libs/RTExceptions.mod")), 649, 9, const_cast<void*> (reinterpret_cast<const void*>("invalidloc")), const_cast<void*> (reinterpret_cast<const void*>("invalid address referenced")));
}
@@ -762,7 +764,7 @@ static void invalidloc (void * a)
static void function (void * a)
{
- RTExceptions_Raise ( ((unsigned int) (M2EXCEPTION_functionException)), const_cast<void*> (reinterpret_cast<const void*>("../../gcc-read-write/gcc/m2/gm2-libs/RTExceptions.mod")), 660, 9, const_cast<void*> (reinterpret_cast<const void*>("function")), const_cast<void*> (reinterpret_cast<const void*>("... function ... "))); /* --fixme-- what has happened ? */
+ RTExceptions_Raise ( ((unsigned int) (M2EXCEPTION_functionException)), const_cast<void*> (reinterpret_cast<const void*>("../../gcc/m2/gm2-libs/RTExceptions.mod")), 661, 9, const_cast<void*> (reinterpret_cast<const void*>("function")), const_cast<void*> (reinterpret_cast<const void*>("... function ... "))); /* --fixme-- what has happened ? */
}
@@ -772,7 +774,7 @@ static void function (void * a)
static void wholevalue (void * a)
{
- RTExceptions_Raise ( ((unsigned int) (M2EXCEPTION_wholeValueException)), const_cast<void*> (reinterpret_cast<const void*>("../../gcc-read-write/gcc/m2/gm2-libs/RTExceptions.mod")), 672, 9, const_cast<void*> (reinterpret_cast<const void*>("wholevalue")), const_cast<void*> (reinterpret_cast<const void*>("illegal whole value exception")));
+ RTExceptions_Raise ( ((unsigned int) (M2EXCEPTION_wholeValueException)), const_cast<void*> (reinterpret_cast<const void*>("../../gcc/m2/gm2-libs/RTExceptions.mod")), 673, 9, const_cast<void*> (reinterpret_cast<const void*>("wholevalue")), const_cast<void*> (reinterpret_cast<const void*>("illegal whole value exception")));
}
@@ -782,7 +784,7 @@ static void wholevalue (void * a)
static void wholediv (void * a)
{
- RTExceptions_Raise ( ((unsigned int) (M2EXCEPTION_wholeDivException)), const_cast<void*> (reinterpret_cast<const void*>("../../gcc-read-write/gcc/m2/gm2-libs/RTExceptions.mod")), 684, 9, const_cast<void*> (reinterpret_cast<const void*>("wholediv")), const_cast<void*> (reinterpret_cast<const void*>("illegal whole value exception")));
+ RTExceptions_Raise ( ((unsigned int) (M2EXCEPTION_wholeDivException)), const_cast<void*> (reinterpret_cast<const void*>("../../gcc/m2/gm2-libs/RTExceptions.mod")), 685, 9, const_cast<void*> (reinterpret_cast<const void*>("wholediv")), const_cast<void*> (reinterpret_cast<const void*>("illegal whole value exception")));
}
@@ -792,7 +794,7 @@ static void wholediv (void * a)
static void realvalue (void * a)
{
- RTExceptions_Raise ( ((unsigned int) (M2EXCEPTION_realValueException)), const_cast<void*> (reinterpret_cast<const void*>("../../gcc-read-write/gcc/m2/gm2-libs/RTExceptions.mod")), 696, 9, const_cast<void*> (reinterpret_cast<const void*>("realvalue")), const_cast<void*> (reinterpret_cast<const void*>("illegal real value exception")));
+ RTExceptions_Raise ( ((unsigned int) (M2EXCEPTION_realValueException)), const_cast<void*> (reinterpret_cast<const void*>("../../gcc/m2/gm2-libs/RTExceptions.mod")), 697, 9, const_cast<void*> (reinterpret_cast<const void*>("realvalue")), const_cast<void*> (reinterpret_cast<const void*>("illegal real value exception")));
}
@@ -802,7 +804,7 @@ static void realvalue (void * a)
static void realdiv (void * a)
{
- RTExceptions_Raise ( ((unsigned int) (M2EXCEPTION_realDivException)), const_cast<void*> (reinterpret_cast<const void*>("../../gcc-read-write/gcc/m2/gm2-libs/RTExceptions.mod")), 708, 9, const_cast<void*> (reinterpret_cast<const void*>("realdiv")), const_cast<void*> (reinterpret_cast<const void*>("real number division by zero exception")));
+ RTExceptions_Raise ( ((unsigned int) (M2EXCEPTION_realDivException)), const_cast<void*> (reinterpret_cast<const void*>("../../gcc/m2/gm2-libs/RTExceptions.mod")), 709, 9, const_cast<void*> (reinterpret_cast<const void*>("realdiv")), const_cast<void*> (reinterpret_cast<const void*>("real number division by zero exception")));
}
@@ -812,7 +814,7 @@ static void realdiv (void * a)
static void complexvalue (void * a)
{
- RTExceptions_Raise ( ((unsigned int) (M2EXCEPTION_complexValueException)), const_cast<void*> (reinterpret_cast<const void*>("../../gcc-read-write/gcc/m2/gm2-libs/RTExceptions.mod")), 720, 9, const_cast<void*> (reinterpret_cast<const void*>("complexvalue")), const_cast<void*> (reinterpret_cast<const void*>("illegal complex value exception")));
+ RTExceptions_Raise ( ((unsigned int) (M2EXCEPTION_complexValueException)), const_cast<void*> (reinterpret_cast<const void*>("../../gcc/m2/gm2-libs/RTExceptions.mod")), 721, 9, const_cast<void*> (reinterpret_cast<const void*>("complexvalue")), const_cast<void*> (reinterpret_cast<const void*>("illegal complex value exception")));
}
@@ -822,7 +824,7 @@ static void complexvalue (void * a)
static void complexdiv (void * a)
{
- RTExceptions_Raise ( ((unsigned int) (M2EXCEPTION_complexDivException)), const_cast<void*> (reinterpret_cast<const void*>("../../gcc-read-write/gcc/m2/gm2-libs/RTExceptions.mod")), 732, 9, const_cast<void*> (reinterpret_cast<const void*>("complexdiv")), const_cast<void*> (reinterpret_cast<const void*>("complex number division by zero exception")));
+ RTExceptions_Raise ( ((unsigned int) (M2EXCEPTION_complexDivException)), const_cast<void*> (reinterpret_cast<const void*>("../../gcc/m2/gm2-libs/RTExceptions.mod")), 733, 9, const_cast<void*> (reinterpret_cast<const void*>("complexdiv")), const_cast<void*> (reinterpret_cast<const void*>("complex number division by zero exception")));
}
@@ -832,7 +834,7 @@ static void complexdiv (void * a)
static void protection (void * a)
{
- RTExceptions_Raise ( ((unsigned int) (M2EXCEPTION_protException)), const_cast<void*> (reinterpret_cast<const void*>("../../gcc-read-write/gcc/m2/gm2-libs/RTExceptions.mod")), 744, 9, const_cast<void*> (reinterpret_cast<const void*>("protection")), const_cast<void*> (reinterpret_cast<const void*>("protection exception")));
+ RTExceptions_Raise ( ((unsigned int) (M2EXCEPTION_protException)), const_cast<void*> (reinterpret_cast<const void*>("../../gcc/m2/gm2-libs/RTExceptions.mod")), 745, 9, const_cast<void*> (reinterpret_cast<const void*>("protection")), const_cast<void*> (reinterpret_cast<const void*>("protection exception")));
}
@@ -842,7 +844,7 @@ static void protection (void * a)
static void systemf (void * a)
{
- RTExceptions_Raise ( ((unsigned int) (M2EXCEPTION_sysException)), const_cast<void*> (reinterpret_cast<const void*>("../../gcc-read-write/gcc/m2/gm2-libs/RTExceptions.mod")), 756, 9, const_cast<void*> (reinterpret_cast<const void*>("systemf")), const_cast<void*> (reinterpret_cast<const void*>("system exception")));
+ RTExceptions_Raise ( ((unsigned int) (M2EXCEPTION_sysException)), const_cast<void*> (reinterpret_cast<const void*>("../../gcc/m2/gm2-libs/RTExceptions.mod")), 757, 9, const_cast<void*> (reinterpret_cast<const void*>("systemf")), const_cast<void*> (reinterpret_cast<const void*>("system exception")));
}
@@ -852,7 +854,7 @@ static void systemf (void * a)
static void coroutine (void * a)
{
- RTExceptions_Raise ( ((unsigned int) (M2EXCEPTION_coException)), const_cast<void*> (reinterpret_cast<const void*>("../../gcc-read-write/gcc/m2/gm2-libs/RTExceptions.mod")), 768, 9, const_cast<void*> (reinterpret_cast<const void*>("coroutine")), const_cast<void*> (reinterpret_cast<const void*>("coroutine exception")));
+ RTExceptions_Raise ( ((unsigned int) (M2EXCEPTION_coException)), const_cast<void*> (reinterpret_cast<const void*>("../../gcc/m2/gm2-libs/RTExceptions.mod")), 769, 9, const_cast<void*> (reinterpret_cast<const void*>("coroutine")), const_cast<void*> (reinterpret_cast<const void*>("coroutine exception")));
}
@@ -862,7 +864,7 @@ static void coroutine (void * a)
static void exception (void * a)
{
- RTExceptions_Raise ( ((unsigned int) (M2EXCEPTION_exException)), const_cast<void*> (reinterpret_cast<const void*>("../../gcc-read-write/gcc/m2/gm2-libs/RTExceptions.mod")), 780, 9, const_cast<void*> (reinterpret_cast<const void*>("exception")), const_cast<void*> (reinterpret_cast<const void*>("exception exception")));
+ RTExceptions_Raise ( ((unsigned int) (M2EXCEPTION_exException)), const_cast<void*> (reinterpret_cast<const void*>("../../gcc/m2/gm2-libs/RTExceptions.mod")), 781, 9, const_cast<void*> (reinterpret_cast<const void*>("exception")), const_cast<void*> (reinterpret_cast<const void*>("exception exception")));
}
@@ -1181,13 +1183,13 @@ extern "C" RTExceptions_EHBlock RTExceptions_GetBaseExceptionBlock (void)
{
if (currentEHB == NULL)
{
- M2RTS_Halt ((const char *) "../../gcc-read-write/gcc/m2/gm2-libs/RTExceptions.mod", 53, 598, (const char *) "GetBaseExceptionBlock", 21, (const char *) "currentEHB has not been initialized yet", 39);
+ M2RTS_Halt ((const char *) "../../gcc/m2/gm2-libs/RTExceptions.mod", 38, 599, (const char *) "GetBaseExceptionBlock", 21, (const char *) "currentEHB has not been initialized yet", 39);
}
else
{
return currentEHB;
}
- ReturnException ("../../gcc-read-write/gcc/m2/gm2-libs/RTExceptions.def", 25, 1);
+ ReturnException ("../../gcc/m2/gm2-libs/RTExceptions.def", 25, 1);
__builtin_unreachable ();
}
@@ -1218,7 +1220,7 @@ extern "C" void _M2_RTExceptions_init (__attribute__((unused)) int argc,__attrib
Init ();
}
-extern "C" void _M2_RTExceptions_finish (__attribute__((unused)) int argc,__attribute__((unused)) char *argv[],__attribute__((unused)) char *envp[])
+extern "C" void _M2_RTExceptions_fini (__attribute__((unused)) int argc,__attribute__((unused)) char *argv[],__attribute__((unused)) char *envp[])
{
TidyUp ();
}
diff --git a/gcc/m2/pge-boot/GSFIO.c b/gcc/m2/pge-boot/GSFIO.c
index 01994a5e4d2..4ecfec8e9d2 100644
--- a/gcc/m2/pge-boot/GSFIO.c
+++ b/gcc/m2/pge-boot/GSFIO.c
@@ -210,6 +210,6 @@ extern "C" void _M2_SFIO_init (__attribute__((unused)) int argc,__attribute__((u
{
}
-extern "C" void _M2_SFIO_finish (__attribute__((unused)) int argc,__attribute__((unused)) char *argv[],__attribute__((unused)) char *envp[])
+extern "C" void _M2_SFIO_fini (__attribute__((unused)) int argc,__attribute__((unused)) char *argv[],__attribute__((unused)) char *envp[])
{
}
diff --git a/gcc/m2/pge-boot/GStdIO.c b/gcc/m2/pge-boot/GStdIO.c
index 04af632977f..8b551aa5b97 100644
--- a/gcc/m2/pge-boot/GStdIO.c
+++ b/gcc/m2/pge-boot/GStdIO.c
@@ -191,7 +191,7 @@ extern "C" StdIO_ProcWrite StdIO_GetCurrentOutput (void)
M2RTS_HALT (-1);
__builtin_unreachable ();
}
- ReturnException ("../../gcc-read-write/gcc/m2/gm2-libs/StdIO.def", 25, 1);
+ ReturnException ("../../gcc/m2/gm2-libs/StdIO.def", 25, 1);
__builtin_unreachable ();
}
@@ -250,7 +250,7 @@ extern "C" StdIO_ProcRead StdIO_GetCurrentInput (void)
M2RTS_HALT (-1);
__builtin_unreachable ();
}
- ReturnException ("../../gcc-read-write/gcc/m2/gm2-libs/StdIO.def", 25, 1);
+ ReturnException ("../../gcc/m2/gm2-libs/StdIO.def", 25, 1);
__builtin_unreachable ();
}
@@ -262,6 +262,6 @@ extern "C" void _M2_StdIO_init (__attribute__((unused)) int argc,__attribute__((
StdIO_PushInput ((StdIO_ProcRead) {(StdIO_ProcRead_t) IO_Read});
}
-extern "C" void _M2_StdIO_finish (__attribute__((unused)) int argc,__attribute__((unused)) char *argv[],__attribute__((unused)) char *envp[])
+extern "C" void _M2_StdIO_fini (__attribute__((unused)) int argc,__attribute__((unused)) char *argv[],__attribute__((unused)) char *envp[])
{
}
diff --git a/gcc/m2/pge-boot/GStorage.c b/gcc/m2/pge-boot/GStorage.c
index 8d6661ae460..d3b8776d525 100644
--- a/gcc/m2/pge-boot/GStorage.c
+++ b/gcc/m2/pge-boot/GStorage.c
@@ -67,6 +67,6 @@ extern "C" void _M2_Storage_init (__attribute__((unused)) int argc,__attribute__
{
}
-extern "C" void _M2_Storage_finish (__attribute__((unused)) int argc,__attribute__((unused)) char *argv[],__attribute__((unused)) char *envp[])
+extern "C" void _M2_Storage_fini (__attribute__((unused)) int argc,__attribute__((unused)) char *argv[],__attribute__((unused)) char *envp[])
{
}
diff --git a/gcc/m2/pge-boot/GStrCase.c b/gcc/m2/pge-boot/GStrCase.c
index 3ddb7a480fd..0e6b5bee012 100644
--- a/gcc/m2/pge-boot/GStrCase.c
+++ b/gcc/m2/pge-boot/GStrCase.c
@@ -170,6 +170,6 @@ extern "C" void _M2_StrCase_init (__attribute__((unused)) int argc,__attribute__
{
}
-extern "C" void _M2_StrCase_finish (__attribute__((unused)) int argc,__attribute__((unused)) char *argv[],__attribute__((unused)) char *envp[])
+extern "C" void _M2_StrCase_fini (__attribute__((unused)) int argc,__attribute__((unused)) char *argv[],__attribute__((unused)) char *envp[])
{
}
diff --git a/gcc/m2/pge-boot/GStrIO.c b/gcc/m2/pge-boot/GStrIO.c
index 0bea153ee84..b8c42ac162a 100644
--- a/gcc/m2/pge-boot/GStrIO.c
+++ b/gcc/m2/pge-boot/GStrIO.c
@@ -272,6 +272,6 @@ extern "C" void _M2_StrIO_init (__attribute__((unused)) int argc,__attribute__((
IsATTY = FALSE;
}
-extern "C" void _M2_StrIO_finish (__attribute__((unused)) int argc,__attribute__((unused)) char *argv[],__attribute__((unused)) char *envp[])
+extern "C" void _M2_StrIO_fini (__attribute__((unused)) int argc,__attribute__((unused)) char *argv[],__attribute__((unused)) char *envp[])
{
}
diff --git a/gcc/m2/pge-boot/GStrLib.c b/gcc/m2/pge-boot/GStrLib.c
index 21a9ccb6d30..d5ae7249d89 100644
--- a/gcc/m2/pge-boot/GStrLib.c
+++ b/gcc/m2/pge-boot/GStrLib.c
@@ -341,6 +341,6 @@ extern "C" void _M2_StrLib_init (__attribute__((unused)) int argc,__attribute__(
{
}
-extern "C" void _M2_StrLib_finish (__attribute__((unused)) int argc,__attribute__((unused)) char *argv[],__attribute__((unused)) char *envp[])
+extern "C" void _M2_StrLib_fini (__attribute__((unused)) int argc,__attribute__((unused)) char *argv[],__attribute__((unused)) char *envp[])
{
}
diff --git a/gcc/m2/pge-boot/GSymbolKey.c b/gcc/m2/pge-boot/GSymbolKey.c
index 61c599ea9a0..51df5fce89d 100644
--- a/gcc/m2/pge-boot/GSymbolKey.c
+++ b/gcc/m2/pge-boot/GSymbolKey.c
@@ -183,7 +183,7 @@ static void FindNodeParentInTree (SymbolKey_SymbolTree t, NameKey_Name n, Symbol
(*parent) = t;
if (t == NULL)
{
- Debug_Halt ((const char *) "parameter t should never be NIL", 31, 240, (const char *) "../../gcc-read-write/gcc/m2/gm2-compiler/SymbolKey.mod", 54);
+ Debug_Halt ((const char *) "parameter t should never be NIL", 31, 240, (const char *) "../../gcc/m2/gm2-compiler/SymbolKey.mod", 39);
}
Assertion_Assert (t->Right == NULL);
(*child) = t->Left;
@@ -392,7 +392,7 @@ extern "C" void SymbolKey_PutSymKey (SymbolKey_SymbolTree t, NameKey_Name NameKe
}
else
{
- Debug_Halt ((const char *) "symbol already stored", 21, 156, (const char *) "../../gcc-read-write/gcc/m2/gm2-compiler/SymbolKey.mod", 54);
+ Debug_Halt ((const char *) "symbol already stored", 21, 156, (const char *) "../../gcc/m2/gm2-compiler/SymbolKey.mod", 39);
}
}
@@ -459,7 +459,7 @@ extern "C" void SymbolKey_DelSymKey (SymbolKey_SymbolTree t, NameKey_Name NameKe
}
else
{
- Debug_Halt ((const char *) "trying to delete a symbol that is not in the tree - the compiler never expects this to occur", 92, 223, (const char *) "../../gcc-read-write/gcc/m2/gm2-compiler/SymbolKey.mod", 54);
+ Debug_Halt ((const char *) "trying to delete a symbol that is not in the tree - the compiler never expects this to occur", 92, 223, (const char *) "../../gcc/m2/gm2-compiler/SymbolKey.mod", 39);
}
}
@@ -551,6 +551,6 @@ extern "C" void _M2_SymbolKey_init (__attribute__((unused)) int argc,__attribute
{
}
-extern "C" void _M2_SymbolKey_finish (__attribute__((unused)) int argc,__attribute__((unused)) char *argv[],__attribute__((unused)) char *envp[])
+extern "C" void _M2_SymbolKey_fini (__attribute__((unused)) int argc,__attribute__((unused)) char *argv[],__attribute__((unused)) char *envp[])
{
}
diff --git a/gcc/m2/pge-boot/GSysExceptions.c b/gcc/m2/pge-boot/GSysExceptions.c
index 94670096386..4e600565fe8 100644
--- a/gcc/m2/pge-boot/GSysExceptions.c
+++ b/gcc/m2/pge-boot/GSysExceptions.c
@@ -232,6 +232,6 @@ _M2_SysExceptions_init (void)
EXTERN
void
-_M2_SysExceptions_finish (void)
+_M2_SysExceptions_fini (void)
{
}
diff --git a/gcc/m2/pge-boot/GSysStorage.c b/gcc/m2/pge-boot/GSysStorage.c
index f2a70385bea..e008d91d0e8 100644
--- a/gcc/m2/pge-boot/GSysStorage.c
+++ b/gcc/m2/pge-boot/GSysStorage.c
@@ -93,7 +93,7 @@ extern "C" void SysStorage_ALLOCATE (void * *a, unsigned int size)
(*a) = libc_malloc (static_cast<size_t> (size));
if ((*a) == NULL)
{
- Debug_Halt ((const char *) "out of memory error", 19, 50, (const char *) "../../gcc-read-write/gcc/m2/gm2-libs/SysStorage.mod", 51);
+ Debug_Halt ((const char *) "out of memory error", 19, 50, (const char *) "../../gcc/m2/gm2-libs/SysStorage.mod", 36);
}
if (enableTrace && trace)
{
@@ -118,7 +118,7 @@ extern "C" void SysStorage_DEALLOCATE (void * *a, unsigned int size)
}
if ((libc_memset ((*a), 0, static_cast<size_t> (size))) != (*a))
{
- Debug_Halt ((const char *) "memset should have returned the first parameter", 47, 76, (const char *) "../../gcc-read-write/gcc/m2/gm2-libs/SysStorage.mod", 51);
+ Debug_Halt ((const char *) "memset should have returned the first parameter", 47, 76, (const char *) "../../gcc/m2/gm2-libs/SysStorage.mod", 36);
}
}
if (enableDeallocation)
@@ -163,7 +163,7 @@ extern "C" void SysStorage_REALLOCATE (void * *a, unsigned int size)
(*a) = libc_realloc ((*a), static_cast<size_t> (size));
if ((*a) == NULL)
{
- Debug_Halt ((const char *) "out of memory error", 19, 119, (const char *) "../../gcc-read-write/gcc/m2/gm2-libs/SysStorage.mod", 51);
+ Debug_Halt ((const char *) "out of memory error", 19, 119, (const char *) "../../gcc/m2/gm2-libs/SysStorage.mod", 36);
}
if (enableTrace && trace)
{
@@ -244,6 +244,6 @@ extern "C" void _M2_SysStorage_init (__attribute__((unused)) int argc,__attribut
}
}
-extern "C" void _M2_SysStorage_finish (__attribute__((unused)) int argc,__attribute__((unused)) char *argv[],__attribute__((unused)) char *envp[])
+extern "C" void _M2_SysStorage_fini (__attribute__((unused)) int argc,__attribute__((unused)) char *argv[],__attribute__((unused)) char *envp[])
{
}
diff --git a/gcc/m2/pge-boot/GUnixArgs.cc b/gcc/m2/pge-boot/GUnixArgs.cc
index 4cd5d3ceef5..29b8ec27323 100644
--- a/gcc/m2/pge-boot/GUnixArgs.cc
+++ b/gcc/m2/pge-boot/GUnixArgs.cc
@@ -73,7 +73,7 @@ _M2_UnixArgs_init (int argc, char *argv[], char *envp[])
}
extern "C" void
-_M2_UnixArgs_finish (int argc, char *argv[], char *envp[])
+_M2_UnixArgs_fini (int argc, char *argv[], char *envp[])
{
}
@@ -86,6 +86,6 @@ struct _M2_UnixArgs_ctor { _M2_UnixArgs_ctor (); } _M2_UnixArgs_ctor;
_M2_UnixArgs_ctor::_M2_UnixArgs_ctor (void)
{
- M2RTS_RegisterModule ("UnixArgs", _M2_UnixArgs_init, _M2_UnixArgs_finish,
+ M2RTS_RegisterModule ("UnixArgs", _M2_UnixArgs_init, _M2_UnixArgs_fini,
_M2_UnixArgs_dep);
}
diff --git a/gcc/m2/pge-boot/Gbnflex.c b/gcc/m2/pge-boot/Gbnflex.c
index ac31e51e9bc..7f78b5d250b 100644
--- a/gcc/m2/pge-boot/Gbnflex.c
+++ b/gcc/m2/pge-boot/Gbnflex.c
@@ -597,6 +597,6 @@ extern "C" void _M2_bnflex_init (__attribute__((unused)) int argc,__attribute__(
Init ();
}
-extern "C" void _M2_bnflex_finish (__attribute__((unused)) int argc,__attribute__((unused)) char *argv[],__attribute__((unused)) char *envp[])
+extern "C" void _M2_bnflex_fini (__attribute__((unused)) int argc,__attribute__((unused)) char *argv[],__attribute__((unused)) char *envp[])
{
}
diff --git a/gcc/m2/pge-boot/Gerrno.c b/gcc/m2/pge-boot/Gerrno.c
index 26756f67808..c65c48630af 100644
--- a/gcc/m2/pge-boot/Gerrno.c
+++ b/gcc/m2/pge-boot/Gerrno.c
@@ -45,7 +45,7 @@ _M2_errno_init (int argc, char *p)
/* finish deconstructor for the module. */
void
-_M2_errno_finish (int argc, char *p)
+_M2_errno_fini (int argc, char *p)
{
}
diff --git a/gcc/m2/pge-boot/Glibc.c b/gcc/m2/pge-boot/Glibc.c
index 3e9b4863f94..e9395651e90 100644
--- a/gcc/m2/pge-boot/Glibc.c
+++ b/gcc/m2/pge-boot/Glibc.c
@@ -115,6 +115,43 @@ libc_printf (char *_format, unsigned int _format_high, ...)
return done;
}
+EXTERN
+int
+libc_snprintf (char *dest, size_t length, char *_format, unsigned int _format_high, ...)
+{
+ va_list arg;
+ int done;
+ char format[_format_high + 1];
+ unsigned int i = 0;
+ unsigned int j = 0;
+ char *c;
+
+ do
+ {
+ c = index (&_format[i], '\\');
+ if (c == NULL)
+ strcpy (&format[j], &_format[i]);
+ else
+ {
+ memcpy (&format[j], &_format[i], (c - _format) - i);
+ i = c - _format;
+ j += c - _format;
+ if (_format[i + 1] == 'n')
+ format[j] = '\n';
+ else
+ format[j] = _format[i + 1];
+ j++;
+ i += 2;
+ }
+ }
+ while (c != NULL);
+
+ va_start (arg, _format_high);
+ done = vsnprintf (dest, length, format, arg);
+ va_end (arg);
+ return done;
+}
+
EXTERN
void *
libc_malloc (unsigned int size)
diff --git a/gcc/m2/pge-boot/Glibc.h b/gcc/m2/pge-boot/Glibc.h
index daa0a1c66ad..f4e769187d3 100644
--- a/gcc/m2/pge-boot/Glibc.h
+++ b/gcc/m2/pge-boot/Glibc.h
@@ -305,6 +305,7 @@ EXTERN void * libc_memset (void * s, int c, size_t size);
EXTERN void * libc_memmove (void * dest, void * src, size_t size);
EXTERN int libc_printf (const char *format_, unsigned int _format_high, ...);
+EXTERN int libc_snprintf (void *dest, size_t length, const char *format_, unsigned int _format_high, ...);
/*
setenv - sets environment variable, name, to value.
diff --git a/gcc/m2/pge-boot/Gpge.c b/gcc/m2/pge-boot/Gpge.c
index 7eaeccb0bd1..e889236b948 100644
--- a/gcc/m2/pge-boot/Gpge.c
+++ b/gcc/m2/pge-boot/Gpge.c
@@ -9748,6 +9748,6 @@ extern "C" void _M2_pge_init (__attribute__((unused)) int argc,__attribute__((un
Init ();
}
-extern "C" void _M2_pge_finish (__attribute__((unused)) int argc,__attribute__((unused)) char *argv[],__attribute__((unused)) char *envp[])
+extern "C" void _M2_pge_fini (__attribute__((unused)) int argc,__attribute__((unused)) char *argv[],__attribute__((unused)) char *envp[])
{
}
diff --git a/gcc/m2/pge-boot/Gtermios.cc b/gcc/m2/pge-boot/Gtermios.cc
index 952270894b4..5660f97b62f 100644
--- a/gcc/m2/pge-boot/Gtermios.cc
+++ b/gcc/m2/pge-boot/Gtermios.cc
@@ -1938,7 +1938,7 @@ _M2_termios_init (void)
}
void
-_M2_termios_finish (void)
+_M2_termios_fini (void)
{
}
diff --git a/gcc/m2/pge-boot/main.c b/gcc/m2/pge-boot/main.c
index 3c7656a1d53..b6f29f628f7 100644
--- a/gcc/m2/pge-boot/main.c
+++ b/gcc/m2/pge-boot/main.c
@@ -1,61 +1,61 @@
extern "C" void _M2_RTExceptions_init (int argc, char *argv[], char *envp[]);
-extern "C" void _M2_RTExceptions_finish (int argc, char *argv[], char *envp[]);
+extern "C" void _M2_RTExceptions_fini (int argc, char *argv[], char *envp[]);
extern "C" void _M2_M2EXCEPTION_init (int argc, char *argv[], char *envp[]);
-extern "C" void _M2_M2EXCEPTION_finish (int argc, char *argv[], char *envp[]);
+extern "C" void _M2_M2EXCEPTION_fini (int argc, char *argv[], char *envp[]);
extern "C" void _M2_M2RTS_init (int argc, char *argv[], char *envp[]);
-extern "C" void _M2_M2RTS_finish (int argc, char *argv[], char *envp[]);
+extern "C" void _M2_M2RTS_fini (int argc, char *argv[], char *envp[]);
extern "C" void _M2_SysExceptions_init (int argc, char *argv[], char *envp[]);
-extern "C" void _M2_SysExceptions_finish (int argc, char *argv[], char *envp[]);
+extern "C" void _M2_SysExceptions_fini (int argc, char *argv[], char *envp[]);
extern "C" void _M2_StrLib_init (int argc, char *argv[], char *envp[]);
-extern "C" void _M2_StrLib_finish (int argc, char *argv[], char *envp[]);
+extern "C" void _M2_StrLib_fini (int argc, char *argv[], char *envp[]);
extern "C" void _M2_errno_init (int argc, char *argv[], char *envp[]);
-extern "C" void _M2_errno_finish (int argc, char *argv[], char *envp[]);
+extern "C" void _M2_errno_fini (int argc, char *argv[], char *envp[]);
extern "C" void _M2_termios_init (int argc, char *argv[], char *envp[]);
-extern "C" void _M2_termios_finish (int argc, char *argv[], char *envp[]);
+extern "C" void _M2_termios_fini (int argc, char *argv[], char *envp[]);
extern "C" void _M2_IO_init (int argc, char *argv[], char *envp[]);
-extern "C" void _M2_IO_finish (int argc, char *argv[], char *envp[]);
+extern "C" void _M2_IO_fini (int argc, char *argv[], char *envp[]);
extern "C" void _M2_StdIO_init (int argc, char *argv[], char *envp[]);
-extern "C" void _M2_StdIO_finish (int argc, char *argv[], char *envp[]);
+extern "C" void _M2_StdIO_fini (int argc, char *argv[], char *envp[]);
extern "C" void _M2_Debug_init (int argc, char *argv[], char *envp[]);
-extern "C" void _M2_Debug_finish (int argc, char *argv[], char *envp[]);
+extern "C" void _M2_Debug_fini (int argc, char *argv[], char *envp[]);
extern "C" void _M2_SysStorage_init (int argc, char *argv[], char *envp[]);
-extern "C" void _M2_SysStorage_finish (int argc, char *argv[], char *envp[]);
+extern "C" void _M2_SysStorage_fini (int argc, char *argv[], char *envp[]);
extern "C" void _M2_Storage_init (int argc, char *argv[], char *envp[]);
-extern "C" void _M2_Storage_finish (int argc, char *argv[], char *envp[]);
+extern "C" void _M2_Storage_fini (int argc, char *argv[], char *envp[]);
extern "C" void _M2_StrIO_init (int argc, char *argv[], char *envp[]);
-extern "C" void _M2_StrIO_finish (int argc, char *argv[], char *envp[]);
+extern "C" void _M2_StrIO_fini (int argc, char *argv[], char *envp[]);
extern "C" void _M2_DynamicStrings_init (int argc, char *argv[], char *envp[]);
-extern "C" void _M2_DynamicStrings_finish (int argc, char *argv[], char *envp[]);
+extern "C" void _M2_DynamicStrings_fini (int argc, char *argv[], char *envp[]);
extern "C" void _M2_Assertion_init (int argc, char *argv[], char *envp[]);
-extern "C" void _M2_Assertion_finish (int argc, char *argv[], char *envp[]);
+extern "C" void _M2_Assertion_fini (int argc, char *argv[], char *envp[]);
extern "C" void _M2_Indexing_init (int argc, char *argv[], char *envp[]);
-extern "C" void _M2_Indexing_finish (int argc, char *argv[], char *envp[]);
+extern "C" void _M2_Indexing_fini (int argc, char *argv[], char *envp[]);
extern "C" void _M2_NameKey_init (int argc, char *argv[], char *envp[]);
-extern "C" void _M2_NameKey_finish (int argc, char *argv[], char *envp[]);
+extern "C" void _M2_NameKey_fini (int argc, char *argv[], char *envp[]);
extern "C" void _M2_NumberIO_init (int argc, char *argv[], char *envp[]);
-extern "C" void _M2_NumberIO_finish (int argc, char *argv[], char *envp[]);
+extern "C" void _M2_NumberIO_fini (int argc, char *argv[], char *envp[]);
extern "C" void _M2_PushBackInput_init (int argc, char *argv[], char *envp[]);
-extern "C" void _M2_PushBackInput_finish (int argc, char *argv[], char *envp[]);
+extern "C" void _M2_PushBackInput_fini (int argc, char *argv[], char *envp[]);
extern "C" void _M2_SymbolKey_init (int argc, char *argv[], char *envp[]);
-extern "C" void _M2_SymbolKey_finish (int argc, char *argv[], char *envp[]);
+extern "C" void _M2_SymbolKey_fini (int argc, char *argv[], char *envp[]);
extern "C" void _M2_UnixArgs_init (int argc, char *argv[], char *envp[]);
-extern "C" void _M2_UnixArgs_finish (int argc, char *argv[], char *envp[]);
+extern "C" void _M2_UnixArgs_fini (int argc, char *argv[], char *envp[]);
extern "C" void _M2_FIO_init (int argc, char *argv[], char *envp[]);
-extern "C" void _M2_FIO_finish (int argc, char *argv[], char *envp[]);
+extern "C" void _M2_FIO_fini (int argc, char *argv[], char *envp[]);
extern "C" void _M2_SFIO_init (int argc, char *argv[], char *envp[]);
-extern "C" void _M2_SFIO_finish (int argc, char *argv[], char *envp[]);
+extern "C" void _M2_SFIO_fini (int argc, char *argv[], char *envp[]);
extern "C" void _M2_StrCase_init (int argc, char *argv[], char *envp[]);
-extern "C" void _M2_StrCase_finish (int argc, char *argv[], char *envp[]);
+extern "C" void _M2_StrCase_fini (int argc, char *argv[], char *envp[]);
extern "C" void _M2_bnflex_init (int argc, char *argv[], char *envp[]);
-extern "C" void _M2_bnflex_finish (int argc, char *argv[], char *envp[]);
+extern "C" void _M2_bnflex_fini (int argc, char *argv[], char *envp[]);
extern "C" void _M2_Lists_init (int argc, char *argv[], char *envp[]);
-extern "C" void _M2_Lists_finish (int argc, char *argv[], char *envp[]);
+extern "C" void _M2_Lists_fini (int argc, char *argv[], char *envp[]);
extern "C" void _M2_Args_init (int argc, char *argv[], char *envp[]);
-extern "C" void _M2_Args_finish (int argc, char *argv[], char *envp[]);
+extern "C" void _M2_Args_fini (int argc, char *argv[], char *envp[]);
extern "C" void _M2_Output_init (int argc, char *argv[], char *envp[]);
-extern "C" void _M2_Output_finish (int argc, char *argv[], char *envp[]);
+extern "C" void _M2_Output_fini (int argc, char *argv[], char *envp[]);
extern "C" void _M2_pge_init (int argc, char *argv[], char *envp[]);
-extern "C" void _M2_pge_finish (int argc, char *argv[], char *envp[]);
+extern "C" void _M2_pge_fini (int argc, char *argv[], char *envp[]);
extern "C" void _exit(int);
@@ -90,34 +90,34 @@ int main(int argc, char *argv[], char *envp[])
_M2_Args_init (argc, argv, envp);
_M2_Output_init (argc, argv, envp);
_M2_pge_init (argc, argv, envp);
- _M2_pge_finish (argc, argv, envp);
- _M2_Output_finish (argc, argv, envp);
- _M2_Args_finish (argc, argv, envp);
- _M2_Lists_finish (argc, argv, envp);
- _M2_bnflex_finish (argc, argv, envp);
- _M2_StrCase_finish (argc, argv, envp);
- _M2_SFIO_finish (argc, argv, envp);
- _M2_FIO_finish (argc, argv, envp);
- _M2_UnixArgs_finish (argc, argv, envp);
- _M2_SymbolKey_finish (argc, argv, envp);
- _M2_PushBackInput_finish (argc, argv, envp);
- _M2_NumberIO_finish (argc, argv, envp);
- _M2_NameKey_finish (argc, argv, envp);
- _M2_Indexing_finish (argc, argv, envp);
- _M2_Assertion_finish (argc, argv, envp);
- _M2_DynamicStrings_finish (argc, argv, envp);
- _M2_StrIO_finish (argc, argv, envp);
- _M2_Storage_finish (argc, argv, envp);
- _M2_SysStorage_finish (argc, argv, envp);
- _M2_Debug_finish (argc, argv, envp);
- _M2_StdIO_finish (argc, argv, envp);
- _M2_IO_finish (argc, argv, envp);
- _M2_termios_finish (argc, argv, envp);
- _M2_errno_finish (argc, argv, envp);
- _M2_StrLib_finish (argc, argv, envp);
- _M2_SysExceptions_finish (argc, argv, envp);
- _M2_M2RTS_finish (argc, argv, envp);
- _M2_M2EXCEPTION_finish (argc, argv, envp);
- _M2_RTExceptions_finish (argc, argv, envp);
+ _M2_pge_fini (argc, argv, envp);
+ _M2_Output_fini (argc, argv, envp);
+ _M2_Args_fini (argc, argv, envp);
+ _M2_Lists_fini (argc, argv, envp);
+ _M2_bnflex_fini (argc, argv, envp);
+ _M2_StrCase_fini (argc, argv, envp);
+ _M2_SFIO_fini (argc, argv, envp);
+ _M2_FIO_fini (argc, argv, envp);
+ _M2_UnixArgs_fini (argc, argv, envp);
+ _M2_SymbolKey_fini (argc, argv, envp);
+ _M2_PushBackInput_fini (argc, argv, envp);
+ _M2_NumberIO_fini (argc, argv, envp);
+ _M2_NameKey_fini (argc, argv, envp);
+ _M2_Indexing_fini (argc, argv, envp);
+ _M2_Assertion_fini (argc, argv, envp);
+ _M2_DynamicStrings_fini (argc, argv, envp);
+ _M2_StrIO_fini (argc, argv, envp);
+ _M2_Storage_fini (argc, argv, envp);
+ _M2_SysStorage_fini (argc, argv, envp);
+ _M2_Debug_fini (argc, argv, envp);
+ _M2_StdIO_fini (argc, argv, envp);
+ _M2_IO_fini (argc, argv, envp);
+ _M2_termios_fini (argc, argv, envp);
+ _M2_errno_fini (argc, argv, envp);
+ _M2_StrLib_fini (argc, argv, envp);
+ _M2_SysExceptions_fini (argc, argv, envp);
+ _M2_M2RTS_fini (argc, argv, envp);
+ _M2_M2EXCEPTION_fini (argc, argv, envp);
+ _M2_RTExceptions_fini (argc, argv, envp);
return(0);
}
diff --git a/gcc/m2/plugin/m2rte.cc b/gcc/m2/plugin/m2rte.cc
index 343384ac231..dcb9c6de42c 100644
--- a/gcc/m2/plugin/m2rte.cc
+++ b/gcc/m2/plugin/m2rte.cc
@@ -55,30 +55,55 @@ void debug_tree (tree);
basic block of a reachable function. */
static const char *m2_runtime_error_calls[] = {
- "M2RTS_AssignmentException",
- "M2RTS_ReturnException",
- "M2RTS_IncException",
- "M2RTS_DecException",
- "M2RTS_InclException",
- "M2RTS_ExclException",
- "M2RTS_ShiftException",
- "M2RTS_RotateException",
- "M2RTS_StaticArraySubscriptException",
- "M2RTS_DynamicArraySubscriptException",
- "M2RTS_ForLoopBeginException",
- "M2RTS_ForLoopToException",
- "M2RTS_ForLoopEndException",
- "M2RTS_PointerNilException",
- "M2RTS_NoReturnException",
- "M2RTS_CaseException",
- "M2RTS_WholeNonPosDivException",
- "M2RTS_WholeNonPosModException",
- "M2RTS_WholeZeroDivException",
- "M2RTS_WholeZeroRemException",
- "M2RTS_WholeValueException",
- "M2RTS_RealValueException",
- "M2RTS_ParameterException",
- "M2RTS_NoException",
+ "m2pim_M2RTS_AssignmentException",
+ "m2pim_M2RTS_ReturnException",
+ "m2pim_M2RTS_IncException",
+ "m2pim_M2RTS_DecException",
+ "m2pim_M2RTS_InclException",
+ "m2pim_M2RTS_ExclException",
+ "m2pim_M2RTS_ShiftException",
+ "m2pim_M2RTS_RotateException",
+ "m2pim_M2RTS_StaticArraySubscriptException",
+ "m2pim_M2RTS_DynamicArraySubscriptException",
+ "m2pim_M2RTS_ForLoopBeginException",
+ "m2pim_M2RTS_ForLoopToException",
+ "m2pim_M2RTS_ForLoopEndException",
+ "m2pim_M2RTS_PointerNilException",
+ "m2pim_M2RTS_NoReturnException",
+ "m2pim_M2RTS_CaseException",
+ "m2pim_M2RTS_WholeNonPosDivException",
+ "m2pim_M2RTS_WholeNonPosModException",
+ "m2pim_M2RTS_WholeZeroDivException",
+ "m2pim_M2RTS_WholeZeroRemException",
+ "m2pim_M2RTS_WholeValueException",
+ "m2pim_M2RTS_RealValueException",
+ "m2pim_M2RTS_ParameterException",
+ "m2pim_M2RTS_NoException",
+
+ "m2iso_M2RTS_AssignmentException",
+ "m2iso_M2RTS_ReturnException",
+ "m2iso_M2RTS_IncException",
+ "m2iso_M2RTS_DecException",
+ "m2iso_M2RTS_InclException",
+ "m2iso_M2RTS_ExclException",
+ "m2iso_M2RTS_ShiftException",
+ "m2iso_M2RTS_RotateException",
+ "m2iso_M2RTS_StaticArraySubscriptException",
+ "m2iso_M2RTS_DynamicArraySubscriptException",
+ "m2iso_M2RTS_ForLoopBeginException",
+ "m2iso_M2RTS_ForLoopToException",
+ "m2iso_M2RTS_ForLoopEndException",
+ "m2iso_M2RTS_PointerNilException",
+ "m2iso_M2RTS_NoReturnException",
+ "m2iso_M2RTS_CaseException",
+ "m2iso_M2RTS_WholeNonPosDivException",
+ "m2iso_M2RTS_WholeNonPosModException",
+ "m2iso_M2RTS_WholeZeroDivException",
+ "m2iso_M2RTS_WholeZeroRemException",
+ "m2iso_M2RTS_WholeValueException",
+ "m2iso_M2RTS_RealValueException",
+ "m2iso_M2RTS_ParameterException",
+ "m2iso_M2RTS_NoException",
NULL,
};
diff --git a/gcc/testsuite/gm2/examples/callingC/pass/examples-callingC-pass.exp b/gcc/testsuite/gm2/examples/callingC/pass/examples-callingC-pass.exp
index 8cbba550448..9e2e9f46f93 100644
--- a/gcc/testsuite/gm2/examples/callingC/pass/examples-callingC-pass.exp
+++ b/gcc/testsuite/gm2/examples/callingC/pass/examples-callingC-pass.exp
@@ -25,7 +25,7 @@ if $tracelevel then {
# load support procs
load_lib gm2-torture.exp
-gm2_init_pim "$srcdir/$subdir"
+gm2_init_pim "${srcdir}/${subdir}"
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 5a055465187..0b5dea9355e 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
@@ -27,7 +27,7 @@ load_lib gm2-torture.exp
set gm2src ${srcdir}/../m2
-gm2_init_iso "$srcdir/$subdir"
+gm2_init_iso "${srcdir}/${subdir}"
gm2_link_obj "c.o"
set output [target_compile $srcdir/$subdir/c.c c.o object "-g"]
diff --git a/gcc/testsuite/gm2/examples/cpp/pass/examples-cpp-pass.exp b/gcc/testsuite/gm2/examples/cpp/pass/examples-cpp-pass.exp
index 02a7321c903..3f3c0c5a85c 100644
--- a/gcc/testsuite/gm2/examples/cpp/pass/examples-cpp-pass.exp
+++ b/gcc/testsuite/gm2/examples/cpp/pass/examples-cpp-pass.exp
@@ -25,7 +25,7 @@ if $tracelevel then {
# load support procs
load_lib gm2-torture.exp
-gm2_init_pim "$srcdir/$subdir/" -fcpp
+gm2_init_pim "${srcdir}/${subdir}/" -fcpp
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/cppDef/pass/examples-cppDef-pass.exp b/gcc/testsuite/gm2/examples/cppDef/pass/examples-cppDef-pass.exp
index d93940b9af7..d4b3c62a71b 100644
--- a/gcc/testsuite/gm2/examples/cppDef/pass/examples-cppDef-pass.exp
+++ b/gcc/testsuite/gm2/examples/cppDef/pass/examples-cppDef-pass.exp
@@ -25,7 +25,7 @@ if $tracelevel then {
# load support procs
load_lib gm2-torture.exp
-gm2_init_pim "$srcdir/$subdir/" -DVALUE=999 -fcpp
+gm2_init_pim "${srcdir}/${subdir}/" -DVALUE=999 -fcpp
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/hello/pass/examples-hello-pass.exp b/gcc/testsuite/gm2/examples/hello/pass/examples-hello-pass.exp
index 93fc85745ed..449c19e04c4 100644
--- a/gcc/testsuite/gm2/examples/hello/pass/examples-hello-pass.exp
+++ b/gcc/testsuite/gm2/examples/hello/pass/examples-hello-pass.exp
@@ -25,7 +25,7 @@ if $tracelevel then {
# load support procs
load_lib gm2-torture.exp
-gm2_init_pim "$srcdir/$subdir"
+gm2_init_pim "${srcdir}/${subdir}"
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/map/pass/examples-map-pass.exp b/gcc/testsuite/gm2/examples/map/pass/examples-map-pass.exp
index ce2f8b3623d..ae29ed7c2a5 100644
--- a/gcc/testsuite/gm2/examples/map/pass/examples-map-pass.exp
+++ b/gcc/testsuite/gm2/examples/map/pass/examples-map-pass.exp
@@ -25,7 +25,7 @@ if $tracelevel then {
# load support procs
load_lib gm2-torture.exp
-gm2_init_pim "$srcdir/$subdir"
+gm2_init_pim "${srcdir}/${subdir}"
# We should be able to compile, link or run in 30 seconds.
gm2_push_timeout 30
diff --git a/gcc/testsuite/gm2/iso/check/fail/iso-check-fail.exp b/gcc/testsuite/gm2/iso/check/fail/iso-check-fail.exp
index 69a1fef6b03..836760d6c66 100644
--- a/gcc/testsuite/gm2/iso/check/fail/iso-check-fail.exp
+++ b/gcc/testsuite/gm2/iso/check/fail/iso-check-fail.exp
@@ -44,7 +44,7 @@ set TORTURE_OPTIONS [list \
{ -O3 -fsoft-check-all } \
{ -O3 -g -fsoft-check-all } ]
-gm2_init_iso "${srcdir}/gm2/iso/check/fail"
+gm2_init_iso "${srcdir}/gm2/iso/check/fail" -fm2-pathname=- -I${srcdir}/gm2/iso/check/fail
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/link/externalscaffold/pass/link-externalscaffold-pass.exp b/gcc/testsuite/gm2/link/externalscaffold/pass/link-externalscaffold-pass.exp
index 32d4315aebd..81ee8e2dfe6 100644
--- a/gcc/testsuite/gm2/link/externalscaffold/pass/link-externalscaffold-pass.exp
+++ b/gcc/testsuite/gm2/link/externalscaffold/pass/link-externalscaffold-pass.exp
@@ -25,7 +25,7 @@ if $tracelevel then {
# load support procs
load_lib gm2-torture.exp
-gm2_init_pim "${srcdir}/gm2/pim/pass" -fscaffold-main -fno-scaffold-dynamic
+gm2_init_pim "${srcdir}/gm2/pim/pass" -fscaffold-main -fno-scaffold-dynamic -fm2-pathname=- -I${srcdir}/gm2/pim/pass
gm2_link_obj scaffold.o
set output [target_compile $srcdir/$subdir/scaffold.c scaffold.o object "-g"]
diff --git a/gcc/testsuite/gm2/link/externalscaffold/pass/scaffold.c b/gcc/testsuite/gm2/link/externalscaffold/pass/scaffold.c
index 52f4cd1460e..2bd3587f6c7 100644
--- a/gcc/testsuite/gm2/link/externalscaffold/pass/scaffold.c
+++ b/gcc/testsuite/gm2/link/externalscaffold/pass/scaffold.c
@@ -1,11 +1,11 @@
extern void exit (int);
-extern void _M2_SYSTEM_init (int argc, char *argv[]);
-extern void _M2_SYSTEM_fini (void);
-extern void _M2_M2RTS_init (int argc, char *argv[]);
-extern void _M2_M2RTS_fini (void);
-extern void _M2_RTExceptions_init (int argc, char *argv[]);
-extern void _M2_RTExceptions_fini (void);
+extern void m2pim_M2_SYSTEM_init (int argc, char *argv[]);
+extern void m2pim_M2_SYSTEM_fini (void);
+extern void m2pim_M2_M2RTS_init (int argc, char *argv[]);
+extern void m2pim_M2_M2RTS_fini (void);
+extern void m2pim_M2_RTExceptions_init (int argc, char *argv[]);
+extern void m2pim_M2_RTExceptions_fini (void);
extern void _M2_hello_init (int argc, char *argv[]);
extern void _M2_hello_fini (void);
@@ -13,19 +13,19 @@ extern void M2RTS_Terminate (void);
static void init (int argc, char *argv[])
{
- _M2_SYSTEM_init (argc, argv);
- _M2_M2RTS_init (argc, argv);
- _M2_RTExceptions_init (argc, argv);
+ m2pim_M2_SYSTEM_init (argc, argv);
+ m2pim_M2_M2RTS_init (argc, argv);
+ m2pim_M2_RTExceptions_init (argc, argv);
_M2_hello_init (argc, argv);
}
static void finish (void)
{
- M2RTS_Terminate ();
+ m2pim_M2RTS_Terminate ();
_M2_hello_fini ();
- _M2_RTExceptions_fini ();
- _M2_M2RTS_fini ();
- _M2_SYSTEM_fini ();
+ m2pim_M2_RTExceptions_fini ();
+ m2pim_M2_M2RTS_fini ();
+ m2pim_M2_SYSTEM_fini ();
exit (0);
}
diff --git a/gcc/testsuite/gm2/pimlib/base/run/pass/FIO.mod b/gcc/testsuite/gm2/pimlib/base/run/pass/FIO.mod
index 6259b56873e..94a183301c3 100644
--- a/gcc/testsuite/gm2/pimlib/base/run/pass/FIO.mod
+++ b/gcc/testsuite/gm2/pimlib/base/run/pass/FIO.mod
@@ -1,21 +1,28 @@
-(* Copyright (C) 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009,
- 2010
- Free Software Foundation, Inc. *)
-(* This file is part of GNU Modula-2.
-
-This library is free software; you can redistribute it and/or
-modify it under the terms of the GNU Lesser General Public
-License as published by the Free Software Foundation; either
-version 2.1 of the License, or (at your option) any later version.
-
-This library is distributed in the hope that it will be useful,
-but WITHOUT ANY WARRANTY; without even the implied warranty of
+(* FIO.mod provides a simple buffered file input/output library.
+
+Copyright (C) 2001-2023 Free Software Foundation, Inc.
+Contributed by Gaius Mulley <gaius.mulley@southwales.ac.uk>.
+
+This file is part of GNU Modula-2.
+
+GNU Modula-2 is free software; you can redistribute it and/or modify
+it under the terms of the GNU General Public License as published by
+the Free Software Foundation; either version 3, or (at your option)
+any later version.
+
+GNU Modula-2 is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
-Lesser General Public License for more details.
+General Public License for more details.
-You should have received a copy of the GNU Lesser General Public
-License along with this library; if not, write to the Free Software
-Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA *)
+Under Section 7 of GPL version 3, you are granted additional
+permissions described in the GCC Runtime Library Exception, version
+3.1, as published by the Free Software Foundation.
+
+You should have received a copy of the GNU General Public License and
+a copy of the GCC Runtime Library Exception along with this program;
+see the files COPYING3 and COPYING.RUNTIME respectively. If not, see
+<http://www.gnu.org/licenses/>. *)
IMPLEMENTATION MODULE FIO ;
@@ -83,22 +90,6 @@ TYPE
(* bufstart above. *)
PtrToChar = POINTER TO CHAR ;
-(* we only need forward directives for the p2c bootstrapping tool *)
-
-(* %%%FORWARD%%%
-PROCEDURE SetEndOfLine (f: File; ch: CHAR) ; FORWARD ;
-PROCEDURE FormatError (a: ARRAY OF CHAR) ; FORWARD ;
-PROCEDURE FormatError1 (a: ARRAY OF CHAR; w: ARRAY OF BYTE) ; FORWARD ;
-PROCEDURE CheckAccess (f: File; use: FileUsage; towrite: BOOLEAN) ; FORWARD ;
-PROCEDURE BufferedRead (f: File; nBytes: CARDINAL; a: ADDRESS) : INTEGER ; FORWARD ;
-PROCEDURE InitializeFile (f: File; fname: ADDRESS; flength: CARDINAL;
- fstate: FileStatus; use: FileUsage; towrite: BOOLEAN; buflength: CARDINAL) : File ; FORWARD ;
-PROCEDURE ConnectToUnix (f: File; towrite, newfile: BOOLEAN) ; FORWARD ;
-PROCEDURE SetState (f: File; s: FileStatus) ; FORWARD ;
-PROCEDURE PreInitialize (f: File; fname: ARRAY OF CHAR;
- state: FileStatus; use: FileUsage;
- towrite: BOOLEAN; osfd: INTEGER; bufsize: CARDINAL) ; FORWARD ;
- %%%FORWARD%%% *)
VAR
FileInfo: Index ;
@@ -543,7 +534,7 @@ END Close ;
*)
PROCEDURE ReadFromBuffer (f: File; a: ADDRESS; nBytes: CARDINAL) : INTEGER ;
-VAR
+VAR
t : ADDRESS ;
result: INTEGER ;
total,
@@ -635,32 +626,32 @@ END ReadFromBuffer ;
(*
- ReadNBytes - reads nBytes of a file into memory area, a, returning
+ ReadNBytes - reads nBytes of a file into memory area, dest, returning
the number of bytes actually read.
This function will consume from the buffer and then
perform direct libc reads. It is ideal for large reads.
*)
-PROCEDURE ReadNBytes (f: File; nBytes: CARDINAL; a: ADDRESS) : CARDINAL ;
+PROCEDURE ReadNBytes (f: File; nBytes: CARDINAL; dest: ADDRESS) : CARDINAL ;
VAR
n: INTEGER ;
p: POINTER TO CHAR ;
BEGIN
- IF f#Error
+ IF f # Error
THEN
- CheckAccess(f, openedforread, FALSE) ;
- n := ReadFromBuffer(f, a, nBytes) ;
- IF n<0
+ CheckAccess (f, openedforread, FALSE) ;
+ n := ReadFromBuffer (f, dest, nBytes) ;
+ IF n <= 0
THEN
- RETURN( 0 )
+ RETURN 0
ELSE
- p := a ;
- INC(p, n) ;
- SetEndOfLine(f, p^) ;
- RETURN( n )
+ p := dest ;
+ INC (p, n-1) ;
+ SetEndOfLine (f, p^) ;
+ RETURN n
END
ELSE
- RETURN( 0 )
+ RETURN 0
END
END ReadNBytes ;
@@ -674,7 +665,7 @@ END ReadNBytes ;
*)
PROCEDURE BufferedRead (f: File; nBytes: CARDINAL; a: ADDRESS) : INTEGER ;
-VAR
+VAR
t : ADDRESS ;
result: INTEGER ;
total,
@@ -747,14 +738,11 @@ BEGIN
END
END ;
RETURN( total )
- ELSE
- RETURN( -1 )
END
END
END
- ELSE
- RETURN( -1 )
- END
+ END ;
+ RETURN( -1 )
END BufferedRead ;
@@ -825,6 +813,8 @@ VAR
BEGIN
HighSrc := StrLen(src) ;
HighDest := HIGH(dest) ;
+ p := NIL ;
+ c := 0 ;
i := 0 ;
j := 0 ;
WHILE (i<HighSrc) AND (src[i]#nul) AND (j<HighDest) AND (src[i]#'%') DO
@@ -892,25 +882,27 @@ END StringFormat1 ;
PROCEDURE FormatError (a: ARRAY OF CHAR) ;
BEGIN
- WriteString(StdErr, a)
+ WriteString (StdErr, a)
END FormatError ;
(*
- FormatError1 - fairly generic error procedure.
+ FormatError1 - generic error procedure taking standard format string
+ and single parameter.
*)
PROCEDURE FormatError1 (a: ARRAY OF CHAR; w: ARRAY OF BYTE) ;
VAR
s: ARRAY [0..MaxErrorString] OF CHAR ;
BEGIN
- StringFormat1(s, a, w) ;
- FormatError(s)
+ StringFormat1 (s, a, w) ;
+ FormatError (s)
END FormatError1 ;
(*
- FormatError2 - fairly generic error procedure.
+ FormatError2 - generic error procedure taking standard format string
+ and two parameters.
*)
PROCEDURE FormatError2 (a: ARRAY OF CHAR;
@@ -918,13 +910,13 @@ PROCEDURE FormatError2 (a: ARRAY OF CHAR;
VAR
s: ARRAY [0..MaxErrorString] OF CHAR ;
BEGIN
- StringFormat1(s, a, w1) ;
- FormatError1(s, w2)
+ StringFormat1 (s, a, w1) ;
+ FormatError1 (s, w2)
END FormatError2 ;
(*
- CheckAccess - checks to see whether a file, f, has been
+ CheckAccess - checks to see whether a file f has been
opened for read/write.
*)
@@ -934,20 +926,20 @@ VAR
BEGIN
IF f#Error
THEN
- fd := GetIndice(FileInfo, f) ;
+ fd := GetIndice (FileInfo, f) ;
IF fd=NIL
THEN
IF f#StdErr
THEN
- FormatError('this file has probably been closed and not reopened successfully or alternatively never opened\n')
+ FormatError ('this file has probably been closed and not reopened successfully or alternatively never opened\n')
END ;
HALT
ELSE
WITH fd^ DO
IF (use=openedforwrite) AND (usage=openedforread)
THEN
- FormatError1('this file (%s) has been opened for reading but is now being written\n',
- name.address) ;
+ FormatError1 ('this file (%s) has been opened for reading but is now being written\n',
+ name.address) ;
HALT
ELSIF (use=openedforread) AND (usage=openedforwrite)
THEN
@@ -982,7 +974,7 @@ END CheckAccess ;
(*
- ReadChar - returns a character read from file, f.
+ ReadChar - returns a character read from file f.
Sensible to check with IsNoError or EOF after calling
this function.
*)
@@ -991,19 +983,19 @@ PROCEDURE ReadChar (f: File) : CHAR ;
VAR
ch: CHAR ;
BEGIN
- CheckAccess(f, openedforread, FALSE) ;
- IF BufferedRead(f, SIZE(ch), ADR(ch)) = INTEGER (SIZE(ch))
+ CheckAccess (f, openedforread, FALSE) ;
+ IF BufferedRead (f, SIZE (ch), ADR (ch)) = VAL (INTEGER, SIZE (ch))
THEN
- SetEndOfLine(f, ch) ;
- RETURN( ch )
+ SetEndOfLine (f, ch) ;
+ RETURN ch
ELSE
- RETURN( nul )
+ RETURN nul
END
END ReadChar ;
(*
- SetEndOfLine -
+ SetEndOfLine -
*)
PROCEDURE SetEndOfLine (f: File; ch: CHAR) ;
@@ -1018,6 +1010,8 @@ BEGIN
IF ch=nl
THEN
state := endofline
+ ELSE
+ state := successful
END
END
END
@@ -1025,14 +1019,17 @@ END SetEndOfLine ;
(*
- UnReadChar - replaces a character, ch, back into file, f.
+ UnReadChar - replaces a character, ch, back into file f.
This character must have been read by ReadChar
and it does not allow successive calls. It may
only be called if the previous read was successful
or end of file was seen.
+ If the state was previously endoffile then it
+ is altered to successful.
+ Otherwise it is left alone.
*)
-PROCEDURE UnReadChar (f: File ; ch: CHAR) ;
+PROCEDURE UnReadChar (f: File; ch: CHAR) ;
VAR
fd : FileDescriptor ;
n : CARDINAL ;
@@ -1061,7 +1058,6 @@ BEGIN
DEC(position) ;
INC(left) ;
contents^[position] := ch ;
- SetEndOfLine(f, ch)
ELSE
(* position=0 *)
(* if possible make room and store ch *)
@@ -1075,7 +1071,6 @@ BEGIN
a := memcpy(a, b, n) ;
INC(filled) ;
contents^[position] := ch ;
- SetEndOfLine(f, ch)
END
END
END
@@ -1097,7 +1092,7 @@ END UnReadChar ;
PROCEDURE ReadAny (f: File; VAR a: ARRAY OF BYTE) ;
BEGIN
CheckAccess(f, openedforread, FALSE) ;
- IF BufferedRead(f, HIGH(a), ADR(a)) = INTEGER (HIGH(a))
+ IF BufferedRead (f, HIGH (a), ADR (a)) = VAL (INTEGER, HIGH (a))
THEN
SetEndOfLine(f, a[HIGH(a)])
END
@@ -1145,10 +1140,10 @@ BEGIN
fd := GetIndice(FileInfo, f) ;
IF fd#NIL
THEN
- IF fd^.state=successful
+ IF (fd^.state=successful) OR (fd^.state=endofline)
THEN
ch := ReadChar(f) ;
- IF fd^.state=successful
+ IF (fd^.state=successful) OR (fd^.state=endofline)
THEN
UnReadChar(f, ch)
END ;
@@ -1190,14 +1185,14 @@ END WriteLine ;
(*
- WriteNBytes - writes nBytes of a file into memory area, a, returning
- the number of bytes actually written.
+ WriteNBytes - writes nBytes from memory area src to a file
+ returning the number of bytes actually written.
This function will flush the buffer and then
write the nBytes using a direct write from libc.
It is ideal for large writes.
*)
-PROCEDURE WriteNBytes (f: File; nBytes: CARDINAL; a: ADDRESS) : CARDINAL ;
+PROCEDURE WriteNBytes (f: File; nBytes: CARDINAL; src: ADDRESS) : CARDINAL ;
VAR
total: INTEGER ;
fd : FileDescriptor ;
@@ -1210,7 +1205,7 @@ BEGIN
IF fd#NIL
THEN
WITH fd^ DO
- total := write(unixfd, a, INTEGER(nBytes)) ;
+ total := write(unixfd, src, INTEGER(nBytes)) ;
IF total<0
THEN
state := failed ;
@@ -1239,7 +1234,7 @@ END WriteNBytes ;
*)
PROCEDURE BufferedWrite (f: File; nBytes: CARDINAL; a: ADDRESS) : INTEGER ;
-VAR
+VAR
t : ADDRESS ;
result: INTEGER ;
total,
@@ -1284,7 +1279,7 @@ BEGIN
END
ELSE
FlushBuffer(f) ;
- IF state#successful
+ IF (state#successful) AND (state#endofline)
THEN
nBytes := 0
END
@@ -1343,8 +1338,8 @@ END FlushBuffer ;
PROCEDURE WriteAny (f: File; VAR a: ARRAY OF BYTE) ;
BEGIN
- CheckAccess(f, openedforwrite, TRUE) ;
- IF BufferedWrite (f, HIGH(a), ADR(a)) = INTEGER (HIGH(a))
+ CheckAccess (f, openedforwrite, TRUE) ;
+ IF BufferedWrite (f, HIGH (a), ADR (a)) = VAL (INTEGER, HIGH (a))
THEN
END
END WriteAny ;
@@ -1356,8 +1351,8 @@ END WriteAny ;
PROCEDURE WriteChar (f: File; ch: CHAR) ;
BEGIN
- CheckAccess(f, openedforwrite, TRUE) ;
- IF BufferedWrite(f, SIZE(ch), ADR(ch)) = INTEGER (SIZE(ch))
+ CheckAccess (f, openedforwrite, TRUE) ;
+ IF BufferedWrite (f, SIZE (ch), ADR (ch)) = VAL (INTEGER, SIZE (ch))
THEN
END
END WriteChar ;
@@ -1608,7 +1603,8 @@ BEGIN
ELSE
RETURN fd^.name.address
END
- END
+ END ;
+ RETURN NIL
END getFileName ;
@@ -1630,7 +1626,8 @@ BEGIN
ELSE
RETURN fd^.name.size
END
- END
+ END ;
+ RETURN 0
END getFileNameLength ;
@@ -1666,8 +1663,10 @@ END PreInitialize ;
(*
- FlushOutErr - called when the application calls M2RTS.Terminate (automatically
- placed in program modules by GM2.
+ FlushOutErr - flushes, StdOut, and, StdErr.
+ It is also called when the application calls M2RTS.Terminate.
+ (which is automatically placed in program modules by the GM2
+ scaffold).
*)
PROCEDURE FlushOutErr ;
diff --git a/gcc/testsuite/gm2/pimlib/base/run/pass/StrLib.mod b/gcc/testsuite/gm2/pimlib/base/run/pass/StrLib.mod
index 47635694a34..f85040ccacd 100644
--- a/gcc/testsuite/gm2/pimlib/base/run/pass/StrLib.mod
+++ b/gcc/testsuite/gm2/pimlib/base/run/pass/StrLib.mod
@@ -1,33 +1,33 @@
-(* Copyright (C) 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008
- Free Software Foundation, Inc. *)
-(* This file is part of GNU Modula-2.
+(* StrLib.mod provides string manipulation procedures.
-This library is free software; you can redistribute it and/or
-modify it under the terms of the GNU Lesser General Public
-License as published by the Free Software Foundation; either
-version 2.1 of the License, or (at your option) any later version.
+Copyright (C) 2001-2023 Free Software Foundation, Inc.
+Contributed by Gaius Mulley <gaius.mulley@southwales.ac.uk>.
-This library is distributed in the hope that it will be useful,
-but WITHOUT ANY WARRANTY; without even the implied warranty of
+This file is part of GNU Modula-2.
+
+GNU Modula-2 is free software; you can redistribute it and/or modify
+it under the terms of the GNU General Public License as published by
+the Free Software Foundation; either version 3, or (at your option)
+any later version.
+
+GNU Modula-2 is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
-Lesser General Public License for more details.
+General Public License for more details.
+
+Under Section 7 of GPL version 3, you are granted additional
+permissions described in the GCC Runtime Library Exception, version
+3.1, as published by the Free Software Foundation.
-You should have received a copy of the GNU Lesser General Public
-License along with this library; if not, write to the Free Software
-Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA *)
+You should have received a copy of the GNU General Public License and
+a copy of the GCC Runtime Library Exception along with this program;
+see the files COPYING3 and COPYING.RUNTIME respectively. If not, see
+<http://www.gnu.org/licenses/>. *)
IMPLEMENTATION MODULE StrLib ;
FROM ASCII IMPORT nul, tab ;
-(* %%%FORWARD%%%
-PROCEDURE StrEqual (a, b: ARRAY OF CHAR) : BOOLEAN ; FORWARD ;
-PROCEDURE StrLen (a: ARRAY OF CHAR) : CARDINAL ; FORWARD ;
-PROCEDURE StrCopy (a: ARRAY OF CHAR ; VAR b: ARRAY OF CHAR) ; FORWARD ;
-PROCEDURE StrConCat (a: ARRAY OF CHAR ; b: ARRAY OF CHAR ; VAR c: ARRAY OF CHAR) ; FORWARD ;
-PROCEDURE IsSubString (a, b: ARRAY OF CHAR) : BOOLEAN ; FORWARD ;
- %%%FORWARD%%% *)
-
(*
StrConCat - combines a and b into c.
@@ -88,24 +88,21 @@ END StrLess ;
PROCEDURE StrEqual (a, b: ARRAY OF CHAR) : BOOLEAN ;
VAR
i,
- Higha,
- Highb: CARDINAL ;
- Equal: BOOLEAN ;
+ higha,
+ highb: CARDINAL ;
BEGIN
- Higha := StrLen(a) ;
- Highb := StrLen(b) ;
- IF Higha=Highb
- THEN
- Equal := TRUE ;
- i := 0 ;
- WHILE Equal AND (i<Higha) DO
- Equal := (a[i]=b[i]) ;
- INC(i)
+ higha := HIGH(a) ;
+ highb := HIGH(b) ;
+ i := 0 ;
+ WHILE (i<=higha) AND (i<=highb) AND (a[i]#nul) AND (b[i]#nul) DO
+ IF a[i]#b[i]
+ THEN
+ RETURN( FALSE )
END ;
- RETURN( Equal )
- ELSE
- RETURN( FALSE )
- END
+ INC(i)
+ END ;
+ RETURN NOT (((i<=higha) AND (a[i]#nul)) OR
+ ((i<=highb) AND (b[i]#nul)))
END StrEqual ;
@@ -123,22 +120,28 @@ BEGIN
END StrLen ;
-PROCEDURE StrCopy (a: ARRAY OF CHAR ; VAR b: ARRAY OF CHAR) ;
+(*
+ StrCopy - copy string src into string dest providing dest is large enough.
+ If dest is smaller than a then src then the string is truncated when
+ dest is full. Add a nul character if there is room in dest.
+*)
+
+PROCEDURE StrCopy (src: ARRAY OF CHAR ; VAR dest: ARRAY OF CHAR) ;
VAR
- Higha,
- Highb,
- n : CARDINAL ;
+ HighSrc,
+ HighDest,
+ n : CARDINAL ;
BEGIN
n := 0 ;
- Higha := StrLen(a) ;
- Highb := HIGH(b) ;
- WHILE (n<Higha) AND (n<=Highb) DO
- b[n] := a[n] ;
- INC(n)
+ HighSrc := StrLen (src) ;
+ HighDest := HIGH (dest) ;
+ WHILE (n < HighSrc) AND (n <= HighDest) DO
+ dest[n] := src[n] ;
+ INC (n)
END ;
- IF n<=Highb
+ IF n <= HighDest
THEN
- b[n] := nul
+ dest[n] := nul
END
END StrCopy ;
diff --git a/gcc/testsuite/gm2/pimlib/base/run/pass/pimlib-base-run-pass.exp b/gcc/testsuite/gm2/pimlib/base/run/pass/pimlib-base-run-pass.exp
index d025443f68c..79640c2db4d 100644
--- a/gcc/testsuite/gm2/pimlib/base/run/pass/pimlib-base-run-pass.exp
+++ b/gcc/testsuite/gm2/pimlib/base/run/pass/pimlib-base-run-pass.exp
@@ -27,7 +27,7 @@ load_lib gm2-torture.exp
set gm2src ${srcdir}/../m2
-gm2_init_pim "${srcdir}/gm2/pimlib/base/run/pass"
+gm2_init_pim ""
# We should be able to compile, link or run in 20 seconds.
gm2_push_timeout 20
diff --git a/gcc/testsuite/gm2/projects/pim/run/pass/random/projects-pim-run-pass-random.exp b/gcc/testsuite/gm2/projects/pim/run/pass/random/projects-pim-run-pass-random.exp
index 012caa61c96..8fa3bee8bf7 100644
--- a/gcc/testsuite/gm2/projects/pim/run/pass/random/projects-pim-run-pass-random.exp
+++ b/gcc/testsuite/gm2/projects/pim/run/pass/random/projects-pim-run-pass-random.exp
@@ -25,7 +25,7 @@ if $tracelevel then {
# load support procs
load_lib gm2-torture.exp
-gm2_init_pim "$srcdir/$subdir" -g
+gm2_init_pim "${srcdir}/${subdir}" -g
gm2_link_obj "WriteMap.o AdvMap.o BoxMap.o Chance.o Geometry.o MakeBoxes.o MapOptions.o Options.o RoomMap.o StoreCoords.o"
# If we want these to be re-built for each torture option we need some different
diff --git a/gcc/testsuite/gm2/projects/pim/run/pass/tower/AdvCmd.def b/gcc/testsuite/gm2/projects/pim/run/pass/tower/AdvCmd.def
new file mode 100644
index 00000000000..166824e67e4
--- /dev/null
+++ b/gcc/testsuite/gm2/projects/pim/run/pass/tower/AdvCmd.def
@@ -0,0 +1,10 @@
+DEFINITION MODULE AdvCmd ;
+
+
+EXPORT QUALIFIED ExecuteCommand ;
+
+
+PROCEDURE ExecuteCommand (ch: CHAR ; VAR Dead: BOOLEAN) ;
+
+
+END AdvCmd.
diff --git a/gcc/testsuite/gm2/projects/pim/run/pass/tower/AdvCmd.mod b/gcc/testsuite/gm2/projects/pim/run/pass/tower/AdvCmd.mod
new file mode 100644
index 00000000000..bc9a5bb4b66
--- /dev/null
+++ b/gcc/testsuite/gm2/projects/pim/run/pass/tower/AdvCmd.mod
@@ -0,0 +1,294 @@
+IMPLEMENTATION MODULE AdvCmd ;
+
+
+FROM ASCII IMPORT ff, esc ;
+FROM Storage IMPORT ALLOCATE ;
+
+FROM AdvMap IMPORT IncPosition ;
+FROM DrawG IMPORT DrawMan, EraseMan ;
+FROM AdvTreasure IMPORT GetTreasure, DropTreasure, UseTreasure ;
+FROM ProcArgs IMPORT SetArgs ;
+
+FROM AdvSystem IMPORT ArrowArgs,
+ Player, TypeOfDeath, PlayerNo,
+ GetWriteAccessToPlayer,
+ ReleaseWriteAccessToPlayer,
+ GetReadAccessToPlayer,
+ ReleaseReadAccessToPlayer,
+ GetAccessToScreenNo,
+ ReleaseAccessToScreenNo ;
+
+FROM AdvMath IMPORT UpDateWoundsAndFatigue,
+ StrengthToFireArrow,
+ StrengthToFireMagic ;
+
+FROM AdvUtil IMPORT MoveMan, Exit, InitialDisplay,
+ OpenDoor, CloseDoor, ExamineDoor, HideDoor,
+ Attack, Thrust, Parry,
+ Speak ;
+
+FROM Screen IMPORT Height, Width, WriteTime, ClearScreen, Pause,
+ WriteString,
+ WriteCommentLine1,
+ DelCommentLine1,
+ WriteArrows, WriteMagicArrows ;
+
+
+CONST
+ MaxCard = 65535 ;
+ CtrlL = ff ;
+
+
+(* Adventure Commands! - Interpreted *)
+
+
+PROCEDURE ExecuteCommand (ch: CHAR ; VAR Dead: BOOLEAN) ;
+VAR
+ p: CARDINAL ;
+BEGIN
+ p := PlayerNo() ;
+ WITH Player[p] DO
+ GetWriteAccessToPlayer ;
+ Dead := DeathType#living ;
+ IF Dead
+ THEN
+ RoomOfMan := 0 ;
+ Xman := MaxCard-Width ;
+ Yman := MaxCard-Height ;
+ ReleaseWriteAccessToPlayer
+ ELSE
+ WriteTime (p) ; (* always start by displaying the current time. *)
+
+ ReleaseWriteAccessToPlayer ;
+ GetAccessToScreenNo(p) ;
+ UpDateWoundsAndFatigue(p) ;
+ ReleaseAccessToScreenNo(p) ;
+
+ CASE ch OF
+
+ 'h' : Help |
+ 'v' : ValtTurn |
+ 'r' : RightTurn |
+ 'l' : LeftTurn |
+ '0'..'9' : MoveMan( ORD(ch)-ORD('0') ) |
+ 'f' : FireNormalArrow |
+ 'm' : FireMagicArrow |
+ 'p' : Parry |
+ 't' : Thrust |
+ 'a' : Attack |
+ 'o' : OpenDoor |
+ 'c' : CloseDoor |
+ 'e' : ExamineDoor |
+ 'g' : GetTreasure |
+ 'd' : DropTreasure |
+ 'u' : UseTreasure |
+ 's' : Speak |
+ 'w' : |
+
+ CtrlL: RedrawScreen |
+
+ esc : Exit ;
+ DeathType := exitdungeon
+
+ ELSE
+ END ;
+ GetWriteAccessToPlayer ;
+ Dead := DeathType#living ;
+ IF Dead
+ THEN
+ Xman := MaxCard-Width ;
+ Yman := MaxCard-Height ;
+ RoomOfMan := 0
+ END ;
+ ReleaseWriteAccessToPlayer
+ END
+ END
+END ExecuteCommand ;
+
+
+PROCEDURE Help ;
+VAR
+ p: CARDINAL ;
+BEGIN
+ p := PlayerNo() ;
+ GetAccessToScreenNo(p) ;
+ ClearScreen(p) ;
+ WriteString(p, 'Key commands are:') ;
+ WriteString(p, '') ;
+ WriteString(p, "'1'..'9' move 1..9 squares forward") ;
+ WriteString(p, "'r' turn right") ;
+ WriteString(p, "'l' turn left") ;
+ WriteString(p, "'v' vault turn") ;
+ WriteString(p, "'f' fire normal arrow") ;
+ WriteString(p, "'m' fire magic arrow") ;
+ WriteString(p, "'o' open door in front of you") ;
+ WriteString(p, "'c' close door in front of you") ;
+ WriteString(p, "'e' examine wall for secret door in front of you") ;
+ WriteString(p, "'p' parry with sword") ;
+ WriteString(p, "'a' attack with sword") ;
+ WriteString(p, "'t' thrust with sword") ;
+ WriteString(p, "'g' get treasure in front of you") ;
+ WriteString(p, "'d' <no> drop treasure in front of you") ;
+ WriteString(p, "'u' <no> use treasure") ;
+ ReleaseAccessToScreenNo(p) ;
+ Pause(p) ;
+ RedrawScreen
+END Help ;
+
+
+PROCEDURE ValtTurn ;
+VAR
+ p: CARDINAL ;
+BEGIN
+ p := PlayerNo() ;
+ GetWriteAccessToPlayer ;
+ EraseMan(p) ;
+ WITH Player[p] DO
+ Direction := (Direction+2) MOD 4 ;
+ END ;
+ DrawMan( p ) ;
+ ReleaseWriteAccessToPlayer
+END ValtTurn ;
+
+
+PROCEDURE RightTurn ;
+VAR
+ p: CARDINAL ;
+BEGIN
+ p := PlayerNo() ;
+ GetWriteAccessToPlayer ;
+ EraseMan(p) ;
+ WITH Player[p] DO
+ Direction := (Direction+3) MOD 4 ;
+ END ;
+ DrawMan(p) ;
+ ReleaseWriteAccessToPlayer
+END RightTurn ;
+
+
+PROCEDURE LeftTurn ;
+VAR
+ p: CARDINAL ;
+BEGIN
+ p := PlayerNo() ;
+ GetWriteAccessToPlayer ;
+ EraseMan(p) ;
+ WITH Player[p] DO
+ Direction := (Direction+1) MOD 4 ;
+ END ;
+ DrawMan( p ) ;
+ ReleaseWriteAccessToPlayer
+END LeftTurn ;
+
+
+PROCEDURE SendFireToProcess (p, r, x, y, d: CARDINAL; magic: BOOLEAN) ;
+VAR
+ aa: ArrowArgs ;
+BEGIN
+ NEW(aa) ;
+ WITH aa^ DO
+ ArrowPlayer := p ;
+ ArrowRoom := r ;
+ ArrowX := x ;
+ ArrowY := y ;
+ ArrowDir := d ;
+ IsMagic := FALSE
+ END ;
+ WITH Player[p] DO
+ IF magic
+ THEN
+ aa := SetArgs(MagicProcArgs, aa)
+ ELSE
+ aa := SetArgs(NormalProcArgs, aa)
+ END
+ END
+END SendFireToProcess ;
+
+
+PROCEDURE FireMagicArrow ;
+VAR
+ r,
+ x, y, p,
+ Dir : CARDINAL ;
+ yes : BOOLEAN ;
+BEGIN
+ p := PlayerNo() ;
+ WITH Player[p] DO
+ GetWriteAccessToPlayer ;
+ StrengthToFireMagic(yes) ;
+ IF yes
+ THEN
+ IF NoOfMagic>0
+ THEN
+ DEC(NoOfMagic) ;
+ Dir := Direction ;
+ x := Xman ;
+ y := Yman ;
+ r := RoomOfMan ;
+ ReleaseWriteAccessToPlayer ;
+ IncPosition(x, y, Dir) ;
+ SendFireToProcess(p, r, x, y, Dir, TRUE) ;
+ GetAccessToScreenNo(p) ;
+ WriteMagicArrows(p, NoOfMagic) ;
+ ReleaseAccessToScreenNo(p)
+ ELSE
+ ReleaseWriteAccessToPlayer ;
+ GetAccessToScreenNo(p) ;
+ DelCommentLine1(p) ;
+ WriteCommentLine1(p, 'None left') ;
+ ReleaseAccessToScreenNo(p)
+ END
+ ELSE
+ ReleaseWriteAccessToPlayer
+ END
+ END
+END FireMagicArrow ;
+
+
+PROCEDURE FireNormalArrow ;
+VAR
+ r,
+ x, y, p,
+ Dir : CARDINAL ;
+ yes : BOOLEAN ;
+BEGIN
+ p := PlayerNo() ;
+ WITH Player[p] DO
+ GetWriteAccessToPlayer ;
+ StrengthToFireArrow(yes) ;
+ IF yes
+ THEN
+ IF NoOfNormal>0
+ THEN
+ DEC(NoOfNormal) ;
+ Dir := Direction ;
+ x := Xman ;
+ y := Yman ;
+ r := RoomOfMan ;
+ ReleaseWriteAccessToPlayer ;
+ IncPosition(x, y, Dir) ;
+ SendFireToProcess(p, r, x, y, Dir, FALSE) ;
+ GetAccessToScreenNo(p) ;
+ DelCommentLine1(p) ;
+ WriteArrows(p, NoOfNormal) ;
+ ReleaseAccessToScreenNo(p)
+ ELSE
+ ReleaseWriteAccessToPlayer ;
+ GetAccessToScreenNo(p) ;
+ WriteCommentLine1(p, 'None left') ;
+ ReleaseAccessToScreenNo(p)
+ END
+ ELSE
+ ReleaseWriteAccessToPlayer
+ END
+ END
+END FireNormalArrow ;
+
+
+PROCEDURE RedrawScreen ;
+BEGIN
+ InitialDisplay
+END RedrawScreen ;
+
+
+END AdvCmd.
diff --git a/gcc/testsuite/gm2/projects/pim/run/pass/tower/AdvIntroduction.def b/gcc/testsuite/gm2/projects/pim/run/pass/tower/AdvIntroduction.def
new file mode 100644
index 00000000000..834ebac49ea
--- /dev/null
+++ b/gcc/testsuite/gm2/projects/pim/run/pass/tower/AdvIntroduction.def
@@ -0,0 +1,7 @@
+DEFINITION MODULE AdvIntroduction ;
+
+EXPORT QUALIFIED StartGame ;
+
+PROCEDURE StartGame ;
+
+END AdvIntroduction.
diff --git a/gcc/testsuite/gm2/projects/pim/run/pass/tower/AdvIntroduction.mod b/gcc/testsuite/gm2/projects/pim/run/pass/tower/AdvIntroduction.mod
new file mode 100644
index 00000000000..31747642874
--- /dev/null
+++ b/gcc/testsuite/gm2/projects/pim/run/pass/tower/AdvIntroduction.mod
@@ -0,0 +1,275 @@
+(* Copyright (C) 2003
+ Free Software Foundation, Inc. *)
+(* This file is part of GNU Modula-2.
+
+GNU Modula-2 is free software; you can redistribute it and/or modify it under
+the terms of the GNU General Public License as published by the Free
+Software Foundation; either version 2, or (at your option) any later
+version.
+
+GNU Modula-2 is distributed in the hope that it will be useful, but WITHOUT ANY
+WARRANTY; without even the implied warranty of MERCHANTABILITY or
+FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
+for more details.
+
+You should have received a copy of the GNU General Public License along
+with gm2; see the file COPYING. If not, write to the Free Software
+Foundation, 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. *)
+
+IMPLEMENTATION MODULE AdvIntroduction ;
+
+FROM SYSTEM IMPORT ADR, SIZE ;
+FROM ASCII IMPORT lf, cr, nul ;
+FROM StrLib IMPORT StrLen ;
+FROM SocketControl IMPORT nonBlocking, ignoreSignals ;
+
+FROM Executive IMPORT WaitForIO, InitProcess, InitSemaphore, Wait, Signal, Resume,
+ Suspend, DESCRIPTOR, SEMAPHORE, KillProcess ;
+
+FROM RTint IMPORT InitInputVector ;
+FROM COROUTINES IMPORT PROTECTION ;
+FROM sckt IMPORT tcpServerState, tcpServerEstablish, tcpServerAccept, tcpServerSocketFd ;
+FROM libc IMPORT printf, read, write ;
+FROM AdvUtil IMPORT Positioning, TestIfLastLivePlayer ;
+
+FROM AdvSystem IMPORT Player, TypeOfDeath, StartPlayer, PlayerNo,
+ ClientRead, DefaultWrite, UnAssign,
+ ReadString, GetReadAccessToPlayer,
+ ReleaseReadAccessToPlayer,
+ GetAccessToScreen, ReleaseAccessToScreen ;
+
+FROM AdvTreasure IMPORT DisplayEnemy, Grenade ;
+FROM AdvUtil IMPORT InitialDisplay ;
+FROM AdvCmd IMPORT ExecuteCommand ;
+FROM Screen IMPORT WriteCommand, ClearScreen, WriteString, PromptString, Pause, Quit ;
+FROM AdvSound IMPORT EnterGame ;
+FROM StdIO IMPORT PushOutput ;
+
+
+CONST
+ Meg = 1024*1024 ;
+ StackSize = 30 * Meg ;
+
+VAR
+ ToBeTaken: SEMAPHORE ;
+ NextFd : INTEGER ;
+
+
+PROCEDURE theServer ;
+VAR
+ fd: INTEGER ;
+ v : CARDINAL ;
+ ch: CHAR ;
+ r : INTEGER ;
+BEGIN
+ fd := NextFd ;
+ Signal(ToBeTaken) ;
+ v := InitInputVector(fd, MAX(PROTECTION)) ;
+ r := printf("inside `theServer' using fd=%d\n", fd);
+ StartPlayer(fd) ;
+ Copyleft ;
+ Title ;
+ Knight ;
+ WITH Player[PlayerNo()] DO
+ fd := -1 ;
+ PlayerProcess := NIL ;
+ END ;
+ UnAssign ;
+ KillProcess
+END theServer ;
+
+
+PROCEDURE StartGame ;
+VAR
+ r : INTEGER ;
+ v : CARDINAL ;
+ fd : INTEGER ;
+ s : tcpServerState ;
+ g, p: DESCRIPTOR ;
+BEGIN
+ ignoreSignals ;
+ PushOutput(DefaultWrite) ;
+ g := Resume(InitProcess(Grenade, StackSize, 'grenade')) ;
+ s := tcpServerEstablish() ;
+ ToBeTaken := InitSemaphore(1, 'ToBeTaken') ;
+ v := InitInputVector(tcpServerSocketFd(s), MAX(PROTECTION)) ;
+ LOOP
+ r := printf("before WaitForIO\n");
+ WaitForIO(v) ;
+ fd := tcpServerAccept(s) ;
+ r := nonBlocking(fd) ;
+ r := printf("before InitProcess\n");
+ p := InitProcess(theServer, StackSize, 'theServer') ;
+ NextFd := fd ;
+ r := printf("before Resume\n");
+ p := Resume(p) ;
+ Wait(ToBeTaken)
+ END
+END StartGame ;
+
+
+PROCEDURE Knight ;
+VAR
+ Dead: BOOLEAN ;
+ ch : CHAR ;
+ p : CARDINAL ;
+BEGIN
+ EquipKnight ;
+ SetUpKnight ;
+ InitialDisplay ;
+ p := PlayerNo() ;
+ EnterGame(p) ;
+ Dead := FALSE ;
+ REPEAT
+ IF ClientRead(ch)
+ THEN
+ WriteCommand(p, ch) ;
+ ExecuteCommand(ch, Dead)
+ ELSE
+ Dead := TRUE
+ END
+ UNTIL Dead ;
+ GiveResults
+END Knight ;
+
+
+PROCEDURE Copyleft ;
+VAR
+ p: CARDINAL ;
+BEGIN
+ p := PlayerNo() ;
+ ClearScreen(p) ;
+ WriteString(p, 'Written whilst on holiday during the rainy months of\n') ;
+ WriteString(p, 'August 85, August 86 and ported to GNU/linux during July/August 2005\n\n') ;
+ WriteString(p, '\n') ;
+ WriteString(p, 'A multiplayer game inspired by two single player Commodore PET\n') ;
+ WriteString(p, 'game of circa 1979 (Morloc Tower and Temple of Apshai)\n') ;
+ WriteString(p, '\n') ;
+ WriteString(p, 'This game is rather different (similar key commands) and\n') ;
+ WriteString(p, 'in retrospect a very very poor persons multiplayer doom!\n') ;
+ Pause(p)
+END Copyleft ;
+
+
+PROCEDURE Title ;
+VAR
+ p: CARDINAL ;
+BEGIN
+ p := PlayerNo() ;
+ ClearScreen(p) ;
+ WriteString(p, '...set in a time of long ago, when life hast no value and\n') ;
+ WriteString(p, ' death sometimes, hadst a price. Thou needst to be quick\n') ;
+ WriteString(p, ' with thy sword and fast with thy bow, for only the best\n') ;
+ WriteString(p, ' survived...\n\n\n')
+END Title ;
+
+
+PROCEDURE EquipKnight ;
+VAR
+ p: CARDINAL ;
+BEGIN
+ p := PlayerNo() ;
+ PromptString(p, 'What is thy name? ') ;
+ WITH Player[PlayerNo()] DO
+ ReadString(ManName)
+ END ;
+ WriteString(p, '\n')
+END EquipKnight ;
+
+
+PROCEDURE SetUpKnight ;
+BEGIN
+ WITH Player[PlayerNo()] DO
+ NoOfMagic := 1 ;
+ NoOfNormal := 7
+ END ;
+ Positioning
+END SetUpKnight ;
+
+
+PROCEDURE GiveResults ;
+VAR
+ yes: BOOLEAN ;
+ p : CARDINAL ;
+BEGIN
+ p := PlayerNo() ;
+ Pause(p) ;
+ GetReadAccessToPlayer ;
+ GetAccessToScreen ;
+ ClearScreen(p) ;
+ WITH Player[p] DO
+ IF Wounds=0
+ THEN
+ WriteString(p, 'Thou art slain...') ;
+ GiveDescriptionOfDeath(p, DeathType)
+ ELSE
+ TestIfLastLivePlayer(yes) ;
+ IF yes
+ THEN
+ WriteString(p, 'Thou art the conqueror of the dungeon')
+ ELSE
+ WriteString(p, 'Thou art the coward of the dungeon')
+ END ;
+ Wounds := 0
+ END ;
+ WriteString(p, '\n\n\n')
+ END ;
+ ReleaseAccessToScreen ;
+ ReleaseReadAccessToPlayer ;
+ Pause(p) ;
+ Quit(p)
+END GiveResults ;
+
+
+PROCEDURE GiveDescriptionOfDeath (p: CARDINAL; Dt: TypeOfDeath) ;
+BEGIN
+ WriteString(p, '\n\n\n\nThou expired from life after :\n\n') ;
+ CASE Dt OF
+
+ sword : WriteString(p, 'being slain with a sword') |
+ magicarrow : WriteString(p, 'being pierced by a magic arrow') |
+ fireball : WriteString(p, 'thou wast struck by a fireball burning thy body fatally') |
+ normalarrow : WriteString(p, 'thou wast struck a deadly blow caused by an arrow') |
+ explosion : WriteString(p, 'having thy guts blown all over the dungeon') |
+ exitdungeon : WriteString(p, 'thou crawlest out of the dungeon and expired')
+
+ END
+END GiveDescriptionOfDeath ;
+
+
+(* Monitor allows a dead player to look around the dungeon unaffecting *)
+(* the current game. *)
+
+PROCEDURE Monitor ;
+VAR
+ p : CARDINAL ;
+ ch: CHAR ;
+BEGIN
+ p := PlayerNo() ;
+ REPEAT
+ ClearScreen(p) ;
+ WriteString(p, 'Monitor --- Look at other players\n\n\n\n') ;
+ WriteString(p, 'Commands:\n') ;
+ WriteString(p, '1) Look at other players\n') ;
+ WriteString(p, '2) Exit\n\n') ;
+ WriteString(p, 'Option:') ;
+ IF ClientRead(ch)
+ THEN
+ DefaultWrite(ch) ;
+ IF ch='1'
+ THEN
+ DisplayEnemy
+ END
+ ELSE
+ RETURN
+ END
+ UNTIL ch='2'
+END Monitor ;
+
+
+END AdvIntroduction.
+(*
+ * Local variables:
+ * compile-command: "make"
+ * End:
+ *)
diff --git a/gcc/testsuite/gm2/projects/pim/run/pass/tower/AdvMap.def b/gcc/testsuite/gm2/projects/pim/run/pass/tower/AdvMap.def
new file mode 100644
index 00000000000..57b079abdd2
--- /dev/null
+++ b/gcc/testsuite/gm2/projects/pim/run/pass/tower/AdvMap.def
@@ -0,0 +1,82 @@
+DEFINITION MODULE AdvMap ;
+
+FROM AdvMath IMPORT MaxNoOfTreasures ;
+
+EXPORT QUALIFIED Rooms, Line, DoorStatus, Door, Room, Treasure,
+ ActualNoOfRooms, MaxNoOfRooms,
+ WallsPerRoom, DoorsPerRoom,
+ NoOfRoomsToHidePlayers, NoOfRoomsToSpring,
+ NoOfRoomsToHideCoal, NoOfRoomsToHideGrenade,
+ TreasureKind,
+ Adjacent, IncPosition,
+ FileName, MaxLengthOfFileName ;
+
+
+CONST
+ MaxNoOfRooms = 350 ; (* An upper limit *)
+ WallsPerRoom = 12 ; (* An upper limit *)
+ DoorsPerRoom = 8 ; (* An upper limit *)
+
+ MaxLengthOfFileName = 11 ;
+ NoOfRoomsToHidePlayers = 50 ;
+ NoOfRoomsToSpring = 50 ;
+ NoOfRoomsToHideCoal = 50 ;
+ NoOfRoomsToHideGrenade = 50 ;
+
+
+TYPE
+ Line = RECORD
+ X1 : CARDINAL ;
+ Y1 : CARDINAL ;
+ X2 : CARDINAL ;
+ Y2 : CARDINAL
+ END ;
+
+ DoorStatus = (Open, Closed, Secret) ;
+
+ Door = RECORD
+ Position : Line ;
+ StateOfDoor : DoorStatus ;
+ LeadsTo : CARDINAL
+ END ;
+
+ TreasureKind = (unused, respawnnormal, respawnmagic,
+ onperson, onfloor, normal, magic) ;
+
+ TreasureInfo = RECORD
+ Xpos : CARDINAL ;
+ Ypos : CARDINAL ;
+ Rm : CARDINAL ;
+ Tweight : CARDINAL ;
+ TreasureName : ARRAY [0..12] OF CHAR ;
+ kind : TreasureKind ;
+ amount : CARDINAL ; (* number of arrows. *)
+ END ;
+
+ Room = RECORD
+ NoOfWalls : CARDINAL ;
+ NoOfDoors : CARDINAL ;
+ Walls : ARRAY [1..WallsPerRoom] OF Line ;
+ Doors : ARRAY [1..DoorsPerRoom] OF Door ;
+ Treasures : BITSET ;
+ END ;
+
+
+VAR
+ ActualNoOfRooms : CARDINAL ;
+ Treasure : ARRAY [1..MaxNoOfTreasures] OF TreasureInfo ;
+ Rooms : ARRAY [1..MaxNoOfRooms] OF Room ;
+ FileName : ARRAY [0..MaxLengthOfFileName] OF CHAR ;
+
+
+(* Tests to see if two rooms are Adjacent to each other. *)
+
+PROCEDURE Adjacent (R1, R2: CARDINAL) : BOOLEAN ;
+
+
+(* Increments the position of x, y by the direction that are facing *)
+
+PROCEDURE IncPosition (VAR x, y: CARDINAL ; Dir: CARDINAL) ;
+
+
+END AdvMap.
diff --git a/gcc/testsuite/gm2/projects/pim/run/pass/tower/AdvMap.mod b/gcc/testsuite/gm2/projects/pim/run/pass/tower/AdvMap.mod
new file mode 100644
index 00000000000..73336fe3945
--- /dev/null
+++ b/gcc/testsuite/gm2/projects/pim/run/pass/tower/AdvMap.mod
@@ -0,0 +1,57 @@
+IMPLEMENTATION MODULE AdvMap ;
+
+
+(* IncPosition increments the x,y coordinates according *)
+(* the Direction sent. *)
+
+PROCEDURE IncPosition (VAR x, y: CARDINAL ; Dir: CARDINAL) ;
+BEGIN
+ IF (Dir=0) AND (y>0)
+ THEN
+ DEC(y)
+ ELSIF Dir=3
+ THEN
+ INC(x)
+ ELSIF Dir=2
+ THEN
+ INC(y)
+ ELSIF x>0
+ THEN
+ DEC(x)
+ END
+END IncPosition ;
+
+
+
+(* Adjacent tests whether two rooms R1 & R2 are adjacent *)
+(* Assume that access to map has been granted. *)
+
+PROCEDURE Adjacent (R1, R2: CARDINAL) : BOOLEAN ;
+VAR
+ i, r1, r2 : CARDINAL ;
+ ok: BOOLEAN ;
+BEGIN
+ WITH Rooms[R1] DO
+ i := NoOfDoors ;
+ ok := FALSE ;
+ WHILE (i>0) AND (NOT ok) DO
+ IF Doors[i].LeadsTo=R2
+ THEN
+ ok := TRUE
+ ELSE
+ DEC (i)
+ END
+ END
+ END ;
+ RETURN ok
+END Adjacent ;
+
+
+BEGIN
+ ActualNoOfRooms := 0
+END AdvMap.
+(*
+ * Local variables:
+ * compile-command: "make"
+ * End:
+ *)
diff --git a/gcc/testsuite/gm2/projects/pim/run/pass/tower/AdvMath.def b/gcc/testsuite/gm2/projects/pim/run/pass/tower/AdvMath.def
new file mode 100644
index 00000000000..c6ec3e209d3
--- /dev/null
+++ b/gcc/testsuite/gm2/projects/pim/run/pass/tower/AdvMath.def
@@ -0,0 +1,120 @@
+DEFINITION MODULE AdvMath ;
+
+EXPORT QUALIFIED RequiredToParry,
+ RequiredToAttack,
+ RequiredToThrust,
+ RequiredToFireArrow,
+ RequiredToFireMagic,
+ RequiredToMove,
+ RequiredToMagicShoes,
+ RequiredToMagicParry,
+ RequiredToMagicAttack,
+ RequiredToMagicThrust,
+
+ DammageByParry,
+ DammageByAttack,
+ DammageByThrust,
+ DammageByFireArrow,
+ DammageByFireMagic,
+ DammageByHandGrenade,
+ DammageByHotIron,
+ DammageByMagicParry,
+ DammageByMagicAttack,
+ DammageByMagicThrust,
+
+ MagicKey,
+ CrystalBall,
+ MagicSpring,
+ SackOfCoal1,
+ SackOfCoal2,
+ HotIron,
+ HandGrenade,
+ MagicSword,
+ MagicShoes,
+ SleepPotion,
+ LumpOfIron,
+ TreasTrove,
+ SpeedPotion,
+ MagicShield,
+ VisionChest,
+ QuiverNormal,
+ QuiverMagic,
+ HealingPotion,
+ LowFreePool,
+ HighFreePool,
+ MaxNoOfTreasures,
+
+ UpDateWoundsAndFatigue,
+ StrengthToParry,
+ StrengthToAttack,
+ StrengthToThrust,
+ StrengthToFireArrow,
+ StrengthToFireMagic,
+ StrengthToMove ;
+
+
+CONST
+ RequiredToParry = 3 ;
+ RequiredToAttack = 5 ;
+ RequiredToThrust = 9 ;
+ RequiredToFireArrow = 10 ;
+ RequiredToFireMagic = 15 ;
+ RequiredToMove = 6 ; (* For 9 squares *)
+ RequiredToMagicShoes = 3 ; (* For 9 squares *)
+ RequiredToMagicParry = 1 ;
+ RequiredToMagicAttack = 3 ;
+ RequiredToMagicThrust = 6 ;
+
+ DammageByParry = 7 ;
+ DammageByAttack = 13 ;
+ DammageByThrust = 17 ;
+ DammageByFireArrow = 23 ;
+ DammageByFireMagic = 74 ;
+ DammageByHandGrenade = 69 ;
+ DammageByHotIron = 19 ;
+ DammageByMagicParry = 8 ;
+ DammageByMagicAttack = 14 ;
+ DammageByMagicThrust = 18 ;
+
+ MagicKey = 1 ; (* Treasure Numbers *)
+ CrystalBall = 2 ;
+ MagicSpring = 3 ;
+ SackOfCoal1 = 4 ;
+ SackOfCoal2 = 5 ;
+ HotIron = 6 ;
+ HandGrenade = 7 ;
+ MagicSword = 8 ;
+ MagicShoes = 9 ;
+ SleepPotion = 10 ;
+ LumpOfIron = 11 ;
+ TreasTrove = 12 ;
+ SpeedPotion = 13 ;
+ MagicShield = 14 ;
+ VisionChest = 15 ;
+ QuiverNormal = 16 ;
+ QuiverMagic = 17 ;
+ HealingPotion = 18 ;
+
+ MaxNoOfTreasures = 31 ; (* An upper limit *)
+ HighFreePool = MaxNoOfTreasures ;
+ LowFreePool = 19 ; (* start of dynamic treasures. (see AdvMath.def for static list). *)
+
+TYPE
+ FreePool = [LowFreePool..HighFreePool] ;
+
+PROCEDURE UpDateWoundsAndFatigue (p: CARDINAL) ;
+
+PROCEDURE StrengthToParry (VAR ok: BOOLEAN) ;
+
+PROCEDURE StrengthToAttack (VAR ok: BOOLEAN) ;
+
+PROCEDURE StrengthToThrust (VAR ok: BOOLEAN) ;
+
+PROCEDURE StrengthToFireArrow (VAR ok: BOOLEAN) ;
+
+PROCEDURE StrengthToFireMagic (VAR ok: BOOLEAN) ;
+
+PROCEDURE StrengthToMove (n: CARDINAL ; VAR ok: BOOLEAN) ;
+
+
+END AdvMath.
diff --git a/gcc/testsuite/gm2/projects/pim/run/pass/tower/AdvMath.mod b/gcc/testsuite/gm2/projects/pim/run/pass/tower/AdvMath.mod
new file mode 100644
index 00000000000..d620665fa30
--- /dev/null
+++ b/gcc/testsuite/gm2/projects/pim/run/pass/tower/AdvMath.mod
@@ -0,0 +1,220 @@
+IMPLEMENTATION MODULE AdvMath ;
+
+
+FROM TimerHandler IMPORT TicksPerSecond, GetTicks ;
+
+FROM AdvSystem IMPORT Player, ManWeight,
+ PlayerNo,
+ TimeMinSec,
+ GetAccessToScreenNo, ReleaseAccessToScreenNo ;
+
+FROM Screen IMPORT WriteWounds, WriteFatigue, WriteCommentLine1 ;
+
+
+(* No access lock on anything ! *)
+
+PROCEDURE UpDateWoundsAndFatigue (p: CARDINAL) ;
+VAR
+ HalfSecs,
+ sec, tsec: CARDINAL ;
+BEGIN
+ TimeMinSec(sec) ;
+ HalfSecs := GetTicks() DIV (TicksPerSecond DIV 2) ; (* we want half seconds *)
+ WITH Player[p] DO
+ IF HalfSecs>LastSecFatigue
+ THEN
+ tsec := HalfSecs-LastSecFatigue ;
+ IF Fatigue<100
+ THEN
+ Fatigue := Fatigue+tsec ;
+ IF Fatigue>100
+ THEN
+ Fatigue := 100
+ END ;
+ WriteFatigue(p, Fatigue)
+ END ;
+ LastSecFatigue := HalfSecs
+ END ;
+ IF sec>LastSecWounds
+ THEN
+ tsec := sec-LastSecWounds ;
+ IF tsec>5
+ THEN
+ LastSecWounds := sec
+ END ;
+ IF Wounds<100
+ THEN
+ Wounds := Wounds+(tsec DIV 6) ;
+ IF Wounds>100
+ THEN
+ Wounds := 100
+ END ;
+ WriteWounds(p, Wounds)
+ END ;
+ LastSecWounds := sec
+ END
+ END
+END UpDateWoundsAndFatigue ;
+
+
+(* The following routines do use AccessToScreen when needed *)
+
+PROCEDURE StrengthToParry (VAR ok: BOOLEAN) ;
+VAR
+ p, t : CARDINAL ;
+BEGIN
+ p := PlayerNo() ;
+ WITH Player[p] DO
+ IF MagicSword IN TreasureOwn (* Magic Sword *)
+ THEN
+ t := (Weight * RequiredToMagicParry) DIV ManWeight
+ ELSE
+ t := (Weight * RequiredToParry) DIV ManWeight
+ END ;
+ GetAccessToScreenNo( p ) ;
+ IF t>Fatigue
+ THEN
+ WriteCommentLine1(p, 'too tired') ;
+ ok := FALSE
+ ELSE
+ DEC( Fatigue, t ) ;
+ WriteFatigue(p, Fatigue) ;
+ ok := TRUE
+ END ;
+ ReleaseAccessToScreenNo( p )
+ END
+END StrengthToParry ;
+
+
+PROCEDURE StrengthToAttack (VAR ok: BOOLEAN) ;
+VAR
+ p, t : CARDINAL ;
+BEGIN
+ p := PlayerNo() ;
+ WITH Player[p] DO
+ IF MagicSword IN TreasureOwn (* Magic Sword *)
+ THEN
+ t := (Weight * RequiredToMagicAttack) DIV ManWeight
+ ELSE
+ t := (Weight * RequiredToAttack) DIV ManWeight
+ END ;
+ GetAccessToScreenNo( p ) ;
+ IF t>Fatigue
+ THEN
+ WriteCommentLine1(p, 'too tired') ;
+ ok := FALSE
+ ELSE
+ DEC( Fatigue, t ) ;
+ WriteFatigue(p, Fatigue) ;
+ ok := TRUE
+ END ;
+ ReleaseAccessToScreenNo( p )
+ END
+END StrengthToAttack ;
+
+
+
+PROCEDURE StrengthToThrust (VAR ok: BOOLEAN) ;
+VAR
+ p, t : CARDINAL ;
+BEGIN
+ p := PlayerNo() ;
+ WITH Player[p] DO
+ IF MagicSword IN TreasureOwn (* Magic Sword *)
+ THEN
+ t := (Weight * RequiredToMagicThrust) DIV ManWeight
+ ELSE
+ t := (Weight * RequiredToThrust) DIV ManWeight
+ END ;
+ GetAccessToScreenNo( p ) ;
+ IF t>Fatigue
+ THEN
+ WriteCommentLine1(p, 'too tired') ;
+ ok := FALSE
+ ELSE
+ DEC( Fatigue, t ) ;
+ WriteFatigue(p, Fatigue) ;
+ ok := TRUE
+ END ;
+ ReleaseAccessToScreenNo( p )
+ END
+END StrengthToThrust ;
+
+
+PROCEDURE StrengthToFireArrow (VAR ok: BOOLEAN) ;
+VAR
+ p, t : CARDINAL ;
+BEGIN
+ p := PlayerNo() ;
+ WITH Player[p] DO
+ t := (Weight * RequiredToFireArrow) DIV ManWeight ;
+ GetAccessToScreenNo( p ) ;
+ IF t>Fatigue
+ THEN
+ WriteCommentLine1(p, 'too tired') ;
+ ok := FALSE
+ ELSE
+ DEC( Fatigue, t ) ;
+ WriteFatigue(p, Fatigue) ;
+ ok := TRUE
+ END ;
+ ReleaseAccessToScreenNo( p )
+ END
+END StrengthToFireArrow ;
+
+
+PROCEDURE StrengthToFireMagic (VAR ok: BOOLEAN) ;
+VAR
+ p, t : CARDINAL ;
+BEGIN
+ p := PlayerNo() ;
+ WITH Player[p] DO
+ t := (Weight * RequiredToFireMagic) DIV ManWeight ;
+ GetAccessToScreenNo( p ) ;
+ IF t>Fatigue
+ THEN
+ WriteCommentLine1(p, 'too tired') ;
+ ok := FALSE
+ ELSE
+ DEC( Fatigue, t ) ;
+ WriteFatigue(p, Fatigue) ;
+ ok := TRUE
+ END ;
+ ReleaseAccessToScreenNo( p )
+ END
+END StrengthToFireMagic ;
+
+
+PROCEDURE StrengthToMove (n: CARDINAL ; VAR ok: BOOLEAN) ;
+VAR
+ p, t : CARDINAL ;
+BEGIN
+ p := PlayerNo() ;
+ WITH Player[p] DO
+ IF MagicShoes IN TreasureOwn (* Magic Shoes *)
+ THEN
+ t := (((Weight * RequiredToMagicShoes) DIV 9) * n) DIV ManWeight
+ ELSE
+ t := (((Weight * RequiredToMove) DIV 9) * n) DIV ManWeight
+ END ;
+ GetAccessToScreenNo( p ) ;
+ IF t>Fatigue
+ THEN
+ WriteCommentLine1(p, 'too tired') ;
+ ok := FALSE
+ ELSE
+ DEC( Fatigue, t ) ;
+ WriteFatigue(p, Fatigue) ;
+ ok := TRUE
+ END ;
+ ReleaseAccessToScreenNo( p )
+ END
+END StrengthToMove ;
+
+
+END AdvMath.
+(*
+ * Local variables:
+ * compile-command: "make"
+ * End:
+ *)
diff --git a/gcc/testsuite/gm2/projects/pim/run/pass/tower/AdvParse.bnf b/gcc/testsuite/gm2/projects/pim/run/pass/tower/AdvParse.bnf
new file mode 100644
index 00000000000..07802d0a23d
--- /dev/null
+++ b/gcc/testsuite/gm2/projects/pim/run/pass/tower/AdvParse.bnf
@@ -0,0 +1,379 @@
+% module AdvParse begin
+IMPLEMENTATION MODULE AdvParse ;
+
+(*
+ Author : Gaius Mulley
+ Title : AdvParse
+ Date : 16/7/2005
+ SYSTEM : GNU Modula-2
+ Description: parses maps.
+*)
+
+FROM libc IMPORT printf ;
+FROM SYSTEM IMPORT ADDRESS ;
+FROM DynamicStrings IMPORT String, string, InitStringCharStar, KillString,
+ InitString, ConCat, ConCatChar, Mark ;
+FROM StringConvert IMPORT stoi ;
+FROM advflex IMPORT toktype, OpenSource, CloseSource, error, GetToken,
+ currenttoken, currentinteger ;
+FROM AdvMap IMPORT Rooms, Line, DoorStatus, Door, Room, Treasure,
+ ActualNoOfRooms, MaxNoOfTreasures, MaxNoOfRooms,
+ WallsPerRoom, DoorsPerRoom, TreasureKind ;
+FROM AdvUtil IMPORT HideTreasure ;
+
+
+CONST
+ Debugging = TRUE ;
+
+TYPE
+ BITSET = SET OF toktype ;
+
+VAR
+ LastInt,
+ ExitValue : INTEGER ;
+
+ CurDoor,
+ CurWall,
+ CurRoom : CARDINAL ;
+
+
+(*
+ Min -
+*)
+
+PROCEDURE Min (a, b: INTEGER) : INTEGER ;
+BEGIN
+ IF a<b
+ THEN
+ RETURN( a )
+ ELSE
+ RETURN( b )
+ END
+END Min ;
+
+
+(*
+ Max -
+*)
+
+PROCEDURE Max (a, b: INTEGER) : INTEGER ;
+BEGIN
+ IF a>b
+ THEN
+ RETURN( a )
+ ELSE
+ RETURN( b )
+ END
+END Max ;
+
+
+(*
+ OpenFile - attempts to open a file, mapfile.
+*)
+
+PROCEDURE OpenFile (mapfile: ADDRESS) : INTEGER ;
+VAR
+ r: INTEGER ;
+BEGIN
+ ExitValue := 0 ;
+ IF OpenSource(mapfile)
+ THEN
+ RETURN( 0 )
+ ELSE
+ r := printf("cannot open file: %s\n", mapfile) ;
+ RETURN( 1 )
+ END ;
+END OpenFile ;
+
+
+(*
+ CloseFile -
+*)
+
+PROCEDURE CloseFile ;
+BEGIN
+ CloseSource
+END CloseFile ;
+
+% declaration AdvParse begin
+
+
+(*
+ ErrorArray -
+*)
+
+PROCEDURE ErrorArray (a: ARRAY OF CHAR) ;
+BEGIN
+ ErrorString(InitString(a))
+END ErrorArray ;
+
+
+(*
+ ErrorString -
+*)
+
+PROCEDURE ErrorString (s: String) ;
+BEGIN
+ error(string(s)) ;
+ ExitValue := 1
+END ErrorString ;
+
+
+(*
+ SyntaxError - after a syntax error we skip all tokens up until we reach
+ a stop symbol.
+*)
+
+PROCEDURE SyntaxError (stopset: BITSET) ;
+VAR
+ r: INTEGER ;
+BEGIN
+ DescribeError(stopset) ;
+ IF Debugging
+ THEN
+ r := printf('\nskipping token *** ')
+ END ;
+ WHILE NOT (currenttoken IN stopset)
+ DO
+ GetToken
+ END ;
+ IF Debugging
+ THEN
+ r := printf(' ***\n')
+ END ;
+ ExitValue := 1
+END SyntaxError ;
+
+
+(*
+ SyntaxCheck -
+*)
+
+PROCEDURE SyntaxCheck (stopset: BITSET) ;
+BEGIN
+ IF NOT (currenttoken IN stopset)
+ THEN
+ SyntaxError(stopset)
+ END
+END SyntaxCheck ;
+
+
+(*
+ WarnMissingToken - generates a warning message about a missing token, t.
+*)
+
+PROCEDURE WarnMissingToken (t: toktype) ;
+VAR
+ s : BITSET ;
+ str: String ;
+BEGIN
+ s := BITSET{t} ;
+ str := DescribeStop(s) ;
+
+ str := ConCat(InitString('syntax error,'), Mark(str)) ;
+ ErrorString(str)
+END WarnMissingToken ;
+
+
+(*
+ MissingToken - generates a warning message about a missing token, t.
+*)
+
+PROCEDURE MissingToken (t: toktype) ;
+VAR
+ r: INTEGER ;
+BEGIN
+ WarnMissingToken(t)
+END MissingToken ;
+
+
+(*
+ InStopSet
+*)
+
+PROCEDURE InStopSet (t: toktype; stopset: BITSET) : BOOLEAN ;
+BEGIN
+ RETURN t IN stopset
+END InStopSet ;
+
+
+(*
+ Expect -
+*)
+
+PROCEDURE Expect (t: toktype; stopset: BITSET) ;
+BEGIN
+ IF currenttoken=t
+ THEN
+ GetToken
+ ELSE
+ MissingToken(t)
+ END ;
+ SyntaxCheck(stopset)
+END Expect ;
+
+
+PROCEDURE ParseMap (a: ADDRESS) : INTEGER ;
+VAR
+ r: INTEGER ;
+BEGIN
+ r := OpenFile(a) ;
+ IF r=0
+ THEN
+ GetToken ;
+ FileUnit(BITSET{eoftok}) ;
+ CloseFile ;
+ RETURN( ExitValue )
+ ELSE
+ RETURN( r )
+ END
+END ParseMap ;
+
+
+(*
+ Integer -
+*)
+
+PROCEDURE Integer (stopset: BITSET) ;
+BEGIN
+ LastInt := currentinteger ;
+ Expect(integertok, stopset)
+END Integer ;
+
+
+% module AdvParse end
+
+
+END AdvParse.
+% rules
+error 'ErrorArray' 'ErrorString'
+tokenfunc 'currenttoken'
+
+token '' eoftok -- internal token
+token 'ROOM' roomtok
+token 'DOOR' doortok
+token 'WALL' walltok
+token 'TREASURE' treasuretok
+token 'AT' attok
+token 'LEADS' leadstok
+token 'TO' totok
+token 'STATUS' statustok
+token "CLOSED" closedtok
+token "OPEN" opentok
+token "SECRET" secrettok
+token 'IS' istok
+token 'END' endtok
+token 'END.' enddottok
+token 'integer number' integertok
+token 'RANDOMIZE' randomizetok
+
+special Integer first { < integertok > } follow { }
+
+BNF
+
+FileUnit := RoomDesc { RoomDesc } [ RandomTreasure ] "END." =:
+
+RoomDesc := 'ROOM' Integer % VAR r: INTEGER ; %
+ % CurRoom := LastInt ;
+ ActualNoOfRooms := Max(CurRoom,
+ ActualNoOfRooms) ;
+ WITH Rooms[CurRoom] DO
+ NoOfWalls := 0 ;
+ NoOfDoors := 0 ;
+ Treasures := {}
+ END ;
+ IF Debugging
+ THEN
+ r := printf('reading room %d\n', CurRoom)
+ END %
+ { WallDesc | DoorDesc | TreasureDesc } 'END' =:
+
+WallDesc := 'WALL' WallCoords { WallCoords } =:
+
+WallCoords := % WITH Rooms[CurRoom] DO
+ INC(NoOfWalls) ;
+ IF NoOfWalls>WallsPerRoom
+ THEN
+ ErrorArray('too many walls') ;
+ NoOfWalls := WallsPerRoom
+ END ;
+ CurWall := NoOfWalls
+ END %
+ Integer % VAR x1, y1, x2, y2: INTEGER ; %
+ % x1 := LastInt %
+ Integer % y1 := LastInt %
+
+ Integer % x2 := LastInt %
+
+ Integer % y2 := LastInt ;
+ WITH Rooms[CurRoom].Walls[CurWall] DO
+ X1 := Min(x1, x2) ;
+ Y1 := Min(y1, y2) ;
+ X2 := Max(x1, x2) ;
+ Y2 := Max(y1, y2) ;
+ IF (X1#X2) AND (Y1#Y2)
+ THEN
+ error(string(InitString("not allowed diagonal wall")))
+ END
+ END %
+ =:
+
+DoorDesc := 'DOOR' DoorCoords { DoorCoords } =:
+
+DoorCoords := % WITH Rooms[CurRoom] DO
+ INC(NoOfDoors) ;
+ IF NoOfDoors>DoorsPerRoom
+ THEN
+ ErrorArray('too many doors') ;
+ NoOfDoors := DoorsPerRoom
+ END ;
+ CurDoor := NoOfDoors
+ END %
+ Integer % VAR x1, y1, x2, y2: INTEGER ; %
+ % x1 := LastInt %
+ Integer % y1 := LastInt %
+
+ Integer % x2 := LastInt %
+
+ Integer % y2 := LastInt ;
+ WITH Rooms[CurRoom].Doors[CurDoor].Position DO
+ X1 := Min(x1, x2) ;
+ Y1 := Min(y1, y2) ;
+ X2 := Max(x1, x2) ;
+ Y2 := Max(y1, y2) ;
+ IF (X1#X2) AND (Y1#Y2)
+ THEN
+ error(string(InitString("not allowed diagonal door")))
+ END
+
+ END %
+
+ Status
+ 'LEADS' 'TO' Integer % Rooms[CurRoom].Doors[CurDoor].LeadsTo := LastInt %
+ =:
+
+Status := 'STATUS' ( 'OPEN' % Rooms[CurRoom].Doors[CurDoor].StateOfDoor := Open %
+ | 'CLOSED' % Rooms[CurRoom].Doors[CurDoor].StateOfDoor := Closed %
+ | 'SECRET' % Rooms[CurRoom].Doors[CurDoor].StateOfDoor := Secret %
+ )
+ =:
+
+TreasureDesc := 'TREASURE' 'AT' Integer
+ % VAR x, y: INTEGER ; %
+ % x := LastInt %
+ Integer % y := LastInt %
+ 'IS' Integer % WITH Treasure[LastInt] DO
+ Xpos := x ;
+ Ypos := y ;
+ Rm := CurRoom ;
+ kind := onfloor
+ END ;
+ INCL(Rooms[CurRoom].Treasures, LastInt) %
+ =:
+
+RandomTreasure := 'RANDOMIZE' 'TREASURE' Integer % HideTreasure(LastInt) %
+ { Integer % HideTreasure(LastInt) %
+ }
+ =:
+
+FNB
diff --git a/gcc/testsuite/gm2/projects/pim/run/pass/tower/AdvParse.def b/gcc/testsuite/gm2/projects/pim/run/pass/tower/AdvParse.def
new file mode 100644
index 00000000000..696e1d27693
--- /dev/null
+++ b/gcc/testsuite/gm2/projects/pim/run/pass/tower/AdvParse.def
@@ -0,0 +1,18 @@
+DEFINITION MODULE AdvParse ;
+
+(*
+ Title : AdvParse
+ Author : Gaius Mulley
+ System : GNU Modula-2
+ Date : Sun Jul 17 14:26:41 2005
+ Revision : $Version$
+ Description: provides a simple interface to the parser.
+*)
+
+FROM SYSTEM IMPORT ADDRESS ;
+EXPORT QUALIFIED ParseMap ;
+
+PROCEDURE ParseMap (a: ADDRESS) : INTEGER ;
+
+
+END AdvParse.
diff --git a/gcc/testsuite/gm2/projects/pim/run/pass/tower/AdvParse.mod b/gcc/testsuite/gm2/projects/pim/run/pass/tower/AdvParse.mod
new file mode 100644
index 00000000000..6a5ca4c9f4a
--- /dev/null
+++ b/gcc/testsuite/gm2/projects/pim/run/pass/tower/AdvParse.mod
@@ -0,0 +1,873 @@
+(* it is advisable not to edit this file as it was automatically generated from the grammer file AdvParse.bnf *)
+# 2 "AdvParse.bnf"
+
+IMPLEMENTATION MODULE AdvParse ;
+
+(*
+ Author : Gaius Mulley
+ Title : AdvParse
+ Date : 16/7/2005
+ SYSTEM : GNU Modula-2
+ Description: parses maps.
+*)
+
+FROM libc IMPORT printf ;
+FROM SYSTEM IMPORT ADDRESS ;
+FROM DynamicStrings IMPORT String, string, InitStringCharStar, KillString,
+ InitString, ConCat, ConCatChar, Mark ;
+FROM StringConvert IMPORT stoi ;
+FROM advflex IMPORT toktype, OpenSource, CloseSource, error, GetToken,
+ currenttoken, currentinteger ;
+FROM AdvMap IMPORT Rooms, Line, DoorStatus, Door, Room, Treasure,
+ ActualNoOfRooms, MaxNoOfRooms,
+ WallsPerRoom, DoorsPerRoom, TreasureKind ;
+FROM AdvUtil IMPORT HideTreasure ;
+
+FROM AdvMath IMPORT MaxNoOfTreasures ;
+
+
+CONST
+ Debugging = TRUE ;
+
+TYPE
+ SetOfTok = SET OF toktype ;
+
+VAR
+ LastInt,
+ ExitValue : INTEGER ;
+
+ CurDoor,
+ CurWall,
+ CurRoom : CARDINAL ;
+
+
+(*
+ Min -
+*)
+
+PROCEDURE Min (a, b: INTEGER) : INTEGER ;
+BEGIN
+ IF a<b
+ THEN
+ RETURN( a )
+ ELSE
+ RETURN( b )
+ END
+END Min ;
+
+
+(*
+ Max -
+*)
+
+PROCEDURE Max (a, b: INTEGER) : INTEGER ;
+BEGIN
+ IF a>b
+ THEN
+ RETURN( a )
+ ELSE
+ RETURN( b )
+ END
+END Max ;
+
+
+(*
+ OpenFile - attempts to open a file, mapfile.
+*)
+
+PROCEDURE OpenFile (mapfile: ADDRESS) : INTEGER ;
+VAR
+ r: INTEGER ;
+BEGIN
+ ExitValue := 0 ;
+ IF OpenSource (mapfile)
+ THEN
+ RETURN 0
+ ELSE
+ r := printf ("cannot open file: %s\n", mapfile) ;
+ RETURN 1
+ END ;
+END OpenFile ;
+
+
+(*
+ CloseFile -
+*)
+
+PROCEDURE CloseFile ;
+BEGIN
+ CloseSource
+END CloseFile ;
+
+(*
+ expecting token set defined as an enumerated type
+ (eoftok, roomtok, doortok, walltok, treasuretok, attok, leadstok, totok, statustok, closedtok, opentok, secrettok, istok, endtok, enddottok, integertok, randomizetok) ;
+*)
+
+(* %%%FORWARD%%%
+PROCEDURE Integer (stopset: SetOfTok) ; FORWARD ;
+PROCEDURE FileUnit (stopset: SetOfTok) ; FORWARD ;
+PROCEDURE RoomDesc (stopset: SetOfTok) ; FORWARD ;
+PROCEDURE WallDesc (stopset: SetOfTok) ; FORWARD ;
+PROCEDURE WallCoords (stopset: SetOfTok) ; FORWARD ;
+PROCEDURE DoorDesc (stopset: SetOfTok) ; FORWARD ;
+PROCEDURE DoorCoords (stopset: SetOfTok) ; FORWARD ;
+PROCEDURE Status (stopset: SetOfTok) ; FORWARD ;
+PROCEDURE TreasureDesc (stopset: SetOfTok) ; FORWARD ;
+PROCEDURE RandomTreasure (stopset: SetOfTok) ; FORWARD ;
+ %%%FORWARD%%% *)
+
+(*
+ DescribeStop - issues a message explaining what tokens were expected
+*)
+
+PROCEDURE DescribeStop (stopset: SetOfTok) : String ;
+VAR
+ n : CARDINAL ;
+ str,
+ message: String ;
+BEGIN
+ n := 0 ;
+ message := InitString('') ;
+ IF randomizetok IN stopset
+ THEN
+ message := ConCat(ConCatChar(message, ' '), Mark(InitString("`RANDOMIZE'"))) ; INC(n)
+ END ;
+ IF integertok IN stopset
+ THEN
+ message := ConCat(ConCatChar(message, ' '), Mark(InitString("`integer number'"))) ; INC(n)
+ END ;
+ IF enddottok IN stopset
+ THEN
+ message := ConCat(ConCatChar(message, ' '), Mark(InitString("`END.'"))) ; INC(n)
+ END ;
+ IF endtok IN stopset
+ THEN
+ message := ConCat(ConCatChar(message, ' '), Mark(InitString("`END'"))) ; INC(n)
+ END ;
+ IF istok IN stopset
+ THEN
+ message := ConCat(ConCatChar(message, ' '), Mark(InitString("`IS'"))) ; INC(n)
+ END ;
+ IF secrettok IN stopset
+ THEN
+ message := ConCat(ConCatChar(message, ' '), Mark(InitString("`SECRET'"))) ; INC(n)
+ END ;
+ IF opentok IN stopset
+ THEN
+ message := ConCat(ConCatChar(message, ' '), Mark(InitString("`OPEN'"))) ; INC(n)
+ END ;
+ IF closedtok IN stopset
+ THEN
+ message := ConCat(ConCatChar(message, ' '), Mark(InitString("`CLOSED'"))) ; INC(n)
+ END ;
+ IF statustok IN stopset
+ THEN
+ message := ConCat(ConCatChar(message, ' '), Mark(InitString("`STATUS'"))) ; INC(n)
+ END ;
+ IF totok IN stopset
+ THEN
+ message := ConCat(ConCatChar(message, ' '), Mark(InitString("`TO'"))) ; INC(n)
+ END ;
+ IF leadstok IN stopset
+ THEN
+ message := ConCat(ConCatChar(message, ' '), Mark(InitString("`LEADS'"))) ; INC(n)
+ END ;
+ IF attok IN stopset
+ THEN
+ message := ConCat(ConCatChar(message, ' '), Mark(InitString("`AT'"))) ; INC(n)
+ END ;
+ IF treasuretok IN stopset
+ THEN
+ message := ConCat(ConCatChar(message, ' '), Mark(InitString("`TREASURE'"))) ; INC(n)
+ END ;
+ IF walltok IN stopset
+ THEN
+ message := ConCat(ConCatChar(message, ' '), Mark(InitString("`WALL'"))) ; INC(n)
+ END ;
+ IF doortok IN stopset
+ THEN
+ message := ConCat(ConCatChar(message, ' '), Mark(InitString("`DOOR'"))) ; INC(n)
+ END ;
+ IF roomtok IN stopset
+ THEN
+ message := ConCat(ConCatChar(message, ' '), Mark(InitString("`ROOM'"))) ; INC(n)
+ END ;
+ IF eoftok IN stopset
+ THEN
+ (* eoftok has no token name (needed to generate error messages) *)
+ END ;
+
+ IF n=0
+ THEN
+ str := InitString(' syntax error') ;
+ message := KillString(message) ;
+ ELSIF n=1
+ THEN
+ str := ConCat(message, Mark(InitString(' missing '))) ;
+ ELSE
+ str := ConCat(InitString(' expecting one of'), message) ;
+ message := KillString(message) ;
+ END ;
+ RETURN( str )
+END DescribeStop ;
+
+
+(*
+ DescribeError - issues a message explaining what tokens were expected
+*)
+
+PROCEDURE DescribeError (stopset: SetOfTok) ;
+VAR
+ str: String ;
+BEGIN
+ str := InitString('') ;
+ CASE currenttoken OF
+
+ randomizetok: str := ConCat(InitString("syntax error, found `RANDOMIZE'"), Mark(str)) |
+ integertok: str := ConCat(InitString("syntax error, found `integer number'"), Mark(str)) |
+ enddottok: str := ConCat(InitString("syntax error, found `END.'"), Mark(str)) |
+ endtok: str := ConCat(InitString("syntax error, found `END'"), Mark(str)) |
+ istok: str := ConCat(InitString("syntax error, found `IS'"), Mark(str)) |
+ secrettok: str := ConCat(InitString("syntax error, found `SECRET'"), Mark(str)) |
+ opentok: str := ConCat(InitString("syntax error, found `OPEN'"), Mark(str)) |
+ closedtok: str := ConCat(InitString("syntax error, found `CLOSED'"), Mark(str)) |
+ statustok: str := ConCat(InitString("syntax error, found `STATUS'"), Mark(str)) |
+ totok: str := ConCat(InitString("syntax error, found `TO'"), Mark(str)) |
+ leadstok: str := ConCat(InitString("syntax error, found `LEADS'"), Mark(str)) |
+ attok: str := ConCat(InitString("syntax error, found `AT'"), Mark(str)) |
+ treasuretok: str := ConCat(InitString("syntax error, found `TREASURE'"), Mark(str)) |
+ walltok: str := ConCat(InitString("syntax error, found `WALL'"), Mark(str)) |
+ doortok: str := ConCat(InitString("syntax error, found `DOOR'"), Mark(str)) |
+ roomtok: str := ConCat(InitString("syntax error, found `ROOM'"), Mark(str)) |
+ eoftok: str := ConCat(InitString("syntax error, found `'"), Mark(str))
+ ELSE
+ END ;
+ ErrorString(str) ;
+END DescribeError ;
+# 99 "AdvParse.bnf"
+
+
+
+(*
+ ErrorArray -
+*)
+
+PROCEDURE ErrorArray (a: ARRAY OF CHAR) ;
+BEGIN
+ ErrorString(InitString(a))
+END ErrorArray ;
+
+
+(*
+ ErrorString -
+*)
+
+PROCEDURE ErrorString (s: String) ;
+BEGIN
+ error(string(s)) ;
+ ExitValue := 1
+END ErrorString ;
+
+
+(*
+ SyntaxError - after a syntax error we skip all tokens up until we reach
+ a stop symbol.
+*)
+
+PROCEDURE SyntaxError (stopset: SetOfTok) ;
+VAR
+ r: INTEGER ;
+BEGIN
+ DescribeError(stopset) ;
+ IF Debugging
+ THEN
+ r := printf('\nskipping token *** ')
+ END ;
+ WHILE NOT (currenttoken IN stopset)
+ DO
+ GetToken
+ END ;
+ IF Debugging
+ THEN
+ r := printf(' ***\n')
+ END ;
+ ExitValue := 1
+END SyntaxError ;
+
+
+(*
+ SyntaxCheck -
+*)
+
+PROCEDURE SyntaxCheck (stopset: SetOfTok) ;
+BEGIN
+ IF NOT (currenttoken IN stopset)
+ THEN
+ SyntaxError(stopset)
+ END
+END SyntaxCheck ;
+
+
+(*
+ WarnMissingToken - generates a warning message about a missing token, t.
+*)
+
+PROCEDURE WarnMissingToken (t: toktype) ;
+VAR
+ s : SetOfTok ;
+ str: String ;
+BEGIN
+ s := SetOfTok{t} ;
+ str := DescribeStop(s) ;
+
+ str := ConCat(InitString('syntax error,'), Mark(str)) ;
+ ErrorString(str)
+END WarnMissingToken ;
+
+
+(*
+ MissingToken - generates a warning message about a missing token, t.
+*)
+
+PROCEDURE MissingToken (t: toktype) ;
+VAR
+ r: INTEGER ;
+BEGIN
+ WarnMissingToken(t)
+END MissingToken ;
+
+
+(*
+ InStopSet
+*)
+
+PROCEDURE InStopSet (t: toktype; stopset: SetOfTok) : BOOLEAN ;
+BEGIN
+ RETURN t IN stopset
+END InStopSet ;
+
+
+(*
+ Expect -
+*)
+
+PROCEDURE Expect (t: toktype; stopset: SetOfTok) ;
+BEGIN
+ IF currenttoken=t
+ THEN
+ GetToken
+ ELSE
+ MissingToken(t)
+ END ;
+ SyntaxCheck(stopset)
+END Expect ;
+
+
+PROCEDURE ParseMap (a: ADDRESS) : INTEGER ;
+VAR
+ r: INTEGER ;
+BEGIN
+ r := OpenFile(a) ;
+ IF r=0
+ THEN
+ GetToken ;
+ FileUnit(SetOfTok{eoftok}) ;
+ CloseFile ;
+ RETURN( ExitValue )
+ ELSE
+ RETURN( r )
+ END
+END ParseMap ;
+
+
+(*
+ Integer -
+*)
+
+PROCEDURE Integer (stopset: SetOfTok) ;
+BEGIN
+ LastInt := currentinteger ;
+ Expect(integertok, stopset)
+END Integer ;
+
+
+(*
+ Integer :=
+
+ first symbols:integertok
+
+ cannot reachend
+*)
+(*
+ FileUnit := RoomDesc { RoomDesc } [ RandomTreasure ] 'END.'
+
+ first symbols:roomtok
+
+ cannot reachend
+*)
+
+# 274 "AdvParse.bnf"
+PROCEDURE FileUnit (stopset: SetOfTok) ;
+# 274 "AdvParse.bnf"
+BEGIN
+# 274 "AdvParse.bnf"
+ RoomDesc(stopset + SetOfTok{enddottok, roomtok, randomizetok}) ;
+# 274 "AdvParse.bnf"
+ WHILE currenttoken=roomtok DO
+ RoomDesc(stopset + SetOfTok{enddottok, randomizetok, roomtok}) ;
+ END (* while *) ;
+# 274 "AdvParse.bnf"
+ IF currenttoken=randomizetok
+ THEN
+ RandomTreasure(stopset + SetOfTok{enddottok}) ;
+ END ;
+# 274 "AdvParse.bnf"
+ Expect(enddottok, stopset) ;
+END FileUnit ;
+
+
+(*
+ RoomDesc := 'ROOM' Integer
+ % VAR r: INTEGER ; %
+
+ % CurRoom := LastInt ;
+ ActualNoOfRooms := Max(CurRoom,
+ ActualNoOfRooms) ;
+ WITH Rooms[CurRoom] DO
+ NoOfWalls := 0 ;
+ NoOfDoors := 0 ;
+ Treasures := {}
+ END ;
+ IF Debugging
+ THEN
+ r := printf('reading room %d\n', CurRoom)
+ END %
+ { WallDesc | DoorDesc | TreasureDesc } 'END'
+
+ first symbols:roomtok
+
+ cannot reachend
+*)
+
+# 276 "AdvParse.bnf"
+PROCEDURE RoomDesc (stopset: SetOfTok) ;
+VAR
+ r: INTEGER ;
+# 276 "AdvParse.bnf"
+BEGIN
+# 276 "AdvParse.bnf"
+ Expect(roomtok, stopset + SetOfTok{integertok}) ;
+# 276 "AdvParse.bnf"
+ Integer(stopset + SetOfTok{endtok, walltok, doortok, treasuretok}) ;
+# 276 "AdvParse.bnf"
+# 277 "AdvParse.bnf"
+# 288 "AdvParse.bnf"
+ CurRoom := LastInt ;
+ ActualNoOfRooms := Max(CurRoom,
+ ActualNoOfRooms) ;
+ WITH Rooms[CurRoom] DO
+ NoOfWalls := 0 ;
+ NoOfDoors := 0 ;
+ Treasures := {}
+ END ;
+ IF Debugging
+ THEN
+ r := printf('reading room %d\n', CurRoom)
+ END ;
+# 289 "AdvParse.bnf"
+ IF (currenttoken IN SetOfTok{treasuretok, doortok, walltok})
+ THEN
+ (* seen optional { | } expression *)
+ WHILE (currenttoken IN SetOfTok{treasuretok, doortok, walltok}) DO
+# 289 "AdvParse.bnf"
+ IF currenttoken=walltok
+ THEN
+ WallDesc(stopset + SetOfTok{endtok, treasuretok, doortok, walltok}) ;
+# 289 "AdvParse.bnf"
+ ELSIF currenttoken=doortok
+ THEN
+ DoorDesc(stopset + SetOfTok{endtok, treasuretok, doortok, walltok}) ;
+# 289 "AdvParse.bnf"
+ ELSIF currenttoken=treasuretok
+ THEN
+ TreasureDesc(stopset + SetOfTok{endtok, treasuretok, doortok, walltok}) ;
+ END ;
+ (* end of optional { | } expression *)
+ END ;
+ END ;
+# 289 "AdvParse.bnf"
+Expect(endtok, stopset) ;
+END RoomDesc ;
+
+
+(*
+ WallDesc := 'WALL' WallCoords { WallCoords }
+
+ first symbols:walltok
+
+ cannot reachend
+*)
+
+# 291 "AdvParse.bnf"
+PROCEDURE WallDesc (stopset: SetOfTok) ;
+# 291 "AdvParse.bnf"
+BEGIN
+# 291 "AdvParse.bnf"
+ Expect(walltok, stopset + SetOfTok{integertok}) ;
+# 291 "AdvParse.bnf"
+ WallCoords(stopset + SetOfTok{integertok}) ;
+# 291 "AdvParse.bnf"
+ WHILE currenttoken=integertok DO
+ WallCoords(stopset + SetOfTok{integertok}) ;
+ END (* while *) ;
+END WallDesc ;
+
+
+(*
+ WallCoords :=
+ % WITH Rooms[CurRoom] DO
+ INC(NoOfWalls) ;
+ IF NoOfWalls>WallsPerRoom
+ THEN
+ ErrorArray('too many walls') ;
+ NoOfWalls := WallsPerRoom
+ END ;
+ CurWall := NoOfWalls
+ END %
+ Integer
+ % VAR x1, y1, x2, y2: INTEGER ; %
+
+ % x1 := LastInt %
+ Integer
+ % y1 := LastInt %
+ Integer
+ % x2 := LastInt %
+ Integer
+ % y2 := LastInt ;
+ WITH Rooms[CurRoom].Walls[CurWall] DO
+ X1 := Min(x1, x2) ;
+ Y1 := Min(y1, y2) ;
+ X2 := Max(x1, x2) ;
+ Y2 := Max(y1, y2) ;
+ IF (X1#X2) AND (Y1#Y2)
+ THEN
+ error(string(InitString("not allowed diagonal wall")))
+ END
+ END %
+
+
+ first symbols:integertok
+
+ cannot reachend
+*)
+
+# 293 "AdvParse.bnf"
+PROCEDURE WallCoords (stopset: SetOfTok) ;
+VAR
+ x1, y1, x2, y2: INTEGER ;
+# 293 "AdvParse.bnf"
+BEGIN
+# 293 "AdvParse.bnf"
+# 301 "AdvParse.bnf"
+ WITH Rooms[CurRoom] DO
+ INC(NoOfWalls) ;
+ IF NoOfWalls>WallsPerRoom
+ THEN
+ ErrorArray('too many walls') ;
+ NoOfWalls := WallsPerRoom
+ END ;
+ CurWall := NoOfWalls
+ END ;
+# 302 "AdvParse.bnf"
+ Integer(stopset + SetOfTok{integertok}) ;
+# 302 "AdvParse.bnf"
+# 303 "AdvParse.bnf"
+ x1 := LastInt ;
+# 304 "AdvParse.bnf"
+ Integer(stopset + SetOfTok{integertok}) ;
+# 304 "AdvParse.bnf"
+ y1 := LastInt ;
+# 306 "AdvParse.bnf"
+ Integer(stopset + SetOfTok{integertok}) ;
+# 306 "AdvParse.bnf"
+ x2 := LastInt ;
+# 308 "AdvParse.bnf"
+ Integer(stopset) ;
+# 308 "AdvParse.bnf"
+# 318 "AdvParse.bnf"
+ y2 := LastInt ;
+ WITH Rooms[CurRoom].Walls[CurWall] DO
+ X1 := Min(x1, x2) ;
+ Y1 := Min(y1, y2) ;
+ X2 := Max(x1, x2) ;
+ Y2 := Max(y1, y2) ;
+ IF (X1#X2) AND (Y1#Y2)
+ THEN
+ error(string(InitString("not allowed diagonal wall")))
+ END
+ END ;
+END WallCoords ;
+
+
+(*
+ DoorDesc := 'DOOR' DoorCoords { DoorCoords }
+
+ first symbols:doortok
+
+ cannot reachend
+*)
+
+# 321 "AdvParse.bnf"
+PROCEDURE DoorDesc (stopset: SetOfTok) ;
+# 321 "AdvParse.bnf"
+BEGIN
+# 321 "AdvParse.bnf"
+ Expect(doortok, stopset + SetOfTok{integertok}) ;
+# 321 "AdvParse.bnf"
+ DoorCoords(stopset + SetOfTok{integertok}) ;
+# 321 "AdvParse.bnf"
+ WHILE currenttoken=integertok DO
+ DoorCoords(stopset + SetOfTok{integertok}) ;
+ END (* while *) ;
+END DoorDesc ;
+
+
+(*
+ DoorCoords :=
+ % WITH Rooms[CurRoom] DO
+ INC(NoOfDoors) ;
+ IF NoOfDoors>DoorsPerRoom
+ THEN
+ ErrorArray('too many doors') ;
+ NoOfDoors := DoorsPerRoom
+ END ;
+ CurDoor := NoOfDoors
+ END %
+ Integer
+ % VAR x1, y1, x2, y2: INTEGER ; %
+
+ % x1 := LastInt %
+ Integer
+ % y1 := LastInt %
+ Integer
+ % x2 := LastInt %
+ Integer
+ % y2 := LastInt ;
+ WITH Rooms[CurRoom].Doors[CurDoor].Position DO
+ X1 := Min(x1, x2) ;
+ Y1 := Min(y1, y2) ;
+ X2 := Max(x1, x2) ;
+ Y2 := Max(y1, y2) ;
+ IF (X1#X2) AND (Y1#Y2)
+ THEN
+ error(string(InitString("not allowed diagonal door")))
+ END
+
+ END %
+ Status 'LEADS' 'TO' Integer
+ % Rooms[CurRoom].Doors[CurDoor].LeadsTo := LastInt %
+
+
+ first symbols:integertok
+
+ cannot reachend
+*)
+
+# 323 "AdvParse.bnf"
+PROCEDURE DoorCoords (stopset: SetOfTok) ;
+VAR
+ x1, y1, x2, y2: INTEGER ;
+# 323 "AdvParse.bnf"
+BEGIN
+# 323 "AdvParse.bnf"
+# 331 "AdvParse.bnf"
+ WITH Rooms[CurRoom] DO
+ INC(NoOfDoors) ;
+ IF NoOfDoors>DoorsPerRoom
+ THEN
+ ErrorArray('too many doors') ;
+ NoOfDoors := DoorsPerRoom
+ END ;
+ CurDoor := NoOfDoors
+ END ;
+# 332 "AdvParse.bnf"
+ Integer(stopset + SetOfTok{integertok}) ;
+# 332 "AdvParse.bnf"
+# 333 "AdvParse.bnf"
+ x1 := LastInt ;
+# 334 "AdvParse.bnf"
+ Integer(stopset + SetOfTok{integertok}) ;
+# 334 "AdvParse.bnf"
+ y1 := LastInt ;
+# 336 "AdvParse.bnf"
+ Integer(stopset + SetOfTok{integertok}) ;
+# 336 "AdvParse.bnf"
+ x2 := LastInt ;
+# 338 "AdvParse.bnf"
+ Integer(stopset + SetOfTok{statustok}) ;
+# 338 "AdvParse.bnf"
+# 349 "AdvParse.bnf"
+ y2 := LastInt ;
+ WITH Rooms[CurRoom].Doors[CurDoor].Position DO
+ X1 := Min(x1, x2) ;
+ Y1 := Min(y1, y2) ;
+ X2 := Max(x1, x2) ;
+ Y2 := Max(y1, y2) ;
+ IF (X1#X2) AND (Y1#Y2)
+ THEN
+ error(string(InitString("not allowed diagonal door")))
+ END
+
+ END ;
+# 352 "AdvParse.bnf"
+ Status(stopset + SetOfTok{leadstok}) ;
+# 352 "AdvParse.bnf"
+ Expect(leadstok, stopset + SetOfTok{totok}) ;
+# 352 "AdvParse.bnf"
+ Expect(totok, stopset + SetOfTok{integertok}) ;
+# 352 "AdvParse.bnf"
+ Integer(stopset) ;
+# 352 "AdvParse.bnf"
+ Rooms[CurRoom].Doors[CurDoor].LeadsTo := LastInt ;
+END DoorCoords ;
+
+
+(*
+ Status := 'STATUS' ( 'OPEN'
+ % Rooms[CurRoom].Doors[CurDoor].StateOfDoor := Open %
+ | 'CLOSED'
+ % Rooms[CurRoom].Doors[CurDoor].StateOfDoor := Closed %
+ | 'SECRET'
+ % Rooms[CurRoom].Doors[CurDoor].StateOfDoor := Secret %
+ )
+
+ first symbols:statustok
+
+ cannot reachend
+*)
+
+# 355 "AdvParse.bnf"
+PROCEDURE Status (stopset: SetOfTok) ;
+# 355 "AdvParse.bnf"
+BEGIN
+# 355 "AdvParse.bnf"
+ Expect(statustok, stopset + SetOfTok{opentok, closedtok, secrettok}) ;
+# 355 "AdvParse.bnf"
+ IF currenttoken=opentok
+ THEN
+ Expect(opentok, stopset) ;
+# 355 "AdvParse.bnf"
+ Rooms[CurRoom].Doors[CurDoor].StateOfDoor := Open ;
+# 356 "AdvParse.bnf"
+ ELSIF currenttoken=closedtok
+ THEN
+ Expect(closedtok, stopset) ;
+# 356 "AdvParse.bnf"
+ Rooms[CurRoom].Doors[CurDoor].StateOfDoor := Closed ;
+# 357 "AdvParse.bnf"
+ ELSIF currenttoken=secrettok
+ THEN
+ Expect(secrettok, stopset) ;
+# 357 "AdvParse.bnf"
+ Rooms[CurRoom].Doors[CurDoor].StateOfDoor := Secret ;
+ ELSE
+ ErrorArray('expecting one of: SECRET CLOSED OPEN')
+ END ;
+END Status ;
+
+
+(*
+ TreasureDesc := 'TREASURE' 'AT' Integer
+ % VAR x, y: INTEGER ; %
+
+ % x := LastInt %
+ Integer
+ % y := LastInt %
+ 'IS' Integer
+ % WITH Treasure[LastInt] DO
+ Xpos := x ;
+ Ypos := y ;
+ Rm := CurRoom
+ END ;
+ INCL(Rooms[CurRoom].Treasures, LastInt) %
+
+
+ first symbols:treasuretok
+
+ cannot reachend
+*)
+
+# 361 "AdvParse.bnf"
+PROCEDURE TreasureDesc (stopset: SetOfTok) ;
+VAR
+ x, y: INTEGER ;
+# 361 "AdvParse.bnf"
+BEGIN
+# 361 "AdvParse.bnf"
+ Expect(treasuretok, stopset + SetOfTok{attok}) ;
+# 361 "AdvParse.bnf"
+ Expect(attok, stopset + SetOfTok{integertok}) ;
+# 362 "AdvParse.bnf"
+ Integer(stopset + SetOfTok{integertok}) ;
+# 362 "AdvParse.bnf"
+# 363 "AdvParse.bnf"
+ x := LastInt ;
+# 364 "AdvParse.bnf"
+ Integer(stopset + SetOfTok{istok}) ;
+# 364 "AdvParse.bnf"
+ y := LastInt ;
+# 365 "AdvParse.bnf"
+ Expect(istok, stopset + SetOfTok{integertok}) ;
+# 365 "AdvParse.bnf"
+ Integer(stopset) ;
+# 365 "AdvParse.bnf"
+# 370 "AdvParse.bnf"
+ WITH Treasure[LastInt] DO
+ Xpos := x ;
+ Ypos := y ;
+ Rm := CurRoom ;
+ kind := onfloor
+ END ;
+ INCL(Rooms[CurRoom].Treasures, VAL(CARDINAL, LastInt))
+END TreasureDesc ;
+
+
+(*
+ RandomTreasure := 'RANDOMIZE' 'TREASURE' Integer
+ % HideTreasure(LastInt) %
+ { Integer
+ % HideTreasure(LastInt) %
+ }
+
+ first symbols:randomizetok
+
+ cannot reachend
+*)
+
+# 373 "AdvParse.bnf"
+PROCEDURE RandomTreasure (stopset: SetOfTok) ;
+# 373 "AdvParse.bnf"
+BEGIN
+# 373 "AdvParse.bnf"
+ Expect(randomizetok, stopset + SetOfTok{treasuretok}) ;
+# 373 "AdvParse.bnf"
+ Expect(treasuretok, stopset + SetOfTok{integertok}) ;
+# 373 "AdvParse.bnf"
+ Integer(stopset + SetOfTok{integertok}) ;
+# 373 "AdvParse.bnf"
+ HideTreasure(LastInt) ;
+# 374 "AdvParse.bnf"
+ WHILE currenttoken=integertok DO
+ Integer(stopset + SetOfTok{integertok}) ;
+# 374 "AdvParse.bnf"
+ HideTreasure(LastInt) ;
+ END (* while *) ;
+END RandomTreasure ;
+
+
+# 245 "AdvParse.bnf"
+
+
+
+END AdvParse.
diff --git a/gcc/testsuite/gm2/projects/pim/run/pass/tower/AdvSound.def b/gcc/testsuite/gm2/projects/pim/run/pass/tower/AdvSound.def
new file mode 100644
index 00000000000..d59ee025e2a
--- /dev/null
+++ b/gcc/testsuite/gm2/projects/pim/run/pass/tower/AdvSound.def
@@ -0,0 +1,70 @@
+(* Copyright (C) 2003
+ Free Software Foundation, Inc. *)
+(* This file is part of GNU Modula-2.
+
+GNU Modula-2 is free software; you can redistribute it and/or modify it under
+the terms of the GNU General Public License as published by the Free
+Software Foundation; either version 2, or (at your option) any later
+version.
+
+GNU Modula-2 is distributed in the hope that it will be useful, but WITHOUT ANY
+WARRANTY; without even the implied warranty of MERCHANTABILITY or
+FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
+for more details.
+
+You should have received a copy of the GNU General Public License along
+with gm2; see the file COPYING. If not, write to the Free Software
+Foundation, 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. *)
+
+DEFINITION MODULE AdvSound ;
+
+(*
+ Title : AdvSound
+ Author : Gaius Mulley
+ System : GNU Modula-2
+ Date : Mon Jul 11 21:40:59 2005
+ Revision : $Version$
+ Description: provides a simple set of routines to generate
+ sound.
+*)
+
+EXPORT QUALIFIED EnterGame, Explode, Swish, Miss, Hit ;
+
+
+(*
+ EnterGame - play the enter game sound to player, p.
+*)
+
+PROCEDURE EnterGame (p: CARDINAL) ;
+
+
+(*
+ Explode - play the explosion for each player in room, r, and adjacent
+ rooms.
+*)
+
+PROCEDURE Explode (r: CARDINAL; pulled: CARDINAL; hit: BOOLEAN) ;
+
+
+(*
+ Swish - play the arrow swish sound to each player in room, r.
+*)
+
+PROCEDURE Swish (r: CARDINAL) ;
+
+
+(*
+ Miss - play the arrow miss sound to each player in room, r.
+*)
+
+PROCEDURE Miss (r: CARDINAL) ;
+
+
+(*
+ Hit - play the arrow hit sound to player, p.
+*)
+
+PROCEDURE Hit (p: CARDINAL) ;
+
+
+END AdvSound.
diff --git a/gcc/testsuite/gm2/projects/pim/run/pass/tower/AdvSound.mod b/gcc/testsuite/gm2/projects/pim/run/pass/tower/AdvSound.mod
new file mode 100644
index 00000000000..1acad8b3df1
--- /dev/null
+++ b/gcc/testsuite/gm2/projects/pim/run/pass/tower/AdvSound.mod
@@ -0,0 +1,143 @@
+IMPLEMENTATION MODULE AdvSound ;
+
+
+FROM AdvMap IMPORT Adjacent ;
+IMPORT StrIO ;
+FROM AdvSystem IMPORT GetAccessToScreenNo, ReleaseAccessToScreenNo,
+ Player, PlayerNo,
+ NextFreePlayer,
+ IsPlayerActive,
+ GetReadAccessToPlayer,
+ ReleaseReadAccessToPlayer ;
+
+
+PROCEDURE EnterGame (p: CARDINAL) ;
+BEGIN
+ GetAccessToScreenNo(p) ;
+ StrIO.WriteString('pS start') ; StrIO.WriteLn ;
+ ReleaseAccessToScreenNo(p)
+END EnterGame ;
+
+
+(*
+ Explode - play the explosion for each player in room, r, and adjacent
+ rooms.
+*)
+
+PROCEDURE Explode (r: CARDINAL; pulled: CARDINAL; hit: BOOLEAN) ;
+VAR
+ p: CARDINAL ;
+BEGIN
+ GetReadAccessToPlayer ;
+ FOR p := 0 TO NextFreePlayer-1 DO
+ IF IsPlayerActive(p)
+ THEN
+ WITH Player[p] DO
+ IF p=pulled
+ THEN
+ IF r=RoomOfMan
+ THEN
+ GetAccessToScreenNo(p) ;
+ StrIO.WriteString('pS ohnoexplode') ; StrIO.WriteLn ;
+ ReleaseAccessToScreenNo(p)
+ ELSIF Adjacent(r, RoomOfMan)
+ THEN
+ IF hit
+ THEN
+ GetAccessToScreenNo(p) ;
+ StrIO.WriteString('pS laughexplode') ; StrIO.WriteLn ;
+ ReleaseAccessToScreenNo(p)
+ ELSE
+ GetAccessToScreenNo(p) ;
+ StrIO.WriteString('pS handgrenade') ; StrIO.WriteLn ;
+ ReleaseAccessToScreenNo(p)
+ END
+ END
+ ELSE
+ GetAccessToScreenNo(p) ;
+ StrIO.WriteString('pS handgrenade') ; StrIO.WriteLn ;
+ ReleaseAccessToScreenNo(p)
+ END
+ END
+ END
+ END ;
+ ReleaseReadAccessToPlayer
+END Explode ;
+
+
+(*
+ ForeachIn -
+*)
+
+PROCEDURE ForeachIn (r: CARDINAL; sound: ARRAY OF CHAR) ;
+VAR
+ p: CARDINAL ;
+BEGIN
+ GetReadAccessToPlayer ;
+ FOR p := 0 TO NextFreePlayer-1 DO
+ IF IsPlayerActive(p)
+ THEN
+ WITH Player[p] DO
+ IF r=RoomOfMan
+ THEN
+ GetAccessToScreenNo(p) ;
+ StrIO.WriteString(sound) ; StrIO.WriteLn ;
+ ReleaseAccessToScreenNo(p)
+ END
+ END
+ END
+ END ;
+ ReleaseReadAccessToPlayer
+END ForeachIn ;
+
+
+(*
+ Swish - play the arrow swish sound to each player in room, r.
+*)
+
+PROCEDURE Swish (r: CARDINAL) ;
+BEGIN
+ ForeachIn(r, 'pS arrowswish')
+END Swish ;
+
+
+(*
+ Miss - play the arrow miss sound to each player in room, r.
+*)
+
+PROCEDURE Miss (r: CARDINAL) ;
+BEGIN
+ ForeachIn(r, 'pS brokenglass')
+END Miss ;
+
+
+(*
+ OhNo - play the OhNo sound to player, p.
+*)
+
+PROCEDURE OhNo (p: CARDINAL) ;
+BEGIN
+ GetAccessToScreenNo(p) ;
+ StrIO.WriteString('pS ohno') ; StrIO.WriteLn ;
+ ReleaseAccessToScreenNo(p)
+END OhNo ;
+
+
+(*
+ Hit - play the arrow hit sound to player, p.
+*)
+
+PROCEDURE Hit (p: CARDINAL) ;
+BEGIN
+ GetAccessToScreenNo(p) ;
+ StrIO.WriteString('pS applause') ; StrIO.WriteLn ;
+ ReleaseAccessToScreenNo(p)
+END Hit ;
+
+
+END AdvSound.
+(*
+ * Local variables:
+ * compile-command: "make"
+ * End:
+ *)
diff --git a/gcc/testsuite/gm2/projects/pim/run/pass/tower/AdvSystem.def b/gcc/testsuite/gm2/projects/pim/run/pass/tower/AdvSystem.def
new file mode 100644
index 00000000000..52a3e7bb812
--- /dev/null
+++ b/gcc/testsuite/gm2/projects/pim/run/pass/tower/AdvSystem.def
@@ -0,0 +1,189 @@
+DEFINITION MODULE AdvSystem ;
+
+
+FROM Executive IMPORT SEMAPHORE, DESCRIPTOR ;
+FROM ProcArgs IMPORT ProcessArgs ;
+
+
+EXPORT QUALIFIED ManWeight,
+ MaxNoOfPlayers,
+ Man,
+ TypeOfDeath,
+ Player,
+ PlayerSet,
+ PlayerNo,
+ ArrowArgs,
+ StartPlayer,
+ TimeMinSec,
+ RandomNumber,
+ ClientRead,
+ DefaultWrite,
+ ReadString,
+ NextFreePlayer,
+ IsPlayerActive,
+ AssignOutputTo,
+ UnAssign,
+
+ GetReadAccessToPlayer,
+ GetWriteAccessToPlayer,
+ ReleaseReadAccessToPlayer,
+ ReleaseWriteAccessToPlayer,
+
+ GetReadAccessToDoor,
+ GetWriteAccessToDoor,
+ ReleaseReadAccessToDoor,
+ ReleaseWriteAccessToDoor,
+
+ GetReadAccessToTreasure,
+ GetWriteAccessToTreasure,
+ ReleaseReadAccessToTreasure,
+ ReleaseWriteAccessToTreasure,
+
+ GetAccessToScreen,
+ ReleaseAccessToScreen,
+ GetAccessToScreenNo,
+ ReleaseAccessToScreenNo ;
+
+
+CONST
+ ManWeight = 70 ; (* Kgs *)
+ MaxNoOfPlayers = 100 ;
+
+TYPE
+ TypeOfDeath = (living, normalarrow, magicarrow,
+ exitdungeon, explosion, sword, fireball) ;
+
+ PlayerSet = SET OF [0..MaxNoOfPlayers] ;
+
+ ArrowArgs = POINTER TO RECORD
+ ArrowPlayer: CARDINAL ;
+ ArrowRoom : CARDINAL ;
+ ArrowX : CARDINAL ; (* X coord of Arrow *)
+ ArrowY : CARDINAL ; (* Y coord of Arrow *)
+ ArrowDir : INTEGER ; (* Direction of Arrow *)
+ IsMagic : BOOLEAN ;
+ END ;
+
+ Man = RECORD
+ ManName : ARRAY [0..9] OF CHAR ;
+ DeathType : TypeOfDeath ;(* How man died! *)
+ Weight : CARDINAL ; (* Mans Weight in lbs *)
+ Wounds : CARDINAL ; (* 0..100 0= Dead! *)
+ Fatigue : CARDINAL ; (* 0..100 0= V Tired *)
+ TreasureOwn : BITSET ; (* Treasures that own *)
+ NoOfMagic : CARDINAL ; (* No Of Magic Arrows *)
+ NoOfNormal : CARDINAL ; (* No Of Normal Arrows *)
+ Xman : CARDINAL ; (* X coord of Man *)
+ Yman : CARDINAL ; (* Y coord of Man *)
+ Direction : CARDINAL ; (* Direction of Man 0.4 *)
+ ScreenX : CARDINAL ; (* Top Right of screen *)
+ ScreenY : CARDINAL ; (* ditto *)
+ RoomOfMan : CARDINAL ; (* Room Man Current in *)
+ NormalProcArgs : ProcessArgs ;
+ MagicProcArgs : ProcessArgs ;
+ MagicP,
+ NormalP : DESCRIPTOR ;
+ LastSecWounds : CARDINAL ; (* Last updated Wounds *)
+ LastSecFatigue : CARDINAL ; (* Last updated Fatigue *)
+ PlayerProcess : DESCRIPTOR ; (* process of player *)
+ fd : INTEGER ; (* socket file desc *)
+ END ;
+
+
+VAR
+ Player : ARRAY [0..MaxNoOfPlayers] OF Man ;
+ NextFreePlayer: CARDINAL ; (* 0..NextFreePlayer-1 are potentially playing *)
+
+
+PROCEDURE ClientRead (VAR ch: CHAR) : BOOLEAN ;
+PROCEDURE DefaultWrite (ch: CHAR) ;
+PROCEDURE ReadString (VAR s: ARRAY OF CHAR) ;
+
+
+(*
+ AssignOutputTo - assigns the current process to be associated with
+ player, p.
+*)
+
+PROCEDURE AssignOutputTo (p: CARDINAL) ;
+
+
+(*
+ UnAssign - unassign the current process from any player.
+*)
+
+PROCEDURE UnAssign ;
+
+
+(*
+ IsPlayerActive - returns TRUE if player, p, is still playing
+*)
+
+PROCEDURE IsPlayerActive (p: CARDINAL) : BOOLEAN ;
+
+
+(* PlayerNo - returns the Player number of the current man calling *)
+
+PROCEDURE PlayerNo () : CARDINAL ;
+
+
+PROCEDURE StartPlayer (f: INTEGER) ;
+
+
+(* Returns Minutes and seconds in Seconds. *)
+
+PROCEDURE TimeMinSec (VAR MinSec: CARDINAL) ;
+
+
+(* RandomNumber delivers a random number in r which is in the *)
+(* range 0..n-1. However n must be in the range 1..256 *)
+
+PROCEDURE RandomNumber (VAR r: CARDINAL ; n: CARDINAL) ;
+
+
+(* The rules which govern the allocation of these resourses are *)
+
+(* 1) One may claim multiple resourses in the following order: *)
+(* AccessPlayer *)
+(* AccessDoor *)
+(* AccessTreasure *)
+(* AccessScreen *)
+(* *)
+(* All r/w - doesn't matter. *)
+(* 2) Must never reverse this claiming or DEADLOCK may occur. *)
+(* *)
+(* 3) Must claim players in order ie 0 1 2 *)
+
+
+(* All Player access commands *)
+
+PROCEDURE GetReadAccessToPlayer ;
+PROCEDURE GetWriteAccessToPlayer ;
+PROCEDURE ReleaseReadAccessToPlayer ;
+PROCEDURE ReleaseWriteAccessToPlayer ;
+
+(* All Door access commands *)
+
+PROCEDURE GetReadAccessToDoor ;
+PROCEDURE GetWriteAccessToDoor ;
+PROCEDURE ReleaseReadAccessToDoor ;
+PROCEDURE ReleaseWriteAccessToDoor ;
+
+
+(* All Treasure access commands *)
+
+PROCEDURE GetReadAccessToTreasure ;
+PROCEDURE GetWriteAccessToTreasure ;
+PROCEDURE ReleaseReadAccessToTreasure ;
+PROCEDURE ReleaseWriteAccessToTreasure ;
+
+
+(* All Screen access commands *)
+
+PROCEDURE GetAccessToScreen ;
+PROCEDURE ReleaseAccessToScreen ;
+PROCEDURE GetAccessToScreenNo (Sn: CARDINAL) ;
+PROCEDURE ReleaseAccessToScreenNo (Sn: CARDINAL) ;
+
+
+END AdvSystem.
diff --git a/gcc/testsuite/gm2/projects/pim/run/pass/tower/AdvSystem.mod b/gcc/testsuite/gm2/projects/pim/run/pass/tower/AdvSystem.mod
new file mode 100644
index 00000000000..fc215166549
--- /dev/null
+++ b/gcc/testsuite/gm2/projects/pim/run/pass/tower/AdvSystem.mod
@@ -0,0 +1,574 @@
+IMPLEMENTATION MODULE AdvSystem ;
+
+FROM ASCII IMPORT nul, cr, lf, bs ;
+FROM StdIO IMPORT PushOutput, PopOutput ;
+FROM libc IMPORT printf, write, read ;
+FROM StrLib IMPORT StrLen ;
+FROM SYSTEM IMPORT ADR ;
+FROM Debug IMPORT Halt ;
+FROM TimerHandler IMPORT GetTicks, TicksPerSecond ;
+FROM RTint IMPORT InitInputVector, InitOutputVector ;
+FROM COROUTINES IMPORT PROTECTION ;
+
+FROM Executive IMPORT GetCurrentProcess, DESCRIPTOR, SEMAPHORE,
+ Resume, InitProcess, InitSemaphore, Wait, Signal,
+ WaitForIO ;
+
+FROM Lock IMPORT InitLock, GetReadAccess, GetWriteAccess, LOCK,
+ ReleaseReadAccess, ReleaseWriteAccess ;
+FROM ProcArgs IMPORT ProcessArgs, InitArgs, SetArgs, CollectArgs ;
+FROM Storage IMPORT ALLOCATE, DEALLOCATE ;
+FROM AdvUtil IMPORT NormalArrow, MagicArrow ;
+
+
+CONST
+ MaxNoOfProcesses = MaxNoOfPlayers*3 + 1 ;
+ ArrowProcessSize = 30 * 1024 * 1024 ;
+
+TYPE
+ ProcPlayer = RECORD
+ process : DESCRIPTOR ;
+ playerId: CARDINAL ;
+ END ;
+
+VAR
+ GlobalFd : INTEGER ;
+ ScreenQ : SEMAPHORE ;
+ PlayerLock : LOCK ;
+ DoorLock : LOCK ;
+ TreasureLock : LOCK ;
+ AccessToRandom: SEMAPHORE ;
+ RandomCount : CARDINAL ;
+ ProcToPlay : ARRAY [0..MaxNoOfPlayers] OF ProcPlayer ;
+ PArgs : ProcessArgs ;
+
+(*
+ AssignOutputTo - assigns the current process to be associated with
+ player, p.
+*)
+
+PROCEDURE AssignOutputTo (p: CARDINAL) ;
+VAR
+ i: CARDINAL ;
+BEGIN
+ i := 0 ;
+ WHILE i<MaxNoOfProcesses DO
+ WITH ProcToPlay[i] DO
+ IF process=NIL
+ THEN
+ process := GetCurrentProcess() ;
+ playerId := p ;
+ RETURN
+ ELSIF process=GetCurrentProcess()
+ THEN
+ playerId := p ;
+ RETURN
+ END
+ END ;
+ INC(i)
+ END ;
+ Halt(__FILE__, __LINE__, __FUNCTION__, 'increase MaxNoOfProcesses')
+END AssignOutputTo ;
+
+
+(*
+ UnAssign - unassign the current process from any player.
+*)
+
+PROCEDURE UnAssign ;
+VAR
+ i: CARDINAL ;
+BEGIN
+ i := 0 ;
+ WHILE i<MaxNoOfProcesses DO
+ WITH ProcToPlay[i] DO
+ IF process=GetCurrentProcess()
+ THEN
+ process := NIL ;
+ RETURN
+ END
+ END ;
+ INC(i)
+ END
+END UnAssign ;
+
+
+(*
+ ProcessToPlayer - returns the player associated with the current process.
+*)
+
+PROCEDURE ProcessToPlayer () : CARDINAL ;
+VAR
+ i: CARDINAL ;
+BEGIN
+ i := 0 ;
+ WHILE i<MaxNoOfProcesses DO
+ WITH ProcToPlay[i] DO
+ IF process=GetCurrentProcess()
+ THEN
+ RETURN( playerId )
+ END
+ END ;
+ INC(i)
+ END ;
+ Halt(__FILE__, __LINE__, __FUNCTION__,
+ 'process has never has a player assigned to its output')
+END ProcessToPlayer ;
+
+
+(*
+ checkStatus -
+*)
+
+PROCEDURE checkStatus (r: INTEGER) ;
+VAR
+ p: CARDINAL ;
+BEGIN
+ IF r<1
+ THEN
+ r := printf("WriteS client has gone away - tidying up\n") ;
+ p := ProcessToPlayer() ;
+ WITH Player[p] DO
+ fd := -1 ;
+ IF DeathType=living
+ THEN
+ DeathType := exitdungeon
+ END
+ END
+ END
+END checkStatus ;
+
+
+PROCEDURE localWrite (fd: INTEGER; ch: CHAR) ;
+VAR
+ r: INTEGER ;
+BEGIN
+ IF fd>=0
+ THEN
+ WaitForIO(InitOutputVector(fd, MAX(PROTECTION))) ;
+ checkStatus(write(fd, ADR(ch), SIZE(ch)))
+ END
+END localWrite ;
+
+
+PROCEDURE localWriteS (fd: INTEGER; s: ARRAY OF CHAR) ;
+VAR
+ r: INTEGER ;
+BEGIN
+ IF fd>=0
+ THEN
+ checkStatus(write(fd, ADR(s), StrLen(s)))
+ END
+END localWriteS ;
+
+
+PROCEDURE ReadString (VAR s: ARRAY OF CHAR) ;
+VAR
+ r: INTEGER ;
+ h: CARDINAL ;
+BEGIN
+ h := 0 ;
+ WHILE h<HIGH(s) DO
+ IF ClientRead(s[h])
+ THEN
+ IF (s[h]=lf) OR (s[h]=cr) OR (s[h]=nul)
+ THEN
+ s[h] := nul ;
+ RETURN
+ ELSIF s[h]=bs
+ THEN
+ IF h>0
+ THEN
+ WriteChar(bs) ;
+ DEC(h)
+ END
+ ELSE
+ WriteChar(s[h]) ;
+ INC(h)
+ END
+ ELSE
+ s[h] := nul ;
+ RETURN
+ END
+ END ;
+ IF (s[h]=lf) OR (s[h]=cr)
+ THEN
+ s[h] := nul
+ END
+END ReadString ;
+
+
+(*
+ DefaultWrite - writes to the default (local) file descriptor.
+*)
+
+PROCEDURE DefaultWrite (ch: CHAR) ;
+VAR
+ p: CARDINAL ;
+BEGIN
+ p := ProcessToPlayer() ;
+ localWrite(Player[p].fd, ch)
+END DefaultWrite ;
+
+
+PROCEDURE ClientRead (VAR ch: CHAR) : BOOLEAN ;
+VAR
+ r: INTEGER ;
+BEGIN
+ WITH Player[PlayerNo()] DO
+ IF fd>=0
+ THEN
+ WaitForIO(InitInputVector(fd, MAX(PROTECTION))) ;
+ r := read(fd, ADR(ch), SIZE(ch)) ;
+ checkStatus(r) ;
+ RETURN( r=1 )
+ ELSE
+ RETURN( FALSE )
+ END
+ END ;
+END ClientRead ;
+
+
+PROCEDURE WriteChar (ch: CHAR) ;
+VAR
+ r: INTEGER ;
+BEGIN
+ WITH Player[PlayerNo()] DO
+ IF fd>=0
+ THEN
+ IF ch=bs
+ THEN
+ localWriteS(fd, 'eC')
+ ELSE
+ localWriteS(fd, 'dC ') ;
+ localWrite(fd, ch)
+ END ;
+ localWrite(fd, lf)
+ END
+ END ;
+END WriteChar ;
+
+
+PROCEDURE PlayerNo () : CARDINAL ;
+VAR
+ i: CARDINAL ;
+BEGIN
+ FOR i := 0 TO NextFreePlayer-1 DO
+ IF GetCurrentProcess()=Player[i].PlayerProcess
+ THEN
+ RETURN( i )
+ END
+ END ;
+ Halt(__FILE__, __LINE__, __FUNCTION__,
+ 'process calling is not a player process')
+END PlayerNo ;
+
+
+(*
+ IsaPlayer -
+*)
+
+PROCEDURE IsaPlayer (d: DESCRIPTOR) : BOOLEAN ;
+VAR
+ i: CARDINAL ;
+BEGIN
+ FOR i := 0 TO NextFreePlayer-1 DO
+ IF Player[i].PlayerProcess=d
+ THEN
+ RETURN( TRUE )
+ END
+ END ;
+ RETURN( FALSE )
+END IsaPlayer ;
+
+
+(*
+ FindFreePlayer -
+*)
+
+PROCEDURE FindFreePlayer () : INTEGER ;
+VAR
+ i : INTEGER ;
+ pc: POINTER TO CARDINAL ;
+BEGIN
+ IF NextFreePlayer<=MaxNoOfPlayers
+ THEN
+ IF NextFreePlayer>0
+ THEN
+ (* reuse an old player who has left the game *)
+ FOR i := 0 TO NextFreePlayer-1 DO
+ WITH Player[i] DO
+ IF fd=-1
+ THEN
+ Weight := ManWeight ;
+ TreasureOwn := {} ;
+ RETURN( i )
+ END
+ END
+ END
+ END ;
+ i := NextFreePlayer ;
+ INC(NextFreePlayer) ;
+ WITH Player[i] DO
+ Weight := ManWeight ;
+ TreasureOwn := {} ;
+ NormalProcArgs := InitArgs() ;
+ MagicProcArgs := InitArgs() ;
+ NEW(pc) ;
+ pc^ := i ;
+ MagicP := Resume(InitProcess(MagicArrowP, ArrowProcessSize, 'Magic Arrow')) ;
+ pc := SetArgs(PArgs, pc) ;
+ NormalP := Resume(InitProcess(NormalArrowP, ArrowProcessSize, 'Normal Arrow')) ;
+ NEW(pc) ;
+ pc^ := i ;
+ pc := SetArgs(PArgs, pc)
+ END ;
+ RETURN( i )
+ ELSE
+ RETURN( -1 )
+ END
+END FindFreePlayer ;
+
+
+(*
+ IsPlayerActive - returns TRUE if player, p, is still playing
+*)
+
+PROCEDURE IsPlayerActive (p: CARDINAL) : BOOLEAN ;
+BEGIN
+ RETURN( (p<NextFreePlayer) AND (Player[p].fd#-1) )
+END IsPlayerActive ;
+
+
+PROCEDURE NormalArrowP ;
+VAR
+ pc: POINTER TO CARDINAL ;
+BEGIN
+ pc := CollectArgs(PArgs) ;
+ LOOP
+ NormalArrow(pc^)
+ END
+END NormalArrowP ;
+
+
+PROCEDURE MagicArrowP ;
+VAR
+ pc: POINTER TO CARDINAL ;
+BEGIN
+ pc := CollectArgs(PArgs) ;
+ LOOP
+ MagicArrow(pc^)
+ END
+END MagicArrowP ;
+
+
+PROCEDURE StartPlayer (f: INTEGER) ;
+VAR
+ i : INTEGER ;
+BEGIN
+ i := FindFreePlayer() ;
+ IF i=-1
+ THEN
+ (* write an error message to fd *)
+ ELSE
+ WITH Player[i] DO
+ fd := f ;
+ PlayerProcess := GetCurrentProcess() ;
+ DeathType := living ;
+ Wounds := 100 ;
+ Fatigue := 100 ;
+ Direction := 0 ;
+ TimeMinSec(LastSecWounds) ;
+ LastSecFatigue := GetTicks() DIV (TicksPerSecond DIV 2)
+ END
+ END
+END StartPlayer ;
+
+
+PROCEDURE Init ;
+BEGIN
+ PlayerLock := InitLock('player lock') ;
+ ScreenQ := InitSemaphore(1, 'ScreenQ') ;
+ DoorLock := InitLock('DoorLock') ;
+ TreasureLock := InitLock('TreasureLock') ;
+ AccessToRandom := InitSemaphore(1, 'AccessToRandom') ;
+ PArgs := InitArgs() ;
+ TimeMinSec (RandomCount) ;
+ NextFreePlayer := 0 ;
+ PushOutput (DefaultWrite)
+END Init ;
+
+
+PROCEDURE TimeMinSec (VAR MinSec: CARDINAL) ;
+BEGIN
+ MinSec := GetTicks() DIV TicksPerSecond
+END TimeMinSec ;
+
+
+PROCEDURE RandomNumber (VAR r: CARDINAL; n: CARDINAL) ;
+VAR
+ ms: CARDINAL ;
+BEGIN
+ IF n=1
+ THEN
+ r := 0
+ ELSE
+ Wait( AccessToRandom ) ;
+ r := RandomCount MOD n ;
+
+ ms := RandomCount MOD 256 ;
+ RandomCount := ms*256+ms ; (* multiply by 257 *)
+
+ IF (MAX(CARDINAL)-RandomCount) >= 0ABCDH (* Add 0ABCDH *)
+ THEN
+ INC( RandomCount, 0ABCDH )
+ ELSE
+ DEC( RandomCount, (MAX(CARDINAL)-0ABCDH) )
+ END ;
+
+ Signal( AccessToRandom ) ;
+
+ (* Returns a number 1..n *)
+ END
+END RandomNumber ;
+
+
+
+(* The rules which govern the allocation of these resourses are *)
+
+(* 1) One may claim multiple resourses in the following order: *)
+(* AccessPlayer *)
+(* AccessDoor *)
+(* AccessTreasure *)
+(* AccessScreen *)
+(* GetTime - Procedure NOT lock! *)
+(* *)
+(* All r/w - doesn't matter! *)
+(* *)
+(* 2) Must never reverse this claiming or DEADLOCK may occur. *)
+(* *)
+(* 3) Must access players in order ie 0 1 2 *)
+
+
+
+(*
+ * Access To Players
+ *)
+
+PROCEDURE GetReadAccessToPlayer ;
+BEGIN
+ GetReadAccess(PlayerLock)
+END GetReadAccessToPlayer ;
+
+
+PROCEDURE GetWriteAccessToPlayer ;
+BEGIN
+ GetWriteAccess(PlayerLock)
+END GetWriteAccessToPlayer ;
+
+
+PROCEDURE ReleaseReadAccessToPlayer ;
+BEGIN
+ ReleaseReadAccess(PlayerLock)
+END ReleaseReadAccessToPlayer ;
+
+
+PROCEDURE ReleaseWriteAccessToPlayer ;
+BEGIN
+ ReleaseWriteAccess(PlayerLock)
+END ReleaseWriteAccessToPlayer ;
+
+
+(*
+ * Access To Doors
+ *)
+
+PROCEDURE GetReadAccessToDoor ;
+BEGIN
+ GetReadAccess(DoorLock)
+END GetReadAccessToDoor ;
+
+
+PROCEDURE GetWriteAccessToDoor ;
+BEGIN
+ GetWriteAccess(DoorLock)
+END GetWriteAccessToDoor ;
+
+
+PROCEDURE ReleaseReadAccessToDoor ;
+BEGIN
+ ReleaseReadAccess(DoorLock)
+END ReleaseReadAccessToDoor ;
+
+
+PROCEDURE ReleaseWriteAccessToDoor ;
+BEGIN
+ ReleaseWriteAccess(DoorLock)
+END ReleaseWriteAccessToDoor ;
+
+
+(*
+ * Access To Treasures
+ *)
+
+PROCEDURE GetReadAccessToTreasure ;
+BEGIN
+ GetReadAccess(TreasureLock)
+END GetReadAccessToTreasure ;
+
+
+PROCEDURE GetWriteAccessToTreasure ;
+BEGIN
+ GetWriteAccess(TreasureLock)
+END GetWriteAccessToTreasure ;
+
+
+PROCEDURE ReleaseReadAccessToTreasure ;
+BEGIN
+ ReleaseReadAccess(TreasureLock)
+END ReleaseReadAccessToTreasure ;
+
+
+PROCEDURE ReleaseWriteAccessToTreasure ;
+BEGIN
+ ReleaseWriteAccess(TreasureLock)
+END ReleaseWriteAccessToTreasure ;
+
+
+(*
+ * Access To Screen
+ *)
+
+PROCEDURE GetAccessToScreen ;
+BEGIN
+ GetAccessToScreenNo(PlayerNo())
+END GetAccessToScreen ;
+
+
+PROCEDURE ReleaseAccessToScreen ;
+BEGIN
+ ReleaseAccessToScreenNo(PlayerNo())
+END ReleaseAccessToScreen ;
+
+
+PROCEDURE GetAccessToScreenNo (p: CARDINAL) ;
+BEGIN
+ AssignOutputTo(p) ;
+ Wait(ScreenQ)
+END GetAccessToScreenNo ;
+
+
+PROCEDURE ReleaseAccessToScreenNo (p: CARDINAL) ;
+BEGIN
+ Signal(ScreenQ)
+END ReleaseAccessToScreenNo ;
+
+
+BEGIN
+ Init
+END AdvSystem.
+(*
+ * Local variables:
+ * compile-command: "make"
+ * End:
+ *)
diff --git a/gcc/testsuite/gm2/projects/pim/run/pass/tower/AdvTreasure.def b/gcc/testsuite/gm2/projects/pim/run/pass/tower/AdvTreasure.def
new file mode 100644
index 00000000000..47e9f8c0519
--- /dev/null
+++ b/gcc/testsuite/gm2/projects/pim/run/pass/tower/AdvTreasure.def
@@ -0,0 +1,22 @@
+DEFINITION MODULE AdvTreasure ;
+
+FROM AdvMap IMPORT TreasureKind ;
+
+EXPORT QUALIFIED GetTreasure, DropTreasure, UseTreasure,
+ Grenade, DisplayEnemy, ScatterTreasures,
+ RespawnTreasure, RespawnArrow ;
+
+
+PROCEDURE GetTreasure ;
+PROCEDURE DropTreasure ;
+PROCEDURE UseTreasure ;
+PROCEDURE Grenade ;
+PROCEDURE DisplayEnemy ;
+PROCEDURE ScatterTreasures (p, r: CARDINAL) ;
+PROCEDURE RespawnTreasu[...]
[diff truncated at 524288 bytes]
^ permalink raw reply [flat|nested] only message in thread
only message in thread, other threads:[~2023-02-25 16:29 UTC | newest]
Thread overview: (only message) (download: mbox.gz / follow: Atom feed)
-- links below jump to the message on this page --
2023-02-25 16:29 [gcc r13-6343] modula-2 module registration process seems to fail with shared libraries [PR108261] Gaius Mulley
This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).