"

 COPYRIGHT (c) 1989 by Claus Gittinger

	      All Rights Reserved

 This software is furnished under a license and may be used

 only in accordance with the terms of that license and with the

 inclusion of the above copyright notice.   This software may not

 be provided or otherwise made available to, or used by, any

 other person.  No title to or ownership of the software is

 hereby transferred.

"

"{ Package: 'stx:libcomp' }"

Parser subclass:#ByteCodeCompiler

	instanceVariableNames:'codeBytes codeIndex litArray stackDelta extra lineno extraLiteral

		maxStackDepth relocList methodTempVars numTemp maxNumTemp

		methodClass extraOP allLiterals allIdenticalLiterals

		breakpointedLines'

	classVariableNames:'JumpToAbsJump ShareCode ListCompiledMethods NewCodeSet

		NewPrimitives'

	poolDictionaries:''

	category:'System-Compiler'

!

!ByteCodeCompiler class methodsFor:'documentation'!

byteCode

"

    TOS   - top of stack

    NOS   - next on stack

    uu    - byte-valued unsigned (0..16rFF)

    uuuu  - twoByte-valued unsigned (0..16rFFFF); msb-first

    ll    - byte-valued literal index (0..16rFF)

    nn    - byte-valued signed (-128..+127)

    nnnn  - twoByte-valued signed (16r-8000 .. 16r7FFF)

    Notes:

	- bytecode optimized for space, not interpreter speed,

	  since JITTER is assumed to be present and compensate for decoding

	  overhead.

	- number assignments due to backward compatible extensions of the

	  bytecode set - reassignment & cleanup would be nice.

	- codes marked with (*) make the minimal set; all others duplicate

	  the functionality of a minimalSet code, but provides dense encoding

    definition of ST/X byteCode:

    *   00          RET_TOP         return TOS from current context

	01          RET_NIL         return nil from current context

	02          RET_TRUE        return true from current context

	03          RET_FALSE       return false from current context

	04          RET_0           return 0 (zero) from current context

	05          RET_SELF        return the current receiver from current context

    *   06          DUP_OVER        push NOS (used with inlined loops)

    *   07          HOME_RET_TOP    return TOS from home context (method return from block)

	08 uu       LINENO          line number information dummy

    *   09 uuuu     LINENO16        line number information dummy

	0A          PUSH_NIL        push nil onto stack

	0B          PUSH_TRUE       push true onto stack

	0C          PUSH_FALSE      push false onto stack

	0D          SEND_SELF       self-send

    *   0E ll       PUSH_LIT        push a literal

	0F          PUSH_SELF       push the current receiver onto stack

	10 nn       PUSH_NUM        push a byte-valued smallInteger onto stack

	11 nnnn     PUSH_NUM16      push a twoByte-valued smallInteger onto stack

    *   12          DROP            pop & forget

    *   13          SEND            send

    *   14          SUPER_SEND      super-send (actually: directed send)

	15          SEND0           send 0-arg message

	16          SEND1           send 1-arg message

	17          SEND2           send 2-arg message

	18          SEND3           send 3-arg message

	19          SEND_DROP       send & forget result

	1A          SEND0_DROP      send 0-arg message & forget result

	1B          SEND1_DROP      send 1-arg message & forget result

	1C          SEND2_DROP      send 2-arg message & forget result

	1D          SEND3_DROP      send 3-arg message & forget result

    *   1E          PUSH_MARG       push method arg

    *   1F          PUSH_MVAR       push method variable

    *   20          PUSH_BARG       push block arg

    *   21          PUSH_BVAR       push block variable

    *   22          PUSH_IVAR       push instance variable

	23          PUSH_CVAR       -- obsolete -- no longer used.

    *   24          PUSH_GLOB       push global

    *   25          STORE_MVAR      pop and store into method variable

    *   26          STORE_BVAR      pop and store into block variable

    *   27          STORE_IVAR      pop and store into instance variable

	28          STORE_CVAR      -- obsolete -- no longer used.

    *   29          STORE_GLOB      pop and store into global

    *   2A          PUSH_OBARG      push outer block arg (n levels)

	2B          PUSH_OBARG1     push outer block arg (1 level)

	2C          PUSH_OBARG2     push outer block arg (2 levels)

	2D          EQEQ            == -> pop a,b; push a==b

	2E          NENE            ~~ -> pop a,b; push a~~b

    *   2F          DUP             duplicate TOS

	30          EQEQ0           ==0 -> pop a; push a==0

	31          NENE0           ~~0 -> pop a; push a~~0

	32          JMP_FALSE       pop; branch if false

	33          JMP_TRUE        pop; branch if true

	34          JMP_NIL         pop; branch if nil

	35          JMP_NOTNIL      pop; branch if not nil

	36          JMP             branch always

	37          MAKE_BLOCK      make a block

	38          JMP_ZERO        pop; branch if ==0

	39          JMP_NOTZERO     pop; branch if ~~0

	3A          JMP_EQEQ        pop a,b; branch if a==b

	3B          JMP_NENE        pop a,b; branch if a~~b

	3C          JMPL_FALSE      like above, extended branch delta, (add +128/-128 to offs)

	...          ...

	45          JMPL_NENE       like above, extended branch delta, (add +128/-128 to offs)

	46          JMPVL_FALSE     like above, extended branch delta, (add +256/-256 to offs)

	...          ...

	4F          JMPVL_NENE      like above, extended branch delta, (add +256/-256 to offs)

	50          PUSH_MVAR1      push method variable 1 (first variable)

	51          PUSH_MVAR2      push method variable 2

	52          PUSH_MVAR3      push method variable 3

	53          PUSH_MVAR4      push method variable 4

	54          PUSH_MVAR5      push method variable 5

	55          PUSH_MVAR6      push method variable 6

	56          PUSH_MARG1      push method arg 1

	57          PUSH_MARG2      push method arg 2

	58          PUSH_MARG3      push method arg 3

	59          PUSH_MARG4      push method arg 4

	5A          PUSH_IVAR1      push inst variable 1 (first variable)

	5B          PUSH_IVAR2      push inst variable 2

	5C          PUSH_IVAR3      push inst variable 3

	5D          PUSH_IVAR4      push inst variable 4

	5E          PUSH_IVAR5      push inst variable 5

	5F          PUSH_IVAR6      push inst variable 6

	60          PUSH_IVAR7      push inst variable 7

	61          PUSH_IVAR8      push inst variable 8

	62          PUSH_IVAR9      push inst variable 9

	63          PUSH_IVAR10     push inst variable 10

	64          STORE_MVAR1     pop and store into method variable 1 (first variable)

	65          STORE_MVAR2     pop and store into method variable 2

	66          STORE_MVAR3     pop and store into method variable 3

	67          STORE_MVAR4     pop and store into method variable 4

	68          STORE_MVAR5     pop and store into method variable 5

	69          STORE_MVAR6     pop and store into method variable 6

	6A          unused

	6B          unused

	6C          unused

	6D          unused

	6E          STORE_IVAR1     pop and store into inst variable 1 (first variable)

	6F          STORE_IVAR2     pop and store into inst variable 2

	70          STORE_IVAR3     pop and store into inst variable 3

	71          STORE_IVAR4     pop and store into inst variable 4

	72          STORE_IVAR5     pop and store into inst variable 5

	73          STORE_IVAR6     pop and store into inst variable 6

	74          STORE_IVAR7     pop and store into inst variable 7

	75          STORE_IVAR8     pop and store into inst variable 8

	76          STORE_IVAR9     pop and store into inst variable 9

	77          STORE_IVAR10    pop and store into inst variable 10

	78          PUSH_0          push smallinteger 0 constant

	79          PUSH_1          push smallinteger 1 constant

	7A          PUSH_M1         push smallinteger -1 constant

	7B          SEND_PLUS1      send '+ 1' to TOS; replace TOS by result

	7C          SEND_MINUS1     send '- 1' to TOS; replace TOS by result

	7D          INC_MVAR        send '+ 1' to a method variable; store result into same mvar (for inlined loops)

	7E          DEC_MVAR        send '- 1' to a method variable; store result into same mvar (for inlined loops)

	7F nn       RET_NUM         return a smallInteger from current context

    *   80          PUSH_OBVAR      push outer block variable

    *   81          STORE_OBVAR     pop and store into outer block variable

	82          SEND_EQ         send #=

	83          SEND_PLUS       send #+

	84          SEND_NE         send #~=

	85          SEND_MINUS      send #-

	86          SEND_CLASS      send #class

	87          SEND_AT         send #at:

	88          SEND_ATPUT      send #at:put:

	89          SEND_BITAND     send #bitAnd:

	8A          SEND_BITOR      send #bitOr:

	8B          PUSH_2          push constant 2

	8C          PUSH_BARG1      push block argument 1

	8D          PUSH_BARG2

	8E          PUSH_BARG3

	8F          PUSH_BARG4

    *   90          PUSH_CONTEXT    push thisContext

	91          SEND_GT         send >

	92          SEND_GE         send >=

	93          SEND_LT         send <

	94          SEND_LE         send <=

	95          UNUSED_149      obsolete; was: send #next

	96          UNUSED_150      obsolete; was: send #peek

	97          SEND_VALUE      send #value

	98          SEND_VALUE1     send #value:

	99          SEND_SIZE       send #size

	9A          UNUSED_154

	9B          UNUSED_155

	9C          MK0BLOCK        make a 0-returning block

	9D          MKNILBLOCK      make a nil-returning block

	9E          UNUSED_158      obsolete; was: send #asInteger */

	9F          UNUSED_159      obsolete; was: send #rounded */

	A0          RET_MVAR1       return method variable 1 from current context

	A1          RET_MVAR2       return method variable 2 from current context

	A2          RET_MVAR3

	A3          RET_MVAR4

	A4          RET_MVAR5

	A5          RET_MVAR6       return method variable 6 from current context

	A6          RET_IVAR1       return instance variable 1 from current context

	A7          RET_IVAR2       return instance variable 2 from current context

	A8          RET_IVAR3

	A9          RET_IVAR4

	AA          RET_IVAR5

	AB          RET_IVAR6

	AC          RET_IVAR7

	AD          RET_IVAR8       return instance variable 8 from current context

	AE          RET_MARG1       return method arg 1 from current context

	AF          RET_MARG2       return method arg 1 from current context

	B0          PUSH_CIVAR      obsolete; push class instance variable

	B1          STORE_CIVAR     obsolete; store top of stack in class instance variable

	B2          SEND_VALUE2     send #value:value:

	B3          SEND_NOT        send #not

	B4          SEND_SELF0      send a 0-arg message to self

	B5          SEND_SELF1      send a 1-arg message to self

	B6          SEND_SELF2      send a 2-arg message to self

	B7          SEND_SELF3      send a 3-arg message to self

	B8          SEND_SELF_DROP0 send a 0-arg message to self forget result

	B9          SEND_SELF_DROP1 send a 1-arg message to self forget result

	BA          SEND_SELF_DROP2 send a 2-arg message to self forget result

	BB          SEND_SELF_DROP3 send a 3-arg message to self forget result

	BC          ISNIL           replace TOS by 'TOS isNil'

	BD          NOTNIL          replace TOS by 'TOS notNil'

	BE uuuu     JMPA_FALSE      jumps to absolute offset (2 byte hi-lo)

	BF uuuu     JMPA_TRUE

	C0 uuuu     JMPA_NIL

	C1 uuuu     JMPA_NOTNIL

	C2 uuuu     JMPA

	C3          MAKE_ABLOCK

	C4 uuuu     JMPA_ZERO

	C5 uuuu     JMPA_NOTZERO

	C6 uuuu     JMPA_EQ

	C7 uuuu     JMPA_NOTEQ

	C8 xx       PUSH_GSPECIAL   push a special global; xx specifies what:

	   00        Array   (push 'Smalltalk at:#Array'; i.e. the Array class)

	   01        String  (push 'Smalltalk at:#String'; i.e. the String class)

	   02        FloatArray

	   03        DoubleArray

	   04        Point

	   05        Symbol

	   06        Smalltalk

	   07        Processor

	   08        SmallInteger

	   09        Character

	   0A        Float

	   0B        Process

	   0C        Set

	   0D        IdentitySet

	   0E        Dictionary

	   0F        IdentityDictionary

	   10        Semaphore

	   11        OrderedCollection

	C9 uuuu     PUSH_LLIT       push a literal (2-byte literal-number)

	CA nn       JMP_FALSE_L     jump if top is false (+127 .. -128)

	CB nn       JMP_TRUE_L      jump if top is true

	CC          UNUSED_204

	CD          LSEND_MSG       send with 16 bit literal index */

	CE          LSUPERSEND_MSG  super send with 16 bit literal index */

	CF          LSEND_SELF      self-send send with 16 bit literal index */

	D0          PUSH_GT0        push 'TOS > 0'; leaves original TOS as NOS

	D1          UNUSED_209

	D2          SEND_ARRAY_NEW  use for new/basicNew; top is size (0 for Array new)

	D3          SEND_BASICNEW   top is class (receiver)

	D4          SEND_GT0        replace TOS by result of send 'TOS > 0'

	D5          SEND_NEW        top is class (receiver)

	D6          SEND_BASICNEWN  top is class (receiver) and arg

	D7          SEND_NEWN       top is class (receiver) and arg

	D8          SEND_LOGAND     send &

	D9          SEND_LOGOR      send |

	DA uuuu     PUSH_LGLOB      push global variable word index literal

	DB uuuu     STORE_LGLOB     store global with word index literal

	DC          UNUSED_220

	DE          UNUSED_221

	DF          PUSH_LIT1       push 1st literal

	E0          PUSH_LIT2       push 2nd literal

	E1          PUSH_LIT3       push literal 3

	E2          PUSH_LIT4       push literal 4

	E3          PUSH_LIT5       push literal 5

	E4          PUSH_LIT6       push literal 6

	E5          PUSH_LIT7       push literal 7

	E6          PUSH_LIT8       push literal 8

	E7          SEND_MUL        send #*

	E8 xx       SEND_SPECIAL    special send; as specified by xx:

	   00         top           send #top

	   01         bottom        send #bottom

	   02         left          send #left

	   03         right         send #right

	   04         x             send #x

	   05         y             send #y

	   06         width         send #width

	   07         height        send #height

	   08         origin        send #origin

	   09         extent        send #extent

	   0A         asInteger     send #asInteger

	   0B         rounded       send #rounded

	   0C         next          send #next

	   0D         peek          send #peek

	E9          PUSH_BVAR1      push block variable 1

	EA          PUSH_BVAR2      push block variable 2

	EB          PUSH_BVAR3      push block variable 3

	EC          STORE_BVAR1     store TOS in block variable 1 and drop

	ED          STORE_BVAR2     store TOS in block variable 2 and drop

	EE          STORE_BVAR3     store TOS in block variable 3 and drop

     *  EF          BLOCK_REF       internal - check if a block is referenced by TOS

	F0          PUSH_LVAR       push local variable 0..numArgs-1 for args; numArgs..numArgs+nLocal-1 for mVars

	F1          STORE_LVAR      store local variable 0..numArgs-1 for args; numArgs..numArgs+nLocal-1 for mVars

	F2          UNUSED_242

	F3          UNUSED_243

	F4          UNUSED_244

	F5          UNUSED_245

	F6          UNUSED_246

	F7          UNUSED_247

	F8          UNUSED_248

	F9          UNUSED_249

	FA          UNUSED_250

	FB          UNUSED_251

	FC          UNUSED_252

	FD          UNUSED_253

	FE          UNUSED_254

	FF          UNUSED_255

    [author:]

	Claus Gittinger

"

!

copyright

"

 COPYRIGHT (c) 1989 by Claus Gittinger

	      All Rights Reserved

 This software is furnished under a license and may be used

 only in accordance with the terms of that license and with the

 inclusion of the above copyright notice.   This software may not

 be provided or otherwise made available to, or used by, any

 other person.  No title to or ownership of the software is

 hereby transferred.

"

!

documentation

"

    This class performs compilation into ByteCodes.

    First, parsing is done using superclass methods,

    then the parse-tree is converted into an array of symbolic codes

    and a relocation table;

    these two are finally combined into a byteArray of the codes.

    (the intermediate step through symbolic codes is for debugging

     only - it may vanish in future releases)

    There are many dependencies to the run-time-system (especially the

    interpreter) in here - be careful when playing around ...

    [Instance variables:]

	codeBytes       <ByteArry>              bytecodes

	codeIndex       <SmallInteger>          next index to put into code array

	litArray        <OrderedCollection>     literals

	stackDelta      <SmallInteger>          return value of byteCodeFor:

	extra           <Symbol>                return value of byteCodeFor:

	lineno          <Boolean>               return value of byteCodeFor:

	extraLiteral    <Symbol>                return value of byteCodeFor:

	maxStackDepth   <SmallInteger>          stack need of method

	relocList       <Array>                 used temporary for relocation

    [Class variables:]

	JumpToAbsJump   <Dictionary>            internal table to map opcodes

	STCCompilationDefines                   passed to stc as command line arguments

	STCCompilationIncludes

	STCCompilationOptions

			<String>

	STCCompilation  <Symbol>                #always, #primitiveOnly or #never

						controls when stc compilation is wanted

	ShareCode       <Boolean>               reuse byteArrays for common (simple) code sequences

						This is normally a 'good' optimization,

						except if you plan to modify the byteCodes.

    [author:]

	Claus Gittinger

"

! !

!ByteCodeCompiler class methodsFor:'initialization'!

initialize

    Smalltalk vmMajorVersionNr >= 5 ifTrue:[

	NewCodeSet := true.

	NewPrimitives := true.

    ] ifFalse:[

	NewCodeSet := false.

	NewPrimitives := false.

    ].

    ShareCode := true.

    ListCompiledMethods := false.

    RestartCompilationSignal := Signal new.

    "Modified: / 15.11.2001 / 17:20:51 / cg"

!

newCodeSet

    ^ NewCodeSet

!

newCodeSet:aBoolean

    NewCodeSet := aBoolean.

    "

     ByteCodeCompiler newCodeSet:true

    "

!

newPrimitives

    ^ NewPrimitives

!

newPrimitives:aBoolean

    NewPrimitives := aBoolean.

    "

     ByteCodeCompiler newPrimitives:true

    "

! !

!ByteCodeCompiler class methodsFor:'compiling methods'!

compile:methodText forClass:classToCompileFor

    "compile a source-string for a method in classToCompileFor.

     Returns the new method, #Error or nil."

    ^ self

	compile:methodText

	forClass:classToCompileFor

	inCategory:'others'

	notifying:nil

	install:true

	skipIfSame:false

	silent:false

!