Files processed by the stc smalltalk-to-c compiler are usually generated by filing out class code with the SystemBrowser.
Of course, since they are regular files, you can alternatively use
any text editing tool to edit and manipulate these files, working
in the traditional edit-compile-link mode if you prefer.
In this mode, think of the file as describing one class;
comparable to programming in C++ or similar languages.
File format
Files compiled by stc must be in smalltalks
fileout format
(i.e. the file consists of smalltalk expressions,
separated by '!'-characters).
'!'-characters within the text have to be doubled;
this need for doubling also applies to exclamation marks within comments and strings.
Since ST/X replaces doubled '!'-characters by a single '!' when filing in,
you will see only single '!'-characters in the browser.
You have to be careful, when editing a source using
the fileBrowser or another editor.
Currently, exactly one class can be contained per source file.
The source syntax for compiled smalltalk implements a subset of the messages used to create/manipulate classes. Other expressions than those listed below are not allowed/supported.
The first expression must be a class-definition expression.
Class definition
The stc compiler accepts the following (and only those) class definition
expressions:
superclass subclass:#class
instanceVariableNames:'instVar1 instVar2 ...'
classVariableNames:'classVar1 classVar2 ...'
poolDictionaries:''
category:'some-category'
to define class as a subclass of superclass.
The instance variables of class are those of its superclass(es) and additionally 'instVar1', 'instvar2', ...
The class variables of class are those of its superclass(es) and additionally 'classVar1', 'classvar2', ...
Class variables are visible in both class- and instance methods, of the defining class and of every subclass (and subclasses of subclasses). Class variables are shared (unless redefined) - meaning that access is to the same physical memory "slot" from both the defining class and all subclasses. You can think of class variables as globals with limited accessablility: only the defining class and its subclasses 'see' them.
See below for class instance variables, which are class private (i.e. each class provides its own physical "slot").
Notice:
there are some classes (currentlyNotice:UndefinedObject
andSmallInteger
) which CANNOT be subclassed.for the curious:
the reason is that instances of these are no real objects, but are marked by a special tag-bit or object-pointer value. Thus these instances do not have a class field in memory. This makes it impossible for the VM (= virtual machine or runtime-system) to know the class of such a sub-instance.
there are some classes, to which you CANNOT add instance variables.In contrast to Smalltalk-80, no poolDictionaries are allowed/supported in Smalltalk/X; The only global-variable pool in ST/X isfor the curious:
these are especiallyObject
,SmallInteger
and all classes which are also known by the VM and/or the compiler. The reasons are:for
Object
: since there are some classes which inherit fromObject
, and which are not represented by pointers (i.e.UndefinedObject
andSmallInteger
). Since these cannot have instance variables, all superclasses of them may also not define any instance variables. This means, that all classes betweenObject
andSmallInteger
(i.e.Magnitude
,ArithmeticValue
,Number
andInteger
) are also not allowed to have instance variables.for the built-in classes: (Actually, the following is also true for the classes mentioned above)
all classes known by the VM (i.e.
Float
,SmallInteger
,Character
,Array
,String
,Method
,Block
,Class
,Metaclass
etc.) must have a layout as compiled into the VM. Since the VM accesses these instance variables (and is not affected by a class change) it would use wrong offsets when accessing an instance of such a changed class. Since instance variables are inherited, this also affects all super- classes of the above listed classes. You will get an error-notification, if you try to change such a class within the browser.
Smalltalk
itself.
The "poolDictionaries:"
-selector-part is included for Smalltalk-80
compatibility only - the argument must be an empty string.
Technically, classvariables are implemented as globals with a special name constructed as:
ClassName:ClassVarNamehowever, you should not have to care for this, except that class variables will be visible when inspecting the Smalltalk dictionary and can be accessed easily from C-functions as globals (named class_name).
Do not depend on any specific implementation of class variables, the current implementation may change without notice. Actually, it is planned to separate classVariables from Smalltalk globals in one of the next ST/X versions. This may also support poolDictionaries.)
superclass variableSubclass:#class
instanceVariableNames:'instVar1 instVar2 ...'
classVariableNames:'classVar1 classVar2 ...'
poolDictionaries:''
category:'some-category'
to define class as a subclass of superclass with indexed instance
variables even if superclass had no indexed instance variables. An
error will be generated, if the superclass is a variableByte- or
variableWord class.
superclass variableByteSubclass:#class
instanceVariableNames:'instVar1 instVar2 ...'
classVariableNames:'classVar1 classVar2 ...'
poolDictionaries:''
category:'some-category'
to define class as a subclass of
superclass variableWordSubclass:#class
instanceVariableNames:'instVar1 instVar2 ...'
classVariableNames:'classVar1 classVar2 ...'
poolDictionaries:''
category:'some-category'
to define class as a subclass of superclass with indexed instance
variables which are word-valued integers (i.e. shorts in c-world).
It is an error if superclass has non-word indexed instance variables.
The support for variableWord classes may be removed - there is currently
no use for it, and it can be easily simulated using variableByte classes.
superclass variableFloatSubclass:#class
instanceVariableNames:'instVar1 instVar2 ...'
classVariableNames:'classVar1 classVar2 ...'
poolDictionaries:''
category:'some-category'
or:
superclass variableDoubleSubclass:#class
instanceVariableNames:'instVar1 instVar2 ...'
classVariableNames:'classVar1 classVar2 ...'
poolDictionaries:''
category:'some-category'
to define class as a subclass of superclass with indexed instance
variables which are shortfloat- or doublefloat-valued rational numbers.
(i.e. floats and doubles in c-world).
Float- and DoubleArrays where added to support 3D graphic packages (i.e. GL), which use arrays of float internally to represent matrices and vectors. They provide much faster access to their elements than the alternative using byteArrays and floatAt:/doubleAt: access methods.
Also, storage is much more dense than in arrays, since they store the values directly instead of pointers to the float objects.
A 1000-element floatArray will need 1000*4 + OHDR_SIZE = 4012 bytes,
while a 1000-float-element array needs 1000*4 + OHDR_SIZE + 1000*(12+8)
= 20012 bytes. (each float itself requires 8-bytes plus 12-byte header)
Class comment
A class comment may be defined with an expression of the form:
an alternative to using a comment is to define class methods under the category "documentation",
consisting of comments only.
ClassName comment:'some string'
Empty methods do not use ANY code space in ST/X,
and have the positive effect
of not eating up data space in the smalltalk executable (which the comment does)
Class instance variables
A class may have instance variables, these MUST be declared before
the first class method is declared. The declaration has the form:
Do not confuse class variables with class instance variables.
ClassName class instanceVariableNames:'string with varNames'
Only one such class-instance-variable definition is allowed per input file.
Method definition
The expressions following the class definition are to be
method definitions of the form:
or
!ClassName methodsFor:'method-category'!
aMethod
...
!
aMethod
...
!
...
lastMethodInCategory
...
! !
There may be only method definitions for the class defined in the class
definition in one source file. Instance methods and class methods may be
in any order.
!ClassName class methodsFor:'category'!
aClassMethod
...
!
...
lastClassMethodInCategory
...
! !
Currently, there is a limit in the maximum number of arguments methods can be defined with and messages can be sent with (currently 12).
This limit will be removed eventually, allowing an arbitrary number of arguments.
Other limits are:
For very complicated expressions (especially when these are generated automatically), the temporary limit could in theory be reached. In practice, so far no Smalltalk code in the available PD programs has ever hit those limits.
Since most terminals cannot display the Smalltalk assignment character
'<-' (backarrow as one character with same ascii-code as '_'),
the scanner also accepts the character sequences ":=" (colon-equal) and
"<-" (less-minus) to express assignment in Smalltalk/X.
This is compatible to similar extensions found in other Smalltalk
implementations. Of course, the '_' is also accepted.
while being accepted, the '<-' sequence is not recommended since its
less common in other ST-versions.
Use ':='
Support for '<-' and '_' may be removed in
later versions. Also, new Smalltalk-80 versions allow
underscores in identifiers - no longer treating it as assignment.
Smalltalk/X will be changed soon to be ST-80
compatible.
Although not defined in the book, Smalltalk-80 expressions seem to require (blank) characters to separate tokens (i.e. Point origin: point1 corner: point2).
Smalltalk/X does not need these
(i.e. "Point origin:point1 corner:point2
" is fine)
I do not know at the moment, if this makes any problem when porting
Smalltalk/X code to other Smalltalk implementations.
(if required, the fileOut-methods may have to be changed to add blanks)
Assignment and init-expressions
In contrast to Smalltalk-80's fileIn format (where any expression is allowed),
expressions other than above must be of the form:
(constant may be any integer, float, string, symbol, true, false or nil)
Smalltalk at:#name put:constant
or of the form:
(classname must be the name of the class defined in this source-file)
classname initialize
These expressions allow globals to be set to a predefined value at startup
and/or class initialization.
Example:
...
Smalltalk at:#MyVariable put:true !
...
Example class
Point subclass:#Point3D
instanceVariableNames:'z'
classVariableNames:''
poolDictionaries:''
category:'Graphics-Primitives'
!
Point3D comment:'
this class defines a point in 3-dimensional space
'!
!Point3D class methodsFor:'instance creation'!
x:newX y:newY z:newZ
"answer a new point with coordinates newX and newY"
^ ((self basicNew) x:newX y:newY) z:newZ
! !
!Point3D methodsFor:'accessing'!
z
"Answer the z coordinate"
^ z
!
z:newZ
"set the z coordinate"
z := newZ
! !
!Point3D methodsFor:'printing'!
printString
"answer my printString"
^ super printString , '@' , z printString
! !
Extensions to Smalltalk-80 (Blue book version)
Compiler directives
Comments of the form:
are recognized by the stc-compiler as directives. Since directives are
hidden within comments, directives for Smalltalk/X will be ignored by
other Smalltalk systems; making Smalltalk/X sources transferable to
other Smalltalks.
"{ something ... }"
"{ Line: n }"
tells stc that line-numbering should continue with line n.
Line numbers in following warning- and error-messages will be relative
to n.
"{ Symbol: aSymbolString }"
tells stc that a primitive wants to access a symbol.
Stc includes a definition for that symbol and generates code to create the
symbol at startup time; within the primitive, the symbol can be refered to
with a c-conforming name as described above.
This directive is not needed, if you use the @symbol
-mechanism.
"{ Class: className }"
after an instance-, class-, or local-variable declaration tells
stc, that this variable will always be assigned an object of class:
className.
Various optimizations in the code are possible if the type of an object is known (especially for simple types such as "SmallInteger", "Character" "Point" or "String".
Currently everything but SmallInteger
, Float
and Point
-definitions in method
local declarations are ignored by the compiler.
Even with these type declarations, the compiler still generates code which checks assignments for correct typing i.e. an assignment of a float to a SmallInteger-typed variable will generate a runtime error.
With the improvements of the type-tracker and optimizations performed in stc, this feature seems now much less useful - especially, when considering the limited reusability of the generated code. Although still in the code, these declarations may be removed sooner or later from the code - this feature may even be completely removed from future stc versions. (see benchmark results of sieve/sieveWithInteger, atAllPut/atAllPut2 etc. some show very small differences between the untyped and typed versions)
Sometimes, finer control (i.e. over individual methods) is needed. Comments of
the form:
where keyword is (currently) one of "+optspeed" or "+optspace"
instruct stc to change its code generation startegy for a single method.
These pragmas must be placed before the methods method selector.
example:
"{ Pragma: keyword }"
Changing compilation to "+optspace" is useful for all methods which are
seldom called (such as class-initialization methods, which are usually called
only once during startup).
"although the whole class is complied "+optinline", "-optspace"
the following class-initialization method is compiled for space"
"{ Pragma: +optspace }"
initialize
....
....
!
The effect of pragmas can be turned off with the "-noPragmas" command line
argument to stc.
Multiple namespaces
This feature is not enabled in ST/X vsn 2.10.x.
Especially when filing in third party code, you may encounter name conflicts with global variable (usually: class-) names. This is very inconvenient, if the sourcecode is not available, or changes are not allowed/wanted.
To allow a reasonable handling of this case, Smalltalk/X provides (starting with rel2.11) multiple namespaces, which effectively allow you to have two or more classes with the same name to reside in one image/executable.
Usually, all global names are defined in the default nameSpace
(the Smalltalk
dictionary).
case 1: You know in advance, that a conflict may arise
you should add a line as:
at the beginning of the ST-source file.
"{ Namespace: SomeName }"
This tells stc,
that all globals defined in this module are not to be
entered in the default nameSpace Smalltalk
,
but instead into a space called SomeName.
Also, globals are first searched for in SomeName,
THEN in the Smalltalk
nameSpace.
SomeName must be a single identifier starting with an
upper-case letter.
Only the first 16 characters are valid.
Example:
You get some code, which defines a class "Button"
,
which should not
conflict with the built-in Button class.
To allow both classes to reside in one executable, add a line:
to the beginning of the code, and recompile it.
The class defined by the module will then NOT conflict (i.e. overwrite)
the existing
"{ Namespace: MyWidgets }"
Button
,
but instead define an alternative class,
which is not visible in the Smalltalk
dictionary,
but instead entered into the
MyWidgets
namespace dictionary.
(accessable as global MyWidgets
).
Also, globals within this module will be resolved from the local nameSpace
first (i.e. the name "Button
within this module
refers to the Button
in MyWidgets
).
case 2:
you got some compiled code module with a conflicting name in it
consider the case, where you got some file (say: 'Foo.o'
) containing
the compiled class Foo
,
and you have another class with the same name,
which you too cannot or dont want to change.
In this case, you have to change the namespace for all globals defined
in Foo.o
and also the order in which global names are resolved
when globals are accessed from within this module.
Stc allows you to specify the defining namespaces and a namespace resolve order at link time. Therefore, it is possibile to change namespaces even without recompilation - a feature not normally available in other language systems.
Explicit naming.
In rare cases, it may be nescessary, to access globals from different namespaces within one module. Consider the above case ('Button' in 'MyWidgets'), and you need access to the original 'Button' from within that module.
To access to original 'Button' from within the module, you can either
use the explicit:
or use the (nonstandard) construct:
'Smalltalk at:#Button',
To access the new Button from other modules, use either:
'Smalltalk::Button'.
or (nonstandard):
'MyWidgets at:#Button'
If you dont want to change the sourcecode, you can also define the
namespaces to use for searching in a line as:
MyWidgets::Button'
at the beginning of the source file.
The names given define the nameSpaces to search for globals, in the
given order. Thus a line:
"{ Using: name1 name2 ... nameN }"
will force searching for globals in the 'MyWidgets' nameSpace first,
THEN in the standard Smalltalk nameSpace; thus 'Button' will access
'MyWidgets.Button' automatically.
"{ Using: MyWidgets }"
NOTICE:
since there is currently no standard for multiple nameSpaces, we highly recommend using the explicit construct ('Smalltalk at:#Button' or 'MyWidgets at:Button'), since this is compatible to other smalltalk implementations (i.e. it can be simulated using poolDictionaries).
Warning: you should keep in mind, the using 'here'-sends will limit the reusability
of your class, in that it reduces the posibilities to change the behavior in
subclasses by redefinition of methods.
You can also turn 'here' sends into normal 'self' sends by a compiler switch,
and use the 'here' feature during development and testing.
(reducing the 'here' to documentation, which can be overriden)
Primitive definitions
Global primitive definitions allow for definitions and declarations common to
all primitive code in methods. Typically, C-include or C-define statements
and/or type declarations are put in these.
A global primitive definition is defined with:
The contents of this chunk will be preserved internally and included whenever
methods which contain primitive code are to be compiled.
!className class primitiveDefinitions!
%{
... anything you like ...
%}
! !
Additional C-functions may be declared in a primitiveFunctions chunk.
Lexical stuff
Some extensions to Smalltalk as described in the blue-book where made by
ParcPlace up to OW4.1.
Some of these extensions are also available in ST/X.
ByteArray literals
A literal byteArrays are created by enclosing the elements in #[ .. ]
.
The elements must be in the range 0 .. 255.
Example:
x := #[ 1 2 3 4 ].
masks := #[ 2r10000000
2r01000000
2r00100000 ]
Non alphanumeric characters in symbols
Usually symbols are defined as #xxx,
where xxx consists of a letter followed
by letters or digits.
There are also keyword and binary symbol literals,
such as: #at:put:
, #at:
or #+
.
>P>
Symbols with other characters can be specified by enclosing them in single
quotes, where the first quote must immediately follow the '#'-character.
Example:
#'a symbol with spaces' - spaces
#'123' - starts with a digit
#'hello_world' - underscore
Empty local variable declaration
The list of local variables may be empty, as in:
the same is true for blocks:
myMethod
| |
....
x := [:a | ] - as in-the-book
x := [:a | | | ] - with empty locals
Empty methods
a totally empty method is legal; it is equivalent to a simple ^ self
.
Thus:
all behave identically (returning self).
myMethod1
!
myMethod2
| |
!
myMethod3
| aLocal |
!
myMethod4
"only a comment"
!
myMethod5
^ self
!
Special 'constants' as Array literals
Smalltalk/X allows "nil", "true" and "false"
to be used in literal arrays.
Thus it is possible, to declare an array as:
Within an array literal, both simple identifiers AND identifiers prefixed by
the #-character are accepted and define a symbol within that literal.
#('string1' 'string2' nil 1 1.2 false true wow)
However, if a symbol named 'nil', 'true' or 'false' is required as an array
element (i.e not the value), a #-character MUST be preceeded, as in:
In the above example, the 5th element will be the symbol true, while
the last element will be the object true.
(Which -for your confusement- is the object bound to the symbol true :-)
#(1 2 3 #nil #true #false true)
'Double' constants
Although Smalltalk/X does not differentiate between Floats and Doubles
as Smalltalk-80 does (i.e. short floats vs. double-floats),
float constants with a trailing "d" are accepted. However, these
literals will be compiled in any case into an ST/X Float object (which
is the equivalent to a Double in ST-80).
This will be changed in an upcoming version.
End-of-line comments
Smalltalk/X allows special comments,
which start with the character sequence:
and are treated as a comment to the end if the source-line.
I.e. everything up to the end-of-line is ignored, even if it contains another
comment, or comment closing character.
Within string constants, this character sequence is ignored.
"/ (double-quote followed by slash)
Notice, that this feature is NOT compatible to other ST versions; code containing these to-end-of-line comments will not compile on other Smalltalks.
However, it simplifies porting of existing code to ST/X, since parts of the code can be easily commented out, by adding "/ to the beginning of each such line.
WARNING:
if an upcoming ansi standard defines another character sequence for this kind of comments, ST/X will be changed without notice. Therefore, this feature (although useful) should be only be used for temporary short-term changes.
"-errorInstVarRedef"
tells stc
to output a warning instead of an error,
and continue with the compilation.
NOTICE: this feature is not fully implemented in vsn 2.10.3
Lowercase vs. uppercase
Normally it is required (by convention - not by language syntax) that
all globals and class-variable names start with an upper case character,
while instance variables and method/block args & vars start with a lower case
character. Normally stc will stop coompilation with an error if these rules
are not followed. The compiler flags "-errorLowerGlobal"
and
"-errorUpperLocal"
turn these into warning messages.
These flags should be
used only when porting (unmodifyable) code to ST/X - new classes should
follow the rules.
The 'here' psudovariable
Smalltalk/X supports another type of send beside the normal
'self' and 'super' sends: the 'here'-send.
To make this extension be compatible with existing code,
'here'
is only
recognized as the pseudoVariable, if no other variable named as
here
is defined in the compilation scope.
Thus, if any instance-, local or argument variable exists with a
name of 'here'
,
the compiler will produce code for a normal send - not creating 'here'-sends.
Read the above section on the semantic and use of 'here'-sends.
UndefinedObject
SmallInteger
True
False
Float
Symbol
subclass may not be
seen as true symbols in many places; subclasses of String
will return an instance of String
when asked to copy,
convert etc.
In general, be very careful in subclassing any of:
Float
String
Symbol
Context
& BlockContext
Method
& Block
ifTrue:
,
ifFalse:
, whileTrue:
, whileFalse:
,
timesRepeat:
, to:do:
and to:by:do:
.
For to:do:
and to:by:do:
,
this bug will show up only for Integer arguments
where stc can deduce Integer types at compile time.
Workaround:
use method variables instead of block locals (there is no performance lost, since inlined blocks access method locals as fast as block locals).this has been fixed with release 2.10.4
(anObject xxx) foo; bar; baz
while
anObject foo; bar; baz
will be ok.
Workaround:
add a temporary and keep the result of the first send there. Do the cascade on this temporary.
!MyClass class primitiveDefinitions!
%{
struct abc {
int field1;
char field2;
};
%}
! !
!MyClass methodsFor:'foo'!
method
|local1 field2|
...
will lead to an error, since the name field2
is used both in a c-structure
and as a method local.
This may also happen with other C-names (i.e. typedefs,
structure names, enum values etc.) Care should be taken, since these
name conflicts may also be due to some #define
in an included
C header file.
Compiling code with such conflicts will usualy lead to errors in the C-compilation phase. Since stc does not parse (and understand) the structure of primitive code, it will not notice this conflict.
Workaround:
rename the local variables.
perform:withArguments:
.
Workaround:
If more argument values have to be passed, the arguments should be put into a collection, or other special object, which is then passed as argument.
A suggested workaround is to create some collection and put local values into that.
There is (currently) a limit of 31 temporaries, leading to a maximum expression nesting of 31 (since for every nesting level, one such temporary is needed).
The compiler is reusing temporaries as much as possible, so this limit is hardly ever reached - if it does, rewrite the complicated expression, using method locals as explicit temporaries.
Workaround:
Simplify the expression(s). Use local variables as explicit temporaries.
|v|
v := 16r12345678. "ok, fits into 31 bits"
v printNL.
v := 16r87654321. "not ok, does not fit into 31 bits"
v printNL.
The built-in incremental compiler DOES handle large integer constants
correctly; the above only applies to stc-compilation.
Workaround:
(this is only a temporary workaround; later versions of stc will be able to handle & generate large constants.)Add a class variable (such as MYLONGCONST) and initialize it in the classes
#initialize
method from a string.
I.e. instead of:use:
... x := 12345678901234567890. ...
... classVariableNames:'MYCONST' ... initialize MYCONST := '12345678901234567890' asInteger. ... ... x := MYCONST. ...
Workaround:
Use a dictionary stored in a class variable. Access your poolVariables asInitialize the dictionary in the classes initialize method using:
myDict at:name
myDict at:name1 put:value. ... myDict at:nameN put:value.
...
"
commented out method definition
"
!
...
instead, you have to include the chunk separator ('!') in the comment:
...
"
commented out method definition
!
"
...
This is of course incompatible with the smalltalk fileOut format definition
and will be fixed in later versions of stc.
Copyright © Claus Gittinger Development & Consulting, all rights reserved
(cg@ssw.de)