St-72-preso-1

depth: 1

reset

1
World extent was:
llively.pt(1440.0,900.0)
Things to fix
mouse 1-4 are reversed in order and in sense
Text in Snippets requires String.fromCharCode(19) 
    for special 's character
move turtle frame up
Next to do
    offer reframe and + - handles
    need "winht _ frmht
XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX

doit

show vars

JavaScript Workspace

X

–

Menu

ALLDEFS

X

–

Menu

'This file is an annotated version of sysdefs.
Comments (by Dan Ingalls and Diana Merry) are in string-quotes like this.
The code portion of this file is copyright Xerox Corp. 1974'

'Phase I.
The bootstrap process sets up a global dictionary.  It then reads input lines, looking specifically for the defining word, to, and calling its code directly.'

to to x (CODE 19)
'Now definitions can be made by evaluating to in ST code'

to read (CODE 2)
'Read input into a vector.  The bootstrap reader is almost identical in function to the SMALLTALK read routine, except that DOIT is signalled by <CR> at zero-th parenthesis level, and single-quote strings are ignored.'

to vector (CODE 3)
'This defines the eval method (and more that will be described later) for code vectors.'

to USER (read eval)
'This is the top-level user program.  Its class variables also serve as the global symbol table (also known in the interpreter as TopLev).'

'Phase II.
As soon as USER has been defined (ie from here on), it provides the code to execute in each cycle of Smalltalk execution.'

to isnew (CODE 5)

to falseclass (isnew)

to atom x y (CODE 29)

"false _ falseclass.

to print (%..)
	':x.Print its address in octal.
	Printing goes to the same place as CODE 20. This is used primarily
	for bootstrapping. All system classes will print themselves.'


 

'MESSAGE HANDLING'

to : (CODE 18)
	'to : name

	%" ?(:"name nil ?(!name_caller message quotefetch)
				(!caller message quotefetch))

	Fetch the next thing in the message stream unevaluated
	and bind it to the name if one is there.

	%# ?(:"name nil ?(!name_caller message referencefetch)
				(!caller message referencefetch))

	Fetch the reference to next thing in the message stream
	and bind it to the name if one is there.

		(:"name nil ?(!name_ caller message evalfetch)
			!caller message evalfetch)

	Fetch the next thing in the message stream evaluated
	and bind it to the name if one is there.'

to % (CODE 17)
	':"token. token=caller.message.code[caller.message.pc]?
		(caller.message.pc_caller.message.pc+1. !true) !false.
	That is, if a match for the token is found in the message, then
 	gobble it up and return true, else return false.'

to  (CODE 36)
	'Fetch the next token quoted -- equivalent to (:").'

to ! (CODE 13)
	':x. then do a return, and apply x to any further message. Note
	that in (... !x+3. "y_y-2), the assignment to y will never
	happen, since ! causes a return.'

to " (CODE 9)
	'!:". That is, get the next thing in the message stream unevalled
	and active return it (which	causes it to be applied to the message).'

to # (:# )
	'Returns a REFERENCE to its arguments binding.'


'CONTROL CLASSES'
 
to repeat token (:#token. CODE 1)
	'repeat (token eval) Not a true apply to eval, and therefore token
	MUST be a vector.'

to done x (%with?(:x. CODE 25) CODE 25)
	'done causes a pop out of the nearest enclosing repeat, for, or do.  
	done with val will cause the repeat to have value val'

to again (CODE 6)
	'repeat ("active_active caller. eq active. class #repeat?(done)).
	That is, redo the most recent repeat, for, or do loop.'

to if exp (:exp?(%then?(:exp. %else?(:". exp)exp)error "(no then))
		%then?(:".   %else?(:exp) false)error "(no then))
	'The ALGOL if ... then ... else ...'

to for token step stop var start exp (
	:"var. (%_?(:start.)"start_1).
	(%to?(:stop.)"stop_start.)
	(%by?(:step.)"step_1.)
	%do. :#exp. CODE 24)
	'An Algol-like for.
	Note the default values if _,to,by,etc., are omitted.
	CODE 24 means  --repeat(exp eval).	
	This implies done and again will work, which is useful.'

to do token step stop var start exp (
	"step_"start_1. :stop. :#exp. CODE 24)



'INITIALIZING SYSTEM CLASSES


		Here are the main kludges which remain from the time when we
	really didn|t understand classes very well, but wanted a working
	SMALLTALK. PUT and GET are two of the principle actions of class
	class. The new verson of SMALLTALK will have class as a class
	with these actions intensional.'

to PUT x y z (:#x. :y. :z. CODE 12)
	'The first argument MUST be an atom which is bound to a class
	table.  The third argument is installed in the value side of that table
	corresponding to the name (atom) which was the second argument.'  

to GET x y (:#x. :y. CODE 28)
	'If x is a class table then the binding of the atom in y will be
	fetched.'

to leech field bits : ptr (
	isnew?(:ptr)
	CODE 27)
	'Lets you subscript any instance
	a[0] gives you the class, a[1] gives the first field, etc.
	a[2] gives you the pointer; a[2]&   returns the BITS in an integer
	a[2]_foo will dereference count previous contents, but a[2]&_ foo
	will not.'

to atom x y (CODE 29
	'%_?(:x.  !x -- Lookup SELF and replace its value by x.)
	%eval?(! -- Lookup the binding of SELF)
	%=?(!SELF=:)
	%chars?(! -- printname of SELF (a string))'

	%is?(ISIT eval)
	%print?(disp_SELF chars) )
	'Done this way (PUT used rather than using to) because we
	wanted to know where the system classes are. Hence the initial
	to atom x y () , for example, in Bootstrapping Magic followed
	by the behavior here.'

to falseclass (CODE 11
	'%?? (:".)
	%or? (!:)
	%and? (:.)
	%<? (:.)
	%=? (:.)
	%>? (:.)'

	isnew.
	%is?(%false?(!true) %~? (!"false) :".)
	%print?("false print) )

to vector x y : : substr (CODE 3 ?(!substr SELF x GLOB MESS)
	'isnew?(Allocate vector of length :.
		Fill vector with nils.)
	%[?(:x. %].
		(%_?(:y. !y -- store y into xth element. )
		!  xth element) )
	%length?(! length of string or vector)
	%eval?("pc_0. repeat
		(null SELF["pc_pc+1]?(done)
		"val_SELF[pc] eval)
		!val) sort of...'
	%is?(ISIT eval)
	%print?(disp_40. for x to SELF length
		(disp_32. SELF[x] print). disp_41)
	%map?(:y. for x to SELF length
		(evapply SELF[x] to y)) )

to string x y : : substr (CODE 3 ?(!substr SELF x GLOB MESS)

	'isnew?(Allocate string of length :.
		Fill string with 255s.)
	%[?(:x. %].
		(%_?(:y. !y -- store y into xth element. )
		!  xth element) )
	%length?(! length of string or vector)'

	%is?(ISIT eval)
	%print?(0 = "x _ SELF[1 to 9999] find first 39?
		 (disp _ 39. disp _ SELF. disp _ 39)
		 SELF[1 to x - 1] print. SELF[x+1 to SELF length] print)
	%=?(:y is string?(SELF length=y length?(
		for x to SELF length (SELF[x]=y[x]?() !false)) !false)
		!false)
	%+?(:y is string?("x_SELF[1 to SELF length+y length].
		!x[SELF length+1 to x length]_y[1 to y length])
		error "(string not found)) )

to number x y : : nprint (CODE 4
	'%+?(!val+:)
	%-?(!val-:)
	%*?(!val*:)
	%/?(!val/:)
	%<?(!val<:)
	%=?(!val=:
	%>?(!val>:)
	%&  ?(%+?(!val OR :)
		%-?(!val XOR :)
		%*?(!val AND :)
		%/?(!val LSHIFT :)))'

	%is?(ISIT eval)
	%print?(SELF>0?(nprint SELF)
		SELF=0?(disp_48)
		disp_21. nprint 0-SELF) )
	'For floating point stuff see FLOAT'

to disp x i (
	%_?(:x is string?(for i to x length (disp_x[i])) CODE 23)
	%clear?() %sub?(:x eval))
	'Writes a character or string to the bootstrap printer.
	Later it will redefined as a display frame.'

to cr (disp_13)
to sp (disp_32)

to ev (repeat (cr read eval print))

to USER (ev)

'The top-level user process is now defined.
The bootstrap reader stops here, and USER starts to run.'

to - x (:x*-1)
	'An often used abbreviation, has to work for float as well.'

to base8 i x s (:x. "s_string 7. for i to 7
	(s[8-i] _ 48 + x &* 7. "x _ x &/ -3). !s)
	'Returns a string containing the octal representation (unsigned) of its
	integer argument.'
 

"ISIT _ "(%~?(!TITLE) !TITLE=:").

to nil x (#x)
	'nil is an unbound pointer, which is used	to fill vectors and
	tables.'

to eq (CODE 15)
	'(! : is-identical-to :) - compare 2 SMALLTALK pointers.'

to null x y (:x. ! eq #x #y)
	'Null returns true if its message is nil, otherwise false.'

'UTILITIES'
 
to mem x y (:x. CODE 26)
	'to mem x y (:x. %_?(!core/mem x _:)!core/mem x)
	mem loads integers from and stores them into real core.
	Tee hee...
	mem 280 _ 0  --set alto clock to zero
	mem 280  ;read the clock
	for i to 16 (mem 280+i _ cursor[i])  --put new bits into cursor
	mem 276 _ mem 277 _ 0.  --reset mouse x and y to 0.
	mem 69 _ 0.  --disconnect cursor from mouse
	mem 278 _ x. mem 0427 _ y.  --move the cursor
	mem 71 _ 127. --make DEL the interrupt char (instead of ESC).
	mem 272.  --get pointer to display control block
	mem 65052.  --reads the first of 4 keyboard input words
	mem 65048. --reads the word with mouse and keyset bits.'
	
to mouse x (:x. CODE 35)
	' x = 0-7  are a map on the mouse buttons. E.g. (4=mouse 4) comes
	back true if the top mouse button is depressed, (1=mouse 1) comes
	back true if bottom mouse button depressed, (7=mouse 7) comes
	back true if all three mouse buttons depressed, etc.  Mouse 8
	returns the x coordinate of the mouse and mouse 9 returns the y
	coordinate.'
to mx (!mouse 8)
to my (!mouse 9)

to core ((mem 63)-mem 62)
	'Returns the amount of space left in your Smalltalk.'

to kbd i ("i _ 0. CODE 20)
	'Waits until a key is struck. Returns an ascii code when a key is
	struck on the keyboard.'

to dsoff (mem 272_0)
	'Turns display off by storing 0 in display control block ptr. Speeds
	up Alto Smalltalk by factor of 2.'

to dson (mem 272 _ 58)
	'Turns display back on by refreshing display control block
	pointer.'

to apply x y  (:#x. %to?(:y. %in?(:GLOB. CODE 10) CODE 10)
		%in?(:GLOB. CODE 10) CODE 10)
to evapply x y (:x. %to?(:y. %in?(:GLOB. CODE 10) CODE 10)
		%in?(:GLOB. CODE 10) CODE 10)
	'Causes its argument to be applied to the message stream of the
	caller, or, in the case of apply foo to <vector>, to that vector.	
	Note that only the message is changed, and that the caller is not
	bypassed in any global symbol lookup unless the in-clause is used to
	specify another context.'

"true_"true
"eval_"eval
to is ( %~?(!"untyped):". !false)
	'These are used to handle messages to classes which can|t answer
	queston invoking is, eval, etc.'

to t nprint substr (ev).
t	'prevent -to- from making these global.'
 
to nprint digit n (:n=0?()
	"digit_n mod 10. nprint n/10. disp_48+digit)
PUT number "nprint #nprint.
	'Prints (non-neg) integers in decimal	with leading zeroes suppressed'
 
to substr op byte s lb ub s2 lb2 ub2 (
	:#s. :lb. :ub. :MESS. "GLOB_ub.  'tee hee'
	:ub. (%]?() error "(missing right bracket))
	"byte _ "lb2 _ "ub2 _ 1.
	%find? ("op _ (%first?(1) %last?(2) 1)
				+ (%non?(2) 0). :byte. CODE 40)
	%_?  (%all? (:byte. "op_0. CODE 40)
		:#s2. "op_5.
		%[? (:lb2. %to. :ub2. %].  CODE 40)
			"ub2_9999. CODE 40)
	"op _ 6.  CODE 40).
PUT string "substr #substr.
PUT vector "substr #substr.
done  'end of subevaluation in t'

	'substr takes care of copying, moving and searching within strings
	and vectors.  It first gets its father (string/vector) and the lower
	bound, and then proceeds to fetch the rest of the message from
	above.  Some examples:
		"(a b c d e)[2 to 3] -> (b c)
		"(a b c d e)[1 to 5] find "c  -> 3
		"(a b c d e)[1 to 5] find "x  -> 0
	See vecmod for more examples.  String syntax is identical.'
 
to vecmod new end old posn ndel nins ins ("end_10000.
	:old. :posn. :ndel. :ins.
	"nins_(ins is vector?(ins length) 1).
	"new _ old[1 to old length+nins-ndel].
	(ins is vector?(new[posn to end] _ ins[1 to nins]) new[posn]_ins).
	new[posn+nins to end] _ old[posn+ndel to end].
	!new)
	'Vecmod makes a copy of old vector with ndel elements deleted
	beginning at posn.  If ins is a vector, its elements are inserted	at
	the same place. It is the heart of edit.'

to addto func v w (:#func. :w. "v_GET func "DO. null v?(error "(no code))
	PUT func "DO vecmod v v length 0 w)
	'Addto appends code to a class definition.'


to fill t i l str ( 
    "l _ :str length. "i _ 0.
    repeat
      (i = l?(done)
      "t _ kbd. str["i _ i + 1] _ t. disp _ t.  t=13?(done)).
    !str)


to stream in : i s l( 
   CODE 22
    '    CODE 22 is equivalent to...
    %_?
      (
        (i = l?
           ("s _ s[1 to "l _ 2 * l]))
       !s["i _ i + 1] _ :)
    %next?
      (i = l?(!0)
       !s["i _ i + 1])
    %contents?
      (!s[1 to i])'
    %reset?
      ("i _ 0)
    isnew?
      ("s _
        (%of?(:)
         string 10).
       "i _
        (%from?((:)
            - 1)
         0).
       "l _
        (%to?(:)
         s length))
    %is?
      (ISIT eval)
    %end?
      (!i = l)
    %print?
      (
        (i > 0?
           (s[1 to i] print)).
       disp _ 1.
       l < i + 1?()
       s[i + 1 to l] print))

to obset i input : vec size end (
	%add?((size="end_end+1?("vec_vec[1 to "size_size+10]))
		vec[end]_:)
	%_?(0=vec[1 to end] find first :input?
		(SELF add input))
	%delete?(0="i_vec[1 to end] find first :input?(!false)
		vec[i to end]_vec[i+1 to end+1]. "end_end - 1)
	%unadd?("input_vec[end]. vec[end]_nil.
		"end_end - 1. !input)
	%vec?(!vec[1 to end])
	%map?(:input. for i _ end to 1 by -1 (input eval))
	%print?(SELF map "(vec[i] print. sp))
	%is?(ISIT eval)
	isnew?("end_0. "vec_vector "size_4)
	)

to { set ("set_stream of vector 10. repeat(
	%}?(!set contents)
	set _ :)
	)


'PRETTY-PRINT
 
		This prints the code; classprint makes the header.'

to show func t (
	:#func. "t_GET func "DO.
	null t ? (!"(no code)) pshow t 0.)
to pshow ptr dent i t :: x tabin index (:ptr :dent.
	(ptr length>4?(tabin dent)) disp_40.
	for i to ptr length
		("t _ ptr[i].
		t is vector ?(pshow t dent+3.
			i=ptr length?()
			". = "x_ptr[i+1]?()
			x is vector?()
			tabin dent)
		i=1 ?(t print)
		0<"x_index "(. ,  [ ] ?) t?
			(x=1?(t print. i=ptr length?()
				ptr[i+1] is vector?() tabin dent)
			t print)
		0=index "(: " # ! [ % ? &  ) ptr[i - 1]?(disp_32. t print)
		t print)
	disp_41)
to t tabin index (ev)
t
to tabin n :: x (:n. disp_13. repeat
        (n > 6?
           (disp _ x[6].
            "n _ n - 6)
         done)
      disp _ x[n + 1])
(PUT tabin "x {string 0 fill string 1 fill string 2 fill string 3
	fill string 4 fill string 5 fill string 6}).
                       'leave these blanks'
PUT pshow "tabin #tabin.
to index op byte s lb ub s2 lb2 ub2 (
	:s. :byte. "op_"lb_"s2_"lb2_"ub2_1. "ub_9999. CODE 40)
	'A piece of substr which runs faster.'
PUT pshow "index #index.
done

'FLOATING POINT'

to float x y : : fprint (CODE 42
       %ipow?
         (:x = 0?(!1.0)
          x = 1?()
          x > 1?
            (1 = x mod 2?
               (!SELF *(SELF * SELF)
                ipow x / 2)
             !(SELF * SELF)
             ipow x / 2)
          !1.0 / SELF ipow 0-x)
       %epart?
         (SELF < :x?(!0)
          SELF < x * x?(!1)
          !
            ("y _ 2 * SELF epart x * x)
          +
            (SELF / x ipow y)
          epart x)
       %is?(ISIT eval)
       %print?
         (SELF = 0.0?(disp _ 48. disp_46. disp_48)
          SELF < 0.0?
            (disp _ 21.
             fprint - SELF)
          fprint SELF)
	)
to t fprint (ev)
t
to fprint n i p q s : : fuzz ( 
    'Normalize to [1..10]'
      (:n < 1?
         ("p _ -(10.0 / n)
          epart 10.0)
       "p _ n epart 10.0)
       "n _ fuzz + n / 10.0 ipow p.
    'Scientific or decimal'
      ("q _ p.
       "s _ fuzz*2.
       p > 6?
         ("p _ 0)
       p < -3?
         ("p _ 0)
       "q _ 0.
       p < 0?
         (disp _ 48. disp_46.
          for i _ p to -2(disp _ 48))
       "s _ s * 10.0 ipow p)
    'Now print (s suppresses trailing zeros)'
    for i to 9
      (disp _ 48 + n ipart.
       "p _ p - 1.
       "n _ 10.0 * n fpart.
       p < 0?
         (
            (p = -1?(disp _ 46))
          n < "s _ 10.0 * s?(done)))
      (p = -1?(disp _ 48))
    q = 0?()
    disp_101.
    q print)
PUT fprint "fuzz 5.0 * 10.0 ipow -9.
PUT float "fprint #fprint.
done
    
'TEXT DISPLAY ROUTINES

Display frames are declared with five parameters. They are a left x, a width, a top y, a height, and a string.  Hence --
	"yourframe_dispframe 16 256 16 256 string 400.
-- gets you an area on the upper left portion of the display that starts at x,y 16,16 and is 256 bits(raster units) wide and 256 bits high. The string (buf) serves as the text buffer, and is altered by _ and scrolling.

There are actually two entities associated with display frames--frames and windows. Currently both are given the same dimensions upon declaration (see isnew).  

The four instance variables defining the window are winx, winwd, winy, and winht.  The boundaries of this rectangle are intersected with the physical display.  The window actually used by the machine language will reduce the size of the window, if necessary, to be confined by the physical display.  Clipping and scrolling are done on the basis of window boundaries.  If a character is in the window it will be displayed.  If a string or character cause overflow of the bottom of the window, scrolling will occur.

The four instance variables defining the frame are frmx, frmwd, frmy, and frmht.   This rectangle may be smaller or larger than its associated window as well as the physical display.   Frame boundaries are the basis for word-wraparound.  (Presently, if frmy+ frmht will cause overflow of the window bottom[winx+winht], frmht will get changed to a height consonant with the bottom of the window.  This has been done to manage scrolling, but may get changed as we get a better handle on the meaning of frames and windows.).

Buf is the string buffer associated with any given instance of dispframe.  This is the string that is picked on the way to microcode scan conversion.  When scrolling occurs, the first line of characters, according to frame boundaries, is stripped out and the remainder of the buffer mapped back into itself.  If a _ message would overflow this buffer, then scrolling will occur until the input fits.  

Last is a buf subscript, pointing to the current last character in the buffer.  That is, the last character resulting from a _.

Lstln also points into the buffer at the character that begins the last line of text in the frame.  It is a starting point for scan conversion in the _ call.

Mark  is set by dread (see below) and points to the character in the buffer which represents the last prompt output by SMALLTALK; reading begins there. Mark is updated by scrolling, so that it tracks the characters.  One could detect scrolling by watching mark.

Charx and chary  reflect right x and top y of the character pointed to by last.

The reply variable in the instance may be helpful in controlling things.  When the reply is 0, it means everything should be OK. That is, there was intersection between the window and display and intersection between the window and the frame. When reply is 1, there was no intersection between the window and the display. A 2 reply means no intersection between window and frame. A 3 reply means window height less than font height -- hence no room for scan conversion of even one line of text. A 4 means that the frame height has been increased in order to accomodate the input. A 5 means the bottom of the window (i.e. window x + window height) has been overflowed --hence that scrolling took place. A 6 means that both 4 and 5 are true.

justify is a toggle for right justifying the  contents of a dispframe.  The default is  0 and means no justification.  Setting it to 1 causes justification on frame boundaries.

The font variable allows for the association of a font other than the default font with the display frame.  To get a different font into core say "something _ file <fontfilename> intostring. Then you can say disp ("font_something) or you can declare the font at the same time as the tdispframe is declared as e.g.
 "yourframe _ dispframe 3 40 3 40 string 20 font something.'  


to dispframe input : winx winwd winy winht frmx frmwd frmy frmht last mark lstln charx chary reply justify buf font editor : sub frame dread reread defont (
% _ ?(0 CODE 51)
	':s. s is number ? (append this ascii char)
		s is string ?(append string)
		error.'

%?(!  eval)
	'Allows access to instance variables. For example, 
		yourframe ("winx_32) 
	will alter the value of window x in the instance of dispframe
	called "yourframe".'

%show?(4 CODE 51 3 CODE 51)

%display?(SELF show. frame black)
	'Show clears the intersection of window and frame (see fclear,
	below) and displays buf from the beginning through last. A handy
	way to clean up a cluttered world.'

%hasmouse?(frmx<mx<frmx+frmwd?(!frmy<my<frmy+frmht)!false)
	'Tells you if the mouse is within a frame.'

%fclear?(4 CODE 51)
	'Fclear clears the intersection of the window and frame. Hence if
	the frame is defined as smaller than the window, only the frame
	area will be cleared.  If the frame is defined as larger than the
	window, only the window area will be cleared, since that space
	is in fact your window on that frame.'

%put?(:input. %at. "winx_"frmx_:. "winy_"frmy_"chary_:.
	"last_0. "lstln_1. SELF_input. !charx-winx)
	'For them as would rather do it themselves.'

%wclear?(5 CODE 51)
	'Wclear clears the intersection of a window and the physical
	display.'

%scroll?(2 CODE 51)
	'Scroll removes the top line of text from the frame|s string buffer,
	and moves the text up one line.'

%clear?(1 CODE 51)
	'Clear does an fclear and sets the last pointer into the string buffer
	to 0 and lstln to 1. It has the effect of cleaning out the string
	buffer as well as clearing the frame area.'

%mfindc ?(7 CODE 51)
	' 	Find character.
	Takes two arguments -- x and y (typically msex and msey).
	Returns vector:
		vec[1] = subscript of char in string
		vec[2] = left x of char
		vec[3] = width of char
		vec[4] = topy of char
	If vec[1] is -1 x,y is after the end of the string.
	If vec[2] is -2 x,y is not in the window.
	Sample call:
		"myvec_yourframe mfindc mx my.'

%mfindw ?(8 CODE 51)
	' 	Find word.
	Takes two arguments -- x and y (typically msex and msey).
	Returns vector:
		vec[1] = subscript of first char in word
		vec[2] = left x of word
		vec[3] = width of word
		vec[4] = topy of word
	If vec[1] is -1 x,y is after the end of the string.
	If vec[2] is -2 x,y is not in the window.
	Sample call:
		"myvec_yourframe mfindw mx my.'

%mfindt ?(6 CODE 51)
	' 	Find token.
	Takes two arguments -- x and y (typically msex and msey).
	Returns vector:
		vec[1] = token count, ala Smalltalk token Spaces and
			carriage returns are  considered as delimiters,but
			multiple delimiters do not bump the count. Text
			delimited by single quotes is counted as one
			token, and embedded text (i.e. more than one
			quote in sequence) will not cause the token count
			to be bumped (allows for embedding strings
			within strings).
		vec[2] = left x of word
		vec[3] = width of word
		vec[4] = topy of word

	If vec[1] is -1 x,y is after the end of the string or not in frame.
	If vec[2] is -2 x,y is not in the window.
	A sample call--
		"variable_yourframe mfindt mx my.'

%read?(!dread)
	'Makes a code vector out of keyboard input. See dread below.'

%reread?(!reread :)
	'Used by redo and fix.  Goes back n(its argument), prompts and does
	a read from there. See reread below.'

%sub?("input _ sub :. SELF show. !input)
	'Evals its argument in a sub-window.  Used by fix and shift-esc.
	 See sub below.'

%knows?(ev)
	'Whilst at the KEYBOARD, one can say 
		yourframe knows(DOIT)
	and get a copy of the evaluator in the context of that instance of
	dispframe.  Allows access to instance variables without going through
	the  path.'

%frame ? (apply frame)
	'Draws a border of the given color around the frame.  E.g., 
		yourframe frame - 1.'

%is ?(ISIT eval)

isnew ? ("winx_:frmx. "winwd_:frmwd. "chary_"winy_:frmy.
	"winht_:frmht. :buf. "lstln_1.
	"mark_"last_"charx_"reply_"justify_0.
	"font _ (%font?(:input is string?(input) defont)defont)
	%noframe?() frame black)  )
 
dispframe knows
to dread t instr prev (
	disp_20. "instr_false. "mark_last.
	(null #DRIBBLE?() DRIBBLE flush)
	repeat ("prev _ buf[last].
		40>disp_"t_kbd?(
		t=8?(last<mark?(disp_20) 
		'	Backspace only up to prompt.'
			prev=39?("instr_instr is false))
			'		Backspace out of string flips instr.'
		t=30?(instr?() done)  
		'	DOIT checks if in a string.'
		t=39?("instr_instr is false)
		'	Flag is true if in a string'
		t=5?(sub "(ev). "last_last - 1. disp show)
		'	Shift-Esc make sub-eval.'
		t=4?(disp_8. "done print. disp_30. !"(done))
		))
	disp_13. !read of buf [mark+1 to last - 2])

to sub disp (
	"disp_dispframe winx+48 winwd - 64 winy+14 winht - 28
			string 300 font font. 
	disp clear. (:)eval)
	'Opens a sub-frame, and evals its argument in that context.'

to frame a ("a _ turtle at frmx - 1 frmy - 1.
	a width 2 . a ink (%white?("white) %black. "black).
	do 2 (a turn 90 go frmwd + 2 turn 90 go frmht + 2)	)
	'Draws a double line around the frame.'


to reread n i p reader ((null :n?("n_1))
	repeat (buf[last] = 20?(disp _ 8. done) disp _ 8).
	"p _ last.
	for i to n
		("p_buf[1 to p - 1] find last 20.
		p<1?(done))
	i<n?(error "(no code))
	!read of buf [p+1 to buf[p+1 to last] find 30])
	'Counts back n prompts (n is integer arg) and then does a read from
	there. Also erases the line just typed.'

"defont _ fill string 6
ST8.AL

done
 
to read str ((%of?(:str)). CODE 2)
	'Adds the ability to read from a supplied string'

to dclear (0 CODE 52)
	'This function takes five parameters -- 
	x width y height value, and clears the display rectangle thus
	defined to the value given. A 0 value, for example, puts all
	zeros into  the rectangle.'


to dcomp (1 CODE 52)
	'Just like dclear only complement rectangle.'


to dmove (2 CODE 52)
	'This function takes six parameters -- source x width source y
	height destination x destination y.  It takes the source rectangle
	(x and width mod 16|d as in dclear) and moves it to the destination
	x and y. Clipping will occur on display boundaries. The source will
	remain intact unless  it overlaps with the destination, in which case
	the over- lapping portion of the destination wins.'

to dmovec (3CODE 52)
	'Dmovec takes the same parameters as dmove, but in addition clears
	the non-intersecting source material. It is the general case of what
	happens on the display screen during a scroll, i.e. scrolling could be
	accomplished by saying disp (dmovec winx winwd winy+fontheight
	winht-fontheight winx winy). A sample call --
		dmovec 0 256 0 256 256 256. 
	This will move whatever is in the upper left hand corner of the
	display to x,y   256,256 -- and then erase the source area. '

 
to redo (!(disp reread :) eval)
	'Causes re-evaluation of the input typed n prompts before this.
	Setting last_mark-2 makes the redo statement and its prompt
	disappear with a disp show.'

to fix vec ("vec_disp reread :.
	(disp sub "(veced vec)) eval)
	'Like redo, except that the previous input is given to the editor in a
	subwindow.  When editing is done, the resulting code is evalled
	before returning.'
 

'TURTLES'

to turtle var : pen ink width dir x xf y yf frame : f (
	CODE 21  '%go?(draw a line of length :)
	          %turn?(turn right : (degrees))
	          %goto?(draw a line to :(x), :(y))'
	%pendn?("pen _ 1. !SELF)
	%penup?("pen _ 0. !SELF)
	%ink?(%_. :ink.  !SELF)
	%width?(%_. :width.  !SELF)
	%xor?("xor _ (%off?(0) 1). !SELF)
	%is?(ISIT eval)
	%home?("x _ frame  frmwd/2.
	       "y _ frame  frmht/2.
	       "xf _ "yf _ 0. "dir_270. !SELF)
	%erase?(frame fclear. !SELF)
	%up?("dir _ 270. !SELF)
	isnew?("ink _ "black. "pen _ "width _ 1. "xor _ 0.
		(%frame?("frame _ :) "frame _ f)
		%at?(:x. :y. "dir_270)
		SELF home)
	)
PUT turtle "f dispframe 0 512 0 512 string 1 noframe.
"@ _ turtle.


'THE TRUTH ABOUT FILES

a file is found in a directory (dirinst) by its file name (fname), and has a one page, 512 character string (sadr).  rvec is an optional vector of disk addresses used for random page access.

"fi _
 <directory> file <string> old -- finds an old file named <string> in <directory> or returns false if does not exist or a disk error occurs.

"fi _
 <directory> file <string> new -- creates a new file or returns false if it already exists.  if neither old or new is specified, an existing file named <string> will be found or a new file created. if <directory> is not specified, the current default directory is used.

<directory> file <string> delete -- deletes a file from a directory and deallocates its pages.  do not delete the system directory (SYSDIR.) or bittable (SYS.STAT.), or any directories you create.

<directory> file <string> rename <string> -- renames file named by first string in <directory> with second string. currently not implemented for directory files.

<directory> file <string> load -- loads a previously saved memory image (Swat format), thereby destroying your current state.

<directory> file <string> save -- saves your Smalltalk memory.

leader and curadr are the alto disk addresses of page 0 and the current page of the file, respectively.  bytec is a character index into sadr.

dirty = 1 if any label block integers (nextp thru sn2) have been changed; = -1 if sadr has been changed; = 0 if the current page is clean.  the user need not worry about this unless (s)he deals directly with the label or sadr. it might be noted here that multiple instances of the same file do not know of each others activities or sadr|s.

status is normally 0, -1 if end occurred with the last set; a positive number (machine language pointer to offending disk command block (dcb)) signals a disk error.

the next 8 integers are the alto disk label block.  nextp and backp are the forward and backward alto address pointers. lnused is currently unused. numch is number of characters on the current page, numch must be 512, except on the last page. pagen is the current page number. page numbers are non-negative integers, and the format demands that the difference in consecutive page numbers is 1. normal file access starts at page 1, although all files possess page 0 (the leader page). version numbers > 1 are not implemented. sn1 and sn2 are the unique 2-word serial number for the file. 

the class function ncheck checks that file names contain alphabetic or legal characters or digits, and end with a period.'


(to file : dirinst fname sadr rvec leader curadr bytec dirty status nextp
	backp lnused numch pagen version sn1 sn2 : ncheck x (

	%_? (17 CODE 50)
		'	fi_<integer>, <string>, or <file> --  
		:x is string? (for i to x length (SELF_x[i]))
		x is file? (repeat (x end? (done) SELF_x next))
		(numch<"bytec_bytec+1? 
		  (SELF set to write (pagen+bytec/512) bytec mod 512))
		sadr[bytec]_x &*  255'

	%next? ((%word? (%_? (7)
			'		fi next word_<integer> -- write integer.
			possibly increment pointer to word boundary.
			(0=bytec &*  1? () "bytec_bytec+1)
			SELF _ :x/256. SELF _ x mod 256.'

			 6)
			'		fi next word -- read an integer
			(0=bytec &*  1? () "bytec_bytec+1)
			!(SELF next*256) + SELF next'

		  %into? (16)
			'		fi next into <string> -- read a string
			for i to :x length(x[i]_SELF next).!x'

		  25) CODE 50)
			'		fi next -- read a character
			(numch<"bytec_bytec+1?
			 (SELF set to read (pagen+bytec/512) 
			   bytec mod 512? () !0))  !sadr[bytec]'

	%set? (%to. (%end?(13)
			'		fi set to end -- set file pointer to end of file.
			SELF set to read 16383 0'

		 %write?(5) 
			'		fi set to write <integer> <integer> -- set file
			pointer to :spage :schar. if current page is dirty,
			or reset, set to end or page change
			occurs, flush current page. read pages until
			pagen=spage. allocate new pages after end if
			necessary (-1 512 is treated as start of next
			page, i.e. pagen+1 0). "bytec_schar'

		%read. 4) CODE 50)
			'		same as write except stop at end'

	%skipnext? (18 CODE 50)
		'	fi skipnext <integer> -- set character pointer relative to
		current position. (useful for skipping rather than reading,
		or for reading and backing up, but end may not work if
		bytec points off the current page)  "bytec_ bytec + :.'

	%end? (10 CODE 50)
		'	fi end -- return false if end of file has not occurred.
		nextp=0? (bytec<numch?(!false))!false'

	%? (! :"  eval)

	%flush? (12 CODE 50)
		'	fi flush -- dirty=0? () write current page'

	%writeseq? (22 CODE 50)
		'	transfer words from memory to a file
		:adr. :count. for i_adr to adr+count - 1
		(SELF next word _ mem i)'

	%readseq? (21 CODE 50)
		'	...from a file to memory...(mem i _ SELF next word)'

	%is? (ISIT eval)

	%remove? (dirinst forget SELF)
		'	remove file from filesopen list of directory'

	%close? (dirinst  bitinst flush.
		 SELF flush. SELF remove. !"closed)
		'	fi close or "fi_fi close (if fi is global) -- flush bittable
		and current page, remove instance from filesopen list of
		directory'

	%shorten? (%to. %here? (SELF shorten pagen bytec) 14 CODE 50)
		'	fi shorten to <integer> <integer> -- shorten a file SELF set
		to read :spage :schar. "x_nextp. "nextp_0.
		"numch_schar. "dirty_1. deallocate x and successors'

	%print? (disp _ fname)
		'	file prints its name'

	%reset? (11 CODE 50)
		'	fi reset -- reposition to beginning of file
		SELF set 1 0'

	%intostring?(SELF set to end.
  		"x _ string bytec + 512 * pagen - 1.
    		SELF reset.  !SELF next into x)

	%random? (SELF set to end. "rvec _ vector pagen.
		  for x to rvec length (SELF set x 0. rvec[x] _ curadr))
		'	fi random -- initialize a random access vector to be used
		in fi set...  new pages appended to the file will not be
		randomly accessed'

	%pages? (20 CODE 50)
		'	fi pages <integer> ... <integer> -- out of the same great
		tradition as mem comes the power to do potentially
		catastrophic direct disk i/o (not for the faint-hearted).
		 :coreaddress. :diskaddress. :diskcommand. :startpage.
		:numberofpages. :coreincrement. if -1 =  coreaddress,
		copy sadr to a buffer before the i/o call. diskaddress
		(=-1 yields curadr) and diskcommand are the alto disk
		address and command. startpage is relevant if label checking
		is performed. numberofpages is the number of disk pages
		to process. coreincrement is usually 0 (for writing in same
		buffer) or 256 for using consecutive pages of core.  use
		label block from instance of fi. copy label block from
		instance. perform i/o call. copy curadr and label block
		into instance. if -1=coreaddress copy buffer to "sadr".' 

	isnew? ("fname_ncheck :. fname is false?
			(error "(bad file name) !nil) 
		(null "dirinst _ #curdir? 
			("dirinst _ directory  defdir.  dirinst open)).
			'		set directory instance for file. if curdir is nil
			because file was not called from the context of a 
			directory instance, use the default directory'

		%exists? (24 CODE 50. !fname)
			'		return false if file name does not occur in the
			directory'

		%delete? (15 CODE 50. !"deleted)
			'		delete a file (see intro)'

		"sadr _ (%using? (:) string 512).
			'		set up file string buffer'

		%rename? ("x _ ncheck :. x is false?
				(error "(bad new name)!nil)
			  file x exists? (error "(name already in use))
			  2 CODE 50.  "fname _ x.  23 CODE 50.
			  SELF set 0 12.  SELF _ fname length.
			  SELF _ fname.  SELF flush.  !fname)
			'		check that the new name is not already in use.
			lookup the original file and change its name in its
			directory, and in its leader page'

		 %load? (2 CODE 50. 8 CODE 50)
			'		lookup an old file and load (overlay) a Swat
			memory image; return via save.'

		(%old? (2)
		 sadr[13] _ fname length.
		 sadr[14 to 13 + fname length] _ fname.
		 %new? (dirinst  filinst is file? (3) 19)
		 1) CODE 50.
			'		find an old file or add a new entry (with its
			name as a BCPL string in its leader page. special
			handling for new directories). machine code may
			return false'

		%save? (SELF set to write 256 0.  SELF reset.
			dirinst close.  9 CODE 50)

			'		allocate a file, close the directory (other files
			e.g. DRIBBLE, and directories should be already
			closed), and write out the memory image as a Swat
			file.  when arriving here from a load, return false;
			otherwise return the file instance.'

		%intostring?(!SELF intostring)
		dirinst remember SELF) ))
			'		finally, file puts itself into the filesopen list of its
			directory'
file (ev)
to ncheck str i x :: legal ("str_:.
	(str is string?(str length < 255?() !false) !false)
	for i to str length
		("x _ str[i].
		96 < x < 123 ? ('lowercase')
		 47 < x <  58 ? ('digit')
	  	   0 < legal[1 to 6] find x ? ('legal')
		64 < x < 91 ? ('uppercase')
		!false)
	x=46?(!str) !str+ ".chars)
'check that the file name is a proper length string containing only lower/upper case letters, digits, or legal characters. if name does not end with a period, append one.'

PUT ncheck "legal fill string 6
+-$!?.   
done


to error adr ptr arec class :: c shocode find sub (
	%knows?(!ev)
	:ptr. "arec_leech AREC.
	disp sub "((0=adr?(ptr print)
		mem 66_0. disp_255 &*  mem adr.
		for adr_adr+1 to adr+(mem adr)&/ -9 (
			"ptr_mem adr.
			disp_ptr&/ -8. disp_ptr&*  255))
	cr c ev))  
error knows
to c class code cpc (
	null arec[5]?(.) "arec_leech arec[5]. "class_arec[0].
	(GET class "TITLE) print. ": print.
	arec[6] is vector?(find arec[1]&   arec[6] ? (shocode))
	find arec[1]&   GET class "DO ? (shocode).
	)
to shocode i (
	for i_1 to code length
		(i<cpc - 5?(disp_46) i>cpc+5?(disp_46)
		sp. (i=cpc?(disp_25))
		code[i] is vector?("$ print) code[i] print).
	)
to find adr vec vadr l (
	'a tree search in vec for the address adr'
	"adr_:. "l_leech :vec.
	vec is vector is false?(!false)
	"vadr_(leech l)[1]&   +1.
	(adr>vadr?(adr<vadr+vec length+1?
		("cpc _ adr-vadr. "l_0. "code_vec. !true)))
	"l_0. for l to vec length
		(vec[l] is vector?(find adr vec[l]?(!true)))
	!false)
to sub disp ("disp _ GET USER "disp. (:) eval)
done
 
to kbck i ("i _ 1. CODE 20)
	'Returns true if the keyboard has been hit.'

to button n (!:n=mouse 7)
	'Returns true if that pattern is being held down'


'THE SMALLTALK EDITOR ---'
 
 
to edit func t (:#func. 
	"t_GET func "DO. 
	null t ? (!"(no code))
	%title? ((veced classprint func header) eval)
	PUT func "DO veced t. 
	!"edited)  
	'Edit picks up a code vector, makes sure it is not empty and calls
	veced to edit the code body.  If you say edit foo title, veced will
	edit the header as well, and the changed form will be evalled upon
	exit to redefine the function, title and all.

	Veced can be used on any vector, and is used by FIX as well as
	EDIT.  It creates two new windows within the default DISP which
	exists when it is called.  One is used for a menu of commands,
	the other becomes the new default window DISP. The new default
	is passed to an intermediary; and the newly edited vector is
	returned.'

(to veced back newdisp  menu x ::  menuwidth menulen menustr
ed edtarget gettwo bugin getvec  (
	%knows?(ev)
	"back_false. 
	disp fclear.
	disp ("menu_dispframe winx+winwd-menuwidth menuwidth
			winy (winht>139?(winht) 140) string 70
			font font.
		menu _ menustr.
		"newdisp _ dispframe winx winwd-menuwidth+2
			winy winht string buf length 
			font font noframe)
	:x. "x _ indisp newdisp (ed x). 
	disp show.
	!x)   )


veced knows

"menuwidth _ 64.
"menustr_string 0.
"menulen _ 10.
do menulen ("x_fill string 9.
	"menustr_menustr+x[1 to x[1 to 9]find 13]).
 Add
 Insert
 Replace
 Delete
 Move
 Up
 Push
 Enter
 Leave
 Exit

to indisp disp (:disp. !  eval)
	'used to make DISP a new local.'

to ed ptr l n nrun command temp i nv n1 fnth hfnth   (
	"command _ 0.
	:ptr. 
	"fnth _ 18.
	"hfnth _ fnth/2.
	repeat(
		"l_ptr length.
		back?(done with ptr) 
		menu show. disp clear
		"nv_0.
		for n to l
			(ptr[n] is vector?(disp_36. sp
				"nv_nv+1. "n1_n)
			ptr[n] print. disp_32) 
		cr cr.
		"command _ edcomp bugin menu menulen both.

		"(  
		("ptr_vecmod ptr l+1 0 read) 
		("ptr_vecmod ptr edcomp edtarget both 0 read) 
		(gettwo.  "ptr_vecmod ptr n nrun read)
		(gettwo. "ptr_vecmod ptr n nrun vector 0)
		(gettwo. "temp _ ptr[n to n+nrun - 1]
			"i_edcomp edtarget both.
			"ptr_vecmod ptr n nrun vector 0.
			(i>n ? ("i_i-nrun))
			"ptr_vecmod ptr i 0 temp)
		(getvec?("ptr_vecmod ptr n 1 ptr[n]) again) 
		(gettwo. "temp_vector 1. 
			temp[1]_ ptr[n to n+nrun - 1].
			"ptr_vecmod ptr n nrun temp)
		(getvec?(ptr[n]_ed ptr[n]) again)
		(done with ptr)	
		("back_true. done with ptr)
			) [command] eval.
		)
	)
	'The heart of ED is a vector, containing as its elements code
	vectors.  The giant vector is indexed to get the particular piece of
	program, and it is sent the message EVAL.  Note that the order of
	the segments in ED1 should match the order of the atom names in
	MENUVEC.'


to gettwo t1 n2 ("n_edcomp edtarget top. 
                 "n2_edcomp edtarget bot.
	"nrun _ 1+n2-n.
	nrun<1?("n_n2. "nrun_2-nrun))

to bugin  someframe  max index(
	:someframe.
	"max _ 1+:.
	repeat (button 0 ? (repeat (
			button 7 ?(disp sub "(ev))
			button 0 ?()
			done) 
		done) 
		) 
        "index_someframe mfindt mx my
	0<index[1]< max ?
		(!index)
	'returns token index, if within range, else'
	again
	'causes an exit out of this command by restarting ed|s
	repeat'
	)

to edtarget (! bugin disp l)
 
to getvec (nv=1?("n_n1. !true)
	!ptr["n_edcomp edtarget both] is vector)

to edcomp compvec y hth (:compvec.
	"y_compvec[4].
	"hth_(%both?(fnth)%top?(hfnth)
		%bot?("y_y+hfnth. hfnth))

	dcomp compvec[2] compvec[3] y hth
	!compvec[1]
	)
done

'BOOTSTRAPPING REVISITED'

to classprint fn a b i j k flags clsv clsm arecv arecm instv instm code (
	:#fn. "code _ GET fn "DO. null code?("(no code))
	"a_leech #fn. "b_vector 1. "b_leech b.  "clsm_"arecm_"instm_0.
	"k_a[1]&  . "clsv_vector k. "arecv_vector k. "instv_vector k.
	'Pull symbols out of class table'
	for i_4 to 4+2*k by 2
	'k is no. dbl entries -1, here'
		("k_a[i]&  .
		k = -1?(again).  "flags _ k&/ -14.
		'	0=class, 2=arec, 3=inst'
		flags=0?(0="(DO TITLE ARSIZE) [1 to 3] find a[i]?
			(clsv["clsm_clsm+1] _ a[i]))
		b[2]&   _ k&*2047.  "j_a[i+1]&  .
		(flags=2?(arecv[j - 6] _ b[2]. arecm<j - 6?("arecm_j - 6))
			instv[j+1] _ b[2]. instm<j+1?("instm_j+1))
		)

	'Now make up input form.'
	"a _ vector 6+arecm+instm+clsm.
	a[1] _ "to. a[2] _ GET fn "TITLE.
	a[3 to "j_2+arecm] _ arecv.
	(0<instm+clsm? (a["j_j+1]_":. a[j+1 to "j_j+instm] _ instv.
		0<clsm? (a["j_j+1]_":. a[j+1 to "j_j+clsm] _ clsv)))
	%header?(a[j+1]_code. !a)
	for i to j (a[i] print. disp_32)
	showpretty?(pshow code 3) code print)
 
to nshow showpretty ("showpretty_true. showev  :" )
 
to showev shAtom shVal (:shAtom. cr.
	(shAtom is atom?
		("shVal _ shAtom eval.
		(null GET shVal "DO?
			("" print. shAtom print. "_ print.
			(shVal is vector? ("" print)
				null shVal?("nil print))
			shVal print. ". print)
		classprint shVal))
	shAtom print)
	disp_30.)

to filout disp flist i showpretty ("showpretty _ %pretty.
	dsoff (:disp is string? ("disp_file disp? () error "(file error)))
	(%add?(disp set to end))
	(null :flist?(defs map "(showev vec[i]. cr))
	(flist is atom? (showev flist. "flist_flist eval))
	for i to flist length - 1 (showev flist[i]. cr)) 
	disp shorten to here. disp close. dson.)
	'Filout basically does a show in an environment where the display is
	replaced by a file. filout pretty <file> or <string = file name> add
	<vector> if pretty is used, the text representation is neater but
	takes longer to generate. if add is used, function definitions are
	appended to the file. if <vector> is not specified, defs is
	used.'
 
to filin fi :: ev (%?(!  eval)
     dsoff. 
    (:fi is string?("fi _ file fi old?()
		dson !false))
    repeat
      (fi end?(done)
       dsoff.
       cr (read of fi) eval print.
       dson).
    fi close.
   )
filin (to ev (repeat(cr (read of fi) eval print)))

	'Filin basically does a read-eval-print loop, but gets its input from a
	file instead of a dispframe.'

to type f t ((:f is string?(
		"f _ file f old?(f remove)
		!false))
	"t_string 30.
	repeat(f end?(done) disp_f next into t))

to t fool  :: fontname ('dispframe  ("defont _  file fontname intostring).'
	"disp_dispframe 16 480 514 184 string 520.
	disp _ version. "defs _ obset.
	to to toAtm (CODE 19 defs_toAtm. toAtm)
	to read str (%of?(:str. CODE 2) ! disp read)
	PUT USER "DO "(repeat (cr read eval print)). "t_0.)
PUT t "fontname fill string 6
ST8.AL
"version_fill string 34
Welcome to SMALLTALK [May 5]               

to quit f s t : : r b   (dsoff.
      (null :s?()
       "f _ file r.
       "t _ f intostring.
       f reset.
       f _ s.
       f _ 13.
       f _ t.
       f close).
    file b load)
PUT quit "r fill string 7
REM.CM.
PUT quit "b fill string 5
BOOT.

to os s : : r b   ("s _ :.
    file b save?
      (quit s + r))
PUT os "b fill string 9
BREAK.SV.
PUT os "r fill string 17
;RESUME BREAK.SV.

"fill _ nil

'Then execute...
	t. USER
...to install the ST dispframe and start the read-eval-print loop in ST.
When restarting from errors, execute...
	disp show. disp frame. USER
'

ALTO Smalltalk-72

X

–

Menu

Step

Run

  Lively-Web NOVA Emulator

Stop

 54657Y   STA 3,.-121; 023257
 26462-2  LDA 1,@.+62; 0521
125014    MOVN 1,1,SZR
   776    JMP .-2; 023401
 50626Q   STA 2,.-152; 023232
 50650Q   STA 2,.-130; 023255
 50672Q   STA 2,.-106; 023300
 40626A   STA 0,.-152; 023235
 20456!.  LDA 0,.+56; 023466
 24623)   LDA 1,.-155; 023234
 344559-  LDA 3,.+55; 023467
166000    ADC 3,1    
 61005b   BLT
 344539+  LDA 3,.+53; 023470
 54441Y!  STA 3,.+41; 023457
175235    MOVZRN 3,3,SNR
   413    JMP .+13; 023433
 20445!%  LDA 0,.+45; 023466
 24635)   LDA 1,.-143; 023257
 344449$  LDA 3,.+44; 023467
166000    ADC 3,1    
 61005b   BLT
 20440!   LDA 0,.+40; 023466
 24653)   LDA 1,.-125; 023302
 344379   LDA 3,.+37; 023467
166000    ADC 3,1    
 61005b   BLT
 306641   LDA 2,.-114; 023317
102460 0  SUBC 0,0    
 42423E   STA 0,@.+23; 0524
 41000B   STA 0,0,2
 41001B   STA 0,1,2
 41010B   STA 0,10,2
 24423)   LDA 1,.+23; 023464
 45011J   STA 1,11,2
 25002*   LDA 1,2,2
 344219   LDA 3,.+21; 023465
137404    AND 1,3,SZR
   425    JMP .+25; 023473
 40615A   STA 0,.-163; 023264
 40615A   STA 0,.-163; 023265
 40616A   STA 0,.-162; 023267
 40614A   STA 0,.-164; 023266
 344169   LDA 3,.+16; 023471
 25401+   LDA 1,1,3
 44613I   STA 1,.-165; 023270
   415    JMP .+15; 023473
     2    JMP 2; 02
   524 T  JMP .+124; 023604
     0    JMP 0; 00
177776    ANDCSN 3,3,SEZ
   521 Q  JMP .+121; 023604
 23253&   LDA 0,@-125,2
    40    JMP 40; 040
 22631%   LDA 0,@.-147; 023230
177770    ANDCSN 3,3    
     0    JMP 0; 00
 22716%   LDA 0,@.-62; 040626
 23226&   LDA 0,@-152,2
 24132(Z  LDA 1,132; 0132
 44770I   STA 1,.-10; 023464
 36766=   LDA 3,@.-12; 0521
175015    MOVN 3,3,SNR
 347649   LDA 3,.-14; 023463
 51400S   STA 2,0,3
 36762=   LDA 3,@.-16; 0521
175015    MOVN 3,3,SNR
   774    JMP .-4; 023477
 14756    DSZ .-22; 023462
   404    JMP .+4; 023511
 347639   LDA 3,.-15; 023471
 50762Q   STA 2,.-16; 023471
  1402    JMP 2,3
 35004:   LDA 3,4,2
 25404+   LDA 1,4,3
 21005"   LDA 0,5,2
 347459   LDA 3,.-33; 023461
163000    ADD 3,0    
 35021:   LDA 3,21,2
 41405C   STA 0,5,3
102460 0  SUBC 0,0    
 41400C   STA 0,0,3
 41401C   STA 0,1,3
 41410C   STA 0,10,3
 35404;   LDA 3,4,3
125400    INC 1,1    
 45404K   STA 1,4,3
 41400C   STA 0,0,3
 41403C   STA 0,3,3
 41402C   STA 0,2,3
 21011"   LDA 0,11,2
 41401C   STA 0,1,3
 3446393  LDA 3,.+63; 023617
 27004.   LDA 1,@4,2
 21001"   LDA 0,1,2
163405    AND 3,0,SNR
   421    JMP .+21; 023561
 344579/  LDA 3,.+57; 023620
116415    SUBN 0,3,SNR
   423    JMP .+23; 023566
 22717%   LDA 0,@.-61; 0521
101014    MOVN 0,0,SZR
   776    JMP .-2; 023544
 14715    DSZ .-63; 023464
   727    JMP .-51; 023477
 20706!   LDA 0,.-72; 023457
 24716)   LDA 1,.-62; 023470
106415    SUBN 0,1,SNR
   433    JMP .+33; 023607
 50707Q   STA 2,.-71; 023464
 310212   LDA 2,21,2
 310212   LDA 2,21,2
   416    JMP .+16; 023576
 21002"   LDA 0,2,2
 347039   LDA 3,.-75; 023465
125014    MOVN 1,1,SZR
117404    AND 0,3,SZR
   747    JMP .-31; 023534
  6704    JSR @.-74; 023226
 14701    DSZ .-77; 023470
125015    MOVN 1,1,SNR
   403    JMP .+3; 023574
 310212   LDA 2,21,2
   700    JMP .-100; 023473
 10675    ISZ .-103; 023471
 50667Q   STA 2,.-111; 023464
 24670)   LDA 1,.-110; 023466
 346709   LDA 3,.-110; 023467
166400    SUB 3,1    
 21004"   LDA 0,4,2
100400    NEG 0,0    
100000    COM 0,0    
 61005b   BLT
 20663!   LDA 0,.-115; 023470
 306561   LDA 2,.-122; 023464
 25011*   LDA 1,11,2
 346619   LDA 3,.-117; 023471
  1404    JMP 4,3
 306571   LDA 2,.-121; 023471
 20132 Z  LDA 0,132; 0132
116400    SUB 0,3    
 54654Y   STA 3,.-124; 023471
   716    JMP .-62; 023534
  7667    JSR @-111,3
  7400    JSR @0,3
177777    ANDCSN 3,3,SBN
  2144 d  JMP @144; 05453
LOAD:
 54420Y   STA 3,.+20; 023643
 3407088  LDA 3,70; 070
137000    ADD 1,3    
 21400#   LDA 0,0,3
  2414    JMP @.+14; 04767
 54413Y   STA 3,.+13; 023643
 3407088  LDA 3,70; 070
137000    ADD 1,3    
 41400C   STA 0,0,3
  2407    JMP @.+7; 04767
 54406Y   STA 3,.+6; 023643
 3407088  LDA 3,70; 070
137000    ADD 1,3    
 21400#   LDA 0,0,3
 25401+   LDA 1,1,3
  2401    JMP @.+1; 04767
  4767    JSR .-11; 023632
 300500(  LDA 2,50; 050
133000    ADD 1,2    
 21007"   LDA 0,7,2
  1400    JMP 0,3
 300500(  LDA 2,50; 050
133000    ADD 1,2    
 25007*   LDA 1,7,2
 41007B   STA 0,7,2
 40406A   STA 0,.+6; 023662
 54406Y   STA 3,.+6; 023663
121000    MOV 1,0    
  6165 u  JSR @165; 011352
 20402!   LDA 0,.+2; 023662
  2402    JMP @.+2; 024666
 25772+   LDA 1,372,3
 24666)   LDA 1,.-112; 023551
 54416Y   STA 3,.+16; 023702
 40775A   STA 0,.-3; 023662
 3407088  LDA 3,70; 070
137000    ADD 1,3    
 21400#   LDA 0,0,3
 40772A   STA 0,.-6; 023663
 20770!   LDA 0,.-10; 023662
 41400C   STA 0,0,3
 20767!   LDA 0,.-11; 023663
 44766I   STA 1,.-12; 023663
  6165 u  JSR @165; 011352
 20763!   LDA 0,.-15; 023662
 24763)   LDA 1,.-15; 023663
  2401    JMP @.+1; 05131
  5131 Y  JSR 131,2
 40100@@  STA 0,100; 0100 =CURRENT
 3007008  LDA 2,70; 070
113000    ADD 0,2    
 50050P(  STA 2,50; 050
151400    INC 2,2    
 50051P)  STA 2,51; 051
151400    INC 2,2    
 50052P*  STA 2,52; 052
151400    INC 2,2    
 50053P+  STA 2,53; 053
151400    INC 2,2    
 50054P,  STA 2,54; 054
151400    INC 2,2    
 50055P-  STA 2,55; 055
151400    INC 2,2    
 50056P.  STA 2,56; 056
151400    INC 2,2    
 50057P/  STA 2,57; 057
  1400    JMP 0,3
 22053$+  LDA 0,@53; 0124151
 3007008  LDA 2,70; 070
113001    ADD 0,2,SKP
 300500(  LDA 2,50; 050
 25001*   LDA 1,1,2
 54710Y   STA 3,.-70; 023643
 3407088  LDA 3,70; 070
137000    ADD 1,3    
 21401#   LDA 0,1,3
101414    INCN 0,0,SZR
 11001    ISZ 1,2
  2702    JMP @.-76; 04767
 22053$+  LDA 0,@53; 0124151
 3007008  LDA 2,70; 070
113000    ADD 0,2    
 21001"   LDA 0,1,2
  1400    JMP 0,3
 54674Y   STA 3,.-104; 023643
 3407088  LDA 3,70; 070
137000    ADD 1,3    
 21401#   LDA 0,1,3
101414    INCN 0,0,SZR
125400    INC 1,1    
  2666    JMP @.-112; 04767
MATCHTOKEN:
 54423Y   STA 3,.+23; 024001
 40423A   STA 0,.+23; 024002
 22053$+  LDA 0,@53; 0124151
 3007008  LDA 2,70; 070
113000    ADD 0,2    
 25001*   LDA 1,1,2
 3407088  LDA 3,70; 070
137000    ADD 1,3    
 21401#   LDA 0,1,3
 344139   LDA 3,.+13; 024002
101414    INCN 0,0,SZR
116414    SUBN 0,3,SZR
   405    JMP .+5; 023777
 341268V  LDA 3,126; 0126
116414    SUBN 0,3,SZR
 11001    ISZ 1,2
  2403    JMP @.+3; 02416
 344029   LDA 3,.+2; 024001

this.AC0 = 0142007;   this.AC1 =  024324;
this.AC2 =   02104;   this.AC3 =  054666;
this.PC  =  023626;   this.CRY =       0;
// instruction# = 390

Restart

Show Smalltalk

About Smalltalk-72

About this Emulation

About Lively Web

Open the ST-72 Manual

ALLDEFS

Keyboard Help

Snippets1

Snippets2

Snippets3

Snippets4

Snippets4

X

–

Menu

A series of snippets for demonstration at HOPL-2020. 

If you click twice to the right of an Alto character , it will select from there to the following do-it character , and then type that in to the Smalltalk-72 simulation here.  You can type there directly of course, ending with a backslash for do-it.  If you get a debug window, type 'done\' (five characters, no quotes) directly into the St-72 window.  typing esc will restart the evaluator at any time.  For a complete restart, press Show-Nova, Restart, Show-Smalltalk.

Now have a seat and we'll take a look at Smalltalk-72...

3+4
We always typed this as out first evaluation after a new build.  It tests a lot of the system including how to read from keyboard, build and eval code vectors and print to the display.  For a first-timer, this is a chance to explain that this sequence means: start with 3, and pass it the message +4, something that 3 understands and can return an appropriate result.  After the do-it character we print the result and invite more input. 

@ go 100
We are introduced to 'Smiley' the resident turtle object (typed as an at-sign).  @ understands the message 'go', just as 3 understands '+'.

do 4 (@ go 100 turn 90)
We talk about how @ has a heading, as you do when you are walking, and that 'turn' causes it to turn by some number of degrees.  Here is a chance to talk through why this square is where it is on the screen.  We are following a loose 'turtle geometry curriculum' inspired by the work of Seymour Pappert.

@ home up erase.  disp display
We talk about housekeeping - Smiley is in charge of the display.  'home' takes her back to the center, 'up' tells her to point upwards, and 'erase' clears the screen.

for i to 300 do (@ go i turn 90)

Here is the code for for...
to for token step stop var start exp (
	:"var.
	(%_?(:start.) "start_1).
	(%to?(:stop.) "stop_start.)
	(%by?(:step.) "step_1.)
	%do. :#exp. CODE 24)

@ home up.
        for i to 300 (@ go i turn 90)

A little bit of housekeeping
to kbd c ("c _ TTY. c = 19?(!19) !kmap[c]).
    to within obj ISIT (:obj. :"ISIT. !obj is).
    addto turtle "(%width?(%_. :width.  !SELF)).
    disp clear

Let's make it easy to read the mouse location and button presses
to mouse x (
     %down?(!0=mouse 1) 
     %up?(!1=mouse 1)
     %pt?(!point mx my) 
     %waitup?(repeat (mouse up?(done)). !mouse pt)
     %waitdown?(repeat (mouse down?(done)). !mouse pt)
     :x. CODE 35)

Without much ado, we have the beginnings of a paint program
to paint (@ erase. @ width _ 3.
    repeat (@ penup goto mx my pendn.
      repeat (mouse up?(done) @ goto mx my)))
End this by pressing the escape key in the St window.
------

"disp _ dispframe 16 480 396 284 string 1000. disp frame

to point d p : x y (
    isnew?(:x. :y. !SELF)
    %x?(!x)
    %y?(!y)
    %+?(:p. !point x + p x  y + p y)
    %-?(:p. !point x - p x  y - p y)
    %=?(:p. x = p x ?(y = p y ?(!p) !false) !false)
    %<?(:p. x < p x ?(y < p y ?(!p) !false) !false)
    %*?(:d. !point x * d  y * d)
    %/?(:d. !point x / d  y / d)
    %rect?(:p. !rectangle SELF p)
    %print?(x print. disp _ ' pt '. y print))

to pt x y (:x. :y. !point x y)

to web q newpt oldpt lastpt avg qi (
    @ erase width _ 1. "q _ vector 20.
    repeat ("qi _ 1. mouse waitdown.
        "avg _ "lastpt _ mouse pt.
        q[1 to q length] _ all avg.
        repeat (mouse up?(done)
            "newpt _ mouse pt.
            newpt = lastpt?()
            (qi = q length?("qi _ 1) "qi _ qi+1).
            "oldpt _ q[qi].
            "avg _ (newpt+avg*4)/5.
            @penup goto avg x avg y.
            @pendn goto oldpt x oldpt y.
            "lastpt _ newpt.
            q[qi] _ avg)))

to rectangle a d p : origin corner (
    isnew?(%fromuser?("origin _ mouse waitdown.
            "corner _ origin + point 5 5.
            repeat( SELF frame black.  mouse up?(done).
                    SELF frame white. "corner _ mouse pt) !SELF)
        :origin. :corner. !SELF)
    %origin?(%_?(:origin) !origin)
      %x?(!origin x)
      %y?(!origin y)
    %corner?(%_?(:corner) !corner)
      %width?(!corner x - origin x)
      %height?(!corner y - origin y)
    %center?(!origin + corner / 2)
    %contains?(:p. origin < p?(p < corner?(!p) !false) !false)
    %print?(origin print. disp _ ' rect '. corner print)
    %frame ("a _ turtle at origin x - 1 origin y - 1.
	a width _ 2. (%white?(a white) %black. a black).
	do 2 (a turn 90 go SELF width + 2 turn 90 go SELF height + 2))
    )

"r _ rectangle fromuser
------
to window f buf : frame disp (
    isnew?(%fromuser. "frame _ "f _ rectangle fromuser. 
        "disp _ dispframe f x f width f y f height string 800.
        disp "("winht _ frmht). !SELF)
   %is?(ISIT eval)
   %run?(frame contains mouse pt?( 
            disp _ 20. sched promote SELF. disp frame black. disp show.
            repeat (kbck?(disp _ 8. read eval print. cr. disp _ 20).  
                frame contains mouse pt?() 
                mouse down?(disp _ 8. done)))))

to scheduler w : windows (
    isnew?("windows _ obset)
    %run?(repeat (windows map "(vec[i] run)))
    %promote?("w_:.  windows delete w.  windows add w)
    %windows?(!windows)
    %add?("w _ :. windows add w))

@ erase. "disp _ dispframe 16 480 610 80 string 600. disp frame black

"sched _ scheduler

sched run


done