Send mail to the CREATE web master
Index
Date: 97 Jan 01 9:44:52 am
From: Mark4Flies@aol.com
To: squeak@create.ucsb.edu
Subject: Re: exit repeat, next repeat
In a message dated 12/30/96 2:28:07 PM, you wrote:
<<There are a pair of features of HyperTalk that I like and want to see in
Squeak. When you are in a loop, you can exit to just beyond the loop (exit
repeat). You can also jump to the bottom of the loop and start the next
cycle (next repeat). These are very useful.>>
This idea is very interesting. I love HyperTalk, too, and use these exits all
of the time in my scripts. Funny thing is I *never* miss this feature in
Smalltalk!
(Different paradigm, different set of walls? Just content in whatever closet
I happen find myself? I don't know.)
I find all of the ideas offered in reply to your question to be very clever
and workable but they also strike me as messy work-arounds. (No offense
intended!) They really stick out from the clean Smalltalk code. (Is it just
because they are new and unfamiliar?) For me, they add a level of threading
which confuses the purpose and approach. Are such exit methods necessary? Are
they valuable? Is there a better answer using a different algorithm, design,
or factorization instead of an exit?
I guess the reason it bothers me is because I can't see the object which
should receive this message and have clear responsibility for it. It is like
an aside in a play but I am not sure who is sitting in the audience. Not
self, not a block variable, not the compiler. Who then? The block itself?
(The message is escape or give it up, I guess.) Who owns the loop, a
collection or a Boolean? How can we send a message from inside the block to
the object interating?
I may be one of the only fans of inject:into but this method is a beautiful
solution to a similarily sticky problem. It achieves the desired result
concisely, efficiently, and in congruence with Smalltalk syntax and style.
Could this example offer some guidance or criteria for the best exit method?
Enough rambling.
Happy New Year to everyone!
Date: 97 Jan 01 10:43:05 am
From: Ed Kleban <ed@kleban.com>
To: Ian Piumarta <piumarta@prof.inria.fr>
Cc: squeak@create.ucsb.edu
In-Reply-To: <199612311209.NAA04553@prof.inria.fr>
Subject: Speed Doubler, Squeak and Digitalk STV - Re: Quick Squeak
Benchmarks
Ian,
Thanks for the great chart. You inspired me to run the benchmarks on
my own machine for both Squeak 1.18, which I would love to be using,
and good ol' Digitalk ST/V 1.2.1 which I'm stuck with for a while until
I find the time to convert. I also ran some tests to get an idea on
the benefit of Speed Doubler for the Squeak which is mostly native and
ST/V which is all running under 68K emulate. Finally, I ran these
tests both with my full compliment of about 106 inits including extensions,
control panels, and shared libraries, versus a startup with essentially
all inits disabled. Actually I find some of the result quite curious if
not outrageous. The results are listed below. I suspect the first two
lines of the eight may be appropriate for your chart.
All tests were run on a Mac Duo 2300c/100 with 603e PPC at 100 MHz under
System 7.5.3 Release 2.
bytecodes invocations Speed Extensions Product
/sec /sec Doubler Disabled
3,086,500 137,300 No Yes Squeak 1.18
3,254,500 178,100 Yes Yes Squeak 1.18
1,531,700 64,500 No No Squeak 1.18
2,583,300 143,000 Yes No Squeak 1.18
1,301,800 143,000 No Yes Digitalk STV 1.2.1
3,051,400 317,000 Yes Yes Digitalk STV 1.2.1
1,045,400 135,000 No No Digitalk STV 1.2.1
2,809,800 330,000 Yes No Digitalk STV 1.2.1
Some interesting conclusions based on these tests:
a. Speed Doubler appears to boost the performance of Squeak running
these benchmarks under system 7.5.3 by about 5% for byte codes
and 30% for invocations.
b. The overhead of my preferred operating environment means I suffer
a performance penalty of about 20% for both bytecodes and invocations
when running Squeak.
c. Speed Doubler boosts the performance of ST/V by about 134% for
bytecodes and 121% for invocations.
d. When running my preferred operating environment additional
overhead can cost me a penaly of perhaps 9%. Failing to run
speed doubler with my preferred environment brings the entire
machine to a screeching crawl.
e. Even running under emulation, the Digitalk implementation is comparable
to the performance of Squeak for bytecodes and is essentially twice
as fast as Squeak for invocations. Now why in the world should
that be the case?
>Ordered by bytecodes/second:
>
>Machine 10 benchmark 26 benchFib Squeak Source Notes
>------- ------------ ----------- ------ ------ -----
>Sun4 IPX 982000 44000 1.17 a (1)
>AlphaServer 4000 2558000 132000 1.17 a
>Mac 7200/90 2753000 137000 1.18 a
>Mac 8100/100 3000000 160000 1.18 b
>SparcStation 20 3344000 169000 1.17 a
>Pentium 150MHz 4587000 233000 1.17 a
>UltraSparc 1 4642000 221000 1.17 a
>Mac 8500/120 4900000 198000 1.1? c (2)
>Acorn RPC StrongARM 5500000 314000 1.1? c (2)
>Mac 9500/200 7800000 440000 1.18 d (3)
>
>Notes:
> (1) this is the machine that I do all my Squeak development on! ;^)
> (2) I don't know if this is 1.17 or 1.18
> (3) running "speed doubler" (what does THAT do?)
>Sources:
> a me
> b John Maloney
> c Tim Rowledge
> d David N. Smith
>
>Does anyone know the approximate price of a Mac 9500/200?
>
>Ian
>------------------------------- projet SOR -------------------------------
>Ian Piumarta, INRIA Rocquencourt, Internet: Ian.Piumarta@inria.fr
>BP105, 78153 Le Chesnay Cedex, FRANCE Voice: +33 1 39 63 52 87
>----------------------- Systemes a Objets Repartis -----------------------
-----------------------------------------------------------------------
****** Ed Kleban A digital guy in an analog world
* *
* 54 * <Ed@Kleban.com> http://www.kleban.com
* * 913-492-0572
****** fax 492-8928 Box 14768, Lenexa KS 66285, USA
-----------------------------------------------------------------------
Date: 97 Jan 01 3:43:00 pm
From: Dan Ingalls <DanI@wdi.disney.com>
To: Mark4Flies@aol.com
Cc: Squeak@create.ucsb.edu
In-Reply-To: <970101124818_643432317@emout10.mail.aol.com>
Subject: Re: exit repeat, next repeat
>This idea is very interesting. I love HyperTalk, too, and use these exits all
>of the time in my scripts. Funny thing is I *never* miss this feature in
>Smalltalk!
I never miss it either, or certainly not enough to think it merits the
extra complexity. I do, however, believe that less experienced programmers
can get themselves into situations where such exceptional control is
needed, so it may well be important for Squeak as a scripting language. It
would be good to look at some compelling examples. Ted -- do you have some?
>I find all of the ideas offered in reply to your question to be very clever
>and workable but they also strike me as messy work-arounds. (No offense
>intended!) They really stick out from the clean Smalltalk code. (Is it just
>because they are new and unfamiliar?) For me, they add a level of threading
>which confuses the purpose and approach. Are such exit methods necessary? Are
>they valuable? Is there a better answer using a different algorithm, design,
>or factorization instead of an exit?
>
>I guess the reason it bothers me is because I can't see the object which
>should receive this message and have clear responsibility for it. It is like
>an aside in a play but I am not sure who is sitting in the audience. Not
>self, not a block variable, not the compiler. Who then? The block itself?
>(The message is escape or give it up, I guess.) Who owns the loop, a
>collection or a Boolean? How can we send a message from inside the block to
>the object interating?
I agree with the approach suggested by Jecel (additional loop-control
blocks get are supplied which can be evaluated at any time). Here the user
of the code doesn't need to worry about "ownership" of the loop, he just
knows he is being given a semantic handle that will do the right thing if
evaluated.
Date: 97 Jan 01 7:09:32 pm
From: areider@spacelab.net (Alan Reider)
To: squeak@create.ucsb.edu
In-Reply-To: <v03007800aef05ef03a60@[206.16.10.79]>
Subject: Re: exit repeat, next repeat
How about using exceptions? (I not sure of squeaks current
capabilities in this area). Here is an example for IndexedCollection I
tested in visualSmalltalk.=20
#(1 2 3 4 5 ) doWithExit: [ : each |
each =3D=3D 3 ifTrue: [ NextRepeat signal ] .
Transcript cr ; nextPutAll: each asString .
each =3D=3D 4 ifTrue: [ ExitRepeat signal ] .
Transcript space ; nextPutAll: each asString .
]
"should answer 1 1 2 2 4"
The following implementation performs almost as good as #do: if no
exits are taken. Unfortunately the exception handler is recreated on
each NextRepeat. I dont immediately see how to avoid this. If it could
be done once, maybe this solution wouldnt be too heavyweight.
Anyway, it doesnt require extensions and doesnt read (or write) too
badly.
-Alan Reider
IndexedCollection methods
doWithExit: aBlock
| curr start |
start :=3D 1 .
[true] whileTrue: [
[ start to: self size do: [ : each |
curr :=3D each .
aBlock value: (self at: each)
] .
^self
] on: ExitRepeat,NextRepeat "<=3D=3Dsubclasses of Exception"
do: [ : excp |
excp class =3D=3D NextRepeat
ifTrue: [
start :=3D curr + 1 .
] ifFalse: [
^self
]
]
]
Date: 97 Jan 02 6:19:54 am
From: Ian Piumarta <piumarta@prof.inria.fr>
To: DanI@wdi.disney.com
Cc: Squeak@create.ucsb.edu
Subject: Re: exit repeat, next repeat
Okay, enough's enough!!! ;-)
I suspect that almost any control construct is easy to implement in Smalltalk
itself, staying within the existing paradigms and without extra VM support. (I
did full continuations once, in 3 tiny methods of 3 or 4 lines each...)
Here's a possibility for an "exit repeat":
'From Squeak 1.17 of October 17, 1996 on 2 January 1997 at 3:05:57 pm'!
!Collection methodsFor: 'enumerating'!
doWithExit: aBlock
"Evaluate aBlock (a binary block) for each of the receiver's elements.
The second argument passed to aBlock is a unary `exit block' which will
terminate the enumeration prematurely, returning its argument as the
result of the enumeration. Ian Piumarta, 2 jan 1997"
| exit |
exit _ [:result | ^result].
^self do: [ :elt | aBlock value: elt value: exit]
"Examples: open a transcript and #printIt for each of the following..."
"#(2 4 6 8 10) doWithExit: [:val :exit |
Transcript cr; show: val printString.
val == 3 ifTrue: [exit value: 42]]"
"#(1 2 3 4 5) doWithExit: [:val :exit |
Transcript cr; show: val printString.
val == 3 ifTrue: [exit value: 42]]"! !
You can use a similar trick in BlockContext to implement #valueWithExit: (and
the other arities of the same thing) which gives you premature exit from a
block. This can in turn be used to implement Collection>>#doWithContinue: and
(in combination with the above mechanism) Collection>>#doWithContinueAndExit:
(the code should be easy enough for anyone to infer).
Ian
------------------------------- projet SOR -------------------------------
Ian Piumarta, INRIA Rocquencourt, Internet: Ian.Piumarta@inria.fr
BP105, 78153 Le Chesnay Cedex, FRANCE Voice: +33 1 39 63 52 87
----------------------- Systemes a Objets Repartis -----------------------
Date: 97 Jan 02 8:21:27 am
From: scottk@maxstrat.com (Scott Kang)
To: Squeak@create.ucsb.edu
Cc: DanI@wdi.disney.com
Subject: Re: Compiler error query
Hi Dan,
Thanks the help. The VitalFixFor1.17.st fixed the error.
Happy New year!
-------------------------------------------------------------------
Scott T. Kang Tel: (408) 383-1600 Ext: 119
Maximum Strategy, Inc. Fax: (408) 383-1616
801 Buckeye Court EMAIL: scottk@maxstrat.com
Milpitas, CA 95035-7408 URL: http://www.maxstrat.com/
-------------------------------------------------------------------
Date: 97 Jan 02 10:55:13 am
From: areider@spacelab.net (Alan Reider)
To: Squeak@create.ucsb.edu
In-Reply-To: <199701021423.PAA06142@prof.inria.fr>
Subject: Re: exit repeat, next repeat
>Here's a possibility for an "exit repeat":
Ian,
Very nice solution. This seems to fully satisfy the requirement with no
drawbacks.
-Alan
(Following code is visual st flavor)
!Collection methodsFor: 'as yet unclassified' !
doWithExit: aBlock
^self do: [ :each | (aBlock valueWithExit: each) ifFalse: [ ^ self ] =
]
"
#(2 4 6 8 10) doWithExit: [:val :exit |
val =3D=3D 4 ifTrue: [exit continue: true] .
Transcript cr; show: val printString.
val =3D=3D 8 ifTrue: [ exit continue: false ]
]
"
! !
!BlockClosure methodsFor: 'as yet unclassified' !
valueWithExit: arg
self value: arg value: [:result | ^result].
^true
! !
!BlockClosure methodsFor: 'as yet unclassified' !
continue: aBool
^self value: aBool! !
Date: 97 Jan 02 1:02:09 pm
From: Jecel Assumpcao Jr <jecel@lsi.usp.br>
To: Ed Kleban <ed@kleban.com>
Cc: Ian Piumarta <piumarta@prof.inria.fr>, squeak@create.ucsb.edu
Subject: Re: Speed Doubler, Squeak and Digitalk STV - Re: Quick Squeak Benchmarks
Ed Kleban <ed@kleban.com> wrote (among a lot of other things):
> e. Even running under emulation, the Digitalk implementation is comparable
> to the performance of Squeak for bytecodes and is essentially twice
> as fast as Squeak for invocations. Now why in the world should
> that be the case?
The Digitalk uses a conventional stack for most contexts, while
Squeak uses the heap for all of them.
BTW, on my 486DX 33Mhz machine with Linux, running Squeak 1.16
gets me these results:
10 benchmark 197000 189000 170000 193000 199000
26 benchFib 14000 13000 18000 15000 18000
I guess this means I won't be too happy running the interpreter
simulation on this computer :-(
-- Jecel
Date: 97 Jan 03 5:02:32 am
From: Ian Piumarta <piumarta@prof.inria.fr>
To: johnm@wdi.disney.com, alan@apple.com, dnsmith@watson.ibm.com
Cc: squeak@create.ucsb.edu
Subject: Mac 9500/200 [OFF TOPIC]
Very many thanks to the several people who gave me details about the above
machine, and especially to those two individuals who even offered to try to
arrange to get me one at a discount price -- which was very generous, and
totally unexpected!!!
But I must admit, I'm finding that even my IPX at home is good enough for the
unambitious tinkering that I currently do in Squeak.
My real interest in the Mac is more "professional" -- because of the
possibility of putting Linux on it, and outperforming a similarly-priced
workstation by a considerable amount. It looks like a 9500/200 costs about
the same as we would pay (as a government lab we get big, statutory discounts
on everything we buy) for a DEC Alpha 255 which is about twice the SPECint92
performance of our AlphaServer 4000 (and so I expect would weigh in at just
over 5M Squeak bytecodes/second -- which is only 65% of the high-end Macs).
I would therefore be *very* grateful to hear from anyone who has:
1) put Linux (or any other free Unix) on a PowerPC (I know that
it's available, but maybe only for 68k?);
2) obtained the SPECint92 and SPECfp92 figures for the high-end Macs
(8500/180 and 9500/200, for example).
Thanks in advance, and sorry for the off-topic noise!
Ian
------------------------------- projet SOR -------------------------------
Ian Piumarta, INRIA Rocquencourt, Internet: Ian.Piumarta@inria.fr
BP105, 78153 Le Chesnay Cedex, FRANCE Voice: +33 1 39 63 52 87
----------------------- Systemes a Objets Repartis -----------------------
Date: 97 Jan 03 9:56:27 am
From: Dan Ingalls <dani@bobo.rd.wdi.disney.com>
To: Squeak@create.ucsb.edu
Subject: [Fwd: Squeak: startup problem @ NT,95]
Folks -
Just saw this on Comp.lang.Smalltalk.
Has anyone observed this problem? Figuired out a solution?
The Squeak team unfortunately has no windows platforms available at
present.
--------------------------------------------------------------
Subject: Squeak: startup problem @ NT,95
Date: Fri, 03 Jan 1997 22:22:54 +0900
From: lee <rainmkr@soback.kornet.nm.kr>
Organization: KORNET
Newsgroups: comp.lang.smalltalk
Help needed. I've got this situation.
I've downloaded Squeak from ftp site, win32 ditectory.
I packed them up in one directory, linked image file with
squeak.exe.
When I start them, squeak crash with an error : "unauthorized paging"
I tried it on NT and 95 both, the same error.
Thank you and Happy new year.
Date: 97 Jan 03 10:17:56 am
From: "David N. Smith" <dnsmith@watson.ibm.com>
To: Ian Piumarta <piumarta@prof.inria.fr>
Cc: squeak@create.ucsb.edu
In-Reply-To: <199701031305.OAA16071@prof.inria.fr>
Subject: Re: Mac 9500/200 [OFF TOPIC]
At 8:05 -0500 01/03/97, Ian Piumarta wrote:
>...snip...
>I would therefore be *very* grateful to hear from anyone who has:
>
> 1) put Linux (or any other free Unix) on a PowerPC (I know that
> it's available, but maybe only for 68k?);
>
> 2) obtained the SPECint92 and SPECfp92 figures for the high-end Macs
> (8500/180 and 9500/200, for example).
>
>Thanks in advance, and sorry for the off-topic noise!
>
>Ian
Ian:
I think Apple is doing a Linux PPC port which should be available Real Soon
Now. There is info on their developer pages somewhere.
Dave
_______________________________
David N. Smith
dnsmith@watson.ibm.com
IBM T J Watson Research Center
Hawthorne, NY
_______________________________
Any opinions or recommendations
herein are those of the author
and not of his employer.
Date: 97 Jan 03 10:47:41 am
From: tim <tim@apple.com>
To: "David N. Smith" <dnsmith@watson.ibm.com>,
"Ian Piumarta" <piumarta@prof.inria.fr>
Cc: <squeak@create.ucsb.edu>
Subject: Re: Mac 9500/200 [OFF TOPIC]
>I think Apple is doing a Linux PPC port which should be available Real Soon
>Now. There is info on their developer pages somewhere.
MkLinux is now in Beta release for PCI-based PowerMacs (like the 9500).
The DR2 release is now available for NuBus PowerMacs (6100/7100/8100).
For more information, see Apple's MkLinux web page at:
<http://www.mklinux.apple.com>
However, it is not tuned, yet, so running the SPEC suites on it won't
give the best results.
-- Tim Olson
Apple Computer, Inc. / Somerset
tim@apple.com
Date: 97 Jan 03 11:07:25 am
From: Diana Merry-Shapiro <merry-shapiro_diana@jpmorgan.com>
To: DanI@wdi.disney.com
Cc: Squeak@create.ucsb.edu
Subject: Re: [Fwd: Squeak: startup problem @ NT,95]
Hi,
I just downloaded onto my Unix box,
/pub/Smalltalk/Squeak/win32/image/1.16/Squeak1.16w.image,Squeak1.16w.changes;
/pub/Smalltalk/Squeak/win32/image/SqueakV1.sources; and
/pub/Smalltalk/Squeak/win32/bin/squeak.exe. I ftp'd them onto my NT 4.0
box at the top level on my C: drive (hard drive). I am definitely not
an NT wizard, but by just doubleclicking the image icon in the file
explorer, I got the image to come up and was able to browse sources and
changes. I'm not sure if this helps, but it might encourage continued
efforts. Is is possible perhaps that the download corrupted the
binaries?
Diana
Dan Ingalls wrote:
>
> Folks -
>
> Just saw this on Comp.lang.Smalltalk.
>
> Has anyone observed this problem? Figuired out a solution?
>
> The Squeak team unfortunately has no windows platforms available at
> present.
>
> --------------------------------------------------------------
> Subject: Squeak: startup problem @ NT,95
> Date: Fri, 03 Jan 1997 22:22:54 +0900
> From: lee <rainmkr@soback.kornet.nm.kr>
> Organization: KORNET
> Newsgroups: comp.lang.smalltalk
>
> Help needed. I've got this situation.
> I've downloaded Squeak from ftp site, win32 ditectory.
>
> I packed them up in one directory, linked image file with
> squeak.exe.
> When I start them, squeak crash with an error : "unauthorized paging"
>
> I tried it on NT and 95 both, the same error.
>
> Thank you and Happy new year.
Date: 97 Jan 04 1:03:20 pm
From: Maloney <johnm@wdi.disney.com>
To: Ed Kleban <ed@kleban.com>
Cc: squeak@create.ucsb.edu
In-Reply-To: <v03007801aef05035432e@[205.230.93.18]>
Subject: Re: Speed Doubler, Squeak and Digitalk STV
Ed:
Thanks for the fascinating numbers!
I have a theory which partly explains the results you are seeing. As
you know, many older Mac programs, including extensions and inits,
are still in 68K code and must run under the emulator. In addition,
some toolbox calls, such as GetNextEvent, are also still in 68K code.
Running a mixture of 68K code and PPC code is quite inefficient for
two reasons. First, it is costly to switch processor modes between
running native code and emulating 68K code. Second, running the 68K
emulator fills most of the 603e's caches with it's own data (its
dispatch table) and code. A second level cache would mitigate this
problem, but the 2300 doesn't have one. Squeak is also a cache hog,
for similar reasons; it has two dispatch tables (one for bytecodes,
one for primitives) and lots of "hot" code. Squeak's performance
depends on most of the interpreter's main loop and dispatch tables
staying in the caches.
So, any 68K init that does background processing at periodic
intervals (such as a clock or calendar reminder or screen saver)
slows Squeak down a fair amount, especially on the 603e, which
has smaller caches than the 601 or 604. (The 603 has even smaller
caches.) You should see similar slowdowns of large PPC programs,
but you might not see a large slowdown with small benchmarks which
load into the cache quickly. For example, a non-JIT Java interpreter
would be prone the the same phenomenon.
I don't know how SpeedDoubler is implemented but if it works
by translating 68K code into PPC code, it might use less of
the cache than Apple's emulator. That would explain why it
improves matters so much when running Squeak with inits. Why
does it also improve things when running Squeak without inits?
My guess is that it makes those calls to GetNextEvent
less costly. The Squeak VM calls GetNextEvent periodically
even when running "compute-bound" code to see if the user has
hit the break key to interrupt the program.
Of course, it's obvious why SpeedDoubler improves Digitalk STV,
since STV is a 68K program. Note also that there is less of a
problem with mode switches and cache flushes if both the
application program (STV) and the active inits are running
in 68K mode.
By the way, I'm far from an expert in cache-related performance
effects, so I welcome comments on the above from those in the
know!
Digitalk STV 1.2.1 is a very good bytecode interpreter. It is
2-3 times faster than Squeak relative to C overall. (Since Squeak
is tuned for the PPC and STV is 68K native, this is the fairest
way to compare their performance.) For method invocation, STV
is probably 5-10 times faster than Squeak, although I haven't
measured it in isolation, since it use a stack and Squeak uses
full Smalltalk Context objects. My tests show that Squeak is
roughly 50-60 times slower than C on a PPC 601 and STV is
20-30 times slower than C on a 68030 for a set of small,
compute-bound benchmarks like quicksort and matrix multiply.
Non-JIT Java VM's are similar to STV 1.2.1 in speed. JIT-based
Javas, and Smalltalks using similar technology are typically
less than 10 times slower than C on these benchmarks. The
Animorphic Java and Smalltalk VM's, which use Self-style
dynamic optimization, achieve speeds only 1.5 to 3 times
slower than C. On the other end of the spectrum, Python is
about 400 times slower than C and HyperTalk is two or
three thousand times slower, yet these interpreters are
still useful for many applications. We're quite happy with
Squeak's performance for a byteocode interpreter. To improve it
significantly, we would need to switch to some sort of
dynamic translation.
As for practical advice: perhaps you can isolate the init that
is the worst offender to Squeak's performance and turn it off
when using Squeak. And, of course, run with SpeedDoubler on.
Also, you might measure some real code from your application
under Squeak; the benchmarks may tend to be pessimistic.
Again, thanks for the numbers...
-- John
>All tests were run on a Mac Duo 2300c/100 with 603e PPC at 100 MHz under
>System 7.5.3 Release 2.
>
>bytecodes invocations Speed Extensions Product
>/sec /sec Doubler Disabled
>
>3,086,500 137,300 No Yes Squeak 1.18
>3,254,500 178,100 Yes Yes Squeak 1.18
>1,531,700 64,500 No No Squeak 1.18
>2,583,300 143,000 Yes No Squeak 1.18
>
>1,301,800 143,000 No Yes Digitalk STV 1.2.1
>3,051,400 317,000 Yes Yes Digitalk STV 1.2.1
>1,045,400 135,000 No No Digitalk STV 1.2.1
>2,809,800 330,000 Yes No Digitalk STV 1.2.1
>
>Some interesting conclusions based on these tests:
>
> a. Speed Doubler appears to boost the performance of Squeak running
> these benchmarks under system 7.5.3 by about 5% for byte codes
> and 30% for invocations.
>
> b. The overhead of my preferred operating environment means I suffer
> a performance penalty of about 20% for both bytecodes and invocations
> when running Squeak.
>
> c. Speed Doubler boosts the performance of ST/V by about 134% for
> bytecodes and 121% for invocations.
>
> d. When running my preferred operating environment additional
> overhead can cost me a penaly of perhaps 9%. Failing to run
> speed doubler with my preferred environment brings the entire
> machine to a screeching crawl.
>
> e. Even running under emulation, the Digitalk implementation is comparable
> to the performance of Squeak for bytecodes and is essentially twice
> as fast as Squeak for invocations. Now why in the world should
> that be the case?
Date: 97 Jan 04 2:22:24 pm
From: Ed Kleban <ed@kleban.com>
To: "Ted K." <tedk@wdi.disney.com>
Cc: squeak@create.ucsb.edu, rob@unicom.net
In-Reply-To: <v03007803aeeda376492f@[206.16.10.211]>
Subject: Parallel potential - MutiSqueak?
Ted,
I like the goal and idea of your exit repeat, next repeat construct but
definitely cast my lot with others who are encouraging us to not screw
around with the syntax. Smalltalk is one of the few syntactically simple
and elegant languages left. It would be wonderful to avoid the temptations
of syntactic speghetti that others who have pushed C, lisp, forth,
you-name-it, to the limit have been unable to resist.
On another topic however, Rob Hinton, a friend of mine, raised an
interesting question. Is squeak at all well positioned to take advantage
of parallel processing? We're starting to see just the tip of the iceberg
in this arena with Power Computing, Be, heck even Apple bringing out
symetric multiprocessor configs. It's not too clear to me how Squeak would
take advantage of an OS that provided mutliprocessing on behalf of its
processes other than allowing other programs to be scheduled to run
simultaneous with a single Squeak process. Is there any meaningful way in
which one might spawn multiple concurrent Squeak proceses that could take
advantage of such an architecture?
-----------------------------------------------------------------------
***** ***** Ed Kleban ed@unicom.net
*** *** Cyber Strategist http://www.unicom.net/
* * Unicom Communications, Inc. fyi@unicom.net
***** 7223 W 95th St., Suite 325 (913) 383-1983 ext 125
*** Overland Park, KS 66212 383-8466 Support
* 383-1998 Fax
A digital guy in an analog world 492-0572 24-hour
-----------------------------------------------------------------------=20
Date: 97 Jan 04 2:45:11 pm
From: Les Tyrrell <tyrrell@avalanche.ncsa.uiuc.edu>
To: ed@kleban.com
Cc: squeak@create.ucsb.edu
Subject: Re: Parallel potential - MutiSqueak?
Some quick references along these lines...
Akinori Yonezewa
ABCM ( An object-Based Concurrent computation Model )
ABCL ( An object-Based Concurrent Language )
http://web.yl.is.s.u-tokyo.ac.jp/
Yasuhiko Yokote, Mario Tokoro
Concurrent Smalltalk
Jean-Pierre Briot
Actalk
Trevor Hopkins,
Smalltalk Actor Kernel ( SMACK )
Monitor
There are other possibly relevant topics, such as Future Objects
( Ralph Johnson ). These are just the ones that come to immediate mind.
Good luck!
Les
Date: 97 Jan 04 3:56:05 pm
From: Les Tyrrell <tyrrell@avalanche.ncsa.uiuc.edu>
To: squeak@create.ucsb.edu
Subject: Re: Parallel potential - MutiSqueak?
Another reference along those lines...
"Object and Native Code Thread Mobility Among Heterogeneous Computers"
Bjarne Steensgaard, and Eric Jul
http://www.diku.dk/research-groups/distlab/emerald
Unfortunatly, I don't have the citation ( it's in an ACM publication,
that's all I know ) and the above web site appears to be unavailable.
Oh well...
Les
Date: 97 Jan 04 9:09:46 pm
From: Michael Dillon <michael@memra.com>
To: squeak@create.ucsb.edu
Subject: Anybody home?
Has the list gone dormant? Or has nobody fixed the web archive
to handle January 1997 yet?
On reading through the two months of the list archive I can see a lot of
good material for a FAQ document if anyone is interested in writing one.
--
Michael Dillon - Internet & ISP
Consulting
Memra Software Inc. - Fax: +1-604-546-3049
http://www.memra.com - E-mail:
michael@memra.com
Date: 97 Jan 05 1:03:22 am
From: stp (Stephen Travis Pope)
To: squeak@create.ucsb.edu
In-Reply-To: Ian Piumarta <piumarta@prof.inria.fr>'s letter of: 30 December 1996
Subject: Re: Squeak and the Babel of programming languages
> However, this does not mean the Squeak tools (debugger, inspector,
> class browser) might not be useful for developing in other
> languages (NewtonScript, Lisp, Basic, C++, Forth, Python, Object
I also just remembered that about 11 years ago--to support the "PS" virtual
machine on the Sun_3--Peter Deutsch wrote a Smalltalk code browser for *68000
assembly language*
stp
Date: 97 Jan 05 1:03:41 am
From: stp (Stephen Travis Pope)
To: Tim Rowledge <rowledge@interval.com>
Cc: Squeak mailinglist <squeak@create.ucsb.edu>
In-Reply-To: Tim Rowledge <rowledge@interval.com>'s letter of: 30 December 1996
Subject: Re: Quick Squeak Benchmarks
> ... DarcPlace ...
I like that!
stp
Date: 97 Jan 05 3:04:08 am
From: johnson@cs.uiuc.edu (Ralph E. Johnson)
To: squeak@create.ucsb.edu
Subject: Re: Parallel potential - MutiSqueak?
One of Dave Ungar's PhD students at Stanford ported Berkeley Smalltalk
to a four-processor Firefly (a Vax cluster). He focused on making the
VM safe, and didn't do that much for the image. The main image change
was that they made some parallel collections that would run do: in
parallel. It was neat watching it redraw the screen, because it was
obvious that there were four processors doing it!
I can't remember the student's name. I think he is at Apple now.
His thesis should tell you what to do to the VM to make it run on a
shared memory multiprocessor.
-Ralph
Date: 97 Jan 05 6:11:44 am
From: Mark4Flies@aol.com
To: squeak@create.ucsb.edu
Subject: Re: exit repeat, next repeat
In a message dated 1/1/97 5:47:15 PM, you wrote:
<<>I guess the reason it bothers me is because I can't see the object which
>should receive this message and have clear responsibility for it. It is like
>an aside in a play but I am not sure who is sitting in the audience. Not
>self, not a block variable, not the compiler. Who then? The block itself?
>(The message is escape or give it up, I guess.) Who owns the loop, a
>collection or a Boolean? How can we send a message from inside the block to
>the object interating?
I agree with the approach suggested by Jecel (additional loop-control
blocks get are supplied which can be evaluated at any time). Here the user
of the code doesn't need to worry about "ownership" of the loop, he just
knows he is being given a semantic handle that will do the right thing if
evaluated.>>
I don't mean to introduce another thing to worry about but on the other
hand, the way Smalltalk consistently handles the receiver of all messages,
shouldn't the solution provide a obvious but uncomplicated receiver (owner)
for this action
Date: 97 Jan 05 9:21:54 am
From: "David N. Smith" <dnsmith@watson.ibm.com>
To: Michael Dillon <michael@memra.com>
Cc: squeak@create.ucsb.edu
In-Reply-To: <32CDF408.173378C0@memra.com>
Subject: Re: Anybody home?
At 1:09 -0500 01/04/97, Michael Dillon wrote:
>Has the list gone dormant? Or has nobody fixed the web archive
>to handle January 1997 yet?
>
>On reading through the two months of the list archive I can see a lot of
>good material for a FAQ document if anyone is interested in writing one.
>
>--
>Michael Dillon - Internet & ISP
>Consulting
>Memra Software Inc. - Fax: +1-604-546-3049
>http://www.memra.com - E-mail:
>michael@memra.com
I'm doing a Smalltalk FAQ which will include Squeak as one of five specific
implementations. See the July 96 draft at:
http://www.dnsmith.com/SmallFAQ/
The next draft will include some Squeak stuff.
HOWEVER, I am NOT covering Squeak internals, Squeak specific tricks,
tweaks, porting, etc. The FAQ is general purpose and intended for people
learning and using Smalltalk as a programming language.
It looks like there is lots of room for a Squeak-specific FAQ covering all
those Squeak specific things that makes us all excited about it.
Dave
_______________________________
David N. Smith
dnsmith@watson.ibm.com
IBM T J Watson Research Center
Hawthorne, NY
_______________________________
Any opinions or recommendations
herein are those of the author
and not of his employer.
Date: 97 Jan 05 9:24:00 am
From: "David N. Smith" <dnsmith@watson.ibm.com>
To: Michael Dillon <michael@memra.com>
Cc: squeak@create.ucsb.edu
In-Reply-To: <32CDF408.173378C0@memra.com>
Subject: Re: Anybody home?
At 1:09 -0500 01/04/97, Michael Dillon wrote:
>Has the list gone dormant?
Not that I can tell. Squeakers seem to post right thru Christmas eve, 2am
New Years day, etc. There seems to be a policy that at least one Squeaker
must remain sober enough to post at any hour. :-)
Dave
_______________________________
David N. Smith
dnsmith@watson.ibm.com
IBM T J Watson Research Center
Hawthorne, NY
_______________________________
Any opinions or recommendations
herein are those of the author
and not of his employer.
Date: 97 Jan 05 10:36:45 am
From: Ian Piumarta <piumarta@prof.inria.fr>
To: squeak@create.ucsb.edu
Subject: 1.17 for i586/Linux
I have compiled 1.17 for Linux/i586. It's in
ftp://alix.inria.fr/pub/squeak/unix/precompiled/SqueakVM-1.17-i586-linux1.3.gz
Sorry that I forgot to do this earlier!
Ian
------------------------------- projet SOR -------------------------------
Ian Piumarta, INRIA Rocquencourt, Internet: Ian.Piumarta@inria.fr
BP105, 78153 Le Chesnay Cedex, FRANCE Voice: +33 1 39 63 52 87
----------------------- Systemes a Objets Repartis -----------------------
Date: 97 Jan 05 11:52:24 am
From: Hans-Martin Mosner <hm.mosner@cww.de>
To: Squeak Mailing List <squeak@create.ucsb.edu>
Subject: Cursor enhancements
Dies ist eine mehrteilige Nachricht im MIME-Format.
--------------38B76DE240A7
Content-Type: text/plain; charset=us-ascii
Content-Transfer-Encoding: 7bit
Hi Squeakers,
I'd like to share my newest thingy with you. It enables Squeak to have
Cursors with black and white pixels, making them easier to see on
black backgrounds :-)
You need to re-generate the Squeak VM to get them...
Dan, is it possible to incorporate this into the next release?
Hans-Martin
--------------38B76DE240A7
Content-Type: text/plain; charset=us-ascii; x-mac-type="54455854"; x-mac-creator="522A6368"
Content-Transfer-Encoding: 7bit
Content-Disposition: inline; filename="MaskedCursor.cs"
'From Squeak 1.18 of December 12, 1996 on 5 January 1997 at 5:00:46 pm'!
"Change Set: MaskedCursor
Date: 5 January 1997
Author: hmm@heeg.de, hm.mosner@cww.de
These changes implement cursors with 2 bits per pixel, enabling Squeak to have the common black/white transparent cursor shapes. The meaning of the pixel values is:
0: white
1: black
2: transparent
3: (platform-dependent, reversing on the mac)
To use it, you need to:
- re-generate the interpreter with the new primitiveBeCursor method
- change the ioSetCursor() function in sqMacWindow.c
- recompile the VM
- execute 'Cursor initialize2' to create some depth-2 cursors
Tell me if you like it!!
Hans-Martin
Here's the modified ioSetCursor() function:
int ioSetCursor(int cursorBitsIndex, int offsetX, int offsetY, int depth) {
Cursor macCursor;
int i, j, data, mask, word;
if (depth == 1) {
for (i = 0; i < 16; i++) {
macCursor.data[i] = (checkedLongAt(cursorBitsIndex + (4 * i)) >> 16) & 0xFFFF;
macCursor.mask[i] = (checkedLongAt(cursorBitsIndex + (4 * i)) >> 16) & 0xFFFF;
}
} else {
for (i = 0; i < 16; i++) {
data = mask = 0;
word = checkedLongAt(cursorBitsIndex + (4 * i));
for (j = 0; j < 16; j++) {
data |= (word >> j) & (1 << j);
mask |= (word >> (j+1)) & (1 << j);
}
macCursor.data[i] = data;
macCursor.mask[i] = mask ^ -1;
}
}
/* Squeak hotspot offsets are negative; Mac's are positive */
macCursor.hotSpot.h = -offsetX;
macCursor.hotSpot.v = -offsetY;
SetCursor(&macCursor);
}
"!
!Cursor methodsFor: 'printing'!
printOn: aStream
"Store the receiver out in the form: Cursor extent:depth:fromArray:#()offset:"
| radix |
radix _ self depth = 1 ifTrue: [2] ifFalse: [4].
aStream nextPut: $(.
aStream nextPutAll: self species name.
aStream crtab: 1; nextPutAll: 'extent: '; print: self extent.
aStream crtab: 1; nextPutAll: 'depth: '; print: self depth.
aStream crtab: 1; nextPutAll: 'fromArray: #('.
1 to: bits size do:
[:index |
aStream crtab: 2.
(self bits at: index) printOn: aStream base: radix].
aStream nextPut: $).
aStream crtab: 1.
aStream nextPutAll: 'offset: '.
self offset printOn: aStream.
aStream nextPut: $)! !
!Cursor methodsFor: 'private'!
beDepth2
"Cursor normal beDepth2 bitEdit"
| copy |
depth = 2 ifFalse: [
copy _ self deepCopy.
depth _ 2.
self
copyBits: (0@0 extent: 16@16)
from: copy
at: 0@0
colorMap: (Bitmap with: 2 with: 1)]! !
!Cursor class reorganize!
('class initialization' initCorner initCrossHair initDown initHand initialize initMarker initMenu initMove initNormal initOrigin initRead initRightArrow initSquare initUp initWait initWrite initXeq startUp)
('depth2 initialization' initCrossHair2 initialize2 initMenu2 initNormal2 initWait2)
('instance creation' extent:depth:fromArray:offset: extent:fromArray:offset: new)
('current cursor' currentCursor currentCursor:)
('constants' blank bottomLeft bottomRight corner crossHair down execute hand marker menu move normal origin read rightArrow square topLeft topRight up wait write)
!
!Cursor class methodsFor: 'depth2 initialization'!
initCrossHair2
"Cursor initCrossHair2"
CrossHairCursor _ (Cursor
extent: 16@16
depth: 2
fromArray: #(
4r2222220002222222
4r2222220102222222
4r2222220102222222
4r2222220102222222
4r2222220102222222
4r2222220102222222
4r100000002
4r111111311111102
4r100000002
4r2222220102222222
4r2222220102222222
4r2222220102222222
4r2222220102222222
4r2222220102222222
4r2222220002222222
4r2222222222222222)
offset: -7@-7)
!
initialize2
"Create the depth-2 cursors"
self initMenu2.
self initWait2.
self initNormal2.
self initCrossHair2.
"Cursor initialize2"
!
initMenu2
"Cursor initMenu2"
MenuCursor _ (Cursor
extent: 16@16
depth: 2
fromArray: #(
4r1111111111122222
4r1000000000122222
4r1010011000122222
4r1000000000122222
4r1011001010122222
4r1000000000122222
4r1010110010122222
4r1000000000122222
4r1010010100122222
4r1000000000122222
4r1111111111122222
4r1101001101122222
4r1111111111122222
4r1000000000122222
4r1010101100122222
4r1111111111122222)
offset: 0@0)!
initNormal2
"Cursor initNormal2"
NormalCursor _ (Cursor
extent: 16@16
depth: 2
fromArray: #(
4r1222222222222222
4r1122222222222222
4r1112222222222222
4r1311222222222222
4r1331122222222222
4r1333112222222222
4r1333311222222222
4r1333122222222222
4r1111122222222222
4r1221122222222222
4r2222112222222222
4r2222112222222222
4r2222211222222222
4r2222211222222222
4r2222221122222222
4r2222221122222222)
offset: 0@0)!
initWait2
"Cursor initWait2"
WaitCursor _ (Cursor
extent: 16@16
depth: 2
fromArray: #(
4r1111111111111111
4r1000000000000001
4r2100000000000012
4r2210000000000122
4r2221110000111222
4r2222111101112222
4r2222211011122222
4r2222221111222222
4r2222221111222222
4r2222210110122222
4r2222100010012222
4r2221000110001222
4r2210001101000122
4r2100111111110012
4r1011111111111101
4r1111111111111111)
offset: 0@0)! !
!Cursor class methodsFor: 'instance creation'!
extent: extentPoint depth: depth fromArray: anArray offset: offsetPoint
"Answer a new instance of me with width and height specified by
extentPoint, offset by offsetPoint, and bits from anArray.
1/4/97 hmm
This is only usable when the appropriate extension of the
interpreter is installed. Note that for the depth-1 case, the Array's
bits are not shifted, unlike the extent:fromArray:offset: method."
extentPoint = (16 @ 16) ifFalse: [self error: 'cursors must be 16@16'].
(depth = 1 or: [depth = 2]) ifFalse: [self error: 'cursors must have depth 1 or 2'].
^(self extent: extentPoint depth: depth)
offset: offsetPoint;
initFromArray: anArray! !
!Interpreter methodsFor: 'I/O primitives'!
primitiveBeCursor
"Set the cursor to the given shape. The Mac only supports 16x16 pixel cursors. Cursor offsets are handled by Smalltalk."
| cursorObj bitsObj extentX extentY offsetObj offsetX offsetY cursorBitsIndex depth |
cursorObj _ self stackTop.
self success: ((self isPointers: cursorObj) and: [(self lengthOf: cursorObj) >= 5]).
successFlag ifTrue: [
bitsObj _ self fetchPointer: 0 ofObject: cursorObj.
extentX _ self fetchInteger: 1 ofObject: cursorObj.
extentY _ self fetchInteger: 2 ofObject: cursorObj.
depth _ self fetchInteger: 3 ofObject: cursorObj.
self success: (depth = 1 or: [depth = 2]).
offsetObj _ self fetchPointer: 4 ofObject: cursorObj.
self success: ((self isPointers: offsetObj) and: [(self lengthOf: offsetObj) >= 2]).
].
successFlag ifTrue: [
offsetX _ self fetchInteger: 0 ofObject: offsetObj.
offsetY _ self fetchInteger: 1 ofObject: offsetObj.
self success: ((extentX = 16) and: [extentY = 16]).
self success: ((offsetX >= -16) and: [offsetX <= 0]).
self success: ((offsetY >= -16) and: [offsetY <= 0]).
self success: ((self isWords: bitsObj) and: [(self lengthOf: bitsObj) = 16]).
cursorBitsIndex _ bitsObj + BaseHeaderSize.
].
successFlag ifTrue: [
self cCode: 'ioSetCursor(cursorBitsIndex, offsetX, offsetY, depth)'.
self pop: 1.
].! !
Cursor initHand!
--------------38B76DE240A7--
Date: 97 Jan 05 1:56:01 pm
From: Les Tyrrell <tyrrell@avalanche.ncsa.uiuc.edu>
To: squeak@create.ucsb.edu
Subject: Re: Squeak and the Babel of programming languages
RE: Multi Language support...
Disclaimeer: these are recollections off the top of my head- no time
to do better at this stage ( sorry! ).
I recall that there was a product called C-Talk, which appeared
( though was not neccessarily ) to be built in V/DOS. That is,
It had an object-oriented extension to C ( proprietary, not C++
or Objective-C ) along with an environment which appeared to look
very much like V/DOS, along with V/DOS-like browsers. You could
see this advertised in Bytes from the mid-80's.
And of course, V/DOS and V/286 both had Prolog that you could file
in ( though the critical part, the parser, was I believe actually
part of the "hidden" classes and not a file-in ).
I just got Mei running in VW last Sunday, and that has both
Prolog and Lisp. But, casual glances give me the impression that
these aren't in the Browsers like Smalltalk, rather they seem
to have thier own Workspace sort of browser. I don't know either
language, so I really can't comment on it much more than that.
ParcPlace's DLL/C Connect has the C parser, and
special classes which can parse both Smalltalk and C in order
to support DLL's.
If we get a little looser with the idea of supporting "non"
Smalltalk languages, there was at least one dialect of Smalltalk
which was aimed at being a simplified version which could be parsed
into Smalltalk primitives... or rather, the intent was to enable
one to write the primitives in Smalltalk. I do not know if this
is the same dialect that is used in Squeak for the same purpose
( at least, from reading a code comment somewhere I was under the
impression that the Squeak ST to C translator was for either a
subset or different dialect of Smalltalk than used in the rest
of Squeak ). Examples of things like this might include
( I believe ) Squeak's own ST-C translator, Hurricane, and
SPiCE ( Smalltalk Programs into C Environment ).
Another example is in Smalltalk/X, where C code can apparently
be given in place of Smalltalk code in a method body ( never
had the full ST/X, so that's just what I recall about it ).
So there is a certain precedent for doing this sort of thing.
Les
Date: 97 Jan 05 2:00:54 pm
From: Les Tyrrell <tyrrell@avalanche.ncsa.uiuc.edu>
To: squeak@create.ucsb.edu
Subject: Re: Parallel potential - MutiSqueak?
Another thought along these lines- has anyone been giving any consideration
to the sorts of things that Tao does, or perhaps porting a variant of
Squeak to the Tao OS?
http://www.tao.co.uk/
Les
Date: 97 Jan 06 10:59:40 am
From: Tim Rowledge <rowledge@interval.com>
To: Les Tyrrell <tyrrell@avalanche.ncsa.uiuc.edu>
Cc: Squeak mailinglist <squeak@create.ucsb.edu>
In-Reply-To: <199701052204.QAA29907@avalanche.ncsa.uiuc.edu>
Subject: Re: Parallel potential - MutiSqueak?
On Sun 05 Jan, Les Tyrrell wrote:
>
> Another thought along these lines- has anyone been giving any consideration
> to the sorts of things that Tao does, or perhaps porting a variant of
> Squeak to the Tao OS?
Nice idea, but do you know anyone with a running TAO-OS machine? Having once-upon-a-time got the VisualWorks dynamic translator (almost) running on my ARM machine I suspect I could tackle the Tao-OS work, but it doesn't look like they hav
e support for StrongARM yet, nor have I heard of any machines really making use of it. Pity, since it looks like it has promise.
--
Tim Rowledge: rowledge@interval.com (w) +1 (415) 354-3627 (w)
tim@sumeru.stanford.edu (h) <http://sumeru.stanford.edu/tim>
Date: 97 Jan 06 5:58:06 pm
From: Jecel Assumpcao Jr <jecel@lsi.usp.br>
To: Squeak mailinglist <squeak@create.ucsb.edu>
Subject: Re: Parallel potential - MutiSqueak?
Tim Rowledge wrote:
>
> On Sun 05 Jan, Les Tyrrell wrote:
> >
> > Another thought along these lines- has anyone been giving any consideration
> > to the sorts of things that Tao does, or perhaps porting a variant of
> > Squeak to the Tao OS?
> Nice idea, but do you know anyone with a running TAO-OS machine? Having
> once-upon-a-time got the VisualWorks dynamic translator (almost) running
> on my ARM machine I suspect I could tackle the Tao-OS work, but it doesn't
> look like they have support for StrongARM yet, nor have I heard of any
> machines really making use of it. Pity, since it looks like it has promise.
I am not sure that TAOS is as good for distributed systems as,
for example, SpringOS or even Helios. More information about
TAOS is available at http://www.tao.co.uk/
Though I am not certain, I think that their system also runs
on top of Windows as well as natively on a number of CPUs.
Compiling the Squeak VM to the TAO assembler (supposing they
finally got a compiler working) would make one port cover a lot
of ground. Normally I don't care much for putting a VM over
another (Smalltalk on Java, for example) but it might turn out
ok in this case.
-- Jecel
Date: 97 Jan 06 7:13:20 pm
From: Les Tyrrell <tyrrell@avalanche.ncsa.uiuc.edu>
To: squeak@create.ucsb.edu
Subject: Re: Parallel potential - MutiSqueak?
Tim Rowledge Wrote:
> Nice idea, but do you know anyone with a running TAO-OS machine?
Just myself, but ( like everything else it seems ) I haven't had
time to do anything with it other than play with the demos.
I've been stalling, waiting for the C compiler to come out.
> once-upon-a-time got the VisualWorks dynamic translator (almost) running
> on my ARM machine I suspect I could tackle the Tao-OS work, but it doesn't
> look like they have support for StrongARM yet, nor have I heard of any
> machines really making use of it. Pity, since it looks like it has promise.
The lack of an installed base would be a bit of a problem... but I think
it would be of interest in the sense of demonstrating thread mobility
among Smalltalk VM's, even though it might not be a very practical
way to do this. Taos supposedly does have quite a few target CPU's
that it can use, although much the same could probably be said about
Squeak in the not too distant future.
------
Jecel Assumpcao Jr. Wrote:
> I am not sure that TAOS is as good for distributed systems as,
> for example, SpringOS or even Helios.
Thanks for the tips!
<snip!>
> Normally I don't care much for putting a VM over
> another (Smalltalk on Java, for example) but it might turn out
> ok in this case.
That's what I've been a bit concerned about...
I have no idea how appropriate it would be to implement a Smalltalk VM
in the Taos VP code- but they do seem to be threatening to come out with
the C compiler in the near future, so perhaps I'll have a chance to try it
out then. That or translate the C code to Basic, and use Tao's Basic
compiler.
Les
Date: 97 Jan 06 7:32:32 pm
From: Les Tyrrell <tyrrell@avalanche.ncsa.uiuc.edu>
To: squeak@create.ucsb.edu
Subject: Squeak Object Database?
I'm also curious whether anyone is looking at hooking up an OO database
to Squeak. I've heard that Texas Persistent Store might be a good
candidate for this- any suggestions?
Thanks!
Les
Date: 97 Jan 07 12:15:46 am
From: kgarrels@rhein-neckar.netsurf.de (Kai Garrels)
To: squeak@create.ucsb.edu
Subject: Cursor Keys in Squeak for Mac
Hi Sqeakers,
is there a way to activate the cursor keys in Squeak for Macintosh? It
seems now they are only inserting some special invisible characters into
text.
Thanks for a hint,
kai
--
Kai Garrels
Mannheim
Germany
Date: 97 Jan 07 2:21:18 am
From: Dan Ingalls <DanI@wdi.disney.com>
To: kgarrels@rhein-neckar.netsurf.de (Kai Garrels)
Cc: Squeak@create.ucsb.edu
In-Reply-To: <19970107092010867679@r30.rhein-neckar.netsurf.de>
Subject: Re: Cursor Keys in Squeak for Mac
>Hi Sqeakers,
>
>is there a way to activate the cursor keys in Squeak for Macintosh? It
>seems now they are only inserting some special invisible characters into
>text.
>
>Thanks for a hint,
>kai
>
>--
>Kai Garrels
>Mannheim
>Germany
Well, here are a couple of hints:
1. By executing Sensor kbdTest, you can determine that these keys generate
ascii codes 28-31 (end this test by typing an 'x').
2. You can then modify ParagraphEditor dispatchOnCharacter:with: to treat
these codes as command keys.
3. You can then put entries into ParagraphEditor class
initializeCmdKeyShortcuts, specifying selectors to be performed when you
type these keys.
4. Then all that remains is to code up the actions you desire. (Note that
the dispatch to your routine occurs as a result of peeking ahead, so don't
forget to consume the character in your routine using Sensor keyboard).
Good luck
- Dan
Date: 97 Jan 07 11:03:33 am
From: "Pete M. Wilson" <Wilsonp@drmc.drhsi.org>
To: 'Squeak Mailing List' <Squeak@create.ucsb.edu>
Subject: Cursor Keys for PC
Since the Win32 version of Squeak doesn't reply any codes at all from
Sensor kbdTest for the PC arrow keys, can I presume that's being
handled in a primitive that would need to be modified?
Pete M. Wilson
Network & Systems Analyst
-----Original Message-----
From: Dan Ingalls [SMTP:DanI@wdi.disney.com]
Sent: Tuesday, January 07, 1997 5:27 AM
To: kgarrels@rhein-neckar.netsurf.de
Cc: Squeak@create.ucsb.edu
Subject: Re: Cursor Keys in Squeak for Mac
>Hi Sqeakers,
>
>is there a way to activate the cursor keys in Squeak for Macintosh?
It
>seems now they are only inserting some special invisible characters
into
>text.
>
>Thanks for a hint,
>kai
>
>--
>Kai Garrels
>Mannheim
>Germany
Well, here are a couple of hints:
1. By executing Sensor kbdTest, you can determine that these keys
generate
ascii codes 28-31 (end this test by typing an 'x').
2. You can then modify ParagraphEditor dispatchOnCharacter:with: to
treat
these codes as command keys.
3. You can then put entries into ParagraphEditor class
initializeCmdKeyShortcuts, specifying selectors to be performed when
you
type these keys.
4. Then all that remains is to code up the actions you desire. (Note
that
the dispatch to your routine occurs as a result of peeking ahead, so
don't
forget to consume the character in your routine using Sensor
keyboard).
Good luck
- Dan
Date: 97 Jan 07 12:00:14 pm
From: Andreas Raab <raab@isg_nw.cs.Uni-Magdeburg.DE>
To: "Pete M. Wilson" <Wilsonp@drmc.drhsi.org>
Cc: squeak@create.ucsb.edu
Subject: Re: Cursor Keys for PC
Hi,
> Since the Win32 version of Squeak doesn't reply any codes at all from
> Sensor kbdTest for the PC arrow keys, can I presume that's being
> handled in a primitive that would need to be modified?
> Pete M. Wilson
Oops, sorry. At the time I wrote this piece of code I did not have
any Mac at hand and so I didn't know the key codes generated by the
Mac. I'll put an updated version on the server, soon. If you wish to
do it manually then you'll have to modify the recordVirtualKey() function
in sqWin32Window.c
Andreas
--
Linear algebra is your friend - Trigonometry is your enemy.
+===== Andreas Raab ============= (raab@isg.cs.uni-magdeburg.de) =====+
I Department of Simulation and Graphics Phone: +49 391 671 8065 I
I University of Magdeburg, Germany Fax: +49 391 671 1164 I
+=============< http://simsrv.cs.uni-magdeburg.de/~raab >=============+
Date: 97 Jan 07 1:46:32 pm
From: Maloney <johnm@wdi.disney.com>
To: Andreas Raab <raab@isg_nw.cs.Uni-Magdeburg.DE>
Cc: squeak@create.ucsb.edu
In-Reply-To: <670A391A6B@isg_nw.cs.uni-magdeburg.de>
Subject: Re: Cursor Keys for PC
Andreas:
In case you need them, the key codes are:
28 <- (left arrow)
29 -> (right arrow)
30 ^ (up arrow)
31 v (down arrow)
Also, the Mac keyboard has an "enter" key which is different from
the return key. The key code for this key is 3. I believe this is
actually used for some shortcut. I don't know if Windows keyboard
have a similar key (On the Mac, the enter key is associated with
the numeric keypad. The other keys on that keypad generate the
numbers, decimal point, and arithmetic symbols.)
Perhaps someone with a Mac extended keyboard could send out a list
of key codes for the function keys F1-F16...
-- John
>Hi,
>
>> Since the Win32 version of Squeak doesn't reply any codes at all from
>> Sensor kbdTest for the PC arrow keys, can I presume that's being
>> handled in a primitive that would need to be modified?
>> Pete M. Wilson
>
>Oops, sorry. At the time I wrote this piece of code I did not have
>any Mac at hand and so I didn't know the key codes generated by the
>Mac. I'll put an updated version on the server, soon. If you wish to
>do it manually then you'll have to modify the recordVirtualKey() function
>in sqWin32Window.c
>
>Andreas
>--
>Linear algebra is your friend - Trigonometry is your enemy.
>+===== Andreas Raab ============= (raab@isg.cs.uni-magdeburg.de) =====+
>I Department of Simulation and Graphics Phone: +49 391 671 8065 I
>I University of Magdeburg, Germany Fax: +49 391 671 1164 I
>+=============< http://simsrv.cs.uni-magdeburg.de/~raab >=============+
Date: 97 Jan 07 5:38:22 pm
From: "Rick L. Taylor" <rltaylor@ix.netcom.com>
To: Kai Garrels <kgarrels@rhein-neckar.netsurf.de>
Cc: Squeak@create.ucsb.edu
Subject: Re: Cursor Keys in Squeak for Mac
Kai Garrels wrote:
>
> Hi Sqeakers,
>
> is there a way to activate the cursor keys in Squeak for Macintosh? It
> seems now they are only inserting some special invisible characters into
> text.
I have written code to enable the arrow keys plus home and end. I have
not tested it on version 1.18, but it should work.
Basically, the code moves one character each time up, down, left or
right is pressed. If a line is shorter that the previous line for up or
down, the position on the new line is used as the offset to the next
line.
Holding down the shift key will allow selecting multiple characters,
however, I did not fully implement this and selecting with the left key
then trying to unselect with the right key will not work. It will
simply continue the selection to the right.
Home pressed once goes to the beginning of the line, a second time
will send the cursor to the beginning of the text. The end key works
similarly in the opposite direction.
I wrote this because the one place I don't like using the mouse is
editing Smalltalk code. If people like it, I would be pleased to see
it put into the next version of Squeak.
After filing in the code you must initialize the keyboard tables by
doing:
ParagraphEditor initializeCmdKeyShortcuts.
ParagraphEditor initializeShiftCmdKeyShortcuts
The code needed to file in is:
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
'From Squeak 1.13 of October 17, 1996 on 9 November 1996 at 11:10:18
pm'!
!ParagraphEditor methodsFor: 'typing/selecting keys'!
cursorDown: characterStream
"Private - Move cursor from position in current line to same position in
next line. If next line too short, put at end. If shift key down,
select."
| shift string right left start position textSize|
shift := sensor leftShiftDown.
sensor keyboard.
string _ paragraph text string.
textSize _ string size.
left _ right _ stopBlock stringIndex.
[left > 1 and: [(string at: (left - 1)) ~= Character cr]] whileTrue:
[left _ left - 1].
position _ stopBlock stringIndex - left.
[right < textSize and: [(string at: right) ~= Character cr]] whileTrue:
[right _ right + 1].
right _ start _ right + 1.
[right < textSize and: [(string at: right) ~= Character cr]] whileTrue:
[right _ right + 1].
shift
ifTrue:
[
start + position > right
ifTrue: [self selectFrom: startBlock stringIndex to: right - 1]
ifFalse: [self selectFrom: startBlock stringIndex to: start +
position - 1]
]
ifFalse:
[
start + position > right
ifTrue: [self selectFrom: right to: right - 1]
ifFalse: [self selectFrom: start + position to: start + position -
1]
].
^true!
cursorEnd: characterStream
"Private - Move cursor end of current line. If cursor already at end of
line, put cursor at end of text"
| string right stringSize |
sensor keyboard.
string _ paragraph text string.
stringSize _ string size.
right _ stopBlock stringIndex.
[right <= stringSize and: [(string at: right) ~= Character cr]]
whileTrue: [right _ right + 1].
stopBlock stringIndex == right
ifTrue: [self selectAt: string size + 1]
ifFalse: [self selectAt: right].
^true!
cursorHome: characterStream
"Private - Move cursor from position in current line to beginning of
current line. If cursor already at beginning of line, put cursor at
beginning of text"
| string left |
sensor keyboard.
string _ paragraph text string.
left _ startBlock stringIndex.
[left > 1 and: [(string at: (left - 1)) ~= Character cr]] whileTrue:
[left _ left - 1].
startBlock stringIndex == left
ifTrue: [self selectAt: 1]
ifFalse: [self selectAt: left].
^true!
cursorLeft: characterStream
"Private - Move cursor left one character if nothing selected, otherwise
move cursor to beginning of selection. If the shift key is down, start
selecting or extending current selection. Don't allow cursor past
beginning of text"
| shift |
shift := sensor leftShiftDown.
sensor keyboard.
shift
ifTrue:
[
startBlock stringIndex > 1
ifTrue: [self selectFrom: startBlock stringIndex - 1 to: stopBlock
stringIndex - 1]
]
ifFalse:
[
(startBlock stringIndex == stopBlock stringIndex and: [startBlock
stringIndex > 1])
ifTrue: [self selectFrom: startBlock stringIndex - 1 to: startBlock
stringIndex - 2]
ifFalse: [self selectFrom: startBlock stringIndex to: startBlock
stringIndex - 1]
].
^true!
cursorRight: characterStream
"Private - Move cursor right one character if nothing selected,
otherwise move cursor to end of selection. If the shift key is down,
start selecting characters or extending already selected characters.
Don't allow cursor past end of text"
| shift |
shift := sensor leftShiftDown.
sensor keyboard.
shift
ifTrue: [self selectFrom: startBlock stringIndex to: stopBlock
stringIndex]
ifFalse:
[
startBlock stringIndex == stopBlock stringIndex
ifTrue: [self selectFrom: stopBlock stringIndex + 1 to: stopBlock
stringIndex]
ifFalse: [self selectFrom: stopBlock stringIndex to: stopBlock
stringIndex - 1]
].
^true!
cursorUp: characterStream
"Private - Move cursor from position in current line to same position in
prior line. If prior line too short, put at end"
| shift string left position start |
shift := sensor leftShiftDown.
sensor keyboard.
string _ paragraph text string.
left _ startBlock stringIndex.
[left > 1 and: [(string at: (left - 1)) ~= Character cr]] whileTrue:
[left _ left - 1].
position _ startBlock stringIndex - left.
start _ left.
left _ left - 1.
[left > 1 and: [(string at: (left - 1)) ~= Character cr]] whileTrue:
[left _ left - 1].
left < 1 ifTrue: [left _ 1].
start = 1 ifTrue: [position _ 0].
shift
ifTrue:
[
(start - left < position and: [start > 1])
ifTrue: [self selectFrom: start - 1 to: stopBlock stringIndex - 1]
ifFalse: [self selectFrom: left + position to: stopBlock stringIndex
- 1]
]
ifFalse:
[
(start - left < position and: [start > 1])
ifTrue: [self selectFrom: start - 1 to: start - 2]
ifFalse: [self selectFrom: left + position to: left + position - 1]
].
^true
!
delete: characterStream
"Private - Delete character behind the cursor"
| stop |
characterStream isEmpty
ifTrue:
[
stop _ startBlock stringIndex = stopBlock stringIndex
ifTrue: [stopBlock stringIndex]
ifFalse: [stopBlock stringIndex - 1].
[sensor keyboardPressed and: [sensor keyboardPeek asciiValue = 127]]
whileTrue:
[
"process multiple backspaces"
sensor keyboard.
stop _ paragraph text string size min: stop + 1.
].
self forwardTo: stop
]
ifFalse:
[
sensor keyboard.
characterStream skip: -1
].
^false! !
!ParagraphEditor methodsFor: 'typing support'!
dispatchOnCharacter: char with: typeAheadStream
"Private - Carry out the action associated with this character, if any.
Type-ahead is passed so some routines can flush or use it."
"process special keys, command keys or shift, command keys"
(sensor commandKeyPressed or: [self class specialShiftCmdKeys includes:
char asciiValue])
ifTrue:
[
sensor leftShiftDown
ifTrue: [^self perform: (ShiftCmdActions at: char asciiValue + 1)
with: typeAheadStream] ifFalse: [^self perform: (CmdActions at: char
asciiValue + 1) with: typeAheadStream].
].
"the control key can be used to invoke shift-cmd shortcuts"
sensor controlKeyPressed
ifTrue: [^self perform: (ShiftCmdActions at: char asciiValue + 1)
with: typeAheadStream].
^ self perform: #normalCharacter: with: typeAheadStream!
forwardTo: stopIndex
"see comments for backTo:"
| saveLimit newForwardovers |
saveLimit _ beginTypeInBlock == nil
ifTrue: [self openTypeIn. UndoSelection _ self nullText. startBlock
stringIndex]
ifFalse: [beginTypeInBlock stringIndex].
stopBlock _ paragraph characterBlockForIndex: stopIndex.
stopIndex > saveLimit
ifTrue:
[
newForwardovers _ beginTypeInBlock stringIndex - stopIndex.
beginTypeInBlock _ startBlock copy.
UndoSelection replaceFrom: 1 to: 0 with:
(paragraph text copyFrom: saveLimit to: stopIndex - 1 ).
UndoMessage argument: UndoMessage argument - newForwardovers
].
self zapSelectionWith: self nullText.
startBlock _ stopBlock copy! !
!ParagraphEditor class methodsFor: 'keyboard shortcut tables'!
initializeCmdKeyShortcuts
"Initialize the (unshifted) command-key shortcut table."
"ParagraphEditor initialize"
| cmdMap cmds |
cmdMap _ Array new: 256. "use temp in case of a crash"
cmdMap atAllPut: #noop:.
cmdMap at: ( 1 + 1) put: #cursorHome:. "home key"
cmdMap at: ( 4 + 1) put: #cursorEnd:. "end key"
cmdMap at: ( 8 + 1) put: #backspace:. "ctrl-H or delete key"
cmdMap at: (27 + 1) put: #selectCurrentTypeIn:. "escape key"
cmdMap at: (28 + 1) put: #cursorLeft:. "left arrow key"
cmdMap at: (29 + 1) put: #cursorRight:. "right arrow key"
cmdMap at: (30 + 1) put: #cursorUp:. "up arrow key"
cmdMap at: (31 + 1) put: #cursorDown:. "down arrow key"
cmdMap at: (127 + 1) put: #delete:. "del key"
'0123456789' do: [ :char | cmdMap at: (char asciiValue + 1) put:
#changeEmphasis: ].
'([{''"<' do: [ :char | cmdMap at: (char asciiValue + 1) put:
#enclose: ].
cmdMap at: ($, asciiValue + 1) put: #shiftEnclose:.
cmds _ #(
$a selectAll:
$b browseIt:
$c copySelection:
$d doIt:
$e exchange:
$f find:
$g findAgain:
$h setSearchString:
$i inspectIt:
$j doAgainOnce:
$k offerFontMenu:
$l cancel:
$m implementorsOfIt:
$n sendersOfIt:
$o spawnIt:
$p printIt:
$q querySymbol:
$r recognizer:
$s save:
$t tempCommand:
$u align:
$v paste:
$w backWord:
$x cut:
$y swapChars:
$z undo:
).
1 to: cmds size by: 2
do: [:i | cmdMap at: ((cmds at: i) asciiValue + 1) put: (cmds at: i +
1)].
CmdActions _ cmdMap.
!
initializeShiftCmdKeyShortcuts
"Initialize the shift-command-key (or control-key) shortcut table."
| cmdMap cmds |
"shift-command and control shortcuts"
cmdMap _ Array new: 256. "use temp in case of a crash"
cmdMap atAllPut: #noop:.
cmdMap at: ( 1 + 1) put: #cursorHome:. "home key"
cmdMap at: ( 4 + 1) put: #cursorEnd:. "end key"
cmdMap at: ( 8 + 1) put: #backspace:. "ctrl-H or delete key"
cmdMap at: (27 + 1) put: #selectCurrentTypeIn:. "escape key"
cmdMap at: (28 + 1) put: #cursorLeft:. "left arrow key"
cmdMap at: (29 + 1) put: #cursorRight:. "right arrow key"
cmdMap at: (30 + 1) put: #cursorUp:. "up arrow key"
cmdMap at: (31 + 1) put: #cursorDown:. "down arrow key"
cmdMap at: (127 + 1) put: #delete:. "del key"
"Note: Command key overrides shift key, so, for example, cmd-shift-9
produces $9 not $("
'9[,''' do: [ :char | cmdMap at: (char asciiValue + 1) put:
#shiftEnclose: ]. "({< and double-quote"
cmdMap at: (27 + 1) put: #shiftEnclose:. "ctrl-["
"Note: Must use cmd-9 or ctrl-9 to get '()' since cmd-shift-9 is a Mac
FKey command."
cmds _ #(
$a argAdvance:
$b browseItHere:
$c compareToClipboard:
$d duplicate:
$f displayIfFalse:
$j doAgainMany:
$k changeStyle:
$n referencesToIt:
$r indent:
$l outdent:
$s search:
$t displayIfTrue:
$w methodNamesContainingIt:
$v pasteInitials:
).
1 to: cmds size by: 2
do:
[
:i |
cmdMap at: ((cmds at: i) asciiValue + 1) put: (cmds at: i + 1).
cmdMap at: (((cmds at: i) asciiValue - 96) + 1) put: (cmds at: i +
1).
].
ShiftCmdActions _ cmdMap.!
specialShiftCmdKeys
"Private - return array of key codes that represent single keys acting
as if shift-command were also being pressed"
^#(
1 "home"
3 "enter"
4 "end"
8 "backspace"
27 "escape"
28 "left arrow"
29 "right arrow"
30 "up arrow"
31 "down arrow"
127 "delete"
)! !
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Date: 97 Jan 07 5:46:43 pm
From: "Rick L. Taylor" <rltaylor@ix.netcom.com>
To: kgarrels@rhein-neckar.netsurf.de
Cc: Squeak@create.ucsb.edu
Subject: Re: Cursor Keys in Squeak for Mac
Rick L. Taylor wrote:
>
> Kai Garrels wrote:
> >
> > Hi Sqeakers,
> >
> > is there a way to activate the cursor keys in Squeak for Macintosh? It
> > seems now they are only inserting some special invisible characters into
> > text.
>
> I have written code to enable the arrow keys plus home and end. I have
> not tested it on version 1.18, but it should work.
>
> Basically, the code moves one character each time up, down, left or
> right is pressed. If a line is shorter that the previous line for up or
> down, the position on the new line is used as the offset to the next
> line.
>
> Holding down the shift key will allow selecting multiple characters,
> however, I did not fully implement this and selecting with the left key
> then trying to unselect with the right key will not work. It will
> simply continue the selection to the right.
>
> Home pressed once goes to the beginning of the line, a second time
> will send the cursor to the beginning of the text. The end key works
> similarly in the opposite direction.
>
I forgot to mention in my last message, I also implemented the Del key
so you can delete characters in either direction.
I should also mention that this code was written on the Macintosh. I
don't know if other flavors use the same keyboard codes, but it should
be easy enough to modify the key tables if they are different
Date: 97 Jan 07 8:16:47 pm
From: Dan Ingalls <DanI@wdi.disney.com>
To: "Rick L. Taylor" <rltaylor@ix.netcom.com>
Cc: Squeak@create.ucsb.edu
In-Reply-To: <32D2FCE2.3BD@ix.netcom.com>
Subject: Re: Cursor Keys in Squeak for Mac
...prior stuff elided...
>I forgot to mention in my last message, I also implemented the Del key
>so you can delete characters in either direction.
Are you aware that shift-delete (works on Duo keyboards) already does
forward delete. I'm not proud of the code, but it was announced in the
README file for 1.14:
"Define ctrl-Return as CR followed by the same number of tabs as the
line above, (adjusted by number of brackets). Also define
Shift-backspace
as forward delete-char [not currently undoable]."
This is also (mirabile dictu!) documented in the
screen-menu.help...command-key help window. The comment there also says
it's not undoable, but actually it is, since Ted K. made it work in 1.16.
- Dan
PS: Don't feel bad -- Squeak at present does not help you to find things
unless you know where they are (!). [Note however that, by loading the
changes file into a fast text editor, you would find both the code and its
scanty documentation by searching for either 'delete' or 'forward'.]
Date: 97 Jan 08 12:08:49 am
From: kgarrels@rhein-neckar.netsurf.de (Kai Garrels)
To: raab@isg_nw.cs.Uni-Magdeburg.DE (Andreas Raab), squeak@create.ucsb.edu
In-Reply-To: <5D9A521DF2@isg_nw.cs.uni-magdeburg.de>
Subject: Re: Cursor Keys in Squeak for Mac
> > Hi Sqeakers,
> >
> > is there a way to activate the cursor keys in Squeak for Macintosh? It
> > seems now they are only inserting some special invisible characters into
> > text.
>
> For a quick hack see:
>
> http://simsrv.cs.uni-magdeburg.de/~michael/st80/cv/src/Cursors.st
>
This was excellent. A good mailing list ;-)
Thanks a lot.
Bye,
kai
--
Kai Garrels
Mannheim
Germany
Date: 97 Jan 08 3:26:25 pm
From: "David N. Smith" <dnsmith@watson.ibm.com>
To: squeak@create.ucsb.edu
Subject: hashMappedBy: and newHashFor: messages
Anyone:
I just ran into the hashMappedBy: and newHashFor: messages. There seems to
be no implementor of newhashFor:, and hashMappedBy: doesn't seem to be used
by anything but other hashMappedBy: messages.
Are these leftovers, partly implemented new stuff, or are they sent by the
VM (or god) or what?
I'm trying to document how one implements a hash method, and its associated
#+ method, for a section in my FAQ, and ran into this stuff.
Can someone who knows more about these messages help me out or point me to
the secret places?
Thanks,
dave
_______________________________
David N. Smith
dnsmith@watson.ibm.com
IBM T J Watson Research Center
Hawthorne, NY
_______________________________
Any opinions or recommendations
herein are those of the author
and not of his employer.
Date: 97 Jan 08 4:47:36 pm
From: Dan Ingalls <DanI@wdi.disney.com>
To: "David N. Smith" <dnsmith@watson.ibm.com>
Cc: Squeak@create.ucsb.edu
In-Reply-To: <v03007802aef9dd9023cc@[129.34.225.178]>
Subject: Re: hashMappedBy: and newHashFor: messages
>Anyone:
>
>I just ran into the hashMappedBy: and newHashFor: messages. There seems to
>be no implementor of newhashFor:, and hashMappedBy: doesn't seem to be used
>by anything but other hashMappedBy: messages.
>
>Are these leftovers, partly implemented new stuff, or are they sent by the
>VM (or god) or what?
>
>I'm trying to document how one implements a hash method, and its associated
>#+ method, for a section in my FAQ, and ran into this stuff.
>
>Can someone who knows more about these messages help me out or point me to
>the secret places?
sure...
There once was a program called variously the SystemTracer, the Cloner, or
the VmemWriter. It was originally written by Ted Kaehler, and it did a
remarkable thing: Within the Smalltalk image itself, it traced all
accessible objects, and then wrote a new image on disk of just those
objects. It was a fantastic help in the early days of Smalltalk, because
there was no garbage collector -- only reference counts.
1. It allowed one to write a new, compact image when you were running out
of memory due to unreclaimed cyclic structures.
2. It also allowed one to change fundamental aspects of the image without
having to restart from scratch, because in the cloner one could add a
method that would, for instance, change every method header as it wrote the
new image on disk.
Of course in the new image, objects would have different object pointers
and, in that version of Smalltalk, the default hash of an object was its
object pointer. Therefore when you started the new image, many of the
hash table entries were in the wrong places.
So Ted put a feature into the cloner which would remap all hashed
structures using hashMappedBy: with a table of new pointers
indexed by old pointers. This fixed the problem with hashed
structures.
The cloner was actually running in Apple's Smalltalk, and we used it
repeatedly to write new 32-bit direct-pointer Squeak images from the old
(16-bit, object-table) image until we finally "crossed the bridge" to a
system that could reliably save a snapshot of itself.
We removed the cloner from Squeak prior to the release because it needed to
be completely rewritten. Among other things, it was full of
circumlocutions to do efficient 16-bit arithmetic with 12-bit integers (one
implementation that allowed addressing of 60k objects and 4k integers with
16-bit pointers). For another, Squeak's ObjectMemory class provides a
working description of the image format, so that it is now very easy to
read in an image, munge it in memory, and then write it our again. This
essentially obviates the need for such a cloner.
Now you know the whole story of hashMappedBy!
- Dan
Date: 97 Jan 08 8:26:48 pm
From: "Rick L. Taylor" <rltaylor@ix.netcom.com>
To: Dan Ingalls <DanI@wdi.disney.com>
Cc: Squeak@create.ucsb.edu
Subject: Re: Cursor Keys in Squeak for Mac
Dan Ingalls wrote:
>
> Are you aware that shift-delete (works on Duo keyboards) already does
> forward delete. I'm not proud of the code, but it was announced in the
> README file for 1.14:
Thanks for the tip. I had originally implemented the code in 1.13,
Then with a busy work schedule and holidays, I have not been able
to get back to Squeak since. So I never saw the read-me file and
have just downloaded 1.18.
Thanks for letting me know.
To remove my del key code
1. remove ParagraphEditor>>delete:
2. In ParagraphEditor>>initializeCmdKeyShortcuts remove statement
cmdMap at: (127 + 1) put: #delete:.
3. In ParagraphEditor>>initializeShiftCmdKeyShortcuts remove statement
cmdMap at: (127 + 1) put: #delete:.
I have not had time to look at the code you described, so I can't tell
at this time if there are any other incompatiblities.
Rick
Date: 97 Jan 08 10:20:40 pm
From: oliver@fritz.co.traverse.com (Christopher Oliver)
To: squeak@create.ucsb.edu (squeak)
Subject: Foreign functions anyone?
Has anyone any advice on how to interface Squeak to a foreign API? I'm
thinking of such things as common C libraries (Berkeley DB for instance),
and OS calls.
Thanks,
--
Christopher Oliver Traverse Communications
Systems Coordinator 223 Grandview Pkwy, Suite 108
oliver@traverse.com Traverse City, Michigan, 49684
The loop macro: because no language is complete without a little COBOL.
Date: 97 Jan 09 7:52:49 am
From: "David N. Smith" <dnsmith@watson.ibm.com>
To: Dan Ingalls <DanI@wdi.disney.com>
Cc: Squeak@create.ucsb.edu
In-Reply-To: <v03007800aef9e3be0161@[206.16.10.79]>
Subject: Re: hashMappedBy: and newHashFor: messages
At 19:53 -0500 01/08/97, Dan Ingalls wrote:
>>Anyone:
>>
>>I just ran into the hashMappedBy: and newHashFor: messages. There seems to
>>be no implementor of newhashFor:, and hashMappedBy: doesn't seem to be used
>>by anything but other hashMappedBy: messages.
>>
>>Are these leftovers, partly implemented new stuff, or are they sent by the
>>VM (or god) or what?
>>
>>I'm trying to document how one implements a hash method, and its associated
>>#+ method, for a section in my FAQ, and ran into this stuff.
>>
>>Can someone who knows more about these messages help me out or point me to
>>the secret places?
>
>sure...
>
>There once was a program called variously the SystemTracer, the Cloner, or
>the VmemWriter.
> ... SNIP ...
>
>Now you know the whole story of hashMappedBy!
>
> - Dan
Dan:
Thanks!
Dave
_______________________________
David N. Smith
dnsmith@watson.ibm.com
IBM T J Watson Research Center
Hawthorne, NY
_______________________________
Any opinions or recommendations
herein are those of the author
and not of his employer.
Date: 97 Jan 10 2:01:44 pm
From: "David N. Smith" <dnsmith@watson.ibm.com>
To: squeak@create.ucsb.edu
Subject: Someone was bored one day?
Just found this in copyReplaceAll:with:
'How now brown cow?' copyReplaceAll: 'ow' with: 'ello'
It probably took someone longer to find this example that it dit do write
the code.
A Yo-Yo would enjoy that. :-)
I did too.
Dave
(Those needing further explanation should check their local CD store.)
_______________________________
David N. Smith
dnsmith@watson.ibm.com
IBM T J Watson Research Center
Hawthorne, NY
_______________________________
Any opinions or recommendations
herein are those of the author
and not of his employer.
Date: 97 Jan 10 3:24:07 pm
From: Dan Ingalls <DanI@wdi.disney.com>
To: Squeak@create.ucsb.edu
Subject: DisplayScanner instvar 'paragraph' & delta files
Attention: maintainers of old images...
Tim Rowledge has uncovered what appears to be a missing item in the deltas
from 1.15 -> 1.16 (or thereabouts). There is a need to add the instance
variable 'paragraph' to DisplayScanner. Without this, as Tim discovered,
the fileIns 1.17 -> 1.18 will barf.
If you have questions about any further ramifications, Tim should be able
to fill you in on the details.
Thanks, Tim
- Dan
>Hi Dan,
> I found a small but potentially worrying problem yesterday while
>attempting to incorporate the 1.17->1.18 delta files into our work image;
>it seems that somewhere between 1.15 & 1.16, DisplayScanner got an extra
>instvar, 'paragraph' which didn't get recorded in any delta file.
>I've scanned all the delta files I downloaded, and in 1.15, DisplayScanner
>has a couple of instvars added ('fillBLt' & 'lineHeight' I think), then in
>the 1.17->1.18 deltas the method displayLines:in:clippedBy: is changed to
>refer to 'paragraph'. In the Interval image this causes great upset, since
>of course it is undeclared and whoosh,bang,oh-nasty. It took quite a while
>to discover this, since my virgin 1.18 image running on the <xyz chip> was
>built simply by filing in all these deltas without any drama at all!
>Whilst it can't really affect most people, it seemed I should tell you
>just in case it points to some bug in the change stuff or whatever.
>
>Happy New Year & all that,
>tim
>--
>Tim Rowledge: rowledge@interval.com (w) +1 (415) 856-7230 (w)
> tim@sumeru.stanford.edu (h) <http://sumeru.stanford.edu/tim>
Date: 97 Jan 10 6:21:30 pm
From: Patrick Logan <plogan@teleport.com>
To: tyrrell@avalanche.ncsa.uiuc.edu
Cc: squeak@create.ucsb.edu
In-Reply-To: <199701070335.VAA01952@avalanche.ncsa.uiuc.edu> (message from Les
Tyrrell on Mon, 6 Jan 1997 21:35:39 -0600 (CST))
Subject: Re: Squeak Object Database?
I'm also curious whether anyone is looking at hooking up an OO database
to Squeak. I've heard that Texas Persistent Store might be a good
candidate for this- any suggestions?
Texas may be a good candidate, since the same group has hooked it up
to their Scheme system (RScheme). So it probably has some
support/awareness of GC, etc. out-of-the-box.
-Patrick Logan
Date: 97 Jan 13 5:58:36 am
From: Georg Gollmann <gollmann@edvz.tuwien.ac.at>
To: "Rick L. Taylor" <rltaylor@ix.netcom.com>
Cc: Squeak@create.ucsb.edu
In-Reply-To: <32D2FAEB.73A5@ix.netcom.com>
Subject: Re: Cursor Keys in Squeak for Mac
At 19:39 Uhr -0600 7.1.1997, Rick L. Taylor wrote:
>I have written code to enable the arrow keys plus home and end. I have
>not tested it on version 1.18, but it should work.
Thanks a lot !
One small point: in "initializeShiftCmdKeyShortcuts" there should be a line
cmdMap at: (13 + 1) put: #crWithIndent:. "ctrl-Return"
otherwise the indent feature of "ctrl-Return" is lost.
Kind regards
Georg
----
Dipl.Ing. Georg Gollmann TU-Wien, EDV-Zentrum
phon:(++43-1) 58801 - 5848
mail:gollmann@edvz.tuwien.ac.at
http://ftp.tuwien.ac.at/~go/Gollmann.html
Date: 97 Jan 13 6:25:19 am
From: Hans-Martin Mosner <hmm@heeg.de>
To: squeak@create.ucsb.edu
Subject: Moderate BitBlt speedup (VM writers, please read)
Dies ist eine mehrteilige Nachricht im MIME-Format.
--------------37C446EA5644
Content-Type: text/plain; charset=us-ascii
Content-Transfer-Encoding: 7bit
Hello,
here is a little speedup for BitBlt:
This code modifies the CCodegenerator and associated
classes so that it
becomes possible to code the BitBltSimulation>>merge:with:
method using
the dispatchOn:... mechanism, which can be translated into
a C case
statement.
This ChangeSet also removes the implementors of
#inlineMethodsUsing:, a
method that obviously was not used anymore.
The speedup that I got for a simple BitBlt case (reversing
a Form) was
about 20 percent on the raw BitBlt stuff (i.e., not
counting the setup
per call of #copyBits).
However, this was comparing the original Squeak VM for the
Mac with one
that I built with the MPW MrC compiler. MrC has a somewhat
weaker code
generation than MetroWerks CodeWarrior, therefore I expect
the
attainable performance gain to be a little bit higher.
Hans-Martin
--------------37C446EA5644
Content-Type: text/plain; charset=us-ascii
Content-Transfer-Encoding: 7bit
Content-Disposition: inline; filename="BitBltSpeed.13Jan226pm.cs"
'From Squeak 1.18 of December 12, 1996 on 13 January 1997 at 2:26:59 pm'!
"Change Set: BitBltSpeed
Date: 13 January 1997
Author: Hans-Martin Mosner <hmm@heeg.de>, <hm.mosner@cww.de>
Here is a little speedup for BitBlt:
This code modifes the CCodegenerator and associated classes so that it becomes possible to code the BitBltSimulation>>merge:with: method using the dispatchOn:... mechanism, which can be translated into a C case statement.
This ChangeSet also removes the implementors of #inlineMethodsUsing:, a method that obviously was not used anymore.
The speedup that I got for a simple BitBlt case (reversing a Form) was about 20 percent on the raw BitBlt stuff (i.e., not counting the setup per call of #copyBits).
However, this was comparing the original Squeak VM for the Mac with one that I built with the MPW MrC compiler. MrC has a somewhat weaker code generation than MetroWerks CodeWarrior, therefore I expect the attainable performance gain to be a little bit higher."!
Object subclass: #BitBltSimulation
instanceVariableNames: 'destForm sourceForm halftoneForm combinationRule destX destY width height sourceX sourceY clipX clipY clipWidth clipHeight sourceBits sourceRaster sourcePixSize destBits destRaster destPixSize pixPerWord bitCount skew mask1 mask2 preload nWords hDir vDir sourceIndex sourceDelta destIndex destDelta sx sy dx dy bbW bbH srcWidth srcHeight halftoneHeight noSource noHalftone halftoneBase colorMap cmBitsPerColor srcBitIndex scanStart scanStop scanString scanRightX scanStopArray scanDisplayFlag scanXTable stopCode bitBltOop affectedL affectedR affectedT affectedB interpreterProxy '
classVariableNames: 'BBClipWidthIndex FixedPt1 BBSourceXIndex FormDepthIndex BBWarpBase BBClipHeightIndex BBRuleIndex BBSourceFormIndex BBDestFormIndex AllOnes BinaryPoint FormBitsIndex FormWidthIndex EndOfRun BBDestYIndex FormHeightIndex BBClipYIndex BBWidthIndex BBClipXIndex BBSourceYIndex BBHalftoneFormIndex BBDestXIndex BBHeightIndex CrossedX BBXTableIndex BBColorMapIndex RuleTable BBLastIndex '
poolDictionaries: ''
category: 'Squeak Interpreter'!
!BitBltSimulation methodsFor: 'translation support'!
dispatchOn: anInteger with: sourceWord with: destinationWord in: selectorArray
"Simulate a case statement via selector table lookup.
The given integer must be between 0 and selectorArray size-1, inclusive.
For speed, no range test is done, since it is done by the at: operation."
"assert: (anInteger >= 0) | (anInteger < selectorArray size)"
^self
perform: (selectorArray at: (anInteger + 1))
with: sourceWord
with: destinationWord! !
!BitBltSimulation methodsFor: 'combination rules'!
addWord: sourceWord with: destinationWord
^sourceWord + destinationWord!
bitAnd: sourceWord with: destinationWord
^sourceWord bitAnd: destinationWord!
bitAndInvert: sourceWord with: destinationWord
^sourceWord bitAnd: destinationWord bitInvert32!
bitInvertAnd: sourceWord with: destinationWord
^sourceWord bitInvert32 bitAnd: destinationWord!
bitInvertAndInvert: sourceWord with: destinationWord
^sourceWord bitInvert32 bitAnd: destinationWord bitInvert32!
bitInvertDestination: sourceWord with: destinationWord
^destinationWord bitInvert32!
bitInvertOr: sourceWord with: destinationWord
^sourceWord bitInvert32 bitOr: destinationWord!
bitInvertOrInvert: sourceWord with: destinationWord
^sourceWord bitInvert32 bitOr: destinationWord bitInvert32!
bitInvertSource: sourceWord with: destinationWord
^sourceWord bitInvert32!
bitInvertXor: sourceWord with: destinationWord
^sourceWord bitInvert32 bitXor: destinationWord!
bitOr: sourceWord with: destinationWord
^sourceWord bitOr: destinationWord!
bitOrInvert: sourceWord with: destinationWord
^sourceWord bitOr: destinationWord bitInvert32!
bitXor: sourceWord with: destinationWord
^sourceWord bitXor: destinationWord!
clearWord: source with: destination
^ 0!
destinationWord: sourceWord with: destinationWord
^destinationWord!
merge: sourceWord with: destinationWord
"1/2/97 hmm: implemented with case statement now..."
^self dispatchOn: combinationRule
with: sourceWord with: destinationWord
in: RuleTable!
sourceWord: sourceWord with: destinationWord
^sourceWord!
subWord: sourceWord with: destinationWord
^sourceWord - destinationWord!
tallyIntoMap: sourceWord with: destinationWord
"Tally pixels into the color map. Note that the source should be
specified = destination, in order for the proper color map checks
to be performed at setup.
Note that the region is not clipped to bit boundaries, but only to the
nearest (enclosing) word. This is because copyLoop does not do
pre-merge masking. For accurate results, you must subtract the
values obtained from the left and right fringes."
| mapIndex pixMask shiftWord |
colorMap = interpreterProxy nilObject
ifTrue: [^ destinationWord "no op"].
destPixSize < 16 ifTrue:
["loop through all packed pixels."
pixMask _ (1<<destPixSize) - 1.
shiftWord _ destinationWord.
1 to: pixPerWord do:
[:i |
mapIndex _ shiftWord bitAnd: pixMask.
interpreterProxy storeWord: mapIndex ofObject: colorMap
withValue: (interpreterProxy fetchWord: mapIndex ofObject: colorMap) + 1.
shiftWord _ shiftWord >> destPixSize].
^ destinationWord].
destPixSize = 16 ifTrue:
["Two pixels Tally the right half..."
mapIndex _ self rgbMap: destinationWord from: 5 to: cmBitsPerColor.
interpreterProxy storeWord: mapIndex ofObject: colorMap
withValue: (interpreterProxy fetchWord: mapIndex ofObject: colorMap) + 1.
"... and then left half"
mapIndex _ self rgbMap: destinationWord>>16 from: 5 to: cmBitsPerColor.
interpreterProxy storeWord: mapIndex ofObject: colorMap
withValue: (interpreterProxy fetchWord: mapIndex ofObject: colorMap) + 1]
ifFalse:
["Just one pixel."
mapIndex _ self rgbMap: destinationWord from: 8 to: cmBitsPerColor.
interpreterProxy storeWord: mapIndex ofObject: colorMap
withValue: (interpreterProxy fetchWord: mapIndex ofObject: colorMap) + 1].
^ destinationWord "For no effect on dest"! !
!BitBltSimulation class methodsFor: 'initialization'!
initialize
"BitBltSimulation initialize"
self initializeRuleTable.
"Mask constants"
AllOnes _ 16rFFFFFFFF.
BinaryPoint _ 14.
FixedPt1 _ 1 << BinaryPoint. "Value of 1.0 in Warp's fixed-point representation"
"Indices into stopConditions for scanning"
EndOfRun _ 257.
CrossedX _ 258.
"Form fields"
FormBitsIndex _ 0.
FormWidthIndex _ 1.
FormHeightIndex _ 2.
FormDepthIndex _ 3.
"BitBlt fields"
BBDestFormIndex _ 0.
BBSourceFormIndex _ 1.
BBHalftoneFormIndex _ 2.
BBRuleIndex _ 3.
BBDestXIndex _ 4.
BBDestYIndex _ 5.
BBWidthIndex _ 6.
BBHeightIndex _ 7.
BBSourceXIndex _ 8.
BBSourceYIndex _ 9.
BBClipXIndex _ 10.
BBClipYIndex _ 11.
BBClipWidthIndex _ 12.
BBClipHeightIndex _ 13.
BBColorMapIndex _ 14.
BBWarpBase _ 15.
BBLastIndex _ 15.
BBXTableIndex _ 16.!
initializeRuleTable
"BitBltSimulation initializeRuleTable"
RuleTable _ #(
"0" clearWord:with:
"1" bitAnd:with:
"2" bitAndInvert:with:
"3" sourceWord:with:
"4" bitInvertAnd:with:
"5" destinationWord:with:
"6" bitXor:with:
"7" bitOr:with:
"8" bitInvertAndInvert:with:
"9" bitInvertXor:with:
"10" bitInvertDestination:with:
"11" bitOrInvert:with:
"12" bitInvertSource:with:
"13" bitInvertOr:with:
"14" bitInvertOrInvert:with:
"15" destinationWord:with:
"16" destinationWord:with:
"17" destinationWord:with:
"18" addWord:with:
"19" subWord:with:
"20" rgbAdd:with:
"21" rgbSub:with:
"22" rgbDiff:with:
"23" tallyIntoMap:with:
"24" alphaBlend:with:
"25" pixPaint:with:
"26" destinationWord:with:
"27" destinationWord:with:
"28" destinationWord:with:
"29" destinationWord:with:
"30" destinationWord:with:
"31" destinationWord:with:
)! !
!CCodeGenerator methodsFor: 'public'!
addClass: aClass
"Add the variables and methods of the given class to the code base."
| source |
self checkClassForNameConflicts: aClass.
aClass classPool associationsDo: [ :assoc |
constants at: assoc key put: (TConstantNode new setValue: assoc value).
].
variables addAll: aClass instVarNames.
'Adding Class ' , aClass name , '...'
displayProgressAt: Sensor cursorPoint
from: 0 to: aClass selectors size
during: [:bar |
aClass selectors doWithIndex: [ :sel :i | bar value: i.
('dispatchOn:*in:' match: sel) ifFalse: [
source _ aClass sourceCodeAt: sel.
self addMethod: ((Compiler new parse: source in: aClass notifying: nil) asTMethodFromClass: aClass)].
]].! !
!CCodeGenerator methodsFor: 'inlining'!
removeMethodsReferingToGlobals: varList except: methodName
"Remove any methods (presumably inlined) that still contain references to the given obsolete global variables."
| varListAsStrings removeIt mVars |
varListAsStrings _ varList collect: [ :sym | sym asString ].
'Removing methods referring to interpreter globals...'
displayProgressAt: Sensor cursorPoint
from: 0 to: methods size
during: [:bar |
methods keys copy doWithIndex: [ :sel :i |
bar value: i.
removeIt _ false.
mVars _ (self methodNamed: sel) freeVariableReferences asSet.
varListAsStrings do: [ :v |
(mVars includes: v) ifTrue: [ removeIt _ true ].
].
(removeIt and: [sel ~= methodName]) ifTrue: [
methods removeKey: sel ifAbsent: [].
].
]].! !
!CCodeGenerator methodsFor: 'utilities'!
prepareMethods
"Prepare methods for browsing."
| globals |
globals _ Set new: 200.
globals addAll: variables.
'Preparing methods...'
displayProgressAt: Sensor cursorPoint
from: 0 to: methods size
during: [:bar |
methods doWithIndex: [ :m :i |
bar value: i.
(m locals, m args) do: [ :var |
(globals includes: var) ifTrue: [
self error: 'Local variable name may mask global when inlining: ', var.
].
(methods includesKey: var) ifTrue: [
self error: 'Local variable name may mask method when inlining: ', var.
].
].
m bindClassVariablesIn: constants.
m prepareMethodIn: self.
]].! !
!TMethod methodsFor: 'transformations'!
buildCaseStmt: aSendNode
"Build a case statement node for the given send of dispatchOn:in:."
"1/2/97 hmm: modified to translate dispatchOn:with:with:in:, too"
"Note: the first argument is the variable to be dispatched on. The second argument is a constant node holding an array of unary selectors, which will be turned into sends to self."
((aSendNode args size = 2 or: [aSendNode args size = 4]) and:
[aSendNode args last isConstant and:
[aSendNode args last value class = Array]]) ifFalse: [
self error: 'wrong node structure for a case statement'.
].
^TCaseStmtNode new
setExpression: aSendNode args first
selectors: aSendNode args last value
arguments: (aSendNode args copyFrom: 2 to: aSendNode args size-1)!
prepareMethodIn: aCodeGen
"Record sends of builtin operators and replace sends of the special selector dispatchOn:in: with case statement nodes."
"Note: Only replaces top-level sends of dispatchOn:in:. Case statements must be top-level statements; they cannot appear in expressions."
| stmts stmt case |
parseTree nodesDo: [ :node |
node isSend ifTrue: [
"record sends of builtin operators"
(aCodeGen builtin: node selector) ifTrue: [ node isBuiltinOperator: true ].
].
node isStmtList ifTrue: [
"replace dispatchOn:in: with case statement node"
stmts _ node statements.
1 to: stmts size do: [ :i |
stmt _ stmts at: i.
case _ self tryToBuildCaseStmt: stmt.
(case == nil) ifFalse: [
stmts at: i put: case.
].
stmt isReturn ifTrue: [
case _ self tryToBuildCaseStmt: stmt expression.
case == nil ifFalse: [
case makeReturnCases.
stmts at: i put: case
]
]
].
].
].!
tryToBuildCaseStmt: stmt
(stmt isSend and: [stmt selector = #dispatchOn:in: or: [stmt selector = #dispatchOn:with:with:in:]]) ifTrue: [
^(self buildCaseStmt: stmt)].
^nil
! !
!TMethod methodsFor: 'inlining'!
inlineCaseStatementBranchesIn: aCodeGen localizingVars: varsList
| stmt sel meth newStatements maxTemp usedVars exitLabel v |
maxTemp _ 0.
parseTree nodesDo: [ :n |
n isCaseStmt ifTrue: [
n cases do: [ :stmtNode |
stmt _ stmtNode statements first.
stmt isSend ifTrue: [
sel _ stmt selector.
meth _ aCodeGen methodNamed: sel.
((meth ~= nil) and:
[meth hasNoCCode "and:
[meth args size = 0]"]) ifTrue: [
meth _ meth copy.
maxTemp _ maxTemp max: (meth renameVarsForCaseStmtWithArgs: stmt args).
meth hasReturn ifTrue: [
exitLabel _ self unusedLabelForInliningInto: self.
meth exitVar: nil label: exitLabel.
labels add: exitLabel.
] ifFalse: [ exitLabel _ nil ].
meth renameLabelsForInliningInto: self.
meth labels do: [ :label | labels add: label ].
newStatements _ stmtNode statements asOrderedCollection.
newStatements removeFirst.
exitLabel ~= nil ifTrue: [
newStatements addFirst:
(TLabeledCommentNode new
setLabel: exitLabel comment: 'end case').
].
newStatements addAllFirst: meth statements.
newStatements addFirst:
(TLabeledCommentNode new setComment: meth selector).
stmtNode setStatements: newStatements.
].
].
].
].
].
usedVars _ (locals, args) asSet.
1 to: maxTemp do: [ :i |
v _ ('t', i printString).
(usedVars includes: v) ifTrue: [ self error: 'temp variable name conflicts with an existing local or arg' ].
locals addLast: v.
].
"make local versions of the given globals"
varsList do: [ :var |
(usedVars includes: var) ifFalse: [ locals addFirst: var asString ].
].
! !
!TMethod methodsFor: 'inlining support'!
renameVarsForCaseStmtWithArgs: caseArgs
"Rename the arguments and locals of this method with names like t1, t2, t3, etc. Return the number of variable names assigned. This is done to allow registers to be shared among the cases."
| i varMap |
i _ 1.
varMap _ Dictionary new.
args with: caseArgs do: [:v :nv |
varMap at: v put: nv name].
locals do: [ :v |
varMap at: v put: ('t', i printString) asSymbol.
i _ i + 1.
].
self renameVariablesUsing: varMap.
^ i - 1! !
!TCaseStmtNode methodsFor: 'all'!
makeReturnCases
"precondition: all cases are simple message sends."
| stmtList |
1 to: cases size do: [:i |
stmtList _ (cases at: i) statements.
stmtList at: 1 put: (TReturnNode new setExpression: stmtList first)]!
setExpression: aNode selectors: selectorList arguments: arguments
"Initialize the node from the given set of selectors."
"Note: Each case is a statement list with containing one statement, a send to self of a selector from the given selector list. Having statement list nodes makes inlining easier later."
| selfNode stmt lastSel firstInRun sel |
expression _ aNode.
selfNode _ TVariableNode new setName: 'self'.
firsts _ OrderedCollection new: 400.
lasts _ OrderedCollection new: 400.
cases _ OrderedCollection new: 400.
lastSel _ selectorList first.
firstInRun _ 0.
1 to: selectorList size do: [ :i |
sel _ selectorList at: i.
sel ~= lastSel ifTrue: [
firsts add: firstInRun.
lasts add: i - 2.
stmt _ TSendNode new setSelector: lastSel receiver: selfNode arguments: arguments.
cases add: (TStmtListNode new setArguments: #() statements: (Array with: stmt)).
lastSel _ sel.
firstInRun _ i - 1.
].
].
firsts add: firstInRun.
lasts add: selectorList size - 1.
stmt _ TSendNode new setSelector: lastSel receiver: selfNode arguments: arguments.
cases add: (TStmtListNode new setArguments: #() statements: (Array with: stmt)).! !
BitBltSimulation initialize!
TParseNode removeSelector: #inlineMethodsUsing:!
TAssignmentNode removeSelector: #inlineMethodsUsing:!
TCaseStmtNode removeSelector: #inlineMethodsUsing:!
TReturnNode removeSelector: #inlineMethodsUsing:!
TSendNode removeSelector: #inlineMethodsUsing:!
TStmtListNode removeSelector: #inlineMethodsUsing:!
BitBltSimulation initializeRuleTable!
--------------37C446EA5644--
Date: 97 Jan 13 10:20:46 am
From: Dan Ingalls <DanI@wdi.disney.com>
To: Squeak@create.ucsb.edu
Subject: Opinion survey (Sin tax ;-)
Folks -
I just wanted to get a quick sampling of opinion regarding a couple of
issues that relate to compatibility with other standards. Needless to say,
we are contemplating these changes, but we would go about it in different
ways depending on whether everyone generally agrees or not.
Make Squeak be case-insensitive
The approach would be to retain the convention of temps and instvars being
lower case, and class, pool, and global variables being uppercase. This
would continue to be enforced where you declare them. Conflicts differing
in case alone would be detected and reported. But if you miss-case a
variable in some code, the compiler would not complain, and it might even
correct your code without asking you (some BASICs do this). Miss-cased
selectors would similarly be accepted or corrected without confirmation.
1. Case-insensitive: good bad dont care
[comments if any]
Make Squeak use := for assignment
The := variant of assigment is currently accepted in Squeak, but we would
convert the system sources and the decompiler to use :=.
2. Colon-equal for assignment: good bad dont care
[comments if any]
Allow underbar as an imbedded character in variable names and message names.
We could probably continue to support the use of underbar for assignment
form if there is a separator character on at least one side of the underbar.
3. Underbar in variable names: good bad dont care
[comments if any]
Allow := on a terminal keyword.
I had this in ST-76. It maintains a symmetry of assignment between
variables and messages, as follows:
variable message
read position obj position
write position := newPos obj position:= newPos
also... list at: index := newVal
The change is straightforward, except that := brings along the precedence
of assigment, so that you can write, eg,
self position:= position max: newPos
without needing parentheses around the max: expression as required now with
position:.
4. Terminal keyword assignment: good bad dont care
[comments if any]
The first two changes are highly compatible: Squeak would continue to
accept ST-80 and most ST-80s would continue to accept Squeak.
The second two are only backward compatible: Squeak would continue to
accept ST-80, but ST-80 would not accept Squeak code that took advantage of
the new syntax.
Thanks in advance for your responses and any comments in brackets. I'll
send out a digest in a couple of days.
- Dan
Date: 97 Jan 13 10:47:55 am
From: Dan Ingalls <DanI@wdi.disney.com>
To: Squeak@create.ucsb.edu
In-Reply-To: <v03007801af00175d5300@[206.16.10.79]>
Subject: Re: Opinion survey (Sin tax ;-)
P.S.
When you respond, please supply some comments with any "bad" response.
Thanks
Date: 97 Jan 13 11:22:51 am
From: Dan Ingalls <DanI@wdi.disney.com>
To: Hans-Martin Mosner <hmm@heeg.de>
Cc: Squeak@create.ucsb.edu
In-Reply-To: <32DA4785.79BF@heeg.de>
Subject: Re: Moderate BitBlt speedup (VM writers, please read)
>Hello,
>
>here is a little speedup for BitBlt:
>This code modifies the CCodegenerator and associated classes so that it
>becomes possible to code the BitBltSimulation>>merge:with: method using
>the dispatchOn:... mechanism, which can be translated into a C case statement.
>This ChangeSet also removes the implementors of #inlineMethodsUsing:, a
>method that obviously was not used anymore.
>
>The speedup that I got for a simple BitBlt case (reversing a Form) was
>about 20 percent on the raw BitBlt stuff (i.e., not counting the setup
>per call of #copyBits).
>
>However, this was comparing the original Squeak VM for the Mac with one
>that I built with the MPW MrC compiler. MrC has a somewhat weaker code
>generation than MetroWerks CodeWarrior, therefore I expect the
>attainable performance gain to be a little bit higher.
Hans-Martin,
This is great!!
I actually started on the same project, and then put it on the shelf when I
realized I had to get into the dispatch translator to complete it.
As soon as we get a chance, John or I will bring it forward into our
system, and give you a speed comparison before and after on the same
compiler.
Thanks for your hard work. BitBlt is an area of high leverage!
- Dan
Date: 97 Jan 13 11:54:17 am
From: "David N. Smith" <dnsmith@watson.ibm.com>
To: Dan Ingalls <DanI@wdi.disney.com>
Cc: Squeak@create.ucsb.edu
In-Reply-To: <v03007801af00175d5300@[206.16.10.79]>
Subject: Re: Opinion survey (Sin tax ;-)
At 13:26 -0500 01/13/97, Dan Ingalls wrote:
>Make Squeak be case-insensitive
>The approach would be to retain the convention of temps and instvars being
>lower case, and class, pool, and global variables being uppercase. This
>would continue to be enforced where you declare them. Conflicts differing
>in case alone would be detected and reported. But if you miss-case a
>variable in some code, the compiler would not complain, and it might even
>correct your code without asking you (some BASICs do this). Miss-cased
>selectors would similarly be accepted or corrected without confirmation.
>
>1. Case-insensitive: bad
[
* Incompatible with other Smalltalk systems.
* Not needed
* Would encourage less readable code:
largeversionofdatabase rather than largeVersionOfDatabase
]
>
>Make Squeak use := for assignment
>The := variant of assigment is currently accepted in Squeak, but we would
>convert the system sources and the decompiler to use :=.
>
>2. Colon-equal for assignment: good
[Great! It'd sure make things easier to read!]
>
>Allow underbar as an imbedded character in variable names and message names.
>We could probably continue to support the use of underbar for assignment
>form if there is a separator character on at least one side of the underbar.
>
>3. Underbar in variable names: bad
[I think it is a bad idea, but other implementations do it, so you may have
no choice if importing code is important. (But does anyone really use it??)
I won't object, they're easy to not use.]
>Allow := on a terminal keyword.
>I had this in ST-76. It maintains a symmetry of assignment between
>variables and messages, as follows:
>
> variable message
> read position obj position
> write position := newPos obj position:= newPos
> also... list at: index := newVal
>
>The change is straightforward, except that := brings along the precedence
>of assigment, so that you can write, eg,
>
> self position:= position max: newPos
>
>without needing parentheses around the max: expression as required now with
>position:.
>
>4. Terminal keyword assignment: bad
[
* It will confuse new users when:
position := newPos
is an assignment, but:
read position := newPos
is a message send. Keeping the two separate reinforces the message nature
of putting things into other objects variables (including collections) and
keeps assignment, which is not a message, quite separate.
* Just what does this do?
read position := newPos
The variable 'read' is a variable containing an object; 'position' is a
message which answers some object. We now have this answered object in
hand. What does the assignment do to it?
Or is that assignment a shorthand for:
read position: newPos
or for:
read position:= newPos
which invokes (in the object referenced by read) the method:
position:=
* I don't like any of these, but maybe you can give us Smalltalk-80 users
some additional details.
]
_______________________________
David N. Smith
dnsmith@watson.ibm.com
IBM T J Watson Research Center
Hawthorne, NY
_______________________________
Any opinions or recommendations
herein are those of the author
and not of his employer.
Date: 97 Jan 13 1:11:05 pm
From: Ian Piumarta <piumarta@prof.inria.fr>
To: DanI@wdi.disney.com
Cc: Squeak@create.ucsb.edu
Subject: Re: Opinion survey (Sin tax ;-)
Dan,
> 1. Case-insensitive: bad
If I understand correctly, the compiler would enforce the
upper/lower-case declaration of variables (based on the scope for
which they were declared), but there wouldn't actually be any
distinction between the names 'foo' and 'Foo'.
I don't like this since it seems that I would never be able to use an
instance or temporary (or argument) variable which differed only in
case from some global variable, or from some class/pool variable
visible from the method. Or have I utterly failed to understand your
proposal?
I *do* like the compiler to try to correct mis-spelled variable names,
though, both for case errors and for real mis-spellings. But it
should *always* warn you when it does this: imagine how long it would
take to debug a large class where a single mis-spelled variable, in
some hidden-away method, was silently corrected into the wrong thing.
I believe that a small pop-up menu of the top five (or so) "best fuzzy
matches" between the mis-spelled (or mis-cased) name and the declared
variables in the scope of the code, with an option to "confirm
correction", is still the best thing to do here. (Ditto for
selectors.)
I also don't like the idea of *enforcing* things. By all means check
that class/pool/global variables have initial upper-case letters, but
I think that the best response is for the compiler to invite you to
either accept an automatic capitalisation of the first letter or to
proceed with the "mis-cased" name, whichever you happen to prefer.
(Same comment, but with case inverted, for inst/temp/arg vars.)
> 2. Colon-equal for assignment: good
More compatible (and looks better in hardcopy and Emacs buffers too ;-).
You might even consider having the compiler offer to replace any
deprecated uses of '_' with ':='.
> 3. Underbar in variable names: good
I have obscure reasons for liking this idea. I used it extensively
(by modifying the compiler to accept names containing '_') when
implementing embedded languages in Smalltalk. It's nice to know that
simply by putting a '_' in your automatically-generated variable names
you can ensure that none of them will conflict with the system. I
therefore think it should be allowed, but discouraged for "everyday"
programming -- *especially* when it occurs as the initial character of
an identifier. ;^)
My (hopelessly subjective and biased) personal preference would be to
drop the use of '_' for assignment, and leave it as an illegal
character in the scanner. Those "in the know" megalomaniacs then need
only re-initialise the scanner's dispatch table to enable '_' as an
identifier character, for use on those rare "special occasions"...
> Allow := on a terminal keyword.
> 4. Terminal keyword assignment: bad
I agree with David: it's confusing (especially for novices), and makes
the immensely simple Smalltalk precedence rules unnecessarily more
complicated.
Your example
anIndexableCollection at: anIndex := aValue
suggests (to me) the "setter syntax" in some Lisps, where the implied
grouping is:
(anIndexableCollection at: anIndex) := aValue
and where ':=' is a piece of *syntax* which magically transforms the
expression into:
(anIndexableCollection at-setter: anIndex with: aValue)
I think that before introducing anything like a ':=' as a terminal
keyword element, it would first be indispensible to find some very
convincing philosophical reasons why #at:put: is Such A Bad Thing.
(ObPhiloPlug: Let's remember Alan's very sage advice about programming
language design -- a "crystallisation of style" is far, far better
than an "agglutenation of features" [HOPL I or II, I can't remember
which]. Otherwise we might have to rename Squeak as "Common
Smalltalk". ;-)
I would, however, like to take this opportunity to mention something
that has occurred to me many times over the years. I sometimes find
the handling of "anonymous" arguments a little unpleasant, since they
involve all those redundant and meaningless "with:"s, etc. Ex:
18 takeuchi: 12 with: 6
I've often wanted to allow the second and subsequent parts of keywords
to be blank. So the above could be written:
18 takeuchi: 12 : 6
The selector in this example would be #'takeuchi::'. You can imagine
lots of situations where you would feel "awkward" giving explicit
names to each keyword argument:
cubicFunction := CubicFunction
withCoefficients: 3.1416 : 2.7128 : 42 : 666.
(In my embedded language adventures I have often generated selectors
which look like #'functionName:_:_:_:' to approximate this effect.)
Regards,
Ian
------------------------------- projet SOR -------------------------------
Ian Piumarta, INRIA Rocquencourt, Internet: Ian.Piumarta@inria.fr
BP105, 78153 Le Chesnay Cedex, FRANCE Voice: +33 1 39 63 52 87
----------------------- Systemes d'Objets Repartis -----------------------
Date: 97 Jan 13 1:37:50 pm
From: stp (Stephen Travis Pope)
To: Dan Ingalls <DanI@wdi.disney.com>
Cc: squeak@create.ucsb.edu
In-Reply-To: Dan Ingalls <DanI@wdi.disney.com>'s letter of: 97 Jan 13
Subject: Re: Opinion survey (Sin tax ;-)
1. Case-insensitive: bad
I agree with IanP that I often use a temp variable named e.g., time,
filename, or stream.
2. Colon-equal for assignment: good
Standard-compatible and "pure" ASCII.
3. Underbar in variable names: good
Pretty standard in many languages. "_" would look pretty odd if used for
anything more useful.
4. Terminal keyword assignment: bad
Use := only for assignment, all keywords end with colons.
stp
_Stephen Travis Pope, Center for Research in Electronic Art Technology
_(CREATE), Dept. of Music, U. of California, Santa Barbara (UCSB)
_Editor, Computer Music Journal (CMJ), MIT Press
_stp@create.ucsb.edu http://www.create.ucsb.edu/~stp/
Date: 97 Jan 13 1:40:04 pm
From: "David N. Smith" <dnsmith@watson.ibm.com>
To: Ian Piumarta <piumarta@prof.inria.fr>
Cc: DanI@wdi.disney.com, Squeak@create.ucsb.edu
In-Reply-To: <199701132115.WAA15705@prof.inria.fr>
Subject: Re: Opinion survey (Sin tax ;-), new proposals
At 16:15 -0500 01/13/97, Ian Piumarta wrote:
...
>
>I would, however, like to take this opportunity to mention something
>that has occurred to me many times over the years. I sometimes find
>the handling of "anonymous" arguments a little unpleasant, since they
>involve all those redundant and meaningless "with:"s, etc. Ex:
>
> 18 takeuchi: 12 with: 6
>
>I've often wanted to allow the second and subsequent parts of keywords
>to be blank. So the above could be written:
>
> 18 takeuchi: 12 : 6
>
>The selector in this example would be #'takeuchi::'. You can imagine
>lots of situations where you would feel "awkward" giving explicit
>names to each keyword argument:
>
> cubicFunction := CubicFunction
> withCoefficients: 3.1416 : 2.7128 : 42 : 666.
>
>(In my embedded language adventures I have often generated selectors
>which look like #'functionName:_:_:_:' to approximate this effect.)
>
So long as only 'those in the know' know... :-)
Imagine how well a *nice* array constructor would work for this, even when
the cooefficients aren't literals:
cubicFunction := CubicFunction
withCoefficients: { Float pi :: exp :: myAge :: three5s + 111 }.
(Not that that's is a nice constructor; it smells too much like C++. :-)
Dave
_______________________________
David N. Smith
dnsmith@watson.ibm.com
IBM T J Watson Research Center
Hawthorne, NY
_______________________________
Any opinions or recommendations
herein are those of the author
and not of his employer.
Date: 97 Jan 13 3:41:22 pm
From: Tim Rowledge <rowledge@interval.com>
To: Dan Ingalls <DanI@wdi.disney.com>
Cc: Squeak mailinglist <Squeak@create.ucsb.edu>
In-Reply-To: <v03007801af00175d5300@[206.16.10.79]>
Subject: Re: Opinion survey (Sin tax ;-)
I'll vote pretty much same as Dave Smith, except to point out that I
actually like _ as the assign.
--
Tim Rowledge: rowledge@interval.com (w) +1 (415) 856-7230 (w)
tim@sumeru.stanford.edu (h) <http://sumeru.stanford.edu/tim>
Date: 97 Jan 13 4:10:39 pm
From: stp (Stephen Travis Pope)
To: "David N. Smith" <dnsmith@watson.ibm.com>
Cc: DanI@wdi.disney.com, Squeak@create.ucsb.edu
In-Reply-To: "David N. Smith" <dnsmith@watson.ibm.com>'s letter of: 97 Jan 13
Subject: Re: Opinion survey (Sin tax ;-), new proposals
Dave's suggestion for with:with:... would also work quite nicely with value:value:...
On the other hand, using free-standing curly braces as an "evaluating array
constructor" looks strange to me; how about using #{} (to go along with #() for
Arrays and #[] for ByteArrays)? (This would also mean that I can continue to
use curly braces as comment characters.)
stp
_Stephen Travis Pope, Center for Research in Electronic Art Technology
_(CREATE), Dept. of Music, U. of California, Santa Barbara (UCSB)
_Editor, Computer Music Journal (CMJ), MIT Press
_stp@create.ucsb.edu http://www.create.ucsb.edu/~stp/
Date: 97 Jan 14 1:03:13 am
From: Georg Gollmann <gollmann@edvz.tuwien.ac.at>
To: Dan Ingalls <DanI@wdi.disney.com>
Cc: Squeak@create.ucsb.edu
In-Reply-To: <v03007801af00175d5300@[206.16.10.79]>
Subject: Re: Opinion survey (Sin tax ;-)
1. Case-insensitive: bad
I concur with what has been written by the previous posters.
2. Colon-equal for assignment: good
3. Underbar in variable names: dont care
4. Terminal keyword assignment: bad
I find this confusing and hard to read. Furthermore I see no real gain, as
it would just save one character.
A comment on the comments:
"David N. Smith" <dnsmith@watson.ibm.com> wrote:
>Imagine how well a *nice* array constructor would work for this, even when
>the cooefficients aren't literals:
>
>cubicFunction := CubicFunction
> withCoefficients: { Float pi :: exp :: myAge :: three5s + 111 }.
stp@create.ucsb.edu (Stephen Travis Pope) wrote:
>Dave's suggestion for with:with:... would also work quite nicely with
>value:value:...
>
>On the other hand, using free-standing curly braces as an "evaluating array
>constructor" looks strange to me; how about using #{} (to go along with
>#() for
>Arrays and #[] for ByteArrays)? (This would also mean that I can continue to
>use curly braces as comment characters.)
I am not sure if all readers are aware that the {} notation is already
implemented ( try { 'some ', 'test'. 3 + 4 }). I agree that a notation
using # would be more in line with constant arrays. BTW, GemStone uses #[]
as the array constructor, SmalltalAgents {}. I don't have a strong opinion
about this issue.
Regarding Ian Piumartas comments on "anonymous" arguments: I see keyword
parameters as a major strength of Smalltalk as it makes a program far more
understandable. I doubt that many parameters are really, really anonymous,
probably the experienced user is just taking them for granted.
Furthermore I made a lot of parameter ordering (or ommitting) mistakes in C
or Modula-2 which simply don't happen in Smalltalk. E.g. given
cubicFunction := CubicFunction
withCoefficients: 3.1416 : 2.7128 : 42 : 666.
are the parameters in rising or falling powers of x ? I would prefer
something like
cubicFunction := CubicFunction
a0: 3.1416 a1: 2.7128 a2: 42 a3: 666.
Georg
----
Dipl.Ing. Georg Gollmann TU-Wien, EDV-Zentrum
phon:(++43-1) 58801 - 5848
mail:gollmann@edvz.tuwien.ac.at
http://ftp.tuwien.ac.at/~go/Gollmann.html
Date: 97 Jan 14 5:35:43 am
From: "IVAN TOMEK" <ivan.tomek@acadiau.ca>
To: "David N. Smith" <dnsmith@watson.ibm.com>, stp@create.ucsb.edu
Cc: DanI@wdi.disney.com, Squeak@create.ucsb.edu
In-Reply-To: <9701140010.AA23203@tango.create.ucsb.edu>
Subject: Re: Opinion survey (Sin tax ;-), new proposals
> From: stp@create.ucsb.edu (Stephen Travis Pope)
> Date: Monday, 13 Jan 97 4:10:39 pm
> Reply-to: stp@create.ucsb.edu
> Subject: Re: Opinion survey (Sin tax ;-), new proposals
> To: "David N. Smith" <dnsmith@watson.ibm.com>
> Cc: DanI@wdi.disney.com, Squeak@create.ucsb.edu
>
> Dave's suggestion for with:with:... would also work quite nicely with value:value:...
>
> On the other hand, using free-standing curly braces as an "evaluating array
> constructor" looks strange to me; how about using #{} (to go along with #() for
> Arrays and #[] for ByteArrays)? (This would also mean that I can continue to
> use curly braces as comment characters.)
>
Although I like the idea in principle, I am againstit.
One of the often praised features of Smalltalk is its straightforward
syntax - and one of the features of other languages often listed by
Smalltalkers as a drawback is the large number of nice syntactic
features that they offer.
Ivan
>
> stp
>
> _Stephen Travis Pope, Center for Research in Electronic Art Technology
> _(CREATE), Dept. of Music, U. of California, Santa Barbara (UCSB)
> _Editor, Computer Music Journal (CMJ), MIT Press
> _stp@create.ucsb.edu http://www.create.ucsb.edu/~stp/
>
Date: 97 Jan 14 4:39:17 pm
From: Tim Rowledge <rowledge@interval.com>
To: Squeak mailinglist <squeak@create.ucsb.edu>
Subject: Storing temp names in compiled methods
So Dan,
would you care to share with us the reasons why you're putting quite
q bit of work into making temp names appear nicely when there is no
sources file? I'm having trouble thinking of situations where I would
to do development work and yet wouldn't have the sources file with
me...
--
Tim Rowledge: rowledge@interval.com (w) +1 (415) 856-7230 (w)
tim@sumeru.stanford.edu (h) <http://sumeru.stanford.edu/tim>
Date: 97 Jan 14 6:08:17 pm
From: Paul Fernhout <kfsoft@netins.net>
To: Dan Ingalls <DanI@wdi.disney.com>
Cc: Squeak@create.ucsb.edu
Subject: Re: Opinion survey (Sin tax ;-) and an alternative approach
I agree with most everyone else on these things.
Dan Ingalls wrote:
> 1. Case-insensitive: bad
Nonstandard. Breaks existing code.
> 2. Colon-equal for assignment: good
Ideally, remove the old assign with _ entirely. Reason: compatability
with everyone else.
> 3. Underbar in variable names: good
I use this in mathematical programming to denote units, as in:
rainfallToday_mm := 20.
or:
weather todaysMinTemp_c: 10 todaysMaxTemp_c: 15.
Other smalltalks and programming languages support this.
> 4. Terminal keyword assignment: bad
Ambiguous. Nonstandard. Also, isn't
receiver x: newValue
shorter than
receiver x := newValue
anyway?
You've created a great thing already with Smalltalk as it is Dan! I
think Smalltalk just needs better marketing. If there was anything I
would like to see radically changed in Smalltalk, it would be building
the dependency mechanism into the syntax of the language. In general
though, I would say one gets much more bang for the buck now by
improving the development environment and adding more libraries than
mucking with smalltalk syntax, except to make the syntax more compliant
with other Smalltalk vendors'.
For people who want other syntaxes, the best thing to do might be to
enhance Squeak's ability to parse arbitrary expressions and handle
multiple programming languages. If someone wants to program in
HyperTalk or BASIC under Squeak, just add the entire language, such as:
Test>>testOfLanguages
"this is a test of Squeak supporting other languages"
Transcript cr; show: 'Beginning test. Please move the mouse to left
side',
'of the screen. You will here two songs played,',
'then press the button connected to port 1',
'and then type in some numbers.'; cr.
<<Basic>>
10 FOR i = 1 to 10
20 PRINT "Hello World!"
30 NEXT i
35 IF MOUSEX < 200 THEN EXIT
40 GOTO 10
<<HyperTalk>>
-- I must admit I'm not sure how to convert a card metaphor to methods
on openCard
play "Fugue1"
end openCard
<<Lisp>>
(print (cons (+ 1 2) (* 4 5 6)))
(smalltalk (Transcript 'show: (displayString 'messageFromLisp)))
<<Forth>>
: MUSICTEST 10 20 + 30 40 * / VOLUME FUGUE2 PLAYMIDI ;
MUSICTEST
<<6502Assembler>
;; from page 11-51 of 6502 Assembly Language Programming - Lance
Leventhal
;; wait for switch to close
LDA #0
STA VIAPCR ;MAKE ALL CONTROL LINES INPUTS
STA VIADDRA ;MAKE PORT A LINES INPUTS
STA $40 ;MARKER = ZERO
WAITC LDA VIAORA ;READ SWITCH POSITION
AND #MASK ;IS SWITCH CLOSED ('0')?
BNE WAITC ;NO, WAIT
INC $40 ;YES, MARKER = ONE
BRK
<<NewtonScript>>
test := {name: "test point", x: 1, y: 2,};
theSum := text.x + test.y;
Print(c);
// assumes TestPoints soup alreasy exists - otherwise will fail
theSoup := GetUnionSoup("TestPoints");
theSoup:AddToDefaultStore(test);
theSoup:AddToDefaultStore({name: "another", x: 20, y: 30,});
<<INTERCAL>>
* from http://www.muppetlabs.com/~breadbox/intercal-man/
* read in 32-bit unsigned integers,
* treat them as signed, 2's-complement numbers,
* and print out their absolute values.
DO (5) NEXT
(5) DO FORGET #1
PLEASE WRITE IN :1
DO .1 <- '?":1~'#32768$#0'"$#1'~#3
DO (1) NEXT
DO :1 <- "'?":1~'#65535$#0'"$#65535'
~'#0$#65535'"$"'?":1~'#0$#65535'"
$#65535'~'#0$#65535'"
DO :2 <- #1
PLEASE DO (4) NEXT
(4) DO FORGET #1
DO .1 <- "?':1~:2'$#1"~#3
DO :1 <- "'?":1~'#65535$#0'"$":2~'#65535
$#0'"'~'#0$#65535'"$"'?":1~'#0
$#65535'"$":2~'#0$#65535'"'~'#0$#65535'"
DO (1) NEXT
DO :2 <- ":2~'#0$#65535'"
$"'":2~'#65535$#0'"$#0'~'#32767$#1'"
DO (4) NEXT
(2) DO RESUME .1
(1) PLEASE DO (2) NEXT
PLEASE FORGET #1
DO READ OUT :1
PLEASE DO .1 <- '?"':1~:1'~#1"$#1'~#3
DO (3) NEXT
PLEASE DO (5) NEXT
(3) DO (2) NEXT
PLEASE GIVE UP
<<SNOBOL>>
* also from http://www.muppetlabs.com/~breadbox/intercal-man/
* does the same as INTERCAL version above
PLEASE INPUT POS(0) ('-' ! '')
+ (SPAN('0123456789') $ OUTPUT)
+ *NE(OUTPUT) :S(PLEASE)F(END)
<<CaselessSmalltalk>>
tranSCRipT SHOW: 'almost done'.
<<Smalltalk>>
Transcript show: 'Done with test. Have a nice day!'; cr.
^nil
No doubt there would be a lot of inter-language issues to work out...
:-)
Ian Piumarta has also thought about getting Smalltalk to support other
languages, based on his previous comments on his Lisp in Smalltalk. It
looks like he's already been quite succesful at it too!
-Paul Fernhout
kfsoft@netins.net
http://www.gardenwithinsight.com
Date: 97 Jan 15 4:28:12 pm
From: Dan Ingalls <DanI@wdi.disney.com>
To: Tim Rowledge <rowledge@interval.com>
Cc: Squeak@create.ucsb.edu
In-Reply-To: <Marcel-1.08-0115004437-0b0KL&V@goldskin.interval.com>
Subject: Re: Storing temp names in compiled methods
>So Dan,
>would you care to share with us the reasons why you're putting quite
>q bit of work into making temp names appear nicely when there is no
>sources file? I'm having trouble thinking of situations where I would want
>to do development work and yet wouldn't have the sources file with
>me...
Sure.
=46irst a couple of definitions:
"putting quite a bit of work into"
This was *play*, and it only lasted a couple of days.
"situations where I would want to do development work and yet wouldn't have=
the sources file"
I like to program "away from work" -- ie in the living room, in the car=
while waiting in a parking lot, on a plane, etc. Only PDA class machines=
currently offer the kind of casual access that I find appropriate to these=
situations. Most PDAs don't have room for the sources file.
That much said, here's how I got into it...
It started just as a curiosity. Decompilation is hard to read because there=
are no temp names and no comments. But I can usually read code pretty well=
without comments (maybe this is why I don't write many comments ;-). Maybe=
keeping the names but not the comments would be better, if not ideal.
I did the experiment - fed the temp names to the decompiler - and whoa...=
it's pretty nice, Dude. =20
So then I thought, What would it take to save the temp names, and could we=
do it compactly? A couple of hours later I had a scheme, and the result --=
about 40k for our (bloated) system of 7700 methods and over 2MB of source c=
ode!
So then I just couldn't resist doing it. The answer to "why" at this point=
was "because it was there".
It's true that I wouldn't have gone to all this trouble without some sense=
of it being potentially useful. I can remember being really happy that we=
could run Apple Smalltalk on a mac with only a single floppy disk drive. =
We decompiled the (system) sources, but kept the changes file on the floppy=
=2E
I can imagine doing the same thing today on a Newton or similar machine. I=
believe that we could squeeze a useful Squeak image, interpreter and change=
log all into 1 (count it) megabyte. Methinks that would be practical in a=
lot more machines than if you also had to allow for 1.5MB of system sources=
as well.
I carried this through to completion because I wanted to be ready to jump on=
it as soon as someone got serious about a PDA port. The only thing lacking=
now is a retrofit to keep the changes as full text so you can write a=
well-commented class on the plane to down-load when you get home. I'll do=
this and put out a goodie.
Date: 97 Jan 15 5:00:04 pm
From: Ravi Pandya <rpandya@netcom.com>
To: Dan Ingalls <DanI@wdi.disney.com>, Tim Rowledge <rowledge@interval.com>
Cc: Squeak@create.ucsb.edu
Subject: Re: Storing temp names in compiled methods
I'm curious how much space it would cost to include the comments in the
compiled bytecodes as well - I suspect it wouldn't be much, and then you
wouldn't need the changes file at all.
A (physically) portable Smalltalk would be wonderful. When I first got
Squeak I was shocked to realize that it was one of the smallest
applications on my machine! It takes well over 100 Mb to install Microsoft
Visual C++ these days... I suspect it would not be much work to move the
Win32 implementation over to Windows CE, since the VM probably doesn't use
much of the API.
Ravi
At 04:34 PM 1/15/97 -0800, Dan Ingalls wrote:
>>So Dan,
>>would you care to share with us the reasons why you're putting quite
>>q bit of work into making temp names appear nicely when there is no
>>sources file? I'm having trouble thinking of situations where I would want
>>to do development work and yet wouldn't have the sources file with
>>me...
>
>Sure.
>
>First a couple of definitions:
>
>"putting quite a bit of work into"
>This was *play*, and it only lasted a couple of days.
>
>"situations where I would want to do development work and yet wouldn't
have the sources file"
>I like to program "away from work" -- ie in the living room, in the car
while waiting in a parking lot, on a plane, etc. Only PDA class machines
currently offer the kind of casual access that I find appropriate to these
situations. Most PDAs don't have room for the sources file.
>
>That much said, here's how I got into it...
>
>It started just as a curiosity. Decompilation is hard to read because
there are no temp names and no comments. But I can usually read code
pretty well without comments (maybe this is why I don't write many comments
;-). Maybe keeping the names but not the comments would be better, if not
ideal.
>
>I did the experiment - fed the temp names to the decompiler - and whoa...
it's pretty nice, Dude.
>
>So then I thought, What would it take to save the temp names, and could we
do it compactly? A couple of hours later I had a scheme, and the result --
about 40k for our (bloated) system of 7700 methods and over 2MB of source
code!
>
>So then I just couldn't resist doing it. The answer to "why" at this
point was "because it was there".
>
>It's true that I wouldn't have gone to all this trouble without some sense
of it being potentially useful. I can remember being really happy that we
could run Apple Smalltalk on a mac with only a single floppy disk drive.
We decompiled the (system) sources, but kept the changes file on the floppy.
>
>I can imagine doing the same thing today on a Newton or similar machine.
I believe that we could squeeze a useful Squeak image, interpreter and
change log all into 1 (count it) megabyte. Methinks that would be
practical in a lot more machines than if you also had to allow for 1.5MB of
system sources as well.
>
>I carried this through to completion because I wanted to be ready to jump
on it as soon as someone got serious about a PDA port. The only thing
lacking now is a retrofit to keep the changes as full text so you can write
a well-commented class on the plane to down-load when you get home. I'll
do this and put out a goodie.
>
>
>
>
Ravi Pandya
9249 NE 14th Street
Bellevue, WA 98004
206 450 1549 home
206 522 7800 x117 work
206 522 9980 fax
rpandya@netcom.com
Date: 97 Jan 15 5:57:27 pm
From: Tim Rowledge <tim@sumeru.stanford.edu>
To: Dan Ingalls <DanI@wdi.disney.com>
Cc: Squeak mailinglist <Squeak@create.ucsb.edu>
In-Reply-To: <v03007801af02fc5b16b5@[206.16.10.79]>
Subject: Re: Storing temp names in compiled methods
On Thu 16 Jan, Dan Ingalls wrote:
> "putting quite a bit of work into"
> This was *play*, and it only lasted a couple of days.
I'm impressed (again)
>
> "situations where I would want to do development work and yet
wouldn't have the source
> s file"
> I like to program "away from work" -- ie in the living room, in the
car while waiting
> in a parking lot, on a plane, etc. Only PDA class machines
currently offer the kind o
> f casual access that I find appropriate to these situations. Most
PDAs don't have roo
> m for the sources file.
Of course.(Sound of thump on forehead). And to think that it was one
of the things I always wanted on a Newt. My excuse is that I posted
the question on a thursday and I never did get the hang of
thursdays ;-)
One of the things I would foresee as being useful for PDA-Squeak
would be some ability to ROM a lot of stuff; it was certainly
important for the Active Book system. Unfortunately, I haven't been
able to see any way of mixing ROM, direct pointers and still being
able to write into objects originally in ROM (you gotta copy the
object from rom to ram, so you can writeinto it. Then you have to
modify the pointers to it, which means moving any obejct that points
to it into ram, and whoops, everything is in ram. Dang.) Unless of
course, high speed flash-RAM comes along soon enough to rescue us.
Newt-Squeak on a card!
--
Tim Rowledge tim@sumeru.stanford.edu http://sumeru.stanford.edu/tim
Date: 97 Jan 15 5:59:46 pm
From: CarlGWatts@AppliedThought.com (Carl G. Watts)
To: Dan Ingalls <DanI@wdi.disney.com>
Cc: Squeak@create.ucsb.edu
Subject: Re: Opinion survey (Sin tax ;-)
>1. Case-insensitive: bad
For many of the same reasons others have already stated.
>2. Colon-equal for assignment: dont care
I actually like the left arrow for assignment. Because it is a very unique symbol for a very unique operation. If I have the option I prefer using "left arrow" for assignment for readability over "colon equals". But I've written a lot both ways so I don't care very much on the issue.
>3. Underbar in variable names: bad
- Means that the character can't be displayed as the left arrow (Smalltalk's more traditional assignment symbol).
- Underscore is a vestigial ASCII glyph that has little place in the world after the age of mechanical typewriters that used it after a backspace ASCII character to underscore letter. It is better that we don't preserve its life by trying to make it useful for something else. Similarly with the "Shift-6" character. Both of which Smalltalk wisely re purposed these two vestigial ASCII values to new character glyphs for very special semantic operations in the language.
>4. Terminal keyword assignment: bad
For many of the same reasons already state by others plus another. A bit of a pet peave of mine actually: it crosses the "Purpose of message" vs. "Implementation of method" boundary for documenting a method.
Smalltalk has had in its method definition template for decades "Comment stating purpose of message" NOT "Comment stating implementation of method" yet this distinction is, unfortunately, sometimes considered unimportant when commenting a method.
For example a comment stating the purpose of the message for "Point x:" might read "Set the position of the receiver on the x Cartesian axis." while a comment stating the implementation of the method might say "Set the x instVar since my implementation involves Cartesian instance variables rather than, say, polar instance variables."
The comment stating the purpose of the message is the most important thing to document. It is what the sender is concerned about. It is all the sender should need to know. This purpose of x: remains the same whether Point has Cartesian instVars x,y or polar instVars theta,r.
So if we allow message selectors where the last two characters are "colon equal" like "position:=" this will end up getting used for messages where the implementation currently happens to be just assignment to an instVar. But then you are documenting in the message selector itself something that is just a detail of the current implementation.
I much prefer having "position:" as the message. The implementation of which is private to the receiver. For some receivers this may be setting an instVar, for others not.
END RANT ON PET PEAVE (forgive me my indulgence and impudence)
And I must re-iterate Paul's comment: You've created a great thing already with Smalltalk as it is Dan!
I agree so whole heartedly. I love Squeak and I've been in love with the syntax of Smalltalk for years.
When I consider what Squeak needs, rather than syntactic additions, I think of:
- better faster graphics implementations and objects (I and constantly pushing the limits of the graphics model speed and agility). I need MaskedForm display in a single blt, blt's where the mask pattern is aligned to the origin of the destination rectangle rather than to the origin of the boundingBox of the Form, more combination rules for blending colors, blt's of tiled forms to cover an area in a single blt, non-blt-based line drawing, primitive polygon fill, etc.
- and a dramatically simplified View hierarchy with the features (real clipping etc.) that all modern interface systems offer (which I've done before in ST 2.5 and am doing again in Squeak)
- faster execution technology (though I am very impressed with the speed of Squeak on my 180Mhz 604e, I think I would be hysterically happy with threaded code interpretation)
Keep up the wonderful work Dan!
Carl
http://AppliedThought.com/carl/
Date: 97 Jan 15 7:11:49 pm
From: Patrick Logan <plogan@teleport.com>
To: dnsmith@watson.ibm.com
Cc: piumarta@prof.inria.fr, DanI@wdi.disney.com, Squeak@create.ucsb.edu
In-Reply-To: <v03007800af005b90147b@[129.34.225.178]> (dnsmith@watson.ibm.com)
Subject: Re: Opinion survey (Sin tax ;-), new proposals
Imagine how well a *nice* array constructor would work for this, even when
the cooefficients aren't literals:
cubicFunction := CubicFunction
withCoefficients: { Float pi :: exp :: myAge :: three5s + 111 }.
(Not that that's is a nice constructor; it smells too much like C++. :-)
Gemstone Smalltalk uses #[] for an array constructor that evaluates
its comma separated arguments. For example...
#[1 + 2, 'fro', 'baz', 3 + 5] => anArray(3 'fro' 'baz' 8)
(Note that in this constructor the comma between strings is not a
message send. That is the one ugly thing about it wrt standard
Smalltalk.)
-Patrick Logan
Date: 97 Jan 15 8:45:23 pm
From: Dan Ingalls <DanI@wdi.disney.com>
To: Tim Rowledge <tim@sumeru.stanford.edu>
Cc: Squeak@create.ucsb.edu
In-Reply-To: <Marcel-1.09-0116015938-e61KL&V@diziet.interval.com>
Subject: Re: Storing temp names in compiled methods
>...My excuse is that I posted
>the question on a thursday and I never did get the hang of
>thursdays ;-)
I can see this is going to be a really rough week for you, Tim.
Tomorrow is Thursday too!
Affectionately,
Dan
P.S. About that mail system written in Squeak...
Date: 97 Jan 15 9:09:21 pm
From: Dan Ingalls <DanI@wdi.disney.com>
To: Tim Rowledge <tim@sumeru.stanford.edu>
Cc: Squeak@create.ucsb.edu
In-Reply-To: <Marcel-1.09-0116015938-e61KL&V@diziet.interval.com>
Subject: Re: ROMing Squeak
>...=20
>Unfortunately, I haven't been
>able to see any way of mixing ROM, direct pointers and still being
>able to write into objects originally in ROM (you gotta copy the
>object from rom to ram, so you can write into it. Then you have to
>modify the pointers to it, which means moving any object that points
>to it into ram, and whoops, everything is in ram. Dang).
I've thought some about this, and you are right that it's hard without
an object table. But it is not impossible.
Imagine that all dictionaries were little 3-word guys:
<class>
nameArray
valueArray
Now imagine that all dictionaries were in RAM, and everything else in ROM. =
The ROM would have two image segments: everything but the dicts, and all =
the dicts. The latter segment would get copied to RAM at startup, and all=
the pointers to them in the ROM would have been adjusted to their future=
RAM locations.
Now, suppose you have to change a method. You have to copy the array it's=
in from ROM to RAM, and install the new method in that array. Then you=
have to store that new array over the old but, guess what, its holder, the=
dict, is in RAM and the need to copy ends there! Same idea with=
dictionaries holding values except, in the current Squeak, you would want=
the Associations to be in RAM, as they are shared in many places beside=
being what you want to store into.
With a bit of study on what is immutable and what gets changed and how often=
in typical usage, I'm sure we could come up with a decent ROM/RAM=
partitioning that would make for reasonably-sized RAM requirements (and=
hence derivative image sizes) in typical usage.
It ain't trivial. But it ain't out of the question either.
>Newt-Squeak on a card!
Yeah
- Dan
Date: 97 Jan 15 10:00:51 pm
From: Dan Ingalls <DanI@wdi.disney.com>
To: Squeak@create.ucsb.edu
In-Reply-To: <199701160313.TAA05047@kelly.teleport.com>
Subject: Re: Opinion survey - thanks
Don't worry, folks. =20
Occasionally we discuss this stuff in our meetings, and I just thought I'd=
sample how other people feel about these.
=46or your amusement, the responses so far are as follows...
1. Case-insensitivity
B B - B B G B B B B
[I'm not sure everyone understood about case insensitivity. The intent is=
to be just like Squeak now, except that the spelling corrector would=
correct case errors (only!) without asking. Your responses point out,=
though, that case of the first letter must remain significant]
2. :=3D preferred for assignement
G G - G G - B G G G
3. Allow imbedded underbar in identifiers
G B - G G G - B B -
4. Allow assignment syntax in terminal keyword
B B B B B B B B B B
Isn't it great to have 100% agreement on something!
Date: 97 Jan 15 11:25:07 pm
From: Paul Fernhout <kfsoft@netins.net>
To: Dan Ingalls <DanI@wdi.disney.com>
Cc: Squeak@create.ucsb.edu
Subject: Newton Squeak (was: Storing temp names in compiled methods)
Dan Ingalls wrote:
> I can imagine doing the same thing today on a Newton or similar machine.
> I believe that we could squeeze a useful Squeak image, interpreter and
> change log all into 1 (count it) megabyte. Methinks that would be
> practical in a lot more machines than if you also had to allow
> for 1.5MB of system sources as well.
>
> I carried this through to completion because I wanted to be ready
> to jump on it as soon as someone got serious about a PDA port.
I'm very serious about the Newton PDA port (as far as my spare time
allows :-), especially since I've currently got three Newtons around
here.
One major part of the Squeak -> Newton port is writing the Squeak code
to have Squeak provide browsers, inspectors, and debuggers that all work
well on a tiny screen. That can all be done before the port. Of
course, if one sees the port as just a runtime, these wouldn't have to
be developed. But I too like the idea of having a programming
environment on the Newton which has all the features of Squeak.
Right now I'm prototyping a browser (in NewtonScript) to see how a
Squeak browser would look on a Newton screen. I am planning to
construct a back end to this prototype so one could browse all the
Squeak source on the Newton (and edit it with version history too!) as a
test of how the Newton handles large amounts of data. If you could
export your changes to Squeak, and resync the source with a changing
Squeak image, this would be a way to at least develop in Squeak on the
Newton even if you couldn't test or run any of the code.
Why am I not doing a direct port right now? I am currently hoping the C
compiler for the Newton becomes available sometime soon. In fact, that
hope is the only thing keeping me from starting right now on having
Squeak spit out the VM in NewtonScript with 'native' flags on every
function. I could then do an ugly hack to the generated VM code to make
it use an object table instead of pointers, hide some flags somewhere
else, and use an array of functions to dispatch the primitives (for
speed, since NewtonScript has no case statement). I would do this first
over generating Forth or ARM since it seems easier, even if the result
would probably be slower - although since the compiler compiles to
native ARM machine code, I don't know how much slower than
alternatives. It's at least a place to start.
Of course the smart thing to do first would be some rough estimates as
to how much RAM the Newton Squeak will need and whether this is more
than the Newton can supply. I still need to determine these figures.
The two things I know right now is that on a MP130 which has 1.2MB RAM,
I get 156KB free heap space when running Newt (a development
environment). I need to use a slimmer tool to see how much heap is left
over when just the Newton OS is running (plus I need to disable the ever
present notepad to get a good reading). More on this when I have the
figures. If the MP130 can't do it, the eMate and MP2000 might be able
to because they may have substantially more free RAM.
I'm not sure what the consequences would be of trying to run an image
out of Flash RAM - I do know those have limited read write cycles
(100,000) and I assume they are slower than dynamic RAM. Maybe one
could set up a new space / old space system using dynamic ram for new
objects and flash ram for older ones?
>From an earlier post by Dan on Newton Squeak:
> The Squeak team will contribute a lean image to this project.
> Our goal will be to run (image, VM and around 100K to play around)
> in 1MB of free space, and we believe we can do even better.
At some point I would like to take you up on your offer for a smaller
Squeak image, although I won't really need one till I start recompiling
the VM for the Newton.
One has to admit that the very best thing about NewtonScript for the
Newton is that it was designed to be an OO language that worked well in
ROM. It does that by references to immutable protos. It uses prototype
inheritence and objects only add slots they need to record changes from
their proto.
For Smalltalk, would an object table be too big a performance hit over
what you propose with dictionaries? Also, since much of the system is
classes, symbols, methods, strings, and such (I don't know how much off
hand), doesn't one get a big bang for the buck just by putting the base
things in ROM and keeping the Smalltalk system dictionary in RAM and
only updating is as needed (plus some special routine to manage a mix of
ROM and RAM symbols). One might need some special symbol and bytecode
manager classes that knew to look first in ROM to see if a symbol or
bytecode string already existed. String could work this way too if one
were willing to pay the overheady of B-tree searches on changes. Even
if entire classes get pulled out of ROM into RAM when you change them,
along with related classes, they all can still refer back to methods in
ROM, and so the cost is really only some new dictionaries. It would be
nice to see some hard figures as to what percentages of the system
memory were dedicated to which activities (storing methods, symbols,
compiled code, as opposed to changing views and rectangles and such) in
order to choose the best approach. Also, it seems like the system
source is a natural thing to put in ROM. In any event, there are 4MB
flash ram cards easily available for the Newton for $200, and even much
larger sizes for more.
I've though quite a bit about creating a very stripped headless Squeak
image that would use the Newton ROM protos through a NewtonScript
interface. I don't think I will pursue this any time soon since that
would entail having to carry around a NewtonScript reference to program
in Squeak, and since I only have that on CD-ROM, to use Squeak on the
Newton I'd also have to carry around my Mac. :-) One big advantage of
Squeak is that all the system call documentation and many working
examples are always available right there at all times.
One last thought on the ROM subject - if Squeak has some sort of
ENVY-like application structure allowing extensions, one might be able
to extend base classes without pulling anything out of ROM. This would
probably require some sort of system where every class had one spot in
RAM which was the start of a linked list of class extensions leading to
the base class. Method lookup would get correspondingly more
complicated. Maybe one could generalize this approach to address the
Smalltalk namespace issue at the same time.
-Paul Fernhout
kfsoft@netins.net
http://www.gardenwithinsight.com
Date: 97 Jan 16 6:30:06 am
From: Stefan Matthias Aust <sma@kiel.netsurf.de>
To: Squeak@create.ucsb.edu
Subject: Re: Opinion survey (Sin tax ;-)
>1. Case-insensitive: good bad dont care
If you ment, make the editor guess what I want/or wanted to type, then good.
If you however want to remove case sensitivity from the language, I vote for
bad.
An optional(!) behavior that, as soon as I type "growtoatleast ", the system
will change this to "growToAtLeast " would be fine. An additional feature, I
would vote for, would be popup menus that let the user pick valid method
selectors as the newest VisualBasic version has.
>2. Colon-equal for assignment: good bad dont care
Good because you need no special font and "_" becomes free for (3)
>3. Underbar in variable names: good bad dont care
Good because it's a handy trick to genrate unique names by prefixing them
with "_" as Ian already pointed out.
>4. Terminal keyword assignment: good bad dont care
Well, I like the idea, but not the way it's done. Bad.
It's probably a matter of style, but even inside the own class, I prefer
"self x" over "x" and "self x: 0" over "x := 0". However, the first looks
not as good (and natural, if you ask me) as the latter. So it we define,
that "x := 0" means nothing else than "self x: 0" we would get the good look
with the good abstraction.
Introducing a special ":="-setter semantic makes Smalltalk syntax a little
bit more complicate but also a little bit more readable IMHO. A similar
approach is followed by the language Cecil.
anObject something := anExpression
is translated to
anObject something-setter anExpression
where something-setter is name: if something is name and at:put: where
something is at:. And
something := anExpression
or
something
is translated to
self something := anExpression
or
self something
if something isn't a defined temporary or instance variable. Then following
the first translation rule.
Now "x := 0" is automatically translated as "self x: 0". The only
disadvantage I see, is that all miswritten attribute names are now seen as
message sends to self and these errors are only found at runtime. However,
when warning because of unknown method selectors, one could treat self-sends
more special, reducing this problem.
bye
--
Stefan Matthias Aust // Too much truth is unhealthy...
http://www.kiel.netsurf.de/users/s/sma/
Date: 97 Jan 16 6:41:02 am
From: Nickolay Saukh <nms@nns.ru>
To: Squeak@create.ucsb.edu
Subject: i18n (was: Re: Opinion survey (Sin tax ;-))
> >1. Case-insensitive: good bad dont care
> An optional(!) behavior that, as soon as I type "growtoatleast ", the system
> will change this to "growToAtLeast " would be fine. An additional feature, I
> would vote for, would be popup menus that let the user pick valid method
> selectors as the newest VisualBasic version has.
As I see there is no hope to make Squeak international (through Unicode)?
Date: 97 Jan 16 9:31:21 am
From: "David N. Smith" <dnsmith@watson.ibm.com>
To: Georg Gollmann <gollmann@edvz.tuwien.ac.at>
Cc: Dan Ingalls <DanI@wdi.disney.com>, Squeak@create.ucsb.edu
In-Reply-To: <v03010d00af00f576c9e2@[128.130.36.64]>
Subject: Re: Opinion survey (Sin tax ;-)
At 4:07 -0500 01/14/97, Georg Gollmann wrote:
>...
>I am not sure if all readers are aware that the {} notation is already
>implemented ( try { 'some ', 'test'. 3 + 4 }).
>...
>Georg
Neat!
I've always wanted collection constructors, not just array constructors.
How about something like:
OrderedCollection{ 'some ', 'test'. 3 + 4 }
which creates an OC directly, rather than constructing an array and
converting it, as in:
{ 'some ', 'test'. 3 + 4 } asOrderedCollection
Dave
_______________________________
David N. Smith
dnsmith@watson.ibm.com
IBM T J Watson Research Center
Hawthorne, NY
_______________________________
Any opinions or recommendations
herein are those of the author
and not of his employer.
Date: 97 Jan 16 9:39:48 am
From: Dan Ingalls <DanI@wdi.disney.com>
To: Stefan Matthias Aust <sma@kiel.netsurf.de>
Cc: Squeak@create.ucsb.edu
In-Reply-To: <1.5.4.32.19970116143327.0069e85c@kiel.netsurf.de>
Subject: Tip of the week: cmd-q and cmd-A
>> ... An additional feature, I
>would vote for, would be popup menus that let the user pick valid method
>selectors as the newest VisualBasic version has.
Are you aware of cmd-q? If you type the first few letters of a selector in=
Squeak, cmd-q will try to complete it for you. It will do this by taking=
all the selectors that begin that way, and pasting one after another as you=
keep typing cmd-q.
Augmenting with this convenience, is cmd-A. Suppose the selector you type=
this way has 4 keywords. The insertion caret will be left following the=
first keyword. After you have typed the first argument, cmd-A will jump=
you over the next keyword, ready to type the second argument.
Who said we don't have EMACS!
- Dan
Date: 97 Jan 16 9:50:12 am
From: Ian Piumarta <piumarta@prof.inria.fr>
To: dnsmith@watson.ibm.com
Cc: gollmann@edvz.tuwien.ac.at, DanI@wdi.disney.com, Squeak@create.ucsb.edu
In-Reply-To: <v03007803af0414c9637e@[129.34.225.178]> (dnsmith@watson.ibm.com)
Subject: Re: Opinion survey (Sin tax ;-)
Anyone who didn't see the "implementing 'case' statements in Smalltalk"
thread on comp.lang.smalltalk can ignore this message.
> At 4:07 -0500 01/14/97, Georg Gollmann wrote:
> >...
> >I am not sure if all readers are aware that the {} notation is already
> >implemented ( try { 'some ', 'test'. 3 + 4 }).
> I've always wanted collection constructors, not just array constructors.
> How about something like:
>
> OrderedCollection{ 'some ', 'test'. 3 + 4 }
It's a trivially small step from an "evaluating constructor" to something
which gives you "arbitrary" evaluation at compile time -- so that you can
create any kind of "constant" object that you like, at the time the method is
compiled. For (an unrealistic, pathetically procedural, "can you say
`quasiquote'?") example:
ProcessScheduler>>priorityValueNamed: aSymbol
^{ IdentityDictionary new
at: #rockBottom put: 1;
at: #systemBackground put: 2;
...
at: #highIO put: 7 } at: aSymbol
This is precisely the kind of thing that you would need in order to create a
"switch" statement in Smalltalk that does *not* evaluate each of the "case
labels". (The details are left as an exercise for the bored reader... ;-)
Ian
PS: Or maybe even to send you some email every time someone files-in your
latest goodie. ;-) ;-)
------------------------------- projet SOR -------------------------------
Ian Piumarta, INRIA Rocquencourt, Internet: Ian.Piumarta@inria.fr
BP105, 78153 Le Chesnay Cedex, FRANCE Voice: +33 1 39 63 52 87
----------------------- Systemes a Objets Repartis -----------------------
Date: 97 Jan 16 9:59:17 am
From: sadams@us.ibm.com
To: <Squeak@create.ucsb.edu>
Subject: Re: Opinion survey (Sin tax ;-)
Classification:
Prologue:
Epilogue: ICFS Portfolio Development Multi-Book Accounting Team
IBM Credit Corporation, White Plains, NY 10604
914-642-6412 (tl 224)
Internet: Susan_Adams@vnet.ibm.com
Can someone PLEASE PLEASE PLEASE explain how to get yourself removed
from this list? It is being sent to an e-mail address that I can receive mail
to, but
cannot SEND mail from. Therefore, every time I ask to be removed, it tells me
that
I am subscribed from a different address, and to unsubscribe from THAT address,
but I can't mail anything from that address.
Who can I call to remove myself??
Thanks, Susan
---------------------- Forwarded by Susan Adams/White Plains/IBM on 01-16-97
01:06 PM ---------------------------
owner-squeak @ create.ucsb.edu
01-16-97 12:51 PM
To: gollmann @ edvz.tuwien.ac.at@internet
cc: Squeak @ create.ucsb.edu@internet, DanI @ wdi.disney.com@internet
Subject: Re: Opinion survey (Sin tax ;-)
At 4:07 -0500 01/14/97, Georg Gollmann wrote:
>...
>I am not sure if all readers are aware that the {} notation is already
>implemented ( try { 'some ', 'test'. 3 + 4 }).
>...
>Georg
Neat!
I've always wanted collection constructors, not just array constructors.
How about something like:
OrderedCollection{ 'some ', 'test'. 3 + 4 }
which creates an OC directly, rather than constructing an array and
converting it, as in:
{ 'some ', 'test'. 3 + 4 } asOrderedCollection
Dave
_______________________________
David N. Smith
dnsmith@watson.ibm.com
IBM T J Watson Research Center
Hawthorne, NY
_______________________________
Any opinions or recommendations
herein are those of the author
and not of his employer.
Date: 97 Jan 16 10:04:23 am
From: Ian Piumarta <piumarta@prof.inria.fr>
To: dnsmith@watson.ibm.com
Cc: gollmann@edvz.tuwien.ac.at, DanI@wdi.disney.com, Squeak@create.ucsb.edu
In-Reply-To: <199701161753.SAA13615@prof.inria.fr> (message from Ian Piumarta
on Thu, 16 Jan 1997 18:53:26 +0100)
Subject: Re: Opinion survey (Sin tax ;-)
> something which gives you "arbitrary" evaluation at compile time
You know, there's already a "pragma thing" in Smalltalk which you could
modify to do this (and lots of other things). Imagine, if you will,
something like this:
ProcessScheduler>>priorityValueNamed: aSymbol
^<eval: IdentityDictionary new
at: #rockBottom put: 1;
at: #systemBackground put: 2;
...
at: #highIO put: 7> at: aSymbol
Or even:
...
<if: (Squeak version < 1.18)>
<eval: (self error: 'only works with version 1.18 or higher; aborting...').
Processor := nil.>.
<endif>
...
(Quick, someone stop me before I say something even sillier! ;-)
Ian
------------------------------- projet SOR -------------------------------
Ian Piumarta, INRIA Rocquencourt, Internet: Ian.Piumarta@inria.fr
BP105, 78153 Le Chesnay Cedex, FRANCE Voice: +33 1 39 63 52 87
----------------------- Systemes a Objets Repartis -----------------------
Date: 97 Jan 16 10:13:04 am
From: Andreas Raab <raab@isg_nw.cs.Uni-Magdeburg.DE>
To: squeak@create.ucsb.edu
Subject: Re: Opinion survey (Sin tax ;-)
> I've always wanted collection constructors, not just array constructors.
> How about something like:
>
> OrderedCollection{ 'some ', 'test'. 3 + 4 }
Great! That's what I've missed (although I never knew before reading
this ;-)
Andreas
--
Linear algebra is your friend - Trigonometry is your enemy.
+===== Andreas Raab ============= (raab@isg.cs.uni-magdeburg.de) =====+
I Department of Simulation and Graphics Phone: +49 391 671 8065 I
I University of Magdeburg, Germany Fax: +49 391 671 1164 I
+=============< http://simsrv.cs.uni-magdeburg.de/~raab >=============+
Date: 97 Jan 16 10:17:40 am
From: Andreas Raab <raab@isg_nw.cs.Uni-Magdeburg.DE>
To: squeak@create.ucsb.edu
Subject: Re: Tip of the week: cmd-q and cmd-A
> Are you aware of cmd-q? If you type the first few letters of a selector in Squeak, cmd-q will try to complete it for you. It will do this by taking all the selectors that begin that way, and pasti
>
> Augmenting with this convenience, is cmd-A. Suppose the selector you type this way has 4 keywords. The insertion caret will be left following the first keyword. After you have typed the first arg
>
> Who said we don't have EMACS!
As I read this, I was really wondering whether there is a reference card
for all the short cuts. If we have Emacs then we also should have
Ctrl-h b ;-) (for those not familiar with Emacs: this describes the
key bindings in the current mode)
- Andreas
--
Linear algebra is your friend - Trigonometry is your enemy.
+===== Andreas Raab ============= (raab@isg.cs.uni-magdeburg.de) =====+
I Department of Simulation and Graphics Phone: +49 391 671 8065 I
I University of Magdeburg, Germany Fax: +49 391 671 1164 I
+=============< http://simsrv.cs.uni-magdeburg.de/~raab >=============+
Date: 97 Jan 16 11:23:33 am
From: stp (Stephen Travis Pope)
To: Ian Piumarta <piumarta@prof.inria.fr>
Cc: gollmann@edvz.tuwien.ac.at, DanI@wdi.disney.com, Squeak@create.ucsb.edu
In-Reply-To: Ian Piumarta <piumarta@prof.inria.fr>'s letter of: 97 Jan 16
Subject: Re: Opinion survey (Sin tax ;-)
I've found it easy to stay within Smalltalk's syntax for this kind of
"constructor," for example I use "," sent to an Association to create a
Dictionary, so that Ian's example of,
> ProcessScheduler>>priorityValueNamed: aSymbol
> ^{ IdentityDictionary new
> at: #rockBottom put: 1;
> at: #systemBackground put: 2;
> ...
>
at: #highIO put: 7 } at: aSymbol
would become,
ProcessScheduler>>priorityValueNamed: aSymbol
^( (#rockBottom -> 1),
(#systemBackground -> 2),
...
(#highIO -> 7)) at: aSymbol
(These methods are in the case statement file-in among my goodies.)
The same could be modified to create OrderedCollections, etc. (as per
David's suggestion) using any available binary operator (or even [e.g.,]
"add:" sent to a String or Magnitude).
stp
_Stephen Travis Pope, Center for Research in Electronic Art Technology
_(CREATE), Dept. of Music, U. of California, Santa Barbara (UCSB)
_Editor, Computer Music Journal (CMJ), MIT Press
_stp@create.ucsb.edu http://www.create.ucsb.edu/~stp/
Date: 97 Jan 16 11:28:40 am
From: stp (Stephen Travis Pope)
To: Andreas Raab <raab@isg_nw.cs.Uni-Magdeburg.DE>, squeak@create.ucsb.edu
In-Reply-To: Andreas Raab <raab@isg_nw.cs.Uni-Magdeburg.DE>'s letter of: 97 Jan 16
Subject: Re: Tip of the week: cmd-q and cmd-A
> As I read this, I was really wondering whether there is a reference card
> for all the short cuts. If we have Emacs then we also should have
> Ctrl-h b ;-) (for those not familiar with Emacs: this describes the
> key bindings in the current mode)
My V9 file-ins (for VW, not ported to Sqwueak yet) include the method
ParagraphEdtor>>dumpTable that prints the keyboard map's method names to the
Transcript (suitable for printing).
stp
_Stephen Travis Pope, Center for Research in Electronic Art Technology
_(CREATE), Dept. of Music, U. of California, Santa Barbara (UCSB)
_Editor, Computer Music Journal (CMJ), MIT Press
_stp@create.ucsb.edu http://www.create.ucsb.edu/~stp/
Date: 97 Jan 16 11:33:54 am
From: stp (Stephen Travis Pope)
To: Patrick Logan <plogan@teleport.com>
Cc: piumarta@prof.inria.fr, DanI@wdi.disney.com, Squeak@create.ucsb.edu
In-Reply-To: Patrick Logan <plogan@teleport.com>'s letter of: 97 Jan 15
Subject: Re: Opinion survey (Sin tax ;-), new proposals
In my previous posting about "," I forgot to translate David's example of,
> cubicFunction := CubicFunction
> withCoefficients: { Float pi :: exp :: myAge :: three5s + 111 }
which of course can be written,
cubicFunction := CubicFunction
withCoefficients: (Float pi, exp, myAge, (three5s + 111))
stp
_Stephen Travis Pope, Center for Research in Electronic Art Technology
_(CREATE), Dept. of Music, U. of California, Santa Barbara (UCSB)
_Editor, Computer Music Journal (CMJ), MIT Press
_stp@create.ucsb.edu http://www.create.ucsb.edu/~stp/
Date: 97 Jan 16 11:35:42 am
From: stp (Stephen Travis Pope)
To: Dan Ingalls <DanI@wdi.disney.com>, Squeak@create.ucsb.edu
In-Reply-To: Dan Ingalls <DanI@wdi.disney.com>'s letter of: 97 Jan 15
Subject: Re: Opinion survey - thanks
DanI wrote,
> Isn't it great to have 100% agreement on something!
I find it even more interesting that we agree > 80% on all questions but
one--using underscore in names.
stp
_Stephen Travis Pope, Center for Research in Electronic Art Technology
_(CREATE), Dept. of Music, U. of California, Santa Barbara (UCSB)
_Editor, Computer Music Journal (CMJ), MIT Press
_stp@create.ucsb.edu http://www.create.ucsb.edu/~stp/
Date: 97 Jan 16 11:57:17 am
From: Jecel Assumpcao Jr <jecel@lsi.usp.br>
To: Squeak@create.ucsb.edu
Subject: Re: Storing temp names in compiled methods
Old Digitalk Smalltalks used to compress the source
files with very good results.
When Self decompiles you always get the names of the
argument and temporary variables since they are just
"instance variables" of the methods. Of course, that
means that every single methods belongs to a separate
"class". This results in an 8 word overhead for every
method plus a 6 word overhead for every argument or
temporary! And you also have to store the names as
strings in the image, but different variables with
the same name can share a single string.
BTW, Self doesn't normally have to decompile methods
because it stores the full sources as strings in the
image! In fact, the source for a block gets stored
several times as it is also part of the source of the
enlcosing lexical blocks and method (and some people
are surprised at the ammount of memory it takes to run
Self ;-)
About anonymous arguments, I once designed a Smalltalk
that used "message template trees" for code rather than
bytecodes (it would proabably make even Self look slim!).
See http://www.lsi.usp.br/~jecel/st84.txt for details.
When I tried to see if the same ideas could be used for
Self, it didn't work because it depended on only the
number of arguments being important (like in Smalltalk),
not their names (like in Self).
-- Jecel
Date: 97 Jan 16 11:57:18 am
From: Jecel Assumpcao Jr <jecel@lsi.usp.br>
To: Squeak@create.ucsb.edu
Subject: Re: ROMing Squeak
On machines with MMUs you can put the image on the ROM
with no changes at all. Whenever someone tries to write
to a page, you copy it to RAM and remap it to the same
address.
A random ordering of objects would probably result in
the whole ROM being copied into RAM. But it would work.
You could then try various static grouping strategies
to see how much you could improve on the random placement.
-- Jecel
Date: 97 Jan 16 12:46:02 pm
From: Tim Rowledge <rowledge@interval.com>
To: Squeak mailinglist <squeak@create.ucsb.edu>
Subject: Little Endian BitBLT code
I've done a little endian bitblt. It seems to work just fine, no bugs have
bitten me over the last few weeks. I'm there are some in there somewhere,
so it's time for some beta testing.
It makes my Acorn seem much more responsive than previously, so it should
be useful for Ian's & Andreas' LE ports.
Go to my webpage and follow links to the Squeak page; sometime over the
next few days there should be rather more adequate documentation available
at the same place.
Enjoy!
--
Tim Rowledge: rowledge@interval.com (w) +1 (415) 856-7230 (w)
tim@sumeru.stanford.edu (h) <http://sumeru.stanford.edu/tim>
Date: 97 Jan 16 3:32:33 pm
From: Stefan Matthias Aust <sma@kiel.netsurf.de>
To: Squeak@create.ucsb.edu
Subject: Re: Opinion survey (Sin tax ;-)
>It's a trivially small step from an "evaluating constructor" to something
>which gives you "arbitrary" evaluation at compile time -- so that you can
>create any kind of "constant" object that you like, at the time the method is
>compiled.
This exists already in Dolphin Smalltalk. They use
##(anExpression)
as notation for compile time evaluation.
z.B.
##(|a| a:=3. a+4) ---> 7
bye
--
Stefan Matthias Aust // Too much truth is unhealthy...
http://www.kiel.netsurf.de/users/s/sma/
Date: 97 Jan 16 3:56:58 pm
From: Ian Piumarta <piumarta@prof.inria.fr>
To: stp@create.ucsb.edu
Cc: DanI@wdi.disney.com, Squeak@create.ucsb.edu, gollmann@edvz.tuwien.ac.at
Subject: constructors/compile-time evaluation (was: Opinion survey (Sin tax ;-))
Stephen,
The real difference between
> > ^{ IdentityDictionary new
> > at: #rockBottom put: 1;
...
> > at: #highIO put: 7 } at: aSymbol
and
> ^( (#rockBottom -> 1),
> ...
> (#highIO -> 7)) at: aSymbol
is that the first constructs the Dictionary once, at compile time,
whereas the second constructs it every time you invoke the method.
To make something like a "switch" statement you could (for example) make
a Dictionary-like thing containing labels as keys, blocks as values, a
suitable "default" behaviour, and the obvious treatment of "value" when
the switch is executed. You would only want to build this thing once,
at compile time, no matter how many times you execute the "switch"
itself. In this case, avoiding the reconstruction is far more important
than in the trivial "priority" example above.
I like that Association>>, trick a lot -- I would therefore like to
resubmit my example as:
^{(#rockBottom -> 1),
...,
(#highIO -> 7)} at: aSymbol
:^) (Even though it is still a *very* bad example!)
Ian
------------------------------- projet SOR -------------------------------
Ian Piumarta, INRIA Rocquencourt, Internet: Ian.Piumarta@inria.fr
BP105, 78153 Le Chesnay Cedex, FRANCE Voice: +33 1 39 63 52 87
----------------------- Systemes a Objets Repartis -----------------------
Date: 97 Jan 16 6:18:02 pm
From: "David N. Smith" <dnsmith@watson.ibm.com>
To: Stefan Matthias Aust <sma@kiel.netsurf.de>
Cc: Squeak@create.ucsb.edu
In-Reply-To: <1.5.4.32.19970116221308.006eb83c@kiel.netsurf.de>
Subject: Re: Opinion survey (Sin tax ;-)
At 17:13 -0500 01/16/97, Stefan Matthias Aust wrote:
>>It's a trivially small step from an "evaluating constructor" to something
>>which gives you "arbitrary" evaluation at compile time -- so that you can
>>create any kind of "constant" object that you like, at the time the method is
>>compiled.
>
>This exists already in Dolphin Smalltalk. They use
>
> ##(anExpression)
>
>as notation for compile time evaluation.
>
>z.B.
> ##(|a| a:=3. a+4) ---> 7
>
>bye
>--
>Stefan Matthias Aust // Too much truth is unhealthy...
> http://www.kiel.netsurf.de/users/s/sma/
It's in IBM Smalltalk too, but not officially documented (except in my book
where I may evenually regret it!) There are a couple of examples of not so
obvious use of this feature at:
http://www.dnsmith.com/dnsmith/DNSSL2/htmlForAW/ver3new.html
Bump down a couple of screen fulls to see the Compile-Time Evaluation section.
The feature essentially evaluates anything you can evaluate in a workspace,
but takes the result as the value of the expression.
Dave
_______________________________
David N. Smith
dnsmith@watson.ibm.com
IBM T J Watson Research Center
Hawthorne, NY
_______________________________
Any opinions or recommendations
herein are those of the author
and not of his employer.
Date: 97 Jan 16 6:43:29 pm
From: Tim Rowledge <rowledge@interval.com>
To: Squeak mailinglist <squeak@create.ucsb.edu>
Subject: Acorn RPC port now available
It's here, it's a bit rough (you try coping with an OS that won't let
you have a file open more than once at a time!) but it goes.
<http://sumeru.stanford.edu/tim/Squeak.html>
And if you don't have an Acorn RPC-StrongARM, shame on you. Write out
a purchase req. right this minute!
--
Tim Rowledge: rowledge@interval.com (w) +1 (415) 856-7230 (w)
tim@sumeru.stanford.edu (h) <http://sumeru.stanford.edu/tim>
Date: 97 Jan 16 9:36:37 pm
From: Hans-Martin Mosner <hm.mosner@cww.de>
To: Squeak Mailing List <squeak@create.ucsb.edu>
Subject: Squeak and Timezones
Dies ist eine mehrteilige Nachricht im MIME-Format.
--------------216C46015B67
Content-Type: text/plain; charset=us-ascii
Content-Transfer-Encoding: 7bit
Hello Squeakers,
just for fun I started to write a mailbox analyzer that could probably
be the basis for the next generation of the mailing list archive. It's
nowhere like finished yet, but I stumbled across one problem for which
we probably need a consensus:
How should time and timezone information be represented in Squeak?
In the Windows NT implementation, the time is given as GMT (that's
what NT uses internally). I believe that there are functions to access
the local timezone and DST information.
On the Mac, time is always reported as local time, but there are
functions in the MacOS to find out about the location and timezone of
the machine.
Unix has it similar to NT: time is kept in GMT, and timezone
information is available to user programs.
Squeak, just like early Smalltalk-80, does not have any notion of
timezones. I propose that we define, for future incarnations of
Squeak, that time is always reported in GMT (or rather UTC, Universal
Time C???) and that an additional primitive makes timezone information
accessible to the image. When this primitive fails, either because it
is not implemented or because the platform has no notion of timezone,
the image can do whatever is appropriate:
- Ask the user about the local timezone and offset from the
VM-reported time, or
- Check whether it runs on a Mac or on Unix/NT, and silently assume
that time reported by the VM is local respective GMT.
We also should consider having a class for timezoned time+date
information which can represent the dates in News and Mail headers
accurately. For the aforementioned mailbox analyzer, I've already
written such a class (it currently knows about the numerical GMT
offset format only, but that will change).
This class keeps the time and date as seconds GMT since the Smalltalk
Epoch (1.jan.1901), plus the offset from GMT for the timezone in which
the timestamp was generated. This allows simple comparisons between
such timestamps, and accurate display in user interfaces.
For those interested in playing around with that class, I've included
it as an attachment. The name should probably change, I just could not
think of something better at that moment.
Hans-Martin
--------------216C46015B67
Content-Type: text/plain; charset=us-ascii; x-mac-type="54455854"; x-mac-creator="522A6368"
Content-Transfer-Encoding: 7bit
Content-Disposition: inline; filename="ZonedDateAndTime.st"
'From Squeak 1.18 of December 12, 1996 on 16 January 1997 at 9:56:36 pm'!
Magnitude subclass: #ZonedDateAndTime
instanceVariableNames: 'seconds gmtOffset '
classVariableNames: 'ReportedTimeOffset LocalTimeOffset '
poolDictionaries: ''
category: 'Numeric-Magnitudes'!
ZonedDateAndTime comment:
'ZonedDateAndTime keeps an absolute time and a timezone, suitable for representing timestamps in RFC-style syntax. A possible extension would include the mnemonic name for the timezone as generated by some mail and news systems.
Note: wherever I wrote GMT, I mean in fact UTC. It just shows how old I am...
Instance Variables:
seconds <Integer> GMT time
gmtOffset <Integer> offset in seconds between local time and GMT (negative: west of GMT, positive: east of GMT)
Class Variables:
ReportedTimeOffset <Integer> offset between the time reported by "Time totalSeconds" and GMT
LocalTimeOffset <Integer> offset between local time and GMT
'!
!ZonedDateAndTime methodsFor: 'printing'!
printOn: aStream
"Print in the format used by Mail and News headers. Timezone name is
currently not printed."
| convertedTime date time off |
convertedTime := seconds + gmtOffset.
date := Date fromDays: convertedTime//86400.
time := Time fromSeconds: convertedTime \\ 86400.
aStream nextPutAll: (date weekday copyFrom: 1 to: 3).
aStream nextPut: $,;
space.
date printOn: aStream format: #(1 2 3 32 2 2 ).
aStream space.
time print24: true on: aStream.
aStream space.
aStream nextPut: (gmtOffset >= 0
ifTrue: [$+]
ifFalse: [$-]).
off := gmtOffset abs.
#(36000 3600 600 60 ) do:
[:factor |
"print timezone offset in HHMM format"
off // factor printOn: aStream.
off := off \\ factor]! !
!ZonedDateAndTime methodsFor: 'accessing'!
gmtOffset
^gmtOffset!
gmtOffset: anInteger
gmtOffset := anInteger!
seconds
^seconds!
seconds: anInteger
seconds := anInteger! !
!ZonedDateAndTime methodsFor: 'comparing'!
< aZonedDateAndTime
^seconds < aZonedDateAndTime asSeconds!
<= aZonedDateAndTime
^seconds <= aZonedDateAndTime asSeconds!
= aZonedDateAndTime
"Is this right? If the time zones are different, the print strings will be different, but the times will be considered equal."
self species = aZonedDateAndTime species ifFalse: [^false].
^seconds = aZonedDateAndTime asSeconds!
> aZonedDateAndTime
^seconds > aZonedDateAndTime asSeconds!
>= aZonedDateAndTime
^seconds >= aZonedDateAndTime asSeconds! !
!ZonedDateAndTime methodsFor: 'converting'!
asSeconds
^seconds! !
"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!
ZonedDateAndTime class
instanceVariableNames: ''!
!ZonedDateAndTime class methodsFor: 'class initialization'!
initialize
"ZonedDateAndTime initialize"
"Set the offset between the time reported by Time totalSeconds and GMT,
and the offset between local time and GMT.
This information is currently not available from the VM,
so we need to have it fixed in the code.
The constants given here are for my Mac at home (1 hour east of GMT)"
LocalTimeOffset := 1 * 3600.
ReportedTimeOffset := 1 * 3600! !
!ZonedDateAndTime class methodsFor: 'instance creation'!
now
"ZonedDateAndTime now Thu, 16 Jan 97 21:51:27 +0100"
^self new
seconds: Time totalSeconds - ReportedTimeOffset;
gmtOffset: LocalTimeOffset!
readFrom: aStream
"read in the format normally used in News or Mail messages, ignoring a leading weekday name."
| date time offset |
[aStream atEnd or: [aStream peek isDigit]] whileFalse: [aStream next].
date := Date readFrom: aStream.
aStream skipSeparators.
time := Time readFrom: aStream.
aStream skipSeparators.
aStream peekFor: $+.
offset := Integer readFrom: aStream.
offset := (offset abs // 100 * 60) + (offset abs \\ 100) * 60 * offset sign.
^self new
seconds: date asSeconds + time asSeconds - offset;
gmtOffset: offset! !
ZonedDateAndTime initialize!
--------------216C46015B67--
Date: 97 Jan 17 12:25:36 am
From: Hans-Martin Mosner <hmm@heeg.de>
To: Nickolay Saukh <nms@nns.ru>
Cc: Squeak@create.ucsb.edu
Subject: Re: i18n (was: Re: Opinion survey (Sin tax ;-))
Nickolay Saukh wrote:
> As I see there is no hope to make Squeak international (through Unicode)?
As it stands, there are just 256 Characters. I have contemplated
changing the Squeak interpreter to support more classes of immediate
objects, so that we could represent 16 bit (or 24 bit) characters,
immediate points, immediate nil, true and false.
With this, Unicode would be just natural...
Of course, one would have to write a UnicodeString class to represent
Strings with 16-bit characters, and appropriate methods for
representation of such strings in files.
And, most importantly, the fonts would have to change to support wide
characters, too. It took ParcPlace quite a while to understand the
issue, and some more time to implement it correctly (some doubt that
they've done it yet). Therefore I think that the solution to the problem
is non-trivial, and probably not doable with the available Squeak
development manpower.
Hans-Martin
--
+--- Hans-Martin Mosner ---- Senior Smalltalk Guru :-) ---+
| These opinions are entirely ficticious. Any similarity |
| to real opinions is purely coincidental and unintended. |
+--- <hmm@heeg.de> ------ URL:http://www.heeg.de/~hmm/ ---+
Date: 97 Jan 17 12:29:24 am
From: Georg Gollmann <gollmann@edvz.tuwien.ac.at>
To: hm.mosner@cww.de, Squeak Mailing List <squeak@create.ucsb.edu>
In-Reply-To: <32DE967F.4ED1@cww.de>
Subject: Re: Squeak and Timezones
At 21:58 Uhr +0100 16.1.1997, Hans-Martin Mosner wrote:
>Squeak, that time is always reported in GMT (or rather UTC, Universal
>Time C???) and that an additional primitive makes timezone information
Coordinated
Georg
----
Dipl.Ing. Georg Gollmann TU-Wien, EDV-Zentrum
phon:(++43-1) 58801 - 5848
mail:gollmann@edvz.tuwien.ac.at
http://ftp.tuwien.ac.at/~go/Gollmann.html
Date: 97 Jan 17 1:17:14 am
From: Georg Gollmann <gollmann@edvz.tuwien.ac.at>
To: Squeak@create.ucsb.edu
Subject: Re: constructors/compile-time evaluation
I'd like to throw in a couple of comments on this thread:
- I believe the need for compile time evaluation is much reduced in
Smalltalk since we have the image where we can store those "helper" objects
(in a classVar or pool), which would be created by a class initialization
method. Sometimes having compile-time evaluation might be more convenient,
though.
- I really like STP's observation that for convenient *runtime*
construction (the starting point of this thread), a binary operator does
the trick very nicely. The power of simplicity ...
Georg
----
Dipl.Ing. Georg Gollmann TU-Wien, EDV-Zentrum
phon:(++43-1) 58801 - 5848
mail:gollmann@edvz.tuwien.ac.at
http://ftp.tuwien.ac.at/~go/Gollmann.html
Date: 97 Jan 17 4:50:19 am
From: johnson@cs.uiuc.edu (Ralph E. Johnson)
To: sadams@us.ibm.com, <Squeak@create.ucsb.edu>
Subject: Re: Opinion survey (Sin tax ;-)
When I saw your e-mail address in my mailer, I said to myself
"Oh, Sam Adams is on the Squeak list. Great!" I was then
amused to when I read your e-mail. I bet you are not amused,
though. Sam probably joined the list and then you ended up
getting the mail.
Here are the instructions I have:
>If you ever want to remove yourself from this mailing list,
>you can send mail to <Majordomo@create.ucsb.edu> with the following
>command in the body of your email message:
> unsubscribe squeak johnson@cs.uiuc.edu
Of course, you will need to replace my address with yours.
It looks like anybody can type any address in there, so it
shouldn't matter that you aren't sending it from your login.
If that doesn't help, try sending "help" to Majordomo@create.ucsb.edu
-Ralph
Date: 97 Jan 17 6:43:08 am
From: "David N. Smith" <dnsmith@watson.ibm.com>
To: sadams@us.ibm.com
Cc: <Squeak@create.ucsb.edu>
In-Reply-To: <0038300005251664000002*@MHS>
Subject: Re: Opinion survey (Sin tax ;-)
At 13:00 -0500 01/16/97, sadams@us.ibm.com wrote:
>Classification:
>Prologue:
>Epilogue: ICFS Portfolio Development Multi-Book Accounting Team
>IBM Credit Corporation, White Plains, NY 10604
>914-642-6412 (tl 224)
>Internet: Susan_Adams@vnet.ibm.com
>
>Can someone PLEASE PLEASE PLEASE explain how to get yourself removed
>from this list? It is being sent to an e-mail address that I can receive mail
>to, but
>cannot SEND mail from. Therefore, every time I ask to be removed, it tells me
>that
>I am subscribed from a different address, and to unsubscribe from THAT
>address,
>but I can't mail anything from that address.
>
>Who can I call to remove myself??
>
>Thanks, Susan
Susan:
There is a Sam Adams in the Smalltalk community. I show this address in my
address book for Sam:
sadams@vnet.ibm.com
but don't know if it is still valid. But there is certainly room for
confusion here. Sam is a nice guy and I'm sure will gladly help you get it
all fixed if your efforts to outsmart a stubborn mail server fail. :-)
Sam is in the Raleigh area, last I heard, and should be easy to find in CALLUP.
Good luck,
Dave
_______________________________
David N. Smith
dnsmith@watson.ibm.com
IBM T J Watson Research Center
Hawthorne, NY
_______________________________
Any opinions or recommendations
herein are those of the author
and not of his employer.
Date: 97 Jan 17 7:23:14 am
From: Stefan Matthias Aust <sma@kiel.netsurf.de>
To: squeak@create.ucsb.edu
Subject: Problem recompiling Squeak
Hi!
I'm trying to recompile the Squeak VM using Ian's 1.17u version under linux.
I use the expression "Interpreter translate: 'I.c' doInlining: false" to do
it but the generated source code (about 200k) has syntaxical errors like for
example
if ( .... ) {
....else {
....
}
instead of
if ( .... ) {
....
} else {
....
}
This is strange, because I checked the code translator sources and I'm sure
it generates the correct code! So the problem seems to be either in the
stream buffering or inside the i/o primitives. Has anybody else run in the
same problems?
Btw, the following quick hack will solve the problem of too big numerical
constants which let GCC heart-rending complain :-)
'From Squeak 1.13 of October 17, 1996 on 17 January 1997 at 3:13:39 pm'!
!CCodeGenerator methodsFor: 'C code generator'!
cLiteralFor: anObject
"Return a string representing the C literal value for the given object."
(anObject isKindOf: Integer) ifTrue: [^ anObject printString ,
(anObject >= 2147483647 ifTrue: ['U'] ifFalse: [''])].
(anObject isKindOf: String) ifTrue: [^ '"', anObject, '"' ].
(anObject isKindOf: Float) ifTrue: [^ anObject printString ].
anObject == nil ifTrue: [^ 'null' ].
Transcript show:
'Warning: A Smalltalk literal could not be translated into a C constant'; cr.
^'"XXX UNTRANSLATABLE CONSTANT XXX"'! !
--
Stefan Matthias Aust // Too much truth is unhealthy...
http://www.kiel.netsurf.de/users/s/sma/
Date: 97 Jan 17 7:23:17 am
From: Stefan Matthias Aust <sma@kiel.netsurf.de>
To: squeak@create.ucsb.edu
Subject: Re: Tip of the week: cmd-q and cmd-A
>As I read this, I was really wondering whether there is a reference card
>for all the short cuts. If we have Emacs then we also should have
>Ctrl-h b ;-) (for those not familiar with Emacs: this describes the
>key bindings in the current mode)
Try evaluating "Utilities openCommandKeyHelp" :-)
bye
--
Stefan Matthias Aust // Too much truth is unhealthy...
http://www.kiel.netsurf.de/users/s/sma/
Date: 97 Jan 17 8:41:41 am
From: Maloney <johnm@wdi.disney.com>
To: sma@kiel.netsurf.de
Cc: squeak@create.ucsb.edu
Subject: Problem recompiling Squeak
>From: Stefan Matthias Aust <sma@kiel.netsurf.de>
>I'm trying to recompile the Squeak VM using Ian's 1.17u version under linux.
>I use the expression "Interpreter translate: 'I.c' doInlining: false" to do
>it but the generated source code (about 200k) has syntaxical errors...
>...the problem seems to be either in the stream buffering or inside the
>i/o primitives...
Yes, there was a bug in the file I/O primitives that caused this problem.
The bug is fixed in 1.18, but I don't think Ian will have time to port 1.18
for another 6 weeks or so. (As I recall, the bug had to do with flushing
the Unix stream between writing and reading.)
As a work-around, you can give Squeak a hefty supply of memory and
then modify the translator to write to an in-memory stream. Then write
the contents of this stream to a file. If you can run Squeak, you can
extract the file "sqFilePrims.c" from the 1.18 image to get the fixed
version. Ian made a few trivial changes to this file for the Unix
port, but I'm not sure they are still needed. I'll enclose the diffs.
-- John
---------------
112c130
< f->file = fopen(cFileName, "rb+");
---
> f->file = fopen(cFileName, "r+");
117c135
< f->file = fopen(cFileName, "wb");
---
> f->file = fopen(cFileName, "a+");
125c143
< f->file = fopen(cFileName, "rb");
---
> f->file = fopen(cFileName, "r");
136c154
< fseek(f->file, 0, SEEK_END);
---
> fseek(f->file, 0, 2);
138c156
< fseek(f->file, 0, SEEK_SET);
---
> fseek(f->file, 0, 0);
188c206
< fseek(f->file, position, SEEK_SET);
---
> fseek(f->file, position, 0);
---------------
Date: 97 Jan 17 8:50:02 am
From: Ian Piumarta <piumarta@prof.inria.fr>
To: johnm@wdi.disney.com, sma@kiel.netsurf.de
Cc: squeak@create.ucsb.edu
Subject: Re: Problem recompiling Squeak
> As a work-around, you can give Squeak a hefty supply of memory and
> then modify the translator to write to an in-memory stream.
I saw the same problem when generating the VM sources for 1.17. I found
that the following sequence produced a correct source file:
1) delete any old VM sources
2) generate a VM
3) generate the VM again (DO NOT DELETE THE FIRST VM!)
I haven't got the slightest idea why this should work, especially now
that you have explained the problem.
Ian
------------------------------- projet SOR -------------------------------
Ian Piumarta, INRIA Rocquencourt, Internet: Ian.Piumarta@inria.fr
BP105, 78153 Le Chesnay Cedex, FRANCE Voice: +33 1 39 63 52 87
----------------------- Systemes a Objets Repartis -----------------------
Date: 97 Jan 17 12:28:49 pm
From: Adam Bridge <abridge@wheel.dcn.davis.ca.us>
To: "squeak" <squeak@create.ucsb.edu>
Subject: Moving Squeak to Be
I'm sorta getting ready to try porting Squeak to BeOS.
It's a first-timer event for me as I attempt refamilierize myself with
C++ on BeOS AND get used to what's required for moving Squeak.
If anyone has thoughts/hints I'd sure like to hear them, espcially for
using the mutli-threaded aspects of the BeOS. (I know this would be a
TERRIFIC port for SmalltalkAgents.)
Thanks in advance,
Adam Bridge
-------------------------------------------
Adam Bridge
No wonder the ruined woods I used to know don't cry out for retribution!
he thought:The people who have destroyed it will accomplish its revenge.
William Faulkner, "Delta Autumn"
Internet: abridge@wheel.dcn.davis.ca.us
Voice: (916) 756-4695
Date: 97 Jan 17 12:53:20 pm
From: James McCartney <james@clyde.as.utexas.edu>
To: Adam Bridge <abridge@wheel.dcn.davis.ca.us>,
"squeak" <squeak@create.ucsb.edu>
In-Reply-To: <199701172037.MAA06926@wheel.dcn.davis.ca.us>
Subject: Re: Moving Squeak to Be
At 12:37 PM -0800 1/17/97, Adam Bridge wrote:
>I'm sorta getting ready to try porting Squeak to BeOS.
>
>It's a first-timer event for me as I attempt refamilierize myself with
>C++ on BeOS AND get used to what's required for moving Squeak.
>
>If anyone has thoughts/hints I'd sure like to hear them, espcially for
>using the mutli-threaded aspects of the BeOS. (I know this would be a
>TERRIFIC port for SmalltalkAgents.)
If you wanted to make Smalltalk threads be real BeOS threads, then it
is going to be hairy. Making garbage collection thread safe will require
making some interesting decisions. I am working through this for my
audio synth language. I require real time GC which is making my case harder.
--- james mccartney james@clyde.as.utexas.edu james@lcsaudio.com
If you have a PowerMac check out SuperCollider, a real time synth program:
ftp://mirror.apple.com//mirrors/Info-Mac.Archive/gst/snd/super-collider-demo.hqx
Date: 97 Jan 17 3:46:19 pm
From: Stefan Matthias Aust <sma@kiel.netsurf.de>
To: squeak@create.ucsb.edu
Subject: Recompiling Squeak adventure
>Yes, there was a bug in the file I/O primitives that caused this problem.
I finally managed to recompile my 1.17 system. Using an internal
stream was the right tip. Thank you. Although I've very less knowledge
with X, I hacked the file sqUnixWindow.c, changing the following
definition
char modifierMap[16]= {
0, 1, 1, 0, 2, 3, 3, 2, 8, 9, 9, 8, 4, 5, 5, 4
};
to activate all that neat command-shortcuts. I also hacked cursor key
support into recordKeystroke() and removed the hard coded ^C interrupt
key (default is now Alt+".")
I would like to add support for more special keys, but I don't know
the mac keycodes for
Begin of Line (aka Home, Pos1),
End of Line (aka End, Ende),
Page Up (aka PgUp, Prior, Bild^),
Page Down (aka PgDn, Next, Bildv)
Could someone please be so kind and figure out these numbers? Thanks.
bye
PS: Ian, I don't understand you changes to sqFilePrims. The original
is a wonderful Posix conforming file which should work well, too.
PPS: From time to time, my new VM get stuck in an endless recursion
loop in Behavior>new:, again a bug of 1.17?
--
Stefan Matthias Aust // Too much truth is unhealthy...
http://www.kiel.netsurf.de/users/s/sma/
Date: 97 Jan 17 3:46:18 pm
From: Stefan Matthias Aust <sma@kiel.netsurf.de>
To: squeak@create.ucsb.edu
Subject: 1.17 -> 1.18 patches
Hi!
Does anybody have the 1.17 -> 1.18 changes available in a non-macintosh
format? I'd be very glad to receive them to be able to build a 1.18 unix
version of squeak I'd like to share then. Thanks.
bye
--
Stefan Matthias Aust // Too much truth is unhealthy...
http://www.kiel.netsurf.de/users/s/sma/
Date: 97 Jan 18 3:17:59 am
From: Ian Piumarta <piumarta@prof.inria.fr>
To: james@clyde.as.utexas.edu
Cc: abridge@wheel.dcn.davis.ca.us, squeak@create.ucsb.edu
In-Reply-To: <l03010d00af0598866ea1@[128.83.128.124]> (message from James
McCartney on Fri, 17 Jan 1997 14:01:38 -0700)
Subject: Re: Moving Squeak to Be
> Making garbage collection thread safe will require making some interesting
> decisions.
I agree. Multi-threaded GC is still a very active area of research.
Modifying a GC such as Squeak's to be properly multi-threaded would be an
awesome task to take on.
[stop reading now if you're not interested in GC implementation]
The only "simple" solution to this problem is to "stop the world" when a
sweep phase begins: turn off pre-emption and let a single thread take over
for the duration of the sweep. Add to this some way to get at the saved
threads' context (registers, stack, thread-specific data, etc.) during
marking and the rest is fairly straighforward. (I recently did this for
Boehm's conservative GC [a plug-in replacement for malloc() in C and C++] to
make it work under DECthreads and the highly-portable MIT pthreads.)
To make a truly multi-threaded collector (especially if it's real-time and/or
incremental) involves very complex cooperation between threads, and if you
manage to implement it then you should immediately publish a bunch of papers
about it! ;-)
There *are* ways to make a single-threaded GC run in a multi-threaded
environment with minimal changes to the GC. I know of one particularly
simple and elegant solution, which has been used in a multi-threaded version
of Bigloo (a Scheme interpreter/compiler). It relies on two things: (a)
knowing how many threads are currently active, and (b) that each thread is
guaranteed to allocate objects very frequently (which is a fair assumption in
most "dynamic" languages).
At each allocation you need to acquire an "allocator lock", which works like
a simple mutex most of the time. However, it's not really a simple mutex but
rather a "counting lock" which can keep track of how many threads are
currently waiting on it. When some thread tries to allocate an object,
acquires the allocator lock and then triggers a GC, it gives up the lock and
blocks on a condition variable. All the other threads will try to allocate
an object very soon, and each one blocks on the CV too. When the last thread
tries to take the lock it succeeds, the thread does not block on the CV, and
the GC runs within that thread. When the GC has finished, the allocator lock
starts working like a simple mutex again (for example the GC thread could
broadcast on the CV before releasing the allocator lock, and then each thread
re-tries its allocation "from scratch").
There is a very good collection of GC-related papers at Henry Baker's home
page: ftp://ftp.netcom.com/pub/hb/hbaker/home.html
Ian
------------------------------- projet SOR -------------------------------
Ian Piumarta, INRIA Rocquencourt, Internet: Ian.Piumarta@inria.fr
BP105, 78153 Le Chesnay Cedex, FRANCE Voice: +33 1 39 63 52 87
----------------------- Systemes a Objets Repartis -----------------------
Date: 97 Jan 18 3:23:55 am
From: Ian Piumarta <piumarta@prof.inria.fr>
To: sma@kiel.netsurf.de
Cc: squeak@create.ucsb.edu
In-Reply-To: <1.5.4.32.19970117235415.006697a8@kiel.netsurf.de> (message from
Stefan Matthias Aust on Sat, 18 Jan 1997 00:54:15 +0100)
Subject: Re: Recompiling Squeak adventure
Stefan,
If you can send me the changes you've made, I will incorporate them into my
sources. Thanks!
> PS: Ian, I don't understand you changes to sqFilePrims. The original
> is a wonderful Posix conforming file which should work well, too.
Not all Unixes are as POSIX-conformant as you might think. The "b" modifier
in fopen() is not supported on very many platforms, and the symbolic
constants which specify the "origin" in lseek() are not defined on many
platforms either. I don't think I modified anything else in there, unless
you know different?
> PPS: From time to time, my new VM get stuck in an endless recursion
> loop in Behavior>new:, again a bug of 1.17?
I've never seen this.
Regards,
Ian
------------------------------- projet SOR -------------------------------
Ian Piumarta, INRIA Rocquencourt, Internet: Ian.Piumarta@inria.fr
BP105, 78153 Le Chesnay Cedex, FRANCE Voice: +33 1 39 63 52 87
----------------------- Systemes a Objets Repartis -----------------------
Date: 97 Jan 18 4:48:31 am
From: Ian Piumarta <piumarta@prof.inria.fr>
To: sma@kiel.netsurf.de
Cc: squeak@create.ucsb.edu
In-Reply-To: <1.5.4.32.19970117235417.006a40c0@kiel.netsurf.de> (message from
Stefan Matthias Aust on Sat, 18 Jan 1997 00:54:17 +0100)
Subject: Re: 1.17 -> 1.18 patches
Hi Stephan,
> Does anybody have the 1.17 -> 1.18 changes available in a non-macintosh
> format? I'd be very glad to receive them to be able to build a 1.18 unix
> version of squeak I'd like to share then. Thanks.
I've made my "quick and dirty" port of 1.18 for Unix/Linux available by FTP
from alix.inria.fr in the directory pub/squeak/unix/Squeak-1.18. It contains
the following:
image/Squeak1.18.image - the 1.18 image
image/Squeak1.18.changes - the 1.18 changes
src/* - my initial port of 1.18
It works for me on my IPX at home -- although I've not tested the VM very
thoroughly, and the port isn't "tidied up" *at all* yet. I will hopefully
get the chance to finish the job properly next week.
I had to make the "byte swap" modification to InterpTestInline.c by hand (the
problem with the order of fgetc() in getLongFromFileSwapped()).
Sorry, no precompiled VMs at the moment!
I hope this helps!
Regards,
Ian
------------------------------- projet SOR -------------------------------
Ian Piumarta, INRIA Rocquencourt, Internet: Ian.Piumarta@inria.fr
BP105, 78153 Le Chesnay Cedex, FRANCE Voice: +33 1 39 63 52 87
----------------------- Systemes a Objets Repartis -----------------------
Date: 97 Jan 18 4:45:20 pm
From: Ian Piumarta <piumarta@prof.inria.fr>
To: squeak@create.ucsb.edu
Subject: 1.18 for Unix
Squeakers,
I've made an initial port of 1.18 for Unix. I've not tested it much yet, but
it seems to work OK for me on my IPX here at home. In particular I have not
even run the VM on an i586 or DEC Alpha -- so I don't know for certain if the
sex-changing code is working properly. You can find it in:
ftp://alix.inria.fr/pub/squeak/unix/Squeak-1.18/
which has the following subdirectories:
image/ - the 1.18 image/changes files
src/ - the VM sources
precompiled/ - precompiled VMs for
Sparc, SunOS 4.1
Sparc, Solaris 2.5
DEC Alpha, OSF/1 3.0
i586, Linux 1.2
I'm making this available mainly so that I can get early feedback about
problems, etc. This version includes Stefan's modifications to the
modifierMap which make the keyboard accelerators work better (for example:
ALT-p does "print-it"; "copy" and "paste" are on ALT-c and ALT-v; and the
user interrupt key is now ALT-. by default [it's defined in the image]
instead of hard-wired as C-c). I have *not* put in Stefan's code for cursor
(or other) keys: I'm waiting for him to finish his improvements before I make
a "consolidated" release.
Regards,
Ian
------------------------------- projet SOR -------------------------------
Ian Piumarta, INRIA Rocquencourt, Internet: Ian.Piumarta@inria.fr
BP105, 78153 Le Chesnay Cedex, FRANCE Voice: +33 1 39 63 52 87
----------------------- Systemes a Objets Repartis -----------------------
Date: 97 Jan 19 6:00:01 am
From: Ian Piumarta <piumarta@prof.inria.fr>
To: squeak@create.ucsb.edu
Subject: 1.18 for Unix
I have added and extended Stefan's support for cursor and editing keys,
although I'm waiting for that list of Mac keycodes for PgUp, PgDown, Home,
End, Begin before these keys can be made to work for Unix platforms.
On Sun platforms with type-3 or type-4 (and probably type-5 too) keyboards,
the following additional keys have been enabled:
KEY LABEL GENERATES ACTION (from Button-2 menu)
--- ----- --------- ------
L1 Stop ALT+'.' <user-interrupt>
L2 Again ALT+'j' do again
L4 Undo ALT+'z' undo
L6 Copy ALT+'c' copy
L8 Paste ALT+'v' paste
L9 Find ALT+'f' find...
L10 Cut ALT+'x' cut
I've also fixed a problem in the file handling which was around since the 1.13
version, which failed to handle symbolic links to nonexistent files properly.
New versions of the sources and precompiled VMs for the usual 4 platforms to
which I have access are available in the usual place. Enjoy!
Ian
------------------------------- projet SOR -------------------------------
Ian Piumarta, INRIA Rocquencourt, Internet: Ian.Piumarta@inria.fr
BP105, 78153 Le Chesnay Cedex, FRANCE Voice: +33 1 39 63 52 87
----------------------- Systemes a Objets Repartis -----------------------
Date: 97 Jan 19 7:35:17 am
From: Stefan Matthias Aust <sma@kiel.netsurf.de>
To: squeak@create.ucsb.edu
Hi!
Because of the annoying number of warning (at least the GNU) C
compiler will emit when compiling the Squeak VM, I changed Squeak's
translator to declare functions without explicit returns as void. This
greatly reduces the number of warning, but also introduces new errors.
A number of methods have both an explicit ^nil and an implicit
^self. Most of them (probably all) are used as procedures, ignoring
the returned nil. Before I now go and change these smalltalk methods
to use an explicit ^self instead of ^nil, I would like ask whether
there's a reason why it's done as it is done.
I take ^self as simple return statement which can be used inside a
void function.
The jump method, on the other hand, is correctly declared as void but
wrongly used as return argument in other methods just to say
.... ifTrue: [^self jump: ....]
instead of
.... ifTrue: [self jump: ... . ^self]
By the way, the methods popFloat, primitiveSnappshot and
scanCharacters seems to use uninitialized variables in (some rare)
error conditions. A couple of other functions are warned by the C
compiler, too, but they are save -- it's only the C compiler which
isn't smart enough.
And yes, the declaration of ioMSecs is missing in sq.h. It's trivial but
I'd like to come to the point, where GNU C compiles without warnings
while in "-pedantic" mode.
Another note. There's a comment about an error in file positioning in
TStmtList> endsWithCloseBracket:, which seems to be obsolete in 1.18
?! It seems to me, that this Method
| ch pos |
(pos _ aStream position) > 0 ifTrue: [
aStream position: pos - 1.
ch _ aStream next.
aStream position: pos.
].
^ ch = $}
could be shortened to
^aStream isEmpty
ifTrue: [false]
ifFalse: [(aStream skip: -1) next = $}]
which also hasn't the problem of possibly accessing the uninitialized
variable "ch". It's no error here, but it's ugly IMHO.
I had eventually included the source of my changes to the system, if
not just in this method the system had core-dumped because I tried to
restart a "No space for composing (or sort of)" exceptions which was
raised because I missclicked a "class" button and resized a subview to
some negative size instead. @#*!$ Next time then...
bye
PS: Squeak's VariableNode>isSelfPsuedoVariable method seems to contain
a spelling error :-)
--
Stefan Matthias Aust // Too much truth is unhealthy...
http://www.kiel.netsurf.de/users/s/sma/
Date: 97 Jan 19 9:51:11 am
From: Dan Ingalls <DanI@wdi.disney.com>
To: Ian Piumarta <piumarta@prof.inria.fr>
Cc: Squeak@create.ucsb.edu
In-Reply-To: <199701191408.PAA23884@prof.inria.fr>
Subject: Mac key codes [Re: 1.18 for Unix]
>I have added and extended Stefan's support for cursor and editing keys,
>although I'm waiting for that list of Mac keycodes for PgUp, PgDown, Home,
>End, Begin before these keys can be made to work for Unix platforms.
5 1 11
ins home pgUp
127 4 12
del end pgDn
- Dan
Date: 97 Jan 19 10:17:22 am
From: kgarrels@rhein-neckar.netsurf.de (Kai Garrels)
To: Squeak@create.ucsb.edu
Subject: What is Forms Editor?
Can somebody enlighten me on the forms editos of squeak?
I cannot find any docs on it...
Bye,
kai
--
Kai Garrels
Mannheim
Germany
Date: 97 Jan 19 12:30:07 pm
From: Ian Piumarta <piumarta@prof.inria.fr>
To: Squeak@create.ucsb.edu
In-Reply-To: <v03007800af0811911d10@[206.16.10.79]> (message from Dan Ingalls
on Sun, 19 Jan 1997 10:01:59 -0800)
Subject: Re: Mac key codes [Re: 1.18 for Unix]
Thanks, Dan.
The sources and precompiled 1.18 VMs on alix.inria.fr should now generate the
following keys correctly:
'X' keysym Mac code generated
---------- ------------------
Home 1
End 4
Insert 5
Prior (page up) 11
Next (page down) 12
Left 28
Right 29
Up 30
Down 31
and for the benefit of Sun keyboards, the following "aliases":
R7 (home) 1
R13 (end) 4
R9 (page up) 11
R15 (page down) 12
L1 (stop) ALT+'.'
L2 (again) ALT+'j'
L4 (undo) ALT+'z'
L6 (copy) ALT+'c'
L8 (paste) ALT+'v'
L9 (find) ALT+'f'
L10 (cut) ALT+'x'
(Note that the Sun keys L1, L2, ..., L10 are often available on other
platforms as F11, F12, ..., F20, and should work as advertised above if you
have those function keys on your keyboard; i.e. F11="user interrupt",
F20="cut", and so on.)
I hope the above "mappings" are acceptable to everyone. (For the occasional
"very weird" keyboard it is always possible to use xmodmap to create
arbitrary mappings between keycodes [the ID of the physical key on the
keyboard] and the keysyms [the symbolic name of the key, as reported in the
KeyEvent] which they generate.)
This is probably the last change I'll make to the 1.18 port for a while:
consider this version relatively "stable" (unless ,of course, any major
problems come to my notice).
Ian
------------------------------- projet SOR -------------------------------
Ian Piumarta, INRIA Rocquencourt, Internet: Ian.Piumarta@inria.fr
BP105, 78153 Le Chesnay Cedex, FRANCE Voice: +33 1 39 63 52 87
----------------------- Systemes a Objets Repartis -----------------------
Date: 97 Jan 19 12:30:41 pm
From: Tim Rowledge <tim@sumeru.stanford.edu>
To: Stefan Matthias Aust <sma@kiel.netsurf.de>
Cc: Squeak mailinglist <squeak@create.ucsb.edu>
In-Reply-To: <1.5.4.32.19970119154324.006a4bec@kiel.netsurf.de>
Subject: Re:
On Sun 19 Jan, Stefan Matthias Aust wrote:
> Hi!
>
> Because of the annoying number of warning (at least the GNU) C
> compiler will emit when compiling the Squeak VM, I changed Squeak's
> translator to declare functions without explicit returns as void. This
> greatly reduces the number of warning, but also introduces new errors.
>
D'accord - I get over 700 warnings from the Acorn compiler from Interp.c; mainly about narrowing context and so on, the odd bleat about pointer worries. It would be nice to get rid of them so that any real problems stand out more obviousl
y!
> And yes, the declaration of ioMSecs is missing in sq.h. It's
trivial but
> I'd like to come to the point, where GNU C compiles without warnings
> while in "-pedantic" mode.
Hmm. In my copy of sq.h, ioMSecs is #defined asa macro.
--
Tim Rowledge tim@sumeru.stanford.edu http://sumeru.stanford.edu/tim
Date: 97 Jan 19 3:56:13 pm
From: Paul Fernhout <kfsoft@netins.net>
To: Squeak@create.ucsb.edu
Cc: spohrer <spohrer@taurus.apple.com>
Subject: Newton Squeak: Memory Issues
I have been exploring the issue of how much free RAM the MP130 has, and
whether this is enough to run Squeak.
The best reference I have found on MP130 memory is from js12@gte.com
(John Schettino) posted on comp.sys.newton.misc:
> One thing to keep in mind is that
> there are *two* heaps in the Newton -
> frames heap (about 190kb on 130/2k)
> and System Heap (400+kb on the 130/2k)
> - The system heap (or C heap) is used
> for things like audio, speech, and
> the NIE, and is the real limiting
> factor on the 120 for the NIE. Frames
> heap is used for run-time variables -
> like the stack in a desktop
> computer, C heap is for HWR and
> double-buffering of VBOs - VBOs are
> virtual binary objects and are used
> for comms and audio - the 120 had only
> about 120kb of system memory free,
> and the 130/2k has over 350kb.
I still don't think this accounts for all of the extra 560K the MP130 is
supposed to have (since 70k more frames heap + 230K more C heap) = 300K.
So where is the extra 240K? I haven't been able to get a straight
answer so far by searching Apple's online or web documentation. Maybe I
just haven't been looking in the right places...
So the best information I have so far is that on the MP130 there will at
best be about 150K frames heap free + 350K C heap free = 500K total
available heap free.
Unfortunately, it appears the eMate and MP2000 will have the same
limited amount of system memory (and possibly even less). Speculations
on comp.sys.newton.misc put it a year off until Apple ships MP2000s with
more system memory (so they could run Java). The Newton may be only one
part number away from greatness (the part number for a 1MB DRAM chip vs.
a 4MB DRAM chip for system RAM). The situation may come from a marketing
orientation that a small heap is good enough for small applications for
a small computer at a slightly smaller price. So, until Apple changes
its Newton marketing strategy, anybody know how to solder more DRAM into
a Newton? :-)
All is not lost however. John Maloney says he knows of a RAM/ROM
partitioning scheme which might require under 500K free dynamic RAM,
with the rest of the image in Read-only FLASH Ram. So, based on the
above, it may be just barely possible to squeeze Squeak into RAM, but it
will be very tight and will require cutting down the NewtonScript heap
size to a bare minimum (if that is possible) and somehow reallocating
that memory to the C heap.
Will a Squeak this small, pushing the limits of the Newton be good
enough to use for anything? I don't know. Actually, I am beginning to
doubt it - given that any software on top of Squeak will also require
more heap. It is possible if your application didn't have many dynamic
objects, it might be OK.
Unless a better solution is found for dealing with this limited memory
situation, as far as using Squeak as the base for a commercial Newton
product in the next year (which is what I want to do with it - to make
educational simulations and games), given these constraints, one would
be better off writing Newton programs in NewtonScript, at least until
the 4MB DRAM Newton comes along. Of course, by that time, there will
be so many people with MessagePads that can't run Squeak (like everyone
who buys a MP2000 or eMate this year) that only a fraction of all people
with MessagePads could run such a product. :-(
So, here are a few the possibilites to deal with this situation:
* Forge ahead, acquire the C compiler, and try to squeeze the Squeak VM
+ volatile image objects into the Newton frame and C heaps, aware of the
fact that there may not be enough memory left to do anything interesting
with the result.
* Figure out a way to have the Squeak use FLASH or a Static RAM (SRAM)
card for its objects (probably slow given the OS, although maybe one
could hack around that bottleneck). Note that the NewtonOS puts a 64K
(ick!) limitation on soup entries (32K if they are on a SRAM card). I
haven't yet figured out how big a NewtonScript binary object can be, but
those allow direct byte manipulation of a large byte array.
* If changing objects outside of system RAM is slow, put new or recently
changed objects in System RAM and move older unchanging objects to a
SRAM card (thanks to John Maloney for suggesting a Static RAM card
instead of a FLASH Ram card).
* Solder more DRAM into the Newton. See
http://ourworld.compuserve.com/homepages/Oharms/install.htm
for a company that installs a clock speed up board into the Newton.
This page has pictures of the Newton interior.
Unfortunately, this approach would mean Squeak would only run on
customized MessagePads with voided warranties...
* Rework the VM to be as small as possible by taking advantage of
NewtonScript benefits (garbage collection, method dispatching), possibly
by rewriting it in NewtonScript. This still requires putting dynamic
objects somewhere.
* As Jecel suggested, have Squeak replace the Newton OS entirely and use
all the system RAM.
* Buy a 486 PCMCIA card and stick it in the Newton running Squeak as its
own OS (or on top of QNX or such)).
I will be learning more about getting the Newton manipulate objects
outside of System memory as I continue work on the Squeak browser
prototype in NewtonScript. Hopefully, all my memory limitation concerns
will prove unfounded. The Squeak 1.16 VM program by itself is 131K when
compiled for a 68000 architecture on a Mac here. I assume RISC code for
the ARM will expand that size by some. If objects outside of System RAM
can be speedily manipulated using C, and the PCMCIA interface doesn't
slow down SRAM card memory accesses too much, the Squeak image can be on
a SRAM card with only the interpreter in the C heap, and the Newton will
run an excellent and unbounded Squeak.
-Paul Fernhout
kfsoft@netins.net
http://www.gardenwithinsight.com
Date: 97 Jan 19 8:28:59 pm
From: Jecel Assumpcao Jr <jecel@lsi.usp.br>
To: Squeak@create.ucsb.edu
Subject: Re: Newton Squeak: Memory Issues
The prospects for a Newton Squeak don't look too
good. Do those new Windows CE machines have more
free memory?
Can't gcc be used to compile Squeak for the Newton?
I know it wouldn't be trivial to write the necessary
libraries.
I got a version of gcc from Cambrige that has been
adapted to the ARM (more so than the normal gcc
distribution, that is). It seems to work, though
I haven't really tested it as a lot of things have
kept me from working on the port to my prototype
these last few weeks.
-- Jecel
Date: 97 Jan 19 9:22:37 pm
From: Tim Rowledge <tim@sumeru.stanford.edu>
To: Paul Fernhout <kfsoft@netins.net>
Cc: Squeak mailinglist <Squeak@create.ucsb.edu>
In-Reply-To: <32E2B771.1FE3@netins.net>
Subject: Re: Newton Squeak: Memory Issues
On Mon 20 Jan, Paul Fernhout wrote:
The Squeak 1.16 VM program by itself is 131K when
> compiled for a 68000 architecture on a Mac here. I assume RISC code for
> the ARM will expand that size by some.
Paul, the vm for my Acorn Squeak is 130kb. You'd be amazed how space efficient the ARM is given the chance. If this is a really serious issue, it might be worth investigating the Thumb architecture, a 16bit capable extension to ARMv3 (bas
ically, it can accept 16bit instructions which are expanded to the normal 32bit one as part of the decode pipeline, see <http://www.arm.com>) although of course this is something of a hardware change. I'm surprised that Apple seem to hav
e missed it!
--
Tim Rowledge tim@sumeru.stanford.edu http://sumeru.stanford.edu/tim
Date: 97 Jan 19 9:22:44 pm
From: Tim Rowledge <tim@sumeru.stanford.edu>
To: Jecel Assumpcao Jr <jecel@lsi.usp.br>
Cc: Squeak mailinglist <Squeak@create.ucsb.edu>
In-Reply-To: <32E2F54F.1C978039@lsi.usp.br>
Subject: Re: Newton Squeak: Memory Issues
On Mon 20 Jan, Jecel Assumpcao Jr wrote:
> The prospects for a Newton Squeak don't look too
> good. Do those new Windows CE machines have more
> free memory?
surely they have 640Kb ;-)
>
> Can't gcc be used to compile Squeak for the Newton?
I'm sure it could; it's a good compiler.
I'm fairly sure the best bet would be to completely take over the
machine and gain complete control over the h/w. It sounds like the
only way to get enough of the memory. Of course, you lose a lot as
well, but that's the nature of the beast. A 'proof of concept' of
this whole thing was done years ago at Active Book in Cambridge,UK.
We had a machine with 1Mb ROM, 1Mb RAM, had Helios, Smalltalk and a
ram filing system to fit into it and a 8MHz ARM2as to power it. It
worked quite nicely, and performance was not any noticable problem.
It was certainly faster than the GO machine, the early Newts or those
'orrible GeoWorks based machines that came out about then.
All we need is a basic hardware, 2-4Mb ram, modest screen (mono would
do), TWO slots (one is never the right number), and a cell modem. To
be honest it should be possible to fit that in less area than the
display covers without much trouble. You could probably make it
little larger than a PiLot organiser thingy; the StrongARM is about
15mm sq, 1 RAM chip, 1 ROM chip, 1 FPGA, 2 pcmcia card slots, etc
etc. Easy (especially if you say it quickly!)
--
Tim Rowledge tim@sumeru.stanford.edu http://sumeru.stanford.edu/tim
Date: 97 Jan 20 8:30:13 pm
From: Paul Fernhout <kfsoft@netins.net>
To: Jecel Assumpcao Jr <jecel@lsi.usp.br>
Cc: Squeak@create.ucsb.edu
Subject: Re: Newton Squeak: Memory Issues
Jecel Assumpcao Jr wrote:
>
> The prospects for a Newton Squeak don't look too
> good.
I wouldn't count the Newton port out quite yet...
I spoke with a friend knowledgeable in PCMCIA, FLASH, DRAM, and
SRAM (although not specifically with the Newton).
He told me:
* Yes, one can run your code out of FLASH, but probably 2 or 3 X
slower than DRAM (so the interpreter could be in FLASH).
Of course this assumes the OS lets you jump to an address in FLASH.
He said technically FLASH isn't RAM, it is EEPROM (electrically
eraseable programable read only memory) or sometimes called PEROM.
* Yes, one can maintain a large byte array in FLASH, but you need to
write blocks of memory at a time (probably 16K or 64K on Intel FLASH,
smaller blocks for other vendors). This would make updating memory
one byte at a time seem slow, since one needs to first copy the
entire block, change one byte, and write it out again.
The 100,000 write limitation on FLASH would apply. So it would be best
to not update the image dynamically in FLASH. However, one certainly
could reference long term objects (symbols, compiled code, some strings)
in FLASH and occasionally update them. (One might also try some fancy
footwork with the ARM MMU to shadow changing FLASH in DRAM pages, sort
of like disk based virtual memory).
* Yes, one can memory map an SRAM PCMCIA card into the ARM address
space, but one may need to have access to the card & socket services
layers of the PCMCIA controller driver to use this effectively. One may
only be able to do so through a 32K window (given what Apple mentions as
a limit for SRAM soup entry size). This would mean one would need to
keep moving this window around as you updated the image in memory. It
might be possible to have more than one memory window open at once
depending on the controller hardware and software. The memory in this
window could be accessed at near DRAM speeds (at best 100ns minimum
PCMCIA refresh vs 60ns for DRAM). This assumes well written PCMCIA BIOS
code that set up the memory mapping and then gets out of the way.
This also assumes a fairly standard ARM implementation (with MMU).
So, all this means that conceivably, the Squeak port would require
nearly no heap at all, but would be slow. Possibly, one might even be
able to turn even a MP100 into a Squeak machine this way. The
intrepreter code could be run out of FLASH at a 2-3X speed penalty.
It would probably need to talk directly to PCMCIA card and socket
services, moving a 32K window around in an SRAM card. The VM code would
have to be modified to handle moving this 32K window as needed whenever
it attempted to store data. Since memory access is localized in a few
macros in Squeak, this doesn't sound too hard - although there would be
a performance drag. Alternatively, having the VM in the C heap would
give a 2-3X speed increase, and the image could still be in SRAM.
Of course, my friend did say that having more DRAM on board the Newton
would make the whole thing easier and faster, by avoiding manipulating
this memory window into PCMCIA hosted SRAM. Since he hasn't worked with
the Newton, there may be Apple specific things affecting this whole
process he is not aware of. All these figures were off the top of his
head, and potentially misunderstood by me, so if anyone sees anything
blatantly wrong with any of this, feel free to chime in.
It has occured to me that if one can get Squeak to work on the Newton,
perhaps Apple could adopt a similar approach to getting Java on the
Newton. Maybe that should perk up somebody's ears...
I have also been wondering how much DRAM the handwriting recognition
takes up, and if that is a lot, perhaps one could dump that code and
reclaim the space for Squeak, using an on screen keyboard or Graffiti
for character input instead.
> Do those new Windows CE machines have more free memory?
To answer your questions, for example, the Casiopiea has
2MB DRAM in the standard configuration;
4MB DRAM total is available for $100 more.
The OS takes up part of that initial 2MB (I assume 1MB
from some references I've heard to reliving the early years..).
So Squeak should have plenty of room in the 4MB version.
But then, you would have to WinCE when you used it. :-)
I'd rather have Squeak on the MP130 - it has better backlighting
than the Casiopiea and I like not having a keyboard in the way.
Plus I would expect the upcoming MP2000 to have much better performance.
> Can't gcc be used to compile Squeak for the Newton?
> I know it wouldn't be trivial to write the necessary
> libraries.
The big issue is knowing how to call the Newton OS services
for talking to the screen, receiving pen gestures,
and dealing with the sound card, PCMCIA storage, and so on.
Apple has a C compiler for the Newton and has publicly said
it will release it; it's just a matter of when (hopefully in
a month or two.) The issue then is, does the C compiler come
with enough information or a library to talk to PCMCIA card & socket
services to manage moving around that SRAM memory window?
So to summarize, the best approach I see so far is to obtain the C
compiler from Apple, acquire a 1MB or 2MB SRAM card, keep the image
entirely in SRAM, and keep the interpreter in C heap on a MP130 or
onboard FLASH on the earlier MP120, 110, 100 or OMP. The Newton should
be able to run Squeak this way if there is nothing unusual about the
PCMCIA implementation. I am not sure how much the overhead of moving the
memory window will decrease performance. Any guesses on this overhead
from people familiar with PCMCIA on the Newton would be appreciated.
-Paul Fernhout
kfsoft@netins.net
http://www.gardenwithinsight.com
Date: 97 Jan 21 12:21:31 pm
From: Stefan Matthias Aust <sma@kiel.netsurf.de>
To: Squeak@create.ucsb.edu
Subject: Re: Mac key codes [Re: 1.18 for Unix]
> 5 1 11
> ins home pgUp
>
> 127 4 12
> del end pgDn
Just to be sure: Do I understand this right, that home has the same key code
as normally returned by Ctrl+A (^A), end=^D, ins=^E, pgUp=^K and pgDown=^L.
Is there any chance to distinguish between control keys and the function keys?
bye
--
Stefan Matthias Aust // Too much truth is unhealthy...
http://www.kiel.netsurf.de/users/s/sma/
Date: 97 Jan 21 12:32:37 pm
From: Dan Ingalls <DanI@wdi.disney.com>
To: kgarrels@rhein-neckar.netsurf.de (Kai Garrels)
Cc: Squeak@create.ucsb.edu
In-Reply-To: <1997011919261786284@r45.rhein-neckar.netsurf.de>
Subject: Re: What is Forms Editor?
>Can somebody enlighten me on the forms editos of squeak?
I'm assuming we're talking about the FormEditor
>I cannot find any docs on it...
Correct; there are none to speak of.
The FormEditor was a precursor to MacPaint done by Bob Flegal and Bill=
Bowman way back when. It was a part of the ST-80 release designed to show=
off BitBlt. Nowadays, after MacPaint, and many more sophisticated systems,=
it is rather weak by comparison. Also, it was hacked into MVC by folks who=
were more after artistic effect than programming elegance, so it is a bit m=
essy.
Be this as it may, I couldn't bring myself to remove it from Squeak, nor=
could I abstain from allowing it to function in color. So I added more=
sins of hackery by merely bashing it into operation in color.
That's what it is, and why it is such a mess. I'm glad you asked about it. =
I WOULD LOVE IT if someone would take a pass over the Form Editor (and=
BitEditor) to clean them up and make them generally useful.
You can tell a bit about the controls from FormMenuView initialize which=
lists names of button icons in raster order. Here is a brief comment about=
each from what I can remember...
Top line...
select select a part of the working image to become the new brush shape
the five "tools":
singlecopy apply the brush each time the mouse is clicked
repeatcopy apply the brush repeatedly while the mouse is down
line draw a straight line, applying the brush at each pixel
curve draw a curve, applying the brush at each pixel
block drag out a rectangle, and apply the current color throughout
the five "modes":
over apply brush and or color using BitBlt's "over" rule
under same, with "under"
reverse same, with "reverse"
erase same, with "erase"
brush I/O
in read a form file in from the disk
it replaces the brush, not the working form!!
Use option menu file out to store the working form
Second line...
magnify Select a part of the working form to edit in a magnified view.
the five "colors":
white These are halftones when working in B/W
lightgray When working in color, though, I think I hacked it so that
gray no matter what button you push, you get a color chooser
darkgray spalshed acroos the top of the screen. =20
black This needs to be fixed!
gridding:
xgrid set x-gridding module
ygrid set y-gridding module
togglegrids turn gridding on/off
brush I/O
out write the current brush out as a Form
I can perhaps be of further assistance, if anyone would be interested in=
taking on this task.
- Dan
Date: 97 Jan 21 1:58:09 pm
From: Maloney <johnm@wdi.disney.com>
To: Stefan Matthias Aust <sma@kiel.netsurf.de>
Cc: Squeak@create.ucsb.edu
In-Reply-To: <1.5.4.32.19970121202936.006aaf90@kiel.netsurf.de>
Subject: Re: Mac key codes [Re: 1.18 for Unix]
>> 5 1 11
>> ins home pgUp
>>
>> 127 4 12
>> del end pgDn
>
>Just to be sure: Do I understand this right, that home has the same key code
>as normally returned by Ctrl+A (^A), end=^D, ins=^E, pgUp=^K and pgDown=^L.
>Is there any chance to distinguish between control keys and the function keys?
Yes, you can tell the difference by looking at the state of the control
key. That is, if the character's value is 1 but the control key is not
down, the keystroke must have come from a function key.
Right now, you have to ask the sensor for the modifier bits. But
we are planning to make the VM report user inputs as events, which will
capture both the key value and the state of the modifier keys.
-- John
Date: 97 Jan 22 11:01:38 am
From: guzdial@cc.gatech.edu (Mark Guzdial)
To: Dan Ingalls <DanI@wdi.disney.com>
Cc: Squeak@create.ucsb.edu
Subject: Re: What is Forms Editor?
At 12:43 PM 1/21/97, Dan Ingalls wrote:
>>Can somebody enlighten me on the forms editos of squeak?
>
>I'm assuming we're talking about the FormEditor
>
>>I cannot find any docs on it...
>
>Correct; there are none to speak of.
The Forms Editor and BitEditor are documented for at least a few pages in
"Smalltalk-80: The Interactive Programming Environment." That's how I got
started with it.
Mark
--------------------------
Mark Guzdial : Georgia Tech : College of Computing : Atlanta, GA 30332-0280
(404) 894-5618 : Fax (404) 894-0673 : guzdial@cc.gatech.edu
http://www.cc.gatech.edu/gvu/people/Faculty/Mark.Guzdial.html
Date: 97 Jan 22 5:35:33 pm
From: stp (Stephen Travis Pope)
To: squeak@create.ucsb.edu
Subject: This is a test; ignore it
test
stp
_Stephen Travis Pope, Center for Research in Electronic Art Technology
_(CREATE), Dept. of Music, U. of California, Santa Barbara (UCSB)
_Editor, Computer Music Journal (CMJ), MIT Press
_stp@create.ucsb.edu http://www.create.ucsb.edu/~stp/
Date: 97 Jan 22 6:10:18 pm
From: Randal Schwartz <merlyn@stonehenge.com>
To: Squeak@create.ucsb.edu
Subject: missing sources in 1.18?
I have *twice* downloaded the .sit.hqx from the archive for 1.18,
but to no avail... it seems that the "sources" are not in the archive.
Are they hiding somewhere else? Am I stupid for not knowing how to
fetch this? :-)
The 1.14 sources were *in* the 1.14 .sit.hqx, if I recall.
--
Name: Randal L. Schwartz / Stonehenge Consulting Services (503)777-0095
Keywords: Perl training, UNIX[tm] consulting, video production, skiing, flying
Email: <merlyn@stonehenge.com> Snail: (Call) PGP-Key: (finger merlyn@ora.com)
Web: <A HREF="http://www.stonehenge.com/merlyn/">My Home Page!</A>
Quote: "I'm telling you, if I could have five lines in my .sig, I would!" -- me
Date: 97 Jan 23 8:50:01 am
From: Ian Piumarta <piumarta@prof.inria.fr>
To: Squeak@create.ucsb.edu
Subject: 1.18 under Linux and DEC OSF/1
Oops, sorry. I just got round to testing the above VMs. It seems that I
neglected to arrange for the word order of Floats to be reversed in the
relevant places. I've fixed the sources (a couple of #defines in
sqUnixConfig.h) and replaced the precompiled VMs for DEC and Linux with
versions that work.
If you took a copy of 1.18 for DEC and/or Linux, and were rewarded with
either a segmentation fault (DEC) or a Pi which claimed to be 0.0e97
(Linux), then you might like to take a fresh copy. ;^)
Apologies again!
Ian
------------------------------- projet SOR -------------------------------
Ian Piumarta, INRIA Rocquencourt, Internet: Ian.Piumarta@inria.fr
BP105, 78153 Le Chesnay Cedex, FRANCE Voice: +33 1 39 63 52 87
----------------------- Systemes a Objets Repartis -----------------------
Date: 97 Jan 23 2:34:05 pm
From: Stefan Matthias Aust <sma@kiel.netsurf.de>
To: squeak@create.ucsb.edu
Subject: Changes to C-Translator
Hi!
I've finally modified the C translator and the Smalltalk sources of
Interpreter, ObjectMemory and BitBitSimulation to compile itself
without any warning (or error) with GCC in mode "-O3 -Wall -pedantic".
I reorganized and modified the C translator. I changed a lot of "^nil"
into "^self" which is compiled as "return;" now. I also introduced some
more returns and some initializations to local variables where the
compiler couldn't proof that the code was already correct. However, I
found the following problems:
Interpreter>primitiveSnapshot is questionable.
Assuming that successFlag is false when it's first tested, then it's
of course still false when tested the second time and so the contents
of the uninitialized variable rcvr (nil in Smalltalk, undefined in
compiled C) is pushed onto the stack. I don't understand why this
method is implemented as it is and so I can only assume that it's okay
to initialize rcvr explicitly to nil.
BitBltSimulation>scanCharacters is questionable.
Here left and top are only initialized when scanDisplayFlag is
true. However, they are accessed in any case at as long as lastIndex
<= scanStop which seems totaly unrelated to scanDisplayFlag. I'll
assume that it's okay to initialize both variables in any case.
Because the changes have a size of 62K, I won't include them in this
email. If anybody is interested in this work, I'd be happy to send it
to him or her in a private email.
bye
--
Stefan Matthias Aust // Too much truth is unhealthy...
http://www.kiel.netsurf.de/users/s/sma/
Date: 97 Jan 23 3:47:50 pm
From: stp (Stephen Travis Pope)
To: squeak@create.ucsb.edu
In-Reply-To: Randal Schwartz <merlyn@stonehenge.com>'s letter of: 97 Jan 22
Subject: Re: missing sources in 1.18?
In the interest of saving space (and your up-load time), the sources file is
not included in all releases. It is the same for all releases to date, and is
stored in,
ftp://ftp.create.ucsb.edu/pub/Smalltalk/Squeak/SqueakV1.sources
Sorrry for the confusion.
stp
_Stephen Travis Pope, Center for Research in Electronic Art Technology
_(CREATE), Dept. of Music, U. of California, Santa Barbara (UCSB)
_Editor, Computer Music Journal (CMJ), MIT Press
_stp@create.ucsb.edu http://www.create.ucsb.edu/~stp/
Date: 97 Jan 23 4:05:04 pm
From: Tim Rowledge <rowledge@interval.com>
To: Squeak mailinglist <squeak@create.ucsb.edu>
Subject: LittleEndian BitBlt bug
Somehow the filein for my LEBB stuff went out without a ^ in the
#sourcePixAtX:y:pixPerWord:, resulting in some oddness with some
WarpBlts.
An updated version is going onto http://sumeru.stanford.
edu/tim/SqFiles/STChanges/LEBitBlt just as quick as I can get it
there.
The FileDir changefile is also updated to include a small change to
SystemDictionary>saveAs that allows the Acorn's demented file system
to cope with saving the image under a new name.
--
Tim Rowledge tim@sumeru.stanford.edu http://sumeru.stanford.edu/tim
Date: 97 Jan 24 5:44:59 am
From: Hans-Martin Mosner <hmm@heeg.de>
To: squeak@create.ucsb.edu
Cc: hmm@heeg.de
Subject: Creating Squeak standalone executables on the Mac
Hello Squeakers,
last night I succeeded in creating a Squeak VM shared
library and a calling stub that can be just put into the
data fork of a Squeak image on a Power Macintosh.
If you'd like to try this out, look at the page
http://www.heeg.de/~hmm/squeak/StandAlone.html
and tell me what you think of it.
It should be possible and relatively simple for other
environments to have something similar. Self-extracting
archives are a standard on DOS/Windows; their mechanism
should be usable for Squeak, too. Under UNIX, there is
already a solution: The image can have a 512-byte prefix
with a call to a Squeak VM, just like shell and other
scripts have a call to their interpreter in the first
line.
Hans-Martin
Date: 97 Jan 25 1:46:54 pm
From: Dan Ingalls <DanI@wdi.disney.com>
To: Hans-Martin Mosner <hmm@heeg.de>
Cc: Squeak@create.ucsb.edu
In-Reply-To: <32E8BFD0.29E3@heeg.de>
Subject: Re: Creating Squeak standalone executables on the Mac
>Hello Squeakers,
>last night I succeeded in creating a Squeak VM shared=20
>library and a calling stub that can be just put into the=20
>data fork of a Squeak image on a Power Macintosh.
Hans-Martin,
This is really nice! It makes me want to resurrect my "winnowing" code. =
This is a method that throws out all unreferenced classes, then all=
unreferenced methods, then starts over until all unreachable methods are=
gone. In that way executable sizes could be made somewhat smaller.
What would be even nicer, though would be to do a proper type inference=
system, as this would allow much more to be thrown out.
Also I looked at your triangleBits. I like the color wheels. I am curious=
about your plans for 3-D. I would love to see more done in this area. As=
you can see, I planned to put z coordinates into warpBlt so that we could=
come closer to a real perspective transformation. Have you thought at all=
about this?
Keep up the good work!
Date: 97 Jan 27 4:48:50 am
From: Ian Piumarta <piumarta@prof.inria.fr>
To: squeak@create.ucsb.edu
Subject: Hogging the CPU
Squeakers,
Several people (including myself) have noted the anti-social behaviour of
Squeak on multi-user Unix machines. In a spare few minutes, which
unexpectedly landed in my lap this morning, I implemented a command-line
option "-lazy" in the Unix VMs. With this option the VM will "go to sleep"
when the Squeak window is unmapped from the display (i.e. when you iconify
it, or move to another "workspace" ["desktop"] if your window manager
supports several virtual workspaces).
This is working well for me on all the four platforms that I can test it on.
I have updated the sources and precompiled binaries (1.18 only) on
alix.inria.fr.
If anyone thinks that this is A Bad Idea, as an intermin solution while
waiting for the VM to become truly event driven, then please state your case!
Regards,
Ian
------------------------------- projet SOR -------------------------------
Ian Piumarta, INRIA Rocquencourt, Internet: Ian.Piumarta@inria.fr
BP105, 78153 Le Chesnay Cedex, FRANCE Voice: +33 1 39 63 52 87
----------------------- Systemes a Objets Repartis -----------------------
Date: 97 Jan 27 12:15:52 pm
From: stp (Stephen Travis Pope)
To: Ian Piumarta <piumarta@prof.inria.fr>, squeak@create.ucsb.edu
In-Reply-To: Ian Piumarta <piumarta@prof.inria.fr>'s letter of: 97 Jan 27
Subject: Re: Hogging the CPU
> I implemented a command-line
> option "-lazy" in the Unix VMs
Thank you, Ian!
> If anyone thinks that this is A Bad Idea, as an intermin solution while
> waiting for the VM to become truly event driven, then please state your case!
This is a good idea, and much lower impact than the eventual event VM.
stp
_Stephen Travis Pope, Center for Research in Electronic Art Technology
_(CREATE), Dept. of Music, U. of California, Santa Barbara (UCSB)
_Editor, Computer Music Journal (CMJ), MIT Press
_stp@create.ucsb.edu http://www.create.ucsb.edu/~stp/
Date: 97 Jan 28 1:00:34 pm
From: Andreas Raab <raab@isg_nw.cs.Uni-Magdeburg.DE>
To: squeak@create.ucsb.edu
Cc: michael <michael@isg.cs.uni-magdeburg.de.Alexander.Lazarevic>
Subject: Did you know ...
that Squeak comes so close to a commercial system that it has already
a "Squeak-Haters-Page" ???? I just found that some of our students do
not love the system as much as most of us do ...
For those interested (and capable of speaking german) have a look at
http://www-hppool.cs.uni-magdeburg.de/~lazarevi/cv/info/squeakhaters/
However, I like the look of the page and the Squeak icon there ;-))
Bye,
Andreas
--
Linear algebra is your friend - Trigonometry is your enemy.
+===== Andreas Raab ============= (raab@isg.cs.uni-magdeburg.de) =====+
I Department of Simulation and Graphics Phone: +49 391 671 8065 I
I University of Magdeburg, Germany Fax: +49 391 671 1164 I
+=============< http://simsrv.cs.uni-magdeburg.de/~raab >=============+
Date: 97 Jan 28 1:58:17 pm
From: Ian Piumarta <piumarta@prof.inria.fr>
To: raab@isg_nw.cs.Uni-Magdeburg.DE, squeak@create.ucsb.edu
Cc: <michael@isg.cs.uni-magdeburg.de.Alexander.Lazarevic>,
michael@isg_nw.cs.Uni-Magdeburg.DE
Subject: Re: Did you know ...
Very entertaining! And at least two phrases should be no problem,
whatever your native language:
95% der Systemresourcen
and
Die SQUEAK Fuck off Aktion
;-)
BTW: maybe part of the problem is that you should be nourishing your
students on 1.18 rather than 1.13? ;-)
Ian
Date: 97 Jan 28 2:01:25 pm
From: Tim Rowledge <rowledge@interval.com>
To: Andreas Raab <raab@isg_nw.cs.Uni-Magdeburg.DE>
Cc: michael <michael@isg.cs.uni-magdeburg.de.Alexander.Lazarevic>,
Squeak mailinglist <squeak@create.ucsb.edu>
In-Reply-To: <93C912DF2@isg_nw.cs.uni-magdeburg.de>
Subject: Re: Did you know ...
I don't suppose you could translate for us could you? My memories of Deutsch are very faint....
--
Tim Rowledge: rowledge@interval.com (w) +1 (415) 856-7230 (w)
tim@sumeru.stanford.edu (h) <http://sumeru.stanford.edu/tim>
Date: 97 Jan 29 1:31:57 pm
From: Stefan Matthias Aust <sma@kiel.netsurf.de>
To: squeak@create.ucsb.edu
Subject: Re: Did you know ...
>I don't suppose you could translate for us could you? My memories of
Deutsch are very faint....
Here's a very rough translation:
The hole page looks like a Squeak window. The title bar shows "Welcome to
the Squeak Haters Page Version 1.13trash." And then...
Why Squeak has earned this page?
1. Because it consumes 95% of system resources doing nothing.
2. Because cursor keys don't work at all and backspace only on some computers.
3. Because the debugger shows only t1, t2, t3... not the real temporaries.
4. Because to save a Smalltalk program with Squeak you have to
1. create an empty file with the FileList
2. select code in the Workspace
3. copy the code from the Workspace
4. paste it into thhe FileList
5. select emtpy file
6. choose Put from menu
7. confirm overwriting of file
5. Because only Computervisualisten(*) have to use Squeak
[I'm not sure, what (*) means. Perhaps people who work in the field
of visual or graphical computer science.]
Then, there's a call to join Squeak Haters Community and also a logo progam
(like Microsoft or Netscape use to spread their Browsers) that you can
include a like to this page to your home page.
It's quite amusing, and Alexander has designed a cool Squeak-Logo.
bye
--
Stefan Matthias Aust // Too much truth is unhealthy...
http://www.kiel.netsurf.de/users/s/sma/
Date: 97 Jan 29 6:19:28 pm
From: Paul Fernhout <kfsoft@netins.net>
To: squeak@create.ucsb.edu
Subject: Merging Forth and Smalltalk
Here is something I just posted to comp.lang.forth.
Any comments from the Squeak side of the aisle would be appreciated.
Subject: Merging Forth and Smalltalk
Date: Wed, 29 Jan 1997 19:54:32 -0600
From: Paul Fernhout <kfsoft@netins.net>
Organization: Kurtz-Fernhout Software
Newsgroups: comp.lang.forth
Forth is really neat, and Smalltalk is really neat, and I keep thinking,
if I could only put them together somehow...
I know there are OO Forths, but it's the Smalltalk environment I like
the most, followed by Smalltalk's clean syntax and class libraries.
It's Forth's speed and simplicity and incremental development I admire
most. Since the Smalltalk VM is itself a stack based machine, I would
think there might be some interesting fundamental compatability...
Apple has made (almost) freely available a Smalltalk called Squeak which
generates its own VM in C using a Smalltalk to C translator. You can
find out more about Squeak at:
http://www.research.apple.com/research/proj/learning_concepts/squeak/
The only major constraint on its distribution is that you have to make
publically available any ports or changes to the base classes.
Unfortunately, Squeak suffers from fairly slow performance (depending on
what you're doing, somewhere about 1/30 to 1/60 that of compiled C).
I'm interested in using it for numerical simulation, among other things.
Any sort of number crunching in Squeak Smalltalk (like 3D graphics or
waveform manipulation or mathematical modeling) would take a big
performance hit. Once can modify the Squeak source code in C to add
fast primitives, but that is a cumbersome process which requires firing
up a C compiler and so on - so it is not incremental.
What I am thinking about doing is adding Forth to Squeak Smalltalk so I
could use Smalltalk where it shines (for GUI work and prototyping) and
use Forth (or code that compiles to Forth) for writing primitives to
optimize key parts of the system (like number crunching, graphics, IO,
and so on).
Adding Forth to Squeak Smalltalk would give two advantages:
* primitives which are rather tricky to debug and test in C because of
the compile/link/run/debug cycle could be developed incrementally.
So one could develop fast things in Squeak without leaving the system.
* Squeak Smalltalk written in Forth would be much closer to a system
that could run without an OS (such as on a PDA).
The Squeak Smalltalk environment would allow one to develop using Forth
in an environment that supported mostly platform independent graphics
and windowing, and which could provide limited version control and
sophisticated code browsers, debuggers, and inspectors. One would want
to augment these browsers, debuggers, and inspectors to also work with
the Forth code.
Smalltalk's weakness has always been speed and footprint. Forth can help
on the speed side. Squeak has a very small footprint for a Smalltalk
system. Squeak Smalltalk can probably run in about a 1MB footprint
(needing perhaps 400K in RAM if the rest is in ROM or FLASH). Most
other smalltalks need around 8MB to 12MB or more just to get going.
I would like to get Squeak Smalltalk to run on the Newton, and the
Newton is very DRAM limited - about 400K at most free with the OS on a
MP130, or 1MB if I could replace the OS entirely with this
Smalltalk-Forth hybrid. Squeak manages all its windows, menus, and
events internally, so a completley Squeak-Forth OS might not be that
hard to do.
Apple's upcoming MP2000 will use the StrongArm processor and so make a
very nifty handheld development system for Smalltalk and Forth. Up till
now Apple hasn't publically released a C compiler or development tools
for the Newton, but people at Apple has said publically (in
comp.sys.newton.misc) that a C compiler should be available soon.
However, a Squeak-Forth hybrid might be possible to get running on the
Newton even without such tools (although it would be difficult).
Right now I'm still thinking about whether I want to do this, as well as
how to go about it. Any comments on this would be appreciated. In
particular, I am trying to decide what publicly available freeware
Forths might be appropriate for such a Forth-Smalltalk marriage...
I'm looking at Timbre right now (because of the Forth to C translator
and the beauty of its language rule concept). I am not yet sure of the
licensing terms as to whether I could include that in another product.
(No language war flames please... Forth was my first language with
function calls - way back on the Commodore VIC (HES Forth) and I do love
it. I just like Smalltalk too - for many of the same reasons,
self-reflective, extendible, incrementally compiled...)
-Paul Fernhout
kfsoft@netins.net
http://www.gardenwithinsight.com
Date: 97 Jan 30 2:18:39 am
From: Dan Ingalls <DanI@wdi.disney.com>
To: mccullough@interval.com (Paul McCullough)
Cc: Squeak@create.ucsb.edu
In-Reply-To: <v02130503af0d56512cf0@[199.170.108.154]>
Subject: Bug Fix: Retrieving methods that send to super
>Hi Dan,
>
>Did you get my email late last week about super send bytecodes?
>paul
Yes, and I was preoccupied with a number of other things. Thanks for your patient reminder.
>Looks like something went wrong in 1.16 to 1.17.
>
>I have a method which has sixty-one literals -- the last is used by a
>message send. There are no super-sends in the method.
>
>The resulting compiled method in 1.17, when sent the message sendsToSuper,
>says true. Looks like the implementation in CompiledMethod should be:
>
>sendsToSuper
> "Answer whether the receiver sends any message to super."
>
> ^ self scanFor: 16r85
>
>what do you think?
Used to be 16r85 or 16r86, and you are right that this is no longer correct.
However, just 16r85 alone will miss any extended sends to super.
It should now be 16r85 or (16r84 followed by 16r20 through 16r3F).
Try the following (I'll get this into the next release)...
sendsToSuper
"Answer whether the receiver sends any message to super."
| scanner |
scanner _ InstructionStream on: self.
^ scanner scanFor:
[:instr | instr = 16r85 or: [instr = 16r84
and: [scanner followingByte between: 16r20 and: 16r3F]]]
Many thanks
- Dan
Date: 97 Jan 30 9:53:25 am
From: Ward Cunningham <ward@c2.com>
To: Paul Fernhout <kfsoft@netins.net>
Cc: squeak@create.ucsb.edu
Subject: Re: Merging Forth and Smalltalk
Paul -- Both Forth and Smalltalk get great mileage out of a surprising
economy of features. However, I fear that when combined we end up with
less economy, not more. Still, language designers should dig in to both
to try to understand where each gets its spark and borrow where
appropriate. -- Ward
See also
http://c2.com/cgi/wiki?ForthInSmalltalk
http://c2.com/cgi/wiki?SmalltalkInForth
--
Ward Cunningham
v 503-245-5633 mailto:ward@c2.com
f 503-246-5587 http://c2.com/
Date: 97 Jan 30 3:10:07 pm
From: Stefan Matthias Aust <sma@kiel.netsurf.de>
To: squeak@create.ucsb.edu
Subject: Re: Merging Forth and Smalltalk
>Forth is really neat, and Smalltalk is really neat, and I keep thinking,
>if I could only put them together somehow...
>[...] Since the Smalltalk VM is itself a stack based machine, I would
>think there might be some interesting fundamental compatability...
Do you want to create a common development environment where you could
combine both Forth and Smalltalk or do you want to use a VM written in Forth
to archive a better performance? I dug out my old Forth book (from C64
times) and basically, I'd agree that both the Forth kernel and Smalltalk's
VM have a lot of similarities.
>Unfortunately, Squeak suffers from fairly slow performance (depending on
>what you're doing, somewhere about 1/30 to 1/60 that of compiled C).
But because of these similarities (see below) I doubt, you would get a major
speedup using Forth as VM implementation language. Or, to be exact, if you
use a Forth written in C. Using an optimized assembler written Forth, it
might be different. But then, you could also hand code the core of Squeak's
VM and archive probably the same result.
>What I am thinking about doing is adding Forth to Squeak Smalltalk so I
>could use Smalltalk where it shines (for GUI work and prototyping) and
>use Forth (or code that compiles to Forth)
I should be possible to use Forth expressions instead of bytecodes. However,
you have to represent objects somehow and provide a garbage collection
system. This is essential. Browsing through my Forth book, I found no hint
that Forth support either of these natively, so you have to add a memory
managing system on the top of Forth. I can't estimate how complex this would
be. For me, it would be more "natural" to add Squeak to Forth than the other
way around. One has to add everything to Forth needed to run a Smalltalk VM.
Then, one can crosscompile Squeak to this new Forth-code and load it into
the Forth-VM.
>Adding Forth to Squeak Smalltalk would give two advantages: [...]
>So one could develop fast things in Squeak without leaving the system.
However, one probably sacrifies some saftyness here, like array bound
checking or the automatic memory managing system.
>* Squeak Smalltalk written in Forth would be much closer to a system
>that could run without an OS (such as on a PDA).
Could an extended Forth system be much smaller then about 200k of the
current C-written VM? Perhaps, only, if you code the Forth directly in
Assembler.
>Right now I'm still thinking about whether I want to do this, as well as
>how to go about it. Any comments on this would be appreciated. In
>particular, I am trying to decide what publicly available freeware
>Forths might be appropriate for such a Forth-Smalltalk marriage...
It's an interesting idea, I think. Does a Forth system for the Newton or the
ARM processor (wasn't a predecessor used in the Archimedes home computer
long ago) already exist? Or would this be the first part, that had to be
written. What is the size and the extent of a minimal Forth system? If I
remeber correctly, I had a quite comfortable FIG Forth system on my old home
computer with a size of about 20K. Even if we triple this because of 32
instead of 8 bit processors, it would be amaizing small.
I think the Squeak bytecode instruction set is very complicate. A simpler
set is used by Little Smalltalk which still can be interpreted fast (Self
has an even smaller set but also relys on message sending only).
LittleSmalltalk uses the following instructions:
push an instance variable #
because all objects are represented as 32 bit pointers, this
means we have to dup the self reference on the stack, push a
constant which implements the ivar offset inside the object,
add this offset to the pointer and dereference (@) it, pushing
the result on the stack. For example
: PUSHIVAR1 4 SELF @ + @ ;
...
: PUSHIVAR6 24 SELF @ + @ ;
: PUSHIVARN 4 * SELF @ + @ ;
push an method argument #
nearly the same, we have to push the argument's address, push
and add the offset and push the dereferenced word. A pointer
to the arguments vector has to be part of the current context,
which has to be accessible by a Forth primitive.
: PUSHARG3 12 CONTEXT @ @ + @ ;
( arg vector is first word of context )
push a temporary variable #
A vector of all temp vars is also accessible via the current
context and access to the word is very similar.
push a literal #
the current method, accessible via current context, refer to
a literal array, which can be accessed similar. I think 7
instructions should be sufficient.
: PUSHLIT9 36 CONTEXT @ 8 + @ 12 + @ + @ ;
( method is 3rd word in context, litvec 3rd world in method )
push a constant #
this instruction optimizes the "push a literal" instruction,
knowing a handful often used literals (called constants here).
Load constant from user variable and push it onto the stack is
only one Forth instruction.
: PUSHTRUE TRUE @ ;
assign value to instance variable #
The value is at TOS. We have to calculate the ivar address and
store (!) the value.
: ASSIGNIVAR1 4 SELF @ + ! ;
assign temporary #
: ASSIGNTEMP3 12 CONTEXT @ 8 + @ + ! ;
( tempvec is second word of context )
create and push block
As I've no idea how to represent a block closure, I can only name
this instruction which creates and pushes a block closure.
send message #1 with argument count #2
This instruction handles a message send. Receiver and arguments
are already on the stack. The first parameter names the message
name literal, the seconds the number of arguments. The forth code
has to find the matching compiled method, check for a special
treatment like primitive or ^self or ivar access. Otherwise it
has to create a new method context, copy the receiver and arguments,
push a return address, save the current context and invoke the new
method.
: SEND ( arg1 ... argn #args rcvr selector -> result ) ... ;
LittleSmalltalk has two additional optimized sends, but they are only
special cases of the common send and omitted here. Finally, there're a
number of special instructions:
return tos
simply emit ";S", when coding a method outside a block. Inside
a block, it's a little bit more tricky and depends on how we
implement a block context.
return self
is an optimization of "SELF @ ;S" which pushes the receiver onto
the stack and aborts the execution of the current Forth procedure.
block return
if the block's code is a single forth word, this is ";S" again.
duplicate TOS
"dup" in Forth
drop TOS
"drop" in Forth
branch #
branch # if TOS is true
branch # if TOS is false
as these byte codes only appair around embedded block code and
because of optimizing ifTrue:ifFalse: and whileTrue:/whileFalse:
the compiler could emit Forth's equivalents IF/ELSE/ENDIF or
DO/LOOP.
This leaves the problem of implementing a memory management on the top of
Forth. Two words ALLOCPTRS ( class size --- addr ) and ALLOCBYTES ( class
size --- addr ) could be used to allocate memory for pointer and for byte
objects. One could add a simple mark & sweep algorythm which is invoked as
GCMARKNSWEEP if no memory is available. An objects has a header of 2 words,
containing its class and its size plus a small flags field used to
distinguish between ptrs and bytes objects and to mark objects during the
gc. SmallIntegers are represented as object pointers with the first bit set.
As we use a mark&sweep gc which never moves objects, we can use the objects
memory address divided by 4 as identity hash value (otherwise this would be
a candidant for another object header slot).
The Forth system must be capable to implement the needed primitives,
especially file i/o and the display primitives.
Resumee: After this kind of brain storming, I think, it's possible :)
bye
--
Stefan Matthias Aust // Too much truth is unhealthy...
http://www.kiel.netsurf.de/users/s/sma/
Date: 97 Jan 30 3:13:40 pm
From: Paul Fernhout <kfsoft@netins.net>
To: Stephen J Bevan <stephenb@harlequin.co.uk>
Cc: Squeak@create.ucsb.edu
Subject: Re: Merging Forth and Smalltalk
Stephen -
Thanks for your reply to my post on comp.lang.forth.
Stephen J Bevan <stephenb@harlequin.co.uk> wrote in reply to my post:
>>Since the Smalltalk VM is itself a stack based machine, I would
>>think there might be some interesting fundamental compatability...
> Some Smalltalk implementations use a VM, some don't. If you are
> interested in speed, try out one of the Smalltalk implementations that
> compiles to native code rather than a VM.
You are correct; some Smalltalks can compile methods to native code.=20
Actually, I=92ve got such a system sitting on my desk; I use it for
contracting. It is VisualWorks from ParcPlace, which with ENVY and ENVY
Server and DLL & C Connect and Advanced Tools set me back about $9000
(not counting the cost of hardware to run it, and that was with a
discount for upgrading from ObjectWorks.) However, VisualWorks will not
run on a PDA anytime soon, nor is the compiler redistributable without
an expensive license. I don't know about the size of Smalltalk MT,
another Smalltalk with a native compiler, but I believe it's specific to
the 80x86 architecture and tightly coupled to Windows. =20
Right now, this Smalltalk-Forth idea is mostly a hobby in my spare time.
In the future, I would like to make a simulation product which the end
user can modify, and so I am looking for something that can produce fast
numerical code which I could embed in a product for a low cost.=20
Actually, the best thing that fits this need today is probably Lisp
which can both do OO and produce compiled numeric code (as shown by the
Nintendo 64 which uses Lisp for some products), and can be licensed to
include a compiler with a product. It=92s just that I prefer the Smalltal=
k
=93object word:other:another:=94 syntax, and also prefer the Smalltalk
development environment (not to mention being much more familiar with
it, even though ZetaLisp & Flavors was my first major true OO
experience).
I don't mind spending a reasonable amount of money for good software
tools, especially when a paying project will justify them; the trouble
is that most companies don't offer great products for building things
your users can build things with (that run fast and yet are not resource
hogs), and all my work on such projects has generally been speculative
and so I can't justify expensive licenses. That is what is behind my
interest in freely distributable development environments (like variants
of Forth and Smalltalk). =20
Unfortunately, while there are some "free" development systems with
compilers out there (like GCC and so on), they are often under the GNU
public license (CopyLeft) and so can't be tinkered with and legally
embedded in a commercial product you hope to sell (unless you also give
away the source to your derivative product and say others may give your
product away). I guess you could try hard to keep GPL'd software your
product intimately relied on seperate from your content but distribute
it with it (dangerously skirting the licensing issue), but that removes
many advantages of embedding a development environment in your product
(plus putting you into a very questionable legal situation). Thus much
of the "free" software out there is useless to me for licensing
reasons. Apple's Squeak has a different license that allows embedding,
and I believe some Forths do as well.=20
The best deal I know of right now in such an area of shipping the
compiler with your product is with Franz Lisp or Macintosh Common Lisp;
I think WinForth may also make such arrangements. But even in those
cases, you of course can't ship the development environment, so you have
to recreate that for your users one way or another (most likely in some
simplified and idiosyncratic fashion.) So to ship the whole thing
(including a debugger), you must pay royalties, yet development
environment vendors usually want hundreds of dollars per copy, and at
retail, the most you can hope for most consumer products is $60, of
which you might get at most around $12 after expenses. So of that $12
per copy, how much goes to the vendor of the development environment you
want to ship (who wants $100s normally)? Yet, as soon as you sell your
product, that vendor's customers can just buy your product for cheap
instead of the vendor's product... So it's a bad deal for the vendor.
The best alternative I can think of is to ship a product with source
code and tell users they can get the compiler you used and tinker with
the product as they want. But then you loose the chance to integrate
the development environment into your specific product with its specific
needs. Not to mention that you probably won't have the source for that
development environment to maintain it if the vendor abandons it to
pursue some new OS market. Of course, I guess if you have a lot of money
you could just buy a compiler vendor...
If anybody has a better answer to this economic & licensing quandry than
using a freely distributable development system, please let me know. =20
To the best of my knowledge, a publicly distributable Forth is the
simplest and fastest system for providing products that are customizable
by the end user without either being resource hogs or running slowly.
A system like Timbre's (if it can be redistributed) using parsing RULEs
allows one to present the end user with a syntax that is most
appropriate for the task at hand. For what I am interested in, that is
probably algebraic mathematical equations.
>=20
> Also you note that you admire the incremental development of Forth.
> Does that mean there is something lacking in the support for
> incremental development in Smalltalk?
>=20
The thing that is lacking in Smalltalk incremental development is
getting close to the hardware (some might call this a virtue in certain
cases). Traditionally, the way one gets close to the machine in
Smalltalk is to write primitives in C and link them into the VM. More
recently, one can link in DLLs or otherwise extend the VM at runtime,
but generally you still have to write the code using another development
system, and debugging these add ons is a hassle. So, in short, one
cannot incrementally develop fast close-to-the machine code in
Smalltalk, although one can easily incrementally develop everything
else.=20
Squeak gets closer to the notion of incremental primitive development
than most Smalltalks, since you can code your primitive in a restricted
subset of Smalltalk and then generate equivalent C code for your method.
But you still have to fire up a C compiler to get the final speedy
product, and you are restricted to a small subset of the language.
Since the core of Forth is so compact, it would require much less memory
and CPU resources to add it to Smalltalk than any other speedy language
(except perhaps assembler.) I would rather program primitives in Forth
than assembler for many reasons, not the least of which is that it is
relatively easy to have Forth inline assembler if needed in critical
parts (so I don=92t give up much to gain all of Forth's benefits).
>> Smalltalk's weakness has always been speed and footprint.=20
>> Forth can help on the speed side.=20
>=20
> I agree that most Smalltalk systems don't generally produce compact
> executables compared to most Forth systems. However, it isn't clear
> to me that speed is an issue if you use an appropriate Smalltalk
> system. Do you have some performance comparisions which show that a
> given Forth implementation is clearly superior in this area?
John Maloney published these figures for performance=20
to the Squeak mailing list (squeak@create.ucsb.edu):
>Here is my mental picture of the implementation technique=20
> versus speed graph for Smalltalk. It is normalized=20
> to the speed of C on a set of C-like benchmarks,
> such as matrix multiply and tight loops.
> Bytecode Interpreter (e.g. Squeak) 60-75 times slower than C
> Redesigned Bytecode Set (e.g. ST/V Mac) 20-25 times slower than C
> Portable Threaded Code (e.g. BrouHaHa) 10-12 times slower than C
> (my guess)
> Native Dynamic Translator (e.g. ObjectWorks) 6-10 times slower than C
> Dynamic Optimization (e.g. Animorphic) 2-5 times slower than C
> (my guess)
Of course these figures will vary depending on the nature of the task.
Clearly Squeak is very slow compared to native C code (60 times slower).
It is my understanding (please correct me if I=92m wrong), that a portabl=
e
Forth like Timbre will have a speed of around 6-7 times slower than C
for intensive floating point calculations (thus perhaps a ten times
speed up over Squeak currently). A native compiled Forth will probably
have a speed about 2-3 times slower than C, and possibly will almost
reach the speed of C depending on exactly how the code is written. I
don=92t have any specific benchmarks about the performance of different
Forths - these are from memory. Any comments on this speed issue would
be appreciated. =20
The thing to remember is that by using Forth instead of C for Smalltalk
primitives, you may well have more time to try better algorithms, debug
your code so it is correct, or optimize key parts, which may give you a
faster system overall.
In general, Smalltalk code takes at least four speed hits:
* run time binding
* type checking by the system and by primitives
* overhead of the VM interpreter or run-time compiler
* memory allocation and garbage collection
For example, to multiply two floats in Smalltalk using =91*=92 as in =931=
0.0 *
20.0=94, Smalltalk must first find the code for =91*=92, then execute the
previously compiled code, or compile it on the fly, or bytecode
interpret it, with the code figuring out if the other number is a float
or converting it to one (probably by using a technique called double
dispatching), then calling the FPU if there is one through a primitive,
and then it must take the result, allocate memory for it, initialize
that float object with the proper value, and then return the result up
the layers of function calls, as well as eventually clean up temporary
objects (like possibly allocated stack frames). =20
This Smalltalk way is much more complex than what goes on to do
something like =9310.0 20.0 FMUL=94 in Forth. That just requires jumping=
to
the one FMUL routine directly by address, smashing two 32-bit things
from the stack into the FPU no matter what the types, then putting the
result back onto the stack where the first number was and decrementing
the SP by one.=20
Of course, Smalltalk gives you many advantages for this performance
penalty; but sometimes you just don't want to pay the cost and are
willing to take risk for faster code (for example, to be fast, I think
Timbre doesn't check when you pop too many things off the stack - I
GPF'd it several times in the first hour of playing with it by doing
various odd things to test its robustness). There are ways around some
of these extra Smalltalk overheads by adding optional types to
Smalltalk, dynamic compilation and other techniques, but all will add to
the complexity of the system. I=92m looking for a simpler way, by just
saying: "do some things in Forth".=20
Why not do *everything* in Forth? Let=92s just say all languages have
strengths and weaknesses, and I think Smalltalk and Forth complement
each other well.
When I first started doing stuff with computers around 1979, I bought a
Commodore KIM (to do robotics ala Todd Lufburrow's book) but never
really understood it. Then I sold the KIM to buy a Commodore PET with
Basic. While I may have played a couple of times with Lisp and Algol at
that time on a timesharing system, most of my efforts were in BASIC.=20
But BASIC (like Smalltalk) wasn=92t fast enough for some things. Then I
saw the wonders one could do with POKEs of magical number sequences
(6502 instructions) and a SYS, and things I didn't understand about the
KIM began to make sense. So I made a more motivated effort to learn
Assembler, aided by the PET's screen and printer using the Commodore
Assembler. I saw the BASIC / Assembler combination as the way to go.=20
For example, one could write most of a game program in BASIC and just do
a few time critical things (like scrolling the screen sideways) in
Assembler. =20
Then I encountered Forth, which seemed like the best of both worlds. I
loved it, especially since I hadn=92t ever been able to name functions
before in BASIC. But the big problem was, the Forths I used came on
cartridges for the Commodore VIC and 64 (Tom Zimmer's early work I
think), and so you couldn=92t use them to develop software for
distribution. So for me, Forth development never became something with
commercial potential. Then I wandered into the C edit / compile / link
/ run / crash / debug fog and stayed there for quite a while (way too
long!), until Lisp and Smalltalk showed me a way out.
Well, it=92s over fifteen years later, and I=92m thinking: Smalltalk / Fo=
rth
today might be equivalent to BASIC / Assembler of my early computer
days... One would start a project with Smalltalk which coddles you and
won=92t let you do anything wrong, and then when you want speed, you star=
t
doing more risky stuff in Forth. Primitives in Forth might not even be
that hard to port. Full featured publicly distributable Forths exist,
and now a full featured publicly distributable Smalltalk exists. So I=92=
m
thinking, let=92s put them together and see what happens...
-Paul Fernhout
kfsoft@netins.net
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D
Download a public beta release of our garden simulator at:
http://www.gardenwithinsight.com
Date: 97 Jan 30 3:25:24 pm
From: Paul Fernhout <kfsoft@netins.net>
To: Ward Cunningham <ward@c2.com>
Cc: Squeak@create.ucsb.edu
Subject: Re: Merging Forth and Smalltalk
Ward -
Thanks for the reply.
Great story on your web pages about you and your brother and Forth and
Smalltalk...
You concerns about two languages being less economical than either may
very well turn out to be true. I'm just trying to see what one can do
easily, with existing publicly distributable software, rather than join
the difficult task of optimizing Squeak for some sort of dynamic
compilation, which is the obvious (and guaranteed technically do-able
and useful) alternative.
-Paul
Ward Cunningham wrote:
>
> Paul -- Both Forth and Smalltalk get great mileage out of a surprising
> economy of features. However, I fear that when combined we end up with
> less economy, not more. Still, language designers should dig in to both
> to try to understand where each gets its spark and borrow where
> appropriate. -- Ward
>
> See also
> http://c2.com/cgi/wiki?ForthInSmalltalk
> http://c2.com/cgi/wiki?SmalltalkInForth
>
> --
> Ward Cunningham
> v 503-245-5633 mailto:ward@c2.com
> f 503-246-5587 http://c2.com/
Date: 97 Jan 30 4:13:28 pm
From: Tim Rowledge <rowledge@interval.com>
To: Stefan Matthias Aust <sma@kiel.netsurf.de>
Cc: Squeak mailinglist <squeak@create.ucsb.edu>
In-Reply-To: <1.5.4.32.19970130222515.006e43d0@kiel.netsurf.de>
Subject: Re: Merging Forth and Smalltalk
On Thu 30 Jan, Stefan Matthias Aust wrote:
> It's an interesting idea, I think. Does a Forth system for the
Newton or the
> ARM processor(wasn't a predecessor used in the Archimedes home
computer
> long ago) already exist?
a) Yes, there are four Forth systems listed in the PD archives @
micros.hensa.ac.uk for the Archimedes family
b) The latest member of the family uses the StrongARM CPU, is called
the RPC and outruns all but the very latest and most expensive
PPC/X86 machines. So, you're right, but wrong :-) - the past tense is
not warranted :-)
Surely the thing to do to satisfy Paul's wish is to actually
implement a Forth inside Squeak, so that you can write prims in
Forth, compile them and store the machine code in
an array & then siply pass that array to a prim that can
execute it
or
the an array in the literal frame so that a method starts
with a prim that will do the above (slightly more elegantly tied into
the browsers I think)
or
actually in the bytecodes of the method and use a bytecode to
tell the VM to just branch to the next bytecode & exceute.
Since Forth basically uses the coder as the parser/optimiser and
produces pretty simple output, making a compiler in Squeak is
probably doable. You wouldn't be able to write big Forth progs, but
then who would want to. What you would get is dynamically file-inable
'primitives'.
--
Tim Rowledge: rowledge@interval.com (w) +1 (415) 856-7230 (w)
tim@sumeru.stanford.edu (h) <http://sumeru.stanford.edu/tim>
Date: 97 Jan 31 12:00:19 am
From: Hans-Martin Mosner <hmm@heeg.de>
To: Tim Rowledge <rowledge@interval.com>
Cc: Stefan Matthias Aust <sma@kiel.netsurf.de>,
Squeak mailinglist <squeak@create.ucsb.edu>
Subject: Re: Merging Forth and Smalltalk
Hi Squeakers,
it seems that to me what we want is a simple way of dynamically writing
speedy operations, especially for the numerical stuff.
There are several alternatives, some of which have been proposed here:
1. Using FORTH
Advantage: Simple & efficient execution model (threaded code).
Disadvantages: Unsafe operations, clumsy syntax IMHO (i.e. none at all).
2. Just-in-time code generation
Advantage: Proven technology with good speedup (VisualWorks et al).
Disadvantages: Difficult to implement portably, requires significant native
method cache size to be efficient.
3. Dynamic creation of primitives
Would allow us to specify primitives sort of like it's done in the Squeak
interpreter (that is, written in Smalltalk) and compile them into machine
code directly. I would like to have this for specifying numerical operations
such as Matrix math, and for certain rendering primitives.
Advantages: Could be done with moderate changes in the VM, allows
programmer-specified optimization, can be integrated with other optimizations
Disadvantages: Somewhat like JIT (code generators have to be written for
every platform), relies on programmer insight into the performance
bottlenecks.
4. More streamlined bytecode set
I don't think that there's a lot to be optimized here. There might be some
tradeoffs that were appropriate in the age of Smalltalk-80's inception but
aren't now, for example the number of 1-byte vs. 2-byte inst var pushes etc.
Advantages: slightly more efficient execution of bytecodes that are currently
2-byte sequences.
Disadvantages: Requires work both in the Smalltalk compiler and in the VM.
5. Highly optimized (assembler) bytecode interpreter
I've been contemplating this for a long time. For the PowerPC I have found a
sequence of instructions that would allow me to do the complete opcode fetch,
branching to the opcode's implementation, and branching back to the dispatch
loop in just 4 instructions that have no pipeline stall points. Together with
top-of-stack caching this can lead to ~10 instructions for loading an inst
var or temp var and storing it into a temp var.
Advantages: no change in the image and bytecode set, integrates well with
other speedup approaches.
Disadvantages: Tricky to implement, needs to be done separately per processor
type.
6. Different stack architecture
One good thing about FORTH implementations is the separation of call stack
and parameter stack, making argument passing and result returning really
cheap. An analogous mechanism for Smalltalk is possible, and it is not more
difficult to use than the traditional Context stuff. It is possible to do
true block closures and exception handling, too, if the call frames have the
appropriate information.
Advantages: should integrate well with other optimization techniques, should
give reasonable speedup.
Disadvantages: Requires significant changes in compiler and interpreter.
I think my opinion on FORTH is obvious. On the other choices I have opinions,
too, but I would accept anything that gives a real speedup without being too
clumsy.
In any case, it must be possible to implement within the limited spare time
that we can spend on it, otherwise it won't be done :-)
Hans-Martin
Date: 97 Jan 31 4:12:31 am
From: Ian Piumarta <piumarta@prof.inria.fr>
To: squeak@create.ucsb.edu
Subject: quote of the week
Just spotted this in comp.lang.smalltalk:
> From: Tim Jones <tim@thregecy.com>
> Subject: parcplace-digitalk --> parcplace-corpse
> Newsgroups: comp.lang.smalltalk
> Date: Fri, 31 Jan 1997 04:54:59 -0600
>
> this will be my first usenet flame.
> this will be my last usenet flame.
[...]
> if parcplace (now that parcplace-digitalk is dead) thinks there is going to
> be some huge migration from vse to vw they are living in a fantasy land.
>
> a much more likely scenario would be to change to visualage. they are very
> architecturally similar. if i wanted screwy mvc and simulated widgets i'd
> switch to squeak.
(Maybe it's time to revive my Small/Tk project and give Squeak a Motif
look-and-feel? ;^)
Ian
------------------------------- projet SOR -------------------------------
Ian Piumarta, INRIA Rocquencourt, Internet: Ian.Piumarta@inria.fr
BP105, 78153 Le Chesnay Cedex, FRANCE Voice: +33 1 39 63 52 87
----------------------- Systemes a Objets Repartis -----------------------
Date: 97 Jan 31 12:03:24 pm
From: Jecel Assumpcao Jr <jecel@lsi.usp.br>
To: Squeak mailinglist <squeak@create.ucsb.edu>
Subject: Re: Merging Forth and Smalltalk
I found this discussion particularly interesting as I am working on
(among many other things) generating threaded code in a Self system.
I didn't know that BrouHaHa Smalltalk used threaded code - I will
look it up on Monday (OOPSLA'86, right?). From the numbers I have
so far, it seems to me that this would be much less effective
for Smalltalk than for Self (the bytecodes are already at a much
lower level).
Forth uses a multiple open stack system, while most languages
use a single framed stack. Smalltalk is even more radical,
splitting the stack among the linked contexts. Even so, I
think it would actually not be very hard to mix the two
almost arbitrarily by adding a per context return stack
(only when actually used, of course).
Smalltalk syntax almost allows us to embed Forth fragments.
Unary messages are just like Words:
10 factorial printString size
We can't push things on the stack without using binary or
keyword messages (2 2 add) or send a unary to an empty
stack (printAllStack).
One option would be to replace bytecodes/literals with threaded
code throught the system. I counted 170K bytecodes in Squeak 1.16,
so replaceing each one with a four byte word doesn't look like
it it worth it.
Another alternative would be to add a new "thread" bytecode
and place the word addresses in the literal vector.
The system I am considering is to dynamically compile from
bytecodes to threaded code.
There was a system which used a restricted dialect of Smalltalk
for low level programming (what was it called? Fasttalk or
something like that). It would be interesting to compare that
with mixing Smalltalk and Forth.
About floating point - Self uses a 30 bit notation with 2 bits
of tag (like SmallIntegers) to avoid the costs that Smalltalk
has, but at a reduced precision. Depending on the application,
this might be a better way to get speed for numeric calculations.
-- Jecel
Date: 97 Jan 31 1:18:40 pm
From: Stefan Matthias Aust <sma@kiel.netsurf.de>
To: squeak@create.ucsb.edu
Subject: Re: Merging Forth and Smalltalk
Hans-Martin wrote:
>it seems that to me what we want is a simple way of dynamically writing
>speedy operations, especially for the numerical stuff.
Oh, I'd like to see an overall speedup.
You can't have enough execution speed :-)
>1. Using FORTH
>Advantage: Simple & efficient execution model (threaded code).
>Disadvantages: Unsafe operations, clumsy syntax IMHO (i.e. none at all).
I browsed through some web pages about Forth and found a pointer to Pocket
Forh (for Macintosh) which is sized about 50K (compressed probably). Thats a
small and promising fact.
I agree with you, that Forth looks -hm- strange, but I think that
challenging, but anoying. And Forth isn't unsafer than C or Assember code.
It should be used to implement a runtime system (VM) only.
>2. Just-in-time code generation
>Advantage: Proven technology with good speedup (VisualWorks et al).
>Disadvantages: Difficult to implement portably, requires significant native
>method cache size to be efficient.
Perhaps, it's a proven technology, but it's also not well known (or at least
complicate). To be efficient, you have to transform the stack-oriented
bytecode into real 3-address (or 2-address) machine code. You have to
consider thinks like optimal instruction ordering and branch avoidance. It's
a very dirty low level work. More memory usage isn't a real disadvantage in
my eyes, it's just the normal time/space trade-off. However, I think, the
disadvantages outweight here.
>3. Dynamic creation of primitives
>Would allow us to specify primitives sort of like it's done in the Squeak
>interpreter (that is, written in Smalltalk) and compile them into machine
>code directly. I would like to have this for specifying numerical operations
>such as Matrix math, and for certain rendering primitives.
An interesting, but very machine depend idea. Don't let the compiler
generate specific machine code. I would prefer (2.) over this approach.
>Advantages: Could be done with moderate changes in the VM, allows
>programmer-specified optimization, can be integrated with other optimizations
>Disadvantages: Somewhat like JIT (code generators have to be written for
>every platform), relies on programmer insight into the performance
>bottlenecks.
Here the Forth idea comes again to front, because it's probably easier and
more portable, to generate Forth words than real machine code. The
difference between the oldish bytecodes interpreted by a self written VM and
the Forth worlds executed with a Forth system is the hope, the latter could
be faster.
Does anybody know benchmarks which compare execution times between C and Forth?
>4. More streamlined bytecode set
>I don't think that there's a lot to be optimized here. There might be some
>tradeoffs that were appropriate in the age of Smalltalk-80's inception but
>aren't now, for example the number of 1-byte vs. 2-byte inst var pushes etc.
I, in constrast with you, would expect a noticable speedup. Probably we both
can't prove this believe with facts, but in my eyes the original bytecode is
too large, to complicate and it is optimized for space not for speed.
>Advantages: slightly more efficient execution of bytecodes that are currently
>2-byte sequences.
>Disadvantages: Requires work both in the Smalltalk compiler and in the VM.
The rework of the compiler should be fairly easy because bytecode emitting
is capsulated in the InstructionStream (I think). You have, of course, to
modify the VM.
>5. Highly optimized (assembler) bytecode interpreter
Very platform dependent. I think, this won't be fulfill the idea of Squeak's
portability.
>6. Different stack architecture
>One good thing about FORTH implementations is the separation of call stack
>and parameter stack, making argument passing and result returning really
>cheap. An analogous mechanism for Smalltalk is possible, and it is not more
>difficult to use than the traditional Context stuff. It is possible to do
>true block closures and exception handling, too, if the call frames have the
>appropriate information.
That's something, one could improve in any case.
bye
--
Stefan Matthias Aust // Too much truth is unhealthy...
http://www.kiel.netsurf.de/users/s/sma/
Date: 97 Jan 31 1:18:47 pm
From: Stefan Matthias Aust <sma@kiel.netsurf.de>
To: squeak@create.ucsb.edu
Subject: Re: Merging Forth and Smalltalk
Hi!
>Actually, the best thing that fits this need today is probably Lisp
>which can both do OO and produce compiled numeric code (as shown by the
>Nintendo 64 which uses Lisp for some products), and can be licensed to
>include a compiler with a product. It's just that I prefer the Smalltalk
>"object word:other:another:" syntax, and also prefer the Smalltalk
>development environment
You could probably hack Lisp's readtable to accept a more Smalltalk-ish
syntax but even if you use the standard ( )-syntax, you could use &keywords
to archive a very similar syntax. However, I don't know a Lisp environment
which has the development power of Smalltalk.
Perhaps you might want to give a look to Cecil, which is a relative new
classless object-oriented languages, which combine the good features of
Self, Dylan or CommonLisp's Object System with the syntax similar to C(++)
(probably a "must" in these days :-) Cecil has multimethods (as CLOS or
Dylan) in opposite to Smalltalk's object-message pattern and should run very
fast.
>The thing that is lacking in Smalltalk incremental development is
>getting close to the hardware (some might call this a virtue in certain
>cases).
I'd agree here. For me, it counts ten times that the VM runs very stable
than that you can squeeze the last percents of speed out of the machine. I
believe, that all optimizing can and should be done by a compiler because
it's better than most humans.
> Traditionally, the way one gets close to the machine in
>Smalltalk is to write primitives in C and link them into the VM. More
>recently, one can link in DLLs or otherwise extend the VM at runtime,
>but generally you still have to write the code using another development
>system, and debugging these add ons is a hassle. So, in short, one
>cannot incrementally develop fast close-to-the machine code in
>Smalltalk, although one can easily incrementally develop everything
>else.
However, I can see the opportunities, if you can add or change system
primitives dynamically at runtime. However, how you you want to debug them?
>Squeak gets closer to the notion of incremental primitive development
>than most Smalltalks, since you can code your primitive in a restricted
>subset of Smalltalk and then generate equivalent C code for your method.
>But you still have to fire up a C compiler to get the final speedy
>product, and you are restricted to a small subset of the language.
...which could be extended of course. FIFO blocks or blocks with no free
variables can be translated to C easily without of (significant) performance
lost. Real message sending could be implemented at the cost of one
additional indirection and so one.
>Since the core of Forth is so compact, it would require much less memory
>and CPU resources to add it to Smalltalk than any other speedy language
>(except perhaps assembler.) I would rather program primitives in Forth
>than assembler for many reasons, not the least of which is that it is
>relatively easy to have Forth inline assembler if needed in critical
>parts (so I don't give up much to gain all of Forth's benefits).
Do you know some links where I could find more information about current
Forth standards, the instruction set of a minimal forth, implementation
technics or simply some runnable Forth systems (for Windows or Linux)?
>>Here is my mental picture of the implementation technique
>> versus speed graph for Smalltalk. It is normalized
>> to the speed of C on a set of C-like benchmarks,
>> such as matrix multiply and tight loops.
>> Bytecode Interpreter (e.g. Squeak) 60-75 times slower than C
>> Redesigned Bytecode Set (e.g. ST/V Mac) 20-25 times slower than C
I'm amaised about the suggested speedup for optimizing the bytecode set.
Does anybody know, how the ST/V bytecode differs from the original blue book
instructions?
>> Portable Threaded Code (e.g. BrouHaHa) 10-12 times slower than C
>> (my guess)
>> Native Dynamic Translator (e.g. ObjectWorks) 6-10 times slower than C
>> Dynamic Optimization (e.g. Animorphic) 2-5 times slower than C
>> (my guess)
The Self people (Animorphics VM is based on their technology) claimed (and
proved in some papers for the Sparc processor) that they would come to half
of C speed.
I participated in a team that wrote a CommonLisp to C compiler which also
reached about 1/3 to 1/2 of the C speed. (And we didn't generate machine
code but highly portable ANSI C code) It can be done with clever optimizations.
>The thing to remember is that by using Forth instead of C for Smalltalk
>primitives, you may well have more time to try better algorithms, debug
>your code so it is correct, or optimize key parts, which may give you a
>faster system overall.
Well, using this argument, I could also speak for the approach to write the
VM in Smalltalk because this language is even more abstract and programming
is once more faster and you have even more time to optimize :-)
>In general, Smalltalk code takes at least four speed hits:
>* run time binding
You probably mean method lookup, don't you? Clever caching can reduce most
lookups to only one or two occurences. With more memory, you could also
flatten the inheritance tree and reduce lookup to one indirection as with
C++'s virtual method tables.
>* type checking by the system and by primitives
That's no burden. Type checking isn't actually done. It's a side effect of
failed method lookup one. Testing for correct primitive arguments can be
reduced to one compare instruction.
>* overhead of the VM interpreter or run-time compiler
This is the greatest burden. Indeed. If you dispatch your bytecodes to small
functions, you brake out the processor because of too much context switches.
If you dispatch in a large switch-statement, you couldn't profit of the
processor's internal cache. If you you compile bytecode (either via
macro-like replacement or via a real compiler) you will have to cache the
native code to gain speed.
>* memory allocation and garbage collection
No great deal. Ignoring GC's, memory allocation is even faster than using
malloc() or similar library routines. And even a simple GC algorithm can be
amaising fast (compared to the overhead of the other issues shown here). In
our Lisp compiler project we found the speed of our very simple stop & copy
GC absolutely suffient and we got more speedup (20%) by reducing the object
size than by hand-optimizing the GC algorythm.
>This Smalltalk way is much more complex than what goes on to do
>something like "10.0 20.0 FMUL" in Forth. That just requires jumping to
>the one FMUL routine directly by address, smashing two 32-bit things
>from the stack into the FPU no matter what the types, then putting the
>result back onto the stack where the first number was and decrementing
>the SP by one.
But Forth probably crashes on 10 20.0 FMUL, doesn't it? (Or at least answer
something which isn't useful at all)
>Why not do *everything* in Forth? Let's just say all languages have
>strengths and weaknesses, and I think Smalltalk and Forth complement
>each other well.
Just an idea: what's about including an byte code assembler in Smalltalk? :-)
>Well, it's over fifteen years later, and I'm thinking: Smalltalk / Forth
>today might be equivalent to BASIC / Assembler of my early computer
>days... One would start a project with Smalltalk which coddles you and
>won't let you do anything wrong, and then when you want speed, you start
>doing more risky stuff in Forth. Primitives in Forth might not even be
>that hard to port. Full featured publicly distributable Forths exist,
>and now a full featured publicly distributable Smalltalk exists. So I'm
>thinking, let's put them together and see what happens...
Then let's think on in this direction. How do you'd start?
bye
--
Stefan Matthias Aust // Too much truth is unhealthy...
http://www.kiel.netsurf.de/users/s/sma/
Date: 97 Jan 31 3:14:39 pm
From: CarlGWatts@AppliedThought.com (Carl G. Watts)
To: DanI@wdi.disney.com
Cc: squeak@create.ucsb.edu
Subject: Process suspend doesn't properly deal with Semaphore wait
Dan,
I recently had some problems because the Process suspend message can fail (as opposed to always succeeding). If the Process happens to be waiting on a Semaphore, Process suspend will fail.
The following doIt demonstrates:
| aProcess aSemaphore |
aSemaphore _ Semaphore new.
aProcess _ [
Smalltalk beep.
aSemaphore wait.
"Will never get to second beep because Process suspend will fail."
Smalltalk beep] newProcess.
aProcess priority: Processor userInterruptPriority.
aProcess resume.
"Now try and suspend the process while its waiting on the Semaphore. This shouldn't fail, but it does."
aProcess suspend.
"Will never get to signal the semaphore because Process suspend will fail."
aSemaphore signal
I suspect the right behavior is to have the Process suspend primitive <primitive: 88> remove the Process from any queue its on regardless of whether its a Semaphore queue or a ProcessorScheduler queue (but keep the myList instVar notNil). And then the Process resume primitive should put it back on the queue. I was tempted to try to fix it the suspect method primFail code to do this but then realized it wouldn't be thread-safe unless it was atomic in the primitive.
Well, that's at least as far as my understanding of it takes me. The stuff at the beginning of ControlManager interruptName: (which appears to be trying to compensate for this) is confusing me a bit. It can't work correctly if the activeControllerProcess was waiting on a Semaphore and the user later tries to proceed in the debugger (the process never re-waits on the Semaphore). But that's an issue farther down the river...
Carl Watts
Date: 97 Jan 31 3:59:01 pm
From: Ian Piumarta <piumarta@prof.inria.fr>
To: jecel@lsi.usp.br
Cc: squeak@create.ucsb.edu
Subject: Re: Merging Forth and Smalltalk
Jecel,
It's a while since I read the paper, but I think I'm right in saying
that the version of BHH described in OOPSLA does not use threaded
code. Eliot started investgating that after the paper was published.
I think the "conclusions" in the paper say that it would be
interesting to investigate if threaded code could improve performance
significantly.
Regards,
Ian
------------------------------- projet SOR -------------------------------
Ian Piumarta, INRIA Rocquencourt, Internet: Ian.Piumarta@inria.fr
BP105, 78153 Le Chesnay Cedex, FRANCE Voice: +33 1 39 63 52 87
----------------------- Systemes a Objets Repartis -----------------------
Date: 97 Jan 31 4:25:31 pm
From: Tim Rowledge <rowledge@interval.com>
To: Ian Piumarta <piumarta@prof.inria.fr>
Cc: Squeak mailinglist <squeak@create.ucsb.edu>
In-Reply-To: <199702010008.BAA06560@prof.inria.fr>
Subject: Re: Merging Forth and Smalltalk
> It's a while since I read the paper, but I think I'm right in saying
> that the version of BHH described in OOPSLA does not use threaded
> code.
Ian's right; I think it was about 90/91 when eliot started the threaded stuff. The 87 paper describes a much simpler system. It does, however describe a context handling scheme that would be very likely a dramatic improvement on the curre
nt Squeak implementation.
tim
--
Tim Rowledge: rowledge@interval.com (w) +1 (415) 856-7230 (w)
tim@sumeru.stanford.edu (h) <http://sumeru.stanford.edu/tim>
Date: 97 Jan 31 5:30:51 pm
From: John M McIntosh <johnmci@ibm.net>
To: "Carl G. Watts" <CarlGWatts@AppliedThought.com>
Cc: squeak@create.ucsb.edu
Subject: Re: Process suspend doesn't properly deal with Semaphore wait
Carl G. Watts wrote:
> I suspect the right behavior is to have the Process suspend primitive <primitive: 88> remove the Process from any queue its on regardless of whether its a Semaphore queue or a ProcessorScheduler queue (but keep the myList instVar notNil).
....
> Carl Watts
Thought I just relate how this works over in VW. When you suspend a
process it's removed from the scheduling queue and any semiphore queues
(I guess). In fact if you don't have a strong reference to the process
elsewhere it will get garbage collected. I found this out when I was
attempting to suspend all processes at a particular priority and then
inspect them. Thing was that if a GC occurred they would all disappear
on me before I could inspect them or resume them.
--
John M McIntosh
1-250-655-0653
VisualWave/VisualWorks/VisualAge Corporate Smalltalk Consulting
Date: 97 Jan 31 7:42:19 pm
From: Jecel Assumpcao Jr <jecel@lsi.usp.br>
To: Ian Piumarta <piumarta@prof.inria.fr>
Cc: squeak@create.ucsb.edu
Subject: BrouHaHa (was: Merging Forth and Smalltalk)
Ian Piumarta wrote:
>
> Jecel,
>
> It's a while since I read the paper, but I think I'm right in saying
> that the version of BHH described in OOPSLA does not use threaded
> code. Eliot started investgating that after the paper was published.
> I think the "conclusions" in the paper say that it would be
> interesting to investigate if threaded code could improve performance
> significantly.
Ah... that explains why I didn't notice anything about
threaded code when I read it back then. I just found this
abstract online:
QMW DCS Technical Report 418 June 1987 (12pp)
BrouHaHa - A Portable Smalltalk Interpreter
MIRANDA, E.
BrouHaHa is a portable implementation of the Smalltalk-80 virtual
machine interpreter. It is a more efficient redesign of the standard
Smalltalk specification, and is tailored to suit conventional 32 bit
microprocessors. This paper presents the major design changes and
optimisation techniques used in the BrouHaHa interpreter. The
interpreter runs at 30% of the speed of the Dorado on a Sun 3/160
workstation. The implementation is portable because it is written in C.
Keywords: Smalltalk, interpreter, optimisation, bitblt, rasterop,
portable
Citation: Accepted for OOPSLA'87, Florida, October 1987.
--------------
It sounds very much like Squeak, doesn't it?
Here is the other reference I was trying to remember:
Mark B. Ballard, David Maier, Allen Wirfs-Brock: Quicktalk: A
Smalltalk-80 Dialect for Defining Primitive Methods. 140-150
Norman K. Meyrowitz (Ed.): Conference on Object-Oriented
Programming Systems, Languages, and Applications (OOPSLA'86),
Portland, Oregon, Proceedings. SIGPLAN Notices 21(11), November 1986
-- Jecel
Date: 97 Jan 31 8:26:24 pm
From: CarlGWatts@AppliedThought.com (Carl G. Watts)
To: johnmci@ibm.net
Cc: squeak@create.ucsb.edu
Subject: Re: Process suspend doesn't properly deal with Semaphore wait
>Thought I just relate how this works over in VW. When you suspend a
>process it's removed from the scheduling queue and any semiphore queues
>(I guess). In fact if you don't have a strong reference to the process
>elsewhere it will get garbage collected.
Yes, isn't it just wonderful how a Process is no different from any other object is Smalltalk. If there are no references, well, there are no references...
When a Process is running (or waiting to run) a ProcessorScheduler is referencing it. When its waiting on a Semaphore the Semaphore is referencing it. But if its not running and not waiting on a Semaphore (ie. suspended) then if there are no other references, it just goes away... Just like any other object.
God I love that... That is pure O.O. for you...
If only the debugging method 'allInstances' returned ONLY referenced (reachable) objects (which it doesn't seem to do in most Smalltalks unfortunately (for some admittedly reasonable implementation reasons)) one couldn't even tell the difference between an unreferencable object and an object that has already been reclaimed. Unfortunately 'allInstances' usually allows you to get references to objects that were previously unreachable. I would prefer just doing away with 'allInstances' altogether. Yep that mutator would have to go away and some other stuff would have to be changed but I think I'd feel cleaner in a world without allInstances. I know, I know, I should be careful what I wish for... I just might get it!
At least allInstances should be marked as a message that shouldn't be used for general programming. I've seen neophytes use it in their code to periodically 'round up' the objects they've been making. But then they complain that occaisionally all their carefully made objects seem to go away (allInstances doesn't find them anymore). Then they think garbage collection is a bug because it deletes all their carefully made objects every once in awhile. Yes, don't worry, I do sit down and explain the birds and the bees to them.
(end rant on subject of allInstances) (apologies)
Carl Watts
stp@create.ucsb.edu]
Created: 1996.11.08; LastEditDate: 1996.11.11