"

 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'

	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

!

compile:aString forClass:aClass inCategory:cat

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