Added standalone Tea compiler - teak
It allows for compilation of .tea files from the command line.
"
Copyright (C) 2015-now Jan Vrany
This code is not an open-source (yet). You may use this code
for your own experiments and projects, given that:
* all modification to the code will be sent to the
original author for inclusion in future releases
* this is not used in any commercial software
This license is provisional and may (will) change in
a future.
"
"{ Package: 'jv:tea/compiler/cli' }"
"{ NameSpace: Smalltalk }"
StandaloneStartup subclass:#TCompilerCommand
instanceVariableNames:''
classVariableNames:''
poolDictionaries:''
category:'Languages-Tea-Compiler'
!
TCompilerCommand class instanceVariableNames:'debugging includes options'
"
The following class instance variables are inherited by this class:
StandaloneStartup - MutexHandle
Object -
"
!
!TCompilerCommand class methodsFor:'documentation'!
copyright
"
Copyright (C) 2015-now Jan Vrany
This code is not an open-source (yet). You may use this code
for your own experiments and projects, given that:
* all modification to the code will be sent to the
original author for inclusion in future releases
* this is not used in any commercial software
This license is provisional and may (will) change in
a future.
"
! !
!TCompilerCommand class methodsFor:'initialization'!
initialize
super initialize.
debugging := Transcript notNil and:[Transcript isView].
self setupSignalHandlers.
"Created: / 06-11-2011 / 22:07:14 / Jan Vrany <jan.vrany@fit.cvut.cz>"
"Modified: / 01-09-2015 / 18:42:09 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !
!TCompilerCommand class methodsFor:'compiling'!
process: files
"Actually compile files using `options` and `includes`."
| env ctx compiler units |
env := TEnvironment new.
env provider classpath addAll: includes.
ctx := TCompilerContext new.
ctx options: options.
ctx environment: env.
compiler := TCompiler new.
compiler context: ctx.
files isEmpty ifTrue:[
TCompilerError raiseErrorString:'no input files'.
].
units := OrderedCollection new: files size.
files do:[:filename |
| file |
file := filename asFilename.
file isRegularFile ifFalse:[
TCompilerError raiseErrorString: ('file does not exist: %1' bindWith: filename).
].
file isReadable ifFalse:[
TCompilerError raiseErrorString: ('file not readable: %1' bindWith: filename).
].
file readingFileDo:[ :stream |
units add: (TSourceReader read: stream).
].
].
files with: units do:[:infile :unit |
compiler compile: unit.
options output isNil ifTrue:[
| outfile |
outfile := infile asFilename withSuffix: (options emitIR ifTrue:[ 'll' ] ifFalse: [ 'bc' ]).
self write: ctx llvmModule as: outfile.
ctx llvmModule: nil.
].
].
options output notNil ifTrue:[
self write: ctx llvmModule as: options output.
].
"Created: / 24-09-2015 / 16:46:48 / Jan Vrany <jan.vrany@fit.cvut.cz>"
"Modified: / 24-09-2015 / 18:45:53 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
write: anLLVMModule as: aString
options emitIR ifTrue:[
aString asFilename writingFileDo:[:s|anLLVMModule dumpOn: s].
] ifFalse:[
anLLVMModule writeBitcodeToFile: aString
]
"Created: / 24-09-2015 / 17:06:23 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !
!TCompilerCommand class methodsFor:'debugging'!
dumpProcess: aProcess
Stderr cr; cr
"Created: / 27-06-2013 / 23:41:15 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
dumpProcess: aProcess on: aStream
| ctx |
aStream cr; cr.
aStream nextPutAll: '== ['; nextPutAll: aProcess id printString; nextPutAll:'] '; nextPutAll: aProcess name; nextPutAll: ' =='; cr.
aStream cr.
aStream nextPutAll: ' State: '; nextPutAll: aProcess state printString; cr.
aStream nextPutAll: ' Group: '; nextPutAll: aProcess processGroupId printString; cr.
aStream nextPutAll: ' Creator: '; nextPutAll: aProcess processGroupId printString; cr.
aStream nextPutAll: ' Stack: '; cr; cr.
aProcess == Processor activeProcess ifTrue:[ctx := thisContext] ifFalse:[ctx := aProcess suspendedContext].
[ ctx notNil ] whileTrue:[
aStream nextPutAll: ' '.
ctx fullPrintOn: aStream.
aStream cr.
ctx := ctx sender.
].
aStream cr.
"
self dumpProcess: Processor activeProcess on: Transcript.
"
"Created: / 28-06-2013 / 01:00:35 / Jan Vrany <jan.vrany@fit.cvut.cz>"
"Modified: / 06-06-2014 / 09:14:23 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
dumpProcesses
self dumpProcessesOn: Stderr
"
self dumpProcessesOn: Transcript.
"
"Created: / 27-06-2013 / 23:41:15 / Jan Vrany <jan.vrany@fit.cvut.cz>"
"Modified (comment): / 28-06-2013 / 01:06:40 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
dumpProcessesOn: aStream
Process allInstancesDo:[:process|
process isDead ifFalse:[
self dumpProcess: process on: aStream
]
]
"Created: / 27-06-2013 / 23:42:21 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !
!TCompilerCommand class methodsFor:'defaults'!
allowCoverageMeasurementOption
^false "CoverageReport will do that"
"Created: / 13-01-2012 / 11:48:40 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
allowDebugOption
^true
"Created: / 21-07-2011 / 09:48:21 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !
!TCompilerCommand class methodsFor:'multiple applications support'!
applicationRegistryPath
"the key under which this application stores its process ID in the registry
as a collection of path-components.
i.e. if #('foo' 'bar' 'baz') is returned here, the current applications ID will be stored
in HKEY_CURRENT_USER\Software\foo\bar\baz\CurrentID.
(would also be used as a relative path for a temporary lock file under unix).
Used to detect if another instance of this application is already running."
^ #('jv' 'tea' 'compiler')
"Modified: / 01-09-2015 / 18:33:12 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
applicationUUID
"answer an application-specific unique uuid.
This is used as the name of some exclusive OS-resource, which is used to find out,
if another instance of this application is already running.
Under win32, a mutex is used; under unix, an exclusive file in the tempDir could be used."
^ '8a084bc0-50cf-11e5-bf6b-606720e43e2c' asUUID
"Modified: / 01-09-2015 / 18:33:26 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !
!TCompilerCommand class methodsFor:'options'!
cmdlineOptionEmitLLVMIR
^CmdLineOption new
long: 'emit-llvm-ir';
description: 'Emit LLVM IR (.ll) instead of bitcode (.bc)';
action:[options emitIR: true];
yourself
"Created: / 24-09-2015 / 16:35:13 / Jan Vrany <jan.vrany@fit.cvut.cz>"
"Modified: / 24-09-2015 / 18:46:33 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
cmdlineOptionOutput
^CmdLineOption new
short: $o;
long: 'output';
description: 'Place output in specified file';
action:[:file | options output: file];
yourself
"Created: / 24-09-2015 / 16:32:26 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !
!TCompilerCommand class methodsFor:'startup'!
handleSIGTERM
self dumpProcesses.
debugging ifFalse:[
Smalltalk exit:127.
].
"Created: / 27-06-2013 / 23:10:48 / Jan Vrany <jan.vrany@fit.cvut.cz>"
"Modified: / 28-06-2013 / 01:08:03 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
handleSIGUSR2
self dumpProcesses
"Created: / 27-06-2013 / 23:10:48 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
setupSignalHandlers
"On UNIX, this sets up a custom signal handler on SIGUSR2 and SIGTERM that
dumps stacks on all threads"
| sigusr2 sigterm |
OperatingSystem isUNIXlike ifTrue:[
sigterm := Signal new.
sigterm handlerBlock: [:ex | self handleSIGTERM].
OperatingSystem operatingSystemSignal:OperatingSystem sigTERM install: sigterm.
OperatingSystem enableSignal: OperatingSystem sigTERM.
sigusr2 := Signal new.
sigusr2 handlerBlock: [:ex | self handleSIGUSR2].
OperatingSystem operatingSystemSignal:OperatingSystem sigUSR2 install: sigusr2.
OperatingSystem enableSignal: OperatingSystem sigUSR2.
].
"
OperatingSystem sendSignal: OperatingSystem sigUSR2 to: OperatingSystem getProcessId
"
"Created: / 27-06-2013 / 20:57:09 / Jan Vrany <jan.vrany@fit.cvut.cz>"
"Modified: / 28-06-2013 / 01:11:04 / Jan Vrany <jan.vrany@fit.cvut.cz>"
"Modified (format): / 01-09-2015 / 18:34:09 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
setupToolsForDebug
super setupToolsForDebug.
debugging := true.
"Created: / 06-11-2011 / 22:06:19 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
start
Smalltalk silentLoading: true.
^ super start.
"Created: / 22-01-2014 / 09:17:12 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
usage
Stderr nextPutAll:'usage: tc';
nextPutAll: '[options] [FILE1 [FILE2 [...]]]'; cr.
Stderr nextPutLine:'Common options:'; cr.
Stderr nextPutLine:' --help .................. output this message'.
"/ Stderr nextPutLine:' --verbose ............... verbose startup'.
"/ Stderr nextPutLine:' --noBanner .............. no splash screen'.
"/ Stderr nextPutLine:' --newAppInstance ........ start as its own application process (do not reuse'.
"/ Stderr nextPutLine:' a running instance)'.
"/ self allowScriptingOption ifTrue:[
"/ Stderr nextPutLine:' --scripting portNr ...enable scripting via port (or stdin/stdOut if 0)'.
"/ ].
self allowDebugOption ifTrue:[
Stderr nextPutLine:' --debug ................. enable Debugger'.
].
"/ ' ......................... '
Stderr nextPutLine:' -I<dir> ................. adds <dir> to the list of directories searched for'.
Stderr nextPutLine:' sources'.
Stderr nextPutLine:' -o'.
Stderr nextPutLine:' --output <file> ........ place output to file <file>'.
Stderr nextPutLine:' --emit-llvm-ir .......... emit LLVM IR (.ll) instead of LLVM bitcode (.bc, default)'.
debugging ifFalse:[
Smalltalk exit:1.
].
"
self usage
"
"Created: / 13-01-2012 / 11:48:07 / Jan Vrany <jan.vrany@fit.cvut.cz>"
"Modified: / 24-09-2015 / 16:35:58 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
usageForReportClass: class
| options |
"/ '.........................' size 25
options := CmdLineOption optionsFor: class new.
options := options reject:[:option | 'pF' includes: option short ].
options notEmptyOrNil ifTrue:[
Stderr cr.
Stderr nextPutAll: class name; nextPutLine:' options:'; cr.
options do:[:option |
| optlen |
option short notNil ifTrue:[
Stderr nextPutAll: ' '.
Stderr nextPut: $-; nextPut: option short; space.
optlen := 2.
option hasParam ifTrue:[
| paramName |
paramName := 'val'.
Stderr nextPut:$<; nextPutAll: paramName; nextPut:$>; space.
optlen := optlen + 3 + paramName size.
].
].
option long notNil ifTrue:[
option short notNil ifTrue:[
Stderr cr.
].
Stderr nextPutAll: ' --'.
Stderr nextPutAll: option long.
optlen := option long size + 2.
option hasParam ifTrue:[
| paramName |
paramName := 'val'.
Stderr nextPut:$=; nextPut:$<; nextPutAll: paramName; nextPut:$>.
optlen := optlen + 3 + paramName size.
].
Stderr space.
].
Stderr next: (26 - 1"space" -2"--" - optlen) put: $..
Stderr space.
option description notNil ifTrue:[
Stderr nextPutAll: option description
].
Stderr cr.
]
]
"
ReportRunner usageForReportClass: TestReport.
"
"Created: / 27-05-2014 / 16:42:27 / Jan Vrany <jan.vrany@fit.cvut.cz>"
"Modified: / 16-06-2014 / 11:25:36 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !
!TCompilerCommand class methodsFor:'startup-to be redefined'!
main:argv0
"Process command line arguments"
| argv parser i files |
argv := argv0 asOrderedCollection.
argv isEmpty ifTrue:[
self usage.
].
argv remove: '--abortOnSEGV' ifAbsent:[nil].
parser := CmdLineParser new.
CmdLineOptionError autoload.
includes := OrderedCollection new.
options := TCompilerOptions new.
[
"/ Parse -I as they cannot be handled by option parser, sigh
i := 1.
[ i <= argv size ] whileTrue:[
| option |
option := argv at: i.
(option = '-I') ifTrue:[
i = argv size ifTrue:[
Stderr nextPutAll:'Error: -I must be followed by path'.
] ifFalse:[
includes add: (argv at: i + 1)
].
argv removeAtIndex: i + 1.
argv removeAtIndex: i.
] ifFalse:[
(option startsWith: '-I') ifTrue:[
| include |
include := option copyFrom: 3.
include isEmptyOrNil ifTrue:[
Stderr nextPutAll:'Error: -I must be followed by path'.
] ifFalse:[
includes add: include.
].
argv removeAtIndex: i.
] ifFalse:[
i := i + 1.
].
]
].
files := parser parse: argv for: self.
] on:CmdLineOptionError do:[:ex|
Stderr nextPutLine:'Error when processing options: ', ex description.
debugging ifFalse:[
ex suspendedContext fullPrintAllOn: Stderr.
Stderr nextPutLine:'Exiting'.
Smalltalk exit:1.
] ifTrue:[
ex pass
]
].
debugging ifFalse:[
NoHandlerError emergencyHandler:(NoHandlerError abortingEmergencyHandler)
].
[
self process: files.
debugging ifFalse:[
Smalltalk exit:0.
].
] on: Error do:[:ex|
Stderr nextPutAll:'Error when compiling: '.
Stderr nextPutAll:ex description; cr.
ex suspendedContext printAllOn:Stderr.
debugging ifFalse:[
Smalltalk exit:1.
] ifTrue:[
ex pass
]
]
"Modified: / 24-09-2015 / 16:40:46 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !
TCompilerCommand initialize!