opcodes[]:

global scope global
{
  global scope implicit__main
  {
  }
  type utf8str:
  type ucs1str:
  type ucs2str:
  type FD:
  type BlockDevice:
  type IdeBlockDevice:
  type I2cBlockDevice:
  type SerialDevice:

  void flush ()
  {
    gvar-12 "stdout"    ( -- FD& )
    peek                ( FD& -- FD¢ )
    5                   ( -- uint8 )
    0                   ( -- uint16 )
    call setctl         ( FD¢, uint8, uint16 )
  }
}
  0                   ( -- OSErr )
  gsinit "errno"
  0                   ( -- uint8 )
  "sio1A"             ( -- ucs1str )
  dup2r               ( ucs1str -- ucs1str¢ )
  call new            ( uint8, ucs1str¢ -- SerialDevice )
  fromr               ( -- ucs1str )
  dispose             ( ucs1str -- )
  gsinit "sio1A"
  1                   ( -- uint8 )
  "sio1B"             ( -- ucs1str )
  dup2r               ( ucs1str -- ucs1str¢ )
  call new            ( uint8, ucs1str¢ -- SerialDevice )
  fromr               ( -- ucs1str )
  dispose             ( ucs1str -- )
  gsinit "sio1B"
  extern const uint8 mSIO_SELECT
  "sio1rom"           ( -- ucs1str )
  dup2r               ( ucs1str -- ucs1str¢ )
  call new            ( uint8, ucs1str¢ -- I2cBlockDevice )
  fromr               ( -- ucs1str )
  dispose             ( ucs1str -- )
  gsinit "sio1rom"
  extern const uint8 mSIO_SELECT
  gvar "k1_irpt_mask" ( -- uint8& )
  &=                  ( uint8, uint8& -- )
  gvar-4 "sio1A"      ( -- SerialDevice& )
  peek                ( SerialDevice& -- SerialDevice¢ )
  retain              ( SerialDevice¢ -- SerialDevice )
  gsinit "stdin"
  gvar-4 "sio1A"      ( -- SerialDevice& )
  peek                ( SerialDevice& -- SerialDevice¢ )
  retain              ( SerialDevice¢ -- SerialDevice )
  gsinit "stdout"
  call ei_all         ()
  "ide2A"             ( -- ucs1str )
  dup2r               ( ucs1str -- ucs1str¢ )
  1                   ( -- bool )
  call new            ( ucs1str¢, bool -- IdeBlockDevice )
  fromr               ( -- ucs1str )
  dispose             ( ucs1str -- )
  gsinit "ide2A"
  "ide2B"             ( -- ucs1str )
  dup2r               ( ucs1str -- ucs1str¢ )
  0                   ( -- bool )
  call new            ( ucs1str¢, bool -- IdeBlockDevice )
  fromr               ( -- ucs1str )
  dispose             ( ucs1str -- )
  gsinit "ide2B"
  251                 ( -- uint8 )
  "ide2rom"           ( -- ucs1str )
  dup2r               ( ucs1str -- ucs1str¢ )
  call new            ( uint8, ucs1str¢ -- I2cBlockDevice )
  fromr               ( -- ucs1str )
  dispose             ( ucs1str -- )
  gsinit "ide2rom"
  gvar "heap_end"     ( -- void*& )
  peek                ( void*& -- void* )
  gvar "heap_start"   ( -- void*& )
  poke                ( void*, void*& -- )
  4                   ( -- uint16 )
  alloc               ( uint16 -- FD[] )
  gsinit "devs"
  0                   ( -- uint16 )
  alloc               ( uint16 -- File[] )
  gsinit "fds"
  gvar-4 "sio1A"      ( -- SerialDevice& )
  peek                ( SerialDevice& -- SerialDevice¢ )
  retain              ( SerialDevice¢ -- SerialDevice )
  gvar-20 "devs"      ( -- FD[]& )
  peek                ( FD[]& -- FD[]¢ )
  0                   ( -- int16 )
  atindex             ( FD[]¢, int16 -- FD& )
  poke                ( FD, FD& -- )
  gvar-6 "sio1B"      ( -- SerialDevice& )
  peek                ( SerialDevice& -- SerialDevice¢ )
  retain              ( SerialDevice¢ -- SerialDevice )
  gvar-20 "devs"      ( -- FD[]& )
  peek                ( FD[]& -- FD[]¢ )
  1                   ( -- int16 )
  atindex             ( FD[]¢, int16 -- FD& )
  poke                ( FD, FD& -- )
  "\r\nrunning tests.." ( -- ucs1str )
  call puts           ( ucs1str )
  gvar "systemtime"   ( -- uint32& )
  lo                  ( uint32& -- uint16& )
  peek                ( uint16& -- uint16 )
  gsinit "start"
  call set_yellow_led ()
  "\r\ntest_core "    ( -- ucs1str )
  call puts           ( ucs1str )
  call flush          ()
  call test_core      ()
  "passed"            ( -- ucs1str )
  call puts           ( ucs1str )
  "\r\ntest_str  "    ( -- ucs1str )
  call puts           ( ucs1str )
  call flush          ()
  call test_str       ()
  "passed"            ( -- ucs1str )
  call puts           ( ucs1str )
  "\r\ntest_8    "    ( -- ucs1str )
  call puts           ( ucs1str )
  call flush          ()
  call test_8         ()
  "passed"            ( -- ucs1str )
  call puts           ( ucs1str )
  "\r\ntest_16   "    ( -- ucs1str )
  call puts           ( ucs1str )
  call flush          ()
  call test_16        ()
  "passed"            ( -- ucs1str )
  call puts           ( ucs1str )
  "\r\ntest_32   "    ( -- ucs1str )
  call puts           ( ucs1str )
  call flush          ()
  call test_32        ()
  "passed"            ( -- ucs1str )
  call puts           ( ucs1str )
  call clear_both_leds ()
  "\r\nelapsed time [ms] = " ( -- ucs1str )
  call puts           ( ucs1str )
  gvar "systemtime"   ( -- uint32& )
  lo                  ( uint32& -- uint16& )
  peek                ( uint16& -- uint16 )
  gvar-24 "start"     ( -- uint16& )
  peek                ( uint16& -- uint16 )
  -                   ( uint16, uint16 -- uint16 )
  call putnum         ( uint16 )
  "\r\nAll tests passed.\r\nPress key to continue -> " ( -- ucs1str )
  call puts           ( ucs1str )
  call getc           ( -- ucs1char )
  call putc           ( ucs1char )
  "\r\nrom size  = "  ( -- ucs1str )
  call puts           ( ucs1str )
  extern const uint16 rom_size
  call numstr         ( uint16 -- ucs1str )
  call puts           ( ucs1str )
  "  init code = "    ( -- ucs1str )
  call puts           ( ucs1str )
  extern const uint16 gsinit_size
  call numstr         ( uint16 -- ucs1str )
  call puts           ( ucs1str )
  "\r\nHW driver = "  ( -- ucs1str )
  call puts           ( ucs1str )
  extern const uint16 hw_driver_size
  call numstr         ( uint16 -- ucs1str )
  call puts           ( ucs1str )
  "   VM size   = "   ( -- ucs1str )
  call puts           ( ucs1str )
  extern const uint16 vm_size
  call numstr         ( uint16 -- ucs1str )
  call puts           ( ucs1str )
  "\r\nProgram   = "  ( -- ucs1str )
  call puts           ( ucs1str )
  extern const uint16 code_size
  call numstr         ( uint16 -- ucs1str )
  call puts           ( ucs1str )
  "  Test code = "    ( -- ucs1str )
  call puts           ( ucs1str )
  extern const uint16 test_code_size
  call numstr         ( uint16 -- ucs1str )
  call puts           ( ucs1str )
  "\r\nheap free = "  ( -- ucs1str )
  call puts           ( ucs1str )
  call mem_get_free   ( -- uint16 )
  call putnum         ( uint16 )
  call getc           ( -- ucs1char )
  call putc           ( ucs1char )
  call flush          ()