ByteCodeCompiler.st
author Claus Gittinger <cg@exept.de>
Tue, 24 Oct 1995 16:55:13 +0100
changeset 126 aca2139a3526
parent 125 5c5f62d4d89d
child 128 61eb0b356b89
permissions -rw-r--r--
.
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
0
7ad01559b262 Initial revision
claus
parents:
diff changeset
     1
"
4
f6fd83437415 *** empty log message ***
claus
parents: 3
diff changeset
     2
 COPYRIGHT (c) 1989 by Claus Gittinger
45
e8331ba8ad5d *** empty log message ***
claus
parents: 39
diff changeset
     3
	      All Rights Reserved
0
7ad01559b262 Initial revision
claus
parents:
diff changeset
     4
7ad01559b262 Initial revision
claus
parents:
diff changeset
     5
 This software is furnished under a license and may be used
7ad01559b262 Initial revision
claus
parents:
diff changeset
     6
 only in accordance with the terms of that license and with the
7ad01559b262 Initial revision
claus
parents:
diff changeset
     7
 inclusion of the above copyright notice.   This software may not
7ad01559b262 Initial revision
claus
parents:
diff changeset
     8
 be provided or otherwise made available to, or used by, any
7ad01559b262 Initial revision
claus
parents:
diff changeset
     9
 other person.  No title to or ownership of the software is
7ad01559b262 Initial revision
claus
parents:
diff changeset
    10
 hereby transferred.
7ad01559b262 Initial revision
claus
parents:
diff changeset
    11
"
7ad01559b262 Initial revision
claus
parents:
diff changeset
    12
7ad01559b262 Initial revision
claus
parents:
diff changeset
    13
Parser subclass:#ByteCodeCompiler
49
02660b790c3e *** empty log message ***
claus
parents: 46
diff changeset
    14
       instanceVariableNames:'codeBytes codeIndex
45
e8331ba8ad5d *** empty log message ***
claus
parents: 39
diff changeset
    15
			      litArray
e8331ba8ad5d *** empty log message ***
claus
parents: 39
diff changeset
    16
			      stackDelta extra lineno
e8331ba8ad5d *** empty log message ***
claus
parents: 39
diff changeset
    17
			      maxStackDepth
e8331ba8ad5d *** empty log message ***
claus
parents: 39
diff changeset
    18
			      relocList'
124
claus
parents: 120
diff changeset
    19
       classVariableNames:'JumpToAbsJump SequenceNumber 
claus
parents: 120
diff changeset
    20
			   STCCompilationDefines STCCompilationIncludes STCCompilationOptions
120
claus
parents: 118
diff changeset
    21
			   STCCompilation KeepSource STCKeepCIntermediate'
0
7ad01559b262 Initial revision
claus
parents:
diff changeset
    22
       poolDictionaries:''
7ad01559b262 Initial revision
claus
parents:
diff changeset
    23
       category:'System-Compiler'
7ad01559b262 Initial revision
claus
parents:
diff changeset
    24
!
7ad01559b262 Initial revision
claus
parents:
diff changeset
    25
7ad01559b262 Initial revision
claus
parents:
diff changeset
    26
ByteCodeCompiler comment:'
4
f6fd83437415 *** empty log message ***
claus
parents: 3
diff changeset
    27
COPYRIGHT (c) 1989 by Claus Gittinger
45
e8331ba8ad5d *** empty log message ***
claus
parents: 39
diff changeset
    28
	     All Rights Reserved
25
865d6cfaf90d changed bytecodes
claus
parents: 20
diff changeset
    29
126
Claus Gittinger <cg@exept.de>
parents: 125
diff changeset
    30
$Header: /cvs/stx/stx/libcomp/ByteCodeCompiler.st,v 1.43 1995-10-24 15:54:48 cg Exp $
3
b63b8a6b71fb *** empty log message ***
claus
parents: 1
diff changeset
    31
'!
b63b8a6b71fb *** empty log message ***
claus
parents: 1
diff changeset
    32
b63b8a6b71fb *** empty log message ***
claus
parents: 1
diff changeset
    33
!ByteCodeCompiler class methodsFor:'documentation'!
b63b8a6b71fb *** empty log message ***
claus
parents: 1
diff changeset
    34
20
f8dd8ba75205 *** empty log message ***
claus
parents: 19
diff changeset
    35
copyright
f8dd8ba75205 *** empty log message ***
claus
parents: 19
diff changeset
    36
"
f8dd8ba75205 *** empty log message ***
claus
parents: 19
diff changeset
    37
 COPYRIGHT (c) 1989 by Claus Gittinger
45
e8331ba8ad5d *** empty log message ***
claus
parents: 39
diff changeset
    38
	      All Rights Reserved
20
f8dd8ba75205 *** empty log message ***
claus
parents: 19
diff changeset
    39
f8dd8ba75205 *** empty log message ***
claus
parents: 19
diff changeset
    40
 This software is furnished under a license and may be used
f8dd8ba75205 *** empty log message ***
claus
parents: 19
diff changeset
    41
 only in accordance with the terms of that license and with the
f8dd8ba75205 *** empty log message ***
claus
parents: 19
diff changeset
    42
 inclusion of the above copyright notice.   This software may not
f8dd8ba75205 *** empty log message ***
claus
parents: 19
diff changeset
    43
 be provided or otherwise made available to, or used by, any
f8dd8ba75205 *** empty log message ***
claus
parents: 19
diff changeset
    44
 other person.  No title to or ownership of the software is
f8dd8ba75205 *** empty log message ***
claus
parents: 19
diff changeset
    45
 hereby transferred.
f8dd8ba75205 *** empty log message ***
claus
parents: 19
diff changeset
    46
"
f8dd8ba75205 *** empty log message ***
claus
parents: 19
diff changeset
    47
!
f8dd8ba75205 *** empty log message ***
claus
parents: 19
diff changeset
    48
f8dd8ba75205 *** empty log message ***
claus
parents: 19
diff changeset
    49
version
f8dd8ba75205 *** empty log message ***
claus
parents: 19
diff changeset
    50
"
126
Claus Gittinger <cg@exept.de>
parents: 125
diff changeset
    51
$Header: /cvs/stx/stx/libcomp/ByteCodeCompiler.st,v 1.43 1995-10-24 15:54:48 cg Exp $
20
f8dd8ba75205 *** empty log message ***
claus
parents: 19
diff changeset
    52
"
f8dd8ba75205 *** empty log message ***
claus
parents: 19
diff changeset
    53
!
f8dd8ba75205 *** empty log message ***
claus
parents: 19
diff changeset
    54
3
b63b8a6b71fb *** empty log message ***
claus
parents: 1
diff changeset
    55
documentation
b63b8a6b71fb *** empty log message ***
claus
parents: 1
diff changeset
    56
"
19
84a1ddf215a5 *** empty log message ***
claus
parents: 15
diff changeset
    57
    This class performs compilation into ByteCodes.
84a1ddf215a5 *** empty log message ***
claus
parents: 15
diff changeset
    58
    First, parsing is done using superclass methods,
84a1ddf215a5 *** empty log message ***
claus
parents: 15
diff changeset
    59
    then the parse-tree is converted into an array of symbolic codes
84a1ddf215a5 *** empty log message ***
claus
parents: 15
diff changeset
    60
    and a relocation table; 
84a1ddf215a5 *** empty log message ***
claus
parents: 15
diff changeset
    61
    these two are finally combined into a byteArray of the codes.
0
7ad01559b262 Initial revision
claus
parents:
diff changeset
    62
19
84a1ddf215a5 *** empty log message ***
claus
parents: 15
diff changeset
    63
    (the intermediate step through symbolic codes is for debugging
84a1ddf215a5 *** empty log message ***
claus
parents: 15
diff changeset
    64
     only - it will vanish)
84a1ddf215a5 *** empty log message ***
claus
parents: 15
diff changeset
    65
84a1ddf215a5 *** empty log message ***
claus
parents: 15
diff changeset
    66
    There are many dependencies to the run-time-system (especially the
84a1ddf215a5 *** empty log message ***
claus
parents: 15
diff changeset
    67
    interpreter) in here - be careful when playing around ...
0
7ad01559b262 Initial revision
claus
parents:
diff changeset
    68
19
84a1ddf215a5 *** empty log message ***
claus
parents: 15
diff changeset
    69
    Instance variables:
0
7ad01559b262 Initial revision
claus
parents:
diff changeset
    70
49
02660b790c3e *** empty log message ***
claus
parents: 46
diff changeset
    71
	codeBytes       <ByteArry>              bytecodes
45
e8331ba8ad5d *** empty log message ***
claus
parents: 39
diff changeset
    72
	codeIndex       <SmallInteger>          next index to put into code array
e8331ba8ad5d *** empty log message ***
claus
parents: 39
diff changeset
    73
	litArray        <OrderedCollection>     literals
e8331ba8ad5d *** empty log message ***
claus
parents: 39
diff changeset
    74
	stackDelta      <SmallInteger>          return value of byteCodeFor:
e8331ba8ad5d *** empty log message ***
claus
parents: 39
diff changeset
    75
	extra           <Symbol>                return value of byteCodeFor:
e8331ba8ad5d *** empty log message ***
claus
parents: 39
diff changeset
    76
	lineno          <Boolean>               return value of byteCodeFor:
e8331ba8ad5d *** empty log message ***
claus
parents: 39
diff changeset
    77
	maxStackDepth   <SmallInteger>          stack need of method
e8331ba8ad5d *** empty log message ***
claus
parents: 39
diff changeset
    78
	relocList       <Array>                 used temporary for relocation
19
84a1ddf215a5 *** empty log message ***
claus
parents: 15
diff changeset
    79
84a1ddf215a5 *** empty log message ***
claus
parents: 15
diff changeset
    80
    Class variables:
84a1ddf215a5 *** empty log message ***
claus
parents: 15
diff changeset
    81
45
e8331ba8ad5d *** empty log message ***
claus
parents: 39
diff changeset
    82
	JumpToAbsJump   <Dictionary>            internal table to map opcodes
3
b63b8a6b71fb *** empty log message ***
claus
parents: 1
diff changeset
    83
"
b63b8a6b71fb *** empty log message ***
claus
parents: 1
diff changeset
    84
! !
0
7ad01559b262 Initial revision
claus
parents:
diff changeset
    85
98
claus
parents: 97
diff changeset
    86
!ByteCodeCompiler methodsFor:'ST-80 compatibility'!
0
7ad01559b262 Initial revision
claus
parents:
diff changeset
    87
98
claus
parents: 97
diff changeset
    88
compile:textOrStream in:aClass notifying:requestor ifFail:exceptionBlock
85
claus
parents: 84
diff changeset
    89
    "name alias for ST-80 compatibility"
claus
parents: 84
diff changeset
    90
98
claus
parents: 97
diff changeset
    91
    ^ self class
claus
parents: 97
diff changeset
    92
		compile:textOrStream
claus
parents: 97
diff changeset
    93
		in:aClass 
claus
parents: 97
diff changeset
    94
		notifying:requestor 
claus
parents: 97
diff changeset
    95
		ifFail:exceptionBlock
claus
parents: 97
diff changeset
    96
"/    |m|
claus
parents: 97
diff changeset
    97
"/
claus
parents: 97
diff changeset
    98
"/    m := self class 
claus
parents: 97
diff changeset
    99
"/                compile:textOrStream 
claus
parents: 97
diff changeset
   100
"/                forClass:aClass 
claus
parents: 97
diff changeset
   101
"/                inCategory:'no category'
claus
parents: 97
diff changeset
   102
"/                notifying:requestor
claus
parents: 97
diff changeset
   103
"/                install:true 
claus
parents: 97
diff changeset
   104
"/                skipIfSame:false
claus
parents: 97
diff changeset
   105
"/                silent:false.
claus
parents: 97
diff changeset
   106
"/    m == #Error ifTrue:[
claus
parents: 97
diff changeset
   107
"/        ^ exceptionBlock value
claus
parents: 97
diff changeset
   108
"/    ].
claus
parents: 97
diff changeset
   109
"/     ^ m
claus
parents: 97
diff changeset
   110
! !
claus
parents: 97
diff changeset
   111
claus
parents: 97
diff changeset
   112
!ByteCodeCompiler class methodsFor:'compiling methods'!
claus
parents: 97
diff changeset
   113
claus
parents: 97
diff changeset
   114
compile:textOrStream in:aClass notifying:requestor ifFail:exceptionBlock
claus
parents: 97
diff changeset
   115
    "name alias for ST-80 compatibility"
claus
parents: 97
diff changeset
   116
claus
parents: 97
diff changeset
   117
    |m|
claus
parents: 97
diff changeset
   118
claus
parents: 97
diff changeset
   119
    m := self 
claus
parents: 97
diff changeset
   120
	   compile:textOrStream
85
claus
parents: 84
diff changeset
   121
	  forClass:aClass 
claus
parents: 84
diff changeset
   122
	inCategory:'others'
98
claus
parents: 97
diff changeset
   123
	 notifying:requestor 
85
claus
parents: 84
diff changeset
   124
	   install:true
claus
parents: 84
diff changeset
   125
	skipIfSame:false
98
claus
parents: 97
diff changeset
   126
	    silent:false.
claus
parents: 97
diff changeset
   127
    m == #Error ifTrue:[
claus
parents: 97
diff changeset
   128
	^ exceptionBlock value
claus
parents: 97
diff changeset
   129
    ].
claus
parents: 97
diff changeset
   130
     ^ m
claus
parents: 97
diff changeset
   131
85
claus
parents: 84
diff changeset
   132
!
claus
parents: 84
diff changeset
   133
0
7ad01559b262 Initial revision
claus
parents:
diff changeset
   134
compile:methodText forClass:classToCompileFor
7ad01559b262 Initial revision
claus
parents:
diff changeset
   135
    "compile a source-string for a method in classToCompileFor"
7ad01559b262 Initial revision
claus
parents:
diff changeset
   136
7ad01559b262 Initial revision
claus
parents:
diff changeset
   137
    ^ self compile:methodText
45
e8331ba8ad5d *** empty log message ***
claus
parents: 39
diff changeset
   138
	  forClass:classToCompileFor
e8331ba8ad5d *** empty log message ***
claus
parents: 39
diff changeset
   139
	inCategory:'others'
e8331ba8ad5d *** empty log message ***
claus
parents: 39
diff changeset
   140
	 notifying:nil
e8331ba8ad5d *** empty log message ***
claus
parents: 39
diff changeset
   141
	   install:true
e8331ba8ad5d *** empty log message ***
claus
parents: 39
diff changeset
   142
	skipIfSame:false
e8331ba8ad5d *** empty log message ***
claus
parents: 39
diff changeset
   143
	    silent:false
0
7ad01559b262 Initial revision
claus
parents:
diff changeset
   144
!
7ad01559b262 Initial revision
claus
parents:
diff changeset
   145
7ad01559b262 Initial revision
claus
parents:
diff changeset
   146
compile:aString forClass:aClass inCategory:cat
7ad01559b262 Initial revision
claus
parents:
diff changeset
   147
    "compile a source-string for a method in classToCompileFor.
7ad01559b262 Initial revision
claus
parents:
diff changeset
   148
     The method will get cat as category"
7ad01559b262 Initial revision
claus
parents:
diff changeset
   149
7ad01559b262 Initial revision
claus
parents:
diff changeset
   150
    ^ self compile:aString
45
e8331ba8ad5d *** empty log message ***
claus
parents: 39
diff changeset
   151
	  forClass:aClass
e8331ba8ad5d *** empty log message ***
claus
parents: 39
diff changeset
   152
	inCategory:cat
e8331ba8ad5d *** empty log message ***
claus
parents: 39
diff changeset
   153
	 notifying:nil
e8331ba8ad5d *** empty log message ***
claus
parents: 39
diff changeset
   154
	   install:true
e8331ba8ad5d *** empty log message ***
claus
parents: 39
diff changeset
   155
	skipIfSame:false
e8331ba8ad5d *** empty log message ***
claus
parents: 39
diff changeset
   156
	    silent:false
0
7ad01559b262 Initial revision
claus
parents:
diff changeset
   157
!
7ad01559b262 Initial revision
claus
parents:
diff changeset
   158
84
claus
parents: 78
diff changeset
   159
compile:methodText forClass:classToCompileFor notifying:requestor
0
7ad01559b262 Initial revision
claus
parents:
diff changeset
   160
    "compile a source-string for a method in classToCompileFor.
84
claus
parents: 78
diff changeset
   161
     Errors are forwarded to requestor."
0
7ad01559b262 Initial revision
claus
parents:
diff changeset
   162
7ad01559b262 Initial revision
claus
parents:
diff changeset
   163
    ^ self compile:methodText
45
e8331ba8ad5d *** empty log message ***
claus
parents: 39
diff changeset
   164
	  forClass:classToCompileFor
e8331ba8ad5d *** empty log message ***
claus
parents: 39
diff changeset
   165
	inCategory:'others'
84
claus
parents: 78
diff changeset
   166
	 notifying:requestor
45
e8331ba8ad5d *** empty log message ***
claus
parents: 39
diff changeset
   167
	   install:true
e8331ba8ad5d *** empty log message ***
claus
parents: 39
diff changeset
   168
	skipIfSame:false
e8331ba8ad5d *** empty log message ***
claus
parents: 39
diff changeset
   169
	    silent:false
0
7ad01559b262 Initial revision
claus
parents:
diff changeset
   170
!
7ad01559b262 Initial revision
claus
parents:
diff changeset
   171
84
claus
parents: 78
diff changeset
   172
compile:aString forClass:aClass inCategory:cat notifying:requestor
0
7ad01559b262 Initial revision
claus
parents:
diff changeset
   173
    "compile a source-string for a method in classToCompileFor.
84
claus
parents: 78
diff changeset
   174
     errors are forwarded to requestor.
0
7ad01559b262 Initial revision
claus
parents:
diff changeset
   175
     The method will get cat as category"
7ad01559b262 Initial revision
claus
parents:
diff changeset
   176
7ad01559b262 Initial revision
claus
parents:
diff changeset
   177
    ^ self compile:aString
45
e8331ba8ad5d *** empty log message ***
claus
parents: 39
diff changeset
   178
	  forClass:aClass
e8331ba8ad5d *** empty log message ***
claus
parents: 39
diff changeset
   179
	inCategory:cat
84
claus
parents: 78
diff changeset
   180
	 notifying:requestor
45
e8331ba8ad5d *** empty log message ***
claus
parents: 39
diff changeset
   181
	   install:true
e8331ba8ad5d *** empty log message ***
claus
parents: 39
diff changeset
   182
	skipIfSame:false
e8331ba8ad5d *** empty log message ***
claus
parents: 39
diff changeset
   183
	    silent:false
0
7ad01559b262 Initial revision
claus
parents:
diff changeset
   184
!
7ad01559b262 Initial revision
claus
parents:
diff changeset
   185
84
claus
parents: 78
diff changeset
   186
compile:aString forClass:aClass inCategory:cat notifying:requestor install:install
20
f8dd8ba75205 *** empty log message ***
claus
parents: 19
diff changeset
   187
    "compile a source-string for a method in classToCompileFor.
f8dd8ba75205 *** empty log message ***
claus
parents: 19
diff changeset
   188
     The install-argument controls if the method is to be installed into the
f8dd8ba75205 *** empty log message ***
claus
parents: 19
diff changeset
   189
     classes method-dictionary, or just to be compiled and a method object to be returned.
84
claus
parents: 78
diff changeset
   190
     Errors are forwarded to requestor. The method will get cat as category"
20
f8dd8ba75205 *** empty log message ***
claus
parents: 19
diff changeset
   191
0
7ad01559b262 Initial revision
claus
parents:
diff changeset
   192
    ^ self compile:aString
45
e8331ba8ad5d *** empty log message ***
claus
parents: 39
diff changeset
   193
	  forClass:aClass
e8331ba8ad5d *** empty log message ***
claus
parents: 39
diff changeset
   194
	inCategory:cat
84
claus
parents: 78
diff changeset
   195
	 notifying:requestor
54
86c5b39c2eca *** empty log message ***
claus
parents: 49
diff changeset
   196
	   install:install
45
e8331ba8ad5d *** empty log message ***
claus
parents: 39
diff changeset
   197
	skipIfSame:false
e8331ba8ad5d *** empty log message ***
claus
parents: 39
diff changeset
   198
	    silent:false
0
7ad01559b262 Initial revision
claus
parents:
diff changeset
   199
!
7ad01559b262 Initial revision
claus
parents:
diff changeset
   200
84
claus
parents: 78
diff changeset
   201
compile:aString forClass:aClass inCategory:cat notifying:requestor
45
e8331ba8ad5d *** empty log message ***
claus
parents: 39
diff changeset
   202
		 install:install skipIfSame:skipIfSame
20
f8dd8ba75205 *** empty log message ***
claus
parents: 19
diff changeset
   203
    "compile a source-string for a method in classToCompileFor.
f8dd8ba75205 *** empty log message ***
claus
parents: 19
diff changeset
   204
     The install-argument controls if the method is to be installed into the
f8dd8ba75205 *** empty log message ***
claus
parents: 19
diff changeset
   205
     classes method-dictionary, or just to be compiled and a method object to be returned.
84
claus
parents: 78
diff changeset
   206
     Errors are forwarded to requestor. The method will get cat as category.
20
f8dd8ba75205 *** empty log message ***
claus
parents: 19
diff changeset
   207
     If skipIsSame is true, and the source is the same as an existing
f8dd8ba75205 *** empty log message ***
claus
parents: 19
diff changeset
   208
     methods source, this is a noop (for fast fileIn)."
0
7ad01559b262 Initial revision
claus
parents:
diff changeset
   209
20
f8dd8ba75205 *** empty log message ***
claus
parents: 19
diff changeset
   210
    ^ self compile:aString
45
e8331ba8ad5d *** empty log message ***
claus
parents: 39
diff changeset
   211
	  forClass:aClass
e8331ba8ad5d *** empty log message ***
claus
parents: 39
diff changeset
   212
	inCategory:cat
84
claus
parents: 78
diff changeset
   213
	 notifying:requestor
54
86c5b39c2eca *** empty log message ***
claus
parents: 49
diff changeset
   214
	   install:install
45
e8331ba8ad5d *** empty log message ***
claus
parents: 39
diff changeset
   215
	skipIfSame:skipIfSame
e8331ba8ad5d *** empty log message ***
claus
parents: 39
diff changeset
   216
	    silent:false
20
f8dd8ba75205 *** empty log message ***
claus
parents: 19
diff changeset
   217
!
f8dd8ba75205 *** empty log message ***
claus
parents: 19
diff changeset
   218
84
claus
parents: 78
diff changeset
   219
compile:aString forClass:aClass inCategory:cat notifying:requestor
45
e8331ba8ad5d *** empty log message ***
claus
parents: 39
diff changeset
   220
		 install:install skipIfSame:skipIfSame silent:silent
20
f8dd8ba75205 *** empty log message ***
claus
parents: 19
diff changeset
   221
f8dd8ba75205 *** empty log message ***
claus
parents: 19
diff changeset
   222
    "the basic workhorse method for compiling:
0
7ad01559b262 Initial revision
claus
parents:
diff changeset
   223
     compile a source-string for a method in classToCompileFor.
84
claus
parents: 78
diff changeset
   224
     errors are forwarded to requestor (report on Transcript and return
claus
parents: 78
diff changeset
   225
     #Error, if requestor is nil).
0
7ad01559b262 Initial revision
claus
parents:
diff changeset
   226
20
f8dd8ba75205 *** empty log message ***
claus
parents: 19
diff changeset
   227
     The new method will get cat as category. 
f8dd8ba75205 *** empty log message ***
claus
parents: 19
diff changeset
   228
     If install is true, the method will go into the classes method-table, 
f8dd8ba75205 *** empty log message ***
claus
parents: 19
diff changeset
   229
     otherwise the method is simply returned (for anonymous methods).
0
7ad01559b262 Initial revision
claus
parents:
diff changeset
   230
     If skipIsSame is true, and the source is the same as an existing
20
f8dd8ba75205 *** empty log message ***
claus
parents: 19
diff changeset
   231
     methods source, this is a noop (for fast fileIn).
f8dd8ba75205 *** empty log message ***
claus
parents: 19
diff changeset
   232
     The argument, silent controls if errors are to be reported."
0
7ad01559b262 Initial revision
claus
parents:
diff changeset
   233
54
86c5b39c2eca *** empty log message ***
claus
parents: 49
diff changeset
   234
    |compiler newMethod tree lits symbolicCodeArray oldMethod lazy silencio 
90
claus
parents: 85
diff changeset
   235
     sourceFile sourceStream newSource primNr pos sel|
0
7ad01559b262 Initial revision
claus
parents:
diff changeset
   236
7ad01559b262 Initial revision
claus
parents:
diff changeset
   237
    aString isNil ifTrue:[^ nil].
54
86c5b39c2eca *** empty log message ***
claus
parents: 49
diff changeset
   238
    silencio := silent or:[Smalltalk silentLoading == true].
0
7ad01559b262 Initial revision
claus
parents:
diff changeset
   239
19
84a1ddf215a5 *** empty log message ***
claus
parents: 15
diff changeset
   240
    "lazy compilation is EXPERIMENTAL"
84a1ddf215a5 *** empty log message ***
claus
parents: 15
diff changeset
   241
    lazy := (LazyCompilation == true) and:[install].
84a1ddf215a5 *** empty log message ***
claus
parents: 15
diff changeset
   242
0
7ad01559b262 Initial revision
claus
parents:
diff changeset
   243
    "create a compiler, let it parse and create the parsetree"
7ad01559b262 Initial revision
claus
parents:
diff changeset
   244
54
86c5b39c2eca *** empty log message ***
claus
parents: 49
diff changeset
   245
    compiler := self for:(ReadStream on:aString) in:aClass.
84
claus
parents: 78
diff changeset
   246
    compiler parseForCode.
claus
parents: 78
diff changeset
   247
    compiler notifying:requestor.
54
86c5b39c2eca *** empty log message ***
claus
parents: 49
diff changeset
   248
    silent ifTrue:[
86c5b39c2eca *** empty log message ***
claus
parents: 49
diff changeset
   249
"/        compiler ignoreErrors.
86c5b39c2eca *** empty log message ***
claus
parents: 49
diff changeset
   250
	compiler ignoreWarnings
86c5b39c2eca *** empty log message ***
claus
parents: 49
diff changeset
   251
    ].
0
7ad01559b262 Initial revision
claus
parents:
diff changeset
   252
    compiler nextToken.
7ad01559b262 Initial revision
claus
parents:
diff changeset
   253
    (compiler parseMethodSpec == #Error) ifTrue:[
45
e8331ba8ad5d *** empty log message ***
claus
parents: 39
diff changeset
   254
	tree := #Error
0
7ad01559b262 Initial revision
claus
parents:
diff changeset
   255
    ] ifFalse:[
45
e8331ba8ad5d *** empty log message ***
claus
parents: 39
diff changeset
   256
	"check if same source"
90
claus
parents: 85
diff changeset
   257
	(skipIfSame and:[(sel := compiler selector) notNil]) ifTrue:[
claus
parents: 85
diff changeset
   258
	    oldMethod := aClass compiledMethodAt:sel.
45
e8331ba8ad5d *** empty log message ***
claus
parents: 39
diff changeset
   259
	    oldMethod notNil ifTrue:[
e8331ba8ad5d *** empty log message ***
claus
parents: 39
diff changeset
   260
		oldMethod source = aString ifTrue:[
e8331ba8ad5d *** empty log message ***
claus
parents: 39
diff changeset
   261
		    oldMethod isInvalid ifFalse:[
54
86c5b39c2eca *** empty log message ***
claus
parents: 49
diff changeset
   262
			silencio ifFalse:[
84
claus
parents: 78
diff changeset
   263
			    Transcript showCr:('    unchanged: ',aClass name,' ',compiler selector)
45
e8331ba8ad5d *** empty log message ***
claus
parents: 39
diff changeset
   264
			].
49
02660b790c3e *** empty log message ***
claus
parents: 46
diff changeset
   265
			"
02660b790c3e *** empty log message ***
claus
parents: 46
diff changeset
   266
			 same. however, category may be different
02660b790c3e *** empty log message ***
claus
parents: 46
diff changeset
   267
			"
02660b790c3e *** empty log message ***
claus
parents: 46
diff changeset
   268
			(cat notNil and:[cat ~~ oldMethod category]) ifTrue:[
02660b790c3e *** empty log message ***
claus
parents: 46
diff changeset
   269
			    oldMethod category:cat.
02660b790c3e *** empty log message ***
claus
parents: 46
diff changeset
   270
			    oldMethod changed:#category.    
02660b790c3e *** empty log message ***
claus
parents: 46
diff changeset
   271
			    aClass addChangeRecordForMethodCategory:oldMethod category:cat.
02660b790c3e *** empty log message ***
claus
parents: 46
diff changeset
   272
			].
45
e8331ba8ad5d *** empty log message ***
claus
parents: 39
diff changeset
   273
			^ oldMethod
e8331ba8ad5d *** empty log message ***
claus
parents: 39
diff changeset
   274
		    ]
e8331ba8ad5d *** empty log message ***
claus
parents: 39
diff changeset
   275
		]
e8331ba8ad5d *** empty log message ***
claus
parents: 39
diff changeset
   276
	    ]
e8331ba8ad5d *** empty log message ***
claus
parents: 39
diff changeset
   277
	].
e8331ba8ad5d *** empty log message ***
claus
parents: 39
diff changeset
   278
	lazy ifFalse:[
e8331ba8ad5d *** empty log message ***
claus
parents: 39
diff changeset
   279
	    tree := compiler parseMethodBody.
e8331ba8ad5d *** empty log message ***
claus
parents: 39
diff changeset
   280
	    compiler tree:tree.
e8331ba8ad5d *** empty log message ***
claus
parents: 39
diff changeset
   281
	]
0
7ad01559b262 Initial revision
claus
parents:
diff changeset
   282
    ].
7ad01559b262 Initial revision
claus
parents:
diff changeset
   283
90
claus
parents: 85
diff changeset
   284
    sel := compiler selector.
0
7ad01559b262 Initial revision
claus
parents:
diff changeset
   285
    (compiler errorFlag or:[tree == #Error]) ifTrue:[
45
e8331ba8ad5d *** empty log message ***
claus
parents: 39
diff changeset
   286
"/        compiler parseError:'syntax error'.
84
claus
parents: 78
diff changeset
   287
	Transcript show:'    '.
101
claus
parents: 98
diff changeset
   288
	aClass notNil ifTrue:[
claus
parents: 98
diff changeset
   289
	    Transcript show:aClass name , '>>'
claus
parents: 98
diff changeset
   290
	].
90
claus
parents: 85
diff changeset
   291
	sel notNil ifTrue:[
101
claus
parents: 98
diff changeset
   292
	    Transcript show:(sel)
45
e8331ba8ad5d *** empty log message ***
claus
parents: 39
diff changeset
   293
	].
101
claus
parents: 98
diff changeset
   294
	Transcript showCr:' -> Error'.
45
e8331ba8ad5d *** empty log message ***
claus
parents: 39
diff changeset
   295
	^ #Error
0
7ad01559b262 Initial revision
claus
parents:
diff changeset
   296
    ].
7ad01559b262 Initial revision
claus
parents:
diff changeset
   297
19
84a1ddf215a5 *** empty log message ***
claus
parents: 15
diff changeset
   298
    "if no error and also no selector ..."
90
claus
parents: 85
diff changeset
   299
     sel isNil ifTrue:[
45
e8331ba8ad5d *** empty log message ***
claus
parents: 39
diff changeset
   300
	"... it was just a comment or other empty stuff"
e8331ba8ad5d *** empty log message ***
claus
parents: 39
diff changeset
   301
	^ nil
0
7ad01559b262 Initial revision
claus
parents:
diff changeset
   302
    ].
7ad01559b262 Initial revision
claus
parents:
diff changeset
   303
54
86c5b39c2eca *** empty log message ***
claus
parents: 49
diff changeset
   304
    "
86c5b39c2eca *** empty log message ***
claus
parents: 49
diff changeset
   305
     freak-out support ...
86c5b39c2eca *** empty log message ***
claus
parents: 49
diff changeset
   306
    "
126
Claus Gittinger <cg@exept.de>
parents: 125
diff changeset
   307
    (compiler hasNonOptionalPrimitiveCode 
Claus Gittinger <cg@exept.de>
parents: 125
diff changeset
   308
    or:[(compiler hasPrimitiveCode and:[self canCreateMachineCode])
Claus Gittinger <cg@exept.de>
parents: 125
diff changeset
   309
    or:[STCCompilation == #always and:[sel  ~~ #doIt]]]) ifTrue:[
97
claus
parents: 96
diff changeset
   310
	newMethod := compiler 
claus
parents: 96
diff changeset
   311
			compileToMachineCode:aString 
claus
parents: 96
diff changeset
   312
			forClass:aClass 
claus
parents: 96
diff changeset
   313
			inCategory:cat 
claus
parents: 96
diff changeset
   314
			notifying:requestor
claus
parents: 96
diff changeset
   315
			install:install 
claus
parents: 96
diff changeset
   316
			skipIfSame:skipIfSame 
claus
parents: 96
diff changeset
   317
			silent:silent.
claus
parents: 96
diff changeset
   318
claus
parents: 96
diff changeset
   319
	newMethod ==#Error ifTrue:[
claus
parents: 96
diff changeset
   320
	    newMethod := compiler trappingStubMethodFor:aString inCategory:cat.
claus
parents: 96
diff changeset
   321
	    install ifTrue:[
claus
parents: 96
diff changeset
   322
		aClass addSelector:sel withMethod:newMethod
claus
parents: 96
diff changeset
   323
	    ].
118
claus
parents: 117
diff changeset
   324
	    Transcript show:'*** '.
97
claus
parents: 96
diff changeset
   325
	    sel notNil ifTrue:[
claus
parents: 96
diff changeset
   326
		Transcript show:(sel ,' ')
claus
parents: 96
diff changeset
   327
	    ].
claus
parents: 96
diff changeset
   328
	    Transcript showCr:'not compiled to machine code - created a stub instead.'.
claus
parents: 96
diff changeset
   329
	].
claus
parents: 96
diff changeset
   330
	^ newMethod
19
84a1ddf215a5 *** empty log message ***
claus
parents: 15
diff changeset
   331
    ].
84a1ddf215a5 *** empty log message ***
claus
parents: 15
diff changeset
   332
54
86c5b39c2eca *** empty log message ***
claus
parents: 49
diff changeset
   333
    "
86c5b39c2eca *** empty log message ***
claus
parents: 49
diff changeset
   334
     EXPERIMENTAL: quick loading
86c5b39c2eca *** empty log message ***
claus
parents: 49
diff changeset
   335
     only create a lazyMethod, which has no byteCode and will 
86c5b39c2eca *** empty log message ***
claus
parents: 49
diff changeset
   336
     compile itself when first called.
86c5b39c2eca *** empty log message ***
claus
parents: 49
diff changeset
   337
    "
19
84a1ddf215a5 *** empty log message ***
claus
parents: 15
diff changeset
   338
    lazy ifTrue:[
45
e8331ba8ad5d *** empty log message ***
claus
parents: 39
diff changeset
   339
	newMethod := LazyMethod new.
54
86c5b39c2eca *** empty log message ***
claus
parents: 49
diff changeset
   340
	KeepSource == false ifTrue:[
86c5b39c2eca *** empty log message ***
claus
parents: 49
diff changeset
   341
	    sourceFile := ObjectMemory nameForSources.
86c5b39c2eca *** empty log message ***
claus
parents: 49
diff changeset
   342
	    sourceStream := sourceFile asFilename appendingWriteStream.
86c5b39c2eca *** empty log message ***
claus
parents: 49
diff changeset
   343
	].
86c5b39c2eca *** empty log message ***
claus
parents: 49
diff changeset
   344
	sourceStream isNil ifTrue:[
86c5b39c2eca *** empty log message ***
claus
parents: 49
diff changeset
   345
	    newMethod source:aString.
86c5b39c2eca *** empty log message ***
claus
parents: 49
diff changeset
   346
	] ifFalse:[
86c5b39c2eca *** empty log message ***
claus
parents: 49
diff changeset
   347
	    sourceStream setToEnd.
86c5b39c2eca *** empty log message ***
claus
parents: 49
diff changeset
   348
	    pos := sourceStream position.
86c5b39c2eca *** empty log message ***
claus
parents: 49
diff changeset
   349
	    sourceStream nextChunkPut:aString.
86c5b39c2eca *** empty log message ***
claus
parents: 49
diff changeset
   350
	    sourceStream close.
86c5b39c2eca *** empty log message ***
claus
parents: 49
diff changeset
   351
	    newMethod sourceFilename:sourceFile position:pos.
86c5b39c2eca *** empty log message ***
claus
parents: 49
diff changeset
   352
	].
45
e8331ba8ad5d *** empty log message ***
claus
parents: 39
diff changeset
   353
	newMethod category:cat.
54
86c5b39c2eca *** empty log message ***
claus
parents: 49
diff changeset
   354
	Project notNil ifTrue:[
98
claus
parents: 97
diff changeset
   355
	    newMethod package:(Project currentPackageName)
54
86c5b39c2eca *** empty log message ***
claus
parents: 49
diff changeset
   356
	].
19
84a1ddf215a5 *** empty log message ***
claus
parents: 15
diff changeset
   357
90
claus
parents: 85
diff changeset
   358
	aClass addSelector:sel withLazyMethod:newMethod.
45
e8331ba8ad5d *** empty log message ***
claus
parents: 39
diff changeset
   359
	^ newMethod
19
84a1ddf215a5 *** empty log message ***
claus
parents: 15
diff changeset
   360
    ].
84a1ddf215a5 *** empty log message ***
claus
parents: 15
diff changeset
   361
90
claus
parents: 85
diff changeset
   362
    (primNr := compiler primitiveNumber) isNil ifTrue:[
78
e320344c19b7 *** empty log message ***
claus
parents: 76
diff changeset
   363
	"
e320344c19b7 *** empty log message ***
claus
parents: 76
diff changeset
   364
	 produce symbolic code first
e320344c19b7 *** empty log message ***
claus
parents: 76
diff changeset
   365
	"
e320344c19b7 *** empty log message ***
claus
parents: 76
diff changeset
   366
	symbolicCodeArray := compiler genSymbolicCode.
90
claus
parents: 85
diff changeset
   367
78
e320344c19b7 *** empty log message ***
claus
parents: 76
diff changeset
   368
	(symbolicCodeArray == #Error) ifTrue:[
84
claus
parents: 78
diff changeset
   369
	    Transcript show:'    '.
90
claus
parents: 85
diff changeset
   370
	    sel notNil ifTrue:[
claus
parents: 85
diff changeset
   371
		Transcript show:(sel ,' ')
78
e320344c19b7 *** empty log message ***
claus
parents: 76
diff changeset
   372
	    ].
e320344c19b7 *** empty log message ***
claus
parents: 76
diff changeset
   373
	    Transcript showCr:'translation error'.
e320344c19b7 *** empty log message ***
claus
parents: 76
diff changeset
   374
	    ^ #Error
45
e8331ba8ad5d *** empty log message ***
claus
parents: 39
diff changeset
   375
	].
0
7ad01559b262 Initial revision
claus
parents:
diff changeset
   376
78
e320344c19b7 *** empty log message ***
claus
parents: 76
diff changeset
   377
	"
e320344c19b7 *** empty log message ***
claus
parents: 76
diff changeset
   378
	 take this, producing bytecode 
e320344c19b7 *** empty log message ***
claus
parents: 76
diff changeset
   379
	 (someone willin' to make machine code :-)
e320344c19b7 *** empty log message ***
claus
parents: 76
diff changeset
   380
	"
e320344c19b7 *** empty log message ***
claus
parents: 76
diff changeset
   381
	((compiler genByteCodeFrom:symbolicCodeArray) == #Error) ifTrue:[
84
claus
parents: 78
diff changeset
   382
	    Transcript show:'    '.
90
claus
parents: 85
diff changeset
   383
	     sel notNil ifTrue:[
claus
parents: 85
diff changeset
   384
		Transcript show:(sel ,' ')
78
e320344c19b7 *** empty log message ***
claus
parents: 76
diff changeset
   385
	    ].
e320344c19b7 *** empty log message ***
claus
parents: 76
diff changeset
   386
	    Transcript showCr:'relocation error - must be simplified'.
e320344c19b7 *** empty log message ***
claus
parents: 76
diff changeset
   387
	    ^ #Error
45
e8331ba8ad5d *** empty log message ***
claus
parents: 39
diff changeset
   388
	].
0
7ad01559b262 Initial revision
claus
parents:
diff changeset
   389
    ].
7ad01559b262 Initial revision
claus
parents:
diff changeset
   390
54
86c5b39c2eca *** empty log message ***
claus
parents: 49
diff changeset
   391
    "
86c5b39c2eca *** empty log message ***
claus
parents: 49
diff changeset
   392
     finally create the new method-object
86c5b39c2eca *** empty log message ***
claus
parents: 49
diff changeset
   393
    "
0
7ad01559b262 Initial revision
claus
parents:
diff changeset
   394
    newMethod := Method new.
7ad01559b262 Initial revision
claus
parents:
diff changeset
   395
    lits := compiler literalArray.
7ad01559b262 Initial revision
claus
parents:
diff changeset
   396
    lits notNil ifTrue:[
45
e8331ba8ad5d *** empty log message ***
claus
parents: 39
diff changeset
   397
	"literals MUST be an array - not just any Collection"
e8331ba8ad5d *** empty log message ***
claus
parents: 39
diff changeset
   398
	lits := Array withAll:lits.
e8331ba8ad5d *** empty log message ***
claus
parents: 39
diff changeset
   399
	newMethod literals:lits
0
7ad01559b262 Initial revision
claus
parents:
diff changeset
   400
    ].
90
claus
parents: 85
diff changeset
   401
    primNr notNil ifTrue:[
claus
parents: 85
diff changeset
   402
	newMethod code:(compiler checkForPrimitiveCode:primNr).
78
e320344c19b7 *** empty log message ***
claus
parents: 76
diff changeset
   403
    ] ifFalse:[
e320344c19b7 *** empty log message ***
claus
parents: 76
diff changeset
   404
	newMethod byteCode:(compiler code).
e320344c19b7 *** empty log message ***
claus
parents: 76
diff changeset
   405
    ].
54
86c5b39c2eca *** empty log message ***
claus
parents: 49
diff changeset
   406
    newMethod numberOfMethodVars:(compiler numberOfMethodVars).
86c5b39c2eca *** empty log message ***
claus
parents: 49
diff changeset
   407
    newMethod numberOfMethodArgs:(compiler numberOfMethodArgs).
86c5b39c2eca *** empty log message ***
claus
parents: 49
diff changeset
   408
    newMethod stackSize:(compiler maxStackDepth).
19
84a1ddf215a5 *** empty log message ***
claus
parents: 15
diff changeset
   409
54
86c5b39c2eca *** empty log message ***
claus
parents: 49
diff changeset
   410
    "
86c5b39c2eca *** empty log message ***
claus
parents: 49
diff changeset
   411
     if there where any corrections, install the updated source
86c5b39c2eca *** empty log message ***
claus
parents: 49
diff changeset
   412
    "
90
claus
parents: 85
diff changeset
   413
    (newSource := compiler correctedSource) notNil ifTrue:[
claus
parents: 85
diff changeset
   414
	newMethod source:newSource 
19
84a1ddf215a5 *** empty log message ***
claus
parents: 15
diff changeset
   415
    ] ifFalse:[
45
e8331ba8ad5d *** empty log message ***
claus
parents: 39
diff changeset
   416
	newMethod source:aString.
19
84a1ddf215a5 *** empty log message ***
claus
parents: 15
diff changeset
   417
    ].
0
7ad01559b262 Initial revision
claus
parents:
diff changeset
   418
    newMethod category:cat.
54
86c5b39c2eca *** empty log message ***
claus
parents: 49
diff changeset
   419
    Project notNil ifTrue:[
98
claus
parents: 97
diff changeset
   420
	newMethod package:(Project currentPackageName)
54
86c5b39c2eca *** empty log message ***
claus
parents: 49
diff changeset
   421
    ].
0
7ad01559b262 Initial revision
claus
parents:
diff changeset
   422
7ad01559b262 Initial revision
claus
parents:
diff changeset
   423
    install ifTrue:[
90
claus
parents: 85
diff changeset
   424
	aClass addSelector:sel withMethod:newMethod
0
7ad01559b262 Initial revision
claus
parents:
diff changeset
   425
    ].
7ad01559b262 Initial revision
claus
parents:
diff changeset
   426
54
86c5b39c2eca *** empty log message ***
claus
parents: 49
diff changeset
   427
    silencio ifFalse:[
90
claus
parents: 85
diff changeset
   428
	Transcript showCr:('    compiled: ', aClass name,' ', sel)
0
7ad01559b262 Initial revision
claus
parents:
diff changeset
   429
    ].
7ad01559b262 Initial revision
claus
parents:
diff changeset
   430
7ad01559b262 Initial revision
claus
parents:
diff changeset
   431
    ^ newMethod
7ad01559b262 Initial revision
claus
parents:
diff changeset
   432
! !
7ad01559b262 Initial revision
claus
parents:
diff changeset
   433
15
992c3d87edbf *** empty log message ***
claus
parents: 13
diff changeset
   434
!ByteCodeCompiler class methodsFor:'constants'!
992c3d87edbf *** empty log message ***
claus
parents: 13
diff changeset
   435
992c3d87edbf *** empty log message ***
claus
parents: 13
diff changeset
   436
byteCodeFor:aSymbol
992c3d87edbf *** empty log message ***
claus
parents: 13
diff changeset
   437
    "only some exported codes handled here (for BlockNode)"
992c3d87edbf *** empty log message ***
claus
parents: 13
diff changeset
   438
25
865d6cfaf90d changed bytecodes
claus
parents: 20
diff changeset
   439
    (aSymbol == #retNil) ifTrue:[^ 1].
865d6cfaf90d changed bytecodes
claus
parents: 20
diff changeset
   440
    (aSymbol == #retTrue) ifTrue:[^ 2].
865d6cfaf90d changed bytecodes
claus
parents: 20
diff changeset
   441
    (aSymbol == #retFalse) ifTrue:[^ 3].
865d6cfaf90d changed bytecodes
claus
parents: 20
diff changeset
   442
    (aSymbol == #ret0) ifTrue:[^ 4].
865d6cfaf90d changed bytecodes
claus
parents: 20
diff changeset
   443
    (aSymbol == #retTop) ifTrue:[^ 0].
865d6cfaf90d changed bytecodes
claus
parents: 20
diff changeset
   444
15
992c3d87edbf *** empty log message ***
claus
parents: 13
diff changeset
   445
    (aSymbol == #push0) ifTrue:[^120].
992c3d87edbf *** empty log message ***
claus
parents: 13
diff changeset
   446
    (aSymbol == #push1) ifTrue:[^121].
992c3d87edbf *** empty log message ***
claus
parents: 13
diff changeset
   447
    (aSymbol == #push2) ifTrue:[^139].
992c3d87edbf *** empty log message ***
claus
parents: 13
diff changeset
   448
    (aSymbol == #pushMinus1) ifTrue:[^122].
992c3d87edbf *** empty log message ***
claus
parents: 13
diff changeset
   449
    (aSymbol == #pushNil) ifTrue:[^ 10].
992c3d87edbf *** empty log message ***
claus
parents: 13
diff changeset
   450
    (aSymbol == #pushTrue) ifTrue:[^ 11].
992c3d87edbf *** empty log message ***
claus
parents: 13
diff changeset
   451
    (aSymbol == #pushFalse) ifTrue:[^ 12].
992c3d87edbf *** empty log message ***
claus
parents: 13
diff changeset
   452
    (aSymbol == #pushSelf) ifTrue:[^ 15].
992c3d87edbf *** empty log message ***
claus
parents: 13
diff changeset
   453
    self error
992c3d87edbf *** empty log message ***
claus
parents: 13
diff changeset
   454
! !
992c3d87edbf *** empty log message ***
claus
parents: 13
diff changeset
   455
54
86c5b39c2eca *** empty log message ***
claus
parents: 49
diff changeset
   456
!ByteCodeCompiler class methodsFor:'stc compilation defaults'!
86c5b39c2eca *** empty log message ***
claus
parents: 49
diff changeset
   457
124
claus
parents: 120
diff changeset
   458
stcCompilationIncludes:aString
claus
parents: 120
diff changeset
   459
    "define the include directories via additional -I flags.
claus
parents: 120
diff changeset
   460
     These are passed to stc. Can be set in your private.rc file"
claus
parents: 120
diff changeset
   461
claus
parents: 120
diff changeset
   462
    STCCompilationIncludes := aString
claus
parents: 120
diff changeset
   463
claus
parents: 120
diff changeset
   464
    "
claus
parents: 120
diff changeset
   465
     Compiler stcCompilationIncludes:'-I/usr/local/include -I../../include'
125
Claus Gittinger <cg@exept.de>
parents: 124
diff changeset
   466
     Compiler stcCompilationIncludes:(Compiler stcCompilationIncludes , ' -I../../libxt')
124
claus
parents: 120
diff changeset
   467
    "
claus
parents: 120
diff changeset
   468
!
54
86c5b39c2eca *** empty log message ***
claus
parents: 49
diff changeset
   469
124
claus
parents: 120
diff changeset
   470
stcCompilationIncludes
claus
parents: 120
diff changeset
   471
    "return the includes used with stc compilation"
claus
parents: 120
diff changeset
   472
claus
parents: 120
diff changeset
   473
    ^ STCCompilationIncludes
claus
parents: 120
diff changeset
   474
!
claus
parents: 120
diff changeset
   475
claus
parents: 120
diff changeset
   476
stcCompilationDefines:aString
claus
parents: 120
diff changeset
   477
    "define the flags (for example, additional -D defines)
claus
parents: 120
diff changeset
   478
     to be used when compiling to machine code.
claus
parents: 120
diff changeset
   479
     These are passed to stc. Can be set from your private.rc file."
claus
parents: 120
diff changeset
   480
claus
parents: 120
diff changeset
   481
    STCCompilationDefines := aString
54
86c5b39c2eca *** empty log message ***
claus
parents: 49
diff changeset
   482
86c5b39c2eca *** empty log message ***
claus
parents: 49
diff changeset
   483
    "
124
claus
parents: 120
diff changeset
   484
     Compiler stcCompilationDefines:'-DVGL -DDEBUG'
54
86c5b39c2eca *** empty log message ***
claus
parents: 49
diff changeset
   485
    "
86c5b39c2eca *** empty log message ***
claus
parents: 49
diff changeset
   486
!
86c5b39c2eca *** empty log message ***
claus
parents: 49
diff changeset
   487
124
claus
parents: 120
diff changeset
   488
stcCompilationDefines
claus
parents: 120
diff changeset
   489
    "return the defines used with stc compilation"
claus
parents: 120
diff changeset
   490
claus
parents: 120
diff changeset
   491
    ^ STCCompilationDefines
claus
parents: 120
diff changeset
   492
!
claus
parents: 120
diff changeset
   493
claus
parents: 120
diff changeset
   494
stcCompilationOptions:aString
claus
parents: 120
diff changeset
   495
    "define the compilation options 
claus
parents: 120
diff changeset
   496
     to be used when compiling to machine code.
claus
parents: 120
diff changeset
   497
     These are passed to stc. Can be set from your private.rc file."
claus
parents: 120
diff changeset
   498
claus
parents: 120
diff changeset
   499
    STCCompilationOptions := aString
claus
parents: 120
diff changeset
   500
claus
parents: 120
diff changeset
   501
    "
claus
parents: 120
diff changeset
   502
     Compiler stcCompilationOptions:'+optinline'
claus
parents: 120
diff changeset
   503
    "
claus
parents: 120
diff changeset
   504
!
claus
parents: 120
diff changeset
   505
claus
parents: 120
diff changeset
   506
stcCompilationOptions
claus
parents: 120
diff changeset
   507
    "return the options used with stc compilation"
claus
parents: 120
diff changeset
   508
claus
parents: 120
diff changeset
   509
    ^ STCCompilationOptions
claus
parents: 120
diff changeset
   510
!
claus
parents: 120
diff changeset
   511
101
claus
parents: 98
diff changeset
   512
stcCompilation
claus
parents: 98
diff changeset
   513
    "return the flag which controls compilation to machine code.
claus
parents: 98
diff changeset
   514
     If #always, methods are always compiled to machine code (which takes
claus
parents: 98
diff changeset
   515
     longer, but provides faster code). If #none, methods are never compiled
claus
parents: 98
diff changeset
   516
     to machine code, instead for non-primitive ones, compilation is to bytecode
claus
parents: 98
diff changeset
   517
     and for primitive ones, a trapping stub is generated.
claus
parents: 98
diff changeset
   518
     Anything else lets the compiler compile to bytecode,
claus
parents: 98
diff changeset
   519
     except for methods containing primitive code.
claus
parents: 98
diff changeset
   520
     This can be set from your private.rc file or from a workspace
claus
parents: 98
diff changeset
   521
     for selective compilation to machine code."
claus
parents: 98
diff changeset
   522
claus
parents: 98
diff changeset
   523
    ^ STCCompilation
claus
parents: 98
diff changeset
   524
claus
parents: 98
diff changeset
   525
    "
claus
parents: 98
diff changeset
   526
     Compiler stcCompilation
claus
parents: 98
diff changeset
   527
    "
claus
parents: 98
diff changeset
   528
!
claus
parents: 98
diff changeset
   529
claus
parents: 98
diff changeset
   530
stcCompilation:how
claus
parents: 98
diff changeset
   531
    "set the flag which controls compilation to machine code.
claus
parents: 98
diff changeset
   532
     If #always, methods are always compiled to machine code (which takes
claus
parents: 98
diff changeset
   533
     longer, but provides faster code). If #none, methods are never compiled
claus
parents: 98
diff changeset
   534
     to machine code, instead for non-primitive ones, compilation is to bytecode
claus
parents: 98
diff changeset
   535
     and for primitive ones, a trapping stub is generated.
claus
parents: 98
diff changeset
   536
     Anything else lets the compiler compile to bytecode,
claus
parents: 98
diff changeset
   537
     except for methods containing primitive code.
54
86c5b39c2eca *** empty log message ***
claus
parents: 49
diff changeset
   538
     This can be set from your private.rc file or from a workspace
86c5b39c2eca *** empty log message ***
claus
parents: 49
diff changeset
   539
     for selective compilation to machine code."
86c5b39c2eca *** empty log message ***
claus
parents: 49
diff changeset
   540
109
claus
parents: 108
diff changeset
   541
    |ret|
claus
parents: 108
diff changeset
   542
claus
parents: 108
diff changeset
   543
    ret := STCCompilation.
claus
parents: 108
diff changeset
   544
    STCCompilation := how.
claus
parents: 108
diff changeset
   545
    ^ ret
54
86c5b39c2eca *** empty log message ***
claus
parents: 49
diff changeset
   546
86c5b39c2eca *** empty log message ***
claus
parents: 49
diff changeset
   547
    "
101
claus
parents: 98
diff changeset
   548
     Compiler stcCompilation:#always
claus
parents: 98
diff changeset
   549
     Compiler stcCompilation:#never 
claus
parents: 98
diff changeset
   550
     Compiler stcCompilation:#default 
54
86c5b39c2eca *** empty log message ***
claus
parents: 49
diff changeset
   551
    "
86c5b39c2eca *** empty log message ***
claus
parents: 49
diff changeset
   552
!
86c5b39c2eca *** empty log message ***
claus
parents: 49
diff changeset
   553
120
claus
parents: 118
diff changeset
   554
stcPathOf:command 
claus
parents: 118
diff changeset
   555
    "return the path to an stc command, or nil if not found."
101
claus
parents: 98
diff changeset
   556
claus
parents: 98
diff changeset
   557
    |f|
97
claus
parents: 96
diff changeset
   558
120
claus
parents: 118
diff changeset
   559
    ((f := '../../stc' asFilename construct:command)) isExecutable ifTrue:[
101
claus
parents: 98
diff changeset
   560
	^ f pathName
claus
parents: 98
diff changeset
   561
    ].
126
Claus Gittinger <cg@exept.de>
parents: 125
diff changeset
   562
    ^ OperatingSystem pathOfCommand:command
97
claus
parents: 96
diff changeset
   563
claus
parents: 96
diff changeset
   564
    "
120
claus
parents: 118
diff changeset
   565
     Compiler stcPathOf:'stc'     
claus
parents: 118
diff changeset
   566
    "
claus
parents: 118
diff changeset
   567
claus
parents: 118
diff changeset
   568
    "Created: 13.9.1995 / 14:37:16 / claus"
claus
parents: 118
diff changeset
   569
!
claus
parents: 118
diff changeset
   570
claus
parents: 118
diff changeset
   571
stcPath 
claus
parents: 118
diff changeset
   572
    "return the path to the stc command, or nil if not found."
claus
parents: 118
diff changeset
   573
claus
parents: 118
diff changeset
   574
    ^ self stcPathOf:'stc'
claus
parents: 118
diff changeset
   575
claus
parents: 118
diff changeset
   576
    "
101
claus
parents: 98
diff changeset
   577
     Compiler stcPath     
claus
parents: 98
diff changeset
   578
    "
120
claus
parents: 118
diff changeset
   579
claus
parents: 118
diff changeset
   580
    "Modified: 13.9.1995 / 14:37:26 / claus"
claus
parents: 118
diff changeset
   581
!
claus
parents: 118
diff changeset
   582
claus
parents: 118
diff changeset
   583
incrementalStcPath 
claus
parents: 118
diff changeset
   584
    "return the path to the stc command for incremental method compilation, 
claus
parents: 118
diff changeset
   585
     or nil if not found."
claus
parents: 118
diff changeset
   586
claus
parents: 118
diff changeset
   587
    |f|
claus
parents: 118
diff changeset
   588
claus
parents: 118
diff changeset
   589
    (f := self stcPathOf:'stc') notNil ifTrue:[^ f].
claus
parents: 118
diff changeset
   590
    ^ self stcPathOf:'demostc'
claus
parents: 118
diff changeset
   591
claus
parents: 118
diff changeset
   592
    "
claus
parents: 118
diff changeset
   593
     Compiler incrementalStcPath     
claus
parents: 118
diff changeset
   594
    "
claus
parents: 118
diff changeset
   595
claus
parents: 118
diff changeset
   596
    "Created: 13.9.1995 / 14:36:36 / claus"
claus
parents: 118
diff changeset
   597
    "Modified: 13.9.1995 / 15:15:04 / claus"
101
claus
parents: 98
diff changeset
   598
!
claus
parents: 98
diff changeset
   599
claus
parents: 98
diff changeset
   600
canCreateMachineCode
claus
parents: 98
diff changeset
   601
    "return true, if compilation to machine code is supported.
118
claus
parents: 117
diff changeset
   602
     Currently, all SYSV4 and Linux systems do so;
claus
parents: 117
diff changeset
   603
     REAL/IX, AIX and HPUX do not (due to the need for dynamic loading 
claus
parents: 117
diff changeset
   604
     of object files, which is not supported by those).
claus
parents: 117
diff changeset
   605
     MIPS ULTRIX is almost finished, but not yet released.
101
claus
parents: 98
diff changeset
   606
claus
parents: 98
diff changeset
   607
     However, if no compiler is around (i.e. the demo distribution),
claus
parents: 98
diff changeset
   608
     there is no chance ..."
claus
parents: 98
diff changeset
   609
claus
parents: 98
diff changeset
   610
    |canDo|
claus
parents: 98
diff changeset
   611
106
claus
parents: 105
diff changeset
   612
    ObjectFileLoader isNil ifTrue:[^ false].
118
claus
parents: 117
diff changeset
   613
    ObjectFileLoader canLoadObjectFiles ifFalse:[^ false].
106
claus
parents: 105
diff changeset
   614
118
claus
parents: 117
diff changeset
   615
    "/ no chance, if no stc is available
120
claus
parents: 118
diff changeset
   616
    ^ self incrementalStcPath notNil
101
claus
parents: 98
diff changeset
   617
claus
parents: 98
diff changeset
   618
    "
claus
parents: 98
diff changeset
   619
     Compiler canCreateMachineCode     
97
claus
parents: 96
diff changeset
   620
    "
120
claus
parents: 118
diff changeset
   621
claus
parents: 118
diff changeset
   622
    "Modified: 13.9.1995 / 15:15:11 / claus"
97
claus
parents: 96
diff changeset
   623
!
claus
parents: 96
diff changeset
   624
54
86c5b39c2eca *** empty log message ***
claus
parents: 49
diff changeset
   625
keepSource:aBoolean
86c5b39c2eca *** empty log message ***
claus
parents: 49
diff changeset
   626
    "if true, the source of a method is kept as a string in memory;
86c5b39c2eca *** empty log message ***
claus
parents: 49
diff changeset
   627
     if false, the source is appended to the sources-file (st.src) and
86c5b39c2eca *** empty log message ***
claus
parents: 49
diff changeset
   628
     only a reference to its fileposition is kept in memory - thus saving
86c5b39c2eca *** empty log message ***
claus
parents: 49
diff changeset
   629
     space. You have to care for the source-file to not become corrupted
86c5b39c2eca *** empty log message ***
claus
parents: 49
diff changeset
   630
     in this case; therefore, the default is to keep it as strings for now."
86c5b39c2eca *** empty log message ***
claus
parents: 49
diff changeset
   631
86c5b39c2eca *** empty log message ***
claus
parents: 49
diff changeset
   632
    KeepSource := aBoolean
86c5b39c2eca *** empty log message ***
claus
parents: 49
diff changeset
   633
86c5b39c2eca *** empty log message ***
claus
parents: 49
diff changeset
   634
    "
86c5b39c2eca *** empty log message ***
claus
parents: 49
diff changeset
   635
     Compiler keepSource:true.
86c5b39c2eca *** empty log message ***
claus
parents: 49
diff changeset
   636
     Compiler keepSource:false.
86c5b39c2eca *** empty log message ***
claus
parents: 49
diff changeset
   637
    "
86c5b39c2eca *** empty log message ***
claus
parents: 49
diff changeset
   638
! !
86c5b39c2eca *** empty log message ***
claus
parents: 49
diff changeset
   639
0
7ad01559b262 Initial revision
claus
parents:
diff changeset
   640
!ByteCodeCompiler methodsFor:'accessing'!
7ad01559b262 Initial revision
claus
parents:
diff changeset
   641
7ad01559b262 Initial revision
claus
parents:
diff changeset
   642
literalArray
7ad01559b262 Initial revision
claus
parents:
diff changeset
   643
    "return the literal array - only valid after parsing"
7ad01559b262 Initial revision
claus
parents:
diff changeset
   644
7ad01559b262 Initial revision
claus
parents:
diff changeset
   645
    ^ litArray
7ad01559b262 Initial revision
claus
parents:
diff changeset
   646
!
7ad01559b262 Initial revision
claus
parents:
diff changeset
   647
7ad01559b262 Initial revision
claus
parents:
diff changeset
   648
code
3
b63b8a6b71fb *** empty log message ***
claus
parents: 1
diff changeset
   649
    "return the bytecode array - only valid after code-generation"
0
7ad01559b262 Initial revision
claus
parents:
diff changeset
   650
49
02660b790c3e *** empty log message ***
claus
parents: 46
diff changeset
   651
    ^ codeBytes
0
7ad01559b262 Initial revision
claus
parents:
diff changeset
   652
!
7ad01559b262 Initial revision
claus
parents:
diff changeset
   653
7ad01559b262 Initial revision
claus
parents:
diff changeset
   654
maxStackDepth
7ad01559b262 Initial revision
claus
parents:
diff changeset
   655
    "return the stack-need of the method - only valid after code-generation"
7ad01559b262 Initial revision
claus
parents:
diff changeset
   656
7ad01559b262 Initial revision
claus
parents:
diff changeset
   657
    ^ maxStackDepth
7ad01559b262 Initial revision
claus
parents:
diff changeset
   658
! !
7ad01559b262 Initial revision
claus
parents:
diff changeset
   659
7ad01559b262 Initial revision
claus
parents:
diff changeset
   660
!ByteCodeCompiler methodsFor:'code generation'!
7ad01559b262 Initial revision
claus
parents:
diff changeset
   661
7ad01559b262 Initial revision
claus
parents:
diff changeset
   662
genSymbolicCode
7ad01559b262 Initial revision
claus
parents:
diff changeset
   663
    "traverse the parse-tree producing symbolicCode - return the codeArray"
7ad01559b262 Initial revision
claus
parents:
diff changeset
   664
120
claus
parents: 118
diff changeset
   665
    |codeStream code thisStatement lastStatement|
0
7ad01559b262 Initial revision
claus
parents:
diff changeset
   666
104
claus
parents: 103
diff changeset
   667
    litArray := nil.
76
55d64cb1ffea *** empty log message ***
claus
parents: 54
diff changeset
   668
    codeStream := WriteStream on:(OrderedCollection new:100).
104
claus
parents: 103
diff changeset
   669
0
7ad01559b262 Initial revision
claus
parents:
diff changeset
   670
    thisStatement := tree.
7ad01559b262 Initial revision
claus
parents:
diff changeset
   671
    [thisStatement notNil] whileTrue:[
45
e8331ba8ad5d *** empty log message ***
claus
parents: 39
diff changeset
   672
	lastStatement := thisStatement.
104
claus
parents: 103
diff changeset
   673
	thisStatement codeForSideEffectOn:codeStream inBlock:nil for:self.
45
e8331ba8ad5d *** empty log message ***
claus
parents: 39
diff changeset
   674
	thisStatement := thisStatement nextStatement
0
7ad01559b262 Initial revision
claus
parents:
diff changeset
   675
    ].
54
86c5b39c2eca *** empty log message ***
claus
parents: 49
diff changeset
   676
    (lastStatement isNil or:[lastStatement isReturnNode not])
0
7ad01559b262 Initial revision
claus
parents:
diff changeset
   677
    ifTrue:[
45
e8331ba8ad5d *** empty log message ***
claus
parents: 39
diff changeset
   678
	"not a return - add retSelf"
54
86c5b39c2eca *** empty log message ***
claus
parents: 49
diff changeset
   679
	"
86c5b39c2eca *** empty log message ***
claus
parents: 49
diff changeset
   680
	 if the last statement was a send for side-effect,
86c5b39c2eca *** empty log message ***
claus
parents: 49
diff changeset
   681
	 replace the previous drop by a retSelf
86c5b39c2eca *** empty log message ***
claus
parents: 49
diff changeset
   682
	"
86c5b39c2eca *** empty log message ***
claus
parents: 49
diff changeset
   683
	lastStatement notNil ifTrue:[
120
claus
parents: 118
diff changeset
   684
	    ((code := codeStream contents) notNil
claus
parents: 118
diff changeset
   685
	    and:[code size > 0
claus
parents: 118
diff changeset
   686
	    and:[code last == #drop]]) ifTrue:[
54
86c5b39c2eca *** empty log message ***
claus
parents: 49
diff changeset
   687
		codeStream position:(codeStream position - 1).
86c5b39c2eca *** empty log message ***
claus
parents: 49
diff changeset
   688
		codeStream nextPut:#retSelf
86c5b39c2eca *** empty log message ***
claus
parents: 49
diff changeset
   689
	    ]
86c5b39c2eca *** empty log message ***
claus
parents: 49
diff changeset
   690
	].
45
e8331ba8ad5d *** empty log message ***
claus
parents: 39
diff changeset
   691
	codeStream nextPut:#retSelf
0
7ad01559b262 Initial revision
claus
parents:
diff changeset
   692
    ].
7ad01559b262 Initial revision
claus
parents:
diff changeset
   693
    ^ codeStream contents
7ad01559b262 Initial revision
claus
parents:
diff changeset
   694
!
7ad01559b262 Initial revision
claus
parents:
diff changeset
   695
19
84a1ddf215a5 *** empty log message ***
claus
parents: 15
diff changeset
   696
checkForPrimitiveCode:nr
78
e320344c19b7 *** empty log message ***
claus
parents: 76
diff changeset
   697
    "return the code for an ST-80 primitive method.
e320344c19b7 *** empty log message ***
claus
parents: 76
diff changeset
   698
     Since many primitives available on ST-80 should also be available
e320344c19b7 *** empty log message ***
claus
parents: 76
diff changeset
   699
     somewhere in ST/X, this may work for many primitive numbers.
e320344c19b7 *** empty log message ***
claus
parents: 76
diff changeset
   700
     However, more information is needed and more things to be added below.
e320344c19b7 *** empty log message ***
claus
parents: 76
diff changeset
   701
e320344c19b7 *** empty log message ***
claus
parents: 76
diff changeset
   702
     This was added to allow emulation of (some) ST-80
e320344c19b7 *** empty log message ***
claus
parents: 76
diff changeset
   703
     primitives (to fileIn RemoteInvocation & Monitor41 packages)"
0
7ad01559b262 Initial revision
claus
parents:
diff changeset
   704
3
b63b8a6b71fb *** empty log message ***
claus
parents: 1
diff changeset
   705
    |cls sel|
b63b8a6b71fb *** empty log message ***
claus
parents: 1
diff changeset
   706
19
84a1ddf215a5 *** empty log message ***
claus
parents: 15
diff changeset
   707
    (nr == 75)  ifTrue:[ cls := Object. sel := #identityHash ].
84a1ddf215a5 *** empty log message ***
claus
parents: 15
diff changeset
   708
    (nr == 110) ifTrue:[ cls := Object. sel := #==           ].
84a1ddf215a5 *** empty log message ***
claus
parents: 15
diff changeset
   709
    (nr == 111) ifTrue:[ cls := Object. sel := #class        ].
49
02660b790c3e *** empty log message ***
claus
parents: 46
diff changeset
   710
    "
02660b790c3e *** empty log message ***
claus
parents: 46
diff changeset
   711
     should add more here, to be able to fileIn ST-80 methods
02660b790c3e *** empty log message ***
claus
parents: 46
diff changeset
   712
     containing primitive calls (who gives me the numbers ... ?)
02660b790c3e *** empty log message ***
claus
parents: 46
diff changeset
   713
    "
3
b63b8a6b71fb *** empty log message ***
claus
parents: 1
diff changeset
   714
    cls notNil ifTrue:[
45
e8331ba8ad5d *** empty log message ***
claus
parents: 39
diff changeset
   715
	^ (cls compiledMethodAt:sel) code
3
b63b8a6b71fb *** empty log message ***
claus
parents: 1
diff changeset
   716
    ].
0
7ad01559b262 Initial revision
claus
parents:
diff changeset
   717
    ^ nil
7ad01559b262 Initial revision
claus
parents:
diff changeset
   718
!
7ad01559b262 Initial revision
claus
parents:
diff changeset
   719
7ad01559b262 Initial revision
claus
parents:
diff changeset
   720
genByteCodeFrom:symbolicCodeArray
7ad01559b262 Initial revision
claus
parents:
diff changeset
   721
    "convert symbolicCode into bytecodes"
7ad01559b262 Initial revision
claus
parents:
diff changeset
   722
49
02660b790c3e *** empty log message ***
claus
parents: 46
diff changeset
   723
    |symIndex    "{Class: SmallInteger }"
02660b790c3e *** empty log message ***
claus
parents: 46
diff changeset
   724
     codeSize    "{Class: SmallInteger }"
02660b790c3e *** empty log message ***
claus
parents: 46
diff changeset
   725
     symCodeSize "{Class: SmallInteger }"
0
7ad01559b262 Initial revision
claus
parents:
diff changeset
   726
     index addr
45
e8331ba8ad5d *** empty log message ***
claus
parents: 39
diff changeset
   727
     codeSymbol nargs needRetry
46
a8c1e932ed6a 16bit literal offsets
claus
parents: 45
diff changeset
   728
     stackDepth relocInfo level nvars round t|
0
7ad01559b262 Initial revision
claus
parents:
diff changeset
   729
7ad01559b262 Initial revision
claus
parents:
diff changeset
   730
    symbolicCodeArray isNil ifTrue:[^ self].
7ad01559b262 Initial revision
claus
parents:
diff changeset
   731
45
e8331ba8ad5d *** empty log message ***
claus
parents: 39
diff changeset
   732
    round := 0.
e8331ba8ad5d *** empty log message ***
claus
parents: 39
diff changeset
   733
    needRetry := true.
0
7ad01559b262 Initial revision
claus
parents:
diff changeset
   734
    symCodeSize := symbolicCodeArray size.
7ad01559b262 Initial revision
claus
parents:
diff changeset
   735
    codeSize := symCodeSize.
7ad01559b262 Initial revision
claus
parents:
diff changeset
   736
45
e8331ba8ad5d *** empty log message ***
claus
parents: 39
diff changeset
   737
    [needRetry] whileTrue:[
e8331ba8ad5d *** empty log message ***
claus
parents: 39
diff changeset
   738
	stackDepth := 0.
e8331ba8ad5d *** empty log message ***
claus
parents: 39
diff changeset
   739
	maxStackDepth := 0.
0
7ad01559b262 Initial revision
claus
parents:
diff changeset
   740
49
02660b790c3e *** empty log message ***
claus
parents: 46
diff changeset
   741
	codeBytes := ByteArray uninitializedNew:codeSize.
96
claus
parents: 95
diff changeset
   742
	relocInfo := Array basicNew:(codeSize + 1).
45
e8331ba8ad5d *** empty log message ***
claus
parents: 39
diff changeset
   743
	symIndex := 1.
e8331ba8ad5d *** empty log message ***
claus
parents: 39
diff changeset
   744
	codeIndex := 1.
0
7ad01559b262 Initial revision
claus
parents:
diff changeset
   745
45
e8331ba8ad5d *** empty log message ***
claus
parents: 39
diff changeset
   746
	needRetry := false.
e8331ba8ad5d *** empty log message ***
claus
parents: 39
diff changeset
   747
	round := round + 1.
e8331ba8ad5d *** empty log message ***
claus
parents: 39
diff changeset
   748
e8331ba8ad5d *** empty log message ***
claus
parents: 39
diff changeset
   749
	[symIndex <= symCodeSize] whileTrue:[
e8331ba8ad5d *** empty log message ***
claus
parents: 39
diff changeset
   750
	    relocInfo at:symIndex put:codeIndex.
0
7ad01559b262 Initial revision
claus
parents:
diff changeset
   751
45
e8331ba8ad5d *** empty log message ***
claus
parents: 39
diff changeset
   752
	    codeSymbol := symbolicCodeArray at:symIndex.
e8331ba8ad5d *** empty log message ***
claus
parents: 39
diff changeset
   753
	    symIndex := symIndex + 1.
e8331ba8ad5d *** empty log message ***
claus
parents: 39
diff changeset
   754
	    stackDelta := 0.
e8331ba8ad5d *** empty log message ***
claus
parents: 39
diff changeset
   755
	    extra := nil.
e8331ba8ad5d *** empty log message ***
claus
parents: 39
diff changeset
   756
	    lineno := false.
e8331ba8ad5d *** empty log message ***
claus
parents: 39
diff changeset
   757
	    self appendByteCodeFor:codeSymbol.
e8331ba8ad5d *** empty log message ***
claus
parents: 39
diff changeset
   758
	    lineno ifTrue:[
e8331ba8ad5d *** empty log message ***
claus
parents: 39
diff changeset
   759
		self appendByte:((symbolicCodeArray at:symIndex) min:255).
e8331ba8ad5d *** empty log message ***
claus
parents: 39
diff changeset
   760
		symIndex := symIndex + 1
e8331ba8ad5d *** empty log message ***
claus
parents: 39
diff changeset
   761
	    ].
e8331ba8ad5d *** empty log message ***
claus
parents: 39
diff changeset
   762
	    extra notNil ifTrue:[
46
a8c1e932ed6a 16bit literal offsets
claus
parents: 45
diff changeset
   763
		(extra == #number) ifTrue:[
a8c1e932ed6a 16bit literal offsets
claus
parents: 45
diff changeset
   764
		    index := symbolicCodeArray at:symIndex.
a8c1e932ed6a 16bit literal offsets
claus
parents: 45
diff changeset
   765
		    symIndex := symIndex + 1.
a8c1e932ed6a 16bit literal offsets
claus
parents: 45
diff changeset
   766
		    self appendSignedByte:index
a8c1e932ed6a 16bit literal offsets
claus
parents: 45
diff changeset
   767
		].
a8c1e932ed6a 16bit literal offsets
claus
parents: 45
diff changeset
   768
		(extra == #number16) ifTrue:[
a8c1e932ed6a 16bit literal offsets
claus
parents: 45
diff changeset
   769
		    index := symbolicCodeArray at:symIndex.
a8c1e932ed6a 16bit literal offsets
claus
parents: 45
diff changeset
   770
		    symIndex := symIndex + 2.
a8c1e932ed6a 16bit literal offsets
claus
parents: 45
diff changeset
   771
		    self appendSignedWord:index
a8c1e932ed6a 16bit literal offsets
claus
parents: 45
diff changeset
   772
		].
54
86c5b39c2eca *** empty log message ***
claus
parents: 49
diff changeset
   773
		(extra == #unsigned16) ifTrue:[
86c5b39c2eca *** empty log message ***
claus
parents: 49
diff changeset
   774
		    index := symbolicCodeArray at:symIndex.
86c5b39c2eca *** empty log message ***
claus
parents: 49
diff changeset
   775
		    symIndex := symIndex + 2.
86c5b39c2eca *** empty log message ***
claus
parents: 49
diff changeset
   776
		    self appendWord:index
86c5b39c2eca *** empty log message ***
claus
parents: 49
diff changeset
   777
		].
45
e8331ba8ad5d *** empty log message ***
claus
parents: 39
diff changeset
   778
		(extra == #index) ifTrue:[
46
a8c1e932ed6a 16bit literal offsets
claus
parents: 45
diff changeset
   779
		    index := symbolicCodeArray at:symIndex.
a8c1e932ed6a 16bit literal offsets
claus
parents: 45
diff changeset
   780
		    symIndex := symIndex + 1.
a8c1e932ed6a 16bit literal offsets
claus
parents: 45
diff changeset
   781
		    self appendByte:index
a8c1e932ed6a 16bit literal offsets
claus
parents: 45
diff changeset
   782
		].
a8c1e932ed6a 16bit literal offsets
claus
parents: 45
diff changeset
   783
		(extra == #lit) ifTrue:[
45
e8331ba8ad5d *** empty log message ***
claus
parents: 39
diff changeset
   784
		    index := self addLiteral:(symbolicCodeArray at:symIndex).
e8331ba8ad5d *** empty log message ***
claus
parents: 39
diff changeset
   785
		    symIndex := symIndex + 1.
e8331ba8ad5d *** empty log message ***
claus
parents: 39
diff changeset
   786
		    self appendByte:index
46
a8c1e932ed6a 16bit literal offsets
claus
parents: 45
diff changeset
   787
		].
a8c1e932ed6a 16bit literal offsets
claus
parents: 45
diff changeset
   788
		(extra == #speciallit) ifTrue:[
a8c1e932ed6a 16bit literal offsets
claus
parents: 45
diff changeset
   789
		    index := self addLiteral:(symbolicCodeArray at:symIndex).
a8c1e932ed6a 16bit literal offsets
claus
parents: 45
diff changeset
   790
		    index > 255 ifTrue:[
a8c1e932ed6a 16bit literal offsets
claus
parents: 45
diff changeset
   791
			self parseError:'too many globals (' , 
a8c1e932ed6a 16bit literal offsets
claus
parents: 45
diff changeset
   792
					(symbolicCodeArray at:symIndex) ,
a8c1e932ed6a 16bit literal offsets
claus
parents: 45
diff changeset
   793
					' index=' , index printString ,
a8c1e932ed6a 16bit literal offsets
claus
parents: 45
diff changeset
   794
					') in method - please simplify'.
a8c1e932ed6a 16bit literal offsets
claus
parents: 45
diff changeset
   795
			^ #Error
a8c1e932ed6a 16bit literal offsets
claus
parents: 45
diff changeset
   796
		    ].
a8c1e932ed6a 16bit literal offsets
claus
parents: 45
diff changeset
   797
		    symIndex := symIndex + 1.
a8c1e932ed6a 16bit literal offsets
claus
parents: 45
diff changeset
   798
		    self appendByte:index.
a8c1e932ed6a 16bit literal offsets
claus
parents: 45
diff changeset
   799
		    self appendByte:0.  "space for inline-generation"
a8c1e932ed6a 16bit literal offsets
claus
parents: 45
diff changeset
   800
		    self appendByte:0.  "space for inline-address"
a8c1e932ed6a 16bit literal offsets
claus
parents: 45
diff changeset
   801
		    self appendByte:0.
a8c1e932ed6a 16bit literal offsets
claus
parents: 45
diff changeset
   802
		    self appendByte:0.
a8c1e932ed6a 16bit literal offsets
claus
parents: 45
diff changeset
   803
		    self appendByte:0.
a8c1e932ed6a 16bit literal offsets
claus
parents: 45
diff changeset
   804
		    symIndex := symIndex + 5
a8c1e932ed6a 16bit literal offsets
claus
parents: 45
diff changeset
   805
		].
117
claus
parents: 111
diff changeset
   806
		(extra == #speciallitS) ifTrue:[
claus
parents: 111
diff changeset
   807
		    index := symbolicCodeArray at:symIndex.
claus
parents: 111
diff changeset
   808
		    symIndex := symIndex + 1.
claus
parents: 111
diff changeset
   809
		    self appendByte:index.
claus
parents: 111
diff changeset
   810
		    self appendByte:0.  "space for inline-generation"
claus
parents: 111
diff changeset
   811
		    self appendByte:0.  "space for inline-address"
claus
parents: 111
diff changeset
   812
		    self appendByte:0.
claus
parents: 111
diff changeset
   813
		    self appendByte:0.
claus
parents: 111
diff changeset
   814
		    self appendByte:0.
claus
parents: 111
diff changeset
   815
		    symIndex := symIndex + 5
claus
parents: 111
diff changeset
   816
		].
claus
parents: 111
diff changeset
   817
		(extra == #speciallitL) ifTrue:[
claus
parents: 111
diff changeset
   818
		    index := symbolicCodeArray at:symIndex.
claus
parents: 111
diff changeset
   819
		    symIndex := symIndex + 2.
claus
parents: 111
diff changeset
   820
		    self appendWord:index.
claus
parents: 111
diff changeset
   821
		    self appendByte:0.  "space for inline-generation"
claus
parents: 111
diff changeset
   822
		    self appendByte:0.  "space for inline-address"
claus
parents: 111
diff changeset
   823
		    self appendByte:0.
claus
parents: 111
diff changeset
   824
		    self appendByte:0.
claus
parents: 111
diff changeset
   825
		    self appendByte:0.
claus
parents: 111
diff changeset
   826
		    symIndex := symIndex + 5
claus
parents: 111
diff changeset
   827
		].
46
a8c1e932ed6a 16bit literal offsets
claus
parents: 45
diff changeset
   828
		(extra == #offset) ifTrue:[
a8c1e932ed6a 16bit literal offsets
claus
parents: 45
diff changeset
   829
		    relocInfo at:symIndex put:codeIndex.
a8c1e932ed6a 16bit literal offsets
claus
parents: 45
diff changeset
   830
		    self addReloc:symIndex.
a8c1e932ed6a 16bit literal offsets
claus
parents: 45
diff changeset
   831
		    symIndex := symIndex + 1.
a8c1e932ed6a 16bit literal offsets
claus
parents: 45
diff changeset
   832
		    self appendByte:0
a8c1e932ed6a 16bit literal offsets
claus
parents: 45
diff changeset
   833
		].
a8c1e932ed6a 16bit literal offsets
claus
parents: 45
diff changeset
   834
		(extra == #indexLevel) ifTrue:[
a8c1e932ed6a 16bit literal offsets
claus
parents: 45
diff changeset
   835
		    index := symbolicCodeArray at:symIndex.
a8c1e932ed6a 16bit literal offsets
claus
parents: 45
diff changeset
   836
		    symIndex := symIndex + 1.
a8c1e932ed6a 16bit literal offsets
claus
parents: 45
diff changeset
   837
		    self appendByte:index.
a8c1e932ed6a 16bit literal offsets
claus
parents: 45
diff changeset
   838
		    level := symbolicCodeArray at:symIndex.
a8c1e932ed6a 16bit literal offsets
claus
parents: 45
diff changeset
   839
		    symIndex := symIndex + 1.
a8c1e932ed6a 16bit literal offsets
claus
parents: 45
diff changeset
   840
		    self appendByte:level
a8c1e932ed6a 16bit literal offsets
claus
parents: 45
diff changeset
   841
		].
a8c1e932ed6a 16bit literal offsets
claus
parents: 45
diff changeset
   842
		(extra == #offsetNvarNarg) ifTrue:[
a8c1e932ed6a 16bit literal offsets
claus
parents: 45
diff changeset
   843
		    relocInfo at:symIndex put:codeIndex.
a8c1e932ed6a 16bit literal offsets
claus
parents: 45
diff changeset
   844
		    self addReloc:symIndex.
a8c1e932ed6a 16bit literal offsets
claus
parents: 45
diff changeset
   845
		    symIndex := symIndex + 1.
a8c1e932ed6a 16bit literal offsets
claus
parents: 45
diff changeset
   846
		    self appendByte:0.
a8c1e932ed6a 16bit literal offsets
claus
parents: 45
diff changeset
   847
		    nvars := symbolicCodeArray at:symIndex.
a8c1e932ed6a 16bit literal offsets
claus
parents: 45
diff changeset
   848
		    symIndex := symIndex + 1.
a8c1e932ed6a 16bit literal offsets
claus
parents: 45
diff changeset
   849
		    self appendByte:nvars.
a8c1e932ed6a 16bit literal offsets
claus
parents: 45
diff changeset
   850
		    level := symbolicCodeArray at:symIndex.
a8c1e932ed6a 16bit literal offsets
claus
parents: 45
diff changeset
   851
		    symIndex := symIndex + 1.
a8c1e932ed6a 16bit literal offsets
claus
parents: 45
diff changeset
   852
		    self appendByte:level
a8c1e932ed6a 16bit literal offsets
claus
parents: 45
diff changeset
   853
		].
a8c1e932ed6a 16bit literal offsets
claus
parents: 45
diff changeset
   854
		(extra == #absoffset) ifTrue:[
a8c1e932ed6a 16bit literal offsets
claus
parents: 45
diff changeset
   855
		    relocInfo at:symIndex put:codeIndex.
a8c1e932ed6a 16bit literal offsets
claus
parents: 45
diff changeset
   856
		    self addReloc:symIndex.
a8c1e932ed6a 16bit literal offsets
claus
parents: 45
diff changeset
   857
		    addr := symbolicCodeArray at:symIndex.
a8c1e932ed6a 16bit literal offsets
claus
parents: 45
diff changeset
   858
		    symIndex := symIndex + 1.
a8c1e932ed6a 16bit literal offsets
claus
parents: 45
diff changeset
   859
		    self appendByte:(addr bitAnd:16rFF).
a8c1e932ed6a 16bit literal offsets
claus
parents: 45
diff changeset
   860
		    self appendByte:((addr bitShift:-8) bitAnd:16rFF).
a8c1e932ed6a 16bit literal offsets
claus
parents: 45
diff changeset
   861
		].
a8c1e932ed6a 16bit literal offsets
claus
parents: 45
diff changeset
   862
		(extra == #absoffsetNvarNarg) ifTrue:[
a8c1e932ed6a 16bit literal offsets
claus
parents: 45
diff changeset
   863
		    relocInfo at:symIndex put:codeIndex.
a8c1e932ed6a 16bit literal offsets
claus
parents: 45
diff changeset
   864
		    self addReloc:symIndex.
a8c1e932ed6a 16bit literal offsets
claus
parents: 45
diff changeset
   865
		    addr := symbolicCodeArray at:symIndex.
a8c1e932ed6a 16bit literal offsets
claus
parents: 45
diff changeset
   866
		    symIndex := symIndex + 1.
a8c1e932ed6a 16bit literal offsets
claus
parents: 45
diff changeset
   867
		    self appendByte:(addr bitAnd:16rFF).
a8c1e932ed6a 16bit literal offsets
claus
parents: 45
diff changeset
   868
		    self appendByte:((addr bitShift:-8) bitAnd:16rFF).
a8c1e932ed6a 16bit literal offsets
claus
parents: 45
diff changeset
   869
		    nvars := symbolicCodeArray at:symIndex.
a8c1e932ed6a 16bit literal offsets
claus
parents: 45
diff changeset
   870
		    symIndex := symIndex + 1.
a8c1e932ed6a 16bit literal offsets
claus
parents: 45
diff changeset
   871
		    self appendByte:nvars.
a8c1e932ed6a 16bit literal offsets
claus
parents: 45
diff changeset
   872
		    level := symbolicCodeArray at:symIndex.
a8c1e932ed6a 16bit literal offsets
claus
parents: 45
diff changeset
   873
		    symIndex := symIndex + 1.
a8c1e932ed6a 16bit literal offsets
claus
parents: 45
diff changeset
   874
		    self appendByte:level
a8c1e932ed6a 16bit literal offsets
claus
parents: 45
diff changeset
   875
		].
a8c1e932ed6a 16bit literal offsets
claus
parents: 45
diff changeset
   876
117
claus
parents: 111
diff changeset
   877
		extra == #special ifTrue:[
claus
parents: 111
diff changeset
   878
		    ((codeSymbol == #send) 
claus
parents: 111
diff changeset
   879
		     or:[codeSymbol == #sendSelf
claus
parents: 111
diff changeset
   880
		     or:[codeSymbol == #superSend
claus
parents: 111
diff changeset
   881
		     or:[codeSymbol == #hereSend]]]) ifTrue:[
106
claus
parents: 105
diff changeset
   882
			index := symbolicCodeArray at:symIndex.
claus
parents: 105
diff changeset
   883
			symIndex := symIndex + 1.
claus
parents: 105
diff changeset
   884
			nargs := symbolicCodeArray at:symIndex.
claus
parents: 105
diff changeset
   885
			symIndex := symIndex + 1.
claus
parents: 105
diff changeset
   886
			self appendByte:nargs.
claus
parents: 105
diff changeset
   887
			self appendByte:index.
117
claus
parents: 111
diff changeset
   888
claus
parents: 111
diff changeset
   889
			(codeSymbol == #superSend
claus
parents: 111
diff changeset
   890
			or:[codeSymbol == #hereSend]) ifTrue:[
claus
parents: 111
diff changeset
   891
			    index := symbolicCodeArray at:symIndex.
claus
parents: 111
diff changeset
   892
			    symIndex := symIndex + 1.
claus
parents: 111
diff changeset
   893
			    self appendByte:index
claus
parents: 111
diff changeset
   894
			].
claus
parents: 111
diff changeset
   895
			stackDelta := nargs negated.
claus
parents: 111
diff changeset
   896
			codeSymbol == #sendSelf ifTrue:[
claus
parents: 111
diff changeset
   897
			    stackDelta := stackDelta + 1
claus
parents: 111
diff changeset
   898
			]
106
claus
parents: 105
diff changeset
   899
		    ] ifFalse:[
117
claus
parents: 111
diff changeset
   900
			(codeSymbol == #sendDrop) ifTrue:[
106
claus
parents: 105
diff changeset
   901
			    index := symbolicCodeArray at:symIndex.
117
claus
parents: 111
diff changeset
   902
			    symIndex := symIndex + 1.
106
claus
parents: 105
diff changeset
   903
			    nargs := symbolicCodeArray at:symIndex.
claus
parents: 105
diff changeset
   904
			    symIndex := symIndex + 1.
claus
parents: 105
diff changeset
   905
			    self appendByte:nargs.
117
claus
parents: 111
diff changeset
   906
			    self appendByte:index.
106
claus
parents: 105
diff changeset
   907
			    stackDelta := (nargs + 1) negated
117
claus
parents: 111
diff changeset
   908
			]
claus
parents: 111
diff changeset
   909
		    ]
claus
parents: 111
diff changeset
   910
		].
claus
parents: 111
diff changeset
   911
claus
parents: 111
diff changeset
   912
		extra == #specialL ifTrue:[
claus
parents: 111
diff changeset
   913
		    ((codeSymbol == #sendL) 
claus
parents: 111
diff changeset
   914
		     or:[codeSymbol == #sendSelfL
claus
parents: 111
diff changeset
   915
		     or:[codeSymbol == #superSendL
claus
parents: 111
diff changeset
   916
		     or:[codeSymbol == #hereSendL]]]) ifTrue:[
claus
parents: 111
diff changeset
   917
			index := symbolicCodeArray at:symIndex.
claus
parents: 111
diff changeset
   918
			symIndex := symIndex + 2.
claus
parents: 111
diff changeset
   919
			nargs := symbolicCodeArray at:symIndex.
claus
parents: 111
diff changeset
   920
			symIndex := symIndex + 1.
claus
parents: 111
diff changeset
   921
			self appendByte:nargs.
claus
parents: 111
diff changeset
   922
			self appendWord:index.
claus
parents: 111
diff changeset
   923
			(codeSymbol == #superSendL
claus
parents: 111
diff changeset
   924
			or:[codeSymbol == #hereSendL]) ifTrue:[
claus
parents: 111
diff changeset
   925
			    index := symbolicCodeArray at:symIndex.
claus
parents: 111
diff changeset
   926
			    symIndex := symIndex + 2.
claus
parents: 111
diff changeset
   927
			    self appendWord:index.
claus
parents: 111
diff changeset
   928
			].
claus
parents: 111
diff changeset
   929
			stackDelta := nargs negated.
claus
parents: 111
diff changeset
   930
			codeSymbol == #sendSelfL ifTrue:[
claus
parents: 111
diff changeset
   931
			    stackDelta := stackDelta + 1
106
claus
parents: 105
diff changeset
   932
			]
claus
parents: 105
diff changeset
   933
		    ]
claus
parents: 105
diff changeset
   934
		].
45
e8331ba8ad5d *** empty log message ***
claus
parents: 39
diff changeset
   935
	    ].
117
claus
parents: 111
diff changeset
   936
45
e8331ba8ad5d *** empty log message ***
claus
parents: 39
diff changeset
   937
	    stackDepth := stackDepth + stackDelta.
e8331ba8ad5d *** empty log message ***
claus
parents: 39
diff changeset
   938
	    (stackDepth > maxStackDepth) ifTrue:[
e8331ba8ad5d *** empty log message ***
claus
parents: 39
diff changeset
   939
		maxStackDepth := stackDepth
e8331ba8ad5d *** empty log message ***
claus
parents: 39
diff changeset
   940
	    ]
e8331ba8ad5d *** empty log message ***
claus
parents: 39
diff changeset
   941
	].
e8331ba8ad5d *** empty log message ***
claus
parents: 39
diff changeset
   942
	relocInfo at:symIndex put:codeIndex.
0
7ad01559b262 Initial revision
claus
parents:
diff changeset
   943
45
e8331ba8ad5d *** empty log message ***
claus
parents: 39
diff changeset
   944
	needRetry ifFalse:[
e8331ba8ad5d *** empty log message ***
claus
parents: 39
diff changeset
   945
	    "
e8331ba8ad5d *** empty log message ***
claus
parents: 39
diff changeset
   946
	     now relocate - returns true if ok, false if we have to do it again
e8331ba8ad5d *** empty log message ***
claus
parents: 39
diff changeset
   947
	     (when short jumps have been changed to long jumps)
e8331ba8ad5d *** empty log message ***
claus
parents: 39
diff changeset
   948
	    "
e8331ba8ad5d *** empty log message ***
claus
parents: 39
diff changeset
   949
	    relocList notNil ifTrue:[
e8331ba8ad5d *** empty log message ***
claus
parents: 39
diff changeset
   950
		needRetry := (self relocateWith:symbolicCodeArray relocInfo:relocInfo) not.
e8331ba8ad5d *** empty log message ***
claus
parents: 39
diff changeset
   951
		"
e8331ba8ad5d *** empty log message ***
claus
parents: 39
diff changeset
   952
		 if returned with false, a relative jump was made into
e8331ba8ad5d *** empty log message ***
claus
parents: 39
diff changeset
   953
		 an absolute jump - need to start over with one more byte space
e8331ba8ad5d *** empty log message ***
claus
parents: 39
diff changeset
   954
		"
e8331ba8ad5d *** empty log message ***
claus
parents: 39
diff changeset
   955
		needRetry ifTrue:[
e8331ba8ad5d *** empty log message ***
claus
parents: 39
diff changeset
   956
		    relocList := nil.
e8331ba8ad5d *** empty log message ***
claus
parents: 39
diff changeset
   957
		    codeSize := codeSize + 1.
e8331ba8ad5d *** empty log message ***
claus
parents: 39
diff changeset
   958
		]
e8331ba8ad5d *** empty log message ***
claus
parents: 39
diff changeset
   959
	    ]
46
a8c1e932ed6a 16bit literal offsets
claus
parents: 45
diff changeset
   960
	] ifTrue:[
95
claus
parents: 94
diff changeset
   961
	    'compiling again ...' infoPrintNL.
46
a8c1e932ed6a 16bit literal offsets
claus
parents: 45
diff changeset
   962
	]
0
7ad01559b262 Initial revision
claus
parents:
diff changeset
   963
    ].
49
02660b790c3e *** empty log message ***
claus
parents: 46
diff changeset
   964
    "code printNL."
0
7ad01559b262 Initial revision
claus
parents:
diff changeset
   965
    ^ errorFlag
117
claus
parents: 111
diff changeset
   966
claus
parents: 111
diff changeset
   967
    "Modified: 3.9.1995 / 12:59:43 / claus"
0
7ad01559b262 Initial revision
claus
parents:
diff changeset
   968
!
7ad01559b262 Initial revision
claus
parents:
diff changeset
   969
1
77da9f5728e5 *** empty log message ***
claus
parents: 0
diff changeset
   970
absJumpFromJump:code
3
b63b8a6b71fb *** empty log message ***
claus
parents: 1
diff changeset
   971
    "given a jump-symbolic code, return corresponding absolute jump"
b63b8a6b71fb *** empty log message ***
claus
parents: 1
diff changeset
   972
1
77da9f5728e5 *** empty log message ***
claus
parents: 0
diff changeset
   973
    JumpToAbsJump isNil ifTrue:[
45
e8331ba8ad5d *** empty log message ***
claus
parents: 39
diff changeset
   974
	JumpToAbsJump := IdentityDictionary new.
e8331ba8ad5d *** empty log message ***
claus
parents: 39
diff changeset
   975
	JumpToAbsJump at:#jump put:#jumpabs.
e8331ba8ad5d *** empty log message ***
claus
parents: 39
diff changeset
   976
	JumpToAbsJump at:#trueJump put:#trueJumpabs.
e8331ba8ad5d *** empty log message ***
claus
parents: 39
diff changeset
   977
	JumpToAbsJump at:#falseJump put:#falseJumpabs.
e8331ba8ad5d *** empty log message ***
claus
parents: 39
diff changeset
   978
	JumpToAbsJump at:#nilJump put:#nilJumpabs.
e8331ba8ad5d *** empty log message ***
claus
parents: 39
diff changeset
   979
	JumpToAbsJump at:#notNilJump put:#notNilJumpabs.
e8331ba8ad5d *** empty log message ***
claus
parents: 39
diff changeset
   980
	JumpToAbsJump at:#eqJump put:#eqJumpabs.
e8331ba8ad5d *** empty log message ***
claus
parents: 39
diff changeset
   981
	JumpToAbsJump at:#notEqJump put:#notEqJumpabs.
e8331ba8ad5d *** empty log message ***
claus
parents: 39
diff changeset
   982
	JumpToAbsJump at:#zeroJump put:#zeroJumpabs.
e8331ba8ad5d *** empty log message ***
claus
parents: 39
diff changeset
   983
	JumpToAbsJump at:#notZeroJump put:#notZeroJumpabs.
e8331ba8ad5d *** empty log message ***
claus
parents: 39
diff changeset
   984
	JumpToAbsJump at:#makeBlock put:#makeBlockabs.
1
77da9f5728e5 *** empty log message ***
claus
parents: 0
diff changeset
   985
    ].
77da9f5728e5 *** empty log message ***
claus
parents: 0
diff changeset
   986
    ^ JumpToAbsJump at:code
77da9f5728e5 *** empty log message ***
claus
parents: 0
diff changeset
   987
!
77da9f5728e5 *** empty log message ***
claus
parents: 0
diff changeset
   988
0
7ad01559b262 Initial revision
claus
parents:
diff changeset
   989
relocateWith:symbolicCodeArray relocInfo:relocInfo
7ad01559b262 Initial revision
claus
parents:
diff changeset
   990
    "helper for genByteCodeFrom - relocate code using relocInfo.
7ad01559b262 Initial revision
claus
parents:
diff changeset
   991
     if relocation fails badly (due to long relative jumps) patch
7ad01559b262 Initial revision
claus
parents:
diff changeset
   992
     symbolicCode to use absolute jumps instead and return false
3
b63b8a6b71fb *** empty log message ***
claus
parents: 1
diff changeset
   993
     (genByteCodeFrom will then try again). Otherwise return true.
b63b8a6b71fb *** empty log message ***
claus
parents: 1
diff changeset
   994
     Also, on the fly, jumps to jumps and jumps to return are handled."
0
7ad01559b262 Initial revision
claus
parents:
diff changeset
   995
49
02660b790c3e *** empty log message ***
claus
parents: 46
diff changeset
   996
    |delta       "{Class: SmallInteger }"
02660b790c3e *** empty log message ***
claus
parents: 46
diff changeset
   997
     codePos     "{Class: SmallInteger }"
02660b790c3e *** empty log message ***
claus
parents: 46
diff changeset
   998
     opCodePos   "{Class: SmallInteger }"
02660b790c3e *** empty log message ***
claus
parents: 46
diff changeset
   999
     codeOffset  "{Class: SmallInteger }"
02660b790c3e *** empty log message ***
claus
parents: 46
diff changeset
  1000
     symOffset 
02660b790c3e *** empty log message ***
claus
parents: 46
diff changeset
  1001
     opcode      "{Class: SmallInteger }"
02660b790c3e *** empty log message ***
claus
parents: 46
diff changeset
  1002
     dstOpcode jumpTarget
3
b63b8a6b71fb *** empty log message ***
claus
parents: 1
diff changeset
  1003
     jumpCode deleteSet|
0
7ad01559b262 Initial revision
claus
parents:
diff changeset
  1004
3
b63b8a6b71fb *** empty log message ***
claus
parents: 1
diff changeset
  1005
    deleteSet := OrderedCollection new.
0
7ad01559b262 Initial revision
claus
parents:
diff changeset
  1006
    relocList do:[:sIndex |
45
e8331ba8ad5d *** empty log message ***
claus
parents: 39
diff changeset
  1007
	"have to relocate symCode at sIndex ..." 
e8331ba8ad5d *** empty log message ***
claus
parents: 39
diff changeset
  1008
	symOffset := symbolicCodeArray at:sIndex.   "the target in the symbolic code"
e8331ba8ad5d *** empty log message ***
claus
parents: 39
diff changeset
  1009
	codePos := relocInfo at:sIndex.             "position of the offet in byte code"
e8331ba8ad5d *** empty log message ***
claus
parents: 39
diff changeset
  1010
	codeOffset := relocInfo at:symOffset.       "position of the target in byte code"
e8331ba8ad5d *** empty log message ***
claus
parents: 39
diff changeset
  1011
	delta := codeOffset - codePos - 1.
e8331ba8ad5d *** empty log message ***
claus
parents: 39
diff changeset
  1012
	opCodePos := codePos - 1.
49
02660b790c3e *** empty log message ***
claus
parents: 46
diff changeset
  1013
	opcode := codeBytes at:opCodePos.
1
77da9f5728e5 *** empty log message ***
claus
parents: 0
diff changeset
  1014
45
e8331ba8ad5d *** empty log message ***
claus
parents: 39
diff changeset
  1015
	(opcode between:190 and:199) ifTrue:[
e8331ba8ad5d *** empty log message ***
claus
parents: 39
diff changeset
  1016
	    "an absolute jump/makeBlock"
0
7ad01559b262 Initial revision
claus
parents:
diff changeset
  1017
49
02660b790c3e *** empty log message ***
claus
parents: 46
diff changeset
  1018
	    codeBytes at:codePos put:(codeOffset bitAnd:16rFF).
02660b790c3e *** empty log message ***
claus
parents: 46
diff changeset
  1019
	    codeBytes at:(codePos + 1) put:(codeOffset bitShift:-8)
45
e8331ba8ad5d *** empty log message ***
claus
parents: 39
diff changeset
  1020
	] ifFalse:[
e8331ba8ad5d *** empty log message ***
claus
parents: 39
diff changeset
  1021
	    "get jump-code from long and vlong codes"
e8331ba8ad5d *** empty log message ***
claus
parents: 39
diff changeset
  1022
	    (opcode between:50 and:59) ifFalse:[
e8331ba8ad5d *** empty log message ***
claus
parents: 39
diff changeset
  1023
		(opcode between:60 and:69) ifTrue:[
e8331ba8ad5d *** empty log message ***
claus
parents: 39
diff changeset
  1024
		    opcode := opcode - 10
e8331ba8ad5d *** empty log message ***
claus
parents: 39
diff changeset
  1025
		] ifFalse:[
e8331ba8ad5d *** empty log message ***
claus
parents: 39
diff changeset
  1026
		    (opcode between:70 and:79) ifTrue:[
e8331ba8ad5d *** empty log message ***
claus
parents: 39
diff changeset
  1027
			opcode := opcode - 20
e8331ba8ad5d *** empty log message ***
claus
parents: 39
diff changeset
  1028
		    ] ifFalse:[
e8331ba8ad5d *** empty log message ***
claus
parents: 39
diff changeset
  1029
			self error:'invalid code to relocate'
e8331ba8ad5d *** empty log message ***
claus
parents: 39
diff changeset
  1030
		    ]
e8331ba8ad5d *** empty log message ***
claus
parents: 39
diff changeset
  1031
		].
e8331ba8ad5d *** empty log message ***
claus
parents: 39
diff changeset
  1032
	    ].
1
77da9f5728e5 *** empty log message ***
claus
parents: 0
diff changeset
  1033
45
e8331ba8ad5d *** empty log message ***
claus
parents: 39
diff changeset
  1034
	    "optimize jump to return and jump to jump"
1
77da9f5728e5 *** empty log message ***
claus
parents: 0
diff changeset
  1035
45
e8331ba8ad5d *** empty log message ***
claus
parents: 39
diff changeset
  1036
	    (opcode == 54) ifTrue:[
e8331ba8ad5d *** empty log message ***
claus
parents: 39
diff changeset
  1037
		"a jump"
e8331ba8ad5d *** empty log message ***
claus
parents: 39
diff changeset
  1038
		dstOpcode := symbolicCodeArray at:symOffset.
3
b63b8a6b71fb *** empty log message ***
claus
parents: 1
diff changeset
  1039
45
e8331ba8ad5d *** empty log message ***
claus
parents: 39
diff changeset
  1040
		(#(retSelf retTop retNil retTrue retFalse ret0 "blockRetTop") includes:dstOpcode) ifTrue:[
e8331ba8ad5d *** empty log message ***
claus
parents: 39
diff changeset
  1041
		    "a jump to a return - put in the return instead jump"
3
b63b8a6b71fb *** empty log message ***
claus
parents: 1
diff changeset
  1042
45
e8331ba8ad5d *** empty log message ***
claus
parents: 39
diff changeset
  1043
		    symbolicCodeArray at:(sIndex - 1) put:dstOpcode.
e8331ba8ad5d *** empty log message ***
claus
parents: 39
diff changeset
  1044
		    symbolicCodeArray at:sIndex put:dstOpcode.
49
02660b790c3e *** empty log message ***
claus
parents: 46
diff changeset
  1045
		    codeBytes at:opCodePos put:(self byteCodeFor:dstOpcode).
45
e8331ba8ad5d *** empty log message ***
claus
parents: 39
diff changeset
  1046
		    delta := 0.
e8331ba8ad5d *** empty log message ***
claus
parents: 39
diff changeset
  1047
		    deleteSet add:sIndex.
3
b63b8a6b71fb *** empty log message ***
claus
parents: 1
diff changeset
  1048
b63b8a6b71fb *** empty log message ***
claus
parents: 1
diff changeset
  1049
" 
49
02660b790c3e *** empty log message ***
claus
parents: 46
diff changeset
  1050
'jump to return at: ' print. (sIndex - 1) printNL.
3
b63b8a6b71fb *** empty log message ***
claus
parents: 1
diff changeset
  1051
" 
45
e8331ba8ad5d *** empty log message ***
claus
parents: 39
diff changeset
  1052
		] ifFalse:[
e8331ba8ad5d *** empty log message ***
claus
parents: 39
diff changeset
  1053
		    (dstOpcode == #jump) ifTrue:[
e8331ba8ad5d *** empty log message ***
claus
parents: 39
diff changeset
  1054
			"jump to jump to be done soon"
e8331ba8ad5d *** empty log message ***
claus
parents: 39
diff changeset
  1055
			jumpTarget := symbolicCodeArray at:(symOffset + 1).
3
b63b8a6b71fb *** empty log message ***
claus
parents: 1
diff changeset
  1056
" 
b63b8a6b71fb *** empty log message ***
claus
parents: 1
diff changeset
  1057
'jump to jump at: ' print. (sIndex - 1) print.
49
02660b790c3e *** empty log message ***
claus
parents: 46
diff changeset
  1058
'  newTarget:' print. jumpTarget printNL.
3
b63b8a6b71fb *** empty log message ***
claus
parents: 1
diff changeset
  1059
" 
b63b8a6b71fb *** empty log message ***
claus
parents: 1
diff changeset
  1060
45
e8331ba8ad5d *** empty log message ***
claus
parents: 39
diff changeset
  1061
			symbolicCodeArray at:sIndex put:jumpTarget.
e8331ba8ad5d *** empty log message ***
claus
parents: 39
diff changeset
  1062
			symOffset := jumpTarget.
e8331ba8ad5d *** empty log message ***
claus
parents: 39
diff changeset
  1063
			codeOffset := relocInfo at:symOffset.
e8331ba8ad5d *** empty log message ***
claus
parents: 39
diff changeset
  1064
			delta := codeOffset - codePos - 1.
3
b63b8a6b71fb *** empty log message ***
claus
parents: 1
diff changeset
  1065
45
e8331ba8ad5d *** empty log message ***
claus
parents: 39
diff changeset
  1066
			"continue with new delta"
e8331ba8ad5d *** empty log message ***
claus
parents: 39
diff changeset
  1067
		    ]
e8331ba8ad5d *** empty log message ***
claus
parents: 39
diff changeset
  1068
		]
e8331ba8ad5d *** empty log message ***
claus
parents: 39
diff changeset
  1069
	    ].
e8331ba8ad5d *** empty log message ***
claus
parents: 39
diff changeset
  1070
	    (#(50 51 52 53 56 57 58 59) includes:opcode) ifTrue:[
e8331ba8ad5d *** empty log message ***
claus
parents: 39
diff changeset
  1071
		"a conditional jump"
3
b63b8a6b71fb *** empty log message ***
claus
parents: 1
diff changeset
  1072
45
e8331ba8ad5d *** empty log message ***
claus
parents: 39
diff changeset
  1073
		dstOpcode := symbolicCodeArray at:symOffset.
e8331ba8ad5d *** empty log message ***
claus
parents: 39
diff changeset
  1074
		(dstOpcode == #jump) ifTrue:[
e8331ba8ad5d *** empty log message ***
claus
parents: 39
diff changeset
  1075
		    "conditional jump to unconditional jump"
e8331ba8ad5d *** empty log message ***
claus
parents: 39
diff changeset
  1076
		    jumpTarget := symbolicCodeArray at:(symOffset + 1).
3
b63b8a6b71fb *** empty log message ***
claus
parents: 1
diff changeset
  1077
" 
b63b8a6b71fb *** empty log message ***
claus
parents: 1
diff changeset
  1078
'cond jump to jump at: ' print. (sIndex - 1) print.
49
02660b790c3e *** empty log message ***
claus
parents: 46
diff changeset
  1079
'  newTarget:' print. jumpTarget printNL.
3
b63b8a6b71fb *** empty log message ***
claus
parents: 1
diff changeset
  1080
" 
b63b8a6b71fb *** empty log message ***
claus
parents: 1
diff changeset
  1081
45
e8331ba8ad5d *** empty log message ***
claus
parents: 39
diff changeset
  1082
		    symbolicCodeArray at:sIndex put:jumpTarget.
e8331ba8ad5d *** empty log message ***
claus
parents: 39
diff changeset
  1083
		    symOffset := jumpTarget.
e8331ba8ad5d *** empty log message ***
claus
parents: 39
diff changeset
  1084
		    codeOffset := relocInfo at:symOffset.
e8331ba8ad5d *** empty log message ***
claus
parents: 39
diff changeset
  1085
		    delta := codeOffset - codePos - 1.
3
b63b8a6b71fb *** empty log message ***
claus
parents: 1
diff changeset
  1086
45
e8331ba8ad5d *** empty log message ***
claus
parents: 39
diff changeset
  1087
		    "continue with new delta"
e8331ba8ad5d *** empty log message ***
claus
parents: 39
diff changeset
  1088
		].
e8331ba8ad5d *** empty log message ***
claus
parents: 39
diff changeset
  1089
	    ].
3
b63b8a6b71fb *** empty log message ***
claus
parents: 1
diff changeset
  1090
45
e8331ba8ad5d *** empty log message ***
claus
parents: 39
diff changeset
  1091
	    (delta >= 0) ifTrue:[
e8331ba8ad5d *** empty log message ***
claus
parents: 39
diff changeset
  1092
		(delta > 127) ifTrue:[
e8331ba8ad5d *** empty log message ***
claus
parents: 39
diff changeset
  1093
		    (opcode between:50 and:59) ifFalse:[
e8331ba8ad5d *** empty log message ***
claus
parents: 39
diff changeset
  1094
			self error:'invalid code to relocate'
49
02660b790c3e *** empty log message ***
claus
parents: 46
diff changeset
  1095
		    ] ifTrue:[
02660b790c3e *** empty log message ***
claus
parents: 46
diff changeset
  1096
			(delta > 255) ifTrue:[
02660b790c3e *** empty log message ***
claus
parents: 46
diff changeset
  1097
			    "change jmp into vljmp ..."
02660b790c3e *** empty log message ***
claus
parents: 46
diff changeset
  1098
			    codeBytes at:opCodePos put:(opcode + 20).
02660b790c3e *** empty log message ***
claus
parents: 46
diff changeset
  1099
			    delta := delta - 256 
02660b790c3e *** empty log message ***
claus
parents: 46
diff changeset
  1100
			] ifFalse:[
02660b790c3e *** empty log message ***
claus
parents: 46
diff changeset
  1101
			    "change jmp into ljmp ..."
02660b790c3e *** empty log message ***
claus
parents: 46
diff changeset
  1102
			    codeBytes at:opCodePos put:(opcode + 10).
02660b790c3e *** empty log message ***
claus
parents: 46
diff changeset
  1103
			    delta := delta - 128
02660b790c3e *** empty log message ***
claus
parents: 46
diff changeset
  1104
			].
02660b790c3e *** empty log message ***
claus
parents: 46
diff changeset
  1105
			(delta > 127) ifTrue:[
02660b790c3e *** empty log message ***
claus
parents: 46
diff changeset
  1106
			    "change symbolic into a jump absolute and fail"
02660b790c3e *** empty log message ***
claus
parents: 46
diff changeset
  1107
			    jumpCode := symbolicCodeArray at:(sIndex - 1).
02660b790c3e *** empty log message ***
claus
parents: 46
diff changeset
  1108
			    symbolicCodeArray at:(sIndex - 1) put:(self absJumpFromJump:jumpCode).
02660b790c3e *** empty log message ***
claus
parents: 46
diff changeset
  1109
			    symbolicCodeArray at:sIndex put:symOffset.
3
b63b8a6b71fb *** empty log message ***
claus
parents: 1
diff changeset
  1110
"
49
02660b790c3e *** empty log message ***
claus
parents: 46
diff changeset
  1111
'change short into abs jump' printNL.
3
b63b8a6b71fb *** empty log message ***
claus
parents: 1
diff changeset
  1112
"
49
02660b790c3e *** empty log message ***
claus
parents: 46
diff changeset
  1113
			    deleteSet do:[:d | relocList remove:d].
02660b790c3e *** empty log message ***
claus
parents: 46
diff changeset
  1114
			    ^ false
02660b790c3e *** empty log message ***
claus
parents: 46
diff changeset
  1115
			]
45
e8331ba8ad5d *** empty log message ***
claus
parents: 39
diff changeset
  1116
		    ].
e8331ba8ad5d *** empty log message ***
claus
parents: 39
diff changeset
  1117
		].
49
02660b790c3e *** empty log message ***
claus
parents: 46
diff changeset
  1118
		codeBytes at:codePos put:delta
45
e8331ba8ad5d *** empty log message ***
claus
parents: 39
diff changeset
  1119
	    ] ifFalse:[
e8331ba8ad5d *** empty log message ***
claus
parents: 39
diff changeset
  1120
		(delta < -128) ifTrue:[
e8331ba8ad5d *** empty log message ***
claus
parents: 39
diff changeset
  1121
		    (opcode between:50 and:59) ifFalse:[
e8331ba8ad5d *** empty log message ***
claus
parents: 39
diff changeset
  1122
			self error:'invalid code to relocate'
49
02660b790c3e *** empty log message ***
claus
parents: 46
diff changeset
  1123
		    ] ifTrue:[
02660b790c3e *** empty log message ***
claus
parents: 46
diff changeset
  1124
			(delta < -256) ifTrue:[
02660b790c3e *** empty log message ***
claus
parents: 46
diff changeset
  1125
			    "change jmp into vljmp ..."
02660b790c3e *** empty log message ***
claus
parents: 46
diff changeset
  1126
			    codeBytes at:opCodePos put:(opcode + 20).
02660b790c3e *** empty log message ***
claus
parents: 46
diff changeset
  1127
			    delta := delta + 256
02660b790c3e *** empty log message ***
claus
parents: 46
diff changeset
  1128
			] ifFalse:[
02660b790c3e *** empty log message ***
claus
parents: 46
diff changeset
  1129
			    "change jmp into ljmp ..."
02660b790c3e *** empty log message ***
claus
parents: 46
diff changeset
  1130
			    codeBytes at:opCodePos put:(opcode + 10).
02660b790c3e *** empty log message ***
claus
parents: 46
diff changeset
  1131
			    delta := delta + 128
02660b790c3e *** empty log message ***
claus
parents: 46
diff changeset
  1132
			].
02660b790c3e *** empty log message ***
claus
parents: 46
diff changeset
  1133
			(delta < -128) ifTrue:[
02660b790c3e *** empty log message ***
claus
parents: 46
diff changeset
  1134
			    "change symbolic into a jump absolute and fail"
02660b790c3e *** empty log message ***
claus
parents: 46
diff changeset
  1135
			    jumpCode := symbolicCodeArray at:(sIndex - 1).
02660b790c3e *** empty log message ***
claus
parents: 46
diff changeset
  1136
			    symbolicCodeArray at:(sIndex - 1) put:(self absJumpFromJump:jumpCode).
02660b790c3e *** empty log message ***
claus
parents: 46
diff changeset
  1137
			    symbolicCodeArray at:sIndex put:symOffset.
3
b63b8a6b71fb *** empty log message ***
claus
parents: 1
diff changeset
  1138
"
49
02660b790c3e *** empty log message ***
claus
parents: 46
diff changeset
  1139
'change short into abs jump' printNL.
3
b63b8a6b71fb *** empty log message ***
claus
parents: 1
diff changeset
  1140
"
49
02660b790c3e *** empty log message ***
claus
parents: 46
diff changeset
  1141
			    deleteSet do:[:d | relocList remove:d].
02660b790c3e *** empty log message ***
claus
parents: 46
diff changeset
  1142
			    ^ false
02660b790c3e *** empty log message ***
claus
parents: 46
diff changeset
  1143
			]
45
e8331ba8ad5d *** empty log message ***
claus
parents: 39
diff changeset
  1144
		    ]
e8331ba8ad5d *** empty log message ***
claus
parents: 39
diff changeset
  1145
		].
49
02660b790c3e *** empty log message ***
claus
parents: 46
diff changeset
  1146
		codeBytes at:codePos put:(256 + delta)
45
e8331ba8ad5d *** empty log message ***
claus
parents: 39
diff changeset
  1147
	    ]
e8331ba8ad5d *** empty log message ***
claus
parents: 39
diff changeset
  1148
	]
0
7ad01559b262 Initial revision
claus
parents:
diff changeset
  1149
    ].
7ad01559b262 Initial revision
claus
parents:
diff changeset
  1150
    (errorFlag == #Error) ifTrue:[
45
e8331ba8ad5d *** empty log message ***
claus
parents: 39
diff changeset
  1151
	self error:'relocation range error'
0
7ad01559b262 Initial revision
claus
parents:
diff changeset
  1152
    ].
7ad01559b262 Initial revision
claus
parents:
diff changeset
  1153
    ^ true
7ad01559b262 Initial revision
claus
parents:
diff changeset
  1154
!
7ad01559b262 Initial revision
claus
parents:
diff changeset
  1155
7ad01559b262 Initial revision
claus
parents:
diff changeset
  1156
addLiteral:anObject
7ad01559b262 Initial revision
claus
parents:
diff changeset
  1157
    "add a literal to the literalArray - watch for and eliminate
7ad01559b262 Initial revision
claus
parents:
diff changeset
  1158
     duplicates. return the index of the literal in the Array"
7ad01559b262 Initial revision
claus
parents:
diff changeset
  1159
3
b63b8a6b71fb *** empty log message ***
claus
parents: 1
diff changeset
  1160
    |index class|
0
7ad01559b262 Initial revision
claus
parents:
diff changeset
  1161
7ad01559b262 Initial revision
claus
parents:
diff changeset
  1162
    litArray isNil ifTrue:[
45
e8331ba8ad5d *** empty log message ***
claus
parents: 39
diff changeset
  1163
	litArray := Array with:anObject.
e8331ba8ad5d *** empty log message ***
claus
parents: 39
diff changeset
  1164
	^ 1
0
7ad01559b262 Initial revision
claus
parents:
diff changeset
  1165
    ].
7ad01559b262 Initial revision
claus
parents:
diff changeset
  1166
    index := litArray identityIndexOf:anObject.
7ad01559b262 Initial revision
claus
parents:
diff changeset
  1167
    (index == 0) ifTrue:[
45
e8331ba8ad5d *** empty log message ***
claus
parents: 39
diff changeset
  1168
	"
e8331ba8ad5d *** empty log message ***
claus
parents: 39
diff changeset
  1169
	 reuse constants if same value and same class
e8331ba8ad5d *** empty log message ***
claus
parents: 39
diff changeset
  1170
	"
e8331ba8ad5d *** empty log message ***
claus
parents: 39
diff changeset
  1171
	class := anObject class.
e8331ba8ad5d *** empty log message ***
claus
parents: 39
diff changeset
  1172
	((class == Float) 
e8331ba8ad5d *** empty log message ***
claus
parents: 39
diff changeset
  1173
	or:[class == Fraction]) ifTrue:[
e8331ba8ad5d *** empty log message ***
claus
parents: 39
diff changeset
  1174
	    index := litArray indexOf:anObject.
e8331ba8ad5d *** empty log message ***
claus
parents: 39
diff changeset
  1175
	].
e8331ba8ad5d *** empty log message ***
claus
parents: 39
diff changeset
  1176
	((index == 0) or:[(litArray at:index) class ~~ class]) ifTrue:[
e8331ba8ad5d *** empty log message ***
claus
parents: 39
diff changeset
  1177
	    litArray := litArray copyWith:anObject.
e8331ba8ad5d *** empty log message ***
claus
parents: 39
diff changeset
  1178
	    ^ litArray size
e8331ba8ad5d *** empty log message ***
claus
parents: 39
diff changeset
  1179
	].
0
7ad01559b262 Initial revision
claus
parents:
diff changeset
  1180
    ].
7ad01559b262 Initial revision
claus
parents:
diff changeset
  1181
    ^ index
7ad01559b262 Initial revision
claus
parents:
diff changeset
  1182
!
7ad01559b262 Initial revision
claus
parents:
diff changeset
  1183
7ad01559b262 Initial revision
claus
parents:
diff changeset
  1184
appendByteCodeFor:codeSymbol
7ad01559b262 Initial revision
claus
parents:
diff changeset
  1185
    "append the byteCode for an instructionSymbol to the code-Array"
7ad01559b262 Initial revision
claus
parents:
diff changeset
  1186
49
02660b790c3e *** empty log message ***
claus
parents: 46
diff changeset
  1187
    |idx "{Class: SmallInteger }"|
02660b790c3e *** empty log message ***
claus
parents: 46
diff changeset
  1188
02660b790c3e *** empty log message ***
claus
parents: 46
diff changeset
  1189
    idx := codeIndex.
02660b790c3e *** empty log message ***
claus
parents: 46
diff changeset
  1190
    codeBytes at:idx put:(self byteCodeFor:codeSymbol).
02660b790c3e *** empty log message ***
claus
parents: 46
diff changeset
  1191
    codeIndex := idx + 1
0
7ad01559b262 Initial revision
claus
parents:
diff changeset
  1192
!
7ad01559b262 Initial revision
claus
parents:
diff changeset
  1193
7ad01559b262 Initial revision
claus
parents:
diff changeset
  1194
appendByte:aByte
7ad01559b262 Initial revision
claus
parents:
diff changeset
  1195
    "append a byte to the code-Array, checking for byte-range (debug-only)"
7ad01559b262 Initial revision
claus
parents:
diff changeset
  1196
49
02660b790c3e *** empty log message ***
claus
parents: 46
diff changeset
  1197
    |idx "{Class: SmallInteger }"|
02660b790c3e *** empty log message ***
claus
parents: 46
diff changeset
  1198
02660b790c3e *** empty log message ***
claus
parents: 46
diff changeset
  1199
    idx := codeIndex.
0
7ad01559b262 Initial revision
claus
parents:
diff changeset
  1200
    (aByte between:0 and:255) ifTrue:[
49
02660b790c3e *** empty log message ***
claus
parents: 46
diff changeset
  1201
	codeBytes at:idx put:aByte.
02660b790c3e *** empty log message ***
claus
parents: 46
diff changeset
  1202
	codeIndex := idx + 1
0
7ad01559b262 Initial revision
claus
parents:
diff changeset
  1203
    ] ifFalse:[
45
e8331ba8ad5d *** empty log message ***
claus
parents: 39
diff changeset
  1204
	self error:'byte range error'.
e8331ba8ad5d *** empty log message ***
claus
parents: 39
diff changeset
  1205
	errorFlag := #Error
0
7ad01559b262 Initial revision
claus
parents:
diff changeset
  1206
    ]
7ad01559b262 Initial revision
claus
parents:
diff changeset
  1207
!
7ad01559b262 Initial revision
claus
parents:
diff changeset
  1208
105
claus
parents: 104
diff changeset
  1209
appendEmptyByte
45
e8331ba8ad5d *** empty log message ***
claus
parents: 39
diff changeset
  1210
    "append an empty byte to the code-Array"
e8331ba8ad5d *** empty log message ***
claus
parents: 39
diff changeset
  1211
49
02660b790c3e *** empty log message ***
claus
parents: 46
diff changeset
  1212
    |idx "{Class: SmallInteger }"|
02660b790c3e *** empty log message ***
claus
parents: 46
diff changeset
  1213
02660b790c3e *** empty log message ***
claus
parents: 46
diff changeset
  1214
    idx := codeIndex.
02660b790c3e *** empty log message ***
claus
parents: 46
diff changeset
  1215
    codeBytes at:idx put:0.
02660b790c3e *** empty log message ***
claus
parents: 46
diff changeset
  1216
    codeIndex := idx + 1
45
e8331ba8ad5d *** empty log message ***
claus
parents: 39
diff changeset
  1217
!
e8331ba8ad5d *** empty log message ***
claus
parents: 39
diff changeset
  1218
0
7ad01559b262 Initial revision
claus
parents:
diff changeset
  1219
appendSignedByte:aByte
7ad01559b262 Initial revision
claus
parents:
diff changeset
  1220
    "append a signedbyte (as in jump-offsets) to the code-Array,
7ad01559b262 Initial revision
claus
parents:
diff changeset
  1221
     check range and report an error if invalid"
7ad01559b262 Initial revision
claus
parents:
diff changeset
  1222
49
02660b790c3e *** empty log message ***
claus
parents: 46
diff changeset
  1223
    |b   "{Class: SmallInteger }" 
02660b790c3e *** empty log message ***
claus
parents: 46
diff changeset
  1224
     idx "{Class: SmallInteger }"|
0
7ad01559b262 Initial revision
claus
parents:
diff changeset
  1225
49
02660b790c3e *** empty log message ***
claus
parents: 46
diff changeset
  1226
    idx := codeIndex.
0
7ad01559b262 Initial revision
claus
parents:
diff changeset
  1227
    b := aByte.
7ad01559b262 Initial revision
claus
parents:
diff changeset
  1228
    (b >= 0) ifTrue:[
45
e8331ba8ad5d *** empty log message ***
claus
parents: 39
diff changeset
  1229
	(b > 127) ifTrue:[
e8331ba8ad5d *** empty log message ***
claus
parents: 39
diff changeset
  1230
	    self error:'jump-range error'.
e8331ba8ad5d *** empty log message ***
claus
parents: 39
diff changeset
  1231
	    errorFlag := #Error
e8331ba8ad5d *** empty log message ***
claus
parents: 39
diff changeset
  1232
	].
49
02660b790c3e *** empty log message ***
claus
parents: 46
diff changeset
  1233
	codeBytes at:idx put:b
0
7ad01559b262 Initial revision
claus
parents:
diff changeset
  1234
    ] ifFalse:[
45
e8331ba8ad5d *** empty log message ***
claus
parents: 39
diff changeset
  1235
	(b < -128) ifTrue:[
e8331ba8ad5d *** empty log message ***
claus
parents: 39
diff changeset
  1236
	    self error:'jump-range error'.
e8331ba8ad5d *** empty log message ***
claus
parents: 39
diff changeset
  1237
	    errorFlag := #Error
e8331ba8ad5d *** empty log message ***
claus
parents: 39
diff changeset
  1238
	].
49
02660b790c3e *** empty log message ***
claus
parents: 46
diff changeset
  1239
	b := 256 + b
0
7ad01559b262 Initial revision
claus
parents:
diff changeset
  1240
    ].
49
02660b790c3e *** empty log message ***
claus
parents: 46
diff changeset
  1241
    codeBytes at:idx put:b.
02660b790c3e *** empty log message ***
claus
parents: 46
diff changeset
  1242
    codeIndex := idx + 1
0
7ad01559b262 Initial revision
claus
parents:
diff changeset
  1243
!
7ad01559b262 Initial revision
claus
parents:
diff changeset
  1244
45
e8331ba8ad5d *** empty log message ***
claus
parents: 39
diff changeset
  1245
appendWord:aWord
54
86c5b39c2eca *** empty log message ***
claus
parents: 49
diff changeset
  1246
    "append an unsigned word (low-high) to the code-Array, 
45
e8331ba8ad5d *** empty log message ***
claus
parents: 39
diff changeset
  1247
     checking for word-range (debug-only)"
e8331ba8ad5d *** empty log message ***
claus
parents: 39
diff changeset
  1248
49
02660b790c3e *** empty log message ***
claus
parents: 46
diff changeset
  1249
    |idx "{Class: SmallInteger }"|
02660b790c3e *** empty log message ***
claus
parents: 46
diff changeset
  1250
02660b790c3e *** empty log message ***
claus
parents: 46
diff changeset
  1251
    idx := codeIndex.
45
e8331ba8ad5d *** empty log message ***
claus
parents: 39
diff changeset
  1252
    (aWord between:0 and:16rFFFF) ifTrue:[
49
02660b790c3e *** empty log message ***
claus
parents: 46
diff changeset
  1253
	codeBytes at:idx put:(aWord bitAnd:16rFF).
02660b790c3e *** empty log message ***
claus
parents: 46
diff changeset
  1254
	idx := idx + 1.
02660b790c3e *** empty log message ***
claus
parents: 46
diff changeset
  1255
	codeBytes at:idx put:(aWord bitShift:-8).
02660b790c3e *** empty log message ***
claus
parents: 46
diff changeset
  1256
	codeIndex := idx + 1
45
e8331ba8ad5d *** empty log message ***
claus
parents: 39
diff changeset
  1257
    ] ifFalse:[
e8331ba8ad5d *** empty log message ***
claus
parents: 39
diff changeset
  1258
	self error:'word range error'.
e8331ba8ad5d *** empty log message ***
claus
parents: 39
diff changeset
  1259
	errorFlag := #Error
e8331ba8ad5d *** empty log message ***
claus
parents: 39
diff changeset
  1260
    ]
e8331ba8ad5d *** empty log message ***
claus
parents: 39
diff changeset
  1261
!
e8331ba8ad5d *** empty log message ***
claus
parents: 39
diff changeset
  1262
46
a8c1e932ed6a 16bit literal offsets
claus
parents: 45
diff changeset
  1263
appendSignedWord:aWord
a8c1e932ed6a 16bit literal offsets
claus
parents: 45
diff changeset
  1264
    "append a signed word to the code-Array,
a8c1e932ed6a 16bit literal offsets
claus
parents: 45
diff changeset
  1265
     check range and report an error if invalid"
a8c1e932ed6a 16bit literal offsets
claus
parents: 45
diff changeset
  1266
49
02660b790c3e *** empty log message ***
claus
parents: 46
diff changeset
  1267
    |w   "{Class: SmallInteger }"|
46
a8c1e932ed6a 16bit literal offsets
claus
parents: 45
diff changeset
  1268
a8c1e932ed6a 16bit literal offsets
claus
parents: 45
diff changeset
  1269
    w := aWord.
a8c1e932ed6a 16bit literal offsets
claus
parents: 45
diff changeset
  1270
    (w >= 0) ifTrue:[
a8c1e932ed6a 16bit literal offsets
claus
parents: 45
diff changeset
  1271
	(w > 16r7FFFF) ifTrue:[
a8c1e932ed6a 16bit literal offsets
claus
parents: 45
diff changeset
  1272
	    self error:'word-range error'.
a8c1e932ed6a 16bit literal offsets
claus
parents: 45
diff changeset
  1273
	    errorFlag := #Error
a8c1e932ed6a 16bit literal offsets
claus
parents: 45
diff changeset
  1274
	].
a8c1e932ed6a 16bit literal offsets
claus
parents: 45
diff changeset
  1275
    ] ifFalse:[
a8c1e932ed6a 16bit literal offsets
claus
parents: 45
diff changeset
  1276
	(w < 16r-8000) ifTrue:[
a8c1e932ed6a 16bit literal offsets
claus
parents: 45
diff changeset
  1277
	    self error:'word-range error'.
a8c1e932ed6a 16bit literal offsets
claus
parents: 45
diff changeset
  1278
	    errorFlag := #Error
a8c1e932ed6a 16bit literal offsets
claus
parents: 45
diff changeset
  1279
	].
a8c1e932ed6a 16bit literal offsets
claus
parents: 45
diff changeset
  1280
	w := (16r10000 + w).
a8c1e932ed6a 16bit literal offsets
claus
parents: 45
diff changeset
  1281
    ].
a8c1e932ed6a 16bit literal offsets
claus
parents: 45
diff changeset
  1282
    self appendWord:w
a8c1e932ed6a 16bit literal offsets
claus
parents: 45
diff changeset
  1283
!
a8c1e932ed6a 16bit literal offsets
claus
parents: 45
diff changeset
  1284
0
7ad01559b262 Initial revision
claus
parents:
diff changeset
  1285
addReloc:symIndex
7ad01559b262 Initial revision
claus
parents:
diff changeset
  1286
    "remember to relocate offset at symIndex later ..."
7ad01559b262 Initial revision
claus
parents:
diff changeset
  1287
7ad01559b262 Initial revision
claus
parents:
diff changeset
  1288
    relocList isNil ifTrue:[
45
e8331ba8ad5d *** empty log message ***
claus
parents: 39
diff changeset
  1289
	relocList := OrderedCollection new.
0
7ad01559b262 Initial revision
claus
parents:
diff changeset
  1290
    ].
7ad01559b262 Initial revision
claus
parents:
diff changeset
  1291
    relocList add:symIndex
7ad01559b262 Initial revision
claus
parents:
diff changeset
  1292
!
7ad01559b262 Initial revision
claus
parents:
diff changeset
  1293
45
e8331ba8ad5d *** empty log message ***
claus
parents: 39
diff changeset
  1294
moveGlobalsToFront
e8331ba8ad5d *** empty log message ***
claus
parents: 39
diff changeset
  1295
    "move all global-literals to the front of the literal array.
e8331ba8ad5d *** empty log message ***
claus
parents: 39
diff changeset
  1296
     This may be the last chance to compile the method, since
e8331ba8ad5d *** empty log message ***
claus
parents: 39
diff changeset
  1297
     for globals, the maximum literal index is 255 - while for normal
e8331ba8ad5d *** empty log message ***
claus
parents: 39
diff changeset
  1298
     literals its a stress-less 65535"
e8331ba8ad5d *** empty log message ***
claus
parents: 39
diff changeset
  1299
e8331ba8ad5d *** empty log message ***
claus
parents: 39
diff changeset
  1300
    litArray isNil ifTrue:[
e8331ba8ad5d *** empty log message ***
claus
parents: 39
diff changeset
  1301
	^ self error:'oops compiler botch'.
e8331ba8ad5d *** empty log message ***
claus
parents: 39
diff changeset
  1302
    ].
e8331ba8ad5d *** empty log message ***
claus
parents: 39
diff changeset
  1303
    litArray sort:[:a :b |   "a < b -> #(a b)"
e8331ba8ad5d *** empty log message ***
claus
parents: 39
diff changeset
  1304
		   (a isMemberOf:Symbol) ifFalse:[false]
e8331ba8ad5d *** empty log message ***
claus
parents: 39
diff changeset
  1305
		   ifTrue:[
e8331ba8ad5d *** empty log message ***
claus
parents: 39
diff changeset
  1306
		      (b isMemberOf:Symbol) ifFalse:[true]
e8331ba8ad5d *** empty log message ***
claus
parents: 39
diff changeset
  1307
		      ifTrue:[
e8331ba8ad5d *** empty log message ***
claus
parents: 39
diff changeset
  1308
			(a at:1) isUppercase ifFalse:[false]
e8331ba8ad5d *** empty log message ***
claus
parents: 39
diff changeset
  1309
			ifTrue:[
e8331ba8ad5d *** empty log message ***
claus
parents: 39
diff changeset
  1310
			  (b at:1) isUppercase ifFalse:[true]
e8331ba8ad5d *** empty log message ***
claus
parents: 39
diff changeset
  1311
			  ifTrue:[a < b].
e8331ba8ad5d *** empty log message ***
claus
parents: 39
diff changeset
  1312
			]
e8331ba8ad5d *** empty log message ***
claus
parents: 39
diff changeset
  1313
		      ]
e8331ba8ad5d *** empty log message ***
claus
parents: 39
diff changeset
  1314
		    ]
e8331ba8ad5d *** empty log message ***
claus
parents: 39
diff changeset
  1315
		   ].
e8331ba8ad5d *** empty log message ***
claus
parents: 39
diff changeset
  1316
e8331ba8ad5d *** empty log message ***
claus
parents: 39
diff changeset
  1317
"
e8331ba8ad5d *** empty log message ***
claus
parents: 39
diff changeset
  1318
    #(#A #c #B #D #E #a #b #F)
e8331ba8ad5d *** empty log message ***
claus
parents: 39
diff changeset
  1319
     sort:[:a :b |  
e8331ba8ad5d *** empty log message ***
claus
parents: 39
diff changeset
  1320
		   (a isMemberOf:Symbol) ifFalse:[false]
e8331ba8ad5d *** empty log message ***
claus
parents: 39
diff changeset
  1321
		   ifTrue:[
e8331ba8ad5d *** empty log message ***
claus
parents: 39
diff changeset
  1322
		      (b isMemberOf:Symbol) ifFalse:[true]
e8331ba8ad5d *** empty log message ***
claus
parents: 39
diff changeset
  1323
		      ifTrue:[
e8331ba8ad5d *** empty log message ***
claus
parents: 39
diff changeset
  1324
			(a at:1) isUppercase ifFalse:[false]
e8331ba8ad5d *** empty log message ***
claus
parents: 39
diff changeset
  1325
			ifTrue:[
e8331ba8ad5d *** empty log message ***
claus
parents: 39
diff changeset
  1326
			  (b at:1) isUppercase ifFalse:[true]
e8331ba8ad5d *** empty log message ***
claus
parents: 39
diff changeset
  1327
			  ifTrue:[(a < b)].
e8331ba8ad5d *** empty log message ***
claus
parents: 39
diff changeset
  1328
			]
e8331ba8ad5d *** empty log message ***
claus
parents: 39
diff changeset
  1329
		      ]
e8331ba8ad5d *** empty log message ***
claus
parents: 39
diff changeset
  1330
		    ]
e8331ba8ad5d *** empty log message ***
claus
parents: 39
diff changeset
  1331
		   ].
e8331ba8ad5d *** empty log message ***
claus
parents: 39
diff changeset
  1332
e8331ba8ad5d *** empty log message ***
claus
parents: 39
diff changeset
  1333
"
e8331ba8ad5d *** empty log message ***
claus
parents: 39
diff changeset
  1334
!
e8331ba8ad5d *** empty log message ***
claus
parents: 39
diff changeset
  1335
0
7ad01559b262 Initial revision
claus
parents:
diff changeset
  1336
byteCodeFor:aSymbol
7ad01559b262 Initial revision
claus
parents:
diff changeset
  1337
    "given a symbolic instruction, return the corresponding bytecode.
7ad01559b262 Initial revision
claus
parents:
diff changeset
  1338
     as a side-effect, leave number of bytes pushed/popped by this instr.
7ad01559b262 Initial revision
claus
parents:
diff changeset
  1339
     in stackDelta, and, if the instruction needs extra arguments, leave
7ad01559b262 Initial revision
claus
parents:
diff changeset
  1340
     this info in extra"
7ad01559b262 Initial revision
claus
parents:
diff changeset
  1341
7ad01559b262 Initial revision
claus
parents:
diff changeset
  1342
    "standard bytecodes"
7ad01559b262 Initial revision
claus
parents:
diff changeset
  1343
7ad01559b262 Initial revision
claus
parents:
diff changeset
  1344
    (aSymbol == #pushNil) ifTrue:[stackDelta := 1. ^ 10].
7ad01559b262 Initial revision
claus
parents:
diff changeset
  1345
    (aSymbol == #pushTrue) ifTrue:[stackDelta := 1. ^ 11].
7ad01559b262 Initial revision
claus
parents:
diff changeset
  1346
    (aSymbol == #pushFalse) ifTrue:[stackDelta := 1. ^ 12].
7ad01559b262 Initial revision
claus
parents:
diff changeset
  1347
    (aSymbol == #pushLit) ifTrue:[stackDelta := 1. extra := #lit. ^ 14].
105
claus
parents: 104
diff changeset
  1348
    (aSymbol == #pushLitS) ifTrue:[stackDelta := 1. extra := #index. ^ 14].
0
7ad01559b262 Initial revision
claus
parents:
diff changeset
  1349
    (aSymbol == #pushSelf) ifTrue:[stackDelta := 1. ^ 15].
7ad01559b262 Initial revision
claus
parents:
diff changeset
  1350
    (aSymbol == #pushNum) ifTrue:[stackDelta := 1. extra := #number. ^ 16].
7ad01559b262 Initial revision
claus
parents:
diff changeset
  1351
7ad01559b262 Initial revision
claus
parents:
diff changeset
  1352
    (aSymbol == #pushMethodArg) ifTrue:[stackDelta := 1. extra := #index. ^ 30].
7ad01559b262 Initial revision
claus
parents:
diff changeset
  1353
    (aSymbol == #pushMethodVar) ifTrue:[stackDelta := 1. extra := #index. ^ 31].
7ad01559b262 Initial revision
claus
parents:
diff changeset
  1354
    (aSymbol == #pushBlockArg) ifTrue:[stackDelta := 1. extra := #index. ^ 32].
7ad01559b262 Initial revision
claus
parents:
diff changeset
  1355
    (aSymbol == #pushBlockVar) ifTrue:[stackDelta := 1. extra := #index. ^ 33].
7ad01559b262 Initial revision
claus
parents:
diff changeset
  1356
    (aSymbol == #pushInstVar) ifTrue:[stackDelta := 1. extra := #index. ^ 34].
1
77da9f5728e5 *** empty log message ***
claus
parents: 0
diff changeset
  1357
    (aSymbol == #pushOuterBlockArg) ifTrue:[stackDelta := 1. extra := #indexLevel. ^ 42].
77da9f5728e5 *** empty log message ***
claus
parents: 0
diff changeset
  1358
    (aSymbol == #pushOuterBlockVar) ifTrue:[stackDelta := 1. extra := #indexLevel. ^ 128].
0
7ad01559b262 Initial revision
claus
parents:
diff changeset
  1359
7ad01559b262 Initial revision
claus
parents:
diff changeset
  1360
    (aSymbol == #retTop) ifTrue:[stackDelta := -1. ^ 0].
7ad01559b262 Initial revision
claus
parents:
diff changeset
  1361
    (aSymbol == #retSelf) ifTrue:[^5].
7ad01559b262 Initial revision
claus
parents:
diff changeset
  1362
7ad01559b262 Initial revision
claus
parents:
diff changeset
  1363
    (aSymbol == #==) ifTrue:[stackDelta := -1. self addLiteral:aSymbol. ^ 45].
7ad01559b262 Initial revision
claus
parents:
diff changeset
  1364
    (aSymbol == #~~) ifTrue:[stackDelta := -1. self addLiteral:aSymbol. ^ 46].
7ad01559b262 Initial revision
claus
parents:
diff changeset
  1365
7ad01559b262 Initial revision
claus
parents:
diff changeset
  1366
    (aSymbol == #falseJump) ifTrue:[stackDelta := -1. extra := #offset. ^ 50].
7ad01559b262 Initial revision
claus
parents:
diff changeset
  1367
    (aSymbol == #trueJump) ifTrue:[stackDelta := -1. extra := #offset. ^ 51].
7ad01559b262 Initial revision
claus
parents:
diff changeset
  1368
    (aSymbol == #nilJump) ifTrue:[stackDelta := -1. extra := #offset. ^ 52].
7ad01559b262 Initial revision
claus
parents:
diff changeset
  1369
    (aSymbol == #notNilJump) ifTrue:[stackDelta := -1. extra := #offset. ^ 53].
7ad01559b262 Initial revision
claus
parents:
diff changeset
  1370
    (aSymbol == #jump) ifTrue:[extra := #offset. ^ 54].
1
77da9f5728e5 *** empty log message ***
claus
parents: 0
diff changeset
  1371
    (aSymbol == #makeBlock) ifTrue:[stackDelta := 1. extra := #offsetNvarNarg. ^ 55].
0
7ad01559b262 Initial revision
claus
parents:
diff changeset
  1372
    (aSymbol == #zeroJump) ifTrue:[stackDelta := -1. extra := #offset. ^ 56].
7ad01559b262 Initial revision
claus
parents:
diff changeset
  1373
    (aSymbol == #notZeroJump) ifTrue:[stackDelta := -1. extra := #offset. ^ 57].
7ad01559b262 Initial revision
claus
parents:
diff changeset
  1374
    (aSymbol == #eqJump) ifTrue:[stackDelta := -2. extra := #offset. ^ 58].
7ad01559b262 Initial revision
claus
parents:
diff changeset
  1375
    (aSymbol == #notEqJump) ifTrue:[stackDelta := -2. extra := #offset. ^ 59].
7ad01559b262 Initial revision
claus
parents:
diff changeset
  1376
54
86c5b39c2eca *** empty log message ***
claus
parents: 49
diff changeset
  1377
    (aSymbol == #lineno) ifTrue:[lineno := true. ^ 8].
86c5b39c2eca *** empty log message ***
claus
parents: 49
diff changeset
  1378
106
claus
parents: 105
diff changeset
  1379
    (aSymbol == #send) ifTrue:[lineno := true. extra := #special. ^ 19].
claus
parents: 105
diff changeset
  1380
    (aSymbol == #superSend) ifTrue:[lineno := true. extra := #special. ^ 20].
claus
parents: 105
diff changeset
  1381
    (aSymbol == #hereSend) ifTrue:[lineno := true. extra := #special. ^ 20].
117
claus
parents: 111
diff changeset
  1382
    (aSymbol == #sendSelf) ifTrue:[lineno := true. extra := #special. ^ 13].
0
7ad01559b262 Initial revision
claus
parents:
diff changeset
  1383
7ad01559b262 Initial revision
claus
parents:
diff changeset
  1384
    (aSymbol == #drop) ifTrue:[stackDelta := -1. ^ 18].
7ad01559b262 Initial revision
claus
parents:
diff changeset
  1385
    (aSymbol == #dup) ifTrue:[stackDelta := 1. ^ 47].
7ad01559b262 Initial revision
claus
parents:
diff changeset
  1386
117
claus
parents: 111
diff changeset
  1387
    (aSymbol == #storeMethodVar) ifTrue:[extra := #index. stackDelta := -1. ^ 37].
claus
parents: 111
diff changeset
  1388
    (aSymbol == #storeBlockVar) ifTrue:[extra := #index. stackDelta := -1. ^ 38].
claus
parents: 111
diff changeset
  1389
    (aSymbol == #storeInstVar) ifTrue:[extra := #index. stackDelta := -1. ^ 39].
0
7ad01559b262 Initial revision
claus
parents:
diff changeset
  1390
117
claus
parents: 111
diff changeset
  1391
    (aSymbol == #pushClassVarS) ifTrue:[stackDelta := 1. extra := #speciallitS. ^ 35].
claus
parents: 111
diff changeset
  1392
    (aSymbol == #pushGlobalS) ifTrue:[stackDelta := 1. extra := #speciallitS. ^ 35].
claus
parents: 111
diff changeset
  1393
claus
parents: 111
diff changeset
  1394
    (aSymbol == #storeClassVarS) ifTrue:[extra := #speciallitS.stackDelta := -1. ^ 40].
claus
parents: 111
diff changeset
  1395
    (aSymbol == #storeGlobalS) ifTrue:[extra := #speciallitS. stackDelta := -1. ^ 40].
claus
parents: 111
diff changeset
  1396
1
77da9f5728e5 *** empty log message ***
claus
parents: 0
diff changeset
  1397
    (aSymbol == #storeOuterBlockVar) ifTrue:[stackDelta := -1. extra := #indexLevel. ^ 129].
0
7ad01559b262 Initial revision
claus
parents:
diff changeset
  1398
117
claus
parents: 111
diff changeset
  1399
    (aSymbol == #pushClassInstVar) ifTrue:[stackDelta := 1. extra := #index. ^ 176].
claus
parents: 111
diff changeset
  1400
    (aSymbol == #storeClassInstVar) ifTrue:[extra := #index.stackDelta := -1. ^ 177].
105
claus
parents: 104
diff changeset
  1401
0
7ad01559b262 Initial revision
claus
parents:
diff changeset
  1402
    "optimized bytecodes"
7ad01559b262 Initial revision
claus
parents:
diff changeset
  1403
7ad01559b262 Initial revision
claus
parents:
diff changeset
  1404
    (aSymbol == #retNil) ifTrue:[^ 1].
7ad01559b262 Initial revision
claus
parents:
diff changeset
  1405
    (aSymbol == #retTrue) ifTrue:[^ 2].
7ad01559b262 Initial revision
claus
parents:
diff changeset
  1406
    (aSymbol == #retFalse) ifTrue:[^ 3].
7ad01559b262 Initial revision
claus
parents:
diff changeset
  1407
    (aSymbol == #ret0) ifTrue:[^ 4].
7ad01559b262 Initial revision
claus
parents:
diff changeset
  1408
    (aSymbol == #retNum) ifTrue:[extra := #number. ^ 127].
25
865d6cfaf90d changed bytecodes
claus
parents: 20
diff changeset
  1409
    (aSymbol == #homeRetTop) ifTrue:[^ 7].
0
7ad01559b262 Initial revision
claus
parents:
diff changeset
  1410
46
a8c1e932ed6a 16bit literal offsets
claus
parents: 45
diff changeset
  1411
    (aSymbol == #pushNum16) ifTrue:[stackDelta := 1. extra := #number16. ^ 17].
0
7ad01559b262 Initial revision
claus
parents:
diff changeset
  1412
    (aSymbol == #push0) ifTrue:[stackDelta := 1. ^120].
7ad01559b262 Initial revision
claus
parents:
diff changeset
  1413
    (aSymbol == #push1) ifTrue:[stackDelta := 1. ^121].
3
b63b8a6b71fb *** empty log message ***
claus
parents: 1
diff changeset
  1414
    (aSymbol == #push2) ifTrue:[stackDelta := 1. ^139].
0
7ad01559b262 Initial revision
claus
parents:
diff changeset
  1415
    (aSymbol == #pushMinus1) ifTrue:[stackDelta := 1. ^122].
7ad01559b262 Initial revision
claus
parents:
diff changeset
  1416
106
claus
parents: 105
diff changeset
  1417
    (aSymbol == #send0) ifTrue:[lineno := true. extra := #index. ^21].
claus
parents: 105
diff changeset
  1418
    (aSymbol == #send1) ifTrue:[lineno := true. extra := #index. stackDelta := -1. ^22].
claus
parents: 105
diff changeset
  1419
    (aSymbol == #send2) ifTrue:[lineno := true. extra := #index. stackDelta := -2. ^23].
claus
parents: 105
diff changeset
  1420
    (aSymbol == #send3) ifTrue:[lineno := true. extra := #index. stackDelta := -3. ^24].
0
7ad01559b262 Initial revision
claus
parents:
diff changeset
  1421
106
claus
parents: 105
diff changeset
  1422
    (aSymbol == #sendSelf0) ifTrue:[lineno := true. extra := #index. stackDelta := 1. ^180].
claus
parents: 105
diff changeset
  1423
    (aSymbol == #sendSelf1) ifTrue:[lineno := true. extra := #index. ^181].
claus
parents: 105
diff changeset
  1424
    (aSymbol == #sendSelf2) ifTrue:[lineno := true. extra := #index. stackDelta := -1. ^182].
claus
parents: 105
diff changeset
  1425
    (aSymbol == #sendSelf3) ifTrue:[lineno := true. extra := #index. stackDelta := -2. ^183].
claus
parents: 105
diff changeset
  1426
    (aSymbol == #sendSelfDrop0) ifTrue:[lineno := true. extra := #index. ^184].
claus
parents: 105
diff changeset
  1427
    (aSymbol == #sendSelfDrop1) ifTrue:[lineno := true. extra := #index. stackDelta := -1. ^185].
claus
parents: 105
diff changeset
  1428
    (aSymbol == #sendSelfDrop2) ifTrue:[lineno := true. extra := #index. stackDelta := -2. ^186].
claus
parents: 105
diff changeset
  1429
    (aSymbol == #sendSelfDrop3) ifTrue:[lineno := true. extra := #index. stackDelta := -3. ^187].
0
7ad01559b262 Initial revision
claus
parents:
diff changeset
  1430
106
claus
parents: 105
diff changeset
  1431
    (aSymbol == #sendDrop) ifTrue:[lineno := true. extra := #special. ^25].
claus
parents: 105
diff changeset
  1432
    (aSymbol == #sendDrop0) ifTrue:[lineno := true. extra := #index. stackDelta := -1. ^26].
claus
parents: 105
diff changeset
  1433
    (aSymbol == #sendDrop1) ifTrue:[lineno := true. extra := #index. stackDelta := -2. ^27].
claus
parents: 105
diff changeset
  1434
    (aSymbol == #sendDrop2) ifTrue:[lineno := true. extra := #index. stackDelta := -3. ^28].
claus
parents: 105
diff changeset
  1435
    (aSymbol == #sendDrop3) ifTrue:[lineno := true. extra := #index. stackDelta := -4. ^29].
0
7ad01559b262 Initial revision
claus
parents:
diff changeset
  1436
7ad01559b262 Initial revision
claus
parents:
diff changeset
  1437
    (aSymbol == #pushMethodVar1) ifTrue:[stackDelta := 1. ^80].
7ad01559b262 Initial revision
claus
parents:
diff changeset
  1438
    (aSymbol == #pushMethodVar2) ifTrue:[stackDelta := 1. ^81].
7ad01559b262 Initial revision
claus
parents:
diff changeset
  1439
    (aSymbol == #pushMethodVar3) ifTrue:[stackDelta := 1. ^82].
7ad01559b262 Initial revision
claus
parents:
diff changeset
  1440
    (aSymbol == #pushMethodVar4) ifTrue:[stackDelta := 1. ^83].
7ad01559b262 Initial revision
claus
parents:
diff changeset
  1441
    (aSymbol == #pushMethodVar5) ifTrue:[stackDelta := 1. ^84].
7ad01559b262 Initial revision
claus
parents:
diff changeset
  1442
    (aSymbol == #pushMethodVar6) ifTrue:[stackDelta := 1. ^85].
7ad01559b262 Initial revision
claus
parents:
diff changeset
  1443
7ad01559b262 Initial revision
claus
parents:
diff changeset
  1444
    (aSymbol == #pushMethodArg1) ifTrue:[stackDelta := 1. ^86].
7ad01559b262 Initial revision
claus
parents:
diff changeset
  1445
    (aSymbol == #pushMethodArg2) ifTrue:[stackDelta := 1. ^87].
7ad01559b262 Initial revision
claus
parents:
diff changeset
  1446
    (aSymbol == #pushMethodArg3) ifTrue:[stackDelta := 1. ^88].
7ad01559b262 Initial revision
claus
parents:
diff changeset
  1447
    (aSymbol == #pushMethodArg4) ifTrue:[stackDelta := 1. ^89].
7ad01559b262 Initial revision
claus
parents:
diff changeset
  1448
7ad01559b262 Initial revision
claus
parents:
diff changeset
  1449
    (aSymbol == #pushInstVar1) ifTrue:[stackDelta := 1. ^90].
7ad01559b262 Initial revision
claus
parents:
diff changeset
  1450
    (aSymbol == #pushInstVar2) ifTrue:[stackDelta := 1. ^91].
7ad01559b262 Initial revision
claus
parents:
diff changeset
  1451
    (aSymbol == #pushInstVar3) ifTrue:[stackDelta := 1. ^92].
7ad01559b262 Initial revision
claus
parents:
diff changeset
  1452
    (aSymbol == #pushInstVar4) ifTrue:[stackDelta := 1. ^93].
7ad01559b262 Initial revision
claus
parents:
diff changeset
  1453
    (aSymbol == #pushInstVar5) ifTrue:[stackDelta := 1. ^94].
7ad01559b262 Initial revision
claus
parents:
diff changeset
  1454
    (aSymbol == #pushInstVar6) ifTrue:[stackDelta := 1. ^95].
7ad01559b262 Initial revision
claus
parents:
diff changeset
  1455
    (aSymbol == #pushInstVar7) ifTrue:[stackDelta := 1. ^96].
7ad01559b262 Initial revision
claus
parents:
diff changeset
  1456
    (aSymbol == #pushInstVar8) ifTrue:[stackDelta := 1. ^97].
7ad01559b262 Initial revision
claus
parents:
diff changeset
  1457
    (aSymbol == #pushInstVar9) ifTrue:[stackDelta := 1. ^98].
7ad01559b262 Initial revision
claus
parents:
diff changeset
  1458
    (aSymbol == #pushInstVar10) ifTrue:[stackDelta := 1. ^99].
7ad01559b262 Initial revision
claus
parents:
diff changeset
  1459
7ad01559b262 Initial revision
claus
parents:
diff changeset
  1460
    (aSymbol == #storeMethodVar1) ifTrue:[stackDelta := -1. ^100].
7ad01559b262 Initial revision
claus
parents:
diff changeset
  1461
    (aSymbol == #storeMethodVar2) ifTrue:[stackDelta := -1. ^101].
7ad01559b262 Initial revision
claus
parents:
diff changeset
  1462
    (aSymbol == #storeMethodVar3) ifTrue:[stackDelta := -1. ^102].
7ad01559b262 Initial revision
claus
parents:
diff changeset
  1463
    (aSymbol == #storeMethodVar4) ifTrue:[stackDelta := -1. ^103].
7ad01559b262 Initial revision
claus
parents:
diff changeset
  1464
    (aSymbol == #storeMethodVar5) ifTrue:[stackDelta := -1. ^104].
7ad01559b262 Initial revision
claus
parents:
diff changeset
  1465
    (aSymbol == #storeMethodVar6) ifTrue:[stackDelta := -1. ^105].
7ad01559b262 Initial revision
claus
parents:
diff changeset
  1466
7ad01559b262 Initial revision
claus
parents:
diff changeset
  1467
    (aSymbol == #storeInstVar1) ifTrue:[stackDelta := -1. ^110].
7ad01559b262 Initial revision
claus
parents:
diff changeset
  1468
    (aSymbol == #storeInstVar2) ifTrue:[stackDelta := -1. ^111].
7ad01559b262 Initial revision
claus
parents:
diff changeset
  1469
    (aSymbol == #storeInstVar3) ifTrue:[stackDelta := -1. ^112].
7ad01559b262 Initial revision
claus
parents:
diff changeset
  1470
    (aSymbol == #storeInstVar4) ifTrue:[stackDelta := -1. ^113].
7ad01559b262 Initial revision
claus
parents:
diff changeset
  1471
    (aSymbol == #storeInstVar5) ifTrue:[stackDelta := -1. ^114].
7ad01559b262 Initial revision
claus
parents:
diff changeset
  1472
    (aSymbol == #storeInstVar6) ifTrue:[stackDelta := -1. ^115].
7ad01559b262 Initial revision
claus
parents:
diff changeset
  1473
    (aSymbol == #storeInstVar7) ifTrue:[stackDelta := -1. ^116].
7ad01559b262 Initial revision
claus
parents:
diff changeset
  1474
    (aSymbol == #storeInstVar8) ifTrue:[stackDelta := -1. ^117].
7ad01559b262 Initial revision
claus
parents:
diff changeset
  1475
    (aSymbol == #storeInstVar9) ifTrue:[stackDelta := -1. ^118].
7ad01559b262 Initial revision
claus
parents:
diff changeset
  1476
    (aSymbol == #storeInstVar10) ifTrue:[stackDelta := -1. ^119].
7ad01559b262 Initial revision
claus
parents:
diff changeset
  1477
103
claus
parents: 102
diff changeset
  1478
    (aSymbol == #pushLit1) ifTrue:[stackDelta := 1. ^ 222].
claus
parents: 102
diff changeset
  1479
    (aSymbol == #pushLit2) ifTrue:[stackDelta := 1. ^ 223].
claus
parents: 102
diff changeset
  1480
    (aSymbol == #pushLit3) ifTrue:[stackDelta := 1. ^ 224].
claus
parents: 102
diff changeset
  1481
    (aSymbol == #pushLit4) ifTrue:[stackDelta := 1. ^ 225].
claus
parents: 102
diff changeset
  1482
    (aSymbol == #pushLit5) ifTrue:[stackDelta := 1. ^ 226].
claus
parents: 102
diff changeset
  1483
    (aSymbol == #pushLit6) ifTrue:[stackDelta := 1. ^ 227].
claus
parents: 102
diff changeset
  1484
    (aSymbol == #pushLit7) ifTrue:[stackDelta := 1. ^ 228].
claus
parents: 102
diff changeset
  1485
    (aSymbol == #pushLit8) ifTrue:[stackDelta := 1. ^ 229].
claus
parents: 102
diff changeset
  1486
0
7ad01559b262 Initial revision
claus
parents:
diff changeset
  1487
    (aSymbol == #retMethodVar1) ifTrue:[^160].
7ad01559b262 Initial revision
claus
parents:
diff changeset
  1488
    (aSymbol == #retMethodVar2) ifTrue:[^161].
7ad01559b262 Initial revision
claus
parents:
diff changeset
  1489
    (aSymbol == #retMethodVar3) ifTrue:[^162].
7ad01559b262 Initial revision
claus
parents:
diff changeset
  1490
    (aSymbol == #retMethodVar4) ifTrue:[^163].
7ad01559b262 Initial revision
claus
parents:
diff changeset
  1491
    (aSymbol == #retMethodVar5) ifTrue:[^164].
7ad01559b262 Initial revision
claus
parents:
diff changeset
  1492
    (aSymbol == #retMethodVar6) ifTrue:[^165].
7ad01559b262 Initial revision
claus
parents:
diff changeset
  1493
7ad01559b262 Initial revision
claus
parents:
diff changeset
  1494
    (aSymbol == #retInstVar1) ifTrue:[^166].
7ad01559b262 Initial revision
claus
parents:
diff changeset
  1495
    (aSymbol == #retInstVar2) ifTrue:[^167].
7ad01559b262 Initial revision
claus
parents:
diff changeset
  1496
    (aSymbol == #retInstVar3) ifTrue:[^168].
7ad01559b262 Initial revision
claus
parents:
diff changeset
  1497
    (aSymbol == #retInstVar4) ifTrue:[^169].
7ad01559b262 Initial revision
claus
parents:
diff changeset
  1498
    (aSymbol == #retInstVar5) ifTrue:[^170].
7ad01559b262 Initial revision
claus
parents:
diff changeset
  1499
    (aSymbol == #retInstVar6) ifTrue:[^171].
7ad01559b262 Initial revision
claus
parents:
diff changeset
  1500
    (aSymbol == #retInstVar7) ifTrue:[^172].
7ad01559b262 Initial revision
claus
parents:
diff changeset
  1501
    (aSymbol == #retInstVar8) ifTrue:[^173].
7ad01559b262 Initial revision
claus
parents:
diff changeset
  1502
7ad01559b262 Initial revision
claus
parents:
diff changeset
  1503
    (aSymbol == #retMethodArg1) ifTrue:[^174].
7ad01559b262 Initial revision
claus
parents:
diff changeset
  1504
    (aSymbol == #retMethodArg2) ifTrue:[^175].
7ad01559b262 Initial revision
claus
parents:
diff changeset
  1505
7ad01559b262 Initial revision
claus
parents:
diff changeset
  1506
    (aSymbol == #pushBlockArg1) ifTrue:[stackDelta := 1. ^140].
7ad01559b262 Initial revision
claus
parents:
diff changeset
  1507
    (aSymbol == #pushBlockArg2) ifTrue:[stackDelta := 1. ^141].
7ad01559b262 Initial revision
claus
parents:
diff changeset
  1508
    (aSymbol == #pushBlockArg3) ifTrue:[stackDelta := 1. ^142].
7ad01559b262 Initial revision
claus
parents:
diff changeset
  1509
    (aSymbol == #pushBlockArg4) ifTrue:[stackDelta := 1. ^143].
7ad01559b262 Initial revision
claus
parents:
diff changeset
  1510
1
77da9f5728e5 *** empty log message ***
claus
parents: 0
diff changeset
  1511
    (aSymbol == #pushOuter1BlockArg) ifTrue:[stackDelta := 1. extra := #index. ^ 43].
77da9f5728e5 *** empty log message ***
claus
parents: 0
diff changeset
  1512
    (aSymbol == #pushOuter2BlockArg) ifTrue:[stackDelta := 1. extra := #index. ^ 44].
0
7ad01559b262 Initial revision
claus
parents:
diff changeset
  1513
5
020d67cc590e *** empty log message ***
claus
parents: 4
diff changeset
  1514
    (aSymbol == #=) ifTrue:[lineno := true. stackDelta := -1. self addLiteral:aSymbol. ^130].
020d67cc590e *** empty log message ***
claus
parents: 4
diff changeset
  1515
    (aSymbol == #+) ifTrue:[lineno := true. stackDelta := -1. self addLiteral:aSymbol. ^131].
020d67cc590e *** empty log message ***
claus
parents: 4
diff changeset
  1516
    (aSymbol == #~=) ifTrue:[lineno := true. stackDelta := -1. self addLiteral:aSymbol. ^132].
020d67cc590e *** empty log message ***
claus
parents: 4
diff changeset
  1517
    (aSymbol == #-) ifTrue:[lineno := true. stackDelta := -1. self addLiteral:aSymbol. ^133].
108
claus
parents: 106
diff changeset
  1518
    (aSymbol == #*) ifTrue:[lineno := true. stackDelta := -1. self addLiteral:aSymbol. ^230].
0
7ad01559b262 Initial revision
claus
parents:
diff changeset
  1519
    (aSymbol == #class) ifTrue:[self addLiteral:aSymbol. ^134].
5
020d67cc590e *** empty log message ***
claus
parents: 4
diff changeset
  1520
    (aSymbol == #x) ifTrue:[lineno := true. self addLiteral:aSymbol. ^106].
020d67cc590e *** empty log message ***
claus
parents: 4
diff changeset
  1521
    (aSymbol == #y) ifTrue:[lineno := true. self addLiteral:aSymbol. ^107].
020d67cc590e *** empty log message ***
claus
parents: 4
diff changeset
  1522
    (aSymbol == #width) ifTrue:[lineno := true. self addLiteral:aSymbol. ^108].
020d67cc590e *** empty log message ***
claus
parents: 4
diff changeset
  1523
    (aSymbol == #height) ifTrue:[lineno := true. self addLiteral:aSymbol. ^109].
020d67cc590e *** empty log message ***
claus
parents: 4
diff changeset
  1524
    (aSymbol == #origin) ifTrue:[lineno := true. self addLiteral:aSymbol. ^154].
020d67cc590e *** empty log message ***
claus
parents: 4
diff changeset
  1525
    (aSymbol == #extent) ifTrue:[lineno := true. self addLiteral:aSymbol. ^155].
020d67cc590e *** empty log message ***
claus
parents: 4
diff changeset
  1526
    (aSymbol == #at:) ifTrue:[lineno := true. stackDelta := -1. self addLiteral:aSymbol. ^135].
020d67cc590e *** empty log message ***
claus
parents: 4
diff changeset
  1527
    (aSymbol == #at:put:)ifTrue:[lineno := true. stackDelta := -2. self addLiteral:aSymbol. ^136].
020d67cc590e *** empty log message ***
claus
parents: 4
diff changeset
  1528
    (aSymbol == #bitAnd:) ifTrue:[lineno := true. stackDelta := -1. self addLiteral:aSymbol. ^137].
020d67cc590e *** empty log message ***
claus
parents: 4
diff changeset
  1529
    (aSymbol == #bitOr:) ifTrue:[lineno := true. stackDelta := -1. self addLiteral:aSymbol. ^138].
020d67cc590e *** empty log message ***
claus
parents: 4
diff changeset
  1530
    (aSymbol == #plus1) ifTrue:[lineno := true. self addLiteral:#+. ^123].
020d67cc590e *** empty log message ***
claus
parents: 4
diff changeset
  1531
    (aSymbol == #minus1) ifTrue:[lineno := true. self addLiteral:#-. ^124].
0
7ad01559b262 Initial revision
claus
parents:
diff changeset
  1532
5
020d67cc590e *** empty log message ***
claus
parents: 4
diff changeset
  1533
    (aSymbol == #incMethodVar) ifTrue:[lineno := true. self addLiteral:#+. extra := #index. ^125].
020d67cc590e *** empty log message ***
claus
parents: 4
diff changeset
  1534
    (aSymbol == #decMethodVar) ifTrue:[lineno := true. self addLiteral:#-. extra := #index. ^126].
0
7ad01559b262 Initial revision
claus
parents:
diff changeset
  1535
7ad01559b262 Initial revision
claus
parents:
diff changeset
  1536
    (aSymbol == #eq0) ifTrue:[self addLiteral:#==. ^48].
7ad01559b262 Initial revision
claus
parents:
diff changeset
  1537
    (aSymbol == #ne0) ifTrue:[self addLiteral:#~~. ^49].
7ad01559b262 Initial revision
claus
parents:
diff changeset
  1538
5
020d67cc590e *** empty log message ***
claus
parents: 4
diff changeset
  1539
    (aSymbol == #>) ifTrue:[lineno := true. self addLiteral:aSymbol. stackDelta := -1. ^ 145].
020d67cc590e *** empty log message ***
claus
parents: 4
diff changeset
  1540
    (aSymbol == #>=) ifTrue:[lineno := true. self addLiteral:aSymbol. stackDelta := -1. ^ 146].
020d67cc590e *** empty log message ***
claus
parents: 4
diff changeset
  1541
    (aSymbol == #<) ifTrue:[lineno := true. self addLiteral:aSymbol. stackDelta := -1. ^ 147].
020d67cc590e *** empty log message ***
claus
parents: 4
diff changeset
  1542
    (aSymbol == #<=) ifTrue:[lineno := true. self addLiteral:aSymbol. stackDelta := -1. ^ 148].
020d67cc590e *** empty log message ***
claus
parents: 4
diff changeset
  1543
    (aSymbol == #next) ifTrue:[lineno := true. self addLiteral:aSymbol. ^ 149].
020d67cc590e *** empty log message ***
claus
parents: 4
diff changeset
  1544
    (aSymbol == #peek) ifTrue:[lineno := true. self addLiteral:aSymbol. ^ 150].
020d67cc590e *** empty log message ***
claus
parents: 4
diff changeset
  1545
    (aSymbol == #value) ifTrue:[lineno := true. self addLiteral:aSymbol. ^ 151].
020d67cc590e *** empty log message ***
claus
parents: 4
diff changeset
  1546
    (aSymbol == #value:) ifTrue:[lineno := true. self addLiteral:aSymbol.  stackDelta := -1. ^ 152].
6
0cd4e7480440 *** empty log message ***
claus
parents: 5
diff changeset
  1547
    (aSymbol == #value:value:) ifTrue:[lineno := true. self addLiteral:aSymbol.  stackDelta := -2. ^ 178].
5
020d67cc590e *** empty log message ***
claus
parents: 4
diff changeset
  1548
    (aSymbol == #size) ifTrue:[lineno := true. self addLiteral:aSymbol. ^ 153].
020d67cc590e *** empty log message ***
claus
parents: 4
diff changeset
  1549
    (aSymbol == #asInteger) ifTrue:[lineno := true. self addLiteral:aSymbol. ^ 158].
020d67cc590e *** empty log message ***
claus
parents: 4
diff changeset
  1550
    (aSymbol == #rounded) ifTrue:[lineno := true. self addLiteral:aSymbol. ^ 159].
0
7ad01559b262 Initial revision
claus
parents:
diff changeset
  1551
    (aSymbol == #mk0Block) ifTrue:[^ 156].
7ad01559b262 Initial revision
claus
parents:
diff changeset
  1552
    (aSymbol == #mkNilBlock) ifTrue:[^ 157].
7ad01559b262 Initial revision
claus
parents:
diff changeset
  1553
103
claus
parents: 102
diff changeset
  1554
    (aSymbol == #gt0) ifTrue:[lineno := true. self addLiteral:#>. ^ 212].
117
claus
parents: 111
diff changeset
  1555
    (aSymbol == #pushgt0) ifTrue:[lineno := true. stackDelta := 1. self addLiteral:#>. ^ 208].
106
claus
parents: 105
diff changeset
  1556
    (aSymbol == #basicNew) ifTrue:[lineno := true. self addLiteral:aSymbol. ^ 211].
claus
parents: 105
diff changeset
  1557
    (aSymbol == #new) ifTrue:[lineno := true. self addLiteral:aSymbol. ^ 213].
111
claus
parents: 110
diff changeset
  1558
    (aSymbol == #basicNew:) ifTrue:[lineno := true. self addLiteral:aSymbol. ^ 214].
claus
parents: 110
diff changeset
  1559
    (aSymbol == #new:) ifTrue:[lineno := true. self addLiteral:aSymbol. ^ 215].
103
claus
parents: 102
diff changeset
  1560
0
7ad01559b262 Initial revision
claus
parents:
diff changeset
  1561
    (aSymbol == #falseJumpabs) ifTrue:[stackDelta := -1. extra := #absoffset. ^ 190].
7ad01559b262 Initial revision
claus
parents:
diff changeset
  1562
    (aSymbol == #trueJumpabs) ifTrue:[stackDelta := -1. extra := #absoffset. ^ 191].
7ad01559b262 Initial revision
claus
parents:
diff changeset
  1563
    (aSymbol == #nilJumpabs) ifTrue:[stackDelta := -1. extra := #absoffset. ^ 192].
7ad01559b262 Initial revision
claus
parents:
diff changeset
  1564
    (aSymbol == #notNilJumpabs) ifTrue:[stackDelta := -1. extra := #absoffset. ^ 193].
7ad01559b262 Initial revision
claus
parents:
diff changeset
  1565
    (aSymbol == #jumpabs) ifTrue:[extra := #absoffset. ^ 194].
1
77da9f5728e5 *** empty log message ***
claus
parents: 0
diff changeset
  1566
    (aSymbol == #makeBlockabs) ifTrue:[stackDelta := 1. extra := #absoffsetNvarNarg. ^ 195].
0
7ad01559b262 Initial revision
claus
parents:
diff changeset
  1567
    (aSymbol == #zeroJumpabs) ifTrue:[stackDelta := -1. extra := #absoffset. ^ 196].
7ad01559b262 Initial revision
claus
parents:
diff changeset
  1568
    (aSymbol == #notZeroJumpabs) ifTrue:[stackDelta := -1. extra := #absoffset. ^ 197].
1
77da9f5728e5 *** empty log message ***
claus
parents: 0
diff changeset
  1569
    (aSymbol == #eqJumpabs) ifTrue:[stackDelta := -2. extra := #absoffset. ^ 198].
77da9f5728e5 *** empty log message ***
claus
parents: 0
diff changeset
  1570
    (aSymbol == #notEqJumpabs) ifTrue:[stackDelta := -2. extra := #absoffset. ^ 199].
0
7ad01559b262 Initial revision
claus
parents:
diff changeset
  1571
7ad01559b262 Initial revision
claus
parents:
diff changeset
  1572
    (aSymbol == #pushThisContext) ifTrue:[stackDelta := 1. ^ 144].
7ad01559b262 Initial revision
claus
parents:
diff changeset
  1573
76
55d64cb1ffea *** empty log message ***
claus
parents: 54
diff changeset
  1574
    (aSymbol == #isNil) ifTrue:[^ 188].
55d64cb1ffea *** empty log message ***
claus
parents: 54
diff changeset
  1575
    (aSymbol == #notNil) ifTrue:[^ 189].
55d64cb1ffea *** empty log message ***
claus
parents: 54
diff changeset
  1576
    (aSymbol == #not) ifTrue:[lineno := true. ^ 179].
110
claus
parents: 109
diff changeset
  1577
    (aSymbol == #&) ifTrue:[lineno := true. ^ 216].
claus
parents: 109
diff changeset
  1578
    (aSymbol == #|) ifTrue:[lineno := true. ^ 217].
76
55d64cb1ffea *** empty log message ***
claus
parents: 54
diff changeset
  1579
117
claus
parents: 111
diff changeset
  1580
    (aSymbol == #pushClassVarL) ifTrue:[stackDelta := 1. extra := #speciallitL. ^ 218].
claus
parents: 111
diff changeset
  1581
    (aSymbol == #pushGlobalL) ifTrue:[stackDelta := 1. extra := #speciallitL. ^ 218].
claus
parents: 111
diff changeset
  1582
    (aSymbol == #storeClassVarL) ifTrue:[extra := #speciallitL.stackDelta := -1. ^ 219].
claus
parents: 111
diff changeset
  1583
    (aSymbol == #storeGlobalL) ifTrue:[extra := #speciallitL. stackDelta := -1. ^ 219].
claus
parents: 111
diff changeset
  1584
    (aSymbol == #pushLitL) ifTrue:[stackDelta := 1. extra := #unsigned16. ^ 201].
claus
parents: 111
diff changeset
  1585
claus
parents: 111
diff changeset
  1586
    (aSymbol == #sendL) ifTrue:[lineno := true. extra := #specialL. ^ 205].
claus
parents: 111
diff changeset
  1587
    (aSymbol == #sendSelfL) ifTrue:[lineno := true. extra := #specialL. ^ 207].
claus
parents: 111
diff changeset
  1588
    (aSymbol == #sendDropL) ifTrue:[lineno := true. extra := #specialL. ^ 204].
claus
parents: 111
diff changeset
  1589
    (aSymbol == #superSendL) ifTrue:[lineno := true. extra := #specialL. ^ 206].
claus
parents: 111
diff changeset
  1590
    (aSymbol == #hereSendL) ifTrue:[lineno := true. extra := #specialL. ^ 206].
106
claus
parents: 105
diff changeset
  1591
0
7ad01559b262 Initial revision
claus
parents:
diff changeset
  1592
    self error:'invalid code symbol'.
7ad01559b262 Initial revision
claus
parents:
diff changeset
  1593
    errorFlag := #Error
117
claus
parents: 111
diff changeset
  1594
claus
parents: 111
diff changeset
  1595
    "Modified: 3.9.1995 / 12:58:47 / claus"
0
7ad01559b262 Initial revision
claus
parents:
diff changeset
  1596
! !
49
02660b790c3e *** empty log message ***
claus
parents: 46
diff changeset
  1597
02660b790c3e *** empty log message ***
claus
parents: 46
diff changeset
  1598
!ByteCodeCompiler methodsFor:'machine code generation'!
02660b790c3e *** empty log message ***
claus
parents: 46
diff changeset
  1599
02660b790c3e *** empty log message ***
claus
parents: 46
diff changeset
  1600
compileToMachineCode:aString forClass:aClass inCategory:cat 
84
claus
parents: 78
diff changeset
  1601
			     notifying:requestor install:install skipIfSame:skipIfSame silent:silent
49
02660b790c3e *** empty log message ***
claus
parents: 46
diff changeset
  1602
    "this is called to compile primitive code.
02660b790c3e *** empty log message ***
claus
parents: 46
diff changeset
  1603
     This is EXPERIMENTAL and going to be changed to raise an error,
02660b790c3e *** empty log message ***
claus
parents: 46
diff changeset
  1604
     an redefined in subclasses which can do it (either by direct compilation, or by calling
02660b790c3e *** empty log message ***
claus
parents: 46
diff changeset
  1605
     the external stc do do it.
02660b790c3e *** empty log message ***
claus
parents: 46
diff changeset
  1606
     For a description of the arguments, see compile:forClass....."
02660b790c3e *** empty log message ***
claus
parents: 46
diff changeset
  1607
54
86c5b39c2eca *** empty log message ***
claus
parents: 49
diff changeset
  1608
    |stFileName stream handle address flags command oFileName soFileName 
120
claus
parents: 118
diff changeset
  1609
     initName newMethod ok status className sep class stcPath 
125
Claus Gittinger <cg@exept.de>
parents: 124
diff changeset
  1610
     errorStream errorMessages eMsg|
96
claus
parents: 95
diff changeset
  1611
125
Claus Gittinger <cg@exept.de>
parents: 124
diff changeset
  1612
    ObjectFileLoader isNil ifTrue:[^ #Error].
101
claus
parents: 98
diff changeset
  1613
    STCCompilation == #never ifTrue:[^ #Error].
120
claus
parents: 118
diff changeset
  1614
    (stcPath := self class incrementalStcPath) isNil ifTrue:[
claus
parents: 118
diff changeset
  1615
	self parseError:'no stc compiler available - cannot create machine code' position:1.
claus
parents: 118
diff changeset
  1616
	^ #Error
claus
parents: 118
diff changeset
  1617
    ].
54
86c5b39c2eca *** empty log message ***
claus
parents: 49
diff changeset
  1618
86c5b39c2eca *** empty log message ***
claus
parents: 49
diff changeset
  1619
    SequenceNumber isNil ifTrue:[
86c5b39c2eca *** empty log message ***
claus
parents: 49
diff changeset
  1620
	SequenceNumber := 0.
86c5b39c2eca *** empty log message ***
claus
parents: 49
diff changeset
  1621
    ].
86c5b39c2eca *** empty log message ***
claus
parents: 49
diff changeset
  1622
    SequenceNumber := SequenceNumber + 1.
49
02660b790c3e *** empty log message ***
claus
parents: 46
diff changeset
  1623
54
86c5b39c2eca *** empty log message ***
claus
parents: 49
diff changeset
  1624
    initName := 'ttt' , SequenceNumber printString.
86c5b39c2eca *** empty log message ***
claus
parents: 49
diff changeset
  1625
    stFileName := initName , '.st'. 
86c5b39c2eca *** empty log message ***
claus
parents: 49
diff changeset
  1626
    stream := stFileName asFilename writeStream.
97
claus
parents: 96
diff changeset
  1627
    sep := stream class chunkSeparator.
49
02660b790c3e *** empty log message ***
claus
parents: 46
diff changeset
  1628
101
claus
parents: 98
diff changeset
  1629
    class := aClass.
claus
parents: 98
diff changeset
  1630
    class isMeta ifTrue:[
claus
parents: 98
diff changeset
  1631
	class := aClass soleInstance
claus
parents: 98
diff changeset
  1632
    ].
claus
parents: 98
diff changeset
  1633
    class allSuperclasses reverseDo:[:cls|
54
86c5b39c2eca *** empty log message ***
claus
parents: 49
diff changeset
  1634
	cls ~~ Object ifTrue:[
110
claus
parents: 109
diff changeset
  1635
	    cls isLoaded ifFalse:[
claus
parents: 109
diff changeset
  1636
		^ #Error
claus
parents: 109
diff changeset
  1637
	    ].
54
86c5b39c2eca *** empty log message ***
claus
parents: 49
diff changeset
  1638
	    cls fileOutDefinitionOn:stream.
96
claus
parents: 95
diff changeset
  1639
	    stream nextPut:sep; cr.
54
86c5b39c2eca *** empty log message ***
claus
parents: 49
diff changeset
  1640
	]
86c5b39c2eca *** empty log message ***
claus
parents: 49
diff changeset
  1641
    ].
101
claus
parents: 98
diff changeset
  1642
    class fileOutDefinitionOn:stream.
96
claus
parents: 95
diff changeset
  1643
    stream nextPut:sep; cr.
54
86c5b39c2eca *** empty log message ***
claus
parents: 49
diff changeset
  1644
101
claus
parents: 98
diff changeset
  1645
    class fileOutPrimitiveDefinitionsOn:stream.
49
02660b790c3e *** empty log message ***
claus
parents: 46
diff changeset
  1646
96
claus
parents: 95
diff changeset
  1647
    stream nextPut:sep.
claus
parents: 95
diff changeset
  1648
    className := aClass name.
claus
parents: 95
diff changeset
  1649
49
02660b790c3e *** empty log message ***
claus
parents: 46
diff changeset
  1650
    aClass isMeta ifTrue:[
96
claus
parents: 95
diff changeset
  1651
	stream nextPutAll:(className copyTo:(className size - 5)); nextPutAll:' class'.
49
02660b790c3e *** empty log message ***
claus
parents: 46
diff changeset
  1652
    ] ifFalse:[
96
claus
parents: 95
diff changeset
  1653
	stream nextPutAll:className.
49
02660b790c3e *** empty log message ***
claus
parents: 46
diff changeset
  1654
    ].
96
claus
parents: 95
diff changeset
  1655
    stream nextPutAll:' methodsFor:'''; nextPutAll:cat; nextPutAll:''''.
claus
parents: 95
diff changeset
  1656
    stream nextPut:sep.
49
02660b790c3e *** empty log message ***
claus
parents: 46
diff changeset
  1657
    stream cr.
02660b790c3e *** empty log message ***
claus
parents: 46
diff changeset
  1658
125
Claus Gittinger <cg@exept.de>
parents: 124
diff changeset
  1659
    stream nextPutAll:'"{ Line: 0 }"'; cr; nextPutAll:aString.
96
claus
parents: 95
diff changeset
  1660
    stream nextPut:sep; space; nextPut:sep.
claus
parents: 95
diff changeset
  1661
49
02660b790c3e *** empty log message ***
claus
parents: 46
diff changeset
  1662
    stream close.
02660b790c3e *** empty log message ***
claus
parents: 46
diff changeset
  1663
02660b790c3e *** empty log message ***
claus
parents: 46
diff changeset
  1664
    "
02660b790c3e *** empty log message ***
claus
parents: 46
diff changeset
  1665
     call stc to compile it
02660b790c3e *** empty log message ***
claus
parents: 46
diff changeset
  1666
    "
94
claus
parents: 90
diff changeset
  1667
    oFileName := './' , initName , '.o'. 
claus
parents: 90
diff changeset
  1668
    oFileName asFilename delete.
49
02660b790c3e *** empty log message ***
claus
parents: 46
diff changeset
  1669
124
claus
parents: 120
diff changeset
  1670
    flags := '+sharedLibCode +newIncremental -EerrorOutput -N' , initName .
claus
parents: 120
diff changeset
  1671
    STCCompilationDefines notNil ifTrue:[
claus
parents: 120
diff changeset
  1672
	flags := STCCompilationDefines , ' ' , flags
claus
parents: 120
diff changeset
  1673
    ].
claus
parents: 120
diff changeset
  1674
    STCCompilationIncludes notNil ifTrue:[
claus
parents: 120
diff changeset
  1675
	flags := STCCompilationIncludes , ' ' , flags
claus
parents: 120
diff changeset
  1676
    ].
claus
parents: 120
diff changeset
  1677
    STCCompilationOptions notNil ifTrue:[
claus
parents: 120
diff changeset
  1678
	flags := STCCompilationOptions , ' ' , flags
54
86c5b39c2eca *** empty log message ***
claus
parents: 49
diff changeset
  1679
    ].
86c5b39c2eca *** empty log message ***
claus
parents: 49
diff changeset
  1680
101
claus
parents: 98
diff changeset
  1681
    command := stcPath , ' ' , flags , ' -c ' , stFileName.
54
86c5b39c2eca *** empty log message ***
claus
parents: 49
diff changeset
  1682
"/    command printNL.
86c5b39c2eca *** empty log message ***
claus
parents: 49
diff changeset
  1683
120
claus
parents: 118
diff changeset
  1684
    ok := OperatingSystem executeCommand:command.
claus
parents: 118
diff changeset
  1685
    status := OperatingSystem lastExecStatus.
101
claus
parents: 98
diff changeset
  1686
120
claus
parents: 118
diff changeset
  1687
    "for debugging - leave c intermediate"
claus
parents: 118
diff changeset
  1688
    STCKeepCIntermediate == true ifTrue:[
101
claus
parents: 98
diff changeset
  1689
	command := stcPath , ' ' , flags , ' -C ' , stFileName.
claus
parents: 98
diff changeset
  1690
	command printNL.
120
claus
parents: 118
diff changeset
  1691
	OperatingSystem executeCommand:command
49
02660b790c3e *** empty log message ***
claus
parents: 46
diff changeset
  1692
    ].
02660b790c3e *** empty log message ***
claus
parents: 46
diff changeset
  1693
94
claus
parents: 90
diff changeset
  1694
    oFileName asFilename exists ifTrue:[
claus
parents: 90
diff changeset
  1695
	ok ifFalse:[
claus
parents: 90
diff changeset
  1696
	    'oops - system says it failed - but o-file is there ...' printNL.
claus
parents: 90
diff changeset
  1697
	    ok := true
claus
parents: 90
diff changeset
  1698
	]
claus
parents: 90
diff changeset
  1699
    ] ifFalse:[
claus
parents: 90
diff changeset
  1700
	ok := false
claus
parents: 90
diff changeset
  1701
    ].
claus
parents: 90
diff changeset
  1702
54
86c5b39c2eca *** empty log message ***
claus
parents: 49
diff changeset
  1703
    ok ifFalse:[
86c5b39c2eca *** empty log message ***
claus
parents: 49
diff changeset
  1704
	status >= 16r200 ifTrue:[
120
claus
parents: 118
diff changeset
  1705
	    errorStream := 'errorOutput' asFilename readStream.
claus
parents: 118
diff changeset
  1706
	    errorStream notNil ifTrue:[
claus
parents: 118
diff changeset
  1707
		errorMessages := errorStream contents.
claus
parents: 118
diff changeset
  1708
		errorMessages notNil ifTrue:[
claus
parents: 118
diff changeset
  1709
		    errorMessages := errorMessages asStringCollection.
claus
parents: 118
diff changeset
  1710
		    errorMessages size > 20 ifTrue:[
claus
parents: 118
diff changeset
  1711
			errorMessages := (errorMessages copyTo:20) copyWith:'... more messages skipped'
claus
parents: 118
diff changeset
  1712
		    ].
claus
parents: 118
diff changeset
  1713
		    errorMessages := errorMessages asString
claus
parents: 118
diff changeset
  1714
		].
claus
parents: 118
diff changeset
  1715
	    ].
claus
parents: 118
diff changeset
  1716
	    errorMessages isNil ifTrue:[
claus
parents: 118
diff changeset
  1717
		errorMessages := ''
claus
parents: 118
diff changeset
  1718
	    ].
125
Claus Gittinger <cg@exept.de>
parents: 124
diff changeset
  1719
	    eMsg := ('STC error during compilation:\',errorMessages) withCRs.
54
86c5b39c2eca *** empty log message ***
claus
parents: 49
diff changeset
  1720
	] ifFalse:[
125
Claus Gittinger <cg@exept.de>
parents: 124
diff changeset
  1721
	    eMsg := 'oops, no STC - cannot create machine code'
54
86c5b39c2eca *** empty log message ***
claus
parents: 49
diff changeset
  1722
	].
125
Claus Gittinger <cg@exept.de>
parents: 124
diff changeset
  1723
	self parseError:eMsg position:1.
120
claus
parents: 118
diff changeset
  1724
	OperatingSystem removeFile:stFileName.
claus
parents: 118
diff changeset
  1725
	^ #Error
claus
parents: 118
diff changeset
  1726
    ].
claus
parents: 118
diff changeset
  1727
claus
parents: 118
diff changeset
  1728
    (ObjectFileLoader notNil 
claus
parents: 118
diff changeset
  1729
    and:[ObjectFileLoader canLoadObjectFiles]) ifFalse:[
claus
parents: 118
diff changeset
  1730
	self parseError:'no dynamic load configured - cannot load machine code' position:1.
claus
parents: 118
diff changeset
  1731
	OperatingSystem removeFile:stFileName.
54
86c5b39c2eca *** empty log message ***
claus
parents: 49
diff changeset
  1732
	^ #Error
86c5b39c2eca *** empty log message ***
claus
parents: 49
diff changeset
  1733
    ].
86c5b39c2eca *** empty log message ***
claus
parents: 49
diff changeset
  1734
49
02660b790c3e *** empty log message ***
claus
parents: 46
diff changeset
  1735
    OperatingSystem getOSType = 'irix' ifTrue:[
02660b790c3e *** empty log message ***
claus
parents: 46
diff changeset
  1736
	"
02660b790c3e *** empty log message ***
claus
parents: 46
diff changeset
  1737
	 link it to a shared object
02660b790c3e *** empty log message ***
claus
parents: 46
diff changeset
  1738
	"
54
86c5b39c2eca *** empty log message ***
claus
parents: 49
diff changeset
  1739
	soFileName := './' , initName , '.so'. 
86c5b39c2eca *** empty log message ***
claus
parents: 49
diff changeset
  1740
	OperatingSystem executeCommand:'rm -f ' , soFileName.
86c5b39c2eca *** empty log message ***
claus
parents: 49
diff changeset
  1741
	OperatingSystem executeCommand:'ld -shared -all -o ' , soFileName , ' ' , oFileName.
120
claus
parents: 118
diff changeset
  1742
	OperatingSystem removeFile:oFileName.
54
86c5b39c2eca *** empty log message ***
claus
parents: 49
diff changeset
  1743
	oFileName := soFileName. 
98
claus
parents: 97
diff changeset
  1744
    ] ifFalse:[
125
Claus Gittinger <cg@exept.de>
parents: 124
diff changeset
  1745
	OperatingSystem getOSType = 'sys5_4' ifTrue:[
98
claus
parents: 97
diff changeset
  1746
	    "
claus
parents: 97
diff changeset
  1747
	     link it to a shared object
claus
parents: 97
diff changeset
  1748
	    "
claus
parents: 97
diff changeset
  1749
	    soFileName := './' , initName , '.so'. 
claus
parents: 97
diff changeset
  1750
	    OperatingSystem executeCommand:'rm -f ' , soFileName.
claus
parents: 97
diff changeset
  1751
	    OperatingSystem executeCommand:'ld -G -o ' , soFileName , ' ' , oFileName.
120
claus
parents: 118
diff changeset
  1752
	    OperatingSystem removeFile:oFileName.
98
claus
parents: 97
diff changeset
  1753
	    oFileName := soFileName. 
claus
parents: 97
diff changeset
  1754
	].
49
02660b790c3e *** empty log message ***
claus
parents: 46
diff changeset
  1755
    ].
02660b790c3e *** empty log message ***
claus
parents: 46
diff changeset
  1756
02660b790c3e *** empty log message ***
claus
parents: 46
diff changeset
  1757
    "
02660b790c3e *** empty log message ***
claus
parents: 46
diff changeset
  1758
     load the objectfile
02660b790c3e *** empty log message ***
claus
parents: 46
diff changeset
  1759
    "
109
claus
parents: 108
diff changeset
  1760
    handle := ObjectFileLoader loadDynamicObject:oFileName.
49
02660b790c3e *** empty log message ***
claus
parents: 46
diff changeset
  1761
    handle isNil ifTrue:[
120
claus
parents: 118
diff changeset
  1762
	OperatingSystem removeFile:stFileName.
claus
parents: 118
diff changeset
  1763
	OperatingSystem removeFile:oFileName.
118
claus
parents: 117
diff changeset
  1764
	self parseError:'dynamic load failed - cannot create machine code' position:1.
49
02660b790c3e *** empty log message ***
claus
parents: 46
diff changeset
  1765
	^ #Error
02660b790c3e *** empty log message ***
claus
parents: 46
diff changeset
  1766
    ].
54
86c5b39c2eca *** empty log message ***
claus
parents: 49
diff changeset
  1767
"/    ('handle is ' , handle printString) printNL.
49
02660b790c3e *** empty log message ***
claus
parents: 46
diff changeset
  1768
54
86c5b39c2eca *** empty log message ***
claus
parents: 49
diff changeset
  1769
    address := ObjectFileLoader getFunction:'__' , initName , '_Init' from:handle.
49
02660b790c3e *** empty log message ***
claus
parents: 46
diff changeset
  1770
    address isNil ifTrue:[
54
86c5b39c2eca *** empty log message ***
claus
parents: 49
diff changeset
  1771
	address := ObjectFileLoader getFunction:'_' , initName , '_Init' from:handle.
49
02660b790c3e *** empty log message ***
claus
parents: 46
diff changeset
  1772
	address isNil ifTrue:[
125
Claus Gittinger <cg@exept.de>
parents: 124
diff changeset
  1773
	    (ObjectFileLoader getListOfUndefinedSymbolsFrom:handle) size > 0 ifTrue:[
Claus Gittinger <cg@exept.de>
parents: 124
diff changeset
  1774
		ObjectFileLoader listUndefinedSymbolsIn:handle.
Claus Gittinger <cg@exept.de>
parents: 124
diff changeset
  1775
		eMsg := 'undefined symbols in primitive code'.
Claus Gittinger <cg@exept.de>
parents: 124
diff changeset
  1776
	    ] ifFalse:[
Claus Gittinger <cg@exept.de>
parents: 124
diff changeset
  1777
		eMsg := initName , '_Init() lookup failed'
Claus Gittinger <cg@exept.de>
parents: 124
diff changeset
  1778
	    ].
Claus Gittinger <cg@exept.de>
parents: 124
diff changeset
  1779
Claus Gittinger <cg@exept.de>
parents: 124
diff changeset
  1780
	    ObjectFileLoader unloadDynamicObject:handle.
Claus Gittinger <cg@exept.de>
parents: 124
diff changeset
  1781
120
claus
parents: 118
diff changeset
  1782
	    OperatingSystem removeFile:stFileName.
claus
parents: 118
diff changeset
  1783
	    OperatingSystem removeFile:oFileName.
125
Claus Gittinger <cg@exept.de>
parents: 124
diff changeset
  1784
	    self parseError:(eMsg , ' - cannot create machine code') position:1.
49
02660b790c3e *** empty log message ***
claus
parents: 46
diff changeset
  1785
	    ^ #Error
02660b790c3e *** empty log message ***
claus
parents: 46
diff changeset
  1786
	]
02660b790c3e *** empty log message ***
claus
parents: 46
diff changeset
  1787
    ].
02660b790c3e *** empty log message ***
claus
parents: 46
diff changeset
  1788
54
86c5b39c2eca *** empty log message ***
claus
parents: 49
diff changeset
  1789
"/    ('init at ' , address printString) printNL.
86c5b39c2eca *** empty log message ***
claus
parents: 49
diff changeset
  1790
94
claus
parents: 90
diff changeset
  1791
    ObjectFileLoader 
claus
parents: 90
diff changeset
  1792
	callInitFunctionAt:address 
claus
parents: 90
diff changeset
  1793
	specialInit:true
claus
parents: 90
diff changeset
  1794
	forceOld:true 
claus
parents: 90
diff changeset
  1795
	interruptable:false
109
claus
parents: 108
diff changeset
  1796
	argument:2
claus
parents: 108
diff changeset
  1797
	identifyAs:handle.
49
02660b790c3e *** empty log message ***
claus
parents: 46
diff changeset
  1798
54
86c5b39c2eca *** empty log message ***
claus
parents: 49
diff changeset
  1799
    "
86c5b39c2eca *** empty log message ***
claus
parents: 49
diff changeset
  1800
     did it work ?
86c5b39c2eca *** empty log message ***
claus
parents: 49
diff changeset
  1801
    "
96
claus
parents: 95
diff changeset
  1802
    newMethod := aClass compiledMethodAt:selector.
54
86c5b39c2eca *** empty log message ***
claus
parents: 49
diff changeset
  1803
    newMethod notNil ifTrue:[
86c5b39c2eca *** empty log message ***
claus
parents: 49
diff changeset
  1804
	newMethod source:aString.
86c5b39c2eca *** empty log message ***
claus
parents: 49
diff changeset
  1805
	aClass addChangeRecordForMethod:newMethod.
86c5b39c2eca *** empty log message ***
claus
parents: 49
diff changeset
  1806
	(silent or:[Smalltalk silentLoading == true]) ifFalse:[
96
claus
parents: 95
diff changeset
  1807
	    Transcript showCr:('    compiled: ', className,' ',selector,' - machine code')
54
86c5b39c2eca *** empty log message ***
claus
parents: 49
diff changeset
  1808
	].
98
claus
parents: 97
diff changeset
  1809
	ObjectMemory flushCaches.
120
claus
parents: 118
diff changeset
  1810
claus
parents: 118
diff changeset
  1811
	OperatingSystem removeFile:stFileName.
claus
parents: 118
diff changeset
  1812
claus
parents: 118
diff changeset
  1813
	handle method:newMethod.
claus
parents: 118
diff changeset
  1814
claus
parents: 118
diff changeset
  1815
	"/ check for obsolete loaded objects and unload them
claus
parents: 118
diff changeset
  1816
claus
parents: 118
diff changeset
  1817
	ObjectFileLoader loadedObjectHandlesDo:[:anotherHandle |
claus
parents: 118
diff changeset
  1818
	    anotherHandle isMethodHandle ifTrue:[
claus
parents: 118
diff changeset
  1819
		anotherHandle method isNil ifTrue:[
claus
parents: 118
diff changeset
  1820
		    ObjectFileLoader unloadObjectFile:anotherHandle pathName.
claus
parents: 118
diff changeset
  1821
		    OperatingSystem removeFile:anotherHandle pathName.
claus
parents: 118
diff changeset
  1822
		]
claus
parents: 118
diff changeset
  1823
	    ]
claus
parents: 118
diff changeset
  1824
	].
54
86c5b39c2eca *** empty log message ***
claus
parents: 49
diff changeset
  1825
	^ newMethod.
86c5b39c2eca *** empty log message ***
claus
parents: 49
diff changeset
  1826
    ].
86c5b39c2eca *** empty log message ***
claus
parents: 49
diff changeset
  1827
120
claus
parents: 118
diff changeset
  1828
    OperatingSystem removeFile:stFileName.
claus
parents: 118
diff changeset
  1829
    OperatingSystem removeFile:oFileName.
54
86c5b39c2eca *** empty log message ***
claus
parents: 49
diff changeset
  1830
    self parseError:'dynamic load failed' position:1.
49
02660b790c3e *** empty log message ***
claus
parents: 46
diff changeset
  1831
    ^ #Error
02660b790c3e *** empty log message ***
claus
parents: 46
diff changeset
  1832
02660b790c3e *** empty log message ***
claus
parents: 46
diff changeset
  1833
    "
02660b790c3e *** empty log message ***
claus
parents: 46
diff changeset
  1834
     |m|
02660b790c3e *** empty log message ***
claus
parents: 46
diff changeset
  1835
02660b790c3e *** empty log message ***
claus
parents: 46
diff changeset
  1836
     Object subclass:#Test
02660b790c3e *** empty log message ***
claus
parents: 46
diff changeset
  1837
	    instanceVariableNames:''
02660b790c3e *** empty log message ***
claus
parents: 46
diff changeset
  1838
	    classVariableNames:''
02660b790c3e *** empty log message ***
claus
parents: 46
diff changeset
  1839
	    poolDictionaries:''
02660b790c3e *** empty log message ***
claus
parents: 46
diff changeset
  1840
	    category:'tests'.
02660b790c3e *** empty log message ***
claus
parents: 46
diff changeset
  1841
     m := ByteCodeCompiler
02660b790c3e *** empty log message ***
claus
parents: 46
diff changeset
  1842
	    compile:'foo ^ ''hello'''
02660b790c3e *** empty log message ***
claus
parents: 46
diff changeset
  1843
	    forClass:Test
02660b790c3e *** empty log message ***
claus
parents: 46
diff changeset
  1844
	    inCategory:'tests'
02660b790c3e *** empty log message ***
claus
parents: 46
diff changeset
  1845
	    notifying:nil
02660b790c3e *** empty log message ***
claus
parents: 46
diff changeset
  1846
	    install:false
02660b790c3e *** empty log message ***
claus
parents: 46
diff changeset
  1847
	    skipIfSame:false.
02660b790c3e *** empty log message ***
claus
parents: 46
diff changeset
  1848
     m inspect
02660b790c3e *** empty log message ***
claus
parents: 46
diff changeset
  1849
    "
02660b790c3e *** empty log message ***
claus
parents: 46
diff changeset
  1850
    "
02660b790c3e *** empty log message ***
claus
parents: 46
diff changeset
  1851
     |m|
02660b790c3e *** empty log message ***
claus
parents: 46
diff changeset
  1852
02660b790c3e *** empty log message ***
claus
parents: 46
diff changeset
  1853
     Object subclass:#Test
02660b790c3e *** empty log message ***
claus
parents: 46
diff changeset
  1854
	    instanceVariableNames:''
02660b790c3e *** empty log message ***
claus
parents: 46
diff changeset
  1855
	    classVariableNames:''
02660b790c3e *** empty log message ***
claus
parents: 46
diff changeset
  1856
	    poolDictionaries:''
02660b790c3e *** empty log message ***
claus
parents: 46
diff changeset
  1857
	    category:'tests'.
02660b790c3e *** empty log message ***
claus
parents: 46
diff changeset
  1858
     m := ByteCodeCompiler
02660b790c3e *** empty log message ***
claus
parents: 46
diff changeset
  1859
	    compileToMachineCode:'foo %{ RETURN (_MKSMALLINT(1)); %}'
02660b790c3e *** empty log message ***
claus
parents: 46
diff changeset
  1860
	    forClass:Test
02660b790c3e *** empty log message ***
claus
parents: 46
diff changeset
  1861
	    inCategory:'tests'
02660b790c3e *** empty log message ***
claus
parents: 46
diff changeset
  1862
	    notifying:nil
02660b790c3e *** empty log message ***
claus
parents: 46
diff changeset
  1863
	    install:false
02660b790c3e *** empty log message ***
claus
parents: 46
diff changeset
  1864
	    skipIfSame:false
02660b790c3e *** empty log message ***
claus
parents: 46
diff changeset
  1865
	    silent:false.
02660b790c3e *** empty log message ***
claus
parents: 46
diff changeset
  1866
     m inspect
02660b790c3e *** empty log message ***
claus
parents: 46
diff changeset
  1867
    "
120
claus
parents: 118
diff changeset
  1868
claus
parents: 118
diff changeset
  1869
    "Modified: 14.9.1995 / 22:33:04 / claus"
97
claus
parents: 96
diff changeset
  1870
!
claus
parents: 96
diff changeset
  1871
claus
parents: 96
diff changeset
  1872
trappingStubMethodFor:aString inCategory:cat
claus
parents: 96
diff changeset
  1873
    "return a stub method which traps and reports an error whenever
claus
parents: 96
diff changeset
  1874
     called."
claus
parents: 96
diff changeset
  1875
claus
parents: 96
diff changeset
  1876
    |newMethod lits|
claus
parents: 96
diff changeset
  1877
claus
parents: 96
diff changeset
  1878
    newMethod := Method new.
claus
parents: 96
diff changeset
  1879
    lits := self literalArray.
claus
parents: 96
diff changeset
  1880
    lits notNil ifTrue:[
claus
parents: 96
diff changeset
  1881
	"literals MUST be an array - not just any Collection"
claus
parents: 96
diff changeset
  1882
	lits := Array withAll:lits.
claus
parents: 96
diff changeset
  1883
	newMethod literals:lits
claus
parents: 96
diff changeset
  1884
    ].
124
claus
parents: 120
diff changeset
  1885
    newMethod makeUncompiled.
97
claus
parents: 96
diff changeset
  1886
    newMethod numberOfMethodVars:(self numberOfMethodVars).
claus
parents: 96
diff changeset
  1887
    newMethod numberOfMethodArgs:(self numberOfMethodArgs).
claus
parents: 96
diff changeset
  1888
    newMethod source:aString.
claus
parents: 96
diff changeset
  1889
    newMethod category:cat.
claus
parents: 96
diff changeset
  1890
    Project notNil ifTrue:[
98
claus
parents: 97
diff changeset
  1891
	newMethod package:(Project currentPackageName)
97
claus
parents: 96
diff changeset
  1892
    ].
claus
parents: 96
diff changeset
  1893
    ^ newMethod
49
02660b790c3e *** empty log message ***
claus
parents: 46
diff changeset
  1894
! !