PowerPC relocation

Makefile

@@ -1,5 +1,5 @@
 CC = gcc
-DEFAULT_CFLAGS = -Wall -O3 -fomit-frame-pointer $(SITE_CFLAGS)
+DEFAULT_CFLAGS = -Wall -Os -fomit-frame-pointer $(SITE_CFLAGS)
 DEFAULT_LIBS = -lm
 
 STRIP = strip
@@ -31,6 +31,7 @@ default:
 	@echo "bsd"
 	@echo "bsd-nopthread - on FreeBSD 4, if you want to use profiling"
 	@echo "linux"
+	@echo "linux-ppc - to compile Factor on Linux/PowerPC"
 	@echo "macosx"
 	@echo "solaris"
 	@echo "windows"
@@ -57,6 +58,11 @@ macosx:
 		LIBS="$(DEFAULT_LIBS)" 
 
 linux:
+	$(MAKE) f \
+		CFLAGS="$(DEFAULT_CFLAGS) -DFFI -export-dynamic" \
+		LIBS="$(DEFAULT_LIBS) -ldl" 
+
+linux-ppc:
 	$(MAKE) f \
 		CFLAGS="$(DEFAULT_CFLAGS) -DFFI -export-dynamic -mregnames" \
 		LIBS="$(DEFAULT_LIBS) -ldl" 

TODO.FACTOR.txt

@@ -9,11 +9,12 @@ I wrote down some issues I found while reading the devel-guide.pdf:
 
 - word preview for remote words
 - faster completion
+- file properties for constructors, accessors/mutators, predicates
+- set 'end' of artifacts/assets accurately
 
 + ui:
 
 - single-pixel shuffle
-- resizing a gadget should probably relayout children
 - resizing: drag relative to initial click pos
 - mouse enter onto overlapping with interior, but not child, gadget
 - menu dragging
@@ -26,6 +27,7 @@ I wrote down some issues I found while reading the devel-guide.pdf:
 
 + compiler/ffi:
 
+- mac os x ffi
 - [ [ dup call ] dup call ] infer hangs
 - ffi unicode strings: null char security hole
 - utf16 string boxing

doc/tools.tex

@@ -3,7 +3,9 @@
 \usepackage{tabularx}
 \usepackage{alltt}
 
-\newcommand{\ttbs}{\char'134}
+\newcommand{\ttbs}{\symbol{92}}
+\newcommand{\tto}{\symbol{123}}
+\newcommand{\ttc}{\symbol{125}}
 \begin{document}
 
 \title{The Factor Development Environment}
@@ -23,6 +25,8 @@ incrementally make changes to your application and test them immediately. If you
 notice an undesirable behavior, Factor's powerful reflection features will aid in
 pinpointing the error.
 
+If you are used to a statically typed language, you might find Factor's tendency to only fail at runtime hard to work with at first. However, the interactive development tools outlined in this document allow a much quicker turn-around time for testing changes. Also, write unit tests -- unit testing is a great way to ensure that old bugs do not re-appear once they've been fixed.
+
 \section{System organization}
 
 \subsection{The listener}
@@ -129,13 +133,38 @@ This is what is meant by the image being an \emph{infinite session}. When you sh
 
 Probably the most important debugging tool of them all is the \texttt{.} word. It prints the object at the top of the stack in a form that can be parsed by the Factor parser. A related word is \texttt{prettyprint}. It is identical to \texttt{.} except the output is more verbose; lists, vectors and hashtables are broken up into multiple lines and indented.
 
-Most objects print in a parsable form, but not all. One exceptions to this rule is objects with external state, such as I/O ports or aliens (pointers to native structures). Also, objects with circular or very deeply nested structure will not print in a fully parsable form, since the prettyprinter has a limit on maximum nesting.
+\begin{alltt}
+\textbf{ok} [ [ \tto 1 \ttc \tto 2 \ttc ] dup car swap cdr ] .
+[ [ \tto 1 \ttc \tto 2 \ttc ] dup car swap cdr ]
+\end{alltt}
 
-The prettyprinted form of a vector or list with many elements is not always readable. The \texttt{[.]} and \texttt{\{.\}} words output a list or a vector, respectively, with each element on its own line.
+Most objects print in a parsable form, but not all. One exceptions to this rule is objects with external state, such as I/O ports or aliens (pointers to native structures). Also, objects with circular or very deeply nested structure will not print in a fully parsable form, since the prettyprinter has a limit on maximum nesting. Here is an example -- a vector is created, that holds a list whose first element is the vector itself:
 
-. prints an object in almost-readable form
+\begin{alltt}
-printing numbers in other bases
+\textbf{ok} \tto \ttc [ unit 0 ] keep [ set-vector-nth ] keep .
-we can inspect memory with  instances references heap-stats
+\tto [ ... ] \ttc
+\end{alltt}
+
+The prettyprinted form of a vector or list with many elements is not always readable. The \texttt{[.]} and \texttt{\tto.\ttc} words output a list or a vector, respectively, with each element on its own line. In fact, the stack printing words are defined in terms of \texttt{[.]} and \texttt{\tto.\ttc}:
+
+\begin{verbatim}
+: .s datastack  {.} ;
+: .r callstack  {.} ;
+: .n namestack  [.] ;
+: .c catchstack [.] ;
+\end{verbatim}
+
+Before we move on, one final set of output words comes is used to output integers in
+different numeric bases. The \texttt{.b} word prints an integer in binary, \texttt{.o} in octal, and \texttt{.h} in hexadecimal.
+
+\begin{alltt}
+\textbf{ok} 31337 .b
+\textbf{111101001101001}
+\textbf{ok} 31337 .o
+\textbf{75151}
+\textbf{ok} 31337 .h
+\textbf{7a69}
+\end{alltt}
 
 \section{Word tools}
 
@@ -252,8 +281,6 @@ You can even start the HTTP in a separate thread, and look at code in your web b
 
 \section{Dealing with runtime errors}
 
-Since Factor does very little ``static'' or compile-time checking, you will have to learn how to deal with and fix runtime errors. On the upside, the tools available are pretty nice.
-
 \subsection{Looking at stacks}
 
 To see the contents of the data stack, use the \texttt{.s} word. Similarly, the other stacks can be shown with \texttt{.r} (return stack), \texttt{.n} (name stack), and \texttt{.c} (catch stack). Each stack is printed with each element on its own line; the top of the stack is the first element printed.
@@ -308,7 +335,7 @@ So now, the mystery has been solved: as \texttt{reverse} iterates down the input
 [[ 1 [[ 2 [[ 3 4 ]] ]] ]]
 \end{alltt}
 
-In the future, the debugger will be linked with the walker, documented below. Right now, the walker is a separate tool. Another caveat is that in compiled code, the return stack is not reconstructed if there is an error. Until this is fixed, you should only compile code once it is debugged. Finally, remember that unit testing is a great way to ensure that old bugs do not re-appear once they've been fixed.
+In the future, the debugger will be linked with the walker, documented below. Right now, the walker is a separate tool. Another caveat is that in compiled code, the return stack is not reconstructed if there is an error. Until this is fixed, you should only compile code once it is debugged. For more potential compiler pitfalls, see \ref{compiler}.
 
 \subsection{The walker}
 
@@ -361,18 +388,243 @@ You can undo the effect of \texttt{break} or \texttt{watch} by reloading the ori
 
 \subsection{Dealing with hangs}
 
-If you accidentally start an infinite loop, you can send the Factor runtime a \texttt{QUIT} signal. On Unix, this is done by pressing \textbf{Control-\ttbs} in the controlling terminal. This will cause the runtime to dump the data and return stacks in a semi-readable form. Note that this will help you find the root cause of the hang, but it will not let you interrupt the infinite loop.
+If you accidentally start an infinite loop, you can send the Factor runtime a \texttt{QUIT} signal. On Unix, this is done by pressing \texttt{Control-\ttbs} in the controlling terminal. This will cause the runtime to dump the data and return stacks in a semi-readable form. Note that this will help you find the root cause of the hang, but it will not let you interrupt the infinite loop.
+
+
+\section{Defensive coding}
+
+\subsection{Unit testing}
+
+Unit tests are very easy to write. They are usually placed in source files. A unit test can be executed with the \texttt{unit-test} word in the \texttt{test} vocabulary. This word takes a list and a quotation; the quotation is executed, and the resulting data stack is compared against the list. If they do not equal, the unit test has failed. Here is an example of a unit test:
+
+\begin{verbatim}
+[ "Hello, crazy world" ] [
+    "editor" get [ 0 caret set ] bind
+    ", crazy" 5 "editor" get [ line-insert ] bind
+    "editor" get [ line-text get ] bind
+] unit-test
+\end{verbatim}
+
+To have a unit test assert that a piece of code does not execute successfully, but rather throws an exception, use the \texttt{unit-test-fails} word. It takes only one quotation; if the quotation does \emph{not} throw an exception, the unit test has failed.
+
+\begin{verbatim}
+[ -3 { } vector-nth ] unit-test-fails
+\end{verbatim}
+
+Unit testing is a good habit to get into. Sometimes, writing tests first, before any code, can speed the development process too; by running your unit test script, you can gauge progress.
 
 \subsection{Stack effect inference}
 
+While most programming errors in Factor are only caught at runtime, the stack effect checker can be useful for checking correctness of code before it is run. It can also help narrow down problems with stack shuffling. The stack checker is used by passing a quotation to the \texttt{infer} word. It uses a sophisticated algorithm to infer stack effects of recursive words, combinators, and other tricky constructions, however, it cannot infer the stack effect of all words. In particular, anything using continuations, such as \texttt{catch} and I/O, will stump the stack checker. Despite this fault, it is still a useful tool.
+
+\begin{alltt}
+\textbf{ok} [ pile-fill * >fixnum over pref-size dup y
+\texttt{...} [ + ] change ] infer .
+\textbf{[ [ tuple number tuple ] [ tuple fixnum object number ] ]}
+\end{alltt}
+
+The stack checker will report an error it it cannot infer the stack effect of a quotation. The ``recursive state'' dump is similar to a return stack, but it is not a real return stack, since only a code walk is taking place, not full evaluation. Understanding recursive state dumps is an art, much like understanding return stacks.
+
+\begin{alltt}
+\textbf{ok} [ 100 [ f f cons ] repeat ] infer .
+\textbf{! Inference error: Unbalanced branches
+! Recursive state:
+! [ (repeat) G:54044 pick pick >= [ 3drop ]
+    [ [ swap >r call 1 + r> ] keep (repeat) ] ifte ]
+! [ repeat G:54042 0 -rot (repeat) ]
+:s :r :n :c show stacks at time of error.
+:get ( var -- value ) inspects the error namestack.}
+\end{alltt}
+
+One reason stack inference might fail is if the quotation contains unbalanced branches, as above. For the inference to work, both branches of a conditional must exit with the same stack height.
+
+Another situation when it fails is if your code calls quotations that are not statically known. This can happen if the word in question uses continuations, or if it pulls a quotation from a variable and calls it. This can also happen if you wrote your own combinator, but forgot to mark it as \texttt{inline}. For example, the following will fail:
+
+\begin{alltt}
+\textbf{ok} : dip swap >r call r> ;
+\textbf{ok} [ [ + ] dip * ] infer .
+! Inference error: A literal value was expected where a
+computed value was found: \#<computed @ 679711507>
+...
+\end{alltt}
+
+However, defining \texttt{dip} to be inlined will work:
+
+\begin{alltt}
+\textbf{ok} : dip swap >r call r> ; inline
+\textbf{ok} [ [ + ] dip * ] infer .
+\textbf{[ [ number number number ] [ number ] ]}
+\end{alltt}
+
 \section{Optimization}
 
+While both the Factor interpreter and compiler are relatively slow at this stage, there
+are still ways you can make your Factor code go faster. The key is to find bottlenecks,
+and optimize them.
+
 \subsection{Timing code}
 
-\subsection{\label{compiler}The compiler}
+The \texttt{time} word reports the time taken to execute a quotation, in milliseconds. The portion of time spent in garbage collection is also shown:
 
-precompile
+\begin{alltt}
+\textbf{ok} [ 1000000 [ f f cons drop ] repeat ] time
+\textbf{515 milliseconds run time
+11 milliseconds GC time}
+\end{alltt}
+
+\subsection{Exploring memory usage}
+
+Factor supports heap introspection. You can find all objects in the heap that match a certain predicate using the \texttt{instances} word. For example, if you suspect a resource leak, you can find all I/O ports as follows:
+
+\begin{alltt}
+\textbf{ok} USE: io-internals
+\textbf{ok} [ port? ] instances .
+\textbf{[ \#<port @ 805466443> \#<port @ 805466499> ]}
+\end{alltt}
+
+The \texttt{references} word finds all objects that refer to a given object:
+
+\begin{alltt}
+\textbf{ok} [ float? ] instances car references .
+\textbf{[ \#<array @ 805542171> [ -1.0 0.0 / ] ]}
+\end{alltt}
+
+You can print a memory usage summary with \texttt{room.}:
+
+\begin{alltt}
+\textbf{ok} room.
+\textbf{Data space: 16384 KB total 2530 KB used 13853 KB free
+Code space: 16384 KB total 490 KB used 15893 KB free}
+\end{alltt}
+
+And finally, a detailed memory allocation breakdown by type with \texttt{heap-stats.}:
+
+\begin{alltt}
+\textbf{ok} heap-stats.
+\textbf{bignum: 312 bytes, 17 instances
+cons: 850376 bytes, 106297 instances
+float: 112 bytes, 7 instances
+t: 8 bytes, 1 instances
+array: 202064 bytes, 3756 instances
+hashtable: 54912 bytes, 3432 instances
+vector: 5184 bytes, 324 instances
+string: 391024 bytes, 7056 instances
+sbuf: 64 bytes, 4 instances
+port: 112 bytes, 2 instances
+word: 96960 bytes, 3030 instances
+tuple: 688 bytes, 22 instances}
+\end{alltt}
 
 \subsection{The profiler}
 
+Factor provides a statistical sampling profiler for narrowing down memory and processor bottlenecks.
+The profiler is only supported on Unix platforms. On FreeBSD 4.x, the Factor runtime must
+be compiled without the \texttt{-pthread} switch, since FreeBS 4.x userspace threading makes
+use of a signal that conflicts with the signal used for profiling.
+
+The \texttt{allot-profile} word executes a quotation with the memory profiler enabled, then prints a list of all words that allocated memory, along with the bytes allocated. Note that during particularly long executions, or executions where a lot of memory is allocated, these counters may overrun.
+
+\begin{alltt}
+\textbf{ok} [ "boot.image.le32" make-image ] allot-profile
+\emph{... many lines omitted ...}
+\textbf{[[ write-little-endian-32 673952 ]]
+[[ wait-to-read-line 788640 ]]
+[[ blocking-read-line 821264 ]]
+[[ vocabularies 822624 ]]
+[[ parse-resource 823376 ]]
+[[ next-line 1116440 ]]
+[[ vector-map 1326504 ]]
+[[ fixup-words 1326520 ]]
+[[ vector-each 1768640 ]]
+[[ (parse) 2434208 ]]
+[[ classes 2517920 ]]
+[[ when* 2939088 ]]
+[[ while 3614408 ]]
+[[ (parse-stream) 3634552 ]]
+[[ make-list 3862000 ]]
+[[ object 4143784 ]]
+[[ each 4712080 ]]
+[[ run-resource 5036904 ]]
+[[ (callcc) 5183400 ]]
+[[ catch 5188976 ]]
+[[ 2slip 8631736 ]]
+[[ end 202896600 ]]
+[[ make-image 208611888 ]]
+[[ with-scope 437823992 ]]}
+\end{alltt}
+
+The \texttt{call-profile} word executes a quotation with the CPU profiler enabled, then prints a list of all words that were found on the return stack, along with the number of times they were seen there. This gives a rough idea of what words are taking up the majority of execution time.
+
+\begin{alltt}
+\textbf{ok} [ "boot.image.le32" make-image ] call-profile
+\emph{... many lines omitted ...}
+\textbf{[[ stream-write 7 ]]
+[[ wait-to-write 7 ]]
+[[ vector-map 11 ]]
+[[ fixup-words 11 ]]
+[[ when* 12 ]]
+[[ write 16 ]]
+[[ write-word 17 ]]
+[[ parse-loop 22 ]]
+[[ make-list 24 ]]
+[[ (parse) 29 ]]
+[[ blocking-write 32 ]]
+[[ while 35 ]]
+[[ (parse-stream) 36 ]]
+[[ dispatch 47 ]]
+[[ run-resource 50 ]]
+[[ write-little-endian-32 76 ]]
+[[ (callcc) 173 ]]
+[[ catch 174 ]]
+[[ each 175 ]]
+[[ 2slip 199 ]]
+[[ end 747 ]]
+[[ make-image 785 ]]
+[[ with-scope 1848 ]]}
+\end{alltt}
+
+Normally, the memory and CPU profilers run every millisecond, and increment counters for all words on the return stack. The \texttt{only-top} variable can be switched on, in which case only the counter for the word at the top of the return stack is incremented. This gives a more localized picture of CPU and memory usage.
+
+\subsection{\label{compiler}The compiler}
+
+The compiler can provide a substantial speed boost for words whose stack effect can be inferred. Words without a known stack effect cannot be compiled, and must be run in the interpreter. The compiler generates native code, and so far, x86 and PowerPC backends have been developed.
+
+To compile a single word, call \texttt{compile}:
+
+\begin{alltt}
+\textbf{ok} \ttbs pref-size compile
+\textbf{Compiling pref-size}
+\end{alltt}
+
+During bootstrap, all words in the library with a known stack effect are compiled. You can
+circumvent this, for whatever reason, by passing the \texttt{-no-compile} switch during
+bootstrap:
+
+\begin{alltt}
+\textbf{bash\$} ./f boot.image.le32 -no-compile
+\end{alltt}
+
+The compiler has some limitations you must be aware of. The most important one is that if you
+redefine
+a word that is called from a compiled word, the change will not take effect until the caller words are themselves recompiled.
+The second limitation is that if an exception is thrown in compiled code, the return stack will be incomplete, since compiled words do not push themselves there. Finally, compiled code cannot be profiled, either. All of these limitations will be resolved in a future release.
+
+The compiler consists of multiple stages -- first, a dataflow graph is inferred, then various optimizations are done on this graph, then it is transformed into a linear representation, further optimizations are done, and finally, machine code is generated from the linear representation. To perform everything except for the machine code generation, use the \texttt{precompile} word. This will dump the optimized linear IR instead of generating code, which can be useful sometimes.
+
+\begin{alltt}
+\textbf{ok} \ttbs append precompile
+\textbf{[ \#prologue ]
+[ over ]
+[[ \#jump-t-label G:54091 ]]
+[ swap ]
+[ drop ]
+[ \#return ]
+[[ \#label G:54091 ]]
+[ >r ]
+[[ \#call uncons ]]
+[ r> ]
+[[ \#call append ]]
+[[ \#jump cons ]]}
+\end{alltt}
+
 \end{document}

library/bootstrap/boot-stage2.factor

@@ -145,11 +145,11 @@ t [
     "/library/ui/events.factor"
     "/library/ui/scrolling.factor"
     "/library/ui/editors.factor"
-    "/library/ui/dialogs.factor"
     "/library/ui/menus.factor"
     "/library/ui/presentations.factor"
     "/library/ui/panes.factor"
     "/library/ui/tiles.factor"
+    "/library/ui/dialogs.factor"
     "/library/ui/inspector.factor"
     "/library/ui/init-world.factor"
     "/library/ui/tool-menus.factor"

library/cli.factor

@@ -50,9 +50,6 @@ kernel-internals ;
     #! Some flags are *on* by default, unless user specifies
     #! -no-<flag> CLI switch
     "user-init" on
-    "interactive" on
-    "smart-terminal" on
-    "verbose-compile" on
     "compile" on
     os "win32" = "ui" "ansi" ? "shell" set ;
 

library/compiler/ppc/generator.factor

@@ -39,34 +39,34 @@ words ;
 ! Far calls are made to addresses already known when the
 ! IR node is being generated. No forward reference far
 ! calls are possible.
-: compile-call-far ( n -- )
+: compile-call-far ( word -- )
-    19 LOAD
+    dup word-xt 19 LOAD32 rel-primitive-16/16
     19 MTLR
     BLRL ;
 
 : compile-call-label ( label -- )
     dup primitive? [
-        word-xt compile-call-far
+        compile-call-far
     ] [
         0 BL relative-24
     ] ifte ;
 
 #call-label [
     ! Hack: length of instruction sequence that follows
-    compiled-offset 20 + 18 LOAD32
+    compiled-offset 20 + 18 LOAD32 rel-address-16/16
     1 1 -16 STWU
     18 1 20 STW
     0 B relative-24
 ] "generator" set-word-prop
 
-: compile-jump-far ( n -- )
+: compile-jump-far ( word -- )
-    19 LOAD
+    dup word-xt 19 LOAD32 rel-primitive-16/16
     19 MTCTR
     BCTR ;
 
 : compile-jump-label ( label -- )
     dup primitive? [
-        word-xt compile-jump-far
+        compile-jump-far
     ] [
         0 B relative-24
     ] ifte ;
@@ -94,7 +94,7 @@ words ;
     18 18 1 SRAWI
     ! The value 24 is a magic number. It is the length of the
     ! instruction sequence that follows to be generated.
-    compiled-offset 24 + 19 LOAD32
+    compiled-offset 24 + 19 LOAD32 rel-address-16/16
     18 18 19 ADD
     18 18 0 LWZ
     18 MTLR

library/compiler/xt.factor

@@ -29,6 +29,14 @@ SYMBOL: relocation-table
     #! If flag is true; relative.
     over primitive? [ rel-primitive ] [ nip rel-address ] ifte ;
 
+! PowerPC relocations
+
+: rel-primitive-16/16 ( word -- )
+    5 rel, relocating word-primitive rel, ;
+
+: rel-address-16/16 ( -- )
+    6 rel, relocating 0 rel, ;
+
 ! We use a hashtable "compiled-xts" that maps words to
 ! xt's that are currently being compiled. The commit-xt's word
 ! sets the xt of each word in the hashtable to the value in the

library/ui/borders.factor

@@ -17,7 +17,7 @@ C: border ( child delegate size -- border )
     <empty-gadget> 5 <border> ;
 
 : line-border ( child -- border )
-    0 0 0 0 <hollow-rect> <gadget> 5 <border> ;
+    0 0 0 0 <etched-rect> <gadget> 5 <border> ;
 
 : filled-border ( child -- border )
     0 0 0 0 <plain-rect> <gadget> 5 <border> ;

library/ui/checkboxes.factor

@@ -7,7 +7,7 @@ USING: generic kernel lists math namespaces sdl ;
 
 : <check> ( -- cross )
     0 0 check-size dup <line> <gadget>
-    >r check-size 1 - 0 check-size neg check-size <line> <gadget> r>
+    >r check-size 0 check-size neg check-size <line> <gadget> r>
     2list <stack> ;
 
 TUPLE: checkbox bevel selected? ;

library/ui/dialogs.factor

@@ -14,17 +14,19 @@ TUPLE: dialog continuation ;
 
 : <dialog-buttons> ( -- gadget )
     <default-shelf>
-    "OK" [ [ dialog-ok ] swap handle-gesture drop ]
+    "OK" f <button>
-    <button> over add-gadget
+    dup [ dialog-ok ] [ action ] link-action
-    "Cancel" [ [ dialog-cancel ] swap handle-gesture drop ]
+    over add-gadget
-    <button> over add-gadget ;
+    "Cancel" f <button>
+    dup [ dialog-cancel ] [ action ] link-action
+    over add-gadget ;
 
 : dialog-actions ( dialog -- )
     dup [ dialog-ok ] dup set-action
     [ dialog-cancel ] dup set-action ;
 
 C: dialog ( content -- gadget )
-    [ f line-border swap set-delegate ] keep
+    [ <empty-gadget> swap set-delegate ] keep
     [
         >r <default-pile>
         [ add-gadget ] keep
@@ -45,4 +47,7 @@ C: dialog ( content -- gadget )
     #! Show an input dialog and resume the current continuation
     #! when the user clicks OK or Cancel. If they click Cancel,
     #! push f.
-    [ <input-dialog> world get add-gadget (yield) ] callcc1 ;
+    [
+        <input-dialog> "Input" <tile> world get add-gadget
+        (yield)
+    ] callcc1 ;

library/ui/frames.factor

@@ -1,3 +1,6 @@
+! Copyright (C) 2005 Slava Pestov.
+! See http://factor.sf.net/license.txt for BSD license.
+IN: gadgets
 USING: gadgets generic kernel lists math namespaces sdl words ;
 
 ! A frame arranges left/right/top/bottom gadgets around a
@@ -86,7 +89,7 @@ SYMBOL: frame-bottom-run
 
 : pos-frame-right
     [
-        >r \ frame-right-run get \ frame-top get r> pref-size drop
+        >r \ frame-right get \ frame-top get r> pref-size drop
         \ frame-bottom-run get
     ] keep reshape-gadget ;
 
@@ -97,7 +100,7 @@ SYMBOL: frame-bottom-run
 
 : pos-frame-bottom
     [
-        >r \ frame-left get \ frame-bottom-run get \ frame-right get
+        >r \ frame-left get \ frame-bottom get \ frame-right get
         r> pref-size nip
     ] keep reshape-gadget ;
 

library/ui/gadgets.factor

@@ -31,7 +31,7 @@ C: gadget ( shape -- gadget )
     gadget-parent [ relayout ] when* ;
 
 : move-gadget ( x y gadget -- ) [ move-shape ] keep redraw ;
-: resize-gadget ( w h gadget -- ) [ resize-shape ] keep redraw ;
+: resize-gadget ( w h gadget -- ) [ resize-shape ] keep relayout ;
 
 : paint-prop ( gadget key -- value ) swap gadget-paint hash ;
 : set-paint-prop ( gadget value key -- ) rot gadget-paint set-hash ;

library/ui/gestures.factor

@@ -26,6 +26,10 @@ USING: alien generic hashtables kernel lists math sdl ;
     #! gesture, otherwise returns f.
     [ dupd handle-gesture* ] each-parent nip ;
 
+: link-action ( gadget to from -- )
+    #! When gadget receives 'from' gesture, send a 'to' gesture.
+    >r [ swap handle-gesture drop ] cons r> set-action ;
+
 : user-input ( ch gadget -- ? )
     [ dupd user-input* ] each-parent nip ;
 

library/ui/init-world.factor

@@ -1,14 +1,12 @@
 ! Copyright (C) 2005 Slava Pestov.
 ! See http://factor.sf.net/license.txt for BSD license.
 IN: gadgets
-USING: namespaces ;
+USING: generic kernel math namespaces ;
+
 
 global [
-    
     <world> world set
     
-    1280 1024 world get resize-gadget
-    
     {{
 
         [[ background [ 255 255 255 ] ]]
@@ -16,4 +14,6 @@ global [
         [[ reverse-video f ]]
         [[ font [[ "Sans Serif" 12 ]] ]]
     }} world get set-gadget-paint
+    
+    1024 768 world get resize-gadget
 ] bind

library/ui/inspector.factor

@@ -5,7 +5,7 @@ USING: errors gadgets generic hashtables kernel kernel-internals
 lists namespaces strings unparser vectors words ;
 
 : label-box ( list -- gadget )
-    <line-pile> swap [ <presentation> over add-gadget ] each ;
+    0 0 0 <pile> swap [ <presentation> over add-gadget ] each ;
 
 : unparse* ( obj -- str ) dup string? [ unparse ] unless ;
 

library/ui/lines.factor

@@ -26,6 +26,7 @@ M: line move-shape ( x y line -- )
     tuck move-line-y move-line-x ;
 
 : resize-line-w ( w line -- )
+    >r 1 - r>
     dup line-w 0 >= [
         set-line-w
     ] [
@@ -35,6 +36,7 @@ M: line move-shape ( x y line -- )
     ] ifte ;
 
 : resize-line-h ( w line -- )
+   >r 1 - r>
     dup line-h 0 >= [
         set-line-h
     ] [

library/ui/rectangles.factor

@@ -75,6 +75,16 @@ C: plain-rect ( x y w h -- rect )
 M: plain-rect draw-shape ( rect -- )
     >r surface get r> plain-rect ;
 
+! A rectangle that is filled with the background color and also
+! has an outline.
+TUPLE: etched-rect ;
+
+C: etched-rect ( x y w h -- rect )
+    [ >r <rectangle> r> set-delegate ] keep ;
+
+M: etched-rect draw-shape ( rect -- )
+    >r surface get r> 2dup plain-rect hollow-rect ;
+
 ! A rectangle that has a visible outline only if the rollover
 ! paint property is set.
 SYMBOL: rollover?

library/ui/tiles.factor

@@ -11,16 +11,19 @@ USING: generic kernel math namespaces ;
     screen-pos
     hand [ hand-clicked screen-pos - ] keep hand-click-rel - ;
 
-: drag-tile ( tile -- )
+: move-tile ( tile -- )
     dup click-rel hand screen-pos + >rect rot move-gadget ;
 
+: resize-tile ( tile -- )
+    dup hand relative >rect rot resize-gadget ;
+ 
 : raise ( gadget -- )
     dup gadget-parent >r dup unparent r> add-gadget ;
 
 : caption-actions ( caption -- )
-    dup [ [ raise ] swap handle-gesture drop ] [ button-down 1 ] set-action
+    dup [ raise ] [ button-down 1 ] link-action
     dup [ drop ] [ button-up 1 ] set-action
-    [ [ drag-tile ] swap handle-gesture drop ] [ drag 1 ] set-action ;
+    [ move-tile ] [ drag 1 ] link-action ;
 
 : close-tile [ close-tile ] swap handle-gesture drop ;
 
@@ -40,10 +43,21 @@ USING: generic kernel math namespaces ;
 : tile-actions ( tile -- )
     dup [ unparent ] [ close-tile ] set-action
     dup [ raise ] [ raise ] set-action
-    [ drag-tile ] [ drag-tile ] set-action ;
+    dup [ move-tile ] [ move-tile ] set-action
+    [ resize-tile ] [ resize-tile ] set-action ;
+
+: <resizer> ( -- gadget )
+    <frame>
+    dup [ resize-tile ] [ drag 1 ] link-action
+    0 0 40 10 <plain-rect> <gadget>
+    dup t reverse-video set-paint-prop
+    over add-right ;
 
 : tile-content ( child caption -- pile )
-     <frame> [ >r <caption> r> add-top ] keep [ add-center ] keep ;
+     <frame>
+     [ >r <caption> r> add-top ] keep
+     [ <resizer> swap add-bottom ] keep
+     [ add-center ] keep ;
 
 TUPLE: tile ;
 C: tile ( child caption -- tile )

library/ui/tool-menus.factor

@@ -18,9 +18,4 @@ SYMBOL: root-menu
     [[ "Exit" [ f world get set-world-running? ] ]]
 ] root-menu set
 
-world get [
+world get [ show-root-menu ] [ button-down 1 ] set-action
-    ! Note that we check if the user explicitly clicked the
-    ! world, to avoid showing the root menu on gadgets that
-    ! don't explicitly handle mouse clicks.
-    hand hand-clicked eq? [ show-root-menu ] when
- ] [ button-down 1 ] set-action

native/relocate.c

@@ -110,6 +110,17 @@ void relocate_dlsym(F_REL* rel, bool relative)
 		- (relative ? rel->offset + CELLS : 0));
 }
 
+void relocate_primitive_16_16(F_REL* rel)
+{
+	reloc_set_16_16((CELL*)rel->offset,primitive_to_xt(rel->argument));
+}
+
+INLINE void code_fixup_16_16(CELL* cell)
+{
+	CELL difference = (compiling.base - code_relocation_base);
+	reloc_set_16_16(cell,reloc_get_16_16(cell) + difference);
+}
+
 INLINE CELL relocate_code_next(CELL relocating)
 {
 	F_COMPILED* compiled = (F_COMPILED*)relocating;
@@ -152,6 +163,12 @@ INLINE CELL relocate_code_next(CELL relocating)
 		case F_ABSOLUTE:
 			code_fixup((CELL*)rel->offset);
 			break;
+		case F_ABSOLUTE_PRIMITIVE_16_16:
+			relocate_primitive_16_16(rel);
+			break;
+		case F_ABSOLUTE_16_16:
+			code_fixup_16_16((CELL*)rel->offset);
+			break;
 		default:
 			fatal_error("Unsupported rel",rel->type);
 			break;

native/relocate.h

@@ -16,7 +16,11 @@ typedef enum {
 	F_RELATIVE_DLSYM,
 	F_ABSOLUTE_DLSYM,
 	/* relocate an address to start of code heap */
-	F_ABSOLUTE
+	F_ABSOLUTE,
+	/* PowerPC absolute address in the low 16 bits of two consecutive
+	32-bit words */
+	F_ABSOLUTE_PRIMITIVE_16_16,
+	F_ABSOLUTE_16_16
 } F_RELTYPE;
 
 /* code relocation consists of a table of entries for each fixup */
@@ -35,3 +39,16 @@ INLINE void code_fixup(CELL* cell)
 
 void relocate_data();
 void relocate_code();
+
+/* on PowerPC, return the 32-bit literal being loaded at the code at the
+given address */
+INLINE CELL reloc_get_16_16(CELL* cell)
+{
+	return ((*(cell - 1) & 0xffff) << 16) | (*cell & 0xffff);
+}
+
+INLINE void reloc_set_16_16(CELL* cell, CELL value)
+{
+	*cell = ((*cell & ~0xffff) | (value & 0xffff));
+	*(cell - 1) = ((*(cell - 1) & ~0xffff) | ((value >> 16) & 0xffff));
+}