'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' poop '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 correct.' 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 '