.
--- a/BCompiler.st Sun Sep 17 19:59:05 1995 +0200
+++ b/BCompiler.st Mon Oct 23 17:58:15 1995 +0100
@@ -27,7 +27,7 @@
COPYRIGHT (c) 1989 by Claus Gittinger
All Rights Reserved
-$Header: /cvs/stx/stx/libcomp/Attic/BCompiler.st,v 1.41 1995-09-17 17:58:42 claus Exp $
+$Header: /cvs/stx/stx/libcomp/Attic/BCompiler.st,v 1.42 1995-10-23 16:57:48 cg Exp $
'!
!ByteCodeCompiler class methodsFor:'documentation'!
@@ -48,7 +48,7 @@
version
"
-$Header: /cvs/stx/stx/libcomp/Attic/BCompiler.st,v 1.41 1995-09-17 17:58:42 claus Exp $
+$Header: /cvs/stx/stx/libcomp/Attic/BCompiler.st,v 1.42 1995-10-23 16:57:48 cg Exp $
"
!
@@ -462,6 +462,7 @@
"
Compiler stcCompilationIncludes:'-I/usr/local/include -I../../include'
+ Compiler stcCompilationIncludes:(Compiler stcCompilationIncludes , ' -I../../libxt')
"
!
@@ -1611,8 +1612,9 @@
|stFileName stream handle address flags command oFileName soFileName
initName newMethod ok status className sep class stcPath
- errorStream errorMessages|
+ errorStream errorMessages eMsg|
+ ObjectFileLoader isNil ifTrue:[^ #Error].
STCCompilation == #never ifTrue:[^ #Error].
(stcPath := self class incrementalStcPath) isNil ifTrue:[
self parseError:'no stc compiler available - cannot create machine code' position:1.
@@ -1659,8 +1661,7 @@
stream nextPut:sep.
stream cr.
- stream nextPutAll:'"{ Line: 0 }"'; cr.
- stream nextPutAll:aString.
+ stream nextPutAll:'"{ Line: 0 }"'; cr; nextPutAll:aString.
stream nextPut:sep; space; nextPut:sep.
stream close.
@@ -1720,10 +1721,11 @@
errorMessages isNil ifTrue:[
errorMessages := ''
].
- self parseError:('STC error during compilation:\',errorMessages)withCRs position:1.
+ eMsg := ('STC error during compilation:\',errorMessages) withCRs.
] ifFalse:[
- self parseError:'oops, no STC - cannot create machine code' position:1.
+ eMsg := 'oops, no STC - cannot create machine code'
].
+ self parseError:eMsg position:1.
OperatingSystem removeFile:stFileName.
^ #Error
].
@@ -1745,7 +1747,7 @@
OperatingSystem removeFile:oFileName.
oFileName := soFileName.
] ifFalse:[
- OperatingSystem getOSType = 'sys5.4' ifTrue:[
+ OperatingSystem getOSType = 'sys5_4' ifTrue:[
"
link it to a shared object
"
@@ -1757,8 +1759,6 @@
].
].
-"/ ObjectFileLoader verbose:true.
-
"
load the objectfile
"
@@ -1775,9 +1775,18 @@
address isNil ifTrue:[
address := ObjectFileLoader getFunction:'_' , initName , '_Init' from:handle.
address isNil ifTrue:[
+ (ObjectFileLoader getListOfUndefinedSymbolsFrom:handle) size > 0 ifTrue:[
+ ObjectFileLoader listUndefinedSymbolsIn:handle.
+ eMsg := 'undefined symbols in primitive code'.
+ ] ifFalse:[
+ eMsg := initName , '_Init() lookup failed'
+ ].
+
+ ObjectFileLoader unloadDynamicObject:handle.
+
OperatingSystem removeFile:stFileName.
OperatingSystem removeFile:oFileName.
- self parseError:initName , '_Init() lookup failed - cannot create machine code' position:1.
+ self parseError:(eMsg , ' - cannot create machine code') position:1.
^ #Error
]
].
--- a/ByteCodeCompiler.st Sun Sep 17 19:59:05 1995 +0200
+++ b/ByteCodeCompiler.st Mon Oct 23 17:58:15 1995 +0100
@@ -27,7 +27,7 @@
COPYRIGHT (c) 1989 by Claus Gittinger
All Rights Reserved
-$Header: /cvs/stx/stx/libcomp/ByteCodeCompiler.st,v 1.41 1995-09-17 17:58:42 claus Exp $
+$Header: /cvs/stx/stx/libcomp/ByteCodeCompiler.st,v 1.42 1995-10-23 16:57:48 cg Exp $
'!
!ByteCodeCompiler class methodsFor:'documentation'!
@@ -48,7 +48,7 @@
version
"
-$Header: /cvs/stx/stx/libcomp/ByteCodeCompiler.st,v 1.41 1995-09-17 17:58:42 claus Exp $
+$Header: /cvs/stx/stx/libcomp/ByteCodeCompiler.st,v 1.42 1995-10-23 16:57:48 cg Exp $
"
!
@@ -462,6 +462,7 @@
"
Compiler stcCompilationIncludes:'-I/usr/local/include -I../../include'
+ Compiler stcCompilationIncludes:(Compiler stcCompilationIncludes , ' -I../../libxt')
"
!
@@ -1611,8 +1612,9 @@
|stFileName stream handle address flags command oFileName soFileName
initName newMethod ok status className sep class stcPath
- errorStream errorMessages|
+ errorStream errorMessages eMsg|
+ ObjectFileLoader isNil ifTrue:[^ #Error].
STCCompilation == #never ifTrue:[^ #Error].
(stcPath := self class incrementalStcPath) isNil ifTrue:[
self parseError:'no stc compiler available - cannot create machine code' position:1.
@@ -1659,8 +1661,7 @@
stream nextPut:sep.
stream cr.
- stream nextPutAll:'"{ Line: 0 }"'; cr.
- stream nextPutAll:aString.
+ stream nextPutAll:'"{ Line: 0 }"'; cr; nextPutAll:aString.
stream nextPut:sep; space; nextPut:sep.
stream close.
@@ -1720,10 +1721,11 @@
errorMessages isNil ifTrue:[
errorMessages := ''
].
- self parseError:('STC error during compilation:\',errorMessages)withCRs position:1.
+ eMsg := ('STC error during compilation:\',errorMessages) withCRs.
] ifFalse:[
- self parseError:'oops, no STC - cannot create machine code' position:1.
+ eMsg := 'oops, no STC - cannot create machine code'
].
+ self parseError:eMsg position:1.
OperatingSystem removeFile:stFileName.
^ #Error
].
@@ -1745,7 +1747,7 @@
OperatingSystem removeFile:oFileName.
oFileName := soFileName.
] ifFalse:[
- OperatingSystem getOSType = 'sys5.4' ifTrue:[
+ OperatingSystem getOSType = 'sys5_4' ifTrue:[
"
link it to a shared object
"
@@ -1757,8 +1759,6 @@
].
].
-"/ ObjectFileLoader verbose:true.
-
"
load the objectfile
"
@@ -1775,9 +1775,18 @@
address isNil ifTrue:[
address := ObjectFileLoader getFunction:'_' , initName , '_Init' from:handle.
address isNil ifTrue:[
+ (ObjectFileLoader getListOfUndefinedSymbolsFrom:handle) size > 0 ifTrue:[
+ ObjectFileLoader listUndefinedSymbolsIn:handle.
+ eMsg := 'undefined symbols in primitive code'.
+ ] ifFalse:[
+ eMsg := initName , '_Init() lookup failed'
+ ].
+
+ ObjectFileLoader unloadDynamicObject:handle.
+
OperatingSystem removeFile:stFileName.
OperatingSystem removeFile:oFileName.
- self parseError:initName , '_Init() lookup failed - cannot create machine code' position:1.
+ self parseError:(eMsg , ' - cannot create machine code') position:1.
^ #Error
]
].
--- a/Make.proto Sun Sep 17 19:59:05 1995 +0200
+++ b/Make.proto Mon Oct 23 17:58:15 1995 +0100
@@ -1,4 +1,4 @@
-# $Header: /cvs/stx/stx/libcomp/Make.proto,v 1.31 1995-09-14 23:31:18 claus Exp $
+# $Header: /cvs/stx/stx/libcomp/Make.proto,v 1.32 1995-10-23 16:58:15 cg Exp $
#
# -------------- no need to change anything below ----------
@@ -8,12 +8,12 @@
LIBNAME=libcomp
STCOPT=$(LIBCOMP_STCOPT)
-STCLOCALOPT='-Pcompiler-classes-(libcomp)' $(COMMONSYMBOLS) $(LINKILC)
+STCLOCALOPT='-Pcompiler-classes-(libcomp)' $(COMMONSYMBOLS)
O_RULE=$(SPEEDOPT_O_RULE)
LOCALDEFS=$(DLDEFS)
-all:: abbrev.stc $(UNCRITICALOBJS) objs classList.stc $(OBJTARGET) $(LIBCOMP_MORE)
+all:: abbrev.stc objs classList.stc $(OBJTARGET) $(LIBCOMP_EXTRA_TARGETS)
#
# although all files are compiled in here,
@@ -27,11 +27,6 @@
#
# these are uncritical - save some bytes by compiling with optspace
#
-UNCRITICALOBJS= \
- Explainer.$(O) \
- UndefVar.$(O) \
- SrcFLoader.$(O)
-
OBJS= \
Scanner.$(O) \
Parser.$(O) \
@@ -60,19 +55,11 @@
ObjFHandle.$(O) \
$(EXTRA_LIBCOMP)
-# only needed for NeXT - assembler dumps core with long name ?!?!
#
-VarNode.$(O):
- $(STC) -CC="$(CC)" $(STCFLAGS) $(SOMESHORTNAMES) $(CFLAGS) -c $*.st
-
+# only needed for NeXT2.1 - assembler dumps core with long name ?!?!
#
-# these are not time critical
-#
-$(UNCRITICALOBJS):
- @$(MAKE) UNCRITICAL NAME=$*.st
-
-UNCRITICAL:
- $(STC) -CC="$(CC)" $(STCFLAGS) +optspace2 $(CFLAGS) -c $(NAME)
+# VarNode.$(O):
+# $(STC) -CC="$(CC)" $(STCFLAGS) $(SOMESHORTNAMES) $(CFLAGS) -c $*.st
#
# install the extra objects
--- a/ObjFHandle.st Sun Sep 17 19:59:05 1995 +0200
+++ b/ObjFHandle.st Mon Oct 23 17:58:15 1995 +0100
@@ -11,7 +11,7 @@
version
"
-$Header: /cvs/stx/stx/libcomp/Attic/ObjFHandle.st,v 1.4 1995-09-15 14:54:02 claus Exp $
+$Header: /cvs/stx/stx/libcomp/Attic/ObjFHandle.st,v 1.5 1995-10-23 16:57:59 cg Exp $
"
!
@@ -140,6 +140,7 @@
classes
"return the classes"
+ weakClassRefs isNil ifTrue:[^nil].
^ weakClassRefs asArray
"Created: 14.9.1995 / 21:13:13 / claus"
--- a/ObjFLoader.st Sun Sep 17 19:59:05 1995 +0200
+++ b/ObjFLoader.st Mon Oct 23 17:58:15 1995 +0100
@@ -12,8 +12,9 @@
Object subclass:#ObjectFileLoader
instanceVariableNames:''
- classVariableNames:'MySymbolTable Verbose LastError LoadedObjects
- NextHandleID PreviouslyLoadedObjects'
+ classVariableNames:'MySymbolTable Verbose LastError LinkErrorMessage NextHandleID
+ LoadedObjects PreviouslyLoadedObjects
+ ActuallyLoadedObjects SearchedLibraries'
poolDictionaries:''
category:'System-Compiler'
!
@@ -22,7 +23,7 @@
COPYRIGHT (c) 1993 by Claus Gittinger
All Rights Reserved
-$Header: /cvs/stx/stx/libcomp/Attic/ObjFLoader.st,v 1.47 1995-09-17 17:59:05 claus Exp $
+$Header: /cvs/stx/stx/libcomp/Attic/ObjFLoader.st,v 1.48 1995-10-23 16:58:01 cg Exp $
'!
!ObjectFileLoader class methodsFor:'documentation'!
@@ -43,7 +44,7 @@
version
"
-$Header: /cvs/stx/stx/libcomp/Attic/ObjFLoader.st,v 1.47 1995-09-17 17:59:05 claus Exp $
+$Header: /cvs/stx/stx/libcomp/Attic/ObjFLoader.st,v 1.48 1995-10-23 16:58:01 cg Exp $
"
!
@@ -68,10 +69,13 @@
For example, the sun dl*-functions do an exit on link-errors (which
is certainly not what we want here :-(; the NeXT mechanism does not
allow for selective unloading (only all or last).
+
The only really useful packages are the GNU-dl package and the SGI/Unixware
sys5.4 libdl packages.
The GNU-dl package is only available for a.out file formats;
i.e. only (a subset of) linux people can use it at this time.
+ For the above reasons, dynamic object loading is currently only
+ officially released for SYS5.4 and LINUX systems.
Once stable, the functionality contained herein will be moved into
the VM.
@@ -156,7 +160,11 @@
#ifdef NEXT_DL
# ifndef _RLD_H_
# define _RLD_H_
-# include <rld.h>
+# ifdef NEXT3
+# include <mach-o/rld.h>
+# else
+# include <rld.h>
+# endif
# endif
#endif /* NEXT_DL */
@@ -196,18 +204,51 @@
Verbose := false.
NextHandleID := 1.
ObjectMemory addDependent:self.
+ OperatingSystem getSystemType = 'linux' ifTrue:[
+ '/usr/lib/libc.a' asFilename isReadable ifTrue:[
+ SearchedLibraries := #('/usr/lib/libc.a')
+ ]
+ ].
"
ObjectFileLoader initialize
"
!
+searchedLibraries:aCollectionOfArchivePathNames
+ "set the pathnames of archives which are to be searched
+ when unresolved references occur while loading in an object
+ file. On systems which support shared libraries (all SYS5.4 based
+ systems), this is usually not required. Instead, modules which are to
+ be filed in (.so files) are to be prelinked with the appropriate
+ shared libraries. The dynamic loader then cares about loading those
+ modules (keeping track of which modules are already loaded).
+ Only systems in which the dynamic load is done 'manually' by st/x
+ (i.e. currently only linux) need to set this."
+
+ SearchedLibraries := aCollectionOfArchivePathNames
+!
+
+searchedLibraries
+ "see comment in #searchedLibraries:"
+
+ ^ SearchedLibraries
+!
+
verbose:aBoolean
"turn on/off debug traces"
Verbose := aBoolean
"ObjectFileLoader verbose:true"
+!
+
+lastError
+ ^ LastError
+!
+
+linkErrorMessage
+ ^ LinkErrorMessage
! !
!ObjectFileLoader class methodsFor:'change & update'!
@@ -216,11 +257,16 @@
"sent, when image is saved or restarted"
(something == #aboutToSnapshot) ifTrue:[
- self unloadAndRememberAllObjectFiles
+ self invalidateAndRememberAllObjectFiles
+ ].
+ (something == #finishedSnapshot) ifTrue:[
+ self revalidateAllObjectFiles
].
(something == #restarted) ifTrue:[
self reloadAllRememberedObjectFiles
].
+
+ "Modified: 5.10.1995 / 15:49:14 / claus"
! !
!ObjectFileLoader class methodsFor:'defaults'!
@@ -232,6 +278,7 @@
|os|
os := OperatingSystem getSystemType.
+ (os = 'sys5_4') ifTrue:[^ '.so'].
(os = 'iris') ifTrue:[^ '.so'].
(os = 'linux') ifTrue:[^ '.o'].
(os = 'aix') ifTrue:[^ '.so'].
@@ -644,7 +691,8 @@
loadClass:aClassName fromObjectFile:aFileName
"load a compiled class (.o-file) into the image"
- |handle initAddr symName newClass list moreHandles status otherClass knownToBeOk|
+ |handle initAddr symName newClass list moreHandles info status
+ otherClass knownToBeOk|
handle := self loadDynamicObject:aFileName.
handle isNil ifTrue:[
@@ -670,41 +718,42 @@
knownToBeOk := true.
- knownToBeOk ifFalse:[
- Verbose ifTrue:[
- 'looking for undefs ...' infoPrintNL.
- ].
-
- "
- if there are any undefined symbols, we may have to load more
- files (libs, other modules)
- "
- list := self getListOfUndefinedSymbolsFrom:handle.
- list notNil ifTrue:[
- moreHandles := self loadModulesFromListOfUndefined:list.
-
- "
- now, try again
- "
- symName := '_' , aClassName , '_Init'.
- initAddr := self getFunction:symName from:handle.
- initAddr isNil ifTrue:[
- "try with added underscore"
- symName := '__' , aClassName , '_Init'.
- initAddr := self getFunction:symName from:handle.
- ].
- ]
- ].
+"/ knownToBeOk ifFalse:[
+"/ Verbose ifTrue:[
+"/ 'looking for undefs ...' infoPrintNL.
+"/ ].
+"/
+"/ "
+"/ if there are any undefined symbols, we may have to load more
+"/ files (libs, other modules)
+"/ "
+"/ list := self getListOfUndefinedSymbolsFrom:handle.
+"/ list notNil ifTrue:[
+"/ moreHandles := self loadModulesFromListOfUndefined:list.
+"/
+"/ "
+"/ now, try again
+"/ "
+"/ symName := '_' , aClassName , '_Init'.
+"/ initAddr := self getFunction:symName from:handle.
+"/ initAddr isNil ifTrue:[
+"/ "try with added underscore"
+"/ symName := '__' , aClassName , '_Init'.
+"/ initAddr := self getFunction:symName from:handle.
+"/ ].
+"/ ]
+"/ ].
initAddr notNil ifTrue:[
Verbose ifTrue:[
('calling init at: ' , (initAddr printStringRadix:16)) infoPrintNL.
].
- status := self performModuleInitAt:initAddr identifyAs:handle.
+ info := self performModuleInitAt:initAddr identifyAs:handle.
+ status := info at:1.
"
if any classes are missing ...
"
- ((status at:1) == #missingClass:) ifTrue:[
+ (status == #missingClass:) ifTrue:[
"
... and we are loading a module ...
"
@@ -715,7 +764,7 @@
try again ...
"
Transcript showCr:'missing class is here; try again ...'.
- status := self performModuleInitAt:initAddr identifyAs:handle.
+ info := self performModuleInitAt:initAddr identifyAs:handle.
]
].
@@ -731,7 +780,7 @@
'LOADER: class ' errorPrint. aClassName errorPrint.
' did not define itself' errorPrintNL
"
- do not unload - could have installed its methods ...
+ do not unload - could have installed other classes/methods ...
"
].
^ newClass
@@ -775,7 +824,8 @@
the class name is not needed (multiple definitions may be in the file).
Return false on error, true if ok."
- |handle initAddr className newClass initNames didInit status suffixLen|
+ |handle initAddr className newClass initNames didInit info status suffixLen
+ undefinedNames dummyHandle|
handle := self loadDynamicObject:aFileName.
handle isNil ifTrue:[
@@ -785,6 +835,22 @@
didInit := false.
+ "/ with dld, load may have worked, even if undefined symbols
+ "/ are to be resolved. If thats the case, load all libraries ...
+
+ SearchedLibraries notNil ifTrue:[
+ (self hasUndefinedSymbolsIn:handle) ifTrue:[
+ SearchedLibraries do:[:libName |
+ Transcript showCr:' ... trying ' , libName , ' to resolve undefined symbols ...'.
+ dummyHandle := Array new:4.
+ dummyHandle := self primLoadDynamicObject:libName into:dummyHandle.
+ dummyHandle isNil ifTrue:[
+ Transcript showCr:' ... load of library ' , libName , ' failed.'.
+ ]
+ ]
+ ]
+ ].
+
"
first, expect the classes-name to be the fileName-base
"
@@ -814,6 +880,13 @@
initAddr := self getFunction:('_' , className , '_Init') from:handle.
].
initAddr isNil ifTrue:[
+ "/
+ "/ special for broken ultrix nlist (will not find symbol with single
+ "/ underscore; workaround: add another underscore
+ "/
+ initAddr := self getFunction:('__' , className , '_Init') from:handle.
+ ].
+ initAddr isNil ifTrue:[
"
look for reverse abbreviation
"
@@ -829,8 +902,11 @@
Verbose ifTrue:[
('calling init at:' , (initAddr printStringRadix:16)) infoPrintNL.
].
- status := self performModuleInitAt:initAddr identifyAs:handle.
- didInit := true.
+ info := self performModuleInitAt:initAddr identifyAs:handle.
+ status := info at:1.
+ status == #ok ifTrue:[
+ didInit := true.
+ ]
] ifFalse:[
"
look for init-function(s); call them all
@@ -849,13 +925,13 @@
].
initAddr isNil ifTrue:[
Transcript showCr:('no symbol: ',aName,' in ',aFileName).
- ^ false
- ].
- Verbose ifTrue:[
- ('calling init at:' , (initAddr printStringRadix:16)) infoPrintNL
- ].
- self performModuleInitAt:initAddr identifyAs:handle.
- didInit := true.
+ ] ifFalse:[
+ Verbose ifTrue:[
+ ('calling init at:' , (initAddr printStringRadix:16)) infoPrintNL
+ ].
+ self performModuleInitAt:initAddr identifyAs:handle.
+ didInit := true.
+ ]
].
].
].
@@ -870,7 +946,12 @@
"/ ].
didInit ifFalse:[
- Transcript showCr:'no init function found'
+ status == #registrationFailed ifTrue:[
+ Transcript showCr:'incompatible object (recompile without commonSymbols)'
+ ].
+ self listUndefinedSymbolsIn:handle.
+ self unloadDynamicObject:handle.
+ Transcript showCr:'module not loaded.'
].
"
@@ -1054,6 +1135,53 @@
"
!
+invalidateAndRememberAllObjectFiles
+ "invalidate code refs into all dynamically loaded object files.
+ Required before writing a snapshot image."
+
+ LoadedObjects notNil ifTrue:[
+ ActuallyLoadedObjects := LoadedObjects.
+ PreviouslyLoadedObjects := LoadedObjects keys copy.
+ ActuallyLoadedObjects keys do:[:aFileName |
+ |handle|
+
+ handle := ActuallyLoadedObjects at:aFileName.
+ handle isNil ifTrue:[
+ self error:'oops, no handle'.
+ ] ifFalse:[
+ self invalidateModule:handle
+ ]
+ ].
+ LoadedObjects := nil.
+ ].
+
+ "Created: 5.10.1995 / 15:48:56 / claus"
+ "Modified: 5.10.1995 / 16:48:51 / claus"
+!
+
+revalidateAllObjectFiles
+ "revalidate code refs into all dynamically loaded object files.
+ Required after writing a snapshot image."
+
+ ActuallyLoadedObjects notNil ifTrue:[
+ ActuallyLoadedObjects keys do:[:aFileName |
+ |handle|
+
+ handle := ActuallyLoadedObjects at:aFileName.
+ handle isNil ifTrue:[
+ self error:'oops, no handle'.
+ ] ifFalse:[
+ self revalidateModule:handle
+ ]
+ ].
+ LoadedObjects := ActuallyLoadedObjects.
+ ActuallyLoadedObjects := PreviouslyLoadedObjects := nil.
+ ].
+
+ "Created: 5.10.1995 / 15:49:08 / claus"
+ "Modified: 5.10.1995 / 16:49:18 / claus"
+!
+
unloadAndRememberAllObjectFiles
LoadedObjects notNil ifTrue:[
PreviouslyLoadedObjects := LoadedObjects keys copy.
@@ -1199,7 +1327,14 @@
"try it the hard way"
buffer := self loadFile:pathName.
].
- buffer isNil ifTrue:[^ nil]
+ buffer isNil ifTrue:[
+ LastError == #linkError ifTrue:[
+ LinkErrorMessage notNil ifTrue:[
+ Transcript showCr:'Load error:' , LinkErrorMessage
+ ].
+ ].
+ ^ nil
+ ]
].
"
@@ -1260,10 +1395,12 @@
{
static firstCall = 1;
extern char *__myName__;
+ extern dld_ignore_redefinitions;
if (firstCall) {
firstCall = 0;
(void) dld_init (__myName__);
+ dld_ignore_redefinitions = 1;
}
if (__isString(pathName)) {
@@ -1352,14 +1489,17 @@
{
void *handle;
char *nm;
+ char *errMsg;
if ((pathName == nil) || __isString(pathName)) {
handle = dlopen(pathName == nil ? (char *)0 : __stringVal(pathName), RTLD_NOW);
if (! handle) {
- fprintf(stderr, "dlopen %s error: <%s>\n",
- __stringVal(pathName), dlerror());
+ errMsg = dlerror();
+ fprintf(stderr, "dlopen %s error:\n", __stringVal(pathName));
+ fprintf(stderr, " <%s>\n", errMsg);
ObjectFileLoader_LastError = @symbol(linkError);
+ ObjectFileLoader_LinkErrorMessage = _MKSTRING(errMsg);
RETURN (nil);
}
@@ -1451,7 +1591,8 @@
'unload module name=' infoPrint. handle pathName infoPrintNL.
].
- self performModuleDeInit:handle.
+ self deinitializeClassesFromModule:handle.
+ self unregisterModule:handle.
(self primUnloadDynamicObject:handle) ifFalse:[
^ self error:'unloadDynamic failed'
@@ -1870,23 +2011,40 @@
^ nil
!
+listUndefinedSymbolsIn:handle
+ |undefinedNames|
+
+ undefinedNames := self getListOfUndefinedSymbolsFrom:handle.
+ undefinedNames size > 0 ifTrue:[
+ Transcript showCr:'undefined:'.
+ undefinedNames do:[:aName |
+ Transcript showCr:' ' , aName
+ ]
+ ].
+!
+
+hasUndefinedSymbolsIn:handle
+ ^ (self getListOfUndefinedSymbolsFrom:handle) size > 0
+!
+
getListOfUndefinedSymbolsFrom:aHandle
"return a collection of undefined symbols in a dynamically loaded object file.
Handle must be the one returned previously from loadDynamicObject.
Not all systems allow an object with undefined symbols to be
- loaded."
+ loaded (actually, only dld does)."
|list|
-%{
+%{ /* STACK: 20000 */
#ifdef GNU_DL
void (*func)();
unsigned long addr;
char *name;
int nMax;
-
+ char **undefNames;
+
+ undefNames = dld_list_undefined_sym();
if (dld_undefined_sym_count > 0) {
- char **undefNames;
char **nm;
int index;
int count = dld_undefined_sym_count;
@@ -1894,12 +2052,14 @@
if (count > 100) count = 100;
list = __ARRAY_NEW_INT(count);
if (list) {
- nm = undefNames = dld_list_undefined_sym();
+ nm = undefNames;
for (index = 0; index < count; index++) {
OBJ s;
- s = _MKSTRING(*nm++);
- _ArrayInstPtr(list)->a_element[index++] = s;
+ s = _MKSTRING(*nm);
+ _ArrayInstPtr(list)->a_element[index] = s;
+ __STORE(list, s);
+ nm++;
}
free(undefNames);
}
@@ -1950,11 +2110,64 @@
%}
!
-performModuleDeInit:handle
+deinitializeClassesFromModule:handle
+ "send #deinitialize to all classes of a module"
+
+ |id classes|
+
+ classes := handle classes.
+ classes notNil ifTrue:[
+ classes do:[:aClass |
+ aClass isMeta ifFalse:[
+ Verbose ifTrue:[
+ 'send #deinitialize to:' infoPrint. aClass name infoPrintNL.
+ ].
+ aClass deinitialize
+ ]
+ ]
+ ]
+!
+
+invalidateModule:handle
+ "invalidate all of the classes code objects ..."
+
|id|
Verbose ifTrue:[
- 'deInit module name=' infoPrint. handle pathName infoPrint.
+ 'invalidate module; name=' infoPrint. handle pathName infoPrint.
+ ' id=' infoPrint. handle moduleID infoPrintNL.
+ ].
+
+ id := handle moduleID.
+%{
+ __INVALIDATE_BY_ID(__intVal(id));
+%}
+!
+
+revalidateModule:handle
+ "revalidate all of the classes code objects ..."
+
+ |id|
+
+ Verbose ifTrue:[
+ 'revalidate module; name=' infoPrint. handle pathName infoPrint.
+ ' id=' infoPrint. handle moduleID infoPrintNL.
+ ].
+
+ id := handle moduleID.
+%{
+ __REVALIDATE_BY_ID(__intVal(id));
+%}
+!
+
+unregisterModule:handle
+ "unregister classes in the VM.
+ This invalidates all of the classes code objects ..."
+
+ |id|
+
+ Verbose ifTrue:[
+ 'unregister module; name=' infoPrint. handle pathName infoPrint.
' id=' infoPrint. handle moduleID infoPrintNL.
].
@@ -2033,18 +2246,21 @@
infoCollection := ObjectMemory binaryModuleInfo.
info := infoCollection at:handle moduleID ifAbsent:nil.
- info notNil ifTrue:[
- classNames := info at:#classNames.
- classNames size > 0 ifTrue:[
- classes := classNames collect:[:nm | Smalltalk classNamed:nm].
- ].
- classes size > 0 ifTrue:[
- classes := classes asArray.
- classes := classes , (classes collect:[:aClass | aClass class]).
- ].
- handle classes:classes.
+ info isNil ifTrue:[
+ "/ mhmh registration failed -
+ ^ Array with:#registrationFailed
].
+ classNames := info at:#classNames.
+ classNames size > 0 ifTrue:[
+ classes := classNames collect:[:nm | Smalltalk classNamed:nm].
+ ].
+ classes size > 0 ifTrue:[
+ classes := classes asArray.
+ classes := classes , (classes collect:[:aClass | aClass class]).
+ ].
+ handle classes:classes.
+
^ Array with:#ok
!
--- a/ObjectFileHandle.st Sun Sep 17 19:59:05 1995 +0200
+++ b/ObjectFileHandle.st Mon Oct 23 17:58:15 1995 +0100
@@ -11,7 +11,7 @@
version
"
-$Header: /cvs/stx/stx/libcomp/ObjectFileHandle.st,v 1.4 1995-09-15 14:54:02 claus Exp $
+$Header: /cvs/stx/stx/libcomp/ObjectFileHandle.st,v 1.5 1995-10-23 16:57:59 cg Exp $
"
!
@@ -140,6 +140,7 @@
classes
"return the classes"
+ weakClassRefs isNil ifTrue:[^nil].
^ weakClassRefs asArray
"Created: 14.9.1995 / 21:13:13 / claus"
--- a/ObjectFileLoader.st Sun Sep 17 19:59:05 1995 +0200
+++ b/ObjectFileLoader.st Mon Oct 23 17:58:15 1995 +0100
@@ -12,8 +12,9 @@
Object subclass:#ObjectFileLoader
instanceVariableNames:''
- classVariableNames:'MySymbolTable Verbose LastError LoadedObjects
- NextHandleID PreviouslyLoadedObjects'
+ classVariableNames:'MySymbolTable Verbose LastError LinkErrorMessage NextHandleID
+ LoadedObjects PreviouslyLoadedObjects
+ ActuallyLoadedObjects SearchedLibraries'
poolDictionaries:''
category:'System-Compiler'
!
@@ -22,7 +23,7 @@
COPYRIGHT (c) 1993 by Claus Gittinger
All Rights Reserved
-$Header: /cvs/stx/stx/libcomp/ObjectFileLoader.st,v 1.47 1995-09-17 17:59:05 claus Exp $
+$Header: /cvs/stx/stx/libcomp/ObjectFileLoader.st,v 1.48 1995-10-23 16:58:01 cg Exp $
'!
!ObjectFileLoader class methodsFor:'documentation'!
@@ -43,7 +44,7 @@
version
"
-$Header: /cvs/stx/stx/libcomp/ObjectFileLoader.st,v 1.47 1995-09-17 17:59:05 claus Exp $
+$Header: /cvs/stx/stx/libcomp/ObjectFileLoader.st,v 1.48 1995-10-23 16:58:01 cg Exp $
"
!
@@ -68,10 +69,13 @@
For example, the sun dl*-functions do an exit on link-errors (which
is certainly not what we want here :-(; the NeXT mechanism does not
allow for selective unloading (only all or last).
+
The only really useful packages are the GNU-dl package and the SGI/Unixware
sys5.4 libdl packages.
The GNU-dl package is only available for a.out file formats;
i.e. only (a subset of) linux people can use it at this time.
+ For the above reasons, dynamic object loading is currently only
+ officially released for SYS5.4 and LINUX systems.
Once stable, the functionality contained herein will be moved into
the VM.
@@ -156,7 +160,11 @@
#ifdef NEXT_DL
# ifndef _RLD_H_
# define _RLD_H_
-# include <rld.h>
+# ifdef NEXT3
+# include <mach-o/rld.h>
+# else
+# include <rld.h>
+# endif
# endif
#endif /* NEXT_DL */
@@ -196,18 +204,51 @@
Verbose := false.
NextHandleID := 1.
ObjectMemory addDependent:self.
+ OperatingSystem getSystemType = 'linux' ifTrue:[
+ '/usr/lib/libc.a' asFilename isReadable ifTrue:[
+ SearchedLibraries := #('/usr/lib/libc.a')
+ ]
+ ].
"
ObjectFileLoader initialize
"
!
+searchedLibraries:aCollectionOfArchivePathNames
+ "set the pathnames of archives which are to be searched
+ when unresolved references occur while loading in an object
+ file. On systems which support shared libraries (all SYS5.4 based
+ systems), this is usually not required. Instead, modules which are to
+ be filed in (.so files) are to be prelinked with the appropriate
+ shared libraries. The dynamic loader then cares about loading those
+ modules (keeping track of which modules are already loaded).
+ Only systems in which the dynamic load is done 'manually' by st/x
+ (i.e. currently only linux) need to set this."
+
+ SearchedLibraries := aCollectionOfArchivePathNames
+!
+
+searchedLibraries
+ "see comment in #searchedLibraries:"
+
+ ^ SearchedLibraries
+!
+
verbose:aBoolean
"turn on/off debug traces"
Verbose := aBoolean
"ObjectFileLoader verbose:true"
+!
+
+lastError
+ ^ LastError
+!
+
+linkErrorMessage
+ ^ LinkErrorMessage
! !
!ObjectFileLoader class methodsFor:'change & update'!
@@ -216,11 +257,16 @@
"sent, when image is saved or restarted"
(something == #aboutToSnapshot) ifTrue:[
- self unloadAndRememberAllObjectFiles
+ self invalidateAndRememberAllObjectFiles
+ ].
+ (something == #finishedSnapshot) ifTrue:[
+ self revalidateAllObjectFiles
].
(something == #restarted) ifTrue:[
self reloadAllRememberedObjectFiles
].
+
+ "Modified: 5.10.1995 / 15:49:14 / claus"
! !
!ObjectFileLoader class methodsFor:'defaults'!
@@ -232,6 +278,7 @@
|os|
os := OperatingSystem getSystemType.
+ (os = 'sys5_4') ifTrue:[^ '.so'].
(os = 'iris') ifTrue:[^ '.so'].
(os = 'linux') ifTrue:[^ '.o'].
(os = 'aix') ifTrue:[^ '.so'].
@@ -644,7 +691,8 @@
loadClass:aClassName fromObjectFile:aFileName
"load a compiled class (.o-file) into the image"
- |handle initAddr symName newClass list moreHandles status otherClass knownToBeOk|
+ |handle initAddr symName newClass list moreHandles info status
+ otherClass knownToBeOk|
handle := self loadDynamicObject:aFileName.
handle isNil ifTrue:[
@@ -670,41 +718,42 @@
knownToBeOk := true.
- knownToBeOk ifFalse:[
- Verbose ifTrue:[
- 'looking for undefs ...' infoPrintNL.
- ].
-
- "
- if there are any undefined symbols, we may have to load more
- files (libs, other modules)
- "
- list := self getListOfUndefinedSymbolsFrom:handle.
- list notNil ifTrue:[
- moreHandles := self loadModulesFromListOfUndefined:list.
-
- "
- now, try again
- "
- symName := '_' , aClassName , '_Init'.
- initAddr := self getFunction:symName from:handle.
- initAddr isNil ifTrue:[
- "try with added underscore"
- symName := '__' , aClassName , '_Init'.
- initAddr := self getFunction:symName from:handle.
- ].
- ]
- ].
+"/ knownToBeOk ifFalse:[
+"/ Verbose ifTrue:[
+"/ 'looking for undefs ...' infoPrintNL.
+"/ ].
+"/
+"/ "
+"/ if there are any undefined symbols, we may have to load more
+"/ files (libs, other modules)
+"/ "
+"/ list := self getListOfUndefinedSymbolsFrom:handle.
+"/ list notNil ifTrue:[
+"/ moreHandles := self loadModulesFromListOfUndefined:list.
+"/
+"/ "
+"/ now, try again
+"/ "
+"/ symName := '_' , aClassName , '_Init'.
+"/ initAddr := self getFunction:symName from:handle.
+"/ initAddr isNil ifTrue:[
+"/ "try with added underscore"
+"/ symName := '__' , aClassName , '_Init'.
+"/ initAddr := self getFunction:symName from:handle.
+"/ ].
+"/ ]
+"/ ].
initAddr notNil ifTrue:[
Verbose ifTrue:[
('calling init at: ' , (initAddr printStringRadix:16)) infoPrintNL.
].
- status := self performModuleInitAt:initAddr identifyAs:handle.
+ info := self performModuleInitAt:initAddr identifyAs:handle.
+ status := info at:1.
"
if any classes are missing ...
"
- ((status at:1) == #missingClass:) ifTrue:[
+ (status == #missingClass:) ifTrue:[
"
... and we are loading a module ...
"
@@ -715,7 +764,7 @@
try again ...
"
Transcript showCr:'missing class is here; try again ...'.
- status := self performModuleInitAt:initAddr identifyAs:handle.
+ info := self performModuleInitAt:initAddr identifyAs:handle.
]
].
@@ -731,7 +780,7 @@
'LOADER: class ' errorPrint. aClassName errorPrint.
' did not define itself' errorPrintNL
"
- do not unload - could have installed its methods ...
+ do not unload - could have installed other classes/methods ...
"
].
^ newClass
@@ -775,7 +824,8 @@
the class name is not needed (multiple definitions may be in the file).
Return false on error, true if ok."
- |handle initAddr className newClass initNames didInit status suffixLen|
+ |handle initAddr className newClass initNames didInit info status suffixLen
+ undefinedNames dummyHandle|
handle := self loadDynamicObject:aFileName.
handle isNil ifTrue:[
@@ -785,6 +835,22 @@
didInit := false.
+ "/ with dld, load may have worked, even if undefined symbols
+ "/ are to be resolved. If thats the case, load all libraries ...
+
+ SearchedLibraries notNil ifTrue:[
+ (self hasUndefinedSymbolsIn:handle) ifTrue:[
+ SearchedLibraries do:[:libName |
+ Transcript showCr:' ... trying ' , libName , ' to resolve undefined symbols ...'.
+ dummyHandle := Array new:4.
+ dummyHandle := self primLoadDynamicObject:libName into:dummyHandle.
+ dummyHandle isNil ifTrue:[
+ Transcript showCr:' ... load of library ' , libName , ' failed.'.
+ ]
+ ]
+ ]
+ ].
+
"
first, expect the classes-name to be the fileName-base
"
@@ -814,6 +880,13 @@
initAddr := self getFunction:('_' , className , '_Init') from:handle.
].
initAddr isNil ifTrue:[
+ "/
+ "/ special for broken ultrix nlist (will not find symbol with single
+ "/ underscore; workaround: add another underscore
+ "/
+ initAddr := self getFunction:('__' , className , '_Init') from:handle.
+ ].
+ initAddr isNil ifTrue:[
"
look for reverse abbreviation
"
@@ -829,8 +902,11 @@
Verbose ifTrue:[
('calling init at:' , (initAddr printStringRadix:16)) infoPrintNL.
].
- status := self performModuleInitAt:initAddr identifyAs:handle.
- didInit := true.
+ info := self performModuleInitAt:initAddr identifyAs:handle.
+ status := info at:1.
+ status == #ok ifTrue:[
+ didInit := true.
+ ]
] ifFalse:[
"
look for init-function(s); call them all
@@ -849,13 +925,13 @@
].
initAddr isNil ifTrue:[
Transcript showCr:('no symbol: ',aName,' in ',aFileName).
- ^ false
- ].
- Verbose ifTrue:[
- ('calling init at:' , (initAddr printStringRadix:16)) infoPrintNL
- ].
- self performModuleInitAt:initAddr identifyAs:handle.
- didInit := true.
+ ] ifFalse:[
+ Verbose ifTrue:[
+ ('calling init at:' , (initAddr printStringRadix:16)) infoPrintNL
+ ].
+ self performModuleInitAt:initAddr identifyAs:handle.
+ didInit := true.
+ ]
].
].
].
@@ -870,7 +946,12 @@
"/ ].
didInit ifFalse:[
- Transcript showCr:'no init function found'
+ status == #registrationFailed ifTrue:[
+ Transcript showCr:'incompatible object (recompile without commonSymbols)'
+ ].
+ self listUndefinedSymbolsIn:handle.
+ self unloadDynamicObject:handle.
+ Transcript showCr:'module not loaded.'
].
"
@@ -1054,6 +1135,53 @@
"
!
+invalidateAndRememberAllObjectFiles
+ "invalidate code refs into all dynamically loaded object files.
+ Required before writing a snapshot image."
+
+ LoadedObjects notNil ifTrue:[
+ ActuallyLoadedObjects := LoadedObjects.
+ PreviouslyLoadedObjects := LoadedObjects keys copy.
+ ActuallyLoadedObjects keys do:[:aFileName |
+ |handle|
+
+ handle := ActuallyLoadedObjects at:aFileName.
+ handle isNil ifTrue:[
+ self error:'oops, no handle'.
+ ] ifFalse:[
+ self invalidateModule:handle
+ ]
+ ].
+ LoadedObjects := nil.
+ ].
+
+ "Created: 5.10.1995 / 15:48:56 / claus"
+ "Modified: 5.10.1995 / 16:48:51 / claus"
+!
+
+revalidateAllObjectFiles
+ "revalidate code refs into all dynamically loaded object files.
+ Required after writing a snapshot image."
+
+ ActuallyLoadedObjects notNil ifTrue:[
+ ActuallyLoadedObjects keys do:[:aFileName |
+ |handle|
+
+ handle := ActuallyLoadedObjects at:aFileName.
+ handle isNil ifTrue:[
+ self error:'oops, no handle'.
+ ] ifFalse:[
+ self revalidateModule:handle
+ ]
+ ].
+ LoadedObjects := ActuallyLoadedObjects.
+ ActuallyLoadedObjects := PreviouslyLoadedObjects := nil.
+ ].
+
+ "Created: 5.10.1995 / 15:49:08 / claus"
+ "Modified: 5.10.1995 / 16:49:18 / claus"
+!
+
unloadAndRememberAllObjectFiles
LoadedObjects notNil ifTrue:[
PreviouslyLoadedObjects := LoadedObjects keys copy.
@@ -1199,7 +1327,14 @@
"try it the hard way"
buffer := self loadFile:pathName.
].
- buffer isNil ifTrue:[^ nil]
+ buffer isNil ifTrue:[
+ LastError == #linkError ifTrue:[
+ LinkErrorMessage notNil ifTrue:[
+ Transcript showCr:'Load error:' , LinkErrorMessage
+ ].
+ ].
+ ^ nil
+ ]
].
"
@@ -1260,10 +1395,12 @@
{
static firstCall = 1;
extern char *__myName__;
+ extern dld_ignore_redefinitions;
if (firstCall) {
firstCall = 0;
(void) dld_init (__myName__);
+ dld_ignore_redefinitions = 1;
}
if (__isString(pathName)) {
@@ -1352,14 +1489,17 @@
{
void *handle;
char *nm;
+ char *errMsg;
if ((pathName == nil) || __isString(pathName)) {
handle = dlopen(pathName == nil ? (char *)0 : __stringVal(pathName), RTLD_NOW);
if (! handle) {
- fprintf(stderr, "dlopen %s error: <%s>\n",
- __stringVal(pathName), dlerror());
+ errMsg = dlerror();
+ fprintf(stderr, "dlopen %s error:\n", __stringVal(pathName));
+ fprintf(stderr, " <%s>\n", errMsg);
ObjectFileLoader_LastError = @symbol(linkError);
+ ObjectFileLoader_LinkErrorMessage = _MKSTRING(errMsg);
RETURN (nil);
}
@@ -1451,7 +1591,8 @@
'unload module name=' infoPrint. handle pathName infoPrintNL.
].
- self performModuleDeInit:handle.
+ self deinitializeClassesFromModule:handle.
+ self unregisterModule:handle.
(self primUnloadDynamicObject:handle) ifFalse:[
^ self error:'unloadDynamic failed'
@@ -1870,23 +2011,40 @@
^ nil
!
+listUndefinedSymbolsIn:handle
+ |undefinedNames|
+
+ undefinedNames := self getListOfUndefinedSymbolsFrom:handle.
+ undefinedNames size > 0 ifTrue:[
+ Transcript showCr:'undefined:'.
+ undefinedNames do:[:aName |
+ Transcript showCr:' ' , aName
+ ]
+ ].
+!
+
+hasUndefinedSymbolsIn:handle
+ ^ (self getListOfUndefinedSymbolsFrom:handle) size > 0
+!
+
getListOfUndefinedSymbolsFrom:aHandle
"return a collection of undefined symbols in a dynamically loaded object file.
Handle must be the one returned previously from loadDynamicObject.
Not all systems allow an object with undefined symbols to be
- loaded."
+ loaded (actually, only dld does)."
|list|
-%{
+%{ /* STACK: 20000 */
#ifdef GNU_DL
void (*func)();
unsigned long addr;
char *name;
int nMax;
-
+ char **undefNames;
+
+ undefNames = dld_list_undefined_sym();
if (dld_undefined_sym_count > 0) {
- char **undefNames;
char **nm;
int index;
int count = dld_undefined_sym_count;
@@ -1894,12 +2052,14 @@
if (count > 100) count = 100;
list = __ARRAY_NEW_INT(count);
if (list) {
- nm = undefNames = dld_list_undefined_sym();
+ nm = undefNames;
for (index = 0; index < count; index++) {
OBJ s;
- s = _MKSTRING(*nm++);
- _ArrayInstPtr(list)->a_element[index++] = s;
+ s = _MKSTRING(*nm);
+ _ArrayInstPtr(list)->a_element[index] = s;
+ __STORE(list, s);
+ nm++;
}
free(undefNames);
}
@@ -1950,11 +2110,64 @@
%}
!
-performModuleDeInit:handle
+deinitializeClassesFromModule:handle
+ "send #deinitialize to all classes of a module"
+
+ |id classes|
+
+ classes := handle classes.
+ classes notNil ifTrue:[
+ classes do:[:aClass |
+ aClass isMeta ifFalse:[
+ Verbose ifTrue:[
+ 'send #deinitialize to:' infoPrint. aClass name infoPrintNL.
+ ].
+ aClass deinitialize
+ ]
+ ]
+ ]
+!
+
+invalidateModule:handle
+ "invalidate all of the classes code objects ..."
+
|id|
Verbose ifTrue:[
- 'deInit module name=' infoPrint. handle pathName infoPrint.
+ 'invalidate module; name=' infoPrint. handle pathName infoPrint.
+ ' id=' infoPrint. handle moduleID infoPrintNL.
+ ].
+
+ id := handle moduleID.
+%{
+ __INVALIDATE_BY_ID(__intVal(id));
+%}
+!
+
+revalidateModule:handle
+ "revalidate all of the classes code objects ..."
+
+ |id|
+
+ Verbose ifTrue:[
+ 'revalidate module; name=' infoPrint. handle pathName infoPrint.
+ ' id=' infoPrint. handle moduleID infoPrintNL.
+ ].
+
+ id := handle moduleID.
+%{
+ __REVALIDATE_BY_ID(__intVal(id));
+%}
+!
+
+unregisterModule:handle
+ "unregister classes in the VM.
+ This invalidates all of the classes code objects ..."
+
+ |id|
+
+ Verbose ifTrue:[
+ 'unregister module; name=' infoPrint. handle pathName infoPrint.
' id=' infoPrint. handle moduleID infoPrintNL.
].
@@ -2033,18 +2246,21 @@
infoCollection := ObjectMemory binaryModuleInfo.
info := infoCollection at:handle moduleID ifAbsent:nil.
- info notNil ifTrue:[
- classNames := info at:#classNames.
- classNames size > 0 ifTrue:[
- classes := classNames collect:[:nm | Smalltalk classNamed:nm].
- ].
- classes size > 0 ifTrue:[
- classes := classes asArray.
- classes := classes , (classes collect:[:aClass | aClass class]).
- ].
- handle classes:classes.
+ info isNil ifTrue:[
+ "/ mhmh registration failed -
+ ^ Array with:#registrationFailed
].
+ classNames := info at:#classNames.
+ classNames size > 0 ifTrue:[
+ classes := classNames collect:[:nm | Smalltalk classNamed:nm].
+ ].
+ classes size > 0 ifTrue:[
+ classes := classes asArray.
+ classes := classes , (classes collect:[:aClass | aClass class]).
+ ].
+ handle classes:classes.
+
^ Array with:#ok
!