"

 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.

"

Parser subclass:#ByteCodeCompiler

	instanceVariableNames:'codeBytes codeIndex litArray stackDelta extra lineno extraLiteral

		maxStackDepth relocList methodTempVars numTemp maxNumTemp'

	classVariableNames:'JumpToAbsJump SequenceNumber STCCompilationDefines

		STCCompilationIncludes STCCompilationOptions STCCompilation

		ShareCode STCKeepSTIntermediate STCKeepCIntermediate

		STCModulePath CCCompilationOptions CC STC ListCompiledMethods

		STCKeepOIntermediate Verbose'

	poolDictionaries:''

	category:'System-Compiler'

!

!ByteCodeCompiler class methodsFor:'documentation'!

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

	SequenceNumber  <Integer>               counting intermediate stc-compiled

						objects (for unique o-file naming)

	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,

						expect if you plan to modify the byteCodes.

    [author:]

	Claus Gittinger

"

! !

!ByteCodeCompiler class methodsFor:'initialization'!

initialize

    ShareCode := true.

    STCKeepCIntermediate := false.

    STCKeepOIntermediate := false.

    STCKeepSTIntermediate := false.

    STCModulePath := './modules'.

    ListCompiledMethods := false.

   "

    STCKeepCIntermediate := true.

    STCKeepOIntermediate := true.

    STCKeepSTIntermediate := true.

   "

    "Modified: / 21.10.1998 / 15:39:52 / cg"

! !

!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.

     The method will get cat as category.

     Returns the new method, #Error or nil."

    ^ self 

        compile:aString

        forClass:aClass

        inCategory:cat

        notifying:nil

        install:true

        skipIfSame:false

        silent:false

!

compile:aString forClass:aClass inCategory:cat notifying:requestor

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

     errors are forwarded to requestor.

     The method will get cat as category.

     Returns the new method, #Error or nil."

    ^ self 

        compile:aString

        forClass:aClass

        inCategory:cat

        notifying:requestor

        install:true

        skipIfSame:false

        silent:false

!

compile:aString forClass:aClass inCategory:cat notifying:requestor install:install

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

     The install-argument controls if the method is to be installed into the

     classes method-dictionary, or just to be compiled and a method object to be returned.

     Errors are forwarded to requestor. The method will get cat as category.

     Returns the new method, #Error or nil."

    ^ self 

        compile:aString

        forClass:aClass

        inCategory:cat

        notifying:requestor

        install:install

        skipIfSame:false

        silent:false

!

compile:aString forClass:aClass inCategory:cat notifying:requestor

                 install:install skipIfSame:skipIfSame

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

     The install-argument controls if the method is to be installed into the

     classes method-dictionary, or just to be compiled and a method object to be returned.

     Errors are forwarded to requestor. The method will get cat as category.

     If skipIsSame is true, and the source is the same as an existing

     methods source, this is a noop (for fast fileIn).

     Returns the new method, #Error or nil."

    ^ self 

        compile:aString

        forClass:aClass

        inCategory:cat

        notifying:requestor

        install:install

        skipIfSame:skipIfSame

        silent:false

!

compile:aString forClass:aClass inCategory:cat notifying:requestor

                 install:install skipIfSame:skipIfSame silent:silent

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

     errors are forwarded to requestor.

     The method will get cat as category.

     if install is true, the method is installed in the class.

     if skipIfSame, the method is not installed if there is no change

     (used when filing in).

     if silent is true, no warnings are output.

     Returns the new method, #Error or nil."

    ^ self

        compile:aString

        forClass:aClass

        inCategory:cat

        notifying:requestor

        install:install

        skipIfSame:skipIfSame

        silent:silent

        foldConstants:true

!

compile:aString forClass:aClass inCategory:cat notifying:requestor

                 install:install skipIfSame:skipIfSame silent:silent foldConstants:fold

    "the basic workhorse method for compiling:

     compile a source-string for a method in classToCompileFor.

     errors are forwarded to requestor 

     (report on Transcript and return #Error, if requestor is nil).

     The new method will get cat as category. 

     If install is true, the method will go into the classes method-table, 

     otherwise the method is simply returned (for anonymous methods).

     If skipIsSame is true, and the source is the same as an existing

     methods source, this is a noop (for fast fileIn).

     The argument, silent controls if errors are to be reported.

     Returns the method, #Error or nil."

    |compiler newMethod tree symbolicCodeArray oldMethod lazy silencio 

     sourceFile sourceStream newSource primNr pos sel keptOldCode msg answer

     pkg|

    aString isNil ifTrue:[^ nil].

    silencio := silent 

                or:[Smalltalk silentLoading == true

                or:[ListCompiledMethods == false]].

    "lazy compilation is EXPERIMENTAL"

    lazy := (LazyCompilation == true) and:[install].

    "create a compiler, let it parse and create the parsetree"

    compiler := self for:(ReadStream on:aString) in:aClass.

    compiler parseForCode.

    fold ifFalse:[compiler foldConstants:nil].

    compiler notifying:requestor.

    silent ifTrue:[

"/        compiler ignoreErrors.

        compiler ignoreWarnings.

        compiler warnUndeclared:false.

    ].

"/    compiler nextToken.

    (compiler parseMethodSpec == #Error) ifTrue:[

        compiler parseError:'syntax error in method specification'.

        tree := #Error

    ] ifFalse:[

        ].

        lazy ifTrue:[

            "/

            "/ that one method IS required

            "/

            (aClass isMeta and:[compiler selector == #version]) ifTrue:[

                lazy := false

            ]

        ].

        lazy ifFalse:[

            "check if same source"

            (skipIfSame and:[(sel := compiler selector) notNil]) ifTrue:[

                oldMethod := aClass compiledMethodAt:sel.

                oldMethod notNil ifTrue:[

                    oldMethod source = aString ifTrue:[

                        oldMethod isInvalid ifFalse:[

                            silencio ifFalse:[

                                Transcript showCR:('    unchanged: ',aClass name,' ',compiler selector)

                            ].

                            "

                             same. however, category may be different

                            "

                            (cat notNil and:[cat ~= oldMethod category]) ifTrue:[

                                oldMethod category:cat.

                                oldMethod changed:#category.    

"/                                aClass updateRevisionString.

                                aClass addChangeRecordForMethodCategory:oldMethod category:cat.

                                silencio ifFalse:[

                                    Transcript showCR:('    (category change only)')

                                ].

                            ].

                            "

                             and package may be too.

                            "

                            (pkg notNil and:[pkg ~~ oldMethod package]) ifTrue:[

                                oldMethod package:pkg.

                                silencio ifFalse:[

                                    Transcript showCR:('    (package-id change only)')

                                ].

                            ].

                            ^ oldMethod

                        ]

                    ]

                ]

            ].

            tree := compiler parseMethodBody.

            compiler tree:tree.

        ]

    ].

    (compiler errorFlag or:[tree == #Error]) ifTrue:[

        compiler showErrorMessageForClass:aClass.

        ^ #Error

    ].

    sel := compiler selector.

    "if no error and also no selector ..."

     sel isNil ifTrue:[

        "... it was just a comment or other empty stuff"

        ^ nil

    ].

    lazy ifFalse:[

        "

         freak-out support for inline C-code...

        "

        ((compiler hasNonOptionalPrimitiveCode 

        or:[(compiler hasPrimitiveCode and:[self canCreateMachineCode])

        or:[STCCompilation == #always and:[sel ~~ #doIt]]])

        and:[STCCompilation ~~ #never]) ifTrue:[

            newMethod := compiler 

                            compileToMachineCode:aString 

                            forClass:aClass 

                            inCategory:cat 

                            notifying:requestor

                            install:install 

                            skipIfSame:skipIfSame 

                            silent:silent.

            newMethod == #Error ifTrue:[

                compiler showErrorMessageForClass:aClass.

                ^ #Error

            ].

            (newMethod == #CannotLoad) ifTrue:[

                newMethod := compiler trappingStubMethodFor:aString inCategory:cat.

                newMethod package:pkg.

                keptOldCode := false.

                install ifTrue:[

                    "/

                    "/ be very careful with existing methods

                    "/ (otherwise, you could easily make your system unusable in systems which cannot load)

                    "/

                    sel notNil ifTrue:[

                        oldMethod := aClass compiledMethodAt:sel 

                    ].

                    (oldMethod notNil and:[oldMethod code ~= newMethod code]) ifTrue:[

                        answer := Dialog

                                     confirm:

'installation of binary code for ''' , aClass name , '>>' , compiler selector , '''

is not possible or disabled.

Shall I use the old methods functionality

or instead create a dummy trap method for it ?

Hint:

  if that method is needed by the system, you better leave the

  original functionality in the system.

Close this warnBox to abort the compilation.

'

                                     yesLabel:'trap code'

                                     noLabel:'keep old'.

                        answer isNil ifTrue:[

                            ^ #Error

                        ].

                        answer == false ifTrue:[

                            newMethod code:(oldMethod code).

                            keptOldCode := true.

                        ].

                    ].

                    aClass addSelector:sel withMethod:newMethod

                ].

                Transcript show:'*** '.

                sel notNil ifTrue:[

                    Transcript show:(sel ,' ')

                ].

                keptOldCode ifTrue:[

                    msg := 'not really compiled - method still shows previous behavior'.

                ] ifFalse:[

                    msg := 'not compiled to machine code - created a stub instead.'.

                ].

                Transcript showCR:msg.

            ].

            ^ newMethod

        ].

    ].

    compiler hasNonOptionalPrimitiveCode ifTrue:[

        newMethod := compiler trappingStubMethodFor:aString inCategory:cat.

        install ifTrue:[

            aClass addSelector:sel withMethod:newMethod.

        ].

        Transcript show:'*** '.

        sel notNil ifTrue:[

            Transcript show:(sel ,' ')

        ].

        Transcript showCR:'not compiled to machine code - created a stub instead.'.

        ^ newMethod

    ].

    "

     EXPERIMENTAL: quick loading

     only create a lazyMethod, which has no byteCode and will 

     compile itself when first called.

    "

    lazy ifTrue:[

        newMethod := LazyMethod new.

        (ClassCategoryReader sourceMode == #sourceReference) ifTrue:[

            sourceFile := ObjectMemory nameForSources.

            sourceFile notNil ifTrue:[    

                sourceStream := sourceFile asFilename appendingWriteStream.

            ]

        ].

        sourceStream isNil ifTrue:[

            newMethod source:aString string.

        ] ifFalse:[

            sourceStream setToEnd.

            pos := sourceStream position.

            sourceStream nextChunkPut:aString.

            sourceStream close.

            newMethod sourceFilename:sourceFile position:pos.

        ].

        newMethod category:cat.

"/        Project notNil ifTrue:[

"/            newMethod package:(Project currentPackageName)

"/        ].

        aClass addSelector:sel withLazyMethod:newMethod.

        ^ newMethod

    ].

    (primNr := compiler primitiveNumber) isNil ifTrue:[

        "

         produce symbolic code first

        "

        symbolicCodeArray := compiler genSymbolicCode.

        (symbolicCodeArray == #Error) ifTrue:[

            Transcript show:'    '.

            sel notNil ifTrue:[

                Transcript show:(sel ,' ')

            ].

            Transcript showCR:'translation error'.

            ^ #Error

        ].

        "

         take this, producing bytecode 

         (someone willin' to make machine code :-)

        "

        ((compiler genByteCodeFrom:symbolicCodeArray) == #Error) ifTrue:[

            Transcript show:'    '.

             sel notNil ifTrue:[

                Transcript show:(sel ,' ')

            ].

            Transcript showCR:'relocation error - must be simplified'.

            ^ #Error

        ].

    ].