code expand-rect  ( src dst w h --- )
   dx  pop              \ Height of source image in pixels
   4 [sp] edi xchg
   8 [sp] esi xchg
   begin
      0 [sp]  cx mov   \ Width of source image in pixels
      begin
         op: ax lods                \ Get a pixel
         op: ax d# 2400 [edi] mov   \ Write to next line
         op: ax stos                \ Write to this line + increment
         op: ax d# 2400 [edi] mov   \ Write to next line
         op: ax stos                \ Write to this line + increment
      loopa
      d# 2400 # edi add             \ Skip the next output line - already written
      edx dec
   0= until
   eax pop   \ Discard source width
   edi pop   \ Restore EDI
   esi pop   \ Restore ESI
c;

   h# 25 to node
   h# 290a8 cmd \ high-pass filter, semi-manual mode, 600Hz cutoff
   h# 34001 cmd \ speaker power 1 dB gain
   h# 38001 cmd \ over-current / short-circuit protection, 2.6A threshold
   h# 39019 cmd \ temperature protection at 130C
   h# 42011 cmd \ over-temperature shutdown of class-D

You see, this code is performing pre-setup of a Conexant HDAudio Codec chip to suit the physical peculiarities of the OLPC 1.5's motherboard and other components. The chip itself has no prior knowledge of the machine it's being used in, so some other component has to provide it with useful information like the power of the speakers, their frequency range, the maximum safe level of current, and so on. And so I've adopted these "magic numbers" into my firmware code quite happily -- it's information peculiar to this PC/motherboard and so the firmware is the place to put it.

Here's some more amusing code that's in the firmware: telling the audio chip what it's many and varied pins are connected to on the motherboard, so that it can repeat this information to Linux's audio driver. Once more -- this information can't be baked into the chip, because it's specific to the use of that chip on this particular motherboard.

: port-a  ( -- u )  19 config(  1/8" green left hp-out jack     )config  ;
: port-b  ( -- u )  1a config(  1/8" pink left mic-in jack      )config  ;
: port-c  ( -- u )  1b config(  builtin front mic-in            )config  ;
: port-d  ( -- u )  1c config(  unused line-out                 )config  ;
: port-e  ( -- u )  1d config(  unused line-out                 )config  ;
: port-f  ( -- u )  1e config(  1/8" pink left line-in jack     )config  ;
: port-g  ( -- u )  1f config(  builtin front speaker           )config  ;
: port-h  ( -- u )  20 config(  unused spdiff-out               )config  ;
: port-i  ( -- u )  22 config(  unused spdiff-out               )config  ;
: port-j  ( -- u )  23 config(  unused mic-in                   )config  ;

So I've somewhat improved my mental model of the appropriate ways to factor information between chips, boards, firmwares, and operating systems.

That doesn't mean I'm happy about seeing this kind of information pass over USB. I'd still like to see gadgets designed for simple on-the-wire protocols, as we do on the internet, and take responsibility for as much of their own configuration as possible. I wonder whether I'll change my mind when I start building USB gadgets.. :-)

Bringups are fun! I would do another :-)

• many: The word many repeats execution of the current line until a key is pressed.

  ok ." luke rules" cr  many
  luke rules
  luke rules
  luke rules
  
  ok see many
  : many   
     key? 0= if    
        0 >in ! 
     then  
  ; 
  

• quine: Since we can introspect the input stream it's easy to write a program that prints itself to stdout.

  ok ( this is a quine ) source type
  ( this is a quine ) source type
  

• patch: The word patch is a simple way to make binary patches to Forth words.

  ok : foo 1 + ;           
  ok see foo
  : foo   
     1 + 
  ; 
  ok 41 foo .
  42 
  
  ok patch - + foo
  ok see foo
  : foo   
     1 - 
  ; 
  ok 43 foo .
  42 
  
  ok patch 5 1 foo
  ok see foo
  : foo   
     5 - 
  ; 
  ok 47 foo .
  42 
  ok 
  

Forth tips would be welcome. :-)

To make life better I've optimized my XOOS edit-compile-boot loop: now I type 'make' on my Macbook and four seconds later the new operating system has loaded and started executing on my XO.

Here are the tricks I learned, mostly from Mitch Bradley, as I went along:

• Openfirmware accepts gzipped operating systems. For me the time to compress/decompress is well worth the savings over the network.
• Boot a new OS without resetting the hardware:

  ok 0 to already-go?  boot

• You can move configuration variables (as in printenv and setenv) into NVRAM to have them preserved between boots. To do this you need to rebuild Openfirmware (type make in cpu/x86/pc/olpc/build/) after uncommenting this line from cpu/x86/pc/olpc/config.fth:

  \ create use-flash-nvram
  

  You should use Openfirmware version Q2E33 for the fix in SVN rev r1111. Otherwise you may see verifier-errors that make it look like your firmware is corrupted when in fact it isn't.
• Once NVRAM is enabled you can store your own little Forth extras in there. Type nvedit to edit your nvramrc (CTRL-X to exit) and use setenv use-nvramrc? true to make it run automatically on boot.
• Use a static IP address on the XO.

  ok setenv ip-address 10.0.0.42

• I setup the XO to automatically boot a new operating system build the moment it's ready. First I wrote in my nvramrc a Forth command to keep on attempting to download and boot an OS until it succeeds:

  : rerun ( -- )
    begin
      " " ['] boot-load catch nip
    0= until
    go
  ;
  

  and then I very forcefully made OFW call rerun every time it becomes idle, e.g. when my operating system finishes executing and returns. The hook I used was overriding the word for printing the Forth prompt:

  ok ' rerun is prompt
  

• I didn't want the XO to busy-loop trying boot all the time, so I tell it to boot from a CGI script on my Macbook's webserver:

  ok setenv boot-device http:\\10.0.0.1\cgi-bin\os

  The CGI script waits until the OS image is created, sends it over to Openfirmware, and then deletes it. That way each request returns the next image. Here's the script:

  #!/bin/sh
  os="/tmp/os"
  until test -f $os; do sleep 1; done
  echo "Content-Type: application/octet-stream"
  echo "Content-Length: $(ls -l $os | awk '{print $5}')"
  echo
  cat $os
  rm $os
  

ok screen-ih iselect
ok t( frame-buffer-adr  frame-buffer-adr 10240 +  10240  move )t
15,393 uS
ok t( here              here             10240 +  10240  move )t
02,756 uS

So people who listen to what I tell them about Geode hardware are advised to take what I say with a grain of salt. I'm still learning and I have the habit of jumping to conclusions :-)

HelloOS 1.0 we write in Forth. That's the simplest and most sensible idea given that the XO already runs everybody's favourite firmware. Create a file called olpc.fth on a USB stick looking something like this:

." Hello, world!" cr

HelloOS 2.0 is the same thing but written in C, for no good reason at all. This is very easy too because openfirmware ships with a subset libc implementation that gives us printf for free:

main() { printf("Hello, world!\n"); }

gcc -g -m32 -fno-builtin -fno-stack-limit -fno-stack-protector -c ../../hello/hello.c
ld -melf_i386 -Bstatic -N -Ttext 0x100000 -o hello.elf start.o hello.o libobp.a -lc
cp hello.elf hello.syms
strip hello.elf

HelloOS 3.0 is the same but ever-so-slightly more macho. Instead of using premade libc functions we'll call into Forth directly when we want a primitive -- and that's trivially easy too:

main() { OFInterpret0(".\" Hello, world!\" cr"); }

OFW = /home/luke/hacking/openfirmware
OFW_CLIENT = ${OFW}/clients/lib/x86

SYSTEMS = os1.elf

all: ${SYSTEMS}

%.o: %.c
	${CC} ${CFLAGS} -c $<

%.elf: %.o
	ld -melf_i386 -Bstatic -N -Ttext 0x100000 \
	   -o $@ ${OFW_CLIENT}/start.o $< ${OFW_CLIENT}/libobp.a -lc
	strip $@

Hurray So there we have it three operating systems in one afternoon. Life sure is grand :-)

There's actually a little more to interrupts than I'd realised. We have two separate bits of hardware dealing with them: the CAN network controller sets interrupt signals based on the CAN bus status (data to receive? ready to transmit?) and the Vectored Interrupt Controller (VIC) decides how these signals should affect the CPU's execution.

I'm using the CAN interrupts to track the bus status and using the VIC to temporarily disable interrupts when they're inconvenient, i.e. when I'm accessing a data structure that's shared between ISR (Interrupt Service Routine) and non-ISR code. These data structures are FIFO queues based on the ring code that I posted before.

The tricky part was figuring out exactly when the CAN controller sets and clears interrupt status. Looks like it's based on discrete events (e.g. CAN frame successfully sent on the bus) rather than just conditions (CAN transmit buffer is empty).

Here's the code for receiving data from the CAN bus:

\ Is there a CAN frame ready to receive?
: can-rx? ( -- flag )
    CAN-GSR can@ $1 and  0 <>
;

\ Return the number of bytes of data in incoming CAN frame. 
: can-dlen ( -- n )
    CAN-RFS can@
    16 rshift $F and
    8 min
;

\ Free CAN Rx hardware buffers
: can-ack-rx ( -- ) $4 ( RRB ) CAN-CMR can! ;

\ Receive a CAN frame (blocking)
: can-rx ( -- dB dA len id )
    BEGIN can-rx? UNTIL
    CAN-RDB can@  CAN-RDA can@  can-dlen  CAN-RID can@
    can-ack-rx
;

\ Read a CAN frame from the controller and put it on the RX queue.
: can-rx-isr ( -- )
    can-rx-ring ring-full? IF
        can-disable-rx-interrupt
    ELSE
        can-rx can-rx-ring >ring
    THEN
;

$4100000 ( CAN1-RX CAN1-TX ) CONSTANT CAN-interrupts
: mask-can{ ( -- ) CAN-interrupts disable-interrupts ;
: }mask-can ( -- ) CAN-interrupts enable-interrupts ;

: can-dequeue? ( -- flag )
    mask-can{  can-rx-ring ring-empty? not  }mask-can
;

: can-dequeue ( -- dB dA len id )
    BEGIN can-dequeue? UNTIL
    mask-can{
        can-rx-ring ring>
    }mask-can
    can-enable-rx-interrupt
;

I've truly wasted my life up to now by not programming in the one true language BASIC assembler C Java Scheme Erlang Emacs Lisp Common Lisp Smalltalk Forth!

I'm reasonably happy with my little interrupt dispatcher which has an interface like this:

\ interrupt service routine for TIMER1 interrupt
: ticker ." tick " TIMER1 clear-timer-interrupt ;

['] ticker int$TIMER1 isr!
int$TIMER1 enable-interrupt

\
\ VIC: Vectored Interrupt Controller
\

VARIABLE isr-table 32 cells ALLOT

: isr-entry ( n -- ) cells isr-table + ;
: isr! ( cfa int# -- ) isr-entry ! ;
: isr@ ( int# -- cfa ) isr-entry @ ;

: service-interrupt ( n -- )
    dup isr@   ( n isr|0 )
    ?dup 0<> IF
        execute
        drop
    ELSE
        ." Unhandled interrupt #" . cr
    THEN
;

: ack-IRQs ( -- ) $0 VICVectAddr ! ;

\ Call the ISR for each enabled and asserted IRQ.
: isr-dispatch ( -- )
    VICIRQStatus @
    32 0 DO ( IRQs )
        dup i bit-set? IF
            i service-interrupt
        THEN
    LOOP
    drop
    ack-IRQs
    EXIT-ISR
;

\ Setup generic interrupt dispatching.
: init-VIC
    32 0 DO  0 i isr!  LOOP
    ['] isr-dispatch forth-isr !
    c-isr @ VICDefVectAddr !  \ default non-vectored IRQ handler
;

\ Utilities for ISRs

: clear-timer-interrupt ( TIMER -- )
    $FF swap T-IR + !   ( clear all interrupt flags )
;

: enable-interrupt ( int# -- ) bit VICIntEnable ! ;

To communicate between I/O interrupt handlers and "normal" code I spent most of the day writing a simple ring (bounded buffer) data structure. I'm not thrilled at how much stack-munging code this turned out to be. I reckon that either I didn't write it very well, or I could have taken a much simpler approach in general, or both.

\ Ring data structure to use as a bounded-buffer.
\ The ring is initialized with two parameters:
\   MAX: The most items that the ring can contain.
\   ITEM-SIZE: The number of words per item in the ring.
\ The basic operations are RING-EMPTY? RING-FULL? >RING RING@ RING>
\ Each add/remove from the queue moves ITEM-SIZE words between the
\ queue and the stack.
\ 
\ For example if ITEM-SIZE is 3 then the stack effect of
\ >RING is ( a b c ring -- ) and RING@ or RING> is ( ring -- a b c ).
\
\ The idea is to have an interrupt handler like:
\ : can-send   ( dB dA len id ) can-tx-ring >ring ;
\ : can-tx-ISR ( -- ) can-tx-ring ring> ( dB dA len id ) can-tx
\ where this ring has four words per item.

\ Data structure layout:
\ MAX is the most items that the ring can hold.
: ring-max          ( ring -- addr ) ;
\ FIRST is the index (0..MAX-1) of the first item i.e. next to be taken.
: ring-first        ( ring -- addr ) cell+ ;
\ LENGTH is the number of items currently in the ring.
: ring-length       ( ring -- addr ) 2 cells + ;
\ ITEM-SIZE is the number of words per item.
: ring-item-size    ( ring -- addr ) 3 cells + ;
\ DATA is the start address of the real data area.
: ring-data         ( ring -- addr ) 4 cells + ;
\ See the example down below for how to initialize a ring.

: ring-empty? ( ring -- flag )
    ring-length @ 0=
;

: ring-full? ( ring -- flag )
    dup ring-length @ ( ring len )
    swap ring-max @   ( len max )
    =
;

\ Return the address of the first (next) data element.
: ring-first-addr ( ring -- addr )
    dup ring-first @          ( ring n )
    over ring-item-size @ cells ( ring n size )
    *                         ( ring offset )
    swap ring-data +          ( element-addr )
;

\ Return the address of the last data element. 
: ring-last-addr ( ring -- addr )
    dup ring-first @          ( ring n )
    over ring-length @ +      ( ring n )
    over ring-max @ mod       ( ring n )
    over ring-item-size @ cells ( ring n size )
    *                         ( ring offset )
    swap ring-data +          ( element-addr )
;

\ Copy the elements of the next data element onto the stack.
: ring@ ( ring -- ... )
    dup ring-first-addr swap ( addr ring )
    ring-item-size @         ( addr size )
    0 DO                     ( addr )
        dup @ swap           ( ... v addr )
\        ." fetched " over . ." from " dup . cr
        cell+
    LOOP                     ( v1 .. vn addr )
    drop                     ( v1 .. vn )
;

\ Drop the next element from the ring.
: ring-drop ( ring -- )
    dup ring-length --
    dup ring-first @ 1+  ( ring first' )
    over ring-max @ mod  ( ring first'' )
    swap ring-first !
;

\ Move the next element of the ring onto the stack.
: ring> ( ring -- ... )
    dup >r
    ring@
    r> ring-drop
;

\ Move a data element from the stack onto the ring.
: >ring ( v1 .. vn ring -- )
    dup ring-last-addr            ( ... ring addr )
    over ring-length ++           ( ... ring addr )
    \ insert the elements backwards so that they'll be taken out forwards
    over ring-item-size @         ( ... ring addr elem-size )
    1- cells +                    ( ... ring addr )
    swap ring-item-size @ 0 DO    ( ... addr )
\        cr ." store " over . ." at " dup .
        swap over                 ( v1 ... addr vn addr )
        !                         ( v1 ... vn-1 addr )
        cell-
    LOOP
    drop
;

: .ring ( ring -- )
    cr
    ." max:    " dup ring-max @ . cr
    ." first:  " dup ring-first @ . cr
    ." length: " dup ring-length @ . cr
    ." esize:  " ring-item-size @ .
;

\
\ Test/example code
\

\ Ring for testing
VARIABLE r 4 3 * ( four 3-word items ) 4 + ( and 4 words of header ) cells ALLOT

: init-r ( ) 
    \ Configure the ring
    4 r ring-max !
    0 r ring-first !
    0 r ring-length !
    3 r ring-item-size !
    \ Then you can do e.g.
    \ 1 2 3 r >ring   s:
    \ 4 5 6 r >ring   s:
    \ r ring>         s: 1 2 3
    \ r ring>         s: 1 2 3 4 5 6
    \ etc..
;

Forth is amazing. There's hardly any compiler or runtime system and yet it has all the sophistication of Lisp. This feels like discovering Gödel, Escher, Bach faithfully expressed in a few dozen cave paintings.

The best part about embedded programming is starting from scratch without using a single line of code that we didn't write outselves. Right now we don't have memory protection, dynamic memory allocation, concurrency, garbage collection, etc. So we're going to rediscover first-hand at what point it's worth developing these fancy features. Truly we're retreading some giant steps :-)

Here's some Forth I wrote that may be clever or stupid, I'm not sure which yet:

\ Running time profiling: t( ... )t
: t(
    r> tick      ( r t1 )
    >r >r        ( r: t1 r )
;
: )t
    tick r> r>   ( t2 r t1 )
    swap >r      ( t2 t1 )
    -            ( tdelta )
    . ." ms" cr
;

What really happened is that I had a lot of fun, learned a lot of Forth, didn't finish the game, and made absolutely no useful contribution to the PONG on the XO. Not too bad as far as failures go. :-)

Anyway I'm an old Amiga guy so I wanted the game logic to execute in lock-step with the screen refresh, and since the vertical blanking period is very short I used double-buffering to avoid flicker:

\ PONGDBUF.FTH: Simple double-buffer support.

: db-fill-rectangle ( col x y w h -- )
   rot screen-height + -rot  ( col x y' w h -- )
   fill-rectangle
;
: wait-vblank ( -- )
   gp-wait-ready
   0 0 wh!  0 0 dst!  0 0 src!
   h# 6000.00cc ropmode!
   h# 400 blt!
;
: db-blit ( -- )
   wait-vblank
   0 screen-height  0 0  screen-width screen-height 20 - gp-move
;

\ PONGSCOR.FTH: Text drawing
decimal
h# ffff constant fg
h# 0000 constant bg

" ****.   *.****.****.*  *.****.*   .****.****.****."
" *  *.   *.   *.   *.*  *.*   .*   .   *.*  *.*  *." $cat2
" *  *.   *.   *.   *.*  *.*   .*   .   *.*  *.*  *." $cat2
" *  *.   *.****.****.****.****.****.   *.****.****." $cat2
" *  *.   *.*   .   *.   *.   *.*  *.   *.*  *.   *." $cat2
" *  *.   *.*   .   *.   *.   *.*  *.   *.*  *.   *." $cat2
" ****.   *.****.****.   *.****.****.   *.****.   *." $cat2
" --------------------------------------------------" $cat2 drop
   constant drawing-instructions

variable ip variable xloc variable yloc

: fill-box ( color -- ) xloc @ yloc @ 10 10 db-fill-rectangle ;
: draw-digit ( x y digit )
   10 mod  5 *  drawing-instructions +  ip !
   yloc !   xloc !
   begin   ( Empty )
      ip @ c@ dup case
         ascii * of  1 ip +!  fg fill-box  10 xloc +!  endof
         bl      of  1 ip +!  bg fill-box  10 xloc +!  endof
         ascii . of 46 ip +!  -40 xloc +!  10 yloc +!  endof
      endcase
   ascii - =  until
;
: draw-score ( x y score )
   >r 2dup swap 50 + swap       ( x y x' y r: score )
   r@      draw-digit           ( x y      r: score )
   r> 10 / draw-digit
;
hex

\ PONGDRAW.FTH: Drawing non-text graphics
decimal

: units ( n -- n ) 20 * ;
: unit  ( n -- n ) units ;

: draw-ball ( x y -- ) fg -rot 1 unit 1 unit  db-fill-rectangle ;
: draw-bat  ( x y -- ) fg -rot 1 unit 6 units db-fill-rectangle ;
: draw-bat1 ( y -- )                 1 unit swap draw-bat ;
: draw-bat2 ( y -- ) screen-width 2 units - swap draw-bat ;
: draw-score1 ( score -- )                100 40 rot draw-score ;
: draw-score2 ( score -- ) screen-width 200 - 40 rot draw-score ;
: draw-centerline ( -- )
   fg  screen-width 10 - 2 /  40  10 screen-height 80 -  db-fill-rectangle
;
: draw-boundary ( y -- ) >r  fg 0 r> screen-width 20 db-fill-rectangle ;
: draw-boundaries ( -- ) 0 draw-boundary  screen-height 20 - draw-boundary ;

: fill-screen ( color -- ) 0 0 screen-width screen-height db-fill-rectangle ;
: draw-screen ( bat1-y bat2-y ball-x ball-y score1 score2 -- )
   bg fill-screen  draw-boundaries  draw-centerline
   draw-score2 draw-score1
   draw-ball draw-bat2 draw-bat1
;
: test-draw-screen ( -- ) 200 500 800 500 72 48 draw-screen ;

hex

\ PONGKDB.FTH: Keyboard input
decimal
0 value key_esc        0 value key_off
0 value key_left_down  0 value key_left_up
0 value key_right_down 0 value key_right_up

: initkeys    ( -- ) " stdin @ iselect  ' get-scan  0 alarm  iunselect" eval ;
: restorekeys ( -- ) " stdin @ iselect  ' get-scan 10 alarm  iunselect" eval ;
: clear-key-states ( -- )
   false to key_esc         false to key_off
   false to key_left_down   false to key_left_up
   false to key_right_down  false to key_right_up
;
0 value e0-seen?
: set-key-states ( down? station )
   dup . dup 1 = if abort" quit" then  case
      h# 65 of  e0-seen? if to key_right_up   else to key_left_up   then  endof
      h# 66 of  e0-seen? if to key_right_down else to key_left_down then  endof
      h# 69 of  to key_esc        endof   \ lower left game button
      h# 2a of  to key_left_up    endof   \ shift-left
      h# 5b of  to key_left_down  endof   \ hand-left
      h# 36 of  to key_right_up   endof   \ shift-right
      h# 5c of  to key_right_down endof   \ hand-right
      h# 5d of  to key_esc        endof   \ square
      h#  1 of  to key_off        endof   \ ESC scancode
   endcase
;
: scan-keyboard ( -- )
   clear-key-states
   begin " get-data?" stdin @ $call-method  while   ( scancode )
      dup h# e0 =  if
         drop  true to e0-seen?
      else
         set-key-states  0 to e0-seen?
      then
   repeat
;
hex

\ PONGGAME.FTH: Game state
decimal

variable bat1-y variable bat2-y variable ball-x variable ball-y
variable ball-dx variable ball-dy
42 value score1 0 value score2
: step-ball ( -- ) ball-dx @ ball-x +!  ball-dy @ ball-y +! ;

: game-draw ( -- )
   bat1-y @ bat2-y @ ball-x @ ball-y @ score1 score2 draw-screen
;
: game-loop ( -- )
   begin
      scan-keyboard
      key_left_up    if -10 bat1-y +! then
      key_left_down  if  10 bat1-y +! then
      key_right_up   if -10 bat2-y +! then
      key_right_down if  10 bat2-y +!  ascii x emit then
\      3 ball-x +!  1 ball-y +!
      game-draw  db-blit
      random d# 10000 mod 0= if 1 to key_off then
   key_off  until
;

: pong-display-test ( -- )
   d# 100 0 do  test-draw-screen db-blit  loop
;
: pong-game ( -- )
   initkeys  game-loop  restorekeys
;

hex

25 bouncing

screen-ih iselect     \ open display device

: wait-vblank ( -- )  \ wait until the next screen refresh
   gp-wait-ready  0 0 wh!  h# 6000.00cc ropmode!   \ setup NOP
   b# 10000000000 blt!                             \ execute on next vblank
;
: origin-xy ( -- x y ) 0 0 ;
: screen-wh ( -- w h ) screen-width screen-height ;
: bounce-setup ( -- )
   gp-setup
   origin-xy  0 screen-height      screen-wh  gp-move
   ffff       0 screen-height 2 *  screen-wh  gp-fill
;
: bounce-step ( speed pos -- speed' pos' )
   over +         ( speed  pos' )
   swap 1- swap   ( speed' pos' )
;
: bounce-draw ( pos -- )
   screen-height +  0 swap  ( src-x,y )
   origin-xy screen-wh      ( src-x,y dst-x,y w,h )
   gp-move
;
: bounce ( init-speed -- )
   bounce-setup
   0 begin
      wait-vblank  bounce-step  dup bounce-draw    ( speed pos )
   dup 0= until  2drop
;      
: bouncing ( init-speed -- )
   recursive  dup 0> if  dup bounce  2 / bouncing  then
;

cd ./cpu/x86/pc/olpc/build; make clean; make

Now I'm trying to setup a self-sufficient Forth development environment on the XO. I'm quite well adjusted to the keyboard by now so there's no good reason to lug this Macbook around from cafe to cafe just to run Emacs.

The first thing I need is a convenient and persistent way to edit Forth programs on the XO. The programs should be stored on the 2GB SD-memory card that I added so that they're not overwritten when I install a new OLPC software image on the 1GB internal NAND flash. Mitch Bradley already sent me a lot of pointers to get started with file system access (I've put these on the OLPC Wiki as draft Forth Lesson #13) so it's only a matter of building some convenient "editing words" on top.

So I've hacked together something that I'm pretty happy with. Now I write ed foo and the openfirmware text editor (which is minimal but comfortably Emacsish) pops up with the contents of sd:\foo.fth. I edit and then press ^C to finish and optionally save the changes. If I want to evaluate the most recently edited source file I just type ev.

Here's the code:

0 0   2value   ed-file      \ filename being edited
10000 constant ed-maxsize   \ buffer size (max)
0     value    ed-size      \ amount of text in buffer
      create   ed-buf  ed-maxsize allot

: read-content ( adr len name$ -- sz )
   r/o open-file  if  0  else  dup >r  fgets  r> fclose  then
;
: write-content ( content$ name$ -- )
   2dup $delete-all  $create-file >r  " write" r@ $call-method  r> close-dev
;

: name>file ( $n -- $fn ) " sd:\" 2swap " .fth"  $cat2 $cat2 ;
: edit-string [ also hidden ] edit-file [ previous ] ;

: ed$   ( -- s$ ) ed-buf ed-size ;
: ed-read  ( -- ) ed-buf ed-maxsize ed-file read-content  is ed-size ;
: ed-write ( -- ) ed$ ed-file write-content ;
: ed-save? ( -- ) " Save?" confirmed? if ed-write then ;
: ed-edit  ( -- ) ed$ ed-maxsize edit-string is ed-size ;
: ed \ name ( -- )
   safe-parse-word name>file is ed-file
   ed-read ed-edit ed-save?
;
: re-ed ( -- ) ed-edit ed-save? ;
: ev    ( -- ) ed$ eval ;

Next target: reading and referencing openfirmware sources without the Macbook.

: ypos ( line# -- y ) char-height *  window-top + ;

: fbgeode-delete-lines ( delta-#lines -- )
   line# + ypos  window-left  swap ( src-x,y )
   window-left  line# ypos         ( src-x,y dst-x,y )
   screen-width screen-height      ( src-x,y dst-x,y w,h )
   gp-move
;

\ Patch geode acceleration into an installed (fb16) framebuffer
: fbgeode-accelerate  ( -- )
   gp-setup
   ['] fbgeode-delete-lines is delete-lines
;   

1. Power on the machine while holding down one of the game buttons (next to the screen). Release the game button when instructed.
2. Press escape (top-left key) to skip the normal boot sequence and go directly to the Forth ok prompt.
3. Enter this line:

   screen-ih iselect  ff000000 20f580 0 do  dup dup c@ invert swap c!  1 +  loop
   

1. It's optimized to be as few characters as possible so that you kids can type it.
2. It uses constants for video memory location and screen size. My God, after all these years, a moment of freedom from slavery to portability!
3. I'm a Forth newbie and I'm probably fumbling around with my stack manipulation.

To be clearer about what's going on, let's rewrite that program by using OFW's macro assembler to convert it into machine code:

code inverse-screen ( -- )
  frame-buffer-adr #  eax mov                \ eax is the increasing memory address
  screen-height /scanline * 4 / #  ecx mov   \ ecx is the loop counter (down to zero)
  begin                                      \ ebx is a temporary
    0 [eax] ebx mov
    ebx not
    ebx 0 [eax] mov
    4 # eax add
    ecx dec
  0= until
c;

.. and now that we have standard hardware we can also once again talk plainly about timings. The Forth version takes around 1284ms to run whereas the assembler one takes around 89ms. Plain and simple!