aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorGaius Mulley <gaiusmod2@gmail.com>2023-02-25 16:28:19 +0000
committerGaius Mulley <gaiusmod2@gmail.com>2023-02-25 16:28:19 +0000
commit05652ac4e8b8685fe0c0f4ee2f75516d28bbf892 (patch)
tree37d3bf0f0a89774a4733b706ddaf3cff5447b182
parent461d3c84a0e5ad045ee54631901cc953d6befa20 (diff)
downloadgcc-05652ac4e8b8685fe0c0f4ee2f75516d28bbf892.zip
gcc-05652ac4e8b8685fe0c0f4ee2f75516d28bbf892.tar.gz
gcc-05652ac4e8b8685fe0c0f4ee2f75516d28bbf892.tar.bz2
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>
-rw-r--r--gcc/doc/gm2.texi27
-rw-r--r--gcc/m2/Make-lang.in12
-rw-r--r--gcc/m2/Make-maintainer.in97
-rw-r--r--gcc/m2/gm2-compiler/DynamicPath.def (renamed from gcc/m2/gm2-compiler/DynamicStringPath.def)45
-rw-r--r--gcc/m2/gm2-compiler/DynamicPath.mod (renamed from gcc/m2/gm2-compiler/DynamicStringPath.mod)82
-rw-r--r--gcc/m2/gm2-compiler/M2AsmUtil.mod46
-rw-r--r--gcc/m2/gm2-compiler/M2Comp.mod64
-rw-r--r--gcc/m2/gm2-compiler/M2Graph.mod12
-rw-r--r--gcc/m2/gm2-compiler/M2Options.def32
-rw-r--r--gcc/m2/gm2-compiler/M2Options.mod61
-rw-r--r--gcc/m2/gm2-compiler/M2Quads.mod47
-rw-r--r--gcc/m2/gm2-compiler/M2Scaffold.mod34
-rw-r--r--gcc/m2/gm2-compiler/M2Search.def10
-rw-r--r--gcc/m2/gm2-compiler/M2Search.mod40
-rw-r--r--gcc/m2/gm2-compiler/PathName.def104
-rw-r--r--gcc/m2/gm2-compiler/PathName.mod279
-rw-r--r--gcc/m2/gm2-compiler/SymbolTable.def17
-rw-r--r--gcc/m2/gm2-compiler/SymbolTable.mod87
-rw-r--r--gcc/m2/gm2-gcc/init.cc6
-rw-r--r--gcc/m2/gm2-gcc/m2decl.cc4
-rw-r--r--gcc/m2/gm2-gcc/m2options.h4
-rw-r--r--gcc/m2/gm2-lang.cc62
-rw-r--r--gcc/m2/gm2-libs-iso/M2RTS.def9
-rw-r--r--gcc/m2/gm2-libs-iso/M2RTS.mod20
-rw-r--r--gcc/m2/gm2-libs-iso/wrapsock.c260
-rw-r--r--gcc/m2/gm2-libs-iso/wraptime.c292
-rw-r--r--gcc/m2/gm2-libs-min/M2RTS.def26
-rw-r--r--gcc/m2/gm2-libs-min/M2RTS.mod43
-rw-r--r--gcc/m2/gm2-libs/M2Dependent.def14
-rw-r--r--gcc/m2/gm2-libs/M2Dependent.mod381
-rw-r--r--gcc/m2/gm2-libs/M2RTS.def9
-rw-r--r--gcc/m2/gm2-libs/M2RTS.mod20
-rw-r--r--gcc/m2/gm2-libs/RTint.mod399
-rw-r--r--gcc/m2/gm2-libs/libc.def10
-rw-r--r--gcc/m2/gm2-libs/sckt.def16
-rw-r--r--gcc/m2/gm2spec.cc64
-rw-r--r--gcc/m2/lang-specs.h7
-rw-r--r--gcc/m2/lang.opt14
-rw-r--r--gcc/m2/mc-boot-ch/GUnixArgs.cc4
-rw-r--r--gcc/m2/mc-boot-ch/Glibc.c36
-rw-r--r--gcc/m2/mc-boot-ch/m2rts.h5
-rw-r--r--gcc/m2/mc-boot/GDynamicStrings.c32
-rw-r--r--gcc/m2/mc-boot/GFIO.c20
-rw-r--r--gcc/m2/mc-boot/GIndexing.c6
-rw-r--r--gcc/m2/mc-boot/GM2Dependent.c450
-rw-r--r--gcc/m2/mc-boot/GM2Dependent.h13
-rw-r--r--gcc/m2/mc-boot/GM2EXCEPTION.c4
-rw-r--r--gcc/m2/mc-boot/GM2RTS.c24
-rw-r--r--gcc/m2/mc-boot/GM2RTS.h8
-rw-r--r--gcc/m2/mc-boot/GPushBackInput.c6
-rw-r--r--gcc/m2/mc-boot/GRTExceptions.c34
-rw-r--r--gcc/m2/mc-boot/GRTint.c20
-rw-r--r--gcc/m2/mc-boot/GStdIO.c4
-rw-r--r--gcc/m2/mc-boot/GStringConvert.c4
-rw-r--r--gcc/m2/mc-boot/GSysStorage.c6
-rw-r--r--gcc/m2/mc-boot/Gdecl.c141
-rw-r--r--gcc/m2/mc-boot/Gkeyc.c2
-rw-r--r--gcc/m2/mc-boot/Glibc.h1
-rw-r--r--gcc/m2/mc-boot/GmcComment.c2
-rw-r--r--gcc/m2/mc-boot/GmcComp.c4
-rw-r--r--gcc/m2/mc-boot/GmcDebug.c2
-rw-r--r--gcc/m2/mc-boot/GmcMetaError.c8
-rw-r--r--gcc/m2/mc-boot/GmcStack.c4
-rw-r--r--gcc/m2/mc-boot/GnameKey.c4
-rw-r--r--gcc/m2/mc-boot/Gpth.h43
-rw-r--r--gcc/m2/mc-boot/GsymbolKey.c6
-rw-r--r--gcc/m2/pge-boot/GASCII.c2
-rw-r--r--gcc/m2/pge-boot/GArgs.c2
-rw-r--r--gcc/m2/pge-boot/GAssertion.c2
-rw-r--r--gcc/m2/pge-boot/GDebug.c2
-rw-r--r--gcc/m2/pge-boot/GDynamicStrings.c34
-rw-r--r--gcc/m2/pge-boot/GFIO.c22
-rw-r--r--gcc/m2/pge-boot/GIO.c2
-rw-r--r--gcc/m2/pge-boot/GIndexing.c8
-rw-r--r--gcc/m2/pge-boot/GLists.c2
-rw-r--r--gcc/m2/pge-boot/GM2Dependent.c454
-rw-r--r--gcc/m2/pge-boot/GM2Dependent.h15
-rw-r--r--gcc/m2/pge-boot/GM2EXCEPTION.c6
-rw-r--r--gcc/m2/pge-boot/GM2RTS.c76
-rw-r--r--gcc/m2/pge-boot/GM2RTS.h73
-rw-r--r--gcc/m2/pge-boot/GNameKey.c6
-rw-r--r--gcc/m2/pge-boot/GNumberIO.c2
-rw-r--r--gcc/m2/pge-boot/GOutput.c2
-rw-r--r--gcc/m2/pge-boot/GPushBackInput.c8
-rw-r--r--gcc/m2/pge-boot/GRTExceptions.c42
-rw-r--r--gcc/m2/pge-boot/GSFIO.c2
-rw-r--r--gcc/m2/pge-boot/GStdIO.c6
-rw-r--r--gcc/m2/pge-boot/GStorage.c2
-rw-r--r--gcc/m2/pge-boot/GStrCase.c2
-rw-r--r--gcc/m2/pge-boot/GStrIO.c2
-rw-r--r--gcc/m2/pge-boot/GStrLib.c2
-rw-r--r--gcc/m2/pge-boot/GSymbolKey.c8
-rw-r--r--gcc/m2/pge-boot/GSysExceptions.c2
-rw-r--r--gcc/m2/pge-boot/GSysStorage.c8
-rw-r--r--gcc/m2/pge-boot/GUnixArgs.cc4
-rw-r--r--gcc/m2/pge-boot/Gbnflex.c2
-rw-r--r--gcc/m2/pge-boot/Gerrno.c2
-rw-r--r--gcc/m2/pge-boot/Glibc.c37
-rw-r--r--gcc/m2/pge-boot/Glibc.h1
-rw-r--r--gcc/m2/pge-boot/Gpge.c2
-rw-r--r--gcc/m2/pge-boot/Gtermios.cc2
-rw-r--r--gcc/m2/pge-boot/main.c116
-rw-r--r--gcc/m2/plugin/m2rte.cc73
-rw-r--r--gcc/testsuite/gm2/examples/callingC/pass/examples-callingC-pass.exp2
-rw-r--r--gcc/testsuite/gm2/examples/callingC/run/pass/examples-callingC-run-pass.exp2
-rw-r--r--gcc/testsuite/gm2/examples/cpp/pass/examples-cpp-pass.exp2
-rw-r--r--gcc/testsuite/gm2/examples/cppDef/pass/examples-cppDef-pass.exp2
-rw-r--r--gcc/testsuite/gm2/examples/hello/pass/examples-hello-pass.exp2
-rw-r--r--gcc/testsuite/gm2/examples/map/pass/examples-map-pass.exp2
-rw-r--r--gcc/testsuite/gm2/iso/check/fail/iso-check-fail.exp2
-rw-r--r--gcc/testsuite/gm2/link/externalscaffold/pass/link-externalscaffold-pass.exp2
-rw-r--r--gcc/testsuite/gm2/link/externalscaffold/pass/scaffold.c26
-rw-r--r--gcc/testsuite/gm2/pimlib/base/run/pass/FIO.mod181
-rw-r--r--gcc/testsuite/gm2/pimlib/base/run/pass/StrLib.mod99
-rw-r--r--gcc/testsuite/gm2/pimlib/base/run/pass/pimlib-base-run-pass.exp2
-rw-r--r--gcc/testsuite/gm2/projects/pim/run/pass/random/projects-pim-run-pass-random.exp2
-rw-r--r--gcc/testsuite/gm2/projects/pim/run/pass/tower/AdvCmd.def10
-rw-r--r--gcc/testsuite/gm2/projects/pim/run/pass/tower/AdvCmd.mod294
-rw-r--r--gcc/testsuite/gm2/projects/pim/run/pass/tower/AdvIntroduction.def7
-rw-r--r--gcc/testsuite/gm2/projects/pim/run/pass/tower/AdvIntroduction.mod275
-rw-r--r--gcc/testsuite/gm2/projects/pim/run/pass/tower/AdvMap.def82
-rw-r--r--gcc/testsuite/gm2/projects/pim/run/pass/tower/AdvMap.mod57
-rw-r--r--gcc/testsuite/gm2/projects/pim/run/pass/tower/AdvMath.def120
-rw-r--r--gcc/testsuite/gm2/projects/pim/run/pass/tower/AdvMath.mod220
-rw-r--r--gcc/testsuite/gm2/projects/pim/run/pass/tower/AdvParse.bnf379
-rw-r--r--gcc/testsuite/gm2/projects/pim/run/pass/tower/AdvParse.def18
-rw-r--r--gcc/testsuite/gm2/projects/pim/run/pass/tower/AdvParse.mod873
-rw-r--r--gcc/testsuite/gm2/projects/pim/run/pass/tower/AdvSound.def70
-rw-r--r--gcc/testsuite/gm2/projects/pim/run/pass/tower/AdvSound.mod143
-rw-r--r--gcc/testsuite/gm2/projects/pim/run/pass/tower/AdvSystem.def189
-rw-r--r--gcc/testsuite/gm2/projects/pim/run/pass/tower/AdvSystem.mod574
-rw-r--r--gcc/testsuite/gm2/projects/pim/run/pass/tower/AdvTreasure.def22
-rw-r--r--gcc/testsuite/gm2/projects/pim/run/pass/tower/AdvTreasure.mod1632
-rw-r--r--gcc/testsuite/gm2/projects/pim/run/pass/tower/AdvUtil.def57
-rw-r--r--gcc/testsuite/gm2/projects/pim/run/pass/tower/AdvUtil.mod1573
-rw-r--r--gcc/testsuite/gm2/projects/pim/run/pass/tower/DrawG.def36
-rw-r--r--gcc/testsuite/gm2/projects/pim/run/pass/tower/DrawG.mod327
-rw-r--r--gcc/testsuite/gm2/projects/pim/run/pass/tower/DrawL.def23
-rw-r--r--gcc/testsuite/gm2/projects/pim/run/pass/tower/DrawL.mod422
-rw-r--r--gcc/testsuite/gm2/projects/pim/run/pass/tower/Dungeon.mod34
-rw-r--r--gcc/testsuite/gm2/projects/pim/run/pass/tower/Lock.def27
-rw-r--r--gcc/testsuite/gm2/projects/pim/run/pass/tower/Lock.mod75
-rw-r--r--gcc/testsuite/gm2/projects/pim/run/pass/tower/ProcArgs.def15
-rw-r--r--gcc/testsuite/gm2/projects/pim/run/pass/tower/ProcArgs.mod58
-rw-r--r--gcc/testsuite/gm2/projects/pim/run/pass/tower/Screen.def55
-rw-r--r--gcc/testsuite/gm2/projects/pim/run/pass/tower/Screen.mod303
-rw-r--r--gcc/testsuite/gm2/projects/pim/run/pass/tower/SocketControl.c27
-rw-r--r--gcc/testsuite/gm2/projects/pim/run/pass/tower/SocketControl.def6
-rw-r--r--gcc/testsuite/gm2/projects/pim/run/pass/tower/Window.def16
-rw-r--r--gcc/testsuite/gm2/projects/pim/run/pass/tower/Window.mod62
-rw-r--r--gcc/testsuite/gm2/projects/pim/run/pass/tower/adv.flex266
-rw-r--r--gcc/testsuite/gm2/projects/pim/run/pass/tower/advflex.c2107
-rw-r--r--gcc/testsuite/gm2/projects/pim/run/pass/tower/advflex.def32
-rw-r--r--gcc/testsuite/gm2/projects/pim/run/pass/tower/projects-pim-run-pass-tower.exp110
-rw-r--r--gcc/testsuite/gm2/projects/pim/run/pass/tower/star71
-rw-r--r--gcc/testsuite/gm2/switches/auto-init/fail/switches-auto-init-fail.exp2
-rw-r--r--gcc/testsuite/gm2/switches/check-all/pim2/fail/switches-check-all-pim2-fail.exp2
-rw-r--r--gcc/testsuite/gm2/switches/makeall/fail/switches-makeall-fail.exp2
-rw-r--r--gcc/testsuite/gm2/switches/makeall/pass/switches-makeall-pass.exp1
-rw-r--r--gcc/testsuite/lib/gm2-simple.exp9
-rw-r--r--gcc/testsuite/lib/gm2-torture.exp18
-rw-r--r--gcc/testsuite/lib/gm2.exp52
-rw-r--r--libgm2/libm2cor/KeyBoardLEDs.cc42
-rw-r--r--libgm2/libm2cor/Makefile.am6
-rw-r--r--libgm2/libm2cor/Makefile.in7
-rw-r--r--libgm2/libm2iso/ErrnoCategory.cc27
-rw-r--r--libgm2/libm2iso/Makefile.am19
-rw-r--r--libgm2/libm2iso/Makefile.in33
-rw-r--r--libgm2/libm2iso/RTco.cc117
-rw-r--r--libgm2/libm2iso/m2rts.h26
-rw-r--r--libgm2/libm2iso/wrapsock.c52
-rw-r--r--libgm2/libm2iso/wraptime.cc (renamed from libgm2/libm2iso/wraptime.c)189
-rw-r--r--libgm2/libm2log/Makefile.am7
-rw-r--r--libgm2/libm2log/Makefile.in8
-rw-r--r--libgm2/libm2min/Makefile.am6
-rw-r--r--libgm2/libm2min/Makefile.in6
-rw-r--r--libgm2/libm2pim/Makefile.am7
-rw-r--r--libgm2/libm2pim/Makefile.in19
-rw-r--r--libgm2/libm2pim/Selective.cc77
-rw-r--r--libgm2/libm2pim/SysExceptions.cc22
-rw-r--r--libgm2/libm2pim/UnixArgs.cc30
-rw-r--r--libgm2/libm2pim/cgetopt.cc63
-rw-r--r--libgm2/libm2pim/dtoa.cc35
-rw-r--r--libgm2/libm2pim/errno.cc19
-rw-r--r--libgm2/libm2pim/ldtoa.cc36
-rw-r--r--libgm2/libm2pim/sckt.cc49
-rw-r--r--libgm2/libm2pim/termios.cc18
-rw-r--r--libgm2/libm2pim/wrapc.cc (renamed from libgm2/libm2pim/wrapc.c)92
188 files changed, 14335 insertions, 2438 deletions
diff --git a/gcc/doc/gm2.texi b/gcc/doc/gm2.texi
index 5b1858b..07729f8 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 d1d02a0..92a413b 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 d2339b3..f6b12ac 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
index e9fdff7..f3bc85a 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 ;
@@ -33,34 +33,6 @@ TYPE
(*
- 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
index 601456e..3eba52f 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 da42414..85bbceb 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 3c2c364..a2a7797 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 ;
@@ -226,6 +229,19 @@ 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 7140d28..f574981 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 dd26984..67b92fa 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 865b857..95dc607 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,
@@ -117,6 +121,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 17062b9..3802b99 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 a2a6250..c0f0efd 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 3d17237..e77c754 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 9c78c80..80806bf 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 0000000..39d9b15
--- /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 0000000..6fc7612
--- /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 c6c39d9..c7f584b 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 cc1a874..92f1f1e 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. *)
@@ -3654,6 +3671,52 @@ 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 a9dfcc7..834a84e 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 ab40937..eb3d98d 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 92b4fd5..7f5173c 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 d9b63be..162baf7 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 cca4ae6..343dab7 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 cbe70a9..a59735a 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 6d032ee..0000000
--- 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 dafdb66..0000000
--- 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 65ffa8c..1952d91 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 e6043bc..1765531 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 5345708..4b77a07 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 f343ac3..cc7e9cf 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,16 +365,50 @@ 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
@@ -529,48 +628,98 @@ 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.
*)
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
@@ -699,22 +854,51 @@ 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 167f964..ca6010b 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 4280fec..d01f6a6 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 d8ca8dd..97fdee2 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 120a9d0..21c790e 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 ;
@@ -361,6 +362,13 @@ 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,
is true. It returns 0 on success and -1 for an error.
diff --git a/gcc/m2/gm2-libs/sckt.def b/gcc/m2/gm2-libs/sckt.def
index 6be7db8..ac51110 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 0645be9..a118a88 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 65004e1..a564779 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 b6ef816..691a75f 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 29b8ec2..815abc3 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 7a37fef..b94aae3 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 09d55f4..d9f3be4 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 dfc1636..2099c2b 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 1ae6bb6..4a6056f 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 0817ff3..f6ec582 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 0057018..64441ff 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
@@ -207,6 +222,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 -
@@ -256,6 +277,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 +303,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,12 +693,47 @@ 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)
{
@@ -809,52 +942,110 @@ 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.
*/
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,13 +1078,40 @@ 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 903f10d..068bbfe 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 387b047..a7b8865 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 8a65ae2..2e8680c 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 8e95e9c..eb1025c 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 e15b3eb..895130e 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 23f8fed..f78a3cb 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 bc83e46..65c8c8a 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 41affe2..e5cc572 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 faa5e344..8858afc 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 98c03f6..3d37ecf 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 ff8298c..08eba89 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 e089ac9..4adcf30 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 daa0a1c..8c6cfd8 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.
diff --git a/gcc/m2/mc-boot/GmcComment.c b/gcc/m2/mc-boot/GmcComment.c
index 2e60c7a..c14beb1 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 8a79413..9362f90 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 db45ae8..26d8efd 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 4d40685..e56cad7 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 95d31a5..146c79d 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 b00a598..7bb1e8f 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 7619d7d..0000000
--- 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 8c16a63..c993097 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 f9779c0..077cdff 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 69fbdd0..819a46f 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 30bbe38..5088db4 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 a473324..4310684 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 7507eca..ed917cf 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 adcbae3..d3e6b4d 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 532b0a4..1d67056 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 81c66fc..428f22b 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 38538bd..45f0ffc 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 32c777c..0e0e3ea 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
@@ -208,6 +225,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 -
@@ -257,6 +280,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.
*/
@@ -271,6 +306,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,12 +696,47 @@ 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)
{
@@ -810,52 +945,110 @@ 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.
*/
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,13 +1081,40 @@ 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 903f10d..c820ae1 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 5a3ba4c..10de9b9 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 1fdd5eb..c6eb399 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 698f142..37cbb1a 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 13511cb..37d8c96 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 f65de59..0e058df 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 ddbc491..22ec0e7 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 70cb272..612e94a 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 84f6cca..8c2d35d 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 01994a5..4ecfec8 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 04af632..8b551aa 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 8d6661a..d3b8776 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 3ddb7a4..0e6b5be 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 0bea153..b8c42ac 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 21a9ccb..d5ae724 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 61c599e..51df5fc 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 9467009..4e60056 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 f2a7038..e008d91 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 4cd5d3c..29b8ec2 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 ac31e51..7f78b5d 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 26756f6..c65c486 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 3e9b486..e939565 100644
--- a/gcc/m2/pge-boot/Glibc.c
+++ b/gcc/m2/pge-boot/Glibc.c
@@ -116,6 +116,43 @@ libc_printf (char *_format, unsigned int _format_high, ...)
}
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 daa0a1c..f4e7691 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 7eaeccb..e889236 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 9522708..5660f97 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 3c7656a..b6f29f6 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 343384a..dcb9c6d 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 8cbba55..9e2e9f4 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 5a05546..0b5dea9 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 02a7321..3f3c0c5 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 d93940b..d4b3c62 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 93fc857..449c19e 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 ce2f8b3..ae29ed7 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 69a1fef..836760d 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 32d4315..81ee8e2 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 52f4cd1..2bd3587 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 6259b56..94a1833 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 4763569..f85040c 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 d025443..79640c2 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 012caa6..8fa3bee 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 0000000..166824e
--- /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 0000000..bc9a5bb
--- /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 0000000..834ebac
--- /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 0000000..3174764
--- /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 0000000..57b079a
--- /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 0000000..73336fe
--- /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 0000000..c6ec3e2
--- /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 0000000..d620665
--- /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 0000000..07802d0
--- /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 0000000..696e1d2
--- /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 0000000..6a5ca4c
--- /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 0000000..d59ee02
--- /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 0000000..1acad8b
--- /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 0000000..52a3e7b
--- /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 0000000..fc21516
--- /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 0000000..47e9f8c
--- /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 RespawnTreasure (seedRoom: CARDINAL; tno: CARDINAL; ticks: CARDINAL) ;
+PROCEDURE RespawnArrow (seedRoom: CARDINAL; tno: CARDINAL;
+ spawnKind, arrowKind: TreasureKind;
+ amount: CARDINAL; ticks: CARDINAL) ;
+
+
+END AdvTreasure.
diff --git a/gcc/testsuite/gm2/projects/pim/run/pass/tower/AdvTreasure.mod b/gcc/testsuite/gm2/projects/pim/run/pass/tower/AdvTreasure.mod
new file mode 100644
index 0000000..f5df8fc
--- /dev/null
+++ b/gcc/testsuite/gm2/projects/pim/run/pass/tower/AdvTreasure.mod
@@ -0,0 +1,1632 @@
+IMPLEMENTATION MODULE AdvTreasure ;
+
+
+FROM libc IMPORT printf ;
+FROM Executive IMPORT GetCurrentProcess, InitSemaphore, SEMAPHORE,
+ Wait, Signal, InitProcess, Resume, DESCRIPTOR ;
+FROM TimerHandler IMPORT Sleep, TicksPerSecond, EVENT, ReArmEvent, ArmEvent, WaitOn, Cancel ;
+
+FROM ASCII IMPORT cr ;
+FROM StrLib IMPORT StrCopy, StrConCat, StrLen ;
+FROM NumberIO IMPORT CardToStr, WriteCard ;
+FROM Storage IMPORT ALLOCATE ;
+FROM Assertion IMPORT Assert ;
+
+FROM AdvSystem IMPORT MaxNoOfPlayers,
+ ManWeight,
+ Man,
+ TypeOfDeath,
+ Player,
+ PlayerSet,
+ PlayerNo,
+ ArrowArgs,
+ StartPlayer,
+ TimeMinSec,
+ RandomNumber,
+ ClientRead,
+ DefaultWrite,
+ ReadString,
+ NextFreePlayer,
+ IsPlayerActive,
+ AssignOutputTo,
+
+ GetReadAccessToPlayer,
+ GetWriteAccessToPlayer,
+ ReleaseReadAccessToPlayer,
+ ReleaseWriteAccessToPlayer,
+
+ GetReadAccessToDoor,
+ GetWriteAccessToDoor,
+ ReleaseReadAccessToDoor,
+ ReleaseWriteAccessToDoor,
+
+ GetReadAccessToTreasure,
+ GetWriteAccessToTreasure,
+ ReleaseReadAccessToTreasure,
+ ReleaseWriteAccessToTreasure,
+
+ GetAccessToScreen,
+ ReleaseAccessToScreen,
+ GetAccessToScreenNo,
+ ReleaseAccessToScreenNo ;
+
+FROM AdvMap IMPORT Treasure, Rooms, DoorStatus, IncPosition,
+ NoOfRoomsToSpring,
+ NoOfRoomsToHideCoal, NoOfRoomsToHideGrenade,
+ TreasureKind, Treasure,
+ ActualNoOfRooms ;
+
+FROM AdvMath IMPORT MaxNoOfTreasures, LowFreePool, HighFreePool ;
+
+FROM Screen IMPORT Width, Height,
+ ClearScreen,
+ InitScreen,
+ WriteWounds,
+ WriteWeight,
+ WriteString,
+ WriteCommentLine1,
+ WriteCommentLine2,
+ WriteCommentLine3,
+ DelCommentLine1,
+ DelCommentLine2,
+ DelCommentLine3,
+ WriteArrows, WriteMagicArrows ;
+
+FROM AdvMath IMPORT MagicKey,
+ CrystalBall,
+ MagicSpring,
+ SackOfCoal1,
+ SackOfCoal2,
+ HotIron,
+ HandGrenade,
+ MagicSword,
+ MagicShoes,
+ SleepPotion,
+ LumpOfIron,
+ TreasTrove,
+ SpeedPotion,
+ MagicShield,
+ VisionChest,
+ QuiverNormal,
+ QuiverMagic,
+ HealingPotion,
+
+ UpDateWoundsAndFatigue,
+ DammageByHandGrenade,
+ DammageByHotIron ;
+
+
+FROM DrawG IMPORT DrawTreasure, EraseTreasure, EraseMan, DrawMan ;
+FROM DrawL IMPORT DrawRoom, DrawAllPlayers ;
+FROM AdvSound IMPORT Explode ;
+
+FROM AdvUtil IMPORT PointOnWall, GetDoorOnPoint, PointOnTreasure,
+ HideDoor, RandomRoom, PositionInRoom, InitialDisplay,
+ FreeOfPlayersAndTreasure, Dead ;
+
+
+
+(* Treasure routines. *)
+(* *)
+(* The treasures are as follows: *)
+(* *)
+(* 1: Magic Key - This treasures allows one to make a *)
+(* closed door into a secret door *)
+(* *)
+(* 2: Crystal Ball - This treasure allows one to get the *)
+(* direction and Room No of the other *)
+(* players *)
+(* *)
+(* 3: Magic Spring - When Grabbed, it springs one to another *)
+(* random picked room *)
+(* *)
+(* 4: Sack Of Coal - When Grabbed, it insists that it must *)
+(* be taken to a randomly picked room *)
+(* before it can be dropped *)
+(* *)
+(* 5: Sack Of Coal - Ditto *)
+(* *)
+(* 6: Hot Iron - Scolds one if picked up *)
+(* *)
+(* 7: Hand Grenade - If used will blow up whole room in *)
+(* 25 seconds *)
+(* *)
+(* 8: Magic Sword - Enables one to fight with ease *)
+(* *)
+(* 9: Magic Shoes - Enable one to run with minimal effort *)
+(* *)
+(* 10: Sleep Potion - Makes one fall to sleep for 24 seconds *)
+(* *)
+(* 11: Lump Of Iron - When picked up scatters all treasure in *)
+(* current room. *)
+(* *)
+(* 12: Treasure Trove - Tells one where or who has the *)
+(* treasures. *)
+(* *)
+(* 13: Speed Potion - Increases ones responce time. *)
+(* *)
+(* 14: Magic Shield - Repels Normal Arrows. *)
+(* *)
+(* 15: Vision Chest - Allows one to see enemies screen. *)
+
+
+CONST
+ respawnStack = 10 * 1024 * 1024 ;
+ RespawnArrowTime = 13 ; (* seconds delay between respawning more arrow treasures 16/17. *)
+ RespawnArrowInventory = 20 ; (* seconds delay between respawning inventory arrows after death. *)
+ RespawnMagicInventory = 30 ; (* seconds delay between respawning inventory magic arrows after death. *)
+
+TYPE
+ QDesc = POINTER TO RECORD
+ right: QDesc ;
+ Rm,
+ tno : CARDINAL ;
+ kind : TreasureKind ;
+ amount,
+ ticks : CARDINAL ;
+ END ;
+
+
+
+
+VAR
+ Tmessage : ARRAY [0..13] OF CHAR ;
+ SackOfCoal : ARRAY [0..1] OF CARDINAL ;
+ PinPulled : SEMAPHORE ;
+ PinHasBeenPulled : BOOLEAN ;
+ PlayerPulled : CARDINAL ;
+ qHead,
+ freeDesc : QDesc ;
+ armedTimer : EVENT ;
+ qAvailable,
+ qMutex : SEMAPHORE ;
+ qThread : DESCRIPTOR ;
+
+
+PROCEDURE GetTreasure ;
+VAR
+ p, r : CARDINAL ;
+ died : BOOLEAN ;
+ Tno : CARDINAL ;
+BEGIN
+ p := PlayerNo() ;
+ GetWriteAccessToPlayer ;
+ Tno := GetTreasure1(p) ;
+ (* Only way so far to die directly from getting treasures. *)
+ died := (Player[p].DeathType=fireball) ;
+ r := Player[p].RoomOfMan ;
+ ReleaseWriteAccessToPlayer ;
+ IF Tno=SleepPotion
+ THEN
+ (* must not sleep holding the lock. *)
+ Sleep(24*TicksPerSecond)
+ END ;
+ IF died
+ THEN
+ Dead(p, r)
+ END
+END GetTreasure ;
+
+
+PROCEDURE GetTreasure1 (p: CARDINAL) : CARDINAL ;
+VAR
+ x, y, d,
+ r,
+ TreasNo: CARDINAL ;
+ ReDraw,
+ ok : BOOLEAN ;
+BEGIN
+ ReDraw := FALSE ;
+ WITH Player[p] DO
+ d := Direction ;
+ r := RoomOfMan ;
+ x := Xman ;
+ y := Yman ;
+ IncPosition(x, y, d) ;
+ GetWriteAccessToTreasure ;
+ PointOnTreasure(r, x, y, TreasNo, ok) ;
+ IF ok
+ THEN
+ IF TreasNo>9
+ THEN
+ Tmessage[12] := '1' ;
+ Tmessage[13] := CHR((TreasNo MOD 10)+ORD('0'))
+ ELSE
+ Tmessage[12] := ' ' ;
+ Tmessage[13] := CHR(TreasNo+ORD('0'))
+ END ;
+ GetAccessToScreenNo(p) ;
+ WriteCommentLine1(p, Tmessage) ;
+ WriteCommentLine2(p, Treasure[TreasNo].TreasureName) ;
+ DelCommentLine3(p) ;
+ ReleaseAccessToScreenNo(p) ;
+ PickUpTreasure(p, r, TreasNo, x, y, ReDraw)
+ ELSE
+ GetAccessToScreenNo(p) ;
+ WriteCommentLine1(p, 'thou canst') ;
+ DelCommentLine2(p) ;
+ DelCommentLine3(p) ;
+ ReleaseAccessToScreenNo(p)
+ END ;
+ ReleaseWriteAccessToTreasure ;
+ IF ReDraw
+ THEN
+ InitScreen(p) ;
+ DrawRoom
+ END
+ END ;
+ RETURN( TreasNo )
+END GetTreasure1 ;
+
+
+(*
+ RandomDrop -
+*)
+
+PROCEDURE RandomDrop (VAR r, x, y: CARDINAL) : BOOLEAN ;
+VAR
+ roomCount: CARDINAL ;
+ ok : BOOLEAN ;
+BEGIN
+ REPEAT
+ RandomNumber (roomCount, ActualNoOfRooms) ;
+ INC (roomCount) ;
+ RandomRoom (roomCount, NoOfRoomsToSpring, r) ;
+ PositionInRoom (r, x, y, ok)
+ UNTIL ok ;
+ RETURN TRUE
+END RandomDrop ;
+
+
+(*
+ IsTreasureArrow - returns TRUE if treasure, i, is an arrow (normal or magic)
+ it can be a respawnable treasure or an item dropped after
+ death.
+*)
+
+PROCEDURE IsTreasureArrow (i: CARDINAL) : BOOLEAN ;
+BEGIN
+ RETURN (i = QuiverNormal) OR (i = QuiverMagic) OR (i >= LowFreePool)
+END IsTreasureArrow ;
+
+
+PROCEDURE PickUpTreasure (p, r, TreasNo, tx, ty: CARDINAL ;
+ VAR ReDraw: BOOLEAN) ;
+VAR
+ tr, i: CARDINAL ;
+ ok : BOOLEAN ;
+ a : ARRAY [0..14] OF CHAR ;
+ b : ARRAY [0..4] OF CHAR ;
+BEGIN
+ WITH Player[p] DO
+ (* Magic Spring CANNOT be Grabbed AND neither can Lump Of Iron *)
+ IF (TreasNo#MagicSpring) AND (TreasNo#LumpOfIron) AND
+ (NOT IsTreasureArrow (TreasNo))
+ THEN
+ pickUp (p, r, TreasNo) ;
+ GetAccessToScreenNo (p) ;
+ WriteWeight (p, Weight) ;
+ ReleaseAccessToScreenNo (p) ;
+ END ;
+ EXCL (Rooms[r].Treasures, TreasNo) ; (* Room no longer has treasure *)
+ EraseTreasure(r, tx, ty) ;
+
+ IF TreasNo=MagicSpring
+ THEN
+ (* Magic Spring - Springs treasure and player into different *)
+ (* rooms. *)
+
+ EraseMan(p) ;
+ REPEAT
+ RandomNumber(r, ActualNoOfRooms) ; (* r>=0 & r<=ActualNoOfRooms-1 *)
+ INC(r) ;
+ RandomRoom(r, NoOfRoomsToSpring, tr) ;
+ PositionInRoom(tr, tx, ty, ok)
+ UNTIL ok ;
+ RoomOfMan := tr ;
+ Xman := tx ;
+ Yman := ty ;
+ ScreenX := tx-(tx MOD Width) ;
+ ScreenY := ty-(ty MOD Height) ;
+ DrawMan(p) ;
+ IF RandomDrop (tr, tx, ty)
+ THEN
+ WITH Treasure[TreasNo] DO
+ Rm := tr ;
+ Xpos := tx ;
+ Ypos := ty
+ END
+ END ;
+ INCL(Rooms[tr].Treasures, TreasNo) ; (* Room has treasure *)
+ DrawTreasure(tr, tx, ty) ;
+ ReDraw := TRUE
+ ELSIF (TreasNo=SackOfCoal1) OR (TreasNo=SackOfCoal2) (* Sacks Of Coal *)
+ THEN
+ RandomNumber(r, ActualNoOfRooms) ;
+ INC(r) ;
+ RandomRoom(r, NoOfRoomsToHideCoal, tr) ;
+ SackOfCoal[TreasNo-SackOfCoal1] := tr ;
+ StrCopy('to room ', a ) ;
+ CardToStr(tr, 4, b) ;
+ StrConCat(a, b, a) ;
+ GetAccessToScreenNo(p) ;
+ WriteCommentLine3(p, a) ;
+ ReleaseAccessToScreenNo(p)
+ ELSIF TreasNo=HotIron (* Hot iron *)
+ THEN
+ GetAccessToScreenNo(p) ;
+ WriteCommentLine1(p, 'ouch') ;
+ WriteCommentLine2(p, 'fire ball') ;
+ WriteCommentLine3(p, 'hit thee') ;
+ IF DammageByHotIron>Wounds
+ THEN
+ Wounds := 0 ;
+ DeathType := fireball
+ ELSE
+ DEC(Wounds, DammageByHotIron)
+ END ;
+ WriteWounds(p, Wounds) ;
+ ReleaseAccessToScreenNo(p)
+ ELSIF TreasNo=LumpOfIron
+ THEN
+ ScatterAllTreasures(p, RoomOfMan)
+ ELSIF TreasNo=SpeedPotion
+ THEN
+ (* PutPriority(CurrentProcess, User, 4) *)
+ ELSIF (TreasNo=QuiverNormal) OR (TreasNo=QuiverMagic)
+ THEN
+ IF TreasNo=QuiverNormal
+ THEN
+ INC (NoOfNormal, 6) ;
+ GetAccessToScreenNo (p) ;
+ WriteArrows (p, NoOfNormal) ;
+ WriteCommentLine1 (p, '6 normal') ;
+ WriteCommentLine2 (p, 'arrows') ;
+ ReleaseAccessToScreenNo (p) ;
+ Treasure[TreasNo].kind := respawnnormal
+ ELSE
+ INC (NoOfMagic, 1) ;
+ GetAccessToScreenNo (p) ;
+ WriteMagicArrows (p, NoOfMagic) ;
+ WriteCommentLine1 (p, 'a magic') ;
+ WriteCommentLine2 (p, 'arrow') ;
+ ReleaseAccessToScreenNo (p) ;
+ Treasure[TreasNo].kind := respawnmagic
+ END ;
+ RespawnTreasure (tr, TreasNo, RespawnArrowTime * TicksPerSecond) ;
+ ELSIF IsTreasureArrow (TreasNo)
+ THEN
+ GetAccessToScreenNo (p) ;
+ IF Treasure[TreasNo].kind = normal
+ THEN
+ INC (NoOfNormal, Treasure[TreasNo].amount) ;
+ WriteArrows (p, NoOfNormal) ;
+ ELSIF Treasure[TreasNo].kind = magic
+ THEN
+ INC (NoOfMagic, Treasure[TreasNo].amount) ;
+ WriteMagicArrows (p, NoOfMagic) ;
+ END ;
+ Treasure[TreasNo].amount := 0 ;
+ Treasure[TreasNo].Rm := 0 ;
+ Treasure[TreasNo].kind := unused ;
+ ReleaseAccessToScreenNo (p)
+ END
+ END
+END PickUpTreasure ;
+
+
+PROCEDURE ScatterAllTreasures (p, r: CARDINAL) ;
+VAR
+ tp, tr,
+ x, y, i : CARDINAL ;
+ ok : BOOLEAN ;
+BEGIN
+ FOR i := 1 TO MaxNoOfTreasures DO
+ FOR tp := 0 TO NextFreePlayer-1 DO
+ IF IsPlayerActive(tp)
+ THEN
+ WITH Player[tp] DO
+ IF (i IN TreasureOwn) AND (r=RoomOfMan)
+ THEN
+ REPEAT
+ RandomRoom(r, NoOfRoomsToSpring, tr) ;
+ PositionInRoom(tr, x, y, ok)
+ UNTIL ok ;
+ putDown (tp, tr, i, x, y) ;
+ printf ("treasure %d is in room %d at %d,%d\n", i, tr, x, y)
+ END
+ END
+ END
+ END ;
+ IF Treasure[i].Rm=r
+ THEN
+ REPEAT
+ RandomRoom(r, NoOfRoomsToSpring, tr) ;
+ PositionInRoom(tr, x, y, ok)
+ UNTIL ok ;
+ printf ("treasure %d is in room %d at %d,%d\n", i, tr, x, y) ;
+ WITH Treasure[i] DO
+ EraseTreasure (Rm, Xpos, Ypos) ;
+ EXCL (Rooms[Rm].Treasures, i) ;
+ Xpos := x ;
+ Ypos := y ;
+ Rm := tr
+ END ;
+ INCL (Rooms[tr].Treasures, i)
+ END ;
+ WITH Treasure[i] DO
+ DrawTreasure (Rm, Xpos, Ypos)
+ END
+ END ;
+ FOR tp := 0 TO NextFreePlayer-1 DO
+ IF IsPlayerActive(tp)
+ THEN
+ WITH Player[tp] DO
+ IF (TreasureOwn#{}) AND (RoomOfMan=r)
+ THEN
+ (* Now undo treasures which have an automatic effect *)
+ IF SpeedPotion IN TreasureOwn
+ THEN
+ (* PutPriority(PlayerProcess(p), User, 3) *)
+ END ;
+
+ TreasureOwn := {} ;
+ GetAccessToScreenNo(tp) ;
+
+ WriteWeight(p, Weight) ;
+ WriteCommentLine1(p, 'thy burdens') ;
+ WriteCommentLine2(p, 'hast been') ;
+ WriteCommentLine3(p, 'lifted') ;
+
+ ReleaseAccessToScreenNo(tp)
+ END
+ END
+ END
+ END
+END ScatterAllTreasures ;
+
+
+PROCEDURE ScatterTreasures (p, r: CARDINAL) ;
+VAR
+ c : INTEGER ;
+ x, y, i : CARDINAL ;
+ ok : BOOLEAN ;
+BEGIN
+ WITH Player[p] DO
+ FOR i := 1 TO MaxNoOfTreasures DO
+ IF i IN TreasureOwn
+ THEN
+ (* Now undo treasures which have an automatic effect *)
+ IF SpeedPotion IN TreasureOwn
+ THEN
+ (* PutPriority(PlayerProcess(p), User, 3) *)
+ END ;
+
+ REPEAT
+ PositionInRoom(r, x, y, ok) ;
+ IF ok
+ THEN
+ WITH Treasure[i] DO
+ DEC(Weight, Tweight) ;
+ Xpos := x ;
+ Ypos := y ;
+ Rm := r
+ END ;
+ DrawTreasure(r, x, y) ;
+ INCL(Rooms[r].Treasures, i) ;
+ ELSE
+ c := printf('trying another room\n') ;
+ RandomRoom(r, 1, x) ;
+ r := x
+ END
+ UNTIL ok
+ END
+ END ;
+ TreasureOwn := {} ;
+ (* and respawn arrows. *)
+ RespawnArrow (r, 0, respawnmagic, magic, NoOfMagic, TicksPerSecond * RespawnMagicInventory) ;
+ RespawnArrow (r, 0, respawnnormal, normal, NoOfNormal, TicksPerSecond * RespawnArrowInventory) ;
+ GetAccessToScreenNo(p) ;
+ WriteWeight(p, Weight) ;
+ ReleaseAccessToScreenNo(p)
+ END
+END ScatterTreasures ;
+
+
+PROCEDURE DropTreasure ;
+VAR
+ ok : BOOLEAN ;
+ p, TreasNo: CARDINAL ;
+ ch,
+ units,
+ tens : CHAR ;
+BEGIN
+ p := PlayerNo() ;
+ GetAccessToScreenNo(p) ;
+ WriteCommentLine2(p, 'which one?') ;
+ ReleaseAccessToScreenNo(p) ;
+ ch := ' ' ;
+ units := ' ' ;
+ tens := ' ' ;
+ REPEAT
+ tens := units ;
+ units := ch ;
+ ok := ClientRead(ch)
+ UNTIL (NOT ok) OR (ch=cr) ;
+ IF ok
+ THEN
+ IF (units>='0') AND (units<='9')
+ THEN
+ TreasNo := ORD(units)-ORD('0') ;
+ IF (tens>='0') AND (tens<='9')
+ THEN
+ TreasNo := TreasNo+10*(ORD(tens)-ORD('0'))
+ END
+ END ;
+ IF (TreasNo<1) OR (TreasNo>MaxNoOfTreasures)
+ THEN
+ GetAccessToScreenNo(p) ;
+ WriteCommentLine1(p, 'thou canst') ;
+ DelCommentLine2(p) ;
+ DelCommentLine3(p);
+ ReleaseAccessToScreenNo(p)
+ ELSE
+ GetWriteAccessToPlayer ;
+ DropTreasure1(p, TreasNo) ;
+ ReleaseWriteAccessToPlayer
+ END
+ END
+END DropTreasure ;
+
+
+PROCEDURE DropTreasure1(p, TreasNo: CARDINAL) ;
+VAR
+ x, y, d,
+ r, z : CARDINAL ;
+ ok : BOOLEAN ;
+BEGIN
+ WITH Player[p] DO
+ IF TreasNo IN TreasureOwn
+ THEN
+ d := Direction ;
+ r := RoomOfMan ;
+ x := Xman ;
+ y := Yman ;
+ IncPosition(x, y, d) ;
+ PointOnWall(r, x, y, ok) ;
+ IF NOT ok
+ THEN
+ GetDoorOnPoint(r, x, y, z, ok) ;
+ IF NOT ok
+ THEN
+ GetWriteAccessToTreasure ;
+ FreeOfPlayersAndTreasure(r, x, y, ok) ;
+ IF ok
+ THEN
+ IF TreasNo>9
+ THEN
+ Tmessage[12] := '1' ;
+ Tmessage[13] := CHR((TreasNo MOD 10)+ORD('0'))
+ ELSE
+ Tmessage[12] := ' ' ;
+ Tmessage[13] := CHR(TreasNo+ORD('0'))
+ END ;
+ GetAccessToScreenNo(p) ;
+ WriteCommentLine1(p, Tmessage) ;
+ WriteCommentLine2(p, Treasure[TreasNo].TreasureName) ;
+ ReleaseAccessToScreenNo( p ) ;
+ PutDownTreasure(p, r, TreasNo, x, y)
+ ELSE
+ GetAccessToScreenNo(p) ;
+ WriteCommentLine1(p, 'thou canst') ;
+ DelCommentLine2(p) ;
+ DelCommentLine3(p) ;
+ ReleaseAccessToScreenNo(p)
+ END ;
+ ReleaseWriteAccessToTreasure
+ ELSE
+ GetAccessToScreenNo(p) ;
+ WriteCommentLine1(p, 'thou canst') ;
+ DelCommentLine2(p) ;
+ DelCommentLine3(p) ;
+ ReleaseAccessToScreenNo(p)
+ END
+ ELSE
+ GetAccessToScreenNo(p) ;
+ WriteCommentLine1(p, 'thou canst') ;
+ DelCommentLine2(p) ;
+ DelCommentLine3(p) ;
+ ReleaseAccessToScreenNo(p)
+ END
+ ELSE
+ GetAccessToScreenNo(p) ;
+ WriteCommentLine1(p, 'thou canst') ;
+ DelCommentLine2(p) ;
+ DelCommentLine3(p) ;
+ ReleaseAccessToScreenNo(p)
+ END
+ END
+END DropTreasure1 ;
+
+
+(*
+ putDown -
+*)
+
+PROCEDURE putDown (p, r, TreasNo, tx, ty: CARDINAL) ;
+BEGIN
+ WITH Player[p] DO
+ DEC (Weight, Treasure[TreasNo].Tweight) ;
+ Treasure[TreasNo].Rm := r ; (* Put in this Room *)
+ Treasure[TreasNo].Xpos := tx ;
+ Treasure[TreasNo].Ypos := ty ;
+ Treasure[TreasNo].kind := onfloor ;
+ INCL (Rooms[r].Treasures, TreasNo) ; (* Room has treasure *)
+ EXCL (TreasureOwn, TreasNo) ; (* Player no longer has treasure *)
+ END
+END putDown ;
+
+
+(*
+ pickUp -
+*)
+
+PROCEDURE pickUp (p, r, TreasNo: CARDINAL) ;
+BEGIN
+ WITH Player[p] DO
+ INC (Weight, Treasure[TreasNo].Tweight) ;
+ Treasure[TreasNo].Rm := 0 ; (* No longer in a Room *)
+ Treasure[TreasNo].kind := onperson ; (* No longer in a Room *)
+ INCL (TreasureOwn, TreasNo)
+ END
+END pickUp ;
+
+
+PROCEDURE PutDownTreasure (p, r, TreasNo, tx, ty: CARDINAL) ;
+VAR
+ tr, i: CARDINAL ;
+ ok : BOOLEAN ;
+ a : ARRAY [0..14] OF CHAR ;
+ b : ARRAY [0..4] OF CHAR ;
+BEGIN
+ WITH Player[p] DO
+ IF (TreasNo=SackOfCoal1) OR (TreasNo=SackOfCoal2) (* Sacks Of Coal *)
+ THEN
+ IF r=SackOfCoal[TreasNo-SackOfCoal1]
+ THEN
+ GetAccessToScreenNo(p) ;
+ WriteWeight(p, Weight) ;
+ WriteCommentLine3(p, 'dropped') ;
+ ReleaseAccessToScreenNo(p) ;
+ putDown (p, r, TreasNo, tx, ty) ;
+ DrawTreasure(r, tx, ty)
+ ELSE
+ StrCopy('to room ', a) ;
+ CardToStr(SackOfCoal[TreasNo-SackOfCoal1], 4, b) ;
+ StrConCat(a, b, a) ;
+ GetAccessToScreenNo(p) ;
+ WriteCommentLine3(p, a) ;
+ ReleaseAccessToScreenNo(p)
+ END
+ ELSE
+ IF TreasNo=SpeedPotion
+ THEN
+ (* PutPriority(CurrentProcess, User, 3) *)
+ END ;
+ putDown (p, r, TreasNo, tx, ty) ;
+ GetAccessToScreenNo(p) ;
+ WriteCommentLine3(p, 'dropped') ;
+ WriteWeight(p, Weight) ;
+ ReleaseAccessToScreenNo(p) ;
+ DrawTreasure(r, tx, ty)
+ END
+ END
+END PutDownTreasure ;
+
+
+PROCEDURE UseTreasure ;
+VAR
+ x, y, d,
+ r, p,
+ TreasNo: CARDINAL ;
+ ok : BOOLEAN ;
+ ch,
+ units,
+ tens : CHAR ;
+BEGIN
+ p := PlayerNo() ;
+ WITH Player[p] DO
+ GetAccessToScreenNo(p) ;
+ WriteCommentLine2(p, 'which one?') ;
+ ReleaseAccessToScreenNo(p) ;
+ ch := ' ' ;
+ units := ' ' ;
+ tens := ' ' ;
+ REPEAT
+ tens := units ;
+ units := ch ;
+ ok := ClientRead(ch)
+ UNTIL (NOT ok) OR (ch=cr) ;
+ IF ok
+ THEN
+ IF (units>='0') AND (units<='9')
+ THEN
+ TreasNo := ORD(units)-ORD('0') ;
+ IF (tens>='0') AND (tens<='9')
+ THEN
+ TreasNo := TreasNo+10*(ORD(tens)-ORD('0'))
+ END
+ END ;
+ GetReadAccessToPlayer ;
+ IF (TreasNo<1) OR (TreasNo>MaxNoOfTreasures)
+ THEN
+ ReleaseReadAccessToPlayer ;
+ GetAccessToScreenNo(p) ;
+ WriteCommentLine1(p, 'thou canst') ;
+ DelCommentLine2(p) ;
+ DelCommentLine3(p) ;
+ ReleaseAccessToScreenNo(p)
+ ELSIF TreasNo IN TreasureOwn
+ THEN
+ ReleaseReadAccessToPlayer ;
+ IF TreasNo>9
+ THEN
+ Tmessage[12] := tens ;
+ Tmessage[13] := units
+ ELSE
+ Tmessage[12] := ' ' ;
+ Tmessage[13] := units
+ END ;
+ GetAccessToScreenNo(p) ;
+ WriteCommentLine1(p, 'using') ;
+ WriteCommentLine2(p, Tmessage) ;
+ WriteCommentLine3(p, Treasure[TreasNo].TreasureName) ;
+ ReleaseAccessToScreenNo(p) ;
+ IF TreasNo=MagicKey (* Magic Key *)
+ THEN
+ HideDoor
+ ELSIF TreasNo=CrystalBall (* Crystal Ball *)
+ THEN
+ UseCrystalBall
+ ELSIF TreasNo=HandGrenade (* Hand Grenade *)
+ THEN
+ PullPin
+ ELSIF TreasNo=TreasTrove
+ THEN
+ DisplayTreasures
+ ELSIF TreasNo=VisionChest
+ THEN
+ DisplayEnemy
+ END
+ ELSE
+ ReleaseReadAccessToPlayer ;
+ GetAccessToScreenNo(p) ;
+ WriteCommentLine1(p, 'thou canst') ;
+ DelCommentLine2(p) ;
+ DelCommentLine3(p) ;
+ ReleaseAccessToScreenNo(p)
+ END
+ END
+ END
+END UseTreasure ;
+
+
+PROCEDURE UseCrystalBall ;
+VAR
+ p, x, y,
+ px, py,
+ r, i : CARDINAL ;
+ a : ARRAY [0..14] OF CHAR ;
+ b : ARRAY [0..4] OF CHAR ;
+ who : ARRAY [0..1] OF CARDINAL ;
+ first: BOOLEAN ;
+ ch : CHAR ;
+BEGIN
+(*
+ p := PlayerNo() ;
+ first := TRUE ;
+ FOR i := 0 TO MaxNoOfPlayers DO
+ IF i#p
+ THEN
+ IF first
+ THEN
+ who[0] := i ;
+ first := FALSE
+ ELSE
+ who[1] := i
+ END
+ END
+ END ;
+ GetReadAccessToPlayerNo( p ) ;
+ WITH Player[p] DO
+ px := Xman ;
+ py := Yman
+ END ;
+ ReleaseReadAccessToPlayerNo( p ) ;
+ GetReadAccessToPlayerNo( who[0] ) ;
+ StrConCat('1: ', Player[who[0]].ManName, a ) ;
+ ReleaseReadAccessToPlayerNo( who[0] ) ;
+ GetAccessToScreenNo( p ) ;
+ WriteCommentLine1(p, a) ;
+ ReleaseAccessToScreenNo( p ) ;
+ GetReadAccessToPlayerNo( who[1] ) ;
+ StrConCat('2: ', Player[who[1]].ManName, a ) ;
+ ReleaseReadAccessToPlayerNo( who[1] ) ;
+ GetAccessToScreenNo( p ) ;
+ WriteCommentLine2(p, a) ;
+ WriteCommentLine3(p, 'peer at ?') ;
+ ReleaseAccessToScreenNo( p ) ;
+ REPEAT
+ Read( ch ) ;
+ IF (ch='1') OR (ch='2')
+ THEN
+ i := ORD(ch)-ORD('1') ;
+ GetReadAccessToPlayerNo( who[i] ) ;
+ WITH Player[who[i]] DO
+ x := Xman ;
+ y := Yman ;
+ r := RoomOfMan
+ END ;
+ ReleaseReadAccessToPlayerNo( who[i] ) ;
+ IF r=0
+ THEN
+ StrCopy('is slain: ', a )
+ ELSE
+ StrCopy('room', a) ;
+ CardToStr( r, 4, b ) ;
+ StrConCat( a, b, a ) ;
+ StrConCat( a, ' ', a )
+ END ;
+ IF y>py
+ THEN
+ StrConCat( a, 'S', a )
+ END ;
+ IF y<py
+ THEN
+ StrConCat( a, 'N', a )
+ END ;
+ IF x>px
+ THEN
+ StrConCat( a, 'E', a )
+ END ;
+ IF x<px
+ THEN
+ StrConCat( a, 'W', a )
+ END ;
+ GetAccessToScreenNo( p ) ;
+ IF ch='1'
+ THEN
+ WriteCommentLine1(p, a)
+ ELSE
+ WriteCommentLine2(p, a)
+ END ;
+ ReleaseAccessToScreenNo( p )
+ END
+ UNTIL (ch#'1') AND (ch#'2') ;
+ GetAccessToScreenNo( p ) ;
+ DelCommentLine1(p) ;
+ DelCommentLine2(p) ;
+ DelCommentLine3(p) ;
+ ReleaseAccessToScreenNo( p )
+*)
+END UseCrystalBall ;
+
+(*
+PROCEDURE DisplayWounds ;
+VAR
+ p, w,
+ r, i : CARDINAL ;
+ b : ARRAY [0..4] OF CHAR ;
+ a : ARRAY [0..14] OF CHAR ;
+ who : ARRAY [0..1] OF CARDINAL ;
+ first: BOOLEAN ;
+ ch : CHAR ;
+BEGIN
+ p := PlayerNo() ;
+ first := TRUE ;
+ FOR i := 0 TO MaxNoOfPlayers DO
+ IF i#p
+ THEN
+ IF first
+ THEN
+ who[0] := i ;
+ first := FALSE
+ ELSE
+ who[1] := i
+ END
+ END
+ END ;
+ GetReadAccessToPlayerNo( who[0] ) ;
+ StrConCat('1: ', Player[who[0]].ManName, a ) ;
+ ReleaseReadAccessToPlayerNo( who[0] ) ;
+ GetAccessToScreenNo( p ) ;
+ WriteCommentLine1(p, a) ;
+ ReleaseAccessToScreenNo( p ) ;
+ GetReadAccessToPlayerNo( who[1] ) ;
+ StrConCat('2: ', Player[who[1]].ManName, a ) ;
+ ReleaseReadAccessToPlayerNo( who[1] ) ;
+ GetAccessToScreenNo( p ) ;
+ WriteCommentLine2(p, a) ;
+ WriteCommentLine3(p, 'peer at ?') ;
+ ReleaseAccessToScreenNo( p ) ;
+ REPEAT
+ Read( ch ) ;
+ IF (ch='1') OR (ch='2')
+ THEN
+ i := ORD(ch)-ORD('1') ;
+ GetReadAccessToPlayerNo( who[i] ) ;
+ WITH Player[who[i]] DO
+ w := Wounds ;
+ r := RoomOfMan
+ END ;
+ ReleaseReadAccessToPlayerNo( who[i] ) ;
+ IF r=0
+ THEN
+ StrCopy('is slain: ', a )
+ ELSE
+ StrCopy('Wounds ', a) ;
+ CardToStr( w, 4, b ) ;
+ StrConCat( a, b, a ) ;
+ StrConCat( a, ' ', a )
+ END ;
+ GetAccessToScreenNo( p ) ;
+ IF ch='1'
+ THEN
+ WriteCommentLine1(p, a)
+ ELSE
+ WriteCommentLine2(p, a)
+ END ;
+ ReleaseAccessToScreenNo( p )
+ END
+ UNTIL (ch#'1') AND (ch#'2') ;
+ GetAccessToScreenNo( p ) ;
+ DelCommentLine1(p) ;
+ DelCommentLine2(p) ;
+ DelCommentLine3(p) ;
+ ReleaseAccessToScreenNo( p )
+END DisplayWounds ;
+*)
+
+PROCEDURE DisplayEnemy ;
+VAR
+ p,
+ r, i : CARDINAL ;
+ who : ARRAY [0..1] OF CARDINAL ;
+ a : ARRAY [0..14] OF CHAR ;
+ first: BOOLEAN ;
+ ch : CHAR ;
+BEGIN
+(*
+ p := PlayerNo() ;
+ first := TRUE ;
+ FOR i := 0 TO MaxNoOfPlayers DO
+ IF i#p
+ THEN
+ IF first
+ THEN
+ who[0] := i ;
+ first := FALSE
+ ELSE
+ who[1] := i
+ END
+ END
+ END ;
+ REPEAT
+ GetReadAccessToPlayerNo( who[0] ) ;
+ StrConCat('1: ', Player[who[0]].ManName, a ) ;
+ ReleaseReadAccessToPlayerNo( who[0] ) ;
+ GetAccessToScreenNo( p ) ;
+ WriteCommentLine1(p, a) ;
+ ReleaseAccessToScreenNo( p ) ;
+ GetReadAccessToPlayerNo( who[1] ) ;
+ StrConCat('2: ', Player[who[1]].ManName, a ) ;
+ ReleaseReadAccessToPlayerNo( who[1] ) ;
+ GetAccessToScreenNo( p ) ;
+ WriteCommentLine2(p, a) ;
+ WriteCommentLine3(p, 'peer at ?') ;
+ ReleaseAccessToScreenNo( p ) ;
+ Read( ch ) ;
+ IF (ch='1') OR (ch='2')
+ THEN
+ i := ORD(ch)-ORD('1') ;
+ GetReadAccessToPlayerNo( who[i] ) ;
+ WITH Player[who[i]] DO
+ r := RoomOfMan
+ END ;
+ ReleaseReadAccessToPlayerNo( who[i] ) ;
+ IF r=0
+ THEN
+ GetAccessToScreenNo( p ) ;
+ IF ch='1'
+ THEN
+ WriteCommentLine1(p, 'is slain:')
+ ELSE
+ WriteCommentLine2(p, 'is slain:')
+ END ;
+ ReleaseAccessToScreenNo( p )
+ ELSE
+ DisplayEn( p, who[i] )
+ END
+ END
+ UNTIL (ch#'1') AND (ch#'2') ;
+ GetAccessToScreenNo( p ) ;
+ DelCommentLine1(p) ;
+ DelCommentLine2(p) ;
+ DelCommentLine3(p) ;
+ ReleaseAccessToScreenNo( p )
+*)
+END DisplayEnemy ;
+
+
+PROCEDURE DisplayEn (p, e: CARDINAL) ;
+VAR
+ OldMan: Man ;
+ ch : CHAR ;
+BEGIN
+(* ******************
+ (* Save player p man first *)
+ GetWriteAccessToAllPlayers ;
+ OldMan := Player[p] ;
+ Player[p] := Player[e] ;
+ (* Now draw Screen etc *)
+ InitScreen ;
+ DrawRoom ;
+ DrawAllPlayers ;
+ Player[p] := OldMan ;
+ ReleaseWriteAccessToAllPlayers ;
+ Read( ch ) ;
+ IF Player[p].RoomOfMan#0 (* So alive - or just killed hopefully... *)
+ THEN
+ InitialDisplay
+ END
+********************** *)
+END DisplayEn ;
+
+
+PROCEDURE DisplayTreasures ;
+VAR
+ p, tp,
+ i, j : CARDINAL ;
+ ok : BOOLEAN ;
+ ch : CHAR ;
+ no : ARRAY [0..3] OF CHAR ;
+ line : ARRAY [0..80] OF CHAR ;
+BEGIN
+ p := PlayerNo() ;
+ GetReadAccessToPlayer ;
+ GetReadAccessToTreasure ;
+ GetAccessToScreenNo(p) ;
+ ClearScreen(p) ;
+ FOR i := 1 TO MaxNoOfTreasures DO
+ ok := FALSE ;
+ FOR tp := 0 TO MaxNoOfPlayers DO
+ IF IsPlayerActive(tp)
+ THEN
+ WITH Player[tp] DO
+ IF i IN TreasureOwn
+ THEN
+ StrCopy(ManName, line) ;
+ StrConCat(line, ' ', line) ;
+ ok := TRUE
+ END
+ END
+ END
+ END ;
+ IF (Treasure[i].Rm # 0) AND (Treasure[i].kind = onfloor)
+ THEN
+ IF (NOT ok)
+ THEN
+ CardToStr(Treasure[i].Rm, 6, line) ;
+ StrConCat(' ', line, line) ;
+ StrConCat('Room Number', line, line) ;
+ END ;
+ StrConCat(line, ' has Treasure No ', line) ;
+ CardToStr(i, 0, no) ;
+ StrConCat(line, no, line) ;
+ StrConCat(line, ' The ', line) ;
+ StrConCat(line, Treasure[i].TreasureName, line) ;
+ WriteString(p, line)
+ END
+ END ;
+ ReleaseReadAccessToPlayer ;
+ ReleaseReadAccessToTreasure ;
+ ReleaseAccessToScreenNo(p) ;
+ IF ClientRead(ch)
+ THEN
+ END ;
+ InitialDisplay
+END DisplayTreasures ;
+
+
+PROCEDURE PullPin ;
+VAR
+ p: CARDINAL ;
+BEGIN
+ p := PlayerNo() ;
+ GetWriteAccessToTreasure ;
+ IF PinHasBeenPulled
+ THEN
+ ReleaseWriteAccessToTreasure ;
+ GetAccessToScreen ;
+ WriteCommentLine1(p, 'pin has been') ;
+ WriteCommentLine2(p, 'pulled') ;
+ DelCommentLine3(p) ;
+ ReleaseAccessToScreen
+ ELSE
+ PinHasBeenPulled := TRUE ;
+ PlayerPulled := p ;
+ ReleaseWriteAccessToTreasure ;
+ Signal(PinPulled)
+ END
+END PullPin ;
+
+
+PROCEDURE Grenade ;
+VAR
+ pulled,
+ RoomOfExplosion,
+ sec, i,
+ start : CARDINAL ;
+ hit,
+ ok : BOOLEAN ;
+ SlainP: PlayerSet ;
+BEGIN
+ LOOP
+ Wait(PinPulled) ;
+ pulled := PlayerPulled ;
+ Sleep(25*TicksPerSecond) ;
+
+ (* Ok now explode! *)
+
+ hit := FALSE ;
+ GetWriteAccessToPlayer ;
+ GetWriteAccessToTreasure ;
+
+ (* Find out where grenade is! *)
+
+ WITH Treasure[HandGrenade] DO
+ IF Rm=0
+ THEN
+ i := 0 ;
+ RoomOfExplosion := 0 ;
+ REPEAT
+ IF IsPlayerActive(i)
+ THEN
+ WITH Player[i] DO
+ IF HandGrenade IN TreasureOwn
+ THEN
+ RoomOfExplosion := RoomOfMan ;
+ DEC(Weight, Tweight) ;
+ EXCL(TreasureOwn, HandGrenade) ;
+ GetAccessToScreenNo(i) ;
+ WriteWeight(i, Weight) ;
+ ReleaseAccessToScreenNo(i)
+ END
+ END
+ END ;
+ INC(i)
+ UNTIL (RoomOfExplosion#0) OR (i=NextFreePlayer)
+ ELSE
+ RoomOfExplosion := Rm ;
+ EXCL(Rooms[Rm].Treasures, HandGrenade) ;
+ EraseTreasure(Rm, Xpos, Ypos)
+ END
+ END ;
+
+ IF RoomOfExplosion # 0
+ THEN
+ SlainP := PlayerSet{} ;
+ FOR i := 0 TO NextFreePlayer-1 DO
+ IF IsPlayerActive(i)
+ THEN
+ WITH Player[i] DO
+ IF RoomOfExplosion=RoomOfMan
+ THEN
+ hit := TRUE ;
+ GetAccessToScreenNo(i) ;
+ UpDateWoundsAndFatigue(i) ;
+ WriteCommentLine1(i, 'boooommm') ;
+ DelCommentLine2(i) ;
+ DelCommentLine3(i) ;
+ IF Wounds>DammageByHandGrenade
+ THEN
+ DEC(Wounds, DammageByHandGrenade) ;
+ ELSE
+ INCL(SlainP, i) ;
+ Wounds := 0 ;
+ DeathType := explosion
+ END ;
+ WriteWounds(i, Wounds) ;
+ ReleaseAccessToScreenNo(i)
+ END
+ END
+ END
+ END
+ END ;
+ ReleaseWriteAccessToTreasure ;
+ ReleaseWriteAccessToPlayer ;
+ IF RoomOfExplosion # 0
+ THEN
+ Explode(RoomOfExplosion, pulled, hit) ;
+ FOR i := 0 TO MaxNoOfPlayers DO
+ IF i IN SlainP
+ THEN
+ Dead(i, RoomOfExplosion)
+ END
+ END
+ END ;
+
+ (* and hide the grenade again. *)
+ GetWriteAccessToPlayer ;
+ GetWriteAccessToTreasure ;
+ WITH Treasure[HandGrenade] DO
+ REPEAT
+ RandomRoom(RoomOfExplosion, NoOfRoomsToHideGrenade, Rm) ;
+ PositionInRoom(Rm, Xpos, Ypos, ok)
+ UNTIL ok ;
+ INCL(Rooms[Rm].Treasures, HandGrenade) ;
+ DrawTreasure(Rm, Xpos, Ypos)
+ END ;
+ PinHasBeenPulled := FALSE ;
+ ReleaseWriteAccessToTreasure ;
+ ReleaseWriteAccessToPlayer ;
+ END
+END Grenade ;
+
+
+(*
+ newQDesc -
+*)
+
+PROCEDURE newQDesc (Rm, tno: CARDINAL; kind: TreasureKind; amount, ticks: CARDINAL) : QDesc ;
+VAR
+ d: QDesc ;
+BEGIN
+ IF freeDesc = NIL
+ THEN
+ NEW (d)
+ ELSE
+ d := freeDesc ;
+ freeDesc := freeDesc^.right
+ END ;
+ d^.Rm := Rm ;
+ d^.tno := tno ;
+ d^.kind := kind ;
+ d^.amount := amount ;
+ d^.ticks := ticks ;
+ d^.right := NIL ;
+ RETURN d
+END newQDesc ;
+
+
+(*
+ freeQ - return the head desc to the freeQ.
+*)
+
+PROCEDURE freeQ ;
+VAR
+ desc: QDesc ;
+BEGIN
+ desc := qHead ;
+ qHead := qHead^.right ;
+ desc^.right := freeDesc ;
+ freeDesc := desc
+END freeQ ;
+
+
+(*
+ respawnThread -
+*)
+
+PROCEDURE respawnThread ;
+VAR
+ desc: QDesc ;
+BEGIN
+ LOOP
+ printf ("respawnThread\n");
+ Wait (qAvailable) ;
+ REPEAT
+ Wait (qMutex) ;
+ armedTimer := ArmEvent (qHead^.ticks) ;
+ Signal (qMutex) ;
+ UNTIL NOT WaitOn (armedTimer) ;
+ printf ("respawnThread has waited\n");
+ Wait (qMutex) ;
+ IF qHead # NIL
+ THEN
+ WITH qHead^ DO
+ IF tno < LowFreePool
+ THEN
+ RespawnTreasure (Rm, tno, 0)
+ ELSE
+ (* as the time is zero there is no need for a respawn kind. *)
+ RespawnArrow (Rm, tno, kind, kind, amount, 0)
+ END
+ END
+ END ;
+ freeQ ;
+ Signal (qMutex)
+ END
+END respawnThread ;
+
+
+(*
+ relativeAdd -
+*)
+
+PROCEDURE relativeAdd (desc: QDesc) ;
+VAR
+ s, t: QDesc ;
+ sum : CARDINAL ;
+BEGIN
+(* works - ish...
+ qHead := desc ;
+ desc^.right := NIL ;
+ RETURN ;
+*)
+ IF qHead = NIL
+ THEN
+ (* simple as the queue is empty (relative=absolute). *)
+ qHead := desc ;
+ desc^.right := NIL
+ ELSE
+ (* at the end of the while loop sum will contain the total of all
+ events up to but not including, t.
+ If the value of sum is < e^.NoOfTicks then e must be placed at the end
+ >= e^.NoOfTicks then e needs to be placed in the middle
+ *)
+
+ sum := qHead^.ticks ;
+ s := qHead ;
+ t := qHead^.right ; (* second event *)
+ WHILE (sum < desc^.ticks) AND (t # NIL) DO
+ INC (sum, t^.ticks) ;
+ s := t ;
+ t := t^.right
+ END ;
+ IF sum < desc^.ticks
+ THEN
+ (* desc will occur after all the current qHead has expired therefore
+ we must add it to the end of the qHead. *)
+ DEC (desc^.ticks, sum) ;
+ s^.right:= desc ;
+ desc^.right := NIL
+ ELSE
+ (* as sum >= desc^.ticks we know that desc is scheduled to occur
+ in the middle of the queue but after, s.
+ *)
+ Assert (sum >= s^.ticks) ;
+ DEC (desc^.ticks, sum - s^.ticks) ;
+ desc^.right := t ;
+ s^.right := desc
+ END ;
+ (* the first event after desc must have its relative ticks altered. *)
+ IF desc^.right # NIL
+ THEN
+ DEC (desc^.right^.ticks, desc^.ticks)
+ END
+ END
+END relativeAdd ;
+
+
+(*
+ addToQueue -
+*)
+
+PROCEDURE addToQueue (seedRoom: CARDINAL; tno: CARDINAL; kind: TreasureKind;
+ amount: CARDINAL; ticks: CARDINAL) ;
+VAR
+ desc: QDesc ;
+BEGIN
+ Wait (qMutex) ;
+ desc := newQDesc (seedRoom, tno, kind, amount, ticks) ;
+ relativeAdd (desc) ;
+ IF armedTimer = NIL
+ THEN
+ armedTimer := ArmEvent (desc^.ticks)
+ ELSE
+ IF Cancel (armedTimer)
+ THEN
+ END ;
+ armedTimer := ArmEvent (desc^.ticks)
+ END ;
+ Signal (qAvailable) ;
+ Signal (qMutex) ;
+ IF qThread = NIL
+ THEN
+ qThread := Resume (InitProcess (respawnThread, respawnStack, "respawnThread"))
+ END
+END addToQueue ;
+
+
+PROCEDURE RespawnTreasure (seedRoom: CARDINAL; tno: CARDINAL; ticks: CARDINAL) ;
+VAR
+ x, y: CARDINAL ;
+BEGIN
+ IF ticks = 0
+ THEN
+ randomPlace (seedRoom, tno, onfloor)
+ ELSE
+ addToQueue (seedRoom, tno, onfloor, 0, ticks)
+ END
+END RespawnTreasure ;
+
+
+(*
+ findSpareTreasure -
+*)
+
+PROCEDURE findSpareTreasure (newkind: TreasureKind) : CARDINAL ;
+VAR
+ i: CARDINAL ;
+BEGIN
+ i := LowFreePool ;
+ WHILE i <= HighFreePool DO
+ IF Treasure[i].kind = unused
+ THEN
+ Treasure[i].kind := newkind ;
+ RETURN i
+ END ;
+ INC (i)
+ END ;
+ RETURN 0
+END findSpareTreasure ;
+
+
+(*
+ randomPlace -
+*)
+
+PROCEDURE randomPlace (seedRoom: CARDINAL; tno: CARDINAL; k: TreasureKind) ;
+VAR
+ x, y: CARDINAL ;
+BEGIN
+ IF RandomDrop (seedRoom, x, y)
+ THEN
+ WITH Treasure[tno] DO
+ Rm := seedRoom ;
+ Xpos := x ;
+ Ypos := y ;
+ kind := k ;
+ END ;
+ IF (tno >= LowFreePool) AND (tno <= HighFreePool)
+ THEN
+ IF k = magic
+ THEN
+ StrCopy ('Magic Arrows', Treasure[tno].TreasureName)
+ ELSIF k = normal
+ THEN
+ StrCopy ('Arrow Quiver', Treasure[tno].TreasureName)
+ END
+ END ;
+ INCL (Rooms[seedRoom].Treasures, tno) ;
+ WITH Treasure[tno] DO
+ IF (kind = onfloor) AND (Rm # 0)
+ THEN
+ DrawTreasure (Rm, Xpos, Ypos)
+ END
+ END
+ END
+END randomPlace ;
+
+
+PROCEDURE RespawnArrow (seedRoom: CARDINAL; tno: CARDINAL;
+ spawnKind, arrowKind: TreasureKind;
+ amount: CARDINAL; ticks: CARDINAL) ;
+BEGIN
+ IF amount > 0
+ THEN
+ IF tno = 0
+ THEN
+ tno := findSpareTreasure (spawnKind) ;
+ END ;
+ IF tno # 0
+ THEN
+ (* this should nearly always be true, but if we did run out of slots then
+ we forget the dynamic arrow treasure. *)
+ IF ticks = 0
+ THEN
+ randomPlace (seedRoom, tno, arrowKind)
+ ELSE
+ addToQueue (seedRoom, tno, arrowKind, amount, ticks)
+ END
+ END
+ END
+END RespawnArrow ;
+
+
+(*
+ initPool - initialise a treasure so that it might be dynamically allocated
+ as items on the floor.
+*)
+
+PROCEDURE initPool (i: CARDINAL) ;
+BEGIN
+ WITH Treasure[i] DO
+ Xpos := 0 ;
+ Ypos := 0 ;
+ Rm := 0 ;
+ Tweight := 0 ;
+ StrCopy ('', TreasureName) ;
+ kind := unused ;
+ amount := 0
+ END
+END initPool ;
+
+
+(*
+ initTreasure - initialize weight and kind.
+*)
+
+PROCEDURE initTreasure (i: CARDINAL; weight: CARDINAL; kind: TreasureKind) ;
+BEGIN
+ Treasure[i].Tweight := weight ;
+ Treasure[i].kind := kind ;
+END initTreasure ;
+
+
+PROCEDURE Init ;
+VAR
+ i: CARDINAL ;
+BEGIN
+ FOR i := 1 TO MaxNoOfTreasures DO
+ initPool (i)
+ END ;
+
+ PinPulled := InitSemaphore(0, 'PinPulled') ;
+ PinHasBeenPulled := FALSE ;
+
+ StrCopy('Magic Key' , Treasure[MagicKey ].TreasureName ) ;
+ StrCopy('Crystal Ball', Treasure[CrystalBall].TreasureName ) ;
+ StrCopy('Magic Spring', Treasure[MagicSpring].TreasureName ) ;
+ StrCopy('Sack Of Coal', Treasure[SackOfCoal1].TreasureName ) ;
+ StrCopy('Sack Of Coal', Treasure[SackOfCoal2].TreasureName ) ;
+ StrCopy('Hot Iron' , Treasure[HotIron ].TreasureName ) ;
+ StrCopy('Hand Grenade', Treasure[HandGrenade].TreasureName ) ;
+ StrCopy('Magic Sword' , Treasure[MagicSword ].TreasureName ) ;
+ StrCopy('Magic Shoes' , Treasure[MagicShoes ].TreasureName ) ;
+ StrCopy('Sleep Potion', Treasure[SleepPotion].TreasureName ) ;
+ StrCopy('Lump Of Iron', Treasure[LumpOfIron ].TreasureName ) ;
+ StrCopy('Treas. Trove', Treasure[TreasTrove ].TreasureName ) ;
+ StrCopy('Speed Potion', Treasure[SpeedPotion].TreasureName ) ;
+ StrCopy('Magic Shield', Treasure[MagicShield].TreasureName ) ;
+ StrCopy('Vision Chest', Treasure[VisionChest].TreasureName ) ;
+ StrCopy('Arrow Quiver', Treasure[QuiverNormal].TreasureName ) ;
+ StrCopy('Magic Arrows', Treasure[QuiverMagic].TreasureName ) ;
+ StrCopy('Salve ', Treasure[HealingPotion].TreasureName ) ;
+
+ initTreasure (MagicKey , 0, unused) ;
+ initTreasure (CrystalBall, 33, unused) ;
+ initTreasure (MagicSpring, 0, unused) ;
+ initTreasure (SackOfCoal1, 100, unused) ;
+ initTreasure (SackOfCoal2, 100, unused) ;
+ initTreasure (HotIron , 4, unused) ; (* was 4 *)
+ initTreasure (HandGrenade, 3, unused) ; (* was 3 *)
+ initTreasure (MagicSword , 1, unused) ; (* was 1 *)
+ initTreasure (MagicShoes , 0, unused) ; (* was 0 *)
+ initTreasure (SleepPotion, 5, unused) ; (* was 5 *)
+ initTreasure (LumpOfIron , 0, unused) ; (* was 0 *)
+ initTreasure (TreasTrove , 53, unused) ; (* was 43 *)
+ initTreasure (SpeedPotion, 0, unused) ; (* was 0 *)
+ initTreasure (MagicShield, 2, unused) ; (* was 2 *)
+ initTreasure (VisionChest, 120, unused) ; (* was 150 *)
+ initTreasure (HealingPotion, 0, unused) ;
+
+ StrCopy('Treasure No xx', Tmessage ) ;
+ armedTimer := NIL ;
+ qMutex := InitSemaphore (1, "qMutex") ;
+ qAvailable := InitSemaphore (0, "qAvailable") ;
+ qHead := NIL ;
+ freeDesc := NIL ;
+ qThread := NIL
+END Init ;
+
+
+BEGIN
+ Init
+END AdvTreasure.
+(*
+ * Local variables:
+ * compile-command: "make"
+ * End:
+ *)
diff --git a/gcc/testsuite/gm2/projects/pim/run/pass/tower/AdvUtil.def b/gcc/testsuite/gm2/projects/pim/run/pass/tower/AdvUtil.def
new file mode 100644
index 0000000..e9ba401
--- /dev/null
+++ b/gcc/testsuite/gm2/projects/pim/run/pass/tower/AdvUtil.def
@@ -0,0 +1,57 @@
+DEFINITION MODULE AdvUtil ;
+
+
+EXPORT QUALIFIED InitialDisplay, TestIfLastLivePlayer,
+ GetDoorOnPoint, PointOnWall, PointOnTreasure,
+ Positioning, RandomRoom, PositionInRoom,
+ FreeOfPlayersAndTreasure,
+ MoveMan, Dead, Exit,
+ OpenDoor, CloseDoor, ExamineDoor, HideDoor,
+ MagicArrow, NormalArrow, HideTreasure,
+ Parry, Thrust, Attack,
+ Speak ;
+
+
+PROCEDURE InitialDisplay ;
+PROCEDURE Positioning ;
+PROCEDURE Dead (p, room: CARDINAL) ;
+PROCEDURE TestIfLastLivePlayer (VAR yes: BOOLEAN) ;
+PROCEDURE PointOnWall (RoomNo, x, y: CARDINAL ; VAR Success: BOOLEAN) ;
+
+PROCEDURE GetDoorOnPoint (RoomNo, x, y: CARDINAL ;
+ VAR DoorNo: CARDINAL ; VAR Success: BOOLEAN) ;
+
+PROCEDURE PointOnTreasure (RoomNo, x, y: CARDINAL ;
+ VAR TreasNo: CARDINAL ; VAR Success: BOOLEAN) ;
+
+PROCEDURE FreeOfPlayersAndTreasure (room, x, y: CARDINAL ;
+ VAR Success: BOOLEAN) ;
+
+PROCEDURE RandomRoom (CurrentRoom, NoOfRoomsApart: CARDINAL ;
+ VAR room: CARDINAL) ;
+
+(*
+ HideTreasure - hides treasure, t, which is assummed to be absent from the
+ data structures when this procedure is called.
+*)
+
+PROCEDURE HideTreasure (t: CARDINAL) ;
+
+PROCEDURE PositionInRoom (room: CARDINAL ;
+ VAR x, y: CARDINAL ; VAR Success: BOOLEAN) ;
+
+PROCEDURE MoveMan (n: CARDINAL) ;
+PROCEDURE MagicArrow (p: CARDINAL) ;
+PROCEDURE NormalArrow (p: CARDINAL) ;
+PROCEDURE OpenDoor ;
+PROCEDURE CloseDoor ;
+PROCEDURE ExamineDoor ;
+PROCEDURE HideDoor ;
+PROCEDURE Parry ;
+PROCEDURE Attack ;
+PROCEDURE Thrust ;
+PROCEDURE Speak ;
+PROCEDURE Exit ;
+
+
+END AdvUtil.
diff --git a/gcc/testsuite/gm2/projects/pim/run/pass/tower/AdvUtil.mod b/gcc/testsuite/gm2/projects/pim/run/pass/tower/AdvUtil.mod
new file mode 100644
index 0000000..f8a84f5
--- /dev/null
+++ b/gcc/testsuite/gm2/projects/pim/run/pass/tower/AdvUtil.mod
@@ -0,0 +1,1573 @@
+IMPLEMENTATION MODULE AdvUtil ;
+
+
+FROM libc IMPORT printf ;
+FROM AdvSystem IMPORT PlayerSet ;
+FROM ASCII IMPORT cr, lf, nul, bs, del, nak ;
+FROM Screen IMPORT WriteString ;
+FROM Storage IMPORT ALLOCATE, DEALLOCATE ;
+FROM Assertion IMPORT Assert ;
+FROM AdvSound IMPORT Miss, Swish, Hit ;
+
+FROM AdvSystem IMPORT Player, PlayerNo, IsPlayerActive,
+ MaxNoOfPlayers,
+ ArrowArgs,
+ NextFreePlayer,
+ TypeOfDeath,
+ RandomNumber,
+ DefaultWrite,
+
+ GetReadAccessToPlayer,
+ ReleaseReadAccessToPlayer,
+ GetWriteAccessToPlayer,
+ ReleaseWriteAccessToPlayer,
+
+ GetReadAccessToTreasure,
+ ReleaseReadAccessToTreasure,
+ GetWriteAccessToTreasure,
+ ReleaseWriteAccessToTreasure,
+
+ GetReadAccessToDoor,
+ ReleaseReadAccessToDoor,
+ GetWriteAccessToDoor,
+ ReleaseWriteAccessToDoor,
+
+ GetAccessToScreen,
+ ReleaseAccessToScreen,
+ GetAccessToScreenNo,
+ ReleaseAccessToScreenNo,
+ ClientRead ;
+
+FROM AdvMath IMPORT MaxNoOfTreasures ;
+
+FROM AdvMap IMPORT Treasure, Rooms, DoorStatus, TreasureKind,
+ NoOfRoomsToHidePlayers,
+ ActualNoOfRooms,
+ IncPosition ;
+
+FROM Executive IMPORT GetCurrentProcess, Wait, Signal ;
+FROM TimerHandler IMPORT Sleep, TicksPerSecond, GetTicks ;
+FROM ProcArgs IMPORT ProcessArgs, CollectArgs ;
+
+FROM Screen IMPORT InitScreen,
+ WriteWounds,
+ WriteRoom, WriteWeight,
+ WriteCommentLine1, DelCommentLine1,
+ WriteCommentLine2, DelCommentLine2,
+ WriteCommentLine3, DelCommentLine3,
+ InnerX, OuterX, InnerY, OuterY, OffX, OffY,
+ Height, Width ;
+
+FROM AdvMath IMPORT DammageByParry,
+ DammageByAttack,
+ DammageByThrust,
+ DammageByFireArrow,
+ DammageByFireMagic,
+ DammageByMagicParry,
+ DammageByMagicAttack,
+ DammageByMagicThrust,
+
+ MagicSword,
+ MagicShield,
+
+ StrengthToParry,
+ StrengthToAttack,
+ StrengthToThrust,
+ StrengthToFireArrow,
+ StrengthToFireMagic,
+ StrengthToMove,
+ UpDateWoundsAndFatigue ;
+
+FROM DrawL IMPORT DrawAllPlayers, DrawRoom, ClearRoom ;
+
+FROM DrawG IMPORT DrawMan, EraseMan, DrawDoor, DrawArrow, EraseArrow,
+ DisplayMessage, DrawTreasure ;
+
+FROM AdvTreasure IMPORT ScatterTreasures, RespawnTreasure ;
+
+
+CONST
+ SquaresPerSecond = 25 ; (* speed of arrows *)
+ DelayPerSquare = TicksPerSecond DIV SquaresPerSecond ;
+
+
+PROCEDURE Max (a, b: CARDINAL) : CARDINAL ;
+BEGIN
+ IF a>b
+ THEN
+ RETURN( a )
+ ELSE
+ RETURN( b )
+ END
+END Max ;
+
+
+PROCEDURE PointOnLine (x, y, x1, y1, x2, y2: CARDINAL ; VAR ok: BOOLEAN) ;
+BEGIN
+ IF (x=x1) AND (y>=y1) AND (y<=y2)
+ THEN
+ ok := TRUE
+ ELSIF (y=y1) AND (x>=x1) AND (x<=x2)
+ THEN
+ ok := TRUE
+ ELSE
+ ok := FALSE
+ END
+END PointOnLine ;
+
+
+(* All the following routines assume that the calling process has gained *)
+(* access to map, if needed! *)
+
+PROCEDURE ChangeStatusOfDoor (RoomNo, DoorNo: CARDINAL ; ds: DoorStatus) ;
+VAR
+ r,i,x1,x2,y1,y2: CARDINAL ;
+BEGIN
+ WITH Rooms[RoomNo].Doors[DoorNo] DO
+ r := LeadsTo ;
+ StateOfDoor := ds ;
+ x1 := Position.X1 ;
+ y1 := Position.Y1 ;
+ x2 := Position.X2 ;
+ y2 := Position.Y2
+ END ;
+ DrawDoor( RoomNo, DoorNo ) ;
+ IF r#0
+ THEN
+ GetDoorIndex( r, x1, y1, x2, y2, i ) ;
+ Rooms[r].Doors[i].StateOfDoor := ds ;
+ DrawDoor( r, i )
+ END
+END ChangeStatusOfDoor ;
+
+
+PROCEDURE GetDoorIndex (RoomNo,
+ x1, y1, x2, y2: CARDINAL ;
+ VAR i: CARDINAL) ;
+VAR
+ Max : CARDINAL ;
+ ok : BOOLEAN ;
+BEGIN
+ i := 1 ;
+ ok := TRUE ;
+ Max := Rooms[RoomNo].NoOfDoors ;
+ WITH Rooms[RoomNo] DO
+ WHILE (i<=NoOfDoors) AND ok DO
+ WITH Doors[i].Position DO
+ IF (x1=X1) AND (y1=Y1) AND
+ (x2=X2) AND (y2=Y2)
+ THEN
+ ok := FALSE
+ ELSE
+ INC( i )
+ END
+ END
+ END
+ END
+END GetDoorIndex ;
+
+
+PROCEDURE GetDoorOnPoint (RoomNo, x, y: CARDINAL ;
+ VAR DoorNo: CARDINAL ; VAR Success: BOOLEAN) ;
+VAR
+ Max : CARDINAL ;
+BEGIN
+ Max := Rooms[RoomNo].NoOfDoors ;
+ DoorNo := 1 ;
+ Success := FALSE ;
+ WITH Rooms[RoomNo] DO
+ WHILE (NOT Success) AND (DoorNo<=Max) DO
+ WITH Doors[DoorNo].Position DO
+ PointOnLine( x, y, X1, Y1, X2, Y2, Success ) ;
+ IF NOT Success
+ THEN
+ INC( DoorNo )
+ END
+ END
+ END
+ END
+END GetDoorOnPoint ;
+
+
+PROCEDURE OpenToClosedDoor (VAR Success: BOOLEAN) ;
+VAR
+ x, y, DoorNo: CARDINAL ;
+BEGIN
+ WITH Player[PlayerNo()] DO
+ x := Xman ;
+ y := Yman ;
+ IncPosition( x, y, Direction ) ;
+ GetDoorOnPoint( RoomOfMan, x, y, DoorNo, Success ) ;
+ IF Success
+ THEN
+ IF Rooms[RoomOfMan].Doors[DoorNo].StateOfDoor=Open
+ THEN
+ ChangeStatusOfDoor( RoomOfMan, DoorNo, Closed )
+ ELSE
+ Success := FALSE
+ END
+ END
+ END
+END OpenToClosedDoor ;
+
+
+PROCEDURE ClosedToOpenDoor (VAR Success: BOOLEAN) ;
+VAR
+ x, y, DoorNo: CARDINAL ;
+BEGIN
+ WITH Player[PlayerNo()] DO
+ x := Xman ;
+ y := Yman ;
+ IncPosition(x, y, Direction) ;
+ GetDoorOnPoint( RoomOfMan, x, y, DoorNo, Success ) ;
+ IF Success
+ THEN
+ IF Rooms[RoomOfMan].Doors[DoorNo].StateOfDoor=Closed
+ THEN
+ ChangeStatusOfDoor( RoomOfMan, DoorNo, Open )
+ ELSE
+ Success := FALSE
+ END
+ END
+ END
+END ClosedToOpenDoor ;
+
+
+PROCEDURE ClosedToSecretDoor (VAR Success: BOOLEAN) ;
+VAR
+ x, y, DoorNo: CARDINAL ;
+BEGIN
+ WITH Player[PlayerNo()] DO
+ x := Xman ;
+ y := Yman ;
+ IncPosition( x, y, Direction ) ;
+ GetDoorOnPoint( RoomOfMan, x, y, DoorNo, Success ) ;
+ IF Success
+ THEN
+ IF Rooms[RoomOfMan].Doors[DoorNo].StateOfDoor=Closed
+ THEN
+ ChangeStatusOfDoor( RoomOfMan, DoorNo, Secret )
+ ELSE
+ Success := FALSE
+ END
+ END
+ END
+END ClosedToSecretDoor ;
+
+
+PROCEDURE SecretToClosedDoor (VAR Success: BOOLEAN) ;
+VAR
+ x, y, DoorNo: CARDINAL ;
+BEGIN
+ WITH Player[PlayerNo()] DO
+ x := Xman ;
+ y := Yman ;
+ IncPosition( x, y, Direction ) ;
+ GetDoorOnPoint( RoomOfMan, x, y, DoorNo, Success ) ;
+ IF Success
+ THEN
+ IF Rooms[RoomOfMan].Doors[DoorNo].StateOfDoor=Secret
+ THEN
+ ChangeStatusOfDoor( RoomOfMan, DoorNo, Closed )
+ ELSE
+ Success := FALSE
+ END
+ END
+ END
+END SecretToClosedDoor ;
+
+
+PROCEDURE PointOnWall (RoomNo, x, y: CARDINAL ;
+ VAR Success: BOOLEAN) ;
+VAR
+ Max,
+ WallNo : CARDINAL ;
+BEGIN
+ Max := Rooms[RoomNo].NoOfWalls ;
+ WallNo := 1 ;
+ Success := FALSE ;
+ WHILE (NOT Success) AND (WallNo<=Max) DO
+ WITH Rooms[RoomNo].Walls[WallNo] DO
+ PointOnLine( x, y, X1, Y1, X2, Y2, Success ) ;
+ IF NOT Success
+ THEN
+ INC( WallNo )
+ END
+ END
+ END
+END PointOnWall ;
+
+
+PROCEDURE PointOnTreasure (RoomNo, x, y: CARDINAL ;
+ VAR TreasNo: CARDINAL ; VAR Success: BOOLEAN) ;
+BEGIN
+ TreasNo := 1 ;
+ Success := FALSE ;
+ WHILE (NOT Success) AND (TreasNo<=MaxNoOfTreasures) DO
+ WITH Treasure[TreasNo] DO
+ IF (Rm = RoomNo) AND (kind = onfloor)
+ THEN
+ IF (Xpos=x) AND (Ypos=y)
+ THEN
+ Success := TRUE
+ ELSE
+ INC( TreasNo )
+ END
+ ELSE
+ INC( TreasNo )
+ END
+ END
+ END
+END PointOnTreasure ;
+
+
+(* This routine finds out if a point is upon a player. It does use *)
+(* GetReadAccessToPlayer & ReleaseReadAccessToPlayer. This routine *)
+(* returns Success if the point was on a player and also sets *)
+(* PlayNo to tell which player is upon this square. *)
+
+PROCEDURE PointOnPlayer (RoomNo, x, y: CARDINAL ;
+ VAR PlayNo: CARDINAL ; VAR Success: BOOLEAN) ;
+BEGIN
+ PlayNo := 0 ;
+ Success := FALSE ;
+ GetReadAccessToPlayer ;
+ WHILE (NOT Success) AND (PlayNo<NextFreePlayer) DO
+ WITH Player[PlayNo] DO
+ IF IsPlayerActive(PlayNo) AND (Xman=x) AND (Yman=y)
+ THEN
+ Success := TRUE
+ ELSE
+ INC(PlayNo)
+ END
+ END
+ END ;
+ ReleaseReadAccessToPlayer
+END PointOnPlayer ;
+
+
+PROCEDURE TestIfLastLivePlayer (VAR yes: BOOLEAN) ;
+VAR
+ p, i: CARDINAL ;
+BEGIN
+ p := PlayerNo() ;
+ i := 0 ;
+ yes := TRUE ;
+ WHILE (i<NextFreePlayer) AND yes DO
+ IF p#i
+ THEN
+ IF (Player[i].DeathType=living) AND IsPlayerActive(i)
+ THEN
+ yes := FALSE
+ END
+ END ;
+ INC( i )
+ END
+END TestIfLastLivePlayer ;
+
+PROCEDURE ReceiveFireFromProcess (p: CARDINAL;
+ VAR r, x, y, d: CARDINAL; magic: BOOLEAN) ;
+VAR
+ aa: ArrowArgs ;
+BEGIN
+ IF magic
+ THEN
+ aa := CollectArgs(Player[p].MagicProcArgs)
+ ELSE
+ aa := CollectArgs(Player[p].NormalProcArgs)
+ END ;
+ WITH aa^ DO
+ Assert(p=ArrowPlayer) ;
+ r := ArrowRoom ;
+ x := ArrowX ;
+ y := ArrowY ;
+ d := ArrowDir
+ END ;
+ DISPOSE(aa)
+END ReceiveFireFromProcess ;
+
+
+PROCEDURE NormalArrow (p: CARDINAL) ;
+VAR
+ x, y, r,
+ d,
+ player : CARDINAL ;
+ hit,
+ done,
+ SlainP : BOOLEAN ;
+BEGIN
+ WITH Player[p] DO
+ LOOP
+ SlainP := FALSE ;
+ ReceiveFireFromProcess(p, r, x, y, d, FALSE) ;
+ REPEAT
+ FireArrow(p, r, x, y, d, hit, player) ;
+ IF hit
+ THEN
+ GetReadAccessToPlayer ;
+ WITH Player[player] DO
+ IF MagicShield IN TreasureOwn
+ THEN
+ done := FALSE ;
+ d := (d+2) MOD 4 ;
+ x := Xman ;
+ y := Yman ;
+ r := RoomOfMan ;
+ IncPosition(x, y, d)
+ ELSE
+ done := TRUE
+ END
+ END ;
+ ReleaseReadAccessToPlayer
+ ELSE
+ done := TRUE
+ END
+ UNTIL done ;
+ IF hit
+ THEN
+ WITH Player[player] DO
+ GetWriteAccessToPlayer ;
+
+ GetAccessToScreenNo(player) ;
+ UpDateWoundsAndFatigue(player) ;
+ IF Wounds<=DammageByFireArrow
+ THEN
+ r := RoomOfMan ;
+ SlainP := TRUE ;
+ Wounds := 0 ;
+ DeathType := normalarrow ;
+ ELSE
+ DEC( Wounds, DammageByFireArrow )
+ END ;
+ WriteWounds(player, Wounds) ;
+ WriteCommentLine1(player, 'struck thee') ;
+ DelCommentLine2(player) ;
+ DelCommentLine3(player) ;
+ ReleaseAccessToScreenNo(player) ;
+
+ GetAccessToScreenNo(p) ;
+ IF Wounds=0
+ THEN
+ DelCommentLine1(p) ;
+ WriteCommentLine2(p, 'slain') ;
+ WriteCommentLine3(p, ManName )
+ ELSE
+ WriteCommentLine1(p, 'thwunk') ;
+ DelCommentLine2(p) ;
+ DelCommentLine3(p)
+ END ;
+ ReleaseAccessToScreenNo(p) ;
+ ReleaseWriteAccessToPlayer
+ END
+ ELSE
+ GetAccessToScreenNo(p) ;
+ WriteCommentLine1(p, 'swish') ;
+ DelCommentLine2(p) ;
+ DelCommentLine3(p) ;
+ ReleaseAccessToScreenNo(p)
+ END ;
+ IF SlainP
+ THEN
+ Dead(player, r)
+ END
+ END
+ END
+END NormalArrow ;
+
+
+PROCEDURE MagicArrow (p: CARDINAL) ;
+VAR
+ x, y, r,
+ d,
+ player : CARDINAL ;
+ hit,
+ SlainP : BOOLEAN ;
+BEGIN
+ WITH Player[p] DO
+ LOOP
+ SlainP := FALSE ;
+ ReceiveFireFromProcess(p, r, x, y, d, TRUE) ;
+ FireArrow(p, r, x, y, d, hit, player) ;
+ IF hit
+ THEN
+ WITH Player[player] DO
+ GetWriteAccessToPlayer ;
+
+ GetAccessToScreenNo(player) ;
+ UpDateWoundsAndFatigue(player) ;
+ IF Wounds<=DammageByFireMagic
+ THEN
+ r := RoomOfMan ;
+ SlainP := TRUE ;
+ DeathType := magicarrow ;
+ Wounds := 0
+ ELSE
+ DEC(Wounds, DammageByFireMagic)
+ END ;
+ WriteWounds(player, Wounds) ;
+ WriteCommentLine1(player, 'struck thee') ;
+ DelCommentLine2(player) ;
+ DelCommentLine3(player) ;
+ ReleaseAccessToScreenNo(player) ;
+
+ GetAccessToScreenNo(p) ;
+
+ IF Wounds=0
+ THEN
+ DelCommentLine1(p) ;
+ WriteCommentLine2(p, 'slain') ;
+ WriteCommentLine3(p, ManName)
+ ELSE
+ WriteCommentLine1(p, 'thwunk') ;
+ DelCommentLine2(p) ;
+ DelCommentLine3(p)
+ END ;
+ ReleaseAccessToScreenNo(p) ;
+ ReleaseWriteAccessToPlayer
+ END
+ ELSE
+ GetAccessToScreenNo(p) ;
+
+ WriteCommentLine1(p, 'swish') ;
+ DelCommentLine2(p) ;
+ DelCommentLine3(p) ;
+ ReleaseAccessToScreenNo(p)
+ END ;
+ IF SlainP
+ THEN
+ Dead(player, r)
+ END
+ END
+ END
+END MagicArrow ;
+
+
+PROCEDURE FireArrow (p, r, x, y, d: CARDINAL ;
+ VAR hit: BOOLEAN ; VAR player: CARDINAL) ;
+VAR
+ t : INTEGER ;
+ NotCont : BOOLEAN ;
+ door,
+ X, Y,
+ i, j : CARDINAL ;
+ playerscreen: PlayerSet ;
+ LastTime,
+ DelayTime : CARDINAL ;
+BEGIN
+ i := x ; (* old x & y *)
+ j := y ;
+ playerscreen := PlayerSet{} ;
+ Swish(r) ;
+ REPEAT
+ LastTime := GetTicks() ;
+ PointOnPlayer(r, x, y, player, NotCont) ;
+ hit := NotCont ;
+ IF NOT NotCont
+ THEN
+ GetReadAccessToDoor ;
+ GetDoorOnPoint(r, x, y, door, NotCont) ;
+ IF NotCont
+ THEN
+ WITH Rooms[r].Doors[door] DO
+ IF (StateOfDoor=Open) AND (LeadsTo#0)
+ THEN
+ NotCont := FALSE ;
+ r := LeadsTo
+ END
+ END ;
+ ReleaseReadAccessToDoor ;
+ ELSE
+ ReleaseReadAccessToDoor ;
+ PointOnWall(r, x, y, NotCont) ;
+ IF NOT NotCont
+ THEN
+ GetReadAccessToTreasure ;
+ PointOnTreasure(r, x, y, door, NotCont) ;
+ ReleaseReadAccessToTreasure ;
+ IF NOT NotCont
+ THEN
+ GetReadAccessToPlayer ;
+ EraseArrow(i, j, playerscreen, FALSE) ;
+ DrawArrow(r, x, y, d, playerscreen) ;
+ ReleaseReadAccessToPlayer ;
+ i := x ;
+ j := y
+ END
+ END
+ END
+ END ;
+ IncPosition(x, y, d) ;
+ (* now we regulate a constant velocity arrow! *)
+ DelayTime := GetTicks() - LastTime ;
+ IF DelayTime<DelayPerSquare
+ THEN
+ (* t := printf("before Sleep for %d ticks\n", DelayPerSquare-DelayTime) ; *)
+ Sleep(DelayPerSquare-DelayTime)
+ (* ; t := printf("after Sleep\n") ; *)
+ END
+ UNTIL NotCont ;
+ IF hit
+ THEN
+ Hit(p)
+ ELSE
+ Miss(r)
+ END ;
+ IF (X#i) OR (Y#j)
+ THEN
+ GetReadAccessToPlayer ;
+ EraseArrow(i, j, playerscreen, TRUE) ;
+ ReleaseReadAccessToPlayer
+ END
+END FireArrow ;
+
+
+PROCEDURE Exit ;
+VAR
+ p : CARDINAL ;
+ yes: BOOLEAN ;
+BEGIN
+ p := PlayerNo() ;
+ GetReadAccessToPlayer ;
+ TestIfLastLivePlayer(yes) ;
+ ReleaseReadAccessToPlayer ;
+ IF NOT yes
+ THEN
+ Dead(p, Player[p].RoomOfMan)
+ END
+END Exit ;
+
+
+(* MoveMan moves the man forward n squares, providing these squares *)
+(* are free from a WALL, DOOR (closed, secret), TREASURE and MAN. *)
+
+PROCEDURE MoveMan (n: CARDINAL) ;
+VAR
+ p : CARDINAL ;
+ yes : BOOLEAN ;
+BEGIN
+ IF n>0
+ THEN
+ p := PlayerNo() ;
+ GetWriteAccessToPlayer ;
+ MoveMan1(n, p) ;
+ ReleaseWriteAccessToPlayer ;
+ IF Player[p].DeathType=exitdungeon
+ THEN
+ TestIfLastLivePlayer(yes) ;
+ IF NOT yes
+ THEN
+ Dead(p, Player[0].RoomOfMan)
+ END
+ END
+ END
+END MoveMan ;
+
+
+PROCEDURE MoveMan1 (n, p: CARDINAL) ;
+VAR
+ x, y,
+ i, j, s,
+ r, dir,
+ tr, z,
+ Sx, Sy,
+ DoorNo : CARDINAL ;
+ hit : BOOLEAN ;
+BEGIN
+ StrengthToMove(n, hit) ;
+ IF hit
+ THEN
+ WITH Player[p] DO
+ EraseMan(p) ;
+ dir := Direction ;
+ tr := RoomOfMan ;
+ x := Xman ;
+ y := Yman ;
+ Sx := ScreenX ;
+ Sy := ScreenY ;
+ hit := FALSE ;
+ s := 1 ;
+ i := x ;
+ j := y ;
+ r := tr ;
+ WHILE (s<=n) AND (NOT hit) DO
+ IncPosition(i, j, dir) ;
+ GetReadAccessToDoor ;
+ GetDoorOnPoint(r, i, j, DoorNo, hit) ;
+ IF hit
+ THEN
+ IF Rooms[r].Doors[DoorNo].StateOfDoor=Open
+ THEN
+ z := Rooms[r].Doors[DoorNo].LeadsTo ;
+ ReleaseReadAccessToDoor ;
+ IF z=0
+ THEN
+ DeathType := exitdungeon
+ ELSE
+ IncPosition(i, j, dir) ;
+ TakenPointInRoom(z, i, j, hit) ;
+ IF NOT hit (* Empty Point In Room *)
+ THEN
+ INC(s) ;
+ x := i ;
+ y := j ;
+ r := z (* Ok so changed room *)
+ END
+ END
+ ELSE
+ ReleaseReadAccessToDoor
+ END ;
+ ELSE
+ ReleaseReadAccessToDoor ;
+ PointOnWall(r, i, j, hit) ;
+ IF NOT hit
+ THEN
+ GetReadAccessToTreasure ;
+ PointOnTreasure(r, i, j, z, hit) ;
+ ReleaseReadAccessToTreasure ;
+ IF NOT hit
+ THEN
+ PointOnOtherPlayer(i, j, z, hit) ;
+ IF NOT hit
+ THEN
+ x := i ;
+ y := j ;
+ INC(s)
+ END
+ END
+ END
+ END
+ END ;
+ IF (x#Xman) OR (y#Yman)
+ THEN
+ Xman := x ;
+ Yman := y ;
+ ScaleSights(x, y, Sx, Sy, hit) ;
+ ScreenX := Sx ;
+ ScreenY := Sy ;
+ RoomOfMan := r ;
+ IF r#0
+ THEN
+ IF (tr#r) OR hit
+ THEN
+ IF hit
+ THEN
+ InitScreen(p)
+ ELSE
+ GetAccessToScreenNo(p) ;
+ WriteRoom(p, r) ;
+ ReleaseAccessToScreenNo(p)
+ END ;
+ ClearRoom(tr) ;
+ DrawRoom
+ END ;
+ DrawMan(p)
+ END
+ ELSE
+ DrawMan(p)
+ END
+ END
+ END
+END MoveMan1 ;
+
+
+PROCEDURE TakenPointInRoom (room, x, y: CARDINAL ; VAR ok: BOOLEAN) ;
+VAR
+ z: CARDINAL ;
+BEGIN
+ PointOnWall( room, x, y, ok ) ;
+ IF NOT ok
+ THEN
+ GetReadAccessToDoor ;
+ GetDoorOnPoint(room, x, y, z, ok) ;
+ ReleaseReadAccessToDoor ;
+ IF NOT ok
+ THEN
+
+ (* No need to get Read Access To Player 's since taken care of *)
+ (* in the called routine. *)
+
+ PointOnOtherPlayer(x, y, z, ok) ;
+ IF NOT ok
+ THEN
+ GetReadAccessToTreasure ;
+ PointOnTreasure(room, x, y, z, ok) ;
+ ReleaseReadAccessToTreasure
+ END
+ END
+ END
+END TakenPointInRoom ;
+
+
+(* ScaleSights scales the sights of the ScreenX and ScreenY *)
+(* coordinates according to whether the player is off the *)
+(* screen or off the boundary. It returns Done if the routine *)
+(* has altered Sx, Sy. *)
+
+PROCEDURE ScaleSights (x, y: CARDINAL ; VAR Sx, Sy: CARDINAL ;
+ VAR Done: BOOLEAN) ;
+VAR
+ sx, sy: CARDINAL ;
+BEGIN
+ sx := Sx ;
+ sy := Sy ;
+ IF Sx+InnerX>x
+ THEN
+ Dec(Sx, OffX)
+ ELSIF Sx+OuterX < x
+ THEN
+ Inc(Sx, OffX)
+ END ;
+ IF Sy+InnerY>y
+ THEN
+ Dec(Sy, OffY)
+ ELSIF Sy+OuterY<y
+ THEN
+ Inc(Sy, OffY)
+ END ;
+ Done := (sx#Sx) OR (sy#Sy)
+END ScaleSights ;
+
+
+PROCEDURE Inc (VAR s: CARDINAL ; c: CARDINAL) ;
+BEGIN
+ IF (c DIV 2) + (s DIV 2) < 32768
+ THEN
+ INC(s, c)
+ END
+END Inc ;
+
+
+PROCEDURE Dec (VAR s: CARDINAL ; c: CARDINAL) ;
+BEGIN
+ IF c<=s
+ THEN
+ DEC(s, c)
+ ELSIF s>0
+ THEN
+ s := 0
+ END
+END Dec ;
+
+
+PROCEDURE Parry ;
+VAR
+ p, r, x, y, Pn : CARDINAL ;
+ hit, SlainP : BOOLEAN ;
+BEGIN
+ SlainP := FALSE ;
+ p := PlayerNo() ;
+ WITH Player[p] DO
+ GetWriteAccessToPlayer ;
+ StrengthToParry(hit) ;
+ IF hit
+ THEN
+ ReleaseWriteAccessToPlayer ;
+ GetReadAccessToPlayer ;
+ x := Xman ;
+ y := Yman ;
+ IncPosition(x, y, Direction) ;
+ PointOnOtherPlayer(x, y, Pn, hit) ;
+ ReleaseReadAccessToPlayer ;
+ IF hit
+ THEN
+ WITH Player[Pn] DO
+ GetWriteAccessToPlayer ;
+
+ GetAccessToScreenNo(Pn) ;
+ UpDateWoundsAndFatigue(Pn) ;
+ ReleaseAccessToScreenNo(Pn) ;
+
+ IF MagicSword IN Player[p].TreasureOwn
+ THEN
+ GetAccessToScreenNo(p) ;
+ IF Wounds>DammageByMagicParry
+ THEN
+ DEC(Wounds, DammageByMagicParry) ;
+ WriteCommentLine1(p, 'hit') ;
+ DelCommentLine2(p) ;
+ DelCommentLine3(p)
+ ELSE
+ r := RoomOfMan ;
+ SlainP := TRUE ;
+ Wounds := 0 ;
+ DeathType := sword ;
+ DelCommentLine1(p) ;
+ WriteCommentLine2(p, 'Slain') ;
+ WriteCommentLine3(p, ManName )
+ END ;
+ ReleaseAccessToScreenNo(p)
+ ELSE
+ GetAccessToScreenNo(p) ;
+ IF Wounds>DammageByParry
+ THEN
+ DEC( Wounds, DammageByParry ) ;
+ WriteCommentLine1(p, 'hit') ;
+ DelCommentLine2(p) ;
+ DelCommentLine3(p)
+ ELSE
+ r := RoomOfMan ;
+ SlainP := TRUE ;
+ Wounds := 0 ;
+ DeathType := sword ;
+ DelCommentLine1(p) ;
+ WriteCommentLine2(p, 'Slain') ;
+ WriteCommentLine3(p, ManName ) ;
+ END ;
+ ReleaseAccessToScreenNo(p)
+ END ;
+
+ GetAccessToScreenNo(Pn) ;
+ WriteCommentLine1(Pn, 'hit thee') ;
+ DelCommentLine2(Pn) ;
+ DelCommentLine3(Pn) ;
+ WriteWounds( Pn, Wounds ) ;
+ ReleaseAccessToScreenNo(Pn) ;
+
+ ReleaseWriteAccessToPlayer
+ END
+ ELSE
+ GetAccessToScreenNo(p) ;
+ WriteCommentLine1(p, 'missed') ;
+ DelCommentLine2(p) ;
+ DelCommentLine3(p) ;
+ ReleaseAccessToScreenNo(p)
+ END
+ ELSE
+ ReleaseWriteAccessToPlayer
+ END
+ END ;
+ IF SlainP
+ THEN
+ Dead( Pn, r )
+ END
+END Parry ;
+
+
+PROCEDURE Attack ;
+VAR
+ p, r, x, y, Pn : CARDINAL ;
+ hit, SlainP : BOOLEAN ;
+BEGIN
+ SlainP := FALSE ;
+ p := PlayerNo() ;
+ WITH Player[p] DO
+ GetWriteAccessToPlayer ;
+ StrengthToAttack( hit ) ;
+ IF hit
+ THEN
+ ReleaseWriteAccessToPlayer ;
+ GetReadAccessToPlayer ;
+ x := Xman ;
+ y := Yman ;
+ IncPosition(x, y, Direction) ;
+ PointOnOtherPlayer(x, y, Pn, hit) ;
+ ReleaseReadAccessToPlayer ;
+ IF hit
+ THEN
+ WITH Player[Pn] DO
+ GetWriteAccessToPlayer ;
+
+ GetAccessToScreenNo(Pn) ;
+ UpDateWoundsAndFatigue(Pn) ;
+ ReleaseAccessToScreenNo(Pn) ;
+
+ IF MagicSword IN Player[p].TreasureOwn
+ THEN
+ GetAccessToScreenNo(p) ;
+ IF Wounds>DammageByMagicAttack
+ THEN
+ DEC(Wounds, DammageByMagicAttack) ;
+ WriteCommentLine1(p, 'hit') ;
+ DelCommentLine2(p) ;
+ DelCommentLine3(p)
+ ELSE
+ r := RoomOfMan ;
+ SlainP := TRUE ;
+ Wounds := 0 ;
+ DeathType := sword ;
+ DelCommentLine1(p) ;
+ WriteCommentLine2(p, 'Slain') ;
+ WriteCommentLine3(p, ManName)
+ END ;
+ ReleaseAccessToScreenNo( p )
+ ELSE
+ GetAccessToScreenNo( p ) ;
+ IF Wounds>DammageByAttack
+ THEN
+ DEC( Wounds, DammageByAttack ) ;
+ WriteCommentLine1(p, 'hit') ;
+ DelCommentLine2(p) ;
+ DelCommentLine3(p)
+ ELSE
+ r := RoomOfMan ;
+ SlainP := TRUE ;
+ Wounds := 0 ;
+ DeathType := sword ;
+ DelCommentLine1(p) ;
+ WriteCommentLine2(p, 'Slain') ;
+ WriteCommentLine3(p, ManName)
+ END ;
+ ReleaseAccessToScreenNo(p)
+ END ;
+
+ GetAccessToScreenNo(Pn) ;
+
+ WriteCommentLine1(Pn, 'hit thee') ;
+ DelCommentLine2(Pn) ;
+ DelCommentLine3(Pn) ;
+ WriteWounds(Pn, Wounds) ;
+ ReleaseAccessToScreenNo(Pn) ;
+
+ ReleaseWriteAccessToPlayer
+ END
+ ELSE
+ GetAccessToScreenNo(p) ;
+ WriteCommentLine1(p, 'missed') ;
+ DelCommentLine2(p) ;
+ DelCommentLine3(p) ;
+ ReleaseAccessToScreenNo(p)
+ END
+ ELSE
+ ReleaseWriteAccessToPlayer
+ END
+ END ;
+ IF SlainP
+ THEN
+ Dead( Pn, r )
+ END
+END Attack ;
+
+
+PROCEDURE Thrust ;
+VAR
+ p, r, x, y, Pn : CARDINAL ;
+ hit, SlainP : BOOLEAN ;
+BEGIN
+ SlainP := FALSE ;
+ p := PlayerNo() ;
+ WITH Player[p] DO
+ GetWriteAccessToPlayer ;
+ StrengthToThrust(hit) ;
+ IF hit
+ THEN
+ ReleaseWriteAccessToPlayer ;
+ GetReadAccessToPlayer ;
+ x := Xman ;
+ y := Yman ;
+ IncPosition(x, y, Direction) ;
+ PointOnOtherPlayer(x, y, Pn, hit) ;
+ ReleaseReadAccessToPlayer ;
+ IF hit
+ THEN
+ WITH Player[Pn] DO
+ GetWriteAccessToPlayer ;
+
+ GetAccessToScreenNo(Pn) ;
+ UpDateWoundsAndFatigue(Pn) ;
+ ReleaseAccessToScreenNo(Pn) ;
+
+ IF MagicSword IN Player[p].TreasureOwn
+ THEN
+ GetAccessToScreenNo(p) ;
+ IF Wounds>DammageByMagicThrust
+ THEN
+ DEC(Wounds, DammageByMagicThrust) ;
+ WriteCommentLine1(p, 'hit') ;
+ DelCommentLine2(p) ;
+ DelCommentLine3(p)
+ ELSE
+ r := RoomOfMan ;
+ SlainP := TRUE ;
+ Wounds := 0 ;
+ DeathType := sword ;
+ DelCommentLine1(p) ;
+ WriteCommentLine2(p, 'Slain') ;
+ WriteCommentLine3(p, ManName)
+ END ;
+ ReleaseAccessToScreenNo(p)
+ ELSE
+ GetAccessToScreenNo(p) ;
+ IF Wounds>DammageByThrust
+ THEN
+ DEC(Wounds, DammageByThrust) ;
+ WriteCommentLine1(p, 'hit') ;
+ DelCommentLine2(p) ;
+ DelCommentLine3(p)
+ ELSE
+ r := RoomOfMan ;
+ SlainP := TRUE ;
+ Wounds := 0 ;
+ DeathType := sword ;
+ DelCommentLine1(p) ;
+ WriteCommentLine2(p, 'Slain') ;
+ WriteCommentLine3(p, ManName)
+ END ;
+ ReleaseAccessToScreenNo( p )
+ END ;
+
+ GetAccessToScreenNo(Pn) ;
+
+ WriteCommentLine1(Pn, 'hit thee') ;
+ DelCommentLine2(Pn) ;
+ DelCommentLine3(Pn) ;
+ WriteWounds( Pn, Wounds ) ;
+ ReleaseAccessToScreenNo(Pn) ;
+
+ ReleaseWriteAccessToPlayer
+ END
+ ELSE
+ GetAccessToScreenNo(p) ;
+ WriteCommentLine1(p, 'missed') ;
+ DelCommentLine2(p) ;
+ DelCommentLine3(p) ;
+ ReleaseAccessToScreenNo(p)
+ END
+ ELSE
+ ReleaseWriteAccessToPlayer
+ END
+ END ;
+ IF SlainP
+ THEN
+ Dead( Pn, r )
+ END
+END Thrust ;
+
+
+(* Tests to see whether the point is occupied by another player. *)
+(* This procedure does NOT use any lock. *)
+
+PROCEDURE PointOnOtherPlayer (x, y: CARDINAL ;
+ VAR Pn: CARDINAL ; VAR Success: BOOLEAN) ;
+VAR
+ p: CARDINAL ;
+BEGIN
+ Success := FALSE ;
+ p := PlayerNo() ;
+ Pn := 0 ;
+ WHILE (Pn<NextFreePlayer) AND (NOT Success) DO
+ IF (Pn#p) AND IsPlayerActive(Pn)
+ THEN
+ WITH Player[Pn] DO
+ IF (Xman=x) AND (Yman=y)
+ THEN
+ Success := TRUE
+ ELSE
+ INC( Pn )
+ END
+ END
+ ELSE
+ INC( Pn )
+ END
+ END
+END PointOnOtherPlayer ;
+
+
+PROCEDURE OpenDoor ;
+VAR
+ Success: BOOLEAN ;
+BEGIN
+ GetReadAccessToPlayer ;
+ GetWriteAccessToDoor ;
+ ClosedToOpenDoor(Success) ;
+ GetAccessToScreen ;
+ IF Success
+ THEN
+ DelCommentLine1(PlayerNo())
+ ELSE
+ WriteCommentLine1(PlayerNo(), 'thou canst')
+ END ;
+ ReleaseAccessToScreen ;
+ ReleaseWriteAccessToDoor ;
+ ReleaseReadAccessToPlayer
+END OpenDoor ;
+
+
+PROCEDURE ExamineDoor ;
+VAR
+ Success: BOOLEAN ;
+BEGIN
+ GetReadAccessToPlayer ;
+ GetWriteAccessToDoor ;
+ SecretToClosedDoor(Success) ;
+ GetAccessToScreen ;
+ IF Success
+ THEN
+ DelCommentLine1(PlayerNo())
+ ELSE
+ WriteCommentLine1(PlayerNo(), 'nothing')
+ END ;
+ ReleaseAccessToScreen ;
+ ReleaseWriteAccessToDoor ;
+ ReleaseReadAccessToPlayer
+END ExamineDoor ;
+
+
+PROCEDURE CloseDoor ;
+VAR
+ Success: BOOLEAN ;
+BEGIN
+ GetReadAccessToPlayer ;
+ GetWriteAccessToDoor ;
+ OpenToClosedDoor(Success) ;
+ GetAccessToScreen ;
+ IF Success
+ THEN
+ DelCommentLine1(PlayerNo())
+ ELSE
+ WriteCommentLine1(PlayerNo(), 'thou canst')
+ END ;
+ ReleaseAccessToScreen ;
+ ReleaseWriteAccessToDoor ;
+ ReleaseReadAccessToPlayer
+END CloseDoor ;
+
+
+PROCEDURE HideDoor ;
+VAR
+ Success: BOOLEAN ;
+BEGIN
+ GetReadAccessToPlayer ;
+ GetWriteAccessToDoor ;
+ ClosedToSecretDoor(Success) ;
+ GetAccessToScreen ;
+ IF Success
+ THEN
+ DelCommentLine1(PlayerNo())
+ ELSE
+ WriteCommentLine1(PlayerNo(), 'thou canst')
+ END ;
+ ReleaseAccessToScreen ;
+ ReleaseWriteAccessToDoor ;
+ ReleaseReadAccessToPlayer
+END HideDoor ;
+
+
+(* Speak Function *)
+
+PROCEDURE Speak ;
+VAR
+ a1, a2, a3: ARRAY [0..14] OF CHAR ;
+ i, r, p : CARDINAL ;
+ ch : CHAR ;
+BEGIN
+ p := PlayerNo() ;
+ r := Player[p].RoomOfMan ;
+ i := 0 ;
+ a1[0] := nul ;
+ a2[0] := nul ;
+ a3[0] := nul ;
+ REPEAT
+ IF ClientRead(ch)
+ THEN
+ IF ch=nak
+ THEN
+ i := 0
+ ELSIF (ch=del) OR (ch=bs)
+ THEN
+ IF i>0
+ THEN
+ DEC( i )
+ END
+ ELSIF (ch>=' ') OR (ch=cr)
+ THEN
+ IF ch=cr
+ THEN
+ ch := nul
+ END ;
+ IF i<15
+ THEN
+ a1[i] := ch
+ ELSIF i<30
+ THEN
+ a2[i-15] := ch
+ ELSE
+ a3[i-30] := ch
+ END ;
+ INC( i )
+ END
+ ELSE
+ RETURN
+ END
+ UNTIL (ch=nul) OR (i>44) ;
+ DisplayMessage( a1, a2, a3 ) ;
+END Speak ;
+
+
+(* Assumes we are configured to write to player, p, *)
+
+PROCEDURE Dead (p, room : CARDINAL) ;
+BEGIN
+ WITH Player[p] DO
+ GetWriteAccessToPlayer ;
+ IF room#0
+ THEN
+ GetReadAccessToDoor ;
+ GetWriteAccessToTreasure ;
+ ScatterTreasures(p, room) ;
+ EraseMan(p) ;
+ ReleaseWriteAccessToTreasure ;
+ ReleaseReadAccessToDoor
+ END ;
+ ReleaseWriteAccessToPlayer
+ END
+END Dead ;
+
+
+(* RandomRoom takes the current room and works out a random room. *)
+
+PROCEDURE RandomRoom (CurrentRoom, NoOfRoomsApart: CARDINAL ;
+ VAR room: CARDINAL) ;
+VAR
+ i: CARDINAL ;
+BEGIN
+ (* Warning the method used here may cause problems to a map which *)
+ (* does not have consecutive rooms. *)
+
+ RandomNumber( i, ActualNoOfRooms) ;
+ room := i+1
+
+(*
+ Cutting out this routine for the moment.
+
+ room := CurrentRoom ;
+ WHILE NoOfRoomsApart>0 DO
+ IF Rooms[CurrentRoom].NoOfDoors=1
+ THEN
+ i := 1
+ ELSE
+ RandomNumber( i, Rooms[CurrentRoom].NoOfDoors ) ;
+ INC( i )
+ END ;
+ room := Rooms[CurrentRoom].Doors[i].LeadsTo ;
+ IF room=0
+ THEN
+ room := CurrentRoom
+ ELSE
+ CurrentRoom := room
+ END ;
+ DEC( NoOfRoomsApart )
+ END
+*)
+END RandomRoom ;
+
+
+(* GetRandomPosition finds a free random position within a room *)
+
+PROCEDURE PositionInRoom (room: CARDINAL ;
+ VAR x, y: CARDINAL ; VAR Success: BOOLEAN) ;
+VAR
+ r : INTEGER ;
+ maxx, maxy,
+ x1, y1, doorno,
+ j, i, d, z,
+ OldRoom : CARDINAL ;
+ OkOld, ok,
+ OkCurrent : BOOLEAN ;
+BEGIN
+ doorno := 1 ;
+ Success := FALSE ;
+ WHILE (doorno<=Rooms[room].NoOfDoors) AND (NOT Success) DO
+ OldRoom := Rooms[room].Doors[doorno].LeadsTo ;
+ IF OldRoom#0
+ THEN
+ WITH Rooms[room].Doors[doorno].Position DO
+ x1 := X1 ;
+ y1 := Y1 ;
+ i := X2
+ END ;
+ IF x1=i
+ THEN
+ d := 1
+ ELSE
+ d := 0
+ END ;
+ i := 1 ;
+ maxx := 0 ;
+ maxy := 0 ;
+ WHILE i<=Rooms[room].NoOfWalls DO
+ maxx := Max(Rooms[room].Walls[i].X2, maxx) ;
+ maxy := Max(Rooms[room].Walls[i].Y2, maxy) ;
+ INC(i)
+ END ;
+ OkCurrent := FALSE ;
+ OkOld := FALSE ;
+ WHILE NOT OkCurrent DO
+ d := (d+2) MOD 4 ;
+ i := x1 ;
+ j := y1 ;
+ REPEAT
+ IncPosition(i, j, d) ;
+ PointOnWall(room, i, j, OkCurrent) ;
+ IF NOT OkCurrent
+ THEN
+ GetDoorOnPoint(room, i, j, z, OkCurrent)
+ END ;
+ PointOnWall(OldRoom, i, j, OkOld) ;
+ IF NOT OkOld
+ THEN
+ GetDoorOnPoint(OldRoom, i, j, z, OkOld)
+ END ;
+ IF NOT OkCurrent
+ THEN
+ FreeOfPlayersAndTreasure(room, i, j, ok) ;
+ IF ok
+ THEN
+ Success := TRUE ;
+ x := i ;
+ y := j
+ END
+ END
+ UNTIL OkCurrent OR OkOld OR
+ (ODD(d) AND ((i=0) OR (i>=maxx))) OR
+ ((NOT ODD(d)) AND ((j=0) OR (j>=maxy))) ;
+ IF OkOld
+ THEN
+ Success := FALSE
+ END
+ END
+ END ;
+ INC(doorno)
+ END ;
+ IF Success
+ THEN
+ r := printf("room %d position %d %d\n", room, x, y)
+ END
+END PositionInRoom ;
+
+
+PROCEDURE FreeOfPlayersAndTreasure (room, x, y: CARDINAL ; VAR Success: BOOLEAN) ;
+VAR
+ i : CARDINAL ;
+BEGIN
+ Success := TRUE ;
+ i := 0 ;
+ WHILE (i<NextFreePlayer) AND Success DO
+ IF IsPlayerActive(i)
+ THEN
+ WITH Player[i] DO
+ IF room=RoomOfMan
+ THEN
+ IF (Xman=x) AND (Yman=y)
+ THEN
+ Success := FALSE
+ END
+ END
+ END
+ END ;
+ INC (i)
+ END ;
+ IF Success
+ THEN
+ i := 1 ;
+ WHILE (i<=MaxNoOfTreasures) AND Success DO
+ WITH Treasure[i] DO
+ IF (Rm=room) AND (kind=onfloor)
+ THEN
+ IF (Xpos=x) AND (Ypos=y)
+ THEN
+ Success := FALSE
+ END
+ END
+ END ;
+ INC (i)
+ END
+ END
+END FreeOfPlayersAndTreasure ;
+
+
+(*
+ HideTreasure - hides treasure, t, which is assummed to be absent from the
+ data structures when this procedure is called.
+*)
+
+PROCEDURE HideTreasure (t: CARDINAL) ;
+VAR
+ ok: BOOLEAN ;
+BEGIN
+ GetReadAccessToTreasure ;
+ RespawnTreasure (GetRandomRoom(NoOfRoomsToHidePlayers, ActualNoOfRooms), t, 0) ;
+ ReleaseReadAccessToTreasure
+END HideTreasure ;
+
+
+(*
+ GetRandomRoom - returns a random room.
+*)
+
+PROCEDURE GetRandomRoom (NoOfRoomsToTraverse, TotalRooms: CARDINAL) : CARDINAL ;
+VAR
+ x, y, r: CARDINAL ;
+BEGIN
+ RandomNumber(x, NoOfRoomsToTraverse) ;
+ INC(x) ;
+ RandomNumber(y, TotalRooms) ;
+ INC(y) ;
+ RandomRoom(y, x, r) ;
+ RETURN( r )
+END GetRandomRoom ;
+
+
+PROCEDURE Positioning ;
+VAR
+ Attempt,
+ i, r, x, y, p: CARDINAL ;
+ ok : BOOLEAN ;
+BEGIN
+ Attempt := MaxNoOfPlayers ;
+ p := PlayerNo() ;
+ WITH Player[p] DO
+ GetWriteAccessToPlayer ;
+ GetReadAccessToDoor ;
+ GetReadAccessToTreasure ;
+ REPEAT
+ r := GetRandomRoom(NoOfRoomsToHidePlayers, ActualNoOfRooms) ;
+ ok := TRUE ;
+ IF Attempt>0
+ THEN
+ FOR i := 0 TO NextFreePlayer-1 DO
+ IF IsPlayerActive(i) AND (i#p)
+ THEN
+ IF r=Player[i].RoomOfMan
+ THEN
+ ok := FALSE
+ END
+ END
+ END ;
+ DEC(Attempt)
+ END ;
+ IF ok
+ THEN
+ PositionInRoom(r, x, y, ok)
+ END
+ UNTIL ok ;
+ ScreenX := x-(x MOD Width) ;
+ ScreenY := y-(y MOD Height) ;
+ RoomOfMan := r ;
+ Xman := x ;
+ Yman := y ;
+ ScaleSights(Xman, Yman, ScreenX, ScreenY, ok) ;
+ ReleaseReadAccessToTreasure ;
+ ReleaseReadAccessToDoor ;
+ ReleaseWriteAccessToPlayer
+ END
+END Positioning ;
+
+
+(* Miscellaneous routines that connect the screen to the main program *)
+
+
+PROCEDURE InitialDisplay ;
+BEGIN
+ InitScreen(PlayerNo()) ;
+ GetReadAccessToPlayer ;
+ DrawRoom ;
+ ReleaseReadAccessToPlayer
+END InitialDisplay ;
+
+
+END AdvUtil.
+(*
+ * Local variables:
+ * compile-command: "make"
+ * End:
+ *)
diff --git a/gcc/testsuite/gm2/projects/pim/run/pass/tower/DrawG.def b/gcc/testsuite/gm2/projects/pim/run/pass/tower/DrawG.def
new file mode 100644
index 0000000..fedf0ac
--- /dev/null
+++ b/gcc/testsuite/gm2/projects/pim/run/pass/tower/DrawG.def
@@ -0,0 +1,36 @@
+DEFINITION MODULE DrawG ;
+
+FROM AdvSystem IMPORT PlayerSet ;
+EXPORT QUALIFIED DrawMan, EraseMan, DrawDoor, DrawTreasure,
+ EraseTreasure, DrawArrow, EraseArrow,
+ DisplayMessage ;
+
+
+(* All these procedures to draw on the screens - are Global *)
+(* Ie they will draw to all the screens that are within *)
+(* the area of effect. *)
+
+
+PROCEDURE DrawMan (p: CARDINAL) ;
+
+PROCEDURE EraseMan (p: CARDINAL) ;
+
+
+(* DrawDoor draws a door on every screen possible ie all that *)
+(* are in this particular area. Hence the coordinates need *)
+(* to be absolute NOT relative! *)
+
+PROCEDURE DrawDoor (RoomOfDoor, IndexToDoor: CARDINAL) ;
+
+PROCEDURE DrawTreasure (room, x, y: CARDINAL) ;
+
+PROCEDURE EraseTreasure (room, x, y: CARDINAL) ;
+
+PROCEDURE DrawArrow (room, x, y, dir: CARDINAL ; VAR playerscreen: PlayerSet) ;
+
+PROCEDURE EraseArrow (x, y: CARDINAL ; playerscreen: PlayerSet; flush: BOOLEAN) ;
+
+PROCEDURE DisplayMessage (a1, a2, a3: ARRAY OF CHAR) ;
+
+
+END DrawG.
diff --git a/gcc/testsuite/gm2/projects/pim/run/pass/tower/DrawG.mod b/gcc/testsuite/gm2/projects/pim/run/pass/tower/DrawG.mod
new file mode 100644
index 0000000..ff85fe3
--- /dev/null
+++ b/gcc/testsuite/gm2/projects/pim/run/pass/tower/DrawG.mod
@@ -0,0 +1,327 @@
+IMPLEMENTATION MODULE DrawG ;
+
+
+FROM AdvMap IMPORT Rooms, Door, DoorStatus, Line, Adjacent ;
+FROM ASCII IMPORT lf, bs ;
+FROM Window IMPORT Clip, ClipPoint ;
+FROM StdIO IMPORT Write ;
+IMPORT DrawL ;
+
+FROM Screen IMPORT Height, Width, Flush,
+ WriteCommentLine1, WriteCommentLine2, WriteCommentLine3 ;
+
+FROM AdvSystem IMPORT Player, PlayerNo, PlayerSet,
+ NextFreePlayer,
+ IsPlayerActive,
+ GetReadAccessToPlayer,
+ GetWriteAccessToPlayer,
+ ReleaseReadAccessToPlayer,
+ ReleaseWriteAccessToPlayer,
+ GetReadAccessToDoor,
+ ReleaseReadAccessToDoor,
+ GetReadAccessToTreasure,
+ ReleaseReadAccessToTreasure,
+ GetAccessToScreenNo,
+ ReleaseAccessToScreenNo ;
+
+
+(* All these procedures to draw on the screens - are Global *)
+(* Ie they will draw to all the screens that are within *)
+(* the area of effect. *)
+
+
+(* DrawMan draws the calling player on every screen that *)
+(* is within the area of effect. And which has the same *)
+(* current room number. *)
+(* This routine only uses the AccessToScreen Locks. *)
+
+PROCEDURE DrawMan (p: CARDINAL) ;
+VAR
+ i,
+ x, y, Sx, Sy, r,
+ dir : CARDINAL ;
+BEGIN
+ WITH Player[p] DO
+ r := RoomOfMan ;
+ x := Xman ;
+ y := Yman ;
+ dir := Direction
+ END ;
+
+ FOR i := 0 TO NextFreePlayer-1 DO
+ IF IsPlayerActive(i)
+ THEN
+ WITH Player[i] DO
+ IF r=RoomOfMan
+ THEN
+ Sy := ScreenY ;
+ Sx := ScreenX ;
+ IF (x>=Sx) AND (x<=Sx+Width) AND
+ (y>=Sy) AND (y<=Sy+Height)
+ THEN
+ GetAccessToScreenNo(i) ;
+ DrawL.DrawMan(p#i, x-Sx, y-Sy, dir) ;
+ ReleaseAccessToScreenNo(i)
+ END
+ END
+ END
+ END
+ END
+END DrawMan ;
+
+
+(* EraseMan erases the calling player on every screen that is *)
+(* currently displaying this player. *)
+
+PROCEDURE EraseMan (p: CARDINAL) ;
+VAR
+ i, r, x, y, Sx, Sy: CARDINAL ;
+BEGIN
+ WITH Player[p] DO
+ r := RoomOfMan ;
+ x := Xman ;
+ y := Yman
+ END ;
+
+ FOR i := 0 TO NextFreePlayer-1 DO
+ IF IsPlayerActive(i)
+ THEN
+ WITH Player[i] DO
+ IF r=RoomOfMan
+ THEN
+ Sy := ScreenY ;
+ Sx := ScreenX ;
+ IF (x>=Sx) AND (x<=Sx+Width) AND
+ (y>=Sy) AND (y<=Sy+Height)
+ THEN
+ GetAccessToScreenNo(i) ;
+ DrawL.Erase(x-Sx, y-Sy) ;
+ Flush(i) ;
+ ReleaseAccessToScreenNo(i)
+ END
+ END
+ END
+ END
+ END
+END EraseMan ;
+
+
+(* DrawDoor draws a door on every screen possible ie all that *)
+(* are in this particular area. Hence the coordinates need *)
+(* to be absolute NOT relative! *)
+(* This procedure uses Locks GetAccessToScreen ONLY! *)
+
+PROCEDURE DrawDoor (RoomOfDoor, IndexToDoor: CARDINAL) ;
+VAR
+ p : CARDINAL ;
+ hx, hy,
+ x, y, NextRoom,
+ i, j, x1, y1, x2, y2: CARDINAL ;
+ ok : BOOLEAN ;
+ yt, xt : CARDINAL ;
+ ds : DoorStatus ;
+BEGIN
+ WITH Rooms[RoomOfDoor].Doors[IndexToDoor].Position DO
+ x1 := X1 ;
+ x2 := X2 ;
+ y1 := Y1 ;
+ y2 := Y2
+ END ;
+
+ WITH Rooms[RoomOfDoor].Doors[IndexToDoor] DO
+ ds := StateOfDoor ;
+ NextRoom := LeadsTo
+ END ;
+
+ FOR p := 0 TO NextFreePlayer-1 DO
+ IF IsPlayerActive(p)
+ THEN
+ WITH Player[p] DO
+ IF (RoomOfDoor=RoomOfMan) OR (RoomOfMan=NextRoom)
+ THEN
+ i := x1 ;
+ j := y1 ;
+ x := x2 ;
+ y := y2 ;
+ Clip(i, j, x, y, ScreenX, ScreenY, ok) ;
+ IF ok
+ THEN
+ GetAccessToScreenNo(p) ;
+ IF i=x
+ THEN
+ hx := x2 ;
+ hy := y2 ;
+ ClipPoint(hx, hy, ScreenX, ScreenY, ok) ;
+ DrawL.DLine(i, j, x, y, ok, ds)
+ ELSE
+ hx := x1 ;
+ hy := y1 ;
+ ClipPoint(hx, hy, ScreenX, ScreenY, ok) ;
+ DrawL.DLine(i, j, x, y, ok, ds)
+ END ;
+ ReleaseAccessToScreenNo(p)
+ END
+ END
+ END
+ END
+ END
+END DrawDoor ;
+
+
+(* This procedure only uses LOCKS GetAccessToScreen *)
+
+PROCEDURE DrawTreasure (room, x, y: CARDINAL) ;
+VAR
+ p : CARDINAL ;
+ Sx, Sy: CARDINAL ;
+BEGIN
+ p := 0 ;
+ WHILE p < NextFreePlayer DO
+ IF IsPlayerActive(p)
+ THEN
+ WITH Player[p] DO
+ IF room=RoomOfMan
+ THEN
+ Sy := ScreenY ;
+ Sx := ScreenX ;
+ IF (x>=Sx) AND (x<=Sx+Width) AND
+ (y>=Sy) AND (y<=Sy+Height)
+ THEN
+ GetAccessToScreenNo(p) ;
+ DrawL.DTreasure(x-Sx, y-Sy) ;
+ ReleaseAccessToScreenNo(p)
+ END
+ END
+ END
+ END ;
+ INC (p)
+ END
+END DrawTreasure ;
+
+
+PROCEDURE EraseTreasure (room, x, y: CARDINAL) ;
+VAR
+ p : CARDINAL ;
+ Sx, Sy: CARDINAL ;
+BEGIN
+ p := 0 ;
+ WHILE p < NextFreePlayer DO
+ IF IsPlayerActive(p)
+ THEN
+ WITH Player[p] DO
+ IF room=RoomOfMan
+ THEN
+ Sy := ScreenY ;
+ Sx := ScreenX ;
+ IF (x>=Sx) AND (x<=Sx+Width) AND
+ (y>=Sy) AND (y<=Sy+Height)
+ THEN
+ GetAccessToScreenNo(p) ;
+ DrawL.Erase(x-Sx, y-Sy) ;
+ Flush(p) ;
+ ReleaseAccessToScreenNo(p)
+ END
+ END
+ END
+ END ;
+ INC (p)
+ END
+END EraseTreasure ;
+
+
+(* This procedure only uses LOCKS GetAccessToScreen *)
+
+PROCEDURE DrawArrow (room, x, y, dir: CARDINAL ; VAR playerscreen: PlayerSet) ;
+VAR
+ p, Sx, Sy: CARDINAL ;
+BEGIN
+ playerscreen := PlayerSet{} ;
+ p := 0 ;
+ WHILE p < NextFreePlayer DO
+ IF IsPlayerActive(p)
+ THEN
+ WITH Player[p] DO
+ IF room=RoomOfMan
+ THEN
+ Sy := ScreenY ;
+ Sx := ScreenX ;
+ IF (x>=Sx) AND (x<=Sx+Width) AND
+ (y>=Sy) AND (y<=Sy+Height)
+ THEN
+ INCL(playerscreen, p) ;
+ GetAccessToScreenNo(p) ;
+ DrawL.DArrow(x-Sx, y-Sy, dir) ;
+ ReleaseAccessToScreenNo(p)
+ END
+ END
+ END
+ END ;
+ INC (p)
+ END
+END DrawArrow ;
+
+
+PROCEDURE EraseArrow (x, y: CARDINAL ; playerscreen: PlayerSet; flush: BOOLEAN) ;
+VAR
+ p, Sx, Sy: CARDINAL ;
+BEGIN
+ p := 0 ;
+ WHILE p < NextFreePlayer DO
+ IF IsPlayerActive(p)
+ THEN
+ WITH Player[p] DO
+ IF p IN playerscreen
+ THEN
+ Sy := ScreenY ;
+ Sx := ScreenX ;
+ IF (x>=Sx) AND (x<=Sx+Width) AND
+ (y>=Sy) AND (y<=Sy+Height)
+ THEN
+ GetAccessToScreenNo(p) ;
+ DrawL.Erase(x-Sx, y-Sy) ;
+ IF flush
+ THEN
+ Flush(p)
+ END ;
+ ReleaseAccessToScreenNo(p)
+ END
+ END
+ END
+ END ;
+ INC (p)
+ END
+END EraseArrow ;
+
+
+PROCEDURE DisplayMessage (a1, a2, a3: ARRAY OF CHAR) ;
+VAR
+ i, p, r: CARDINAL ;
+BEGIN
+ p := PlayerNo() ;
+ GetReadAccessToPlayer ;
+ r := Player[p].RoomOfMan ;
+ FOR i := 0 TO NextFreePlayer-1 DO
+ IF IsPlayerActive(i)
+ THEN
+ WITH Player[i] DO
+ IF r=RoomOfMan
+ THEN
+ GetAccessToScreenNo(i) ;
+ WriteCommentLine1(i, a1) ;
+ WriteCommentLine2(i, a2) ;
+ WriteCommentLine3(i, a3) ;
+ ReleaseAccessToScreenNo(i)
+ END
+ END
+ END
+ END ;
+ ReleaseReadAccessToPlayer
+END DisplayMessage ;
+
+
+END DrawG.
+(*
+ * Local variables:
+ * compile-command: "make"
+ * End:
+ *)
diff --git a/gcc/testsuite/gm2/projects/pim/run/pass/tower/DrawL.def b/gcc/testsuite/gm2/projects/pim/run/pass/tower/DrawL.def
new file mode 100644
index 0000000..48c165e
--- /dev/null
+++ b/gcc/testsuite/gm2/projects/pim/run/pass/tower/DrawL.def
@@ -0,0 +1,23 @@
+DEFINITION MODULE DrawL ;
+
+FROM AdvMap IMPORT DoorStatus ;
+EXPORT QUALIFIED DrawRoom, ClearRoom, DrawAllPlayers, EraseAllPlayers,
+ StrPoint, DTreasure, Erase, DrawMan, DLine, DArrow ;
+
+
+PROCEDURE DrawRoom ;
+PROCEDURE ClearRoom (r: CARDINAL) ;
+PROCEDURE DrawAllPlayers ;
+PROCEDURE EraseAllPlayers ;
+
+(* and some low level string routines *)
+
+PROCEDURE StrPoint (a: ARRAY OF CHAR; x, y: CARDINAL) ;
+PROCEDURE DTreasure (x, y: CARDINAL) ;
+PROCEDURE Erase (x, y: CARDINAL) ;
+PROCEDURE DrawMan (other: BOOLEAN; x, y, dir: CARDINAL) ;
+PROCEDURE DLine (x1, y1, x2, y2: CARDINAL; hinge: BOOLEAN; ds: DoorStatus) ;
+PROCEDURE DArrow (x, y, dir: CARDINAL) ;
+
+
+END DrawL.
diff --git a/gcc/testsuite/gm2/projects/pim/run/pass/tower/DrawL.mod b/gcc/testsuite/gm2/projects/pim/run/pass/tower/DrawL.mod
new file mode 100644
index 0000000..e6753c9
--- /dev/null
+++ b/gcc/testsuite/gm2/projects/pim/run/pass/tower/DrawL.mod
@@ -0,0 +1,422 @@
+IMPLEMENTATION MODULE DrawL ;
+
+
+FROM ASCII IMPORT lf, bs ;
+FROM Window IMPORT Clip, ClipPoint ;
+FROM StrIO IMPORT WriteString, WriteLn ;
+FROM NumberIO IMPORT WriteCard ;
+FROM StdIO IMPORT Write ;
+FROM Debug IMPORT Halt ;
+FROM Assertion IMPORT Assert ;
+
+FROM AdvMap IMPORT Rooms, DoorStatus, Line, Room, Door, Treasure ;
+
+FROM AdvMath IMPORT MaxNoOfTreasures ;
+
+FROM AdvSystem IMPORT Player, PlayerNo,
+ IsPlayerActive,
+ NextFreePlayer,
+ GetAccessToScreen,
+ ReleaseAccessToScreen,
+ GetAccessToScreenNo,
+ ReleaseAccessToScreenNo,
+ GetWriteAccessToPlayer,
+ ReleaseWriteAccessToPlayer,
+ GetReadAccessToPlayer,
+ ReleaseReadAccessToPlayer,
+ GetReadAccessToDoor,
+ ReleaseReadAccessToDoor,
+ GetReadAccessToTreasure,
+ ReleaseReadAccessToTreasure ;
+
+
+(* Draws the current Room that the callers player is in. It also draws *)
+(* all treasures, doors and players associated with this room. This *)
+(* procedure DOES get access to treasure locks and door locks but NO *)
+(* player lock is used. *)
+(* This procedure does NOT draw SECRET doors as might give them away! *)
+(* It is assumed that walls cover ALL doors. *)
+
+PROCEDURE DrawRoom ;
+VAR
+ ok : BOOLEAN ;
+ hx, hy,
+ x1, y1, x2, y2,
+ p, t, r, i,
+ Sx, Sy : CARDINAL ;
+ ds : DoorStatus ;
+BEGIN
+ p := PlayerNo() ;
+ WITH Player[p] DO
+
+ r := RoomOfMan ;
+ Sx := ScreenX ;
+ Sy := ScreenY ;
+ t := Rooms[r].NoOfWalls ;
+ FOR i := 1 TO t DO
+ WITH Rooms[r].Walls[i] DO
+ x1 := X1 ;
+ y1 := Y1 ;
+ x2 := X2 ;
+ y2 := Y2
+ END ;
+ Clip( x1, y1, x2, y2, Sx, Sy, ok ) ;
+
+ IF ok
+ THEN
+ GetAccessToScreen ;
+ WLine(x1, y1, x2, y2) ;
+ ReleaseAccessToScreen
+ END
+ END ;
+
+ GetReadAccessToDoor ;
+ t := Rooms[r].NoOfDoors ;
+ FOR i := 1 TO t DO
+ WITH Rooms[r].Doors[i] DO
+ x1 := Position.X1 ;
+ y1 := Position.Y1 ;
+ x2 := Position.X2 ;
+ y2 := Position.Y2 ;
+ ds := StateOfDoor ;
+ IF ds#Secret
+ THEN
+ Clip( x1, y1, x2, y2, Sx, Sy, ok ) ;
+ IF ok
+ THEN
+ GetAccessToScreen ;
+ IF Position.X1=Position.X2
+ THEN
+ hx := Position.X2 ;
+ hy := Position.Y2 ;
+ Assert((ScreenX=Sx) AND (ScreenY=Sy)) ;
+ ClipPoint(hx, hy, ScreenX, ScreenY, ok) ;
+ DLine(x1, y1, x2, y2, ok, ds)
+ ELSE
+ hx := Position.X1 ;
+ hy := Position.Y1 ;
+ Assert((ScreenX=Sx) AND (ScreenY=Sy)) ;
+ ClipPoint(hx, hy, ScreenX, ScreenY, ok) ;
+ DLine(x1, y1, x2, y2, ok, ds)
+ END ;
+ ReleaseAccessToScreen
+ END
+ END
+ END
+ END ;
+ ReleaseReadAccessToDoor ;
+
+ GetReadAccessToTreasure ;
+ FOR i := 1 TO MaxNoOfTreasures DO
+ WITH Rooms[r] DO
+ IF i IN Treasures
+ THEN
+ x1 := Treasure[i].Xpos ;
+ y1 := Treasure[i].Ypos ;
+ ClipPoint(x1, y1, ScreenX, ScreenY, ok) ;
+ IF ok
+ THEN
+ GetAccessToScreen ;
+ DTreasure(x1, y1) ;
+ ReleaseAccessToScreen
+ END
+ END
+ END
+ END ;
+ ReleaseReadAccessToTreasure ;
+ END ;
+
+ (* This called routine must now draw the other players as well *)
+ (* as drawing the current man. *)
+ (* Assumes that this player has been updated in Data Structure *)
+ (* but has not yet been displayed on the screen. *)
+
+ DrawAllPlayers ;
+
+END DrawRoom ;
+
+
+(* Draw all players uses no player lock. *)
+
+PROCEDURE DrawAllPlayers ;
+VAR
+ pn,
+ Sx, Sy, dir, p: CARDINAL ;
+ x, y, r : CARDINAL ;
+ ok : BOOLEAN ;
+ ch : CHAR ;
+BEGIN
+ p := PlayerNo() ;
+ WITH Player[p] DO
+ Sx := ScreenX ;
+ Sy := ScreenY ;
+ r := RoomOfMan ;
+ dir := Direction ;
+ x := Xman-Sx ;
+ y := Yman-Sy ;
+ GetAccessToScreenNo(p) ;
+ DrawMan(FALSE, x, y, dir) ;
+ ReleaseAccessToScreenNo(p)
+ END ;
+
+ (* Now write all the other Players on the screen *)
+
+ FOR pn := 0 TO NextFreePlayer-1 DO
+ IF (pn#p) AND IsPlayerActive(pn)
+ THEN
+ WITH Player[pn] DO
+ IF r=RoomOfMan
+ THEN
+ x := Xman ;
+ y := Yman ;
+ dir := Direction ;
+ ClipPoint(x, y, Sx, Sy, ok) ;
+ IF ok
+ THEN
+ GetAccessToScreenNo( p ) ;
+ DrawMan(TRUE, x, y, dir) ;
+ ReleaseAccessToScreenNo( p )
+ END
+ END
+ END
+ END
+ END
+END DrawAllPlayers ;
+
+
+(* This procedure uses no player lock. *)
+
+PROCEDURE EraseAllPlayers ;
+VAR
+ pn,
+ Sx, Sy, p: CARDINAL ;
+ x, y, r : CARDINAL ;
+ ok : BOOLEAN ;
+BEGIN
+ p := PlayerNo() ;
+ WITH Player[p] DO
+ Sx := ScreenX ;
+ Sy := ScreenY ;
+ r := RoomOfMan ;
+ x := Xman-Sx ;
+ y := Yman-Sy ;
+ GetAccessToScreenNo(p) ;
+ Erase(x, y) ;
+ ReleaseAccessToScreenNo(p)
+ END ;
+
+ (* Now write all the other Players on the screen *)
+
+ FOR pn := 0 TO NextFreePlayer-1 DO
+ IF (pn#p) AND IsPlayerActive(pn)
+ THEN
+ WITH Player[pn] DO
+ IF r=RoomOfMan
+ THEN
+ x := Xman ;
+ y := Yman ;
+ ClipPoint(x, y, Sx, Sy, ok) ;
+ IF ok
+ THEN
+ GetAccessToScreenNo(p) ;
+ Erase(x, y) ;
+ ReleaseAccessToScreenNo(p)
+ END
+ END
+ END
+ END
+ END
+END EraseAllPlayers ;
+
+
+(* Clears the Room specified of all treasures and all OTHER players. *)
+(* It uses NO lock on any Player. But uses Treasure Lock. *)
+
+PROCEDURE ClearRoom (r: CARDINAL) ;
+VAR
+ p, Sx, Sy,
+ x, y, pn,
+ x1, y1, i: CARDINAL ;
+ ok : BOOLEAN ;
+BEGIN
+ p := PlayerNo() ;
+ WITH Player[p] DO
+ Sx := ScreenX ;
+ Sy := ScreenY ;
+ GetReadAccessToTreasure ;
+ FOR i := 1 TO MaxNoOfTreasures DO
+ WITH Rooms[r] DO
+ IF i IN Treasures
+ THEN
+ x1 := Treasure[i].Xpos ;
+ y1 := Treasure[i].Ypos ;
+ ClipPoint(x1, y1, Sx, Sy, ok) ;
+ IF ok
+ THEN
+ GetAccessToScreenNo(p) ;
+ Erase(x1, y1) ;
+ ReleaseAccessToScreenNo(p)
+ END
+ END
+ END
+ END ;
+ ReleaseReadAccessToTreasure
+ END ;
+
+ (* Now erase all the other Players on the screen *)
+
+ FOR pn := 0 TO NextFreePlayer-1 DO
+ IF p#pn
+ THEN
+ WITH Player[pn] DO
+ IF r=RoomOfMan
+ THEN
+ x := Xman ;
+ y := Yman ;
+ ClipPoint(x, y, Sx, Sy, ok) ;
+ IF ok
+ THEN
+ GetAccessToScreenNo(p) ;
+ Erase(x, y) ;
+ ReleaseAccessToScreenNo(p)
+ END
+ END
+ END
+ END
+ END
+END ClearRoom ;
+
+
+PROCEDURE StrLine (a: ARRAY OF CHAR; x1, y1, x2, y2: CARDINAL) ;
+BEGIN
+ WriteString(a) ; Write(' ') ;
+ WriteCard(x1, 0) ; Write(' ') ;
+ WriteCard(y1, 0) ; Write(' ') ;
+ WriteCard(x2, 0) ; Write(' ') ;
+ WriteCard(y2, 0) ; WriteLn
+END StrLine ;
+
+
+PROCEDURE WLine (x1, y1, x2, y2: CARDINAL) ;
+BEGIN
+ IF y1=y2
+ THEN
+ StrLine('hwall', x1, y1, x2, y2)
+ ELSE
+ Assert(x1=x2) ;
+ StrLine('vwall', x1, y1, x2, y2)
+ END
+END WLine ;
+
+
+PROCEDURE DLine (x1, y1, x2, y2: CARDINAL; hinge: BOOLEAN; ds: DoorStatus) ;
+VAR
+ x, ys: CARDINAL ;
+BEGIN
+ IF y1=y2
+ THEN
+ CASE ds OF
+
+ Closed: IF hinge
+ THEN
+ WriteString('hhinge ') ; WriteCard(x1, 0) ; Write(' ') ; WriteCard(y1, 0) ; WriteLn ;
+ INC(x1)
+ END ;
+ IF x1<=x2
+ THEN
+ StrLine('hdoor', x1, y1, x2, y2)
+ END |
+ Open : StrLine('eL', x1, y1, x2, y2) |
+ Secret: WLine(x1, y1, x2, y2)
+
+ END
+ ELSE
+ CASE ds OF
+
+ Closed: IF hinge
+ THEN
+ WriteString('vhinge ') ; WriteCard(x1, 0) ; Write(' ') ; WriteCard(y2, 0) ; WriteLn ;
+ DEC(y2)
+ END ;
+ IF y1<=y2
+ THEN
+ StrLine('vdoor', x1, y1, x2, y2)
+ END |
+ Open : StrLine('eL', x1, y1, x2, y2) |
+ Secret: WLine(x1, y1, x2, y2)
+
+ END
+ END
+END DLine ;
+
+
+PROCEDURE StrPoint (a: ARRAY OF CHAR; x, y: CARDINAL) ;
+BEGIN
+ WriteString(a) ; Write(' ') ;
+ WriteCard(x, 0) ; Write(' ') ;
+ WriteCard(y, 0) ; WriteLn
+END StrPoint ;
+
+
+PROCEDURE DTreasure (x, y: CARDINAL) ;
+BEGIN
+ StrPoint('treasure', x, y)
+END DTreasure ;
+
+
+PROCEDURE Erase (x, y: CARDINAL) ;
+BEGIN
+ StrPoint('eL', x, y)
+END Erase ;
+
+
+PROCEDURE DrawMan (other: BOOLEAN; x, y, dir: CARDINAL) ;
+BEGIN
+ IF other
+ THEN
+ CASE dir OF
+
+ 0: StrPoint('Nman', x, y) |
+ 1: StrPoint('Wman', x, y) |
+ 2: StrPoint('Sman', x, y) |
+ 3: StrPoint('Eman', x, y)
+
+ ELSE
+ Halt(__FILE__, __LINE__, __FUNCTION__, 'unexpected direction')
+ END
+ ELSE
+ CASE dir OF
+
+ 0: StrPoint('nman', x, y) |
+ 1: StrPoint('wman', x, y) |
+ 2: StrPoint('sman', x, y) |
+ 3: StrPoint('eman', x, y)
+
+ ELSE
+ Halt(__FILE__, __LINE__, __FUNCTION__, 'unexpected direction')
+ END
+ END
+END DrawMan ;
+
+
+PROCEDURE DArrow (x, y, dir: CARDINAL) ;
+BEGIN
+ CASE dir OF
+
+ 0: StrPoint('nar', x, y) |
+ 1: StrPoint('war', x, y) |
+ 2: StrPoint('sar', x, y) |
+ 3: StrPoint('ear', x, y)
+
+ ELSE
+ Halt(__FILE__, __LINE__, __FUNCTION__, 'unexpected direction')
+ END
+END DArrow ;
+
+
+END DrawL.
+(*
+ * Local variables:
+ * compile-command: "make"
+ * End:
+ *)
diff --git a/gcc/testsuite/gm2/projects/pim/run/pass/tower/Dungeon.mod b/gcc/testsuite/gm2/projects/pim/run/pass/tower/Dungeon.mod
new file mode 100644
index 0000000..29b5e79
--- /dev/null
+++ b/gcc/testsuite/gm2/projects/pim/run/pass/tower/Dungeon.mod
@@ -0,0 +1,34 @@
+MODULE Dungeon ;
+(* *)
+
+FROM AdvIntroduction IMPORT StartGame ;
+FROM SArgs IMPORT GetArg ;
+FROM AdvParse IMPORT ParseMap ;
+FROM DynamicStrings IMPORT String, string ;
+FROM libc IMPORT printf, exit ;
+FROM Screen IMPORT AssignMapName ;
+
+
+VAR
+ s: String ;
+ r: INTEGER ;
+BEGIN
+ IF GetArg(s, 1)
+ THEN
+ r := ParseMap(string(s)) ;
+ IF r=0
+ THEN
+ AssignMapName(s) ;
+ StartGame
+ ELSE
+ exit(r)
+ END
+ ELSE
+ r := printf("usage: dungeon mapfile\n")
+ END
+END Dungeon.
+(*
+ * Local variables:
+ * compile-command: "make"
+ * End:
+ *)
diff --git a/gcc/testsuite/gm2/projects/pim/run/pass/tower/Lock.def b/gcc/testsuite/gm2/projects/pim/run/pass/tower/Lock.def
new file mode 100644
index 0000000..6829b15
--- /dev/null
+++ b/gcc/testsuite/gm2/projects/pim/run/pass/tower/Lock.def
@@ -0,0 +1,27 @@
+DEFINITION MODULE Lock ;
+
+(*
+ Author : Gaius Mulley
+ Title : Lock
+ Date : 12/2/86
+ Version : 1.0
+ Last Edit : 22/7/86
+ Description: Lock - Implements a Read / Write Lock
+*)
+
+EXPORT QUALIFIED LOCK,
+ GetReadAccess, ReleaseReadAccess,
+ GetWriteAccess, ReleaseWriteAccess,
+ InitLock ;
+
+TYPE
+ LOCK ;
+
+PROCEDURE GetReadAccess (l: LOCK) ;
+PROCEDURE ReleaseReadAccess (l: LOCK) ;
+PROCEDURE GetWriteAccess (l: LOCK) ;
+PROCEDURE ReleaseWriteAccess (l: LOCK) ;
+PROCEDURE InitLock (Name: ARRAY OF CHAR) : LOCK ;
+
+
+END Lock.
diff --git a/gcc/testsuite/gm2/projects/pim/run/pass/tower/Lock.mod b/gcc/testsuite/gm2/projects/pim/run/pass/tower/Lock.mod
new file mode 100644
index 0000000..3f7726a
--- /dev/null
+++ b/gcc/testsuite/gm2/projects/pim/run/pass/tower/Lock.mod
@@ -0,0 +1,75 @@
+IMPLEMENTATION MODULE Lock ;
+
+
+FROM Storage IMPORT ALLOCATE, DEALLOCATE ;
+FROM Executive IMPORT Wait, Signal, InitSemaphore,
+ SEMAPHORE ;
+
+
+TYPE
+ LOCK = POINTER TO RECORD
+ Mutex : SEMAPHORE ;
+ ReadCount : CARDINAL ;
+ Wrt : SEMAPHORE ;
+ END ;
+
+
+PROCEDURE InitLock (Name: ARRAY OF CHAR) : LOCK ;
+VAR
+ l: LOCK ;
+BEGIN
+ NEW( l ) ;
+ WITH l^ DO
+ Mutex := InitSemaphore(1, Name) ;
+ Wrt := InitSemaphore(1, Name) ;
+ ReadCount := 0
+ END ;
+ RETURN( l )
+END InitLock ;
+
+
+PROCEDURE GetReadAccess (l: LOCK) ;
+BEGIN
+ WITH l^ DO
+ Wait( Mutex ) ;
+ INC( ReadCount ) ;
+ IF ReadCount=1
+ THEN
+ Wait( Wrt )
+ END ;
+ Signal( Mutex )
+ END
+END GetReadAccess ;
+
+
+PROCEDURE ReleaseReadAccess (l: LOCK) ;
+BEGIN
+ WITH l^ DO
+ Wait( Mutex ) ;
+ DEC( ReadCount ) ;
+ IF ReadCount=0
+ THEN
+ Signal( Wrt )
+ END ;
+ Signal( Mutex )
+ END
+END ReleaseReadAccess ;
+
+
+PROCEDURE GetWriteAccess (l: LOCK) ;
+BEGIN
+ WITH l^ DO
+ Wait( Wrt )
+ END
+END GetWriteAccess ;
+
+
+PROCEDURE ReleaseWriteAccess (l: LOCK) ;
+BEGIN
+ WITH l^ DO
+ Signal( Wrt )
+ END
+END ReleaseWriteAccess ;
+
+
+END Lock.
diff --git a/gcc/testsuite/gm2/projects/pim/run/pass/tower/ProcArgs.def b/gcc/testsuite/gm2/projects/pim/run/pass/tower/ProcArgs.def
new file mode 100644
index 0000000..cf5b023
--- /dev/null
+++ b/gcc/testsuite/gm2/projects/pim/run/pass/tower/ProcArgs.def
@@ -0,0 +1,15 @@
+DEFINITION MODULE ProcArgs ;
+
+FROM SYSTEM IMPORT ADDRESS ;
+EXPORT QUALIFIED ProcessArgs,
+ InitArgs, SetArgs, CollectArgs, KillArgs ;
+
+TYPE
+ ProcessArgs ;
+
+PROCEDURE InitArgs () : ProcessArgs ;
+PROCEDURE SetArgs (p: ProcessArgs; a: ADDRESS) : ADDRESS ;
+PROCEDURE CollectArgs (p: ProcessArgs) : ADDRESS ;
+PROCEDURE KillArgs (p: ProcessArgs) : ProcessArgs ;
+
+END ProcArgs.
diff --git a/gcc/testsuite/gm2/projects/pim/run/pass/tower/ProcArgs.mod b/gcc/testsuite/gm2/projects/pim/run/pass/tower/ProcArgs.mod
new file mode 100644
index 0000000..ceae241
--- /dev/null
+++ b/gcc/testsuite/gm2/projects/pim/run/pass/tower/ProcArgs.mod
@@ -0,0 +1,58 @@
+IMPLEMENTATION MODULE ProcArgs ;
+
+FROM Storage IMPORT ALLOCATE, DEALLOCATE ;
+FROM Executive IMPORT SEMAPHORE, InitSemaphore, Wait, Signal ;
+
+TYPE
+ ProcessArgs = POINTER TO RECORD
+ argPtr: ADDRESS ;
+ taken,
+ given : SEMAPHORE ;
+ END ;
+
+PROCEDURE InitArgs () : ProcessArgs ;
+VAR
+ p: ProcessArgs ;
+BEGIN
+ NEW(p) ;
+ WITH p^ DO
+ taken := InitSemaphore(1, 'ProcArgs') ;
+ given := InitSemaphore(0, 'ProcArgs') ;
+ argPtr := NIL
+ END ;
+ RETURN( p )
+END InitArgs ;
+
+
+PROCEDURE SetArgs (p: ProcessArgs; a: ADDRESS) : ADDRESS ;
+BEGIN
+ WITH p^ DO
+ Wait(taken) ;
+ argPtr := a ;
+ Signal(given)
+ END ;
+ RETURN( NIL )
+END SetArgs ;
+
+
+PROCEDURE CollectArgs (p: ProcessArgs) : ADDRESS ;
+VAR
+ a: ADDRESS ;
+BEGIN
+ WITH p^ DO
+ Wait(given) ;
+ a := argPtr ;
+ Signal(taken)
+ END ;
+ RETURN( a )
+END CollectArgs ;
+
+
+PROCEDURE KillArgs (p: ProcessArgs) : ProcessArgs ;
+BEGIN
+ DISPOSE(p) ;
+ RETURN( NIL )
+END KillArgs ;
+
+
+END ProcArgs.
diff --git a/gcc/testsuite/gm2/projects/pim/run/pass/tower/Screen.def b/gcc/testsuite/gm2/projects/pim/run/pass/tower/Screen.def
new file mode 100644
index 0000000..91d2d38
--- /dev/null
+++ b/gcc/testsuite/gm2/projects/pim/run/pass/tower/Screen.def
@@ -0,0 +1,55 @@
+DEFINITION MODULE Screen ;
+
+FROM DynamicStrings IMPORT String ;
+EXPORT QUALIFIED ClearScreen, WriteString, PromptString,
+ InitScreen, WriteName, WriteFloor, WriteRoom,
+ WriteWounds, WriteFatigue, WriteMagicArrows,
+ WriteArrows, WriteTime, WriteCommand, WriteWeight,
+ WriteCommentLine1, WriteCommentLine2, WriteCommentLine3,
+ DelCommentLine1, DelCommentLine2, DelCommentLine3,
+ Pause, AssignMapName, Quit, Flush,
+ Width, Height,
+ InnerX, OuterX, InnerY, OuterY, OffX, OffY ;
+
+
+CONST
+ Width = 29 ; (* 0..29 Horizontal Width *)
+ Height= 31 ; (* 0..31 Vertical Height *)
+
+ InnerX= 5 ; (* when do we adjust screen *)
+ OuterX= Width-InnerX ;
+ InnerY= 5 ;
+ OuterY= Height-InnerY ;
+
+ OffX = OuterX-InnerX ; (* To redraw screen +- Off *)
+ OffY = OuterY-InnerY ;
+
+
+PROCEDURE ClearScreen (p: CARDINAL) ;
+PROCEDURE WriteString (p: CARDINAL; a: ARRAY OF CHAR) ;
+PROCEDURE PromptString (p: CARDINAL; a: ARRAY OF CHAR) ;
+
+PROCEDURE InitScreen (p: CARDINAL) ;
+PROCEDURE WriteName (p: CARDINAL; a: ARRAY OF CHAR) ;
+PROCEDURE WriteFloor (p: CARDINAL) ;
+PROCEDURE WriteRoom (p: CARDINAL; x: CARDINAL) ;
+PROCEDURE WriteWeight (p: CARDINAL; x: CARDINAL) ;
+PROCEDURE WriteWounds (p: CARDINAL; x: CARDINAL) ;
+PROCEDURE WriteFatigue (p: CARDINAL; x: CARDINAL) ;
+PROCEDURE WriteMagicArrows (p: CARDINAL; x: CARDINAL) ;
+PROCEDURE WriteArrows (p: CARDINAL; x: CARDINAL) ;
+PROCEDURE WriteTime (p: CARDINAL) ;
+PROCEDURE WriteCommand (p: CARDINAL; ch: CHAR) ;
+PROCEDURE WriteCommentLine1 (p: CARDINAL; a: ARRAY OF CHAR) ;
+PROCEDURE WriteCommentLine2 (p: CARDINAL; a: ARRAY OF CHAR) ;
+PROCEDURE WriteCommentLine3 (p: CARDINAL; a: ARRAY OF CHAR) ;
+PROCEDURE DelCommentLine1 (p: CARDINAL) ;
+PROCEDURE DelCommentLine2 (p: CARDINAL) ;
+PROCEDURE DelCommentLine3 (p: CARDINAL) ;
+PROCEDURE Pause (p: CARDINAL) ;
+PROCEDURE AssignMapName (s: String) ;
+PROCEDURE Quit (p: CARDINAL) ;
+PROCEDURE Flush (p: CARDINAL) ;
+
+
+END Screen.
diff --git a/gcc/testsuite/gm2/projects/pim/run/pass/tower/Screen.mod b/gcc/testsuite/gm2/projects/pim/run/pass/tower/Screen.mod
new file mode 100644
index 0000000..098867e
--- /dev/null
+++ b/gcc/testsuite/gm2/projects/pim/run/pass/tower/Screen.mod
@@ -0,0 +1,303 @@
+IMPLEMENTATION MODULE Screen ;
+
+
+FROM ASCII IMPORT nul ;
+FROM StrLib IMPORT StrLen ;
+FROM TimerHandler IMPORT GetTicks, TicksPerSecond ;
+
+FROM AdvSystem IMPORT Player, PlayerNo, ClientRead,
+ GetAccessToScreenNo,
+ ReleaseAccessToScreenNo, AssignOutputTo ;
+
+FROM AdvMap IMPORT DoorStatus, FileName, MaxLengthOfFileName ;
+FROM DynamicStrings IMPORT CopyOut ;
+
+FROM StdIO IMPORT Write ;
+IMPORT NumberIO ;
+IMPORT StrIO ;
+
+
+VAR
+ mapname: ARRAY [0..12] OF CHAR ;
+
+
+PROCEDURE AssignMapName (s: String) ;
+BEGIN
+ CopyOut(mapname, s)
+END AssignMapName ;
+
+
+PROCEDURE WriteCommand (p: CARDINAL; ch: CHAR) ;
+BEGIN
+ GetAccessToScreenNo(p) ;
+ StrIO.WriteString('dCMD ') ; Write(ch) ;
+ Write(' ') ;
+ CASE ch OF
+
+ 'l' : StrIO.WriteString( 'Left ') |
+ 'r' : StrIO.WriteString( 'Right ') |
+ 'v' : StrIO.WriteString( 'Vault Turn ') |
+ '0'..'9' : StrIO.WriteString( 'Forward ') ; Write(ch) |
+ 't' : StrIO.WriteString( 'Thrust ') |
+ 'a' : StrIO.WriteString( 'Attack ') |
+ 'p' : StrIO.WriteString( 'Parry ') |
+ 'o' : StrIO.WriteString( 'Open Door ') |
+ 'c' : StrIO.WriteString( 'Close Door ') |
+ 'e' : StrIO.WriteString( 'Examine Door ') |
+ 'f' : StrIO.WriteString( 'Fire Arrow ') |
+ 'm' : StrIO.WriteString( 'Magic Arrow ') |
+ 'g' : StrIO.WriteString( 'Get Treasure ') |
+ 'd' : StrIO.WriteString( 'Drop Treasure') |
+ 'u' : StrIO.WriteString( 'Use Treasure ') |
+ 's' : StrIO.WriteString( 'Speak ') |
+ 'w' : StrIO.WriteString( 'Watch sayeth ') |
+ '|' : StrIO.WriteString( 'Exit Dungeon ')
+
+ ELSE StrIO.WriteString( 'No Command ')
+ END ;
+ StrIO.WriteLn ;
+ ReleaseAccessToScreenNo(p)
+END WriteCommand ;
+
+
+(*
+ Sync -
+*)
+
+PROCEDURE Sync (p: CARDINAL) ;
+BEGIN
+ AssignOutputTo(p) ;
+ StrIO.WriteString('sync') ; StrIO.WriteLn
+END Sync ;
+
+
+(*
+ Flush -
+*)
+
+PROCEDURE Flush (p: CARDINAL) ;
+BEGIN
+ AssignOutputTo(p) ;
+ StrIO.WriteString('fl') ; StrIO.WriteLn
+END Flush ;
+
+
+(*
+ ClearScreen -
+*)
+
+PROCEDURE ClearScreen (p: CARDINAL) ;
+BEGIN
+ AssignOutputTo(p) ;
+ StrIO.WriteString('clear') ; StrIO.WriteLn
+END ClearScreen ;
+
+PROCEDURE WriteName (p: CARDINAL; n: ARRAY OF CHAR) ;
+BEGIN
+ AssignOutputTo(p) ;
+ StrIO.WriteString('dN ') ; StrIO.WriteString(n) ; StrIO.WriteLn
+END WriteName ;
+
+PROCEDURE WriteRoom (p: CARDINAL; r: CARDINAL) ;
+BEGIN
+ AssignOutputTo(p) ;
+ StrIO.WriteString('dR ') ; NumberIO.WriteCard(r, 0) ; StrIO.WriteLn
+END WriteRoom ;
+
+PROCEDURE WriteWounds (p: CARDINAL; w: CARDINAL) ;
+BEGIN
+ AssignOutputTo(p) ;
+ StrIO.WriteString('dW ') ; NumberIO.WriteCard(w, 0) ; StrIO.WriteLn
+END WriteWounds ;
+
+PROCEDURE WriteFatigue (p: CARDINAL; f: CARDINAL) ;
+BEGIN
+ AssignOutputTo(p) ;
+ StrIO.WriteString('dF ') ; NumberIO.WriteCard(f, 0) ; StrIO.WriteLn
+END WriteFatigue ;
+
+PROCEDURE WriteMagicArrows (p: CARDINAL; m: CARDINAL) ;
+BEGIN
+ AssignOutputTo(p) ;
+ StrIO.WriteString('dM ') ; NumberIO.WriteCard(m, 0) ; StrIO.WriteLn
+END WriteMagicArrows ;
+
+PROCEDURE WriteArrows (p: CARDINAL; a: CARDINAL) ;
+BEGIN
+ AssignOutputTo(p) ;
+ StrIO.WriteString('dA ') ; NumberIO.WriteCard(a, 0) ; StrIO.WriteLn
+END WriteArrows ;
+
+PROCEDURE WriteWeight (p: CARDINAL; w: CARDINAL) ;
+BEGIN
+ AssignOutputTo(p) ;
+ StrIO.WriteString('dw ') ; NumberIO.WriteCard(w, 0) ; StrIO.WriteLn
+END WriteWeight ;
+
+PROCEDURE WriteTime (p: CARDINAL) ;
+BEGIN
+ AssignOutputTo(p) ;
+ StrIO.WriteString('dT ') ;
+ NumberIO.WriteCard((GetTicks() DIV TicksPerSecond) DIV 60, 0) ;
+ Write(':') ;
+ NumberIO.WriteCard((GetTicks() DIV TicksPerSecond) MOD 60, 0) ;
+ StrIO.WriteLn
+END WriteTime ;
+
+PROCEDURE WriteFloor (p: CARDINAL) ;
+BEGIN
+ AssignOutputTo(p) ;
+ StrIO.WriteString('dMap ') ; StrIO.WriteString('mapname') ; StrIO.WriteLn
+END WriteFloor ;
+
+PROCEDURE InitScreen (p: CARDINAL) ;
+BEGIN
+ GetAccessToScreenNo(p) ;
+ Sync(p) ;
+ ClearScreen(p) ;
+
+ WITH Player[p] DO
+ WriteName(p, ManName) ;
+ WriteFloor(p) ;
+ WriteRoom(p, RoomOfMan) ;
+ WriteWounds(p, Wounds) ;
+ WriteFatigue(p, Fatigue) ;
+ WriteMagicArrows(p, NoOfMagic) ;
+ WriteArrows(p, NoOfNormal) ;
+ WriteWeight(p, Weight) ;
+ WriteTime(p)
+ END ;
+ ReleaseAccessToScreenNo(p)
+END InitScreen ;
+
+
+PROCEDURE WriteCommentLine1 (p: CARDINAL; a: ARRAY OF CHAR) ;
+BEGIN
+ AssignOutputTo(p) ;
+ StrIO.WriteString('dC1 ') ; StrIO.WriteString(a) ; StrIO.WriteLn
+END WriteCommentLine1 ;
+
+
+PROCEDURE WriteCommentLine2 (p: CARDINAL; a: ARRAY OF CHAR) ;
+BEGIN
+ AssignOutputTo(p) ;
+ StrIO.WriteString('dC2 ') ; StrIO.WriteString(a) ; StrIO.WriteLn
+END WriteCommentLine2 ;
+
+
+PROCEDURE WriteCommentLine3 (p: CARDINAL; a: ARRAY OF CHAR) ;
+BEGIN
+ AssignOutputTo(p) ;
+ StrIO.WriteString('dC3 ') ; StrIO.WriteString(a) ; StrIO.WriteLn
+END WriteCommentLine3 ;
+
+
+PROCEDURE DelCommentLine1 (p: CARDINAL) ;
+BEGIN
+ AssignOutputTo(p) ;
+ WriteCommentLine1(p, '')
+END DelCommentLine1 ;
+
+
+PROCEDURE DelCommentLine2 (p: CARDINAL) ;
+BEGIN
+ AssignOutputTo(p) ;
+ WriteCommentLine2(p, '')
+END DelCommentLine2 ;
+
+
+PROCEDURE DelCommentLine3 (p: CARDINAL) ;
+BEGIN
+ AssignOutputTo(p) ;
+ WriteCommentLine3(p, '')
+END DelCommentLine3 ;
+
+
+(*
+ Pause - issues a pause message and waits for a character to be pressed.
+*)
+
+PROCEDURE Pause (p: CARDINAL) ;
+VAR
+ ch: CHAR ;
+BEGIN
+ AssignOutputTo(p) ;
+ WriteCommentLine2(p, 'Press any key') ;
+ WriteCommentLine3(p, 'to continue') ;
+ IF ClientRead(ch)
+ THEN
+ END
+END Pause ;
+
+
+PROCEDURE Quit (p: CARDINAL) ;
+BEGIN
+ AssignOutputTo(p) ;
+ StrIO.WriteString('quit') ; StrIO.WriteLn
+END Quit ;
+
+
+(*
+ PromptString - writes a text message to the client console.
+ without the final 'newline'
+*)
+
+PROCEDURE PromptString (p: CARDINAL; a: ARRAY OF CHAR) ;
+BEGIN
+ AssignOutputTo(p) ;
+ StrIO.WriteString('dWriteStr ') ;
+ StrIO.WriteString(a) ;
+ StrIO.WriteLn
+END PromptString ;
+
+
+(*
+ WriteString - writes a text message to the client console.
+*)
+
+PROCEDURE WriteString (p: CARDINAL; a: ARRAY OF CHAR) ;
+VAR
+ start,
+ needEol: BOOLEAN ;
+ i, j, n: CARDINAL ;
+BEGIN
+ AssignOutputTo(p) ;
+ n := StrLen(a) ;
+ i := 0 ;
+ start := TRUE ;
+ needEol := FALSE ;
+ WHILE i<n DO
+ IF (a[i]='\') AND (a[i+1]='n')
+ THEN
+ IF start
+ THEN
+ StrIO.WriteString('dWriteLn ')
+ END ;
+ StrIO.WriteLn ;
+ start := TRUE ;
+ needEol := FALSE ;
+ INC(i)
+ ELSE
+ IF start
+ THEN
+ StrIO.WriteString('dWriteLn ') ;
+ start := FALSE
+ END ;
+ Write(a[i]) ;
+ needEol := TRUE
+ END ;
+ INC(i)
+ END ;
+ IF needEol
+ THEN
+ StrIO.WriteLn
+ END
+END WriteString ;
+
+
+END Screen.
+(*
+ * Local variables:
+ * compile-command: "make"
+ * End:
+ *)
diff --git a/gcc/testsuite/gm2/projects/pim/run/pass/tower/SocketControl.c b/gcc/testsuite/gm2/projects/pim/run/pass/tower/SocketControl.c
new file mode 100644
index 0000000..5844bd2
--- /dev/null
+++ b/gcc/testsuite/gm2/projects/pim/run/pass/tower/SocketControl.c
@@ -0,0 +1,27 @@
+
+#include <unistd.h>
+#include <fcntl.h>
+#include <signal.h>
+
+
+int SocketControl_nonBlocking (int fd)
+{
+ return fcntl (fd, fcntl (fd, F_GETFL) | O_NONBLOCK);
+}
+
+int SocketControl_ignoreSignals (void)
+{
+ signal (SIGPIPE, SIG_IGN);
+}
+
+void _M2_SocketControl_init (int, char *, char *)
+{
+}
+
+void _M2_SocketControl_finish (int, char *, char *)
+{
+}
+
+void _M2_SocketControl_ctor ()
+{
+}
diff --git a/gcc/testsuite/gm2/projects/pim/run/pass/tower/SocketControl.def b/gcc/testsuite/gm2/projects/pim/run/pass/tower/SocketControl.def
new file mode 100644
index 0000000..e52b2ec
--- /dev/null
+++ b/gcc/testsuite/gm2/projects/pim/run/pass/tower/SocketControl.def
@@ -0,0 +1,6 @@
+DEFINITION MODULE SocketControl ;
+
+PROCEDURE nonBlocking (fd: INTEGER) : INTEGER ;
+PROCEDURE ignoreSignals ;
+
+END SocketControl.
diff --git a/gcc/testsuite/gm2/projects/pim/run/pass/tower/Window.def b/gcc/testsuite/gm2/projects/pim/run/pass/tower/Window.def
new file mode 100644
index 0000000..d515af4
--- /dev/null
+++ b/gcc/testsuite/gm2/projects/pim/run/pass/tower/Window.def
@@ -0,0 +1,16 @@
+DEFINITION MODULE Window ;
+
+
+EXPORT QUALIFIED ClipPoint, Clip ;
+
+
+PROCEDURE ClipPoint (VAR x, y: CARDINAL ; Sx, Sy: CARDINAL ; VAR ok: BOOLEAN) ;
+
+
+PROCEDURE Clip (VAR x1,y1,x2,y2: CARDINAL ;
+ Sx,Sy: CARDINAL ;
+ VAR ok: BOOLEAN) ;
+
+
+END Window.
+
diff --git a/gcc/testsuite/gm2/projects/pim/run/pass/tower/Window.mod b/gcc/testsuite/gm2/projects/pim/run/pass/tower/Window.mod
new file mode 100644
index 0000000..2f71271
--- /dev/null
+++ b/gcc/testsuite/gm2/projects/pim/run/pass/tower/Window.mod
@@ -0,0 +1,62 @@
+IMPLEMENTATION MODULE Window ;
+
+
+FROM Screen IMPORT Width, Height ;
+
+
+
+PROCEDURE ClipPoint (VAR x, y: CARDINAL ; Sx, Sy: CARDINAL ; VAR ok: BOOLEAN) ;
+BEGIN
+ IF (x>=Sx) AND (x<=Sx+Width) AND
+ (y>=Sy) AND (y<=Sy+Height)
+ THEN
+ DEC(x, Sx) ;
+ DEC(y, Sy) ;
+ ok := TRUE
+ ELSE
+ ok := FALSE
+ END
+END ClipPoint ;
+
+
+PROCEDURE Clip (VAR x1, y1, x2, y2: CARDINAL ;
+ Sx, Sy: CARDINAL ;
+ VAR ok: BOOLEAN) ;
+BEGIN
+ IF (Sx>x2) OR (Sx+Width<x1)
+ THEN
+ ok := FALSE ;
+ ELSIF (Sy>y2) OR (Sy+Height<y1)
+ THEN
+ ok := FALSE
+ ELSE
+ ok := TRUE ;
+ IF Sx>x1
+ THEN
+ x1 := 0
+ ELSE
+ DEC(x1, Sx)
+ END ;
+ IF Sy>y1
+ THEN
+ y1 := 0
+ ELSE
+ DEC(y1, Sy)
+ END ;
+ IF x2-Sx>Width
+ THEN
+ x2 := Width
+ ELSE
+ DEC(x2, Sx)
+ END ;
+ IF y2-Sy>Height
+ THEN
+ y2 := Height
+ ELSE
+ DEC(y2, Sy)
+ END
+ END
+END Clip ;
+
+
+END Window.
diff --git a/gcc/testsuite/gm2/projects/pim/run/pass/tower/adv.flex b/gcc/testsuite/gm2/projects/pim/run/pass/tower/adv.flex
new file mode 100644
index 0000000..0c4eebb
--- /dev/null
+++ b/gcc/testsuite/gm2/projects/pim/run/pass/tower/adv.flex
@@ -0,0 +1,266 @@
+%{
+/* Copyright (C) 2022 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.
+ */
+
+ /*
+ * adv.flex - provides a lexical analyser for Dungeon
+ */
+
+ struct lineInfo {
+ char *linebuf; /* line contents */
+ int linelen; /* length */
+ int tokenpos; /* start position of token within line */
+ int toklen; /* a copy of yylen (length of token) */
+ int nextpos; /* position after token */
+ int actualline; /* line number of this line */
+ };
+
+ static int lineno =1; /* a running count of the file line number */
+ static char *filename =NULL;
+ static struct lineInfo *currentLine =NULL;
+
+ void advflex_error (const char *);
+static void finishedLine (void);
+static void resetpos (void);
+static void consumeLine (void);
+static void updatepos (void);
+static void skippos (void);
+static void poperrorskip (const char *);
+ int advflex_OpenSource (char *s);
+ int advflex_GetLineNo (void);
+ void advflex_CloseSource(void);
+ char *advflex_GetToken (void);
+ void _M2_advflex_init (int, char *, char *);
+ void _M2_advflex_finish (int, char *, char *);
+ void _M2_advflex_ctor (void);
+extern void yylex (void);
+
+#if !defined(TRUE)
+# define TRUE (1==1)
+#endif
+#if !defined(FALSE)
+# define FALSE (1==0)
+#endif
+
+typedef enum {eoftok, roomtok, doortok, walltok, treasuretok, attok,
+ leadstok, totok, statustok, closedtok, opentok, secrettok,
+ istok, endtok, enddottok, integertok, randomizetok} toktype ;
+
+toktype advflex_currenttoken;
+char *advflex_currentident;
+int advflex_currentinteger;
+
+
+#define YY_DECL void yylex (void)
+%}
+
+%%
+
+\n.* { consumeLine(); /* printf("found: %s\n", currentLine->linebuf); */ }
+[0-9]+ { updatepos();
+ advflex_currenttoken = integertok;
+ advflex_currentinteger = atoi(yytext);
+ return; }
+[ \t]* { updatepos(); }
+ROOM { updatepos(); advflex_currenttoken = roomtok; return; }
+END { updatepos(); advflex_currenttoken = endtok; return; }
+WALL { updatepos(); advflex_currenttoken = walltok; return; }
+DOOR { updatepos(); advflex_currenttoken = doortok; return; }
+STATUS { updatepos(); advflex_currenttoken = statustok; return; }
+CLOSED { updatepos(); advflex_currenttoken = closedtok; return; }
+OPEN { updatepos(); advflex_currenttoken = opentok; return; }
+SECRET { updatepos(); advflex_currenttoken = secrettok; return; }
+LEADS { updatepos(); advflex_currenttoken = leadstok; return; }
+TO { updatepos(); advflex_currenttoken = totok; return; }
+TREASURE { updatepos(); advflex_currenttoken = treasuretok; return; }
+AT { updatepos(); advflex_currenttoken = attok; return; }
+IS { updatepos(); advflex_currenttoken = istok; return; }
+END. { updatepos(); advflex_currenttoken = enddottok; return; }
+RANDOMIZE { updatepos(); advflex_currenttoken = randomizetok; return; }
+<<EOF>> { updatepos(); advflex_currenttoken = eoftok; return; }
+
+%%
+
+/*
+ * consumeLine - reads a line into a buffer, it then pushes back the whole
+ * line except the initial \n.
+ */
+
+static void consumeLine (void)
+{
+ if (currentLine->linelen<yyleng) {
+ currentLine->linebuf = (char *)realloc (currentLine->linebuf, yyleng);
+ currentLine->linelen = yyleng;
+ }
+ strcpy(currentLine->linebuf, yytext+1); /* copy all except the initial \n */
+ lineno++;
+ currentLine->actualline = lineno;
+ currentLine->tokenpos=0;
+ currentLine->nextpos=0;
+ yyless(1); /* push back all but the \n */
+}
+
+/*
+ * updatepos - updates the current token position.
+ * Should be used when a rule matches a token.
+ */
+
+static void updatepos (void)
+{
+ currentLine->nextpos = currentLine->tokenpos+yyleng;
+ currentLine->toklen = yyleng;
+}
+
+/*
+ * skippos - skips over this token. This function should be called
+ * if we are not returning and thus not calling getToken.
+ */
+
+static void skippos (void)
+{
+ currentLine->tokenpos = currentLine->nextpos;
+}
+
+/*
+ * initLine - initializes a currentLine
+ */
+
+static void initLine (void)
+{
+ currentLine = (struct lineInfo *)malloc (sizeof(struct lineInfo));
+
+ if (currentLine == NULL)
+ perror("malloc");
+ currentLine->linebuf = NULL;
+ currentLine->linelen = 0;
+ currentLine->tokenpos = 0;
+ currentLine->toklen = 0;
+ currentLine->nextpos = 0;
+ currentLine->actualline = lineno;
+}
+
+/*
+ * resetpos - resets the position of the next token to the start of the line.
+ */
+
+static void resetpos (void)
+{
+ if (currentLine != NULL)
+ currentLine->nextpos = 0;
+}
+
+/*
+ * advflex_GetToken - returns a new token.
+ */
+
+char *advflex_GetToken (void)
+{
+ if (currentLine == NULL)
+ initLine();
+ currentLine->tokenpos = currentLine->nextpos;
+ yylex();
+}
+
+void advflex_error (const char *s)
+{
+ if (currentLine != NULL) {
+ printf("%s:%d:%s\n", filename, currentLine->actualline, s);
+ printf("%s\n", currentLine->linebuf);
+# if 0
+ printf("%*s%*s\n", currentLine->nextpos, " ", currentLine->toklen, "^");
+# endif
+ }
+}
+
+/*
+ * OpenSource - returns TRUE if file, s, can be opened and
+ * all tokens are taken from this file.
+ */
+
+int advflex_OpenSource (char *s)
+{
+ FILE *f = fopen(s, "r");
+
+ if (f == NULL)
+ return FALSE;
+ else {
+ yy_delete_buffer(YY_CURRENT_BUFFER);
+ yy_switch_to_buffer(yy_create_buffer(f, YY_BUF_SIZE));
+ filename = strdup(s);
+ lineno =1;
+ if (currentLine != NULL)
+ currentLine->actualline = lineno;
+ return TRUE;
+ }
+}
+
+/*
+ * CloseSource - provided for semantic sugar
+ */
+
+void advflex_CloseSource (void)
+{
+}
+
+/*
+ * advflex_GetLineNo - returns the current line number.
+ */
+
+int advflex_GetLineNo (void)
+{
+ if (currentLine != NULL)
+ return currentLine->actualline;
+ else
+ return 0;
+}
+
+/*
+ * yywrap is called when end of file is seen. We push an eof token
+ * and tell the lexical analysis to stop.
+ */
+
+int yywrap (void)
+{
+ updatepos(); return 1;
+}
+
+void _M2_advflex_init (int, char *, char *)
+{
+}
+
+void _M2_advflex_finish (int, char *, char *)
+{
+}
+
+void _M2_advflex_ctor (void)
+{
+}
+
+#if 0
+main () {
+ char *s;
+
+ if (advflex_OpenSource("../maps/glover")) {
+ s = (char *)advflex_GetToken();
+ while (s != NULL) {
+ advflex_error(s);
+ s = (char *)advflex_GetToken();
+ }
+ }
+}
+#endif
diff --git a/gcc/testsuite/gm2/projects/pim/run/pass/tower/advflex.c b/gcc/testsuite/gm2/projects/pim/run/pass/tower/advflex.c
new file mode 100644
index 0000000..542723f
--- /dev/null
+++ b/gcc/testsuite/gm2/projects/pim/run/pass/tower/advflex.c
@@ -0,0 +1,2107 @@
+#line 2 "advflex.c"
+
+#line 4 "advflex.c"
+
+#define YY_INT_ALIGNED short int
+
+/* A lexical scanner generated by flex */
+
+#define FLEX_SCANNER
+#define YY_FLEX_MAJOR_VERSION 2
+#define YY_FLEX_MINOR_VERSION 6
+#define YY_FLEX_SUBMINOR_VERSION 4
+#if YY_FLEX_SUBMINOR_VERSION > 0
+#define FLEX_BETA
+#endif
+
+/* First, we deal with platform-specific or compiler-specific issues. */
+
+/* begin standard C headers. */
+#include <stdio.h>
+#include <string.h>
+#include <errno.h>
+#include <stdlib.h>
+
+/* end standard C headers. */
+
+/* flex integer type definitions */
+
+#ifndef FLEXINT_H
+#define FLEXINT_H
+
+/* C99 systems have <inttypes.h>. Non-C99 systems may or may not. */
+
+#if defined (__STDC_VERSION__) && __STDC_VERSION__ >= 199901L
+
+/* C99 says to define __STDC_LIMIT_MACROS before including stdint.h,
+ * if you want the limit (max/min) macros for int types.
+ */
+#ifndef __STDC_LIMIT_MACROS
+#define __STDC_LIMIT_MACROS 1
+#endif
+
+#include <inttypes.h>
+typedef int8_t flex_int8_t;
+typedef uint8_t flex_uint8_t;
+typedef int16_t flex_int16_t;
+typedef uint16_t flex_uint16_t;
+typedef int32_t flex_int32_t;
+typedef uint32_t flex_uint32_t;
+#else
+typedef signed char flex_int8_t;
+typedef short int flex_int16_t;
+typedef int flex_int32_t;
+typedef unsigned char flex_uint8_t;
+typedef unsigned short int flex_uint16_t;
+typedef unsigned int flex_uint32_t;
+
+/* Limits of integral types. */
+#ifndef INT8_MIN
+#define INT8_MIN (-128)
+#endif
+#ifndef INT16_MIN
+#define INT16_MIN (-32767-1)
+#endif
+#ifndef INT32_MIN
+#define INT32_MIN (-2147483647-1)
+#endif
+#ifndef INT8_MAX
+#define INT8_MAX (127)
+#endif
+#ifndef INT16_MAX
+#define INT16_MAX (32767)
+#endif
+#ifndef INT32_MAX
+#define INT32_MAX (2147483647)
+#endif
+#ifndef UINT8_MAX
+#define UINT8_MAX (255U)
+#endif
+#ifndef UINT16_MAX
+#define UINT16_MAX (65535U)
+#endif
+#ifndef UINT32_MAX
+#define UINT32_MAX (4294967295U)
+#endif
+
+#ifndef SIZE_MAX
+#define SIZE_MAX (~(size_t)0)
+#endif
+
+#endif /* ! C99 */
+
+#endif /* ! FLEXINT_H */
+
+/* begin standard C++ headers. */
+
+/* TODO: this is always defined, so inline it */
+#define yyconst const
+
+#if defined(__GNUC__) && __GNUC__ >= 3
+#define yynoreturn __attribute__((__noreturn__))
+#else
+#define yynoreturn
+#endif
+
+/* Returned upon end-of-file. */
+#define YY_NULL 0
+
+/* Promotes a possibly negative, possibly signed char to an
+ * integer in range [0..255] for use as an array index.
+ */
+#define YY_SC_TO_UI(c) ((YY_CHAR) (c))
+
+/* Enter a start condition. This macro really ought to take a parameter,
+ * but we do it the disgusting crufty way forced on us by the ()-less
+ * definition of BEGIN.
+ */
+#define BEGIN (yy_start) = 1 + 2 *
+/* Translate the current start state into a value that can be later handed
+ * to BEGIN to return to the state. The YYSTATE alias is for lex
+ * compatibility.
+ */
+#define YY_START (((yy_start) - 1) / 2)
+#define YYSTATE YY_START
+/* Action number for EOF rule of a given start state. */
+#define YY_STATE_EOF(state) (YY_END_OF_BUFFER + state + 1)
+/* Special action meaning "start processing a new file". */
+#define YY_NEW_FILE yyrestart( yyin )
+#define YY_END_OF_BUFFER_CHAR 0
+
+/* Size of default input buffer. */
+#ifndef YY_BUF_SIZE
+#ifdef __ia64__
+/* On IA-64, the buffer size is 16k, not 8k.
+ * Moreover, YY_BUF_SIZE is 2*YY_READ_BUF_SIZE in the general case.
+ * Ditto for the __ia64__ case accordingly.
+ */
+#define YY_BUF_SIZE 32768
+#else
+#define YY_BUF_SIZE 16384
+#endif /* __ia64__ */
+#endif
+
+/* The state buf must be large enough to hold one state per character in the main buffer.
+ */
+#define YY_STATE_BUF_SIZE ((YY_BUF_SIZE + 2) * sizeof(yy_state_type))
+
+#ifndef YY_TYPEDEF_YY_BUFFER_STATE
+#define YY_TYPEDEF_YY_BUFFER_STATE
+typedef struct yy_buffer_state *YY_BUFFER_STATE;
+#endif
+
+#ifndef YY_TYPEDEF_YY_SIZE_T
+#define YY_TYPEDEF_YY_SIZE_T
+typedef size_t yy_size_t;
+#endif
+
+extern int yyleng;
+
+extern FILE *yyin, *yyout;
+
+#define EOB_ACT_CONTINUE_SCAN 0
+#define EOB_ACT_END_OF_FILE 1
+#define EOB_ACT_LAST_MATCH 2
+
+ #define YY_LESS_LINENO(n)
+ #define YY_LINENO_REWIND_TO(ptr)
+
+/* Return all but the first "n" matched characters back to the input stream. */
+#define yyless(n) \
+ do \
+ { \
+ /* Undo effects of setting up yytext. */ \
+ int yyless_macro_arg = (n); \
+ YY_LESS_LINENO(yyless_macro_arg);\
+ *yy_cp = (yy_hold_char); \
+ YY_RESTORE_YY_MORE_OFFSET \
+ (yy_c_buf_p) = yy_cp = yy_bp + yyless_macro_arg - YY_MORE_ADJ; \
+ YY_DO_BEFORE_ACTION; /* set up yytext again */ \
+ } \
+ while ( 0 )
+#define unput(c) yyunput( c, (yytext_ptr) )
+
+#ifndef YY_STRUCT_YY_BUFFER_STATE
+#define YY_STRUCT_YY_BUFFER_STATE
+struct yy_buffer_state
+ {
+ FILE *yy_input_file;
+
+ char *yy_ch_buf; /* input buffer */
+ char *yy_buf_pos; /* current position in input buffer */
+
+ /* Size of input buffer in bytes, not including room for EOB
+ * characters.
+ */
+ int yy_buf_size;
+
+ /* Number of characters read into yy_ch_buf, not including EOB
+ * characters.
+ */
+ int yy_n_chars;
+
+ /* Whether we "own" the buffer - i.e., we know we created it,
+ * and can realloc() it to grow it, and should free() it to
+ * delete it.
+ */
+ int yy_is_our_buffer;
+
+ /* Whether this is an "interactive" input source; if so, and
+ * if we're using stdio for input, then we want to use getc()
+ * instead of fread(), to make sure we stop fetching input after
+ * each newline.
+ */
+ int yy_is_interactive;
+
+ /* Whether we're considered to be at the beginning of a line.
+ * If so, '^' rules will be active on the next match, otherwise
+ * not.
+ */
+ int yy_at_bol;
+
+ int yy_bs_lineno; /**< The line count. */
+ int yy_bs_column; /**< The column count. */
+
+ /* Whether to try to fill the input buffer when we reach the
+ * end of it.
+ */
+ int yy_fill_buffer;
+
+ int yy_buffer_status;
+
+#define YY_BUFFER_NEW 0
+#define YY_BUFFER_NORMAL 1
+ /* When an EOF's been seen but there's still some text to process
+ * then we mark the buffer as YY_EOF_PENDING, to indicate that we
+ * shouldn't try reading from the input source any more. We might
+ * still have a bunch of tokens to match, though, because of
+ * possible backing-up.
+ *
+ * When we actually see the EOF, we change the status to "new"
+ * (via yyrestart()), so that the user can continue scanning by
+ * just pointing yyin at a new input file.
+ */
+#define YY_BUFFER_EOF_PENDING 2
+
+ };
+#endif /* !YY_STRUCT_YY_BUFFER_STATE */
+
+/* Stack of input buffers. */
+static size_t yy_buffer_stack_top = 0; /**< index of top of stack. */
+static size_t yy_buffer_stack_max = 0; /**< capacity of stack. */
+static YY_BUFFER_STATE * yy_buffer_stack = NULL; /**< Stack as an array. */
+
+/* We provide macros for accessing buffer states in case in the
+ * future we want to put the buffer states in a more general
+ * "scanner state".
+ *
+ * Returns the top of the stack, or NULL.
+ */
+#define YY_CURRENT_BUFFER ( (yy_buffer_stack) \
+ ? (yy_buffer_stack)[(yy_buffer_stack_top)] \
+ : NULL)
+/* Same as previous macro, but useful when we know that the buffer stack is not
+ * NULL or when we need an lvalue. For internal use only.
+ */
+#define YY_CURRENT_BUFFER_LVALUE (yy_buffer_stack)[(yy_buffer_stack_top)]
+
+/* yy_hold_char holds the character lost when yytext is formed. */
+static char yy_hold_char;
+static int yy_n_chars; /* number of characters read into yy_ch_buf */
+int yyleng;
+
+/* Points to current character in buffer. */
+static char *yy_c_buf_p = NULL;
+static int yy_init = 0; /* whether we need to initialize */
+static int yy_start = 0; /* start state number */
+
+/* Flag which is used to allow yywrap()'s to do buffer switches
+ * instead of setting up a fresh yyin. A bit of a hack ...
+ */
+static int yy_did_buffer_switch_on_eof;
+
+void yyrestart ( FILE *input_file );
+void yy_switch_to_buffer ( YY_BUFFER_STATE new_buffer );
+YY_BUFFER_STATE yy_create_buffer ( FILE *file, int size );
+void yy_delete_buffer ( YY_BUFFER_STATE b );
+void yy_flush_buffer ( YY_BUFFER_STATE b );
+void yypush_buffer_state ( YY_BUFFER_STATE new_buffer );
+void yypop_buffer_state ( void );
+
+static void yyensure_buffer_stack ( void );
+static void yy_load_buffer_state ( void );
+static void yy_init_buffer ( YY_BUFFER_STATE b, FILE *file );
+#define YY_FLUSH_BUFFER yy_flush_buffer( YY_CURRENT_BUFFER )
+
+YY_BUFFER_STATE yy_scan_buffer ( char *base, yy_size_t size );
+YY_BUFFER_STATE yy_scan_string ( const char *yy_str );
+YY_BUFFER_STATE yy_scan_bytes ( const char *bytes, int len );
+
+void *yyalloc ( yy_size_t );
+void *yyrealloc ( void *, yy_size_t );
+void yyfree ( void * );
+
+#define yy_new_buffer yy_create_buffer
+#define yy_set_interactive(is_interactive) \
+ { \
+ if ( ! YY_CURRENT_BUFFER ){ \
+ yyensure_buffer_stack (); \
+ YY_CURRENT_BUFFER_LVALUE = \
+ yy_create_buffer( yyin, YY_BUF_SIZE ); \
+ } \
+ YY_CURRENT_BUFFER_LVALUE->yy_is_interactive = is_interactive; \
+ }
+#define yy_set_bol(at_bol) \
+ { \
+ if ( ! YY_CURRENT_BUFFER ){\
+ yyensure_buffer_stack (); \
+ YY_CURRENT_BUFFER_LVALUE = \
+ yy_create_buffer( yyin, YY_BUF_SIZE ); \
+ } \
+ YY_CURRENT_BUFFER_LVALUE->yy_at_bol = at_bol; \
+ }
+#define YY_AT_BOL() (YY_CURRENT_BUFFER_LVALUE->yy_at_bol)
+
+/* Begin user sect3 */
+typedef flex_uint8_t YY_CHAR;
+
+FILE *yyin = NULL, *yyout = NULL;
+
+typedef int yy_state_type;
+
+extern int yylineno;
+int yylineno = 1;
+
+extern char *yytext;
+#ifdef yytext_ptr
+#undef yytext_ptr
+#endif
+#define yytext_ptr yytext
+
+static yy_state_type yy_get_previous_state ( void );
+static yy_state_type yy_try_NUL_trans ( yy_state_type current_state );
+static int yy_get_next_buffer ( void );
+static void yynoreturn yy_fatal_error ( const char* msg );
+
+/* Done after the current pattern has been matched and before the
+ * corresponding action - sets up yytext.
+ */
+#define YY_DO_BEFORE_ACTION \
+ (yytext_ptr) = yy_bp; \
+ yyleng = (int) (yy_cp - yy_bp); \
+ (yy_hold_char) = *yy_cp; \
+ *yy_cp = '\0'; \
+ (yy_c_buf_p) = yy_cp;
+#define YY_NUM_RULES 19
+#define YY_END_OF_BUFFER 20
+/* This struct is not used in this scanner,
+ but its presence is necessary. */
+struct yy_trans_info
+ {
+ flex_int32_t yy_verify;
+ flex_int32_t yy_nxt;
+ };
+static const flex_int16_t yy_accept[75] =
+ { 0,
+ 3, 3, 20, 19, 3, 1, 2, 19, 19, 19,
+ 19, 19, 19, 19, 19, 19, 19, 19, 3, 1,
+ 2, 15, 0, 0, 0, 16, 0, 0, 0, 0,
+ 0, 0, 13, 0, 0, 0, 0, 5, 0, 0,
+ 0, 0, 0, 0, 0, 0, 0, 7, 17, 0,
+ 10, 0, 4, 0, 0, 0, 6, 0, 12, 0,
+ 0, 0, 0, 9, 0, 11, 8, 0, 0, 0,
+ 0, 14, 18, 0
+ } ;
+
+static const YY_CHAR yy_ec[256] =
+ { 0,
+ 1, 1, 1, 1, 1, 1, 1, 1, 2, 3,
+ 1, 1, 1, 1, 1, 1, 1, 1, 1, 1,
+ 1, 1, 1, 1, 1, 1, 1, 1, 1, 1,
+ 1, 2, 1, 1, 1, 1, 1, 1, 1, 1,
+ 1, 1, 1, 1, 1, 1, 1, 4, 4, 4,
+ 4, 4, 4, 4, 4, 4, 4, 1, 1, 1,
+ 1, 1, 1, 1, 5, 1, 6, 7, 8, 1,
+ 1, 1, 9, 1, 1, 10, 11, 12, 13, 14,
+ 1, 15, 16, 17, 18, 1, 19, 1, 1, 20,
+ 1, 1, 1, 1, 1, 1, 1, 1, 1, 1,
+
+ 1, 1, 1, 1, 1, 1, 1, 1, 1, 1,
+ 1, 1, 1, 1, 1, 1, 1, 1, 1, 1,
+ 1, 1, 1, 1, 1, 1, 1, 1, 1, 1,
+ 1, 1, 1, 1, 1, 1, 1, 1, 1, 1,
+ 1, 1, 1, 1, 1, 1, 1, 1, 1, 1,
+ 1, 1, 1, 1, 1, 1, 1, 1, 1, 1,
+ 1, 1, 1, 1, 1, 1, 1, 1, 1, 1,
+ 1, 1, 1, 1, 1, 1, 1, 1, 1, 1,
+ 1, 1, 1, 1, 1, 1, 1, 1, 1, 1,
+ 1, 1, 1, 1, 1, 1, 1, 1, 1, 1,
+
+ 1, 1, 1, 1, 1, 1, 1, 1, 1, 1,
+ 1, 1, 1, 1, 1, 1, 1, 1, 1, 1,
+ 1, 1, 1, 1, 1, 1, 1, 1, 1, 1,
+ 1, 1, 1, 1, 1, 1, 1, 1, 1, 1,
+ 1, 1, 1, 1, 1, 1, 1, 1, 1, 1,
+ 1, 1, 1, 1, 1
+ } ;
+
+static const YY_CHAR yy_meta[21] =
+ { 0,
+ 1, 1, 2, 1, 1, 1, 1, 1, 1, 1,
+ 1, 1, 1, 1, 1, 1, 1, 1, 1, 1
+ } ;
+
+static const flex_int16_t yy_base[77] =
+ { 0,
+ 0, 0, 78, 79, 75, 0, 72, 58, 64, 60,
+ 60, 55, 62, 55, 16, 14, 10, 63, 65, 0,
+ 62, 79, 52, 51, 56, 79, 57, 53, 48, 46,
+ 52, 52, 79, 48, 45, 38, 38, 0, 45, 39,
+ 43, 38, 33, 30, 41, 35, 36, 79, 79, 27,
+ 79, 29, 79, 33, 22, 23, 79, 31, 79, 26,
+ 19, 19, 16, 79, 24, 79, 79, 17, 10, 20,
+ 19, 79, 79, 79, 25, 23
+ } ;
+
+static const flex_int16_t yy_def[77] =
+ { 0,
+ 74, 1, 74, 74, 74, 75, 74, 74, 74, 74,
+ 74, 74, 74, 74, 74, 74, 74, 74, 74, 75,
+ 74, 74, 74, 74, 74, 74, 74, 74, 74, 74,
+ 74, 74, 74, 74, 74, 74, 74, 76, 74, 74,
+ 74, 74, 74, 74, 74, 74, 74, 74, 74, 74,
+ 74, 74, 74, 74, 74, 74, 74, 74, 74, 74,
+ 74, 74, 74, 74, 74, 74, 74, 74, 74, 74,
+ 74, 74, 74, 0, 74, 74
+ } ;
+
+static const flex_int16_t yy_nxt[100] =
+ { 0,
+ 4, 5, 6, 7, 8, 9, 10, 11, 12, 13,
+ 4, 4, 14, 4, 15, 16, 17, 4, 18, 4,
+ 29, 31, 33, 49, 34, 20, 73, 72, 30, 71,
+ 32, 70, 69, 68, 67, 66, 65, 64, 63, 62,
+ 61, 60, 59, 58, 57, 56, 55, 54, 53, 52,
+ 51, 50, 48, 47, 46, 45, 44, 43, 42, 41,
+ 40, 39, 38, 37, 36, 21, 19, 35, 28, 27,
+ 26, 25, 24, 23, 22, 21, 19, 74, 3, 74,
+ 74, 74, 74, 74, 74, 74, 74, 74, 74, 74,
+ 74, 74, 74, 74, 74, 74, 74, 74, 74
+
+ } ;
+
+static const flex_int16_t yy_chk[100] =
+ { 0,
+ 1, 1, 1, 1, 1, 1, 1, 1, 1, 1,
+ 1, 1, 1, 1, 1, 1, 1, 1, 1, 1,
+ 15, 16, 17, 76, 17, 75, 71, 70, 15, 69,
+ 16, 68, 65, 63, 62, 61, 60, 58, 56, 55,
+ 54, 52, 50, 47, 46, 45, 44, 43, 42, 41,
+ 40, 39, 37, 36, 35, 34, 32, 31, 30, 29,
+ 28, 27, 25, 24, 23, 21, 19, 18, 14, 13,
+ 12, 11, 10, 9, 8, 7, 5, 3, 74, 74,
+ 74, 74, 74, 74, 74, 74, 74, 74, 74, 74,
+ 74, 74, 74, 74, 74, 74, 74, 74, 74
+
+ } ;
+
+static yy_state_type yy_last_accepting_state;
+static char *yy_last_accepting_cpos;
+
+extern int yy_flex_debug;
+int yy_flex_debug = 0;
+
+/* The intent behind this definition is that it'll catch
+ * any uses of REJECT which flex missed.
+ */
+#define REJECT reject_used_but_not_detected
+#define yymore() yymore_used_but_not_detected
+#define YY_MORE_ADJ 0
+#define YY_RESTORE_YY_MORE_OFFSET
+char *yytext;
+#line 1 "adv.flex"
+#line 2 "adv.flex"
+/* Copyright (C) 2022 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.
+ */
+
+ /*
+ * adv.flex - provides a lexical analyser for Dungeon
+ */
+
+ struct lineInfo {
+ char *linebuf; /* line contents */
+ int linelen; /* length */
+ int tokenpos; /* start position of token within line */
+ int toklen; /* a copy of yylen (length of token) */
+ int nextpos; /* position after token */
+ int actualline; /* line number of this line */
+ };
+
+ static int lineno =1; /* a running count of the file line number */
+ static char *filename =NULL;
+ static struct lineInfo *currentLine =NULL;
+
+ void advflex_error (const char *);
+static void finishedLine (void);
+static void resetpos (void);
+static void consumeLine (void);
+static void updatepos (void);
+static void skippos (void);
+static void poperrorskip (const char *);
+ int advflex_OpenSource (char *s);
+ int advflex_GetLineNo (void);
+ void advflex_CloseSource(void);
+ char *advflex_GetToken (void);
+ void _M2_advflex_init (int, char *, char *);
+ void _M2_advflex_finish (int, char *, char *);
+ void _M2_advflex_ctor (void);
+extern void yylex (void);
+
+#if !defined(TRUE)
+# define TRUE (1==1)
+#endif
+#if !defined(FALSE)
+# define FALSE (1==0)
+#endif
+
+typedef enum {eoftok, roomtok, doortok, walltok, treasuretok, attok,
+ leadstok, totok, statustok, closedtok, opentok, secrettok,
+ istok, endtok, enddottok, integertok, randomizetok} toktype ;
+
+toktype advflex_currenttoken;
+char *advflex_currentident;
+int advflex_currentinteger;
+
+
+#define YY_DECL void yylex (void)
+#line 553 "advflex.c"
+#line 554 "advflex.c"
+
+#define INITIAL 0
+
+#ifndef YY_NO_UNISTD_H
+/* Special case for "unistd.h", since it is non-ANSI. We include it way
+ * down here because we want the user's section 1 to have been scanned first.
+ * The user has a chance to override it with an option.
+ */
+#include <unistd.h>
+#endif
+
+#ifndef YY_EXTRA_TYPE
+#define YY_EXTRA_TYPE void *
+#endif
+
+static int yy_init_globals ( void );
+
+/* Accessor methods to globals.
+ These are made visible to non-reentrant scanners for convenience. */
+
+int yylex_destroy ( void );
+
+int yyget_debug ( void );
+
+void yyset_debug ( int debug_flag );
+
+YY_EXTRA_TYPE yyget_extra ( void );
+
+void yyset_extra ( YY_EXTRA_TYPE user_defined );
+
+FILE *yyget_in ( void );
+
+void yyset_in ( FILE * _in_str );
+
+FILE *yyget_out ( void );
+
+void yyset_out ( FILE * _out_str );
+
+ int yyget_leng ( void );
+
+char *yyget_text ( void );
+
+int yyget_lineno ( void );
+
+void yyset_lineno ( int _line_number );
+
+/* Macros after this point can all be overridden by user definitions in
+ * section 1.
+ */
+
+#ifndef YY_SKIP_YYWRAP
+#ifdef __cplusplus
+extern "C" int yywrap ( void );
+#else
+extern int yywrap ( void );
+#endif
+#endif
+
+#ifndef YY_NO_UNPUT
+
+ static void yyunput ( int c, char *buf_ptr );
+
+#endif
+
+#ifndef yytext_ptr
+static void yy_flex_strncpy ( char *, const char *, int );
+#endif
+
+#ifdef YY_NEED_STRLEN
+static int yy_flex_strlen ( const char * );
+#endif
+
+#ifndef YY_NO_INPUT
+#ifdef __cplusplus
+static int yyinput ( void );
+#else
+static int input ( void );
+#endif
+
+#endif
+
+/* Amount of stuff to slurp up with each read. */
+#ifndef YY_READ_BUF_SIZE
+#ifdef __ia64__
+/* On IA-64, the buffer size is 16k, not 8k */
+#define YY_READ_BUF_SIZE 16384
+#else
+#define YY_READ_BUF_SIZE 8192
+#endif /* __ia64__ */
+#endif
+
+/* Copy whatever the last rule matched to the standard output. */
+#ifndef ECHO
+/* This used to be an fputs(), but since the string might contain NUL's,
+ * we now use fwrite().
+ */
+#define ECHO do { if (fwrite( yytext, (size_t) yyleng, 1, yyout )) {} } while (0)
+#endif
+
+/* Gets input and stuffs it into "buf". number of characters read, or YY_NULL,
+ * is returned in "result".
+ */
+#ifndef YY_INPUT
+#define YY_INPUT(buf,result,max_size) \
+ if ( YY_CURRENT_BUFFER_LVALUE->yy_is_interactive ) \
+ { \
+ int c = '*'; \
+ int n; \
+ for ( n = 0; n < max_size && \
+ (c = getc( yyin )) != EOF && c != '\n'; ++n ) \
+ buf[n] = (char) c; \
+ if ( c == '\n' ) \
+ buf[n++] = (char) c; \
+ if ( c == EOF && ferror( yyin ) ) \
+ YY_FATAL_ERROR( "input in flex scanner failed" ); \
+ result = n; \
+ } \
+ else \
+ { \
+ errno=0; \
+ while ( (result = (int) fread(buf, 1, (yy_size_t) max_size, yyin)) == 0 && ferror(yyin)) \
+ { \
+ if( errno != EINTR) \
+ { \
+ YY_FATAL_ERROR( "input in flex scanner failed" ); \
+ break; \
+ } \
+ errno=0; \
+ clearerr(yyin); \
+ } \
+ }\
+\
+
+#endif
+
+/* No semi-colon after return; correct usage is to write "yyterminate();" -
+ * we don't want an extra ';' after the "return" because that will cause
+ * some compilers to complain about unreachable statements.
+ */
+#ifndef yyterminate
+#define yyterminate() return YY_NULL
+#endif
+
+/* Number of entries by which start-condition stack grows. */
+#ifndef YY_START_STACK_INCR
+#define YY_START_STACK_INCR 25
+#endif
+
+/* Report a fatal error. */
+#ifndef YY_FATAL_ERROR
+#define YY_FATAL_ERROR(msg) yy_fatal_error( msg )
+#endif
+
+/* end tables serialization structures and prototypes */
+
+/* Default declaration of generated scanner - a define so the user can
+ * easily add parameters.
+ */
+#ifndef YY_DECL
+#define YY_DECL_IS_OURS 1
+
+extern int yylex (void);
+
+#define YY_DECL int yylex (void)
+#endif /* !YY_DECL */
+
+/* Code executed at the beginning of each rule, after yytext and yyleng
+ * have been set up.
+ */
+#ifndef YY_USER_ACTION
+#define YY_USER_ACTION
+#endif
+
+/* Code executed at the end of each rule. */
+#ifndef YY_BREAK
+#define YY_BREAK /*LINTED*/break;
+#endif
+
+#define YY_RULE_SETUP \
+ YY_USER_ACTION
+
+/** The main scanner function which does all the work.
+ */
+YY_DECL
+{
+ yy_state_type yy_current_state;
+ char *yy_cp, *yy_bp;
+ int yy_act;
+
+ if ( !(yy_init) )
+ {
+ (yy_init) = 1;
+
+#ifdef YY_USER_INIT
+ YY_USER_INIT;
+#endif
+
+ if ( ! (yy_start) )
+ (yy_start) = 1; /* first start state */
+
+ if ( ! yyin )
+ yyin = stdin;
+
+ if ( ! yyout )
+ yyout = stdout;
+
+ if ( ! YY_CURRENT_BUFFER ) {
+ yyensure_buffer_stack ();
+ YY_CURRENT_BUFFER_LVALUE =
+ yy_create_buffer( yyin, YY_BUF_SIZE );
+ }
+
+ yy_load_buffer_state( );
+ }
+
+ {
+#line 72 "adv.flex"
+
+
+#line 774 "advflex.c"
+
+ while ( /*CONSTCOND*/1 ) /* loops until end-of-file is reached */
+ {
+ yy_cp = (yy_c_buf_p);
+
+ /* Support of yytext. */
+ *yy_cp = (yy_hold_char);
+
+ /* yy_bp points to the position in yy_ch_buf of the start of
+ * the current run.
+ */
+ yy_bp = yy_cp;
+
+ yy_current_state = (yy_start);
+yy_match:
+ do
+ {
+ YY_CHAR yy_c = yy_ec[YY_SC_TO_UI(*yy_cp)] ;
+ if ( yy_accept[yy_current_state] )
+ {
+ (yy_last_accepting_state) = yy_current_state;
+ (yy_last_accepting_cpos) = yy_cp;
+ }
+ while ( yy_chk[yy_base[yy_current_state] + yy_c] != yy_current_state )
+ {
+ yy_current_state = (int) yy_def[yy_current_state];
+ if ( yy_current_state >= 75 )
+ yy_c = yy_meta[yy_c];
+ }
+ yy_current_state = yy_nxt[yy_base[yy_current_state] + yy_c];
+ ++yy_cp;
+ }
+ while ( yy_base[yy_current_state] != 79 );
+
+yy_find_action:
+ yy_act = yy_accept[yy_current_state];
+ if ( yy_act == 0 )
+ { /* have to back up */
+ yy_cp = (yy_last_accepting_cpos);
+ yy_current_state = (yy_last_accepting_state);
+ yy_act = yy_accept[yy_current_state];
+ }
+
+ YY_DO_BEFORE_ACTION;
+
+do_action: /* This label is used only to access EOF actions. */
+
+ switch ( yy_act )
+ { /* beginning of action switch */
+ case 0: /* must back up */
+ /* undo the effects of YY_DO_BEFORE_ACTION */
+ *yy_cp = (yy_hold_char);
+ yy_cp = (yy_last_accepting_cpos);
+ yy_current_state = (yy_last_accepting_state);
+ goto yy_find_action;
+
+case 1:
+/* rule 1 can match eol */
+YY_RULE_SETUP
+#line 74 "adv.flex"
+{ consumeLine(); /* printf("found: %s\n", currentLine->linebuf); */ }
+ YY_BREAK
+case 2:
+YY_RULE_SETUP
+#line 75 "adv.flex"
+{ updatepos();
+ advflex_currenttoken = integertok;
+ advflex_currentinteger = atoi(yytext);
+ return; }
+ YY_BREAK
+case 3:
+YY_RULE_SETUP
+#line 79 "adv.flex"
+{ updatepos(); }
+ YY_BREAK
+case 4:
+YY_RULE_SETUP
+#line 80 "adv.flex"
+{ updatepos(); advflex_currenttoken = roomtok; return; }
+ YY_BREAK
+case 5:
+YY_RULE_SETUP
+#line 81 "adv.flex"
+{ updatepos(); advflex_currenttoken = endtok; return; }
+ YY_BREAK
+case 6:
+YY_RULE_SETUP
+#line 82 "adv.flex"
+{ updatepos(); advflex_currenttoken = walltok; return; }
+ YY_BREAK
+case 7:
+YY_RULE_SETUP
+#line 83 "adv.flex"
+{ updatepos(); advflex_currenttoken = doortok; return; }
+ YY_BREAK
+case 8:
+YY_RULE_SETUP
+#line 84 "adv.flex"
+{ updatepos(); advflex_currenttoken = statustok; return; }
+ YY_BREAK
+case 9:
+YY_RULE_SETUP
+#line 85 "adv.flex"
+{ updatepos(); advflex_currenttoken = closedtok; return; }
+ YY_BREAK
+case 10:
+YY_RULE_SETUP
+#line 86 "adv.flex"
+{ updatepos(); advflex_currenttoken = opentok; return; }
+ YY_BREAK
+case 11:
+YY_RULE_SETUP
+#line 87 "adv.flex"
+{ updatepos(); advflex_currenttoken = secrettok; return; }
+ YY_BREAK
+case 12:
+YY_RULE_SETUP
+#line 88 "adv.flex"
+{ updatepos(); advflex_currenttoken = leadstok; return; }
+ YY_BREAK
+case 13:
+YY_RULE_SETUP
+#line 89 "adv.flex"
+{ updatepos(); advflex_currenttoken = totok; return; }
+ YY_BREAK
+case 14:
+YY_RULE_SETUP
+#line 90 "adv.flex"
+{ updatepos(); advflex_currenttoken = treasuretok; return; }
+ YY_BREAK
+case 15:
+YY_RULE_SETUP
+#line 91 "adv.flex"
+{ updatepos(); advflex_currenttoken = attok; return; }
+ YY_BREAK
+case 16:
+YY_RULE_SETUP
+#line 92 "adv.flex"
+{ updatepos(); advflex_currenttoken = istok; return; }
+ YY_BREAK
+case 17:
+YY_RULE_SETUP
+#line 93 "adv.flex"
+{ updatepos(); advflex_currenttoken = enddottok; return; }
+ YY_BREAK
+case 18:
+YY_RULE_SETUP
+#line 94 "adv.flex"
+{ updatepos(); advflex_currenttoken = randomizetok; return; }
+ YY_BREAK
+case YY_STATE_EOF(INITIAL):
+#line 95 "adv.flex"
+{ updatepos(); advflex_currenttoken = eoftok; return; }
+ YY_BREAK
+case 19:
+YY_RULE_SETUP
+#line 97 "adv.flex"
+ECHO;
+ YY_BREAK
+#line 934 "advflex.c"
+
+ case YY_END_OF_BUFFER:
+ {
+ /* Amount of text matched not including the EOB char. */
+ int yy_amount_of_matched_text = (int) (yy_cp - (yytext_ptr)) - 1;
+
+ /* Undo the effects of YY_DO_BEFORE_ACTION. */
+ *yy_cp = (yy_hold_char);
+ YY_RESTORE_YY_MORE_OFFSET
+
+ if ( YY_CURRENT_BUFFER_LVALUE->yy_buffer_status == YY_BUFFER_NEW )
+ {
+ /* We're scanning a new file or input source. It's
+ * possible that this happened because the user
+ * just pointed yyin at a new source and called
+ * yylex(). If so, then we have to assure
+ * consistency between YY_CURRENT_BUFFER and our
+ * globals. Here is the right place to do so, because
+ * this is the first action (other than possibly a
+ * back-up) that will match for the new input source.
+ */
+ (yy_n_chars) = YY_CURRENT_BUFFER_LVALUE->yy_n_chars;
+ YY_CURRENT_BUFFER_LVALUE->yy_input_file = yyin;
+ YY_CURRENT_BUFFER_LVALUE->yy_buffer_status = YY_BUFFER_NORMAL;
+ }
+
+ /* Note that here we test for yy_c_buf_p "<=" to the position
+ * of the first EOB in the buffer, since yy_c_buf_p will
+ * already have been incremented past the NUL character
+ * (since all states make transitions on EOB to the
+ * end-of-buffer state). Contrast this with the test
+ * in input().
+ */
+ if ( (yy_c_buf_p) <= &YY_CURRENT_BUFFER_LVALUE->yy_ch_buf[(yy_n_chars)] )
+ { /* This was really a NUL. */
+ yy_state_type yy_next_state;
+
+ (yy_c_buf_p) = (yytext_ptr) + yy_amount_of_matched_text;
+
+ yy_current_state = yy_get_previous_state( );
+
+ /* Okay, we're now positioned to make the NUL
+ * transition. We couldn't have
+ * yy_get_previous_state() go ahead and do it
+ * for us because it doesn't know how to deal
+ * with the possibility of jamming (and we don't
+ * want to build jamming into it because then it
+ * will run more slowly).
+ */
+
+ yy_next_state = yy_try_NUL_trans( yy_current_state );
+
+ yy_bp = (yytext_ptr) + YY_MORE_ADJ;
+
+ if ( yy_next_state )
+ {
+ /* Consume the NUL. */
+ yy_cp = ++(yy_c_buf_p);
+ yy_current_state = yy_next_state;
+ goto yy_match;
+ }
+
+ else
+ {
+ yy_cp = (yy_c_buf_p);
+ goto yy_find_action;
+ }
+ }
+
+ else switch ( yy_get_next_buffer( ) )
+ {
+ case EOB_ACT_END_OF_FILE:
+ {
+ (yy_did_buffer_switch_on_eof) = 0;
+
+ if ( yywrap( ) )
+ {
+ /* Note: because we've taken care in
+ * yy_get_next_buffer() to have set up
+ * yytext, we can now set up
+ * yy_c_buf_p so that if some total
+ * hoser (like flex itself) wants to
+ * call the scanner after we return the
+ * YY_NULL, it'll still work - another
+ * YY_NULL will get returned.
+ */
+ (yy_c_buf_p) = (yytext_ptr) + YY_MORE_ADJ;
+
+ yy_act = YY_STATE_EOF(YY_START);
+ goto do_action;
+ }
+
+ else
+ {
+ if ( ! (yy_did_buffer_switch_on_eof) )
+ YY_NEW_FILE;
+ }
+ break;
+ }
+
+ case EOB_ACT_CONTINUE_SCAN:
+ (yy_c_buf_p) =
+ (yytext_ptr) + yy_amount_of_matched_text;
+
+ yy_current_state = yy_get_previous_state( );
+
+ yy_cp = (yy_c_buf_p);
+ yy_bp = (yytext_ptr) + YY_MORE_ADJ;
+ goto yy_match;
+
+ case EOB_ACT_LAST_MATCH:
+ (yy_c_buf_p) =
+ &YY_CURRENT_BUFFER_LVALUE->yy_ch_buf[(yy_n_chars)];
+
+ yy_current_state = yy_get_previous_state( );
+
+ yy_cp = (yy_c_buf_p);
+ yy_bp = (yytext_ptr) + YY_MORE_ADJ;
+ goto yy_find_action;
+ }
+ break;
+ }
+
+ default:
+ YY_FATAL_ERROR(
+ "fatal flex scanner internal error--no action found" );
+ } /* end of action switch */
+ } /* end of scanning one token */
+ } /* end of user's declarations */
+} /* end of yylex */
+
+/* yy_get_next_buffer - try to read in a new buffer
+ *
+ * Returns a code representing an action:
+ * EOB_ACT_LAST_MATCH -
+ * EOB_ACT_CONTINUE_SCAN - continue scanning from current position
+ * EOB_ACT_END_OF_FILE - end of file
+ */
+static int yy_get_next_buffer (void)
+{
+ char *dest = YY_CURRENT_BUFFER_LVALUE->yy_ch_buf;
+ char *source = (yytext_ptr);
+ int number_to_move, i;
+ int ret_val;
+
+ if ( (yy_c_buf_p) > &YY_CURRENT_BUFFER_LVALUE->yy_ch_buf[(yy_n_chars) + 1] )
+ YY_FATAL_ERROR(
+ "fatal flex scanner internal error--end of buffer missed" );
+
+ if ( YY_CURRENT_BUFFER_LVALUE->yy_fill_buffer == 0 )
+ { /* Don't try to fill the buffer, so this is an EOF. */
+ if ( (yy_c_buf_p) - (yytext_ptr) - YY_MORE_ADJ == 1 )
+ {
+ /* We matched a single character, the EOB, so
+ * treat this as a final EOF.
+ */
+ return EOB_ACT_END_OF_FILE;
+ }
+
+ else
+ {
+ /* We matched some text prior to the EOB, first
+ * process it.
+ */
+ return EOB_ACT_LAST_MATCH;
+ }
+ }
+
+ /* Try to read more data. */
+
+ /* First move last chars to start of buffer. */
+ number_to_move = (int) ((yy_c_buf_p) - (yytext_ptr) - 1);
+
+ for ( i = 0; i < number_to_move; ++i )
+ *(dest++) = *(source++);
+
+ if ( YY_CURRENT_BUFFER_LVALUE->yy_buffer_status == YY_BUFFER_EOF_PENDING )
+ /* don't do the read, it's not guaranteed to return an EOF,
+ * just force an EOF
+ */
+ YY_CURRENT_BUFFER_LVALUE->yy_n_chars = (yy_n_chars) = 0;
+
+ else
+ {
+ int num_to_read =
+ YY_CURRENT_BUFFER_LVALUE->yy_buf_size - number_to_move - 1;
+
+ while ( num_to_read <= 0 )
+ { /* Not enough room in the buffer - grow it. */
+
+ /* just a shorter name for the current buffer */
+ YY_BUFFER_STATE b = YY_CURRENT_BUFFER_LVALUE;
+
+ int yy_c_buf_p_offset =
+ (int) ((yy_c_buf_p) - b->yy_ch_buf);
+
+ if ( b->yy_is_our_buffer )
+ {
+ int new_size = b->yy_buf_size * 2;
+
+ if ( new_size <= 0 )
+ b->yy_buf_size += b->yy_buf_size / 8;
+ else
+ b->yy_buf_size *= 2;
+
+ b->yy_ch_buf = (char *)
+ /* Include room in for 2 EOB chars. */
+ yyrealloc( (void *) b->yy_ch_buf,
+ (yy_size_t) (b->yy_buf_size + 2) );
+ }
+ else
+ /* Can't grow it, we don't own it. */
+ b->yy_ch_buf = NULL;
+
+ if ( ! b->yy_ch_buf )
+ YY_FATAL_ERROR(
+ "fatal error - scanner input buffer overflow" );
+
+ (yy_c_buf_p) = &b->yy_ch_buf[yy_c_buf_p_offset];
+
+ num_to_read = YY_CURRENT_BUFFER_LVALUE->yy_buf_size -
+ number_to_move - 1;
+
+ }
+
+ if ( num_to_read > YY_READ_BUF_SIZE )
+ num_to_read = YY_READ_BUF_SIZE;
+
+ /* Read in more data. */
+ YY_INPUT( (&YY_CURRENT_BUFFER_LVALUE->yy_ch_buf[number_to_move]),
+ (yy_n_chars), num_to_read );
+
+ YY_CURRENT_BUFFER_LVALUE->yy_n_chars = (yy_n_chars);
+ }
+
+ if ( (yy_n_chars) == 0 )
+ {
+ if ( number_to_move == YY_MORE_ADJ )
+ {
+ ret_val = EOB_ACT_END_OF_FILE;
+ yyrestart( yyin );
+ }
+
+ else
+ {
+ ret_val = EOB_ACT_LAST_MATCH;
+ YY_CURRENT_BUFFER_LVALUE->yy_buffer_status =
+ YY_BUFFER_EOF_PENDING;
+ }
+ }
+
+ else
+ ret_val = EOB_ACT_CONTINUE_SCAN;
+
+ if (((yy_n_chars) + number_to_move) > YY_CURRENT_BUFFER_LVALUE->yy_buf_size) {
+ /* Extend the array by 50%, plus the number we really need. */
+ int new_size = (yy_n_chars) + number_to_move + ((yy_n_chars) >> 1);
+ YY_CURRENT_BUFFER_LVALUE->yy_ch_buf = (char *) yyrealloc(
+ (void *) YY_CURRENT_BUFFER_LVALUE->yy_ch_buf, (yy_size_t) new_size );
+ if ( ! YY_CURRENT_BUFFER_LVALUE->yy_ch_buf )
+ YY_FATAL_ERROR( "out of dynamic memory in yy_get_next_buffer()" );
+ /* "- 2" to take care of EOB's */
+ YY_CURRENT_BUFFER_LVALUE->yy_buf_size = (int) (new_size - 2);
+ }
+
+ (yy_n_chars) += number_to_move;
+ YY_CURRENT_BUFFER_LVALUE->yy_ch_buf[(yy_n_chars)] = YY_END_OF_BUFFER_CHAR;
+ YY_CURRENT_BUFFER_LVALUE->yy_ch_buf[(yy_n_chars) + 1] = YY_END_OF_BUFFER_CHAR;
+
+ (yytext_ptr) = &YY_CURRENT_BUFFER_LVALUE->yy_ch_buf[0];
+
+ return ret_val;
+}
+
+/* yy_get_previous_state - get the state just before the EOB char was reached */
+
+ static yy_state_type yy_get_previous_state (void)
+{
+ yy_state_type yy_current_state;
+ char *yy_cp;
+
+ yy_current_state = (yy_start);
+
+ for ( yy_cp = (yytext_ptr) + YY_MORE_ADJ; yy_cp < (yy_c_buf_p); ++yy_cp )
+ {
+ YY_CHAR yy_c = (*yy_cp ? yy_ec[YY_SC_TO_UI(*yy_cp)] : 1);
+ if ( yy_accept[yy_current_state] )
+ {
+ (yy_last_accepting_state) = yy_current_state;
+ (yy_last_accepting_cpos) = yy_cp;
+ }
+ while ( yy_chk[yy_base[yy_current_state] + yy_c] != yy_current_state )
+ {
+ yy_current_state = (int) yy_def[yy_current_state];
+ if ( yy_current_state >= 75 )
+ yy_c = yy_meta[yy_c];
+ }
+ yy_current_state = yy_nxt[yy_base[yy_current_state] + yy_c];
+ }
+
+ return yy_current_state;
+}
+
+/* yy_try_NUL_trans - try to make a transition on the NUL character
+ *
+ * synopsis
+ * next_state = yy_try_NUL_trans( current_state );
+ */
+ static yy_state_type yy_try_NUL_trans (yy_state_type yy_current_state )
+{
+ int yy_is_jam;
+ char *yy_cp = (yy_c_buf_p);
+
+ YY_CHAR yy_c = 1;
+ if ( yy_accept[yy_current_state] )
+ {
+ (yy_last_accepting_state) = yy_current_state;
+ (yy_last_accepting_cpos) = yy_cp;
+ }
+ while ( yy_chk[yy_base[yy_current_state] + yy_c] != yy_current_state )
+ {
+ yy_current_state = (int) yy_def[yy_current_state];
+ if ( yy_current_state >= 75 )
+ yy_c = yy_meta[yy_c];
+ }
+ yy_current_state = yy_nxt[yy_base[yy_current_state] + yy_c];
+ yy_is_jam = (yy_current_state == 74);
+
+ return yy_is_jam ? 0 : yy_current_state;
+}
+
+#ifndef YY_NO_UNPUT
+
+ static void yyunput (int c, char * yy_bp )
+{
+ char *yy_cp;
+
+ yy_cp = (yy_c_buf_p);
+
+ /* undo effects of setting up yytext */
+ *yy_cp = (yy_hold_char);
+
+ if ( yy_cp < YY_CURRENT_BUFFER_LVALUE->yy_ch_buf + 2 )
+ { /* need to shift things up to make room */
+ /* +2 for EOB chars. */
+ int number_to_move = (yy_n_chars) + 2;
+ char *dest = &YY_CURRENT_BUFFER_LVALUE->yy_ch_buf[
+ YY_CURRENT_BUFFER_LVALUE->yy_buf_size + 2];
+ char *source =
+ &YY_CURRENT_BUFFER_LVALUE->yy_ch_buf[number_to_move];
+
+ while ( source > YY_CURRENT_BUFFER_LVALUE->yy_ch_buf )
+ *--dest = *--source;
+
+ yy_cp += (int) (dest - source);
+ yy_bp += (int) (dest - source);
+ YY_CURRENT_BUFFER_LVALUE->yy_n_chars =
+ (yy_n_chars) = (int) YY_CURRENT_BUFFER_LVALUE->yy_buf_size;
+
+ if ( yy_cp < YY_CURRENT_BUFFER_LVALUE->yy_ch_buf + 2 )
+ YY_FATAL_ERROR( "flex scanner push-back overflow" );
+ }
+
+ *--yy_cp = (char) c;
+
+ (yytext_ptr) = yy_bp;
+ (yy_hold_char) = *yy_cp;
+ (yy_c_buf_p) = yy_cp;
+}
+
+#endif
+
+#ifndef YY_NO_INPUT
+#ifdef __cplusplus
+ static int yyinput (void)
+#else
+ static int input (void)
+#endif
+
+{
+ int c;
+
+ *(yy_c_buf_p) = (yy_hold_char);
+
+ if ( *(yy_c_buf_p) == YY_END_OF_BUFFER_CHAR )
+ {
+ /* yy_c_buf_p now points to the character we want to return.
+ * If this occurs *before* the EOB characters, then it's a
+ * valid NUL; if not, then we've hit the end of the buffer.
+ */
+ if ( (yy_c_buf_p) < &YY_CURRENT_BUFFER_LVALUE->yy_ch_buf[(yy_n_chars)] )
+ /* This was really a NUL. */
+ *(yy_c_buf_p) = '\0';
+
+ else
+ { /* need more input */
+ int offset = (int) ((yy_c_buf_p) - (yytext_ptr));
+ ++(yy_c_buf_p);
+
+ switch ( yy_get_next_buffer( ) )
+ {
+ case EOB_ACT_LAST_MATCH:
+ /* This happens because yy_g_n_b()
+ * sees that we've accumulated a
+ * token and flags that we need to
+ * try matching the token before
+ * proceeding. But for input(),
+ * there's no matching to consider.
+ * So convert the EOB_ACT_LAST_MATCH
+ * to EOB_ACT_END_OF_FILE.
+ */
+
+ /* Reset buffer status. */
+ yyrestart( yyin );
+
+ /*FALLTHROUGH*/
+
+ case EOB_ACT_END_OF_FILE:
+ {
+ if ( yywrap( ) )
+ return 0;
+
+ if ( ! (yy_did_buffer_switch_on_eof) )
+ YY_NEW_FILE;
+#ifdef __cplusplus
+ return yyinput();
+#else
+ return input();
+#endif
+ }
+
+ case EOB_ACT_CONTINUE_SCAN:
+ (yy_c_buf_p) = (yytext_ptr) + offset;
+ break;
+ }
+ }
+ }
+
+ c = *(unsigned char *) (yy_c_buf_p); /* cast for 8-bit char's */
+ *(yy_c_buf_p) = '\0'; /* preserve yytext */
+ (yy_hold_char) = *++(yy_c_buf_p);
+
+ return c;
+}
+#endif /* ifndef YY_NO_INPUT */
+
+/** Immediately switch to a different input stream.
+ * @param input_file A readable stream.
+ *
+ * @note This function does not reset the start condition to @c INITIAL .
+ */
+ void yyrestart (FILE * input_file )
+{
+
+ if ( ! YY_CURRENT_BUFFER ){
+ yyensure_buffer_stack ();
+ YY_CURRENT_BUFFER_LVALUE =
+ yy_create_buffer( yyin, YY_BUF_SIZE );
+ }
+
+ yy_init_buffer( YY_CURRENT_BUFFER, input_file );
+ yy_load_buffer_state( );
+}
+
+/** Switch to a different input buffer.
+ * @param new_buffer The new input buffer.
+ *
+ */
+ void yy_switch_to_buffer (YY_BUFFER_STATE new_buffer )
+{
+
+ /* TODO. We should be able to replace this entire function body
+ * with
+ * yypop_buffer_state();
+ * yypush_buffer_state(new_buffer);
+ */
+ yyensure_buffer_stack ();
+ if ( YY_CURRENT_BUFFER == new_buffer )
+ return;
+
+ if ( YY_CURRENT_BUFFER )
+ {
+ /* Flush out information for old buffer. */
+ *(yy_c_buf_p) = (yy_hold_char);
+ YY_CURRENT_BUFFER_LVALUE->yy_buf_pos = (yy_c_buf_p);
+ YY_CURRENT_BUFFER_LVALUE->yy_n_chars = (yy_n_chars);
+ }
+
+ YY_CURRENT_BUFFER_LVALUE = new_buffer;
+ yy_load_buffer_state( );
+
+ /* We don't actually know whether we did this switch during
+ * EOF (yywrap()) processing, but the only time this flag
+ * is looked at is after yywrap() is called, so it's safe
+ * to go ahead and always set it.
+ */
+ (yy_did_buffer_switch_on_eof) = 1;
+}
+
+static void yy_load_buffer_state (void)
+{
+ (yy_n_chars) = YY_CURRENT_BUFFER_LVALUE->yy_n_chars;
+ (yytext_ptr) = (yy_c_buf_p) = YY_CURRENT_BUFFER_LVALUE->yy_buf_pos;
+ yyin = YY_CURRENT_BUFFER_LVALUE->yy_input_file;
+ (yy_hold_char) = *(yy_c_buf_p);
+}
+
+/** Allocate and initialize an input buffer state.
+ * @param file A readable stream.
+ * @param size The character buffer size in bytes. When in doubt, use @c YY_BUF_SIZE.
+ *
+ * @return the allocated buffer state.
+ */
+ YY_BUFFER_STATE yy_create_buffer (FILE * file, int size )
+{
+ YY_BUFFER_STATE b;
+
+ b = (YY_BUFFER_STATE) yyalloc( sizeof( struct yy_buffer_state ) );
+ if ( ! b )
+ YY_FATAL_ERROR( "out of dynamic memory in yy_create_buffer()" );
+
+ b->yy_buf_size = size;
+
+ /* yy_ch_buf has to be 2 characters longer than the size given because
+ * we need to put in 2 end-of-buffer characters.
+ */
+ b->yy_ch_buf = (char *) yyalloc( (yy_size_t) (b->yy_buf_size + 2) );
+ if ( ! b->yy_ch_buf )
+ YY_FATAL_ERROR( "out of dynamic memory in yy_create_buffer()" );
+
+ b->yy_is_our_buffer = 1;
+
+ yy_init_buffer( b, file );
+
+ return b;
+}
+
+/** Destroy the buffer.
+ * @param b a buffer created with yy_create_buffer()
+ *
+ */
+ void yy_delete_buffer (YY_BUFFER_STATE b )
+{
+
+ if ( ! b )
+ return;
+
+ if ( b == YY_CURRENT_BUFFER ) /* Not sure if we should pop here. */
+ YY_CURRENT_BUFFER_LVALUE = (YY_BUFFER_STATE) 0;
+
+ if ( b->yy_is_our_buffer )
+ yyfree( (void *) b->yy_ch_buf );
+
+ yyfree( (void *) b );
+}
+
+/* Initializes or reinitializes a buffer.
+ * This function is sometimes called more than once on the same buffer,
+ * such as during a yyrestart() or at EOF.
+ */
+ static void yy_init_buffer (YY_BUFFER_STATE b, FILE * file )
+
+{
+ int oerrno = errno;
+
+ yy_flush_buffer( b );
+
+ b->yy_input_file = file;
+ b->yy_fill_buffer = 1;
+
+ /* If b is the current buffer, then yy_init_buffer was _probably_
+ * called from yyrestart() or through yy_get_next_buffer.
+ * In that case, we don't want to reset the lineno or column.
+ */
+ if (b != YY_CURRENT_BUFFER){
+ b->yy_bs_lineno = 1;
+ b->yy_bs_column = 0;
+ }
+
+ b->yy_is_interactive = file ? (isatty( fileno(file) ) > 0) : 0;
+
+ errno = oerrno;
+}
+
+/** Discard all buffered characters. On the next scan, YY_INPUT will be called.
+ * @param b the buffer state to be flushed, usually @c YY_CURRENT_BUFFER.
+ *
+ */
+ void yy_flush_buffer (YY_BUFFER_STATE b )
+{
+ if ( ! b )
+ return;
+
+ b->yy_n_chars = 0;
+
+ /* We always need two end-of-buffer characters. The first causes
+ * a transition to the end-of-buffer state. The second causes
+ * a jam in that state.
+ */
+ b->yy_ch_buf[0] = YY_END_OF_BUFFER_CHAR;
+ b->yy_ch_buf[1] = YY_END_OF_BUFFER_CHAR;
+
+ b->yy_buf_pos = &b->yy_ch_buf[0];
+
+ b->yy_at_bol = 1;
+ b->yy_buffer_status = YY_BUFFER_NEW;
+
+ if ( b == YY_CURRENT_BUFFER )
+ yy_load_buffer_state( );
+}
+
+/** Pushes the new state onto the stack. The new state becomes
+ * the current state. This function will allocate the stack
+ * if necessary.
+ * @param new_buffer The new state.
+ *
+ */
+void yypush_buffer_state (YY_BUFFER_STATE new_buffer )
+{
+ if (new_buffer == NULL)
+ return;
+
+ yyensure_buffer_stack();
+
+ /* This block is copied from yy_switch_to_buffer. */
+ if ( YY_CURRENT_BUFFER )
+ {
+ /* Flush out information for old buffer. */
+ *(yy_c_buf_p) = (yy_hold_char);
+ YY_CURRENT_BUFFER_LVALUE->yy_buf_pos = (yy_c_buf_p);
+ YY_CURRENT_BUFFER_LVALUE->yy_n_chars = (yy_n_chars);
+ }
+
+ /* Only push if top exists. Otherwise, replace top. */
+ if (YY_CURRENT_BUFFER)
+ (yy_buffer_stack_top)++;
+ YY_CURRENT_BUFFER_LVALUE = new_buffer;
+
+ /* copied from yy_switch_to_buffer. */
+ yy_load_buffer_state( );
+ (yy_did_buffer_switch_on_eof) = 1;
+}
+
+/** Removes and deletes the top of the stack, if present.
+ * The next element becomes the new top.
+ *
+ */
+void yypop_buffer_state (void)
+{
+ if (!YY_CURRENT_BUFFER)
+ return;
+
+ yy_delete_buffer(YY_CURRENT_BUFFER );
+ YY_CURRENT_BUFFER_LVALUE = NULL;
+ if ((yy_buffer_stack_top) > 0)
+ --(yy_buffer_stack_top);
+
+ if (YY_CURRENT_BUFFER) {
+ yy_load_buffer_state( );
+ (yy_did_buffer_switch_on_eof) = 1;
+ }
+}
+
+/* Allocates the stack if it does not exist.
+ * Guarantees space for at least one push.
+ */
+static void yyensure_buffer_stack (void)
+{
+ yy_size_t num_to_alloc;
+
+ if (!(yy_buffer_stack)) {
+
+ /* First allocation is just for 2 elements, since we don't know if this
+ * scanner will even need a stack. We use 2 instead of 1 to avoid an
+ * immediate realloc on the next call.
+ */
+ num_to_alloc = 1; /* After all that talk, this was set to 1 anyways... */
+ (yy_buffer_stack) = (struct yy_buffer_state**)yyalloc
+ (num_to_alloc * sizeof(struct yy_buffer_state*)
+ );
+ if ( ! (yy_buffer_stack) )
+ YY_FATAL_ERROR( "out of dynamic memory in yyensure_buffer_stack()" );
+
+ memset((yy_buffer_stack), 0, num_to_alloc * sizeof(struct yy_buffer_state*));
+
+ (yy_buffer_stack_max) = num_to_alloc;
+ (yy_buffer_stack_top) = 0;
+ return;
+ }
+
+ if ((yy_buffer_stack_top) >= ((yy_buffer_stack_max)) - 1){
+
+ /* Increase the buffer to prepare for a possible push. */
+ yy_size_t grow_size = 8 /* arbitrary grow size */;
+
+ num_to_alloc = (yy_buffer_stack_max) + grow_size;
+ (yy_buffer_stack) = (struct yy_buffer_state**)yyrealloc
+ ((yy_buffer_stack),
+ num_to_alloc * sizeof(struct yy_buffer_state*)
+ );
+ if ( ! (yy_buffer_stack) )
+ YY_FATAL_ERROR( "out of dynamic memory in yyensure_buffer_stack()" );
+
+ /* zero only the new slots.*/
+ memset((yy_buffer_stack) + (yy_buffer_stack_max), 0, grow_size * sizeof(struct yy_buffer_state*));
+ (yy_buffer_stack_max) = num_to_alloc;
+ }
+}
+
+/** Setup the input buffer state to scan directly from a user-specified character buffer.
+ * @param base the character buffer
+ * @param size the size in bytes of the character buffer
+ *
+ * @return the newly allocated buffer state object.
+ */
+YY_BUFFER_STATE yy_scan_buffer (char * base, yy_size_t size )
+{
+ YY_BUFFER_STATE b;
+
+ if ( size < 2 ||
+ base[size-2] != YY_END_OF_BUFFER_CHAR ||
+ base[size-1] != YY_END_OF_BUFFER_CHAR )
+ /* They forgot to leave room for the EOB's. */
+ return NULL;
+
+ b = (YY_BUFFER_STATE) yyalloc( sizeof( struct yy_buffer_state ) );
+ if ( ! b )
+ YY_FATAL_ERROR( "out of dynamic memory in yy_scan_buffer()" );
+
+ b->yy_buf_size = (int) (size - 2); /* "- 2" to take care of EOB's */
+ b->yy_buf_pos = b->yy_ch_buf = base;
+ b->yy_is_our_buffer = 0;
+ b->yy_input_file = NULL;
+ b->yy_n_chars = b->yy_buf_size;
+ b->yy_is_interactive = 0;
+ b->yy_at_bol = 1;
+ b->yy_fill_buffer = 0;
+ b->yy_buffer_status = YY_BUFFER_NEW;
+
+ yy_switch_to_buffer( b );
+
+ return b;
+}
+
+/** Setup the input buffer state to scan a string. The next call to yylex() will
+ * scan from a @e copy of @a str.
+ * @param yystr a NUL-terminated string to scan
+ *
+ * @return the newly allocated buffer state object.
+ * @note If you want to scan bytes that may contain NUL values, then use
+ * yy_scan_bytes() instead.
+ */
+YY_BUFFER_STATE yy_scan_string (const char * yystr )
+{
+
+ return yy_scan_bytes( yystr, (int) strlen(yystr) );
+}
+
+/** Setup the input buffer state to scan the given bytes. The next call to yylex() will
+ * scan from a @e copy of @a bytes.
+ * @param yybytes the byte buffer to scan
+ * @param _yybytes_len the number of bytes in the buffer pointed to by @a bytes.
+ *
+ * @return the newly allocated buffer state object.
+ */
+YY_BUFFER_STATE yy_scan_bytes (const char * yybytes, int _yybytes_len )
+{
+ YY_BUFFER_STATE b;
+ char *buf;
+ yy_size_t n;
+ int i;
+
+ /* Get memory for full buffer, including space for trailing EOB's. */
+ n = (yy_size_t) (_yybytes_len + 2);
+ buf = (char *) yyalloc( n );
+ if ( ! buf )
+ YY_FATAL_ERROR( "out of dynamic memory in yy_scan_bytes()" );
+
+ for ( i = 0; i < _yybytes_len; ++i )
+ buf[i] = yybytes[i];
+
+ buf[_yybytes_len] = buf[_yybytes_len+1] = YY_END_OF_BUFFER_CHAR;
+
+ b = yy_scan_buffer( buf, n );
+ if ( ! b )
+ YY_FATAL_ERROR( "bad buffer in yy_scan_bytes()" );
+
+ /* It's okay to grow etc. this buffer, and we should throw it
+ * away when we're done.
+ */
+ b->yy_is_our_buffer = 1;
+
+ return b;
+}
+
+#ifndef YY_EXIT_FAILURE
+#define YY_EXIT_FAILURE 2
+#endif
+
+static void yynoreturn yy_fatal_error (const char* msg )
+{
+ fprintf( stderr, "%s\n", msg );
+ exit( YY_EXIT_FAILURE );
+}
+
+/* Redefine yyless() so it works in section 3 code. */
+
+#undef yyless
+#define yyless(n) \
+ do \
+ { \
+ /* Undo effects of setting up yytext. */ \
+ int yyless_macro_arg = (n); \
+ YY_LESS_LINENO(yyless_macro_arg);\
+ yytext[yyleng] = (yy_hold_char); \
+ (yy_c_buf_p) = yytext + yyless_macro_arg; \
+ (yy_hold_char) = *(yy_c_buf_p); \
+ *(yy_c_buf_p) = '\0'; \
+ yyleng = yyless_macro_arg; \
+ } \
+ while ( 0 )
+
+/* Accessor methods (get/set functions) to struct members. */
+
+/** Get the current line number.
+ *
+ */
+int yyget_lineno (void)
+{
+
+ return yylineno;
+}
+
+/** Get the input stream.
+ *
+ */
+FILE *yyget_in (void)
+{
+ return yyin;
+}
+
+/** Get the output stream.
+ *
+ */
+FILE *yyget_out (void)
+{
+ return yyout;
+}
+
+/** Get the length of the current token.
+ *
+ */
+int yyget_leng (void)
+{
+ return yyleng;
+}
+
+/** Get the current token.
+ *
+ */
+
+char *yyget_text (void)
+{
+ return yytext;
+}
+
+/** Set the current line number.
+ * @param _line_number line number
+ *
+ */
+void yyset_lineno (int _line_number )
+{
+
+ yylineno = _line_number;
+}
+
+/** Set the input stream. This does not discard the current
+ * input buffer.
+ * @param _in_str A readable stream.
+ *
+ * @see yy_switch_to_buffer
+ */
+void yyset_in (FILE * _in_str )
+{
+ yyin = _in_str ;
+}
+
+void yyset_out (FILE * _out_str )
+{
+ yyout = _out_str ;
+}
+
+int yyget_debug (void)
+{
+ return yy_flex_debug;
+}
+
+void yyset_debug (int _bdebug )
+{
+ yy_flex_debug = _bdebug ;
+}
+
+static int yy_init_globals (void)
+{
+ /* Initialization is the same as for the non-reentrant scanner.
+ * This function is called from yylex_destroy(), so don't allocate here.
+ */
+
+ (yy_buffer_stack) = NULL;
+ (yy_buffer_stack_top) = 0;
+ (yy_buffer_stack_max) = 0;
+ (yy_c_buf_p) = NULL;
+ (yy_init) = 0;
+ (yy_start) = 0;
+
+/* Defined in main.c */
+#ifdef YY_STDINIT
+ yyin = stdin;
+ yyout = stdout;
+#else
+ yyin = NULL;
+ yyout = NULL;
+#endif
+
+ /* For future reference: Set errno on error, since we are called by
+ * yylex_init()
+ */
+ return 0;
+}
+
+/* yylex_destroy is for both reentrant and non-reentrant scanners. */
+int yylex_destroy (void)
+{
+
+ /* Pop the buffer stack, destroying each element. */
+ while(YY_CURRENT_BUFFER){
+ yy_delete_buffer( YY_CURRENT_BUFFER );
+ YY_CURRENT_BUFFER_LVALUE = NULL;
+ yypop_buffer_state();
+ }
+
+ /* Destroy the stack itself. */
+ yyfree((yy_buffer_stack) );
+ (yy_buffer_stack) = NULL;
+
+ /* Reset the globals. This is important in a non-reentrant scanner so the next time
+ * yylex() is called, initialization will occur. */
+ yy_init_globals( );
+
+ return 0;
+}
+
+/*
+ * Internal utility routines.
+ */
+
+#ifndef yytext_ptr
+static void yy_flex_strncpy (char* s1, const char * s2, int n )
+{
+
+ int i;
+ for ( i = 0; i < n; ++i )
+ s1[i] = s2[i];
+}
+#endif
+
+#ifdef YY_NEED_STRLEN
+static int yy_flex_strlen (const char * s )
+{
+ int n;
+ for ( n = 0; s[n]; ++n )
+ ;
+
+ return n;
+}
+#endif
+
+void *yyalloc (yy_size_t size )
+{
+ return malloc(size);
+}
+
+void *yyrealloc (void * ptr, yy_size_t size )
+{
+
+ /* The cast to (char *) in the following accommodates both
+ * implementations that use char* generic pointers, and those
+ * that use void* generic pointers. It works with the latter
+ * because both ANSI C and C++ allow castless assignment from
+ * any pointer type to void*, and deal with argument conversions
+ * as though doing an assignment.
+ */
+ return realloc(ptr, size);
+}
+
+void yyfree (void * ptr )
+{
+ free( (char *) ptr ); /* see yyrealloc() for (char *) cast */
+}
+
+#define YYTABLES_NAME "yytables"
+
+#line 97 "adv.flex"
+
+
+/*
+ * consumeLine - reads a line into a buffer, it then pushes back the whole
+ * line except the initial \n.
+ */
+
+static void consumeLine (void)
+{
+ if (currentLine->linelen<yyleng) {
+ currentLine->linebuf = (char *)realloc (currentLine->linebuf, yyleng);
+ currentLine->linelen = yyleng;
+ }
+ strcpy(currentLine->linebuf, yytext+1); /* copy all except the initial \n */
+ lineno++;
+ currentLine->actualline = lineno;
+ currentLine->tokenpos=0;
+ currentLine->nextpos=0;
+ yyless(1); /* push back all but the \n */
+}
+
+/*
+ * updatepos - updates the current token position.
+ * Should be used when a rule matches a token.
+ */
+
+static void updatepos (void)
+{
+ currentLine->nextpos = currentLine->tokenpos+yyleng;
+ currentLine->toklen = yyleng;
+}
+
+/*
+ * skippos - skips over this token. This function should be called
+ * if we are not returning and thus not calling getToken.
+ */
+
+static void skippos (void)
+{
+ currentLine->tokenpos = currentLine->nextpos;
+}
+
+/*
+ * initLine - initializes a currentLine
+ */
+
+static void initLine (void)
+{
+ currentLine = (struct lineInfo *)malloc (sizeof(struct lineInfo));
+
+ if (currentLine == NULL)
+ perror("malloc");
+ currentLine->linebuf = NULL;
+ currentLine->linelen = 0;
+ currentLine->tokenpos = 0;
+ currentLine->toklen = 0;
+ currentLine->nextpos = 0;
+ currentLine->actualline = lineno;
+}
+
+/*
+ * resetpos - resets the position of the next token to the start of the line.
+ */
+
+static void resetpos (void)
+{
+ if (currentLine != NULL)
+ currentLine->nextpos = 0;
+}
+
+/*
+ * advflex_GetToken - returns a new token.
+ */
+
+char *advflex_GetToken (void)
+{
+ if (currentLine == NULL)
+ initLine();
+ currentLine->tokenpos = currentLine->nextpos;
+ yylex();
+}
+
+void advflex_error (const char *s)
+{
+ if (currentLine != NULL) {
+ printf("%s:%d:%s\n", filename, currentLine->actualline, s);
+ printf("%s\n", currentLine->linebuf);
+# if 0
+ printf("%*s%*s\n", currentLine->nextpos, " ", currentLine->toklen, "^");
+# endif
+ }
+}
+
+/*
+ * OpenSource - returns TRUE if file, s, can be opened and
+ * all tokens are taken from this file.
+ */
+
+int advflex_OpenSource (char *s)
+{
+ FILE *f = fopen(s, "r");
+
+ if (f == NULL)
+ return FALSE;
+ else {
+ yy_delete_buffer(YY_CURRENT_BUFFER);
+ yy_switch_to_buffer(yy_create_buffer(f, YY_BUF_SIZE));
+ filename = strdup(s);
+ lineno =1;
+ if (currentLine != NULL)
+ currentLine->actualline = lineno;
+ return TRUE;
+ }
+}
+
+/*
+ * CloseSource - provided for semantic sugar
+ */
+
+void advflex_CloseSource (void)
+{
+}
+
+/*
+ * advflex_GetLineNo - returns the current line number.
+ */
+
+int advflex_GetLineNo (void)
+{
+ if (currentLine != NULL)
+ return currentLine->actualline;
+ else
+ return 0;
+}
+
+/*
+ * yywrap is called when end of file is seen. We push an eof token
+ * and tell the lexical analysis to stop.
+ */
+
+int yywrap (void)
+{
+ updatepos(); return 1;
+}
+
+void _M2_advflex_init (int, char *, char *)
+{
+}
+
+void _M2_advflex_finish (int, char *, char *)
+{
+}
+
+void _M2_advflex_ctor (void)
+{
+}
+
+#if 0
+main () {
+ char *s;
+
+ if (advflex_OpenSource("../maps/glover")) {
+ s = (char *)advflex_GetToken();
+ while (s != NULL) {
+ advflex_error(s);
+ s = (char *)advflex_GetToken();
+ }
+ }
+}
+#endif
+
diff --git a/gcc/testsuite/gm2/projects/pim/run/pass/tower/advflex.def b/gcc/testsuite/gm2/projects/pim/run/pass/tower/advflex.def
new file mode 100644
index 0000000..49e50c6
--- /dev/null
+++ b/gcc/testsuite/gm2/projects/pim/run/pass/tower/advflex.def
@@ -0,0 +1,32 @@
+DEFINITION MODULE advflex ;
+
+(*
+ Title : advflex
+ Author : Gaius Mulley
+ System : GNU Modula-2
+ Date : Sun Jul 17 12:32:58 2005
+ Revision : $Version$
+ Description: provides access to basic lexical functions.
+*)
+
+FROM SYSTEM IMPORT ADDRESS ;
+EXPORT QUALIFIED toktype, OpenSource, CloseSource, error, GetToken, GetLineNo,
+ currenttoken, currentinteger ;
+
+TYPE
+ toktype = (eoftok, roomtok, doortok, walltok, treasuretok, attok,
+ leadstok, totok, statustok, closedtok, opentok, secrettok,
+ istok, endtok, enddottok, integertok, randomizetok) ;
+
+VAR
+ currenttoken : toktype ;
+ currentinteger: INTEGER ;
+
+PROCEDURE OpenSource (s: ADDRESS) : BOOLEAN ;
+PROCEDURE CloseSource ;
+PROCEDURE GetLineNo () : CARDINAL ;
+PROCEDURE error (s: ADDRESS) ;
+PROCEDURE GetToken ;
+
+
+END advflex.
diff --git a/gcc/testsuite/gm2/projects/pim/run/pass/tower/projects-pim-run-pass-tower.exp b/gcc/testsuite/gm2/projects/pim/run/pass/tower/projects-pim-run-pass-tower.exp
new file mode 100644
index 0000000..303672e
--- /dev/null
+++ b/gcc/testsuite/gm2/projects/pim/run/pass/tower/projects-pim-run-pass-tower.exp
@@ -0,0 +1,110 @@
+# Expect driver script for GCC Regression Tests
+# Copyright (C) 2023 Free Software Foundation, Inc.
+
+# This program 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 of the License, or
+# (at your option) any later version.
+#
+# This program 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 GCC; see the file COPYING3. If not see
+# <http://www.gnu.org/licenses/>.
+
+# This file was written by Gaius Mulley (gaius.mulley@southwales.ac.uk)
+# for GNU Modula-2.
+
+if $tracelevel then {
+ strace $tracelevel
+}
+
+# load support procs
+# load_lib gm2-torture.exp
+load_lib gm2-simple.exp
+
+gm2_init_cor "${srcdir}/${subdir}" -g
+gm2_link_obj "advflex.o AdvCmd.o AdvIntroduction.o AdvMap.o AdvMath.o AdvParse.o AdvSound.o AdvSystem.o AdvTreasure.o AdvUtil.o DrawG.o DrawL.o Lock.o ProcArgs.o Screen.o Window.o SocketControl.o"
+
+
+proc gm2-local-exec { testcase execname mapfile } {
+ global tool;
+ # puts stderr "about to run: ${execname} ${mapfile}"
+
+ set pid [fork]
+ switch $pid {
+ -1 {
+ puts stderr "fork failed."
+ }
+ 0 {
+ # puts stderr "child running ${execname} ${mapfile}"
+ set result [gm2_load "$execname" "$mapfile" ""];
+ exit 0
+ }
+ default {
+ # puts stderr "parent attempting to connect to the child"
+ set port 7000;
+ # wait for 3 seconds before attempting to connect.
+ sleep 3
+ # verbose "parent attempting to connect to ${execname} ${mapfile}" 1
+ if {[catch {set chan [socket 127.0.0.1 ${port}]
+ puts ${chan} "quit\r"
+ flush ${chan}
+ close ${chan} }]} {
+ verbose "parent unable to connect to ${execname} ${mapfile}" 1
+ puts stderr "parent unable to connect to ${execname} ${mapfile}"
+ ${tool}_fail ${testcase} ${mapfile}
+ } else {
+ # verbose "parent successfully able to connect to ${execname} ${mapfile}" 1
+ # puts stderr "parent successfully connected to ${execname} ${mapfile}"
+ ${tool}_pass ${testcase} ${mapfile}
+ }
+ remote_file build delete $execname;
+ # verbose "killing off child after successful test" 1
+ puts stderr "parent successfully connected to child"
+ puts stderr "now tidying up by killing the child"
+ puts stderr "ignore next warning about sig term"
+ set res [exec kill ${pid}];
+ }
+ }
+}
+
+# If we want these to be re-built for each torture option we need some different
+# logic.
+gm2_target_compile $srcdir/$subdir/AdvCmd.mod AdvCmd.o object "-c -g -I$srcdir/$subdir/"
+gm2_target_compile $srcdir/$subdir/AdvIntroduction.mod AdvIntroduction.o object "-c -g -I$srcdir/$subdir/"
+gm2_target_compile $srcdir/$subdir/AdvMap.mod AdvMap.o object "-c -g -I$srcdir/$subdir/"
+gm2_target_compile $srcdir/$subdir/AdvMath.mod AdvMath.o object "-c -g -I$srcdir/$subdir/"
+gm2_target_compile $srcdir/$subdir/AdvParse.mod AdvParse.o object "-c -g -I$srcdir/$subdir/"
+gm2_target_compile $srcdir/$subdir/AdvSound.mod AdvSound.o object "-c -g -I$srcdir/$subdir/"
+gm2_target_compile $srcdir/$subdir/AdvSystem.mod AdvSystem.o object "-c -g -I$srcdir/$subdir/"
+gm2_target_compile $srcdir/$subdir/AdvTreasure.mod AdvTreasure.o object "-c -g -I$srcdir/$subdir/"
+gm2_target_compile $srcdir/$subdir/AdvUtil.mod AdvUtil.o object "-c -g -I$srcdir/$subdir/"
+gm2_target_compile $srcdir/$subdir/DrawG.mod DrawG.o object "-c -g -I$srcdir/$subdir/"
+gm2_target_compile $srcdir/$subdir/DrawL.mod DrawL.o object "-c -g -I$srcdir/$subdir/"
+gm2_target_compile $srcdir/$subdir/Lock.mod Lock.o object "-c -g -I$srcdir/$subdir/"
+gm2_target_compile $srcdir/$subdir/ProcArgs.mod ProcArgs.o object "-c -g -I$srcdir/$subdir/"
+gm2_target_compile $srcdir/$subdir/Screen.mod Screen.o object "-c -g -I$srcdir/$subdir/"
+gm2_target_compile $srcdir/$subdir/Window.mod Window.o object "-c -g -I$srcdir/$subdir/"
+
+set output [target_compile $srcdir/$subdir/SocketControl.c SocketControl.o object "-g"]
+set output [target_compile $srcdir/$subdir/advflex.c advflex.o object "-g"]
+
+foreach testcase [lsort [glob -nocomplain $srcdir/$subdir/Dungeon.mod]] {
+ # If we're only testing specific files and this isn't one of them, skip it.
+ if ![runtest_file_p $runtests $testcase] then {
+ continue
+ }
+ set gm2_keep_executable 1
+ # gm2-torture-execute $testcase "" "pass"
+ gm2-simple-execute $testcase "" ""
+ set gm2_keep_executable 0
+
+ global tmpdir;
+ set executable $tmpdir/[file tail [file rootname $testcase].x];
+ gm2-local-exec ${testcase} ${executable} $srcdir/$subdir/star
+ remote_file build delete ${executable};
+}
diff --git a/gcc/testsuite/gm2/projects/pim/run/pass/tower/star b/gcc/testsuite/gm2/projects/pim/run/pass/tower/star
new file mode 100644
index 0000000..4bdae85
--- /dev/null
+++ b/gcc/testsuite/gm2/projects/pim/run/pass/tower/star
@@ -0,0 +1,71 @@
+ROOM 1
+
+WALL 1 1 1 20
+WALL 1 20 20 20
+WALL 20 20 20 1
+WALL 20 1 1 1
+
+DOOR 9 20 12 20 STATUS CLOSED LEADS TO 5
+DOOR 20 9 20 12 STATUS CLOSED LEADS TO 5
+END
+
+ROOM 2
+
+WALL 26 1 45 1
+WALL 45 1 45 20
+WALL 45 20 26 20
+WALL 26 20 26 1
+
+DOOR 26 9 26 12 STATUS CLOSED LEADS TO 5
+DOOR 34 20 37 20 STATUS CLOSED LEADS TO 5
+END
+
+
+ROOM 3
+
+WALL 1 26 20 26
+WALL 20 26 20 45
+WALL 20 45 1 45
+WALL 1 45 1 26
+
+DOOR 9 26 12 26 STATUS CLOSED LEADS TO 5
+DOOR 20 34 20 37 STATUS CLOSED LEADS TO 5
+END
+
+ROOM 4
+
+WALL 26 26 45 26
+WALL 45 26 45 45
+WALL 45 45 26 45
+WALL 26 45 26 26
+
+DOOR 34 26 37 26 STATUS CLOSED LEADS TO 5
+DOOR 26 34 26 37 STATUS CLOSED LEADS TO 5
+END
+
+ROOM 5
+
+WALL 1 20 1 26
+ 1 26 20 26
+ 20 26 20 45
+ 20 45 26 45
+ 26 45 26 26
+ 26 26 45 26
+ 45 26 45 20
+ 45 20 26 20
+ 26 20 26 1
+ 26 1 20 1
+ 20 1 20 20
+ 20 20 1 20
+
+DOOR 9 20 12 20 STATUS CLOSED LEADS TO 1
+DOOR 20 9 20 12 STATUS CLOSED LEADS TO 1
+DOOR 26 9 26 12 STATUS CLOSED LEADS TO 2
+DOOR 34 20 37 20 STATUS CLOSED LEADS TO 2
+DOOR 9 26 12 26 STATUS CLOSED LEADS TO 3
+DOOR 20 34 20 37 STATUS CLOSED LEADS TO 3
+DOOR 34 26 37 26 STATUS CLOSED LEADS TO 4
+DOOR 26 34 26 37 STATUS CLOSED LEADS TO 4
+END
+RANDOMIZE TREASURE 1 3 4 6 7 8 9 10 11 12 14 16 17 18
+END.
diff --git a/gcc/testsuite/gm2/switches/auto-init/fail/switches-auto-init-fail.exp b/gcc/testsuite/gm2/switches/auto-init/fail/switches-auto-init-fail.exp
index 98cf5ff..44b44b4 100644
--- a/gcc/testsuite/gm2/switches/auto-init/fail/switches-auto-init-fail.exp
+++ b/gcc/testsuite/gm2/switches/auto-init/fail/switches-auto-init-fail.exp
@@ -36,7 +36,7 @@ if $tracelevel then {
# load support procs
load_lib gm2-torture.exp
-gm2_init_pim2 "${srcdir}/gm2/switches/auto-init/fail" -fsoft-check-all -O2 -fauto-init
+gm2_init_pim2 "${srcdir}/gm2/switches/auto-init/fail" -fsoft-check-all -O2 -fauto-init -fm2-pathname=- -I${srcdir}/gm2/switches/auto-init/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/switches/check-all/pim2/fail/switches-check-all-pim2-fail.exp b/gcc/testsuite/gm2/switches/check-all/pim2/fail/switches-check-all-pim2-fail.exp
index a59bca0..bd2d723 100644
--- a/gcc/testsuite/gm2/switches/check-all/pim2/fail/switches-check-all-pim2-fail.exp
+++ b/gcc/testsuite/gm2/switches/check-all/pim2/fail/switches-check-all-pim2-fail.exp
@@ -36,7 +36,7 @@ if $tracelevel then {
# load support procs
load_lib gm2-torture.exp
-gm2_init_pim2 "${srcdir}/gm2/switches/check-all/pim2/fail" -fsoft-check-all -O2
+gm2_init_pim2 "${srcdir}/gm2/switches/check-all/pim2/fail" -fsoft-check-all -O2 -g -fm2-pathname=- -I${srcdir}/gm2/switches/check-all/pim2/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/switches/makeall/fail/switches-makeall-fail.exp b/gcc/testsuite/gm2/switches/makeall/fail/switches-makeall-fail.exp
index 32da0ec..42dc3f1 100644
--- a/gcc/testsuite/gm2/switches/makeall/fail/switches-makeall-fail.exp
+++ b/gcc/testsuite/gm2/switches/makeall/fail/switches-makeall-fail.exp
@@ -29,7 +29,7 @@ load_lib gm2-torture.exp
# attempts to use gm2 -fmakeall to build a syntactally incorrect program.
#
-gm2_init "$srcdir/../gm2/gm2-libs $srcdir/gm2/switches/makeall/fail" -fmakeall
+gm2_init "${srcdir}/../gm2/gm2-libs $srcdir/gm2/switches/makeall/fail" -fmakeall
foreach testcase [lsort [glob -nocomplain $srcdir/$subdir/*.mod]] {
diff --git a/gcc/testsuite/gm2/switches/makeall/pass/switches-makeall-pass.exp b/gcc/testsuite/gm2/switches/makeall/pass/switches-makeall-pass.exp
index 41308af..e94d0fd 100644
--- a/gcc/testsuite/gm2/switches/makeall/pass/switches-makeall-pass.exp
+++ b/gcc/testsuite/gm2/switches/makeall/pass/switches-makeall-pass.exp
@@ -24,7 +24,6 @@ if $tracelevel then {
# load support procs
load_lib gm2-torture.exp
-gm2_init "${srcdir}/gm2/switches/makeall/pass" -fmakeall
gm2_init_pim4 "${srcdir}/gm2/switches/makeall/pass"
foreach testcase [lsort [glob -nocomplain $srcdir/$subdir/*.mod]] {
diff --git a/gcc/testsuite/lib/gm2-simple.exp b/gcc/testsuite/lib/gm2-simple.exp
index bafcfd5..506a815 100644
--- a/gcc/testsuite/lib/gm2-simple.exp
+++ b/gcc/testsuite/lib/gm2-simple.exp
@@ -20,6 +20,8 @@
load_lib file-format.exp
load_lib gm2.exp
+set gm2_keep_executable 0
+
#
# gm2-simple-compile -- runs the compiler
#
@@ -70,6 +72,7 @@ proc gm2-simple-execute { sources args option } {
global gm2_link_libraries;
global gm2_link_path;
global gm2_link_objects;
+ global gm2_keep_executable;
# Use the first source filename given as the filename under test.
set src [lindex $sources 0];
@@ -111,7 +114,6 @@ proc gm2-simple-execute { sources args option } {
# now append path -fno-libs=- and objects
set options [concat "{additional_flags=$gm2_link_path} " $options]
set options [concat "{additional_flags=-fno-libs=-} " $options]
- set options [concat "{additional_flags=$gm2_link_objects} " $options]
set comp_output [gm2_target_compile "${sources}" "${execname}" executable ${options}];
@@ -131,7 +133,10 @@ proc gm2-simple-execute { sources args option } {
}
if { $status == "pass" } {
${tool}_pass $testcase $option
- remote_file build delete $execname;
+ # puts stderr $execname
+ if { ! $gm2_keep_executable } {
+ remote_file build delete $execname;
+ }
}
return 1
}
diff --git a/gcc/testsuite/lib/gm2-torture.exp b/gcc/testsuite/lib/gm2-torture.exp
index d069446..e364dcf 100644
--- a/gcc/testsuite/lib/gm2-torture.exp
+++ b/gcc/testsuite/lib/gm2-torture.exp
@@ -103,9 +103,9 @@ if ![info exists TORTURE_OPTIONS] {
# OPTION is the specific compiler flag we're testing (eg: -O2).
#
proc gm2-torture-compile { src option } {
- global output
- global srcdir tmpdir
- global host_triplet
+ global output;
+ global srcdir tmpdir;
+ global host_triplet;
set output "$tmpdir/[file tail [file rootname $src]].o"
@@ -137,7 +137,7 @@ proc gm2-torture-compile { src option } {
#
proc gm2_check_compile_fail {testcase option objname gcc_output} {
- global tool
+ global tool;
set fatal_signal "*cc: Internal compiler error: program*got fatal signal"
if [string match "$fatal_signal 6" $gcc_output] then {
@@ -194,9 +194,9 @@ proc gm2_check_compile_fail {testcase option objname gcc_output} {
# OPTION is the specific compiler flag we're testing (eg: -O2).
#
proc gm2-torture-compile-fail { src option } {
- global output
- global srcdir tmpdir
- global host_triplet
+ global output;
+ global srcdir tmpdir;
+ global host_triplet;
# puts stderr "gm2-torture-compile-fail: ${option}\n"
set output "$tmpdir/[file tail [file rootname $src]].o"
@@ -472,7 +472,7 @@ proc search_for { file pattern } {
# to more than 14 chars.
#
proc gm2-torture { args } {
- global srcdir subdir compiler_conditional_xfail_data TORTURE_OPTIONS
+ global srcdir subdir compiler_conditional_xfail_data TORTURE_OPTIONS;
set src [lindex $args 0];
if { [llength $args] > 1 } {
@@ -526,7 +526,7 @@ proc gm2-torture { args } {
# to more than 14 chars.
#
proc gm2-torture-fail { args } {
- global srcdir subdir compiler_conditional_xfail_data TORTURE_OPTIONS
+ global srcdir subdir compiler_conditional_xfail_data TORTURE_OPTIONS;
set src [lindex $args 0];
if { [llength $args] > 1 } {
diff --git a/gcc/testsuite/lib/gm2.exp b/gcc/testsuite/lib/gm2.exp
index da08a56..25b5e68 100644
--- a/gcc/testsuite/lib/gm2.exp
+++ b/gcc/testsuite/lib/gm2.exp
@@ -343,22 +343,28 @@ proc gm2_init_pimx { dialect paths args } {
send_log "gccpath is $gccpath\n"
send_log "gm2src is $gm2src\n"
- set theIpath -I${gccpath}/libgm2/libm2pim
+ set theIpath -fm2-pathname=m2pim
+ lappend theIpath -I${gccpath}/libgm2/libm2pim
+ lappend theIpath -fm2-pathname=m2log
lappend theIpath -I${gm2src}/gm2-libs-log
# NOTE:
+ lappend theIpath -fm2-pathname=m2pim
lappend theIpath -I${gm2src}/gm2-libs
set theLpath -L${gccpath}/libgm2/libm2pim/.libs
+ lappend theIpath -fm2-pathname=m2iso
lappend theIpath -I${gccpath}/libgm2/libm2iso
lappend theIpath -I${gm2src}/gm2-libs-iso
lappend theLpath -L${gccpath}/libgm2/libm2iso/.libs
+ lappend theIpath -fm2-pathname=-
foreach p $paths {
lappend theIpath -I$p
}
+ lappend theIpath -fm2-pathname=-
gm2_link_lib "m2pim m2iso"
lappend args -fno-libs=-
@@ -415,27 +421,35 @@ proc gm2_init_iso { paths args } {
set gm2src ${srcdir}/../m2
- set theIpath -I${gccpath}/libgm2/libm2iso
+ set theIpath -fm2-pathname=m2iso
+ lappend theIpath -I${gccpath}/libgm2/libm2iso
lappend theIpath -I${gm2src}/gm2-libs-iso
set theLpath -L${gccpath}/libgm2/libm2iso/.libs
+ lappend theIpath -fm2-pathname=m2pim
lappend theIpath -I${gccpath}/libgm2/libm2pim
+
+ lappend theIpath -fm2-pathname=m2log
lappend theIpath -I${gm2src}/gm2-libs-log
# NOTE:
+ lappend theIpath -fm2-pathname=m2pim
lappend theIpath -I${gm2src}/gm2-libs
lappend theLpath -L${gccpath}/libgm2/libm2pim/.libs
+ lappend theIpath -fm2-pathname=m2cor
lappend theIpath -I${gccpath}/libgm2/libm2cor
lappend theIpath -I${gm2src}/gm2-libs-coroutines
lappend theLpath -L${gccpath}/libgm2/libm2cor/.libs
+ lappend theIpath -fm2-pathname=-
foreach p $paths {
lappend theIpath -I$p
}
+ lappend theIpath -fm2-pathname=-
gm2_link_lib "m2iso m2pim m2cor"
lappend args -fno-libs=-
@@ -452,23 +466,29 @@ proc gm2_init_ulm { paths args } {
set gm2src ${srcdir}/../m2
- set theIpath -I${gccpath}/libgm2/libm2ulm
+ set theIpath -fm2-pathname=m2ulm
+ lappend theIpath -I${gccpath}/libgm2/libm2ulm
lappend theIpath -I${gm2src}/ulm-lib-gm2/std
lappend theIpath -I${gm2src}/ulm-lib-gm2/sys
set theLpath -L${gccpath}/libgm2/libm2ulm/.libs
+ lappend theIpath -fm2-pathname=m2pim
lappend theIpath -I${gccpath}/libgm2/libm2pim
+ lappend theIpath -fm2-pathname=m2log
lappend theIpath -I${gm2src}/gm2-libs-log
# NOTE:
+ lappend theIpath -fm2-pathname=m2pim
lappend theIpath -I${gm2src}/gm2-libs
lappend theLpath -L${gccpath}/libgm2/libm2pim/.libs
+ lappend theIpath -fm2-pathname=-
foreach p $paths {
lappend theIpath -I$p
}
+ lappend theIpath -fm2-pathname=-
gm2_link_lib "m2ulm m2pim"
lappend args -fno-libs=-
@@ -492,25 +512,30 @@ proc gm2_init_log { paths args } {
send_log "gm2src is $gm2src\n"
# FIXME: this seems to interleave the library defs.
- set theIpath -I${gccpath}/libgm2/libm2log
+ set theIpath -fm2-pathname=m2log
+ lappend theIpath -I${gccpath}/libgm2/libm2log
lappend theIpath -I${gm2src}/gm2-libs-log
set theLpath -L${gccpath}/libgm2/libm2log/.libs
+ lappend theIpath -fm2-pathname=m2pim
lappend theIpath -I${gccpath}/libgm2/libm2pim
lappend theIpath -I${gm2src}/gm2-libs
lappend theLpath -L${gccpath}/libgm2/libm2pim/.libs
+ lappend theIpath -fm2-pathname=m2iso
lappend theIpath -I${gccpath}/libgm2/libm2iso
lappend theIpath -I${gm2src}/gm2-libs-iso
# ??? lappend theIpath -I${gm2src}/gm2-libs
lappend theLpath -L${gccpath}/libgm2/libm2iso/.libs
+ lappend theIpath -fm2-pathname=-
foreach p $paths {
lappend theIpath -I$p
}
+ lappend theIpath -fm2-pathname=-
gm2_link_lib "m2log m2pim m2iso"
lappend args -fno-libs=-
@@ -533,29 +558,41 @@ proc gm2_init_cor { paths args } {
send_log "gccpath is $gccpath\n"
send_log "gm2src is $gm2src\n"
- set theIpath -I${gccpath}/libgm2/libm2cor
+ set theIpath -fm2-pathname=m2cor
+ lappend theIpath -I${gccpath}/libgm2/libm2cor
lappend theIpath -I${gm2src}/gm2-libs-coroutines
set theLpath -L${gccpath}/libgm2/libm2cor/.libs
+ lappend theIpath -fm2-pathname=m2pim
lappend theIpath -I${gccpath}/libgm2/libm2pim
+
+ lappend theIpath -fm2-pathname=m2log
lappend theIpath -I${gm2src}/gm2-libs-log
+ lappend theIpath -fm2-pathname=m2pim
lappend theLpath -L${gccpath}/libgm2/libm2pim/.libs
+ lappend theIpath -fm2-pathname=m2log
lappend theIpath -I${gccpath}/libgm2/libm2log
+
+ lappend theIpath -fm2-pathname=m2pim
lappend theIpath -I${gm2src}/gm2-libs
+ lappend theIpath -fm2-pathname=m2log
lappend theLpath -L${gccpath}/libgm2/libm2log/.libs
+ lappend theIpath -fm2-pathname=m2iso
lappend theIpath -I${gccpath}/libgm2/libm2iso
lappend theIpath -I${gm2src}/gm2-libs-iso
lappend theLpath -L${gccpath}/libgm2/libm2iso/.libs
+ lappend theIpath -fm2-pathname=-
foreach p $paths {
lappend theIpath -I$p
}
+ lappend theIpath -fm2-pathname=-
gm2_link_lib "m2cor m2pim m2log m2iso"
append args " -fno-libs=- "
@@ -578,14 +615,17 @@ proc gm2_init_minx { dialect paths args } {
send_log "gccpath is $gccpath\n"
send_log "gm2src is $gm2src\n"
- set theIpath -I${gccpath}/libgm2/libm2min
+ set theIpath -fm2-pathname=m2min
+ lappend theIpath -I${gccpath}/libgm2/libm2min
lappend theIpath -I${gm2src}/gm2-libs-min
set theLpath -L${gccpath}/libgm2/libm2min/.libs
+ lappend theIpath -fm2-pathname=-
foreach p $paths {
lappend theIpath -I$p
}
+ lappend theIpath -fm2-pathname=-
gm2_link_lib "m2min"
lappend args -fno-exceptions
diff --git a/libgm2/libm2cor/KeyBoardLEDs.cc b/libgm2/libm2cor/KeyBoardLEDs.cc
index bd0a450..e2e8198 100644
--- a/libgm2/libm2cor/KeyBoardLEDs.cc
+++ b/libgm2/libm2cor/KeyBoardLEDs.cc
@@ -27,6 +27,10 @@ see the files COPYING3 and COPYING.RUNTIME respectively. If not, see
#include <config.h>
#include <m2rts.h>
+#define EXPORT(FUNC) m2cor ## _KeyBoardLEDs_ ## FUNC
+#define M2EXPORT(FUNC) m2cor ## _M2_KeyBoardLEDs_ ## FUNC
+#define M2LIBNAME "m2cor"
+
#if defined(linux)
#include <sys/types.h>
@@ -50,7 +54,7 @@ static int initialized = FALSE;
extern "C" void
-KeyBoardLEDs_SwitchScroll (int scrolllock)
+EXPORT(SwitchScroll) (int scrolllock)
{
unsigned char leds;
int r = ioctl (fd, KDGETLED, &leds);
@@ -62,7 +66,7 @@ KeyBoardLEDs_SwitchScroll (int scrolllock)
}
extern "C" void
-KeyBoardLEDs_SwitchNum (int numlock)
+EXPORT(SwitchNum) (int numlock)
{
unsigned char leds;
int r = ioctl (fd, KDGETLED, &leds);
@@ -74,7 +78,7 @@ KeyBoardLEDs_SwitchNum (int numlock)
}
extern "C" void
-KeyBoardLEDs_SwitchCaps (int capslock)
+EXPORT(SwitchCaps) (int capslock)
{
unsigned char leds;
int r = ioctl (fd, KDGETLED, &leds);
@@ -86,15 +90,15 @@ KeyBoardLEDs_SwitchCaps (int capslock)
}
extern "C" void
-KeyBoardLEDs_SwitchLeds (int numlock, int capslock, int scrolllock)
+EXPORT(SwitchLeds) (int numlock, int capslock, int scrolllock)
{
- KeyBoardLEDs_SwitchScroll (scrolllock);
- KeyBoardLEDs_SwitchNum (numlock);
- KeyBoardLEDs_SwitchCaps (capslock);
+ EXPORT(SwitchScroll) (scrolllock);
+ EXPORT(SwitchNum) (numlock);
+ EXPORT(SwitchCaps) (capslock);
}
extern "C" void
-_M2_KeyBoardLEDs_init (int, char **, char **)
+M2EXPORT(init) (int, char **, char **)
{
if (! initialized)
{
@@ -110,47 +114,47 @@ _M2_KeyBoardLEDs_init (int, char **, char **)
#else
extern "C" void
-KeyBoardLEDs_SwitchLeds (int numlock, int capslock, int scrolllock)
+EXPORT(SwitchLeds) (int numlock, int capslock, int scrolllock)
{
}
extern "C" void
-KeyBoardLEDs_SwitchScroll (int scrolllock)
+EXPORT(SwitchScroll) (int scrolllock)
{
}
extern "C" void
-KeyBoardLEDs_SwitchNum (int numlock)
+EXPORT(SwitchNum) (int numlock)
{
}
extern "C" void
-KeyBoardLEDs_SwitchCaps (int capslock)
+EXPORT(SwitchCaps) (int capslock)
{
}
extern "C" void
-_M2_KeyBoardLEDs_init (int, char **, char **)
+M2EXPORT(init) (int, char **, char **)
{
}
-
#endif
/* GNU Modula-2 linking hooks. */
extern "C" void
-_M2_KeyBoardLEDs_finish (int, char **, char **)
+M2EXPORT(fini) (int, char **, char **)
{
}
extern "C" void
-_M2_KeyBoardLEDs_dep (void)
+M2EXPORT(dep) (void)
{
}
extern "C" void __attribute__((__constructor__))
- _M2_KeyBoardLEDs_ctor (void)
+M2EXPORT(ctor) (void)
{
- M2RTS_RegisterModule ("KeyBoardLEDs", _M2_KeyBoardLEDs_init, _M2_KeyBoardLEDs_finish,
- _M2_KeyBoardLEDs_dep);
+ m2pim_M2RTS_RegisterModule ("KeyBoardLEDs", M2LIBNAME,
+ M2EXPORT(init), M2EXPORT(fini),
+ M2EXPORT(dep));
}
diff --git a/libgm2/libm2cor/Makefile.am b/libgm2/libm2cor/Makefile.am
index 662a440..25a5f00 100644
--- a/libgm2/libm2cor/Makefile.am
+++ b/libgm2/libm2cor/Makefile.am
@@ -113,7 +113,11 @@ nodist_EXTRA_libm2cor_la_SOURCES = dummy.c ## forces automake to generate the L
libm2cordir = libm2cor
libm2cor_la_DEPENDENCIES = SYSTEM.def $(addsuffix .lo, $(basename $(libm2cor_la_SOURCES)))
libm2cor_la_CFLAGS = -I. -I.. -I$(GM2_SRC)/gm2-libs -I$(GM2_SRC)/gm2-libs-iso -DBUILD_GM2_LIBS -I@srcdir@/../ -I@srcdir@/../libm2iso
-libm2cor_la_M2FLAGS = -I. -I$(GM2_SRC)/gm2-libs-coroutines -I$(GM2_SRC)/gm2-libs -I$(GM2_SRC)/gm2-libs-iso -fm2-g -g -Wreturn-type -fcase
+libm2cor_la_M2FLAGS = \
+ -fm2-pathname=m2cor -I. -I$(GM2_SRC)/gm2-libs-coroutines \
+ -fm2-pathname=m2pim -I$(GM2_SRC)/gm2-libs \
+ -fm2-pathname=m2iso -I$(GM2_SRC)/gm2-libs-iso \
+ -fm2-g -g -Wreturn-type -fcase -fm2-prefix=m2cor
if TARGET_DARWIN
libm2cor_la_link_flags = -Wl,-undefined,dynamic_lookup
else
diff --git a/libgm2/libm2cor/Makefile.in b/libgm2/libm2cor/Makefile.in
index ca3ddd0..869924b 100644
--- a/libgm2/libm2cor/Makefile.in
+++ b/libgm2/libm2cor/Makefile.in
@@ -463,7 +463,12 @@ FLAGS_TO_PASS = $(AM_MAKEFLAGS)
@BUILD_CORLIB_TRUE@libm2cordir = libm2cor
@BUILD_CORLIB_TRUE@libm2cor_la_DEPENDENCIES = SYSTEM.def $(addsuffix .lo, $(basename $(libm2cor_la_SOURCES)))
@BUILD_CORLIB_TRUE@libm2cor_la_CFLAGS = -I. -I.. -I$(GM2_SRC)/gm2-libs -I$(GM2_SRC)/gm2-libs-iso -DBUILD_GM2_LIBS -I@srcdir@/../ -I@srcdir@/../libm2iso
-@BUILD_CORLIB_TRUE@libm2cor_la_M2FLAGS = -I. -I$(GM2_SRC)/gm2-libs-coroutines -I$(GM2_SRC)/gm2-libs -I$(GM2_SRC)/gm2-libs-iso -fm2-g -g -Wreturn-type -fcase
+@BUILD_CORLIB_TRUE@libm2cor_la_M2FLAGS = \
+@BUILD_CORLIB_TRUE@ -fm2-pathname=m2cor -I. -I$(GM2_SRC)/gm2-libs-coroutines \
+@BUILD_CORLIB_TRUE@ -fm2-pathname=m2pim -I$(GM2_SRC)/gm2-libs \
+@BUILD_CORLIB_TRUE@ -fm2-pathname=m2iso -I$(GM2_SRC)/gm2-libs-iso \
+@BUILD_CORLIB_TRUE@ -fm2-g -g -Wreturn-type -fcase -fm2-prefix=m2cor
+
@BUILD_CORLIB_TRUE@@TARGET_DARWIN_FALSE@libm2cor_la_link_flags =
@BUILD_CORLIB_TRUE@@TARGET_DARWIN_TRUE@libm2cor_la_link_flags = -Wl,-undefined,dynamic_lookup
@BUILD_CORLIB_TRUE@libm2cor_la_LINK = $(LINK) -version-info $(libtool_VERSION) $(libm2cor_la_link_flags)
diff --git a/libgm2/libm2iso/ErrnoCategory.cc b/libgm2/libm2iso/ErrnoCategory.cc
index 2db2639..55db89d 100644
--- a/libgm2/libm2iso/ErrnoCategory.cc
+++ b/libgm2/libm2iso/ErrnoCategory.cc
@@ -25,7 +25,6 @@ see the files COPYING3 and COPYING.RUNTIME respectively. If not, see
<http://www.gnu.org/licenses/>. */
#include "config.h"
-
#include "ChanConsts.h"
#if defined(HAVE_ERRNO_H)
@@ -38,6 +37,11 @@ see the files COPYING3 and COPYING.RUNTIME respectively. If not, see
#include "m2rts.h"
+#define EXPORT(FUNC) m2iso ## _ErrnoCategory_ ## FUNC
+#define M2EXPORT(FUNC) m2iso ## _M2_ErrnoCategory_ ## FUNC
+#define M2LIBNAME "m2iso"
+
+
#if !defined(FALSE)
#define FALSE (1 == 0)
#endif
@@ -50,7 +54,7 @@ see the files COPYING3 and COPYING.RUNTIME respectively. If not, see
with a hard device error. */
extern "C" int
-ErrnoCategory_IsErrnoHard (int e)
+EXPORT(IsErrnoHard) (int e)
{
#if defined(HAVE_ERRNO_H) || defined(HAVE_SYS_ERRNO_H)
return ((e == EPERM) || (e == ENOENT) || (e == EIO) || (e == ENXIO)
@@ -65,7 +69,7 @@ ErrnoCategory_IsErrnoHard (int e)
with a soft device error. */
extern "C" int
-ErrnoCategory_IsErrnoSoft (int e)
+EXPORT(IsErrnoSoft) (int e)
{
#if defined(HAVE_ERRNO_H) || defined(HAVE_SYS_ERRNO_H)
return ((e == ESRCH) || (e == EINTR) || (e == E2BIG) || (e == ENOEXEC)
@@ -79,7 +83,7 @@ ErrnoCategory_IsErrnoSoft (int e)
}
extern "C" int
-ErrnoCategory_UnAvailable (int e)
+EXPORT(UnAvailable) (int e)
{
#if defined(HAVE_ERRNO_H) || defined(HAVE_SYS_ERRNO_H)
return ((e == ENOENT) || (e == ESRCH) || (e == ENXIO) || (e == ECHILD)
@@ -93,7 +97,7 @@ ErrnoCategory_UnAvailable (int e)
OpenResults. */
extern "C" openResults
-ErrnoCategory_GetOpenResults (int e)
+EXPORT(GetOpenResults) (int e)
{
if (e == 0)
return opened;
@@ -157,23 +161,24 @@ ErrnoCategory_GetOpenResults (int e)
/* GNU Modula-2 linking fodder. */
extern "C" void
-_M2_ErrnoCategory_init (int, char *argv[], char *env[])
+M2EXPORT(init) (int, char **, char **)
{
}
extern "C" void
-_M2_ErrnoCategory_fini (int, char *argv[], char *env[])
+M2EXPORT(fini) (int, char **, char **)
{
}
extern "C" void
-_M2_ErrnoCategory_dep (void)
+M2EXPORT(dep) (void)
{
}
extern "C" void __attribute__((__constructor__))
-_M2_ErrnoCategory_ctor (void)
+M2EXPORT(ctor) (void)
{
- M2RTS_RegisterModule ("ErrnoCategory", _M2_ErrnoCategory_init, _M2_ErrnoCategory_fini,
- _M2_ErrnoCategory_dep);
+ m2iso_M2RTS_RegisterModule ("ErrnoCategory", M2LIBNAME,
+ M2EXPORT(init), M2EXPORT(fini),
+ M2EXPORT(dep));
}
diff --git a/libgm2/libm2iso/Makefile.am b/libgm2/libm2iso/Makefile.am
index cc9a477..dddced4 100644
--- a/libgm2/libm2iso/Makefile.am
+++ b/libgm2/libm2iso/Makefile.am
@@ -15,7 +15,7 @@
# along with this program; see the file COPYING3. If not see
# <http://www.gnu.org/licenses/>.
-SUFFIXES = .c .mod .def .o .obj .lo .a .la
+SUFFIXES = .c .cc .mod .def .o .obj .lo .a .la
ACLOCAL_AMFLAGS = -I . -I .. -I ../config
@@ -178,15 +178,18 @@ M2MODS = ChanConsts.mod CharClass.mod \
toolexeclib_LTLIBRARIES = libm2iso.la
libm2iso_la_SOURCES = $(M2MODS) \
- ErrnoCategory.cc wrapsock.c \
- wraptime.c RTco.cc
+ ErrnoCategory.cc wraptime.cc RTco.cc wrapsock.c
+# wrapsock.cc
C_INCLUDES = -I.. -I$(toplevel_srcdir)/libiberty -I$(toplevel_srcdir)/include
libm2isodir = libm2iso
libm2iso_la_DEPENDENCIES = SYSTEM.def $(addsuffix .lo, $(basename $(libm2iso_la_SOURCES)))
libm2iso_la_CFLAGS = $(C_INCLUDES) -I. -I.. -I$(GM2_SRC)/gm2-libs-iso -I$(GM2_SRC)/gm2-libs -DBUILD_GM2_LIBS -I@srcdir@/../ -I../../../gcc -I$(GCC_DIR) -I$(GCC_DIR)/../include -I../../libgcc -I$(GCC_DIR)/../libgcc -I$(MULTIBUILDTOP)../../gcc/include
-libm2iso_la_M2FLAGS = -I. -Ilibm2iso -I$(GM2_SRC)/gm2-libs-iso -I$(GM2_SRC)/gm2-libs -fiso -fextended-opaque -fm2-g -g -Wreturn-type -fcase
+libm2iso_la_M2FLAGS = \
+ -fm2-pathname=m2iso -I. -Ilibm2iso -I$(GM2_SRC)/gm2-libs-iso \
+ -fm2-pathname=m2pim -I$(GM2_SRC)/gm2-libs \
+ -fiso -fextended-opaque -fm2-g -g -Wreturn-type -fcase -fm2-prefix=m2iso
if TARGET_DARWIN
libm2iso_la_link_flags = -Wl,-undefined,dynamic_lookup
else
@@ -207,17 +210,15 @@ SYSTEM.def: Makefile
-I$(GM2_SRC)/gm2-libs-iso -I$(GM2_SRC)/gm2-libs \
"$(GM2_FOR_TARGET)" $@
-## add these to the .mod.o rule when optimization is fixed $(CFLAGS_FOR_TARGET) $(LIBCFLAGS)
-
.mod.lo:
$(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(GM2_FOR_TARGET) -c $(CFLAGS_FOR_TARGET) $(LIBCFLAGS) $(libm2iso_la_M2FLAGS) $< -o $@
-.c.lo:
- $(LIBTOOL) --tag=CC --mode=compile $(CC) -c $(CFLAGS) $(LIBCFLAGS) $(libm2iso_la_CFLAGS) $< -o $@
-
.cc.lo:
$(LIBTOOL) --tag=CXX --mode=compile $(CXX) -c -I$(srcdir) $(CXXFLAGS) $(LIBCFLAGS) $(libm2iso_la_CFLAGS) $< -o $@
+.c.lo:
+ $(LIBTOOL) --tag=CC --mode=compile $(CC) -c -I$(srcdir) $(CFLAGS) $(LIBCFLAGS) $(libm2iso_la_CFLAGS) $< -o $@
+
install-data-local: force
mkdir -p $(DESTDIR)$(inst_libdir)/$(M2LIBDIR)
for i in $(M2DEFS) $(M2MODS) ; do \
diff --git a/libgm2/libm2iso/Makefile.in b/libgm2/libm2iso/Makefile.in
index b96136a..e28e9dd 100644
--- a/libgm2/libm2iso/Makefile.in
+++ b/libgm2/libm2iso/Makefile.in
@@ -179,8 +179,8 @@ libm2iso_la_LIBADD =
@BUILD_ISOLIB_TRUE@ TextIO.lo WholeConv.lo WholeIO.lo \
@BUILD_ISOLIB_TRUE@ WholeStr.lo
@BUILD_ISOLIB_TRUE@am_libm2iso_la_OBJECTS = $(am__objects_1) \
-@BUILD_ISOLIB_TRUE@ ErrnoCategory.lo libm2iso_la-wrapsock.lo \
-@BUILD_ISOLIB_TRUE@ libm2iso_la-wraptime.lo RTco.lo
+@BUILD_ISOLIB_TRUE@ ErrnoCategory.lo wraptime.lo RTco.lo \
+@BUILD_ISOLIB_TRUE@ libm2iso_la-wrapsock.lo
libm2iso_la_OBJECTS = $(am_libm2iso_la_OBJECTS)
@BUILD_ISOLIB_TRUE@am_libm2iso_la_rpath = -rpath $(toolexeclibdir)
AM_V_P = $(am__v_P_@AM_V@)
@@ -408,7 +408,7 @@ toolexeclibdir = @toolexeclibdir@
top_build_prefix = @top_build_prefix@
top_builddir = @top_builddir@
top_srcdir = @top_srcdir@
-SUFFIXES = .c .mod .def .o .obj .lo .a .la
+SUFFIXES = .c .cc .mod .def .o .obj .lo .a .la
ACLOCAL_AMFLAGS = -I . -I .. -I ../config
# Multilib support.
@@ -556,14 +556,18 @@ FLAGS_TO_PASS = $(AM_MAKEFLAGS)
@BUILD_ISOLIB_TRUE@toolexeclib_LTLIBRARIES = libm2iso.la
@BUILD_ISOLIB_TRUE@libm2iso_la_SOURCES = $(M2MODS) \
-@BUILD_ISOLIB_TRUE@ ErrnoCategory.cc wrapsock.c \
-@BUILD_ISOLIB_TRUE@ wraptime.c RTco.cc
+@BUILD_ISOLIB_TRUE@ ErrnoCategory.cc wraptime.cc RTco.cc wrapsock.c
+# wrapsock.cc
@BUILD_ISOLIB_TRUE@C_INCLUDES = -I.. -I$(toplevel_srcdir)/libiberty -I$(toplevel_srcdir)/include
@BUILD_ISOLIB_TRUE@libm2isodir = libm2iso
@BUILD_ISOLIB_TRUE@libm2iso_la_DEPENDENCIES = SYSTEM.def $(addsuffix .lo, $(basename $(libm2iso_la_SOURCES)))
@BUILD_ISOLIB_TRUE@libm2iso_la_CFLAGS = $(C_INCLUDES) -I. -I.. -I$(GM2_SRC)/gm2-libs-iso -I$(GM2_SRC)/gm2-libs -DBUILD_GM2_LIBS -I@srcdir@/../ -I../../../gcc -I$(GCC_DIR) -I$(GCC_DIR)/../include -I../../libgcc -I$(GCC_DIR)/../libgcc -I$(MULTIBUILDTOP)../../gcc/include
-@BUILD_ISOLIB_TRUE@libm2iso_la_M2FLAGS = -I. -Ilibm2iso -I$(GM2_SRC)/gm2-libs-iso -I$(GM2_SRC)/gm2-libs -fiso -fextended-opaque -fm2-g -g -Wreturn-type -fcase
+@BUILD_ISOLIB_TRUE@libm2iso_la_M2FLAGS = \
+@BUILD_ISOLIB_TRUE@ -fm2-pathname=m2iso -I. -Ilibm2iso -I$(GM2_SRC)/gm2-libs-iso \
+@BUILD_ISOLIB_TRUE@ -fm2-pathname=m2pim -I$(GM2_SRC)/gm2-libs \
+@BUILD_ISOLIB_TRUE@ -fiso -fextended-opaque -fm2-g -g -Wreturn-type -fcase -fm2-prefix=m2iso
+
@BUILD_ISOLIB_TRUE@@TARGET_DARWIN_FALSE@libm2iso_la_link_flags =
@BUILD_ISOLIB_TRUE@@TARGET_DARWIN_TRUE@libm2iso_la_link_flags = -Wl,-undefined,dynamic_lookup
@BUILD_ISOLIB_TRUE@libm2iso_la_LINK = $(LINK) -version-info $(libtool_VERSION) $(libm2iso_la_link_flags)
@@ -575,7 +579,7 @@ all: $(BUILT_SOURCES)
$(MAKE) $(AM_MAKEFLAGS) all-am
.SUFFIXES:
-.SUFFIXES: .c .mod .def .o .obj .lo .a .la .cc
+.SUFFIXES: .c .cc .mod .def .o .obj .lo .a .la
$(srcdir)/Makefile.in: @MAINTAINER_MODE_TRUE@ $(srcdir)/Makefile.am $(am__configure_deps)
@for dep in $?; do \
case '$(am__configure_deps)' in \
@@ -653,7 +657,7 @@ distclean-compile:
@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/ErrnoCategory.Plo@am__quote@
@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/RTco.Plo@am__quote@
@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/libm2iso_la-wrapsock.Plo@am__quote@
-@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/libm2iso_la-wraptime.Plo@am__quote@
+@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/wraptime.Plo@am__quote@
.c.o:
@am__fastdepCC_TRUE@ $(AM_V_CC)$(COMPILE) -MT $@ -MD -MP -MF $(DEPDIR)/$*.Tpo -c -o $@ $<
@@ -683,13 +687,6 @@ libm2iso_la-wrapsock.lo: wrapsock.c
@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@
@am__fastdepCC_FALSE@ $(AM_V_CC@am__nodep@)$(LIBTOOL) $(AM_V_lt) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(libm2iso_la_CFLAGS) $(CFLAGS) -c -o libm2iso_la-wrapsock.lo `test -f 'wrapsock.c' || echo '$(srcdir)/'`wrapsock.c
-libm2iso_la-wraptime.lo: wraptime.c
-@am__fastdepCC_TRUE@ $(AM_V_CC)$(LIBTOOL) $(AM_V_lt) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(libm2iso_la_CFLAGS) $(CFLAGS) -MT libm2iso_la-wraptime.lo -MD -MP -MF $(DEPDIR)/libm2iso_la-wraptime.Tpo -c -o libm2iso_la-wraptime.lo `test -f 'wraptime.c' || echo '$(srcdir)/'`wraptime.c
-@am__fastdepCC_TRUE@ $(AM_V_at)$(am__mv) $(DEPDIR)/libm2iso_la-wraptime.Tpo $(DEPDIR)/libm2iso_la-wraptime.Plo
-@AMDEP_TRUE@@am__fastdepCC_FALSE@ $(AM_V_CC)source='wraptime.c' object='libm2iso_la-wraptime.lo' libtool=yes @AMDEPBACKSLASH@
-@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@
-@am__fastdepCC_FALSE@ $(AM_V_CC@am__nodep@)$(LIBTOOL) $(AM_V_lt) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(libm2iso_la_CFLAGS) $(CFLAGS) -c -o libm2iso_la-wraptime.lo `test -f 'wraptime.c' || echo '$(srcdir)/'`wraptime.c
-
.cc.o:
@am__fastdepCXX_TRUE@ $(AM_V_CXX)$(CXXCOMPILE) -MT $@ -MD -MP -MF $(DEPDIR)/$*.Tpo -c -o $@ $<
@am__fastdepCXX_TRUE@ $(AM_V_at)$(am__mv) $(DEPDIR)/$*.Tpo $(DEPDIR)/$*.Po
@@ -911,12 +908,12 @@ uninstall-am: uninstall-toolexeclibLTLIBRARIES
@BUILD_ISOLIB_TRUE@.mod.lo:
@BUILD_ISOLIB_TRUE@ $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(GM2_FOR_TARGET) -c $(CFLAGS_FOR_TARGET) $(LIBCFLAGS) $(libm2iso_la_M2FLAGS) $< -o $@
-@BUILD_ISOLIB_TRUE@.c.lo:
-@BUILD_ISOLIB_TRUE@ $(LIBTOOL) --tag=CC --mode=compile $(CC) -c $(CFLAGS) $(LIBCFLAGS) $(libm2iso_la_CFLAGS) $< -o $@
-
@BUILD_ISOLIB_TRUE@.cc.lo:
@BUILD_ISOLIB_TRUE@ $(LIBTOOL) --tag=CXX --mode=compile $(CXX) -c -I$(srcdir) $(CXXFLAGS) $(LIBCFLAGS) $(libm2iso_la_CFLAGS) $< -o $@
+@BUILD_ISOLIB_TRUE@.c.lo:
+@BUILD_ISOLIB_TRUE@ $(LIBTOOL) --tag=CC --mode=compile $(CC) -c -I$(srcdir) $(CFLAGS) $(LIBCFLAGS) $(libm2iso_la_CFLAGS) $< -o $@
+
@BUILD_ISOLIB_TRUE@install-data-local: force
@BUILD_ISOLIB_TRUE@ mkdir -p $(DESTDIR)$(inst_libdir)/$(M2LIBDIR)
@BUILD_ISOLIB_TRUE@ for i in $(M2DEFS) $(M2MODS) ; do \
diff --git a/libgm2/libm2iso/RTco.cc b/libgm2/libm2iso/RTco.cc
index 8b8a4dc..33da586 100644
--- a/libgm2/libm2iso/RTco.cc
+++ b/libgm2/libm2iso/RTco.cc
@@ -32,8 +32,9 @@ see the files COPYING3 and COPYING.RUNTIME respectively. If not, see
#include <m2rts.h>
#include <cstdio>
-#define EXPORT(FUNC) RTco_ ## FUNC
-#define M2EXPORT(FUNC) _M2_RTco_ ## FUNC
+#define EXPORT(FUNC) m2iso ## _RTco_ ## FUNC
+#define M2EXPORT(FUNC) m2iso ## _M2_RTco_ ## FUNC
+#define M2LIBNAME "m2iso"
/* This implementation of RTco.cc uses a single lock for mutex across
the whole module. It also forces context switching between threads
@@ -104,12 +105,9 @@ static threadSem **semArray = NULL;
static __gthread_mutex_t lock; /* This is the only mutex for
the whole module. */
static int initialized = FALSE;
-static int currentThread = 0;
-
extern "C" int EXPORT(init) (void);
-
extern "C" void
M2EXPORT(dep) (void)
{
@@ -184,8 +182,8 @@ newSem (void)
= (threadSem *)malloc (sizeof (threadSem));
nSemaphores += 1;
if (nSemaphores == SEM_POOL)
- M2RTS_HaltC (__FILE__, __LINE__, __FUNCTION__,
- "too many semaphores created");
+ m2iso_M2RTS_HaltC (__FILE__, __LINE__, __FUNCTION__,
+ "too many semaphores created");
#else
threadSem *sem
= (threadSem *)malloc (sizeof (threadSem));
@@ -233,6 +231,18 @@ EXPORT(initSemaphore) (int value)
return sid;
}
+static int
+currentThread (void)
+{
+ int tid;
+
+ for (tid = 0; tid < nThreads; tid++)
+ if (pthread_self () == threadArray[tid].p)
+ return tid;
+ m2iso_M2RTS_HaltC (__FILE__, __LINE__, __FUNCTION__,
+ "failed to find currentThread");
+}
+
extern "C" int
EXPORT(currentThread) (void)
{
@@ -240,7 +250,7 @@ EXPORT(currentThread) (void)
EXPORT(init) ();
__gthread_mutex_lock (&lock);
- tid = currentThread;
+ tid = currentThread ();
tprintf ("currentThread %d\n", tid);
__gthread_mutex_unlock (&lock);
return tid;
@@ -253,9 +263,10 @@ EXPORT(currentInterruptLevel) (void)
{
EXPORT(init) ();
__gthread_mutex_lock (&lock);
+ int current = currentThread ();
tprintf ("currentInterruptLevel %d\n",
- threadArray[currentThread].interruptLevel);
- int level = threadArray[currentThread].interruptLevel;
+ threadArray[current].interruptLevel);
+ int level = threadArray[current].interruptLevel;
__gthread_mutex_unlock (&lock);
return level;
}
@@ -268,9 +279,10 @@ EXPORT(turnInterrupts) (unsigned int newLevel)
{
EXPORT(init) ();
__gthread_mutex_lock (&lock);
- unsigned int old = threadArray[currentThread].interruptLevel;
+ int current = currentThread ();
+ unsigned int old = threadArray[current].interruptLevel;
tprintf ("turnInterrupts from %d to %d\n", old, newLevel);
- threadArray[currentThread].interruptLevel = newLevel;
+ threadArray[current].interruptLevel = newLevel;
__gthread_mutex_unlock (&lock);
return old;
}
@@ -278,8 +290,8 @@ EXPORT(turnInterrupts) (unsigned int newLevel)
static void
never (void)
{
- M2RTS_HaltC (__FILE__, __LINE__, __FUNCTION__,
- "the main thread should never call here");
+ m2iso_M2RTS_HaltC (__FILE__, __LINE__, __FUNCTION__,
+ "the main thread should never call here");
}
static void *
@@ -313,10 +325,10 @@ execThread (void *t)
__gthread_mutex_unlock (&lock);
tp->proc (); /* Now execute user procedure. */
#if 0
- M2RTS_CoroutineException ( __FILE__, __LINE__, __COLUMN__, __FUNCTION__, "coroutine finishing");
+ m2iso_M2RTS_CoroutineException ( __FILE__, __LINE__, __COLUMN__, __FUNCTION__, "coroutine finishing");
#endif
- M2RTS_HaltC (__FILE__, __LINE__, __FUNCTION__,
- "execThread should never finish");
+ m2iso_M2RTS_HaltC (__FILE__, __LINE__, __FUNCTION__,
+ "execThread should never finish");
return NULL;
}
@@ -326,8 +338,8 @@ newThread (void)
#if defined(POOL)
nThreads += 1;
if (nThreads == THREAD_POOL)
- M2RTS_HaltC (__FILE__, __LINE__, __FUNCTION__,
- "too many threads created");
+ m2iso_M2RTS_HaltC (__FILE__, __LINE__, __FUNCTION__,
+ "too many threads created");
return nThreads - 1;
#else
if (nThreads == 0)
@@ -364,15 +376,15 @@ initThread (void (*proc) (void), unsigned int stackSize,
/* Set thread creation attributes. */
result = pthread_attr_init (&attr);
if (result != 0)
- M2RTS_HaltC (__FILE__, __LINE__, __FUNCTION__,
- "failed to create thread attribute");
+ m2iso_M2RTS_HaltC (__FILE__, __LINE__, __FUNCTION__,
+ "failed to create thread attribute");
if (stackSize > 0)
{
result = pthread_attr_setstacksize (&attr, stackSize);
if (result != 0)
- M2RTS_HaltC (__FILE__, __LINE__, __FUNCTION__,
- "failed to set stack size attribute");
+ m2iso_M2RTS_HaltC (__FILE__, __LINE__, __FUNCTION__,
+ "failed to set stack size attribute");
}
tprintf ("initThread [%d] function = 0x%p (arg = 0x%p)\n", tid, proc,
@@ -380,7 +392,7 @@ initThread (void (*proc) (void), unsigned int stackSize,
result = pthread_create (&threadArray[tid].p, &attr, execThread,
(void *)&threadArray[tid]);
if (result != 0)
- M2RTS_HaltC (__FILE__, __LINE__, __FUNCTION__, "thread_create failed");
+ m2iso_M2RTS_HaltC (__FILE__, __LINE__, __FUNCTION__, "thread_create failed");
tprintf (" created thread [%d] function = 0x%p 0x%p\n", tid, proc,
(void *)&threadArray[tid]);
return tid;
@@ -408,62 +420,61 @@ EXPORT(transfer) (int *p1, int p2)
{
__gthread_mutex_lock (&lock);
{
+ int current = currentThread ();
if (!initialized)
- M2RTS_HaltC (__FILE__, __LINE__, __FUNCTION__,
- "cannot transfer to a process before the process has been created");
- if (currentThread == p2)
+ m2iso_M2RTS_HaltC (__FILE__, __LINE__, __FUNCTION__,
+ "cannot transfer to a process before the process has been created");
+ if (current == p2)
{
/* Error. */
- M2RTS_HaltC (__FILE__, __LINE__, __FUNCTION__,
- "attempting to transfer to ourself");
+ m2iso_M2RTS_HaltC (__FILE__, __LINE__, __FUNCTION__,
+ "attempting to transfer to ourself");
}
else
{
- *p1 = currentThread;
- int old = currentThread;
- tprintf ("start, context switching from: %d to %d\n", currentThread, p2);
+ *p1 = current;
+ int old = current;
+ tprintf ("start, context switching from: %d to %d\n", current, p2);
/* Perform signal (p2 sem). Without the mutex lock as we have
already obtained it above. */
if (threadArray[p2].waiting)
{
/* p2 is blocked on the condition variable, release it. */
- tprintf ("p1 = %d cond_signal to p2 (%d)\n", currentThread, p2);
+ tprintf ("p1 = %d cond_signal to p2 (%d)\n", current, p2);
__gthread_cond_signal (&threadArray[p2].run_counter);
- tprintf ("after p1 = %d cond_signal to p2 (%d)\n", currentThread, p2);
+ tprintf ("after p1 = %d cond_signal to p2 (%d)\n", current, p2);
}
else
{
/* p2 hasn't reached the condition variable, so bump value
ready for p2 to test. */
tprintf ("no need for thread %d to cond_signal - bump %d value (pre) = %d\n",
- currentThread, p2, threadArray[p2].value);
+ current, p2, threadArray[p2].value);
threadArray[p2].value++;
}
/* Perform wait (old sem). Again without obtaining mutex as
we've already claimed it. */
if (threadArray[old].value == 0)
{
- currentThread = p2;
/* Record we are about to wait on the condition variable. */
threadArray[old].waiting = true;
__gthread_cond_wait (&threadArray[old].run_counter, &lock);
threadArray[old].waiting = false;
/* We are running again. */
- currentThread = old;
}
else
{
tprintf ("(currentThread = %d) no need for thread %d to cond_wait - taking value (pre) = %d\n",
- currentThread, old, threadArray[old].value);
+ current, old, threadArray[old].value);
/* No need to block as we have been told a signal has
effectively already been recorded. We remove the signal
notification without blocking. */
threadArray[old].value--;
}
- tprintf ("end, context back to %d\n", currentThread);
- if (currentThread != old)
- M2RTS_HaltC (__FILE__, __LINE__, __FUNCTION__,
- "wrong process id");
+ tprintf ("end, context back to %d\n", current);
+ if (current != old)
+ m2iso_M2RTS_HaltC (__FILE__, __LINE__, __FUNCTION__,
+ "wrong process id");
}
}
__gthread_mutex_unlock (&lock);
@@ -494,15 +505,15 @@ EXPORT(init) (void)
semArray = (threadSem **)malloc (sizeof (threadSem *) * SEM_POOL);
#endif
/* Create a thread control block for the main program (or process). */
- currentThread = newThread (); /* For the current initial thread. */
- threadArray[currentThread].p = pthread_self ();
- threadArray[currentThread].tid = currentThread;
- __GTHREAD_COND_INIT_FUNCTION (&threadArray[currentThread].run_counter);
- threadArray[currentThread].interruptLevel = 0;
+ int tid = newThread (); /* For the current initial thread. */
+ threadArray[tid].p = pthread_self ();
+ threadArray[tid].tid = tid;
+ __GTHREAD_COND_INIT_FUNCTION (&threadArray[tid].run_counter);
+ threadArray[tid].interruptLevel = 0;
/* The line below shouldn't be necessary as we are already running. */
- threadArray[currentThread].proc = never;
- threadArray[currentThread].waiting = false; /* We are running. */
- threadArray[currentThread].value = 0; /* No signal from anyone yet. */
+ threadArray[tid].proc = never;
+ threadArray[tid].waiting = false; /* We are running. */
+ threadArray[tid].value = 0; /* No signal from anyone yet. */
tprintf ("RTco initialized completed\n");
__gthread_mutex_unlock (&lock);
}
@@ -512,7 +523,7 @@ EXPORT(init) (void)
extern "C" void __attribute__((__constructor__))
M2EXPORT(ctor) (void)
{
- M2RTS_RegisterModule ("RTco",
- M2EXPORT(init), M2EXPORT(fini),
- M2EXPORT(dep));
+ m2iso_M2RTS_RegisterModule ("RTco", M2LIBNAME,
+ M2EXPORT(init), M2EXPORT(fini),
+ M2EXPORT(dep));
}
diff --git a/libgm2/libm2iso/m2rts.h b/libgm2/libm2iso/m2rts.h
index 1f3bc2d..97612c1 100644
--- a/libgm2/libm2iso/m2rts.h
+++ b/libgm2/libm2iso/m2rts.h
@@ -25,19 +25,25 @@ see the files COPYING3 and COPYING.RUNTIME respectively. If not, see
<http://www.gnu.org/licenses/>. */
+#define str(X) #X
+
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 m2iso_M2RTS_RequestDependant (const char *modulename, const char *libname, const char *dependancy);
+extern "C" void m2iso_M2RTS_RegisterModule (const char *modulename, const char *libname,
+ proc_con init, proc_con fini, proc_dep dependencies);
+extern "C" void m2pim_M2RTS_RegisterModule (const char *modulename, const char *libname,
+ proc_con init, proc_con fini, proc_dep dependencies);
+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);
+extern "C" void m2iso_M2_M2RTS_init (void);
-extern "C" void M2RTS_ConstructModules (const char *,
- int argc, char *argv[], char *envp[]);
-extern "C" void M2RTS_Terminate (void);
-extern "C" void M2RTS_DeconstructModules (void);
+extern "C" void m2iso_M2RTS_ConstructModules (const char *modulename, const char *libname,
+ int argc, char *argv[], char *envp[]);
+extern "C" void m2iso_M2RTS_Terminate (void);
+extern "C" void m2iso_M2RTS_DeconstructModules (void);
-extern "C" void M2RTS_HaltC (const char *filename, int line,
- const char *functionname, const char *desc)
- __attribute__ ((noreturn));
+extern "C" void m2iso_M2RTS_HaltC (const char *filename, int line,
+ const char *functionname, const char *desc)
+ __attribute__ ((noreturn));
diff --git a/libgm2/libm2iso/wrapsock.c b/libgm2/libm2iso/wrapsock.c
index 79c2d89..1582f24 100644
--- a/libgm2/libm2iso/wrapsock.c
+++ b/libgm2/libm2iso/wrapsock.c
@@ -26,6 +26,20 @@ see the files COPYING3 and COPYING.RUNTIME respectively. If not, see
#include "config.h"
+#define EXPORT(FUNC) m2iso ## _wrapsock_ ## FUNC
+#define IMPORT(MODULE,FUNC) m2iso ## _ ## MODULE ## _ ## FUNC
+#define M2EXPORT(FUNC) m2iso ## _M2_wrapsock_ ## FUNC
+#define M2LIBNAME "m2iso"
+
+/* This module should be rewritten to use C++. */
+
+typedef void (*proc_con) (int, char **, char **);
+typedef void (*proc_dep) (void);
+
+extern void m2iso_M2RTS_RequestDependant (const char *modulename, const char *libname, const char *dependancy);
+extern void m2iso_M2RTS_RegisterModule (const char *modulename, const char *libname,
+ proc_con init, proc_con fini, proc_dep dependencies);
+
#if defined(HAVE_SYS_TYPES_H)
#include "sys/types.h"
#endif
@@ -106,7 +120,7 @@ static openResults clientConnect (clientInfo *c);
structure, c, will have its fields initialized. */
openResults
-wrapsock_clientOpen (clientInfo *c, char *hostname, unsigned int length,
+EXPORT(clientOpen) (clientInfo *c, char *hostname, unsigned int length,
int portNo)
{
/* remove SIGPIPE which is raised on the server if the client is killed. */
@@ -133,7 +147,7 @@ wrapsock_clientOpen (clientInfo *c, char *hostname, unsigned int length,
structure, c, will have its fields initialized. */
openResults
-wrapsock_clientOpenIP (clientInfo *c, unsigned int ip, int portNo)
+EXPORT(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);
@@ -166,7 +180,7 @@ clientConnect (clientInfo *c)
/* getClientPortNo - returns the portNo from structure, c. */
int
-wrapsock_getClientPortNo (clientInfo *c)
+EXPORT(getClientPortNo) (clientInfo *c)
{
return c->portNo;
}
@@ -175,7 +189,7 @@ wrapsock_getClientPortNo (clientInfo *c)
which the client is connecting. */
void
-wrapsock_getClientHostname (clientInfo *c, char *hostname, unsigned int high)
+EXPORT(getClientHostname) (clientInfo *c, char *hostname, unsigned int high)
{
strncpy (hostname, c->hostname, high + 1);
}
@@ -183,7 +197,7 @@ wrapsock_getClientHostname (clientInfo *c, char *hostname, unsigned int high)
/* getClientSocketFd - returns the sockFd from structure, c. */
int
-wrapsock_getClientSocketFd (clientInfo *c)
+EXPORT(getClientSocketFd) (clientInfo *c)
{
return c->sockFd;
}
@@ -191,7 +205,7 @@ wrapsock_getClientSocketFd (clientInfo *c)
/* getClientIP - returns the sockFd from structure, s. */
unsigned int
-wrapsock_getClientIP (clientInfo *c)
+EXPORT(getClientIP) (clientInfo *c)
{
#if 0
printf("client ip = %s\n", inet_ntoa (c->sa.sin_addr.s_addr));
@@ -203,7 +217,7 @@ wrapsock_getClientIP (clientInfo *c)
available. */
unsigned int
-wrapsock_getPushBackChar (clientInfo *c, char *ch)
+EXPORT(getPushBackChar) (clientInfo *c, char *ch)
{
if (c->hasChar > 0)
{
@@ -218,7 +232,7 @@ wrapsock_getPushBackChar (clientInfo *c, char *ch)
character. */
unsigned int
-wrapsock_setPushBackChar (clientInfo *c, char ch)
+EXPORT(setPushBackChar) (clientInfo *c, char ch)
{
if (c->hasChar == MAXPBBUF)
return FALSE;
@@ -230,21 +244,35 @@ wrapsock_setPushBackChar (clientInfo *c, char ch)
/* getSizeOfClientInfo - returns the sizeof (opaque data type). */
unsigned int
-wrapsock_getSizeOfClientInfo (void)
+EXPORT(getSizeOfClientInfo) (void)
{
return sizeof (clientInfo);
}
#endif
-/* GNU Modula-2 link fodder. */
+
+/* GNU Modula-2 linking hooks. */
+
+void
+M2EXPORT(init) (int, char **, char **)
+{
+}
void
-_M2_wrapsock_init (void)
+M2EXPORT(fini) (int, char **, char **)
{
}
void
-_M2_wrapsock_fini (void)
+M2EXPORT(dep) (void)
+{
+}
+
+void __attribute__((__constructor__))
+M2EXPORT(ctor) (void)
{
+ m2iso_M2RTS_RegisterModule ("wrapsock", M2LIBNAME,
+ M2EXPORT(init), M2EXPORT(fini),
+ M2EXPORT(dep));
}
diff --git a/libgm2/libm2iso/wraptime.c b/libgm2/libm2iso/wraptime.cc
index 6d6929b..3cdc385 100644
--- a/libgm2/libm2iso/wraptime.c
+++ b/libgm2/libm2iso/wraptime.cc
@@ -25,6 +25,11 @@ see the files COPYING3 and COPYING.RUNTIME respectively. If not, see
<http://www.gnu.org/licenses/>. */
#include "config.h"
+#include <m2rts.h>
+
+#define EXPORT(FUNC) m2iso ## _wraptime_ ## FUNC
+#define M2EXPORT(FUNC) m2iso ## _M2_wraptime_ ## FUNC
+#define M2LIBNAME "m2iso"
#if defined(HAVE_SYS_TYPES_H)
#include "sys/types.h"
@@ -61,14 +66,14 @@ see the files COPYING3 and COPYING.RUNTIME respectively. If not, see
/* InitTimeval returns a newly created opaque type. */
#if defined(HAVE_TIMEVAL) && defined(HAVE_MALLOC_H)
-struct timeval *
-wraptime_InitTimeval (void)
+extern "C" struct timeval *
+EXPORT(InitTimeval) (void)
{
return (struct timeval *)malloc (sizeof (struct timeval));
}
#else
-void *
-wraptime_InitTimeval (void)
+extern "C" void *
+EXPORT(InitTimeval) (void)
{
return NULL;
}
@@ -76,8 +81,8 @@ wraptime_InitTimeval (void)
/* KillTimeval deallocates the memory associated with an opaque type. */
-struct timeval *
-wraptime_KillTimeval (void *tv)
+extern "C" struct timeval *
+EXPORT(KillTimeval) (void *tv)
{
#if defined(HAVE_MALLOC_H)
free (tv);
@@ -88,14 +93,14 @@ wraptime_KillTimeval (void *tv)
/* InitTimezone returns a newly created opaque type. */
#if defined(HAVE_STRUCT_TIMEZONE) && defined(HAVE_MALLOC_H)
-struct timezone *
-wraptime_InitTimezone (void)
+extern "C" struct timezone *
+EXPORT(InitTimezone) (void)
{
return (struct timezone *)malloc (sizeof (struct timezone));
}
#else
-void *
-wraptime_InitTimezone (void)
+extern "C" void *
+EXPORT(InitTimezone) (void)
{
return NULL;
}
@@ -104,8 +109,8 @@ wraptime_InitTimezone (void)
/* KillTimezone - deallocates the memory associated with an opaque
type. */
-struct timezone *
-wraptime_KillTimezone (struct timezone *tv)
+extern "C" struct timezone *
+EXPORT(KillTimezone) (struct timezone *tv)
{
#if defined(HAVE_MALLOC_H)
free (tv);
@@ -116,14 +121,14 @@ wraptime_KillTimezone (struct timezone *tv)
/* InitTM - returns a newly created opaque type. */
#if defined(HAVE_STRUCT_TM) && defined(HAVE_MALLOC_H)
-struct tm *
-wraptime_InitTM (void)
+extern "C" struct tm *
+EXPORT(InitTM) (void)
{
return (struct tm *)malloc (sizeof (struct tm));
}
#else
-void *
-wraptime_InitTM (void)
+extern "C" void *
+EXPORT(InitTM) (void)
{
return NULL;
}
@@ -131,8 +136,8 @@ wraptime_InitTM (void)
/* KillTM - deallocates the memory associated with an opaque type. */
-struct tm *
-wraptime_KillTM (struct tm *tv)
+extern "C" struct tm *
+EXPORT(KillTM) (struct tm *tv)
{
#if defined(HAVE_MALLOC_H)
free (tv);
@@ -144,14 +149,14 @@ wraptime_KillTM (struct tm *tv)
and, tz. It returns 0 on success. */
#if defined(HAVE_STRUCT_TIMEZONE) && defined(HAVE_GETTIMEOFDAY)
-int
-wraptime_gettimeofday (void *tv, struct timezone *tz)
+extern "C" int
+EXPORT(gettimeofday) (void *tv, struct timezone *tz)
{
return gettimeofday (tv, tz);
}
#else
-int
-wraptime_gettimeofday (void *tv, void *tz)
+extern "C" int
+EXPORT(gettimeofday) (void *tv, void *tz)
{
return -1;
}
@@ -161,14 +166,14 @@ wraptime_gettimeofday (void *tv, void *tz)
and, tz. It returns 0 on success. */
#if defined(HAVE_STRUCT_TIMEZONE) && defined(HAVE_SETTIMEOFDAY)
-int
-wraptime_settimeofday (void *tv, struct timezone *tz)
+extern "C" int
+EXPORT(settimeofday) (void *tv, struct timezone *tz)
{
return settimeofday (tv, tz);
}
#else
-int
-wraptime_settimeofday (void *tv, void *tz)
+extern "C" int
+EXPORT(settimeofday) (void *tv, void *tz)
{
return -1;
}
@@ -178,14 +183,14 @@ wraptime_settimeofday (void *tv, void *tz)
timeval structure. */
#if defined(HAVE_TIMEVAL)
-unsigned int
-wraptime_GetFractions (struct timeval *tv)
+extern "C" unsigned int
+EXPORT(GetFractions) (struct timeval *tv)
{
return (unsigned int)tv->tv_usec;
}
#else
-unsigned int
-wraptime_GetFractions (void *tv)
+extern "C" unsigned int
+EXPORT(GetFractions) (void *tv)
{
return (unsigned int)-1;
}
@@ -197,14 +202,14 @@ wraptime_GetFractions (void *tv)
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)
+extern "C" struct tm *
+EXPORT(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)
+extern "C" struct tm *
+EXPORT(localtime_r) (void *tv, struct tm *m)
{
return m;
}
@@ -213,14 +218,14 @@ wraptime_localtime_r (void *tv, struct tm *m)
/* wraptime_GetYear - returns the year from the structure, m. */
#if defined(HAVE_STRUCT_TM)
-unsigned int
-wraptime_GetYear (struct tm *m)
+extern "C" unsigned int
+EXPORT(GetYear) (struct tm *m)
{
return m->tm_year;
}
#else
-unsigned int
-wraptime_GetYear (void *m)
+extern "C" unsigned int
+EXPORT(GetYear) (void *m)
{
return (unsigned int)-1;
}
@@ -229,14 +234,14 @@ wraptime_GetYear (void *m)
/* wraptime_GetMonth - returns the month from the structure, m. */
#if defined(HAVE_STRUCT_TM)
-unsigned int
-wraptime_GetMonth (struct tm *m)
+extern "C" unsigned int
+EXPORT(GetMonth) (struct tm *m)
{
return m->tm_mon;
}
#else
-unsigned int
-wraptime_GetMonth (void *m)
+extern "C" unsigned int
+EXPORT(GetMonth) (void *m)
{
return (unsigned int)-1;
}
@@ -246,14 +251,14 @@ wraptime_GetMonth (void *m)
m. */
#if defined(HAVE_STRUCT_TM)
-unsigned int
-wraptime_GetDay (struct tm *m)
+extern "C" unsigned int
+EXPORT(GetDay) (struct tm *m)
{
return m->tm_mday;
}
#else
-unsigned int
-wraptime_GetDay (void *m)
+extern "C" unsigned int
+EXPORT(GetDay) (void *m)
{
return (unsigned int)-1;
}
@@ -263,14 +268,14 @@ wraptime_GetDay (void *m)
m. */
#if defined(HAVE_STRUCT_TM)
-unsigned int
-wraptime_GetHour (struct tm *m)
+extern "C" unsigned int
+EXPORT(GetHour) (struct tm *m)
{
return m->tm_hour;
}
#else
-unsigned int
-wraptime_GetHour (void *m)
+extern "C" unsigned int
+EXPORT(GetHour) (void *m)
{
return (unsigned int)-1;
}
@@ -280,14 +285,14 @@ wraptime_GetHour (void *m)
structure, m. */
#if defined(HAVE_STRUCT_TM)
-unsigned int
-wraptime_GetMinute (struct tm *m)
+extern "C" unsigned int
+EXPORT(GetMinute) (struct tm *m)
{
return m->tm_min;
}
#else
-unsigned int
-wraptime_GetMinute (void *m)
+extern "C" unsigned int
+EXPORT(GetMinute) (void *m)
{
return (unsigned int)-1;
}
@@ -298,8 +303,8 @@ wraptime_GetMinute (void *m)
A leap minute of value 60 will be truncated to 59. */
#if defined(HAVE_STRUCT_TM)
-unsigned int
-wraptime_GetSecond (struct tm *m)
+extern "C" unsigned int
+EXPORT(GetSecond) (struct tm *m)
{
if (m->tm_sec == 60)
return 59;
@@ -307,8 +312,8 @@ wraptime_GetSecond (struct tm *m)
return m->tm_sec;
}
#else
-unsigned int
-wraptime_GetSecond (void *m)
+extern "C" unsigned int
+EXPORT(GetSecond) (void *m)
{
return (unsigned int)-1;
}
@@ -317,14 +322,14 @@ wraptime_GetSecond (void *m)
/* wraptime_GetSummerTime - returns true if summer time is in effect. */
#if defined(HAVE_STRUCT_TIMEZONE)
-unsigned int
-wraptime_GetSummerTime (struct timezone *tz)
+extern "C" unsigned int
+EXPORT(GetSummerTime) (struct timezone *tz)
{
return tz->tz_dsttime != 0;
}
#else
-unsigned int
-wraptime_GetSummerTime (void *tz)
+extern "C" unsigned int
+EXPORT(GetSummerTime) (void *tz)
{
return FALSE;
}
@@ -333,14 +338,14 @@ wraptime_GetSummerTime (void *tz)
/* wraptime_GetDST - returns the number of minutes west of GMT. */
#if defined(HAVE_STRUCT_TIMEZONE)
-int
-wraptime_GetDST (struct timezone *tz)
+extern "C" int
+EXPORT(GetDST) (struct timezone *tz)
{
return tz->tz_minuteswest;
}
#else
-int
-wraptime_GetDST (void *tz)
+extern "C" int
+EXPORT(GetDST) (void *tz)
{
#if defined(INT_MIN)
return INT_MIN;
@@ -353,15 +358,15 @@ wraptime_GetDST (void *tz)
/* SetTimezone - set the timezone field inside timeval, tv. */
#if defined(HAVE_STRUCT_TIMEZONE)
-void
-wraptime_SetTimezone (struct timezone *tz, int zone, int minuteswest)
+extern "C" void
+EXPORT(SetTimezone) (struct timezone *tz, int zone, int minuteswest)
{
tz->tz_dsttime = zone;
tz->tz_minuteswest = minuteswest;
}
#else
-void
-wraptime_SetTimezone (void *tz, int zone, int minuteswest)
+extern "C" void
+EXPORT(SetTimezone) (void *tz, int zone, int minuteswest)
{
}
#endif
@@ -370,11 +375,11 @@ wraptime_SetTimezone (void *tz, int zone, int minuteswest)
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)
+extern "C" void
+EXPORT(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;
@@ -387,22 +392,38 @@ wraptime_SetTimeval (struct tm *t, unsigned int second, unsigned int minute,
t->tm_isdst = isdst;
}
#else
-void
-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)
+extern "C" void
+EXPORT(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)
{
}
#endif
/* init - init/finish functions for the module */
-void
-_M2_wraptime_init ()
+/* GNU Modula-2 linking hooks. */
+
+extern "C" void
+M2EXPORT(init) (int, char **, char **)
+{
+}
+
+extern "C" void
+M2EXPORT(fini) (int, char **, char **)
{
}
-void
-_M2_wraptime_fini ()
+
+extern "C" void
+M2EXPORT(dep) (void)
+{
+}
+
+extern "C" void __attribute__((__constructor__))
+M2EXPORT(ctor) (void)
{
+ m2iso_M2RTS_RegisterModule ("wraptime", M2LIBNAME,
+ M2EXPORT(init), M2EXPORT(fini),
+ M2EXPORT(dep));
}
diff --git a/libgm2/libm2log/Makefile.am b/libgm2/libm2log/Makefile.am
index 450673f..c38ec3c 100644
--- a/libgm2/libm2log/Makefile.am
+++ b/libgm2/libm2log/Makefile.am
@@ -131,7 +131,12 @@ libm2log_la_SOURCES = $(M2MODS) Break.c
libm2log_la_DEPENDENCIES = ../libm2pim/SYSTEM.def $(addsuffix .lo, $(basename $(libm2log_la_SOURCES)))
libm2log_la_CFLAGS = -I. -DBUILD_GM2_LIBS -I@srcdir@/../
-libm2log_la_M2FLAGS = -I../libm2pim -I$(GM2_SRC)/gm2-libs-log -I$(GM2_SRC)/gm2-libs -I$(GM2_SRC)/gm2-libs-iso -Wreturn-type -fcase
+libm2log_la_M2FLAGS = \
+ -fm2-pathname=m2pim -I../libm2pim \
+ -fm2-pathname=m2log -I$(GM2_SRC)/gm2-libs-log \
+ -fm2-pathname=m2pim -I$(GM2_SRC)/gm2-libs \
+ -fm2-pathname=m2iso -I$(GM2_SRC)/gm2-libs-iso \
+ -Wreturn-type -fcase -fm2-prefix=m2log
if TARGET_DARWIN
libm2log_la_link_flags = -Wl,-undefined,dynamic_lookup
else
diff --git a/libgm2/libm2log/Makefile.in b/libgm2/libm2log/Makefile.in
index c8d36a3..ef43b0d 100644
--- a/libgm2/libm2log/Makefile.in
+++ b/libgm2/libm2log/Makefile.in
@@ -471,7 +471,13 @@ FLAGS_TO_PASS = $(AM_MAKEFLAGS)
@BUILD_LOGLIB_TRUE@libm2log_la_SOURCES = $(M2MODS) Break.c
@BUILD_LOGLIB_TRUE@libm2log_la_DEPENDENCIES = ../libm2pim/SYSTEM.def $(addsuffix .lo, $(basename $(libm2log_la_SOURCES)))
@BUILD_LOGLIB_TRUE@libm2log_la_CFLAGS = -I. -DBUILD_GM2_LIBS -I@srcdir@/../
-@BUILD_LOGLIB_TRUE@libm2log_la_M2FLAGS = -I../libm2pim -I$(GM2_SRC)/gm2-libs-log -I$(GM2_SRC)/gm2-libs -I$(GM2_SRC)/gm2-libs-iso -Wreturn-type -fcase
+@BUILD_LOGLIB_TRUE@libm2log_la_M2FLAGS = \
+@BUILD_LOGLIB_TRUE@ -fm2-pathname=m2pim -I../libm2pim \
+@BUILD_LOGLIB_TRUE@ -fm2-pathname=m2log -I$(GM2_SRC)/gm2-libs-log \
+@BUILD_LOGLIB_TRUE@ -fm2-pathname=m2pim -I$(GM2_SRC)/gm2-libs \
+@BUILD_LOGLIB_TRUE@ -fm2-pathname=m2iso -I$(GM2_SRC)/gm2-libs-iso \
+@BUILD_LOGLIB_TRUE@ -Wreturn-type -fcase -fm2-prefix=m2log
+
@BUILD_LOGLIB_TRUE@@TARGET_DARWIN_FALSE@libm2log_la_link_flags =
@BUILD_LOGLIB_TRUE@@TARGET_DARWIN_TRUE@libm2log_la_link_flags = -Wl,-undefined,dynamic_lookup
@BUILD_LOGLIB_TRUE@libm2log_la_LINK = $(LINK) -version-info $(libtool_VERSION) $(libm2log_la_link_flags)
diff --git a/libgm2/libm2min/Makefile.am b/libgm2/libm2min/Makefile.am
index 6633549..4d6203a 100644
--- a/libgm2/libm2min/Makefile.am
+++ b/libgm2/libm2min/Makefile.am
@@ -104,8 +104,10 @@ toolexeclib_LTLIBRARIES = libm2min.la
libm2min_la_SOURCES = $(M2MODS) libc.c
libm2min_la_DEPENDENCIES = SYSTEM.def $(addsuffix .lo, $(basename $(libm2min_la_SOURCES)))
libm2min_la_CFLAGS = -I. -I$(GM2_SRC)/gm2-libs-min -I$(GM2_SRC)/gm2-libs
-libm2min_la_M2FLAGS = -I. -I$(GM2_SRC)/gm2-libs-min -I$(GM2_SRC)/gm2-libs -fno-exceptions \
- -fno-m2-plugin -fno-scaffold-dynamic -fno-scaffold-main
+libm2min_la_M2FLAGS = \
+ -fm2-pathname=m2min -I. -I$(GM2_SRC)/gm2-libs-min \
+ -fm2-pathname=m2pim -I$(GM2_SRC)/gm2-libs -fno-exceptions \
+ -fno-m2-plugin -fno-scaffold-dynamic -fno-scaffold-main -fm2-prefix=m2min
if TARGET_DARWIN
libm2min_la_link_flags = -Wl,-undefined,dynamic_lookup
else
diff --git a/libgm2/libm2min/Makefile.in b/libgm2/libm2min/Makefile.in
index 0ef7642..673d6d5 100644
--- a/libgm2/libm2min/Makefile.in
+++ b/libgm2/libm2min/Makefile.in
@@ -437,8 +437,10 @@ toolexeclib_LTLIBRARIES = libm2min.la
libm2min_la_SOURCES = $(M2MODS) libc.c
libm2min_la_DEPENDENCIES = SYSTEM.def $(addsuffix .lo, $(basename $(libm2min_la_SOURCES)))
libm2min_la_CFLAGS = -I. -I$(GM2_SRC)/gm2-libs-min -I$(GM2_SRC)/gm2-libs
-libm2min_la_M2FLAGS = -I. -I$(GM2_SRC)/gm2-libs-min -I$(GM2_SRC)/gm2-libs -fno-exceptions \
- -fno-m2-plugin -fno-scaffold-dynamic -fno-scaffold-main
+libm2min_la_M2FLAGS = \
+ -fm2-pathname=m2min -I. -I$(GM2_SRC)/gm2-libs-min \
+ -fm2-pathname=m2pim -I$(GM2_SRC)/gm2-libs -fno-exceptions \
+ -fno-m2-plugin -fno-scaffold-dynamic -fno-scaffold-main -fm2-prefix=m2min
@TARGET_DARWIN_FALSE@libm2min_la_link_flags =
@TARGET_DARWIN_TRUE@libm2min_la_link_flags = -Wl,-undefined,dynamic_lookup
diff --git a/libgm2/libm2pim/Makefile.am b/libgm2/libm2pim/Makefile.am
index 7bb08c0..eae14fa 100644
--- a/libgm2/libm2pim/Makefile.am
+++ b/libgm2/libm2pim/Makefile.am
@@ -161,12 +161,15 @@ libm2pim_la_SOURCES = $(M2MODS) \
errno.cc dtoa.cc \
ldtoa.cc termios.cc \
SysExceptions.cc target.c \
- wrapc.c cgetopt.cc
+ wrapc.cc cgetopt.cc
libm2pimdir = libm2pim
libm2pim_la_DEPENDENCIES = SYSTEM.def $(addsuffix .lo, $(basename $(libm2pim_la_SOURCES)))
libm2pim_la_CFLAGS = -I. -I.. -I$(GM2_SRC)/gm2-libs -I$(GM2_SRC)/gm2-libs-iso -DBUILD_GM2_LIBS -I@srcdir@/../ -I@srcdir@/../libm2iso
-libm2pim_la_M2FLAGS = -I. -I$(GM2_SRC)/gm2-libs -I$(GM2_SRC)/gm2-libs-iso -fm2-g -g -Wreturn-type -fcase
+libm2pim_la_M2FLAGS = \
+ -fm2-pathname=m2pim -I. -I$(GM2_SRC)/gm2-libs \
+ -fm2-pathname=m2iso -I$(GM2_SRC)/gm2-libs-iso \
+ -fm2-g -g -Wreturn-type -fcase -fm2-prefix=m2pim
if TARGET_DARWIN
libm2pim_la_link_flags = -Wl,-undefined,dynamic_lookup
else
diff --git a/libgm2/libm2pim/Makefile.in b/libgm2/libm2pim/Makefile.in
index 7a59893..ec81103 100644
--- a/libgm2/libm2pim/Makefile.in
+++ b/libgm2/libm2pim/Makefile.in
@@ -170,7 +170,7 @@ libm2pim_la_LIBADD =
@BUILD_PIMLIB_TRUE@ UnixArgs.lo Selective.lo sckt.lo errno.lo \
@BUILD_PIMLIB_TRUE@ dtoa.lo ldtoa.lo termios.lo \
@BUILD_PIMLIB_TRUE@ SysExceptions.lo libm2pim_la-target.lo \
-@BUILD_PIMLIB_TRUE@ libm2pim_la-wrapc.lo cgetopt.lo
+@BUILD_PIMLIB_TRUE@ wrapc.lo cgetopt.lo
libm2pim_la_OBJECTS = $(am_libm2pim_la_OBJECTS)
@BUILD_PIMLIB_TRUE@am_libm2pim_la_rpath = -rpath $(toolexeclibdir)
AM_V_P = $(am__v_P_@AM_V@)
@@ -529,12 +529,16 @@ FLAGS_TO_PASS = $(AM_MAKEFLAGS)
@BUILD_PIMLIB_TRUE@ errno.cc dtoa.cc \
@BUILD_PIMLIB_TRUE@ ldtoa.cc termios.cc \
@BUILD_PIMLIB_TRUE@ SysExceptions.cc target.c \
-@BUILD_PIMLIB_TRUE@ wrapc.c cgetopt.cc
+@BUILD_PIMLIB_TRUE@ wrapc.cc cgetopt.cc
@BUILD_PIMLIB_TRUE@libm2pimdir = libm2pim
@BUILD_PIMLIB_TRUE@libm2pim_la_DEPENDENCIES = SYSTEM.def $(addsuffix .lo, $(basename $(libm2pim_la_SOURCES)))
@BUILD_PIMLIB_TRUE@libm2pim_la_CFLAGS = -I. -I.. -I$(GM2_SRC)/gm2-libs -I$(GM2_SRC)/gm2-libs-iso -DBUILD_GM2_LIBS -I@srcdir@/../ -I@srcdir@/../libm2iso
-@BUILD_PIMLIB_TRUE@libm2pim_la_M2FLAGS = -I. -I$(GM2_SRC)/gm2-libs -I$(GM2_SRC)/gm2-libs-iso -fm2-g -g -Wreturn-type -fcase
+@BUILD_PIMLIB_TRUE@libm2pim_la_M2FLAGS = \
+@BUILD_PIMLIB_TRUE@ -fm2-pathname=m2pim -I. -I$(GM2_SRC)/gm2-libs \
+@BUILD_PIMLIB_TRUE@ -fm2-pathname=m2iso -I$(GM2_SRC)/gm2-libs-iso \
+@BUILD_PIMLIB_TRUE@ -fm2-g -g -Wreturn-type -fcase -fm2-prefix=m2pim
+
@BUILD_PIMLIB_TRUE@@TARGET_DARWIN_FALSE@libm2pim_la_link_flags =
@BUILD_PIMLIB_TRUE@@TARGET_DARWIN_TRUE@libm2pim_la_link_flags = -Wl,-undefined,dynamic_lookup
@BUILD_PIMLIB_TRUE@libm2pim_la_LINK = $(LINK) -version-info $(libtool_VERSION) $(libm2pim_la_link_flags)
@@ -628,9 +632,9 @@ distclean-compile:
@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/errno.Plo@am__quote@
@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/ldtoa.Plo@am__quote@
@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/libm2pim_la-target.Plo@am__quote@
-@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/libm2pim_la-wrapc.Plo@am__quote@
@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/sckt.Plo@am__quote@
@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/termios.Plo@am__quote@
+@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/wrapc.Plo@am__quote@
.c.o:
@am__fastdepCC_TRUE@ $(AM_V_CC)$(COMPILE) -MT $@ -MD -MP -MF $(DEPDIR)/$*.Tpo -c -o $@ $<
@@ -660,13 +664,6 @@ libm2pim_la-target.lo: target.c
@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@
@am__fastdepCC_FALSE@ $(AM_V_CC@am__nodep@)$(LIBTOOL) $(AM_V_lt) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(libm2pim_la_CFLAGS) $(CFLAGS) -c -o libm2pim_la-target.lo `test -f 'target.c' || echo '$(srcdir)/'`target.c
-libm2pim_la-wrapc.lo: wrapc.c
-@am__fastdepCC_TRUE@ $(AM_V_CC)$(LIBTOOL) $(AM_V_lt) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(libm2pim_la_CFLAGS) $(CFLAGS) -MT libm2pim_la-wrapc.lo -MD -MP -MF $(DEPDIR)/libm2pim_la-wrapc.Tpo -c -o libm2pim_la-wrapc.lo `test -f 'wrapc.c' || echo '$(srcdir)/'`wrapc.c
-@am__fastdepCC_TRUE@ $(AM_V_at)$(am__mv) $(DEPDIR)/libm2pim_la-wrapc.Tpo $(DEPDIR)/libm2pim_la-wrapc.Plo
-@AMDEP_TRUE@@am__fastdepCC_FALSE@ $(AM_V_CC)source='wrapc.c' object='libm2pim_la-wrapc.lo' libtool=yes @AMDEPBACKSLASH@
-@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@
-@am__fastdepCC_FALSE@ $(AM_V_CC@am__nodep@)$(LIBTOOL) $(AM_V_lt) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(libm2pim_la_CFLAGS) $(CFLAGS) -c -o libm2pim_la-wrapc.lo `test -f 'wrapc.c' || echo '$(srcdir)/'`wrapc.c
-
.cc.o:
@am__fastdepCXX_TRUE@ $(AM_V_CXX)$(CXXCOMPILE) -MT $@ -MD -MP -MF $(DEPDIR)/$*.Tpo -c -o $@ $<
@am__fastdepCXX_TRUE@ $(AM_V_at)$(am__mv) $(DEPDIR)/$*.Tpo $(DEPDIR)/$*.Po
diff --git a/libgm2/libm2pim/Selective.cc b/libgm2/libm2pim/Selective.cc
index 3c6b855..09c57f2 100644
--- a/libgm2/libm2pim/Selective.cc
+++ b/libgm2/libm2pim/Selective.cc
@@ -27,6 +27,10 @@ see the files COPYING3 and COPYING.RUNTIME respectively. If not, see
#include <config.h>
#include <m2rts.h>
+#define EXPORT(FUNC) m2pim ## _Selective_ ## FUNC
+#define M2EXPORT(FUNC) m2pim ## _M2_Selective_ ## FUNC
+#define M2LIBNAME "m2pim"
+
#if defined(HAVE_STDDEF_H)
/* Obtain a definition for NULL. */
#include <stddef.h>
@@ -83,15 +87,15 @@ see the files COPYING3 and COPYING.RUNTIME respectively. If not, see
#if defined(HAVE_STRUCT_TIMEVAL)
extern "C" int
-Selective_Select (int nooffds, fd_set *readfds, fd_set *writefds,
- fd_set *exceptfds, struct timeval *timeout)
+EXPORT(Select) (int nooffds, fd_set *readfds, fd_set *writefds,
+ fd_set *exceptfds, struct timeval *timeout)
{
return select (nooffds, readfds, writefds, exceptfds, timeout);
}
#else
extern "C" int
-Selective_Select (int nooffds, void *readfds, void *writefds, void *exceptfds,
- void *timeout)
+EXPORT(Select) (int nooffds, void *readfds, void *writefds, void *exceptfds,
+ void *timeout)
{
return 0;
}
@@ -101,7 +105,7 @@ Selective_Select (int nooffds, void *readfds, void *writefds, void *exceptfds,
#if defined(HAVE_STRUCT_TIMEVAL)
extern "C" struct timeval *
-Selective_InitTime (unsigned int sec, unsigned int usec)
+EXPORT(InitTime) (unsigned int sec, unsigned int usec)
{
struct timeval *t = (struct timeval *)malloc (sizeof (struct timeval));
@@ -111,14 +115,14 @@ Selective_InitTime (unsigned int sec, unsigned int usec)
}
extern "C" void
-Selective_GetTime (struct timeval *t, unsigned int *sec, unsigned int *usec)
+EXPORT(GetTime) (struct timeval *t, unsigned int *sec, unsigned int *usec)
{
*sec = (unsigned int)t->tv_sec;
*usec = (unsigned int)t->tv_usec;
}
extern "C" void
-Selective_SetTime (struct timeval *t, unsigned int sec, unsigned int usec)
+EXPORT(SetTime) (struct timeval *t, unsigned int sec, unsigned int usec)
{
t->tv_sec = sec;
t->tv_usec = usec;
@@ -127,7 +131,7 @@ Selective_SetTime (struct timeval *t, unsigned int sec, unsigned int usec)
/* KillTime frees the timeval structure and returns NULL. */
extern "C" struct timeval *
-Selective_KillTime (struct timeval *t)
+EXPORT(KillTime) (struct timeval *t)
{
#if defined(HAVE_STDLIB_H)
free (t);
@@ -138,7 +142,7 @@ Selective_KillTime (struct timeval *t)
/* InitSet returns a pointer to a FD_SET. */
extern "C" FDSET_T *
-Selective_InitSet (void)
+EXPORT(InitSet) (void)
{
#if defined(HAVE_STDLIB_H)
FDSET_T *s = (FDSET_T *)malloc (sizeof (FDSET_T));
@@ -152,7 +156,7 @@ Selective_InitSet (void)
/* KillSet frees the FD_SET and returns NULL. */
extern "C" FDSET_T *
-Selective_KillSet (FDSET_T *s)
+EXPORT(KillSet) (FDSET_T *s)
{
#if defined(HAVE_STDLIB_H)
free (s);
@@ -163,7 +167,7 @@ Selective_KillSet (FDSET_T *s)
/* FdZero generate an empty set. */
extern "C" void
-Selective_FdZero (FDSET_T *s)
+EXPORT(FdZero) (FDSET_T *s)
{
FD_ZERO (s);
}
@@ -171,7 +175,7 @@ Selective_FdZero (FDSET_T *s)
/* FS_Set include an element, fd, into set, s. */
extern "C" void
-Selective_FdSet (int fd, FDSET_T *s)
+EXPORT(FdSet) (int fd, FDSET_T *s)
{
FD_SET (fd, s);
}
@@ -179,7 +183,7 @@ Selective_FdSet (int fd, FDSET_T *s)
/* FdClr exclude an element, fd, from the set, s. */
extern "C" void
-Selective_FdClr (int fd, FDSET_T *s)
+EXPORT(FdClr) (int fd, FDSET_T *s)
{
FD_CLR (fd, s);
}
@@ -187,7 +191,7 @@ Selective_FdClr (int fd, FDSET_T *s)
/* FdIsSet return TRUE if, fd, is present in set, s. */
extern "C" int
-Selective_FdIsSet (int fd, FDSET_T *s)
+EXPORT(FdIsSet) (int fd, FDSET_T *s)
{
return FD_ISSET (fd, s);
}
@@ -197,69 +201,69 @@ Selective_FdIsSet (int fd, FDSET_T *s)
It returns zero (see man 3p gettimeofday). */
extern "C" int
-Selective_GetTimeOfDay (struct timeval *t)
+EXPORT(GetTimeOfDay) (struct timeval *t)
{
return gettimeofday (t, NULL);
}
#else
extern "C" void *
-Selective_InitTime (unsigned int sec, unsigned int usec)
+EXPORT(InitTime) (unsigned int sec, unsigned int usec)
{
return NULL;
}
extern "C" void *
-Selective_KillTime (void *t)
+EXPORT(KillTime) (void *t)
{
return NULL;
}
extern "C" void
-Selective_GetTime (void *t, unsigned int *sec, unsigned int *usec)
+EXPORT(GetTime) (void *t, unsigned int *sec, unsigned int *usec)
{
}
extern "C" void
-Selective_SetTime (void *t, unsigned int sec, unsigned int usec)
+EXPORT(SetTime) (void *t, unsigned int sec, unsigned int usec)
{
}
extern "C" FDSET_T *
-Selective_InitSet (void)
+EXPORT(InitSet) (void)
{
return NULL;
}
extern "C" FDSET_T *
-Selective_KillSet (void)
+EXPORT(KillSet) (void)
{
return NULL;
}
extern "C" void
-Selective_FdZero (void *s)
+EXPORT(FdZero) (void *s)
{
}
extern "C" void
-Selective_FdSet (int fd, void *s)
+EXPORT(FdSet) (int fd, void *s)
{
}
extern "C" void
-Selective_FdClr (int fd, void *s)
+EXPORT(FdClr) (int fd, void *s)
{
}
extern "C" int
-Selective_FdIsSet (int fd, void *s)
+EXPORT(FdIsSet) (int fd, void *s)
{
return 0;
}
extern "C" int
-Selective_GetTimeOfDay (void *t)
+EXPORT(GetTimeOfDay) (void *t)
{
return -1;
}
@@ -268,7 +272,7 @@ Selective_GetTimeOfDay (void *t)
/* MaxFdsPlusOne returns max (a + 1, b + 1). */
extern "C" int
-Selective_MaxFdsPlusOne (int a, int b)
+EXPORT(MaxFdsPlusOne) (int a, int b)
{
if (a > b)
return a + 1;
@@ -279,7 +283,7 @@ Selective_MaxFdsPlusOne (int a, int b)
/* WriteCharRaw writes a single character to the file descriptor. */
extern "C" void
-Selective_WriteCharRaw (int fd, char ch)
+EXPORT(WriteCharRaw) (int fd, char ch)
{
write (fd, &ch, 1);
}
@@ -287,7 +291,7 @@ Selective_WriteCharRaw (int fd, char ch)
/* ReadCharRaw read and return a single char from file descriptor, fd. */
extern "C" char
-Selective_ReadCharRaw (int fd)
+EXPORT(ReadCharRaw) (int fd)
{
char ch;
@@ -295,24 +299,27 @@ Selective_ReadCharRaw (int fd)
return ch;
}
+/* GNU Modula-2 linking hooks. */
+
extern "C" void
-_M2_Selective_init (int argc, char *argv[], char *envp[])
+M2EXPORT(init) (int, char **, char **)
{
}
extern "C" void
-_M2_Selective_fini (int argc, char *argv[], char *envp[])
+M2EXPORT(fini) (int, char **, char **)
{
}
extern "C" void
-_M2_Selective_dep (void)
+M2EXPORT(dep) (void)
{
}
extern "C" void __attribute__((__constructor__))
-_M2_Selective_ctor (void)
+M2EXPORT(ctor) (void)
{
- M2RTS_RegisterModule ("Selective", _M2_Selective_init, _M2_Selective_fini,
- _M2_Selective_dep);
+ m2pim_M2RTS_RegisterModule ("Selective", M2LIBNAME,
+ M2EXPORT(init), M2EXPORT(fini),
+ M2EXPORT(dep));
}
diff --git a/libgm2/libm2pim/SysExceptions.cc b/libgm2/libm2pim/SysExceptions.cc
index 2c37c7a..d93e79e 100644
--- a/libgm2/libm2pim/SysExceptions.cc
+++ b/libgm2/libm2pim/SysExceptions.cc
@@ -25,6 +25,11 @@ see the files COPYING3 and COPYING.RUNTIME respectively. If not, see
<http://www.gnu.org/licenses/>. */
#include <config.h>
+#include "m2rts.h"
+
+#define EXPORT(FUNC) m2pim ## _SysExceptions_ ## FUNC
+#define M2EXPORT(FUNC) m2pim ## _M2_SysExceptions_ ## FUNC
+#define M2LIBNAME "m2pim"
#if defined(HAVE_SIGNAL_H)
#include <signal.h>
@@ -172,7 +177,7 @@ sigfpeDespatcher (int signum, siginfo_t *info, void *ucontext)
}
extern "C" void
-SysExceptions_InitExceptionHandlers (
+EXPORT(InitExceptionHandlers) (
void (*indexf) (void *), void (*range) (void *), void (*casef) (void *),
void (*invalidloc) (void *), void (*function) (void *),
void (*wholevalue) (void *), void (*wholediv) (void *),
@@ -223,7 +228,7 @@ SysExceptions_InitExceptionHandlers (
#else
extern "C" void
-SysExceptions_InitExceptionHandlers (void *indexf, void *range, void *casef,
+EXPORT(InitExceptionHandlers) (void *indexf, void *range, void *casef,
void *invalidloc, void *function,
void *wholevalue, void *wholediv,
void *realvalue, void *realdiv,
@@ -236,23 +241,24 @@ SysExceptions_InitExceptionHandlers (void *indexf, void *range, void *casef,
extern "C" void
-_M2_SysExceptions_init (int, char *[], char *[])
+M2EXPORT(init) (int, char **, char **)
{
}
extern "C" void
-_M2_SysExceptions_fini (int, char *[], char *[])
+M2EXPORT(fini) (int, char **, char **)
{
}
extern "C" void
-_M2_SysExceptions_dep (void)
+M2EXPORT(dep) (void)
{
}
extern "C" void __attribute__((__constructor__))
-_M2_SysExceptions_ctor (void)
+M2EXPORT(ctor) (void)
{
- M2RTS_RegisterModule ("SysExceptions", _M2_SysExceptions_init, _M2_SysExceptions_fini,
- _M2_SysExceptions_dep);
+ m2pim_M2RTS_RegisterModule ("SysExceptions", M2LIBNAME,
+ M2EXPORT(init), M2EXPORT(fini),
+ M2EXPORT(dep));
}
diff --git a/libgm2/libm2pim/UnixArgs.cc b/libgm2/libm2pim/UnixArgs.cc
index 944a3cd..803188d 100644
--- a/libgm2/libm2pim/UnixArgs.cc
+++ b/libgm2/libm2pim/UnixArgs.cc
@@ -27,10 +27,13 @@ see the files COPYING3 and COPYING.RUNTIME respectively. If not, see
#include <config.h>
#include <m2rts.h>
+#define EXPORT(FUNC) m2pim ## _UnixArgs_ ## FUNC
+#define M2EXPORT(FUNC) m2pim ## _M2_UnixArgs_ ## FUNC
+#define M2LIBNAME "m2pim"
-extern "C" int UnixArgs_GetArgC (void);
-extern "C" char **UnixArgs_GetArgV (void);
-extern "C" char **UnixArgs_GetEnvV (void);
+extern "C" int EXPORT(GetArgC) (void);
+extern "C" char **EXPORT(GetArgV) (void);
+extern "C" char **EXPORT(GetEnvV) (void);
static int UnixArgs_ArgC;
static char **UnixArgs_ArgV;
@@ -40,7 +43,7 @@ static char **UnixArgs_EnvV;
/* GetArgC returns argc. */
extern "C" int
-UnixArgs_GetArgC (void)
+EXPORT(GetArgC) (void)
{
return UnixArgs_ArgC;
}
@@ -49,7 +52,7 @@ UnixArgs_GetArgC (void)
/* GetArgV returns argv. */
extern "C" char **
-UnixArgs_GetArgV (void)
+EXPORT(GetArgV) (void)
{
return UnixArgs_ArgV;
}
@@ -58,14 +61,16 @@ UnixArgs_GetArgV (void)
/* GetEnvV returns envv. */
extern "C" char **
-UnixArgs_GetEnvV (void)
+EXPORT(GetEnvV) (void)
{
return UnixArgs_EnvV;
}
+/* GNU Modula-2 linking hooks. */
+
extern "C" void
-_M2_UnixArgs_init (int argc, char *argv[], char *envp[])
+M2EXPORT(init) (int argc, char **argv, char **envp)
{
UnixArgs_ArgC = argc;
UnixArgs_ArgV = argv;
@@ -73,18 +78,19 @@ _M2_UnixArgs_init (int argc, char *argv[], char *envp[])
}
extern "C" void
-_M2_UnixArgs_fini (int argc, char *argv[], char *envp[])
+M2EXPORT(fini) (int, char **, char **)
{
}
extern "C" void
-_M2_UnixArgs_dep (void)
+M2EXPORT(dep) (void)
{
}
extern "C" void __attribute__((__constructor__))
-_M2_UnixArgs_ctor (void)
+M2EXPORT(ctor) (void)
{
- M2RTS_RegisterModule ("UnixArgs", _M2_UnixArgs_init, _M2_UnixArgs_fini,
- _M2_UnixArgs_dep);
+ m2pim_M2RTS_RegisterModule ("UnixArgs", M2LIBNAME,
+ M2EXPORT(init), M2EXPORT(fini),
+ M2EXPORT(dep));
}
diff --git a/libgm2/libm2pim/cgetopt.cc b/libgm2/libm2pim/cgetopt.cc
index 4e8ac9e..858c775 100644
--- a/libgm2/libm2pim/cgetopt.cc
+++ b/libgm2/libm2pim/cgetopt.cc
@@ -29,20 +29,24 @@ see the files COPYING3 and COPYING.RUNTIME respectively. If not, see
#include <getopt.h>
#include <m2rts.h>
-extern "C" {char *cgetopt_optarg;}
-extern "C" {int cgetopt_optind;}
-extern "C" {int cgetopt_opterr;}
-extern "C" {int cgetopt_optopt;}
+#define EXPORT(FUNC) m2pim ## _cgetopt_ ## FUNC
+#define M2EXPORT(FUNC) m2pim ## _M2_cgetopt_ ## FUNC
+#define M2LIBNAME "m2pim"
+
+extern "C" {char *EXPORT(optarg);}
+extern "C" {int EXPORT(optind);}
+extern "C" {int EXPORT(opterr);}
+extern "C" {int EXPORT(optopt);}
extern "C" char
-cgetopt_getopt (int argc, char *argv[], char *optstring)
+EXPORT(getopt) (int argc, char *argv[], char *optstring)
{
char r = getopt (argc, argv, optstring);
- cgetopt_optarg = optarg;
- cgetopt_optind = optind;
- cgetopt_opterr = opterr;
- cgetopt_optopt = optopt;
+ EXPORT(optarg) = optarg;
+ EXPORT(optind) = optind;
+ EXPORT(opterr) = opterr;
+ EXPORT(optopt) = optopt;
if (r == (char)-1)
return (char)0;
@@ -50,29 +54,29 @@ cgetopt_getopt (int argc, char *argv[], char *optstring)
}
extern "C" int
-cgetopt_getopt_long (int argc, char *argv[], char *optstring,
+EXPORT(getopt_long) (int argc, char *argv[], char *optstring,
const struct option *longopts, int *longindex)
{
int r = getopt_long (argc, argv, optstring, longopts, longindex);
- cgetopt_optarg = optarg;
- cgetopt_optind = optind;
- cgetopt_opterr = opterr;
- cgetopt_optopt = optopt;
+ EXPORT(optarg) = optarg;
+ EXPORT(optind) = optind;
+ EXPORT(opterr) = opterr;
+ EXPORT(optopt) = optopt;
return r;
}
extern "C" int
-cgetopt_getopt_long_only (int argc, char *argv[], char *optstring,
+EXPORT(getopt_long_only) (int argc, char *argv[], char *optstring,
const struct option *longopts, int *longindex)
{
int r = getopt_long_only (argc, argv, optstring, longopts, longindex);
- cgetopt_optarg = optarg;
- cgetopt_optind = optind;
- cgetopt_opterr = opterr;
- cgetopt_optopt = optopt;
+ EXPORT(optarg) = optarg;
+ EXPORT(optind) = optind;
+ EXPORT(opterr) = opterr;
+ EXPORT(optopt) = optopt;
return r;
}
@@ -86,7 +90,7 @@ typedef struct cgetopt_Options_s
/* InitOptions a constructor for Options. */
extern "C" cgetopt_Options *
-cgetopt_InitOptions (void)
+EXPORT(InitOptions) (void)
{
cgetopt_Options *o = (cgetopt_Options *)malloc (sizeof (cgetopt_Options));
o->cinfo = (struct option *)malloc (sizeof (struct option));
@@ -98,7 +102,7 @@ cgetopt_InitOptions (void)
up all allocated memory associated with o. */
extern "C" cgetopt_Options *
-cgetopt_KillOptions (cgetopt_Options *o)
+EXPORT(KillOptions) (cgetopt_Options *o)
{
free (o->cinfo);
free (o);
@@ -108,7 +112,7 @@ cgetopt_KillOptions (cgetopt_Options *o)
/* SetOption set option[index] with {name, has_arg, flag, val}. */
extern "C" void
-cgetopt_SetOption (cgetopt_Options *o, unsigned int index, char *name,
+EXPORT(SetOption) (cgetopt_Options *o, unsigned int index, char *name,
unsigned int has_arg, int *flag, int val)
{
if (index > o->high)
@@ -127,7 +131,7 @@ cgetopt_SetOption (cgetopt_Options *o, unsigned int index, char *name,
long options. */
extern "C" struct option *
-cgetopt_GetLongOptionArray (cgetopt_Options *o)
+EXPORT(GetLongOptionArray) (cgetopt_Options *o)
{
return o->cinfo;
}
@@ -135,23 +139,24 @@ cgetopt_GetLongOptionArray (cgetopt_Options *o)
/* GNU Modula-2 linking fodder. */
extern "C" void
-_M2_cgetopt_init (int, char *argv[], char *env[])
+M2EXPORT(init) (int, char *argv[], char *env[])
{
}
extern "C" void
-_M2_cgetopt_fini (int, char *argv[], char *env[])
+M2EXPORT(fini) (int, char *argv[], char *env[])
{
}
extern "C" void
-_M2_cgetopt_dep (void)
+M2EXPORT(dep) (void)
{
}
extern "C" void __attribute__((__constructor__))
-_M2_cgetopt_ctor (void)
+M2EXPORT(ctor) (void)
{
- M2RTS_RegisterModule ("cgetopt", _M2_cgetopt_init, _M2_cgetopt_fini,
- _M2_cgetopt_dep);
+ m2pim_M2RTS_RegisterModule ("cgetopt", M2LIBNAME,
+ M2EXPORT(init), M2EXPORT(fini),
+ M2EXPORT(dep));
}
diff --git a/libgm2/libm2pim/dtoa.cc b/libgm2/libm2pim/dtoa.cc
index 95d24d4..c6b573b 100644
--- a/libgm2/libm2pim/dtoa.cc
+++ b/libgm2/libm2pim/dtoa.cc
@@ -29,6 +29,10 @@ see the files COPYING3 and COPYING.RUNTIME respectively. If not, see
#include <config.h>
#include <m2rts.h>
+#define EXPORT(FUNC) m2pim ## _dtoa_ ## FUNC
+#define M2EXPORT(FUNC) m2pim ## _M2_dtoa_ ## FUNC
+#define M2LIBNAME "m2pim"
+
#if defined(HAVE_STRINGS)
#include <strings.h>
#endif
@@ -106,7 +110,7 @@ typedef enum Mode { maxsignicant, decimaldigits } Mode;
contain ndigits past the decimal point (ndigits may be negative). */
extern "C" double
-dtoa_strtod (const char *s, int *error)
+EXPORT(strtod) (const char *s, int *error)
{
char *endp;
double d;
@@ -130,7 +134,7 @@ dtoa_strtod (const char *s, int *error)
it also removes the decimal point and exponent from string, p. */
extern "C" int
-dtoa_calcmaxsig (char *p, int ndigits)
+EXPORT(calcmaxsig) (char *p, int ndigits)
{
char *e;
char *o;
@@ -161,7 +165,7 @@ dtoa_calcmaxsig (char *p, int ndigits)
Ie ndigits is the number of digits after the '.'. */
extern "C" int
-dtoa_calcdecimal (char *p, int str_size, int ndigits)
+EXPORT(calcdecimal) (char *p, int str_size, int ndigits)
{
char *e;
char *o;
@@ -195,7 +199,7 @@ dtoa_calcdecimal (char *p, int str_size, int ndigits)
}
extern "C" int
-dtoa_calcsign (char *p, int str_size)
+EXPORT(calcsign) (char *p, int str_size)
{
if (p[0] == '-')
{
@@ -207,7 +211,7 @@ dtoa_calcsign (char *p, int str_size)
}
extern "C" char *
-dtoa_dtoa (double d, int mode, int ndigits, int *decpt, int *sign)
+EXPORT(dtoa) (double d, int mode, int ndigits, int *decpt, int *sign)
{
char format[50];
char *p;
@@ -220,15 +224,15 @@ dtoa_dtoa (double d, int mode, int ndigits, int *decpt, int *sign)
p = (char *) malloc (ndigits);
snprintf (format, 50, "%s%d%s", "%.", ndigits - 20, "E");
snprintf (p, ndigits, format, d);
- *sign = dtoa_calcsign (p, ndigits);
- *decpt = dtoa_calcmaxsig (p, ndigits);
+ *sign = EXPORT(calcsign) (p, ndigits);
+ *decpt = EXPORT(calcmaxsig) (p, ndigits);
return p;
case decimaldigits:
p = (char *) malloc (MAX_FP_DIGITS + 20);
snprintf (format, 50, "%s%d%s", "%.", MAX_FP_DIGITS, "E");
snprintf (p, MAX_FP_DIGITS + 20, format, d);
- *sign = dtoa_calcsign (p, MAX_FP_DIGITS + 20);
- *decpt = dtoa_calcdecimal (p, MAX_FP_DIGITS + 20, ndigits);
+ *sign = EXPORT(calcsign) (p, MAX_FP_DIGITS + 20);
+ *decpt = EXPORT(calcdecimal) (p, MAX_FP_DIGITS + 20, ndigits);
return p;
default:
abort ();
@@ -241,24 +245,25 @@ dtoa_dtoa (double d, int mode, int ndigits, int *decpt, int *sign)
/* GNU Modula-2 linking hooks. */
extern "C" void
-_M2_dtoa_init (int, char **, char **)
+M2EXPORT(init) (int, char **, char **)
{
}
extern "C" void
-_M2_dtoa_fini (int, char **, char **)
+M2EXPORT(fini) (int, char **, char **)
{
}
extern "C" void
-_M2_dtoa_dep (void)
+M2EXPORT(dep) (void)
{
}
extern "C" void __attribute__((__constructor__))
-_M2_dtoa_ctor (void)
+M2EXPORT(ctor) (void)
{
- M2RTS_RegisterModule ("dtoa", _M2_dtoa_init, _M2_dtoa_fini,
- _M2_dtoa_dep);
+ m2pim_M2RTS_RegisterModule ("dtoa", M2LIBNAME,
+ M2EXPORT(init), M2EXPORT(fini),
+ M2EXPORT(dep));
}
#endif
diff --git a/libgm2/libm2pim/errno.cc b/libgm2/libm2pim/errno.cc
index 296ab0b..db8628f 100644
--- a/libgm2/libm2pim/errno.cc
+++ b/libgm2/libm2pim/errno.cc
@@ -36,8 +36,12 @@ see the files COPYING3 and COPYING.RUNTIME respectively. If not, see
#include "m2rts.h"
+#define EXPORT(FUNC) m2pim ## _errno_ ## FUNC
+#define M2EXPORT(FUNC) m2pim ## _M2_errno_ ## FUNC
+#define M2LIBNAME "m2pim"
+
extern "C" int
-errno_geterrno (void)
+EXPORT(geterrno) (void)
{
#if defined(HAVE_ERRNO_H) || defined(HAVE_SYS_ERRNO_H)
return errno;
@@ -47,23 +51,24 @@ errno_geterrno (void)
}
extern "C" void
-_M2_errno_init (int, char *[], char *[])
+M2EXPORT(init) (int, char **, char **)
{
}
extern "C" void
-_M2_errno_fini (int, char *[], char *[])
+M2EXPORT(fini) (int, char **, char **)
{
}
extern "C" void
-_M2_errno_dep (void)
+M2EXPORT(dep) (void)
{
}
extern "C" void __attribute__((__constructor__))
-_M2_errno_ctor (void)
+M2EXPORT(ctor) (void)
{
- M2RTS_RegisterModule ("errno", _M2_errno_init, _M2_errno_fini,
- _M2_errno_dep);
+ m2pim_M2RTS_RegisterModule ("errno", M2LIBNAME,
+ M2EXPORT(init), M2EXPORT(fini),
+ M2EXPORT(dep));
}
diff --git a/libgm2/libm2pim/ldtoa.cc b/libgm2/libm2pim/ldtoa.cc
index 8b44983..9250ca4 100644
--- a/libgm2/libm2pim/ldtoa.cc
+++ b/libgm2/libm2pim/ldtoa.cc
@@ -29,6 +29,11 @@ see the files COPYING3 and COPYING.RUNTIME respectively. If not, see
#include <config.h>
#include <m2rts.h>
+#define EXPORT(FUNC) m2pim ## _ldtoa_ ## FUNC
+#define IMPORT(MODULE,FUNC) m2pim ## _ ## MODULE ## _ ## FUNC
+#define M2EXPORT(FUNC) m2pim ## _M2_ldtoa_ ## FUNC
+#define M2LIBNAME "m2pim"
+
#if defined(HAVE_STRINGS)
#include <strings.h>
#endif
@@ -97,9 +102,9 @@ see the files COPYING3 and COPYING.RUNTIME respectively. If not, see
typedef enum Mode { maxsignicant, decimaldigits } Mode;
-extern "C" int dtoa_calcmaxsig (char *p, int ndigits);
-extern "C" int dtoa_calcdecimal (char *p, int str_size, int ndigits);
-extern "C" int dtoa_calcsign (char *p, int str_size);
+extern "C" int IMPORT(dtoa,calcmaxsig) (char *p, int ndigits);
+extern "C" int IMPORT(dtoa,calcdecimal) (char *p, int str_size, int ndigits);
+extern "C" int IMPORT(dtoa,calcsign) (char *p, int str_size);
/* maxsignicant return a string containing max(1,ndigits) significant
digits. The return string contains the string produced by snprintf.
@@ -108,7 +113,7 @@ extern "C" int dtoa_calcsign (char *p, int str_size);
contain ndigits past the decimal point (ndigits may be negative). */
extern "C" long double
-ldtoa_strtold (const char *s, int *error)
+EXPORT(strtold) (const char *s, int *error)
{
char *endp;
long double d;
@@ -134,7 +139,7 @@ ldtoa_strtold (const char *s, int *error)
}
extern "C" char *
-ldtoa_ldtoa (long double d, int mode, int ndigits, int *decpt, int *sign)
+EXPORT(ldtoa) (long double d, int mode, int ndigits, int *decpt, int *sign)
{
char format[50];
char *p;
@@ -147,15 +152,15 @@ ldtoa_ldtoa (long double d, int mode, int ndigits, int *decpt, int *sign)
p = (char *) malloc (ndigits);
snprintf (format, 50, "%s%d%s", "%.", ndigits - 20, "LE");
snprintf (p, ndigits, format, d);
- *sign = dtoa_calcsign (p, ndigits);
- *decpt = dtoa_calcmaxsig (p, ndigits);
+ *sign = IMPORT(dtoa,calcsign) (p, ndigits);
+ *decpt = IMPORT(dtoa,calcmaxsig) (p, ndigits);
return p;
case decimaldigits:
p = (char *) malloc (MAX_FP_DIGITS + 20);
snprintf (format, 50, "%s%d%s", "%.", MAX_FP_DIGITS, "LE");
snprintf (p, MAX_FP_DIGITS + 20, format, d);
- *sign = dtoa_calcsign (p, MAX_FP_DIGITS + 20);
- *decpt = dtoa_calcdecimal (p, MAX_FP_DIGITS + 20, ndigits);
+ *sign = IMPORT(dtoa,calcsign) (p, MAX_FP_DIGITS + 20);
+ *decpt = IMPORT(dtoa,calcdecimal) (p, MAX_FP_DIGITS + 20, ndigits);
return p;
default:
abort ();
@@ -166,24 +171,25 @@ ldtoa_ldtoa (long double d, int mode, int ndigits, int *decpt, int *sign)
/* GNU Modula-2 linking hooks. */
extern "C" void
-_M2_ldtoa_init (int, char **, char **)
+M2EXPORT(init) (int, char **, char **)
{
}
extern "C" void
-_M2_ldtoa_fini (int, char **, char **)
+M2EXPORT(fini) (int, char **, char **)
{
}
extern "C" void
-_M2_ldtoa_dep (void)
+M2EXPORT(dep) (void)
{
}
extern "C" void __attribute__((__constructor__))
-_M2_ldtoa_ctor (void)
+M2EXPORT(ctor) (void)
{
- M2RTS_RegisterModule ("ldtoa", _M2_ldtoa_init, _M2_ldtoa_fini,
- _M2_ldtoa_dep);
+ m2pim_M2RTS_RegisterModule ("ldtoa", M2LIBNAME,
+ M2EXPORT(init), M2EXPORT(fini),
+ M2EXPORT(dep));
}
#endif
diff --git a/libgm2/libm2pim/sckt.cc b/libgm2/libm2pim/sckt.cc
index 585ed14..ee579c2 100644
--- a/libgm2/libm2pim/sckt.cc
+++ b/libgm2/libm2pim/sckt.cc
@@ -27,6 +27,10 @@ see the files COPYING3 and COPYING.RUNTIME respectively. If not, see
#include <config.h>
#include <m2rts.h>
+#define EXPORT(FUNC) m2pim ## _sckt_ ## FUNC
+#define M2EXPORT(FUNC) m2pim ## _M2_sckt_ ## FUNC
+#define M2LIBNAME "m2pim"
+
#if defined(HAVE_SYS_TYPES_H)
#include <sys/types.h>
#endif
@@ -125,7 +129,7 @@ localExit (int i)
This method attempts to use the port specified by the parameter. */
extern "C" tcpServerState *
-tcpServerEstablishPort (int portNo)
+EXPORT(tcpServerEstablishPort) (int portNo)
{
tcpServerState *s = (tcpServerState *)malloc (sizeof (tcpServerState));
int b, p, n;
@@ -180,16 +184,16 @@ tcpServerEstablishPort (int portNo)
information about a socket declared to receive tcp connections. */
extern "C" tcpServerState *
-tcpServerEstablish (void)
+EXPORT(tcpServerEstablish) (void)
{
- return tcpServerEstablishPort (PORTSTART);
+ return EXPORT(tcpServerEstablishPort) (PORTSTART);
}
/* tcpServerAccept returns a file descriptor once a client has connected and
been accepted. */
extern "C" int
-tcpServerAccept (tcpServerState *s)
+EXPORT(tcpServerAccept) (tcpServerState *s)
{
socklen_t i = sizeof (s->isa);
int t;
@@ -204,7 +208,7 @@ tcpServerAccept (tcpServerState *s)
/* tcpServerPortNo returns the portNo from structure, s. */
extern "C" int
-tcpServerPortNo (tcpServerState *s)
+EXPORT(tcpServerPortNo) (tcpServerState *s)
{
return s->portNo;
}
@@ -212,7 +216,7 @@ tcpServerPortNo (tcpServerState *s)
/* tcpServerSocketFd returns the sockFd from structure, s. */
extern "C" int
-tcpServerSocketFd (tcpServerState *s)
+EXPORT(tcpServerSocketFd) (tcpServerState *s)
{
return s->sockFd;
}
@@ -220,7 +224,7 @@ tcpServerSocketFd (tcpServerState *s)
/* getLocalIP returns the IP address of this machine. */
extern "C" unsigned int
-getLocalIP (tcpServerState *s)
+EXPORT(getLocalIP) (tcpServerState *s)
{
char hostname[1024];
struct hostent *hp;
@@ -262,7 +266,7 @@ getLocalIP (tcpServerState *s)
/* tcpServerIP returns the IP address from structure s. */
extern "C" int
-tcpServerIP (tcpServerState *s)
+EXPORT(tcpServerIP) (tcpServerState *s)
{
return *((int *)s->hp->h_addr_list[0]);
}
@@ -271,7 +275,7 @@ tcpServerIP (tcpServerState *s)
has connected to server s. */
extern "C" unsigned int
-tcpServerClientIP (tcpServerState *s)
+EXPORT(tcpServerClientIP) (tcpServerState *s)
{
unsigned int ip;
@@ -285,7 +289,7 @@ tcpServerClientIP (tcpServerState *s)
has connected to server s. */
extern "C" unsigned int
-tcpServerClientPortNo (tcpServerState *s)
+EXPORT(tcpServerClientPortNo) (tcpServerState *s)
{
return s->isa.sin_port;
}
@@ -309,7 +313,7 @@ typedef struct
connected to, serverName:portNo. */
extern "C" tcpClientState *
-tcpClientSocket (char *serverName, int portNo)
+EXPORT(tcpClientSocket) (char *serverName, int portNo)
{
tcpClientState *s = (tcpClientState *)malloc (sizeof (tcpClientState));
@@ -342,7 +346,7 @@ tcpClientSocket (char *serverName, int portNo)
connected to, ip:portNo. */
extern "C" tcpClientState *
-tcpClientSocketIP (unsigned int ip, int portNo)
+EXPORT(tcpClientSocketIP) (unsigned int ip, int portNo)
{
tcpClientState *s = (tcpClientState *)malloc (sizeof (tcpClientState));
@@ -368,7 +372,7 @@ tcpClientSocketIP (unsigned int ip, int portNo)
once a connect has been performed. */
extern "C" int
-tcpClientConnect (tcpClientState *s)
+EXPORT(tcpClientConnect) (tcpClientState *s)
{
if (connect (s->sockFd, (struct sockaddr *)&s->sa, sizeof (s->sa)) < 0)
ERROR ("failed to connect to the TCP server");
@@ -379,7 +383,7 @@ tcpClientConnect (tcpClientState *s)
/* tcpClientPortNo returns the portNo from structure s. */
extern "C" int
-tcpClientPortNo (tcpClientState *s)
+EXPORT(tcpClientPortNo) (tcpClientState *s)
{
return s->portNo;
}
@@ -387,7 +391,7 @@ tcpClientPortNo (tcpClientState *s)
/* tcpClientSocketFd returns the sockFd from structure s. */
extern "C" int
-tcpClientSocketFd (tcpClientState *s)
+EXPORT(tcpClientSocketFd) (tcpClientState *s)
{
return s->sockFd;
}
@@ -395,7 +399,7 @@ tcpClientSocketFd (tcpClientState *s)
/* tcpClientIP returns the sockFd from structure s. */
extern "C" int
-tcpClientIP (tcpClientState *s)
+EXPORT(tcpClientIP) (tcpClientState *s)
{
#if defined(DEBUGGING)
printf ("client ip = %s\n", inet_ntoa (s->sa.sin_addr.s_addr));
@@ -407,23 +411,24 @@ tcpClientIP (tcpClientState *s)
/* GNU Modula-2 link fodder. */
extern "C" void
-_M2_sckt_init (int, char *[], char *[])
+M2EXPORT(init) (int, char *[], char *[])
{
}
extern "C" void
-_M2_sckt_finish (int, char *[], char *[])
+M2EXPORT(finish) (int, char *[], char *[])
{
}
extern "C" void
-_M2_sckt_dep (void)
+M2EXPORT(dep) (void)
{
}
extern "C" void __attribute__((__constructor__))
-_M2_sckt_ctor (void)
+M2EXPORT(ctor) (void)
{
- M2RTS_RegisterModule ("sckt", _M2_sckt_init, _M2_sckt_finish,
- _M2_sckt_dep);
+ m2pim_M2RTS_RegisterModule ("sckt", M2LIBNAME,
+ M2EXPORT(init), M2EXPORT(finish),
+ M2EXPORT(dep));
}
diff --git a/libgm2/libm2pim/termios.cc b/libgm2/libm2pim/termios.cc
index 55818d2..5812837 100644
--- a/libgm2/libm2pim/termios.cc
+++ b/libgm2/libm2pim/termios.cc
@@ -27,6 +27,10 @@ see the files COPYING3 and COPYING.RUNTIME respectively. If not, see
#include <config.h>
#include <m2rts.h>
+#define EXPORT(FUNC) m2pim ## _termios_ ## FUNC
+#define M2EXPORT(FUNC) m2pim ## _M2_termios_ ## FUNC
+#define M2LIBNAME "m2pim"
+
#if defined(HAVE_STDIO_H)
#include <stdio.h>
#endif
@@ -60,8 +64,6 @@ void _M2_termios_finish (void);
#if defined(HAVE_TERMIOS_H)
-#define EXPORT(X) termios##_##X
-
typedef enum {
vintr,
vquit,
@@ -1964,23 +1966,23 @@ EXPORT (SetChar) (struct termios *t, ControlChar c, char ch)
#endif
extern "C" void
-_M2_termios_init (int, char *[], char *[])
+M2EXPORT(init) (int, char *argv[], char *env[])
{
}
extern "C" void
-_M2_termios_fini (int, char *[], char *[])
+M2EXPORT(fini) (int, char *argv[], char *env[])
{
}
extern "C" void
-_M2_termios_dep (void)
+M2EXPORT(dep) (void)
{
}
extern "C" void __attribute__((__constructor__))
-_M2_termios_ctor (void)
+M2EXPORT(ctor) (void)
{
- M2RTS_RegisterModule ("termios", _M2_termios_init, _M2_termios_fini,
- _M2_termios_dep);
+ m2pim_M2RTS_RegisterModule ("termios", M2LIBNAME,
+ M2EXPORT(init), M2EXPORT(fini), M2EXPORT(dep));
}
diff --git a/libgm2/libm2pim/wrapc.c b/libgm2/libm2pim/wrapc.cc
index 8e35949..0412ccc 100644
--- a/libgm2/libm2pim/wrapc.c
+++ b/libgm2/libm2pim/wrapc.cc
@@ -25,6 +25,11 @@ see the files COPYING3 and COPYING.RUNTIME respectively. If not, see
<http://www.gnu.org/licenses/>. */
#include <config.h>
+#include <m2rts.h>
+
+#define EXPORT(FUNC) m2pim ## _wrapc_ ## FUNC
+#define M2EXPORT(FUNC) m2pim ## _M2_wrapc_ ## FUNC
+#define M2LIBNAME "m2pim"
#if defined(HAVE_MATH_H)
#include <math.h>
@@ -69,11 +74,11 @@ see the files COPYING3 and COPYING.RUNTIME respectively. If not, see
/* strtime returns the address of a string which describes the
local time. */
-char *
-wrapc_strtime (void)
+extern "C" char *
+EXPORT(strtime) (void)
{
#if defined(HAVE_CTIME)
- time_t clock = time ((void *)0);
+ time_t clock = time (NULL);
char *string = ctime (&clock);
string[24] = (char)0;
@@ -84,8 +89,8 @@ wrapc_strtime (void)
#endif
}
-int
-wrapc_filesize (int f, unsigned int *low, unsigned int *high)
+extern "C" int
+EXPORT(filesize) (int f, unsigned int *low, unsigned int *high)
{
#if defined(HAVE_SYS_STAT_H) && defined(HAVE_STRUCT_STAT)
struct stat s;
@@ -104,8 +109,8 @@ wrapc_filesize (int f, unsigned int *low, unsigned int *high)
/* filemtime returns the mtime of a file, f. */
-int
-wrapc_filemtime (int f)
+extern "C" int
+EXPORT(filemtime) (int f)
{
#if defined(HAVE_SYS_STAT_H) && defined(HAVE_STRUCT_STAT)
struct stat s;
@@ -122,8 +127,8 @@ wrapc_filemtime (int f)
/* fileinode returns the inode associated with a file, f. */
#if defined(HAVE_SYS_STAT_H) && defined(HAVE_STRUCT_STAT)
-ino_t
-wrapc_fileinode (int f, unsigned int *low, unsigned int *high)
+extern "C" ino_t
+EXPORT(fileinode) (int f, unsigned int *low, unsigned int *high)
{
struct stat s;
@@ -140,8 +145,8 @@ wrapc_fileinode (int f, unsigned int *low, unsigned int *high)
return -1;
}
#else
-int
-wrapc_fileinode (int f, unsigned int *low, unsigned int *high)
+extern "C" int
+EXPORT(fileinode) (int f, unsigned int *low, unsigned int *high)
{
*low = 0;
*high = 0;
@@ -151,8 +156,8 @@ wrapc_fileinode (int f, unsigned int *low, unsigned int *high)
/* getrand returns a random number between 0..n-1. */
-int
-wrapc_getrand (int n)
+extern "C" int
+EXPORT(getrand) (int n)
{
return rand () % n;
}
@@ -160,8 +165,8 @@ wrapc_getrand (int n)
#if defined(HAVE_PWD_H)
#include <pwd.h>
-char *
-wrapc_getusername (void)
+extern "C" char *
+EXPORT(getusername) (void)
{
return getpwuid (getuid ())->pw_gecos;
}
@@ -169,8 +174,8 @@ wrapc_getusername (void)
/* getnameuidgid fills in the, uid, and, gid, which represents
user, name. */
-void
-wrapc_getnameuidgid (char *name, int *uid, int *gid)
+extern "C" void
+EXPORT(getnameuidgid) (char *name, int *uid, int *gid)
{
struct passwd *p = getpwnam (name);
@@ -186,22 +191,22 @@ wrapc_getnameuidgid (char *name, int *uid, int *gid)
}
}
#else
-char *
-wrapc_getusername (void)
+extern "C" char *
+EXPORT(getusername) (void)
{
return "unknown";
}
-void
-wrapc_getnameuidgid (char *name, int *uid, int *gid)
+extern "C" void
+EXPORT(getnameuidgid) (char *name, int *uid, int *gid)
{
*uid = -1;
*gid = -1;
}
#endif
-int
-wrapc_signbit (double r)
+extern "C" int
+EXPORT(signbit) (double r)
{
#if defined(HAVE_SIGNBIT)
@@ -213,8 +218,8 @@ wrapc_signbit (double r)
#endif
}
-int
-wrapc_signbitl (long double r)
+extern "C" int
+EXPORT(signbitl) (long double r)
{
#if defined(HAVE_SIGNBITL)
@@ -226,8 +231,8 @@ wrapc_signbitl (long double r)
#endif
}
-int
-wrapc_signbitf (float r)
+extern "C" int
+EXPORT(signbitf) (float r)
{
#if defined(HAVE_SIGNBITF)
@@ -242,8 +247,8 @@ wrapc_signbitf (float r)
/* isfinite provide non builtin alternative to the gcc builtin
isfinite. Returns 1 if x is finite and 0 if it is not. */
-int
-wrapc_isfinite (double x)
+extern "C" int
+EXPORT(isfinite) (double x)
{
#if defined(FP_NAN) && defined(FP_INFINITE)
return (fpclassify (x) != FP_NAN && fpclassify (x) != FP_INFINITE);
@@ -255,8 +260,8 @@ wrapc_isfinite (double x)
/* isfinitel provide non builtin alternative to the gcc builtin
isfinite. Returns 1 if x is finite and 0 if it is not. */
-int
-wrapc_isfinitel (long double x)
+extern "C" int
+EXPORT(isfinitel) (long double x)
{
#if defined(FP_NAN) && defined(FP_INFINITE)
return (fpclassify (x) != FP_NAN && fpclassify (x) != FP_INFINITE);
@@ -268,8 +273,8 @@ wrapc_isfinitel (long double x)
/* isfinitef provide non builtin alternative to the gcc builtin
isfinite. Returns 1 if x is finite and 0 if it is not. */
-int
-wrapc_isfinitef (float x)
+extern "C" int
+EXPORT(isfinitef) (float x)
{
#if defined(FP_NAN) && defined(FP_INFINITE)
return (fpclassify (x) != FP_NAN && fpclassify (x) != FP_INFINITE);
@@ -278,20 +283,27 @@ wrapc_isfinitef (float x)
#endif
}
-/* init/finish are GNU Modula-2 linking fodder. */
+/* GNU Modula-2 linking hooks. */
-void
-_M2_wrapc_init ()
+extern "C" void
+M2EXPORT(init) (int, char **, char **)
{
}
-void
-_M2_wrapc_fini ()
+extern "C" void
+M2EXPORT(fini) (int, char **, char **)
{
}
-void
-_M2_wrapc_ctor ()
+extern "C" void
+M2EXPORT(dep) (void)
{
}
+extern "C" void __attribute__((__constructor__))
+M2EXPORT(ctor) (void)
+{
+ m2pim_M2RTS_RegisterModule ("wrapc", M2LIBNAME,
+ M2EXPORT(init), M2EXPORT(fini),
+ M2EXPORT(dep));
+}