ByteCodeCompiler.st
changeset 98 ccc7f9389a8e
parent 97 3b0d380771e9
child 101 845d70bbd94d
equal deleted inserted replaced
97:3b0d380771e9 98:ccc7f9389a8e
    24 
    24 
    25 ByteCodeCompiler comment:'
    25 ByteCodeCompiler comment:'
    26 COPYRIGHT (c) 1989 by Claus Gittinger
    26 COPYRIGHT (c) 1989 by Claus Gittinger
    27 	     All Rights Reserved
    27 	     All Rights Reserved
    28 
    28 
    29 $Header: /cvs/stx/stx/libcomp/ByteCodeCompiler.st,v 1.26 1995-07-03 02:38:16 claus Exp $
    29 $Header: /cvs/stx/stx/libcomp/ByteCodeCompiler.st,v 1.27 1995-07-23 02:22:57 claus Exp $
    30 '!
    30 '!
    31 
    31 
    32 !ByteCodeCompiler class methodsFor:'documentation'!
    32 !ByteCodeCompiler class methodsFor:'documentation'!
    33 
    33 
    34 copyright
    34 copyright
    45 "
    45 "
    46 !
    46 !
    47 
    47 
    48 version
    48 version
    49 "
    49 "
    50 $Header: /cvs/stx/stx/libcomp/ByteCodeCompiler.st,v 1.26 1995-07-03 02:38:16 claus Exp $
    50 $Header: /cvs/stx/stx/libcomp/ByteCodeCompiler.st,v 1.27 1995-07-23 02:22:57 claus Exp $
    51 "
    51 "
    52 !
    52 !
    53 
    53 
    54 documentation
    54 documentation
    55 "
    55 "
    80 
    80 
    81 	JumpToAbsJump   <Dictionary>            internal table to map opcodes
    81 	JumpToAbsJump   <Dictionary>            internal table to map opcodes
    82 "
    82 "
    83 ! !
    83 ! !
    84 
    84 
       
    85 !ByteCodeCompiler methodsFor:'ST-80 compatibility'!
       
    86 
       
    87 compile:textOrStream in:aClass notifying:requestor ifFail:exceptionBlock
       
    88     "name alias for ST-80 compatibility"
       
    89 
       
    90     ^ self class
       
    91 		compile:textOrStream
       
    92 		in:aClass 
       
    93 		notifying:requestor 
       
    94 		ifFail:exceptionBlock
       
    95 "/    |m|
       
    96 "/
       
    97 "/    m := self class 
       
    98 "/                compile:textOrStream 
       
    99 "/                forClass:aClass 
       
   100 "/                inCategory:'no category'
       
   101 "/                notifying:requestor
       
   102 "/                install:true 
       
   103 "/                skipIfSame:false
       
   104 "/                silent:false.
       
   105 "/    m == #Error ifTrue:[
       
   106 "/        ^ exceptionBlock value
       
   107 "/    ].
       
   108 "/     ^ m
       
   109 ! !
       
   110 
    85 !ByteCodeCompiler class methodsFor:'compiling methods'!
   111 !ByteCodeCompiler class methodsFor:'compiling methods'!
    86 
   112 
    87 compile:textOrStream in:aClass notifying:aRequestor ifFail:aBlock
   113 compile:textOrStream in:aClass notifying:requestor ifFail:exceptionBlock
    88     "name alias for ST-80 compatibility"
   114     "name alias for ST-80 compatibility"
    89 
   115 
    90     ^ self compile:textOrStream
   116     |m|
       
   117 
       
   118     m := self 
       
   119 	   compile:textOrStream
    91 	  forClass:aClass 
   120 	  forClass:aClass 
    92 	inCategory:'others'
   121 	inCategory:'others'
    93 	 notifying:aRequestor 
   122 	 notifying:requestor 
    94 	   install:true
   123 	   install:true
    95 	skipIfSame:false
   124 	skipIfSame:false
    96 	    silent:false
   125 	    silent:false.
       
   126     m == #Error ifTrue:[
       
   127 	^ exceptionBlock value
       
   128     ].
       
   129      ^ m
       
   130 
    97 !
   131 !
    98 
   132 
    99 compile:methodText forClass:classToCompileFor
   133 compile:methodText forClass:classToCompileFor
   100     "compile a source-string for a method in classToCompileFor"
   134     "compile a source-string for a method in classToCompileFor"
   101 
   135 
   310 	    sourceStream close.
   344 	    sourceStream close.
   311 	    newMethod sourceFilename:sourceFile position:pos.
   345 	    newMethod sourceFilename:sourceFile position:pos.
   312 	].
   346 	].
   313 	newMethod category:cat.
   347 	newMethod category:cat.
   314 	Project notNil ifTrue:[
   348 	Project notNil ifTrue:[
   315 	    newMethod package:(Project current packageName)
   349 	    newMethod package:(Project currentPackageName)
   316 	].
   350 	].
   317 
   351 
   318 	aClass addSelector:sel withLazyMethod:newMethod.
   352 	aClass addSelector:sel withLazyMethod:newMethod.
   319 	^ newMethod
   353 	^ newMethod
   320     ].
   354     ].
   375     ] ifFalse:[
   409     ] ifFalse:[
   376 	newMethod source:aString.
   410 	newMethod source:aString.
   377     ].
   411     ].
   378     newMethod category:cat.
   412     newMethod category:cat.
   379     Project notNil ifTrue:[
   413     Project notNil ifTrue:[
   380 	newMethod package:(Project current packageName)
   414 	newMethod package:(Project currentPackageName)
   381     ].
   415     ].
   382 
   416 
   383     install ifTrue:[
   417     install ifTrue:[
   384 	aClass addSelector:sel withMethod:newMethod
   418 	aClass addSelector:sel withMethod:newMethod
   385     ].
   419     ].
  1399      For a description of the arguments, see compile:forClass....."
  1433      For a description of the arguments, see compile:forClass....."
  1400 
  1434 
  1401     |stFileName stream handle address flags command oFileName soFileName 
  1435     |stFileName stream handle address flags command oFileName soFileName 
  1402      initName newMethod ok status className sep|
  1436      initName newMethod ok status className sep|
  1403 
  1437 
  1404     ForceNoSTCCompilation ifTrue:[^ #Error].
  1438     ForceNoSTCCompilation == true ifTrue:[^ #Error].
  1405 
  1439 
  1406     SequenceNumber isNil ifTrue:[
  1440     SequenceNumber isNil ifTrue:[
  1407 	SequenceNumber := 0.
  1441 	SequenceNumber := 0.
  1408     ].
  1442     ].
  1409     SequenceNumber := SequenceNumber + 1.
  1443     SequenceNumber := SequenceNumber + 1.
  1501 	"
  1535 	"
  1502 	soFileName := './' , initName , '.so'. 
  1536 	soFileName := './' , initName , '.so'. 
  1503 	OperatingSystem executeCommand:'rm -f ' , soFileName.
  1537 	OperatingSystem executeCommand:'rm -f ' , soFileName.
  1504 	OperatingSystem executeCommand:'ld -shared -all -o ' , soFileName , ' ' , oFileName.
  1538 	OperatingSystem executeCommand:'ld -shared -all -o ' , soFileName , ' ' , oFileName.
  1505 	oFileName := soFileName. 
  1539 	oFileName := soFileName. 
       
  1540     ] ifFalse:[
       
  1541 	OperatingSystem getOSType = 'sys5.4' ifTrue:[
       
  1542 	    "
       
  1543 	     link it to a shared object
       
  1544 	    "
       
  1545 	    soFileName := './' , initName , '.so'. 
       
  1546 	    OperatingSystem executeCommand:'rm -f ' , soFileName.
       
  1547 	    OperatingSystem executeCommand:'ld -G -o ' , soFileName , ' ' , oFileName.
       
  1548 	    oFileName := soFileName. 
       
  1549 	].
  1506     ].
  1550     ].
  1507 
  1551 
  1508     ObjectFileLoader isNil ifTrue:[
  1552     ObjectFileLoader isNil ifTrue:[
  1509 	self parseError:'no dynamic load configured - cannot compile primitive code' position:1.
  1553 	self parseError:'no dynamic load configured - cannot compile primitive code' position:1.
  1510 	^ #Error
  1554 	^ #Error
  1547 	newMethod source:aString.
  1591 	newMethod source:aString.
  1548 	aClass addChangeRecordForMethod:newMethod.
  1592 	aClass addChangeRecordForMethod:newMethod.
  1549 	(silent or:[Smalltalk silentLoading == true]) ifFalse:[
  1593 	(silent or:[Smalltalk silentLoading == true]) ifFalse:[
  1550 	    Transcript showCr:('    compiled: ', className,' ',selector,' - machine code')
  1594 	    Transcript showCr:('    compiled: ', className,' ',selector,' - machine code')
  1551 	].
  1595 	].
       
  1596 	ObjectMemory flushCaches.
  1552 	^ newMethod.
  1597 	^ newMethod.
  1553     ].
  1598     ].
  1554 
  1599 
  1555     self parseError:'dynamic load failed' position:1.
  1600     self parseError:'dynamic load failed' position:1.
  1556     ^ #Error
  1601     ^ #Error
  1610     newMethod numberOfMethodVars:(self numberOfMethodVars).
  1655     newMethod numberOfMethodVars:(self numberOfMethodVars).
  1611     newMethod numberOfMethodArgs:(self numberOfMethodArgs).
  1656     newMethod numberOfMethodArgs:(self numberOfMethodArgs).
  1612     newMethod source:aString.
  1657     newMethod source:aString.
  1613     newMethod category:cat.
  1658     newMethod category:cat.
  1614     Project notNil ifTrue:[
  1659     Project notNil ifTrue:[
  1615 	newMethod package:(Project current packageName)
  1660 	newMethod package:(Project currentPackageName)
  1616     ].
  1661     ].
  1617     ^ newMethod
  1662     ^ newMethod
  1618 ! !
  1663 ! !