968 int32 *slp; |
974 int32 *slp; |
969 int32 l; |
975 int32 l; |
970 |
976 |
971 slp = (int32 *)(pFirst + (indx<<2)); |
977 slp = (int32 *)(pFirst + (indx<<2)); |
972 l = *slp; |
978 l = *slp; |
973 #if __POINTER_SIZE__ == 8 |
979 # if __POINTER_SIZE__ == 8 |
974 { |
980 { |
975 INT ll = (INT)l; |
981 INT ll = (INT)l; |
976 RETURN ( __mkSmallInteger(ll) ); |
982 RETURN ( __mkSmallInteger(ll) ); |
977 } |
983 } |
978 #else |
984 # else |
979 if (__ISVALIDINTEGER(l)) { |
985 if (__ISVALIDINTEGER(l)) { |
980 RETURN ( __mkSmallInteger(l) ); |
986 RETURN ( __mkSmallInteger(l) ); |
981 } |
987 } |
982 RETURN ( __MKLARGEINT(l) ); |
988 RETURN ( __MKLARGEINT(l) ); |
983 #endif |
989 # endif |
984 } |
990 } |
985 break; |
991 break; |
986 |
992 |
987 case __MASKSMALLINT(SLONGLONGARRAY): |
993 case __MASKSMALLINT(SLONGLONGARRAY): |
988 /* |
994 /* |
989 * signed 64bit longlongs |
995 * signed 64bit longlongs |
990 */ |
996 */ |
991 #ifdef __NEED_LONGLONG_ALIGN |
997 # ifdef __NEED_LONGLONG_ALIGN |
992 if ((INT)pFirst & (__LONGLONG_ALIGN-1)) { |
998 if ((INT)pFirst & (__LONGLONG_ALIGN-1)) { |
993 int delta = __LONGLONG_ALIGN - ((INT)pFirst & (__LONGLONG_ALIGN-1)); |
999 int delta = __LONGLONG_ALIGN - ((INT)pFirst & (__LONGLONG_ALIGN-1)); |
994 |
1000 |
995 pFirst += delta; |
1001 pFirst += delta; |
996 nbytes -= delta; |
1002 nbytes -= delta; |
997 } |
1003 } |
998 #endif |
1004 # endif |
999 /* Notice: the hard coded shifts are by purpose; |
1005 /* Notice: the hard coded shifts are by purpose; |
1000 * it makes us independent of the long/longlong-size of the machine |
1006 * it makes us independent of the long/longlong-size of the machine |
1001 */ |
1007 */ |
1002 if ((unsigned)indx < (nbytes>>3)) { |
1008 if ((unsigned)indx < (nbytes>>3)) { |
1003 #if __POINTER_SIZE__ == 8 |
1009 # if __POINTER_SIZE__ == 8 |
1004 INT *slp, ll; |
1010 INT *slp, ll; |
1005 |
1011 |
1006 slp = (INT *)(pFirst + (indx<<3)); |
1012 slp = (INT *)(pFirst + (indx<<3)); |
1007 ll = *slp; |
1013 ll = *slp; |
1008 if (__ISVALIDINTEGER(ll)) { |
1014 if (__ISVALIDINTEGER(ll)) { |
1009 RETURN ( __mkSmallInteger(ll) ); |
1015 RETURN ( __mkSmallInteger(ll) ); |
1010 } |
1016 } |
1011 RETURN ( __MKLARGEINT(ll) ); |
1017 RETURN ( __MKLARGEINT(ll) ); |
1012 #else |
1018 # else |
1013 __int64__ *llp; |
1019 __int64__ *llp; |
1014 |
1020 |
1015 llp = (__int64__ *)(pFirst + (indx<<3)); |
1021 llp = (__int64__ *)(pFirst + (indx<<3)); |
1016 RETURN (__MKINT64(llp)); |
1022 RETURN (__MKINT64(llp)); |
1017 #endif |
1023 # endif |
1018 } |
1024 } |
1019 break; |
1025 break; |
1020 |
1026 |
1021 case __MASKSMALLINT(LONGLONGARRAY): |
1027 case __MASKSMALLINT(LONGLONGARRAY): |
1022 /* |
1028 /* |
1023 * unsigned 64bit longlongs |
1029 * unsigned 64bit longlongs |
1024 */ |
1030 */ |
1025 #ifdef __NEED_LONGLONG_ALIGN |
1031 # ifdef __NEED_LONGLONG_ALIGN |
1026 if ((INT)pFirst & (__LONGLONG_ALIGN-1)) { |
1032 if ((INT)pFirst & (__LONGLONG_ALIGN-1)) { |
1027 int delta = __LONGLONG_ALIGN - ((INT)pFirst & (__LONGLONG_ALIGN-1)); |
1033 int delta = __LONGLONG_ALIGN - ((INT)pFirst & (__LONGLONG_ALIGN-1)); |
1028 |
1034 |
1029 pFirst += delta; |
1035 pFirst += delta; |
1030 nbytes -= delta; |
1036 nbytes -= delta; |
1031 } |
1037 } |
1032 #endif |
1038 # endif |
1033 /* Notice: the hard coded shifts are by purpose; |
1039 /* Notice: the hard coded shifts are by purpose; |
1034 * it makes us independent of the long/longlong-size of the machine |
1040 * it makes us independent of the long/longlong-size of the machine |
1035 */ |
1041 */ |
1036 if ((unsigned)indx < (nbytes>>3)) { |
1042 if ((unsigned)indx < (nbytes>>3)) { |
1037 #if __POINTER_SIZE__ == 8 |
1043 # if __POINTER_SIZE__ == 8 |
1038 unsigned INT *ulp, ul; |
1044 unsigned INT *ulp, ul; |
1039 |
1045 |
1040 ulp = (unsigned INT *)(pFirst + (indx<<3)); |
1046 ulp = (unsigned INT *)(pFirst + (indx<<3)); |
1041 ul = *ulp; |
1047 ul = *ulp; |
1042 if (ul <= _MAX_INT) { |
1048 if (ul <= _MAX_INT) { |
1043 RETURN ( __mkSmallInteger(ul) ); |
1049 RETURN ( __mkSmallInteger(ul) ); |
1044 } |
1050 } |
1045 RETURN ( __MKULARGEINT(ul) ); |
1051 RETURN ( __MKULARGEINT(ul) ); |
1046 #else |
1052 # else |
1047 __uint64__ *llp; |
1053 __uint64__ *llp; |
1048 |
1054 |
1049 llp = (__uint64__ *)(pFirst + (indx<<3)); |
1055 llp = (__uint64__ *)(pFirst + (indx<<3)); |
1050 RETURN (__MKUINT64(llp)); |
1056 RETURN (__MKUINT64(llp)); |
1051 #endif |
1057 # endif |
1052 } |
1058 } |
1053 break; |
1059 break; |
1054 } |
1060 } |
1055 } |
1061 } |
|
1062 #endif /* ! __JAVA__ */ |
1056 %}. |
1063 %}. |
1057 ^ self indexNotIntegerOrOutOfBounds:index |
1064 ^ self indexNotIntegerOrOutOfBounds:index |
1058 ! |
1065 ! |
1059 |
1066 |
1060 basicAt:index put:anObject |
1067 basicAt:index put:anObject |
1248 /* |
1264 /* |
1249 * zero means failure for an int larger than 4 bytes |
1265 * zero means failure for an int larger than 4 bytes |
1250 * (would be a smallInteger) |
1266 * (would be a smallInteger) |
1251 */ |
1267 */ |
1252 if (u) { |
1268 if (u) { |
1253 #if __POINTER_SIZE__ == 8 |
1269 # if __POINTER_SIZE__ == 8 |
1254 if (u <= 0xFFFFFFFF) |
1270 if (u <= 0xFFFFFFFF) |
1255 #endif |
1271 # endif |
1256 { |
1272 { |
1257 *lp = u; |
1273 *lp = u; |
1258 RETURN ( anObject ); |
1274 RETURN ( anObject ); |
1259 } |
1275 } |
1260 } |
1276 } |
1261 } |
1277 } |
1262 break; |
1278 break; |
1263 |
1279 |
1264 case __MASKSMALLINT(SLONGLONGARRAY): |
1280 case __MASKSMALLINT(SLONGLONGARRAY): |
1265 #ifdef __NEED_LONGLONG_ALIGN |
1281 # ifdef __NEED_LONGLONG_ALIGN |
1266 if ((INT)pFirst & (__LONGLONG_ALIGN-1)) { |
1282 if ((INT)pFirst & (__LONGLONG_ALIGN-1)) { |
1267 int delta = __LONGLONG_ALIGN - ((INT)pFirst & (__LONGLONG_ALIGN-1)); |
1283 int delta = __LONGLONG_ALIGN - ((INT)pFirst & (__LONGLONG_ALIGN-1)); |
1268 |
1284 |
1269 pFirst += delta; |
1285 pFirst += delta; |
1270 nbytes -= delta; |
1286 nbytes -= delta; |
1271 } |
1287 } |
1272 #endif |
1288 # endif |
1273 if ((unsigned)indx < (nbytes>>3)) { |
1289 if ((unsigned)indx < (nbytes>>3)) { |
1274 __int64__ ll; |
1290 __int64__ ll; |
1275 __int64__ *sllp; |
1291 __int64__ *sllp; |
1276 |
1292 |
1277 sllp = (__int64__ *)(pFirst + (indx<<3)); |
1293 sllp = (__int64__ *)(pFirst + (indx<<3)); |
1278 |
1294 |
1279 #if __POINTER_SIZE__ == 8 |
1295 # if __POINTER_SIZE__ == 8 |
1280 if (__isSmallInteger(anObject)) { |
1296 if (__isSmallInteger(anObject)) { |
1281 *sllp = __intVal(anObject); |
1297 *sllp = __intVal(anObject); |
1282 RETURN ( anObject ); |
1298 RETURN ( anObject ); |
1283 } |
1299 } |
1284 n = __signedLongIntVal(anObject); |
1300 n = __signedLongIntVal(anObject); |
1285 if (n) { |
1301 if (n) { |
1286 *sllp = n; |
1302 *sllp = n; |
1287 RETURN ( anObject ); |
1303 RETURN ( anObject ); |
1288 } |
1304 } |
1289 #else |
1305 # else |
1290 if (anObject == __mkSmallInteger(0)) { |
1306 if (anObject == __mkSmallInteger(0)) { |
1291 ll.lo = ll.hi = 0; |
1307 ll.lo = ll.hi = 0; |
1292 *sllp = ll; |
1308 *sllp = ll; |
1293 RETURN ( anObject ); |
1309 RETURN ( anObject ); |
1294 } |
1310 } |
1295 if (__signedLong64IntVal(anObject, &ll)) { |
1311 if (__signedLong64IntVal(anObject, &ll)) { |
1296 *sllp = ll; |
1312 *sllp = ll; |
1297 RETURN ( anObject ); |
1313 RETURN ( anObject ); |
1298 } |
1314 } |
1299 #endif |
1315 # endif |
1300 } |
1316 } |
1301 break; |
1317 break; |
1302 |
1318 |
1303 case __MASKSMALLINT(LONGLONGARRAY): |
1319 case __MASKSMALLINT(LONGLONGARRAY): |
1304 #ifdef __NEED_LONGLONG_ALIGN |
1320 # ifdef __NEED_LONGLONG_ALIGN |
1305 if ((INT)pFirst & (__LONGLONG_ALIGN-1)) { |
1321 if ((INT)pFirst & (__LONGLONG_ALIGN-1)) { |
1306 int delta = __LONGLONG_ALIGN - ((INT)pFirst & (__LONGLONG_ALIGN-1)); |
1322 int delta = __LONGLONG_ALIGN - ((INT)pFirst & (__LONGLONG_ALIGN-1)); |
1307 |
1323 |
1308 pFirst += delta; |
1324 pFirst += delta; |
1309 nbytes -= delta; |
1325 nbytes -= delta; |
1310 } |
1326 } |
1311 #endif |
1327 # endif |
1312 if ((unsigned)indx < (nbytes>>3)) { |
1328 if ((unsigned)indx < (nbytes>>3)) { |
1313 __uint64__ ll; |
1329 __uint64__ ll; |
1314 __uint64__ *llp; |
1330 __uint64__ *llp; |
1315 |
1331 |
1316 llp = (__uint64__ *)(pFirst + (indx<<3)); |
1332 llp = (__uint64__ *)(pFirst + (indx<<3)); |
1317 #if __POINTER_SIZE__ == 8 |
1333 # if __POINTER_SIZE__ == 8 |
1318 if (__isSmallInteger(anObject)) { |
1334 if (__isSmallInteger(anObject)) { |
1319 *llp = __intVal(anObject); |
1335 *llp = __intVal(anObject); |
1320 RETURN ( anObject ); |
1336 RETURN ( anObject ); |
1321 } |
1337 } |
1322 ll = __longIntVal(anObject); |
1338 ll = __longIntVal(anObject); |
1323 if (ll) { |
1339 if (ll) { |
1324 *llp = ll; |
1340 *llp = ll; |
1325 RETURN ( anObject ); |
1341 RETURN ( anObject ); |
1326 } |
1342 } |
1327 #else |
1343 # else |
1328 if (anObject == __mkSmallInteger(0)) { |
1344 if (anObject == __mkSmallInteger(0)) { |
1329 ll.lo = ll.hi = 0; |
1345 ll.lo = ll.hi = 0; |
1330 *llp = ll; |
1346 *llp = ll; |
1331 RETURN ( anObject ); |
1347 RETURN ( anObject ); |
1332 } |
1348 } |
1333 if (__unsignedLong64IntVal(anObject, &ll)) { |
1349 if (__unsignedLong64IntVal(anObject, &ll)) { |
1334 *llp = ll; |
1350 *llp = ll; |
1335 RETURN ( anObject ); |
1351 RETURN ( anObject ); |
1336 } |
1352 } |
1337 #endif |
1353 # endif |
1338 } |
1354 } |
1339 break; |
1355 break; |
1340 } |
1356 } |
1341 } |
1357 } |
|
1358 #endif /* ! JAVA */ |
1342 %}. |
1359 %}. |
1343 index isInteger ifFalse:[ |
1360 index isInteger ifFalse:[ |
1344 " |
1361 " |
1345 the index should be an integer number |
1362 the index should be an integer number |
1346 " |
1363 " |
1736 "store the attribute anObject referenced by key into the receiver" |
1753 "store the attribute anObject referenced by key into the receiver" |
1737 |
1754 |
1738 "/ must do this save from being reentered, since the attributes collection |
1755 "/ must do this save from being reentered, since the attributes collection |
1739 "/ is possibly accessed from multiple threads... |
1756 "/ is possibly accessed from multiple threads... |
1740 ObjectAttributesAccessLock critical:[ |
1757 ObjectAttributesAccessLock critical:[ |
1741 | attrs | |
1758 | attrs | |
1742 |
1759 |
1743 attrs := self objectAttributes. |
1760 attrs := self objectAttributes. |
1744 "/ only need a WeakIdentityDictionary, if there are any non-symbol keys in |
1761 "/ only need a WeakIdentityDictionary, if there are any non-symbol keys in |
1745 "/ it. Start with a regular IDDict, and migrate to WeakIDDict if ever required. |
1762 "/ it. Start with a regular IDDict, and migrate to WeakIDDict if ever required. |
1746 "/ Typically, this never happens (but does in the UIPainter!!) |
1763 "/ Typically, this never happens (but does in the UIPainter!!) |
1747 attrs isEmptyOrNil ifTrue:[ |
1764 attrs isEmptyOrNil ifTrue:[ |
1748 attributeKey isSymbol ifTrue:[ |
1765 attributeKey isSymbol ifTrue:[ |
1749 attrs := IdentityDictionary new. |
1766 attrs := IdentityDictionary new. |
1750 ] ifFalse:[ |
1767 ] ifFalse:[ |
1751 attrs := WeakIdentityDictionary new. |
1768 attrs := WeakIdentityDictionary new. |
1752 ]. |
1769 ]. |
1753 attrs at:attributeKey put:anObject. |
1770 attrs at:attributeKey put:anObject. |
1754 self objectAttributes:attrs. |
1771 self objectAttributes:attrs. |
1755 ] ifFalse:[ |
1772 ] ifFalse:[ |
1756 attributeKey isSymbol ifFalse:[ |
1773 attributeKey isSymbol ifFalse:[ |
1757 attrs isWeakCollection ifFalse:[ |
1774 attrs isWeakCollection ifFalse:[ |
1758 "first non-symbol attributeKey - convert to WeakIdentityDictionary" |
1775 "first non-symbol attributeKey - convert to WeakIdentityDictionary" |
1759 attrs := WeakIdentityDictionary new declareAllFrom:attrs. |
1776 attrs := WeakIdentityDictionary new declareAllFrom:attrs. |
1760 self objectAttributes:attrs. |
1777 self objectAttributes:attrs. |
1761 ]. |
1778 ]. |
1762 ]. |
1779 ]. |
1763 attrs at:attributeKey put:anObject. |
1780 attrs at:attributeKey put:anObject. |
1764 ]. |
1781 ]. |
1765 ] |
1782 ] |
1766 |
1783 |
1767 "Attaching additional attributes (slots) to an arbitrary object: |
1784 "Attaching additional attributes (slots) to an arbitrary object: |
1768 |
1785 |
1769 |p| |
1786 |p| |
3240 This message is intended for application developers, so its printed as info message." |
3257 This message is intended for application developers, so its printed as info message." |
3241 |
3258 |
3242 |spec sender message| |
3259 |spec sender message| |
3243 |
3260 |
3244 Smalltalk isSmalltalkDevelopmentSystem ifFalse:[ |
3261 Smalltalk isSmalltalkDevelopmentSystem ifFalse:[ |
3245 "ignore in production systems" |
3262 "ignore in production systems" |
3246 ^ self. |
3263 ^ self. |
3247 ]. |
3264 ]. |
3248 |
3265 |
3249 message := messageOrNil ? 'Obsolete method called'. |
3266 message := messageOrNil ? 'Obsolete method called'. |
3250 |
3267 |
3251 spec := aContext methodPrintString. |
3268 spec := aContext methodPrintString. |
3252 sender := aContext sender. |
3269 sender := aContext sender. |
3253 ('WARNING: the ''' , spec , ''' method is obsolete.') infoPrintCR. |
3270 ('WARNING: the ''' , spec , ''' method is obsolete.') infoPrintCR. |
3254 (' And may not be present in future ST/X versions.') infoPrintCR. |
3271 (' And may not be present in future ST/X versions.') infoPrintCR. |
3255 (' called from ' , sender printString) infoPrintCR. |
3272 (' called from ' , sender printString) infoPrintCR. |
3256 (sender selector startsWith:'perform:') ifTrue:[ |
3273 (sender selector startsWith:'perform:') ifTrue:[ |
3257 sender := sender sender. |
3274 sender := sender sender. |
3258 (sender selector startsWith:'perform:') ifTrue:[ |
3275 (sender selector startsWith:'perform:') ifTrue:[ |
3259 sender := sender sender. |
3276 sender := sender sender. |
3260 ]. |
3277 ]. |
3261 (' called from ' , sender printString) infoPrintCR. |
3278 (' called from ' , sender printString) infoPrintCR. |
3262 ]. |
3279 ]. |
3263 message notNil ifTrue:[ |
3280 message notNil ifTrue:[ |
3264 '------> ' infoPrint. message infoPrintCR |
3281 '------> ' infoPrint. message infoPrintCR |
3265 ]. |
3282 ]. |
3266 |
3283 |
3267 "CG: care for standalone non-GUI progs, which have no userPreferences class" |
3284 "CG: care for standalone non-GUI progs, which have no userPreferences class" |
3268 (Smalltalk isInitialized |
3285 (Smalltalk isInitialized |
3269 and:[ UserPreferences notNil |
3286 and:[ UserPreferences notNil |
3270 and:[ UserPreferences current haltInObsoleteMethod]]) ifTrue:[ |
3287 and:[ UserPreferences current haltInObsoleteMethod]]) ifTrue:[ |
3271 "/ cg: nice try, stefan, but I don't want halts in system processes (fly by help and others) |
3288 "/ cg: nice try, stefan, but I don't want halts in system processes (fly by help and others) |
3272 Processor activeProcess isSystemProcess ifTrue:[ |
3289 Processor activeProcess isSystemProcess ifTrue:[ |
3273 (message , ' - please fix this now (no halt in system process)') infoPrintCR |
3290 (message , ' - please fix this now (no halt in system process)') infoPrintCR |
3274 ] ifFalse:[ |
3291 ] ifFalse:[ |
3275 "/ please check for the sender of the obsoleteMethodWarning, |
3292 "/ please check for the sender of the obsoleteMethodWarning, |
3276 "/ and fix the code there. |
3293 "/ and fix the code there. |
3277 self halt:(message , ' - please fix this now!!') |
3294 self halt:(message , ' - please fix this now!!') |
3278 ]. |
3295 ]. |
3279 ]. |
3296 ]. |
3280 |
3297 |
3281 " |
3298 " |
3282 Object obsoleteMethodWarning:'foo' from:thisContext sender sender |
3299 Object obsoleteMethodWarning:'foo' from:thisContext sender sender |
3283 " |
3300 " |
5213 |
5230 |
5214 |name here sig fatal titles actions badContext msg pc addr |
5231 |name here sig fatal titles actions badContext msg pc addr |
5215 action title screen| |
5232 action title screen| |
5216 |
5233 |
5217 thisContext isRecursive ifTrue:[ |
5234 thisContext isRecursive ifTrue:[ |
5218 'Severe error: signalInterrupt while processing a signalInterrupt.' errorPrintCR. |
5235 'Severe error: signalInterrupt while processing a signalInterrupt.' errorPrintCR. |
5219 'Terminating process ' errorPrint. Processor activeProcess errorPrintCR. |
5236 'Terminating process ' errorPrint. Processor activeProcess errorPrintCR. |
5220 "/ GenericException handle:[:ex | |
5237 "/ GenericException handle:[:ex | |
5221 "/ "/ ignore any error during termination |
5238 "/ "/ ignore any error during termination |
5222 "/ ] do:[ |
5239 "/ ] do:[ |
5223 "/ Processor activeProcess terminate. |
5240 "/ Processor activeProcess terminate. |
5224 "/ ]. |
5241 "/ ]. |
5225 Processor activeProcess terminateNoSignal. |
5242 Processor activeProcess terminateNoSignal. |
5226 ]. |
5243 ]. |
5227 |
5244 |
5228 "if there has been an ST-signal installed, use it ..." |
5245 "if there has been an ST-signal installed, use it ..." |
5229 sig := OperatingSystem operatingSystemSignal:signalNumber. |
5246 sig := OperatingSystem operatingSystemSignal:signalNumber. |
5230 sig notNil ifTrue:[ |
5247 sig notNil ifTrue:[ |
5231 sig raiseSignalWith:signalNumber. |
5248 sig raiseSignalWith:signalNumber. |
5232 ^ self. |
5249 ^ self. |
5233 ]. |
5250 ]. |
5234 |
5251 |
5235 "/ if handled, raise OSSignalInterruptSignal |
5252 "/ if handled, raise OSSignalInterruptSignal |
5236 OSSignalInterrupt isHandled ifTrue:[ |
5253 OSSignalInterrupt isHandled ifTrue:[ |
5237 OSSignalInterrupt raiseRequestWith:signalNumber. |
5254 OSSignalInterrupt raiseRequestWith:signalNumber. |
5238 ^ self. |
5255 ^ self. |
5239 ]. |
5256 ]. |
5240 |
5257 |
5241 " |
5258 " |
5242 special cases |
5259 special cases |
5243 - SIGPWR: power failure - write a crash image and continue |
5260 - SIGPWR: power failure - write a crash image and continue |
5244 - SIGHUP: hang up - write a crash image and exit |
5261 - SIGHUP: hang up - write a crash image and exit |
5245 " |
5262 " |
5246 (signalNumber == OperatingSystem sigPWR) ifTrue:[ |
5263 (signalNumber == OperatingSystem sigPWR) ifTrue:[ |
5247 SnapshotError ignoreIn:[ObjectMemory writeCrashImage]. |
5264 SnapshotError ignoreIn:[ObjectMemory writeCrashImage]. |
5248 ^ self. |
5265 ^ self. |
5249 ]. |
5266 ]. |
5250 (signalNumber == OperatingSystem sigHUP) ifTrue:[ |
5267 (signalNumber == OperatingSystem sigHUP) ifTrue:[ |
5251 SnapshotError ignoreIn:[ObjectMemory writeCrashImage]. |
5268 SnapshotError ignoreIn:[ObjectMemory writeCrashImage]. |
5252 'Object [info]: exit due to hangup signal.' errorPrintCR. |
5269 'Object [info]: exit due to hangup signal.' errorPrintCR. |
5253 Smalltalk exit:1. |
5270 Smalltalk exit:1. |
5254 ]. |
5271 ]. |
5255 |
5272 |
5256 name := OperatingSystem nameForSignal:signalNumber. |
5273 name := OperatingSystem nameForSignal:signalNumber. |
5257 |
5274 |
5258 "if there is no screen at all, bring up a mini debugger" |
5275 "if there is no screen at all, bring up a mini debugger" |
5259 (Screen isNil |
5276 (Screen isNil |
5260 or:[(screen := Screen current) isNil |
5277 or:[(screen := Screen current) isNil |
5261 or:[(screen := Screen default) isNil |
5278 or:[(screen := Screen default) isNil |
5262 or:[screen isOpen not]]]) ifTrue:[ |
5279 or:[screen isOpen not]]]) ifTrue:[ |
5263 ^ self startMiniDebuggerOrExit:'OS-Signal (' , name, ')'. |
5280 ^ self startMiniDebuggerOrExit:'OS-Signal (' , name, ')'. |
5264 ]. |
5281 ]. |
5265 |
5282 |
5266 "ungrab - in case it happened in a box/popupview |
5283 "ungrab - in case it happened in a box/popupview |
5267 otherwise display stays locked" |
5284 otherwise display stays locked" |
5268 screen ungrabPointer; ungrabKeyboard. |
5285 screen ungrabPointer; ungrabKeyboard. |
5270 here := thisContext. |
5287 here := thisContext. |
5271 badContext := here sender. "the context, in which the signal occurred" |
5288 badContext := here sender. "the context, in which the signal occurred" |
5272 |
5289 |
5273 "there is a screen. use it to bring up a box asking for what to do ..." |
5290 "there is a screen. use it to bring up a box asking for what to do ..." |
5274 Screen currentScreenQuerySignal answer:screen do:[ |
5291 Screen currentScreenQuerySignal answer:screen do:[ |
5275 " |
5292 " |
5276 SIGBUS, SIGSEGV and SIGILL do not make sense to ignore (i.e. continue) |
5293 SIGBUS, SIGSEGV and SIGILL do not make sense to ignore (i.e. continue) |
5277 since the system will retry the faulty instruction, which leads to |
5294 since the system will retry the faulty instruction, which leads to |
5278 another signal - to avoid frustration, better not offer this option. |
5295 another signal - to avoid frustration, better not offer this option. |
5279 " |
5296 " |
5280 fatal := OperatingSystem isFatalSignal:signalNumber. |
5297 fatal := OperatingSystem isFatalSignal:signalNumber. |
5281 fatal ifTrue:[ |
5298 fatal ifTrue:[ |
5282 (Debugger isNil or:[here isRecursive]) ifTrue:[ |
5299 (Debugger isNil or:[here isRecursive]) ifTrue:[ |
5283 'Object [hard error]: signal ' errorPrint. signalNumber errorPrintCR. |
5300 'Object [hard error]: signal ' errorPrint. signalNumber errorPrintCR. |
5284 ^ self startMiniDebuggerOrExit:'OS-Signal (' , name, ')'. |
5301 ^ self startMiniDebuggerOrExit:'OS-Signal (' , name, ')'. |
5285 ]. |
5302 ]. |
5286 " |
5303 " |
5287 a hard signal - go into debugger immediately |
5304 a hard signal - go into debugger immediately |
5288 " |
5305 " |
5289 msg := 'OS-signal: ', name. |
5306 msg := 'OS-signal: ', name. |
5290 |
5307 |
5291 "/ the IRQ-PC is passed as low-hi, to avoid the need |
5308 "/ the IRQ-PC is passed as low-hi, to avoid the need |
5292 "/ to allocate a LargeInteger in the VM during signal |
5309 "/ to allocate a LargeInteger in the VM during signal |
5293 "/ time. I know, this is ugly. |
5310 "/ time. I know, this is ugly. |
5294 |
5311 |
5295 InterruptPcLow notNil ifTrue:[ |
5312 InterruptPcLow notNil ifTrue:[ |
5296 pc := InterruptPcLow + (InterruptPcHi bitShift:((SmallInteger maxBits + 1) // 2)). |
5313 pc := InterruptPcLow + (InterruptPcHi bitShift:((SmallInteger maxBits + 1) // 2)). |
5297 pc ~~ 0 ifTrue:[ |
5314 pc ~~ 0 ifTrue:[ |
5298 msg := msg , ' PC=' , (pc printStringRadix:16) |
5315 msg := msg , ' PC=' , (pc printStringRadix:16) |
5299 ]. |
5316 ]. |
5300 ]. |
5317 ]. |
5301 InterruptAddrLow notNil ifTrue:[ |
5318 InterruptAddrLow notNil ifTrue:[ |
5302 addr := InterruptAddrLow + (InterruptAddrHi bitShift:((SmallInteger maxBits + 1) // 2)). |
5319 addr := InterruptAddrLow + (InterruptAddrHi bitShift:((SmallInteger maxBits + 1) // 2)). |
5303 addr ~~ 0 ifTrue:[ |
5320 addr ~~ 0 ifTrue:[ |
5304 msg := msg , ' ADDR=' , (addr printStringRadix:16) |
5321 msg := msg , ' ADDR=' , (addr printStringRadix:16) |
5305 ]. |
5322 ]. |
5306 ]. |
5323 ]. |
5307 Debugger enter:here withMessage:msg mayProceed:false. |
5324 Debugger enter:here withMessage:msg mayProceed:false. |
5308 "unreachable" |
5325 "unreachable" |
5309 ^ nil. |
5326 ^ nil. |
5310 ]. |
5327 ]. |
5311 |
5328 |
5312 "if possible, open an option box asking the user what do. |
5329 "if possible, open an option box asking the user what do. |
5313 Otherwise, start a debugger" |
5330 Otherwise, start a debugger" |
5314 Dialog notNil ifTrue:[ |
5331 Dialog notNil ifTrue:[ |
5315 OperatingSystem isOSXlike ifTrue:[ |
5332 OperatingSystem isOSXlike ifTrue:[ |
5316 titles := #('Save crash image' 'Dump core' 'GDB' 'Exit ST/X' 'Debug'). |
5333 titles := #('Save crash image' 'Dump core' 'GDB' 'Exit ST/X' 'Debug'). |
5317 actions := #(save core gdb exit debug). |
5334 actions := #(save core gdb exit debug). |
5318 ] ifFalse:[ |
5335 ] ifFalse:[ |
5319 titles := #('Save crash image' 'Dump core' 'Exit ST/X' 'Debug'). |
5336 titles := #('Save crash image' 'Dump core' 'Exit ST/X' 'Debug'). |
5320 actions := #(save core exit debug). |
5337 actions := #(save core exit debug). |
5321 ]. |
5338 ]. |
5322 action := nil. |
5339 action := nil. |
5323 title := 'OS Signal caught (' , name, ')'. |
5340 title := 'OS Signal caught (' , name, ')'. |
5324 title := (title , '\[in ST-process: ' , Processor activeProcess nameOrId ,']') withCRs. |
5341 title := (title , '\[in ST-process: ' , Processor activeProcess nameOrId ,']') withCRs. |
5325 |
5342 |
5326 "/ if caught while in the scheduler or event dispatcher, |
5343 "/ if caught while in the scheduler or event dispatcher, |
5327 "/ a modal dialog is not possible ... |
5344 "/ a modal dialog is not possible ... |
5328 "/ (therefore, abort & return does not makes sense) |
5345 "/ (therefore, abort & return does not makes sense) |
5329 |
5346 |
5330 Processor activeProcess isSystemProcess ifFalse:[ |
5347 Processor activeProcess isSystemProcess ifFalse:[ |
5331 titles := #('Abort') , titles. |
5348 titles := #('Abort') , titles. |
5332 actions := #(abort), actions. |
5349 actions := #(abort), actions. |
5333 |
5350 |
5334 badContext canReturn ifTrue:[ |
5351 badContext canReturn ifTrue:[ |
5335 titles := #('Return') , titles. |
5352 titles := #('Return') , titles. |
5336 actions := #(return), actions. |
5353 actions := #(return), actions. |
5337 ]. |
5354 ]. |
5338 ]. |
5355 ]. |
5339 |
5356 |
5340 fatal ifFalse:[ |
5357 fatal ifFalse:[ |
5341 titles := titles, #('Ignore'). |
5358 titles := titles, #('Ignore'). |
5342 actions := actions , #(ignore). |
5359 actions := actions , #(ignore). |
5343 ]. |
5360 ]. |
5344 action := Dialog choose:title |
5361 action := Dialog choose:title |
5345 labels:titles |
5362 labels:titles |
5346 values:actions |
5363 values:actions |
5347 default:(fatal ifTrue:[nil] ifFalse:[#ignore]). |
5364 default:(fatal ifTrue:[nil] ifFalse:[#ignore]). |
5348 |
5365 |
5349 "Dialog may fail (if system process), default action is debug" |
5366 "Dialog may fail (if system process), default action is debug" |
5350 action isEmptyOrNil ifTrue:[action := #debug]. |
5367 action isEmptyOrNil ifTrue:[action := #debug]. |
5351 ] ifFalse:[ |
5368 ] ifFalse:[ |
5352 action := #debug. |
5369 action := #debug. |
5353 ]. |
5370 ]. |
5354 |
5371 |
5355 action == #save ifTrue:[ |
5372 action == #save ifTrue:[ |
5356 ObjectMemory writeCrashImage |
5373 ObjectMemory writeCrashImage |
5357 ]. |
5374 ]. |
5358 action == #gdb ifTrue:[ |
5375 action == #gdb ifTrue:[ |
5359 |pid| |
5376 |pid| |
5360 |
5377 |
5361 pid := OperatingSystem getProcessId. |
5378 pid := OperatingSystem getProcessId. |
5362 OperatingSystem openTerminalWithCommand:('gdb -p %1' bindWith:pid) inBackground:true. |
5379 OperatingSystem openTerminalWithCommand:('gdb -p %1' bindWith:pid) inBackground:true. |
5363 MiniDebugger enter. "/ to stop, so gdb can show where we are |
5380 MiniDebugger enter. "/ to stop, so gdb can show where we are |
5364 AbortOperationRequest raise. |
5381 AbortOperationRequest raise. |
5365 ]. |
5382 ]. |
5366 action == #core ifTrue:[ |
5383 action == #core ifTrue:[ |
5367 Smalltalk fatalAbort |
5384 Smalltalk fatalAbort |
5368 ]. |
5385 ]. |
5369 action == #exit ifTrue:[ |
5386 action == #exit ifTrue:[ |
5370 Smalltalk exit:10. |
5387 Smalltalk exit:10. |
5371 ]. |
5388 ]. |
5372 action == #return ifTrue:[ |
5389 action == #return ifTrue:[ |
5373 badContext return |
5390 badContext return |
5374 ]. |
5391 ]. |
5375 action == #abort ifTrue:[ |
5392 action == #abort ifTrue:[ |
5376 AbortOperationRequest raise. |
5393 AbortOperationRequest raise. |
5377 ]. |
5394 ]. |
5378 |
5395 |
5379 action == #debug ifTrue:[ |
5396 action == #debug ifTrue:[ |
5380 Debugger isNil ifTrue:[ |
5397 Debugger isNil ifTrue:[ |
5381 ^ self startMiniDebuggerOrExit:'OS-Signal (' , name, ')'. |
5398 ^ self startMiniDebuggerOrExit:'OS-Signal (' , name, ')'. |
5382 ]. |
5399 ]. |
5383 Debugger enter:here withMessage:('OS-Signal ', name) mayProceed:true. |
5400 Debugger enter:here withMessage:('OS-Signal ', name) mayProceed:true. |
5384 ]. |
5401 ]. |
5385 "action == #ignore" |
5402 "action == #ignore" |
5386 ]. |
5403 ]. |
5387 |
5404 |
5388 "Modified: / 15-09-2011 / 16:38:14 / cg" |
5405 "Modified: / 15-09-2011 / 16:38:14 / cg" |
5389 ! |
5406 ! |
5390 |
5407 |
5490 |
5507 |
5491 #undef SEL_AND_ILC_INIT_131 |
5508 #undef SEL_AND_ILC_INIT_131 |
5492 #undef SEL_AND_ILC_INIT_257 |
5509 #undef SEL_AND_ILC_INIT_257 |
5493 |
5510 |
5494 #define TRY(n) \ |
5511 #define TRY(n) \ |
5495 if (sel == sel_and_ilc[hash0].sel[n]) { \ |
5512 if (sel == sel_and_ilc[hash0].sel[n]) { \ |
5496 pIlc = &sel_and_ilc[hash0].ilc[n]; \ |
5513 pIlc = &sel_and_ilc[hash0].ilc[n]; \ |
5497 goto perform0_send_and_return; \ |
5514 goto perform0_send_and_return; \ |
5498 } |
5515 } |
5499 |
5516 |
5500 if (__isNonNilObject(sel)) { |
5517 if (__isNonNilObject(sel)) { |
5501 hash0 = __MAKE_HASH__(__GET_HASH(sel)) % nilcs; |
5518 hash0 = __MAKE_HASH__(__GET_HASH(sel)) % nilcs; |
5502 } else { |
5519 } else { |
5503 /* sel is either nil or smallint, use its value as hash */ |
5520 /* sel is either nil or smallint, use its value as hash */ |
5504 hash0 = (INT)sel % nilcs; |
5521 hash0 = (INT)sel % nilcs; |
5505 } |
5522 } |
5506 |
5523 |
5507 TRY(0); |
5524 TRY(0); |
5508 TRY(1); |
5525 TRY(1); |
5509 |
5526 |
5510 #undef TRY |
5527 #undef TRY |
5511 /*printf("Object >> #perform: #%s --> no PIC found\n", __symbolVal(aSelector));*/ |
5528 /*printf("Object >> #perform: #%s --> no PIC found\n", __symbolVal(aSelector));*/ |
5512 |
5529 |
5513 pIlc = &sel_and_ilc[hash0].ilc[sel_and_ilc[hash0].flip]; |
5530 pIlc = &sel_and_ilc[hash0].ilc[sel_and_ilc[hash0].flip]; |
5514 sel_and_ilc[hash0].sel[sel_and_ilc[hash0].flip] = sel; |
5531 sel_and_ilc[hash0].sel[sel_and_ilc[hash0].flip] = sel; |
5515 sel_and_ilc[hash0].flip = (sel_and_ilc[hash0].flip + 1) % nways; |
5532 sel_and_ilc[hash0].flip = (sel_and_ilc[hash0].flip + 1) % nways; |
5516 pIlc->ilc_func = __SEND0ADDR__; |
5533 pIlc->ilc_func = __SEND0ADDR__; |
5517 if (pIlc->ilc_poly) { |
5534 if (pIlc->ilc_poly) { |
5518 __flushPolyCache(pIlc->ilc_poly); |
5535 __flushPolyCache(pIlc->ilc_poly); |
5519 pIlc->ilc_poly = 0; |
5536 pIlc->ilc_poly = 0; |
5520 } |
5537 } |
5521 perform0_send_and_return: |
5538 perform0_send_and_return: |
5522 RETURN ( (*(pIlc->ilc_func))(self, sel, nil, pIlc) ); |
5539 RETURN ( (*(pIlc->ilc_func))(self, sel, nil, pIlc) ); |
5523 } else { |
5540 } else { |
5524 static struct inlineCache ilc0 = __DUMMYILCSELF0(@line+1); |
5541 static struct inlineCache ilc0 = __DUMMYILCSELF0(@line+1); |
5525 RETURN (_SEND0(self, aSelector, nil, &ilc0)); |
5542 RETURN (_SEND0(self, aSelector, nil, &ilc0)); |
5526 } |
5543 } |
5527 %}. |
5544 %}. |
5528 ^ self perform:aSelector withArguments:#() |
5545 ^ self perform:aSelector withArguments:#() |
5529 ! |
5546 ! |
5530 |
5547 |
5770 |
5787 |
5771 #undef SEL_AND_ILC_INIT_131 |
5788 #undef SEL_AND_ILC_INIT_131 |
5772 #undef SEL_AND_ILC_INIT_257 |
5789 #undef SEL_AND_ILC_INIT_257 |
5773 |
5790 |
5774 #define TRY(n) \ |
5791 #define TRY(n) \ |
5775 if (sel == sel_and_ilc[hash0].sel[n]) { \ |
5792 if (sel == sel_and_ilc[hash0].sel[n]) { \ |
5776 pIlc = &sel_and_ilc[hash0].ilc[n]; \ |
5793 pIlc = &sel_and_ilc[hash0].ilc[n]; \ |
5777 goto perform1_send_and_return; \ |
5794 goto perform1_send_and_return; \ |
5778 } |
5795 } |
5779 |
5796 |
5780 if (__isNonNilObject(sel)) { |
5797 if (__isNonNilObject(sel)) { |
5781 hash0 = __MAKE_HASH__(__GET_HASH(sel)) % nilcs; |
5798 hash0 = __MAKE_HASH__(__GET_HASH(sel)) % nilcs; |
5782 } else { |
5799 } else { |
5783 /* sel is either nil or smallint, use its value as hash */ |
5800 /* sel is either nil or smallint, use its value as hash */ |
5784 hash0 = (INT)sel % nilcs; |
5801 hash0 = (INT)sel % nilcs; |
5785 } |
5802 } |
5786 |
5803 |
5787 TRY(0); |
5804 TRY(0); |
5788 TRY(1); |
5805 TRY(1); |
5789 |
5806 |
5790 #undef TRY |
5807 #undef TRY |
5791 /*printf("Object >> #perform: #%s --> no PIC found\n", __symbolVal(aSelector));*/ |
5808 /*printf("Object >> #perform: #%s --> no PIC found\n", __symbolVal(aSelector));*/ |
5792 |
5809 |
5793 pIlc = &sel_and_ilc[hash0].ilc[sel_and_ilc[hash0].flip]; |
5810 pIlc = &sel_and_ilc[hash0].ilc[sel_and_ilc[hash0].flip]; |
5794 sel_and_ilc[hash0].sel[sel_and_ilc[hash0].flip] = sel; |
5811 sel_and_ilc[hash0].sel[sel_and_ilc[hash0].flip] = sel; |
5795 sel_and_ilc[hash0].flip = (sel_and_ilc[hash0].flip + 1) % nways; |
5812 sel_and_ilc[hash0].flip = (sel_and_ilc[hash0].flip + 1) % nways; |
5796 pIlc->ilc_func = __SEND1ADDR__; |
5813 pIlc->ilc_func = __SEND1ADDR__; |
5797 if (pIlc->ilc_poly) { |
5814 if (pIlc->ilc_poly) { |
5798 __flushPolyCache(pIlc->ilc_poly); |
5815 __flushPolyCache(pIlc->ilc_poly); |
5799 pIlc->ilc_poly = 0; |
5816 pIlc->ilc_poly = 0; |
5800 } |
5817 } |
5801 |
5818 |
5802 perform1_send_and_return: |
5819 perform1_send_and_return: |
5803 RETURN ( (*(pIlc->ilc_func))(self, sel, nil, pIlc, arg) ); |
5820 RETURN ( (*(pIlc->ilc_func))(self, sel, nil, pIlc, arg) ); |
5804 } else { |
5821 } else { |
5805 static struct inlineCache ilc1 = __DUMMYILCSELF1(@line+1); |
5822 static struct inlineCache ilc1 = __DUMMYILCSELF1(@line+1); |
5806 RETURN (_SEND1(self, aSelector, nil, &ilc1, arg)); |
5823 RETURN (_SEND1(self, aSelector, nil, &ilc1, arg)); |
5807 } |
5824 } |
5808 %}. |
5825 %}. |
5809 ^ self perform:aSelector withArguments:(Array with:arg) |
5826 ^ self perform:aSelector withArguments:(Array with:arg) |
5810 ! |
5827 ! |
5811 |
5828 |
5850 |
5867 |
5851 #undef SEL_AND_ILC_INIT_131 |
5868 #undef SEL_AND_ILC_INIT_131 |
5852 #undef SEL_AND_ILC_INIT_257 |
5869 #undef SEL_AND_ILC_INIT_257 |
5853 |
5870 |
5854 #define TRY(n) \ |
5871 #define TRY(n) \ |
5855 if (sel == sel_and_ilc[hash0].sel[n]) { \ |
5872 if (sel == sel_and_ilc[hash0].sel[n]) { \ |
5856 pIlc = &sel_and_ilc[hash0].ilc[n]; \ |
5873 pIlc = &sel_and_ilc[hash0].ilc[n]; \ |
5857 goto perform2_send_and_return; \ |
5874 goto perform2_send_and_return; \ |
5858 } |
5875 } |
5859 |
5876 |
5860 if (__isNonNilObject(sel)) { |
5877 if (__isNonNilObject(sel)) { |
5861 hash0 = __MAKE_HASH__(__GET_HASH(sel)) % nilcs; |
5878 hash0 = __MAKE_HASH__(__GET_HASH(sel)) % nilcs; |
5862 } else { |
5879 } else { |
5863 /* sel is either nil or smallint, use its value as hash */ |
5880 /* sel is either nil or smallint, use its value as hash */ |
5864 hash0 = (INT)sel % nilcs; |
5881 hash0 = (INT)sel % nilcs; |
5865 } |
5882 } |
5866 |
5883 |
5867 TRY(0); |
5884 TRY(0); |
5868 TRY(1); |
5885 TRY(1); |
5869 |
5886 |
5870 #undef TRY |
5887 #undef TRY |
5871 /*printf("Object >> #perform: #%s --> no PIC found\n", __symbolVal(aSelector));*/ |
5888 /*printf("Object >> #perform: #%s --> no PIC found\n", __symbolVal(aSelector));*/ |
5872 |
5889 |
5873 pIlc = &sel_and_ilc[hash0].ilc[sel_and_ilc[hash0].flip]; |
5890 pIlc = &sel_and_ilc[hash0].ilc[sel_and_ilc[hash0].flip]; |
5874 sel_and_ilc[hash0].sel[sel_and_ilc[hash0].flip] = sel; |
5891 sel_and_ilc[hash0].sel[sel_and_ilc[hash0].flip] = sel; |
5875 sel_and_ilc[hash0].flip = (sel_and_ilc[hash0].flip + 1) % nways; |
5892 sel_and_ilc[hash0].flip = (sel_and_ilc[hash0].flip + 1) % nways; |
5876 pIlc->ilc_func = __SEND2ADDR__; |
5893 pIlc->ilc_func = __SEND2ADDR__; |
5877 if (pIlc->ilc_poly) { |
5894 if (pIlc->ilc_poly) { |
5878 __flushPolyCache(pIlc->ilc_poly); |
5895 __flushPolyCache(pIlc->ilc_poly); |
5879 pIlc->ilc_poly = 0; |
5896 pIlc->ilc_poly = 0; |
5880 } |
5897 } |
5881 |
5898 |
5882 perform2_send_and_return: |
5899 perform2_send_and_return: |
5883 RETURN ( (*(pIlc->ilc_func))(self, aSelector, nil, pIlc, arg1, arg2) ); |
5900 RETURN ( (*(pIlc->ilc_func))(self, aSelector, nil, pIlc, arg1, arg2) ); |
5884 } else { |
5901 } else { |
5885 static struct inlineCache ilc2 = __DUMMYILCSELF2(@line+1); |
5902 static struct inlineCache ilc2 = __DUMMYILCSELF2(@line+1); |
5886 RETURN (_SEND2(self, aSelector, nil, &ilc2, arg1, arg2)); |
5903 RETURN (_SEND2(self, aSelector, nil, &ilc2, arg1, arg2)); |
5887 } |
5904 } |
5888 %}. |
5905 %}. |
5889 ^ self perform:aSelector withArguments:(Array with:arg1 with:arg2) |
5906 ^ self perform:aSelector withArguments:(Array with:arg1 with:arg2) |
5890 ! |
5907 ! |
5891 |
5908 |
7533 Use storeBinaryOn:, which handles these cases correctly." |
7550 Use storeBinaryOn:, which handles these cases correctly." |
7534 |
7551 |
7535 |myClass hasSemi sz "{ Class: SmallInteger }" | |
7552 |myClass hasSemi sz "{ Class: SmallInteger }" | |
7536 |
7553 |
7537 thisContext isRecursive ifTrue:[ |
7554 thisContext isRecursive ifTrue:[ |
7538 RecursiveStoreError raiseRequestWith:self. |
7555 RecursiveStoreError raiseRequestWith:self. |
7539 'Object [error]: storeString of self referencing object (' errorPrint. |
7556 'Object [error]: storeString of self referencing object (' errorPrint. |
7540 self class name errorPrint. |
7557 self class name errorPrint. |
7541 ')' errorPrintCR. |
7558 ')' errorPrintCR. |
7542 aStream nextPutAll:'#("recursive")'. |
7559 aStream nextPutAll:'#("recursive")'. |
7543 ^ self |
7560 ^ self |
7544 ]. |
7561 ]. |
7545 |
7562 |
7546 myClass := self class. |
7563 myClass := self class. |
7547 aStream nextPut:$(. |
7564 aStream nextPut:$(. |
7548 aStream nextPutAll:self class name. |
7565 aStream nextPutAll:self class name. |
7549 |
7566 |
7550 hasSemi := false. |
7567 hasSemi := false. |
7551 myClass isVariable ifTrue:[ |
7568 myClass isVariable ifTrue:[ |
7552 aStream nextPutAll:' basicNew:'. |
7569 aStream nextPutAll:' basicNew:'. |
7553 self basicSize printOn:aStream |
7570 self basicSize printOn:aStream |
7554 ] ifFalse:[ |
7571 ] ifFalse:[ |
7555 aStream nextPutAll:' basicNew' |
7572 aStream nextPutAll:' basicNew' |
7556 ]. |
7573 ]. |
7557 |
7574 |
7558 sz := myClass instSize. |
7575 sz := myClass instSize. |
7559 1 to:sz do:[:i | |
7576 1 to:sz do:[:i | |
7560 |ref| |
7577 |ref| |
7561 |
7578 |
7562 ref := (self instVarAt:i). |
7579 ref := (self instVarAt:i). |
7563 "/ no need to store nil entries, because the object has been instantiated |
7580 "/ no need to store nil entries, because the object has been instantiated |
7564 "/ with basicNew just a moment ago (so the fields are already nil) |
7581 "/ with basicNew just a moment ago (so the fields are already nil) |
7565 ref notNil ifTrue:[ |
7582 ref notNil ifTrue:[ |
7566 aStream nextPutAll:' instVarAt:'. |
7583 aStream nextPutAll:' instVarAt:'. |
7567 i printOn:aStream. |
7584 i printOn:aStream. |
7568 aStream nextPutAll:' put:'. |
7585 aStream nextPutAll:' put:'. |
7569 ref storeOn:aStream. |
7586 ref storeOn:aStream. |
7570 aStream nextPut:$;. |
7587 aStream nextPut:$;. |
7571 hasSemi := true |
7588 hasSemi := true |
7572 ]. |
7589 ]. |
7573 ]. |
7590 ]. |
7574 myClass isVariable ifTrue:[ |
7591 myClass isVariable ifTrue:[ |
7575 sz := self basicSize. |
7592 sz := self basicSize. |
7576 1 to:sz do:[:i | |
7593 1 to:sz do:[:i | |
7577 |ref| |
7594 |ref| |
7578 |
7595 |
7579 ref := (self basicAt:i). |
7596 ref := (self basicAt:i). |
7580 "/ no need to store nil entries, because the object has been instantiated |
7597 "/ no need to store nil entries, because the object has been instantiated |
7581 "/ with basicNew just a moment ago (so the fields are already nil) |
7598 "/ with basicNew just a moment ago (so the fields are already nil) |
7582 ref notNil ifTrue:[ |
7599 ref notNil ifTrue:[ |
7583 aStream nextPutAll:' basicAt:'. |
7600 aStream nextPutAll:' basicAt:'. |
7584 i printOn:aStream. |
7601 i printOn:aStream. |
7585 aStream nextPutAll:' put:'. |
7602 aStream nextPutAll:' put:'. |
7586 ref storeOn:aStream. |
7603 ref storeOn:aStream. |
7587 aStream nextPut:$;. |
7604 aStream nextPut:$;. |
7588 hasSemi := true |
7605 hasSemi := true |
7589 ] |
7606 ] |
7590 ] |
7607 ] |
7591 ]. |
7608 ]. |
7592 hasSemi ifTrue:[ |
7609 hasSemi ifTrue:[ |
7593 aStream nextPutAll:' yourself' |
7610 aStream nextPutAll:' yourself' |
7594 ]. |
7611 ]. |
7595 aStream nextPut:$). |
7612 aStream nextPut:$). |
7596 |
7613 |
7597 " |
7614 " |
7598 |s| |
7615 |s| |
8665 otherClass autoload. |
8688 otherClass autoload. |
8666 |
8689 |
8667 "check for UndefinedObject/SmallInteger receiver or newClass" |
8690 "check for UndefinedObject/SmallInteger receiver or newClass" |
8668 %{ |
8691 %{ |
8669 { |
8692 { |
8670 OBJ other = otherClass; |
8693 OBJ other = otherClass; |
8671 |
8694 |
8672 if (__isNonNilObject(self) |
8695 if (__isNonNilObject(self) |
8673 && __isNonNilObject(other) |
8696 && __isNonNilObject(other) |
8674 && (other != UndefinedObject) |
8697 && (other != UndefinedObject) |
8675 && (other != SmallInteger)) { |
8698 && (other != SmallInteger)) { |
8676 ok = true; |
8699 ok = true; |
8677 } else { |
8700 } else { |
8678 ok = false; |
8701 ok = false; |
8679 } |
8702 } |
8680 } |
8703 } |
8681 %}. |
8704 %}. |
8682 ok ifTrue:[ |
8705 ok ifTrue:[ |
8683 ok := false. |
8706 ok := false. |
8684 myClass := self class. |
8707 myClass := self class. |
8685 myClass == otherClass ifTrue:[ |
8708 myClass == otherClass ifTrue:[ |
8686 "nothing to change" |
8709 "nothing to change" |
8687 ^ self. |
8710 ^ self. |
8688 ]. |
8711 ]. |
8689 myClass flags == otherClass flags ifTrue:[ |
8712 myClass flags == otherClass flags ifTrue:[ |
8690 myClass instSize == otherClass instSize ifTrue:[ |
8713 myClass instSize == otherClass instSize ifTrue:[ |
8691 "same instance layout and types: its ok to do it" |
8714 "same instance layout and types: its ok to do it" |
8692 ok := true. |
8715 ok := true. |
8693 ] ifFalse:[ |
8716 ] ifFalse:[ |
8694 myClass isPointers ifTrue:[ |
8717 myClass isPointers ifTrue:[ |
8695 myClass isVariable ifTrue:[ |
8718 myClass isVariable ifTrue:[ |
8696 ok := true |
8719 ok := true |
8697 ] |
8720 ] |
8698 ] |
8721 ] |
8699 ] |
8722 ] |
8700 ] ifFalse:[ |
8723 ] ifFalse:[ |
8701 myClass isPointers ifTrue:[ |
8724 myClass isPointers ifTrue:[ |
8702 "if newClass is a variable class, with instSize <= my instsize, |
8725 "if newClass is a variable class, with instSize <= my instsize, |
8703 we can do it (effectively mapping additional instvars into the |
8726 we can do it (effectively mapping additional instvars into the |
8704 variable part) - usefulness is questionable, though" |
8727 variable part) - usefulness is questionable, though" |
8705 |
8728 |
8706 otherClass isPointers ifTrue:[ |
8729 otherClass isPointers ifTrue:[ |
8707 otherClass isVariable ifTrue:[ |
8730 otherClass isVariable ifTrue:[ |
8708 otherClass instSize <= (myClass instSize + self basicSize) |
8731 otherClass instSize <= (myClass instSize + self basicSize) |
8709 ifTrue:[ |
8732 ifTrue:[ |
8710 ok := true |
8733 ok := true |
8711 ] |
8734 ] |
8712 ] ifFalse:[ |
8735 ] ifFalse:[ |
8713 otherClass instSize == (myClass instSize + self basicSize) |
8736 otherClass instSize == (myClass instSize + self basicSize) |
8714 ifTrue:[ |
8737 ifTrue:[ |
8715 ok := true |
8738 ok := true |
8716 ] |
8739 ] |
8717 ] |
8740 ] |
8718 ] ifFalse:[ |
8741 ] ifFalse:[ |
8719 "it does not make sense to convert pointers to bytes ..." |
8742 "it does not make sense to convert pointers to bytes ..." |
8720 ] |
8743 ] |
8721 ] ifFalse:[ |
8744 ] ifFalse:[ |
8722 "does it make sense, to convert bits ?" |
8745 "does it make sense, to convert bits ?" |
8723 "could allow byteArray->wordArray->longArray->floatArray->doubleArray here ..." |
8746 "could allow byteArray->wordArray->longArray->floatArray->doubleArray here ..." |
8724 (myClass isBitsExtended and:[otherClass isBitsExtended]) ifTrue:[ |
8747 (myClass isBitsExtended and:[otherClass isBitsExtended]) ifTrue:[ |
8725 ok := true |
8748 ok := true |
8726 ] |
8749 ] |
8727 ] |
8750 ] |
8728 ] |
8751 ] |
8729 ]. |
8752 ]. |
8730 ok ifTrue:[ |
8753 ok ifTrue:[ |
8731 "now, change the receivers class ..." |
8754 "now, change the receivers class ..." |
8732 %{ |
8755 %{ |
8733 { |
8756 { |
8734 OBJ me = self; |
8757 OBJ me = self; |
8735 |
8758 |
8736 // gcc4.4 does not like this: |
8759 // gcc4.4 does not like this: |
8737 // __qClass(me) = otherClass; |
8760 // __qClass(me) = otherClass; |
8738 __objPtr(me)->o_class = (CLASS_OBJ)otherClass; |
8761 __objPtr(me)->o_class = (CLASS_OBJ)otherClass; |
8739 __STORE(me, otherClass); |
8762 __STORE(me, otherClass); |
8740 RETURN (me); |
8763 RETURN (me); |
8741 } |
8764 } |
8742 %}. |
8765 %}. |
8743 ]. |
8766 ]. |
8744 |
8767 |
8745 " |
8768 " |
8746 the receiver cannot be represented as a instance of |
8769 the receiver cannot be represented as a instance of |
9951 telling user something and optionally give the user a chance to enter debugger." |
9974 telling user something and optionally give the user a chance to enter debugger." |
9952 |
9975 |
9953 |currentScreen con sender action boxLabels boxValues default s| |
9976 |currentScreen con sender action boxLabels boxValues default s| |
9954 |
9977 |
9955 Smalltalk isInitialized ifFalse:[ |
9978 Smalltalk isInitialized ifFalse:[ |
9956 'errorNotification: ' print. aString printCR. |
9979 'errorNotification: ' print. aString printCR. |
9957 con := aContext ? thisContext methodHome. |
9980 con := aContext ? thisContext methodHome. |
9958 con sender printAllLevels:10. |
9981 con sender printAllLevels:10. |
9959 ^ nil |
9982 ^ nil |
9960 ]. |
9983 ]. |
9961 |
9984 |
9962 (Dialog isNil |
9985 (Dialog isNil |
9963 or:[Screen isNil |
9986 or:[Screen isNil |
9964 or:[(currentScreen := Screen current) isNil |
9987 or:[(currentScreen := Screen current) isNil |
9965 or:[currentScreen isOpen not]]]) ifTrue:[ |
9988 or:[currentScreen isOpen not]]]) ifTrue:[ |
9966 " |
9989 " |
9967 on systems without GUI, simply show |
9990 on systems without GUI, simply show |
9968 the message on the Transcript and abort. |
9991 the message on the Transcript and abort. |
9969 " |
9992 " |
9970 Transcript showCR:aString. |
9993 Transcript showCR:aString. |
9971 AbortOperationRequest raise. |
9994 AbortOperationRequest raise. |
9972 "not reached" |
9995 "not reached" |
9973 ^ nil |
9996 ^ nil |
9974 ]. |
9997 ]. |
9975 |
9998 |
9976 Processor activeProcessIsSystemProcess ifTrue:[ |
9999 Processor activeProcessIsSystemProcess ifTrue:[ |
9977 action := #debug. |
10000 action := #debug. |
9978 sender := aContext. |
10001 sender := aContext. |
9979 Debugger isNil ifTrue:[ |
10002 Debugger isNil ifTrue:[ |
9980 '****************** Caught Error while in SystemProcess ****************' errorPrintCR. |
10003 '****************** Caught Error while in SystemProcess ****************' errorPrintCR. |
9981 aString errorPrintCR. |
10004 aString errorPrintCR. |
9982 Exception handle:[:ex | |
10005 Exception handle:[:ex | |
9983 'Caught recursive error while printing backtrace:' errorPrintCR. |
10006 'Caught recursive error while printing backtrace:' errorPrintCR. |
9984 ex description errorPrintCR. |
10007 ex description errorPrintCR. |
9985 ] do:[ |
10008 ] do:[ |
9986 thisContext fullPrintAll. |
10009 thisContext fullPrintAll. |
9987 ]. |
10010 ]. |
9988 action := #abort. |
10011 action := #abort. |
9989 ]. |
10012 ]. |
9990 ] ifFalse:[ |
10013 ] ifFalse:[ |
9991 Dialog autoload. "in case it's autoloaded" |
10014 Dialog autoload. "in case it's autoloaded" |
9992 |
10015 |
9993 Error handle:[:ex | |
10016 Error handle:[:ex | |
9994 "/ a recursive error - quickly enter debugger |
10017 "/ a recursive error - quickly enter debugger |
9995 "/ this happened, when I corrupted the Dialog class ... |
10018 "/ this happened, when I corrupted the Dialog class ... |
9996 ('Object [error]: ' , ex description , ' caught in errorNotification') errorPrintCR. |
10019 ('Object [error]: ' , ex description , ' caught in errorNotification') errorPrintCR. |
9997 action := #debug. |
10020 action := #debug. |
9998 ex return. |
10021 ex return. |
9999 ] do:[ |s| |
10022 ] do:[ |s| |
10000 sender := aContext. |
10023 sender := aContext. |
10001 sender isNil ifTrue:[ |
10024 sender isNil ifTrue:[ |
10002 sender := thisContext methodHome sender. |
10025 sender := thisContext methodHome sender. |
10003 ]. |
10026 ]. |
10004 con := sender. |
10027 con := sender. |
10005 |
10028 |
10006 "/ skip intermediate (signal & exception) contexts |
10029 "/ skip intermediate (signal & exception) contexts |
10007 DebugView notNil ifTrue:[ |
10030 DebugView notNil ifTrue:[ |
10008 con := DebugView interestingContextFrom:sender |
10031 con := DebugView interestingContextFrom:sender |
10009 ]. |
10032 ]. |
10010 |
10033 |
10011 "/ show the first few contexts |
10034 "/ show the first few contexts |
10012 |
10035 |
10013 s := CharacterWriteStream with:aString. |
10036 s := CharacterWriteStream with:aString. |
10014 s cr; cr. |
10037 s cr; cr. |
10015 s nextPutLine:'Calling Chain:'. |
10038 s nextPutLine:'Calling Chain:'. |
10016 s nextPutLine:'--------------------------------------------------------------'. |
10039 s nextPutLine:'--------------------------------------------------------------'. |
10017 1 to:25 do:[:n | |
10040 1 to:25 do:[:n | |
10018 con notNil ifTrue:[ |
10041 con notNil ifTrue:[ |
10019 con printOn:s. |
10042 con printOn:s. |
10020 s cr. |
10043 s cr. |
10021 con := con sender |
10044 con := con sender |
10022 ] |
10045 ] |
10023 ]. |
10046 ]. |
10024 |
10047 |
10025 mayProceed ifTrue:[ |
10048 mayProceed ifTrue:[ |
10026 boxLabels := #('Proceed'). |
10049 boxLabels := #('Proceed'). |
10027 boxValues := #(#proceed). |
10050 boxValues := #(#proceed). |
10028 default := #proceed. |
10051 default := #proceed. |
10029 ] ifFalse:[ |
10052 ] ifFalse:[ |
10030 boxLabels := #(). |
10053 boxLabels := #(). |
10031 boxValues := #(). |
10054 boxValues := #(). |
10032 ]. |
10055 ]. |
10033 |
10056 |
10034 AbortOperationRequest isHandled ifTrue:[ |
10057 AbortOperationRequest isHandled ifTrue:[ |
10035 default := #abort. |
10058 default := #abort. |
10036 boxLabels := boxLabels , #('Abort'). |
10059 boxLabels := boxLabels , #('Abort'). |
10037 boxValues := boxValues , #(#abort). |
10060 boxValues := boxValues , #(#abort). |
10038 AbortAllOperationRequest isHandled ifTrue:[ |
10061 AbortAllOperationRequest isHandled ifTrue:[ |
10039 boxLabels := boxLabels , #('Abort All'). |
10062 boxLabels := boxLabels , #('Abort All'). |
10040 boxValues := boxValues , #(#abortAll). |
10063 boxValues := boxValues , #(#abortAll). |
10041 ]. |
10064 ]. |
10042 true "allowDebug" ifTrue:[ |
10065 true "allowDebug" ifTrue:[ |
10043 boxLabels := boxLabels , #('Copy Trace and Abort'). |
10066 boxLabels := boxLabels , #('Copy Trace and Abort'). |
10044 boxValues := boxValues , #(#copyAndAbort). |
10067 boxValues := boxValues , #(#copyAndAbort). |
10045 ]. |
10068 ]. |
10046 ] ifFalse:[ |
10069 ] ifFalse:[ |
10047 mayProceed "and:[allowDebug]" ifTrue:[ |
10070 mayProceed "and:[allowDebug]" ifTrue:[ |
10048 boxLabels := boxLabels , #('Copy Trace and Proceed'). |
10071 boxLabels := boxLabels , #('Copy Trace and Proceed'). |
10049 boxValues := boxValues , #(#copyAndProceed). |
10072 boxValues := boxValues , #(#copyAndProceed). |
10050 ]. |
10073 ]. |
10051 ]. |
10074 ]. |
10052 |
10075 |
10053 (allowDebug and:[Debugger notNil]) ifTrue:[ |
10076 (allowDebug and:[Debugger notNil]) ifTrue:[ |
10054 boxLabels := boxLabels , #('Debug'). |
10077 boxLabels := boxLabels , #('Debug'). |
10055 boxValues := boxValues , #(#debug). |
10078 boxValues := boxValues , #(#debug). |
10056 default := #debug. |
10079 default := #debug. |
10057 ]. |
10080 ]. |
10058 |
10081 |
10059 action := Dialog |
10082 action := Dialog |
10060 choose:s contents |
10083 choose:s contents |
10061 label:('Exception [' , Processor activeProcess nameOrId , ']') |
10084 label:('Exception [' , Processor activeProcess nameOrId , ']') |
10062 image:WarningBox errorIconBitmap |
10085 image:WarningBox errorIconBitmap |
10063 labels:boxLabels |
10086 labels:boxLabels |
10064 values:boxValues |
10087 values:boxValues |
10065 default:default |
10088 default:default |
10066 onCancel:nil. |
10089 onCancel:nil. |
10067 ]. |
10090 ]. |
10068 ]. |
10091 ]. |
10069 |
10092 |
10070 action == #debug ifTrue:[ |
10093 action == #debug ifTrue:[ |
10071 ^ Debugger enter:sender withMessage:aString mayProceed:mayProceed |
10094 ^ Debugger enter:sender withMessage:aString mayProceed:mayProceed |
10072 ]. |
10095 ]. |
10073 action == #proceed ifTrue:[ |
10096 action == #proceed ifTrue:[ |
10074 ^ nil. |
10097 ^ nil. |
10075 ]. |
10098 ]. |
10076 (action == #copyAndProceed |
10099 (action == #copyAndProceed |
10077 or:[action == #copyAndAbort]) ifTrue:[ |
10100 or:[action == #copyAndAbort]) ifTrue:[ |
10078 s := '' writeStream. |
10101 s := '' writeStream. |
10079 Exception handle:[:ex | |
10102 Exception handle:[:ex | |
10080 'Caught recursive error while printing backtrace' errorPrintCR. |
10103 'Caught recursive error while printing backtrace' errorPrintCR. |
10081 ] do:[ |
10104 ] do:[ |
10082 sender fullPrintAllOn:s. |
10105 sender fullPrintAllOn:s. |
10083 ]. |
10106 ]. |
10084 currentScreen rootView setClipboardText:s contents. |
10107 currentScreen rootView setClipboardText:s contents. |
10085 action == #copyAndProceed ifTrue:[ |
10108 action == #copyAndProceed ifTrue:[ |
10086 ^ nil |
10109 ^ nil |
10087 ]. |
10110 ]. |
10088 ]. |
10111 ]. |
10089 (action == #abortAll) ifTrue:[ |
10112 (action == #abortAll) ifTrue:[ |
10090 AbortAllOperationRequest raise |
10113 AbortAllOperationRequest raise |
10091 ]. |
10114 ]. |
10092 |
10115 |
10093 AbortOperationRequest raise. |
10116 AbortOperationRequest raise. |
10094 "not reached" |
10117 "not reached" |
10095 |
10118 |
10096 " |
10119 " |