- OpenBIOS - mail.coreboot.org

r614 - cpu/x86/pc/olpc
by svn＠openbios.org 18 Sep '07

18 Sep '07

Author: wmb Date: 2007-09-18 01:40:58 +0200 (Tue, 18 Sep 2007) New Revision: 614 Added: cpu/x86/pc/olpc/life.fth Modified: cpu/x86/pc/olpc/fw.bth Log: OLPC load file changes in support of safer "flash" command. Also new Easter egg. Modified: cpu/x86/pc/olpc/fw.bth =================================================================== --- cpu/x86/pc/olpc/fw.bth 2007-09-17 23:37:47 UTC (rev 613) +++ cpu/x86/pc/olpc/fw.bth 2007-09-17 23:40:58 UTC (rev 614) @@ -330,7 +330,6 @@ fload ${BP}/cpu/x86/pc/olpc/suspend.fth \ Suspend/resume setup fload ${BP}/dev/olpc/keyboard/selftest.fth \ Keyboard diagnostic fload ${BP}/dev/olpc/touchpad/touchpad.fth \ Touchpad diagnostic -fload ${BP}/dev/olpc/kb3700/battery.fth \ Battery status reports fload ${BP}/cpu/x86/pc/olpc/copynand.fth fload ${BP}/cpu/x86/pc/olpc/nandstat.fth \ fload ${BP}/cpu/x86/pc/olpc/carousel.fth \ Carouseled NAND writing @@ -339,6 +338,13 @@ fload ${BP}/cpu/x86/pc/olpc/security.fth fload ${BP}/cpu/x86/pc/olpc/setwp.fth fload ${BP}/ofw/gui/ofpong.fth +fload ${BP}/cpu/x86/pc/olpc/life.fth +: olpc-power-off ( -- ) + gx-power-off \ Try the nice way first + d# 20 ms + ec-power-off \ Then try the hard way +; +' olpc-power-off to power-off [then] \ Eliminate 4 second delay in install console for the case where @@ -490,7 +496,9 @@ game-key-mask h# 40 and if start-sound then ; : ?games ( -- ) - game-key-mask h# 20 and if pong then + game-key-mask h# 20 and if + time&date 5drop 1 and if pong else d# 1200 life then + then ; : ?freeze ( -- ) game-key-mask h# 10 and if freeze then @@ -545,7 +553,7 @@ ; : newrom - " flash http:\\10.20.0.14\new.rom" eval + " flash! http:\\10.20.0.14\new.rom" eval \ " wifi media lab 802.11" eval \ " flash http:\\18.85.46.172\new.rom" eval ; Added: cpu/x86/pc/olpc/life.fth =================================================================== --- cpu/x86/pc/olpc/life.fth (rev 0) +++ cpu/x86/pc/olpc/life.fth 2007-09-17 23:40:58 UTC (rev 614) @@ -0,0 +1,192 @@ + +\ rgb color value +h# ff 0 0 rgb>565 constant xred \ red +h# 0 0 0 rgb>565 constant xblack \ black + +\ screen size constant +d# 128 constant lf_width +d# 95 constant lf_height + +\ board and working area +lf_width lf_height * constant /board +/board buffer: lf_board +/board buffer: lf_board_work + +\ some macros to get a linear address o a cell of board or working area +: >offset ( i j -- lin_addr ) swap lf_width * + ; +: >cell ( i j -- adr ) swap lf_width * + lf_board + ; +: >work ( i j -- adr ) swap lf_width * + lf_board_work + ; + +: show-cell ( state y x -- ) + >offset swap if xred else xblack then show-state +; + +\ display the board of life +: lf_board_print ( -- ) + lf_height 0 do + lf_width 0 do + j i >cell c@ j i show-cell + loop + loop +; + +\ working variable +variable cell-sum + +: xy+ ( x1 y1 x2 y2 -- x3 y3 ) rot + -rot + swap ; + +: +sum ( i j +i +j -- i j ) + 2over xy+ ( i j i' j' ) + >cell c@ cell-sum +! ( i j ) +; + +: lf_check_live_i_j ( i j -- ncell ) + cell-sum off ( i j ) + -1 -1 +sum + -1 0 +sum + -1 1 +sum + 0 -1 +sum + 0 1 +sum + 1 -1 +sum + 1 0 +sum + 1 1 +sum ( i j ) + 2drop cell-sum @ ( sum ) +; + +\ one step evolve the board +: lf_board_evolve + + \ copy the line before the last to the first one and the second to the last + lf_board lf_width lf_height 2 - * + lf_board lf_width move + lf_board lf_width + lf_board lf_width lf_height 1 - * + lf_width move + + \ copy the column before last to the first one and the second to the last + lf_height 0 do + i lf_width 2 - >cell @ i 0 >cell c! + i 1 >cell @ i lf_width 1 - >cell c! + loop + + lf_height 1 - 1 do + lf_width 1 - 1 do + j i lf_check_live_i_j ( sum1 ) + j i >cell c@ if ( sum1 ) + \ caso in cui nella cella c'e' 1 + 2 3 between ( 0|-1 ) + else ( sum1 ) + \ caso in cui nella cella c'e' 0 + 3 = ( 0|-1 ) + then + negate ( 0|1 ) + dup j i >work c! ( 0|1 ) + dup j i >cell c@ <> if ( 0|1 ) + j i show-cell + else + drop + then + loop + loop + lf_board_work lf_board /board move +; + +decimal +\ initialize data +: set-cell ( i j -- ) >cell 1 swap c! ; +: init-board ( -- ) + lf_board /board erase +[ifdef] notdef + 2 2 set-cell + 3 3 set-cell + 4 3 set-cell + 4 2 set-cell + 4 1 set-cell +[else] + + \ R-pentominos + \ This placement evolves nicely + \ 20 20 set-cell 20 21 set-cell 21 19 set-cell 21 20 set-cell 22 20 set-cell + + \ This placement is boring + \ 40 20 set-cell 40 21 set-cell 41 19 set-cell 41 20 set-cell 42 20 set-cell + + \ This one is excellent! + \ 20 40 set-cell 20 41 set-cell 21 39 set-cell 21 40 set-cell 22 40 set-cell + + \ This one almost dies out, then explodes into a complex arrangement with + \ stuff happening everywhere. + \ 20 60 set-cell 20 61 set-cell 21 59 set-cell 21 60 set-cell 22 60 set-cell + + \ This one takes a long time to kill off the glider gun, then lasts for a long time + \ 20 80 set-cell 20 81 set-cell 21 79 set-cell 21 80 set-cell 22 80 set-cell + + \ This one takes out the block at the right side of the glider gun, which + \ disperses in an interesting pattern, then the whole arena dies quickly + \ 20 78 set-cell 20 79 set-cell 21 77 set-cell 21 78 set-cell 22 78 set-cell + + \ This one is absolutely brilliant! It takes out the glider gun, which + \ disperse in a boring way, but then the rest of the pattern just keeps + \ changing and changing, after looking like it is about to die several times. + \ It eventually dies about about 5000 generations. + 20 79 set-cell 20 80 set-cell 21 78 set-cell 21 79 set-cell 22 79 set-cell + + \ Glider gun + 55 21 set-cell + 55 22 set-cell + 56 21 set-cell + 56 22 set-cell + 53 34 set-cell + 53 33 set-cell + 54 32 set-cell + 55 31 set-cell + 56 31 set-cell + 57 31 set-cell + 58 32 set-cell + 59 33 set-cell + 59 34 set-cell + 56 35 set-cell + 54 36 set-cell + 55 37 set-cell + 56 37 set-cell + 56 38 set-cell + 57 37 set-cell + 58 36 set-cell + + 55 41 set-cell + 54 41 set-cell + 53 41 set-cell + 55 42 set-cell + 54 42 set-cell + 53 42 set-cell + + 52 43 set-cell + 52 45 set-cell + 51 45 set-cell + 56 43 set-cell + 56 45 set-cell + 57 45 set-cell + + 53 55 set-cell + 53 56 set-cell + 54 55 set-cell + 54 56 set-cell + +[then] +; +hex + +: show-board ( -- ) + cursor-off " erase-screen" $call-screen + lf_board_print +; + +\ Version that displays the result in-place +: generations ( n -- ) + show-board + ( n ) 0 do lf_board_evolve loop +; +: life ( #generations -- ) + page + init-board + generations +; + +\ 500 generations

1 0

r613 - dev/usb2/device/wlan
by svn＠openbios.org 18 Sep '07

18 Sep '07

Author: wmb Date: 2007-09-18 01:37:47 +0200 (Tue, 18 Sep 2007) New Revision: 613 Modified: dev/usb2/device/wlan/usb8388.fth Log: USB Wlan driver - Added support for disconnect-while-host-is-sleeping. Modified: dev/usb2/device/wlan/usb8388.fth =================================================================== --- dev/usb2/device/wlan/usb8388.fth 2007-09-17 23:34:55 UTC (rev 612) +++ dev/usb2/device/wlan/usb8388.fth 2007-09-17 23:37:47 UTC (rev 613) @@ -1105,7 +1105,49 @@ wait-cmd-resp if exit then ; +2 constant gpio-pin +d# 20 constant wake-gap +1 constant wake-on-broadcast +2 constant wake-on-unicast +4 constant wake-on-mac-event +-1 constant remove-wakeup +\ LED_GPIO_CTRL + +: host-sleep-activate ( -- ) + 0 h# 45 ( CMD_802_11_HOST_SLEEP_ACTIVATE ) prepare-cmd + 0 outbuf-bulk-out if exit then + wait-cmd-resp if exit then +; + +: host-sleep-config ( conditions -- ) + >r + 6 h# 43 ( CMD_802_11_HOST_SLEEP_CFG ) prepare-cmd +\ ACTION_SET +xw + + r> +xl + gpio-pin +xb + wake-gap +xb + + 6 outbuf-bulk-out if exit then + wait-cmd-resp if exit then +; + +: unicast-wakeup ( -- ) wake-on-unicast host-sleep-config ; +: broadcast-wakeup ( -- ) wake-on-unicast wake-on-broadcast or host-sleep-config ; +: sleep ( -- ) host-sleep-activate ; + +[ifdef] notdef \ This is test code that only works with a special debug version of the Libertas firmware +: autostart ( -- ) + h# 82 h# 9b ( CMD_MESH_ACCESS ) prepare-cmd + 5 +xw \ CMD_ACT_SET_ANYCAST + h# 700000 +xl + + h# 82 outbuf-bulk-out if exit then + wait-cmd-resp if exit then +; +[then] + \ LICENSE_BEGIN \ Copyright (c) 2007 FirmWorks \

1 0

r612 - cpu/x86/pc/olpc dev/geode dev/olpc/kb3700 dev/olpc/spiflash
by svn＠openbios.org 18 Sep '07

18 Sep '07

Author: wmb Date: 2007-09-18 01:34:55 +0200 (Tue, 18 Sep 2007) New Revision: 612 Modified: cpu/x86/pc/olpc/devices.fth dev/geode/acpi.fth dev/olpc/kb3700/battery.fth dev/olpc/kb3700/ecio.fth dev/olpc/spiflash/spiui.fth Log: OLPC "flash" command - guard against common failure modes like power loss and premature power button pushes. Modified: cpu/x86/pc/olpc/devices.fth =================================================================== --- cpu/x86/pc/olpc/devices.fth 2007-09-17 23:32:59 UTC (rev 611) +++ cpu/x86/pc/olpc/devices.fth 2007-09-17 23:34:55 UTC (rev 612) @@ -124,6 +124,27 @@ [then] device-end +dev /8042/keyboard +0 value waiting-up? +: olpc-check-abort ( scan-code -- abort? ) \ Square pressed? + last-scan over to last-scan ( scan-code old-scan-code ) + h# e0 <> if drop false exit then ( scan-code ) + + check-abort? 0= if drop false exit then ( scan-code ) + + dup h# 7f and h# 5d <> if drop false exit then ( scan-code ) + + h# 80 and if \ Up + false to waiting-up? + false ( abort? ) + else + waiting-up? 0= ( abort? ) + true to waiting-up? + then +; +patch olpc-check-abort check-abort get-scan +dend + 0 0 " i70" " /isa" begin-package \ Real-time clock node fload ${BP}/dev/ds1385r.fth 8 encode-int 0 encode-int encode+ " interrupts" property @@ -233,6 +254,8 @@ \needs md5init fload ${BP}/ofw/ppp/md5.fth \ MD5 hash +fload ${BP}/dev/geode/acpi.fth \ Power management + fload ${BP}/dev/olpc/kb3700/ecspi.fth \ EC chip SPI FLASH access warning @ warning off @@ -275,6 +298,8 @@ fload ${BP}/cpu/x86/pc/olpc/mfgtree.fth \ Manufacturing data in device tree fload ${BP}/cpu/x86/pc/olpc/kbdtype.fth \ Export keyboard type +fload ${BP}/dev/olpc/kb3700/battery.fth \ Battery status reports + fload ${BP}/dev/olpc/spiflash/spiflash.fth \ SPI FLASH programming fload ${BP}/dev/olpc/spiflash/spiui.fth \ User interface for SPI FLASH programming fload ${BP}/dev/olpc/spiflash/recover.fth \ XO-to-XO SPI FLASH recovery @@ -304,8 +329,6 @@ devalias screen /display also hidden d# 34 to display-height previous \ For editing -fload ${BP}/dev/geode/acpi.fth \ Power management - fload ${BP}/cpu/x86/adpcm.fth \ ADPCM decoding [ifdef] rom-loaded Modified: dev/geode/acpi.fth =================================================================== --- dev/geode/acpi.fth 2007-09-17 23:32:59 UTC (rev 611) +++ dev/geode/acpi.fth 2007-09-17 23:34:55 UTC (rev 612) @@ -12,15 +12,11 @@ : pm@ ( offset -- n ) pm-base + pl@ ; : pm! ( n offset -- ) pm-base + pl! ; -: enable-power-button ( -- ) h# 100 2 acpi-w! ; +: enable-power-button ( -- ) 2 acpi-w@ h# 100 or 2 acpi-w! ; +: disable-power-button ( -- ) 2 acpi-w@ h# 100 invert and 2 acpi-w! ; h# 4000.0000 constant pm-enable : gx-power-off ( -- ) - \ If the keyboard controller is off (after "flash"), power off doesn't work. - \ I suspect that is because the EC doesn't notice the deassertion - \ of main_on and sus_on from the 5536. - ec-power-off - \ The rest of this will succeed in turning off the CPU, but the EC will \ stay on. The ec-power-off above turns off both the EC and CPU, so the \ rest of this is for historical interest only. Modified: dev/olpc/kb3700/battery.fth =================================================================== --- dev/olpc/kb3700/battery.fth 2007-09-17 23:32:59 UTC (rev 611) +++ dev/olpc/kb3700/battery.fth 2007-09-17 23:34:55 UTC (rev 612) @@ -77,7 +77,7 @@ dup abs d# 10,000 / <# u# u# [char] . hold u#s swap sign u#> type pop-base ; -: 2.d ( n -- ) push-decimal <# u# u#s u#> type pop-base ; +\needs 2.d : 2.d ( n -- ) push-decimal <# u# u#s u#> type pop-base ; : .% ( n -- ) 2.d ." %" ; : .bat ( -- ) bat-status@ ( stat ) @@ -101,11 +101,17 @@ then drop ; + +: ?enough-power ( ) + bat-status@ ( stat ) + dup h# 10 and 0= abort" AC not present" ( stat ) + dup 1 and 0= abort" Battery not present" ( stat ) + 4 and abort" Battery low" +; + : watch-battery ( -- ) - cursor-off begin (cr .bat kill-line d# 1000 ms key? until key drop - cursor-on ; \ send questions to andrew at gold peak Modified: dev/olpc/kb3700/ecio.fth =================================================================== --- dev/olpc/kb3700/ecio.fth 2007-09-17 23:32:59 UTC (rev 611) +++ dev/olpc/kb3700/ecio.fth 2007-09-17 23:34:55 UTC (rev 612) @@ -267,6 +267,7 @@ 7 to spi-us \ Measured time for "1 fea9 ec!" is 7.9 uS kbc-off + disable-power-button \ Guard against the user panicing ; : use-local-ec ( -- ) ['] io-spi-start to spi-start ; use-local-ec Modified: dev/olpc/spiflash/spiui.fth =================================================================== --- dev/olpc/spiflash/spiui.fth 2007-09-17 23:32:59 UTC (rev 611) +++ dev/olpc/spiflash/spiui.fth 2007-09-17 23:34:55 UTC (rev 612) @@ -241,7 +241,8 @@ $get-file ; -: flash ( ["filename"] -- ) get-file reflash ; +: flash ( ["filename"] -- ) get-file ?enough-power reflash ; +: flash! ( ["filename"] -- ) get-file reflash ; \ This is a slower version of "rom-va flash-buf /flash lmove" \ It works around the problem that continuous CPU access to the

1 0

r611 - dev/olpc/keyboard
by svn＠openbios.org 18 Sep '07

18 Sep '07

Author: wmb Date: 2007-09-18 01:32:59 +0200 (Tue, 18 Sep 2007) New Revision: 611 Modified: dev/olpc/keyboard/selftest.fth Log: OLPC keyboard selftest - use "open/close" instead of iselect so the selftest method is independent of the value of "stdin". Modified: dev/olpc/keyboard/selftest.fth =================================================================== --- dev/olpc/keyboard/selftest.fth 2007-09-17 23:30:12 UTC (rev 610) +++ dev/olpc/keyboard/selftest.fth 2007-09-17 23:32:59 UTC (rev 611) @@ -191,7 +191,7 @@ : toss-keys ( -- ) begin key? while key drop repeat ; : selftest ( -- error? ) - stdin @ iselect + open 0= if true exit then make-keys cursor-off draw-keyboard toss-keys " translation-off" $call-parent @@ -200,6 +200,7 @@ iunselect screen-ih iselect erase-screen iunselect page + close false ;

1 0

r610 - dev/usb2/device/storage
by svn＠openbios.org 18 Sep '07

18 Sep '07

Author: wmb Date: 2007-09-18 01:30:12 +0200 (Tue, 18 Sep 2007) New Revision: 610 Modified: dev/usb2/device/storage/scsidisk.fth Log: USB mass storage driver - removed spinner from the read routine. Modified: dev/usb2/device/storage/scsidisk.fth =================================================================== --- dev/usb2/device/storage/scsidisk.fth 2007-09-17 23:29:26 UTC (rev 609) +++ dev/usb2/device/storage/scsidisk.fth 2007-09-17 23:30:12 UTC (rev 610) @@ -149,10 +149,7 @@ \ These three methods are called by the deblocker. : max-transfer ( -- n ) parent-max-transfer ; -: read-blocks ( addr block# #blocks -- #read ) - " show-progress" evaluate - true d# 8 r/w-blocks -; +: read-blocks ( addr block# #blocks -- #read ) true d# 8 r/w-blocks ; : write-blocks ( addr block# #blocks -- #written ) false d# 10 r/w-blocks ; \ Methods used by external clients

1 0

r609 - cpu/x86/pc/olpc
by svn＠openbios.org 18 Sep '07

18 Sep '07

Author: wmb Date: 2007-09-18 01:29:26 +0200 (Tue, 18 Sep 2007) New Revision: 609 Modified: cpu/x86/pc/olpc/crypto.bth cpu/x86/pc/olpc/crypto.fth cpu/x86/pc/olpc/loaddropins.fth cpu/x86/pc/olpc/security.fth Log: OLPC firmware security - use 4 keys in the firmware. Modified: cpu/x86/pc/olpc/crypto.bth =================================================================== --- cpu/x86/pc/olpc/crypto.bth 2007-09-17 23:15:36 UTC (rev 608) +++ cpu/x86/pc/olpc/crypto.bth 2007-09-17 23:29:26 UTC (rev 609) @@ -5,9 +5,11 @@ fload ${BP}/cpu/x86/pc/olpc/versions.fth -" wget http://dev.laptop.org/pub/firmware/crypto/bios_crypto-${CRYPTO_VERSION}.img -O crypto.img" expand$ $sh -" wget http://dev.laptop.org/pub/firmware/crypto/testkeys/os.public -O os.public" expand$ $sh -" wget http://dev.laptop.org/pub/firmware/crypto/testkeys/fw.public -O fw.public" expand$ $sh +" wget http://dev.laptop.org/pub/firmware/crypto/bios_verify-${CRYPTO_VERSION}.img -O verify.img" expand$ $sh +" wget http://dev.laptop.org/pub/firmware/crypto/testkeys/os.public -O os.public" expand$ $sh +" wget http://dev.laptop.org/pub/firmware/crypto/testkeys/fw.public -O fw.public" expand$ $sh +" wget http://dev.laptop.org/pub/firmware/crypto/testkeys/os.public -O lease.public" expand$ $sh +" wget http://dev.laptop.org/pub/firmware/crypto/testkeys/fw.public -O developer.public" expand$ $sh \ This forces the creation of an crypto.log file, so we don't re-fetch writing crypto.version Modified: cpu/x86/pc/olpc/crypto.fth =================================================================== --- cpu/x86/pc/olpc/crypto.fth 2007-09-17 23:15:36 UTC (rev 608) +++ cpu/x86/pc/olpc/crypto.fth 2007-09-17 23:29:26 UTC (rev 609) @@ -1,9 +1,9 @@ purpose: Interface to cryptographic code for firmware image validation \ See license at end of file -h# c0000 constant crypto-base \ The address the code is linked to run at -h# d0000 constant crypto-bss \ The address the code is linked to run at -h# 10000 constant /crypto-bss +h# c0000 constant verify-base \ The address the code is linked to run at +h# d0000 constant verify-bss \ The address the code is linked to run at +h# 10000 constant /verify-bss 0 [if] h# c0000 constant hasher-base \ The address the code is linked to run at @@ -25,34 +25,17 @@ 0 value crypto-loaded? : load-crypto ( -- error? ) crypto-loaded? if false exit then - " crypto" find-drop-in 0= if true exit then ( prog$ ) - 2dup crypto-base swap move free-mem ( ) + " verify" find-drop-in 0= if true exit then ( prog$ ) + 2dup verify-base swap move free-mem ( ) true to crypto-loaded? false ; -h# 200 buffer: pubkey -0 value /pubkey -: load-key ( name$ -- error? ) - find-drop-in 0= if true exit then ( key$ ) - dup h# 200 > if free-mem true exit then ( key$ ) - dup to /pubkey ( key$ ) - 2dup pubkey swap move ( key$ ) - free-mem - false -; +: signature-bad? ( data$ sig$ key$ hashname$ -- mismatch? ) + $cstr + verify-bss /verify-bss erase ( data$ sig$ key$ 'hashname ) + verify-base dup h# 10 - sp-call >r 3drop 4drop r> ( result ) -: signature-bad? ( data$ sig$ hashname$ -- mismatch? ) - $cstr >r ( data$ sig$ r: 'hashname ) - - swap 2swap swap ( siglen sigadr datalen dataadr ) - /pubkey pubkey 2swap ( siglen sigadr keylen keyadr datalen dataadr ) - r> ( siglen sigadr keylen keyadr datalen dataadr 'hashname ) - - - crypto-bss /crypto-bss erase - crypto-base dup h# 10 - sp-call >r 3drop 4drop r> ( result ) - \ XXX free-mem in suspend.fth and fw.bth after find-drop-in \ XXX clean out dead code in usb.fth ; Modified: cpu/x86/pc/olpc/loaddropins.fth =================================================================== --- cpu/x86/pc/olpc/loaddropins.fth 2007-09-17 23:15:36 UTC (rev 608) +++ cpu/x86/pc/olpc/loaddropins.fth 2007-09-17 23:29:26 UTC (rev 609) @@ -38,6 +38,8 @@ " ${BP}/ofw/termemu/gallant.obf" " font" $add-deflated-dropin - " crypto.img" " crypto" $add-deflated-dropin - " os.public" " oskey" $add-dropin \ Incompressible - " fw.public" " fwkey" $add-dropin \ Incompressible + " verify.img" " verify" $add-deflated-dropin + " os.public" " ospubkey" $add-dropin \ Incompressible + " fw.public" " fwpubkey" $add-dropin \ Incompressible + " lease.public" " leasepubkey" $add-dropin \ Incompressible + " developer.public" " develpubkey" $add-dropin \ Incompressible Modified: cpu/x86/pc/olpc/security.fth =================================================================== --- cpu/x86/pc/olpc/security.fth 2007-09-17 23:15:36 UTC (rev 608) +++ cpu/x86/pc/olpc/security.fth 2007-09-17 23:29:26 UTC (rev 609) @@ -3,6 +3,7 @@ \ Specs at http://wiki.laptop.org/go/Firmware_Security +: developer-device-list " disk sd nand" ; : boot-device-list " disk sd nand" ; true value debug-security? @@ -34,9 +35,44 @@ : PN pn-buf count ; previous definitions +\ key: is a defining word whose children return key strings. +\ Each child word has the name of its key stored in the dictionary. +\ The first time that a child word executes, it uses the key name +\ to find the key value and caches the key value in RAM so subsequent +\ uses are faster. + +: key: ( name$ "name" -- key$ ) + create 0 , 0 , ", \ adr len name + does> ( apf -- key$ ) + dup @ if 2@ exit then ( apf ) + dup 2 na+ count ( apf name$ ) + 2dup find-drop-in if ( apf name$ key$ ) + 2nip + else ( apf name$ ) + ." Can't load key " type cr + " Missing Key" ( apf bad-key$ ) + then + rot >r 2dup r> 2! ( key$ ) +; +" ospubkey" key: oskey$ +" fwpubkey" key: fwkey$ +" develpubkey" key: develkey$ +" leasepubkey" key: leasekey$ + +\ pubkey$ is a global variable that points to the currently-selected +\ public key string. It simplifies the stack manipulations for other +\ words, since the same key string is often used multiple times. +0 0 2value pubkey$ + +\ sig-buf is used for storing the binary version of signature strings +\ that have been decoded from the hex representation. + d# 256 constant /sig /sig buffer: sig-buf +\ hex-decode decodes a hexadecimal signature string, storing it in +\ binary form at sig-buf. It returns the adr,len of the binary string. + : hex-decode ( hex$ -- true | sig$ false ) dup /sig 2* <> if ( ." Bad signature length" cr ) @@ -52,6 +88,10 @@ sig-buf tuck - false ( sig$ false ) ; +\ parse-sig parses a "sig01:" format signature string, returning its +\ hashname and signature substrings. It converts the signature +\ substring from ASCII hex to binary bytes. + : parse-sig ( sig01$ -- true | hashname$ sig$ false ) dup d# 89 < if 2drop true exit then bl left-parse-string " sig01:" $= 0= if 2drop true exit then ( rem$ ) @@ -61,6 +101,12 @@ hex-decode if 2drop true else false then ; +\ zip-extent looks inside a memory-resident ZIP archive and returns +\ the address,length of a given component of that archive. This +\ assumes that the components are "stored", not "deflated". It +\ depends on the existence of a support package named "/lzip" to +\ do the work. + : zip-extent ( name$ -- adr len ) expand$ open-dev ?dup 0= if " " exit then >r @@ -68,10 +114,23 @@ " size" r@ $call-method drop r> close-dev ; + +\ sig$ and img$ find the signature and signed-image components of +\ a ZIP bundle image that is already in memory. + : sig$ ( -- adr len ) " /lzip:\data.sig" zip-extent ; : img$ ( -- adr len ) " /lzip:\data.img" zip-extent ; + +\ bundle-name$ returns the full OFW pathname of a signed image +\ bundle, piecing it together from the device (DN), path (PN), +\ filename head (CN), and filename body (FN) macros. + : bundle-name$ ( -- $ ) " ${DN}:${PN}\${CN}${FN}.zip" expand$ ; +\ bundle-present? determines the existence (or not) of a signed image +\ bundle whose name is constructed from the current settings of the +\ device (DN), path (PN), filename head (CN), and filename body (FN). + : bundle-present? ( -- flag ) bundle-name$ " Trying " ?lease-debug 2dup ?lease-debug-cr @@ -79,32 +138,53 @@ true ; +\ hashname remembers the most recently used hashname to guard against +\ attacks based on reuse of the same (presumably compromized) hash. + d# 32 buffer: hashname -\ fn-buf and pn-buf must contain the base file name and path -: valid? ( data$ sig$ -- okay? ) + +\ valid? checks the validity of data$ against the ASCII signature +\ record sig01$, using the public key that pubkey$ points to. +\ It also verifies that the hashname contained in sig01$ is not +\ the same one that was last used (for verification of firmware +\ images against two different hashes). + +: valid? ( data$ sig01$ -- okay? ) parse-sig if ." Bad signature format in " bundle-name$ type cr false exit then ( data$ hashname$ sig$ ) + 2swap d# 31 min ( data$ sig$ hashname$' ) + \ Check for duplicate hashname attacks - 2swap 2dup hashname count $= if ( data$ sig$ hashname$ ) + 2dup hashname count $= if ( data$ sig$ hashname$ ) ." Duplicate hash name in " bundle-name$ type cr 4drop false exit - then + then ( data$ sig$ hashname$ ) - d# 31 min hashname place ( data$ sig$ ) + hashname place ( data$ sig$ ) - hashname count signature-bad? 0= + pubkey$ hashname count signature-bad? 0= ( okay? ) ; +\ earliest is the earliest acceptable date value (in seconds). +\ It is the date that the first test version of this code was +\ deployed. If a laptop has any earlier date that than, that +\ date is presumed bogus. + d# 2007 d# 12 * 8 1- + d# 31 * d# 27 + constant earliest + 0. 2value current-seconds -\ This isn't an accurate calculation of seconds, but it -\ is sufficient for comparison purposes so long as we -\ use the same calculation in all cases. It is not good -\ if we need to do arithmetic on dates. +\ get-date reads the date and time from the real time clock +\ and converts it to seconds. + +\ The seconds conversion uses a simplified approach that ignores +\ leap years and the like - it assumes that all months are 31 days. +\ This is sufficient for comparison purposes so long as we use the +\ same calculation in all cases. It is not good for doing +\ arithmetic on dates. : get-date ( -- error? ) time&date ( s m h d m y ) d# 12 * swap 1- + ( s m h d m' ) \ Months start at 1 @@ -121,17 +201,24 @@ false ; +\ break$ splits a string into an initial substring of length n +\ (head$) and the residual substring (tail$). If the input +\ string is shorter than n, head$ is the input string and tail$ is +\ the null string. + : break$ ( $ n -- tail$ head$ ) + 2dup < if drop null$ 2swap exit then dup >r /string ( tail$ ) over r@ - r> ( tail$ head$ ) ; 0. 2value exp-seconds \ Accumulator for parsing data/time strings -\ This is a factor used for parsing 2-digit fields from date/time strings. +\ numfield is a factor used for parsing 2-digit fields from date/time strings. \ Radix is the number to scale the result by, i.e. one more than the maximum \ value of the field. Adjust is 0 for fields whose first valid value is 0 \ (hours, minutes, seconds) or 1 for fields that start at 1 (month,day). + : numfield ( exp$ adjust radix -- exp$' ) >r >r ( exp$ r: radix adjust ) 2 break$ $number throw ( exp$' num r: radix adjust ) @@ -144,6 +231,10 @@ rot 0 d+ to exp-seconds ( exp$ ) ; +\ expiration-to-seconds parses an expiration date string like +\ "20070820T130401Z", converting it to (double precision) seconds +\ according to the simplified calculation described above for "get-date" + : (expiration-to-seconds) ( expiration$ -- true | d.seconds false ) 4 break$ $number throw ( exp$' year ) dup d# 2999 u> throw ( exp$' year ) @@ -169,6 +260,9 @@ dup if nip nip then ; +\ expired? determines whether or not the expiration time string is +\ earlier than this machine's current time (from the real time clock). + : expired? ( expiration$ -- bad? ) expiration-to-seconds if true exit then current-seconds d< @@ -177,15 +271,24 @@ d# 1024 constant /sec-line-max /sec-line-max buffer: sec-line-buf -\ Remove bogus null characters from the end of tags on old machines +\ Remove bogus null characters from the end of mfg data tags (old machines +\ have malformed tags) : ?-null ( adr len -- adr' len' ) dup if 2dup + 1- c@ 0= if 1- then ( adr len' ) then ; +\ machine-id-buf is a buffer into which the machine signature string, +\ including serial number, UUID, and expiration time, is place. +\ That string is the signed object for lease and developer key verification. + d# 65 buffer: machine-id-buf +\ get-my-sn get the machine identification info including serial number +\ and UUID from the manufacturing data, placing it into machine-id-buf +\ for later use. The expiration time is added later. + : get-my-sn ( -- error? ) " SN" find-tag 0= if @@ -214,18 +317,33 @@ false ; + +\ my-sn$ returns the serial number portion of the machine identification. +\ get-my-sn must be called before my-sn$ will be valid. + : my-sn$ ( -- adr len ) machine-id-buf d# 11 ; + +\ check-machine-signature verifies the signed object consisting +\ of the machine identification info (SN + UUID) plus the expiration +\ time "expiration$" against the crypto signature string sig$, +\ returning 1 if valid, -1 if invalid. (The unusual return value +\ encoding is because the caller of check-machine-signature returns +\ a tree-state flag; see check-lease.) + : check-machine-signature ( sig$ expiration$ -- -1|1 ) 0 hashname c! machine-id-buf d# 49 + swap move ( sig$ ) machine-id-buf d# 65 2swap valid? if 1 else -1 then ; +\ check-lease checks a lease signature record in act01: format + \ -1 means lease is for this machine and is invalid \ 1 means lease is for this machine and is valid \ 0 means lease is not for this machine -: check-lease ( lease$ -- -1|0|1 ) + +: check-lease ( act01-lease$ -- -1|0|1 ) bl left-parse-string " act01:" $= 0= if " Not act01:" ?lease-debug-cr 2drop -1 exit @@ -253,12 +371,18 @@ then ; -: lease-valid? ( -- flag ) +\ lease-valid? tries to read a lease file from the currently-selected +\ device, searches it for a lease record corresponding to this machine, +\ and checks that record for validity. The return value is true if +\ a valid lease was found. + +: lease-valid? ( -- valid? ) " ${DN}:\security\lease.sig" expand$ ( name$ ) " Trying " ?lease-debug 2dup ?lease-debug-cr r/o open-file if drop false exit then ( ih ) >r ( r: ih ) " Lease " ?lease-debug ( r: ih ) + leasekey$ to pubkey$ ( r: ih ) begin sec-line-buf /sec-line-max r@ read-line if ( actual -eof? ) 2drop r> close-file drop false exit @@ -272,11 +396,25 @@ r> close-file drop false ; +\ ?leased checks the currently-selected device for a valid lease +\ (see lease-valid?), setting the CN macro to "run" if one was +\ found or to "act" otherwise. CN is used to construct a filename +\ like "runos.zip" (the normal OS, used when an valid lease is +\ present) or "actos.zip" (the activation version of the OS). + : ?leased ( -- ) lease-valid? if " run" else " act" then cn-buf place ; -: olpc-load-image ( list$ pathname$ -- okay? ) +\ olpc-load-image is factor that is close the top level of the +\ secure boot process. Given a directory prefix (e.g. "\boot") +\ and a space-delimited list of device names, it searches +\ each device in that list for an OS bundle in that directory. +\ The name of the OS bundle file is either "actos.zip" or +\ "runos.zip" according to whether or not a valid lease for +\ this machine is present on the same device. + +: olpc-load-image ( list$ dirname$ -- okay? ) pn-buf place ( list$ ) begin dup while ( list$ ) bl left-parse-string ( list$ devname$ ) @@ -285,6 +423,7 @@ bundle-present? if ( list$ ) " OS found - " ?lease-debug 0 hashname c! + oskey$ to pubkey$ img$ sig$ valid? if " Signature valid" ?lease-debug-cr img$ tuck load-base swap move !load-size @@ -297,20 +436,20 @@ 2drop false ; +\ secure-load is the top level of the secure OS loading process. +\ It searches for lease files and signed OS image bundles on several +\ different devices. If an OS bundle is not found, it then searches +\ the NAND FLASH for an alternate OS image. + : secure-load ( -- okay? ) load-crypto if ( ) - ." Can't get crypt code" cr ( ) + ." Can't get crypto code" cr ( ) false exit then ( ) get-my-sn if false exit then get-date if false exit then - " oskey" load-key if ( ) - ." Can't find OS public key" cr ( ) - false exit - then ( ) - " os" fn-buf place boot-device-list " \boot" olpc-load-image if true exit then @@ -318,8 +457,19 @@ false ; +\ secure-load-ramdisk is called during the process of preparing an +\ OS image for execution. It looks for an initrd bundle file on +\ the same device where the OS image was found, in a file named +\ either "runrd.zip" or "actrd.zip" depending on the presence of +\ a valid lease. + +\ If no such bundle is found, the OS is booted without a ramdisk. +\ If a valid bundle is found, the OS is booted with that ramdisk. +\ If a bundle is found but it is not valid, the booting process aborts. + \ Call this after the kernel has already been moved away from load-base \ We assume that pn-buf already has the path prefix string + : secure-load-ramdisk ( -- ) \ Bad idea, because the cmdline would need to be signed too \ " /lzip:\cmdline" zip-extent to cmdline @@ -338,14 +488,47 @@ then ; -: check-devel-key ( adr len -- -1|0|1 ) + +\ secure-boot performs the secure boot process + +: secure-boot ( -- ) + debug-security? if screen-ih stdout ! then + ['] secure-load-ramdisk to load-ramdisk + secure-load 0= if fail-load then + loaded sync-cache " init-program" $find if execute else 2drop then + go +; + +\ wp? returns true if a "wp" manufacturing data tag is present + +: wp? ( -- flag ) " wp" find-tag dup if nip nip then ; + +\ ?secure-boot performs either the secure boot algorithm or the +\ historical boot algorithm depending on the presence of a "wp" +\ manufacturing data tag. + +: ?secure-boot ( -- ) wp? if secure-boot else boot then ; +" ?secure-boot" ' boot-command set-config-string-default + + +\ check-devel-key tests the developer signature string "dev01$". + +\ -1 means the signature is for this machine and is invalid +\ 1 means the signature is for this machine and is valid +\ 0 means the signature is not for this machine + +: check-devel-key ( dev01$ -- -1|0|1 ) bl left-parse-string " dev01:" $= 0= if 2drop -1 exit then ( rem$ ) bl left-parse-string ( rem$ serial$ ) - my-sn$ $= 0= if 2drop 0 exit then ( rem$ ) + my-sn$ $= 0= if 2drop 0 exit then ( rem$ ) + develkey$ to pubkey$ " 00000000T000000Z" check-machine-signature ; +\ has-developer-key? searches for a valid developer key on the +\ device given by the DN macro. + : has-developer-key? ( -- flag ) " ${DN}:\security\develop.sig" expand$ ( name$ ) r/o open-file if drop false exit then ( ih ) @@ -363,22 +546,18 @@ r> close-file drop false ; -: developer-device-list " disk sd nand" ; +\ developer? searches a list of devices (given by "developer-device-list") +\ for a valid developer key : developer? ( -- flag ) - get-my-sn if false exit then + get-my-sn if false exit then load-crypto if ( ) ." Can't get crypt code" cr ( ) false exit then ( ) - " fwkey" load-key if ( ) - ." Can't find firmware public key" cr ( ) - false exit - then ( ) - - developer-device-list + developer-device-list ( list$ ) begin dup while ( list$ ) bl left-parse-string dn-buf place ( list$' ) has-developer-key? if ( list$' ) @@ -388,22 +567,7 @@ 2drop false ; -: secure-boot ( -- ) - debug-security? if screen-ih stdout ! then - ['] secure-load-ramdisk to load-ramdisk - secure-load 0= if fail-load then - loaded sync-cache " init-program" $find if execute else 2drop then - go -; -: wp? ( -- flag ) " wp" find-tag dup if nip nip then ; - -: ?secure-boot ( -- ) wp? if secure-boot else boot then ; -" ?secure-boot" ' boot-command set-config-string-default - -\ For dn in boot-device-list -\ if - fexit Firmware security use cases:

1 0

r608 - cpu/x86/pc/olpc
by svn＠openbios.org 18 Sep '07

18 Sep '07

Author: wmb Date: 2007-09-18 01:15:36 +0200 (Tue, 18 Sep 2007) New Revision: 608 Modified: cpu/x86/pc/olpc/copynand.fth cpu/x86/pc/olpc/nandstat.fth Log: save-nand now creates a .crc file . New "scan-nand" command. Modified: cpu/x86/pc/olpc/copynand.fth =================================================================== --- cpu/x86/pc/olpc/copynand.fth 2007-09-17 23:09:19 UTC (rev 607) +++ cpu/x86/pc/olpc/copynand.fth 2007-09-17 23:15:36 UTC (rev 608) @@ -15,12 +15,16 @@ 0 value crc-buf -: >crc ( index -- crc ) crc-buf swap la+ l@ ; +: >crc ( index -- 'crc ) crc-buf swap la+ ; + : $call-nand ( ?? method$ -- ?? ) nandih $call-method ; +: close-image-file ( -- ) + fileih ?dup if 0 to fileih close-dev then +; : close-nand-ihs ( -- ) - fileih ?dup if 0 to fileih close-dev 0 to #image-eblocks then + close-image-file nandih ?dup if 0 to nandih close-dev 0 to #nand-pages then crc-ih ?dup if 0 to crc-ih close-dev then #crc-records if @@ -118,7 +122,7 @@ ; : check-mem-crc ( record# -- ) - >crc ( crc ) + >crc l@ ( crc ) load-base /nand-block $crc ( crc actual-crc ) 2dup <> if cr ." CRC miscompare - expected " swap . ." got " . cr @@ -133,6 +137,9 @@ #crc-records if check-mem-crc else drop then ; +defer show-init ( #eblocks -- ) +' drop to show-init + defer show-erasing ( #blocks -- ) : (show-erasing) ( #blocks -- ) ." Erasing " . ." blocks" cr ; ' (show-erasing) to show-erasing @@ -151,17 +158,26 @@ ' drop to show-clean defer show-cleaning ( -- ) -: (show-cleaning) ( -- ) cr ." Cleanmarkers" cr ; +: (show-cleaning) ( -- ) cr ." Cleanmarkers" ; ' (show-cleaning) to show-cleaning defer show-writing ( #blocks -- ) : (show-writing) ." Writing " . ." blocks" cr ; ' (show-writing) to show-writing +defer show-pending ( block# -- ) +' drop to show-pending + defer show-written : (show-written) ( block# -- ) (cr . ; ' (show-written) to show-written +defer show-strange +' drop to show-strange + +defer show-done +' cr to show-done + : copy-nand ( "devspec" -- ) open-nand get-img-filename @@ -170,7 +186,9 @@ ['] noop to show-progress - #nand-pages nand-pages/block / show-erasing + #nand-pages nand-pages/block / dup show-init ( #eblocks ) + + show-erasing ( ) ['] show-bad ['] show-erased ['] show-bbt-block " (wipe)" $call-nand #image-eblocks show-writing @@ -185,6 +203,7 @@ show-cleaning ['] show-clean " put-cleanmarkers" $call-nand + show-done close-nand-ihs ; @@ -243,7 +262,7 @@ load-base " read-next-block" $call-nand ( ) - load-base /nand-block $crc i >crc ( actual-crc expected-crc ) + load-base /nand-block $crc i >crc l@ ( actual-crc expected-crc ) 2dup <> if ( actual-crc expected-crc ) cr ." CRC miscompare - expected " . ." got " . ( ) ." in NAND block starting at page " @@ -264,44 +283,101 @@ ; true value dump-oob? -: (dump-nand) ( "devspec" -- ) - open-nand - safe-parse-word ( name$ ) +: make-new-file ( devspec$ -- fileih ) + 2dup ['] $delete catch if 2drop then ( name$ ) + 2dup ['] $create-file catch if ( name$ x x ) + 2drop ( name$ ) + " Can't open a file. Try using the raw disk?" confirm if ( name$ ) + open-dev ( ih ) + else ( name$ ) + 2drop 0 ( ih=0 ) + then ( ih ) + else ( name$ ih ) + nip nip ( ih ) + then ( ih ) +; - cr ." Dumping to " 2dup type cr +: alloc-crc-buf ( -- ) + #nand-pages nand-pages/block / to #crc-records + #crc-records /l* alloc-mem to crc-buf +; - 2dup ['] $delete catch if 2drop then ( name$ ) - 2dup ['] $create-file catch if - 2drop - " Can't open a file. Try using the raw disk?" confirm if - open-file - else - 2drop 0 +: save-crcs ( -- ) + image-name$ crc-name-buf place + true + crc-name$ nip 4 >= if + crc-name$ + 4 - c@ [char] . = if + " crc" crc-name$ + 3 - swap move + drop false then - then - to fileih + then ( error? ) + " Filename needs a 3-character extension" ?nand-abort + crc-name$ ( name$ ) + ." CRC file is " 2dup type ( name$ ) + + make-new-file to crc-ih + + crc-ih 0= " Can't open CRC output file" ?nand-abort + + #image-eblocks 0 ?do + i >crc l@ + push-hex + <# newline hold u# u# u# u# u# u# u# u# u#> ( adr len ) + pop-base + " write" crc-ih $call-method 9 <> " CRC write failed" ?nand-abort + loop + +; +: open-dump-file ( devspec$ -- ) + cr ." Dumping to " 2dup type cr + + make-new-file to fileih + fileih 0= " Can't open output" ?nand-abort +; +: (dump-nand) ( "devspec" -- ) + open-nand + get-img-filename + + dump-oob? 0= if alloc-crc-buf then + image-name$ open-dump-file + + 0 to #image-eblocks + \ The stack is empty at the end of each line unless otherwise noted - #nand-pages 0 do - (cr i . + dump-oob? if #nand-pages else " usable-page-limit" $call-nand then + 0 do + (cr i nand-pages/block / . load-base i nand-pages/block " read-blocks" $call-nand nand-pages/block = if load-base /nand-block written? if - load-base /nand-block " write" fileih $call-method drop + ." w" + load-base /nand-block " write" fileih $call-method + /nand-block <> " Write to dump file failed" ?nand-abort dump-oob? if i nand-pages/block bounds ?do i " read-oob" $call-nand h# 40 ( adr len ) " write" fileih $call-method drop - i pad ! pad 4 " write" fileih $call-method drop + h# 40 <> " Write of OOB data failed" ?nand-abort + i pad ! pad 4 " write" fileih $call-method + 4 <> " Write of eblock number failed" ?nand-abort loop + else + load-base /nand-block $crc #image-eblocks >crc l! then + #image-eblocks 1+ to #image-eblocks + else + ." s" then then nand-pages/block +loop cr ." Done" cr + close-image-file + save-crcs + close-nand-ihs ; : dump-nand ( "devspec" -- ) true to dump-oob? (dump-nand) ; Modified: cpu/x86/pc/olpc/nandstat.fth =================================================================== --- cpu/x86/pc/olpc/nandstat.fth 2007-09-17 23:09:19 UTC (rev 607) +++ cpu/x86/pc/olpc/nandstat.fth 2007-09-17 23:15:36 UTC (rev 608) @@ -12,71 +12,250 @@ 9 constant grid-h d# 128 value #cols +: xy+ ( x1 y1 x2 y2 -- x3 y3 ) rot + -rot + swap ; : xy* ( x y w h -- x*w y*h ) rot * >r * r> ; +0 value nand-block-limit + +: do-fill ( color x y w h -- ) " fill-rectangle" $call-screen ; + \ States: 0:erased 1:bad 2:waiting for write 3:written -: >loc ( eblock# -- ) #cols /mod grid-w grid-h xy* ulhc d+ ; +: >loc ( eblock# -- x y ) #cols /mod grid-w grid-h xy* ulhc xy+ ; -: show-state ( eblock# state -- ) - swap >loc glyph-w glyph-h " fill-rectangle" $call-screen -; +: show-state ( eblock# state -- ) swap >loc glyph-w glyph-h do-fill ; dev screen : erase-screen erase-screen ; dend -h# 80 h# 80 h# 80 rgb>565 constant bbt-color - 0 0 0 rgb>565 constant erased-color -h# ff 0 0 rgb>565 constant bad-color - 0 0 h# ff rgb>565 constant clean-color -h# ff h# ff 0 rgb>565 constant writing-color - 0 h# ff 0 rgb>565 constant written-color -h# ff h# ff h# ff rgb>565 constant starting-color +h# 80 h# 80 h# 80 rgb>565 constant bbt-color \ gray + 0 0 0 rgb>565 constant erased-color \ black +h# ff 0 0 rgb>565 constant bad-color \ red + 0 0 h# ff rgb>565 constant clean-color \ blue +h# ff h# ff 0 rgb>565 constant pending-color \ yellow + 0 h# ff 0 rgb>565 constant written-color \ green + 0 h# ff h# ff rgb>565 constant strange-color \ cyan +h# ff h# ff h# ff rgb>565 constant starting-color \ white -: gshow-erasing ( #eblocks -- ) - cursor-off " erase-screen" $call-screen 0 status-line at-xy - ." Erasing " +: gshow-init ( #eblocks -- ) + #nand-pages nand-pages/block / to nand-block-limit + cursor-off " erase-screen" $call-screen + " bbt0" $call-nand nand-pages/block / bbt-color show-state " bbt1" $call-nand nand-pages/block / bbt-color show-state starting-color ( #eblocks color ) swap 0 ?do i over show-state loop drop + 0 status-line at-xy ; +: gshow-erasing ( #eblocks -- ) drop ." Erasing " ; + : gshow-erased ( eblock# -- ) erased-color show-state ; : gshow-bad ( eblock# -- ) bad-color show-state ; : gshow-bbt-block ( eblock# -- ) bbt-color show-state ; : gshow-clean ( eblock# -- ) clean-color show-state ; +: gshow-strange ( eblock# -- ) strange-color show-state ; -: gshow-cleaning ( -- ) ." Cleanmarkers" cr cursor-on ; +: gshow-cleaning ( -- ) d# 26 status-line at-xy ." Cleanmarkers" cr ; +: gshow-done ( -- ) cursor-on ; +: gshow-pending ( eblock# -- ) pending-color show-state ; + : gshow-writing ( #eblocks -- ) ." Writing " - writing-color ( #eblocks color ) - 0 rot 0 ?do ( color eblock# ) - dup nand-pages/block * " block-bad?" $call-nand 0= if ( color eblock# ) - 2dup swap show-state ( color eblock# ) - 1 ( color eblock# increment ) - else ( color eblock# ) - 0 ( color eblock# increment ) - then ( color eblock# increment ) - swap 1+ swap ( color eblock#' increment ) - +loop ( color eblock#' ) - 2drop + 0 rot 0 ?do ( eblock# ) + dup nand-pages/block * " block-bad?" $call-nand 0= if ( eblock# ) + dup show-pending ( eblock# ) + 1 ( eblock# increment ) + else ( eblock# ) + 0 ( eblock# increment ) + then ( eblock# increment ) + swap 1+ swap ( eblock#' increment ) + +loop ( eblock#' ) + drop ; -: gshow-written ( eblock# -- ) written-color show-state ; +: gshow-written ( eblock# -- ) + dup written-color show-state + d# 20 status-line at-xy .x +; : gshow + ['] gshow-init to show-init ['] gshow-erasing to show-erasing ['] gshow-erased to show-erased ['] gshow-bad to show-bad ['] gshow-bbt-block to show-bbt-block ['] gshow-clean to show-clean ['] gshow-cleaning to show-cleaning + ['] gshow-pending to show-pending ['] gshow-writing to show-writing ['] gshow-written to show-written + ['] gshow-strange to show-strange + ['] gshow-done to show-done ; gshow + +\ 0 - marked bad block : show-bad +\ 1 - unreadable block : show-bad +\ 2 - jffs2 w/ summary: show-written +\ 3 - jffs2 w/o summary: show-pending +\ 4 - clean : show-clean +\ 5 - non-jffs2 data : show-strange +\ 6 - erased : show-erased +\ 7 - primary bad-block-table : show-bbt-block +\ 8 - secondary bad-block-table : show-bbt-block +: show-status ( status eblock# -- ) + swap case + 0 of show-bad endof + 1 of show-bad endof + 2 of show-written endof + 3 of show-pending endof + 4 of show-clean endof + 5 of show-strange endof + 6 of show-erased endof + 7 of show-bbt-block endof + 8 of show-bbt-block endof + endcase +; + +0 value nand-map +0 value working-page +: classify-block ( page# -- status ) + to working-page + + \ Check for block marked bad in bad-block table + working-page " block-bad?" $call-nand if 0 exit then + + \ Try to read the first few bytes + load-base 4 working-page 0 " pio-read" $call-nand + + \ Check for a JFFS2 node at the beginning + load-base w@ h# 1985 = if + \ Look for a summary node + load-base 4 working-page h# 3f + h# 7fc " pio-read" $call-nand + load-base " "(85 18 85 02)" comp if 3 else 2 then + exit + then + + \ Check for non-erased, non-JFFS2 data + load-base l@ h# ffff.ffff <> if 5 exit then + + \ Check for various signatures in the OOB area + working-page " read-oob" $call-nand d# 14 + ( adr ) + + \ .. Cleanmarker + dup " "(85 19 03 20 08 00 00 00)" comp 0= if drop 4 exit then + + \ .. Bad block tables +\ These can't happen because the BBT table blocks are marked "bad" +\ so they get filtered out at the top of this routine. +\ dup " Bbt0" comp 0= if drop 7 exit then +\ dup " 1tbB" comp 0= if drop 8 exit then + drop + + \ See if the whole thing is really completely erased + load-base working-page nand-pages/block ( adr block# #blocks ) + " read-blocks" $call-nand nand-pages/block <> if 1 exit then + + \ Not completely erased + load-base load-base h# 100000 + /nand-block comp if 5 exit then + + \ Erased + 6 +; + +0 value current-block +0 value examine-done? + +string-array status-descriptions + ," Marked bad in Bad Block Table" \ 0 + ," Read error" \ 1 + ," JFFS2 data with summary" \ 2 + ," JFFS2 data, no summary" \ 3 + ," Clean (erased with JFFS2 cleanmarker)" \ 4 + ," Dirty, with non-JFFS2 data" \ 5 + ," Erased, no cleanmarker" \ 6 + ," Primary Bad Block Table" \ 7 + ," Secondary Bad Block Table" \ 8 +end-string-array + +: show-block-status ( block# -- ) + d# 20 status-line at-xy + dup .x + nand-map + c@ status-descriptions count type kill-line +; + +: cell-border ( block# color -- ) + swap >loc ( color x y ) + -1 -1 xy+ + 3dup grid-w 1 do-fill ( color x y ) + 3dup grid-w 0 xy+ 1 grid-h do-fill ( color x y ) + 3dup 0 1 xy+ 1 grid-h do-fill ( color x y ) + 1 grid-h xy+ grid-w 1 do-fill +; +: lowlight ( block# -- ) h# ffff cell-border ; +: highlight ( block# -- ) 0 cell-border ; +: +block ( offset -- ) + current-block + nand-block-limit mod ( new-block ) + current-block lowlight + to current-block + current-block highlight + current-block show-block-status +; + +: process-key ( char -- ) + case + h# 9b of endof + [char] A of #cols negate +block endof \ up + [char] B of #cols +block endof \ down + [char] C of 1 +block endof \ right + [char] D of -1 +block endof \ left + [char] ? of #cols 8 * negate +block endof \ page up + [char] / of #cols 8 * +block endof \ page down + [char] K of 8 +block endof \ page right + [char] H of -8 +block endof \ page left + h# 1b of d# 20 ms key? 0= if true to examine-done? then endof + endcase +; + +: examine-nand ( -- ) + 0 status-line 1+ at-xy ." Arrows, fn Arrows to move, Esc to exit" cr + 0 to current-block + current-block highlight + false to examine-done? + begin key process-key examine-done? until + current-block lowlight +; + + +: scan-nand ( -- ) + open-nand + nand-map 0= if + #nand-pages nand-pages/block / alloc-mem to nand-map + then + + \ Something to compare against + load-base h# 100000 + /nand-block h# ff fill + + " usable-page-limit" $call-nand + dup nand-pages/block / show-init ( page-limit ) + + 7 " bbt0" $call-nand nand-pages/block / nand-map + c! + 8 " bbt1" $call-nand nand-pages/block / nand-map + c! + + 0 ?do + i classify-block ( status ) + i nand-pages/block / ( status eblock# ) + 2dup nand-map + c! ( status eblock# ) + show-status + nand-pages/block +loop ( ) + + show-done + close-nand-ihs + + examine-nand +;

1 0

r607 - cpu/x86/pc/olpc/build
by svn＠openbios.org 18 Sep '07

18 Sep '07

Author: wmb Date: 2007-09-18 01:09:19 +0200 (Tue, 18 Sep 2007) New Revision: 607 Modified: cpu/x86/pc/olpc/build/ Log: svn ignore *.public in build/ Property changes on: cpu/x86/pc/olpc/build ___________________________________________________________________ Name: svn:ignore - build ofw.elf builton.fth *.rom *.bin *.version forth sourceurl *.md5 + build ofw.elf builton.fth *.rom *.bin *.version forth sourceurl *.md5 *.public

1 0

r606 - cpu/x86 dev/mmc/sdhci forth/lib ofw/confvar ofw/core
by svn＠openbios.org 18 Sep '07

18 Sep '07

Author: wmb Date: 2007-09-18 01:06:51 +0200 (Tue, 18 Sep 2007) New Revision: 606 Modified: cpu/x86/basefw.bth dev/mmc/sdhci/sdhci.bth dev/mmc/sdhci/sdhci.fth forth/lib/objects.fth ofw/confvar/loadcv.fth ofw/core/loadmore.fth Log: Added various ifdefs in the build process to accomodate building a stripped-down image for firmware recovery. Modified: cpu/x86/basefw.bth =================================================================== --- cpu/x86/basefw.bth 2007-09-17 22:52:04 UTC (rev 605) +++ cpu/x86/basefw.bth 2007-09-17 23:06:51 UTC (rev 606) @@ -22,7 +22,9 @@ \ fload ${BP}/forth/lib/showmsgs.fth \ List error messages fload ${BP}/ofw/core/ofwcore.fth \ Device tree and other OBP routines +[ifndef] no-tools fload ${BP}/ofw/core/ofwfw.fth \ FirmWorks enhancements +[then] fload ${BP}/ofw/core/memops.fth \ Call memory node methods fload ${BP}/ofw/core/mmuops.fth \ Call MMU node methods @@ -33,14 +35,18 @@ fload ${BP}/cpu/x86/vector.fth \ Interrupt vectors \ fload ${BP}/forth/lib/struct.fth fload ${BP}/cpu/x86/interrup.fth \ Enable and disable interrupts +[ifdef] pssave fload ${BP}/cpu/x86/catchexc.fth fload ${BP}/cpu/x86/ctrace.fth \ C stack backtrace +[then] +[ifdef] valid-adr? : mapped? ( adr -- flag ) " translate" mmu-node @ $call-method dup if nip nip then ; ' mapped? to valid-adr? +[then] fload ${BP}/cpu/x86/descr.fth \ Decode segment descriptors fload ${BP}/cpu/x86/dtacc.fth \ Descriptor table access words @@ -49,7 +55,9 @@ fload ${BP}/ofw/core/silentmd.fth \ NVRAM variable silent-mode? fload ${BP}/cpu/x86/call.fth \ Primitive subroutine calls +[ifndef] no-tools fload ${BP}/cpu/x86/centry.fth \ Low-level client entry and exit +[then] [ifdef] v2-compat fload ${BP}/cpu/x86/textops.fth \ S Machine code for 1-bit ops @@ -70,9 +78,11 @@ fload ${BP}/cpu/x86/regacc.fth \ Register access words +\ [ifndef] no-tools fload ${BP}/ofw/fcode/loadfcod.fth \ S Fcode interpreter fload ${BP}/ofw/fcode/regcodes.fth \ Register access words +\ [then] \ File system readers fload ${BP}/ofw/core/initprog.fth \ handle fcode and Forth source @@ -84,15 +94,18 @@ fload ${BP}/ofw/fs/fatfs/loadpkg.fth \ FAT file system reader end-support-package +[ifndef] no-tools support-package: iso9660-file-system fload ${BP}/ofw/fs/cdfs/loadpkg.fth \ ISO 9660 CD-ROM file system reader end-support-package +[then] support-package: disk-label fload ${BP}/ofw/disklabel/loadpkg.fth \ Disk label package end-support-package [then] +[ifndef] no-tools [ifdef] resident-packages fload ${BP}/ofw/fs/fatfs/fdisk2.fth \ Partition map administration [else] @@ -102,6 +115,7 @@ \ defines: init-nt-disk defines: $partition [then] +[then] [ifndef] no-heads resident dispose 0 0 set-transize \ true is suppress-transient Modified: dev/mmc/sdhci/sdhci.bth =================================================================== --- dev/mmc/sdhci/sdhci.bth 2007-09-17 22:52:04 UTC (rev 605) +++ dev/mmc/sdhci/sdhci.bth 2007-09-17 23:06:51 UTC (rev 606) @@ -9,6 +9,13 @@ FCode-version2 fload ${BP}/dev/mmc/sdhci/sdhci.fth + +init +new-device + " sdmmc" " $load-driver" eval drop +finish-device + + fload ${BP}/dev/mmc/sdhci/selftest.fth end0 Modified: dev/mmc/sdhci/sdhci.fth =================================================================== --- dev/mmc/sdhci/sdhci.fth 2007-09-17 22:52:04 UTC (rev 605) +++ dev/mmc/sdhci/sdhci.fth 2007-09-17 23:06:51 UTC (rev 606) @@ -608,15 +608,9 @@ h# 7fff h# 60 cw! unmap-regs ; -init external -new-device - " sdmmc" " $load-driver" eval drop -finish-device - - \ LICENSE_BEGIN \ Copyright (c) 2006 FirmWorks \ Modified: forth/lib/objects.fth =================================================================== --- forth/lib/objects.fth 2007-09-17 22:52:04 UTC (rev 605) +++ forth/lib/objects.fth 2007-09-17 23:06:51 UTC (rev 606) @@ -137,11 +137,13 @@ \ will not show the action name and its argument on separate lines \ if it happens to be near the end of a line. +[ifdef] install-decomp : .action ( ip -- ip' ) dup token@ .name ta1+ dup token@ .name ta1+ ; also hidden also ' to ' .action ' skip-(') install-decomp ' addr ' .action ' skip-(') install-decomp previous previous +[then] : ?has-action ( object-acf action-acf -- object-acf action-acf ) 2dup >body >action# >action-adr .object-error 2drop @@ -158,6 +160,7 @@ -level \ Exit temporary compile state, perhaps run word ; +[ifdef] object-definer : (object-definer) ( action-acf -- definer ) dup /n - @ ( action-acf #actions ) 1- /token * - /n - token@ ( last-action-acf ) @@ -170,6 +173,7 @@ until ; also hidden ' (object-definer) is object-definer previous +[then] \ action-compiler: to action-compiler: addr Modified: ofw/confvar/loadcv.fth =================================================================== --- ofw/confvar/loadcv.fth 2007-09-17 22:52:04 UTC (rev 605) +++ ofw/confvar/loadcv.fth 2007-09-17 23:06:51 UTC (rev 606) @@ -4,7 +4,9 @@ fload ${BP}/ofw/ppp/md5.fth fload ${BP}/ofw/confvar/conftype.fth \ Configuration variable base types fload ${BP}/ofw/confvar/nvramrcg.fth \ NVRAMRC (generic version) +[ifndef] no-tools fload ${BP}/ofw/confvar/nvalias.fth \ Persistent devaliases +[then] fload ${BP}/ofw/confvar/nvcache.fth \ NVRAM cache fload ${BP}/ofw/confvar/nameval.fth \ name=value config variable encoding \ LICENSE_BEGIN Modified: ofw/core/loadmore.fth =================================================================== --- ofw/core/loadmore.fth 2007-09-17 22:52:04 UTC (rev 605) +++ ofw/core/loadmore.fth 2007-09-17 23:06:51 UTC (rev 606) @@ -1,5 +1,6 @@ purpose: Load file for additional core routines +[ifndef] no-tools \ Load code to recognize client program header \ fload ${BP}/ofw/core/go.fth \ Initial program state @@ -9,11 +10,14 @@ \ fload ${BP}/ofw/core/dload.fth \ Diagnostic loading fload ${BP}/ofw/core/callback.fth \ Client callbacks +[then] fload ${BP}/ofw/core/deblock.fth \ Block-to-byte conversion package +[ifndef] no-tools fload ${BP}/ofw/core/dl.fth \ Diagnostic loading fload ${BP}/ofw/core/dlfcode.fth \ Serial line loading +[then] fload ${BP}/ofw/core/instcons.fth \ install-console

1 0

r605 - ofw/fs/fatfs
by svn＠openbios.org 18 Sep '07

18 Sep '07

Author: wmb Date: 2007-09-18 00:52:04 +0200 (Tue, 18 Sep 2007) New Revision: 605 Modified: ofw/fs/fatfs/fat.fth Log: FAT FS: Changed the search order for free clusters so the upward search happens before the downward one, thus eliminating severe FAT cache thrashing when creating large files, as with "save-nand". Modified: ofw/fs/fatfs/fat.fth =================================================================== --- ofw/fs/fatfs/fat.fth 2007-09-17 22:47:27 UTC (rev 604) +++ ofw/fs/fatfs/fat.fth 2007-09-17 22:52:04 UTC (rev 605) @@ -53,13 +53,22 @@ \ If the FAT cache has been modified since it was last written, flush it \ to disk. +: .sectors ( sector# #sectors -- ) + ." " . ." sectors starting at " . +; : ?flush-fat-cache ( -- ) fat-dirty w@ if - fat-sector @ #valid-sectors fat-cache @ write-sectors ( err? ) - if "CaW ". "FAT ". abort then + fat-sector @ #valid-sectors fat-cache @ write-sectors ( err? ) if + "CaW ". "FAT ". + fat-sector @ #valid-sectors .sectors + abort + then - fat-sector @ spf l@ + #valid-sectors fat-cache @ write-sectors ( err? ) - if "CaW ". ." alternate " "FAT ". abort then + fat-sector @ spf l@ + #valid-sectors fat-cache @ write-sectors if + "CaW ". ." alternate " "FAT ". + fat-sector @ spf l@ + #valid-sectors .sectors + abort + then false fat-dirty w! then @@ -172,11 +181,12 @@ fatc-start @ hint @ search-down if mark-cluster exit then then + \ Search up to the end of the disk ** 10/30/90 cpt: up to last cl (1+) + max-cl# l@ 1+ fatc-end @ search-up if mark-cluster exit then + \ Search down to the beginning of the disk 2 fatc-start @ search-down if mark-cluster exit then - \ Search up to the end of the disk ** 10/30/90 cpt: up to last cl (1+) - max-cl# l@ 1+ fatc-end @ search-up if mark-cluster exit then false ; : allocate-cluster ( hint-cluster# -- false | cluster# true )

1 0

r604 - ofw/fs/jffs2
by svn＠openbios.org 18 Sep '07

18 Sep '07

Author: wmb Date: 2007-09-18 00:47:27 +0200 (Tue, 18 Sep 2007) New Revision: 604 Modified: ofw/fs/jffs2/jffs2.fth Log: JFFS2: Changed a message from Unsupported nodetype 2006 to JFFS2 warning: Bad summary node in erase block 0xNNNN Modified: ofw/fs/jffs2/jffs2.fth =================================================================== --- ofw/fs/jffs2/jffs2.fth 2007-09-17 22:44:57 UTC (rev 603) +++ ofw/fs/jffs2/jffs2.fth 2007-09-17 22:47:27 UTC (rev 604) @@ -697,6 +697,11 @@ endof [then] + summary-type of ( adr ) + ." JFFS2 warning: Bad summary node in erase block 0x" have-eblock# . cr + drop eb-end exit + endof ( adr nodetype ) + ( adr nodetype ) cr ." Unsupported nodetype " dup . cr

1 0

r603 - cpu/x86/Linux forth/wrapper
by svn＠openbios.org 18 Sep '07

18 Sep '07

Author: wmb Date: 2007-09-18 00:44:57 +0200 (Tue, 18 Sep 2007) New Revision: 603 Added: cpu/x86/Linux/graphdev.fth Modified: cpu/x86/Linux/Makefile forth/wrapper/wrapper.c Log: Added X graphics support, disabled by default. Modified: cpu/x86/Linux/Makefile =================================================================== --- cpu/x86/Linux/Makefile 2007-09-11 17:13:15 UTC (rev 602) +++ cpu/x86/Linux/Makefile 2007-09-17 22:44:57 UTC (rev 603) @@ -6,6 +6,7 @@ BP=../../.. CFLAGS = -O -g -m32 -DUNIX -D${OS} -DX86 +# CFLAGS += -DUSE_XCB WRTAIL = forth/wrapper WRDIR = ${BP}/${WRTAIL} Added: cpu/x86/Linux/graphdev.fth =================================================================== --- cpu/x86/Linux/graphdev.fth (rev 0) +++ cpu/x86/Linux/graphdev.fth 2007-09-17 22:44:57 UTC (rev 603) @@ -0,0 +1,42 @@ +purpose: Simulation of OFW graphics using X + +dev / new-device + " xgraphics" device-name + : open ( -- okay? ) d# 1200 d# 900 d# 392 syscall 2drop retval 0= ; + : close ( -- ) d# 396 syscall ; + + : fill-rectangle ( color565 x y w h -- ) d# 404 syscall 4drop drop ; +finish-device + +: get-color ( r g b -- color ) + d# 400 syscall 3drop retval +; + +: open-screen + " /xgraphics" open-dev to screen-ih +; + +0 value xred +0 value xgreen +0 value xblue +0 value xmagenta +0 value xblack +0 value xmagenta + +: demo ( -- ) + open-screen + + h# ff h# 00 h# 00 get-color to xred + h# 00 h# ff h# 00 get-color to xgreen + h# 00 h# 00 h# ff get-color to xblue + h# ff h# 00 h# ff get-color to xmagenta + 0 0 0 get-color to xblack + h# ff h# ff h# ff get-color to xmagenta + + d# 500 0 do i xred show-state loop + d# 1000 d# 500 do i xblue show-state loop + d# 1500 d# 1000 do i xgreen show-state loop + d# 2000 d# 1500 do i xmagenta show-state loop + + xblack d# 400 d# 300 d# 50 d# 60 " fill-rectangle" $call-screen +; Modified: forth/wrapper/wrapper.c =================================================================== --- forth/wrapper/wrapper.c 2007-09-11 17:13:15 UTC (rev 602) +++ forth/wrapper/wrapper.c 2007-09-17 22:44:57 UTC (rev 603) @@ -371,6 +371,10 @@ extern long dlopen(), dlsym(), dlerror(), dlclose(); #endif +#ifdef USE_XCB +extern long open_window(), close_window(), rgbcolor(), fill_rectangle(); +#endif + #ifdef JTAG #include "jtag.h" #endif @@ -493,7 +497,12 @@ #endif /* 376 380 384 388 */ - m_inflate, m_map, m_unmap, s_ioperm + m_inflate, m_map, m_unmap, s_ioperm, + +#ifdef USE_XCB + /* 392 396 400 404 */ + open_window, close_window, rgbcolor, fill_rectangle, +#endif }; /* * Function semantics:

1 0

r602 - cpu/x86/pc/olpc
by svn＠openbios.org 11 Sep '07

11 Sep '07

Author: wmb Date: 2007-09-11 19:13:15 +0200 (Tue, 11 Sep 2007) New Revision: 602 Modified: cpu/x86/pc/olpc/resume.bth cpu/x86/pc/olpc/suspend.fth Log: OLPC - Added sci-wakeup and lid-wakeup for suspend/resume testing. Modified: cpu/x86/pc/olpc/resume.bth =================================================================== --- cpu/x86/pc/olpc/resume.bth 2007-09-11 16:48:47 UTC (rev 601) +++ cpu/x86/pc/olpc/resume.bth 2007-09-11 17:13:15 UTC (rev 602) @@ -274,6 +274,7 @@ \ The caller chooses the wakeup conditions, so we don't do it here \ h# 0100.ffff h# 1840 port-wl \ Enable Power button wakeup, clear status bits + h# ffff.ffff h# 1858 port-wl \ Clear all status bits wbinvd \ Flush the cache h# 00ff.ff00 h# 2000.0018 bitclr-msr \ Set refresh to 0, disabling GX refresh Modified: cpu/x86/pc/olpc/suspend.fth =================================================================== --- cpu/x86/pc/olpc/suspend.fth 2007-09-11 16:48:47 UTC (rev 601) +++ cpu/x86/pc/olpc/suspend.fth 2007-09-11 17:13:15 UTC (rev 602) @@ -15,11 +15,27 @@ code ax-call ( ax-value dst -- ) bx pop ax pop bx call c; +: lid-wakeup + h# 400 h# c8 gpio! \ Clear positive edge status bit + h# 400 h# cc gpio! \ Clear negative edge status bit + h# 185c pl@ h# 4000.0000 or h# 185c pl! +; + +: sci-wakeup + h# 800 h# c8 gpio! \ Clear positive edge status bit + h# 800 h# cc gpio! \ Clear negative edge status bit + h# 185c pl@ h# 8000.0000 or h# 185c pl! +; + : s3 \ Enable wakeup from power button, also clearing \ any status bits in the low half of the register. h# 1840 pl@ h# 100.0000 or h# 1840 pl! + h# ffff.ffff h# 1858 pl! \ Clear PME status bits + h# ffff h# c8 gpio! \ Clear positive edge status bits + h# ffff h# cc gpio! \ Clear negative edge status bits + \ sum-forth [ also dev /mmu ] pdir-va h# f0000 ax-call [ previous definitions ] \ sum-forth

1 0

r601 - /
by svn＠openbios.org 11 Sep '07

11 Sep '07

Author: wmb Date: 2007-09-11 18:48:47 +0200 (Tue, 11 Sep 2007) New Revision: 601 Removed: branches/ Log: The branch is no longer needed, and the source for the builds that it created are archived elsewhere

1 0

r600 - cpu/x86/pc/olpc
by svn＠openbios.org 11 Sep '07

11 Sep '07

Author: wmb Date: 2007-09-11 00:24:49 +0200 (Tue, 11 Sep 2007) New Revision: 600 Modified: cpu/x86/pc/olpc/devices.fth Log: OLPC - Fixed an error in the assigned-addresses property of the display node. Nobody was using that property so the error had no practical impact. Modified: cpu/x86/pc/olpc/devices.fth =================================================================== --- cpu/x86/pc/olpc/devices.fth 2007-09-03 03:56:58 UTC (rev 599) +++ cpu/x86/pc/olpc/devices.fth 2007-09-10 22:24:49 UTC (rev 600) @@ -295,9 +295,9 @@ 0 0 encode-bytes h# 8200.0910 +i 0+i h# fd00.0000 +i 0+i h# 0080.0000 +i \ Frame buffer h# 8200.0914 +i 0+i h# fe00.0000 +i 0+i h# 0000.4000 +i \ GP - h# 8200.0918 +i 0+i h# fe40.0000 +i 0+i h# 0000.4000 +i \ DC - h# 8200.091c +i 0+i h# fe80.0000 +i 0+i h# 0000.4000 +i \ VP - h# 8200.0920 +i 0+i h# fec0.0000 +i 0+i h# 0000.4000 +i \ VIP (LX only) + h# 8200.0918 +i 0+i h# fe00.4000 +i 0+i h# 0000.4000 +i \ DC + h# 8200.091c +i 0+i h# fe00.8000 +i 0+i h# 0000.4000 +i \ VP + h# 8200.0920 +i 0+i h# fe00.c000 +i 0+i h# 0000.4000 +i \ VIP (LX only) " assigned-addresses" property end-package

1 0

r599 - cpu/x86/pc/olpc
by svn＠openbios.org 03 Sep '07

03 Sep '07

Author: wmb Date: 2007-09-03 05:56:58 +0200 (Mon, 03 Sep 2007) New Revision: 599 Modified: cpu/x86/pc/olpc/setwp.fth Log: Reset the system after clear-wp Modified: cpu/x86/pc/olpc/setwp.fth =================================================================== --- cpu/x86/pc/olpc/setwp.fth 2007-08-31 21:11:38 UTC (rev 598) +++ cpu/x86/pc/olpc/setwp.fth 2007-09-03 03:56:58 UTC (rev 599) @@ -27,6 +27,7 @@ : put-mfg-data ( -- ) spi-start spi-identify mfg-data-buf mfg-data-end-offset mfg-data-offset write-flash-range + spi-reprogrammed ; \ Find RAM address of tag, given FLASH address

1 0

r598 - ofw/inetv6
by svn＠openbios.org 31 Aug '07

31 Aug '07

Author: lwalter Date: 2007-08-31 23:11:38 +0200 (Fri, 31 Aug 2007) New Revision: 598 Modified: ofw/inetv6/ethernet.fth ofw/inetv6/icmpecho.fth ofw/inetv6/ipfrv6.fth ofw/inetv6/ipv6.fth ofw/inetv6/neighdis.fth Log: Add IPv6 fragmentation/reassembly Modified: ofw/inetv6/ethernet.fth =================================================================== --- ofw/inetv6/ethernet.fth 2007-08-31 08:05:44 UTC (rev 597) +++ ofw/inetv6/ethernet.fth 2007-08-31 21:11:38 UTC (rev 598) @@ -9,6 +9,7 @@ 0 instance value (link-mtu) \ max packet size 0 instance value packet-buffer +0 instance value /packet-buffer \ Determine the Ethernet address for his-ip-addr instance defer resolve-en-addr ( 'dest-adr type -- 'en-adr type ) @@ -29,8 +30,8 @@ then ; -: open-link ( -- ) link-mtu alloc-mem to packet-buffer ; -: close-link ( -- ) packet-buffer link-mtu free-mem ; +: open-link ( -- ) link-mtu dup to /packet-buffer alloc-mem to packet-buffer ; +: close-link ( -- ) packet-buffer /packet-buffer free-mem ; 6 constant /e Modified: ofw/inetv6/icmpecho.fth =================================================================== --- ofw/inetv6/icmpecho.fth 2007-08-31 08:05:44 UTC (rev 597) +++ ofw/inetv6/icmpecho.fth 2007-08-31 21:11:38 UTC (rev 598) @@ -35,8 +35,7 @@ 2dup exchange-ipsv6 ( en-adr,len icmp-adr,len ip-adr,len ) 2over change-typev6 ( en-adr,len icmp-adr,len ip-adr,len ) recompute-icmpv6-checksum ( en-adr,len ) - tuck " write" $call-parent ( len actual ) - <> if ." Network transmit error" cr then + send-raw-packet ( ) ; : handle-echo-reply ( adr len -- ) 2drop ; Modified: ofw/inetv6/ipfrv6.fth =================================================================== --- ofw/inetv6/ipfrv6.fth 2007-08-31 08:05:44 UTC (rev 597) +++ ofw/inetv6/ipfrv6.fth 2007-08-31 21:11:38 UTC (rev 598) @@ -7,18 +7,10 @@ 1 sfield ipv6-fh-next-hdr 1 sfield ipv6-fh-len 2 sfield ipv6-fh-frag-offset \ OOOO.OOOO.OOOO.OxxM - \ Os contain the fragment offset; M=1=more fragments + \ Os contain the fragment offset in 8-byte unit + \ M=1=more fragments 4 sfield ipv6-fh-frag-id - \ Maybe followed by zero or more of headers in following order: - \ - Hop-by-Hop Options header - \ - Destination Options header (for first destination, plus destinations in the - \ Routing header) - \ - Routing header - \ - Fragment header - \ - Authentication header - \ - Encapsulating Security Payload header - \ - Destionation Options header (for final destination) - \ - Upper-Layer header + 0 sfield ipv6-fh-data constant /ipv6-frag-hdr instance variable frag-id @@ -34,14 +26,11 @@ : send-ip-packet ( adr len protocol -- ) 3drop ; [then] -: max-ipv6-payload ( -- n ) - max-link-payload /ipv6-header - - h# ffff.fff8 and -; : max-ipv6-fragment ( -- n ) max-link-payload /ipv6-header - /ipv6-frag-hdr - h# ffff.fff8 and ; +: max-ipv6-payload ( -- n ) max-ipv6-fragment /ipv6-frag-hdr + ; headerless : (send-ipv6-packet) ( adr len protocol -- ) @@ -64,15 +53,15 @@ 0 value fadr \ fragment address : send-ipv6-fragment ( offset -- ) - >r fadr ( fadr ) ( R: offset ) - olen r@ - max-ipv6-fragment min ( fadr flen ) ( R: offset ) - 2dup oaddr r@ + -rot move ( fadr flen ) ( R: offset ) - fadr set-struct ( fadr flen ) ( R: offset ) + >r fadr dup set-struct ( fadr ) ( R: offset ) + olen max-ipv6-fragment min ( fadr flen ) ( R: offset ) + oaddr r@ + ipv6-fh-data 2 pick move ( fadr flen ) ( R: offset ) oprotocol ipv6-fh-next-hdr xc! \ Next header in fragment header 0 ipv6-fh-len xc! \ Length of header in units of 8 bytes - 1 - frag-id ipv6-fh-frag-id xl! \ Fragment id - dup r@ + olen < 1 and ( fadr flen more? ) ( R: offset ) - r> 3 << or ipv6-fh-frag-offset xw! ( fadr flen ) + frag-id @ ipv6-fh-frag-id xl! \ Fragment id + dup olen u< 1 and ( fadr flen more? ) ( R: offset ) + r> or ipv6-fh-frag-offset xw! ( fadr flen ) + olen over - to olen ( fadr flen ) /ipv6-frag-hdr + ( fadr flen' ) IP_HDR_FRAGMENT (send-ipv6-packet) ( ) ; @@ -83,9 +72,9 @@ else 1 frag-id +! over max-ipv6-fragment /mod swap 0> if 1+ then ( adr len protocol #frags ) - >r to oprotocol to olen to oaddr r> ( #frags ) + >r to oprotocol to olen to oaddr r> ( #frags ) max-ipv6-payload allocate-ipv6 to fadr ( #frags ) - ( #frags ) 0 do ( ) + ( #frags ) 0 ?do ( ) i max-ipv6-fragment * send-ipv6-fragment loop fadr max-ipv6-payload free-ipv6 @@ -97,12 +86,328 @@ ; \ ********************************************************************************* +\ Send fully prepared ethernet packet +\ ( For ECHO reply use where ethernet and IP headers are complete. ) +\ ********************************************************************************* + +\ For going between the two headers; used as a pair +: ipv6-struct ( -- ) /ipv6-header negate +struct ; +: frag-struct ( -- ) /ipv6-header +struct ; + +: alloc-fadr ( adr -- ) + dup link-mtu alloc-mem dup to fadr ( adr adr fadr ) + /ether-header /ipv6-header + move ( adr ) + /ether-header + set-struct ( ) + ipv6-length xw@ to olen + ipv6-next-hdr c@ to oprotocol + + \ Initialize static part of IPv6 header + fadr /ether-header + set-struct + IP_HDR_FRAGMENT ipv6-next-hdr xc! + + \ Initialize static part of fragment header + frag-struct + oprotocol ipv6-fh-next-hdr xc! + 0 ipv6-fh-len xc! + frag-id @ ipv6-fh-frag-id xl! + ipv6-struct +; + +: (send-raw-packet) ( adr len -- ) + tuck " write" $call-parent + <> if ." Network transmit error" cr then +; +: send-raw-fragment ( offset -- ) + >r ( ) ( R: offset ) + olen max-ipv6-fragment min ( flen ) ( R: offset ) + dup /ipv6-frag-hdr + ipv6-length xw! ( flen ) ( R: offset ) + frag-struct ( flen ) ( R: offset ) + dup olen u< 1 and ( flen more? ) ( R: offset ) + r@ or ipv6-fh-frag-offset xw! ( flen ) ( R: offset ) + oaddr r> + ipv6-fh-data 2 pick move ( flen ) + ipv6-struct ( flen ) + olen over - to olen ( flen ) + /ipv6-frag-hdr + /ipv6-header + /ether-header + ( len ) + fadr swap (send-raw-packet) ( ) +; +: send-raw-packet ( adr len -- ) + dup link-mtu <= if + (send-raw-packet) + else + 1 frag-id +! ( adr len ) + over alloc-fadr ( adr len ) + /ether-header /ipv6-header + /string ( content-adr,len ) + swap to oaddr ( content-len ) + max-ipv6-fragment /mod swap 0> if 1+ then ( #frags ) + ( #frags ) 0 ?do + i max-ipv6-fragment * send-raw-fragment + loop + fadr link-mtu free-mem + then +; + +\ ********************************************************************************* \ Receive IP packet \ ********************************************************************************* +list: ipv6list +listnode + /ether-header field >ipv6-ether \ Beginning of ethernet header + 0 field >ipv6-header \ Beginning of IPv6 header + 4 field >ipv6-version + 2 field >ipv6-len \ Total length of reassembled data + 1 field >ipv6-protocol + 1 field >ipv6-hop-limit + /ipv6 field >ipv6-source-addr + /ipv6 field >ipv6-dest-addr \ End of IPv6 header + /n field >ipv6-dghead \ Head of list of IPv6 datagrams + /n field >ipv6-dgtail \ Tail of list of IPv6 datagrams + /n field >ipv6-timer \ Timeout value in ms + /n field >ipv6-rangelist \ Pointer to range info + /n field >ipv6-id \ Fragment id +nodetype: ipv6node \ List of IPv6 reassembly in process + +0 ipv6list ! +0 ipv6node ! + +struct + /n field >dgv6-adr \ Pointer to content of fragmented data + /n field >dgv6-len \ Length of fragmented data + /n field >dgv6-offset \ Offset of fragmented data + /n field >dgv6-next +constant /dgv6list + +[ifndef] include-ipv4 +struct + /n field >rl-begin + /n field >rl-end + /n field >rl-next + /n field >rl-prev +constant /rangelist +[then] + +0 instance value reassembledv6-adr +0 instance value reassembledv6-len \ ihl + data len +d# 60 d# 1000 * constant tlbv6 \ 60 seconds for initial timer setting + +: ipv6-id=? ( node -- id=? ) + >r ( ) ( R: node ) + frag-struct ( ) ( R: node ) + ipv6-fh-next-hdr c@ ipv6-fh-frag-id xl@ ( next-hdr frag-id ) ( R: node ) + ipv6-struct ( next-hdr frag-id ) ( R: node ) + r@ >ipv6-id @ <> if r> 2drop false exit then ( next-hdr ) ( R: node ) + r@ >ipv6-protocol c@ <> if r> drop false exit then ( ) ( R: node ) + r@ >ipv6-source-addr ipv6-source-addr ipv6= not if r> drop false exit then + r> >ipv6-dest-addr ipv6-dest-addr ipv6= +; + +: find-ipv6? ( -- prev-node this-node | 0 ) + ipv6list ['] ipv6-id=? find-node +; + +: alloc-ipv6 ( last-node -- node ) + ipv6node allocate-node tuck swap insert-after + >r + the-struct /ether-header - r@ >ipv6-ether /ipv6-header /ether-header + move + 0 r@ >ipv6-dghead ! + 0 r@ >ipv6-dgtail ! + get-msecs tlbv6 + r@ >ipv6-timer ! + 0 r@ >ipv6-len xw! + 0 r@ >ipv6-rangelist ! + frag-struct + ipv6-fh-frag-id xl@ r@ >ipv6-id ! + ipv6-fh-next-hdr c@ r@ >ipv6-protocol xc! + ipv6-struct + r> +; + +: save-ipv6 ( node -- ) + >r + ipv6-length xw@ /ipv6-frag-hdr - dup alloc-mem ( len this-dg ) ( R: node ) + + frag-struct + 2dup swap the-struct /ipv6-frag-hdr + -rot move ( len this-dg ) ( R: node ) + ipv6-fh-frag-offset xw@ ( len this-dg offset ) ( R: node ) + ipv6-struct ( len this-dg offset ) ( R: node ) + dup h# fff8 and swap 1 and 0= if \ Last fragment + ipv6-length xw@ /ipv6-frag-hdr - over + ( len this-dg offset ) ( R: node ) + r@ >ipv6-len xw! + then + + /dgv6list alloc-mem ( len this-dg offset this-dglist ) ( R: node ) + tuck >dgv6-offset ! ( len this-dg this-dglist ) ( R: node ) + tuck >dgv6-adr ! ( len this-dglist ) ( R: node ) + tuck >dgv6-len ! ( this-dglist ) ( R: node ) + 0 over >dgv6-next ! ( this-dglist ) ( R: node ) + + r@ >ipv6-dghead @ 0= if dup r@ >ipv6-dghead ! then ( this-dglist ) ( R: node ) + r@ >ipv6-dgtail @ ?dup 0<> if >dgv6-next over swap ! then ( this-dglist ) ( R: node ) + r> >ipv6-dgtail ! ( ) +; + +: free-dgv6 ( dg -- ) + begin ?dup while ( 'dg ) + dup >dgv6-adr @ over >dgv6-len @ free-mem ( 'dg ) + dup >dgv6-next @ ( 'dg 'dg-next ) + swap /dgv6list free-mem ( 'dg-nest ) + repeat ( ) +; + +[ifndef] include-ipv4 +: free-rangelist ( rl -- ) + begin ?dup while ( rl ) + dup >rl-next @ swap /rangelist free-mem ( rl-next ) + repeat ( ) +; +[then] + +: free-ipv6node ( prev -- ) + delete-after + dup ipv6node free-node + dup >ipv6-dghead @ free-dgv6 + >ipv6-rangelist @ free-rangelist +; + +: free-ipv6list ( -- ) + find-ipv6? if free-ipv6node else drop then +; + +: ipv6-timeout? ( node -- flag ) >ipv6-timer @ get-msecs <= ; + +: process-timeoutv6? ( -- flag ) + ipv6list ['] ipv6-timeout? find-node if free-ipv6node true else drop false then +; + +[ifndef] include-ipv4 +0 value rlb +0 value rle +0 value last-rl + +: create-rangelist ( -- rl ) + /rangelist alloc-mem ( rl ) + rle over >rl-end ! ( rl ) + rlb over >rl-begin ! ( rl ) +; +[then] + +: insert-before-rangelistv6 ( node rl -- ) + create-rangelist >r ( node rl ) + dup r@ >rl-next ! ( node rl ) + dup >rl-prev @ dup r@ >rl-prev ! ( node rl rl-prev ) + ?dup 0<> if >rl-next r@ swap ! then ( node rl ) + r@ over >rl-prev ! ( node rl ) + r> -rot ( new node rl ) + over >ipv6-rangelist @ = if >ipv6-rangelist ! else 2drop then +; + +: insert-endof-rangelistv6 ( node rl -- ) + create-rangelist ( node rl new ) + 0 over >rl-next ! ( node rl new ) + 2dup >rl-prev ! ( node rl new ) + -rot tuck ( new rl node rl ) + 0= if nip >ipv6-rangelist ! else drop >rl-next ! then +; + +\ New range = b:e +\ Current node = x:y +\ if e<x-1, add node to front and exit +\ if b>y+1, goto examine next node +\ if b<x, x=b +\ if e>y, y=e and exit +\ if all the nodes have been examined, add node to end and exit +\ +: (update-rangelistv6) ( ofs len node -- ) + -rot over + 1- to rle to rlb ( node ) + 0 to last-rl ( node ) + dup >ipv6-rangelist @ ( node rl ) + begin ?dup while + >r ( node ) + rle r@ >rl-begin @ 1- < if r> insert-before-rangelistv6 exit then + rlb r@ >rl-end @ 1+ <= if ( node ) + rlb r@ >rl-begin @ < if rlb r@ >rl-begin ! then + rle r@ >rl-end @ > if rle r@ >rl-end ! then + r> 2drop + exit + then + r@ to last-rl ( node ) + r> >rl-next @ ( node rl ) + repeat ( node ) + last-rl insert-endof-rangelistv6 +; + +: update-rangelistv6 ( node -- ) + frag-struct + ipv6-fh-frag-offset xw@ h# fff8 and ( node ofs ) + ipv6-struct + ipv6-length xw@ /ipv6-frag-hdr - ( node ofs len ) + rot (update-rangelistv6) +; + +: rl-complete? ( rl -- complete? ) + 0 swap ( 0 rl ) + begin ( e rl ) + 2dup >rl-begin @ 1- < ( e rl gap? ) + if 2drop false exit then ( e rl ) + dup >rl-end @ rot max swap ( e' rl ) + >rl-next @ ?dup 0= ( e' rl-next ) + until ( e' ) + drop true +; + +: ipv6-done? ( node -- done? ) + dup >ipv6-len xw@ 0= if drop false exit then + >ipv6-rangelist @ rl-complete? +; + +: (reassemble-ipv6) ( adr dg -- ) + begin ?dup while ( adr dg ) + 2dup >dgv6-offset @ + ( adr dg dst ) + over >dgv6-adr @ swap ( adr dg src dst ) + 2 pick >dgv6-len @ move ( adr dg ) + >dgv6-next @ ( adr dg-next ) + repeat drop ( ) +; + +: reassemble-ipv6 ( node -- ip-adr,len ) + >r + r@ >ipv6-len xw@ ( dlen ) ( R: node ) + /ipv6-header + /ether-header + ( rlen ) ( R: node ) + dup to reassembledv6-len ( rlen ) ( R: node ) + alloc-mem dup to reassembledv6-adr ( radr ) ( R: node ) + r@ >ipv6-ether swap /ipv6-header /ether-header + move \ Copy IPv6 header content + reassembledv6-adr /ipv6-header + /ether-header + ( content-adr ) ( R: node ) + r> >ipv6-dghead @ (reassemble-ipv6) ( ) + reassembledv6-adr reassembledv6-len /ether-header /string ( ip-adr,len ) + free-ipv6list ( ip-adr,len ) +; + +: process-datagramv6 ( node -- false | ip-adr,len true) + dup save-ipv6 ( node ) + dup update-rangelistv6 ( node ) + dup ipv6-done? if ( node ) + reassemble-ipv6 ( ip-adr,len ) + true ( ip-adr,len true ) + else ( node ) + drop false ( false ) + then +; + +: process-done-ipv6 ( -- ) + reassembledv6-len 0> if + reassembledv6-adr reassembledv6-len free-mem + 0 to reassembledv6-adr 0 to reassembledv6-len + then +; + +: get-done-ipv6? ( -- false | ip-adr,len true ) + find-ipv6? ?dup if nip else alloc-ipv6 then + process-datagramv6 +; + defer handle-icmpv6 ( contents-adr,len protocol -- ) ' 3drop to handle-icmpv6 [ifndef] include-ipv4 +: process-done-ip ( -- ) ; : process-timeout? ( -- flag ) false ; : process-ipv4-packet ( adr len type -- flag ) 3drop ." Discarding IPv4 packet" cr false @@ -110,29 +415,48 @@ : ip-payload ( len -- adr len' ) .ipv4-not-supported ; [then] +: process-timeout? ( -- flag ) + use-ipv6? if process-timeoutv6? else process-timeout? then +; + : process-ipv6-packet ( adr len type -- false | contents-adr,len true ) - \ XXX Not complete. Need to process additional headers and fragmentation. - \ XXX Assume no additional headers for now. + \ XXX Assume no additional headers other than fragmentation header for now. + nip swap ( type adr ) + dup set-struct to last-ipv6-packet ( type ) - nip swap ( type adr ) - dup set-struct to last-ip-packet ( type ) - ipv6-addr-match? if ( type ) - ipv6-next-hdr c@ dup >r = dup if ( type=? ) ( R: next-hdr ) - ipv6-payload rot ( contents-adr,len true ) ( R: next-hdr ) - then ( false | contents-adr,len true ) ( R: next-hdr ) - r> IP_HDR_ICMPV6 = if ( false | contents-adr,len true ) - ipv6-payload IP_HDR_ICMPV6 handle-icmpv6 \ Handle ICMPv6 packets + \ If IPv6 packet is not for me, exit + ipv6-addr-match? not if ( type ) + drop ipv6-payload handle-other-ipv6 ( ) + false exit \ Got an packet not for me + then ( type ) + + \ If IPv6 packet is a fragment, reassemble packet if possible + ipv6-next-hdr c@ IP_HDR_FRAGMENT = if ( type ) + get-done-ipv6? if ( type false | ip-adr,len true ) + drop dup set-struct to last-ipv6-packet \ Fragment reassembly complete else - dup not if ipv6-payload ipv6-next-hdr c@ handle-ipv6 then + drop false exit \ Fragment reassembly incomplete + then + then + + \ By now, we have a complete IPv6 packet. Is it what we're waiting for? + ipv6-next-hdr c@ >r ( type ) ( R: next-hdr ) + r@ = dup if ( type=next-hdr? ) ( R: next-hdr ) + ipv6-payload rot ( contents-adr,len true ) ( R: next-hdr ) + then ( false | contents-adr,len true ) ( R: next-hdr ) + \ Is it an ICMPv6 packet? + r> IP_HDR_ICMPV6 = if ( false | contents-adr,len true ) + ipv6-payload IP_HDR_ICMPV6 handle-icmpv6 \ Handle ICMPv6 packets + else + dup not if ipv6-payload ipv6-next-hdr c@ handle-ipv6 then \ Handle other unexpected packets - then ( false | contents-adr,len true ) - else - drop ipv6-payload handle-other-ipv6 \ Handle packets for other address - false ( false ) then ( false | contents-adr,len true ) ; : receive-ip-packet ( type -- true | contents-adr,len false ) + process-done-ip + process-done-ipv6 + begin use-ipv6? if IPV6_TYPE else IP_TYPE then receive-ethernet-packet ( type [ip-adr,len] flag ) Modified: ofw/inetv6/ipv6.fth =================================================================== --- ofw/inetv6/ipv6.fth 2007-08-31 08:05:44 UTC (rev 597) +++ ofw/inetv6/ipv6.fth 2007-08-31 21:11:38 UTC (rev 598) @@ -31,7 +31,16 @@ 1 sfield ipv6-hop-limit /ipv6 sfield ipv6-source-addr /ipv6 sfield ipv6-dest-addr - \ There maybe extension headers here. + \ Maybe followed by zero or more of headers in following order: + \ - Hop-by-Hop Options header + \ - Destination Options header (for first destination, plus destinations in the + \ Routing header) + \ - Routing header + \ - Fragment header + \ - Authentication header + \ - Encapsulating Security Payload header + \ - Destionation Options header (for final destination) + \ - Upper-Layer header constant /ipv6-header \ Values of ipv6-next-hdr @@ -186,9 +195,7 @@ ; : .name-server-ipv6 ( -- ) ." DNS IPv6: " name-server-ipv6 .ipv6 ; -[ifndef] include-ipv4 -0 instance value last-ip-packet -[then] +0 instance value last-ipv6-packet headers : (set-dest-ipv6) ( buf -- ) @@ -208,7 +215,7 @@ ; : lock-ipv6-address ( -- ) - the-struct >r last-ip-packet set-struct + the-struct >r last-ipv6-packet set-struct \ Don't change his-ipv6-addr for booting over gateway use-routerv6? if \ booting over a gateway. bootnet-debug if indent ." Using router" cr then @@ -253,7 +260,12 @@ : ipv6-payload ( -- adr len ) the-struct /ipv6-header + ipv6-length xw@ ; \ Skip checking his-ipv6-addr if it is an ICMPv6 packet which may come from anywhere. -: check-his-ipv6-addr? ( -- flag ) ipv6-next-hdr c@ IP_HDR_ICMPV6 <> ; +\ XXX Assume <IPv6 header> [ <fragment header> ] <data> +: check-his-ipv6-addr? ( -- flag ) + ipv6-next-hdr c@ IP_HDR_ICMPV6 = if false exit then + ipv6-next-hdr c@ IP_HDR_FRAGMENT <> if true exit then + the-struct /ipv6-header + c@ IP_HDR_ICMPV6 <> +; : ipv6-addr-match? ( -- flag ) check-his-ipv6-addr? if his-ipv6-addr his-ipv6-addr-mc? 0= if Modified: ofw/inetv6/neighdis.fth =================================================================== --- ofw/inetv6/neighdis.fth 2007-08-31 08:05:44 UTC (rev 597) +++ ofw/inetv6/neighdis.fth 2007-08-31 21:11:38 UTC (rev 598) @@ -3,9 +3,9 @@ headerless -d# 200 constant ND_TIMEOUT \ Neighbor discovery timeout (ms) -d# 200 constant DAD_TIMEOUT \ Duplicate Address Detection timeout (ms) -d# 500 constant RD_TIMEOUT \ Router Discovery timeout (ms) +d# 200 constant ND_TIMEOUT \ Neighbor discovery timeout (ms) +d# 200 constant DAD_TIMEOUT \ Duplicate Address Detection timeout (ms) +d# 2000 constant RD_TIMEOUT \ Router Discovery timeout (ms) " stateless" d# 40 config-string ipv6-address \ leave room \ " dhcp" ' ipv6-address set-config-string-default @@ -141,7 +141,7 @@ over 8 + be-l@ to prefix-lifetime \ XXX lifetime over d# 16 + my-prefix copy-ipv6-addr \ Prefix endof - 5 of over 4 + be-l@ to (link-mtu) endof \ MTU option + 5 of over 4 + be-l@ link-mtu min to (link-mtu) endof \ MTU option d# 25 of over 8 + name-server-ipv6 copy-ipv6-addr endof \ RDNSS option endcase over 1+ c@ 8 * /string @@ -190,7 +190,6 @@ ['] 4drop to icmpv6-err-callback-xt ['] 2drop to icmpv6-info-callback-xt - unknown-ipv6-addr name-server-ipv6 copy-ipv6-addr discover-me discover-router @@ -212,6 +211,7 @@ ; : close ( -- ) + process-done-ipv6 [ifdef] include-ipv4 close [else] @@ -241,6 +241,7 @@ true to use-ipv6? set-mc-hash if close false exit then ['] (resolve-en-addrv6) to resolve-en-addr + unknown-ipv6-addr name-server-ipv6 copy-ipv6-addr configure-ipv6 s-all-ipv6 setup-ip-attr

1 0

r597 - cpu/x86/pc/olpc
by svn＠openbios.org 31 Aug '07

31 Aug '07

Author: wmb Date: 2007-08-31 10:05:44 +0200 (Fri, 31 Aug 2007) New Revision: 597 Modified: cpu/x86/pc/olpc/security.fth Log: OLPC security - Added error messages about bad serial numbers and UUIDs. Modified: cpu/x86/pc/olpc/security.fth =================================================================== --- cpu/x86/pc/olpc/security.fth 2007-08-31 07:59:15 UTC (rev 596) +++ cpu/x86/pc/olpc/security.fth 2007-08-31 08:05:44 UTC (rev 597) @@ -188,14 +188,26 @@ : get-my-sn ( -- error? ) - " SN" find-tag 0= if true exit then ( adr len ) - ?-null dup d# 11 <> if 2drop true exit then ( adr len ) + " SN" find-tag 0= if + " No serial number in mfg data" ?lease-debug-cr + true exit + then ( adr len ) + ?-null dup d# 11 <> if + " Invalid serial number" ?lease-debug-cr + 2drop true exit + then ( adr len ) machine-id-buf swap move [char] : machine-id-buf d# 11 + c! - " U#" find-tag 0= if true exit then ( adr len ) - ?-null dup d# 36 <> if 2drop true exit then ( adr len ) + " U#" find-tag 0= if + " No UUID in mfg data" ?lease-debug-cr + true exit + then ( adr len ) + ?-null dup d# 36 <> if + " Invalid UUID" ?lease-debug-cr + 2drop true exit + then ( adr len ) machine-id-buf d# 12 + swap move [char] : machine-id-buf d# 48 + c!

1 0

r596 - cpu/x86/pc/olpc
by svn＠openbios.org 31 Aug '07

31 Aug '07

Author: wmb Date: 2007-08-31 09:59:15 +0200 (Fri, 31 Aug 2007) New Revision: 596 Modified: cpu/x86/pc/olpc/security.fth Log: Name change for secure-boot. Modified: cpu/x86/pc/olpc/security.fth =================================================================== --- cpu/x86/pc/olpc/security.fth 2007-08-31 07:52:04 UTC (rev 595) +++ cpu/x86/pc/olpc/security.fth 2007-08-31 07:59:15 UTC (rev 596) @@ -376,7 +376,7 @@ 2drop false ; -: do-secure-boot ( -- ) +: secure-boot ( -- ) debug-security? if screen-ih stdout ! then ['] secure-load-ramdisk to load-ramdisk secure-load 0= if fail-load then @@ -386,8 +386,8 @@ : wp? ( -- flag ) " wp" find-tag dup if nip nip then ; -: secure-boot ( -- ) wp? if do-secure-boot else boot then ; -" secure-boot" ' boot-command set-config-string-default +: ?secure-boot ( -- ) wp? if secure-boot else boot then ; +" ?secure-boot" ' boot-command set-config-string-default \ For dn in boot-device-list \ if

1 0

r595 - cpu/x86/pc/olpc
by svn＠openbios.org 31 Aug '07

31 Aug '07

Author: wmb Date: 2007-08-31 09:52:04 +0200 (Fri, 31 Aug 2007) New Revision: 595 Modified: cpu/x86/pc/olpc/setwp.fth Log: Added clear-wp capability. Modified: cpu/x86/pc/olpc/setwp.fth =================================================================== --- cpu/x86/pc/olpc/setwp.fth 2007-08-31 07:45:02 UTC (rev 594) +++ cpu/x86/pc/olpc/setwp.fth 2007-08-31 07:52:04 UTC (rev 595) @@ -3,6 +3,10 @@ \ should not be necessary once mass production systems start coming from \ the factor with the "wp" tag set. +\ You can turn "ww" into "wp" just by clearing bits, which doesn't +\ require a full erase. That is faster and safer than copying out the +\ data, erasing the block and rewriting it. + : set-wp ( -- ) h# fffefffe 2 " wp" $= if ." wp is already set" cr exit then h# fffefffe 2 " ww" $= 0= abort" No ww tag" @@ -11,3 +15,49 @@ h# fffefffe 2 " wp" $= if ." Succeeded" cr then spi-reprogrammed ; + +\ Set and clear the write-protect tag by copying, erasing, rewriting + +\ Read mfg data from FLASH to RAM +: get-mfg-data ( -- ) + rom-pa mfg-data-offset + mfg-data-buf /flash-block lmove +; + +\ Write mfg data from RAM to FLASH +: put-mfg-data ( -- ) + spi-start spi-identify + mfg-data-buf mfg-data-end-offset mfg-data-offset write-flash-range +; + +\ Find RAM address of tag, given FLASH address +: tag>ram-adr ( adr len -- ram-adr ) + drop 2+ ( adr' ) \ Address of "ww" tag + rom-pa mfg-data-offset + - ( offset ) + + dup /flash-block u>= abort" Bad ww offset" \ Sanity check + + mfg-data-buf + ( ram-adr ) +; + +\ Get ready to modify the tag whose name is tag$ +: mfg-data-setup ( tag$ -- ram-adr ) + get-mfg-data + 2dup find-tag 0= if ." No " type ." tag" cr abort then ( tag$ adr len ) + tag>ram-adr >r ( tag$ r: ram-adr ) + r@ 2 $= 0= abort" Tag mismatch in RAM" ( r: ram-adr ) + r> +; + +\ Change the "ww" tag to "wp" +: hard-set-wp ( -- ) + " ww" mfg-data-setup ( ram-adr ) + [char] p swap 1+ c! ( ) + put-mfg-data +; + +\ Change the "wp" tag to "ww" +: clear-wp ( -- ) + " wp" mfg-data-setup ( ram-adr ) + [char] w swap 1+ c! ( ) + put-mfg-data +;

1 0

r594 - cpu/x86/pc/olpc
by svn＠openbios.org 31 Aug '07

31 Aug '07

Author: wmb Date: 2007-08-31 09:45:02 +0200 (Fri, 31 Aug 2007) New Revision: 594 Added: cpu/x86/pc/olpc/crypto.bth Log: Initial checkin of crypto.bth Added: cpu/x86/pc/olpc/crypto.bth =================================================================== --- cpu/x86/pc/olpc/crypto.bth (rev 0) +++ cpu/x86/pc/olpc/crypto.bth 2007-08-31 07:45:02 UTC (rev 594) @@ -0,0 +1,15 @@ +purpose: Fetch the Crypto code and keys + +command: &builder &this +build-now + +fload ${BP}/cpu/x86/pc/olpc/versions.fth + +" wget http://dev.laptop.org/pub/firmware/crypto/bios_crypto-${CRYPTO_VERSION}.img -O crypto.img" expand$ $sh +" wget http://dev.laptop.org/pub/firmware/crypto/testkeys/os.public -O os.public" expand$ $sh +" wget http://dev.laptop.org/pub/firmware/crypto/testkeys/fw.public -O fw.public" expand$ $sh + +\ This forces the creation of an crypto.log file, so we don't re-fetch +writing crypto.version +" ${CRYPTO_VERSION}"n" expand$ ofd @ fputs +ofd @ fclose

1 0

r593 - cpu/x86/pc/olpc
by svn＠openbios.org 31 Aug '07

31 Aug '07

Author: wmb Date: 2007-08-31 09:42:08 +0200 (Fri, 31 Aug 2007) New Revision: 593 Modified: cpu/x86/pc/olpc/versions.fth Log: Q2C26 Modified: cpu/x86/pc/olpc/versions.fth =================================================================== --- cpu/x86/pc/olpc/versions.fth 2007-08-31 01:16:13 UTC (rev 592) +++ cpu/x86/pc/olpc/versions.fth 2007-08-31 07:42:08 UTC (rev 593) @@ -2,7 +2,7 @@ \ The overall firmware revision macro: FW_MAJOR C -macro: FW_MINOR 25 +macro: FW_MINOR 26 \ The EC microcode macro: EC_VERSION c24 @@ -14,3 +14,6 @@ \ The wireless LAN module firmware macro: WLAN_RPM ${WLAN_VERSION}-1.olpc1 macro: WLAN_VERSION 5.110.16.p1 + +\ The bios_crypto image +macro: CRYPTO_VERSION 0.0

1 0

Dictionary size limit per device instance
by Asif Haswarey 31 Aug '07

31 Aug '07

Does anyone happen to know what the dictionary size upper limit (for openbios) is hardcoded to per device instance? _____________ Äsif Haswaréy QLogic Corporation

5 17

Re: [OpenBIOS] Dictionary size limit per device instance
by Parag Patel 31 Aug '07

31 Aug '07

Segher Boessenkool wrote: > >Some Open Firmware implementations have a special FCode x'f4 which >allows FCode#s up to x'ffff; x'f4 followed by "high" byte, "low" byte. SmartFirmware currently doesn't allow Fcodes greater than 0xFFF, as per the (current) spec. But that's only for tokenizing, so that the resulting image file is 1275-compliant. SF's internal Forth execution-token representation is mostly Fcode to save memory. Forth toks that aren't tokenzied/fcodes are limited to 0x3FFF_FFFF. The vendor-specific marker 0x6 is used to indicate a token value greater than 0xfff. 2 additional bytes for values 0x1000:0x7fff, 3 more bytes for 0x8000:0x3fffff, and 4 bytes for 0x400000:0x3fffffff. The 1st MSB bits of the byte after the 0x06 indicates 4, 3, or 2 additional bytes: 0xC0 == 4; 0x80 == 3; else 2. No reason that some scheme like this couldn't be used for extending Fcodes too. (SF also uses the vendor-specific range codes 0x7* as a sort of prefix for internal use. It's also not used for tokenizing.) Anyway, just throwing this out, for what it's worth. -- __ /__)_ _ _ _ "For three days after death hair and fingernails continue / (// (/(/ to grow but phone calls taper off." -- Johnny Carson _/

1 0

r592 - cpu/x86/pc/olpc
by svn＠openbios.org 31 Aug '07

31 Aug '07

Author: wmb Date: 2007-08-31 03:16:13 +0200 (Fri, 31 Aug 2007) New Revision: 592 Modified: cpu/x86/pc/olpc/fw.bth cpu/x86/pc/olpc/setwp.fth Log: Added set-wp to the build. Modified: cpu/x86/pc/olpc/fw.bth =================================================================== --- cpu/x86/pc/olpc/fw.bth 2007-08-31 01:15:01 UTC (rev 591) +++ cpu/x86/pc/olpc/fw.bth 2007-08-31 01:16:13 UTC (rev 592) @@ -337,6 +337,7 @@ fload ${BP}/cpu/x86/pc/olpc/crypto.fth \ Cryptographic image validation fload ${BP}/cpu/x86/pc/olpc/lzip.fth \ Access zip images from memory fload ${BP}/cpu/x86/pc/olpc/security.fth +fload ${BP}/cpu/x86/pc/olpc/setwp.fth fload ${BP}/ofw/gui/ofpong.fth [then] Modified: cpu/x86/pc/olpc/setwp.fth =================================================================== --- cpu/x86/pc/olpc/setwp.fth 2007-08-31 01:15:01 UTC (rev 591) +++ cpu/x86/pc/olpc/setwp.fth 2007-08-31 01:16:13 UTC (rev 592) @@ -11,4 +11,3 @@ h# fffefffe 2 " wp" $= if ." Succeeded" cr then spi-reprogrammed ; -set-wp

1 0

r591 - cpu/x86/pc/olpc
by svn＠openbios.org 31 Aug '07

31 Aug '07

Author: wmb Date: 2007-08-31 03:15:01 +0200 (Fri, 31 Aug 2007) New Revision: 591 Added: cpu/x86/pc/olpc/setwp.fth Log: Added "setwp.fth" file. Added: cpu/x86/pc/olpc/setwp.fth =================================================================== --- cpu/x86/pc/olpc/setwp.fth (rev 0) +++ cpu/x86/pc/olpc/setwp.fth 2007-08-31 01:15:01 UTC (rev 591) @@ -0,0 +1,14 @@ +\ Set the write protect tag. This is used to convert unlocked prototype +\ machined to locked machines for testing the firmware security. This +\ should not be necessary once mass production systems start coming from +\ the factor with the "wp" tag set. + +: set-wp ( -- ) + h# fffefffe 2 " wp" $= if ." wp is already set" cr exit then + h# fffefffe 2 " ww" $= 0= abort" No ww tag" + spi-start spi-identify + " wp" h# efffe write-spi-flash + h# fffefffe 2 " wp" $= if ." Succeeded" cr then + spi-reprogrammed +; +set-wp

1 0

r590 - forth/lib
by svn＠openbios.org 31 Aug '07

31 Aug '07

Author: wmb Date: 2007-08-31 03:04:52 +0200 (Fri, 31 Aug 2007) New Revision: 590 Added: forth/lib/wrtime.fth Log: Added forth/lib/wrtime.fth - interval delays using wrapper calls. Added: forth/lib/wrtime.fth =================================================================== --- forth/lib/wrtime.fth (rev 0) +++ forth/lib/wrtime.fth 2007-08-31 01:04:52 UTC (rev 590) @@ -0,0 +1,15 @@ +purpose: Timing using wrapper calls + +: get-usecs ( -- d.usec ) + d# 348 syscall retval 2@ ( usec sec ) + d# 1,000,000 um* rot 0 d+ +; + +\ We really should call usleep, but that wrapper doesn't have that +: (us) ( d.microseconds -- ) + get-usecs d+ ( d.target-time ) + begin 2dup get-usecs d- d0< until ( d.target-time ) + 2drop +; +: us ( microseconds -- ) 0 (us) ; +: ms ( milliseconds -- ) d# 1000 um* (us) ;

1 0

r589 - dev/olpc/spiflash
by svn＠openbios.org 31 Aug '07

31 Aug '07

Author: wmb Date: 2007-08-31 03:04:08 +0200 (Fri, 31 Aug 2007) New Revision: 589 Modified: dev/olpc/spiflash/spiflash.fth Log: OLPC spiflash.fth - fixed a stack comment - no substantive change. Modified: dev/olpc/spiflash/spiflash.fth =================================================================== --- dev/olpc/spiflash/spiflash.fth 2007-08-31 01:03:19 UTC (rev 588) +++ dev/olpc/spiflash/spiflash.fth 2007-08-31 01:04:08 UTC (rev 589) @@ -31,7 +31,7 @@ \ For some commands, a 3-byte address follows the command code -: spi-adr ( adr cmd -- ) +: spi-adr ( adr -- ) lbsplit drop spi-out spi-out spi-out ;

1 0

r588 - cpu/x86 cpu/x86/pc/olpc ofw/fs
by svn＠openbios.org 31 Aug '07

31 Aug '07

Author: wmb Date: 2007-08-31 03:03:19 +0200 (Fri, 31 Aug 2007) New Revision: 588 Added: cpu/x86/pc/olpc/lzip.fth cpu/x86/pc/olpc/security.fth Modified: cpu/x86/call.fth cpu/x86/pc/olpc/crypto.fth cpu/x86/pc/olpc/fw.bth cpu/x86/pc/olpc/linux.fth cpu/x86/pc/olpc/loaddropins.fth cpu/x86/pc/olpc/olpc.bth ofw/fs/zipfs.fth Log: OLPC - First cut at secure booting. Modified: cpu/x86/call.fth =================================================================== --- cpu/x86/call.fth 2007-08-31 01:02:04 UTC (rev 587) +++ cpu/x86/call.fth 2007-08-31 01:03:19 UTC (rev 588) @@ -1,7 +1,7 @@ \ See license at end of file purpose: From Forth, call the C subroutine whose address is on the stack -code sp-call ( [ arg5 .. arg0 ] adr sp -- [ arg5 .. arg0 ] result ) +code sp-call ( [ arg7 .. arg0 ] adr sp -- [ arg5 .. arg0 ] result ) bx pop \ Get the new stack pointer ax pop \ Get the subroutine address @@ -9,7 +9,9 @@ rp 'user saved-rp mov \ Save for callbacks sp bx xchg \ Switch to new SP, with EBX set to old SP - 5 /n* [ebx] push \ Copy the arguments to the new stack + 7 /n* [ebx] push \ Copy the arguments to the new stack + 6 /n* [ebx] push + 5 /n* [ebx] push 4 /n* [ebx] push 3 /n* [ebx] push 2 /n* [ebx] push Modified: cpu/x86/pc/olpc/crypto.fth =================================================================== --- cpu/x86/pc/olpc/crypto.fth 2007-08-31 01:02:04 UTC (rev 587) +++ cpu/x86/pc/olpc/crypto.fth 2007-08-31 01:03:19 UTC (rev 588) @@ -2,9 +2,11 @@ \ See license at end of file h# c0000 constant crypto-base \ The address the code is linked to run at -h# c0000 constant hasher-base \ The address the code is linked to run at +h# d0000 constant crypto-bss \ The address the code is linked to run at +h# 10000 constant /crypto-bss 0 [if] +h# c0000 constant hasher-base \ The address the code is linked to run at variable hashlen d# 128 buffer: hashbuf @@ -20,21 +22,36 @@ ; [then] -0 value hashname +0 value crypto-loaded? +: load-crypto ( -- error? ) + crypto-loaded? if false exit then + " crypto" find-drop-in 0= if true exit then ( prog$ ) + 2dup crypto-base swap move free-mem ( ) + true to crypto-loaded? + false +; + +h# 200 buffer: pubkey +0 value /pubkey +: load-key ( name$ -- error? ) + find-drop-in 0= if true exit then ( key$ ) + dup h# 200 > if free-mem true exit then ( key$ ) + dup to /pubkey ( key$ ) + 2dup pubkey swap move ( key$ ) + free-mem + false +; + : signature-bad? ( data$ sig$ hashname$ -- mismatch? ) - $cstr to hashname ( data$ sig$ ) - " crypto" find-drop-in 0= if 4drop true exit then ( data$ sig$ prog$ ) - 2dup crypto-base swap move free-mem ( data$ sig$ ) + $cstr >r ( data$ sig$ r: 'hashname ) - " pubkey" find-drop-in 0= if 4drop true exit then ( data$ sig$ key$ ) - 2>r ( data$ sig$ r: key$ ) - swap 2swap swap ( siglen sigadr datalen dataadr r: key$ ) - 2r@ swap 2swap ( siglen sigadr keylen keyadr datalen dataadr r: key$ ) + swap 2swap swap ( siglen sigadr datalen dataadr ) + /pubkey pubkey 2swap ( siglen sigadr keylen keyadr datalen dataadr ) + r> ( siglen sigadr keylen keyadr datalen dataadr 'hashname ) - hashname ( siglen sigadr keylen keyadr datalen dataadr hash r: key$ ) - crypto-base dup h# 10 - sp-call >r 3drop 4drop r> ( result r: key$ ) - 2r> free-mem + crypto-bss /crypto-bss erase + crypto-base dup h# 10 - sp-call >r 3drop 4drop r> ( result ) \ XXX free-mem in suspend.fth and fw.bth after find-drop-in \ XXX clean out dead code in usb.fth Modified: cpu/x86/pc/olpc/fw.bth =================================================================== --- cpu/x86/pc/olpc/fw.bth 2007-08-31 01:02:04 UTC (rev 587) +++ cpu/x86/pc/olpc/fw.bth 2007-08-31 01:03:19 UTC (rev 588) @@ -335,6 +335,8 @@ fload ${BP}/cpu/x86/pc/olpc/nandstat.fth \ fload ${BP}/cpu/x86/pc/olpc/carousel.fth \ Carouseled NAND writing fload ${BP}/cpu/x86/pc/olpc/crypto.fth \ Cryptographic image validation +fload ${BP}/cpu/x86/pc/olpc/lzip.fth \ Access zip images from memory +fload ${BP}/cpu/x86/pc/olpc/security.fth fload ${BP}/ofw/gui/ofpong.fth [then] @@ -542,7 +544,7 @@ ; : newrom - " flash http:\\10.20.0.104\new.rom" eval + " flash http:\\10.20.0.14\new.rom" eval \ " wifi media lab 802.11" eval \ " flash http:\\18.85.46.172\new.rom" eval ; Modified: cpu/x86/pc/olpc/linux.fth =================================================================== --- cpu/x86/pc/olpc/linux.fth 2007-08-31 01:02:04 UTC (rev 587) +++ cpu/x86/pc/olpc/linux.fth 2007-08-31 01:03:19 UTC (rev 588) @@ -181,8 +181,8 @@ d# 256 buffer: ramdisk-buf ' ramdisk-buf " ramdisk" chosen-string -: load-ramdisk ( -- ) - " ramdisk" eval dup 0= if 2drop exit then ( name$ ) +defer load-ramdisk +: $load-ramdisk ( name$ -- ) 0 to /ramdisk ( name$ ) ['] load-path behavior >r ( name$ r: xt ) @@ -195,6 +195,11 @@ throw loaded to /ramdisk to ramdisk-adr ; +: cv-load-ramdisk ( -- ) + " ramdisk" eval dup 0= if 2drop exit then ( name$ ) + $load-ramdisk +; +' cv-load-ramdisk to load-ramdisk : claim-params ( -- ) [ifdef] virtual-mode Modified: cpu/x86/pc/olpc/loaddropins.fth =================================================================== --- cpu/x86/pc/olpc/loaddropins.fth 2007-08-31 01:02:04 UTC (rev 587) +++ cpu/x86/pc/olpc/loaddropins.fth 2007-08-31 01:03:19 UTC (rev 588) @@ -38,7 +38,6 @@ " ${BP}/ofw/termemu/gallant.obf" " font" $add-deflated-dropin -\ " /space/bios-crypto/bios_crypto.img" " crypto" $add-deflated-dropin -\ " /space/bios-crypto/bios_hash.img" " hasher" $add-deflated-dropin -\ " /space/bios-crypto/wmbtest256.public" " pubkey" $add-dropin \ Incompressible -\ " /space/bios-crypto/usb8388.bin.sig256" " usb8388.sig" $add-dropin \ Incompressible + " crypto.img" " crypto" $add-deflated-dropin + " os.public" " oskey" $add-dropin \ Incompressible + " fw.public" " fwkey" $add-dropin \ Incompressible Added: cpu/x86/pc/olpc/lzip.fth =================================================================== --- cpu/x86/pc/olpc/lzip.fth (rev 0) +++ cpu/x86/pc/olpc/lzip.fth 2007-08-31 01:03:19 UTC (rev 588) @@ -0,0 +1,70 @@ +\ See license at end of file +purpose: Package for treating the data at load-base as a device + +dev / +new-device +" lzip" device-name + +headerless +0 instance value seek-ptr +0 instance value image-size +0 instance value base-adr + +headers +external +: seek ( d.offset -- status ) + 0<> over image-size u> or if drop true exit then \ Seek offset too big + to seek-ptr + false +; + +: open ( -- flag ) + 0 to seek-ptr ( ) + load-base to base-adr ( ) + file-size @ to image-size ( ) + my-args dup if ( adr len ) + " zip-file-system" find-package 0= if ( adr len ph ) + 2drop false exit + then ( adr len ph ) + interpose + else ( adr len ) + 2drop ( ) + then ( ) + true ( true ) +; +: close ( -- ) ; +: size ( -- d.size ) image-size 0 ; +: read ( adr len -- actual ) + seek-ptr + image-size min seek-ptr - ( adr len' ) + tuck ( len adr len ) + base-adr seek-ptr + -rot move ( len ) + dup seek-ptr + to seek-ptr ( len ) +; +\ Having a load method is pointless since the image is already at load-base + +finish-device +device-end + +\ LICENSE_BEGIN +\ Copyright (c) 2007 FirmWorks +\ +\ Permission is hereby granted, free of charge, to any person obtaining +\ a copy of this software and associated documentation files (the +\ "Software"), to deal in the Software without restriction, including +\ without limitation the rights to use, copy, modify, merge, publish, +\ distribute, sublicense, and/or sell copies of the Software, and to +\ permit persons to whom the Software is furnished to do so, subject to +\ the following conditions: +\ +\ The above copyright notice and this permission notice shall be +\ included in all copies or substantial portions of the Software. +\ +\ THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, +\ EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF +\ MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND +\ NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE +\ LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION +\ OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION +\ WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. +\ +\ LICENSE_END Modified: cpu/x86/pc/olpc/olpc.bth =================================================================== --- cpu/x86/pc/olpc/olpc.bth 2007-08-31 01:02:04 UTC (rev 587) +++ cpu/x86/pc/olpc/olpc.bth 2007-08-31 01:03:19 UTC (rev 588) @@ -24,6 +24,7 @@ in: ${BP}/dev/olpc/cafecamera/build/cafecamera.fc in: ${BP}/clients/memtest86/memtest in: ec.img +in: crypto.img in: usb8388.bin in: ${BP}/dev/pci/build/pcibridg.fc Added: cpu/x86/pc/olpc/security.fth =================================================================== --- cpu/x86/pc/olpc/security.fth (rev 0) +++ cpu/x86/pc/olpc/security.fth 2007-08-31 01:03:19 UTC (rev 588) @@ -0,0 +1,443 @@ +purpose: OLPC secure boot +\ See license at end of file + +\ Specs at http://wiki.laptop.org/go/Firmware_Security + +: boot-device-list " disk sd nand" ; + +true value debug-security? +: ?lease-debug ( msg$ -- ) + debug-security? if type else 2drop then +; +: ?lease-debug-cr ( msg$2 -- ) + debug-security? if type cr else 2drop then +; + +: fail-load ( -- ) + screen-ih stdout ! + ." OS Load Failed" cr + quit + begin again +; + +h# 20 buffer: cn-buf \ filename prefix - either "act" or "run" +h# 20 buffer: fn-buf \ filename tail - either "os" or "rd" +h# 100 buffer: pn-buf \ pathname - either "\boot" or "\boot-alt" +h# 100 buffer: dn-buf \ device name + +\ These macro definitions make it easy to compose device specifier strings +\ from the above name components. +also macros definitions +: FN fn-buf count ; +: CN cn-buf count ; +: DN dn-buf count ; +: PN pn-buf count ; +previous definitions + +d# 256 constant /sig +/sig buffer: sig-buf + +: hex-decode ( hex$ -- true | sig$ false ) + dup /sig 2* <> if + ( ." Bad signature length" cr ) + 2drop true exit + then ( hex$ ) + sig-buf -rot ( adr hex$ ) + bounds ?do ( adr ) + i 2 push-hex $number pop-base if ( adr ) + 2drop true unloop exit + then ( adr n ) + over c! 1+ ( adr' ) + 2 +loop ( adr ) + sig-buf tuck - false ( sig$ false ) +; + +: parse-sig ( sig01$ -- true | hashname$ sig$ false ) + dup d# 89 < if 2drop true exit then + bl left-parse-string " sig01:" $= 0= if 2drop true exit then ( rem$ ) + bl left-parse-string dup d# 6 <> if 4drop true exit then 2swap ( hash$ rem$ ) + bl left-parse-string nip d# 64 <> if 4drop true exit then ( hash$ rem$ ) + newline left-parse-string 2swap nip 0<> if 4drop true exit then ( hash$ data$ ) + hex-decode if 2drop true else false then +; + +: zip-extent ( name$ -- adr len ) + expand$ open-dev ?dup 0= if " " exit then + >r + " offset" r@ $call-method load-base + + " size" r@ $call-method drop + r> close-dev +; +: sig$ ( -- adr len ) " /lzip:\data.sig" zip-extent ; +: img$ ( -- adr len ) " /lzip:\data.img" zip-extent ; +: bundle-name$ ( -- $ ) " ${DN}:${PN}\${CN}${FN}.zip" expand$ ; + +: bundle-present? ( -- flag ) + bundle-name$ + " Trying " ?lease-debug 2dup ?lease-debug-cr + ['] (boot-read) catch if 2drop false exit then + true +; + +d# 32 buffer: hashname +\ fn-buf and pn-buf must contain the base file name and path +: valid? ( data$ sig$ -- okay? ) + parse-sig if + ." Bad signature format in " bundle-name$ type cr + false exit + then ( data$ hashname$ sig$ ) + + \ Check for duplicate hashname attacks + 2swap 2dup hashname count $= if ( data$ sig$ hashname$ ) + ." Duplicate hash name in " bundle-name$ type cr + 4drop false exit + then + + d# 31 min hashname place ( data$ sig$ ) + + hashname count signature-bad? 0= +; + +d# 2007 d# 12 * 8 1- + d# 31 * d# 27 + constant earliest +0. 2value current-seconds + +\ This isn't an accurate calculation of seconds, but it +\ is sufficient for comparison purposes so long as we +\ use the same calculation in all cases. It is not good +\ if we need to do arithmetic on dates. +: get-date ( -- error? ) + time&date ( s m h d m y ) + d# 12 * swap 1- + ( s m h d m' ) \ Months start at 1 + d# 31 * swap 1- + ( s m h d' ) \ Days start at 1 + dup earliest < if ( s m h d' ) + screen-ih stdout ! + ." The clock is not set properly" cr + 4drop true exit + then ( s m h d' ) + d# 24 * + ( s m h' ) + d# 60 * + ( s m' ) \ Can't overflow so far + d# 60 um* ( s d.s' ) + swap 0 d+ to current-seconds + false +; + +: break$ ( $ n -- tail$ head$ ) + dup >r /string ( tail$ ) + over r@ - r> ( tail$ head$ ) +; + +0. 2value exp-seconds \ Accumulator for parsing data/time strings + +\ This is a factor used for parsing 2-digit fields from date/time strings. +\ Radix is the number to scale the result by, i.e. one more than the maximum +\ value of the field. Adjust is 0 for fields whose first valid value is 0 +\ (hours, minutes, seconds) or 1 for fields that start at 1 (month,day). +: numfield ( exp$ adjust radix -- exp$' ) + >r >r ( exp$ r: radix adjust ) + 2 break$ $number throw ( exp$' num r: radix adjust ) + r> - ( exp$ num' r: radix ) + dup r@ u>= throw ( exp$ num r: radix ) + + \ No need to multiply the top half because it can only become nonzero + \ on the last call to scale-time + exp-seconds drop r> um* ( exp$ num d.seconds ) + rot 0 d+ to exp-seconds ( exp$ ) +; + +: (expiration-to-seconds) ( expiration$ -- true | d.seconds false ) + 4 break$ $number throw ( exp$' year ) + dup d# 2999 u> throw ( exp$' year ) + 0 to exp-seconds ( exp$' ) + + 1 d# 12 numfield ( exp$' ) \ Month + 1 d# 31 numfield ( exp$' ) \ Day + + 1 break$ " T" $= 0= throw ( exp$' ) + + 0 d# 24 numfield ( exp$' ) \ Hour + 0 d# 60 numfield ( exp$' ) \ Minute + 0 d# 60 numfield ( exp$' ) \ Second + + " Z" $= 0= throw ( ) + exp-seconds +; + +: expiration-to-seconds ( expiration$ -- true | d.seconds false ) + push-decimal + ['] (expiration-to-seconds) catch ( x x true | d.seconds false ) + pop-base + dup if nip nip then +; + +: expired? ( expiration$ -- bad? ) + expiration-to-seconds if true exit then + current-seconds d< +; + +d# 1024 constant /sec-line-max +/sec-line-max buffer: sec-line-buf + +\ Remove bogus null characters from the end of tags on old machines +: ?-null ( adr len -- adr' len' ) + dup if + 2dup + 1- c@ 0= if 1- then ( adr len' ) + then +; + +d# 65 buffer: machine-id-buf + +: get-my-sn ( -- error? ) + + " SN" find-tag 0= if true exit then ( adr len ) + ?-null dup d# 11 <> if 2drop true exit then ( adr len ) + machine-id-buf swap move + + [char] : machine-id-buf d# 11 + c! + + " U#" find-tag 0= if true exit then ( adr len ) + ?-null dup d# 36 <> if 2drop true exit then ( adr len ) + machine-id-buf d# 12 + swap move + + [char] : machine-id-buf d# 48 + c! + + false +; +: my-sn$ ( -- adr len ) machine-id-buf d# 11 ; + +: check-machine-signature ( sig$ expiration$ -- -1|1 ) + 0 hashname c! + machine-id-buf d# 49 + swap move ( sig$ ) + machine-id-buf d# 65 2swap valid? if 1 else -1 then +; + +\ -1 means lease is for this machine and is invalid +\ 1 means lease is for this machine and is valid +\ 0 means lease is not for this machine +: check-lease ( lease$ -- -1|0|1 ) + bl left-parse-string " act01:" $= 0= if + " Not act01:" ?lease-debug-cr + 2drop -1 exit + then + bl left-parse-string ( rem$ serial$ ) + my-sn$ $= 0= if ( rem$ ) + " is for a different system" ?lease-debug-cr + 2drop 0 exit + then ( rem$ ) + bl left-parse-string ( sig$ expiration$ ) + dup d# 16 <> if ( sig$ expiration$ ) + " has bad expiration format" ?lease-debug-cr + 4drop -1 exit + then ( sig$ expiration$ ) + 2dup expired? if + " expired" ?lease-debug-cr + 4drop -1 exit + then ( sig$ expiration$ ) + check-machine-signature ( -1|1 ) + + dup 0< if + " has bad signature" ?lease-debug-cr + else + " valid" ?lease-debug-cr + then +; + +: lease-valid? ( -- flag ) + " ${DN}:\security\lease.sig" expand$ ( name$ ) + " Trying " ?lease-debug 2dup ?lease-debug-cr + r/o open-file if drop false exit then ( ih ) + >r ( r: ih ) + " Lease " ?lease-debug ( r: ih ) + begin + sec-line-buf /sec-line-max r@ read-line if ( actual -eof? ) + 2drop r> close-file drop false exit + then ( actual -eof? ) + while ( actual ) + sec-line-buf swap check-lease case ( -1|0|1 ) + 1 of r> close-file drop true exit endof + -1 of r> close-file drop false exit endof + endcase + repeat + r> close-file drop false +; + +: ?leased ( -- ) + lease-valid? if " run" else " act" then cn-buf place +; + +: olpc-load-image ( list$ pathname$ -- okay? ) + pn-buf place ( list$ ) + begin dup while ( list$ ) + bl left-parse-string ( list$ devname$ ) + dn-buf place ( list$' ) + ?leased ( list$ ) + bundle-present? if ( list$ ) + " OS found - " ?lease-debug + 0 hashname c! + img$ sig$ valid? if + " Signature valid" ?lease-debug-cr + img$ tuck load-base swap move !load-size + 2drop true exit + else + " Signature invalid" ?lease-debug-cr + then + then ( list$ ) + repeat ( list$ ) + 2drop false +; + +: secure-load ( -- okay? ) + load-crypto if ( ) + ." Can't get crypt code" cr ( ) + false exit + then ( ) + + get-my-sn if false exit then + get-date if false exit then + + " oskey" load-key if ( ) + ." Can't find OS public key" cr ( ) + false exit + then ( ) + + " os" fn-buf place + + boot-device-list " \boot" olpc-load-image if true exit then + " nand" " \boot-alt" olpc-load-image if true exit then + false +; + +\ Call this after the kernel has already been moved away from load-base +\ We assume that pn-buf already has the path prefix string +: secure-load-ramdisk ( -- ) +\ Bad idea, because the cmdline would need to be signed too +\ " /lzip:\cmdline" zip-extent to cmdline + + " rd" fn-buf place + bundle-present? if + " RD found - " ?lease-debug + 0 hashname c! + img$ sig$ valid? if + " Signature valid" ?lease-debug-cr + " /lzip:\data.img" $load-ramdisk exit + else + " Signature invalid" ?lease-debug-cr + fail-load + then + then +; + +: check-devel-key ( adr len -- -1|0|1 ) + bl left-parse-string " dev01:" $= 0= if 2drop -1 exit then ( rem$ ) + bl left-parse-string ( rem$ serial$ ) + my-sn$ $= 0= if 2drop 0 exit then ( rem$ ) + + " 00000000T000000Z" check-machine-signature +; + +: has-developer-key? ( -- flag ) + " ${DN}:\security\develop.sig" expand$ ( name$ ) + r/o open-file if drop false exit then ( ih ) + >r + begin + sec-line-buf /sec-line-max r@ read-line if ( actual -eof? ) + 2drop r> close-file drop false exit + then ( actual -eof? ) + while ( actual ) + sec-line-buf swap check-devel-key case ( -1|0|1 ) + 1 of r> close-file drop true exit endof + -1 of r> close-file drop false exit endof + endcase + repeat + r> close-file drop false +; + +: developer-device-list " disk sd nand" ; + +: developer? ( -- flag ) + get-my-sn if false exit then + + load-crypto if ( ) + ." Can't get crypt code" cr ( ) + false exit + then ( ) + + " fwkey" load-key if ( ) + ." Can't find firmware public key" cr ( ) + false exit + then ( ) + + developer-device-list + begin dup while ( list$ ) + bl left-parse-string dn-buf place ( list$' ) + has-developer-key? if ( list$' ) + 2drop true exit + then ( list$ ) + repeat ( list$ ) + 2drop false +; + +: do-secure-boot ( -- ) + debug-security? if screen-ih stdout ! then + ['] secure-load-ramdisk to load-ramdisk + secure-load 0= if fail-load then + loaded sync-cache " init-program" $find if execute else 2drop then + go +; + +: wp? ( -- flag ) " wp" find-tag dup if nip nip then ; + +: secure-boot ( -- ) wp? if do-secure-boot else boot then ; +" secure-boot" ' boot-command set-config-string-default + +\ For dn in boot-device-list +\ if + +fexit + +Firmware security use cases: + +a) load image signing: + +Package: {run,act}{os,rd}.zip +Expiration: none +Signed object: OS or RD image file in .zip file +Signature: sha256_rsa256.sig in .zip file +Verification Algorithm: sha256 -> rsa256 +Verification Key: OLPC-run-public-key + +Rule: Don't run the image if the signature fails + +b) Firmware update key + +Package: /boot/bootfw.zip +Expiration: none (but should be versioned to avoid repeated updates) +Signed object: image in .zip file +Signature1: sha255.rsa in .zip file +Signature2: whirl.rsa in .zip file +Verification Algorithm: sha256 -> rsa256, whirlpool -> rsa256 +Verification Key: OLPC-fw-public-key + +Rule: If the developer key is valid, enter unlocked firmware state + +c) Developer key + +Package: /security/develop.key +Expiration: none +Signed object: <serial#>:<uuid>:00000000T000000Z (representing the machine) +Signature: rsa256 data in sig01 line +Verification Algorithm: rsa256 +Verification Key: OLPC-devel-public-key + +Rule: If the developer key is valid, enter unlocked firmware state + +d) Activation lease + +Package: /security/lease +Expiration: Yes - time on signature line +Signed object: <serial#>:<uuid>:<expiration time> (representing the machine) +Signature: rsa256 data in sig01 line +Verification Algorithm: rsa256 +Verification Key: OLPC-act-public-key + +Rule: If the lease is invalid, invoke act{os,rd}.zip instead of run{os,rd}.zip + Modified: ofw/fs/zipfs.fth =================================================================== --- ofw/fs/zipfs.fth 2007-08-31 01:02:04 UTC (rev 587) +++ ofw/fs/zipfs.fth 2007-08-31 01:03:19 UTC (rev 588) @@ -5,7 +5,10 @@ 0 instance value base-adr 0 instance value image-size 0 instance value seek-ptr +external +\ Expose for the OLPC security scheme 0 instance value offset +headerless : clip-size ( adr len -- adr len' ) seek-ptr + image-size umin seek-ptr -

1 0

r587 - dev/geode/ac97
by svn＠openbios.org 31 Aug '07

31 Aug '07

Author: wmb Date: 2007-08-31 03:02:04 +0200 (Fri, 31 Aug 2007) New Revision: 587 Modified: dev/geode/ac97/selftest.fth Log: OLPC audio - close microphone after selftest, so LED goes off. Modified: dev/geode/ac97/selftest.fth =================================================================== --- dev/geode/ac97/selftest.fth 2007-08-30 21:20:40 UTC (rev 586) +++ dev/geode/ac97/selftest.fth 2007-08-31 01:02:04 UTC (rev 587) @@ -21,6 +21,7 @@ : record ( -- ) open-in establish-level record-base record-len audio-in drop + close-in ; : play ( -- )

1 0

r586 - dev/geode/nandflash
by svn＠openbios.org 30 Aug '07

30 Aug '07

Author: wmb Date: 2007-08-30 23:20:40 +0200 (Thu, 30 Aug 2007) New Revision: 586 Modified: dev/geode/nandflash/nand5536.fth Log: OLPC - Synchronized CS5536 NAND FLASH driver with recent changes to CaFe NAND driver. Modified: dev/geode/nandflash/nand5536.fth =================================================================== --- dev/geode/nandflash/nand5536.fth 2007-08-30 20:13:18 UTC (rev 585) +++ dev/geode/nandflash/nand5536.fth 2007-08-30 21:20:40 UTC (rev 586) @@ -97,6 +97,8 @@ handle-ecc ( ) stp ; +h# 800 buffer: page-buf +: get-page ( page# -- adr ) page-buf swap read-page page-buf ; : read-id ( -- adr ) h# 90 cmd \ Read-id command

1 0

r585 - cpu/x86/pc/olpc
by svn＠openbios.org 30 Aug '07

30 Aug '07

Author: wmb Date: 2007-08-30 22:13:18 +0200 (Thu, 30 Aug 2007) New Revision: 585 Modified: cpu/x86/pc/olpc/rmstart.fth Log: rmstart.fth - Added commentary describing the code that turns of the MIC bias. Modified: cpu/x86/pc/olpc/rmstart.fth =================================================================== --- cpu/x86/pc/olpc/rmstart.fth 2007-08-28 23:18:26 UTC (rev 584) +++ cpu/x86/pc/olpc/rmstart.fth 2007-08-30 20:13:18 UTC (rev 585) @@ -128,6 +128,11 @@ h# 01 # al mov al h# 80 # out + \ The following code sequence is a workaround for a hardware situation. + \ The MIC-on LED defaults to "on", because the CODEC chip powers on with + \ VREFOUT (i.e. MIC vbias) on. We don't want the MIC LED to turn on + \ automatically on every resume, so we have to turn it off very quickly. + \ The next few MSRs allow us to access the 5536 \ EXTMSR - page 449 \ Use PCI device #F for port 2 @@ -141,18 +146,21 @@ op: h# 51000010 # cx mov \ MSR number - CPU interface serial wrmsr - op: h# 014fc001 # dx mov - op: h# 01480001 # ax mov - op: h# 51000026 # cx mov + op: h# 014fc001 # dx mov \ Top of I/O region - 0x14fc, I/O space + op: h# 01480001 # ax mov \ Bottom of I/O region - 0x1480, enable + op: h# 51000026 # cx mov \ Region 6 configuration wrmsr - op: h# a0000001 # dx mov - op: h# 480fff80 # ax mov - op: h# 510100e1 # cx mov + op: h# a0000001 # dx mov \ Maps I/O space starting at 0x1480 + op: h# 480fff80 # ax mov \ to the AC97 CODEC (ACC block) + op: h# 510100e1 # cx mov \ IOD Base Mask 1 MSR wrmsr + \ Writes 4 to CODEC register 0x76 to turn off VBIAS (VREFOUT) op: h# 7601.0004 # ax mov op: h# 148c # dx mov op: ax dx out + \ End of MIC LED code. + \ This code is highly optimized because it runs when the CPU is in \ it slowest operation mode, so we want to get it done fast. \ GLCP_SYS_RSTPLL - page 406

1 0

resend: [5/5] Open Firmware on LinuxBIOS on M57SLI
by Torsten Duwe 29 Aug '07

29 Aug '07

This may look right, but it is a bad kludge. Open Firmware, when "biosload"ed, expects a top-of-RAM at physical address 0x1004 ( mem-info-pa 4 + ) , as a little endian pointer. LinuxBIOS however only provides its tables. There's currently code in the queue from Jens Freimann to parse the LB tables, and OFW should ideally get its info from that, but the stuff is not yet stable (right, Jens?) and providing the table info to the /memory device init is still to be written. Until openfirmware/cpu/x86/pc/biosload/probemem.fth is changed or maybe even an openfirmware/cpu/x86/pc/linuxbiosload is created, use this evil hack. The memory map is parsed anyway to find a RAM buffer for the payload, so I just hook in here to find a 32-bit pointer to the top of RAM, clipped to 3GB, to not confuse the payload :) Signed-off-by: Torsten Duwe <duwe(a)lst.de> Recommendation: do _NOT_ apply! I admit that I wrote this, but only as an interim solution.

1 0

resend: [1/5] Open Firmware on LinuxBIOS on M57SLI
by Torsten Duwe 29 Aug '07

29 Aug '07

As on http://www.openbios.org/Open_Firmware, change the config to get a suitable ELF header. qemu-loaded is also necessary on real hardware for current openfirmware versions. pc-linux will get you the capability to load ELF kernels from EXT2 file systems :-) virtual-mode somehow doesn't work for me. Signed-off-by: Torsten Duwe <duwe(a)lst.de> Recommendation: update the wiki page

1 0

[0/5] Open Firmware on LinuxBIOS on M57SLI
by Torsten Duwe 29 Aug '07

29 Aug '07

Hi all! Working a little on $SUBJECT, I found a few patches to be necessary to get it all running. It's far from perfect yet, but I wanted to share with you what I found so far. I had to make the config change to Open Firmware similar to that on the openbios wiki, and change 4 things in the LinuxBIOS source. I'll post these to the individual lists now. Thanks a lot for the work I could build upon! Torsten

2 1

[1/5] Open Firmware on LinuxBIOS on M57SLI
by Torsten Duwe 29 Aug '07

29 Aug '07

As on http://www.openbios.org/Open_Firmware, change the config to get a suitable ELF header. qemu-loaded is also necessary on real hardware for current openfirmware versions. pc-linux will get you the capability to load ELF kernels from EXT2 file systems :-) virtual-mode somehow doesn't work for me. Recommendation: update the wiki page

1 0

[5/5] Open Firmware on LinuxBIOS on M57SLI
by Torsten Duwe 29 Aug '07

29 Aug '07

This may look right, but it is a bad kludge. Open Firmware, when "biosload"ed, expects a top-of-RAM at physical address 0x1004 ( mem-info-pa 4 + ) , as a little endian pointer. LinuxBIOS however only provides its tables. There's currently code in the queue from Jens Freimann to parse the LB tables, and OFW should ideally get its info from that, but the stuff is not yet stable (right, Jens?) and providing the table info to the /memory device init is still to be written. Until openfirmware/cpu/x86/pc/biosload/probemem.fth is changed or maybe even an openfirmware/cpu/x86/pc/linuxbiosload is created, use this evil hack. The memory map is parsed anyway to find a RAM buffer for the payload, so I just hook in here to find a 32-bit pointer to the top of RAM, clipped to 3GB, to not confuse the payload :) Recommendation: do _NOT_ apply!

1 0

r584 - cpu/x86/pc/olpc dev/olpc/cafenand
by svn＠openbios.org 29 Aug '07

29 Aug '07

Author: wmb Date: 2007-08-29 01:18:26 +0200 (Wed, 29 Aug 2007) New Revision: 584 Modified: cpu/x86/pc/olpc/copynand.fth cpu/x86/pc/olpc/nandstat.fth dev/olpc/cafenand/badblock.fth dev/olpc/cafenand/cafenand.fth Log: copy-nand - Check carefully for bad blocks when copying on the OS image, adding any newly-discovered ones to the bad block table. Modified: cpu/x86/pc/olpc/copynand.fth =================================================================== --- cpu/x86/pc/olpc/copynand.fth 2007-08-28 18:45:58 UTC (rev 583) +++ cpu/x86/pc/olpc/copynand.fth 2007-08-28 23:18:26 UTC (rev 584) @@ -135,32 +135,32 @@ defer show-erasing ( #blocks -- ) : (show-erasing) ( #blocks -- ) ." Erasing " . ." blocks" cr ; -' (show-erasing) is show-erasing +' (show-erasing) to show-erasing defer show-erased ( block# -- ) : (show-erased) ( block# -- ) (cr . ; -' (show-erased) is show-erased +' (show-erased) to show-erased defer show-bad ( block# -- ) -' drop is show-bad +' drop to show-bad -defer show-bbt ( block# -- ) -' drop is show-bbt +defer show-bbt-block ( block# -- ) +' drop to show-bbt-block defer show-clean ( block# -- ) -' drop is show-clean +' drop to show-clean defer show-cleaning ( -- ) : (show-cleaning) ( -- ) cr ." Cleanmarkers" cr ; -' (show-cleaning) is show-cleaning +' (show-cleaning) to show-cleaning defer show-writing ( #blocks -- ) : (show-writing) ." Writing " . ." blocks" cr ; -' (show-writing) is show-writing +' (show-writing) to show-writing defer show-written : (show-written) ( block# -- ) (cr . ; -' (show-written) is show-written +' (show-written) to show-written : copy-nand ( "devspec" -- ) open-nand @@ -171,7 +171,7 @@ ['] noop to show-progress #nand-pages nand-pages/block / show-erasing - ['] show-bad ['] show-erased ['] show-bbt " (wipe)" $call-nand + ['] show-bad ['] show-erased ['] show-bbt-block " (wipe)" $call-nand #image-eblocks show-writing @@ -307,7 +307,6 @@ : dump-nand ( "devspec" -- ) true to dump-oob? (dump-nand) ; : save-nand ( "devspec" -- ) false to dump-oob? (dump-nand) ; - : fastcopy-nand ( "devspec" -- ) open-nand Modified: cpu/x86/pc/olpc/nandstat.fth =================================================================== --- cpu/x86/pc/olpc/nandstat.fth 2007-08-28 18:45:58 UTC (rev 583) +++ cpu/x86/pc/olpc/nandstat.fth 2007-08-28 23:18:26 UTC (rev 584) @@ -44,10 +44,10 @@ drop ; -: gshow-erased ( eblock# -- ) erased-color show-state ; -: gshow-bad ( eblock# -- ) bad-color show-state ; -: gshow-bbt ( eblock# -- ) bbt-color show-state ; -: gshow-clean ( eblock# -- ) clean-color show-state ; +: gshow-erased ( eblock# -- ) erased-color show-state ; +: gshow-bad ( eblock# -- ) bad-color show-state ; +: gshow-bbt-block ( eblock# -- ) bbt-color show-state ; +: gshow-clean ( eblock# -- ) clean-color show-state ; : gshow-cleaning ( -- ) ." Cleanmarkers" cr cursor-on ; @@ -69,14 +69,14 @@ : gshow-written ( eblock# -- ) written-color show-state ; : gshow - ['] gshow-erasing to show-erasing - ['] gshow-erased to show-erased - ['] gshow-bad to show-bad - ['] gshow-bbt to show-bbt - ['] gshow-clean to show-clean - ['] gshow-cleaning to show-cleaning - ['] gshow-writing to show-writing - ['] gshow-written to show-written + ['] gshow-erasing to show-erasing + ['] gshow-erased to show-erased + ['] gshow-bad to show-bad + ['] gshow-bbt-block to show-bbt-block + ['] gshow-clean to show-clean + ['] gshow-cleaning to show-cleaning + ['] gshow-writing to show-writing + ['] gshow-written to show-written ; gshow Modified: dev/olpc/cafenand/badblock.fth =================================================================== --- dev/olpc/cafenand/badblock.fth 2007-08-28 18:45:58 UTC (rev 583) +++ dev/olpc/cafenand/badblock.fth 2007-08-28 23:18:26 UTC (rev 584) @@ -142,7 +142,9 @@ /page + ( signature$ page# adr' ) loop ( signature$ page# adr' ) drop ( signature$ page# ) - /page bb-offset + write-bytes ( ) + /page bb-offset + write-bytes if ( ) + ." Failed to write bad block table" cr + then else ( signature$ page# ) 3drop ( ) then @@ -386,21 +388,51 @@ : start-scan ( -- ) pages/eblock negate to scan-page# ; -\ Must erase all (wipe) first +: try-copy-block ( adr page# -- okay? ) + pages/eblock bounds ?do ( adr ) + dup i write-page if ( adr ) + drop false unloop exit ( false ) + then ( adr ) + /page + ( adr' ) + loop ( adr ) + drop true ( true ) +; +: block-okay? ( adr page# -- okay? ) + pages/eblock bounds ?do ( adr ) + i get-page if ( adr ) + drop false unloop exit ( false ) + then ( adr buf-adr ) + over /page comp if ( adr ) + drop false unloop exit + then + /page + ( adr' ) + loop ( adr ) + drop true ( true ) +; +: copy&check ( adr page# -- okay? ) + 2dup try-copy-block 0= if 2drop false exit then ( adr page# ) + block-okay? +; + : copy-block ( adr -- page# error? ) - next-page# ( adr page# ) - tuck pages/eblock bounds ?do ( page# adr ) - dup i write-page if ( page# adr ) - drop true unloop exit ( page# true ) - then ( page# adr ) - /page + ( page# adr' ) - loop ( page# adr ) - drop false ( page# false ) + begin (next-page#) 0= while ( adr page# ) + 2dup copy&check if nip false exit then ( adr page# ) + \ Error; retry once + dup erase-block ( adr page# ) + 2dup copy&check if nip false exit then ( adr page# ) + mark-bad save-bbt ( adr ) + repeat ( adr ) + drop ( ) + usable-page-limit pages/eblock - true ( page# error? ) ; : put-cleanmarker ( page# -- ) - " "(85 19 03 20 08 00 00 00)" ( page# adr len ) - rot /page /ecc + write-bytes ( ) + >r + " "(85 19 03 20 08 00 00 00)" ( adr len r: page# ) + r@ /page /ecc + write-bytes if ( r: page# ) + r@ mark-bad save-bbt ( r: page# ) + then ( r: page# ) + r> drop ; : put-cleanmarkers ( show-xt -- ) begin (next-page#) 0= while ( show-xt page# ) Modified: dev/olpc/cafenand/cafenand.fth =================================================================== --- dev/olpc/cafenand/cafenand.fth 2007-08-28 18:45:58 UTC (rev 583) +++ dev/olpc/cafenand/cafenand.fth 2007-08-28 23:18:26 UTC (rev 584) @@ -149,13 +149,12 @@ swap r> move ( ) ; -: pio-write-raw ( adr len page# offset -- ) +: pio-write-raw ( adr len page# offset -- error? ) write-enable dma-off set-page dup datalen ( adr len ) chip h# 2000 + swap move ( ) write-cmd h# 0000.0110 cmd wait-cmd ( ) \ No Auto ECC wait-write-done ( error? ) - drop ; : pio-write-page ( adr page# -- error? ) @@ -210,21 +209,27 @@ syndrome-buf ; -: read-page ( adr page# -- error? ) - 0 set-page ( adr ) - /page /ecc + h# 18 cl! ( adr ) - dma-buf-pa h# 44 cl! ( adr ) - 0 h# 48 cl! ( adr ) - /page h# a000.0000 or h# 40 cl! ( adr ) - read-cmd h# 0800.0130 cmd wait-dma ( adr ) +\ Reads page into DMA buffer +: get-page ( page# -- true | adr false ) + 0 set-page ( ) + /page /ecc + h# 18 cl! ( ) + dma-buf-pa h# 44 cl! ( ) + 0 h# 48 cl! ( ) + /page h# a000.0000 or h# 40 cl! ( ) + read-cmd h# 0800.0130 cmd wait-dma ( ) - h# 3c cl@ h# 40000 and if ( adr ) \ ECC error - dma-buf-va syndrome correct-ecc ( adr uncorrectable? ) - else ( adr ) - false ( adr error? ) - then ( adr error? ) + h# 3c cl@ h# 40000 and if ( ) \ ECC error + dma-buf-va syndrome correct-ecc ( uncorrectable? ) + else ( ) + false ( error? ) + then ( error? ) + dup 0= if dma-buf-va swap then ( true | adr false ) +; - dma-buf-va rot /page do-lmove ( error? ) +: read-page ( adr page# -- error? ) + get-page if drop true exit then ( adr dma-buf-adr ) + swap /page do-lmove ( ) + false ; [ifdef] notdef @@ -267,7 +272,7 @@ ; : write-page ( adr page# -- error? ) dma-write-page ; -: write-bytes ( adr len page# offset -- ) pio-write-raw ; +: write-bytes ( adr len page# offset -- error? ) pio-write-raw ; 3 value #erase-adr-bytes \ Chip dependent : erase-block ( page# -- )

1 0

r583 - dev/olpc/cafenand
by svn＠openbios.org 28 Aug '07

28 Aug '07

Author: lwalter Date: 2007-08-28 20:45:58 +0200 (Tue, 28 Aug 2007) New Revision: 583 Modified: dev/olpc/cafenand/selftest.fth Log: Add fixbbt selftest Modified: dev/olpc/cafenand/selftest.fth =================================================================== --- dev/olpc/cafenand/selftest.fth 2007-08-27 23:09:32 UTC (rev 582) +++ dev/olpc/cafenand/selftest.fth 2007-08-28 18:45:58 UTC (rev 583) @@ -7,9 +7,31 @@ rn @ d# 1103515245 * d# 12345 + h# 7FFFFFFF and dup rn ! ; -false value selftest-err? -: record-err ( error? -- ) if true to selftest-err? then ; +0 value cur-eblock \ Eblock # under scrutiny +0 value prev-eblock \ Last bad eblock # +0 value #fixbbt \ Counter of bad eblocks found +false value fixbbt? \ Flag to determine whether to mark bad eblocks +false value selftest-err? \ Selftest result +: #fixbbt++ ( -- ) #fixbbt 1+ to #fixbbt ; +: .#fixbbt ( -- ) + (cr ." # bad blocks " + fixbbt? if ." marked" else ." found" then + ." = " #fixbbt .d cr +; +: record-err ( error? -- ) + noop + if + true to selftest-err? + prev-eblock cur-eblock <> if + ." Bad block" cur-eblock .page-byte cr + cur-eblock to prev-eblock + #fixbbt++ + fixbbt? if cur-eblock mark-bad then + then + then +; + 0 value sbuf \ Original content of block 0 value obuf \ Block data written 0 value ibuf \ Block data read @@ -37,7 +59,7 @@ : test-eblock ( page# pattern -- error? ) obuf erase-size 2 pick fill ibuf erase-size rot invert fill - obuf over write-eblock if true exit then + obuf over write-eblock if drop true exit then ibuf swap read-eblock if true exit then ibuf obuf erase-size comp ; @@ -46,7 +68,7 @@ : erase ( subarg$ -- ) 2drop ." Erasing..." cr wipe ; \ Destroy content of flash. Argument is hex byte pattern value. -: .skip-bad ( page# -- ) cr ." Skipping bad block" .page-byte cr ; +: .skip-bad ( page# -- ) (cr ." Skip bad block" .page-byte cr ; : fill ( subarg$ -- ) $number if 0 else 0 max h# ff min then ." Fill nandflash with h# " dup u. cr @@ -55,9 +77,12 @@ i block-bad? if i .skip-bad else + i to cur-eblock (cr i . i over test-eblock record-err then pages/eblock +loop drop + + .#fixbbt ; \ Non-destructive. Argument is number of blocks to test. @@ -77,6 +102,7 @@ dup block-bad? if ( block#' ) drop ( ) else ( block#' ) + dup to cur-eblock (cr dup . sbuf over read-eblock dup record-err 0= if dup h# 55 test-eblock record-err @@ -86,6 +112,8 @@ sbuf swap write-eblock record-err then loop + + .#fixbbt ; \ Non-destructive. Argument is <#blk>,<blk#> @@ -119,6 +147,7 @@ pages/eblock * swap 1+ pages/eblock * ( page# #page ) usable-page-limit rot ?do ( #blk+1 ) i block-bad? not if + i to cur-eblock (cr i . sbuf i read-eblock dup record-err 0= if i h# 55 test-eblock record-err @@ -127,8 +156,17 @@ sbuf i write-eblock record-err then dup +loop drop + + .#fixbbt ; +\ Non-destructive. Same as full. Except failed eblocks are marked as bad. +: fixbbt ( subarg$ -- ) + true to fixbbt? + full + #fixbbt if save-bbt then +; + : none ( subarg$ -- ) 2drop exit ; : help ( subarg$ -- ) @@ -146,19 +184,28 @@ ." Default <data> is 00" cr ." fast[,<#blk>] to non-destructively test the specified <#blk> of flash" cr ." Default <#blk> is decimal 10" cr - ." full[,<#blk>[,<blk#>]" cr + ." full[,<#blk>[,<blk#>]]" cr ." to non-destructively test the specified <blk#> every" cr ." <#blk>+1 number of blocks" cr ." Default <#blk> and <blk#> are 0" cr ." E.g., full,1,0 test even blocks" cr ." full,1,1 test odd blocks" cr ." full,2,0 test 33% of the flash" cr + ." fixbbt[,<#blk>[,<blk#>]]" cr + ." same as full; however, bad blocks found are marked as bad" cr cr ; +: selftest-init ( -- ) \ Init variables per test + false to fixbbt? + 0 to #fixbbt + -1 to prev-eblock +; + : parse-selftest-args ( arg$ -- ) begin ( arg$ ) ascii ; left-parse-string ?dup if ( rem$ arg$' ) + selftest-init ( rem$ arg$' ) ascii , left-parse-string ( rem$ subarg$ method$ ) my-self ['] $call-method catch if ( rem$ x x x x x ) ." Unknown argument" cr @@ -179,6 +226,7 @@ selftest-args ?dup if parse-selftest-args else + selftest-init drop " " fast then free-test-bufs

1 0

r582 - cpu/x86/pc/olpc
by svn＠openbios.org 28 Aug '07

28 Aug '07

Author: wmb Date: 2007-08-28 01:09:32 +0200 (Tue, 28 Aug 2007) New Revision: 582 Modified: cpu/x86/pc/olpc/nandstat.fth Log: nandstat.fth - Refactored the color names. Modified: cpu/x86/pc/olpc/nandstat.fth =================================================================== --- cpu/x86/pc/olpc/nandstat.fth 2007-08-27 23:08:11 UTC (rev 581) +++ cpu/x86/pc/olpc/nandstat.fth 2007-08-27 23:09:32 UTC (rev 582) @@ -25,6 +25,12 @@ dev screen : erase-screen erase-screen ; dend h# 80 h# 80 h# 80 rgb>565 constant bbt-color + 0 0 0 rgb>565 constant erased-color +h# ff 0 0 rgb>565 constant bad-color + 0 0 h# ff rgb>565 constant clean-color +h# ff h# ff 0 rgb>565 constant writing-color + 0 h# ff 0 rgb>565 constant written-color +h# ff h# ff h# ff rgb>565 constant starting-color : gshow-erasing ( #eblocks -- ) cursor-off " erase-screen" $call-screen 0 status-line at-xy @@ -33,21 +39,21 @@ " bbt0" $call-nand nand-pages/block / bbt-color show-state " bbt1" $call-nand nand-pages/block / bbt-color show-state - h# ff h# ff h# ff rgb>565 ( #eblocks color ) + starting-color ( #eblocks color ) swap 0 ?do i over show-state loop drop ; -: gshow-erased ( eblock# -- ) 0 0 0 rgb>565 show-state ; -: gshow-bad ( eblock# -- ) h# ff 0 0 rgb>565 show-state ; -: gshow-bbt ( eblock# -- ) h# 80 80 0 rgb>565 show-state ; -: gshow-clean ( eblock# -- ) h# 0 0 ff rgb>565 show-state ; +: gshow-erased ( eblock# -- ) erased-color show-state ; +: gshow-bad ( eblock# -- ) bad-color show-state ; +: gshow-bbt ( eblock# -- ) bbt-color show-state ; +: gshow-clean ( eblock# -- ) clean-color show-state ; : gshow-cleaning ( -- ) ." Cleanmarkers" cr cursor-on ; : gshow-writing ( #eblocks -- ) ." Writing " - h# ff h# ff 0 rgb>565 ( #eblocks color ) + writing-color ( #eblocks color ) 0 rot 0 ?do ( color eblock# ) dup nand-pages/block * " block-bad?" $call-nand 0= if ( color eblock# ) 2dup swap show-state ( color eblock# ) @@ -60,7 +66,7 @@ 2drop ; -: gshow-written ( eblock# -- ) 0 h# ff 0 rgb>565 show-state ; +: gshow-written ( eblock# -- ) written-color show-state ; : gshow ['] gshow-erasing to show-erasing

1 0

r581 - cpu/x86/pc/olpc dev/olpc/spiflash
by svn＠openbios.org 28 Aug '07

28 Aug '07

Author: wmb Date: 2007-08-28 01:08:11 +0200 (Tue, 28 Aug 2007) New Revision: 581 Modified: cpu/x86/pc/olpc/spiflash.bth dev/olpc/spiflash/flashec.fth Log: Added flash-ec to spiflash.dic Modified: cpu/x86/pc/olpc/spiflash.bth =================================================================== --- cpu/x86/pc/olpc/spiflash.bth 2007-08-27 23:07:37 UTC (rev 580) +++ cpu/x86/pc/olpc/spiflash.bth 2007-08-27 23:08:11 UTC (rev 581) @@ -3,17 +3,22 @@ command: &builder &this build-now -: null$ " " ; +\needs cdump : cdump ( adr len -- ) push-hex bounds ?do i c@ 3 u.r loop pop-base ; +\needs null$ : null$ " " ; + +h# fff0.0000 constant rom-pa + fload ${BP}/cpu/x86/pc/olpc/linuxserial.fth fload ${BP}/cpu/x86/ioports.fth \ I/O port access under Linux +alias root-map-in mmap ( phys len -- virt ) +alias root-map-out munmap ( virt len -- ) + fload ${BP}/cpu/x86/crc32.fth \ Assembly language Zip CRC calculation fload ${BP}/forth/lib/crc32.fth \ High-level portion of CRC calculation +fload ${BP}/forth/lib/wrtime.fth \ Time delays via the wrapper -: us ( microseconds -- ) drop ; -: ms ( milliseconds -- ) drop ; - : power-off ( -- ) " sync" $sh " kbc-on" eval ; hex @@ -30,6 +35,7 @@ fload ${BP}/dev/olpc/kb3700/ecserial.fth fload ${BP}/cpu/x86/pc/olpc/mfgdata.fth fload ${BP}/dev/olpc/spiflash/spiui.fth +fload ${BP}/dev/olpc/spiflash/flashec.fth : os-fw-filename$ ( -- adr len ) " olpc.rom" ; @@ -63,7 +69,11 @@ ." Verification over the serial line is slow (17 minutes)" cr ." so you might want to skip it and let the" cr ." loaded image verify itself upon booting." cr + ." cr + ." flash-ec filename \ Programs the EC FLASH from the named file + + cr ; ' usage to title Modified: dev/olpc/spiflash/flashec.fth =================================================================== --- dev/olpc/spiflash/flashec.fth 2007-08-27 23:07:37 UTC (rev 580) +++ dev/olpc/spiflash/flashec.fth 2007-08-27 23:08:11 UTC (rev 581) @@ -2,11 +2,13 @@ \ This will cause the overall CRC near the end of the FLASH to be wrong, \ but that won't prevent the system from working. -.( EC FLASH Program. Example: ok flash-ec disk:\PQ2B31.bin) cr +\ .( EC FLASH Program. Example: ok flash-ec disk:\PQ2B31.bin) cr +h# 1.0000 constant /ec + : flash-ec ( "filename" -- ) reading - ec-buf /ec ifd @ fgets ( len ) + flash-buf /ec ifd @ fgets ( len ) ifd @ fclose /ec <> abort" EC image file is the wrong length" @@ -14,7 +16,7 @@ spi-start spi-identify .spi-id cr - merge-mfg-data + \ merge-mfg-data flash-buf /ec 0 write-flash-range \ Write everything ;

1 0

r580 - cpu/x86/pc/olpc/sdtools
by svn＠openbios.org 28 Aug '07

28 Aug '07

Author: wmb Date: 2007-08-28 01:07:37 +0200 (Tue, 28 Aug 2007) New Revision: 580 Modified: cpu/x86/pc/olpc/sdtools/dumpgamma.fth cpu/x86/pc/olpc/sdtools/maketar cpu/x86/pc/olpc/sdtools/sd.fth Log: Cleaned up the initialization of base addresses. Modified: cpu/x86/pc/olpc/sdtools/dumpgamma.fth =================================================================== --- cpu/x86/pc/olpc/sdtools/dumpgamma.fth 2007-08-27 22:44:27 UTC (rev 579) +++ cpu/x86/pc/olpc/sdtools/dumpgamma.fth 2007-08-27 23:07:37 UTC (rev 580) @@ -5,7 +5,7 @@ \needs mmap fload ioports.fth hex -fe00.8000 4000 mmap constant vp-base +-1 value vp-base : vp@ ( reg -- l ) vp-base + l@ ; : vp! ( l reg -- ) vp-base + l! ; @@ -24,20 +24,16 @@ h# 8 +loop ; -fe00.4000 4000 mmap constant dc-base +-1 value dc-base : dc@ ( reg -- l ) dc-base + l@ ; : dc! ( l reg -- ) dc-base + l! ; -fe00.0000 4000 mmap constant gp-base +-1 value gp-base : gp@ ( reg -- l ) gp-base + l@ ; : gp! ( l reg -- ) gp-base + l! ; - - - - \ LICENSE_BEGIN \ Copyright (c) 2006 FirmWorks \ Modified: cpu/x86/pc/olpc/sdtools/maketar =================================================================== --- cpu/x86/pc/olpc/sdtools/maketar 2007-08-27 22:44:27 UTC (rev 579) +++ cpu/x86/pc/olpc/sdtools/maketar 2007-08-27 23:07:37 UTC (rev 580) @@ -4,8 +4,10 @@ cp ../../../../../cpu/x86/build/builder.dic sdkit cp ../../../../../cpu/x86/ioports.fth sdkit cp ../../../../../cpu/x86/pc/olpc/mfgdata.fth sdkit +cp ../../../../../forth/lib/wrtime.fth sdkit cp ../../../../../dev/olpc/dcon/dconsmb.fth sdkit cp ../../../../../dev/olpc/kb3700/ecio.fth sdkit cp sd sd.fth ecdump.fth dumpgamma.fth sdkit +chmod 755 sdkit/sd tar cfz sdkit.tgz sdkit # rm sdkit/* Modified: cpu/x86/pc/olpc/sdtools/sd.fth =================================================================== --- cpu/x86/pc/olpc/sdtools/sd.fth 2007-08-27 22:44:27 UTC (rev 579) +++ cpu/x86/pc/olpc/sdtools/sd.fth 2007-08-27 23:07:37 UTC (rev 580) @@ -21,30 +21,24 @@ usage hex -fe01.0000 4000 mmap constant sd +0 value sd-base -: sdl@ ( offset -- l ) sd + l@ ; -: sdw@ ( offset -- w ) sd + w@ ; -: sdb@ ( offset -- b ) sd + c@ ; +: sdl@ ( offset -- l ) sd-base + l@ ; +: sdw@ ( offset -- w ) sd-base + w@ ; +: sdb@ ( offset -- b ) sd-base + c@ ; -: sdl! ( l offset -- ) sd + l! ; -: sdw! ( w offset -- ) sd + w! ; -: sdb! ( b offset -- ) sd + c! ; +: sdl! ( l offset -- ) sd-base + l! ; +: sdw! ( w offset -- ) sd-base + w! ; +: sdb! ( b offset -- ) sd-base + c! ; : r ( offset -- ) sdl@ u. ; : w ( l offset -- ) sdl! ; -1 value flash-base -fff0.0000 10.0000 mmap to flash-base \needs cdump : cdump ( adr len -- ) bounds ?do i c@ .x loop ; \needs .mfg-data fload mfgdata.fth -: 1ms ( -- ) - h# 10 msr@ drop d# 500,000 + ( limit ) - begin dup h# 10 msr@ drop - 0< until - drop -; -: ms ( #ms -- ) 0 ?do 1ms loop ; +\needs ms fload wrtime.fth \needs dcon@ fload dconsmb.fth @@ -68,6 +62,15 @@ \needs ec@ fload ecio.fth \needs ec-range fload ecdump.fth +: map-io ( -- ) + h# fe01.0000 h# 4000 mmap to sd-base + h# fff0.0000 h# 10.0000 mmap to flash-base + h# fe00.8000 h# 4000 mmap to vp-base + h# fe00.4000 h# 4000 mmap to dc-base + h# fe00.0000 h# 4000 mmap to gp-base +; +map-io + \ LICENSE_BEGIN \ Copyright (c) 2006 FirmWorks \

1 0

r579 - ofw/inetv6
by svn＠openbios.org 28 Aug '07

28 Aug '07

Author: lwalter Date: 2007-08-28 00:44:27 +0200 (Tue, 28 Aug 2007) New Revision: 579 Modified: ofw/inetv6/dhcpv6.fth ofw/inetv6/ipv6.fth ofw/inetv6/udpv6.fth Log: Get DNS ipv6 address from stateless DHCPv6 server if the router does not provide the info Modified: ofw/inetv6/dhcpv6.fth =================================================================== --- ofw/inetv6/dhcpv6.fth 2007-08-24 00:08:52 UTC (rev 578) +++ ofw/inetv6/dhcpv6.fth 2007-08-27 22:44:27 UTC (rev 579) @@ -36,7 +36,7 @@ 0 sfield do6-data \ Option data constant /do6-hdr -d# 1024 constant /dhcpv6-packet +d# 1024 constant max-dhcpv6-packet \ do6-code values \ 1 client ID @@ -55,14 +55,22 @@ d# 256 buffer: 'root-path d# 256 buffer: 'client-name d# 256 buffer: 'vendor-options + headers ' 'client-name " client-name" chosen-string ' 'vendor-options " vendor-options" chosen-string ' 'root-path " root-path" chosen-string : domain-name ( -- adr len ) 'domain-name cscount ; + +headerless +instance variable xid [then] -0 instance value dhcpv6-packet +headers + +0 instance value dhcp-pref \ DHCPv6 server preference +0 instance value dhcpv6-packet \ DHCPv6 packet to send +0 instance value dhcpv6-reply \ DHCPv6 packet received 0 instance value dhcpv6-len \ Actual length of received DHCPv6 packet 0 instance value dhcpv6-option \ Pointer to option field in dhcpv6-packet @@ -75,15 +83,13 @@ : op$! ( $ -- ) tuck dhcpv6-option swap move +dhcpv6-option ; : allocate-dhcpv6 ( size -- ) - allocate-udp dup is dhcpv6-packet set-struct + allocate-udpv6 dup is dhcpv6-packet set-struct set-dhcpv6-option - get-msecs start-time ! - \ Set "random" transaction ID and random number generator seed my-en-addr 2 + xl@ get-msecs xor dup xid ! rn ! ; -: free-dhcpv6 ( size -- ) dhcpv6-packet swap free-udp ; +: free-dhcpv6 ( size -- ) dhcpv6-packet swap free-udpv6 ; : init-dhcpv6 ( -- ) [ifndef] include-ipv4 @@ -101,23 +107,53 @@ ; previous definitions -: send-dhcpv6-packet ( size op -- ) - dh6-op c! - xid dh6-xid! - dhcpv6-packet swap client-port dhcpv6-port send-udpv6-packet +: .dhcpv6-err ( status -- ) + ?dup 0= if exit then + ." DHCPv6: " + case + 1 of ." unspecified failure" endof + 2 of ." no address available" endof + 3 of ." no binding" endof + 4 of ." not on-link" endof + 5 of ." use multicast" endof + ( otherwise ) ." unknown error: " dup u. + endcase + cr ; -: detect-dhcpv6-packet ( op -- timeout? ) +: process-dhcpv6-options ( adr len -- error? ) + begin dup 0> while + over be-w@ case \ Option code + 7 of over 4 + c@ to dhcp-pref endof \ Preference + d# 13 of over 4 + be-w@ dup .dhcpv6-err \ Reply status + if 2drop true exit then endof + d# 25 of over 4 + name-server-ipv6 copy-ipv6-addr endof \ RDNSS + endcase + over 2 + be-w@ 4 + /string \ Advance to next option + repeat 2drop false +; + +: receive-dhcpv6-packet ( op -- timeout? ) >r dhcpv6-timeout set-timeout begin client-port receive-udp-packet 0= while ( adr,len src-port ) - drop to dhcpv6-len set-struct -the-struct dhcpv6-len dump cr - dh6-xid@ xid @ h# ff.ffff = dh6-op c@ r@ = and if r> drop false exit then + drop to dhcpv6-len dup set-struct to dhcpv6-reply + dh6-xid@ xid @ h# ff.ffff and = dh6-op c@ r@ = and if r> drop false exit then repeat r> drop true ; +: detect-dhcpv6-packet ( op -- error? ) + receive-dhcpv6-packet ?dup if exit then + dh6-options dhcpv6-len /dhcpv6-hdr - process-dhcpv6-options +; + +: send-dhcpv6-packet ( size op -- ) + dh6-op c! + xid @ dh6-xid! + dhcpv6-packet swap client-port dhcpv6-port send-udpv6-packet +; + : option-client-id ( -- ) 1 opw! \ Client ID option /e 4 + opw! \ Option len @@ -151,16 +187,14 @@ ; : do-dhcpv6-stateless ( -- ) - ." DHCPv6 stateless auto configuration not supported yet" cr exit - bootnet-debug if - ." DHCPv6 protocol: Getting network information" cr + ." DHCPv6 protocol: Information Request" cr then - /dhcpv6-packet allocate-dhcpv6 + max-dhcpv6-packet allocate-dhcpv6 - ['] dhcpv6-req-info catch drop + ['] dhcpv6-req-info catch if indent ." Timeout waiting for requested info" cr then - /dhcpv6-packet free-dhcpv6 + max-dhcpv6-packet free-dhcpv6 ; : do-dhcpv6-stateful ( -- ) Modified: ofw/inetv6/ipv6.fth =================================================================== --- ofw/inetv6/ipv6.fth 2007-08-24 00:08:52 UTC (rev 578) +++ ofw/inetv6/ipv6.fth 2007-08-27 22:44:27 UTC (rev 579) @@ -78,7 +78,6 @@ /ipv6 buffer: my-ipv6-addr-global /ipv6 buffer: router-ipv6-addr /ipv6 buffer: name-server-ipv6 -/ipv6 buffer: dhcp-ipv6-addr headerless @@ -107,6 +106,7 @@ >r r@ his-ipv6-addr-mc-sol-node ipv6= \ His solicited node address? r@ ipv6-addr-mc-all-nodes ipv6= or \ Multicast all-nodes? + r@ ipv6-addr-mc-all-dhcp ipv6= or \ Multicast all-dhcp? r> ipv6-addr-mc-all-routers ipv6= or \ Multicast all-routers? ; : my-ipv6-addr-mc? ( adr-buf -- flag ) Modified: ofw/inetv6/udpv6.fth =================================================================== --- ofw/inetv6/udpv6.fth 2007-08-24 00:08:52 UTC (rev 578) +++ ofw/inetv6/udpv6.fth 2007-08-27 22:44:27 UTC (rev 579) @@ -29,18 +29,18 @@ /udpv6-pseudo-hdr instance buffer: udpv6-pseudo-hdr \ Assumes the-struct is the UDP packet. -: fill-udpv6-pseudo-hdr ( -- ) +: fill-udpv6-pseudo-hdr ( his-ipv6 my-ipv6 -- ) /ipv6-header negate +struct udpv6-pseudo-hdr ( udp-pseudo-addr ) - my-ipv6-addr over udpv6-src-addr copy-ipv6-addr ( udp-pseudo-addr ) - his-ipv6-addr over udpv6-dst-addr copy-ipv6-addr ( udp-pseudo-addr ) + tuck ( my-ipv6-addr ) udpv6-src-addr copy-ipv6-addr ( udp-pseudo-addr ) + tuck ( his-ipv6-addr ) udpv6-dst-addr copy-ipv6-addr ( udp-pseudo-addr ) IP_HDR_UDP over udpv6-protocol-id xl! ( udp-pseudo-addr ) /ipv6-header +struct ( udp-pseudo-addr ) udp-length xw@ swap udpv6-len-copy xl! ( ) ; \ Assumes the-struct is the UDP packet. -: calc-udpv6-checksum ( -- checksum ) +: calc-udpv6-checksum ( his-ipv6 my-ipv6 -- checksum ) fill-udpv6-pseudo-hdr 0 udpv6-pseudo-hdr /udpv6-pseudo-hdr (oc-checksum) ( cksum ) 0 udp-checksum xw! @@ -54,7 +54,8 @@ /udp-header + dup udp-length xw! ( udp-len ) 0 udp-checksum xw! ( udp-len ) - calc-udpv6-checksum udp-checksum xw! ( udp-len ) + his-ipv6-addr my-ipv6-addr calc-udpv6-checksum udp-checksum xw! + ( udp-len ) the-struct swap IP_HDR_UDP send-ipv6-packet ( ) ; @@ -76,10 +77,15 @@ ; headerless +\ XXX Assume no extra IPv6 headers : bad-udpv6-checksum? ( -- bad? ) - udp-checksum xw@ dup if ( checksum ) - calc-udpv6-checksum <> ( bad? ) - then ( bad? ) + udp-checksum xw@ dup if ( checksum ) + the-struct dup >r ( checksum ) ( R: udp ) + /ipv6-header - set-struct ( checksum ) ( R: udp ) + ipv6-source-addr ipv6-dest-addr ( checksum his-ipv6 my-ipv6 ) ( R: udp ) + r> set-struct ( checksum his-ipv6 my-ipv6 ) + calc-udpv6-checksum <> ( bad? ) + then ( bad? ) ; : lock-udpv6-address ( -- ) lock-ipv6-address ;

1 0

.bin?
by Duane Ryan 27 Aug '07

27 Aug '07

I'm looking for a .bin file for ppc for the purpose of using it as a qemu bios (openhackware is broken). However, there are a few problems. 1, there isn't an ppc target. You list it in your readme as a target, but the rules.xml/config.xml for ppc don't exist, and I can't build a cross compiler. So, is there a previously built openbios image? Cheers, -Duane

4 4

r578 - cpu/x86/build
by svn＠openbios.org 24 Aug '07

24 Aug '07

Author: wmb Date: 2007-08-24 02:08:52 +0200 (Fri, 24 Aug 2007) New Revision: 578 Modified: cpu/x86/build/builder.dic Log: Rebuilt builder.dic with the change in r576. Modified: cpu/x86/build/builder.dic =================================================================== (Binary files differ)

1 0

r577 - ofw/fs/fatfs
by svn＠openbios.org 24 Aug '07

24 Aug '07

Author: wmb Date: 2007-08-24 01:34:38 +0200 (Fri, 24 Aug 2007) New Revision: 577 Modified: ofw/fs/fatfs/partition.fth Log: Followup to r564 - Tighter heuristic for detecting the presence of a partition map; the old one was treating boot code as partition info. This new one also requires a couple of specific values (0 or 80) in the bootable byte. Modified: ofw/fs/fatfs/partition.fth =================================================================== --- ofw/fs/fatfs/partition.fth 2007-08-23 23:31:44 UTC (rev 576) +++ ofw/fs/fatfs/partition.fth 2007-08-23 23:34:38 UTC (rev 577) @@ -17,8 +17,12 @@ \ using fdisk and mkdosfs under Linux. It is too easy to run mkdosfs on \ the overall disk (not the partition). : unpartitioned? ( -- flag ) - sector-buf h# 1fe + le-w@ h# aa55 <> - sector-buf h# 1c6 + le-l@ 0= or + \ In partition maps, the status byte is 0 (not bootable) or 80 (bootable) + sector-buf h# 1be + c@ h# 7f and 0<> ( unpartitioned? ) + \ and the end of the sector contains a signature + sector-buf h# 1fe + le-w@ h# aa55 <> or ( unpartitioned?' ) + \ and the first partition entry has a non0 starting sector number + sector-buf h# 1c6 + le-l@ 0= or ( unpartitioned?' ) ; : ptable-bounds ( -- end start ) sector-buf h# 1be + h# 40 bounds ;

1 0

r576 - forth/kernel
by svn＠openbios.org 24 Aug '07

24 Aug '07

Author: wmb Date: 2007-08-24 01:31:44 +0200 (Fri, 24 Aug 2007) New Revision: 576 Modified: forth/kernel/kernel.fth Log: Fixed a longstanding bug that caused misleading error messages when interpreting from files. The problem is that the line buffer memory has been freed and possibly overwritten before the undefined word name is displayed. The solution is to copy the word name to a dedicated buffer. Modified: forth/kernel/kernel.fth =================================================================== --- forth/kernel/kernel.fth 2007-08-23 23:28:07 UTC (rev 575) +++ forth/kernel/kernel.fth 2007-08-23 23:31:44 UTC (rev 576) @@ -995,9 +995,11 @@ then ; headers +0 value 'error-word : .not-found ( adr len -- ) where type ." ?" cr ; \ Abort after an undefined word in interpret state : $interpret-do-undefined ( adr len -- ) + d# 32 min 'error-word pack count set-abort-message d# -13 throw ; \ Compile a surrogate for an undefined word in compile state @@ -1532,6 +1534,7 @@ init d# 20 alloc-mem is fake-name-buf d# 32 alloc-mem is canonical-word + d# 34 alloc-mem is 'error-word ; headers

1 0

r575 - dev/olpc/cafenand
by svn＠openbios.org 24 Aug '07

24 Aug '07

Author: wmb Date: 2007-08-24 01:28:07 +0200 (Fri, 24 Aug 2007) New Revision: 575 Modified: dev/olpc/cafenand/badblock.fth Log: Changed the name of "scrub" to "scrub!" and made "scrub" issue a warning message. Modified: dev/olpc/cafenand/badblock.fth =================================================================== --- dev/olpc/cafenand/badblock.fth 2007-08-23 16:08:37 UTC (rev 574) +++ dev/olpc/cafenand/badblock.fth 2007-08-23 23:28:07 UTC (rev 575) @@ -286,7 +286,7 @@ \ Completely erase the device, ignoring any existing bad-block info \ This is fairly severe, not recommended except in exceptional situations -: scrub ( -- ) +: scrub! ( -- ) release-bbt total-pages 0 ?do (cr i . @@ -294,6 +294,11 @@ pages/eblock +loop make-bbt ; +: scrub ( -- ) + ." scrub is dangerous because it discards factory bad block information." cr + ." That can cause bad problems with later use of the NAND FLASH device." cr + ." Type scrub! if you really want to do it." cr +; : .bn ( -- ) (cr . ;

1 0

r574 - ofw/inetv6
by svn＠openbios.org 23 Aug '07

23 Aug '07

Author: lwalter Date: 2007-08-23 18:08:37 +0200 (Thu, 23 Aug 2007) New Revision: 574 Modified: ofw/inetv6/icmperr.fth ofw/inetv6/ipv6.fth ofw/inetv6/neighdis.fth ofw/inetv6/netloadv6.fth ofw/inetv6/tcpv6.fth Log: /prefix does not have to be multiple of 8 any more; some cleanup Modified: ofw/inetv6/icmperr.fth =================================================================== --- ofw/inetv6/icmperr.fth 2007-08-22 16:31:41 UTC (rev 573) +++ ofw/inetv6/icmperr.fth 2007-08-23 16:08:37 UTC (rev 574) @@ -58,6 +58,10 @@ icmp-code c@ -rot ( code adr len ) icmp-type c@ -rot ( code type adr len ) icmpv6-err-callback-xt execute + + \ Abort because, most likely, the error condition is caused by + \ erroneous networking code. + true abort" Fix cause of error and retry" ; headers Modified: ofw/inetv6/ipv6.fth =================================================================== --- ofw/inetv6/ipv6.fth 2007-08-22 16:31:41 UTC (rev 573) +++ ofw/inetv6/ipv6.fth 2007-08-23 16:08:37 UTC (rev 574) @@ -96,25 +96,6 @@ : unknown-ipv6-addr? ( adr-buf -- flag ) unknown-ipv6-addr ipv6= ; : knownv6? ( adr-buf -- flag ) unknown-ipv6-addr? 0= ; -: bits>mask ( bits -- mask ) - ?dup 0= if 0 exit then - 0 swap 0 7 ?do ( mask bits ) - 1 i << rot or swap ( mask' bits ) - 1- dup 0= if leave then ( mask bits' ) - -1 +loop drop ( mask ) -; - -: prefix-match? ( ip1 ip2 -- flag ) - /prefix 8 /mod 2over 2 pick ( ip1 ip2 rem quot ip1 ip2 quot ) - comp 0= if - swap bits>mask >r ( ip1 ip2 quot ) ( R: mask ) - tuck + c@ r@ and ( ip1 quot [ip2+quot]&mask ) ( R: mask ) - -rot + c@ r> and = ( flag ) - else - 4drop false - then -; - : set-his-ipv6-addr-mc ( -- ) his-ipv6-addr /ipv6 + 3 - his-ipv6-addr-mc-sol-node /ipv6 + 3 - 3 move ; @@ -142,6 +123,35 @@ his-ipv6-addr ipv6-addr-local? not if use-routerv6? and then ; +: bits>mask ( bits -- mask ) h# ff 8 rot - << h# ff and ; +: copy-ipv6-prefix ( prefix ip /prefix -- ) + 8 /mod 2over 2 pick move ( prefix ip rem quot ) + swap ?dup if ( prefix ip quot rem ) + bits>mask ( prefix ip quot mask ) + -rot ( prefix mask ip quot ) + tuck + dup c@ ( prefix mask quot ip+quot ip[quot] ) + 3 pick invert and 2>r ( prefix mask quot ) ( R: ip+quot ip[quot]&~mask ) + rot + c@ and ( prefix[quot]&mask ) ( R: ip+quot ip[quot]&~mask ) + 2r> rot or swap c! ( ) + else + 3drop ( ) + then +; +: (prefix-match?) ( ip1 ip2 /prefix -- flag ) + 8 /mod 2over 2 pick ( ip1 ip2 rem quot ip1 ip2 quot ) + comp 0= if + swap bits>mask >r ( ip1 ip2 quot ) ( R: mask ) + tuck + c@ r@ and ( ip1 quot ip2[quot]&mask ) ( R: mask ) + -rot + c@ r> and = ( flag ) + else + 4drop false + then +; +: prefix-match? ( ip1 ip2 -- flag ) + dup ipv6-addr-local? if d# 64 else /prefix then + (prefix-match?) +; + /ipv6 buffer: server-ipv6-addr : use-serverv6? ( -- flag ) server-ipv6-addr knownv6? ; : use-server? ( -- flag ) Modified: ofw/inetv6/neighdis.fth =================================================================== --- ofw/inetv6/neighdis.fth 2007-08-22 16:31:41 UTC (rev 573) +++ ofw/inetv6/neighdis.fth 2007-08-23 16:08:37 UTC (rev 574) @@ -160,12 +160,11 @@ ; : auto-cfg-global? ( -- flag ) my-prefix unknown-ipv6-addr? if false exit then - prefix-flag h# 40 and 0= if false exit then - /prefix d# 64 = \ XXX What to do with /prefix other than 64? + prefix-flag h# 40 and \ Prefix can be used for autocfg ; : discover-router ( -- ) - unknown-ipv6-addr my-ipv6-addr-global copy-ipv6-addr - ipv6-addr-mc-all-routers his-ipv6-addr copy-ipv6-addr + unknown-ipv6-addr my-ipv6-addr-global copy-ipv6-addr + ipv6-addr-mc-all-routers his-ipv6-addr copy-ipv6-addr set-his-en-addr-mc send-router-sol @@ -173,11 +172,11 @@ begin IP_HDR_ICMPV6 receive-ip-packet ?dup 0= if process-rd? then until - auto-cfg-global? not if exit then + auto-cfg-global? 0= if exit then \ DAD on the global IPv6 address my-ipv6-addr-link-local my-ipv6-addr-global copy-ipv6-addr - my-prefix my-ipv6-addr-global /prefix 8 / move \ XXX assume prefix multiple of 8 bits + my-prefix my-ipv6-addr-global /prefix copy-ipv6-prefix ipv6-addr-mc-all-nodes his-ipv6-addr copy-ipv6-addr set-his-en-addr-mc Modified: ofw/inetv6/netloadv6.fth =================================================================== --- ofw/inetv6/netloadv6.fth 2007-08-22 16:31:41 UTC (rev 573) +++ ofw/inetv6/netloadv6.fth 2007-08-23 16:08:37 UTC (rev 574) @@ -12,22 +12,27 @@ d# 256 buffer: 'root-path d# 32 buffer: tmpname false instance value bootp-only? +[then] +: (.ipv6) ( buf -- adr len ) + push-hex + <# dup /ipv6 + 1- do i c@ u# u# drop -1 +loop 0 u#> + pop-base +; + \ Construct the file name for the second-stage boot program from \ the IP address and the architecture. -: boot-filename ( -- adr len ) +: boot-filenamev6 ( -- adr len ) file-name-buf cscount dup if exit then ( adr len ) 2drop - push-hex - \ XXX Questionable code for IPv6 - my-ipv6-addr be-l@ (.8) 2dup upper ( adr len ) - pop-base + my-ipv6-addr (.ipv6) 2dup upper ( adr len ) tmpname place cpu-arch dup if " ." tmpname $cat tmpname $cat else 2drop then tmpname count file-name-buf place-cstr drop file-name-buf cscount ; +[ifndef] include-ipv4 headers true instance value use-bootp? @@ -116,7 +121,7 @@ headers : next-xid ( -- id ) rpc-xid 1+ dup to rpc-xid ; -: load ( adr -- len ) boot-filename read-file ; +: load ( adr -- len ) boot-filenamev6 read-file ; \ LICENSE_BEGIN \ Copyright (c) 2006 FirmWorks Modified: ofw/inetv6/tcpv6.fth =================================================================== --- ofw/inetv6/tcpv6.fth 2007-08-22 16:31:41 UTC (rev 573) +++ ofw/inetv6/tcpv6.fth 2007-08-23 16:08:37 UTC (rev 574) @@ -2413,7 +2413,6 @@ use-ipv6? if acceptv6 else accept then ; -\ XXX new args: ipv4, ipv6 [ifndef] include-ipv4 : parse-args ( -- ) my-args

1 0

r573 - ofw/inetv6
by svn＠openbios.org 22 Aug '07

22 Aug '07

Author: lwalter Date: 2007-08-22 18:31:41 +0200 (Wed, 22 Aug 2007) New Revision: 573 Modified: ofw/inetv6/dhcpv6.fth ofw/inetv6/dnsv6.fth ofw/inetv6/ipv6.fth ofw/inetv6/neighdis.fth Log: Obtain DNS IPv6 address from router advertisement Modified: ofw/inetv6/dhcpv6.fth =================================================================== --- ofw/inetv6/dhcpv6.fth 2007-08-22 01:05:10 UTC (rev 572) +++ ofw/inetv6/dhcpv6.fth 2007-08-22 16:31:41 UTC (rev 573) @@ -1,6 +1,56 @@ \ See license at end of file purpose: Dynamic Host Configuration Protocol for IPv6 (DHCPv6) (RFC 3315) +d# 1000 constant dhcpv6-timeout \ 1 second timeout + +d# 546 constant client-port +d# 547 constant dhcpv6-port + +struct ( dhcpv6 packet ) + 1 sfield dh6-op \ DHCPv6 message type + 3 sfield dh6-xid \ Transaction ID + 0 sfield dh6-options \ DHCPv6 options +constant /dhcpv6-hdr + +: dh6-xid@ ( -- xid ) dh6-xid 2 + c@ dh6-xid 1+ c@ dh6-xid c@ 0 bljoin ; +: dh6-xid! ( xid -- ) lbsplit drop dh6-xid c! dh6-xid 1+ c! dh6-xid 2 + c! ; + +\ dh6-op values +\ 1 SOLICIT Used by clients to locate DHCP servers +\ 2 ADVERTISE Used by servers as response to SOLICIT +\ 3 REQUEST Used by clients to get info from servers +\ 4 CONFIRM Used by clients to verify validity of params +\ 5 RENEW Used by clients to extend lifetime +\ 6 REBIND Used by clients to extend lifetime if no reply to RENEW +\ 7 REPLY Used by servers to respond +\ 8 RELEASE Used by clients to release their IPv6 addresses +\ 9 DECLINE Used by clients to decline assigned addresses +\ 10 RECONFIGURE Used by DHCP servers to inform clients of new cfg +\ 11 INFO_REQUEST Used by clients to request additional cfg params +\ 12 RELAY_FORWARD Used by DHCP relays to forward client msgs to servers +\ 13 RELAY_REPLY Used by DHCP servers to send msgs to clients via a relay + +struct ( dhcpv6 option ) + 2 sfield do6-code \ Option code + 2 sfield do6-len \ Option len + 0 sfield do6-data \ Option data +constant /do6-hdr + +d# 1024 constant /dhcpv6-packet + +\ do6-code values +\ 1 client ID +\ 2 server ID +\ 3 ID association for nontemporary address (IA_NA) +\ 4 ID association for temporary address (IA_TA) +\ 5 IA address +\ 6 option request +\ 7 preference +\ 8 elapse time +\ 9 relay message +\ 11 authentication +\ 12 server unicast + [ifndef] include-ipv4 d# 256 buffer: 'root-path d# 256 buffer: 'client-name @@ -12,9 +62,29 @@ : domain-name ( -- adr len ) 'domain-name cscount ; [then] -\ tubes.laptop.org -create default-name-server-ipv6 h# 20 c, 1 c, h# 48 c, h# 30 c, h# 24 c, h# 46 c, h# ff c, 0 c, 0 l, 0 w, 0 c, 1 c, +0 instance value dhcpv6-packet +0 instance value dhcpv6-len \ Actual length of received DHCPv6 packet +0 instance value dhcpv6-option \ Pointer to option field in dhcpv6-packet +: /dhcpv6-packet ( -- len ) dhcpv6-option dhcpv6-packet - ; +: set-dhcpv6-option ( -- ) dh6-options to dhcpv6-option ; +: +dhcpv6-option ( n -- ) dhcpv6-option + to dhcpv6-option ; +: opc! ( c -- ) dhcpv6-option c! 1 +dhcpv6-option ; +: opw! ( w -- ) dhcpv6-option be-w! 2 +dhcpv6-option ; +: opl! ( l -- ) dhcpv6-option be-l! 4 +dhcpv6-option ; +: op$! ( $ -- ) tuck dhcpv6-option swap move +dhcpv6-option ; + +: allocate-dhcpv6 ( size -- ) + allocate-udp dup is dhcpv6-packet set-struct + set-dhcpv6-option + + get-msecs start-time ! + + \ Set "random" transaction ID and random number generator seed + my-en-addr 2 + xl@ get-msecs xor dup xid ! rn ! +; +: free-dhcpv6 ( size -- ) dhcpv6-packet swap free-udp ; + : init-dhcpv6 ( -- ) [ifndef] include-ipv4 0 'domain-name c! @@ -23,7 +93,6 @@ 0 'vendor-options c! \ 0 file-name-buf c! [then] - default-name-server-ipv6 name-server-ipv6 copy-ipv6-addr ; also forth definitions @@ -32,9 +101,72 @@ ; previous definitions -: do-dhcp ( -- ) +: send-dhcpv6-packet ( size op -- ) + dh6-op c! + xid dh6-xid! + dhcpv6-packet swap client-port dhcpv6-port send-udpv6-packet ; +: detect-dhcpv6-packet ( op -- timeout? ) + >r + dhcpv6-timeout set-timeout + begin client-port receive-udp-packet 0= while ( adr,len src-port ) + drop to dhcpv6-len set-struct +the-struct dhcpv6-len dump cr + dh6-xid@ xid @ h# ff.ffff = dh6-op c@ r@ = and if r> drop false exit then + repeat + r> drop true +; + +: option-client-id ( -- ) + 1 opw! \ Client ID option + /e 4 + opw! \ Option len + 3 opw! \ DUID type: link-layer address + 1 opw! \ Hardware type: ethernet + my-en-addr /e op$! \ My mac address +; + +: option-req-option ( -- ) + 6 opw! \ Option request option + 2 opw! \ Option len + d# 23 opw! \ OPTION_DNS_SERVERS +; + +: dhcpv6-solicit ( -- ) + ipv6-addr-mc-all-dhcp his-ipv6-addr copy-ipv6-addr + set-his-en-addr-mc + option-client-id + \ option-ia to which server will assign addresses + option-req-option + /dhcpv6-packet d# 11 send-dhcpv6-packet + 2 detect-dhcpv6-packet abort" Timeout soliciting DHCPv6 server" +; +: dhcpv6-req-info ( -- ) + ipv6-addr-mc-all-dhcp his-ipv6-addr copy-ipv6-addr + set-his-en-addr-mc + option-client-id + option-req-option + /dhcpv6-packet d# 11 send-dhcpv6-packet + 7 detect-dhcpv6-packet abort" Timeout waiting for requested info" +; + +: do-dhcpv6-stateless ( -- ) + ." DHCPv6 stateless auto configuration not supported yet" cr exit + + bootnet-debug if + ." DHCPv6 protocol: Getting network information" cr + then + /dhcpv6-packet allocate-dhcpv6 + + ['] dhcpv6-req-info catch drop + + /dhcpv6-packet free-dhcpv6 +; + +: do-dhcpv6-stateful ( -- ) + true abort" Stateful autoconfiguration not supported yet" +; + \ LICENSE_BEGIN \ Copyright (c) 2007 FirmWorks \ Modified: ofw/inetv6/dnsv6.fth =================================================================== --- ofw/inetv6/dnsv6.fth 2007-08-22 01:05:10 UTC (rev 572) +++ ofw/inetv6/dnsv6.fth 2007-08-22 16:31:41 UTC (rev 573) @@ -224,6 +224,8 @@ [then] : resolvev6 ( hostname$ -- ) + name-server-ipv6 unknown-ipv6-addr? if true abort" Unknown DNS server IPv6 address" then + bootnet-debug if ( hostname$ ) ." Using IPv6 DNS to find the IPv6 address of " ( hostname$ ) 2dup type cr ( hostname$ ) Modified: ofw/inetv6/ipv6.fth =================================================================== --- ofw/inetv6/ipv6.fth 2007-08-22 01:05:10 UTC (rev 572) +++ ofw/inetv6/ipv6.fth 2007-08-22 16:31:41 UTC (rev 573) @@ -78,6 +78,7 @@ /ipv6 buffer: my-ipv6-addr-global /ipv6 buffer: router-ipv6-addr /ipv6 buffer: name-server-ipv6 +/ipv6 buffer: dhcp-ipv6-addr headerless @@ -86,6 +87,7 @@ create default-ipv6-addr h# fe c, h# 80 c, 0 w, 0 l, 0 w, 0 c, h# ff c, h# fe c, 0 c, 0 w, create ipv6-addr-mc-all-nodes h# ff c, 2 c, 0 w, 0 l, 0 l, 0 w, 0 c, 1 c, create ipv6-addr-mc-all-routers h# ff c, 2 c, 0 w, 0 l, 0 l, 0 w, 0 c, 2 c, +create ipv6-addr-mc-all-dhcp h# ff c, 2 c, 0 w, 0 l, 0 l, 0 c, 1 c, 0 c, 2 c, create my-ipv6-addr-mc-sol-node h# ff c, 2 c, 0 w, 0 l, 0 w, 0 c, 1 c, h# ff c, 0 c, 0 w, create his-ipv6-addr-mc-sol-node h# ff c, 2 c, 0 w, 0 l, 0 w, 0 c, 1 c, h# ff c, 0 c, 0 w, @@ -168,10 +170,11 @@ : .my-ipv6-addr-global ( -- ) ." My IPv6 (global): " my-ipv6-addr-global .ipv6 ; -: .his-ipv6-addr ( -- ) ." His IP: " his-ipv6-addr .ipv6 ; +: .his-ipv6-addr ( -- ) ." His IPv6: " his-ipv6-addr .ipv6 ; : .my-prefix ( -- ) ." My prefix (global): " my-prefix .ipv6 ." /" /prefix .d ; +: .name-server-ipv6 ( -- ) ." DNS IPv6: " name-server-ipv6 .ipv6 ; [ifndef] include-ipv4 0 instance value last-ip-packet Modified: ofw/inetv6/neighdis.fth =================================================================== --- ofw/inetv6/neighdis.fth 2007-08-22 01:05:10 UTC (rev 572) +++ ofw/inetv6/neighdis.fth 2007-08-22 16:31:41 UTC (rev 573) @@ -86,6 +86,7 @@ then indent .my-link-addr cr use-routerv6? if indent .routerv6-en-addr cr then + name-server-ipv6 knownv6? if indent .name-server-ipv6 cr then then ; @@ -98,6 +99,7 @@ ; : set-my-ipv6-addr-link-local ( -- ) \ Duplicate Address Discovery + d# 64 to /prefix unknown-ipv6-addr my-ipv6-addr copy-ipv6-addr default-ipv6-addr my-ipv6-addr-link-local copy-ipv6-addr @@ -114,17 +116,33 @@ my-ipv6-addr-link-local my-ipv6-addr copy-ipv6-addr ; +: discover-me ( -- ) + ipv6-address " stateless" $= if + set-my-ipv6-addr-link-local + else + do-dhcpv6-stateful + then +; +: ?discover-dns ( -- ) + ipv6-address " stateless" $= if + name-server-ipv6 unknown-ipv6-addr? if + do-dhcpv6-stateless + then + then +; + : process-rd-options ( adr len -- ) begin dup 0> while over c@ case - 1 of over 2 + routerv6-en-addr copy-en-addr endof \ Source link-layer address option - 3 of over 2 + c@ to /prefix \ Prefix option + 1 of over 2 + routerv6-en-addr copy-en-addr endof \ Source link-layer address option + 3 of over 2 + c@ to /prefix \ Prefix option over 3 + c@ to prefix-flag - over 8 + be-l@ to prefix-lifetime \ XXX lifetime - over d# 16 + my-prefix copy-ipv6-addr \ Prefix + over 8 + be-l@ to prefix-lifetime \ XXX lifetime + over d# 16 + my-prefix copy-ipv6-addr \ Prefix endof - 5 of over 4 + be-l@ to (link-mtu) endof \ MTU option + 5 of over 4 + be-l@ to (link-mtu) endof \ MTU option + d# 25 of over 8 + name-server-ipv6 copy-ipv6-addr endof \ RDNSS option endcase over 1+ c@ 8 * /string repeat 2drop @@ -173,11 +191,12 @@ ['] 4drop to icmpv6-err-callback-xt ['] 2drop to icmpv6-info-callback-xt + unknown-ipv6-addr name-server-ipv6 copy-ipv6-addr - d# 64 to /prefix - set-my-ipv6-addr-link-local - + discover-me discover-router + ?discover-dns + to use-ipv6? \ Restore IPv6 flag ;

1 0

r572 - cpu/x86/pc/olpc
by svn＠openbios.org 22 Aug '07

22 Aug '07

Author: wmb Date: 2007-08-22 03:05:10 +0200 (Wed, 22 Aug 2007) New Revision: 572 Modified: cpu/x86/pc/olpc/devices.fth cpu/x86/pc/olpc/gpioinit.fth cpu/x86/pc/olpc/micin.fth Log: OLPC trac #2767 - finish the job started by r571. Modified: cpu/x86/pc/olpc/devices.fth =================================================================== --- cpu/x86/pc/olpc/devices.fth 2007-08-21 20:49:43 UTC (rev 571) +++ cpu/x86/pc/olpc/devices.fth 2007-08-22 01:05:10 UTC (rev 572) @@ -324,7 +324,7 @@ " SN" find-tag if 1- else " Unknown" then " serial-number" string-property [ifndef] lx-devel - 8 ec-cmd " ec-version" integer-property + 8 ec-cmd-b@ " ec-version" integer-property " PQ2" h# fff0.0000 h# 1.0000 sindex dup 0>= if ( offset ) h# fff0.0000 + cscount ( name ) Modified: cpu/x86/pc/olpc/gpioinit.fth =================================================================== --- cpu/x86/pc/olpc/gpioinit.fth 2007-08-21 20:49:43 UTC (rev 571) +++ cpu/x86/pc/olpc/gpioinit.fth 2007-08-22 01:05:10 UTC (rev 572) @@ -190,7 +190,7 @@ : fix-sirq ( -- ) [ifdef] lx-devel exit [then] - 9 ec-cmd 9 <> if + 9 ec-cmd-b@ 9 <> if h# 5140.004e rdmsr swap h# 40 or swap h# 5140.004e wrmsr then ; Modified: cpu/x86/pc/olpc/micin.fth =================================================================== --- cpu/x86/pc/olpc/micin.fth 2007-08-21 20:49:43 UTC (rev 571) +++ cpu/x86/pc/olpc/micin.fth 2007-08-22 01:05:10 UTC (rev 572) @@ -10,14 +10,14 @@ post-b1? if 2 >clr OUT_VAL gpio! \ 5536 GPIO01 else - 2 ec-cmd drop \ EC GPIO18 + 2 ec-cmd-b@ drop \ EC GPIO18 then ; : dc-mode ( -- ) post-b1? if 2 OUT_VAL gpio! \ 5536 GPIO01 else - 1 ec-cmd drop \ EC GPIO18 + 1 ec-cmd-b@ drop \ EC GPIO18 then ;

1 0

r571 - dev/olpc/kb3700
by svn＠openbios.org 21 Aug '07

21 Aug '07

Author: wmb Date: 2007-08-21 22:49:43 +0200 (Tue, 21 Aug 2007) New Revision: 571 Modified: dev/olpc/kb3700/ecio.fth Log: OLPC trac #2767 - retry EC commands after timeout. Modified: dev/olpc/kb3700/ecio.fth =================================================================== --- dev/olpc/kb3700/ecio.fth 2007-08-20 19:37:58 UTC (rev 570) +++ dev/olpc/kb3700/ecio.fth 2007-08-21 20:49:43 UTC (rev 571) @@ -28,7 +28,7 @@ : ec-cmd-out ( cmd -- ) wait-ib-empty h# 6c pc! ; : ec-wb ( -- ) wait-ib-empty h# 68 pc! ; : ec-rb ( -- b ) - d# 1000 0 do + d# 200 0 do h# 6c pc@ 3 and 1 = if h# 68 pc@ unloop exit @@ -38,8 +38,6 @@ true abort" EC port 6c output buffer timeout" ; -: ec-cmd ( cmd -- response ) ec-cmd-out ec-rb ; - : ec-cmd66 ( byte -- ) h# 66 pc! \ It typically requires about 200 polls @@ -50,10 +48,52 @@ : ec-rw ( -- w ) ec-rb ec-rb swap bwjoin ; : ec-ww ( -- w ) wbsplit ec-wb ec-wb ; -: ec-cmd-w@ ( cmd -- w ) ec-cmd-out ec-rw ; -: ec-cmd-b@ ( cmd -- b ) ec-cmd ; -: ec-cmd-b! ( b cmd -- ) ec-cmd-out ec-wb ; +: (ec-cmd-b!) ( b cmd -- ) ec-cmd-out ec-wb ; +: (ec-cmd-b@) ( cmd -- b ) ec-cmd-out ec-rb ; +: (ec-cmd-w@) ( cmd -- w ) ec-cmd-out ec-rw ; +: too-many-retries ( -- ) true abort" Too many EC command retries" ; +d# 10 constant #ec-retries + +: ec-cmd ( cmd -- ) + #ec-retries 0 do ( cmd ) + dup ['] ec-cmd-out catch 0= if ( cmd ) + drop unloop exit + then ( cmd x ) + drop ( cmd ) + loop ( cmd ) + too-many-retries +; + +\ Hideous retries to work around race conditions in the EC code +: ec-cmd-b! ( b cmd -- ) + #ec-retries 0 do ( b cmd ) + 2dup ['] (ec-cmd-b!) catch 0= if ( b cmd ) + 2drop unloop exit + then ( b cmd x x ) + 2drop ( b cmd ) + loop ( b cmd ) + too-many-retries +; +: ec-cmd-b@ ( cmd -- b ) + #ec-retries 0 do ( cmd ) + dup ['] (ec-cmd-b@) catch 0= if ( cmd b ) + nip unloop exit + then ( cmd x ) + drop ( cmd ) + loop ( cmd ) + too-many-retries +; +: ec-cmd-w@ ( cmd -- w ) + #ec-retries 0 do ( cmd ) + dup ['] (ec-cmd-w@) catch 0= if ( cmd w ) + nip unloop exit + then ( cmd x ) + drop ( cmd ) + loop ( cmd ) + too-many-retries +; + : bat-voltage@ ( -- w ) h# 10 ec-cmd-w@ ; : bat-current@ ( -- w ) h# 11 ec-cmd-w@ ; : bat-acr@ ( -- w ) h# 12 ec-cmd-w@ ; @@ -61,31 +101,60 @@ : ambient-temp@ ( -- w ) h# 14 ec-cmd-w@ ; : bat-status@ ( -- b ) h# 15 ec-cmd-b@ ; : bat-soc@ ( -- b ) h# 16 ec-cmd-b@ ; -: bat-gauge-id@ ( -- sn0 .. sn7 ) h# 17 ec-cmd-out 8 0 do ec-rb loop ; -: bat-gauge@ ( -- b ) h# 18 ec-cmd-out h# 31 ec-wb ec-rb ; \ 31 is the EEPROM address -: bat-type@ ( -- b ) h# 18 ec-cmd-out h# 5f ec-wb ec-rb ; \ 5f is the EEPROM address +: (bat-gauge-id@) ( -- sn0 .. sn7 ) h# 17 ec-cmd-out 8 0 do ec-rb loop ; +: bat-gauge-id@ ( -- sn0 .. sn7 ) + #ec-retries 0 do + ['] (bat-gauge-id@) catch 0= if unloop exit then + loop + too-many-retries +; +: (bat-gauge@) ( -- b ) h# 18 ec-cmd-out h# 31 ec-wb ec-rb ; \ 31 is the EEPROM address +: bat-gauge@ ( -- b ) + #ec-retries 0 do + ['] (bat-gauge@) catch 0= if unloop exit then + loop + too-many-retries +; + +: (bat-type@) ( -- b ) h# 18 ec-cmd-out h# 5f ec-wb ec-rb ; \ 5f is the EEPROM address +: bat-type@ ( -- b ) + #ec-retries 0 do + ['] (bat-type@) catch 0= if unloop exit then + loop + too-many-retries +; + : board-id@ ( -- b ) h# 19 ec-cmd-b@ ; : sci-source@ ( -- b ) h# 1a ec-cmd-b@ ; : sci-mask! ( b -- ) h# 1b ec-cmd-b! ; : sci-mask@ ( -- b ) h# 1c ec-cmd-b@ ; -: game-key@ ( -- w ) h# 1d ec-cmd-out ec-rw ; -: ec-date! ( day month year -- ) h# 1e ec-cmd-out ec-wb ec-wb ec-wb ; +: game-key@ ( -- w ) h# 1d ec-cmd-w@ ; +: (ec-date!) ( day month year -- ) h# 1e ec-cmd-out ec-wb ec-wb ec-wb ; +: ec-date! ( day month year -- ) + #ec-retries 0 do ( d m y ) + 3dup ['] (ec-date!) catch 0= if 3drop unloop exit then ( d m y x x x ) + 3drop ( d m y ) + loop ( d m y ) + too-many-retries +; + : ec-abnormal@ ( -- b ) h# 1f ec-cmd-b@ ; -: bat-init-nimh-gp ( -- ) h# 20 ec-cmd-out ; -: bat-init-lifepo4-byd ( -- ) h# 21 ec-cmd-out ; -: bat-init-lifepo4-gp ( -- ) h# 22 ec-cmd-out ; +: bat-init-nimh-gp ( -- ) h# 20 ec-cmd ; +: bat-init-lifepo4-byd ( -- ) h# 21 ec-cmd ; +: bat-init-lifepo4-gp ( -- ) h# 22 ec-cmd ; : wlan-off ( -- ) 0 h# 23 ec-cmd-b! ; : wlan-on ( -- ) 1 h# 23 ec-cmd-b! ; -: wlan-wake ( -- ) h# 24 ec-cmd-out ; -: wlan-reset ( -- ) h# 25 ec-cmd-out ; +: wlan-wake ( -- ) h# 24 ec-cmd ; +: wlan-reset ( -- ) h# 25 ec-cmd ; : dcon-disable ( -- ) 0 h# 26 ec-cmd-b! ; : dcon-enable ( -- ) 1 h# 26 ec-cmd-b! ; -: reset-ec-warm ( -- ) h# 27 ec-cmd-out ; -: reset-ec ( -- ) h# 28 ec-cmd-out ; -: write-protect-fw ( -- ) h# 29 ec-cmd-out ; +: reset-ec-warm ( -- ) h# 27 ec-cmd ; +: reset-ec ( -- ) h# 28 ec-cmd ; +: write-protect-fw ( -- ) h# 29 ec-cmd ; : ebook-mode? ( -- b ) h# 2a ec-cmd-b@ ; +0 [if] \ EC mailbox access words : ec-mb-adr@ ( -- w ) h# 80 ec-cmd-out ec-rw ; @@ -96,6 +165,7 @@ : ec-mb-w@ ( adr -- w ) h# 88 ec-mb-setup h# 82 ec-cmd-w@ ; : ec-mb-b! ( b adr -- ) h# 85 ec-mb-setup ec-wb h# 8b ec-cmd-out ; : ec-mb-w! ( w adr -- ) h# 83 ec-mb-setup ec-ww h# 89 ec-cmd-out ; +[then] \ SCI source codes: \ SCI_WAKEUP_EVENT 0x01 // Game button, @@ -109,9 +179,9 @@ \ This command hard-resets the EC deeply enough for the SP write-protect to \ be off when the system is powered up again. -: ec-reset ( -- ) 5 ec-cmd ; +: ec-reset ( -- ) 5 ec-cmd-b@ drop ; -: kb3920? ( -- flag ) h# 6c pc@ h# ff = if true exit then 9 ec-cmd 9 = ; +: kb3920? ( -- flag ) h# 6c pc@ h# ff = if true exit then 9 ec-cmd-b@ 9 = ; \ This makes the EC stop generating a flood of SCIs every time you do \ the port 66 command sequence.

1 0

r570 - forth/lib
by svn＠openbios.org 20 Aug '07

20 Aug '07

Author: wmb Date: 2007-08-20 21:37:58 +0200 (Mon, 20 Aug 2007) New Revision: 570 Added: forth/lib/tofile.fth Log: forth/lib/tofile.fth - Initial checkin Added: forth/lib/tofile.fth =================================================================== --- forth/lib/tofile.fth (rev 0) +++ forth/lib/tofile.fth 2007-08-20 19:37:58 UTC (rev 570) @@ -0,0 +1,97 @@ +purpose: Redirect the output stream. +\ See license at end of file + +\ to-file \ filename ( -- ) +\ causes output to be temporarily diverted to the named file. +\ The file is created if it doesn't exist, and overwritten if it does. +\ Output is restored to the console just before Forth prompts for a +\ new line of input. +\ append-to-file \ filename ( -- ) +\ Similar to to-file but if the file already exists, the new stuff is +\ tacked onto the end, rather than overwriting the file. + +\ We really need to make the output stream a multi-field structure, and +\ keep a stack of output streams. + +only forth also hidden also definitions +variable old-status ' noop old-status token! +variable old-(emit ' noop old-(emit token! +variable old-(type ' noop old-(type token! +variable old-cr ' noop old-cr token! +variable old-exit? ' noop old-exit? token! +variable old-#out 0 old-#out ! +variable old-#line 0 old-#line ! +variable saved-output-valid saved-output-valid off + +forth definitions +: save-output ( -- ) + ['] status behavior old-status token! + ['] (emit behavior old-(emit token! + ['] (type behavior old-(type token! + ['] cr behavior old-cr token! + ['] exit? behavior old-exit? token! + #out @ old-#out ! + #line @ old-#line ! + saved-output-valid on +; +: unsave-output ( -- ) + saved-output-valid @ if + old-(emit token@ is (emit + old-(type token@ is (type + old-status token@ is status + old-cr token@ is cr + old-exit? token@ is exit? + old-#out @ #out ! + old-#line @ #line ! + saved-output-valid off + then +; +hidden definitions +: undo-file-output ( -- ) unsave-output ofd @ fclose ; +: file-(emit ( char -- ) ofd @ fputc ; +: file-(type ( adr len -- ) ofd @ fputs ; +: file-cr ( adr len -- ) + #out off 1 #line +! newline-string ofd @ fputs +; +forth definitions +: file-output ( -- ) + save-output + ['] undo-file-output is status + ['] file-(emit is (emit + ['] file-(type is (type + ['] file-cr is cr + ['] false is exit? + #out off #line off +; + +: to-file \ filename ( -- ) + writing file-output +; +: append-to-file \ filename ( -- ) + appending file-output +; +only forth also definitions + +\ LICENSE_BEGIN +\ Copyright (c) 2007 FirmWorks +\ +\ Permission is hereby granted, free of charge, to any person obtaining +\ a copy of this software and associated documentation files (the +\ "Software"), to deal in the Software without restriction, including +\ without limitation the rights to use, copy, modify, merge, publish, +\ distribute, sublicense, and/or sell copies of the Software, and to +\ permit persons to whom the Software is furnished to do so, subject to +\ the following conditions: +\ +\ The above copyright notice and this permission notice shall be +\ included in all copies or substantial portions of the Software. +\ +\ THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, +\ EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF +\ MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND +\ NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE +\ LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION +\ OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION +\ WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. +\ +\ LICENSE_END

1 0

r569 - dev/ne2000
by svn＠openbios.org 19 Aug '07

19 Aug '07

Author: wmb Date: 2007-08-19 20:13:20 +0200 (Sun, 19 Aug 2007) New Revision: 569 Modified: dev/ne2000/ne2000.fth Log: ne2000 driver - fixed a typo - OVR was spelled OVER, thus possibly causing a bug in the "overrun" routine. Modified: dev/ne2000/ne2000.fth =================================================================== --- dev/ne2000/ne2000.fth 2007-08-19 01:51:23 UTC (rev 568) +++ dev/ne2000/ne2000.fth 2007-08-19 18:13:20 UTC (rev 569) @@ -433,7 +433,7 @@ \ updated the boundary register, or determined that there really were \ no new packets in the ring. - OVER isr! \ Clear the overrun interrupt bit + OVR isr! \ Clear the overrun interrupt bit set-tx-mode \ Take the NIC out of loopback \ Resend any incomplete transmission @@ -446,7 +446,7 @@ : recv-690-overrun ( -- ) false to is-overrun-690 boundary@ boundary! \ rewrite bndry with itself - OVER isr! \ Clear overrun interrupt bit + OVR isr! \ Clear overrun interrupt bit ; [then]

1 0

r568 - cpu/x86/pc/olpc
by svn＠openbios.org 19 Aug '07

19 Aug '07

Author: wmb Date: 2007-08-19 03:51:23 +0200 (Sun, 19 Aug 2007) New Revision: 568 Modified: cpu/x86/pc/olpc/versions.fth Log: Q2C25 Modified: cpu/x86/pc/olpc/versions.fth =================================================================== --- cpu/x86/pc/olpc/versions.fth 2007-08-19 01:39:34 UTC (rev 567) +++ cpu/x86/pc/olpc/versions.fth 2007-08-19 01:51:23 UTC (rev 568) @@ -2,7 +2,7 @@ \ The overall firmware revision macro: FW_MAJOR C -macro: FW_MINOR 24 +macro: FW_MINOR 25 \ The EC microcode macro: EC_VERSION c24

1 0

r567 - in dev/olpc: kb3700 spiflash
by svn＠openbios.org 19 Aug '07

19 Aug '07

Author: wmb Date: 2007-08-19 03:39:34 +0200 (Sun, 19 Aug 2007) New Revision: 567 Modified: dev/olpc/kb3700/ecserial.fth dev/olpc/spiflash/recover.fth dev/olpc/spiflash/spiui.fth Log: OLPC - reliability improvements in "clone" (for debricking machines). a) Eliminate EC watchdog resets by reading the SPI FLASH slowly (c.f. Trac #2636) b) Tell user when and how to reset the target machine. Modified: dev/olpc/kb3700/ecserial.fth =================================================================== --- dev/olpc/kb3700/ecserial.fth 2007-08-19 01:13:03 UTC (rev 566) +++ dev/olpc/kb3700/ecserial.fth 2007-08-19 01:39:34 UTC (rev 567) @@ -17,11 +17,22 @@ ['] noop to spi-reprogrammed d# 57600 baud + + \ We have to reset the target here because it is probably confused by having + \ received other characters from our serial line + ." Reset the target system with a full power-cycle, then type a key to continue" cr + begin key? until key drop + h# 5a uemit ( divisor ) \ ( wait-tx ) h# 88 spicfg! ( divisor ) \ Write enable for SPICMD register h# 45 spibaud! ( ) + + d# 50 ms \ Settling time + d# 115200 baud + d# 50 ms \ Settling time + -1 to flash-base ; : use-serial-ec ( -- ) ['] serial-spi-start to spi-start ; Modified: dev/olpc/spiflash/recover.fth =================================================================== --- dev/olpc/spiflash/recover.fth 2007-08-19 01:13:03 UTC (rev 566) +++ dev/olpc/spiflash/recover.fth 2007-08-19 01:39:34 UTC (rev 567) @@ -28,7 +28,7 @@ : clone ( -- ) ." Getting a copy of this machine's FLASH" cr - h# fff0.0000 flash-buf /flash move + slow-flash-read true to file-loaded? (serial-flash) Modified: dev/olpc/spiflash/spiui.fth =================================================================== --- dev/olpc/spiflash/spiui.fth 2007-08-19 01:13:03 UTC (rev 566) +++ dev/olpc/spiflash/spiui.fth 2007-08-19 01:39:34 UTC (rev 567) @@ -203,6 +203,12 @@ /flash mfg-data-end-offset write-flash-range \ Write last part ; +: .verify-msg ( -- ) + ." Type verify if you want to verify the data just written." cr + ." Verification will take about 17 minutes if the host is running Linux" cr + ." or about 5 minutes if the host is running OFW." cr +; + : reflash ( -- ) \ Flash from data already in memory ?file spi-start @@ -222,8 +228,7 @@ then spi-reprogrammed else - ." Type verify if you want to verify the data just written." cr - ." Verification will take about 17 minutes..." cr + .verify-msg then ; @@ -238,21 +243,26 @@ : flash ( ["filename"] -- ) get-file reflash ; -[ifdef] dev -dev /flash +\ This is a slower version of "rom-va flash-buf /flash lmove" +\ It works around the problem that continuous CPU access to the +\ SPI FLASH starves the EC of instruction fetch cycles, often +\ causing it to turn off the system. 0 value rom-va -: selftest ( -- error? ) - rom-va 0= if rom-pa /flash root-map-in to rom-va then - - \ This is a slower version of "rom-va flash-buf /flash lmove" - \ It works around the problem that continuous CPU access to the - \ SPI FLASH starves the EC of instruction fetch cycles, often - \ causing it to turn off the system. +: slow-flash-read ( -- ) + rom-pa /flash root-map-in to rom-va /flash 0 do rom-va i + flash-buf i + h# 1.0000 lmove d# 200 ms h# 1.0000 +loop + rom-va /flash root-map-out 0 to rom-va +; +[ifdef] dev +dev /flash +: selftest ( -- error? ) + + slow-flash-read + \ Replace the manufacturing data block with all FF flash-buf mfg-data-offset + /flash-block h# ff fill @@ -261,7 +271,6 @@ -1 swap l! flash-buf /flash crc <> - rom-va /flash root-map-out 0 to rom-va ; device-end [then] @@ -291,8 +300,7 @@ \ Don't overwrite the EC code flash-buf /flash /ec write-flash-range - ." Type verify-bios if you want to verify the data just written." cr - ." Verification will take about 17 minutes..." cr + .verify-msg ; : verify-bios ( -- ) flash-buf /flash /ec verify-flash-range ;

1 0

r566 - cpu/x86/pc/olpc
by svn＠openbios.org 19 Aug '07

19 Aug '07

Author: wmb Date: 2007-08-19 03:13:03 +0200 (Sun, 19 Aug 2007) New Revision: 566 Modified: cpu/x86/pc/olpc/fw.bth Log: Added game-key (direction-pad left) to invoke the "freeze screen" function for "pretty boot". Modified: cpu/x86/pc/olpc/fw.bth =================================================================== --- cpu/x86/pc/olpc/fw.bth 2007-08-19 01:07:32 UTC (rev 565) +++ cpu/x86/pc/olpc/fw.bth 2007-08-19 01:13:03 UTC (rev 566) @@ -476,23 +476,26 @@ r> to load-started r> to playback-volume ; +: go-hook-freeze + [ ' go-hook behavior compile, ] + 0 " set-source" $call-screen +; +: freeze ( -- ) ['] go-hook-freeze to go-hook ; +: unfreeze ( -- ) ['] usb-quiet to go-hook ; : ?start-sound ( -- ) game-key-mask h# 40 and if start-sound then ; : ?games ( -- ) - game-key-mask h# 20 and if pong then + game-key-mask h# 20 and if pong then ; +: ?freeze ( -- ) + game-key-mask h# 10 and if freeze then +; : open-keyboard ( -- ) " keyboard" open-dev ?dup if set-stdin then ; -: go-hook-freeze - [ ' go-hook behavior compile, ] - 0 " set-source" $call-screen -; -: freeze ( -- ) ['] go-hook-freeze to go-hook ; -: unfreeze ( -- ) ['] usb-quiet to go-hook ; : startup ( -- ) standalone? 0= if exit then @@ -505,6 +508,7 @@ stdout off probe-pci ?start-sound + ?freeze ['] false to interrupt-auto-boot? probe-usb \ " nand" $dev-update-flash @@ -522,6 +526,7 @@ ?start-sound open-keyboard ?games + ?freeze optional-startup interpreter-init [ifndef] lx-devel

1 0

r565 - cpu/x86
by svn＠openbios.org 19 Aug '07

19 Aug '07

Author: wmb Date: 2007-08-19 03:07:32 +0200 (Sun, 19 Aug 2007) New Revision: 565 Modified: cpu/x86/catchexc.fth cpu/x86/dtacc.fth Log: OLPC trac #2897 - An ordering problem in the allocation of the cpu-state array versus the setting of a value in that array was causing B2 machines to crash very early in the OFW init sequence - only on Q2C24 firmware. Modified: cpu/x86/catchexc.fth =================================================================== --- cpu/x86/catchexc.fth 2007-08-17 21:23:31 UTC (rev 564) +++ cpu/x86/catchexc.fth 2007-08-19 01:07:32 UTC (rev 565) @@ -333,9 +333,6 @@ forth definitions : catch-exceptions ( -- ) - pssave drop rssave drop \ Force buffer allocation - [ 0 alloc-reg ] literal alloc-mem is cpu-state - d# 00 catch-vector \ Divide by 0 d# 01 catch-vector \ Debugger d# 03 catch-vector \ Breakpoint @@ -354,7 +351,14 @@ ['] (uncatch-exceptions) is uncatch-exceptions ; +: init-exceptions ( -- ) + pssave drop rssave drop \ Force buffer allocation + [ 0 alloc-reg ] literal alloc-mem is cpu-state + restartable? off + catch-exceptions +; + : (cold-hook ( -- ) (cold-hook ['] noop is uncatch-exceptions @@ -418,13 +422,6 @@ ; \ ' print-breakpoint is handle-breakpoint -\ defer restart ( -- ) -hidden also -stand-init: - restartable? off -; -only forth also definitions - \ LICENSE_BEGIN \ Copyright (c) 2006 FirmWorks \ Modified: cpu/x86/dtacc.fth =================================================================== --- cpu/x86/dtacc.fth 2007-08-17 21:23:31 UTC (rev 564) +++ cpu/x86/dtacc.fth 2007-08-19 01:07:32 UTC (rev 565) @@ -26,7 +26,7 @@ [ also hidden ] ['] save-state-common to save-state [ previous ] - catch-exceptions + init-exceptions then ;

1 0

r564 - in ofw: disklabel fs/fatfs
by svn＠openbios.org 17 Aug '07

17 Aug '07

Author: wmb Date: 2007-08-17 23:23:31 +0200 (Fri, 17 Aug 2007) New Revision: 564 Modified: ofw/disklabel/methods.fth ofw/fs/fatfs/partition.fth Log: OLPC trac #2889 - handle disks that have a bogus duplicate BIOS Parameter Block in sector 0 in addition to the real on in the partition. Modified: ofw/disklabel/methods.fth =================================================================== --- ofw/disklabel/methods.fth 2007-08-17 19:23:21 UTC (rev 563) +++ ofw/disklabel/methods.fth 2007-08-17 21:23:31 UTC (rev 564) @@ -69,7 +69,7 @@ \ If we find certain things in the first sector, we need not bother \ with partitions, and we ignore the partition specification - fat? if get-disk-size exit then + fat? unpartitioned? and if get-disk-size exit then dropin? if get-disk-size exit then zip? if get-disk-size exit then Modified: ofw/fs/fatfs/partition.fth =================================================================== --- ofw/fs/fatfs/partition.fth 2007-08-17 19:23:21 UTC (rev 563) +++ ofw/fs/fatfs/partition.fth 2007-08-17 21:23:31 UTC (rev 564) @@ -10,6 +10,17 @@ sector-buf d# 16 + c@ 1 2 between and ( flag ) \ #FATS ok? ; +\ This is a lame check to see if there might be a partition map entry. +\ It is for the case where the disk has a valid BPB in sector 0, but +\ also has a partition that doesn't start at 0. Thit is a bogus layout, +\ but we need to handle it anyway, because people often screw up when +\ using fdisk and mkdosfs under Linux. It is too easy to run mkdosfs on +\ the overall disk (not the partition). +: unpartitioned? ( -- flag ) + sector-buf h# 1fe + le-w@ h# aa55 <> + sector-buf h# 1c6 + le-l@ 0= or +; + : ptable-bounds ( -- end start ) sector-buf h# 1be + h# 40 bounds ; : ptable-sum ( -- n ) 0 ptable-bounds do i c@ + loop ; : fdisk? ( -- flag )

1 0

r563 - ofw/wifi
by svn＠openbios.org 17 Aug '07

17 Aug '07

Author: lwalter Date: 2007-08-17 21:23:21 +0200 (Fri, 17 Aug 2007) New Revision: 563 Modified: ofw/wifi/eapol.fth Log: Mask out bit 7 when deriving common rates Modified: ofw/wifi/eapol.fth =================================================================== --- ofw/wifi/eapol.fth 2007-08-17 18:59:06 UTC (rev 562) +++ ofw/wifi/eapol.fth 2007-08-17 19:23:21 UTC (rev 563) @@ -579,8 +579,8 @@ 0 value cr-idx \ Index into common-rates : supported-rate? ( r -- true | false ) - false swap #rates 0 ?do - supported-rates i + c@ over = if nip true swap leave then + h# 7f and false swap #rates 0 ?do + supported-rates i + c@ h# 7f and over = if nip true swap leave then loop drop ; : add-common-rates ( adr len -- )

1 0

r562 - dev/olpc/cafenand
by svn＠openbios.org 17 Aug '07

17 Aug '07

Author: wmb Date: 2007-08-17 20:59:06 +0200 (Fri, 17 Aug 2007) New Revision: 562 Modified: dev/olpc/cafenand/badblock.fth Log: NAND Cleanmarkers are supposed to be 8 bytes, not 12. Compatible with kernels built after Aug 10, 2007. Modified: dev/olpc/cafenand/badblock.fth =================================================================== --- dev/olpc/cafenand/badblock.fth 2007-08-17 18:31:38 UTC (rev 561) +++ dev/olpc/cafenand/badblock.fth 2007-08-17 18:59:06 UTC (rev 562) @@ -394,7 +394,7 @@ ; : put-cleanmarker ( page# -- ) - " "(85 19 03 20 08 00 00 00 00 00 00 00)" ( page# adr len ) + " "(85 19 03 20 08 00 00 00)" ( page# adr len ) rot /page /ecc + write-bytes ( ) ; : put-cleanmarkers ( show-xt -- )

1 0

r561 - cpu/x86
by svn＠openbios.org 17 Aug '07

17 Aug '07

Author: wmb Date: 2007-08-17 20:31:38 +0200 (Fri, 17 Aug 2007) New Revision: 561 Modified: cpu/x86/kernel.bth cpu/x86/savemeta.fth Log: Yet another step in the pstr-elimination sage, see r521. Modified: cpu/x86/kernel.bth =================================================================== --- cpu/x86/kernel.bth 2007-08-17 18:25:27 UTC (rev 560) +++ cpu/x86/kernel.bth 2007-08-17 18:31:38 UTC (rev 561) @@ -117,7 +117,8 @@ hex \Tags close-tag-file -\NotTags .( --- Saving ) dic-file-name ". .( ---) dic-file-name save-meta cr +\NotTags .( --- Saving ) dic-file-name ". .( ---) +dic-file-name count $save-meta cr \ LICENSE_BEGIN \ Copyright (c) 2006 FirmWorks Modified: cpu/x86/savemeta.fth =================================================================== --- cpu/x86/savemeta.fth 2007-08-17 18:25:27 UTC (rev 560) +++ cpu/x86/savemeta.fth 2007-08-17 18:31:38 UTC (rev 561) @@ -8,7 +8,7 @@ 0f + 4 >> ; -: save-meta ( str -- ) +: $save-meta ( filename$ -- ) \ origin-t >hostaddr here-t origin-t - save-image origin-t origin-t h# 1c + le-l!-t \ Relocation base of saved image @@ -17,7 +17,7 @@ origin-t >hostaddr is code-adr makeheader - new-file + $new-file exp-header /exp-header ofd @ fputs code-adr code-size ofd @ fputs relocation-map-t reloc-size ofd @ fputs

1 0

r560 - cpu/x86/pc/olpc
by svn＠openbios.org 17 Aug '07

17 Aug '07

Author: wmb Date: 2007-08-17 20:25:27 +0200 (Fri, 17 Aug 2007) New Revision: 560 Modified: cpu/x86/pc/olpc/versions.fth Log: Version q2c24 Modified: cpu/x86/pc/olpc/versions.fth =================================================================== --- cpu/x86/pc/olpc/versions.fth 2007-08-17 04:14:16 UTC (rev 559) +++ cpu/x86/pc/olpc/versions.fth 2007-08-17 18:25:27 UTC (rev 560) @@ -2,10 +2,10 @@ \ The overall firmware revision macro: FW_MAJOR C -macro: FW_MINOR 23 +macro: FW_MINOR 24 \ The EC microcode -macro: EC_VERSION c23 +macro: EC_VERSION c24 \ Alternate command for getting EC microcode, for testing new versions. \ Temporarily uncomment the line and modify the path as necessary

1 0

r559 - cpu/x86/pc/olpc
by svn＠openbios.org 17 Aug '07

17 Aug '07

Author: wmb Date: 2007-08-17 06:14:16 +0200 (Fri, 17 Aug 2007) New Revision: 559 Added: cpu/x86/pc/olpc/rtcwake.fth Log: OLPC rtcwake.fth - Initial checkin of test code to wakeup from RTC alarm. Added: cpu/x86/pc/olpc/rtcwake.fth =================================================================== --- cpu/x86/pc/olpc/rtcwake.fth (rev 0) +++ cpu/x86/pc/olpc/rtcwake.fth 2007-08-17 04:14:16 UTC (rev 559) @@ -0,0 +1,36 @@ +\ Suspend/resume test with RTC wakeup +d# 2 value rtc-alarm-delay + +h# 41 constant cmos-alarm-day \ CMOS offset of day alarm +h# 40 constant cmos-alarm-month \ CMOS offset of month alarm +cmos-alarm-day 0 h# 5140.0055 msr! +cmos-alarm-month 0 h# 5140.0056 msr! + +: enable-rtc-alarm ( -- ) + h# c cmos@ drop \ Clear RTC interrupt flags + h# b cmos@ h# 20 or h# b cmos! +; +: disable-rtc-alarm ( -- ) + h# b cmos@ h# 20 invert and h# b cmos! +; +: bcd-cmos! ( binary -- ) " bcd!" clock-node @ $call-method ; +: set-rtc-alarm ( secs -- ) + disable-rtc-alarm + now ( secs s m h ) + d# 60 * d# 60 * swap d# 60 * + + + ( s ) + d# 60 /mod d# 60 /mod d# 24 mod ( s m h ) + h# c0 cmos-alarm-month cmos! ( s m h ) \ Any day + h# c0 cmos-alarm-day cmos! ( s m h ) \ Any month + 5 bcd-cmos! 3 bcd-cmos! 1 bcd-cmos! ( ) + enable-rtc-alarm +; + +: rs ( -- ) + rtc-alarm-delay set-rtc-alarm + s + disable-rtc-alarm +; +patch 500.0000 100.0000 s3 \ Turn on RTC wakeup too +: rss begin d# 50 ms rs ." ." key? until ; + +.( 'rs' does it once, 'rss' does it until you type a key) cr

1 0

r558 - dev/geode/display
by svn＠openbios.org 17 Aug '07

17 Aug '07

Author: wmb Date: 2007-08-17 06:12:02 +0200 (Fri, 17 Aug 2007) New Revision: 558 Modified: dev/geode/display/gp.fth dev/geode/display/gxfb.fth Log: GX display driver - save/restore GP registers when suspending. Modified: dev/geode/display/gp.fth =================================================================== --- dev/geode/display/gp.fth 2007-08-17 01:02:12 UTC (rev 557) +++ dev/geode/display/gp.fth 2007-08-17 04:12:02 UTC (rev 558) @@ -3,9 +3,6 @@ alias depth+ wa+ -: gp! ( l reg -- ) gp-base + rl! ; -: gp@ ( reg -- l ) gp-base + rl@ ; - : dst! ( x y -- ) bytes/line16 * swap depth+ 0 gp! ; : src! ( x y -- ) bytes/line16 * swap depth+ 4 gp! ; : stride! ( dst-stride src-stride -- ) wljoin 8 gp! ; Modified: dev/geode/display/gxfb.fth =================================================================== --- dev/geode/display/gxfb.fth 2007-08-17 01:02:12 UTC (rev 557) +++ dev/geode/display/gxfb.fth 2007-08-17 04:12:02 UTC (rev 558) @@ -36,7 +36,10 @@ : dc@ ( offset -- value ) dc-base + rl@ ; : vp! ( value offset -- ) vp-base + rl! ; : vp@ ( offset -- value ) vp-base + rl@ ; +: gp! ( l reg -- ) gp-base + rl! ; +: gp@ ( reg -- l ) gp-base + rl@ ; + : iand ( value mask -- ) invert and ; : map-frame-buffer ( -- ) @@ -337,8 +340,8 @@ 0 h# 38 vp! h# 100 0 do h# 40 vp@ l!+ loop \ Gamma h# 410 vp@ l!+ -\ h# 3c 0 do i gp@ l!+ 4 +loop -\ h# 4c gp@ l!+ + h# 3c 0 do i gp@ l!+ 4 +loop + h# 4c gp@ l!+ drop \ video-state - /l / . cr @@ -386,8 +389,8 @@ 0 h# 38 vp! h# 100 0 do l@+ h# 40 vp! loop \ Gamma l@+ h# 410 vp! -\ h# 3c 0 do l@+ i gp! 4 +loop -\ l@+ h# 4c gp! + h# 3c 0 do l@+ i gp! 4 +loop + l@+ h# 4c gp! 0 0 dc! \ Lock drop

1 0

r557 - cpu/x86/pc/olpc dev/olpc/cafenand
by svn＠openbios.org 17 Aug '07

17 Aug '07

Author: wmb Date: 2007-08-17 03:02:12 +0200 (Fri, 17 Aug 2007) New Revision: 557 Modified: cpu/x86/pc/olpc/copynand.fth cpu/x86/pc/olpc/nandstat.fth dev/olpc/cafenand/badblock.fth Log: copy-nand - added graphical display of bad-block-table location, fixed a bug in verify-nand and crc-nand (they were stuck on block 0). Modified: cpu/x86/pc/olpc/copynand.fth =================================================================== --- cpu/x86/pc/olpc/copynand.fth 2007-08-16 22:14:47 UTC (rev 556) +++ cpu/x86/pc/olpc/copynand.fth 2007-08-17 01:02:12 UTC (rev 557) @@ -137,19 +137,20 @@ : (show-erasing) ( #blocks -- ) ." Erasing " . ." blocks" cr ; ' (show-erasing) is show-erasing -defer show-erased +defer show-erased ( block# -- ) : (show-erased) ( block# -- ) (cr . ; ' (show-erased) is show-erased -defer show-bad -: (show-bad) ( block# -- ) drop ; -' (show-bad) is show-bad +defer show-bad ( block# -- ) +' drop is show-bad -defer show-clean -: (show-clean) ( block# -- ) drop ; -' (show-clean) is show-clean +defer show-bbt ( block# -- ) +' drop is show-bbt -defer show-cleaning +defer show-clean ( block# -- ) +' drop is show-clean + +defer show-cleaning ( -- ) : (show-cleaning) ( -- ) cr ." Cleanmarkers" cr ; ' (show-cleaning) is show-cleaning @@ -170,7 +171,7 @@ ['] noop to show-progress #nand-pages nand-pages/block / show-erasing - ['] show-bad ['] show-erased " (wipe)" $call-nand + ['] show-bad ['] show-erased ['] show-bbt " (wipe)" $call-nand #image-eblocks show-writing @@ -205,7 +206,7 @@ " scan-page#" $call-nand .x cr ( ) ?key-stop then ( ) - repeat ( ) + loop ( ) close-nand-ihs ; @@ -251,7 +252,7 @@ else ( actual-crc expected-crc ) 2drop ( ) then ( ) - repeat ( ) + loop ( ) close-nand-ihs ; Modified: cpu/x86/pc/olpc/nandstat.fth =================================================================== --- cpu/x86/pc/olpc/nandstat.fth 2007-08-16 22:14:47 UTC (rev 556) +++ cpu/x86/pc/olpc/nandstat.fth 2007-08-17 01:02:12 UTC (rev 557) @@ -38,12 +38,12 @@ drop ; -: gshow-erased ( eblock# -- ) 0 0 0 rgb>565 show-state ; +: gshow-erased ( eblock# -- ) 0 0 0 rgb>565 show-state ; +: gshow-bad ( eblock# -- ) h# ff 0 0 rgb>565 show-state ; +: gshow-bbt ( eblock# -- ) h# 80 80 0 rgb>565 show-state ; +: gshow-clean ( eblock# -- ) h# 0 0 ff rgb>565 show-state ; -: gshow-bad ( eblock# -- ) h# ff 0 0 rgb>565 show-state ; - : gshow-cleaning ( -- ) ." Cleanmarkers" cr cursor-on ; -: gshow-clean ( eblock# -- ) h# 0 0 ff rgb>565 show-state ; : gshow-writing ( #eblocks -- ) ." Writing " @@ -66,6 +66,7 @@ ['] gshow-erasing to show-erasing ['] gshow-erased to show-erased ['] gshow-bad to show-bad + ['] gshow-bbt to show-bbt ['] gshow-clean to show-clean ['] gshow-cleaning to show-cleaning ['] gshow-writing to show-writing Modified: dev/olpc/cafenand/badblock.fth =================================================================== --- dev/olpc/cafenand/badblock.fth 2007-08-16 22:14:47 UTC (rev 556) +++ dev/olpc/cafenand/badblock.fth 2007-08-17 01:02:12 UTC (rev 557) @@ -297,26 +297,30 @@ : .bn ( -- ) (cr . ; -: (wipe) ( 'show-bad 'show-erased -- ) +: (wipe) ( 'show-bad 'show-erased 'show-bbt -- ) get-existing-bbt - bbt if - usable-page-limit 0 ?do ( 'show-bad 'show-erased ) - i block-bad? if - i pages/eblock / 2 pick execute - else - i pages/eblock / over execute - i erase-block - then - pages/eblock +loop ( 'show-bad 'show-erased ) - 2drop exit - then ( 'show-bad 'show-erased ) - \ If there is no existing bad block table, make one from factory info - make-bbt - 2drop + bbt 0= if + \ If there is no existing bad block table, make one from factory info + make-bbt + then ( 'show-bad 'show-erased 'show-bbt ) + + bbt0 if bbt0 pages/eblock / over execute then + bbt1 if bbt1 pages/eblock / over execute then + drop ( 'show-bad 'show-erased ) + + usable-page-limit 0 ?do ( 'show-bad 'show-erased ) + i block-bad? if + i pages/eblock / 2 pick execute + else + i pages/eblock / over execute + i erase-block + then + pages/eblock +loop ( 'show-bad 'show-erased ) + 2drop exit ; \ Clear the device but honor the existing bad block table -: wipe ( -- ) ['] drop ['] .bn (wipe) ; +: wipe ( -- ) ['] drop ['] .bn ['] drop (wipe) ; : show-bbt ( -- ) get-bbt

1 0

r556 - cpu/x86/pc/olpc
by svn＠openbios.org 17 Aug '07

17 Aug '07

Author: wmb Date: 2007-08-17 00:14:47 +0200 (Fri, 17 Aug 2007) New Revision: 556 Modified: cpu/x86/pc/olpc/fw.bth Log: Oops, fw.bth was including the IPv6 version of http.fth. Reverted to the IPv4 version. Modified: cpu/x86/pc/olpc/fw.bth =================================================================== --- cpu/x86/pc/olpc/fw.bth 2007-08-16 21:00:46 UTC (rev 555) +++ cpu/x86/pc/olpc/fw.bth 2007-08-16 22:14:47 UTC (rev 556) @@ -367,7 +367,7 @@ fload ${BP}/ofw/inet/loadtcp.fth support-package: http - fload ${BP}/ofw/inetv6/http.fth \ HTTP client + fload ${BP}/ofw/inet/http.fth \ HTTP client end-support-package fload ${BP}/ofw/wifi/wifi-cfg.fth @@ -507,7 +507,7 @@ ?start-sound ['] false to interrupt-auto-boot? probe-usb - " nand" $dev-update-flash +\ " nand" $dev-update-flash interpreter-init [ifndef] lx-devel enable-power-button

1 0

r555 - cpu/x86/pc/olpc
by svn＠openbios.org 16 Aug '07

16 Aug '07

Author: wmb Date: 2007-08-16 23:00:46 +0200 (Thu, 16 Aug 2007) New Revision: 555 Modified: cpu/x86/pc/olpc/crypto.fth Log: OLPC crypto - converted interface code to use the simplified version of the C code that just verifies one signature at a time. Modified: cpu/x86/pc/olpc/crypto.fth =================================================================== --- cpu/x86/pc/olpc/crypto.fth 2007-08-16 20:58:17 UTC (rev 554) +++ cpu/x86/pc/olpc/crypto.fth 2007-08-16 21:00:46 UTC (rev 555) @@ -4,6 +4,7 @@ h# c0000 constant crypto-base \ The address the code is linked to run at h# c0000 constant hasher-base \ The address the code is linked to run at +0 [if] variable hashlen d# 128 buffer: hashbuf @@ -17,9 +18,11 @@ hasher-base dup h# 10 - sp-call abort" Hash failed" drop 4drop ( ) hashbuf hashlen @ ; +[then] -h# f value which-hashes -: signature-bad? ( data$ sig$ -- mismatch? ) +0 value hashname +: signature-bad? ( data$ sig$ hashname$ -- mismatch? ) + $cstr to hashname ( data$ sig$ ) " crypto" find-drop-in 0= if 4drop true exit then ( data$ sig$ prog$ ) 2dup crypto-base swap move free-mem ( data$ sig$ ) @@ -28,7 +31,7 @@ swap 2swap swap ( siglen sigadr datalen dataadr r: key$ ) 2r@ swap 2swap ( siglen sigadr keylen keyadr datalen dataadr r: key$ ) - which-hashes + hashname ( siglen sigadr keylen keyadr datalen dataadr hash r: key$ ) crypto-base dup h# 10 - sp-call >r 3drop 4drop r> ( result r: key$ ) 2r> free-mem

1 0

r554 - cpu/x86/pc/olpc dev/olpc/cafenand
by svn＠openbios.org 16 Aug '07

16 Aug '07

Author: wmb Date: 2007-08-16 22:58:17 +0200 (Thu, 16 Aug 2007) New Revision: 554 Modified: cpu/x86/pc/olpc/nandstat.fth dev/olpc/cafenand/badblock.fth Log: Graphical copy-nand - fixed some stack bugs in the support routines. Modified: cpu/x86/pc/olpc/nandstat.fth =================================================================== --- cpu/x86/pc/olpc/nandstat.fth 2007-08-16 20:53:50 UTC (rev 553) +++ cpu/x86/pc/olpc/nandstat.fth 2007-08-16 20:58:17 UTC (rev 554) @@ -50,14 +50,14 @@ h# ff h# ff 0 rgb>565 ( #eblocks color ) 0 rot 0 ?do ( color eblock# ) dup nand-pages/block * " block-bad?" $call-nand 0= if ( color eblock# ) - 2dup swap show-state - 1 - else - 0 - then - swap 1+ swap - +loop - drop + 2dup swap show-state ( color eblock# ) + 1 ( color eblock# increment ) + else ( color eblock# ) + 0 ( color eblock# increment ) + then ( color eblock# increment ) + swap 1+ swap ( color eblock#' increment ) + +loop ( color eblock#' ) + 2drop ; : gshow-written ( eblock# -- ) 0 h# ff 0 rgb>565 show-state ; Modified: dev/olpc/cafenand/badblock.fth =================================================================== --- dev/olpc/cafenand/badblock.fth 2007-08-16 20:53:50 UTC (rev 553) +++ dev/olpc/cafenand/badblock.fth 2007-08-16 20:58:17 UTC (rev 554) @@ -307,8 +307,8 @@ i pages/eblock / over execute i erase-block then - pages/eblock +loop - exit + pages/eblock +loop ( 'show-bad 'show-erased ) + 2drop exit then ( 'show-bad 'show-erased ) \ If there is no existing bad block table, make one from factory info make-bbt

1 0

r553 - cpu/x86/pc/olpc
by svn＠openbios.org 16 Aug '07

16 Aug '07

Author: wmb Date: 2007-08-16 22:53:50 +0200 (Thu, 16 Aug 2007) New Revision: 553 Modified: cpu/x86/pc/olpc/resume.bth Log: OLPC resume - turned off "restore-usb-power", so the kernel is completely in charge of USB during suspend/resume. Modified: cpu/x86/pc/olpc/resume.bth =================================================================== --- cpu/x86/pc/olpc/resume.bth 2007-08-16 20:49:15 UTC (rev 552) +++ cpu/x86/pc/olpc/resume.bth 2007-08-16 20:53:50 UTC (rev 553) @@ -21,7 +21,7 @@ \ create save-display create reset-smbus -create restore-usb-power +\ create restore-usb-power h# fe00.0000 constant gp-pa h# fe00.4000 constant dc-pa

1 0

r552 - cpu/x86 cpu/x86/Linux cpu/x86/build forth/lib
by svn＠openbios.org 16 Aug '07

16 Aug '07

Author: wmb Date: 2007-08-16 22:49:15 +0200 (Thu, 16 Aug 2007) New Revision: 552 Modified: cpu/x86/Linux/catchexc.fth cpu/x86/build/builder.dic cpu/x86/cpubpsup.fth cpu/x86/disassem.fth cpu/x86/register.fth forth/lib/stringop.fth Log: Added support for exception handling and breakpointing under Linux. Modified: cpu/x86/Linux/catchexc.fth =================================================================== --- cpu/x86/Linux/catchexc.fth 2007-08-16 18:57:40 UTC (rev 551) +++ cpu/x86/Linux/catchexc.fth 2007-08-16 20:49:15 UTC (rev 552) @@ -3,7 +3,23 @@ decimal only forth also hidden also forth definitions +d# 64 constant #signals + +\ Ideally, we should determine /fpstate at runtime by searching +\ for the "retcode" signature 0077b858 +\ h# 264 constant /fpstate \ Determined empirically by dumping with gdb +h# 26c constant /fpstate \ Determined empirically by dumping with gdb + +\ retcode - 8 +\ extramask - 8 +\ fpstate - 264 +\ sigcontext - 58 +\ signal# - 4 +\ retaddr - 4 + : enterforth + \ Adjust pc if it has been incremented past the trap + int# 3 = if %eip 1- to %eip then handle-breakpoint ; @@ -19,7 +35,7 @@ \ Establish the Data and Return stacks 'user rp0 rp mov - 'user sp0 bx mov + 'user sp0 sp mov \ Restart the Forth interpreter. cld @@ -44,8 +60,8 @@ \ gs, fs, es, ds 00..0c \ edi, esi, ebp, esp, ebx, edx, ecx, eax 10..2c \ trapno, err, eip, cs 30..3c -\ esp_at_signal, ss, *fpstate, oldmask 40..4c -\ cr2 50 +\ eflags, esp_at_signal, ss, *fpstate 40..4c +\ oldmask, cr2 50..54 label save-state-signal @@ -56,29 +72,30 @@ 0 [dx] up mov \ Establish user pointer 'user cpu-state bx mov \ Base address of save area - 4 [sp] si lea \ Address of signal# + sp si mov \ Address of return address cld \ Increment pointers - ax lods ax offset-of int# [bx] mov + ax lods ax offset-of %esp2 [bx] mov + ax lods ax offset-of sig# [bx] mov - ax lods ax offset-of %gs [bx] mov - ax lods ax offset-of %fs [bx] mov - ax lods ax offset-of %es [bx] mov - ax lods ax offset-of %ds [bx] mov + ax lods ax offset-of %gs [bx] mov + ax lods ax offset-of %fs [bx] mov + ax lods ax offset-of %es [bx] mov + ax lods ax offset-of %ds [bx] mov - ax lods ax offset-of %edi [bx] mov - ax lods ax offset-of %esi [bx] mov - ax lods ax offset-of %ebp [bx] mov - ax lods ax offset-of %esp [bx] mov \ Correct ESP value will be set later - ax lods ax offset-of %ebx [bx] mov - ax lods ax offset-of %edx [bx] mov - ax lods ax offset-of %ecx [bx] mov - ax lods ax offset-of %eax [bx] mov + ax lods ax offset-of %edi [bx] mov + ax lods ax offset-of %esi [bx] mov + ax lods ax offset-of %ebp [bx] mov + ax lods ax offset-of %esp [bx] mov \ Correct ESP value will be set later + ax lods ax offset-of %ebx [bx] mov + ax lods ax offset-of %edx [bx] mov + ax lods ax offset-of %ecx [bx] mov + ax lods ax offset-of %eax [bx] mov - ax lods \ Skip trapno + ax lods ax offset-of int# [bx] mov \ trapno ax lods ax offset-of %error [bx] mov \ Save err - ax lods ax offset-of %eip [bx] mov + ax lods ax offset-of %eip [bx] mov \ Change the resume address to go to "reenter" make-odd \ word-align address @@ -90,6 +107,12 @@ ax lods ax offset-of %eflags [bx] mov ax lods \ Skip esp_at_signal ax lods ax offset-of %ss [bx] mov + ax lods \ Skip *fpstate + ax lods ax offset-of %esp1 [bx] mov \ Hijack esp1 for oldmask + ax lods ax offset-of %cr3 [bx] mov \ Hijack cr3 for cr2 + /fpstate # si add \ Skip fpstate + ax lods ax offset-of %ss0 [bx] mov \ Hijack ss0 for extramask0 + ax lods ax offset-of %ss1 [bx] mov \ Hijack ss1 for extramask1 ax ax xor ax dec ax offset-of %state-valid [bx] mov \ mark saved state as valid @@ -118,10 +141,82 @@ ret end-code +h# 400 buffer: restart-stack +0 value restart-sp +code (restart ( -- ) + \ Restore the Forth stacks. + + cld \ Increment pointers + up bx mov \ Save UP because it is di + + \ Data Stack + 'user pssave si mov \ Address of data stack save area + 'user sp0 di mov \ Top of data stack area + + ps-size # di sub \ Bottom of data stack area + ps-size 4 / # cx mov \ Size of data stack area (in longwords) + rep movs + + + \ Return Stack + bx up mov \ Restore UP for 'user + 'user rssave si mov \ Address of return stack save area + 'user rp0 di mov \ Top of return stack area + + rs-size # di sub \ Bottom of return stack area + rs-size 4 / # cx mov \ Size of return stack area (in longwords) + rep movs + + \ Restore registers + + bx up mov \ Restore UP for 'user + 'user cpu-state bx mov \ Base address of save area + + 'user restart-sp sp mov \ Establish a stack for the next steps + + h# 80cd0000 # push \ tail of retcode + h# 0077b858 # push \ retcode - ax pop d# 119 # ax mov h# 80 int + offset-of %ss1 [bx] push \ Actually extramask + offset-of %ss0 [bx] push + /fpstate # sp sub \ Space for fpstate + offset-of %cr3 [bx] push \ Actually cr2 + offset-of %esp1 [bx] push \ Actually oldmask + 0 # push \ *fpstate + offset-of %ss [bx] push \ ss + offset-of %esp [bx] push \ esp_at_signal + offset-of %eflags [bx] push + offset-of %cs [bx] push + offset-of %eip [bx] push + offset-of %error [bx] push + offset-of int# [bx] push \ Actually trapno + + offset-of %eax [bx] push + offset-of %ecx [bx] push + offset-of %edx [bx] push + offset-of %ebx [bx] push + offset-of %esp [bx] push + offset-of %ebp [bx] push + offset-of %esi [bx] push + offset-of %edi [bx] push + + offset-of %ds [bx] push + offset-of %es [bx] push + offset-of %fs [bx] push + offset-of %gs [bx] push + + offset-of sig# [bx] push + offset-of %esp2 [bx] push \ Actually return address + + ret + +end-code +' (restart is restart + + + hidden definitions -d# 65 constant #signals #signals /n* buffer: old-signals defer save-state @@ -179,13 +274,17 @@ ( 08 ) ," Floating point error or divide-by-0" ( 09 ) ," " ( 10 ) ," " -( 11 ) ," " +( 11 ) ," Segmentation fault" end-string-array : (.exception) ( -- ) - int# - dup d# 8 <= if exception-names ". cr exit then - push-decimal (u.) type cr pop-base + sig# 5 = if + int# 3 <> if ." Int 0x" .x then + exit + then + + sig# d# 11 <= if sig# exception-names ". cr exit then + push-decimal sig# (u.) type cr pop-base ; ' (.exception) is .exception : print-breakpoint @@ -199,7 +298,9 @@ hidden also : sys-init sys-init + restart-stack h# 400 + to restart-sp catch-signals + false to hardware-step? restartable? off ; only forth also definitions Modified: cpu/x86/build/builder.dic =================================================================== (Binary files differ) Modified: cpu/x86/cpubpsup.fth =================================================================== --- cpu/x86/cpubpsup.fth 2007-08-16 18:57:40 UTC (rev 551) +++ cpu/x86/cpubpsup.fth 2007-08-16 20:49:15 UTC (rev 552) @@ -50,12 +50,30 @@ then ( adr'' ) sizes r> + c@ + ( adr''' ) \ Add displacement ; + \ Looks for call instructions and figures out the length of their \ addressing mode bytes. Returns the address following those addressing \ mode bytes, or step-adr if the instruction is not a call or if following- \ jsrs is true. -: next-instruction ( following-jsrs? -- adr 0 ) - 0= if +true value hardware-step? \ True if the environment permits hardware single-step +: find-successors ( -- pc1 pc2 ) + hardware-step? if step-adr 0 exit then + + ['] cr behavior >r ['] type behavior >r + ['] noop to cr ['] 2drop to type + [ also disassembler ] %eip pc!dis1 pc @ branch-target @ [ previous ] + r> to type r> to cr +; + +: next-instruction ( following-jsrs? -- next-adr 0|branch_target ) + if + \ We are following jsrs, so we want the target address + \ of call instructions. + find-successors ( adr1 adr2 ) + else + \ We are not following jsrs, so we want the address right after + \ the instruction, not the address within the called subroutine. + %eip dup 1+ swap c@ ( %eip opcode ) case ( %eip+1 opcode ) h# 0cc of 0 exit endof \ INT 3 @@ -71,8 +89,8 @@ endof endcase ( %eip+1 ) drop ( ) - then ( ) - step-adr 0 + find-successors ( adr1 adr2 ) + then ( adr1 adr2 ) ; code goto ( adr -- ) @@ -84,7 +102,7 @@ true abort" loop-exit-adr is not implemented" ; -: bumppc ( -- ) 0 next-instruction to rpc ; +: bumppc ( -- ) 0 next-instruction drop to rpc ; only forth also definitions headers : set-pc ( adr -- ) dup to rpc ; Modified: cpu/x86/disassem.fth =================================================================== --- cpu/x86/disassem.fth 2007-08-16 18:57:40 UTC (rev 551) +++ cpu/x86/disassem.fth 2007-08-16 20:49:15 UTC (rev 552) @@ -14,6 +14,7 @@ nuser instruction variable end-found nuser pc +nuser branch-target nuser dis-offset : op8@ ( -- b ) pc @ dis-offset @ + c@ 1 pc +! ; @@ -185,8 +186,8 @@ ," s" ," ns" ," pe" ," po" ," l" ," ge" ," le" ," g" end-string-array -: jb ( -- ) op8@ bext pc @ + showaddr ; -: jv ( -- ) adv@ pc @ + showaddr ; +: jb ( -- ) op8@ bext pc @ + dup branch-target ! showaddr ; +: jv ( -- ) adv@ pc @ + dup branch-target ! showaddr ; : .jcc ( -- ) ." j" low4bits >cond ". op-col jb ; : ea,g ( -- ) get-ea .ea ., gb/v ; @@ -573,7 +574,7 @@ .op8 .op9 .opa .movi .opc .opd .ope .opf ; -: (dis-body) ( -- ) decode-op op-class ; +: (dis-body) ( -- ) branch-target off decode-op op-class ; ' (dis-body) is dis-body : dis1 ( -- ) ??cr Modified: cpu/x86/register.fth =================================================================== --- cpu/x86/register.fth 2007-08-16 18:57:40 UTC (rev 551) +++ cpu/x86/register.fth 2007-08-16 20:49:15 UTC (rev 552) @@ -63,7 +63,7 @@ \ State information needed by the firmware; not machine registers register watchdog register %state-valid register %restartable? -register %saved-my-self register last-trap# +register %saved-my-self register sig# \ Following words defined here to satisfy the \ references to these "variables" anywhere else Modified: forth/lib/stringop.fth =================================================================== --- forth/lib/stringop.fth 2007-08-16 18:57:40 UTC (rev 551) +++ forth/lib/stringop.fth 2007-08-16 20:49:15 UTC (rev 552) @@ -35,9 +35,9 @@ vocabulary macros : $set-macro ( value$ name$ -- ) - warning @ warning off + warning @ >r warning off also macros definitions $header create-cf previous definitions ( value$ ) - warning ! + r> warning ! ", does> ( -- adr len ) count ;

1 0

r551 - ofw/inetv6
by svn＠openbios.org 16 Aug '07

16 Aug '07

Author: lwalter Date: 2007-08-16 20:57:40 +0200 (Thu, 16 Aug 2007) New Revision: 551 Modified: ofw/inetv6/dns.fth Log: Fix dns IPv4/IPv6 resolution order Modified: ofw/inetv6/dns.fth =================================================================== --- ofw/inetv6/dns.fth 2007-08-16 18:54:10 UTC (rev 550) +++ ofw/inetv6/dns.fth 2007-08-16 18:57:40 UTC (rev 551) @@ -284,8 +284,8 @@ false value resolve-flag : resolvev4 ( hostname$ -- ) false to resolve-flag - 2dup ['] resolve-a catch if 2drop else true to resolve-flag set-dest-ip then - ['] resolve-aaaa catch if 2drop else true to resolve-flag then + 2dup ['] resolve-aaaa catch if 2drop else true to resolve-flag then + ['] resolve-a catch if 2drop else true to resolve-flag set-dest-ip then resolve-flag not abort" DNS: No answer" ;

1 0

r550 - forth/wrapper
by svn＠openbios.org 16 Aug '07

16 Aug '07

Author: wmb Date: 2007-08-16 20:54:10 +0200 (Thu, 16 Aug 2007) New Revision: 550 Modified: forth/wrapper/wrapper.c Log: wrapper.c - deleted support for obsolete systems - MAJC process and OSF1 OS. Modified: forth/wrapper/wrapper.c =================================================================== --- forth/wrapper/wrapper.c 2007-08-16 18:53:12 UTC (rev 549) +++ forth/wrapper/wrapper.c 2007-08-16 18:54:10 UTC (rev 550) @@ -174,12 +174,6 @@ char *host_cpu = "x86"; #endif -#ifdef OSF1 -char *host_os = "osf1"; -char *host_cpu = "alpha"; -#endif - - #ifdef TARGET_POWERPC char *target_cpu = "powerpc"; #ifndef LinuxPOWERPC @@ -202,12 +196,6 @@ #define START_OFFSET 0 #endif -#ifdef MAJC -char *target_cpu = "majc"; -#define CPU_MAGIC 0x03a00008 -#define START_OFFSET 0 -#endif - #ifdef ALPHA char *target_cpu = "alpha"; #define CPU_MAGIC 0xc3e00007 @@ -232,12 +220,7 @@ #include <errno.h> -/* Is OSF/1 the only build environment where a long is 64 bits? */ -#ifdef OSF1 -typedef int quadlet; -#else typedef long quadlet; -#endif #ifdef WIN32 #include <windows.h> @@ -291,17 +274,13 @@ extern void _sync_cache_range(char *, long); #endif -#ifdef OSF1 -#undef BSD -#endif - #ifdef UNIX INTERNAL void exit_handler(); -#ifdef BSD +# ifdef BSD INTERNAL void cont_handler(); INTERNAL void stop_handler(); +# endif #endif -#endif #ifdef WIN32 #define isatty _isatty @@ -395,7 +374,7 @@ #ifdef JTAG #include "jtag.h" #endif -#if defined (BSD) || defined(OSF1) || defined (LinuxX86) +#if defined (BSD) || defined (__linux__) INTERNAL long s_timeofday(); #endif #if defined(USE_TERMIOS) @@ -500,7 +479,7 @@ /* 268 .. 344 */ 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, #endif -#if defined(BSD) || defined(OSF1) || defined(LinuxX86) +#if defined(BSD) || defined(__linux__) /* 348 */ s_timeofday, #else @@ -781,10 +760,6 @@ char **argv, *envp; { char * loadaddr; -#ifdef LinuxX86 - unsigned char * pc; - unsigned char pcb; -#endif long f; long dictsize, extrasize, imagesize, memsize, relsize; int extrak; @@ -949,10 +924,6 @@ if (header.h_magic != CPU_MAGIC) { error("forth: Incorrect dictionary file header in ", dictfile); /* XXX */ printf("%x %x\n", CPU_MAGIC, header.h_magic); -#ifdef LinuxX86 -pc = (char *)&header.h_magic; -pcb = pc[0]; -#endif exit(1); } @@ -981,14 +952,7 @@ printf("Copyright 1994 FirmWorks All rights reserved\n"); # endif -# ifdef MAJC - /* The code wad must be aligned on a 64K boundary because of the - * way that call instructions work in MAJC */ - loadaddr = (char *)m_alloc(dictsize + 0x10020); - loadaddr = (char *)(((((int)loadaddr + 0x10020)) & ~0xffff) - 0x20); -# else loadaddr = (char *)m_alloc(dictsize); -# endif if ((loadaddr == (char *) -1) || (loadaddr == (char *) 0)) { error("forth: Can't get memory",""); exit(1); @@ -1015,7 +979,6 @@ keymode(); -#ifdef MAJC #ifdef UNIX signal(SIGHUP,exit_handler); signal(SIGINT,exit_handler); @@ -1025,28 +988,21 @@ signal(SIGFPE,exit_handler); signal(SIGBUS,exit_handler); signal(SIGSEGV,exit_handler); -#ifndef __linux__ +# ifndef __linux__ signal(SIGEMT,exit_handler); signal(SIGSYS,exit_handler); -#endif -#ifdef BSD +# endif +# ifdef BSD signal(SIGCONT,cont_handler); signal(SIGTSTP,stop_handler); +# endif #endif -#endif -#endif /* * Call the Forth interpreter as a subroutine. If it returns, * exit with its return value as the status code. */ -#ifdef MAJC - s_bye((*(long (*) ())(loadaddr+sizeof(header)+START_OFFSET)) - (loadaddr, functions, ((long)loadaddr+dictsize - 16) & ~15, - argc, argv)); -#endif - #ifdef PPCSIM simulate(0L, loadaddr+sizeof(header)+START_OFFSET, loadaddr, functions, ((long)loadaddr+dictsize - 16) & ~15, @@ -1168,6 +1124,9 @@ exit_handler(sig) int sig; { + printf("Mama\n"); + while (1) ; + #ifdef HAVE_PSIGNAL psignal(sig, "forth"); #else @@ -1237,14 +1196,6 @@ int nchars = 0; fflush(stdout); -#ifdef MAJC - if ( (nchars = stdin->_r) == 0 ) { - keyqmode(); - nchars = read(0, &c, 1) > 0; - if (nchars) - ungetc(c[0], stdin); - } -#else # ifdef UNIX # ifdef SYS5 # ifdef __linux__ @@ -1273,7 +1224,6 @@ # endif #endif return ((long)nchars); -#endif } /* @@ -1408,40 +1358,45 @@ initline() { if (lmode != M_ORIG) return; -#ifndef MAJC #ifdef USE_TERMIOS tcgetattr(0, &ostate); /* save old state */ tcgetattr(0, &lstate); /* base of line state */ lstate.c_iflag |= IXON|IXANY|IXOFF; /* XON/XOFF */ lstate.c_iflag |= ICRNL; /* CR/NL munging */ -#ifdef IUCLC + +# ifdef IUCLC lstate.c_iflag &= ~(IUCLC); /* no case folding */ -#endif -#ifndef AIX +# endif + +# ifndef AIX lstate.c_oflag |= OPOST|ONLCR; /* Map NL to CR-LF */ -#ifdef ILCUC +# ifdef ILCUC lstate.c_oflag &= ~(OLCUC); /* No case folding */ -#endif +# endif lstate.c_oflag &= ~(OCRNL|ONLRET); /* Don't swap cr and lf */ -#endif +# endif + lstate.c_lflag |= ICANON|ECHO; /* Line editing on */ lstate.c_cc[VMIN] = 1; /* Don't hold up input */ lstate.c_cc[VTIME] = 0; /* No input delay */ tcgetattr(0, &kstate); /* base of key state */ kstate.c_iflag &= ~(IXON|IXANY|IXOFF); /* no XON/XOFF */ -#ifdef IUCLC + +# ifdef IUCLC kstate.c_iflag &= ~(IUCLC); /* no case folding */ -#endif -#ifndef AIX +# endif + +# ifndef AIX kstate.c_iflag &= ~(INLCR|ICRNL); /* no CR/NL munging */ kstate.c_oflag |= OPOST|ONLCR; /* Map NL to CR-LF */ -#ifdef OLCUC +# ifdef OLCUC kstate.c_oflag &= ~(OLCUC); /* No case folding */ -#endif +# endif kstate.c_oflag &= ~(OCRNL|ONLRET); /* Don't swap cr and lf */ -#endif +# endif + kstate.c_lflag &= ~(ICANON|ECHO); /* No editing characters */ kstate.c_cc[VMIN] = 1; /* Don't hold up input */ kstate.c_cc[VTIME] = 0; /* No input delay */ @@ -1449,6 +1404,7 @@ kqstate = kstate; kqstate.c_cc[VMIN] = 0; /* Poll for character */ #endif + #ifdef USE_STTY ioctl(0, TIOCGETP, &ostate); /* save old state */ @@ -1460,27 +1416,6 @@ kstate.sg_flags |= CBREAK; /* Wake up on each char */ kstate.sg_flags &= ~ECHO; /* Don't echo */ #endif -#else -#ifdef notnow - tcgetattr(0, &ostate); /* save old state */ - tcgetattr(0, &lstate); /* base of line state */ - lstate.c_iflag |= IXON|IXOFF; /* XON/XOFF */ - lstate.c_iflag |= ICRNL; /* CR/NL munging */ - lstate.c_oflag |= OPOST; /* */ - lstate.c_lflag |= ICANON|ECHO; /* Line editing on */ - lstate.c_cc[VMIN] = 1; /* Don't hold up input */ - lstate.c_cc[VTIME] = 0; /* No input delay */ - tcgetattr(0, &kstate); /* base of key state */ - kstate.c_iflag &= ~(IXON|IXOFF); /* no XON/XOFF */ - kstate.c_iflag &= ~(INLCR|ICRNL); /* no CR/NL munging */ - kstate.c_oflag |= OPOST; /* */ - kstate.c_lflag &= ~(ICANON|ECHO); /* No editing characters */ - kstate.c_cc[VMIN] = 1; /* Don't hold up input */ - kstate.c_cc[VTIME] = 0; /* No input delay */ - kqstate = kstate; - kqstate.c_cc[VMIN] = 0; /* Poll for character */ -#endif -#endif } INTERNAL linemode() @@ -1513,18 +1448,7 @@ } #endif -#ifdef MAJC INTERNAL void -keyqmode() -{ - initline(); - if (lmode != M_KEYQ) { - lmode = M_KEYQ; - } -} -#endif - -INTERNAL void keymode() { initline(); @@ -1876,9 +1800,6 @@ f_mkdir(name) char *name; { -#ifdef MAJC - return(-1); -#else #ifdef DEMON return(-1); /* XXX fixme */ #else @@ -1888,22 +1809,17 @@ #endif )); #endif -#endif } INTERNAL long f_rmdir(name) char *name; { -#ifdef MAJC - return(-1); -#else #ifdef DEMON return(-1); /* XXX fixme */ #else return((long)rmdir(expand_name(name))); #endif -#endif } INTERNAL long @@ -1981,12 +1897,8 @@ char *buf; { #ifdef UNIX -#ifndef MAJC return((long)ioctl((int)fd, (int)code, buf)); #else - return(0); -#endif -#else return((long)-1); #endif } @@ -2029,7 +1941,6 @@ s_system(str) char *str; { -#ifndef MAJC int i; char *cmd; @@ -2048,7 +1959,6 @@ keymode(); return ((long)i); -#endif } /* @@ -2274,10 +2184,7 @@ INTERNAL long timez() { -#ifdef MAJC - return(0); -#endif -#if defined(BSD) || defined(OSF1) +#if defined(BSD) static struct timeval t; static struct timezone tz; extern int gettimeofday(); @@ -2304,7 +2211,7 @@ #endif } -#if defined(BSD) || defined(OSF1) || defined(LinuxX86) +#if defined(BSD) || defined(__linux__) INTERNAL long s_timeofday() {

1 0

r549 - cpu/x86 ofw/tokenizer
by svn＠openbios.org 16 Aug '07

16 Aug '07

Author: wmb Date: 2007-08-16 20:53:12 +0200 (Thu, 16 Aug 2007) New Revision: 549 Modified: cpu/x86/builder.bth ofw/tokenizer/tokenize.fth Log: Deleted a couple more vestiges of the pstr format, thus completing (I hope) the job begun by r521. Modified: cpu/x86/builder.bth =================================================================== --- cpu/x86/builder.bth 2007-08-15 22:59:54 UTC (rev 548) +++ cpu/x86/builder.bth 2007-08-16 18:53:12 UTC (rev 549) @@ -7,4 +7,4 @@ fload ${BP}/ofw/tokenizer/tokenize.fth \ Tokenizer fload ${BP}/forth/lib/builder.fth \ Builder -.( --- Saving builder.dic --- ) "" builder.dic save-forth cr +.( --- Saving builder.dic --- ) " builder.dic" $save-forth cr Modified: ofw/tokenizer/tokenize.fth =================================================================== --- ofw/tokenizer/tokenize.fth 2007-08-15 22:59:54 UTC (rev 548) +++ ofw/tokenizer/tokenize.fth 2007-08-16 18:53:12 UTC (rev 549) @@ -1226,7 +1226,7 @@ init-vars init-path - save$3 new-file ( ) + save$3 count $new-file ( ) aout-header? @ if write-header then ( ) \ Save the current stack depth

1 0

r548 - ofw/inetv6
by svn＠openbios.org 16 Aug '07

16 Aug '07

Author: lwalter Date: 2007-08-16 00:59:54 +0200 (Thu, 16 Aug 2007) New Revision: 548 Added: ofw/inetv6/dhcpv6.fth Modified: ofw/inetv6/dns.fth ofw/inetv6/dnsv6.fth ofw/inetv6/ethernet.fth ofw/inetv6/icmpinfo.fth ofw/inetv6/loadpkg.fth ofw/inetv6/neighdis.fth ofw/inetv6/tcpv6.fth Log: Fix a couple of page fault bugs; Add IPv6 DNS support using tubes.laptop.org Added: ofw/inetv6/dhcpv6.fth =================================================================== --- ofw/inetv6/dhcpv6.fth (rev 0) +++ ofw/inetv6/dhcpv6.fth 2007-08-15 22:59:54 UTC (rev 548) @@ -0,0 +1,60 @@ +\ See license at end of file +purpose: Dynamic Host Configuration Protocol for IPv6 (DHCPv6) (RFC 3315) + +[ifndef] include-ipv4 +d# 256 buffer: 'root-path +d# 256 buffer: 'client-name +d# 256 buffer: 'vendor-options +headers +' 'client-name " client-name" chosen-string +' 'vendor-options " vendor-options" chosen-string +' 'root-path " root-path" chosen-string +: domain-name ( -- adr len ) 'domain-name cscount ; +[then] + +\ tubes.laptop.org +create default-name-server-ipv6 h# 20 c, 1 c, h# 48 c, h# 30 c, h# 24 c, h# 46 c, h# ff c, 0 c, 0 l, 0 w, 0 c, 1 c, + +: init-dhcpv6 ( -- ) +[ifndef] include-ipv4 + 0 'domain-name c! + 0 'root-path c! + 0 'client-name c! + 0 'vendor-options c! +\ 0 file-name-buf c! +[then] + default-name-server-ipv6 name-server-ipv6 copy-ipv6-addr +; + +also forth definitions +stand-init: DHCPv6 init + init-dhcpv6 +; +previous definitions + +: do-dhcp ( -- ) +; + +\ LICENSE_BEGIN +\ Copyright (c) 2007 FirmWorks +\ +\ Permission is hereby granted, free of charge, to any person obtaining +\ a copy of this software and associated documentation files (the +\ "Software"), to deal in the Software without restriction, including +\ without limitation the rights to use, copy, modify, merge, publish, +\ distribute, sublicense, and/or sell copies of the Software, and to +\ permit persons to whom the Software is furnished to do so, subject to +\ the following conditions: +\ +\ The above copyright notice and this permission notice shall be +\ included in all copies or substantial portions of the Software. +\ +\ THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, +\ EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF +\ MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND +\ NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE +\ LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION +\ OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION +\ WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. +\ +\ LICENSE_END Modified: ofw/inetv6/dns.fth =================================================================== --- ofw/inetv6/dns.fth 2007-08-15 20:20:01 UTC (rev 547) +++ ofw/inetv6/dns.fth 2007-08-15 22:59:54 UTC (rev 548) @@ -244,6 +244,7 @@ [ifdef] include-ipv6 : resolve-aaaa ( hostname$ -- ) + his-ipv6-addr unknown-ipv6-addr? not if 2drop exit then bootnet-debug if ( hostname$ ) ." Using DNS AAAA to find the IPv6 address of " ( hostname$ ) 2dup type cr ( hostname$ ) Modified: ofw/inetv6/dnsv6.fth =================================================================== --- ofw/inetv6/dnsv6.fth 2007-08-15 20:20:01 UTC (rev 547) +++ ofw/inetv6/dnsv6.fth 2007-08-15 22:59:54 UTC (rev 548) @@ -3,38 +3,276 @@ headerless +[ifndef] include-ipv4 +\ struct ( dns header ) +\ /w field >id \ 0 - Number to match questions with answers +\ /w field >dns-flags \ 2 - q/a:8000 opcode:780 aa:40 tc:20 rd:10 ra:8 rc:f +\ /w field >qdcount \ 4 - number of following questions +\ /w field >anscount \ 6 - number of following answer RRs +\ /w field >nscount \ 8 - number of following name server RRs +\ /w field >arccount \ a - number of following additional RRs +\ constant /dns-header + +\ DNS question format: QNAME-variable_length, QTYPE(/w), QCLASS(/w) +\ QTYPE value for "A" (host name) is 1 +\ QTYPE value for "AAAA" (IPv6 hostname) is h# 1c +\ QCLASS value for "IN" (Internet) is 1 + +\ d# 1022 value fw-port# \ It's been assigned by IANA. +h# 800a constant fw-port# \ It's unassigned as of 8/13/2007. + +d# 2000 constant dns-timeout + +2 value #retries-a +2 value #retries-aaaa + +0 value qtype +1 constant qclass + +\ Encode/decode various DNS data types +: +dnsw ( w -- ) wbsplit +xb +xb ; +: -dnsw ( -- w ) -xb -xb swap bwjoin ; +: -dnsl ( -- l ) -dnsw -dnsw swap wljoin ; + +\ A label is a dot-less component of a dotted name. In DNS packets, +\ a label is represented as a length byte followed by the bytes of the string. +: +dns-label ( adr len -- ) dup +xb bounds ?do i c@ +xb loop ; + +\ A name is a full domain name consisting of one or more labels sepearate +\ by dots. In DNS packets, the dots are not included. +: +dns-name ( adr len -- ) + begin dup while + [char] . left-parse-string + +dns-label + repeat + 2drop + 0 +xb +; +: -dnsbytes ( len -- adr len ) + dup x$ over >r ( len len adr rem-len r: adr ) + rot /string to x$ ( len r: adr ) + r> swap ( adr len ) +; + +: +np ( adr len byte -- ) >r 2dup + r> swap c! 1+ ; + +defer -dns-tail \ Forward reference for mutual recursion + +0 instance value dns-header \ Pointer to beginning of DNS header + +\ Handle a compressed name tail, which is represented by a 2-byte +\ offset from the beginning of the DNS header to the beginning of a +\ previous uncompressed copy of the name tail. +: do-ptr ( adr len ptr-offset -- adr len' ) + h# c0 invert and -xb swap bwjoin dns-header + d# 255 ( adr len ) + x$ 2>r to x$ + -dns-tail + 2r> to x$ +; + +\ Handle the next name component, which is either: +\ a) The end of the name, represented by a 0 byte +\ b) A label, represented by a length byte (0-31) followed by the string +\ c) A pointer, represented by pair of bytes "11oooooo oooooooo", where +\ oooooo oooooooo is a 14-bit offset (see do-ptr) +: -component ( adr len -- adr len' end? ) + -xb ?dup 0= if true exit then + dup h# c0 and case + h# c0 of do-ptr true endof + h# 00 of -dnsbytes bounds ?do i c@ +np loop false endof + \ the 80 and 40 cases are reserved + ( default ) ." Unknown DNS label code" cr true swap + endcase +; + +\ Copy the tail of a DNS name from the DNS packet to the buffer adr,len +: (-dns-tail) ( adr len -- adr len' ) + -component if exit then + begin [char] . +np -component until +; +' (-dns-tail) to -dns-tail + +\ Extract a domain name from the DNS packet into a local buffer +d# 256 buffer: dns-name-buf +: -dns-name ( -- adr len ) dns-name-buf 0 -dns-tail ; + +\ Add the host name to the packet and tack on the domain name +\ if it's not already there +: +dns-host ( adr len -- ) + [char] . split-string ( head$ tail$ ) + dup if \ Already fully-qualified ( head$ tail$ ) + nip + +dns-name ( ) + else \ No domain name ( head$ tail$ ) + 2drop +dns-label ( ) + domain-name +dns-name ( ) + then ( ) +; + +d# 512 constant /dns-query +d# 53 constant dns-port# +0 instance value dns-xid + +\ Send a DNS question asking for the IP address for the indicated host +: send-dns-query ( hostname$ -- ) + /dns-query allocate-udp >r + r@ start-encode + next-xid lwsplit drop to dns-xid \ DNS transaction IDs are 16 bits + \ Flags=100 means standard query, recursion desired (100) + \ ID flags #questions #answers #namesrvrs #additional + dns-xid +dnsw h# 100 +dnsw 1 +dnsw 0 +dnsw 0 +dnsw 0 +dnsw + +dns-host + qtype +dnsw qclass +dnsw + x$ fw-port# dns-port# send-udp-packet + r> /dns-query free-udp +; +defer handle-dns-call ' noop is handle-dns-call + +: unexpected-xid ( -- ) + bootnet-debug if + ." (Discarding DNS reply with mismatched transaction ID)" cr + then +; + +\ Receive a DNS reply, filtering out stuff that's not for us +: receive-dns-reply ( xid his-port# my-port# -- error? ) + begin + begin + \ Filter out other destination ports + dup receive-udp-packet if ( xid his mine ) \ Timeout + ." Timeout waiting for DNS reply" cr + 3drop true exit + then ( xid his mine adr len actual-port# ) + \ Filter out other source ports + 4 pick <> while ( xid his mine adr len ) + 2drop ( xid his mine ) + repeat ( xid his mine adr len ) + + over to dns-header ( xid his mine ) + start-decode ( xid his mine ) + + \ Filter out other transaction IDs + 2 pick -dnsw <> if ( xid his mine ) + unexpected-xid false ( xid his mine flag ) + else ( xid his mine ) + \ Filter out DNS calls + -dnsw h# 8000 and 0= if ( xid his mine ) + handle-dns-call false ( xid his mine false ) + else ( xid his mine ) + true ( xid his mine true ) + then ( xid his mine done? ) + then ( xid his mine done? ) + until ( xid his mine ) + 3drop false ( false ) +; + +\ Decode/extract a DNS question section from the DNS packet +: -dns-question ( -- name$ type class ) -dns-name -dnsw -dnsw ; + +\ Discard TTL +: -data ( -- ) -dnsw -dnsbytes 2drop ; +: parse-answer ( -- false | 'ip true ) + -dns-name 2drop + + -dnsw -dnsw wljoin ( class.type ) + -dnsl drop ( class.type ) \ Discard TTL + qtype qclass wljoin = if ( ) + -dnsw drop \ Discard RDLENGTH (it better be 4!) + x$ drop true ( 'ip true ) + else ( ) + -dnsw ( datalen ) + -dnsbytes 2drop false ( false ) + then +; + +\ Decode the reply to a DNS "get IP address for host name" query. +: get-host-addr ( -- 'ip ) + \ Decoder is pointing at the QDCOUNT field + + -dnsw -dnsw ( #questions #answers ) + -dnsw drop -dnsw drop \ Discard NSCOUNT and ARCOUNT + + \ Discard echoed questions + swap 0 ?do -dns-question 2drop 2drop loop ( #answers ) + + 0 ?do parse-answer if unloop exit then loop ( ) + 4 throw +; + +headers +\ Return in the buffer 'ip the IP address address for named host. +\ The host name can be either a simple name (e.g. "pi") or a +\ fully-qualified domain name (e.g. "pi.firmworks.com"). +: try-resolve ( hostname$ -- 'ip ) + dns-timeout set-timeout ( hostname$ ) + send-dns-query ( ) + dns-xid dns-port# fw-port# receive-dns-reply ( error? ) + 1 and throw ( ) + get-host-addr ( answer-ip ) +; +[then] + +headerless + /ipv6 buffer: ipv6-buf [ifndef] include-ipv4 : $>ip ( hostname$ -- 'ip ) .ipv4-not-supported ; : resolvev4 ( hostname$ -- ) .ipv4-not-supported ; +: (set-dest-ip) ( buf -- ) .ipv4-not-supported ; : set-dest-ip ( buf -- ) .ipv4-not-supported ; : ?bad-ip ( flag -- ) abort" Bad host name or address" ; [then] : resolvev6 ( hostname$ -- ) + bootnet-debug if ( hostname$ ) + ." Using IPv6 DNS to find the IPv6 address of " ( hostname$ ) + 2dup type cr ( hostname$ ) + then + true to use-ipv6? - unknown-ipv6-addr his-ipv6-addr copy-ipv6-addr - abort" IPv6 DNS not supported yet" + h# 1c to qtype + name-server-ipv6 set-dest-ipv6 + 2dup ['] try-resolve catch ?dup if ( hostname$ x x err ) + nip nip ( hostname$ err ) + 1 <> if ( hostname$ ) + bootnet-debug if + indent ." Unknown IPv6 hostname: " 2dup type cr + then + true abort" Unknown IPv6 hostname" + then + else + bootnet-debug if + indent ." Got IPv6 address " dup .ipv6 cr + then + set-dest-ipv6 + 2drop exit + then + + bootnet-debug if indent ." No answer to IPv6 DNS request" cr then + true abort" IPv6 DNS: No answer" ; headers -\ XXX Try (resolve) or (resolve6) first. If fail, try the other one. -: (resolve) ( hostname$ -- ) +: resolve ( hostname$ -- ) 2dup ['] resolvev6 catch if 2drop + unknown-ipv6-addr his-ipv6-addr copy-ipv6-addr + then + use-ipv6-ok? not if \ IPv6 DNS fail, try DNS false to use-ipv6? resolvev4 else 2drop then - use-ipv6-ok? dup to use-ipv6? if \ Make sure all the addresses are set properly + use-ipv6-ok? dup to use-ipv6? if \ Make sure all the addresses are set properly his-ipv6-addr (set-dest-ipv6) bootnet-debug if ." Use IPv6 protocol" cr then else +[ifdef] include-ipv4 his-ip-addr (set-dest-ip) bootnet-debug if ." Use IP protocol" cr then +[then] then ; @@ -42,7 +280,7 @@ dup 0= ?bad-ip 2dup ['] $>ip catch if 2drop else false to use-ipv6? set-dest-ip 2drop exit then 2dup ipv6-buf ['] $ipv6# catch if - 3drop (resolve) + 3drop resolve else 2drop true to use-ipv6? ipv6-buf set-dest-ipv6 Modified: ofw/inetv6/ethernet.fth =================================================================== --- ofw/inetv6/ethernet.fth 2007-08-15 20:20:01 UTC (rev 547) +++ ofw/inetv6/ethernet.fth 2007-08-15 22:59:54 UTC (rev 548) @@ -53,6 +53,12 @@ create broadcast-en-addr h# ff c, h# ff c, h# ff c, h# ff c, h# ff c, h# ff c, : unknown-en-addr? ( 'en -- flag ) dup l@ 0= swap w@ 0= and ; +: known-en-addr? ( 'en -- flag ) + >r + r@ unknown-en-addr? + r@ broadcast-en-addr en= or + r@ c@ h# 33 = r> 1+ c@ h# 33 = and or not +; decimal @@ -119,7 +125,9 @@ th 86dd constant IPV6_TYPE hex -: ip-type? ( type -- ip-type? ) dup IP_TYPE = swap IPV6_TYPE = or ; +: ip-type? ( type -- ip-type? ) + use-ipv6? if IPV6_TYPE else IP_TYPE then = +; : eth-type=? ( type -- flag ) eth-type ip-type? if ip-type? else eth-type = then Modified: ofw/inetv6/icmpinfo.fth =================================================================== --- ofw/inetv6/icmpinfo.fth 2007-08-15 20:20:01 UTC (rev 547) +++ ofw/inetv6/icmpinfo.fth 2007-08-15 22:59:54 UTC (rev 548) @@ -9,7 +9,10 @@ \ ****************** Neighbor Discovery and Autoconfiguration ****************** : handle-router-sol ( adr len -- ) 2drop ; \ Router solicitation -: handle-router-ad ( adr len -- ) 2drop ; \ Router advertisement +: handle-router-ad ( adr len -- ) \ Router advertisement + bootnet-debug if ." Router advertisement" cr then + 2drop +; : send-router-sol ( -- ) 8 allocate-icmpv6 set-struct \ Option: source link-layer addr @@ -53,7 +56,7 @@ ( 'ip ) icmp-data copy-ipv6-addr h# 201 icmp-data /ipv6 + xw! \ Option type 2 (target mac addr) \ Length (in 8 octels) - my-en-addr icmp-data /ipv6 + 2 + copy-ipv6-addr + my-en-addr icmp-data /ipv6 + 2 + copy-en-addr hop-limit >r h# ff to hop-limit \ Save and change hop-limit the-struct d# 24 2dup send-icmpv6-packet @@ -61,6 +64,7 @@ r> to hop-limit \ Restore hop-limit ; +/e buffer: his-en-addr-save /ipv6 buffer: his-ipv6-addr-save /ipv6 buffer: my-ipv6-addr-save : handle-neigh-sol ( adr len -- ) \ Neighbor solicitation @@ -74,21 +78,29 @@ 2drop exit then - \ XXX Send Neighbor Advertisement + \ Send Neighbor Advertisement drop ( adr ) - his-ipv6-addr his-ipv6-addr-save copy-ipv6-addr \ Save his-ipv6-addr + his-ipv6-addr his-ipv6-addr-save copy-ipv6-addr \ Save his-*-addr my-ipv6-addr my-ipv6-addr-save copy-ipv6-addr + his-en-addr his-en-addr-save copy-en-addr ipv6-dest-addr c@ dup h# ff = swap h# fe = or if my-ipv6-addr-link-local else my-ipv6-addr-global then my-ipv6-addr copy-ipv6-addr - ipv6-source-addr his-ipv6-addr copy-ipv6-addr \ Use the solicitor's IPv6 addr as dst + ipv6-source-addr his-ipv6-addr copy-ipv6-addr \ Use solicitor's IPv6 addr as dst + dup /icmp-header + /ipv6 + 2 + his-en-addr copy-en-addr \ Use solicitor's mac addr as dst /icmp-header + true send-neigh-ad - his-ipv6-addr-save his-ipv6-addr copy-ipv6-addr \ Restore his-ipv6-addr + his-ipv6-addr-save his-ipv6-addr copy-ipv6-addr \ Restore his-*-addr my-ipv6-addr-save my-ipv6-addr copy-ipv6-addr + his-en-addr-save his-en-addr copy-en-addr ; -: handle-neigh-ad ( adr len -- ) 2drop ; \ Neighbor advertisement +: handle-neigh-ad ( adr len -- ) \ Neighbor advertisement + bootnet-debug if + ." Neighbor advertisement from MAC: " over d# 26 + .enaddr cr + then + 2drop +; : handle-inv-neigh-sol ( adr len -- ) 2drop ; \ Inverse neighbor discovery solicitation : handle-inv-neigh-ad ( adr len -- ) 2drop ; \ Inverse neighbor discovery advertisement Modified: ofw/inetv6/loadpkg.fth =================================================================== --- ofw/inetv6/loadpkg.fth 2007-08-15 20:20:01 UTC (rev 547) +++ ofw/inetv6/loadpkg.fth 2007-08-15 22:59:54 UTC (rev 548) @@ -43,7 +43,7 @@ [then] [ifdef] include-ipv6 \ fload ${BP}/ofw/inetv6/bootpv6.fth \ Bootp Protocol -\ fload ${BP}/ofw/inetv6/dhcpv6.fth \ Dynamic Host Config. Protocol +fload ${BP}/ofw/inetv6/dhcpv6.fth \ Dynamic Host Config. Protocol fload ${BP}/ofw/inetv6/tftp.fth \ Trivial File Transfer Protocol fload ${BP}/ofw/inetv6/netloadv6.fth \ Network boot loading package fload ${BP}/ofw/inetv6/neighdis.fth \ Neighbor discovery Modified: ofw/inetv6/neighdis.fth =================================================================== --- ofw/inetv6/neighdis.fth 2007-08-15 20:20:01 UTC (rev 547) +++ ofw/inetv6/neighdis.fth 2007-08-15 22:59:54 UTC (rev 548) @@ -57,7 +57,7 @@ else ( ip-type 'ip-adr ) his-ip-addr copy-ip-addr ( ip-type ) his-ip-addr my-ip-addr ip-prefix=? if - his-en-addr broadcast-en-addr en= if do-arp then ( ip-type ) + his-en-addr known-en-addr? not if unlock-link-addr do-arp then ( ip-type ) else router-en-addr his-en-addr copy-en-addr then @@ -130,14 +130,14 @@ repeat 2drop ; : process-rd? ( adr len -- router-ad? ) - over c@ d# 134 <> if drop false exit then \ Router advertisement? + over c@ d# 134 <> if 2drop false exit then \ Router advertisement? over 4 + c@ to router-hop-limit - over 5 + c@ to router-flags \ XXX What to do with stateful config? + over 5 + c@ to router-flags \ XXX What to do with stateful config? over 6 + be-w@ to router-lifetime over 8 + be-l@ to router-reachable-time over d# 12 + be-l@ to router-retrans-time - d# 16 /string ( opt-adr,len ) - process-rd-options ( ) + d# 16 /string ( opt-adr,len ) + process-rd-options ( ) true ; : auto-cfg-global? ( -- flag ) @@ -222,10 +222,10 @@ [then] true to use-ipv6? set-mc-hash if close false exit then + ['] (resolve-en-addrv6) to resolve-en-addr configure-ipv6 s-all-ipv6 setup-ip-attr - ['] (resolve-en-addrv6) to resolve-en-addr true ; Modified: ofw/inetv6/tcpv6.fth =================================================================== --- ofw/inetv6/tcpv6.fth 2007-08-15 20:20:01 UTC (rev 547) +++ ofw/inetv6/tcpv6.fth 2007-08-15 22:59:54 UTC (rev 548) @@ -2008,7 +2008,6 @@ ; : free-buffersv6 ( -- ) - free-buffers wbufv6-start /wbufv6 free-mem xmit_bufv6 /xmit-max " free-ipv6" $call-parent ; @@ -2430,9 +2429,6 @@ : open ( -- ) alloc-buffersv6 -[ifdef] open - open -[else] parse-args alloc-buffers @@ -2451,7 +2447,6 @@ true to alive? true -[then] ; [ifndef] include-ipv4 @@ -2494,10 +2489,9 @@ \ to make its way through the sequence of termination states. : disconnectv6 ( -- ) usrclosed - flush-writes flush-writesv6 alive? if tcp_outputv6 then - use-ipv6? if drainv6 else drain then + drainv6 alive? if tcp_close then ; @@ -2505,16 +2499,14 @@ \ external : set-nodelay ( -- ) nodelay set-flag ; : abort-on-reconnect ( -- ) true to abort-on-reconnect? ; +: disconnect ( -- ) ; [then] : close ( -- ) - disconnectv6 -[ifdef] close - close -[else] + use-ipv6? if disconnectv6 else disconnect then ['] delack-tick 0 alarm ['] protocol-tick 0 alarm -[then] + free-buffers free-buffersv6 ;

1 0

r547 - in cpu/x86: . Linux
by svn＠openbios.org 15 Aug '07

15 Aug '07

Author: wmb Date: 2007-08-15 22:20:01 +0200 (Wed, 15 Aug 2007) New Revision: 547 Added: cpu/x86/Linux/catchexc.fth Modified: cpu/x86/loadmach.fth Log: Added signal handling to the x86 Linux-hosted Forth. Added: cpu/x86/Linux/catchexc.fth =================================================================== --- cpu/x86/Linux/catchexc.fth (rev 0) +++ cpu/x86/Linux/catchexc.fth 2007-08-15 20:20:01 UTC (rev 547) @@ -0,0 +1,229 @@ +\ See license at end of file + +decimal + +only forth also hidden also forth definitions +: enterforth + handle-breakpoint +; + +label reenter + \ We get here from then end of save-state, either by branching directly + \ or by modifying the return address in the DPMI exception frame. + + make-odd \ word-align address + 'body main-task dup # dx mov + -4 allot token, \ rewrite address as relocatable + + 0 [dx] up mov \ Establish user pointer + + \ Establish the Data and Return stacks + 'user rp0 rp mov + 'user sp0 bx mov + + \ Restart the Forth interpreter. + cld + + \ Execute enterforth +\ 'body enterforth #) ip lea + make-even \ word-align for relocation + 'body enterforth dup #) ip lea + -4 allot token, \ rewrite address as relocatable +c; + +\ This is the signal handler. When it is called, the stack contains: +\ +\ struct sigcontext ( See /usr/include/asm/sigcontext.h ) +\ signal number +\ return address +\ +\ We copy the data from sigcontext and fiddle the EIP value in sigcontext +\ so that Forth is re-entered at the enterforth addresss + +\ For reference, sigcontext contains: +\ gs, fs, es, ds 00..0c +\ edi, esi, ebp, esp, ebx, edx, ecx, eax 10..2c +\ trapno, err, eip, cs 30..3c +\ esp_at_signal, ss, *fpstate, oldmask 40..4c +\ cr2 50 + +label save-state-signal + + make-odd \ word-align address + 'body main-task dup # dx mov + -4 allot token, \ rewrite address as relocatable + + 0 [dx] up mov \ Establish user pointer + 'user cpu-state bx mov \ Base address of save area + + 4 [sp] si lea \ Address of signal# + + cld \ Increment pointers + ax lods ax offset-of int# [bx] mov + + ax lods ax offset-of %gs [bx] mov + ax lods ax offset-of %fs [bx] mov + ax lods ax offset-of %es [bx] mov + ax lods ax offset-of %ds [bx] mov + + ax lods ax offset-of %edi [bx] mov + ax lods ax offset-of %esi [bx] mov + ax lods ax offset-of %ebp [bx] mov + ax lods ax offset-of %esp [bx] mov \ Correct ESP value will be set later + ax lods ax offset-of %ebx [bx] mov + ax lods ax offset-of %edx [bx] mov + ax lods ax offset-of %ecx [bx] mov + ax lods ax offset-of %eax [bx] mov + + ax lods \ Skip trapno + ax lods ax offset-of %error [bx] mov \ Save err + + ax lods ax offset-of %eip [bx] mov + + \ Change the resume address to go to "reenter" + make-odd \ word-align address + 'body reenter dup # ax mov + -4 allot token, \ rewrite address as relocatable + ax -4 [si] mov \ Resume at reenter address + + ax lods ax offset-of %cs [bx] mov + ax lods ax offset-of %eflags [bx] mov + ax lods \ Skip esp_at_signal + ax lods ax offset-of %ss [bx] mov + + ax ax xor ax dec + ax offset-of %state-valid [bx] mov \ mark saved state as valid + + \ Copy the entire Forth data stack and return stack areas to a save area. + up dx mov \ Save UP + + \ Data Stack (load si first because di is the user pointer!) + 'user sp0 si mov + 'user pssave di mov \ Address of data stack save area + ps-size # si sub \ Bottom of data stack area (in longwords) + + ps-size 4 / # cx mov \ Size of data stack area + rep movs + + dx up mov \ Get user pointer back + + \ Return Stack (load si first because di is the user pointer!) + 'user rp0 si mov + 'user rssave di mov \ Address of return stack save area + rs-size # si sub \ Bottom of return stack area + + rs-size 4 / # cx mov \ Size of return stack area (in longwords) + rep movs + + ret +end-code + + +hidden definitions + +d# 65 constant #signals +#signals /n* buffer: old-signals + +defer save-state +' save-state-signal to save-state + +: set-signal ( handler signal# -- old-handler ) + d# 92 syscall 2drop retval +; +: catch-signal ( signal# -- ) + save-state over set-signal ( signal# old-handler ) + old-signals rot na+ ! +; +: uncatch-signal ( signal# -- ) old-signals over na+ @ swap set-signal drop ; + +: uncatch-signals ( -- ) + d# 02 uncatch-signal \ SIGINT + d# 04 uncatch-signal \ SIGILL + d# 05 uncatch-signal \ SIGTRAP + d# 07 uncatch-signal \ SIGBUS + d# 08 uncatch-signal \ SIGFPE, Divide by 0 + d# 11 uncatch-signal \ SIGSEGV +; + +forth definitions +: catch-signals ( -- ) + pssave drop rssave drop \ Force buffer allocation + [ 0 alloc-reg ] literal alloc-mem is cpu-state + + d# 02 catch-signal \ SIGINT + d# 04 catch-signal \ SIGILL + d# 05 catch-signal \ SIGTRAP + d# 07 catch-signal \ SIGBUS + d# 08 catch-signal \ SIGFPE, Divide by 0 + d# 11 catch-signal \ SIGSEGV +; + +[ifdef] $save-forth +: $save-forth ( name$ -- ) + uncatch-signals $save-forth catch-signals +; +[then] +only forth also definitions + +\ Linux signal names + +string-array exception-names +( 00 ) ," " +( 01 ) ," " +( 02 ) ," Interrupt" +( 03 ) ," " +( 04 ) ," Illegal Instruction" +( 05 ) ," Trap" +( 06 ) ," " +( 07 ) ," Bus error" +( 08 ) ," Floating point error or divide-by-0" +( 09 ) ," " +( 10 ) ," " +( 11 ) ," " +end-string-array + +: (.exception) ( -- ) + int# + dup d# 8 <= if exception-names ". cr exit then + push-decimal (u.) type cr pop-base +; +' (.exception) is .exception +: print-breakpoint + .exception + interactive? 0= if bye then \ Restart only if a human is at the controls + ??cr quit +; +\ ' print-breakpoint is handle-breakpoint + +\ defer restart ( -- ) +hidden also +: sys-init + sys-init + catch-signals + restartable? off +; +only forth also definitions + +\ LICENSE_BEGIN +\ Copyright (c) 2007 FirmWorks +\ +\ Permission is hereby granted, free of charge, to any person obtaining +\ a copy of this software and associated documentation files (the +\ "Software"), to deal in the Software without restriction, including +\ without limitation the rights to use, copy, modify, merge, publish, +\ distribute, sublicense, and/or sell copies of the Software, and to +\ permit persons to whom the Software is furnished to do so, subject to +\ the following conditions: +\ +\ The above copyright notice and this permission notice shall be +\ included in all copies or substantial portions of the Software. +\ +\ THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, +\ EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF +\ MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND +\ NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE +\ LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION +\ OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION +\ WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. +\ +\ LICENSE_END Modified: cpu/x86/loadmach.fth =================================================================== --- cpu/x86/loadmach.fth 2007-08-15 03:30:45 UTC (rev 546) +++ cpu/x86/loadmach.fth 2007-08-15 20:20:01 UTC (rev 547) @@ -53,6 +53,7 @@ start-module \ Breakpointing fload ${BP}/cpu/x86/cpubpsup.fth \ Breakpoint support fload ${BP}/forth/lib/breakpt.fth +fload ${BP}/cpu/x86/Linux/catchexc.fth \ OS signal handling end-module \ LICENSE_BEGIN

1 0

r546 - dev/olpc/cafenand
by svn＠openbios.org 15 Aug '07

15 Aug '07

Author: wmb Date: 2007-08-15 05:30:45 +0200 (Wed, 15 Aug 2007) New Revision: 546 Modified: dev/olpc/cafenand/cafenand.fth Log: OLPC CaFe NAND driver - added commented-out code for random-read and random-write NAND commands, which might eventually be useful for diagnostics. Modified: dev/olpc/cafenand/cafenand.fth =================================================================== --- dev/olpc/cafenand/cafenand.fth 2007-08-15 03:28:22 UTC (rev 545) +++ dev/olpc/cafenand/cafenand.fth 2007-08-15 03:30:45 UTC (rev 546) @@ -96,6 +96,10 @@ h# 20.0070 1 0 >cmd constant read-status-cmd h# 0420.0000 0 5 >cmd constant read-cmd h# 0220.0080 0 6 >cmd constant write-cmd \ The 6 adds a dummy address cycle to meet tADR for Hynix +[ifdef] notdef +h# 0400.0005 0 2 >cmd constant random-read-cmd +h# 0200.0085 0 2 >cmd constant random-write-cmd +[then] : wait-mask ( bitmask -- ) begin dup h# 10 cl@ and until ( bitmask ) @@ -223,6 +227,26 @@ dma-buf-va rot /page do-lmove ( error? ) ; +[ifdef] notdef +: dma-read-buffer ( adr len offset -- ) + h# 1c cl! ( adr len ) \ Offset in internal chip buffer + dup h# 18 cl! ( adr len ) + dma-buf-pa h# 44 cl! ( adr len ) + 0 h# 48 cl! ( adr len) + dup h# a000.0000 or h# 40 cl! ( adr len ) + random-read-cmd h# 0800.01e0 cmd wait-dma ( adr len ) + dma-buf-va -rot do-lmove ( ) +; + +: dma-write-buffer ( adr len offset -- ) + write-enable ( adr len offset ) + h# 1c cl! ( adr len ) \ Offset in internal chip buffer + dup false dma-setup ( ) + random-write-cmd 0 cmd wait-cmd ( ) + dma-release ( ) +; +[then] + : dma-write-raw ( adr len page# offset -- ) write-enable ( adr len page# offset ) set-page ( adr len )

1 0

r545 - cpu/x86/pc/olpc
by svn＠openbios.org 15 Aug '07

15 Aug '07

Author: wmb Date: 2007-08-15 05:28:22 +0200 (Wed, 15 Aug 2007) New Revision: 545 Added: cpu/x86/pc/olpc/waveform.fth Log: waveform.fth - initial checkin of line drawing code, not included in build. Added: cpu/x86/pc/olpc/waveform.fth =================================================================== --- cpu/x86/pc/olpc/waveform.fth (rev 0) +++ cpu/x86/pc/olpc/waveform.fth 2007-08-15 03:28:22 UTC (rev 545) @@ -0,0 +1,175 @@ +dev screen + +9 constant wave-scale +1 d# 15 wave-scale - << 2+ constant wave-height + +: pitch* ( #lines -- #pixels ) bytes/line * ; +: wave-top ( -- adr ) + screen-height wave-height 2* - pitch* frame-buffer-adr + +; + +: wave0 ( -- ) screen-height wave-height - ; + +5 value fg +h# f value bg + +: pointat ( x y -- ) + bytes/line * swap wa+ frame-buffer-adr + fg swap w! +; + +variable curx variable cury +: moveto ( x y -- ) cury ! curx ! ; +: rmove ( dx dy -- ) cury +! curx +! ; +: point ( -- ) curx @ cury @ pointat ; + +2variable bump 2variable nobump +: bresenham ( incr reload -- ) + tuck dup 2/ ( reload incr reload delta ) + swap 0 do ( reload incr delta ) + point ( reload incr delta ) + over - dup 0< if ( reload incr delta' ) + 2 pick + ( reload incr delta' ) + bump ( reload incr delta var ) + else ( reload incr delta ) + nobump ( reload incr delta var ) + then ( reload incr delta ) + 2@ cury +! curx +! ( reload incr delta ) + loop ( reload incr delta ) + 3drop point ( ) +; + +: rline ( dx dy -- ) + dup 0< if ( dx dy- ) + negate ( dx |dy| ) + over 0< if ( dx- |dy| ) + swap negate swap ( |dx| |dy| ) + 2dup < if 0 -1 else swap -1 0 then -1 + else ( dx+ |dy| ) + 2dup < if 0 -1 else swap 1 0 then 1 + then ( incr reload nobump-xy bump-x ) + -1 ( incr reload nobump-xy bump-xy ) + else ( dx dy+ ) + over 0< if ( dx- dy+ ) + swap negate swap ( |dx| dy ) + 2dup < if 0 1 else swap -1 0 then -1 + else ( dx+ dy+ ) + 2dup < if 0 1 else swap 1 0 then 1 + then ( incr reload nobump-xy bump-x ) + 1 ( incr reload nobump-xy bump-xy ) + then ( incr reload nobump-xy bump-xy ) + bump 2! nobump 2! ( incr reload ) + bresenham ( ) +; + +0 [if] +\ Divide-and-conquer line drawing. Bresenham above is about twice +\ as fast, but this is less code. +: xy+ ( x1 y1 x2 y2 -- x3 y3 ) rot + >r + r> ; +: (rxline) ( x y dx dy -- ) + 2dup or if ( x y dx dy ) + swap 2/ swap 2/ ( x y dx/2 dy/2 ) + 2over 2over recurse ( x y dx/2 dy/2 ) + 2swap 2over xy+ 2dup pointat 2swap recurse ( ) + else ( x y dx dy ) + 4drop ( ) + then ( ) +; +: rxline ( dx dy -- ) curx @ cury @ 2swap (rxline) ; +[then] + +: lineto ( x y -- ) swap curx @ - swap cury @ - rline ; + + +1 [if] +\ Test for line drawing +d# 240 value gey0 d# 240 value gex0 +: godseye ( -- ) + gex0 0 do + i gey0 moveto + gex0 gey0 i - lineto + gex0 2* i - gey0 lineto + gex0 gey0 i + lineto + i gey0 lineto + 3 +loop +; +: godseye1 ( -- ) + gex0 0 do + i gey0 moveto + gex0 i - i ( x0-i i ) + negate 2dup rline ( x0-i -i ) + negate 2dup rline ( x0-i i ) + swap negate swap ( i-x0 i ) + 2dup rline ( x0-i -i ) + negate rline ( ) + 3 +loop +; +[then] + +: plot0 ( -- x y ) 0 screen-height 10 - ; +: clear-plot ( width height -- ) + 2>r + bg plot0 2r> ( bg plot0-xy wh ) + rot over - -rot ( bg plot0-xy' wh ) + fill-rectangle +; + +variable ylim variable ymin +1 value stretch +: clip-y ( value -- value' ) ymin @ - 0 max ylim @ min ; +: plot ( xt xmin xmax xscale ymin ymax -- ) + over - ylim ! ymin ! to stretch ( xt xmin xmax ) + over 3 pick execute clip-y ( xt xmin xmax y-at-xmin ) + plot0 2 pick - moveto ( xt xmin xmax y-at-xmin ) + -rot swap 1+ ?do ( xt last ) + i 2 pick execute clip-y ( xt last value ) + tuck - ( xt value delta ) + stretch swap rline ( xt value ) + loop ( xt last ) + 2drop ( ) +; + +: clear-waveform ( -- ) + bg + 0 wave0 wave-height - screen-width wave-height 2* + fill-rectangle +; +: waveform-start ( -- ) 0 wave0 moveto ; +: draw-wave ( adr ) + 0 swap ( last adr ) + screen-width 0 do ( last adr ) + tuck <w@ ( adr last this-unscaled ) + wave-scale >>a ( adr last this ) + tuck swap - ( adr this distance ) + 1 swap rline ( adr this ) + swap wa1+ ( this adr ) + loop ( last adr ) + 2drop +; +: waveform ( adr -- ) clear-waveform waveform-start draw-wave ; +: set-fg ( fg -- ) to fg ; +: set-bg ( bg -- ) to bg ; +: vgrid ( width height interval -- ) + rot 0 ?do ( height interval ) + i plot0 nip moveto ( height interval ) + 0 2 pick negate rline ( height interval ) + dup +loop ( height interval ) + 2drop ( ) +; +: hgrid ( width height interval -- ) + swap 0 ?do ( width interval ) + plot0 i - moveto ( width interval ) + over 0 rline ( width interval ) + dup +loop ( width interval ) + 2drop ( ) +; + +dend + +: $call-screen ( ? name$ -- ? ) stdout @ $call-method ; +: wave ( adr -- ) " waveform" $call-screen ; +: clear-plot ( width height -- ) " clear-plot" $call-screen ; +: lineplot ( xt xmin xmax xscale ymin ymax -- ) " plot" $call-screen ; +: set-fg ( fg -- ) " set-fg" $call-screen ; +: set-bg ( bg -- ) " set-bg" $call-screen ; +: vgrid ( width height interval -- ) " vgrid" $call-screen ; +: hgrid ( width height interval -- ) " hgrid" $call-screen ;

1 0

r544 - cpu/x86/pc/olpc/sdtools
by svn＠openbios.org 15 Aug '07

15 Aug '07

Author: wmb Date: 2007-08-15 05:27:30 +0200 (Wed, 15 Aug 2007) New Revision: 544 Added: cpu/x86/pc/olpc/sdtools/ecdump.fth Modified: cpu/x86/pc/olpc/sdtools/maketar cpu/x86/pc/olpc/sdtools/sd.fth Log: sdkit - added EC register dumping commands. Added: cpu/x86/pc/olpc/sdtools/ecdump.fth =================================================================== --- cpu/x86/pc/olpc/sdtools/ecdump.fth (rev 0) +++ cpu/x86/pc/olpc/sdtools/ecdump.fth 2007-08-15 03:27:30 UTC (rev 544) @@ -0,0 +1,33 @@ +: .3r space <# u# u# u#> type ; +: dump-ec ( adr len -- ) + dup h# 10 < if + over 4 u.r ." : " bounds do i ec@ .3r loop cr + else + bounds ?do + i 4 u.r ." : " + i h# 10 bounds ?do i ec@ .3r loop cr + h# 10 +loop + then +; +: dump-ec-regs ( -- ) +." GPIOO " fc00 4 dump-ec +." GPIOE " fc10 6 dump-ec +." GPIOD " fc20 6 dump-ec +." GPIOIN " fc30 7 dump-ec +." GPIOPU " fc40 6 dump-ec +." GPIOOD " fc50 4 dump-ec +." GPIOIE " fc60 7 dump-ec +." GPIOM " fc70 1 dump-ec +." KBC " fc80 7 dump-ec +." PWM " fe00 e dump-ec +." GPT " fe50 a dump-ec +." SPI " fea0 10 dump-ec +." WDT " fe80 6 dump-ec +." LPC " fe90 10 dump-ec +." PS2 " fee0 7 dump-ec +." EC " ff00 20 dump-ec +." GPWUEN " ff30 4 dump-ec +." GPWUPF " ff40 4 dump-ec +." GPWUPS " ff50 4 dump-ec +." GPWUEL " ff60 4 dump-ec +; Modified: cpu/x86/pc/olpc/sdtools/maketar =================================================================== --- cpu/x86/pc/olpc/sdtools/maketar 2007-08-15 03:26:50 UTC (rev 543) +++ cpu/x86/pc/olpc/sdtools/maketar 2007-08-15 03:27:30 UTC (rev 544) @@ -6,6 +6,6 @@ cp ../../../../../cpu/x86/pc/olpc/mfgdata.fth sdkit cp ../../../../../dev/olpc/dcon/dconsmb.fth sdkit cp ../../../../../dev/olpc/kb3700/ecio.fth sdkit -cp sd sd.fth dumpgamma.fth sdkit +cp sd sd.fth ecdump.fth dumpgamma.fth sdkit tar cfz sdkit.tgz sdkit # rm sdkit/* Modified: cpu/x86/pc/olpc/sdtools/sd.fth =================================================================== --- cpu/x86/pc/olpc/sdtools/sd.fth 2007-08-15 03:26:50 UTC (rev 543) +++ cpu/x86/pc/olpc/sdtools/sd.fth 2007-08-15 03:27:30 UTC (rev 544) @@ -66,6 +66,7 @@ defer spi-start defer spi@ defer spi! defer spi-out defer spi-reprogrammed 1 value spi-us \needs ec@ fload ecio.fth +\needs ec-range fload ecdump.fth \ LICENSE_BEGIN \ Copyright (c) 2006 FirmWorks

1 0

r543 - cpu/x86/pc/olpc
by svn＠openbios.org 15 Aug '07

15 Aug '07

Author: wmb Date: 2007-08-15 05:26:50 +0200 (Wed, 15 Aug 2007) New Revision: 543 Modified: cpu/x86/pc/olpc/loaddropins.fth Log: OLPC loaddropins.fth - minor cleanup and space savings. Modified: cpu/x86/pc/olpc/loaddropins.fth =================================================================== --- cpu/x86/pc/olpc/loaddropins.fth 2007-08-15 03:16:38 UTC (rev 542) +++ cpu/x86/pc/olpc/loaddropins.fth 2007-08-15 03:26:50 UTC (rev 543) @@ -18,8 +18,8 @@ " ${BP}/dev/olpc/cafenand/build/cafenand.fc" " class050101" $add-deflated-dropin " ${BP}/dev/olpc/cafecamera/build/cafecamera.fc" " pci11ab,4102" $add-deflated-dropin - " ${BP}/dev/mmc/sdhci/build/sdhci.fc" " pci11ab,4101" $add-dropin - " ${BP}/dev/mmc/sdhci/build/sdmmc.fc" " sdmmc" $add-dropin + " ${BP}/dev/mmc/sdhci/build/sdhci.fc" " pci11ab,4101" $add-deflated-dropin + " ${BP}/dev/mmc/sdhci/build/sdmmc.fc" " sdmmc" $add-deflated-dropin " ${BP}/dev/geode/nandflash/build/nandflash.fc" " nand5536" $add-deflated-dropin " ${BP}/dev/geode/ac97/build/ac97.fc" " pci1022,2093" $add-deflated-dropin @@ -28,9 +28,6 @@ " ${BP}/ofw/inet/telnetd.fth" " telnetd" $add-deflated-dropin -\ " ${BP}/ofw/linux/logos.bmp" " oslogo.bmp" $add-deflated-dropin -\ " ${BP}/ofw/linux/logom16e.bmp" " error.bmp" $add-deflated-dropin -\ " ${BP}/ofw/linux/logom16c.bmp" " timeout.bmp" $add-deflated-dropin " ${BP}/cpu/x86/pc/olpc/images/olpclogo.565" " olpc.565" $add-deflated-dropin " ${BP}/cpu/x86/pc/olpc/images/laptop.565" " nandflash.565" $add-deflated-dropin " ${BP}/cpu/x86/pc/olpc/images/ethernet.565" " ethernet.565" $add-deflated-dropin @@ -40,3 +37,8 @@ " ${BP}/cpu/x86/pc/olpc/images/sd.565" " sdmmc.565" $add-deflated-dropin " ${BP}/ofw/termemu/gallant.obf" " font" $add-deflated-dropin + +\ " /space/bios-crypto/bios_crypto.img" " crypto" $add-deflated-dropin +\ " /space/bios-crypto/bios_hash.img" " hasher" $add-deflated-dropin +\ " /space/bios-crypto/wmbtest256.public" " pubkey" $add-dropin \ Incompressible +\ " /space/bios-crypto/usb8388.bin.sig256" " usb8388.sig" $add-dropin \ Incompressible

1 0

r542 - dev/olpc/cafenand
by svn＠openbios.org 15 Aug '07

15 Aug '07

Author: wmb Date: 2007-08-15 05:16:38 +0200 (Wed, 15 Aug 2007) New Revision: 542 Modified: dev/olpc/cafenand/badblock.fth Log: CaFe NAND - support for graphical copy-nand progress reports. Modified: dev/olpc/cafenand/badblock.fth =================================================================== --- dev/olpc/cafenand/badblock.fth 2007-08-15 03:14:55 UTC (rev 541) +++ dev/olpc/cafenand/badblock.fth 2007-08-15 03:16:38 UTC (rev 542) @@ -5,7 +5,10 @@ 0 value bbt \ Bad block table address -: round-up ( n boundary -- n' ) over 1- + over / * ; +: round-up ( n boundary -- n' ) + tuck 1- + ( boundary n' ) + over / * +; : /bbt ( -- bytes ) \ Bytes per bad block table total-pages pages/eblock / 3 + 4 / ( bytes ) @@ -225,8 +228,8 @@ : map-resblock ( page# #pages -- page#' #pages ) swap pages/eblock /mod ( adr #pages offset eblock# ) - resmap swap na+ @ ( adr #pages offset res-page# ) - + swap ( adr page#' #pages ) + resmap swap na+ @ ( adr #pages offset res-eblock# ) + + pages/eblock * swap ( adr page#' #pages ) ; external @@ -292,23 +295,29 @@ make-bbt ; -\ Clear the device but honor the existing bad block table -: wipe ( -- ) +: .bn ( -- ) (cr . ; + +: (wipe) ( 'show-bad 'show-erased -- ) get-existing-bbt bbt if - usable-page-limit 0 ?do + usable-page-limit 0 ?do ( 'show-bad 'show-erased ) i block-bad? if -\ cr ." Skipping bad block" i .page-byte cr + i pages/eblock / 2 pick execute else - (cr i . + i pages/eblock / over execute i erase-block then pages/eblock +loop exit - then + then ( 'show-bad 'show-erased ) \ If there is no existing bad block table, make one from factory info make-bbt + 2drop ; + +\ Clear the device but honor the existing bad block table +: wipe ( -- ) ['] drop ['] .bn (wipe) ; + : show-bbt ( -- ) get-bbt total-pages 0 ?do @@ -369,22 +378,28 @@ : start-scan ( -- ) pages/eblock negate to scan-page# ; \ Must erase all (wipe) first -: copy-block ( adr -- error? ) - next-page# pages/eblock bounds ?do ( adr ) - dup i write-page if ( adr ) - drop true unloop exit ( true ) - then ( adr ) - /page + ( adr' ) - loop ( adr ) - drop false ( false ) +: copy-block ( adr -- page# error? ) + next-page# ( adr page# ) + tuck pages/eblock bounds ?do ( page# adr ) + dup i write-page if ( page# adr ) + drop true unloop exit ( page# true ) + then ( page# adr ) + /page + ( page# adr' ) + loop ( page# adr ) + drop false ( page# false ) ; -: put-cleanmarkers ( -- ) - begin (next-page#) 0= while ( page# ) - " "(85 19 03 20 08 00 00 00 00 00 00 00)" ( page# adr len ) - rot /page /ecc + write-bytes ( ) - repeat ( ) +: put-cleanmarker ( page# -- ) + " "(85 19 03 20 08 00 00 00 00 00 00 00)" ( page# adr len ) + rot /page /ecc + write-bytes ( ) ; +: put-cleanmarkers ( show-xt -- ) + begin (next-page#) 0= while ( show-xt page# ) + dup put-cleanmarker ( show-xt page# ) + pages/eblock / over execute ( show-xt ) + repeat ( show-xt ) + drop +; : read-next-block ( adr -- ) next-page# pages/eblock bounds ?do ( adr )

1 0

r541 - dev/usb2/device/wlan
by svn＠openbios.org 15 Aug '07

15 Aug '07

Author: wmb Date: 2007-08-15 05:14:55 +0200 (Wed, 15 Aug 2007) New Revision: 541 Modified: dev/usb2/device/wlan/usb8388.fth dev/usb2/device/wlan/wlan.fth Log: OLPC wireless LAN driver - added promiscuous mode. Modified: dev/usb2/device/wlan/usb8388.fth =================================================================== --- dev/usb2/device/wlan/usb8388.fth 2007-08-15 03:14:16 UTC (rev 540) +++ dev/usb2/device/wlan/usb8388.fth 2007-08-15 03:14:55 UTC (rev 541) @@ -661,6 +661,15 @@ enable-11d ; +: enable-promiscuous ( -- ) + mac-ctrl h# 80 or to mac-ctrl + set-mac-control +; +: disable-promiscuous ( -- ) + mac-ctrl h# 80 invert and to mac-ctrl + set-mac-control +; + : enable-multicast ( -- ) mac-ctrl h# 20 or to mac-ctrl set-mac-control Modified: dev/usb2/device/wlan/wlan.fth =================================================================== --- dev/usb2/device/wlan/wlan.fth 2007-08-15 03:14:16 UTC (rev 540) +++ dev/usb2/device/wlan/wlan.fth 2007-08-15 03:14:55 UTC (rev 541) @@ -52,6 +52,8 @@ true ; +false instance value use-promiscuous? + external \ Set to true to force open the driver without association. @@ -60,9 +62,11 @@ false instance value force-open? : parse-args ( $ -- ) + false to use-promiscuous? begin ?dup while ascii , left-parse-string 2dup " debug" $= if debug-on then + 2dup " promiscuous" $= if true to use-promiscuous? then " force" $= if true to force-open? then repeat drop ; @@ -87,6 +91,7 @@ then start-nic then + use-promiscuous? if enable-promiscuous else disable-promiscuous then opencount @ 1+ opencount ! true ;

1 0

r540 - dev/olpc/kb3700
by svn＠openbios.org 15 Aug '07

15 Aug '07

Author: wmb Date: 2007-08-15 05:14:16 +0200 (Wed, 15 Aug 2007) New Revision: 540 Modified: dev/olpc/kb3700/battery.fth Log: OLPC watch-battery - Minor formatting change to prevent line wrap Modified: dev/olpc/kb3700/battery.fth =================================================================== --- dev/olpc/kb3700/battery.fth 2007-08-15 03:06:37 UTC (rev 539) +++ dev/olpc/kb3700/battery.fth 2007-08-15 03:14:16 UTC (rev 540) @@ -81,7 +81,7 @@ : .% ( n -- ) 2.d ." %" ; : .bat ( -- ) bat-status@ ( stat ) - ." AC: " dup h# 10 and if ." on " else ." off " then ( stat ) + ." AC:" dup h# 10 and if ." on " else ." off " then ( stat ) ." PCB: " pcb-temp 2.d ." C " dup 1 and if

1 0

r539 - cpu/x86/pc/olpc
by svn＠openbios.org 15 Aug '07

15 Aug '07

Author: wmb Date: 2007-08-15 05:06:37 +0200 (Wed, 15 Aug 2007) New Revision: 539 Added: cpu/x86/pc/olpc/boardrev.fth Modified: cpu/x86/pc/olpc/devices.fth cpu/x86/pc/olpc/fw.bth Log: OLPC - Split the board revision sensing code out into a separate file and rearranged the code that loads it. Also added a game to the early startup button sequence. Added: cpu/x86/pc/olpc/boardrev.fth =================================================================== --- cpu/x86/pc/olpc/boardrev.fth (rev 0) +++ cpu/x86/pc/olpc/boardrev.fth 2007-08-15 03:06:37 UTC (rev 539) @@ -0,0 +1,61 @@ +purpose: Determine the board revision based on hardware and EC info +\ See license at end of file + +0 value atest? +0 value board-revision + +\ Constructs a string like "B4" or "preB4" or "postB4" +: model-name$ ( -- model$ ) + board-revision h# 10 /mod ( minor major ) + swap dup 8 = if ( major minor ) + drop " " ( major prefix$ ) + else ( major minor ) + 8 < if " pre" else " post" then ( major prefix$ ) + then ( major prefix$ ) + push-hex + rot <# u# u# drop hold$ 0 u#> ( adr len ) + pop-base + 2dup + 2- 2 upper ( model$ ) \ Upper case for base model +; + +stand-init: board revision + kb3920? to atest? + atest? if + h# a18 + else + lx? if + board-id@ case + h# b2 of h# b30 endof \ preB3 + ( board-id ) dup h# 10 * 8 + swap \ E.g. b3 -> b38 + endcase + else + h# 4c00.0014 rdmsr drop ( RSTPLL-value ) + 4 rshift 7 and 0= if h# b28 else h# b18 then + then + then + to board-revision +; + +\ LICENSE_BEGIN +\ Copyright (c) 2007 FirmWorks +\ +\ Permission is hereby granted, free of charge, to any person obtaining +\ a copy of this software and associated documentation files (the +\ "Software"), to deal in the Software without restriction, including +\ without limitation the rights to use, copy, modify, merge, publish, +\ distribute, sublicense, and/or sell copies of the Software, and to +\ permit persons to whom the Software is furnished to do so, subject to +\ the following conditions: +\ +\ The above copyright notice and this permission notice shall be +\ included in all copies or substantial portions of the Software. +\ +\ THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, +\ EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF +\ MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND +\ NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE +\ LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION +\ OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION +\ WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. +\ +\ LICENSE_END Modified: cpu/x86/pc/olpc/devices.fth =================================================================== --- cpu/x86/pc/olpc/devices.fth 2007-08-15 03:02:48 UTC (rev 538) +++ cpu/x86/pc/olpc/devices.fth 2007-08-15 03:06:37 UTC (rev 539) @@ -243,27 +243,8 @@ fload ${BP}/dev/olpc/kb3700/ecio.fth \ I/O space access to EC chip -0 value atest? -0 value board-revision +fload ${BP}/cpu/x86/pc/olpc/boardrev.fth \ Board revision decoding - stand-init: board revision - kb3920? to atest? - atest? if - h# a18 - else - lx? if - board-id@ case - h# b2 of h# b30 endof \ preB3 - ( board-id ) dup h# 10 * 8 + swap \ E.g. b3 -> b38 - endcase - else - h# 4c00.0014 rdmsr drop ( RSTPLL-value ) - 4 rshift 7 and 0= if h# b28 else h# b18 then - then - then - to board-revision -; - stand-init: Quiet SCI sci-quiet ; @@ -327,6 +308,44 @@ fload ${BP}/cpu/x86/adpcm.fth \ ADPCM decoding +[ifdef] rom-loaded +fload ${BP}/cpu/x86/pc/olpc/gpioinit.fth +fload ${BP}/cpu/x86/pc/olpc/chipinit.fth +[then] + +warning @ warning off +: stand-init + stand-init + root-device + model-name$ 2dup model ( name$ ) + " OLPC " encode-bytes 2swap encode-string encode+ " banner-name" property + board-revision " board-revision-int" integer-property + \ The "1-" removes the null byte + " SN" find-tag if 1- else " Unknown" then " serial-number" string-property + +[ifndef] lx-devel + 8 ec-cmd " ec-version" integer-property + + " PQ2" h# fff0.0000 h# 1.0000 sindex dup 0>= if ( offset ) + h# fff0.0000 + cscount ( name ) + else + drop " UNKNOWN" + then + " ec-name" string-property +[then] + + dend + + " /openprom" find-device + h# ffff.ffc0 d# 16 " model" string-property + + " sourceurl" find-drop-in if " source-url" string-property then + dend +; +warning ! + +fload ${BP}/cpu/x86/pc/olpc/micin.fth \ Microphone input AC/DC coupling + \ LICENSE_BEGIN \ Copyright (c) 2006 FirmWorks \ Modified: cpu/x86/pc/olpc/fw.bth =================================================================== --- cpu/x86/pc/olpc/fw.bth 2007-08-15 03:02:48 UTC (rev 538) +++ cpu/x86/pc/olpc/fw.bth 2007-08-15 03:06:37 UTC (rev 539) @@ -214,54 +214,6 @@ fload ${BP}/cpu/x86/pc/olpc/devices.fth -[ifdef] rom-loaded -fload ${BP}/cpu/x86/pc/olpc/gpioinit.fth -fload ${BP}/cpu/x86/pc/olpc/chipinit.fth -[then] - -warning @ warning off -: stand-init - stand-init - root-device - board-revision case - h# a18 of " A1" " OLPC A-test" endof - h# b18 of " B1" " OLPC B1" endof - h# b28 of " B2" " OLPC B2" endof - h# b30 of " preB3" " OLPC preB3" endof - h# b38 of " B3" " OLPC B3" endof - h# b40 of " preB4" " OLPC preB4" endof - h# b48 of " B4" " OLPC B4" endof - ( default ) >r " ??" " OLPC ??" r> - endcase - encode-string " banner-name" property - model - board-revision " board-revision-int" integer-property - \ The "1-" removes the null byte - " SN" find-tag if 1- else " Unknown" then " serial-number" string-property - -[ifndef] lx-devel - 8 ec-cmd " ec-version" integer-property - - " PQ2" h# fff0.0000 h# 1.0000 sindex dup 0>= if ( offset ) - h# fff0.0000 + cscount ( name ) - else - drop " UNKNOWN" - then - " ec-name" string-property -[then] - - dend - - " /openprom" find-device - h# ffff.ffc0 d# 16 " model" string-property - - " sourceurl" find-drop-in if " source-url" string-property then - dend -; -warning ! - -fload ${BP}/cpu/x86/pc/olpc/micin.fth \ Microphone input AC/DC coupling - fload ${BP}/cpu/x86/pc/olpc/countdwn.fth \ Startup countdown fload ${BP}/dev/scsi/probscsi.fth \ probe-scsi and probe-scsi-all @@ -380,7 +332,10 @@ fload ${BP}/dev/olpc/touchpad/touchpad.fth \ Touchpad diagnostic fload ${BP}/dev/olpc/kb3700/battery.fth \ Battery status reports fload ${BP}/cpu/x86/pc/olpc/copynand.fth +fload ${BP}/cpu/x86/pc/olpc/nandstat.fth +\ fload ${BP}/cpu/x86/pc/olpc/carousel.fth \ Carouseled NAND writing fload ${BP}/cpu/x86/pc/olpc/crypto.fth \ Cryptographic image validation +fload ${BP}/ofw/gui/ofpong.fth [then] \ Eliminate 4 second delay in install console for the case where @@ -412,7 +367,7 @@ fload ${BP}/ofw/inet/loadtcp.fth support-package: http - fload ${BP}/ofw/inet/http.fth \ HTTP client + fload ${BP}/ofw/inetv6/http.fth \ HTTP client end-support-package fload ${BP}/ofw/wifi/wifi-cfg.fth @@ -456,7 +411,7 @@ ; : fast-boot? ( -- flag ) [ifdef] rom-loaded - game-key-mask h# 100 and 0= + game-key-mask h# 120 and 0= [else] false [then] @@ -525,6 +480,9 @@ : ?start-sound ( -- ) game-key-mask h# 40 and if start-sound then ; +: ?games ( -- ) + game-key-mask h# 20 and if pong then +; : open-keyboard ( -- ) " keyboard" open-dev ?dup if set-stdin then ; @@ -563,6 +521,7 @@ probe-pci ?start-sound open-keyboard + ?games optional-startup interpreter-init [ifndef] lx-devel @@ -578,7 +537,9 @@ ; : newrom - " flash http:\\10.20.0.109\new.rom" eval + " flash http:\\10.20.0.104\new.rom" eval +\ " wifi media lab 802.11" eval +\ " flash http:\\18.85.46.172\new.rom" eval ; \ This helps with TeraTerm, which sends ESC-O as the arrow key prefix

1 0

r538 - ofw/gui
by svn＠openbios.org 15 Aug '07

15 Aug '07

Author: wmb Date: 2007-08-15 05:02:48 +0200 (Wed, 15 Aug 2007) New Revision: 538 Added: ofw/gui/ofpong.fth Log: Pong - initial checkin. Added: ofw/gui/ofpong.fth =================================================================== --- ofw/gui/ofpong.fth (rev 0) +++ ofw/gui/ofpong.fth 2007-08-15 03:02:48 UTC (rev 538) @@ -0,0 +1,572 @@ +\ Adapted from http://members.aol.com/plforth/ofpong/20020313/ofpong.txt +\ See also http://members.aol.com/plforth/ofpong/index.html +\ Originally from 1.0d1 MacHack '98 release of OFPong.of found in OFPONG.SIT. + +decimal + + 0 value erasecol +-1 value drawcol + +0 value key_left_up +0 value key_left_down +0 value key_right_up +0 value key_right_down +0 value key_esc +0 value key_off + +0 value grandseed +0 value glastupdate +0 value loopcount +0 value totalupdate + +0 value ballstop + +0 value ballx +0 value bally + +0 value balldx +0 value balldy + +0 value leftbaty +0 value rightbaty +0 value batdy + +0 value leftscore +0 value rightscore + +640 value screenw +480 value screenh + +20 value ballsize +ballsize 2 / value scoresize +ballsize 5 * value batsize +1000 value pscale + +0 value ball_limit_x +ballsize pscale * value ball_limit_lo_y +0 value ball_limit_hi_y + +ballsize pscale * value bat_limit_lo_y +0 value bat_limit_hi_y + +0 value hit_limit_left_lo_x +ballsize 2 * pscale * value hit_limit_left_hi_x +0 value hit_limit_right_lo_x +0 value hit_limit_right_hi_x + +ballsize pscale * value reflect_left_x +0 value reflect_right_x + +: initlimits + " dimensions" $call-screen to screenh to screenw + screenw ballsize - pscale * to ball_limit_x + screenh ballsize 2 * - pscale * to ball_limit_hi_y + screenh ballsize batsize + - pscale * to bat_limit_hi_y + screenw ballsize 3 * - pscale * to hit_limit_right_lo_x + screenw ballsize - pscale * to hit_limit_right_hi_x + + screenw ballsize 2 * - pscale * to reflect_right_x + get-msecs to grandseed +; + +: random ( -- n ) grandseed 16807 * 17 + abs to grandseed grandseed 1000 mod ; +: unscale ( n -- n ) pscale 2/ + pscale / ; +: calcbatx ( n -- x ) screenw ballsize 3 * - * ballsize + ; +: paintrect ( c pixx pixy pixw pixh -- ) " fill-rectangle" $call-screen ; + +\needs xy* : xy* ( x y w h -- x' y' ) rot * >r * r> ; + +\ Big digits for the score + +0 0 2value digitxy + +: rectcol ( x y w h c -- ) + -rot >r >r -rot ( c x y r: h w ) + scoresize dup xy* ( c x' y' r: h w ) + digitxy xy+ ( c base-xy r: h w ) + r> r> scoresize dup xy* ( c base-xy wh-scaled ) + paintrect +; + +: blackrect ( x y w h -- ) drawcol rectcol ; +: whiterect ( x y w h -- ) erasecol rectcol ; + +: drawblank ( -- ) 0 0 4 7 whiterect ; + +: drawzero ( -- ) + 0 0 1 7 blackrect + 1 0 2 1 blackrect + 1 6 2 1 blackrect + 3 0 1 7 blackrect + 1 3 2 1 whiterect +; + +: drawone ( -- ) + 3 0 1 7 blackrect + 0 0 3 7 whiterect +; + +: drawtwo ( -- ) + 0 0 4 1 blackrect + 3 1 1 2 blackrect + 0 3 4 1 blackrect + 0 4 1 2 blackrect + 0 6 4 1 blackrect + 0 1 1 2 whiterect + 3 4 1 2 whiterect +; + +: drawthree ( -- ) + 0 0 4 1 blackrect + 3 1 1 2 blackrect + 0 3 4 1 blackrect + 3 4 1 2 blackrect + 0 6 4 1 blackrect + 0 1 1 2 whiterect + 0 4 1 2 whiterect +; + +: drawfour ( -- ) + 0 0 1 3 blackrect + 0 3 3 1 blackrect + 3 0 1 7 blackrect + 1 0 2 1 whiterect + 0 4 3 3 whiterect +; + +: drawfive ( -- ) + 0 0 4 1 blackrect + 0 1 1 2 blackrect + 0 3 4 1 blackrect + 3 4 1 2 blackrect + 0 6 4 1 blackrect + 3 1 1 2 whiterect + 0 4 1 2 whiterect +; + +: drawsix ( -- ) + 0 0 1 7 blackrect + 1 3 2 1 blackrect + 1 6 2 1 blackrect + 3 3 1 4 blackrect + 1 0 3 3 whiterect +; + +: drawseven ( -- ) + 0 0 3 1 blackrect + 3 0 1 7 blackrect + 0 1 3 6 whiterect +; + +: draweight ( -- ) + 0 0 4 1 blackrect + 0 1 1 2 blackrect + 3 1 1 2 blackrect + 0 3 4 1 blackrect + 0 4 1 2 blackrect + 3 4 1 2 blackrect + 0 6 4 1 blackrect +; + +: drawnine ( -- ) + 0 0 1 4 blackrect + 1 0 2 1 blackrect + 1 3 2 1 blackrect + 3 0 1 7 blackrect + 0 4 3 3 whiterect +; + +: drawdigit ( x y n -- ) + -rot to digitxy ( n ) + case + 0 of drawzero endof + 1 of drawone endof + 2 of drawtwo endof + 3 of drawthree endof + 4 of drawfour endof + 5 of drawfive endof + 6 of drawsix endof + 7 of drawseven endof + 8 of draweight endof + 9 of drawnine endof + endcase +; + +: drawnumber ( startx starty num -- ) + abs 100 /mod drop 10 /mod ( startxy 1s 10s ) + swap >r >r ( startxy r: 10s 1s ) + 2dup r> drawdigit ( startxy r: 1s ) + scoresize 5 * 0 xy+ r> drawdigit ( ) +; + +\ Ball and bats + +: plotball ( x y -- ) + drawcol -rot swap unscale swap unscale ballsize ballsize paintrect +; +: eraseball ( x y -- ) + erasecol -rot swap unscale swap unscale ballsize ballsize paintrect +; +: plotbat ( x y -- ) + drawcol -rot swap swap unscale ballsize batsize paintrect +; +: erasebat ( x y -- ) + erasecol -rot swap swap unscale ballsize batsize paintrect +; + +: redraw ( -- ) + drawcol 0 0 screenw ballsize paintrect + drawcol 0 screenh ballsize - screenw ballsize paintrect + + drawcol screenw scoresize - 2/ ballsize 2* + scoresize screenh ballsize 4 * - paintrect + + ballsize 7 * ballsize 2* leftscore drawnumber + screenw ballsize 7 * 9 scoresize * + - ballsize 2* rightscore drawnumber + 0 calcbatx leftbaty plotbat + 1 calcbatx rightbaty plotbat + ballx bally plotball +; + +: drawboard ( -- ) + drawcol 0 0 screenw screenh paintrect + erasecol 0 0 screenw screenh paintrect + redraw +; + +: resetball ( -- ) + 500 to ballstop + screenw ballsize - 2 / pscale * ballx pscale mod + random + to ballx + screenh ballsize - 2 / pscale * bally pscale mod + random + to bally + + random screenw pscale * * 2000000 / to balldx + random screenh pscale * * 2000000 / to balldy + balldx screenw pscale * 3000 / + to balldx + balldy screenh pscale * 6000 / + to balldy + + random 500 < if balldx negate to balldx then + random 500 < if balldy negate to balldy then +; + +: initvalues ( -- ) + ballsize 2* pscale * to leftbaty + screenh ballsize 2 * - batsize - pscale * to rightbaty + + screenh pscale * 1000 / to batdy +; + +: doreset ( -- ) + resetball + 0 to leftscore + 0 to rightscore + drawboard +; + +\ Keyboard drivers; just receiving keys is usually not good enough; +\ the response is too slow. It is better to get up/down events or +\ poll key states if you can. + +[ifdef] olpc +\ This works with the FirmWorks pckbd driver. The key map below +\ is good for the OLPC keyboard. +: initkeys + ." Shift, Hand, Esc, Square" cr + d# 3000 ms + " stdin @ iselect ' get-scan 0 alarm iunselect" eval + false to key_left_up + false to key_left_down + false to key_right_up + false to key_right_down + false to key_esc + false to key_off +; +: restorekeys + " stdin @ iselect ' get-scan d# 10 alarm iunselect" eval +; +0 value e0-seen? +: scankeys + begin " get-data?" stdin @ $call-method while ( scancode ) + dup h# e0 = if + drop true to e0-seen? + else + dup h# 80 and 0= swap h# 7f and ( down? station ) + case + h# 65 of + e0-seen? if to key_right_up else to key_left_up then + endof \ game up + h# 66 of + e0-seen? if to key_right_down else to key_left_down then + endof \ game down + 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 + nip + endcase + false to e0-seen? + then + repeat +; +[else] +\ This version uses "key" with normal ASCII. It is typically too slow +\ dup to limited keyboard repeat rate. +: initkeys ; +: restorekeys ; +: scankeys + false to key_left_up + false to key_left_down + false to key_right_up + false to key_right_down + false to key_esc + false to key_off + 0 to key_esc + key? if + key upc case + [char] A of true to key_left_up endof + [char] Z of true to key_left_down endof + [char] ' of true to key_right_up endof + [char] / of true to key_right_down endof + 27 of true to key_esc endof + 8 of true to key_off endof + endcase + then +; +[then] + +: moveball ( oldx oldy newx newy -- ) 2swap eraseball plotball ; + +: doupdateball ( delta -- ) + ballx swap bally swap + + dup + + balldx * ballx + to ballx + balldy * bally + to bally + + ballx 0< if + resetball + balldx abs negate to balldx + ballx ballsize 2 * pscale * + to ballx + rightscore 1 + to rightscore + rightscore 15 = if + -1 to ballstop + then + then + ballx ball_limit_x > if + resetball + balldx abs to balldx + ballx ballsize 2 * pscale * - to ballx + leftscore 1 + to leftscore + leftscore 15 = if + -1 to ballstop + then + then + + bally ball_limit_lo_y < if + balldy negate to balldy + ball_limit_lo_y 2 * bally - to bally + then + bally ball_limit_hi_y > if + balldy negate to balldy + ball_limit_hi_y 2 * bally - to bally + then + + balldx 0< if + ballx hit_limit_left_lo_x hit_limit_left_hi_x between if + bally leftbaty ballsize pscale * - leftbaty batsize pscale * + between if + + bally leftbaty < if + balldy abs negate to balldy + then + + bally leftbaty batsize ballsize - pscale * + > if + balldy abs to balldy + then + + ballx reflect_left_x > if + balldx abs random 50 / + to balldx + + leftbaty bally - unscale + dup 0 batsize between if + batsize 2 / - random * 2 / batsize / 25 / balldy + to balldy + else + drop + then + then + then + then + then + + balldx 0> if + ballx hit_limit_right_lo_x hit_limit_right_hi_x between if + bally rightbaty ballsize pscale * - rightbaty batsize pscale * + between if + + bally rightbaty < if + balldy abs negate to balldy + then + + bally rightbaty batsize ballsize - pscale * + > if + balldy abs to balldy + then + + ballx reflect_right_x < if + balldx abs random 50 / + negate to balldx + + rightbaty bally - unscale + dup 0 batsize between if + batsize 2 / - random * 2 / batsize / 25 / balldy + to balldy + else + drop + then + then + then + then + then + + bally ball_limit_lo_y < if + ball_limit_lo_y to bally + then + bally ball_limit_hi_y > if + ball_limit_hi_y to bally + then + + ballx bally moveball +; + +: updateball ( delta -- ) + ballstop 0= if + doupdateball + else + ballstop -1 = if + drop + else + ballstop swap - to ballstop + ballstop 0<= if + 0 to ballstop + then + then + then +; + +0 value batx +: movebatup ( oldp delta -- ) + 2dup >r >r ( oldp delta r: delta oldp ) + erasecol batx r> batsize + r@ + ballsize r> negate paintrect + + >r >r ( r: delta oldp ) + drawcol batx r> r@ + ballsize r> negate paintrect +; + +: movebatdown ( oldp delta -- ) + 2dup >r >r ( oldp delta r: delta oldp ) + erasecol batx r> ballsize r> paintrect + + >r >r ( r: delta oldp ) + drawcol batx r> batsize + ballsize r> paintrect +; + +: movebat ( n oldy newy -- ) + rot calcbatx to batx swap ( newy oldy ) + over unscale over unscale - ( newy oldy deltay ) + dup abs batsize < if ( newy oldy deltay ) + dup if ( newy oldy deltay ) + dup 0< if ( newy oldy deltay ) + swap unscale swap movebatup ( newy ) + else + swap unscale swap movebatdown ( newy ) + then ( newy ) + drop ( ) + else ( newy oldy deltay ) + 3drop ( ) + then ( ) + else ( newy oldy deltay ) + drop ( newy oldy ) + batx swap erasebat ( newy ) + batx swap plotbat ( ) + then +; + +: updatebats ( deltat -- ) + >r + 0 leftbaty 0 ( n oldy deltay ) + + over bat_limit_lo_y > if + key_left_up if batdy - then + then + + over bat_limit_hi_y < if + key_left_down if batdy + then + then + + r@ * ( n oldy deltay' ) \ Scale by the elapsed time + over + ( n oldy newy ) + dup to leftbaty ( n oldy newy ) + movebat + + 1 rightbaty 0 ( 1 right dy ) + + over bat_limit_lo_y > if + key_right_up if batdy - then + then + + over bat_limit_hi_y < if + key_right_down if batdy + then + then + + r> * over + + dup to rightbaty + movebat +; + +: initeverything ( -- ) + cr + 0 to loopcount + 0 to totalupdate + initlimits + initvalues + initkeys + doreset + get-msecs to glastupdate +; + +: doloop ( deltat -- ) + loopcount 1 + to loopcount + dup totalupdate + to totalupdate + + dup updatebats + dup updateball + redraw + + glastupdate + to glastupdate +; + +: pong ( -- ) + initeverything + begin + get-msecs glastupdate - + dup 0> if + dup 250 > if + drop + get-msecs to glastupdate + 250 + then + doloop + else + drop + then + scankeys + key_esc if doreset begin scankeys key_esc 0= until then + key_off until + restorekeys + h# ffff 0 0 screenw screenh paintrect + page +\ " Count:" type loopcount .d cr +\ " Avg millisec:" type totalupdate loopcount / .d cr +; + +hex + +\ pong

1 0

r537 - ofw/inetv6
by svn＠openbios.org 15 Aug '07

15 Aug '07

Author: wmb Date: 2007-08-15 05:02:27 +0200 (Wed, 15 Aug 2007) New Revision: 537 Modified: ofw/inetv6/tcpv6.fth Log: IPv6 stack - fixed a heap corruption bug that results from trying to checksum an IPv4 packet using IPv6 rules. This isn't the ultimate fix, but it helps. Modified: ofw/inetv6/tcpv6.fth =================================================================== --- ofw/inetv6/tcpv6.fth 2007-08-15 02:28:29 UTC (rev 536) +++ ofw/inetv6/tcpv6.fth 2007-08-15 03:02:27 UTC (rev 537) @@ -2497,8 +2497,7 @@ flush-writes flush-writesv6 alive? if tcp_outputv6 then - drain - drainv6 + use-ipv6? if drainv6 else drain then alive? if tcp_close then ;

1 0

r536 - dev/olpc/kb3700
by svn＠openbios.org 15 Aug '07

15 Aug '07

Author: rsmith Date: 2007-08-15 04:28:29 +0200 (Wed, 15 Aug 2007) New Revision: 536 Modified: dev/olpc/kb3700/battery.fth Log: OLPC: Remove some spaces from .bat so that the output will fit on a sigle line OLPL: Prior to when the EC firmware reads the mfg info and battery type from the battery EEPROM or when there is no battery it sets these values to zero make the status indicators just print blanks for zero. Modified: dev/olpc/kb3700/battery.fth =================================================================== --- dev/olpc/kb3700/battery.fth 2007-08-14 19:03:40 UTC (rev 535) +++ dev/olpc/kb3700/battery.fth 2007-08-15 02:28:29 UTC (rev 536) @@ -58,12 +58,14 @@ : .bat-type ( -- ) bat-type@ dup 4 rshift case ( type ) + 0 of ." " endof 1 of ." GPB " endof 2 of ." BYD " endof ." UnknownVendor " endcase ( type ) h# 0f and case ( ) + 0 of ." " endof 1 of ." NiMH " endof 2 of ." LiFePO4 " endof ." UnknownType " @@ -79,16 +81,16 @@ : .% ( n -- ) 2.d ." %" ; : .bat ( -- ) bat-status@ ( stat ) - ." AC: " dup h# 10 and if ." on " else ." off " then ( stat ) - ." PCB: " pcb-temp 2.d ." C " + ." AC: " dup h# 10 and if ." on " else ." off " then ( stat ) + ." PCB: " pcb-temp 2.d ." C " dup 1 and if ." Battery: " .bat-type - soc .% ." " - uvolt@ .milli ." V " - cur@ .milli ." A " - bat-temp 2.d ." C " + soc .% ." " + uvolt@ .milli ." V " + cur@ .milli ." A " + bat-temp 2.d ." C " dup 2 and if ." full " then dup 4 and if ." low " then dup 8 and if ." error " then

1 0

r535 - cpu/x86/pc/olpc
by svn＠openbios.org 14 Aug '07

14 Aug '07

Author: wmb Date: 2007-08-14 21:03:40 +0200 (Tue, 14 Aug 2007) New Revision: 535 Added: cpu/x86/pc/olpc/nandstat.fth Modified: cpu/x86/pc/olpc/copynand.fth Log: OLPC copy-nand - graphic display of progress. Modified: cpu/x86/pc/olpc/copynand.fth =================================================================== --- cpu/x86/pc/olpc/copynand.fth 2007-08-14 16:05:09 UTC (rev 534) +++ cpu/x86/pc/olpc/copynand.fth 2007-08-14 19:03:40 UTC (rev 535) @@ -17,6 +17,8 @@ : >crc ( index -- crc ) crc-buf swap la+ l@ ; +: $call-nand ( ?? method$ -- ?? ) nandih $call-method ; + : close-nand-ihs ( -- ) fileih ?dup if 0 to fileih close-dev 0 to #image-eblocks then nandih ?dup if 0 to nandih close-dev 0 to #nand-pages then @@ -44,11 +46,11 @@ : open-nand ( -- ) " /nandflash" open-dev to nandih nandih 0= " Can't open NAND FLASH device" ?nand-abort - " erase-size" nandih $call-method to /nand-block - " block-size" nandih $call-method to /nand-page - " size" nandih $call-method /nand-page um/mod nip to #nand-pages + " erase-size" $call-nand to /nand-block + " block-size" $call-nand to /nand-page + " size" $call-nand /nand-page um/mod nip to #nand-pages /nand-block /nand-page / to nand-pages/block - " start-scan" nandih $call-method + " start-scan" $call-nand ; h# 20 buffer: line-buf @@ -131,6 +133,34 @@ #crc-records if check-mem-crc else drop then ; +defer show-erasing ( #blocks -- ) +: (show-erasing) ( #blocks -- ) ." Erasing " . ." blocks" cr ; +' (show-erasing) is show-erasing + +defer show-erased +: (show-erased) ( block# -- ) (cr . ; +' (show-erased) is show-erased + +defer show-bad +: (show-bad) ( block# -- ) drop ; +' (show-bad) is show-bad + +defer show-clean +: (show-clean) ( block# -- ) drop ; +' (show-clean) is show-clean + +defer show-cleaning +: (show-cleaning) ( -- ) cr ." Cleanmarkers" cr ; +' (show-cleaning) is show-cleaning + +defer show-writing ( #blocks -- ) +: (show-writing) ." Writing " . ." blocks" cr ; +' (show-writing) is show-writing + +defer show-written +: (show-written) ( block# -- ) (cr . ; +' (show-written) is show-written + : copy-nand ( "devspec" -- ) open-nand get-img-filename @@ -139,21 +169,21 @@ ['] noop to show-progress - ." Erasing..." cr - " wipe" nandih $call-method + #nand-pages nand-pages/block / show-erasing + ['] show-bad ['] show-erased " (wipe)" $call-nand - cr ." Writing " #image-eblocks . ." blocks" cr + #image-eblocks show-writing #image-eblocks 0 ?do - (cr i . read-image-block i ?check-crc - load-base " copy-block" nandih $call-method ( error? ) - " Error writing to NAND FLASH" ?nand-abort + load-base " copy-block" $call-nand ( page# error? ) + " Error writing to NAND FLASH" ?nand-abort ( page# ) + nand-pages/block / show-written ( ) loop - cr ." Filling with cleanmarkers ..." - " put-cleanmarkers" nandih $call-method cr + show-cleaning + ['] show-clean " put-cleanmarkers" $call-nand close-nand-ihs ; @@ -169,10 +199,10 @@ #image-eblocks 0 ?do (cr i . read-image-block - load-base /nand-block + " read-next-block" nandih $call-method ( ) + load-base /nand-block + " read-next-block" $call-nand ( ) load-base load-base /nand-block + /nand-block comp if ( ) cr ." Miscompare in block starting at page# " ( ) - " scan-page#" nandih $call-method .x cr ( ) + " scan-page#" $call-nand .x cr ( ) ?key-stop then ( ) repeat ( ) @@ -210,13 +240,13 @@ #crc-records 0 ?do (cr i . - load-base " read-next-block" nandih $call-method ( ) + load-base " read-next-block" $call-nand ( ) load-base /nand-block $crc i >crc ( actual-crc expected-crc ) 2dup <> if ( actual-crc expected-crc ) cr ." CRC miscompare - expected " . ." got " . ( ) ." in NAND block starting at page " - " scan-page#" nandih $call-method . cr + " scan-page#" $call-nand . cr ?key-stop else ( actual-crc expected-crc ) 2drop ( ) @@ -255,13 +285,13 @@ \ The stack is empty at the end of each line unless otherwise noted #nand-pages 0 do (cr i . - load-base i nand-pages/block " read-blocks" nandih $call-method + load-base i nand-pages/block " read-blocks" $call-nand nand-pages/block = if load-base /nand-block written? if load-base /nand-block " write" fileih $call-method drop dump-oob? if i nand-pages/block bounds ?do - i " read-oob" nandih $call-method h# 40 ( adr len ) + i " read-oob" $call-nand h# 40 ( adr len ) " write" fileih $call-method drop i pad ! pad 4 " write" fileih $call-method drop loop @@ -284,7 +314,7 @@ fileih 0= " Can't open NAND fastboot image file" ?nand-abort " size" fileih $call-method drop ( len ) - " start-fastcopy" nandih $call-method ( error? ) + " start-fastcopy" $call-nand ( error? ) " Not enough spare NAND space for fast copy" ?nand-abort begin ( ) @@ -293,10 +323,10 @@ \ If the read didn't fill a complete block, zero the rest load-base /nand-block rot /string erase - load-base " next-fastcopy" nandih $call-method ( ) + load-base " next-fastcopy" $call-nand ( ) repeat ( len ) drop ( ) - " end-fastcopy" nandih $call-method ( ) + " end-fastcopy" $call-nand ( ) close-nand-ihs ; Added: cpu/x86/pc/olpc/nandstat.fth =================================================================== --- cpu/x86/pc/olpc/nandstat.fth (rev 0) +++ cpu/x86/pc/olpc/nandstat.fth 2007-08-14 19:03:40 UTC (rev 535) @@ -0,0 +1,75 @@ +purpose: Graphical status display of NAND FLASH updates +\ See license at end of file + +d# 24 d# 24 2value ulhc + +d# 22 constant status-line + +8 constant glyph-w +8 constant glyph-h + +9 constant grid-w +9 constant grid-h + +d# 128 value #cols +: xy* ( x y w h -- x*w y*h ) rot * >r * r> ; + +\ States: 0:erased 1:bad 2:waiting for write 3:written + +: >loc ( eblock# -- ) #cols /mod grid-w grid-h xy* ulhc d+ ; + +: show-state ( eblock# state -- ) + swap >loc glyph-w glyph-h " fill-rectangle" $call-screen +; + +dev screen : erase-screen erase-screen ; dend + +h# 80 h# 80 h# 80 rgb>565 constant bbt-color + +: gshow-erasing ( #eblocks -- ) + cursor-off " erase-screen" $call-screen 0 status-line at-xy + ." Erasing " + + " bbt0" $call-nand nand-pages/block / bbt-color show-state + " bbt1" $call-nand nand-pages/block / bbt-color show-state + + h# ff h# ff h# ff rgb>565 ( #eblocks color ) + swap 0 ?do i over show-state loop + drop +; + +: gshow-erased ( eblock# -- ) 0 0 0 rgb>565 show-state ; + +: gshow-bad ( eblock# -- ) h# ff 0 0 rgb>565 show-state ; + +: gshow-cleaning ( -- ) ." Cleanmarkers" cr cursor-on ; +: gshow-clean ( eblock# -- ) h# 0 0 ff rgb>565 show-state ; + +: gshow-writing ( #eblocks -- ) + ." Writing " + h# ff h# ff 0 rgb>565 ( #eblocks color ) + 0 rot 0 ?do ( color eblock# ) + dup nand-pages/block * " block-bad?" $call-nand 0= if ( color eblock# ) + 2dup swap show-state + 1 + else + 0 + then + swap 1+ swap + +loop + drop +; + +: gshow-written ( eblock# -- ) 0 h# ff 0 rgb>565 show-state ; + +: gshow + ['] gshow-erasing to show-erasing + ['] gshow-erased to show-erased + ['] gshow-bad to show-bad + ['] gshow-clean to show-clean + ['] gshow-cleaning to show-cleaning + ['] gshow-writing to show-writing + ['] gshow-written to show-written +; + +gshow

1 0

r534 - ofw/inetv6
by svn＠openbios.org 14 Aug '07

14 Aug '07

Author: lwalter Date: 2007-08-14 18:05:09 +0200 (Tue, 14 Aug 2007) New Revision: 534 Modified: ofw/inetv6/arp.fth ofw/inetv6/dhcp.fth ofw/inetv6/dns.fth ofw/inetv6/dnsv6.fth ofw/inetv6/ethernet.fth ofw/inetv6/ip.fth ofw/inetv6/ipv6.fth ofw/inetv6/neighdis.fth ofw/inetv6/netload.fth Log: Use IPv4 DNS server to get IPv6 address; Use gateway when his-ip-addr is not local Modified: ofw/inetv6/arp.fth =================================================================== --- ofw/inetv6/arp.fth 2007-08-10 10:36:53 UTC (rev 533) +++ ofw/inetv6/arp.fth 2007-08-14 16:05:09 UTC (rev 534) @@ -158,7 +158,11 @@ broadcast-en-addr his-en-addr copy-en-addr ( ip-type ) else ( ip-type 'ip-adr ) his-ip-addr copy-ip-addr ( ip-type ) - his-en-addr broadcast-en-addr en= if do-arp then ( ip-type ) + his-ip-addr my-ip-addr ip-prefix=? if + his-en-addr broadcast-en-addr en= if do-arp then ( ip-type ) + else + router-en-addr his-en-addr copy-en-addr \ Not local, go through the gateway + then then his-en-addr swap exit then ( 'dest-adr type ) Modified: ofw/inetv6/dhcp.fth =================================================================== --- ofw/inetv6/dhcp.fth 2007-08-10 10:36:53 UTC (rev 533) +++ ofw/inetv6/dhcp.fth 2007-08-14 16:05:09 UTC (rev 534) @@ -249,6 +249,7 @@ 0 file-name-buf c! unknown-ip-addr name-server-ip copy-ip-addr unknown-ip-addr dhcp-server-ip copy-ip-addr + unknown-ip-addr name-server-ip-slave copy-ip-addr ; also forth definitions @@ -483,7 +484,9 @@ then then - d# 6 find-option if drop name-server-ip copy-ip-addr then + d# 6 find-option if over name-server-ip copy-ip-addr + 4 > if 4 + name-server-ip-slave copy-ip-addr else drop then + then d# 28 find-option if drop broadcast-ip-addr copy-ip-addr then d# 15 find-option if 'domain-name place-cstr drop then d# 12 find-option if 'client-name place-cstr drop then @@ -493,8 +496,11 @@ bootnet-debug if indent ." Received DHCP ACK" cr name-server-ip known? if - indent indent ." Name server: " name-server-ip .ipaddr cr + indent indent ." Master name server: " name-server-ip .ipaddr cr then + name-server-ip-slave known? if + indent indent ." Slave name server: " name-server-ip-slave .ipaddr cr + then broadcast-ip-addr if indent indent ." IP broadcast: " broadcast-ip-addr (.ipaddr) cr then Modified: ofw/inetv6/dns.fth =================================================================== --- ofw/inetv6/dns.fth 2007-08-10 10:36:53 UTC (rev 533) +++ ofw/inetv6/dns.fth 2007-08-14 16:05:09 UTC (rev 534) @@ -13,10 +13,20 @@ \ DNS question format: QNAME-variable_length, QTYPE(/w), QCLASS(/w) \ QTYPE value for "A" (host name) is 1 +\ QTYPE value for "AAAA" (IPv6 hostname) is h# 1c \ QCLASS value for "IN" (Internet) is 1 -d# 1022 value fw-port# +\ d# 1022 value fw-port# \ It's been assigned by IANA. +h# 800a constant fw-port# \ It's unassigned as of 8/13/2007. +d# 2000 constant dns-timeout + +2 value #retries-a +2 value #retries-aaaa + +0 value qtype +1 constant qclass + \ Encode/decode various DNS data types : +dnsw ( w -- ) wbsplit +xb +xb ; : -dnsw ( -- w ) -xb -xb swap bwjoin ; @@ -109,7 +119,7 @@ \ ID flags #questions #answers #namesrvrs #additional dns-xid +dnsw h# 100 +dnsw 1 +dnsw 0 +dnsw 0 +dnsw 0 +dnsw +dns-host - 1 +dnsw 1 +dnsw + qtype +dnsw qclass +dnsw x$ fw-port# dns-port# send-udp-packet r> /dns-query free-udp ; @@ -164,7 +174,7 @@ -dnsw -dnsw wljoin ( class.type ) -dnsl drop ( class.type ) \ Discard TTL - h# 1.0001 = if ( ) + qtype qclass wljoin = if ( ) -dnsw drop \ Discard RDLENGTH (it better be 4!) x$ drop true ( 'ip true ) else ( ) @@ -192,21 +202,25 @@ \ The host name can be either a simple name (e.g. "pi") or a \ fully-qualified domain name (e.g. "pi.firmworks.com"). : try-resolve ( hostname$ -- 'ip ) - name-server-ip set-dest-ip ( hostname$ ) - d# 2000 set-timeout ( hostname$ ) - send-dns-query ( ) - dns-xid dns-port# fw-port# receive-dns-reply ( error? ) - 1 and throw ( ) - get-host-addr ( answer-ip ) + dns-timeout set-timeout ( hostname$ ) + send-dns-query ( ) + dns-xid dns-port# fw-port# receive-dns-reply ( error? ) + 1 and throw ( ) + get-host-addr ( answer-ip ) ; -: (resolve) ( hostname$ -- ) - bootnet-debug if ( hostname$ ) - ." Using DNS to find the IP address of " ( hostname$ ) - 2dup type cr ( hostname$ ) - then ( hostname$ ) +: resolve-a ( hostname$ -- 'ip ) + bootnet-debug if ( hostname$ ) + ." Using DNS to find the IP address of " ( hostname$ ) + 2dup type cr ( hostname$ ) + then ( hostname$ ) - d# 20 0 do \ Try 20 times at 2 seconds per try - 2dup ['] try-resolve catch ?dup if ( hostname$ x x err ) + 1 to qtype + #retries-a 0 do \ Try 20 times at 2 seconds per try + name-server-ip set-dest-ip + i 1 and if + name-server-ip-slave known? if name-server-ip-slave set-dest-ip then + then + 2dup ['] try-resolve catch ?dup if ( hostname$ x x err ) nip nip ( hostname$ err ) 1 <> if ( hostname$ ) bootnet-debug if ( hostname$ ) @@ -214,21 +228,66 @@ then ( hostname$ ) true abort" Unknown hostname" then ( hostname$ ) - else ( hostname$ 'ip ) - bootnet-debug if ( hostname$ 'ip ) - ." Got IP address " dup .ipaddr cr ( hostname$ 'ip ) - then ( hostname$ 'ip ) + else ( hostname$ 'ip ) + bootnet-debug if ( hostname$ 'ip ) + indent ." Got IP address " dup .ipaddr cr ( hostname$ 'ip ) + then ( hostname$ 'ip ) - nip nip ( 'ip ) + nip nip ( 'ip ) unloop exit - then ( hostname$ ) - loop ( hostname$ ) + then ( hostname$ ) + loop ( hostname$ ) - bootnet-debug if ." No answer to DNS request" cr then ( hostname$ ) + bootnet-debug if ." No answer to DNS A request" cr then ( hostname$ ) true abort" DNS: No answer" ; -\ : resolve ( 'ip hostname$ -- ) (resolve) swap copy-ip-addr ; +[ifdef] include-ipv6 +: resolve-aaaa ( hostname$ -- ) + bootnet-debug if ( hostname$ ) + ." Using DNS AAAA to find the IPv6 address of " ( hostname$ ) + 2dup type cr ( hostname$ ) + then + + h# 1c to qtype + #retries-aaaa 0 do \ Try 20 times at 2 seconds per try + name-server-ip set-dest-ip + i 1 and if + name-server-ip-slave known? if name-server-ip-slave set-dest-ip then + then + 2dup ['] try-resolve catch ?dup if ( hostname$ x x err ) + nip nip ( hostname$ err ) + 1 <> if ( hostname$ ) + bootnet-debug if ( hostname$ ) + indent ." Unknown IPv6 hostname: " 2dup type cr ( hostname ) + then ( hostname$ ) + true abort" Unknown IPv6 hostname" + then ( hostname$ ) + else ( hostname$ 'ip ) + bootnet-debug if ( hostname$ 'ip ) + indent ." Got IPv6 address " dup .ipv6 cr ( hostname$ 'ip ) + then ( hostname$ 'ip ) + + set-dest-ipv6 2drop ( ) + unloop exit + then ( hostname$ ) + loop ( hostname$ ) + + bootnet-debug if indent ." No answer to DNS AAAA request" cr then ( hostname$ ) + true abort" DNS AAAA: No answer" +; +[else] +: resolve-aaaa ( hostname$ -- ) abort" IPv4 AAAA DNS not supported" ; +[then] + +false value resolve-flag +: resolvev4 ( hostname$ -- ) + false to resolve-flag + 2dup ['] resolve-a catch if 2drop else true to resolve-flag set-dest-ip then + ['] resolve-aaaa catch if 2drop else true to resolve-flag then + resolve-flag not abort" DNS: No answer" +; + headerless : ?bad-ip ( flag -- ) abort" Bad host name or address" ; 4 buffer: ip-buf @@ -245,8 +304,7 @@ headers : $set-host ( hostname$ -- ) dup 0= ?bad-ip - over c@ [char] 0 [char] 9 between if $>ip else (resolve) then - set-dest-ip + over c@ [char] 0 [char] 9 between if $>ip set-dest-ip else resolvev4 then ; \ LICENSE_BEGIN \ Copyright (c) 2006 FirmWorks Modified: ofw/inetv6/dnsv6.fth =================================================================== --- ofw/inetv6/dnsv6.fth 2007-08-10 10:36:53 UTC (rev 533) +++ ofw/inetv6/dnsv6.fth 2007-08-14 16:05:09 UTC (rev 534) @@ -7,26 +7,46 @@ [ifndef] include-ipv4 : $>ip ( hostname$ -- 'ip ) .ipv4-not-supported ; -: (resolve) ( hostname$ -- 'ip ) .ipv4-not-supported ; +: resolvev4 ( hostname$ -- ) .ipv4-not-supported ; : set-dest-ip ( buf -- ) .ipv4-not-supported ; : ?bad-ip ( flag -- ) abort" Bad host name or address" ; [then] +: resolvev6 ( hostname$ -- ) + true to use-ipv6? + unknown-ipv6-addr his-ipv6-addr copy-ipv6-addr + abort" IPv6 DNS not supported yet" +; + headers -: (resolvev6) ( hostname$ -- 'ip ) ; \ XXX Try (resolve) or (resolve6) first. If fail, try the other one. -: (resolve) ( hostname$ -- 'ip ) - use-ipv6? if (resolvev6) true else (resolve) false then - dup to use-ipv6? - if set-dest-ipv6 else set-dest-ip then +: (resolve) ( hostname$ -- ) + 2dup ['] resolvev6 catch if + 2drop + false to use-ipv6? + resolvev4 + else + 2drop + then + use-ipv6-ok? dup to use-ipv6? if \ Make sure all the addresses are set properly + his-ipv6-addr (set-dest-ipv6) + bootnet-debug if ." Use IPv6 protocol" cr then + else + his-ip-addr (set-dest-ip) + bootnet-debug if ." Use IP protocol" cr then + then ; : $set-host ( hostname$ -- ) dup 0= ?bad-ip 2dup ['] $>ip catch if 2drop else false to use-ipv6? set-dest-ip 2drop exit then - 2dup ipv6-buf ['] $ipv6# catch nip nip not if true to use-ipv6? ipv6-buf set-dest-ipv6 exit then - (resolve) + 2dup ipv6-buf ['] $ipv6# catch if + 3drop (resolve) + else + 2drop + true to use-ipv6? ipv6-buf set-dest-ipv6 + then ; \ LICENSE_BEGIN Modified: ofw/inetv6/ethernet.fth =================================================================== --- ofw/inetv6/ethernet.fth 2007-08-10 10:36:53 UTC (rev 533) +++ ofw/inetv6/ethernet.fth 2007-08-14 16:05:09 UTC (rev 534) @@ -39,11 +39,13 @@ /e buffer: my-en-addr /e buffer: his-en-addr -/e buffer: routerv6-en-addr +/e buffer: router-en-addr \ IPv4 gateway/router +/e buffer: routerv6-en-addr \ IPv6 router /e buffer: mc-en-addr -: .my-link-addr ( -- ) ." My MAC: " my-en-addr .enaddr ; -: .his-link-addr ( -- ) ." His MAC: " his-en-addr .enaddr ; +: .my-link-addr ( -- ) ." My MAC: " my-en-addr .enaddr ; +: .his-link-addr ( -- ) ." His MAC: " his-en-addr .enaddr ; +: .router-en-addr ( -- ) ." Gateway MAC: " router-en-addr .enaddr ; : .routerv6-en-addr ( -- ) ." IPv6 router MAC: " routerv6-en-addr .enaddr ; create mc-en-addr-all-nodes h# 33 c, h# 33 c, h# 00 c, 0 c, 0 c, 1 c, Modified: ofw/inetv6/ip.fth =================================================================== --- ofw/inetv6/ip.fth 2007-08-10 10:36:53 UTC (rev 533) +++ ofw/inetv6/ip.fth 2007-08-14 16:05:09 UTC (rev 534) @@ -42,6 +42,7 @@ headers /i buffer: his-ip-addr /i buffer: name-server-ip +/i buffer: name-server-ip-slave ' 'domain-name " domain-name" chosen-string headerless @@ -125,13 +126,12 @@ 0 instance value last-ip-packet headers +: (set-dest-ip) ( buf -- ) + his-ip-addr copy-ip-addr + unlock-link-addr +; : set-dest-ip ( buf -- ) - dup his-ip-addr ip= if - drop - else - his-ip-addr copy-ip-addr - unlock-link-addr - then + dup his-ip-addr ip= if drop else (set-dest-ip) then ; : lock-ip-address ( -- ) Modified: ofw/inetv6/ipv6.fth =================================================================== --- ofw/inetv6/ipv6.fth 2007-08-10 10:36:53 UTC (rev 533) +++ ofw/inetv6/ipv6.fth 2007-08-14 16:05:09 UTC (rev 534) @@ -135,6 +135,10 @@ : ipv6-addr-local? ( adr-buf -- flag ) c@ h# e0 and h# 20 <> ; : use-routerv6? ( -- flag ) routerv6-en-addr unknown-en-addr? not ; +: use-ipv6-ok? ( -- flag ) + his-ipv6-addr knownv6? + his-ipv6-addr ipv6-addr-local? not if use-routerv6? and then +; /ipv6 buffer: server-ipv6-addr : use-serverv6? ( -- flag ) server-ipv6-addr knownv6? ; @@ -174,22 +178,21 @@ [then] headers -: set-dest-ipv6 ( buf -- ) - dup his-ipv6-addr ipv6= if - drop +: (set-dest-ipv6) ( buf -- ) + his-ipv6-addr copy-ipv6-addr + set-his-ipv6-addr-mc + his-ipv6-addr ipv6-addr-local? if + unlock-link-addr + my-ipv6-addr-link-local else - his-ipv6-addr copy-ipv6-addr - set-his-ipv6-addr-mc - his-ipv6-addr ipv6-addr-local? if - unlock-link-addr - my-ipv6-addr-link-local - else - use-routerv6? if routerv6-en-addr his-en-addr copy-en-addr then - my-ipv6-addr-global - then - my-ipv6-addr copy-ipv6-addr + use-routerv6? if routerv6-en-addr his-en-addr copy-en-addr then + my-ipv6-addr-global then + my-ipv6-addr copy-ipv6-addr ; +: set-dest-ipv6 ( buf -- ) + dup his-ipv6-addr ipv6= if drop else (set-dest-ipv6) then +; : lock-ipv6-address ( -- ) the-struct >r last-ip-packet set-struct Modified: ofw/inetv6/neighdis.fth =================================================================== --- ofw/inetv6/neighdis.fth 2007-08-10 10:36:53 UTC (rev 533) +++ ofw/inetv6/neighdis.fth 2007-08-14 16:05:09 UTC (rev 534) @@ -27,8 +27,8 @@ /ipv6 buffer: his-ipv6-addr-temp : do-neighbor-discovery ( -- ) bootnet-debug if - ." ICMPv6 ND protocol: Getting MAC address for IP address: " - his-ipv6-addr .ipv6 cr + ." ICMPv6 ND protocol: Getting MAC address for IPv6 address: " cr + indent his-ipv6-addr .ipv6 cr then his-ipv6-addr his-ipv6-addr-temp copy-ipv6-addr @@ -56,7 +56,11 @@ broadcast-en-addr his-en-addr copy-en-addr ( ip-type ) else ( ip-type 'ip-adr ) his-ip-addr copy-ip-addr ( ip-type ) - his-en-addr broadcast-en-addr en= if do-arp then ( ip-type ) + his-ip-addr my-ip-addr ip-prefix=? if + his-en-addr broadcast-en-addr en= if do-arp then ( ip-type ) + else + router-en-addr his-en-addr copy-en-addr + then then his-en-addr swap [then] @@ -76,7 +80,7 @@ bootnet-debug if ." My IPv6 configuration (stateless autoconfiguration): " cr indent .my-ipv6-addr-link-local cr - my-ipv6-addr-global unknown-ipv6-addr? not if + my-ipv6-addr-global knownv6? if indent .my-ipv6-addr-global cr indent .my-prefix cr then Modified: ofw/inetv6/netload.fth =================================================================== --- ofw/inetv6/netload.fth 2007-08-10 10:36:53 UTC (rev 533) +++ ofw/inetv6/netload.fth 2007-08-14 16:05:09 UTC (rev 534) @@ -26,7 +26,9 @@ ; : show-router-addr ( -- ) - bootnet-debug if ." Router IP: = " router-ip-addr .ipaddr cr then + bootnet-debug if + .router-en-addr ." Router IP: = " router-ip-addr .ipaddr cr + then ; : show-all-en-ip-address ( -- ) @@ -102,6 +104,7 @@ indent ." Boot server: " server-ip-addr .ipaddr cr then use-router? if + indent .router-en-addr cr indent ." Router: " router-ip-addr .ipaddr cr then then @@ -400,6 +403,12 @@ 2drop false ; +: resolve-router-en-addr ( -- ) + router-ip-addr his-ip-addr copy-ip-addr + do-arp + his-en-addr router-en-addr copy-en-addr +; + defer configured ' noop to configured : configure ( -- ) use-last? if configured exit then @@ -430,6 +439,7 @@ server-ip-addr set-dest-ip then then + use-router? if resolve-router-en-addr then \ Find router's MAC address show-all-en-ip-address configured ;

1 0

r169 - openbios-devel/arch/sparc32
by svn＠openbios.org 11 Aug '07

11 Aug '07

Author: blueswirl Date: 2007-08-11 09:45:33 +0200 (Sat, 11 Aug 2007) New Revision: 169 Modified: openbios-devel/arch/sparc32/romvec.c Log: Fix NetBSD property problems Modified: openbios-devel/arch/sparc32/romvec.c =================================================================== --- openbios-devel/arch/sparc32/romvec.c 2007-08-05 18:01:20 UTC (rev 168) +++ openbios-devel/arch/sparc32/romvec.c 2007-08-11 07:45:33 UTC (rev 169) @@ -86,6 +86,11 @@ { int notfound; + if (!node) { + DPRINTF("obp_proplen(0x0, %s) = -1\n", name); + return -1; + } + push_str(name); PUSH(node); fword("get-package-property"); @@ -127,6 +132,11 @@ int len; char *str; + if (!node) { + DPRINTF("obp_getprop(0x0, %s) = -1\n", name); + return -1; + } + if (!name) { // NULL name means get first property push_str("");

1 0

r533 - cpu/x86/pc/olpc
by svn＠openbios.org 10 Aug '07

10 Aug '07

Author: rsmith Date: 2007-08-10 12:36:53 +0200 (Fri, 10 Aug 2007) New Revision: 533 Modified: cpu/x86/pc/olpc/versions.fth Log: OLPC: Ver q2c23 Modified: cpu/x86/pc/olpc/versions.fth =================================================================== --- cpu/x86/pc/olpc/versions.fth 2007-08-10 02:06:46 UTC (rev 532) +++ cpu/x86/pc/olpc/versions.fth 2007-08-10 10:36:53 UTC (rev 533) @@ -2,10 +2,10 @@ \ The overall firmware revision macro: FW_MAJOR C -macro: FW_MINOR 22 +macro: FW_MINOR 23 \ The EC microcode -macro: EC_VERSION c20 +macro: EC_VERSION c23 \ Alternate command for getting EC microcode, for testing new versions. \ Temporarily uncomment the line and modify the path as necessary

1 0

r532 - ofw/inetv6
by svn＠openbios.org 10 Aug '07

10 Aug '07

Author: lwalter Date: 2007-08-10 04:06:46 +0200 (Fri, 10 Aug 2007) New Revision: 532 Modified: ofw/inetv6/ethernet.fth Log: Send multiple multicast addresses to set-multicast Modified: ofw/inetv6/ethernet.fth =================================================================== --- ofw/inetv6/ethernet.fth 2007-08-09 21:42:49 UTC (rev 531) +++ ofw/inetv6/ethernet.fth 2007-08-10 02:06:46 UTC (rev 532) @@ -66,9 +66,13 @@ ; : set-mc-hash ( -- err? ) - \ XXX Make buffer of all multicast addresses for "set-multicast" my-en-addr 3 + multicast-en-addr 3 + 3 move - multicast-en-addr /e " set-multicast" ['] $call-parent catch 0= if false exit then + /e 2 * dup >r alloc-mem >r ( R: len adr ) + multicast-en-addr r@ /e move ( R: len adr ) + mc-en-addr-all-nodes r@ /e + /e move ( R: len adr ) + 2r@ swap " set-multicast" ['] $call-parent catch ( flag ) ( R: len adr ) + 2r> swap free-mem ( flag ) + 0= if false exit then 4drop multicast-en-addr (set-mc-hash) mc-en-addr-all-nodes (set-mc-hash) or

1 0

r531 - ofw/inetv6
by svn＠openbios.org 09 Aug '07

09 Aug '07

Author: lwalter Date: 2007-08-09 23:42:49 +0200 (Thu, 09 Aug 2007) New Revision: 531 Modified: ofw/inetv6/attr-ipv6.fth ofw/inetv6/ethernet.fth ofw/inetv6/icmpinfo.fth ofw/inetv6/icmpv6.fth ofw/inetv6/ipfrv6.fth ofw/inetv6/ippkg.fth ofw/inetv6/ipv6.fth ofw/inetv6/neighdis.fth ofw/inetv6/supportv6.fth ofw/inetv6/tcpv6.fth Log: DAD, Router Discovery, route global IPv6 packets via router discovered Modified: ofw/inetv6/attr-ipv6.fth =================================================================== --- ofw/inetv6/attr-ipv6.fth 2007-08-08 03:14:05 UTC (rev 530) +++ ofw/inetv6/attr-ipv6.fth 2007-08-09 21:42:49 UTC (rev 531) @@ -23,10 +23,11 @@ : (setup-ipv6-attr) ( -- ) \ set tftp ip addresses (setup-ip-attr) - my-ipv6-addr /ipv6 " client-ipv6" set-chosen-property - his-ipv6-addr /ipv6 " server-ipv6" set-chosen-property - router-ipv6-addr /ipv6 " gateway-ipv6" set-chosen-property - my-mc-ipv6-addr /ipv6 " multicast-ipv6" set-chosen-property + my-prefix /ipv6 " ipv6-prefix" set-chosen-property + my-ipv6-addr-link-local /ipv6 " client-ipv6-local" set-chosen-property + my-ipv6-addr-global /ipv6 " client-ipv6-global" set-chosen-property + his-ipv6-addr /ipv6 " server-ipv6" set-chosen-property + router-ipv6-addr /ipv6 " gateway-ipv6" set-chosen-property ; ['] (setup-ipv6-attr) is setup-ip-attr Modified: ofw/inetv6/ethernet.fth =================================================================== --- ofw/inetv6/ethernet.fth 2007-08-08 03:14:05 UTC (rev 530) +++ ofw/inetv6/ethernet.fth 2007-08-09 21:42:49 UTC (rev 531) @@ -39,13 +39,19 @@ /e buffer: my-en-addr /e buffer: his-en-addr +/e buffer: routerv6-en-addr +/e buffer: mc-en-addr : .my-link-addr ( -- ) ." My MAC: " my-en-addr .enaddr ; : .his-link-addr ( -- ) ." His MAC: " his-en-addr .enaddr ; +: .routerv6-en-addr ( -- ) ." IPv6 router MAC: " routerv6-en-addr .enaddr ; -create multicast-en-addr h# 33 c, 33 c, h# ff c, 0 c, 0 c, 0 c, -create broadcast-en-addr h# ff c, ff c, h# ff c, h# ff c, h# ff c, h# ff c, +create mc-en-addr-all-nodes h# 33 c, h# 33 c, h# 00 c, 0 c, 0 c, 1 c, +create multicast-en-addr h# 33 c, h# 33 c, h# ff c, 0 c, 0 c, 0 c, +create broadcast-en-addr h# ff c, h# ff c, h# ff c, h# ff c, h# ff c, h# ff c, +: unknown-en-addr? ( 'en -- flag ) dup l@ 0= swap w@ 0= and ; + decimal struct ( ether-header ) @@ -54,14 +60,22 @@ 2 sfield en-type constant /ether-header +: (set-mc-hash) ( 'mc-en-adr -- err? ) + /e " $crc" evaluate invert + " set-hash" ['] $call-parent catch if 3drop true else false then +; + : set-mc-hash ( -- err? ) - my-ipv6-addr /ipv6 + 3 - multicast-en-addr 3 + 3 move + \ XXX Make buffer of all multicast addresses for "set-multicast" + my-en-addr 3 + multicast-en-addr 3 + 3 move multicast-en-addr /e " set-multicast" ['] $call-parent catch 0= if false exit then 4drop - multicast-en-addr /e " $crc" evaluate invert - " set-hash" ['] $call-parent catch if 3drop true else false then + multicast-en-addr (set-mc-hash) + mc-en-addr-all-nodes (set-mc-hash) or ; +: multicast-en-addr? ( adr -- flag ) w@ h# 3333 = ; + : select-ethernet-header ( -- ) packet-buffer set-struct ; : max-link-payload ( -- n ) link-mtu /ether-header - ; Modified: ofw/inetv6/icmpinfo.fth =================================================================== --- ofw/inetv6/icmpinfo.fth 2007-08-08 03:14:05 UTC (rev 530) +++ ofw/inetv6/icmpinfo.fth 2007-08-09 21:42:49 UTC (rev 531) @@ -11,32 +11,46 @@ : handle-router-sol ( adr len -- ) 2drop ; \ Router solicitation : handle-router-ad ( adr len -- ) 2drop ; \ Router advertisement +: send-router-sol ( -- ) + 8 allocate-icmpv6 set-struct \ Option: source link-layer addr + d# 133 icmp-type xc! + 0 icmp-code xc! + 0 icmp-flags xl! + h# 101 icmp-data xw! \ Option type 1 (source mac addr) + my-en-addr icmp-data 2 + copy-en-addr + + hop-limit >r h# ff to hop-limit + the-struct 8 2dup send-icmpv6-packet + free-icmpv6 + r> to hop-limit +; + : handle-mc-router-ad ( adr len -- ) 2drop ; \ Multicast router advertisement : handle-mc-router-sol ( adr len -- ) 2drop ; \ Multicast router solicitation : handle-mc-router-term ( adr len -- ) 2drop ; \ Multicast router termination -: send-neigh-sol ( -- ) +: send-neigh-sol ( 'ipv6 -- ) d# 24 allocate-icmpv6 set-struct \ Dest IPv6 + one option d# 135 icmp-type xc! 0 icmp-code xc! 0 icmp-flags xl! - his-ipv6-addr icmp-data copy-ipv6-addr + ( 'ipv6 ) icmp-data copy-ipv6-addr h# 101 icmp-data /ipv6 + xw! \ Option type 1 (source mac addr) \ Length (in 8 octels) - my-en-addr icmp-data /ipv6 + 2 + copy-ipv6-addr + my-en-addr icmp-data /ipv6 + 2 + copy-en-addr hop-limit >r h# ff to hop-limit \ Save and change hop-limit - the-struct d# 24 2dup send-mc-icmpv6-packet + the-struct d# 24 2dup send-icmpv6-packet free-icmpv6 r> to hop-limit \ Restore hop-limit ; -: send-neigh-ad ( solicited? -- ) +: send-neigh-ad ( 'ip solicited? -- ) d# 24 allocate-icmpv6 set-struct \ Dest IPv6 + one option d# 136 icmp-type xc! 0 icmp-code xc! h# 40 and h# 20 or icmp-flags xl! \ Flags = (un)solicited, override - my-ipv6-addr icmp-data copy-ipv6-addr + ( 'ip ) icmp-data copy-ipv6-addr h# 201 icmp-data /ipv6 + xw! \ Option type 2 (target mac addr) \ Length (in 8 octels) my-en-addr icmp-data /ipv6 + 2 + copy-ipv6-addr @@ -47,16 +61,31 @@ r> to hop-limit \ Restore hop-limit ; +/ipv6 buffer: his-ipv6-addr-save +/ipv6 buffer: my-ipv6-addr-save : handle-neigh-sol ( adr len -- ) \ Neighbor solicitation \ XXX Verify hop limit is 255. dup d# 24 < if 2drop exit then bootnet-debug if ." Neighbor solicitation from MAC: " over d# 26 + .enaddr cr then - over /icmp-header + my-ipv6-addr ipv6= not if ." Not for me" cr 2drop exit then - 2drop + over /icmp-header + my-ipv6-addr ipv6= not if + bootnet-debug if ." Not for me" cr then + 2drop exit + then + \ XXX Send Neighbor Advertisement - true send-neigh-ad + drop ( adr ) + his-ipv6-addr his-ipv6-addr-save copy-ipv6-addr \ Save his-ipv6-addr + my-ipv6-addr my-ipv6-addr-save copy-ipv6-addr + ipv6-dest-addr c@ dup h# ff = swap h# fe = or if + my-ipv6-addr-link-local else my-ipv6-addr-global + then + my-ipv6-addr copy-ipv6-addr + ipv6-source-addr his-ipv6-addr copy-ipv6-addr \ Use the solicitor's IPv6 addr as dst + /icmp-header + true send-neigh-ad + his-ipv6-addr-save his-ipv6-addr copy-ipv6-addr \ Restore his-ipv6-addr + my-ipv6-addr-save my-ipv6-addr copy-ipv6-addr ; : handle-neigh-ad ( adr len -- ) 2drop ; \ Neighbor advertisement Modified: ofw/inetv6/icmpv6.fth =================================================================== --- ofw/inetv6/icmpv6.fth 2007-08-08 03:14:05 UTC (rev 530) +++ ofw/inetv6/icmpv6.fth 2007-08-09 21:42:49 UTC (rev 531) @@ -50,7 +50,7 @@ /ipv6 buffer: his-ipv6-temp : send-mc-icmpv6-packet ( adr len -- ) \ Send to his multicast IPv6 address his-ipv6-addr his-ipv6-temp copy-ipv6-addr - his-mc-ipv6-addr his-ipv6-addr copy-ipv6-addr + his-ipv6-addr-mc-sol-node his-ipv6-addr copy-ipv6-addr send-icmpv6-packet his-ipv6-temp his-ipv6-addr copy-ipv6-addr ; Modified: ofw/inetv6/ipfrv6.fth =================================================================== --- ofw/inetv6/ipfrv6.fth 2007-08-08 03:14:05 UTC (rev 530) +++ ofw/inetv6/ipfrv6.fth 2007-08-09 21:42:49 UTC (rev 531) @@ -3,32 +3,6 @@ headerless -d# 0 constant IP_HDR_HOP \ Hop-by-hop option -d# 1 constant IP_HDR_ICMPV4 \ Internet control message protocol - IPv4 -d# 2 constant IP_HDR_IGMPV4 \ Internet group management protocol - IPv4 -d# 4 constant IP_HDR_IPV4 -d# 6 constant IP_HDR_TCP -d# 8 constant IP_HDR_EGP \ Exterior gateway protocol -d# 9 constant IP_HDR_IGP \ Cisco private interior gateway -d# 17 constant IP_HDR_UDP -d# 41 constant IP_HDR_IPV6 -d# 43 constant IP_HDR_ROUTING \ Routing header -d# 44 constant IP_HDR_FRAGMENT -d# 45 constant IP_HDR_IDRP \ Interdomain routing protocol -d# 46 constant IP_HDR_RSVP \ Resource reservation protocol -d# 47 constant IP_HDR_GRE \ General routing encapsulation -d# 50 constant IP_HDR_SECURE \ Encrypted security payload -d# 51 constant IP_HDR_AUTHEN \ Authentication -d# 58 constant IP_HDR_ICMPV6 -d# 59 constant IP_HDR_NONE \ No next header -d# 60 constant IP_HDR_DEST \ Destination options -d# 88 constant IP_HDR_EIGRP -d# 89 constant IP_HDR_OSPF -d# 108 constant IP_HDR_COMP \ IP payload compression protocol -d# 115 constant IP_HDR_L2TP \ Layer 2 tunneling protocol -d# 132 constant IP_HDR_SCTP \ Stream control transmission protocol -d# 135 constant IP_HDR_MOBILITY \ Mobile IPV6 - struct ( ipv6-frag-header ) 1 sfield ipv6-fh-next-hdr 1 sfield ipv6-fh-len @@ -48,7 +22,7 @@ constant /ipv6-frag-hdr instance variable frag-id -0 instance value hop-limit +h# 40 instance value hop-limit headers @@ -75,7 +49,8 @@ h# 6000.0000 ipv6-version xl! \ version 6 ( protocol ) ipv6-next-hdr xc! ( len ) ( len ) dup ipv6-length xw! ( len ) - hop-limit ipv6-hop-limit xc! ( len ) + his-ipv6-addr ipv6-addr-local? if hop-limit else router-hop-limit then + ( hop-limit ) ipv6-hop-limit xc! ( len ) my-ipv6-addr ipv6-source-addr copy-ipv6-addr ( len ) his-ipv6-addr ipv6-dest-addr copy-ipv6-addr ( len ) /ipv6-header + ( ip-len ) Modified: ofw/inetv6/ippkg.fth =================================================================== --- ofw/inetv6/ippkg.fth 2007-08-08 03:14:05 UTC (rev 530) +++ ofw/inetv6/ippkg.fth 2007-08-09 21:42:49 UTC (rev 531) @@ -72,7 +72,7 @@ call-tftp: set-dest-ipv6 ( 'ip -- ) call-tftp: max-ipv6-payload ( -- n ) call-tftp: prefix-match? ( 'ip1 'ip2 -- flag ) -call-tftp: his-mc-ipv6-addr? ( 'ip -- flag ) +call-tftp: his-ipv6-addr-mc? ( 'ip -- flag ) [then] call-tftp: set-timeout ( #milliseconds -- ) Modified: ofw/inetv6/ipv6.fth =================================================================== --- ofw/inetv6/ipv6.fth 2007-08-08 03:14:05 UTC (rev 530) +++ ofw/inetv6/ipv6.fth 2007-08-09 21:42:49 UTC (rev 531) @@ -4,6 +4,14 @@ \ Internet protocol version 6 (IPv6). +\ IPv6 refixes: +\ ::0/8 unaligned +\ 2000::/3 global unicast +\ fe80::/10 link-local unicast +\ fc00::/7 site-local IPv6 address +\ fd00::/8 private administration +\ ff00::/8 multicast + decimal headerless @@ -26,24 +34,60 @@ \ There maybe extension headers here. constant /ipv6-header +\ Values of ipv6-next-hdr +d# 0 constant IP_HDR_HOP \ Hop-by-hop option +d# 1 constant IP_HDR_ICMPV4 \ Internet control message protocol - IPv4 +d# 2 constant IP_HDR_IGMPV4 \ Internet group management protocol - IPv4 +d# 4 constant IP_HDR_IPV4 +d# 6 constant IP_HDR_TCP +d# 8 constant IP_HDR_EGP \ Exterior gateway protocol +d# 9 constant IP_HDR_IGP \ Cisco private interior gateway +d# 17 constant IP_HDR_UDP +d# 41 constant IP_HDR_IPV6 +d# 43 constant IP_HDR_ROUTING \ Routing header +d# 44 constant IP_HDR_FRAGMENT +d# 45 constant IP_HDR_IDRP \ Interdomain routing protocol +d# 46 constant IP_HDR_RSVP \ Resource reservation protocol +d# 47 constant IP_HDR_GRE \ General routing encapsulation +d# 50 constant IP_HDR_SECURE \ Encrypted security payload +d# 51 constant IP_HDR_AUTHEN \ Authentication +d# 58 constant IP_HDR_ICMPV6 +d# 59 constant IP_HDR_NONE \ No next header +d# 60 constant IP_HDR_DEST \ Destination options +d# 88 constant IP_HDR_EIGRP +d# 89 constant IP_HDR_OSPF +d# 108 constant IP_HDR_COMP \ IP payload compression protocol +d# 115 constant IP_HDR_L2TP \ Layer 2 tunneling protocol +d# 132 constant IP_HDR_SCTP \ Stream control transmission protocol +d# 135 constant IP_HDR_MOBILITY \ Mobile IPV6 + [ifndef] include-ipv4 d# 256 buffer: 'domain-name ' 'domain-name " domain-name" chosen-string : use-server? ( -- flag ) false ; -: use-router? ( -- flag ) false ; [then] headers -0 instance value prefix +0 value /prefix \ Length of prefix (# of bits) +0 value prefix-flag +0 value prefix-lifetime +/ipv6 buffer: my-prefix + /ipv6 buffer: his-ipv6-addr +/ipv6 buffer: my-ipv6-addr-link-local +/ipv6 buffer: my-ipv6-addr-global +/ipv6 buffer: router-ipv6-addr /ipv6 buffer: name-server-ipv6 headerless \ link-local scope multicast all-nodes address -create my-mc-ipv6-addr h# ff c, 2 c, 0 w, 0 l, 0 w, 0 c, 1 c, h# ff c, 0 c, 0 c, 0 c, -create his-mc-ipv6-addr h# ff c, 2 c, 0 w, 0 l, 0 w, 0 c, 1 c, h# ff c, 0 c, 0 c, 0 c, -create unknown-ipv6-addr h# 00 l, h# 00 l, h# 00 l, h# 00 l, +create unknown-ipv6-addr 0 l, 0 l, 0 l, 0 l, +create default-ipv6-addr h# fe c, h# 80 c, 0 w, 0 l, 0 w, 0 c, h# ff c, h# fe c, 0 c, 0 w, +create ipv6-addr-mc-all-nodes h# ff c, 2 c, 0 w, 0 l, 0 l, 0 w, 0 c, 1 c, +create ipv6-addr-mc-all-routers h# ff c, 2 c, 0 w, 0 l, 0 l, 0 w, 0 c, 2 c, +create my-ipv6-addr-mc-sol-node h# ff c, 2 c, 0 w, 0 l, 0 w, 0 c, 1 c, h# ff c, 0 c, 0 w, +create his-ipv6-addr-mc-sol-node h# ff c, 2 c, 0 w, 0 l, 0 w, 0 c, 1 c, h# ff c, 0 c, 0 w, : ipv6= ( ip-addr1 ip-addr2 -- flag ) /ipv6 comp 0= ; @@ -59,7 +103,7 @@ ; : prefix-match? ( ip1 ip2 -- flag ) - prefix 8 /mod 2over 2 pick ( ip1 ip2 rem quot ip1 ip2 quot ) + /prefix 8 /mod 2over 2 pick ( ip1 ip2 rem quot ip1 ip2 quot ) comp 0= if swap bits>mask >r ( ip1 ip2 quot ) ( R: mask ) tuck + c@ r@ and ( ip1 quot [ip2+quot]&mask ) ( R: mask ) @@ -69,26 +113,29 @@ then ; -: set-his-mc-ipv6-addr ( -- ) - his-ipv6-addr /ipv6 + 3 - his-mc-ipv6-addr /ipv6 + 3 - 3 move +: set-his-ipv6-addr-mc ( -- ) + his-ipv6-addr /ipv6 + 3 - his-ipv6-addr-mc-sol-node /ipv6 + 3 - 3 move ; -: set-my-mc-ipv6-addr ( -- ) - my-ipv6-addr /ipv6 + 3 - my-mc-ipv6-addr /ipv6 + 3 - 3 move +: set-my-ipv6-addr-mc ( -- ) + my-ipv6-addr-link-local /ipv6 + 3 - my-ipv6-addr-mc-sol-node /ipv6 + 3 - 3 move ; -: his-mc-ipv6-addr? ( adr-buf -- flag ) - dup his-mc-ipv6-addr ipv6= swap unknown-ipv6-addr? or +: his-ipv6-addr-mc? ( adr-buf -- flag ) + >r + r@ his-ipv6-addr-mc-sol-node ipv6= \ His solicited node address? + r@ ipv6-addr-mc-all-nodes ipv6= or \ Multicast all-nodes? + r> ipv6-addr-mc-all-routers ipv6= or \ Multicast all-routers? ; -: my-mc-ipv6-addr? ( adr-buf -- flag ) - dup my-mc-ipv6-addr ipv6= swap unknown-ipv6-addr? or +: my-ipv6-addr-mc? ( adr-buf -- flag ) + >r + r@ my-ipv6-addr-mc-sol-node ipv6= \ My solicited node address? + r> ipv6-addr-mc-all-nodes ipv6= or \ Multicast all-nodes? ; -/ipv6 buffer: router-ipv6-addr -: use-routerv6? ( -- flag ) router-ipv6-addr knownv6? ; -: use-router? ( -- flag ) - use-ipv6? if use-routerv6? else use-router? then -; +: ipv6-addr-local? ( adr-buf -- flag ) c@ h# e0 and h# 20 <> ; +: use-routerv6? ( -- flag ) routerv6-en-addr unknown-en-addr? not ; + /ipv6 buffer: server-ipv6-addr : use-serverv6? ( -- flag ) server-ipv6-addr knownv6? ; : use-server? ( -- flag ) @@ -96,10 +143,12 @@ ; \ Generate his multicast MAC address from his IPv6 address -: set-his-mc-en ( -- ) - his-ipv6-addr be-w@ h# fe80 = - his-ipv6-addr d# 11 + be-w@ h# fffe = and if - multicast-en-addr his-en-addr 3 move +: set-his-en-addr-mc ( -- ) + multicast-en-addr his-en-addr 2 move + his-ipv6-addr c@ h# ff = if + his-ipv6-addr d# 12 + his-en-addr 2 + 4 move + else + h# ff his-en-addr 2 + c! his-ipv6-addr d# 13 + his-en-addr 3 + 3 move then ; @@ -109,8 +158,16 @@ : indent ( -- ) bootnet-debug if ." " then ; [then] headerless -: .my-ipv6-addr ( -- ) ." My IP: " my-ipv6-addr .ipv6 ; -: .his-ipv6-addr ( -- ) ." His IP: " his-ipv6-addr .ipv6 ; +: .my-ipv6-addr-link-local ( -- ) + ." My IPv6 (local link): " my-ipv6-addr-link-local .ipv6 +; +: .my-ipv6-addr-global ( -- ) + ." My IPv6 (global): " my-ipv6-addr-global .ipv6 +; +: .his-ipv6-addr ( -- ) ." His IP: " his-ipv6-addr .ipv6 ; +: .my-prefix ( -- ) + ." My prefix (global): " my-prefix .ipv6 ." /" /prefix .d +; [ifndef] include-ipv4 0 instance value last-ip-packet @@ -122,8 +179,15 @@ drop else his-ipv6-addr copy-ipv6-addr - set-his-mc-ipv6-addr - unlock-link-addr + set-his-ipv6-addr-mc + his-ipv6-addr ipv6-addr-local? if + unlock-link-addr + my-ipv6-addr-link-local + else + use-routerv6? if routerv6-en-addr his-en-addr copy-en-addr then + my-ipv6-addr-global + then + my-ipv6-addr copy-ipv6-addr then ; @@ -172,17 +236,17 @@ : ipv6-payload ( -- adr len ) the-struct /ipv6-header + ipv6-length xw@ ; +\ Skip checking his-ipv6-addr if it is an ICMPv6 packet which may come from anywhere. +: check-his-ipv6-addr? ( -- flag ) ipv6-next-hdr c@ IP_HDR_ICMPV6 <> ; : ipv6-addr-match? ( -- flag ) - \ If we know the server's IP address (e.g. the user specified one, or - \ we chose one from a RARP or BOOTP reply, or we locked onto one that - \ responded to a TFTP broadcast), then we silently discard IP packets - \ from other hosts. - his-ipv6-addr his-mc-ipv6-addr? 0= if - his-ipv6-addr ipv6-source-addr ipv6= 0= if false exit then + check-his-ipv6-addr? if + his-ipv6-addr his-ipv6-addr-mc? 0= if + his-ipv6-addr ipv6-source-addr ipv6= 0= if false exit then + then then \ Accept IP multicast packets - ipv6-dest-addr my-mc-ipv6-addr? if true exit then + ipv6-dest-addr my-ipv6-addr-mc? if true exit then \ If we don't know our own IP address yet, we accept every IP packet my-ipv6-addr unknown-ipv6-addr? if true exit then Modified: ofw/inetv6/neighdis.fth =================================================================== --- ofw/inetv6/neighdis.fth 2007-08-08 03:14:05 UTC (rev 530) +++ ofw/inetv6/neighdis.fth 2007-08-09 21:42:49 UTC (rev 531) @@ -3,10 +3,11 @@ headerless -" " d# 40 config-string ipv6-dns-server -" " d# 64 config-string ipv6-domain -" " d# 40 config-string ipv6-router -" stateless" d# 40 config-string ipv6-address \ leave room +d# 200 constant ND_TIMEOUT \ Neighbor discovery timeout (ms) +d# 200 constant DAD_TIMEOUT \ Duplicate Address Detection timeout (ms) +d# 500 constant RD_TIMEOUT \ Router Discovery timeout (ms) + +" stateless" d# 40 config-string ipv6-address \ leave room \ " dhcp" ' ipv6-address set-config-string-default [ifndef] include-ipv4 @@ -23,17 +24,22 @@ true ; +/ipv6 buffer: his-ipv6-addr-temp : do-neighbor-discovery ( -- ) bootnet-debug if ." ICMPv6 ND protocol: Getting MAC address for IP address: " his-ipv6-addr .ipv6 cr then - set-his-mc-en \ Set his multicast link address - send-neigh-sol \ Neighbor solicitation + his-ipv6-addr his-ipv6-addr-temp copy-ipv6-addr + set-his-en-addr-mc \ Set his multicast link address + set-his-ipv6-addr-mc + his-ipv6-addr-mc-sol-node his-ipv6-addr copy-ipv6-addr + his-ipv6-addr-temp send-neigh-sol \ Neighbor solicitation + his-ipv6-addr-temp his-ipv6-addr copy-ipv6-addr current-timeout >r - timeout-msecs @ set-timeout + ND_TIMEOUT set-timeout begin IP_HDR_ICMPV6 receive-ip-packet ?dup 0= if got-nd-ad? then until @@ -42,11 +48,6 @@ bootnet-debug if ." Got MAC address: " his-en-addr .enaddr cr then ; -: do-discovery ( -- ) - \ XXX need to do DHCPv6 discovery - his-ipv6-addr be-w@ h# fe80 = if do-neighbor-discovery then -; - : (resolve-en-addrv6) ( 'dest-adr type -- 'en-adr type ) dup IP_TYPE = if ( 'ip-adr ip-type ) [ifdef] include-ipv4 @@ -63,7 +64,7 @@ else ( 'dest-adr type ) dup IPV6_TYPE = if swap his-ipv6-addr copy-ipv6-addr - his-en-addr broadcast-en-addr en= if do-discovery then + his-en-addr broadcast-en-addr en= if do-neighbor-discovery then his-en-addr swap exit then then @@ -73,44 +74,113 @@ : s-all-ipv6 ( -- ) \ See discovery info bootnet-debug if - ." Initial configuration: (fixed) " cr - indent .my-ipv6-addr cr + ." My IPv6 configuration (stateless autoconfiguration): " cr + indent .my-ipv6-addr-link-local cr + my-ipv6-addr-global unknown-ipv6-addr? not if + indent .my-ipv6-addr-global cr + indent .my-prefix cr + then indent .my-link-addr cr + use-routerv6? if indent .routerv6-en-addr cr then then ; -create default-ipv6-addr h# fe c, h# 80 c, 0 c, 0 c, 0 c, 0 c, 0 c, 0 c, - 0 c, 0 c, 0 c, h# ff c, h# fe c, 0 c, 0 c, 0 c, -: set-my-ipv6-addr ( -- ) - default-ipv6-addr my-ipv6-addr copy-ipv6-addr - my-en-addr c@ 2 xor my-ipv6-addr 8 + c! - my-en-addr 1+ my-ipv6-addr 9 + 2 move - my-en-addr 3 + my-ipv6-addr d# 13 + 3 move +: detect-dad ( -- ) + DAD_TIMEOUT set-timeout + begin + IP_HDR_ICMPV6 receive-ip-packet + dup 0= if got-nd-ad? abort" Duplicate IPv6 address detected" then + until ; +: set-my-ipv6-addr-link-local ( -- ) + \ Duplicate Address Discovery + unknown-ipv6-addr my-ipv6-addr copy-ipv6-addr -: configure-ipv6 ( -- ) \ Get discovery info + default-ipv6-addr my-ipv6-addr-link-local copy-ipv6-addr + my-en-addr c@ 2 xor my-ipv6-addr-link-local 8 + c! + my-en-addr 1+ my-ipv6-addr-link-local 9 + 2 move + my-en-addr 3 + my-ipv6-addr-link-local d# 13 + 3 move + + set-my-ipv6-addr-mc + + ipv6-addr-mc-all-nodes his-ipv6-addr copy-ipv6-addr + set-his-en-addr-mc + my-ipv6-addr-link-local send-neigh-sol + detect-dad + + my-ipv6-addr-link-local my-ipv6-addr copy-ipv6-addr +; + +: process-rd-options ( adr len -- ) + begin dup 0> while + over c@ case + 1 of over 2 + routerv6-en-addr copy-en-addr endof \ Source link-layer address option + 3 of over 2 + c@ to /prefix \ Prefix option + over 3 + c@ to prefix-flag + over 8 + be-l@ to prefix-lifetime \ XXX lifetime + over d# 16 + my-prefix copy-ipv6-addr \ Prefix + endof + 5 of over 4 + be-l@ to (link-mtu) endof \ MTU option + endcase + over 1+ c@ 8 * /string + repeat 2drop +; +: process-rd? ( adr len -- router-ad? ) + over c@ d# 134 <> if drop false exit then \ Router advertisement? + over 4 + c@ to router-hop-limit + over 5 + c@ to router-flags \ XXX What to do with stateful config? + over 6 + be-w@ to router-lifetime + over 8 + be-l@ to router-reachable-time + over d# 12 + be-l@ to router-retrans-time + d# 16 /string ( opt-adr,len ) + process-rd-options ( ) + true +; +: auto-cfg-global? ( -- flag ) + my-prefix unknown-ipv6-addr? if false exit then + prefix-flag h# 40 and 0= if false exit then + /prefix d# 64 = \ XXX What to do with /prefix other than 64? +; +: discover-router ( -- ) + unknown-ipv6-addr my-ipv6-addr-global copy-ipv6-addr + ipv6-addr-mc-all-routers his-ipv6-addr copy-ipv6-addr + set-his-en-addr-mc + send-router-sol + + RD_TIMEOUT set-timeout + begin + IP_HDR_ICMPV6 receive-ip-packet ?dup 0= if process-rd? then + until + auto-cfg-global? not if exit then + + \ DAD on the global IPv6 address + my-ipv6-addr-link-local my-ipv6-addr-global copy-ipv6-addr + my-prefix my-ipv6-addr-global /prefix 8 / move \ XXX assume prefix multiple of 8 bits + + ipv6-addr-mc-all-nodes his-ipv6-addr copy-ipv6-addr + set-his-en-addr-mc + my-ipv6-addr-global send-neigh-sol + detect-dad +; + +: configure-ipv6 ( -- ) \ Get discovery info + use-ipv6? \ Save IPv6 flag + true to use-ipv6? + ['] 4drop to icmpv6-err-callback-xt ['] 2drop to icmpv6-info-callback-xt - d# 64 to prefix - set-my-ipv6-addr - set-my-mc-ipv6-addr + d# 64 to /prefix + set-my-ipv6-addr-link-local - \ XXX Duplicate address discovery; Router discovery - \ ::0 => ff02::1:ffb4:0061 hop-by-hop, multicast listener report - \ ::0 => ff02::2 router solicitation - \ ::0 => ff02::1:ffb4:0061 DAD, neighbor solicitation with target addr - \ Wait for router advertisement, if gotten, continue - \ For each prefix in router advertisement, combine prefix with interface id - \ Add address to the list of assigned addresses for the interface - \ All addresses must be verified with DAD - \ fe80::259:08ff:feb4:0061 => ff02::1:ffb4:0061 hop-by-hop, multicast listener report + discover-router + to use-ipv6? \ Restore IPv6 flag ; : configure ( -- ) - use-ipv6? \ Save IPv6 flag + use-ipv6? \ Save IPv6 flag false to use-ipv6? configure - to use-ipv6? \ Restore IPv6 flag + to use-ipv6? \ Restore IPv6 flag configure-ipv6 ; @@ -139,7 +209,7 @@ : open ( -- ok? ) [ifdef] include-ipv4 false to use-ipv6? - open 0= if false exit then \ IPv4 open + open 0= if false exit then \ IPv4 open [else] open-link parse-args @@ -147,11 +217,11 @@ my-self to obp-tftp-ih [then] true to use-ipv6? - ['] (resolve-en-addrv6) to resolve-en-addr + set-mc-hash if close false exit then configure-ipv6 - set-mc-hash if close false exit then s-all-ipv6 setup-ip-attr + ['] (resolve-en-addrv6) to resolve-en-addr true ; Modified: ofw/inetv6/supportv6.fth =================================================================== --- ofw/inetv6/supportv6.fth 2007-08-08 03:14:05 UTC (rev 530) +++ ofw/inetv6/supportv6.fth 2007-08-09 21:42:49 UTC (rev 531) @@ -6,6 +6,12 @@ d# 16 constant /ipv6 \ Bytes per IP address /ipv6 buffer: my-ipv6-addr +0 value router-hop-limit +0 value router-flags +0 value router-lifetime +0 value router-reachable-time +0 value router-retrans-time + : copy-ipv6-addr ( src dst -- ) /ipv6 move ; : .ipv6 ( buf -- ) @@ -107,7 +113,7 @@ " ::xyz" " 123::456:xyz" " xyz:123::456" -" 123:::456" \ Error was not caught! +" 123:::456" " 123" " 123:456" " ::192.xy.1.102" Modified: ofw/inetv6/tcpv6.fth =================================================================== --- ofw/inetv6/tcpv6.fth 2007-08-08 03:14:05 UTC (rev 530) +++ ofw/inetv6/tcpv6.fth 2007-08-09 21:42:49 UTC (rev 531) @@ -1356,7 +1356,7 @@ th_sport w@ th_dport w@ th_sport w! th_dport w! ; : multicast-dstv6? ( -- flag ) - ipv6-struct ihv6_dst tcpv6-struct ( adr ) " his-mc-ipv6-addr?" $call-parent + ipv6-struct ihv6_dst tcpv6-struct ( adr ) " his-ipv6-addr-mc?" $call-parent ; /ipv6 buffer: tmp-ipv6 : dropwithresetv6 ( -- )

1 0

r530 - dev/geode/display
by svn＠openbios.org 08 Aug '07

08 Aug '07

Author: wmb Date: 2007-08-08 05:14:05 +0200 (Wed, 08 Aug 2007) New Revision: 530 Modified: dev/geode/display/gp.fth dev/geode/display/gxfb.fth dev/geode/display/loadpkg.fth Log: OLPC display - sped up scrolling 20x by using the graphics processor. Modified: dev/geode/display/gp.fth =================================================================== --- dev/geode/display/gp.fth 2007-08-06 18:37:01 UTC (rev 529) +++ dev/geode/display/gp.fth 2007-08-08 03:14:05 UTC (rev 530) @@ -1,8 +1,6 @@ purpose: Geode LX graphics acceleration \ See license at end of file -dev screen - alias depth+ wa+ : gp! ( l reg -- ) gp-base + rl! ; @@ -70,9 +68,46 @@ ; [then] +: rc>pixels ( r c -- x y ) swap char-width * swap char-height * ; +: +window ( x y -- x' y' ) window-left 2/ window-top d+ ; +: rc>window ( r c -- x y ) rc>pixels +window ; -dend +: fbgeode-delete-lines ( delta-#lines -- ) + >r ( r: delta-#lines ) + 0 line# r@ + rc>window ( src-x,y r: delta ) + 0 line# rc>window ( src-x,y dst-x,y r: delta ) + #columns #lines r@ - rc>pixels ( src-x,y dst-x,y w,h r: delta ) + gp-move ( r: delta ) + screen-background16 ( color r: delta ) + 0 #lines r@ - rc>window ( color dst-x,y r: delta ) + #columns r> rc>pixels ( color dst-x,y w,h ) + gp-fill +; +: gp-fb16-install ( -- ) + fb16-install + gp-setup + ['] fbgeode-delete-lines is delete-lines +; + +: display-install ( -- ) + init-all + default-font set-font + /scanline bytes/pixel / #scanlines ( width height ) + over char-width / over char-height / ( width height rows cols ) + bytes/pixel case ( width height rows cols ) + 1 of fb8-install endof ( ) + 2 of gp-fb16-install endof ( ) + endcase ( ) + init-hook +; + +: display-selftest ( -- failed? ) false ; + +' display-install is-install +' display-remove is-remove +' display-selftest is-selftest + \ LICENSE_BEGIN \ Copyright (c) 2006 FirmWorks \ Modified: dev/geode/display/gxfb.fth =================================================================== --- dev/geode/display/gxfb.fth 2007-08-06 18:37:01 UTC (rev 529) +++ dev/geode/display/gxfb.fth 2007-08-08 03:14:05 UTC (rev 530) @@ -565,24 +565,6 @@ " ISO8859-1" encode-string " character-set" property 0 0 encode-bytes " iso6429-1983-colors" property -: display-install ( -- ) - init-all - default-font set-font - /scanline bytes/pixel / #scanlines ( width height ) - over char-width / over char-height / ( width height rows cols ) - bytes/pixel case ( width height rows cols ) - 1 of fb8-install endof ( ) - 2 of fb16-install endof ( ) - endcase ( ) - init-hook -; - -: display-selftest ( -- failed? ) false ; - -' display-install is-install -' display-remove is-remove -' display-selftest is-selftest - \ LICENSE_BEGIN \ Copyright (c) 2006 FirmWorks \ Modified: dev/geode/display/loadpkg.fth =================================================================== --- dev/geode/display/loadpkg.fth 2007-08-06 18:37:01 UTC (rev 529) +++ dev/geode/display/loadpkg.fth 2007-08-08 03:14:05 UTC (rev 530) @@ -5,6 +5,7 @@ fload ${BP}/dev/geode/display/gxpci.fth \ PCI interfaces fload ${BP}/dev/geode/display/gxfb.fth \ Controller code +fload ${BP}/dev/geode/display/gp.fth \ Graphics processor support fload ${BP}/dev/video/common/rectangle16.fth \ Rectangular graphics \ LICENSE_BEGIN

1 0

r529 - ofw/inetv6
by svn＠openbios.org 06 Aug '07

06 Aug '07

Author: lwalter Date: 2007-08-06 20:37:01 +0200 (Mon, 06 Aug 2007) New Revision: 529 Modified: ofw/inetv6/http.fth Log: Support redirect and http-proxy Modified: ofw/inetv6/http.fth =================================================================== --- ofw/inetv6/http.fth 2007-08-06 18:26:17 UTC (rev 528) +++ ofw/inetv6/http.fth 2007-08-06 18:37:01 UTC (rev 529) @@ -5,6 +5,42 @@ false instance value debug? +h# 100 instance buffer: url +0 instance value /url +h# 80 instance buffer: proxy +0 instance value /proxy + +-1 value result-code +0 value image-size + +\ proxy should have the value of +\ 1. environment variable, http-proxy, if not null$ +\ 2. otherwise, devalias http-proxy, if not null$ +\ 3. Location: URL$ for status code 305 + +: set-proxy ( $ -- ) + \ strip "http://" or "http:\\" + over " http:" comp 0= if + 7 /string + else + over " HTTP:" comp 0= if 7 /string then + then + + dup to /proxy proxy swap move +; +: init-proxy ( -- ) + 0 to /proxy + " http-proxy" $getenv 0= if + ?dup if + set-proxy + exit + else + drop + then + then + " http-proxy" not-alias? 0= if set-proxy then +; + d# 255 instance buffer: pathbuf : fix-delims ( $ -- $' ) pathbuf pack count ( $' ) @@ -117,21 +153,17 @@ : decode-url ( url$ -- send$ prefix$ port# server$ ) fix-delims ( url$' ) - " http-proxy" not-alias? if ( url$ ) + /proxy 0= if url-parse null$ ( filename$ server$ prefix$ ) - bootnet-debug if ." HTTP Server " 2over type cr then - else ( url$ proxy$ ) - dup 0= if ( url$ proxy$ ) - 2drop url-parse null$ ( filename$ server$ prefix$ ) - bootnet-debug if ." HTTP Proxy server " 2over type cr then - else ( url$ proxy$ ) - " http:" ( url$ proxy$ prefix$ ) - then ( url$ proxy$ prefix$ ) + bootnet-debug if ." HTTP: Server is: " 2over type cr then + else ( url$ ) + proxy /proxy ( url$ proxy$ ) + bootnet-debug if ." HTTP: Proxy is: " 2dup type cr then + " http:" ( url$ proxy$ prefix$ ) then ( send$ server$ prefix$ ) 2swap parse-port ( send$ prefix$ port# server$ ) ; -0 value image-size --1 value result-code + vocabulary http-tags : parse-line ( adr len -- ) @@ -193,7 +225,7 @@ : get-number ( adr len -- n ) push-decimal $number pop-base throw ; : version-bad? ( $ -- flag ) - 2dup " HTTP/1.0" $= if 2drop false exit then ( $ ) + 2dup " HTTP/1.0" $= if 2drop false exit then ( $ ) 2dup " HTTP/1.1" $= if 2drop false else @@ -203,6 +235,11 @@ true then ; +: result-code-supported? ( # -- supported? ) + dup to result-code >r ( # ) + r@ d# 200 = r@ d# 301 d# 303 between or + r@ d# 305 = or r> d# 307 = or +; : dump-response ( -- ) begin get-line dup while type cr repeat ; @@ -212,15 +249,10 @@ abort" HTTP: Bad version line" ( rem$ ) skipwhite scanwhite ( rem$ head$ ) get-number ( rem$ # ) - \ XXX should handle 3xx redirects - dup d# 200 <> if ( rem$ # ) + dup result-code-supported? not if ( rem$ # ) bootnet-debug if ( rem$ # ) - dup d# 302 = if - ." HTTP: Response: " .d type cr ( ) - dump-response - else - ." HTTP: Bad response: " .d type cr ( ) - then + ." HTTP: Bad response: " .d type cr ( ) + dump-response then ( | rem$ # ) abort ( ) else 3drop then ( ) @@ -242,6 +274,7 @@ \ Content-type: text/html \ Content-length: 10696 \ Last-modified: Thu, 11 Feb 1999 01:08:12 GMT +\ Location: http://www.w3.org/TheProject.html : content-length ( $ -- ) \ [<white>] length skipwhite scanwhite ( tail$ head$ ) @@ -249,6 +282,19 @@ get-number ( size ) to image-size ; +: location ( $ -- ) \ [<white>] url$ + skipwhite scanwhite ( tail$ head$ ) + 2swap 2drop ( head$ ) + ascii : left-parse-string 2drop ( head$' ) + result-code d# 305 = if + set-proxy + else + dup to /url ( head$ ) + url swap move ( ) + null$ set-proxy + bootnet-debug if ." HTTP: Location: " url /url type cr then + then +; previous definitions @@ -259,7 +305,7 @@ check-status-line begin get-line dup while parse-header-line repeat 2drop ; -: mount ( $url -- error? ) +: (mount) ( $url -- error? ) decode-url ( send$ prefix$ port# server$ ) 2dup set-server ( send$ prefix$ port# server$ ) @@ -284,9 +330,18 @@ ['] check-header catch ; +: mount ( url$ -- error? ) + dup to /url 2dup url swap move + begin (mount) 0= if result-code d# 200 <> else false then while + " disconnect" $call-parent + url /url + repeat + result-code d# 200 <> +; : open ( -- ) my-args dup if + init-proxy bootnet-debug if 2dup ." HTTP: URL is: " type cr then

1 0

r528 - ofw/inetv6
by svn＠openbios.org 06 Aug '07

06 Aug '07

Author: lwalter Date: 2007-08-06 20:26:17 +0200 (Mon, 06 Aug 2007) New Revision: 528 Modified: ofw/inetv6/ping.fth ofw/inetv6/pingv6.fth Log: ping is IPv4 and IPv6 independent Modified: ofw/inetv6/ping.fth =================================================================== --- ofw/inetv6/ping.fth 2007-08-06 01:11:12 UTC (rev 527) +++ ofw/inetv6/ping.fth 2007-08-06 18:26:17 UTC (rev 528) @@ -239,13 +239,16 @@ loop ; -: $ping ( ip$ -- ) - " net//obp-tftp:last" open-net " $set-host" $call-net +: (ping) ( -- ) /ping-max " allocate-ip" $call-net to ping-packet try-pings ping-packet /ping-max " free-ip" $call-net close-net ; +: $ping ( ip$ -- ) + " net//obp-tftp:last" open-net " $set-host" $call-net + (ping) +; : ping ( "host" -- ) safe-parse-word $ping ; \ LICENSE_BEGIN Modified: ofw/inetv6/pingv6.fth =================================================================== --- ofw/inetv6/pingv6.fth 2007-08-06 01:11:12 UTC (rev 527) +++ ofw/inetv6/pingv6.fth 2007-08-06 18:26:17 UTC (rev 528) @@ -129,16 +129,29 @@ loop ; -: $ping6 ( ip$ -- ) - " net//obp-tftp:last" open-net " $set-host" $call-net +: (ping6) ( -- ) /ping-max " allocate-ipv6" $call-net to ping-packet try-pingsv6 ping-packet /ping-max " free-ipv6" $call-net close-net ; +: $ping6 ( ip$ -- ) + " net//obp-tftp:last" open-net " $set-host" $call-net + (ping6) +; : ping6 ( "host" -- ) safe-parse-word $ping6 ; +[ifdef] include-ipv4 +: $ping ( ip$ -- ) + " net//obp-tftp:last" open-net " $set-host" $call-net + " use-ipv6?" $call-net if (ping6) else (ping) then +; +[else] +: $ping ( ip$ -- ) $ping6 ; +[then] +: ping ( "host" -- ) safe-parse-word $ping ; + \ LICENSE_BEGIN \ Copyright (c) 2006 FirmWorks \

1 0

r527 - in ofw: inet inetv6
by svn＠openbios.org 06 Aug '07

06 Aug '07

Author: wmb Date: 2007-08-06 03:11:12 +0200 (Mon, 06 Aug 2007) New Revision: 527 Modified: ofw/inet/http.fth ofw/inet/httpdpkg.fth ofw/inetv6/http.fth ofw/inetv6/httpdpkg.fth Log: More changes to ensure that base doesn't change. Modified: ofw/inet/http.fth =================================================================== --- ofw/inet/http.fth 2007-08-06 01:02:44 UTC (rev 526) +++ ofw/inet/http.fth 2007-08-06 01:11:12 UTC (rev 527) @@ -122,9 +122,9 @@ : parse-line ( adr len -- ) save-input 2>r 2>r 2>r -1 set-input - push-decimal - parse-word ['] http-tags search-wordlist if execute then - pop-base + parse-word ['] http-tags search-wordlist if + push-decimal ['] execute catch pop-base throw + then 2r> 2r> 2r> restore-input ; @@ -276,7 +276,7 @@ mount 0= bootnet-debug if ." HTTP: " - dup if ." Succeded" else ." Failed!" then cr + dup if ." Succeeded" else ." Failed!" then cr then else 2drop true Modified: ofw/inet/httpdpkg.fth =================================================================== --- ofw/inet/httpdpkg.fth 2007-08-06 01:02:44 UTC (rev 526) +++ ofw/inet/httpdpkg.fth 2007-08-06 01:11:12 UTC (rev 527) @@ -212,11 +212,7 @@ sbuf r> ( $3 ) ; -: create-num$ ( len -- num$ ) - base @ >r decimal ( len ) ( r: base ) - num>ascii ( num$ ) - r> base ! ( num$ ) -; +: create-num$ ( len -- num$ ) push-decimal num>ascii pop-base ; : get-type ( adr len -- c ) 0 -rot Modified: ofw/inetv6/http.fth =================================================================== --- ofw/inetv6/http.fth 2007-08-06 01:02:44 UTC (rev 526) +++ ofw/inetv6/http.fth 2007-08-06 01:11:12 UTC (rev 527) @@ -136,9 +136,9 @@ : parse-line ( adr len -- ) save-input 2>r 2>r 2>r -1 set-input - push-decimal - parse-word ['] http-tags search-wordlist if execute then - pop-base + parse-word ['] http-tags search-wordlist if + push-decimal ['] execute catch pop-base throw + then 2r> 2r> 2r> restore-input ; Modified: ofw/inetv6/httpdpkg.fth =================================================================== --- ofw/inetv6/httpdpkg.fth 2007-08-06 01:02:44 UTC (rev 526) +++ ofw/inetv6/httpdpkg.fth 2007-08-06 01:11:12 UTC (rev 527) @@ -212,11 +212,7 @@ sbuf r> ( $3 ) ; -: create-num$ ( len -- num$ ) - base @ >r decimal ( len ) ( r: base ) - num>ascii ( num$ ) - r> base ! ( num$ ) -; +: create-num$ ( len -- num$ ) push-decimal num>ascii pop-base ; : get-type ( adr len -- c ) 0 -rot

1 0

r526 - in ofw: inet inetv6
by svn＠openbios.org 06 Aug '07

06 Aug '07

Author: wmb Date: 2007-08-06 03:02:44 +0200 (Mon, 06 Aug 2007) New Revision: 526 Modified: ofw/inet/dns.fth ofw/inetv6/dns.fth Log: Use of malformed dotted IP addresses could leave base set to decimal. Modified: ofw/inet/dns.fth =================================================================== --- ofw/inet/dns.fth 2007-08-06 00:29:32 UTC (rev 525) +++ ofw/inet/dns.fth 2007-08-06 01:02:44 UTC (rev 526) @@ -233,13 +233,11 @@ : ?bad-ip ( flag -- ) abort" Bad host name or address" ; 4 buffer: ip-buf : $>ip ( adr len -- 'ip ) - push-decimal ip-buf 4 bounds do - [char] . left-parse-string $number ?bad-ip + [char] . left-parse-string push-decimal $number pop-base ?bad-ip dup d# 256 >= ?bad-ip i c! loop - pop-base 2drop ip-buf ; Modified: ofw/inetv6/dns.fth =================================================================== --- ofw/inetv6/dns.fth 2007-08-06 00:29:32 UTC (rev 525) +++ ofw/inetv6/dns.fth 2007-08-06 01:02:44 UTC (rev 526) @@ -233,13 +233,11 @@ : ?bad-ip ( flag -- ) abort" Bad host name or address" ; 4 buffer: ip-buf : $>ip ( adr len -- 'ip ) - push-decimal ip-buf 4 bounds do - [char] . left-parse-string $number ?bad-ip + [char] . left-parse-string push-decimal $number pop-base ?bad-ip dup d# 256 >= ?bad-ip i c! loop - pop-base 2drop ip-buf ;

1 0

r525 - ofw/inetv6
by svn＠openbios.org 06 Aug '07

06 Aug '07

Author: lwalter Date: 2007-08-06 02:29:32 +0200 (Mon, 06 Aug 2007) New Revision: 525 Modified: ofw/inetv6/http.fth ofw/inetv6/neighdis.fth ofw/inetv6/tcpv6.fth Log: HTTP from local IPv6 address debugged. Modified: ofw/inetv6/http.fth =================================================================== --- ofw/inetv6/http.fth 2007-08-04 20:14:30 UTC (rev 524) +++ ofw/inetv6/http.fth 2007-08-06 00:29:32 UTC (rev 525) @@ -88,9 +88,23 @@ drop swap - update-ptr ( len ) ; +false instance value ipv6-host$? +: parse-ipv6-port ( server$ -- server$' port$ ) + 1 /string + [char] ] left-parse-string ( port$ server$ ) + 2swap [char] : left-parse-string ( server$ port$ junk$ ) + 2drop ( server$ port$ ) +; + : parse-port ( server$ -- port# server$' ) - [char] : left-parse-string ( port$ server$ ) - 2swap dup if ( server$ port$ ) + over c@ [char] [ = dup to ipv6-host$? if + parse-ipv6-port ( server$ port$ ) + else + + [char] : left-parse-string ( port$ server$ ) + 2swap ( server$ port$ ) + then + dup if ( server$ port$ ) push-decimal $number pop-base ( server$ port# error? ) abort" Bad port number" ( server$ port# ) else ( server$ port$ ) @@ -260,8 +274,11 @@ " GET " tcp-write ( send$ prefix$ server$ ) 2swap tcp-write 2swap tcp-write ( server$ ) - " HTTP/1.1"r"nUser-Agent: FirmWorks/1.1"r"nHost: " tcp-write - tcp-write " "r"n"r"n" tcp-write + " HTTP/1.1"r"nUser-Agent: FirmWorks/1.1"r"nHost: " tcp-write + ipv6-host$? if " [" tcp-write then + ( server$ ) tcp-write + ipv6-host$? if " ]" tcp-write then + " "r"n"r"n" tcp-write " flush-writes" $call-parent @@ -276,7 +293,7 @@ mount 0= bootnet-debug if ." HTTP: " - dup if ." Succeded" else ." Failed!" then cr + dup if ." Succeeded" else ." Failed!" then cr then else 2drop true Modified: ofw/inetv6/neighdis.fth =================================================================== --- ofw/inetv6/neighdis.fth 2007-08-04 20:14:30 UTC (rev 524) +++ ofw/inetv6/neighdis.fth 2007-08-06 00:29:32 UTC (rev 525) @@ -79,12 +79,21 @@ then ; +create default-ipv6-addr h# fe c, h# 80 c, 0 c, 0 c, 0 c, 0 c, 0 c, 0 c, + 0 c, 0 c, 0 c, h# ff c, h# fe c, 0 c, 0 c, 0 c, +: set-my-ipv6-addr ( -- ) + default-ipv6-addr my-ipv6-addr copy-ipv6-addr + my-en-addr c@ 2 xor my-ipv6-addr 8 + c! + my-en-addr 1+ my-ipv6-addr 9 + 2 move + my-en-addr 3 + my-ipv6-addr d# 13 + 3 move +; + : configure-ipv6 ( -- ) \ Get discovery info ['] 4drop to icmpv6-err-callback-xt ['] 2drop to icmpv6-info-callback-xt d# 64 to prefix - " fe80::259:08ff:feb4:0061" my-ipv6-addr $ipv6# + set-my-ipv6-addr set-my-mc-ipv6-addr \ XXX Duplicate address discovery; Router discovery Modified: ofw/inetv6/tcpv6.fth =================================================================== --- ofw/inetv6/tcpv6.fth 2007-08-04 20:14:30 UTC (rev 524) +++ ofw/inetv6/tcpv6.fth 2007-08-06 00:29:32 UTC (rev 525) @@ -212,40 +212,42 @@ [ifndef] include-ipv4 : +rcv_nxt ( n -- ) rcv_nxt + to rcv_nxt ; +[then] -0 value wbuf-start -0 value wbuf-adr -0 value wbuf-top -0 value wbuf-end -0 value wbuf-threshold +0 value wbufv6-start +0 value wbufv6-adr +0 value wbufv6-top +0 value wbufv6-end +0 value wbufv6-threshold -d# 1024 d# 16 * constant /wbuf -: wbuf-clear ( -- ) - wbuf-start /wbuf + to wbuf-end - wbuf-start dup to wbuf-adr to wbuf-top - wbuf-start /wbuf 2/ + to wbuf-threshold +d# 1024 d# 16 * constant /wbufv6 +: wbufv6-clear ( -- ) + wbufv6-start /wbufv6 + to wbufv6-end + wbufv6-start dup to wbufv6-adr to wbufv6-top + wbufv6-start /wbufv6 2/ + to wbufv6-threshold ; -: wbuf-allocate ( -- ) - /wbuf alloc-mem to wbuf-start - wbuf-clear +: wbufv6-allocate ( -- ) + /wbufv6 alloc-mem to wbufv6-start + wbufv6-clear ; -: wbuf-actual ( -- n ) wbuf-top wbuf-adr - ; -: wbuf-avail ( -- n ) wbuf-end wbuf-top - ; +: wbufv6-actual ( -- n ) wbufv6-top wbufv6-adr - ; +: wbufv6-avail ( -- n ) wbufv6-end wbufv6-top - ; \ Remove n bytes of data from the beginning of the write buffer -: wbuf-drop ( n -- ) - wbuf-adr + to wbuf-adr +: wbufv6-drop ( n -- ) + wbufv6-adr + to wbufv6-adr \ If there are enough empty bytes at the beginning to make \ it worthwhile to do so, copy the data down to make more \ space at the end. - wbuf-adr wbuf-threshold >= if - wbuf-adr wbuf-start wbuf-actual move \ Copy bytes down - wbuf-actual wbuf-start + to wbuf-top \ Fix pointers - wbuf-start to wbuf-adr + wbufv6-adr wbufv6-threshold >= if + wbufv6-adr wbufv6-start wbufv6-actual move \ Copy bytes down + wbufv6-actual wbufv6-start + to wbufv6-top \ Fix pointers + wbufv6-start to wbufv6-adr then ; +[ifndef] include-ipv4 \ send sequence variables 0 instance value snd_una \ send unacknowledged 0 instance value snd_nxt \ send next @@ -728,7 +730,9 @@ 0 value win 0 value offs -: dont-send? ( -- exit? ) +[then] + +: dont-sendv6? ( -- exit? ) false \ Sender silly window avoidance. If connection is idle and can send @@ -741,7 +745,7 @@ len if len t_maxseg = ?exit - idle? nodelay t_flag? or len offs + wbuf-actual >= and ?exit + idle? nodelay t_flag? or len offs + wbufv6-actual >= and ?exit t_force ?exit @@ -796,7 +800,7 @@ \ If nothing happens soon, send when timer expires: \ if window is nonzero, transmit what we can, otherwise force out a byte. - wbuf-actual 0<> tcpt_rexmt @ 0= and tcpt_persist @ 0= and if + wbufv6-actual 0<> tcpt_rexmt @ 0= and tcpt_persist @ 0= and if 0 to t_rxtshift setpersist then @@ -804,6 +808,7 @@ drop true ; +[ifndef] include-ipv4 \ TCP output routine: figure out what should be sent and send it. d# 32 buffer: opt 0 value hdrlen @@ -849,14 +854,14 @@ xmit_bufv6 set-struct len if - wbuf-adr offs + xmit_bufv6 hdrlen + len move + wbufv6-adr offs + xmit_bufv6 hdrlen + len move \ If we're sending everything we've got, set PUSH. \ (This will keep happy those implementations which only \ give data to the user when a buffer fills or \ a PUSH comes in.) - offs len + wbuf-actual = + offs len + wbufv6-actual = len snd_cwnd = or \ Also PUSH when we have a lot if oflags th_push or to oflags @@ -1033,12 +1038,12 @@ \ \ We can't just blindly clear the FIN bit, because if we don't \ have any more data to send then the probe will be the FIN itself. - off wbuf-actual < if fin-off then + off wbufv6-actual < if fin-off then 1 to win then then - win wbuf-actual < if fin-off win else wbuf-actual then ( n ) + win wbufv6-actual < if fin-off win else wbufv6-actual then ( n ) offs - to len len 0< if @@ -1056,7 +1061,7 @@ rbuf-space to win - dont-send? ?exit + dont-sendv6? ?exit sendv6 sendalot? 0= until @@ -1106,7 +1111,7 @@ then iack snd_una - to acked \ XXX drop-snd needs to "wakeup" the sender - acked wbuf-drop + acked wbufv6-drop iack to snd_una \ We are now finished with the packet data @@ -1121,7 +1126,7 @@ snd_una snd_max = if tcpt_rexmt off else tcpt_persist @ 0= if t_rxtcur tcpt_rexmt ! then then - wbuf-actual if tcp_outputv6 then + wbufv6-actual if tcp_outputv6 then true exit then false exit @@ -1576,18 +1581,18 @@ tcp_close ; +[then] \ Discard from the buffer the transmitted data that was acked -: release-data ( -- flag ) - acked wbuf-actual > dup if ( flag ) - snd_wnd wbuf-actual - to snd_wnd ( flag ) - wbuf-actual wbuf-drop ( flag ) +: release-datav6 ( -- flag ) + acked wbufv6-actual > dup if ( flag ) + snd_wnd wbufv6-actual - to snd_wnd ( flag ) + wbufv6-actual wbufv6-drop ( flag ) else ( flag ) - acked wbuf-drop ( flag ) + acked wbufv6-drop ( flag ) snd_wnd acked - to snd_wnd ( flag ) then ( flag ) ; -[then] : do-ackv6 ( -- done? ) ts syn_received = if @@ -1692,7 +1697,7 @@ snd_cwnd snd_ssthresh u> if dup u* snd_cwnd / then ( cwnd-increment ) snd_cwnd + maxwin min set-cwnd - release-data to ourfinisacked? + release-datav6 to ourfinisacked? \ wakeup-sender @@ -1987,24 +1992,24 @@ /tcphdr d# 32 + mssmax + constant /xmit-max : alloc-buffers ( -- ) - wbuf-allocate d# 1024 d# 16 * to rbuf-len rbuf-len alloc-mem to rbuf-adr 0 to rbuf-actual ; : free-buffers ( -- ) - wbuf-start /wbuf free-mem rbuf-adr rbuf-len free-mem ; [then] \ This is basically attach : alloc-buffersv6 ( -- ) + wbufv6-allocate /xmit-max " allocate-ipv6" $call-parent to xmit_bufv6 ; : free-buffersv6 ( -- ) free-buffers + wbufv6-start /wbufv6 free-mem xmit_bufv6 /xmit-max " free-ipv6" $call-parent ; @@ -2265,17 +2270,18 @@ ?receivev6 ; -[ifndef] include-ipv4 -: wbuf-set ( adr len -- ) over to wbuf-adr + to wbuf-top ; -: wbuf-add ( adr len -- #added ) - wbuf-avail min ( adr #added ) +: wbufv6-set ( adr len -- ) over to wbufv6-adr + to wbufv6-top ; +: wbufv6-add ( adr len -- #added ) + wbufv6-avail min ( adr #added ) dup if ( adr #added ) - tuck wbuf-top swap move ( #added ) - dup wbuf-top + to wbuf-top ( #added ) + tuck wbufv6-top swap move ( #added ) + dup wbufv6-top + to wbufv6-top ( #added ) else ( adr 0 ) nip ( 0 ) then ( #added ) ; + +[ifndef] include-ipv4 : read ( adr len -- actual ) 2drop 0 ; : write ( adr len -- actual ) 2drop 0 ; : write-oob ( adr len -- actual ) 2drop 0 ; @@ -2285,7 +2291,7 @@ : writev6 ( adr len -- actual ) tuck begin ( len adr remaining ) alive? 0= if 3drop -1 exit then - 2dup wbuf-add /string ( len adr' remaining' ) + 2dup wbufv6-add /string ( len adr' remaining' ) dup while ( len adr' remaining' ) tcp_outputv6 pollv6 ( len adr' remaining' ) repeat ( len adr 0 ) @@ -2465,11 +2471,11 @@ : flush-writesv6 ( -- ) \ If the connection is already down, just blow away any pending data - ts closed = if wbuf-clear exit then + ts closed = if wbufv6-clear exit then get-msecs begin - wbuf-actual 0<> ( start-time flag ) + wbufv6-actual 0<> ( start-time flag ) get-msecs 2 pick - d# 10000 < ( start-time flag flag ) and ( start-time flag' ) while ( start-time ) @@ -2477,10 +2483,10 @@ repeat ( start-time ) drop ( ) - wbuf-actual 0<> if + wbufv6-actual 0<> if show" TDROP" debug" TCP Timeout!" - wbuf-clear + wbufv6-clear then ;

1 0

r168 - openbios-devel/drivers
by svn＠openbios.org 05 Aug '07

05 Aug '07

Author: blueswirl Date: 2007-08-05 20:01:20 +0200 (Sun, 05 Aug 2007) New Revision: 168 Modified: openbios-devel/drivers/obio.c Log: Enable all interrupt sources for NetBSD Modified: openbios-devel/drivers/obio.c =================================================================== --- openbios-devel/drivers/obio.c 2007-07-29 20:20:46 UTC (rev 167) +++ openbios-devel/drivers/obio.c 2007-08-05 18:01:20 UTC (rev 168) @@ -927,7 +927,7 @@ fword("property"); intregs = map_io(base | (uint64_t)offset, sizeof(*intregs)); - intregs->set = ~SUN4M_INT_MASKALL; + intregs->clear = ~SUN4M_INT_MASKALL; intregs->cpu_intregs[0].clear = ~0x17fff; for (i = 0; i < SUN4M_NCPU; i++) {

1 0

r524 - cpu/x86/pc/olpc
by svn＠openbios.org 04 Aug '07

04 Aug '07

Author: wmb Date: 2007-08-04 22:14:30 +0200 (Sat, 04 Aug 2007) New Revision: 524 Modified: cpu/x86/pc/olpc/vsapci.fth Log: OLPC PCI spoofing - Fixed a bug that caused GX-based systems to see a phantom AES device. The observed symptom was the message: Can't assign address ranges larger than 32-bits Modified: cpu/x86/pc/olpc/vsapci.fth =================================================================== --- cpu/x86/pc/olpc/vsapci.fth 2007-08-03 00:59:36 UTC (rev 523) +++ cpu/x86/pc/olpc/vsapci.fth 2007-08-04 20:14:30 UTC (rev 524) @@ -152,7 +152,7 @@ h# 7d00 of ehci-hdr endof h# 800 of nb-hdr endof h# 900 of gxfb-hdr endof - h# a00 of gx? if ff-loc else aes-hdr then endof + h# a00 of gx? if drop ff-loc exit else aes-hdr then endof ( default ) 2drop ff-loc exit endcase +hdr

1 0

r523 - dev/olpc/kb3700
by svn＠openbios.org 03 Aug '07

03 Aug '07

Author: wmb Date: 2007-08-03 02:59:36 +0200 (Fri, 03 Aug 2007) New Revision: 523 Modified: dev/olpc/kb3700/battery.fth dev/olpc/kb3700/ecio.fth Log: OLPC watch-battery - improved watch-battery by adding extra info like the battery manufacturer and type, and improving the formatting. Modified: dev/olpc/kb3700/battery.fth =================================================================== --- dev/olpc/kb3700/battery.fth 2007-08-03 00:57:32 UTC (rev 522) +++ dev/olpc/kb3700/battery.fth 2007-08-03 00:59:36 UTC (rev 523) @@ -13,7 +13,6 @@ : eram-w@ h# f400 + dup 1+ ec@ swap ec@ bwjoin ; \ Base unit for temperature is 1/256 degrees C : >degrees-c 7 rshift 1+ 2/ ; \ Round to nearest degree -: .% ( n -- ) .d ." %" ; \ : uvolt@ 0 bat-w@ d# 9760 d# 32 */ ; \ : cur@ 2 bat-w@ wextend d# 15625 d# 120 */ ; \ : pcb-temp 8 bat-w@ >degrees-c ; @@ -57,18 +56,18 @@ ," abnormal: " end-string-array -: .bat-status - bat-status@ - ." AC " dup h# 10 and if ." on " else ." off " then +: .bat-type ( -- ) + bat-type@ dup 4 rshift case ( type ) + 1 of ." GPB " endof + 2 of ." BYD " endof + ." UnknownVendor " + endcase ( type ) - dup 1 and if - dup 2 and if ." Battery full " then - dup 4 and if ." Battery low " then - dup 8 and if ." Battery destroyed " then - else - ." No battery" - then - drop + h# 0f and case ( ) + 1 of ." NiMH " endof + 2 of ." LiFePO4 " endof + ." UnknownType " + endcase ; : .milli ( -- ) @@ -76,18 +75,33 @@ dup abs d# 10,000 / <# u# u# [char] . hold u#s swap sign u#> type pop-base ; +: 2.d ( n -- ) push-decimal <# u# u#s u#> type pop-base ; +: .% ( n -- ) 2.d ." %" ; : .bat ( -- ) - ." Battery: " - soc .% ." " - uvolt@ .milli ." V " - cur@ .milli ." A " - bat-temp .d ." C " - .bat-status - ." (PCB " pcb-temp .d ." C)" + bat-status@ ( stat ) + ." AC: " dup h# 10 and if ." on " else ." off " then ( stat ) + ." PCB: " pcb-temp 2.d ." C " + + dup 1 and if + ." Battery: " + .bat-type + soc .% ." " + uvolt@ .milli ." V " + cur@ .milli ." A " + bat-temp 2.d ." C " + dup 2 and if ." full " then + dup 4 and if ." low " then + dup 8 and if ." error " then + dup h# 20 and if ." charging " then + dup h# 40 and if ." discharging " then + else + ." No battery" + then + drop ; : watch-battery ( -- ) cursor-off - begin (cr .bat d# 100 ms key? until + begin (cr .bat kill-line d# 1000 ms key? until key drop cursor-on ; Modified: dev/olpc/kb3700/ecio.fth =================================================================== --- dev/olpc/kb3700/ecio.fth 2007-08-03 00:57:32 UTC (rev 522) +++ dev/olpc/kb3700/ecio.fth 2007-08-03 00:59:36 UTC (rev 523) @@ -63,6 +63,7 @@ : bat-soc@ ( -- b ) h# 16 ec-cmd-b@ ; : bat-gauge-id@ ( -- sn0 .. sn7 ) h# 17 ec-cmd-out 8 0 do ec-rb loop ; : bat-gauge@ ( -- b ) h# 18 ec-cmd-out h# 31 ec-wb ec-rb ; \ 31 is the EEPROM address +: bat-type@ ( -- b ) h# 18 ec-cmd-out h# 5f ec-wb ec-rb ; \ 5f is the EEPROM address : board-id@ ( -- b ) h# 19 ec-cmd-b@ ; : sci-source@ ( -- b ) h# 1a ec-cmd-b@ ; : sci-mask! ( b -- ) h# 1b ec-cmd-b! ;

1 0

r522 - ofw/core
by svn＠openbios.org 03 Aug '07

03 Aug '07

Author: wmb Date: 2007-08-03 02:57:32 +0200 (Fri, 03 Aug 2007) New Revision: 522 Modified: ofw/core/filecmds.fth ofw/core/ofwfw.fth Log: Integrated OFW device tree "$create-file" into the Forthmacs file interface wordset so you can say, e.g. "writing <device_specifier>". Modified: ofw/core/filecmds.fth =================================================================== --- ofw/core/filecmds.fth 2007-08-03 00:55:32 UTC (rev 521) +++ ofw/core/filecmds.fth 2007-08-03 00:57:32 UTC (rev 522) @@ -297,6 +297,13 @@ public +: $delete1 ( path$ -- ) + open-directory ?dup 0= abort" Can't open directory" ( name$ dir-ih ) + >r " $delete!" r@ $call-method abort" Can't delete file" ( r: dir-ih ) + r> close-dev +; +' $delete1 to _ofdelete + : $delete-all ( pattern-adr pattern-len -- ) begin-search begin another-match? while ( 8*attributes name$ ) \ Check attributes to see if this is a directory @@ -438,6 +445,7 @@ r> close-dev ( path$2 ) $open-file ; +' $create-file to _ofcreate internal Modified: ofw/core/ofwfw.fth =================================================================== --- ofw/core/ofwfw.fth 2007-08-03 00:55:32 UTC (rev 521) +++ ofw/core/ofwfw.fth 2007-08-03 00:57:32 UTC (rev 522) @@ -76,10 +76,30 @@ \ succeeds, returns the addresses of routines to perform I/O on the \ open file and true. If the operation fails, returns false. + +defer _ofcreate +: null-create ( name -- 0 ) 2drop 0 ; +' null-create to _ofcreate + +defer _ofdelete +' 2drop to _ofdelete + : _ofopen ( name mode -- [ fid mode sizeop alignop closeop writeop readop ] okay? ) - >r count open-dev - dup 0= if r> 2drop false exit then ( fid ) + >r count ( name$ r: mode ) + r@ create-flag and if ( name$ r: mode ) + 2dup ['] _ofdelete catch if 2drop then ( name$ r: mode ) + then ( name$ r: mode ) + + 2dup open-dev ?dup 0= if ( name$ r: mode ) + r@ r/o = if ( name$ r: mode ) + 0 ( name$ 0 r: mode ) + else ( name$ r: mode ) + 2dup _ofcreate ( name$ ih r: mode ) + then ( name$ ih r: mode ) + ?dup 0= if r> 3drop false exit then ( name$ ih r: mode ) + then ( name$ ih r: mode ) + nip nip ( ih r: mode ) r@ ['] _ofsize ['] _dfalign ['] _ofclose ['] _ofseek r@ r/o = if ['] nullwrite else ['] _ofwrite then r> w/o = if ['] nullread else ['] _ofread then

1 0

r521 - cpu/ppc cpu/ppc/olpc cpu/x86 cpu/x86/pc/biosload cpu/x86/pc/lxdevel cpu/x86/pc/olpc forth/lib
by svn＠openbios.org 03 Aug '07

03 Aug '07

Author: wmb Date: 2007-08-03 02:55:32 +0200 (Fri, 03 Aug 2007) New Revision: 521 Modified: cpu/ppc/basefw.bth cpu/ppc/builder.bth cpu/ppc/loadmach.fth cpu/ppc/olpc/fw.bth cpu/ppc/savefort.fth cpu/ppc/tools.bth cpu/x86/basefw.bth cpu/x86/catchexc.fth cpu/x86/loadmach.fth cpu/x86/pc/biosload/fw.bth cpu/x86/pc/lxdevel/fw.bth cpu/x86/pc/olpc/fw.bth cpu/x86/pc/olpc/spiflash.bth cpu/x86/saveexp.fth cpu/x86/savefort.fth cpu/x86/tools.bth forth/lib/filetool.fth Log: Deleted the last (I hope) vestiges of the long-obsolete "pstr" format for save-forth and some file creation operators. Modified: cpu/ppc/basefw.bth =================================================================== --- cpu/ppc/basefw.bth 2007-08-03 00:47:34 UTC (rev 520) +++ cpu/ppc/basefw.bth 2007-08-03 00:55:32 UTC (rev 521) @@ -85,7 +85,7 @@ [then] [ifndef] no-heads -.( --- Saving basefw.dic --- ) cr "" basefw.dic save-forth +.( --- Saving basefw.dic --- ) cr " basefw.dic" $save-forth [then] \ LICENSE_BEGIN Modified: cpu/ppc/builder.bth =================================================================== --- cpu/ppc/builder.bth 2007-08-03 00:47:34 UTC (rev 520) +++ cpu/ppc/builder.bth 2007-08-03 00:55:32 UTC (rev 521) @@ -8,7 +8,7 @@ fload ${BP}/ofw/tokenizer/tokenize.fth fload ${BP}/forth/lib/builder.fth -.( --- Saving builder.dic --- ) cr "" builder.dic save-forth +.( --- Saving builder.dic --- ) cr " builder.dic" $save-forth \ LICENSE_BEGIN \ Copyright (c) 2007 FirmWorks Modified: cpu/ppc/loadmach.fth =================================================================== --- cpu/ppc/loadmach.fth 2007-08-03 00:47:34 UTC (rev 520) +++ cpu/ppc/loadmach.fth 2007-08-03 00:55:32 UTC (rev 521) @@ -18,7 +18,7 @@ [ifndef] partial-no-heads transient [then] fload ${BP}/forth/lib/binhdr.fth fload ${BP}/cpu/ppc/savefort.fth -\ alias save-forth save-forth +\ alias $save-forth $save-forth [ifndef] partial-no-heads resident [then] fload ${BP}/forth/lib/instdis.fth Modified: cpu/ppc/olpc/fw.bth =================================================================== --- cpu/ppc/olpc/fw.bth 2007-08-03 00:47:34 UTC (rev 520) +++ cpu/ppc/olpc/fw.bth 2007-08-03 00:55:32 UTC (rev 521) @@ -270,7 +270,7 @@ install-rom-cold -.( --- Saving fw.dic ---) cr p" fw.dic" save-forth +.( --- Saving fw.dic ---) cr " fw.dic" $save-forth \ LICENSE_BEGIN \ Copyright (c) 2007 FirmWorks Modified: cpu/ppc/savefort.fth =================================================================== --- cpu/ppc/savefort.fth 2007-08-03 00:47:34 UTC (rev 520) +++ cpu/ppc/savefort.fth 2007-08-03 00:55:32 UTC (rev 521) @@ -1,10 +1,10 @@ purpose: Save the Forth dictionary to a file \ See license at end of file -\ save-forth ( filename -- ) +\ $save-forth ( filename$ -- ) \ Saves the Forth dictionary to a file so it may be later used under Unix \ -\ save-image ( header-adr header-len filename -- ) +\ $save-image ( header-adr header-len filename$ -- ) \ Primitive save routine. Saves the dictionary image to a file. \ The header is placed at the start of the file. The latest definition \ whose name is the same as the "init-routine-name" argument is @@ -30,10 +30,10 @@ loop ( adr ) drop ; -: save-image ( header header-len filename -- ) +: $save-image ( header header-len filename$ -- ) ['] ($find-next) is $find-next - new-file ( header header-len ) + $new-file ( header header-len ) in-little-endian? if ( header header-len ) be-fputs \ Write header origin text-size ?be-fputs \ Write dictionary @@ -62,16 +62,16 @@ ; \ Save an image of the target system in a file. -: save-forth ( str -- ) +: $save-forth ( name$ -- ) 8 (align) \ Make sure image is 8 byte aligned - >r + 2>r make-bin-header " sys-init-io" $find-name is init-io " sys-init" init-save - bin-header /bin-header r> save-image + bin-header /bin-header 2r> $save-image ; only forth also definitions Modified: cpu/ppc/tools.bth =================================================================== --- cpu/ppc/tools.bth 2007-08-03 00:47:34 UTC (rev 520) +++ cpu/ppc/tools.bth 2007-08-03 00:55:32 UTC (rev 521) @@ -21,7 +21,7 @@ fload ${BP}/cpu/ppc/loadmach.fth \ CPU and OS-specific extensions [ifndef] no-heads -.( --- Saving tools.dic --- ) "" tools.dic save-forth cr +.( --- Saving tools.dic --- ) " tools.dic" $save-forth cr [then] \ LICENSE_BEGIN Modified: cpu/x86/basefw.bth =================================================================== --- cpu/x86/basefw.bth 2007-08-03 00:47:34 UTC (rev 520) +++ cpu/x86/basefw.bth 2007-08-03 00:55:32 UTC (rev 521) @@ -106,7 +106,7 @@ [ifndef] no-heads resident dispose 0 0 set-transize \ true is suppress-transient -cr .( --- Saving basefw.dic --- ) "" basefw.dic save-forth cr +cr .( --- Saving basefw.dic --- ) " basefw.dic" $save-forth cr [then] \ LICENSE_BEGIN Modified: cpu/x86/catchexc.fth =================================================================== --- cpu/x86/catchexc.fth 2007-08-03 00:47:34 UTC (rev 520) +++ cpu/x86/catchexc.fth 2007-08-03 00:55:32 UTC (rev 521) @@ -360,11 +360,11 @@ ['] noop is uncatch-exceptions ; -: save-forth ( pstr -- ) +: $save-forth ( name$ -- ) ['] uncatch-exceptions behavior ['] (uncatch-exceptions) = if - uncatch-exceptions save-forth catch-exceptions + uncatch-exceptions $save-forth catch-exceptions else - save-forth + $save-forth then ; Modified: cpu/x86/loadmach.fth =================================================================== --- cpu/x86/loadmach.fth 2007-08-03 00:47:34 UTC (rev 520) +++ cpu/x86/loadmach.fth 2007-08-03 00:55:32 UTC (rev 521) @@ -19,7 +19,7 @@ [ifndef] partial-no-heads transient [then] fload ${BP}/cpu/x86/saveexp.fth fload ${BP}/cpu/x86/savefort.fth -\ alias save-forth save-forth +\ alias $save-forth $save-forth [ifndef] partial-no-heads resident [then] [ifdef] resident-packages Modified: cpu/x86/pc/biosload/fw.bth =================================================================== --- cpu/x86/pc/biosload/fw.bth 2007-08-03 00:47:34 UTC (rev 520) +++ cpu/x86/pc/biosload/fw.bth 2007-08-03 00:55:32 UTC (rev 521) @@ -310,7 +310,7 @@ " dhcp" ' ip-address set-config-string-default .( Saving fw.dic ...) -"" fw.dic save-forth cr +" fw.dic" $save-forth cr .( Saving fw.img ...) " fw.img" RAMbase save-abs-rom cr Modified: cpu/x86/pc/lxdevel/fw.bth =================================================================== --- cpu/x86/pc/lxdevel/fw.bth 2007-08-03 00:47:34 UTC (rev 520) +++ cpu/x86/pc/lxdevel/fw.bth 2007-08-03 00:55:32 UTC (rev 521) @@ -510,7 +510,7 @@ previous previous definitions .( --- Saving fw.dic ...) -"" fw.dic save-forth cr +" fw.dic" $save-forth cr \ patch foo decimal cold Modified: cpu/x86/pc/olpc/fw.bth =================================================================== --- cpu/x86/pc/olpc/fw.bth 2007-08-03 00:47:34 UTC (rev 520) +++ cpu/x86/pc/olpc/fw.bth 2007-08-03 00:55:32 UTC (rev 521) @@ -589,7 +589,7 @@ previous previous definitions .( --- Saving fw.dic ...) -"" fw.dic save-forth cr +" fw.dic" $save-forth cr \ patch foo decimal cold Modified: cpu/x86/pc/olpc/spiflash.bth =================================================================== --- cpu/x86/pc/olpc/spiflash.bth 2007-08-03 00:47:34 UTC (rev 520) +++ cpu/x86/pc/olpc/spiflash.bth 2007-08-03 00:55:32 UTC (rev 521) @@ -70,4 +70,4 @@ alias quit bye -"" spiflash.dic save-forth +" spiflash.dic" $save-forth Modified: cpu/x86/saveexp.fth =================================================================== --- cpu/x86/saveexp.fth 2007-08-03 00:47:34 UTC (rev 520) +++ cpu/x86/saveexp.fth 2007-08-03 00:55:32 UTC (rev 521) @@ -48,11 +48,11 @@ checksum 12 hw! \ Checksum ; -: save-image ( pstr base-adr len -- ) - is code-size is code-adr ( pstr ) - makeheader ( pstr ) +: $save-image ( name$ base-adr len -- ) + is code-size is code-adr ( name$ ) + makeheader ( name$ ) - new-file + $new-file exp-header /exp-header ofd @ fputs code-adr code-size ofd @ fputs Modified: cpu/x86/savefort.fth =================================================================== --- cpu/x86/savefort.fth 2007-08-03 00:47:34 UTC (rev 520) +++ cpu/x86/savefort.fth 2007-08-03 00:55:32 UTC (rev 521) @@ -3,8 +3,8 @@ only forth also definitions -: save-forth ( pstr -- ) - " sys-init-io" $find-name is init-io ( pstr ) +: $save-forth ( name$ -- ) + " sys-init-io" $find-name is init-io ( name$ ) " sys-init" init-save ['] noop is set-relocation-bit \ Turn off until relo map is allocated @@ -12,9 +12,9 @@ origin origin h# 1c + le-l! \ Set relocation base address \ Set user initialization table - up@ init-user-area origin + user-size move ( pstr ) + up@ init-user-area origin + user-size move ( name$ ) - origin here over - save-image + origin here over - $save-image ; only forth also definitions Modified: cpu/x86/tools.bth =================================================================== --- cpu/x86/tools.bth 2007-08-03 00:47:34 UTC (rev 520) +++ cpu/x86/tools.bth 2007-08-03 00:55:32 UTC (rev 521) @@ -38,7 +38,7 @@ \ .( zeroed: ) dot ' noop is include-hook ' noop is include-exit-hook -.( --- Saving tools.dic --- ) "" tools.dic save-forth cr +.( --- Saving tools.dic --- ) " tools.dic" $save-forth cr [then] \ LICENSE_BEGIN \ Copyright (c) 2006 FirmWorks Modified: forth/lib/filetool.fth =================================================================== --- forth/lib/filetool.fth 2007-08-03 00:47:34 UTC (rev 520) +++ forth/lib/filetool.fth 2007-08-03 00:55:32 UTC (rev 521) @@ -38,6 +38,8 @@ ofd ! ( name$ ) 2drop ; +: modifying ( "filename" -- ) safe-parse-word $write-open ; + : $new-file ( name$ -- ) 2dup r/w create-file if ( name$ x ) drop ." Can't create " type cr abort @@ -71,15 +73,6 @@ note-string 2drop \ Mark as a sequence of bytes ; -\ Backwards compatibility ... - -: read-open ( name-pstr -- ) count $read-open ; -: write-open ( name-pstr -- ) count $write-open ; -: new-file ( name-pstr -- ) count $new-file ; -: append-open ( name-pstr -- ) count $append-open ; -: file-exists? ( name-pstr -- flag ) \ True if the named file already exists - read fopen ( fd ) dup if fclose true then -; \ LICENSE_BEGIN \ Copyright (c) 2006 FirmWorks \

1 0

r520 - clients/memtest86
by svn＠openbios.org 03 Aug '07

03 Aug '07

Author: wmb Date: 2007-08-03 02:47:34 +0200 (Fri, 03 Aug 2007) New Revision: 520 Modified: clients/memtest86/Makefile Log: memtest86 - Added -fno-stack-protector to default CCFLAGS, so it will compile on e.g. Ubuntu. Modified: clients/memtest86/Makefile =================================================================== --- clients/memtest86/Makefile 2007-08-02 22:14:08 UTC (rev 519) +++ clients/memtest86/Makefile 2007-08-03 00:47:34 UTC (rev 520) @@ -13,7 +13,7 @@ # gcc compiler options, these settings should suffice # CCFLAGS=-Wall -march=i486 -m32 -Os -fomit-frame-pointer -fno-builtin -ffreestanding -#CCFLAGS += -fno-stack-protector +CCFLAGS += -fno-stack-protector AS=as -32

1 0

r519 - ofw/termemu
by svn＠openbios.org 03 Aug '07

03 Aug '07

Author: wmb Date: 2007-08-03 00:14:08 +0200 (Fri, 03 Aug 2007) New Revision: 519 Modified: ofw/termemu/fb16.fth Log: fb16 - Fixed terminal emulator problem with insert-characters and delete-characters. Erase-to-end-of-line left garbage at the right of the screen. Modified: ofw/termemu/fb16.fth =================================================================== --- ofw/termemu/fb16.fth 2007-08-02 21:37:59 UTC (rev 518) +++ ofw/termemu/fb16.fth 2007-08-02 22:14:08 UTC (rev 519) @@ -197,20 +197,20 @@ headerless : move-chars16 ( source-col# dest-col# -- ) - 2dup max #columns swap - ( src dst #chars ) - char-width * -rot \ count is linelength-maxcol# - swap column-adr16 swap column-adr16 ( count src-adr dst-adr ) - char-height 0 do - 3dup rot move ( count src-adr dst-adr ) - swap bytes/line16 + swap bytes/line16 + - loop 2drop drop + 2dup max #columns swap - ( src dst #chars ) + char-width 2* * -rot ( #bytes src dst ) + swap column-adr16 swap column-adr16 ( #bytes src dst ) + char-height 0 do ( #bytes src dst ) + 3dup rot move ( #bytes src dst ) + swap bytes/line16 + swap bytes/line16 + ( #bytes src' dst' ) + loop 3drop ( ) ; : erase-chars16 ( #chars start-col# -- ) - swap char-width * swap - column-adr16 char-height 0 do ( count adr ) - 2dup swap text-background16 fb-fill ( count adr ) - bytes/line16 + - loop 2drop + swap char-width 2* * swap ( #bytes start-col# ) + column-adr16 char-height 0 do ( #bytes adr ) + 2dup swap text-background16 fb-fill ( #bytes adr ) + bytes/line16 + ( #bytes adr' ) + loop 2drop ( ) ; headers : fb16-insert-characters ( #chars -- )

1 0

r518 - dev/usb2/device/wlan ofw ofw/inetv6
by svn＠openbios.org 02 Aug '07

02 Aug '07

Author: lwalter Date: 2007-08-02 23:37:59 +0200 (Thu, 02 Aug 2007) New Revision: 518 Added: ofw/inetv6/ ofw/inetv6/adaptime.fth ofw/inetv6/arp.fth ofw/inetv6/attr-ip.fth ofw/inetv6/attr-ipv6.fth ofw/inetv6/bootp.fth ofw/inetv6/config.fth ofw/inetv6/dhcp.fth ofw/inetv6/dns.fth ofw/inetv6/dnsv6.fth ofw/inetv6/encdec.fth ofw/inetv6/ethernet.fth ofw/inetv6/finger.fth ofw/inetv6/http.fth ofw/inetv6/httpd.fth ofw/inetv6/httpdpkg.fth ofw/inetv6/icmpecho.fth ofw/inetv6/icmperr.fth ofw/inetv6/icmpinfo.fth ofw/inetv6/icmpv6.fth ofw/inetv6/ip.fth ofw/inetv6/ipfr.fth ofw/inetv6/ipfrv6.fth ofw/inetv6/ippkg.fth ofw/inetv6/ipv6.fth ofw/inetv6/loadmail.fth ofw/inetv6/loadpkg.fth ofw/inetv6/loadtcp.fth ofw/inetv6/loadtftp.fth ofw/inetv6/macaddr.fth ofw/inetv6/mailbuff.fth ofw/inetv6/neighdis.fth ofw/inetv6/netload.fth ofw/inetv6/netloadv6.fth ofw/inetv6/occhksum.fth ofw/inetv6/ping.fth ofw/inetv6/pingv6.fth ofw/inetv6/pop3.fth ofw/inetv6/random.fth ofw/inetv6/smtp.fth ofw/inetv6/support.fth ofw/inetv6/supportv6.fth ofw/inetv6/tcp.fth ofw/inetv6/tcpapp.fth ofw/inetv6/tcpv6.fth ofw/inetv6/telnet.fth ofw/inetv6/telnetd.fth ofw/inetv6/tftp.fth ofw/inetv6/udp.fth ofw/inetv6/udpv6.fth ofw/inetv6/watchnet.fth Modified: dev/usb2/device/wlan/usb8388.fth Log: Initial checkin of IPv6 networking stack. Local link scope only. Modified: dev/usb2/device/wlan/usb8388.fth =================================================================== --- dev/usb2/device/wlan/usb8388.fth 2007-08-02 10:32:34 UTC (rev 517) +++ dev/usb2/device/wlan/usb8388.fth 2007-08-02 21:37:59 UTC (rev 518) @@ -76,6 +76,11 @@ /mac-adr buffer: target-mac : target-mac$ ( -- $ ) target-mac /mac-adr ; +0 value #mc-adr \ Actual number of set multicast addresses +d# 32 dup constant #max-mc-adr \ Maximum number of multicast addresses +/mac-adr * dup constant /mc-adrs + buffer: mc-adrs \ Buffer of multicast addresses + d# 256 buffer: ssid 0 value /ssid : ssid$ ( -- $ ) ssid /ssid ; @@ -533,6 +538,26 @@ wait-cmd-resp if exit then ; +: marvel-get-mc-address ( -- ) + 4 /mc-adrs + h# 10 ( CMD_MAC_MULTICAST_ADR ) prepare-cmd + ACTION_GET +xw + 4 /mc-adrs + outbuf-bulk-out if exit then + wait-cmd-resp if exit then + respbuf >fw-data 2 + le-w@ to #mc-adr + respbuf >fw-data 4 + mc-adrs #mc-adr /mac-adr * move +; + +: marvel-set-mc-address ( adr len -- ) + 4 /mc-adrs + h# 10 ( CMD_MAC_MULTICAST_ADR ) prepare-cmd + ACTION_SET +xw + dup /mac-adr / dup +xw \ Number of multicast addresses + to #mc-adr + ( adr len ) 2dup +x$ \ Multicast addresses + mc-adrs swap move + 4 /mc-adrs + outbuf-bulk-out if exit then + wait-cmd-resp if exit then +; + \ ========================================================================= \ Register access \ ========================================================================= @@ -635,6 +660,16 @@ set-domain-info enable-11d ; + +: enable-multicast ( -- ) + mac-ctrl h# 20 or to mac-ctrl + set-mac-control +; +: disable-multicast ( -- ) + mac-ctrl h# 20 invert and to mac-ctrl + set-mac-control +; +: set-multicast ( adr len -- ) marvel-set-mc-address enable-multicast ; headers \ ========================================================================= Added: ofw/inetv6/adaptime.fth =================================================================== --- ofw/inetv6/adaptime.fth (rev 0) +++ ofw/inetv6/adaptime.fth 2007-08-02 21:37:59 UTC (rev 518) @@ -0,0 +1,59 @@ +\ See license at end of file +purpose: Adaptive retry timeouts + +d# 200 constant min-timeout +d# 5000 constant max-timeout +0 instance value srtt +0 instance value time0 +d# 4000 instance value next-timeout \ First timeout is 4 seconds + +\ Smoothed round-trip-time (srtt) = (ALPHA * old SRTT) + ((1-ALPHA) * RTT) +\ where alpha in this case is 4/5 +: compute-srtt ( -- ) + srtt 4 * get-msecs time0 - + 5 / to srtt + bootnet-debug 0= if + \ If netword debugging is on, don't shorten the timeout, because + \ the time to display the debugging messages can exceed the round-trip + \ time, thus causing false timeouts. + srtt 3 * 2/ min-timeout max max-timeout min to next-timeout + then +; + +\ Randomize the timeout by a uniformly-distributed random number in +\ the range +-63 msecs. +: randomize ( msecs -- msecs' ) + random dup h# 3f and swap h# 40 and if negate then + +; + +\ Timeout starts at a value that depends on the smoothed round-trip time, +\ and doubles on each consecutive missed packet. Successful reception +\ of a tftp data packet resets it to the (newly-recomputed) starting value. + +: update-timeout ( -- ) + get-msecs to time0 + next-timeout randomize set-timeout + next-timeout 2* max-timeout min to next-timeout +; +\ LICENSE_BEGIN +\ Copyright (c) 2006 FirmWorks +\ +\ Permission is hereby granted, free of charge, to any person obtaining +\ a copy of this software and associated documentation files (the +\ "Software"), to deal in the Software without restriction, including +\ without limitation the rights to use, copy, modify, merge, publish, +\ distribute, sublicense, and/or sell copies of the Software, and to +\ permit persons to whom the Software is furnished to do so, subject to +\ the following conditions: +\ +\ The above copyright notice and this permission notice shall be +\ included in all copies or substantial portions of the Software. +\ +\ THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, +\ EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF +\ MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND +\ NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE +\ LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION +\ OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION +\ WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. +\ +\ LICENSE_END Added: ofw/inetv6/arp.fth =================================================================== --- ofw/inetv6/arp.fth (rev 0) +++ ofw/inetv6/arp.fth 2007-08-02 21:37:59 UTC (rev 518) @@ -0,0 +1,302 @@ +\ See license at end of file +purpose: Address Resolution Protocol (ARP) and Reverse ARP (RARP) + +\ Address Resolution Protocol (ARP) +\ Given the local Ethernet address, finds a server's Ethernet address +\ +\ Reverse Address Resolution Protocol (RARP) +\ Given the local Ethernet address, finds corresponding Internet address +\ +\ These protocols are specific to both Ethernet and Internet, since +\ their purpose is to relate corresponding addresses from the two +\ families. +\ +\ do-arp ( -- ) +\ If his-en-addr contains the broadcast Ethernet address, +\ performs the ARP protocol and sets his-en-addr to the +\ responding server's Ethernet address +\ +\ do-rarp ( -- ) +\ If my-ip-addr contains a broadcast IP address (the first byte is ff), +\ performs the RARP protocol and sets my-ip-addr to my Internet address, +\ and his-en-addr and his-ip-addr to the responding server's Ethernet +\ address and Internet address. +\ +\ clear-net-addresses ( -- ) +\ Sets his-en-addr and my-ip-addr to the broadcast values so that +\ ARP and RARP will have to re-acquire them. + +decimal + +headerless +h# 806 constant ARP_TYPE +h# 8035 constant RARP_TYPE + +: arp-address-type ( -- type ) + " arp-address-type" ['] $call-parent catch if ( x x ) + 2drop 1 ( ARPHRD_ETHER ) + then ( type ) +; + +\ Request structure shared between ARP and RARP + +struct ( arp-packet) + 2 sfield arp-hw \ set to 1 for ethernet + 2 sfield arp-protocol \ set to IP_TYPE + 1 sfield arp-hwlen \ set to 6 for ethernet + 1 sfield arp-protolen \ set to 4 for IP + 2 sfield arp-opcode \ 1 arp req., 2 arp reply, 3 rarp req., 4 rarp reply + /e sfield arp-sha \ sender hardware address + /i sfield arp-spa \ sender protocol address + /e sfield arp-tha \ target hardware address + /i sfield arp-tpa \ target protocol address +constant /arp-packet + +/ether-header /arp-packet + constant /ether+arp + +0 value arp-packet +\ Common ARP/RARP request packet constructor +: send-arp/rarp-packet ( his-ip his-en my-ip my-en req-type en-type -- ) + >r ( his-ip his-en my-ip my-en req-type r: en-type ) + /arp-packet allocate-ethernet to arp-packet + arp-packet set-struct + arp-address-type arp-hw xw! + IP_TYPE arp-protocol xw! + /e arp-hwlen xc! + /i arp-protolen xc! + ( ... req-type ) arp-opcode xw! + ( ... my-en-addr ) arp-sha copy-en-addr + ( ... my-ip-addr ) arp-spa copy-ip-addr + ( ... his-en-addr ) arp-tha copy-en-addr + ( his-ip-addr ) arp-tpa copy-ip-addr + + the-struct /arp-packet r> broadcast-en-addr send-ethernet-packet + arp-packet /arp-packet free-ethernet +; +\ The backoff goes as follows (in seconds): 0 1 2 4 8 16 32 1 2 4 8 16 32 ... +instance variable arp-delay + +: arp-backoff ( -- ) + arp-delay @ ms + arp-delay @ d# 1000 max 2* + dup d# 32000 > if drop d# 1000 then arp-delay ! +; + +: .arp/rarp-timeout ( -- ) + " Timeout waiting for ARP/RARP packet" diag-type diag-cr +; + +: arpcom ( his-ip his-en my-ip my-en req-type en-type -- ok? ) + arp-backoff + send-arp/rarp-packet + timeout-msecs @ set-timeout +; + +: decode-arp-packet ( -- ) + arp-sha his-en-addr copy-en-addr \ grab his Ethernet address +; + +: use-fixed ( -- addr ) + use-router? if router-ip-addr else his-ip-addr then +; +: sought-ip-addr ( -- ip ) + \ If we don't know who we are, we don't know our network number, so + \ we have to guess. + my-ip-addr unknown-ip-addr? if use-fixed exit then + + \ If we are on the same network as the destination host, we send + \ directly to him. + my-ip-addr his-ip-addr ip-prefix=? if his-ip-addr exit then + + \ Otherwise, we are not on the same net, so we want to send to the + \ router, but if we don't have the address of a router, we will + \ try to send directly just in case it might work anyway. + use-fixed +; + +\ we use router-ip-addr in case of gateway booting. +\ In fact, the response ethernet address (router's) will be +\ moved in "his-en-addr". This is correct behavior since the package +\ uses his-en-addr as destination ethernet address. +: try-arp ( -- ) + sought-ip-addr his-en-addr my-ip-addr my-en-addr 1 ARP_TYPE ( params ) + arpcom + + begin ARP_TYPE receive-ethernet-packet 0= while ( arp-adr,len ) + drop set-struct ( ) + arp-tpa my-ip-addr ip= if \ Addressed to me + arp-opcode xw@ 2 = if decode-arp-packet exit then \ ARP reply + then ( ) + repeat + .arp/rarp-timeout +; + +headers + +: do-arp ( -- ) + sought-ip-addr broadcast-ip-addr? if + broadcast-en-addr his-en-addr copy-en-addr exit + then + bootnet-debug if + ." ARP protocol: Getting MAC address for IP address: " + his-ip-addr .ipaddr cr + then + 0 arp-delay ! + + \ Loop until we find the destination Ethernet address + current-timeout >r + begin his-en-addr xw@ h# ffff = while try-arp repeat + r> restore-timeout + + bootnet-debug if indent ." Got MAC address: " his-en-addr .enaddr cr then +; + +: (resolve-en-addr) ( 'dest-adr type -- 'en-adr type ) + dup IP_TYPE = if ( 'ip-adr ip-type ) + swap dup broadcast-ip-addr? if ( ip-type 'ip-adr ) + drop ( ip-type ) + broadcast-en-addr his-en-addr copy-en-addr ( ip-type ) + else ( ip-type 'ip-adr ) + his-ip-addr copy-ip-addr ( ip-type ) + his-en-addr broadcast-en-addr en= if do-arp then ( ip-type ) + then + his-en-addr swap exit + then ( 'dest-adr type ) + nip his-en-addr swap +; +\ ' (resolve-en-addr) to resolve-en-addr + +headerless + +\ Handle incoming arp packets if we know our address +: arp-response ( adr len type -- ) + ARP_TYPE <> if 2drop exit then \ Packet type filter + /arp-packet < if drop exit then \ Packet length filter + set-struct + arp-protocol xw@ IP_TYPE <> if exit then \ Type filter + arp-opcode xw@ 1 <> if exit then \ Type filter + arp-tpa my-ip-addr ip= 0= if exit then \ For somebody else? + + \ All the checks have succeeded, so we can send the reply + 2 arp-opcode xw! + arp-sha arp-tha copy-en-addr + my-en-addr arp-sha copy-en-addr + arp-spa arp-tpa copy-ip-addr + my-ip-addr arp-spa copy-ip-addr + + the-struct /arp-packet ARP_TYPE arp-tha send-ethernet-packet +; +' arp-response is handle-ethernet + +\ Reverse Address Resolution Protocol - finds my Internet address +\ given my Ethernet address. + +: decode-rarp-packet ( -- ) + arp-opcode xw@ 4 <> if exit then + arp-sha his-en-addr copy-en-addr \ grab his Ethernet address + arp-spa his-ip-addr copy-ip-addr \ grab his IP address + arp-tpa my-ip-addr copy-ip-addr \ grab my IP address +; + +: try-rarp ( -- ) + broadcast-ip-addr my-en-addr broadcast-ip-addr my-en-addr 3 RARP_TYPE + arpcom + + begin RARP_TYPE receive-ethernet-packet 0= while ( arp-adr,len ) + drop set-struct ( ) + arp-tha my-en-addr en= if \ Addressed to me + arp-opcode xw@ 4 = if \ RARP reply + decode-rarp-packet exit + then + then ( ) + repeat + .arp/rarp-timeout +; + +headers + +: do-rarp ( -- ) + 0 arp-delay ! + bootnet-debug if + ." RARP protocol: Getting IP address for MAC address: " + my-en-addr .enaddr cr + then + + current-timeout >r + begin my-ip-addr unknown-ip-addr? while try-rarp repeat + r> restore-timeout + + bootnet-debug if indent ." Got IP address: " my-ip-addr .ipaddr cr then +; + +: clear-his-address ( -- ) + use-router? use-server? or if exit then + + broadcast-ip-addr set-dest-ip +; +: clear-my-address ( -- ) + unknown-ip-addr my-ip-addr copy-ip-addr +; +: clear-net-addresses ( -- ) + clear-his-address + clear-my-address + unknown-ip-addr name-server-ip copy-ip-addr + unknown-ip-addr subnetmask copy-ip-addr +; + +false instance value pp? +\ Support for point-to-point links +warning @ warning off +: open-link ( -- ) + open-link + + ['] (resolve-en-addr) to resolve-en-addr + + " point-to-point?" ['] $call-parent catch if 2drop exit then + ( false | 'his-ip 'my-ip true ) if ( 'his-ip 'my-ip ) + my-ip-addr copy-ip-addr his-ip-addr copy-ip-addr ( ) + ['] noop to resolve-en-addr + true to pp? + then + + " dns-servers" ['] $call-parent catch if ( x x ) + 2drop ( ) + else ( false | 'ip1 'ip0 true ) + if ( 'ip1 'ip0 ) + dup known? if nip else drop then ( 'ip ) + name-server-ip copy-ip-addr ( ) + then + then + + " domain-name" ['] $call-parent catch if ( x x ) + 2drop ( ) + else ( name$ ) + 'domain-name place-cstr drop + then +; + +: close-link ( -- ) close-link pp? if clear-my-address then ; +warning ! +\ LICENSE_BEGIN +\ Copyright (c) 2006 FirmWorks +\ +\ Permission is hereby granted, free of charge, to any person obtaining +\ a copy of this software and associated documentation files (the +\ "Software"), to deal in the Software without restriction, including +\ without limitation the rights to use, copy, modify, merge, publish, +\ distribute, sublicense, and/or sell copies of the Software, and to +\ permit persons to whom the Software is furnished to do so, subject to +\ the following conditions: +\ +\ The above copyright notice and this permission notice shall be +\ included in all copies or substantial portions of the Software. +\ +\ THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, +\ EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF +\ MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND +\ NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE +\ LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION +\ OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION +\ WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. +\ +\ LICENSE_END Added: ofw/inetv6/attr-ip.fth =================================================================== --- ofw/inetv6/attr-ip.fth (rev 0) +++ ofw/inetv6/attr-ip.fth 2007-08-02 21:37:59 UTC (rev 518) @@ -0,0 +1,79 @@ +\ See license at end of file +purpose: Add properties describing the network to /chosen + +headerless +: set-chosen-property ( adr,len prop,len -- ) + 2dup " /chosen" find-package drop ( ip-adr$ prop$ prop$ phandle ) + dup >r get-package-property if ( ip-adr$ prop$ ) + \ Create new property + r> 0 package( push-package ( ip-adr$ prop$ ) + 2>r encode-bytes 2r> property ( ) + pop-package )package + else ( ip-adr$ prop$ xdr,len ) + \ Replace existing property + 2swap 2drop rot drop move ( ) + r> drop + then +; +[ifdef] notdef +: ?set-chosen-string ( value$ name$ -- ) + 2swap dup if ( name$ value$ ) + $cstr 1+ 2swap set-chosen-property ( ) + else ( name$ value$ ) + 2drop 2drop ( ) + then +; +[then] + +: (setup-ip-attr) ( -- ) \ set tftp ip addresses + my-ip-addr /i " client-ip" set-chosen-property + his-ip-addr /i " server-ip" set-chosen-property + router-ip-addr /i " gateway-ip" set-chosen-property + netmask /i " netmask-ip" set-chosen-property + broadcast-ip-addr /i " broadcast-ip" set-chosen-property + +[ifdef] notdef + tftp-name " tftp-file" ?set-chosen-string + domain-name " domain-name" ?set-chosen-string + vendor-options " vendor-options" ?set-chosen-string + client-name " client-name" ?set-chosen-string +[then] + + report-buffer if + report-buffer bootp-len encode-bytes " bootp-response" + set-chosen-property + + report-buffer /bootp-packet free-mem + 0 to report-buffer + + \ h# f0 is offset of the options field with the bootp packet + bootp-packet next-option h# f0 + encode-bytes + " bootp-request" set-chosen-property + then +; + +['] (setup-ip-attr) is setup-ip-attr +headers +\ LICENSE_BEGIN +\ Copyright (c) 2006 FirmWorks +\ +\ Permission is hereby granted, free of charge, to any person obtaining +\ a copy of this software and associated documentation files (the +\ "Software"), to deal in the Software without restriction, including +\ without limitation the rights to use, copy, modify, merge, publish, +\ distribute, sublicense, and/or sell copies of the Software, and to +\ permit persons to whom the Software is furnished to do so, subject to +\ the following conditions: +\ +\ The above copyright notice and this permission notice shall be +\ included in all copies or substantial portions of the Software. +\ +\ THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, +\ EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF +\ MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND +\ NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE +\ LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION +\ OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION +\ WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. +\ +\ LICENSE_END Added: ofw/inetv6/attr-ipv6.fth =================================================================== --- ofw/inetv6/attr-ipv6.fth (rev 0) +++ ofw/inetv6/attr-ipv6.fth 2007-08-02 21:37:59 UTC (rev 518) @@ -0,0 +1,57 @@ +\ See license at end of file +purpose: Add properties describing the IPv6 network to /chosen + +headerless +[ifndef] include-ipv4 +: (setup-ip-attr) ( -- ) ; + +: set-chosen-property ( adr,len prop,len -- ) + 2dup " /chosen" find-package drop ( ip-adr$ prop$ prop$ phandle ) + dup >r get-package-property if ( ip-adr$ prop$ ) + \ Create new property + r> 0 package( push-package ( ip-adr$ prop$ ) + 2>r encode-bytes 2r> property ( ) + pop-package )package + else ( ip-adr$ prop$ xdr,len ) + \ Replace existing property + 2swap 2drop rot drop move ( ) + r> drop + then +; +[then] + +: (setup-ipv6-attr) ( -- ) \ set tftp ip addresses + (setup-ip-attr) + + my-ipv6-addr /ipv6 " client-ipv6" set-chosen-property + his-ipv6-addr /ipv6 " server-ipv6" set-chosen-property + router-ipv6-addr /ipv6 " gateway-ipv6" set-chosen-property + my-mc-ipv6-addr /ipv6 " multicast-ipv6" set-chosen-property +; + +['] (setup-ipv6-attr) is setup-ip-attr + +headers +\ LICENSE_BEGIN +\ Copyright (c) 2006 FirmWorks +\ +\ Permission is hereby granted, free of charge, to any person obtaining +\ a copy of this software and associated documentation files (the +\ "Software"), to deal in the Software without restriction, including +\ without limitation the rights to use, copy, modify, merge, publish, +\ distribute, sublicense, and/or sell copies of the Software, and to +\ permit persons to whom the Software is furnished to do so, subject to +\ the following conditions: +\ +\ The above copyright notice and this permission notice shall be +\ included in all copies or substantial portions of the Software. +\ +\ THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, +\ EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF +\ MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND +\ NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE +\ LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION +\ OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION +\ WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. +\ +\ LICENSE_END Added: ofw/inetv6/bootp.fth =================================================================== --- ofw/inetv6/bootp.fth (rev 0) +++ ofw/inetv6/bootp.fth 2007-08-02 21:37:59 UTC (rev 518) @@ -0,0 +1,260 @@ +\ See license at end of file +purpose: Bootstrap Protocol (BOOTP) (RFC 951) + vendor extensions (RFC 1084) + +decimal +headerless +struct ( bootp packet ) + 1 sfield bp-op \ 00 packet type: 1 = request, 2 = reply + 1 sfield bp-htype \ 01 hardware addr type + 1 sfield bp-hlen \ 02 hardware addr length + 1 sfield bp-hops \ 03 gateway hops + 4 sfield bp-xid \ 04 transaction ID + 2 sfield bp-secs \ 08 seconds since boot began + 2 sfield bp-unused \ 0a now "flags" field; see RFC 1542 + /i sfield bp-ciaddr \ 0c client IP address + /i sfield bp-yiaddr \ 10 'your' IP address + /i sfield bp-siaddr \ 14 server IP address + /i sfield bp-giaddr \ 18 gateway (BOOTP relay agent) IP address +d# 16 sfield bp-chaddr \ 1c client hardware address +d# 64 sfield bp-sname \ 2c server host name + +d# 128 sfield bp-file \ 6c boot file name + 4 sfield bp-vend-magic \ ec vendor-specific area +dup constant /bootp-fixed +d# 60 sfield bp-options \ f0 vendor-specific area +constant /bootp + +0 value /bootp-packet +0 instance value bootp-packet + +0 value report-buffer \ Can't use buffer: because DHCP changes the packet size + +0 instance value bootp-len \ Actual length of received bootp packet + +instance variable start-time +instance variable xid + +d# 32 instance buffer: server-name +partial-headers +d# 128 buffer: file-name-buf +headerless +d# 128 instance buffer: bootp-name-buf + +headers +' file-name-buf " tftp-file" chosen-string +headerless + +d# 255 constant end-option + +[ifndef] c@+ +: c@+ ( adr -- adr+1 char ) dup ca1+ swap c@ ; +[then] + +: elapsed-secs ( -- #secs ) get-msecs start-time @ - d# 1000 / ; + +\ RFC 1533 magic number 99.130.83.99 +h# 63.82.53.63 constant 1533-magic + +: not-1533-magic? ( -- adr,len false | true ) + bp-vend-magic dup xl@ 1533-magic = if + la1+ bootp-len /bootp-fixed - false + else + drop true + then +; + +: do-vendor ( -- ) + not-1533-magic? if exit then ( adr,len ) + over ca+ >r ( adr ) ( r: end ) + begin dup r@ <= while ( adr ) ( r: end ) + c@+ case + + end-option of r> 2drop exit endof \ End (255) + + 0 of endof \ Pad + + 1 of \ Netmask + c@+ + over subnetmask copy-ip-addr + ca+ + endof + + 3 of \ Router + c@+ + over router-ip-addr copy-ip-addr + ca+ + endof + + \ default - skip option + drop c@+ ca+ 0 ( adr' 0 ) ( r: end ) + + endcase ( adr' ) ( r: end ) + repeat ( adr" ) ( r: end ) + r> 2drop +; + +: set-cookie ( -- ) " "(63 82 53 63)" bp-vend-magic swap move ; + +: prepare-bootp-packet ( -- ) + bootp-packet set-struct + bootp-packet /bootp-packet erase + 1 bp-op xc! \ BOOTREQUEST + arp-address-type bp-htype xc! \ Hardware address type + /e bp-hlen xc! \ Hardware address length + xid @ bp-xid xl! \ "Random" transaction ID + unknown-ip-addr subnetmask copy-ip-addr + unknown-ip-addr my-ip-addr copy-ip-addr + + \ bp-ciaddr should be 0.0.0.0 or a valid unicast address per RFC 1542 + \ This following clause can't execute in light of the preceding line + \ that clears my-ip-addr. + my-ip-addr broadcast-ip-addr? 0= if + my-ip-addr bp-ciaddr copy-ip-addr + then + + my-en-addr bp-chaddr copy-en-addr + server-name count bp-sname place-cstr drop + file-name-buf cscount bp-file place-cstr drop + + set-cookie + end-option bp-options c! +; + +: send-bootp-packet ( size secs -- ) + bp-secs xw! ( size ) + bootp-packet swap d# 68 d# 67 send-udp-packet ( ) +; + +defer handle-bootp ( -- ) +headers +: (handle-bootp) ( -- ) + bootnet-debug if + ." (Discarding BOOTP packet with unexpected packet type or transaction id)" + cr + ." Header: " + the-struct /bootp-fixed cdump cr + then +; +' (handle-bootp) is handle-bootp +headerless + +: get-bootp-reply ( -- timeout? ) + begin d# 68 receive-udp-packet 0= while ( adr,len src-port ) + drop to bootp-len set-struct ( ) + + bp-xid xl@ xid @ = if + bp-op c@ 2 = if + bp-chaddr my-en-addr en= if false exit then + then + then + handle-bootp + repeat ( ) + true +; +: allocate-bootp ( size -- ) + allocate-udp is bootp-packet + + get-msecs start-time ! + + \ Set "random" transaction ID and random number generator seed + my-en-addr 2 + xl@ get-msecs xor dup xid ! rn ! +; +: free-bootp ( size -- ) bootp-packet swap free-udp ; + +\ Sets my-ip-addr, his-ip-addr, bootp-name-buf, netmask, router-ip-addr, etc. +: extract-bootp-info ( -- ) + bp-yiaddr my-ip-addr copy-ip-addr + bp-siaddr server-ip-addr copy-ip-addr + + server-ip-addr set-dest-ip \ Use the indicated server for TFTP later + + \ We do NOT copy (nor to we even pay attention to) the bp-giaddr field. + \ RFC1542 specifies that said field is for the use of BOOTP relay agents, + \ not clients. + + do-vendor + + \ Copy the filename as modified by the server back into the filename + \ buffer, unless it is empty. We have seen cases where a BOOTP or + \ DHCP server has nulled out a file name that was supplied to it. + bp-file cscount dup if bootp-name-buf place else 2drop then + + report-buffer 0= if /bootp-packet alloc-mem to report-buffer then + the-struct report-buffer bootp-len move +; + +-1 instance value bootp-retries + +[ifndef] use-dhcp + +h# 7ff constant 2seconds \ About 2 seconds of milliseconds +h# 3fff constant 16seconds \ About 16 seconds of milliseconds + +instance variable rn-mask \ Backoff mask + +: first-interval ( -- ) 2seconds rn-mask ! ; +: random-interval ( -- n ) + random rn-mask @ and 2seconds max ( number ) + rn-mask @ 16seconds < if rn-mask @ 2* 1 or rn-mask ! then +; + +0 instance value try# + +: do-bootp ( -- ) + /bootp to /bootp-packet + + /bootp-packet allocate-bootp + + first-interval + 0 to try# + + prepare-bootp-packet + + \ At this point, server-ip-addr will usually be 0.0.0.0, but it may + \ have been overridden from the command line. 1275 committee members + \ have reported that it is necessary to unicast BOOTP requests in some + \ circumstances. We don't do this for DHCP though, because DHCP asserts + \ that the bp-siaddr field denotes the TFTP server, not the BOOTP server. + server-ip-addr bp-siaddr copy-ip-addr + + begin + /bootp-packet elapsed-secs send-bootp-packet + random-interval set-timeout + get-bootp-reply + while + try# if \ We always have to retry the first time! + ." Retrying... Check bootp server and network setup." cr + then + try# 1+ to try# + try# bootp-retries u> abort" Too many BOOTP retries" + repeat + + extract-bootp-info + + /bootp-packet free-bootp +; +[then] +headerless +\ LICENSE_BEGIN +\ Copyright (c) 2006 FirmWorks +\ +\ Permission is hereby granted, free of charge, to any person obtaining +\ a copy of this software and associated documentation files (the +\ "Software"), to deal in the Software without restriction, including +\ without limitation the rights to use, copy, modify, merge, publish, +\ distribute, sublicense, and/or sell copies of the Software, and to +\ permit persons to whom the Software is furnished to do so, subject to +\ the following conditions: +\ +\ The above copyright notice and this permission notice shall be +\ included in all copies or substantial portions of the Software. +\ +\ THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, +\ EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF +\ MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND +\ NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE +\ LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION +\ OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION +\ WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. +\ +\ LICENSE_END Added: ofw/inetv6/config.fth =================================================================== --- ofw/inetv6/config.fth (rev 0) +++ ofw/inetv6/config.fth 2007-08-02 21:37:59 UTC (rev 518) @@ -0,0 +1,7 @@ +purpose: Configuration file for the networking stack + +\ At least one of the below must be created. +\ When both are created, we have a dual networking stack. +create include-ipv4 +create include-ipv6 + Added: ofw/inetv6/dhcp.fth =================================================================== --- ofw/inetv6/dhcp.fth (rev 0) +++ ofw/inetv6/dhcp.fth 2007-08-02 21:37:59 UTC (rev 518) @@ -0,0 +1,708 @@ +\ See license at end of file +purpose: Dynamic Host Configuration Protocol (DHCP) (RFC 1541) + +[ifdef] notdef +dev /obp-tftp +[then] + +partial-headers +defer .dhcp-msg ( adr len -- ) + +: (.dhcp-msg) ( adr len -- ) bootnet-debug if indent type cr else 2drop then ; +' (.dhcp-msg) to .dhcp-msg + +headerless +defer .discover-error +: (.discover-error) " DHCP discover failed; restarting" .dhcp-msg ; +' (.discover-error) to .discover-error + +defer .request-error +: (.request-error) " DHCP request failed; retrying" .dhcp-msg ; +' (.request-error) to .request-error + +d# 308 constant /options-field + +/bootp d# 60 - /options-field + constant /dhcp + +\ Search for the DHCP option whose tag is "code#", returning its value if found +: find-option ( code# -- false | adr len true ) + \ XXX handle options overload + bp-options begin ( code# adr ) + dup c@ dup 0<> swap d# 255 <> and ( code# adr ) + while ( code# adr ) + 2dup c@ = if nip 1+ count true exit then ( code# adr ) + 1+ count + ( code# adr' ) + repeat ( code# adr ) + 2drop false +; + +\ For NVT-ASCII data, which might or might not have trailing nulls +: -nulls ( adr len -- adr len' ) + dup 0 ?do 2dup + 1- c@ 0<> ?leave 1- loop +; + +\ True if the BOOTP vendor extensions area contains DHCP options +: dhcp-options? ( -- flag ) bp-vend-magic " "(63 82 53 63)" comp 0= ; + +/options-field d# 64 + d# 128 + constant /options-max +/options-max buffer: options + +0 value next-option + +\ Initialize the temporary options buffer in preparation for adding options +: start-options ( -- ) options /options-max erase 0 to next-option ; + +\ Add a byte to the temporary options buffer +: option, ( byte -- ) + next-option options + c! next-option 1+ to next-option +; + +\ Add to the temporary options buffer an option with code# as the tag and +\ the value from the memory range adr,len +: +option ( adr len code# -- ) + \ 3 is 1 for the code#, 1 for the length byte, and 1 for an END option + over 3 + next-option + ( adr len code# new#options ) + /options-max >= abort" DHCP options buffer overflow" ( adr len code# ) + option, dup option, bounds ?do i c@ option, loop ( ) +; + +\ Copy the temporary options buffer to the outgoing packet +: copy-options ( -- ) + end-option option, + next-option /options-field > abort" DHCP options overload not supported" + set-cookie + bp-options /options-field erase + options bp-options next-option move +; + +\ Return the DHCP message type +: dhcp-type ( -- true | message-type false ) + dhcp-options? 0= if true exit then + \ Look for a DHCP message type option + d# 53 find-option if drop c@ false else true then +; + +\ Add a "request parameters" option +\ : request-parameters ( adr len -- ) d# 55 +option ; + +\ Display the "message" option from a DHCPNAK message +: .nak-message ( -- ) d# 56 find-option if -nulls type cr then ; + +: root-property ( name$ -- true | value false ) + ['] root-node get-package-property +; + +\ Add a "vendor class" option if there is an "architecture" property +\ in the root node +: set-vendor-class ( -- ) + " architecture" root-property if exit then ( adr len ) + get-encoded-string d# 60 +option \ Vendor class identifier option +; + +\ Add a "client identifier" option whose value is the MAC address +\ XXX we should probably use the root-node system-id property instead, +\ if its value differs from the mac-address value. +0 value client-id +: set-client-id ( -- ) + " system-id" root-property if exit then ( adr len ) + + dup 1+ dup >r alloc-mem to client-id ( adr len r: len' ) + tuck client-id 1+ swap move ( len ) + 1 client-id c! ( len ) + client-id swap 1+ d# 61 +option \ Client identifier option + client-id r> free-mem +; + +0 value backoff \ First set to d# 4000, then double up to d# 32,000 + +\ The spec recommends a 4 second initial timeout, but that appears to be +\ a bit short in some environments, especially considering that +\ a) The actual delay is randomized by +- 1 second. +\ b) Some DHCP servers, when dynamically allocating an IP address, first +\ test that IP address by issuing an ARP request and waiting a timeout +\ interval, prior to responding to the DHCPDISCOVER. +: init-backoff ( -- ) ( d# 4000 ) d# 8000 to backoff ; +: too-many? ( -- flag ) backoff d# 64,000 >= ; + +\ The nominal retry delay interval starts at 4 seconds and doubles each +\ time, giving up after the retry following the 32 second delay. The +\ actual delay is the nominal delay randomized by a uniformly-distributed +\ random number in the range +-1.023 seconds. +: next-backoff ( -- #ms ) + random dup h# 3ff and swap h# 400 and if negate then + backoff + ( #ms ) + backoff 2* to backoff +; + +: erase-ip-addr ( adr -- ) /i erase ; + +\ This is similar to but not exactly the same as my-ip-addr +\ The differences have to do with DHCP protocol requirements +\ about when the BOOTP ciaddr field must be 0. +/i instance buffer: accepted-ip +/i instance buffer: offered-ip + +: start-dhcp-packet ( dhcptype$ -- ) + prepare-bootp-packet + bp-yiaddr erase-ip-addr + bp-siaddr erase-ip-addr + bp-giaddr erase-ip-addr + accepted-ip bp-ciaddr copy-ip-addr + start-options + ( adr len ) d# 53 +option \ DHCPTYPE + set-client-id +; +\ Options common to discover, inform, and request messages +: other-parameters ( -- ) + set-vendor-class + \ Later: Add requested IP address if we know it + \ Later: Add requested IP lease time if we have a preference + \ Later: Add parameter request list if we care + \ Later: Add maximum message size if we should need to +; +: use-ip-broadcast ( -- ) broadcast-ip-addr set-dest-ip ; + +0 instance value dhcp-secs + +: prepare-discover-packet ( -- ) + \ Note: It is permissible to unicast this packet if a DHCP server's + \ IP address is known; see clause 4.4.4 + use-ip-broadcast + + elapsed-secs to dhcp-secs + " "(01)" start-dhcp-packet \ DHCPDISCOVER + other-parameters + copy-options +; + +\ Common code for SELECTING, INIT-REBOOT, BOUND, RENEWING, and REBINDING +: start-request-packet ( -- ) + \ Note: It is permissible to unicast this packet in either INIT or + \ REBOOTING state if a DHCP server's IP address is known; see clause 4.4.4 + use-ip-broadcast + + " "(03)" start-dhcp-packet \ DHCPREQUEST + other-parameters +; + +: send-dhcp-packet ( -- ) + /bootp-packet dhcp-secs send-bootp-packet + next-backoff set-timeout +; + +false instance value bootp-only? \ Set to true if a BOOTP server replies + +defer handle-dhcp +headers +: (handle-dhcp) ( -- ) + bootnet-debug if + ." (Discarding DHCP packet of unexpected type)" cr + ." Packet: " the-struct /bootp cdump cr + then +; +' (handle-dhcp) is handle-dhcp +headerless + +: receive-dhcp-packet ( accept-mask -- true | dhcp-type false ) + >r + begin + get-bootp-reply if r> drop true exit then + + dhcp-type if \ Not a DHCP packet + true to bootp-only? \ This flag may be useful for a fallback to BOOTP + r> drop 0 false exit + else ( dhcp-type ) + 1 over lshift r@ and if \ We got one of the types we want + r> drop false exit ( dhcp-type false ) + then ( dhcp-type ) + drop ( ) \ Silently discard other types + handle-dhcp ( ) + then ( ) + again +; + +defer handle-dhcp-nak + +d# 256 buffer: 'root-path +d# 256 buffer: 'client-name +d# 256 buffer: 'vendor-options +headers +' 'client-name " client-name" chosen-string +' 'vendor-options " vendor-options" chosen-string +' 'root-path " root-path" chosen-string +: domain-name ( -- adr len ) 'domain-name cscount ; + +/i buffer: dhcp-server-ip +: (handle-dhcp-nak) ( -- ) + bootnet-debug if + indent ." (Discarding bogus DHCP NAK packet from server: " + dhcp-server-ip .ipaddr ." )" cr + then +; +' (handle-dhcp-nak) is handle-dhcp-nak + +: init-dhcp ( -- ) + 0 'domain-name c! + 0 'root-path c! + 0 'client-name c! + 0 'vendor-options c! + 0 file-name-buf c! + unknown-ip-addr name-server-ip copy-ip-addr + unknown-ip-addr dhcp-server-ip copy-ip-addr +; + +also forth definitions +stand-init: DHCP init + init-dhcp +; +previous definitions + +: .dhcp-server ( -- ) + bootp-only? 0= if + ." DHCP server: " dhcp-server-ip .ipaddr cr + then +; + +headerless + +: .offer ( -- ) + bootnet-debug if + indent ." Received offer of IP address " my-ip-addr .ipaddr + ." from " + bootp-only? if + ." BOOTP server " server-ip-addr + else + ." DHCP server " dhcp-server-ip + then + .ipaddr cr + + indent indent ." Boot server IP: " server-ip-addr .ipaddr + ." Filename: " bootp-name-buf count type cr + subnetmask known? if + indent indent ." Netmask: " subnetmask .ipaddr cr + then + use-router? if + indent indent ." BOOTP relay agent: " router-ip-addr .ipaddr cr + then + then +; + +partial-headers +\ For now we'll take the first offer we get. + +\ The default value of wanted? accepts the first DHCPOFFER that is received +defer wanted? ( -- flag ) ' true to wanted? + +\ This filter rejects offers whose siaddr field is empty, (Microsoft's +\ DHCP server doesn't fill in siaddr), since we are hosed if we don't know +\ which server to use. + +: (wanted?) ( -- flag ) + \ If we already know the boot server, we needn't insist on one from DHCP + use-server? if true exit then + bp-siaddr known? dup 0= if + " The DHCP 'siaddr' field is empty" .dhcp-msg + then +; +' true to wanted? \ By default, we accept all DHCP offers +\ ' (wanted?) to wanted? + +\ Another plausible criterion for choosing a particular offer might be: +\ If a vendor class identifier is supplied, reject offers that do +\ not return that identifier, instead waiting for an offer from a +\ server that explicitly recognizes the vendor class. + +: choose-response ( -- timeout? ) + begin + \ Accept DHCPOFFER packets (4 = 1 LSHIFT 2; 2 is the DHCPOFFER type code) + 4 receive-dhcp-packet if true exit then ( dhcp-type=2 ) + drop wanted? if false exit then ( ) + " Discarding unwanted DHCPOFFER" .dhcp-msg + again +; +: do-discover ( -- error? ) + accepted-ip erase-ip-addr + prepare-discover-packet + + bootnet-debug if + indent ." DHCP Discover: requesting an IP address for " + my-en-addr .enaddr cr + then + + init-backoff + begin + send-dhcp-packet + \ Enter SELECTING state + choose-response ( timeout? ) + while ( ) + " Timeout" .dhcp-msg + + \ If too many retries, go to INIT state + too-many? if true exit then + repeat + + extract-bootp-info + + \ A BOOTP reply essentially takes to directly to BOUND-DONE state + bootp-only? if .offer false exit then + + d# 54 find-option 0= abort" Server identifier missing" ( adr len ) + drop dhcp-server-ip copy-ip-addr + .offer + + \ get yiaddr from ack packet for use in subsequent request packet + bp-yiaddr offered-ip copy-ip-addr + + false +; + +headerless +create null-ip-addr 0 c, 0 c, 0 c, 0 c, + +: ip-in-use? ( -- error? ) + \ ARP to see if somebody else has the IP address we were assigned. + \ use my-en-addr as sender's hardware address, and 0 as sender's IP + \ address, per last paragraph of clause 4.4.1 + + my-ip-addr broadcast-en-addr null-ip-addr my-en-addr 1 ARP_TYPE ( params ) + send-arp/rarp-packet + + \ If we get a response within a short time, that indicates a conflict. + d# 200 set-timeout + begin ARP_TYPE receive-ethernet-packet 0= while ( arp-adr,len ) + drop set-struct ( ) + arp-tha my-ip-addr ip= if \ Addressed to me + arp-opcode xw@ 2 = if true exit then \ ARP reply + then + repeat + false +; + +\ Broadcast an ARP reply, announcing our new IP address in order to clear +\ any stale ARP cache entries out there (see 4.4.1 in the DHCP RFC). +: arp-notify ( -- ) + broadcast-ip-addr broadcast-en-addr + my-ip-addr my-en-addr 2 ARP_TYPE send-arp/rarp-packet +; + +[ifdef] notdef +Appropriate responses for request failure: + my-ip-address-unknown? 0= if + (it is permitted to go to BOUND state if the lease is unexpired) + then + notify-user retry-at-INIT-state +[then] + +: set-server-id ( -- ) + dhcp-server-ip /i d# 54 +option \ Server identifier option +; +\ Common end options for DHCPREQUEST and DHCPDECLINE packets +: finish-request/decline ( -- ) + offered-ip /i d# 50 +option \ Requested IP address option + copy-options +; + +: send-decline ( -- ) + accepted-ip erase-ip-addr + 0 to dhcp-secs + " "(04)" start-dhcp-packet \ DHCPDECLINE + " Duplicate IP address" d# 56 +option \ Message option + set-server-id + finish-request/decline +; + +partial-headers +defer parse-vendor ( adr len -- adr len ) ' noop is parse-vendor + +headerless +\ true on top of the stack means that a NAK was received from our chosen +\ server, in which case the caller will abandon this DHCP attempt. +\ false on top of the stack means either a timeout or an ACK. +: receive-ack ( -- true | timeout? false ) \ True if our server NAK'ed + begin + \ Accept DHCPACK and DHCPNAK packets + \ 60 masks bits 5 and 6, 5 is DHCPACK and 6 is DHCPNAK + + \ If receive-dhcp-packet returns true, it's a timeout, so we + \ retry at that higher level where the DHCPREQUEST will be resent. + h# 60 receive-dhcp-packet if true false exit then ( dhcp-type ) + + \ If it's an ACK, we return "false false" so the higher level will + \ proceed. + 5 = if false false exit then ( ) + + \ It was a NAK; our response depends on which server issued it. + + \ XXX this code may need modification if we add + \ support for the DHCP INIT-REBOOT state. + + d# 54 find-option if ( ) + \ If the NAK is from the chosen server, we give up. + drop dhcp-server-ip ip= if ( ) + " Received DHCP NAK from the chosen server!" .dhcp-msg + \ XXX clear any remembered IP address + \ Return "true" so the higher level will give up. + true exit + then ( ) + then ( ) + + \ The NAK was from a server that we don't care about, + \ so we just ignore it and keep looking. + handle-dhcp-nak + again +; + +\ If we ever implement persistent IP addresses, we will need to add code to +\ clear the remembered IP address. +: (requesting) ( -- error? ) \ Packet must be prepared in advance + " Confirming IP address with DHCP Request" .dhcp-msg + + init-backoff + + begin + send-dhcp-packet + \ Entering REQUESTING or REBOOTING state + receive-ack if true exit then ( timeout? ) + while ( ) + too-many? if true exit then ( ) + repeat ( ) + + \ We got an ACK + \ Entering BOUND state + extract-bootp-info + + \ If the BOOTP or DHCP server did not return a filename, and + \ the user did not supply one in the package arguments, then + \ we return the system architecture name in bootp-name-buf. + bootp-name-buf count nip 0= if + file-name-buf c@ 0= if + " architecture" ['] root-node get-package-property 0= if ( prop$ ) + get-encoded-string ( name$ ) + bootp-name-buf place ( ) + then + then + then + + d# 6 find-option if drop name-server-ip copy-ip-addr then + d# 28 find-option if drop broadcast-ip-addr copy-ip-addr then + d# 15 find-option if 'domain-name place-cstr drop then + d# 12 find-option if 'client-name place-cstr drop then + d# 43 find-option if parse-vendor 'vendor-options place-cstr drop then + d# 17 find-option if 'root-path place-cstr drop then + + bootnet-debug if + indent ." Received DHCP ACK" cr + name-server-ip known? if + indent indent ." Name server: " name-server-ip .ipaddr cr + then + broadcast-ip-addr if + indent indent ." IP broadcast: " broadcast-ip-addr (.ipaddr) cr + then + 'domain-name c@ if + indent indent ." Domain: " 'domain-name cscount type cr + then + 'client-name c@ if + indent indent ." My hostname: " 'client-name cscount type cr + then + 'root-path c@ if + indent indent ." Root path: " 'root-path cscount type cr + then + 'vendor-options c@ if + indent indent ." Vendor options: " 'vendor-options cscount type cr + then + then + + " Using ARP to check if the assigned IP address is free." .dhcp-msg + + ip-in-use? if + " Oops, it's already in use; sending DHCP Decline" .dhcp-msg + + send-decline + ." The IP address assigned to us by the DHCP server is already in use" cr + d# 10,000 ms \ Per clause 3.1.5 in dhcp-09 + \ Go to INIT state + true exit + else + " Broadcasting ARP reply to announce my IP address" .dhcp-msg + \ Broadcast ARP reply, announcing the new IP address + arp-notify + then + + \ Everything is just fine; we are finished with the protocol for now + false +; + +\ True when in the INIT/SELECTING branch of the state machine. +\ False when in the INIT-REBOOT/REBOOTING branch. + +true value unknown-ip? + +: requesting ( -- error? ) + start-request-packet + unknown-ip? if set-server-id then + finish-request/decline + (requesting) +; + +\ XXX the spec calls for a randomized 1-10 second delay prior to obtaining +\ an IP address via DHCP DISCOVER. We default to not doing this, because +\ of concerns that it would slow down the booting process. A particular +\ system can override this by plugging in a non-null implementation of +\ desync-delay. +defer desync-delay ' noop is desync-delay + +\ XXX currently the presence of a client IP address in the load arguments +\ causes DHCP to be bypassed. We should probably change that to have it +\ do a DHCPINFORM. + +: do-dhcp ( -- ) + bootnet-debug if + ." DHCP protocol: Getting network addresses and client information" cr + then + /dhcp to /bootp-packet + + /bootp-packet allocate-bootp + + \ XXX Derive, or pass in as an argument, the initial IP address + \ and set unknown-ip? according to its existence or lack thereof. + + false to bootp-only? + + unknown-ip? if desync-delay then \ 1-10 seconds; per 4.4.1 + + \ INIT state or INIT-REBOOT state + + begin + unknown-ip? if + \ INIT state + begin do-discover while .discover-error repeat + then + + bootp-only? 0= + while + requesting + while + .request-error + true to unknown-ip? + repeat + then + + setup-ip-attr + /bootp-packet free-bootp +; + +[ifdef] notdef +BOUND state: + Now we have a good IP address + + + + +If we already know our IP address via manual configuration: + send-inform (actually, INFORM is used only when the client already + knows its IP address, and needs only to get the rest + of its parameters. If the client got the IP address + with the preceding algorithm, it will have already + obtained all of its parameters) + receive-ack + + +Option packing: + options field first - end option must be present if chaining, + but pad options are optional + file field next - but only if file field is enabled in the options + overload option. end option must be present and + pad options must be used as necessary to fill the field + sname field next - but only if sname field is enabled in the options + overload option. end option must be present and + pad options must be used as necessary to fill the field + + +client concatenates all options of the same name. + + +backoff: randomized exponential backoff + ethernet: 1st retransmission at 4 seconds randomized by a uniformly + distributed random number between -1 and 1 + 2nd retransmission at 8 seconds randomized by -1 to +1 + 3rd retransmission at 16 seconds randomized by -1 to +1 + 4th retransmission at 32 seconds randomized by -1 to +1 + last retransmission at 64 seconds randomized by -1 to +1 + +How to choose xids to minimize collisions? perhaps hash +ethernet address and clock value? + +Be careful: The server will not automatically extend an extant lease +when the client requests the address again. If the lease needs to +be extended, that must be done explicitly. This implies that +the client probably needs to keep track of its extant lease and +try to reuse/extend it. + +See page 28 for an interesting table. + +Note: lease durations need to be converted to absolute expiration +times by adding to the local clock. It might be better to time +stamp the acquisition of the lease, so the firmware doesn't have +to do studly time calculations. + +Note: source address field in IP header must be set to 0 before the +client has obtained its IP address + + my-leased-ip-address-known-and-unexpired? if + must not fill-in-ciaddr-field (see end of 3.5 on p.22) + + don't fill in server identifier option (see 4.3.2) + + fill in 'requested-IP address' option + + (okay for client to respond to pings (ICMP echo requests)) + + fill in list of specific parameters client is interested in, + using "parameter request list" option. + + set 'maximum DHCP message size' option + + for the next REQUEST: + if INIT-REBOOT state: (table 4 p33) + (broadcast) + server identifier must not be filled in + set requested IP address with previous-assigned address + ciaddr must be 0 per 4.3.2 + + if RENEWING state: (table 4 p33) + (unicast) + server identifier must not be filled in + requested IP address must not be filled in + ciaddr must be the client's IP address + + if REBINDING state: (table 4 p33) + (broadcast) + server identifier must not be filled in + requested IP address must not be filled in + ciaddr must be the client's IP address + else +[then] +\ XXX Remove now-obsolete bootp code like do-bootp +\ LICENSE_BEGIN +\ Copyright (c) 2006 FirmWorks +\ +\ Permission is hereby granted, free of charge, to any person obtaining +\ a copy of this software and associated documentation files (the +\ "Software"), to deal in the Software without restriction, including +\ without limitation the rights to use, copy, modify, merge, publish, +\ distribute, sublicense, and/or sell copies of the Software, and to +\ permit persons to whom the Software is furnished to do so, subject to +\ the following conditions: +\ +\ The above copyright notice and this permission notice shall be +\ included in all copies or substantial portions of the Software. +\ +\ THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, +\ EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF +\ MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND +\ NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE +\ LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION +\ OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION +\ WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. +\ +\ LICENSE_END Added: ofw/inetv6/dns.fth =================================================================== --- ofw/inetv6/dns.fth (rev 0) +++ ofw/inetv6/dns.fth 2007-08-02 21:37:59 UTC (rev 518) @@ -0,0 +1,275 @@ +\ See license at end of file +purpose: Domain name resolver + +headerless +\ struct ( dns header ) +\ /w field >id \ 0 - Number to match questions with answers +\ /w field >dns-flags \ 2 - q/a:8000 opcode:780 aa:40 tc:20 rd:10 ra:8 rc:f +\ /w field >qdcount \ 4 - number of following questions +\ /w field >anscount \ 6 - number of following answer RRs +\ /w field >nscount \ 8 - number of following name server RRs +\ /w field >arccount \ a - number of following additional RRs +\ constant /dns-header + +\ DNS question format: QNAME-variable_length, QTYPE(/w), QCLASS(/w) +\ QTYPE value for "A" (host name) is 1 +\ QCLASS value for "IN" (Internet) is 1 + +d# 1022 value fw-port# + +\ Encode/decode various DNS data types +: +dnsw ( w -- ) wbsplit +xb +xb ; +: -dnsw ( -- w ) -xb -xb swap bwjoin ; +: -dnsl ( -- l ) -dnsw -dnsw swap wljoin ; + +\ A label is a dot-less component of a dotted name. In DNS packets, +\ a label is represented as a length byte followed by the bytes of the string. +: +dns-label ( adr len -- ) dup +xb bounds ?do i c@ +xb loop ; + +\ A name is a full domain name consisting of one or more labels sepearate +\ by dots. In DNS packets, the dots are not included. +: +dns-name ( adr len -- ) + begin dup while + [char] . left-parse-string + +dns-label + repeat + 2drop + 0 +xb +; +: -dnsbytes ( len -- adr len ) + dup x$ over >r ( len len adr rem-len r: adr ) + rot /string to x$ ( len r: adr ) + r> swap ( adr len ) +; + +: +np ( adr len byte -- ) >r 2dup + r> swap c! 1+ ; + +defer -dns-tail \ Forward reference for mutual recursion + +0 instance value dns-header \ Pointer to beginning of DNS header + +\ Handle a compressed name tail, which is represented by a 2-byte +\ offset from the beginning of the DNS header to the beginning of a +\ previous uncompressed copy of the name tail. +: do-ptr ( adr len ptr-offset -- adr len' ) + h# c0 invert and -xb swap bwjoin dns-header + d# 255 ( adr len ) + x$ 2>r to x$ + -dns-tail + 2r> to x$ +; + +\ Handle the next name component, which is either: +\ a) The end of the name, represented by a 0 byte +\ b) A label, represented by a length byte (0-31) followed by the string +\ c) A pointer, represented by pair of bytes "11oooooo oooooooo", where +\ oooooo oooooooo is a 14-bit offset (see do-ptr) +: -component ( adr len -- adr len' end? ) + -xb ?dup 0= if true exit then + dup h# c0 and case + h# c0 of do-ptr true endof + h# 00 of -dnsbytes bounds ?do i c@ +np loop false endof + \ the 80 and 40 cases are reserved + ( default ) ." Unknown DNS label code" cr true swap + endcase +; + +\ Copy the tail of a DNS name from the DNS packet to the buffer adr,len +: (-dns-tail) ( adr len -- adr len' ) + -component if exit then + begin [char] . +np -component until +; +' (-dns-tail) to -dns-tail + +\ Extract a domain name from the DNS packet into a local buffer +d# 256 buffer: dns-name-buf +: -dns-name ( -- adr len ) dns-name-buf 0 -dns-tail ; + +\ Add the host name to the packet and tack on the domain name +\ if it's not already there +: +dns-host ( adr len -- ) + [char] . split-string ( head$ tail$ ) + dup if \ Already fully-qualified ( head$ tail$ ) + nip + +dns-name ( ) + else \ No domain name ( head$ tail$ ) + 2drop +dns-label ( ) + domain-name +dns-name ( ) + then ( ) +; + +d# 512 constant /dns-query +d# 53 constant dns-port# +0 instance value dns-xid + +\ Send a DNS question asking for the IP address for the indicated host +: send-dns-query ( hostname$ -- ) + /dns-query allocate-udp >r + r@ start-encode + next-xid lwsplit drop to dns-xid \ DNS transaction IDs are 16 bits + \ Flags=100 means standard query, recursion desired (100) + \ ID flags #questions #answers #namesrvrs #additional + dns-xid +dnsw h# 100 +dnsw 1 +dnsw 0 +dnsw 0 +dnsw 0 +dnsw + +dns-host + 1 +dnsw 1 +dnsw + x$ fw-port# dns-port# send-udp-packet + r> /dns-query free-udp +; +defer handle-dns-call ' noop is handle-dns-call + +: unexpected-xid ( -- ) + bootnet-debug if + ." (Discarding DNS reply with mismatched transaction ID)" cr + then +; + +\ Receive a DNS reply, filtering out stuff that's not for us +: receive-dns-reply ( xid his-port# my-port# -- error? ) + begin + begin + \ Filter out other destination ports +\ dup receive-udp-packet if ( xid his mine ) \ Timeout + dup receive if ( xid his mine ) \ Timeout + ." Timeout waiting for DNS reply" cr + 3drop true exit + then ( xid his mine adr len actual-port# ) + \ Filter out other source ports + 4 pick <> while ( xid his mine adr len ) + 2drop ( xid his mine ) + repeat ( xid his mine adr len ) + + over to dns-header ( xid his mine ) + start-decode ( xid his mine ) + + \ Filter out other transaction IDs + 2 pick -dnsw <> if ( xid his mine ) + unexpected-xid false ( xid his mine flag ) + else ( xid his mine ) + \ Filter out DNS calls + -dnsw h# 8000 and 0= if ( xid his mine ) + handle-dns-call false ( xid his mine false ) + else ( xid his mine ) + true ( xid his mine true ) + then ( xid his mine done? ) + then ( xid his mine done? ) + until ( xid his mine ) + 3drop false ( false ) +; + +\ Decode/extract a DNS question section from the DNS packet +: -dns-question ( -- name$ type class ) -dns-name -dnsw -dnsw ; + +\ Discard TTL +: -data ( -- ) -dnsw -dnsbytes 2drop ; +: parse-answer ( -- false | 'ip true ) + -dns-name 2drop + + -dnsw -dnsw wljoin ( class.type ) + -dnsl drop ( class.type ) \ Discard TTL + h# 1.0001 = if ( ) + -dnsw drop \ Discard RDLENGTH (it better be 4!) + x$ drop true ( 'ip true ) + else ( ) + -dnsw ( datalen ) + -dnsbytes 2drop false ( false ) + then +; + +\ Decode the reply to a DNS "get IP address for host name" query. +: get-host-addr ( -- 'ip ) + \ Decoder is pointing at the QDCOUNT field + + -dnsw -dnsw ( #questions #answers ) + -dnsw drop -dnsw drop \ Discard NSCOUNT and ARCOUNT + + \ Discard echoed questions + swap 0 ?do -dns-question 2drop 2drop loop ( #answers ) + + 0 ?do parse-answer if unloop exit then loop ( ) + 4 throw +; + +headers +\ Return in the buffer 'ip the IP address address for named host. +\ The host name can be either a simple name (e.g. "pi") or a +\ fully-qualified domain name (e.g. "pi.firmworks.com"). +: try-resolve ( hostname$ -- 'ip ) + name-server-ip set-dest-ip ( hostname$ ) + d# 2000 set-timeout ( hostname$ ) + send-dns-query ( ) + dns-xid dns-port# fw-port# receive-dns-reply ( error? ) + 1 and throw ( ) + get-host-addr ( answer-ip ) +; +: (resolve) ( hostname$ -- ) + bootnet-debug if ( hostname$ ) + ." Using DNS to find the IP address of " ( hostname$ ) + 2dup type cr ( hostname$ ) + then ( hostname$ ) + + d# 20 0 do \ Try 20 times at 2 seconds per try + 2dup ['] try-resolve catch ?dup if ( hostname$ x x err ) + nip nip ( hostname$ err ) + 1 <> if ( hostname$ ) + bootnet-debug if ( hostname$ ) + ." Unknown hostname: " 2dup type cr ( hostname ) + then ( hostname$ ) + true abort" Unknown hostname" + then ( hostname$ ) + else ( hostname$ 'ip ) + bootnet-debug if ( hostname$ 'ip ) + ." Got IP address " dup .ipaddr cr ( hostname$ 'ip ) + then ( hostname$ 'ip ) + + nip nip ( 'ip ) + unloop exit + then ( hostname$ ) + loop ( hostname$ ) + + bootnet-debug if ." No answer to DNS request" cr then ( hostname$ ) + true abort" DNS: No answer" +; +\ : resolve ( 'ip hostname$ -- ) (resolve) swap copy-ip-addr ; + +headerless +: ?bad-ip ( flag -- ) abort" Bad host name or address" ; +4 buffer: ip-buf +: $>ip ( adr len -- 'ip ) + push-decimal + ip-buf 4 bounds do + [char] . left-parse-string $number ?bad-ip + dup d# 256 >= ?bad-ip + i c! + loop + pop-base + 2drop + ip-buf +; + +headers +: $set-host ( hostname$ -- ) + dup 0= ?bad-ip + over c@ [char] 0 [char] 9 between if $>ip else (resolve) then + set-dest-ip +; +\ LICENSE_BEGIN +\ Copyright (c) 2006 FirmWorks +\ +\ Permission is hereby granted, free of charge, to any person obtaining +\ a copy of this software and associated documentation files (the +\ "Software"), to deal in the Software without restriction, including +\ without limitation the rights to use, copy, modify, merge, publish, +\ distribute, sublicense, and/or sell copies of the Software, and to +\ permit persons to whom the Software is furnished to do so, subject to +\ the following conditions: +\ +\ The above copyright notice and this permission notice shall be +\ included in all copies or substantial portions of the Software. +\ +\ THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, +\ EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF +\ MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND +\ NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE +\ LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION +\ OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION +\ WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. +\ +\ LICENSE_END Added: ofw/inetv6/dnsv6.fth =================================================================== --- ofw/inetv6/dnsv6.fth (rev 0) +++ ofw/inetv6/dnsv6.fth 2007-08-02 21:37:59 UTC (rev 518) @@ -0,0 +1,54 @@ +\ See license at end of file +purpose: Domain name version 6 resolver + +headerless + +/ipv6 buffer: ipv6-buf + +[ifndef] include-ipv4 +: $>ip ( hostname$ -- 'ip ) .ipv4-not-supported ; +: (resolve) ( hostname$ -- 'ip ) .ipv4-not-supported ; +: set-dest-ip ( buf -- ) .ipv4-not-supported ; +: ?bad-ip ( flag -- ) abort" Bad host name or address" ; +[then] + +headers +: (resolvev6) ( hostname$ -- 'ip ) ; + +\ XXX Try (resolve) or (resolve6) first. If fail, try the other one. +: (resolve) ( hostname$ -- 'ip ) + use-ipv6? if (resolvev6) true else (resolve) false then + dup to use-ipv6? + if set-dest-ipv6 else set-dest-ip then +; + +: $set-host ( hostname$ -- ) + dup 0= ?bad-ip + 2dup ['] $>ip catch if 2drop else false to use-ipv6? set-dest-ip 2drop exit then + 2dup ipv6-buf ['] $ipv6# catch nip nip not if true to use-ipv6? ipv6-buf set-dest-ipv6 exit then + (resolve) +; + +\ LICENSE_BEGIN +\ Copyright (c) 2006 FirmWorks +\ +\ Permission is hereby granted, free of charge, to any person obtaining +\ a copy of this software and associated documentation files (the +\ "Software"), to deal in the Software without restriction, including +\ without limitation the rights to use, copy, modify, merge, publish, +\ distribute, sublicense, and/or sell copies of the Software, and to +\ permit persons to whom the Software is furnished to do so, subject to +\ the following conditions: +\ +\ The above copyright notice and this permission notice shall be +\ included in all copies or substantial portions of the Software. +\ +\ THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, +\ EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF +\ MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND +\ NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE +\ LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION +\ OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION +\ WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. +\ +\ LICENSE_END Added: ofw/inetv6/encdec.fth =================================================================== --- ofw/inetv6/encdec.fth (rev 0) +++ ofw/inetv6/encdec.fth 2007-08-02 21:37:59 UTC (rev 518) @@ -0,0 +1,37 @@ +\ See license at end of file +purpose: Encode and decode bytes + +headerless +0 0 2value x$ +: start-encode ( adr -- ) 0 to x$ ; +: start-decode ( adr len -- ) to x$ ; +: +xb ( byte -- ) x$ + c! x$ 1+ to x$ ; +: -xb ( -- byte ) + x$ ( adr len ) + dup 0<= abort" Premature exhaustion of decoded data" + over c@ -rot 1 /string to x$ +; +headers +\ LICENSE_BEGIN +\ Copyright (c) 2006 FirmWorks +\ +\ Permission is hereby granted, free of charge, to any person obtaining +\ a copy of this software and associated documentation files (the +\ "Software"), to deal in the Software without restriction, including +\ without limitation the rights to use, copy, modify, merge, publish, +\ distribute, sublicense, and/or sell copies of the Software, and to +\ permit persons to whom the Software is furnished to do so, subject to +\ the following conditions: +\ +\ The above copyright notice and this permission notice shall be +\ included in all copies or substantial portions of the Software. +\ +\ THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, +\ EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF +\ MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND +\ NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE +\ LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION +\ OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION +\ WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. +\ +\ LICENSE_END Added: ofw/inetv6/ethernet.fth =================================================================== --- ofw/inetv6/ethernet.fth (rev 0) +++ ofw/inetv6/ethernet.fth 2007-08-02 21:37:59 UTC (rev 518) @@ -0,0 +1,212 @@ +\ See license at end of file +purpose: Definitions related to Ethernet headers and addresses + +hex + +headerless +d# 1514 constant ethernet-max \ Header (14) + data (1500) + \ Checksum (4) not counted + +0 instance value (link-mtu) \ max packet size +0 instance value packet-buffer + +\ Determine the Ethernet address for his-ip-addr +instance defer resolve-en-addr ( 'dest-adr type -- 'en-adr type ) +\ will be set later + +: link-mtu ( -- n ) + (link-mtu) ?dup 0= if + " max-frame-size" get-inherited-property if + " max-frame-size" my-parent ihandle>phandle find-method if + drop " max-frame-size" my-parent $call-method + else + ethernet-max + then + else + get-encoded-int + then + dup to (link-mtu) + then +; + +: open-link ( -- ) link-mtu alloc-mem to packet-buffer ; +: close-link ( -- ) packet-buffer link-mtu free-mem ; + +6 constant /e + +: en= ( adr1 adr2 -- flag ) /e comp 0= ; +: copy-en-addr ( src dst -- ) /e move ; + +/e buffer: my-en-addr +/e buffer: his-en-addr + +: .my-link-addr ( -- ) ." My MAC: " my-en-addr .enaddr ; +: .his-link-addr ( -- ) ." His MAC: " his-en-addr .enaddr ; + +create multicast-en-addr h# 33 c, 33 c, h# ff c, 0 c, 0 c, 0 c, +create broadcast-en-addr h# ff c, ff c, h# ff c, h# ff c, h# ff c, h# ff c, + +decimal + +struct ( ether-header ) + /e sfield en-dest-addr + /e sfield en-source-addr + 2 sfield en-type +constant /ether-header + +: set-mc-hash ( -- err? ) + my-ipv6-addr /ipv6 + 3 - multicast-en-addr 3 + 3 move + multicast-en-addr /e " set-multicast" ['] $call-parent catch 0= if false exit then + 4drop + multicast-en-addr /e " $crc" evaluate invert + " set-hash" ['] $call-parent catch if 3drop true else false then +; + +: select-ethernet-header ( -- ) packet-buffer set-struct ; + +: max-link-payload ( -- n ) link-mtu /ether-header - ; + +defer handle-ethernet ( adr len type -- ) ' 3drop is handle-ethernet +headers +: (handle-ethernet) ( adr len type -- ) + ." (Discarding ethernet packet of type " u. ." )" cr + 2drop +; +headerless + +list: ethlist +listnode + /n field >eth-adr \ contents-adr + /n field >eth-len \ contents-len + 2 field >eth-type +nodetype: ethnode + +0 ethlist ! +0 ethnode ! +0 value eth-type + +: free-ethnode ( prev -- adr len ) + delete-after + dup ethnode free-node + dup >eth-adr @ swap >eth-len @ ( adr len ) + 2dup packet-buffer swap move ( adr len ) + tuck free-mem ( len ) + packet-buffer swap ( adr len ) +; + +decimal +th 800 constant IP_TYPE +th 86dd constant IPV6_TYPE +hex + +: ip-type? ( type -- ip-type? ) dup IP_TYPE = swap IPV6_TYPE = or ; + +: eth-type=? ( type -- flag ) + eth-type ip-type? if ip-type? else eth-type = then +; + +: eth-type-find ( node-adr -- flag ) >eth-type w@ eth-type=? ; + +: enque ( adr len type -- ) + -rot dup alloc-mem swap 2dup 2>r move 2r> ( type adr' len ) + ethnode allocate-node ( type adr len node ) + dup ethlist last-node insert-after ( type adr len node ) + tuck >eth-len ! ( type adr node ) + tuck >eth-adr ! ( type node ) + >eth-type w! ( ) +; + +: dequeue? ( type -- 0 | adr len true ) + to eth-type + ethlist ['] eth-type-find find-node if + free-ethnode ( adr len ) + true ( adr len true ) + else + drop 0 + then +; + +: (receive-ethernet-packet) ( type -- true | adr len false ) + begin + pause + packet-buffer link-mtu " read" $call-parent ( type length|-error ) + dup 0> if ( type length ) + select-ethernet-header ( type length ) + over en-type xw@ = if ( type length ) + nip /ether-header payload false exit ( adr len false ) + else ( type length ) + dup /ether-header payload ( type len adr len ) + en-type xw@ dup ip-type? if ( type len adr len type ) + enque ( type len ) + else ( type len adr len type ) + handle-ethernet ( type length ) + then + then ( type length ) + then ( type 0|-error ) + drop ( type ) + timeout? ( type flag ) + until ( type ) + drop true ( true ) +; + +: receive-ethernet-packet ( type -- true | adr len false ) + dup dequeue? if rot drop false exit then + (receive-ethernet-packet) +; + +: send-ethernet-packet ( data-adr data-len type dst-en-addr -- ) + 2swap swap /ether-header - set-struct -rot ( data-len type dst ) + + en-dest-addr copy-en-addr ( data-len type ) + en-type xw! ( data-len ) + my-en-addr en-source-addr copy-en-addr ( data-len ) + + the-struct swap /ether-header + tuck " write" $call-parent ( len actual ) + <> if ." Network transmit error" cr then +; + +: lock-link-addr ( -- ) + the-struct >r select-ethernet-header + en-source-addr his-en-addr copy-en-addr + r> set-struct +; +: allocate-ethernet ( payload-len -- payload-adr ) + /ether-header + alloc-mem /ether-header + +; +: free-ethernet ( payload-adr payload-len -- ) + /ether-header negate /string free-mem +; + +: unlock-link-addr ( -- ) broadcast-en-addr his-en-addr copy-en-addr ; + +: send-link-packet ( packet-adr packet-len [ 'dest-adr ... ] type -- ) + resolve-en-addr ( packet-adr packet-len 'en-adr type -- ) + swap send-ethernet-packet + +; + +headers + +\ LICENSE_BEGIN +\ Copyright (c) 2006 FirmWorks +\ +\ Permission is hereby granted, free of charge, to any person obtaining +\ a copy of this software and associated documentation files (the +\ "Software"), to deal in the Software without restriction, including +\ without limitation the rights to use, copy, modify, merge, publish, +\ distribute, sublicense, and/or sell copies of the Software, and to +\ permit persons to whom the Software is furnished to do so, subject to +\ the following conditions: +\ +\ The above copyright notice and this permission notice shall be +\ included in all copies or substantial portions of the Software. +\ +\ THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, +\ EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF +\ MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND +\ NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE +\ LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION +\ OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION +\ WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. +\ +\ LICENSE_END Added: ofw/inetv6/finger.fth =================================================================== --- ofw/inetv6/finger.fth (rev 0) +++ ofw/inetv6/finger.fth 2007-08-02 21:37:59 UTC (rev 518) @@ -0,0 +1,44 @@ +\ See license at end of file +purpose: "Finger" command, useful mostly for testing + +100 buffer: rbuf +: read-one ( -- n ) + begin rbuf 100 " read" $call-tcp dup -2 = while drop repeat +; +: read-all ( -- ) + begin read-one dup -1 <> while rbuf swap list repeat drop +; + +: $finger ( name$ host$ -- ) + d# 79 open-tcp-connection + tcp-type " "n" tcp-type read-all + close-tcp +; +: finger ( "user@host" -- ) + safe-parse-word + [char] @ left-parse-string 2swap ( user$ host$ ) + $finger +; +\ LICENSE_BEGIN +\ Copyright (c) 2006 FirmWorks +\ +\ Permission is hereby granted, free of charge, to any person obtaining +\ a copy of this software and associated documentation files (the +\ "Software"), to deal in the Software without restriction, including +\ without limitation the rights to use, copy, modify, merge, publish, +\ distribute, sublicense, and/or sell copies of the Software, and to +\ permit persons to whom the Software is furnished to do so, subject to +\ the following conditions: +\ +\ The above copyright notice and this permission notice shall be +\ included in all copies or substantial portions of the Software. +\ +\ THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, +\ EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF +\ MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND +\ NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE +\ LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION +\ OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION +\ WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. +\ +\ LICENSE_END Added: ofw/inetv6/http.fth =================================================================== --- ofw/inetv6/http.fth (rev 0) +++ ofw/inetv6/http.fth 2007-08-02 21:37:59 UTC (rev 518) @@ -0,0 +1,308 @@ +\ See license at end of file +purpose: HTTP package + +hex + +false instance value debug? + +d# 255 instance buffer: pathbuf +: fix-delims ( $ -- $' ) + pathbuf pack count ( $' ) + + 2dup bounds ?do ( $' ) + i c@ dup [char] | = swap [char] \ = or if [char] / i c! then + loop +; +: set-server ( server$ -- ) + dup if " $set-host" $call-parent else 2drop then +; +char / constant delim +: url-parse ( url$ -- filename$ server$ ) + \ If the string is shorter than 2 characters, the server portion is null + dup 2 < if " " exit then ( url$ ) + + \ If the string doesn't start with //, the server portion is null + over " //" comp if " " exit then ( url$ ) + + 2 /string ( server/filename$ ) + delim split-string ( server$ filename$ ) + 2swap ( filename$ server$ ) +; + +: close ( -- ) +; + +\ false instance value reports? + +2variable seek-ptr +: seek ( d -- error? ) seek-ptr 2@ d<> ; +: update-ptr ( actual -- actual ) + dup 0 seek-ptr 2@ d+ seek-ptr 2! ( actual ) +; + +: tcp-read ( adr len -- actual ) " read" $call-parent ; +: wait-read ( adr len -- actual ) + begin + 2dup tcp-read dup -2 = ( adr len actual flag ) + while ( adr len actual ) + drop ( adr len ) + repeat ( adr len actual ) + nip nip ( actual ) + update-ptr ( actual ) +; + +: read ( adr len -- actual ) + over + over ( start end next ) + begin ( start end next ) + \ Check for end of buffer + 2dup = if ( start end next ) + nip swap - update-ptr exit ( actual ) + then ( start end next ) + + 2dup - ( start end next # ) + over swap wait-read ( start end next actual ) + + dup -1 = if ( start end next -1 ) + drop ( start end next ) + nip swap - update-ptr ( actual ) + \ Return -1 if this is the end and we didn't get any data this pass + dup 0= if 1- then ( actual | -1 ) + exit + then ( start end next actual ) + + + ( start end next' ) + again +; + +: load ( adr -- len ) + dup begin ( adr next-adr ) + dup h# 800 read dup -1 <> ( adr next-adr ) + while ( adr next-adr actual ) + dup 0<= if ( adr next-adr actual ) + drop ( adr next-adr ) + else ( adr next-adr actual ) + + ( adr next-adr' ) + show-progress ( adr next-adr' ) + then ( adr next-adr' ) + repeat ( adr next-adr actual ) + drop swap - update-ptr ( len ) +; + +: parse-port ( server$ -- port# server$' ) + [char] : left-parse-string ( port$ server$ ) + 2swap dup if ( server$ port$ ) + push-decimal $number pop-base ( server$ port# error? ) + abort" Bad port number" ( server$ port# ) + else ( server$ port$ ) + 2drop d# 80 ( server$ port# ) + then ( server$ port# ) + -rot ( port# server$ ) +; + +: tcp-write ( adr len -- ) " write" $call-parent drop ; + +: decode-url ( url$ -- send$ prefix$ port# server$ ) + fix-delims ( url$' ) + " http-proxy" not-alias? if ( url$ ) + url-parse null$ ( filename$ server$ prefix$ ) + bootnet-debug if ." HTTP Server " 2over type cr then + else ( url$ proxy$ ) + dup 0= if ( url$ proxy$ ) + 2drop url-parse null$ ( filename$ server$ prefix$ ) + bootnet-debug if ." HTTP Proxy server " 2over type cr then + else ( url$ proxy$ ) + " http:" ( url$ proxy$ prefix$ ) + then ( url$ proxy$ prefix$ ) + then ( send$ server$ prefix$ ) + 2swap parse-port ( send$ prefix$ port# server$ ) +; +0 value image-size +-1 value result-code +vocabulary http-tags + +: parse-line ( adr len -- ) + save-input 2>r 2>r 2>r -1 set-input + push-decimal + parse-word ['] http-tags search-wordlist if execute then + pop-base + 2r> 2r> 2r> restore-input +; + +: read1 ( adr -- ) 1 wait-read -1 = throw ; + +1 instance buffer: ch +: eat-line ( -- ) + begin ch read1 ch c@ carret = until + ch read1 +; + +: (get-line) ( adr maxlen -- adr actual ) + over + over ( start end next ) + begin ( start end next ) + \ Check for end of buffer + 2dup = if ( start end next ) + eat-line ( start end next ) + nip over - exit ( adr len ) + then ( start end next ) + + \ Read the next character + dup read1 ( start end next ) + + \ Check for end of line + dup c@ carret = if ( start end next ) + dup read1 ( start end next ) \ Eat the LF + nip over - exit ( adr len ) + then ( start end next ) + + 1+ ( start end next' ) + again +; +h# 100 instance buffer: line-buffer + +: get-line ( -- adr len ) line-buffer h# 100 (get-line) ; +: skipwhite ( $ -- $' ) + begin ( $ ) + dup ( $ len ) + while ( $ ) + over c@ dup bl = swap 9 = or ( $ white? ) + while ( $ ) + 1 /string ( $' ) + repeat then ( $' ) +; +: scanwhite ( $ -- tail$ head$ ) + " "t" lex if ( tail$ head$ delim ) + drop ( tail$ head$ ) + else ( $ ) + null$ 2swap ( null-tail$ head$ ) + then ( tail$ head$ ) +; + +: get-number ( adr len -- n ) push-decimal $number pop-base throw ; +: version-bad? ( $ -- flag ) + 2dup " HTTP/1.0" $= if 2drop false exit then ( $ ) + 2dup " HTTP/1.1" $= if + 2drop false + else + bootnet-debug if + ." HTTP: Bad version: " type cr + else 2drop then + true + then +; +: dump-response ( -- ) + begin get-line dup while type cr repeat +; +: check-status-line ( -- ) + get-line scanwhite ( rem$' head$ ) + version-bad? ( rem$' error? ) + abort" HTTP: Bad version line" ( rem$ ) + skipwhite scanwhite ( rem$ head$ ) + get-number ( rem$ # ) + \ XXX should handle 3xx redirects + dup d# 200 <> if ( rem$ # ) + bootnet-debug if ( rem$ # ) + dup d# 302 = if + ." HTTP: Response: " .d type cr ( ) + dump-response + else + ." HTTP: Bad response: " .d type cr ( ) + then + then ( | rem$ # ) + abort ( ) + else 3drop then ( ) +; +: parse-header-line ( adr len -- ) + [char] : left-parse-string ( tail$ head$ ) + ['] http-tags search-wordlist if ( tail$ xt ) + execute ( ) + else ( tail$ ) + 2drop ( ) + then ( ) +; + +also http-tags definitions +\ Sample header: +\ HTTP/1.0 200 OK +\ Date: Tue, 02 Mar 1999 22:46:34 GMT +\ Server: Apache/1.1.1 +\ Content-type: text/html +\ Content-length: 10696 +\ Last-modified: Thu, 11 Feb 1999 01:08:12 GMT + +: content-length ( $ -- ) \ [<white>] length + skipwhite scanwhite ( tail$ head$ ) + 2swap 2drop ( head$ ) + get-number ( size ) + to image-size +; + +previous definitions + +: check-header ( -- ) + 0. seek-ptr 2! + 0 to image-size + -1 to result-code + check-status-line + begin get-line dup while parse-header-line repeat 2drop +; +: mount ( $url -- error? ) + decode-url ( send$ prefix$ port# server$ ) + + 2dup set-server ( send$ prefix$ port# server$ ) + rot ( send$ prefix$ server$ port# ) + + bootnet-debug if ." Connecting to port " dup .d cr then + " connect" $call-parent 0= if ( send$ prefix$ server$ ) + 4drop 2drop true exit + then ( send$ prefix$ server$ ) + + bootnet-debug if ." Connected" cr then + + " GET " tcp-write ( send$ prefix$ server$ ) + 2swap tcp-write 2swap tcp-write ( server$ ) + " HTTP/1.1"r"nUser-Agent: FirmWorks/1.1"r"nHost: " tcp-write + tcp-write " "r"n"r"n" tcp-write + + " flush-writes" $call-parent + + ['] check-header catch +; + +: open ( -- ) + my-args dup if + bootnet-debug if + 2dup ." HTTP: URL is: " type cr + then + mount 0= + bootnet-debug if + ." HTTP: " + dup if ." Succeded" else ." Failed!" then cr + then + else + 2drop true + then +; +: size ( -- d ) image-size 0 ; +\ LICENSE_BEGIN +\ Copyright (c) 2006 FirmWorks +\ +\ Permission is hereby granted, free of charge, to any person obtaining +\ a copy of this software and associated documentation files (the +\ "Software"), to deal in the Software without restriction, including +\ without limitation the rights to use, copy, modify, merge, publish, +\ distribute, sublicense, and/or sell copies of the Software, and to +\ permit persons to whom the Software is furnished to do so, subject to +\ the following conditions: +\ +\ The above copyright notice and this permission notice shall be +\ included in all copies or substantial portions of the Software. +\ +\ THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, +\ EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF +\ MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND +\ NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE +\ LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION +\ OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION +\ WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. +\ +\ LICENSE_END Added: ofw/inetv6/httpd.fth =================================================================== --- ofw/inetv6/httpd.fth (rev 0) +++ ofw/inetv6/httpd.fth 2007-08-02 21:37:59 UTC (rev 518) @@ -0,0 +1,53 @@ +\ See license at end of file +purpose: HTTP Server command + +external + +defer httpd-exit-hook ['] noop to httpd-exit-hook + +headers + +support-package: httpd +fload ${BP}/ofw/inet/httpdpkg.fth +end-support-package + +\ devalias httpd tcp//httpd +\ devalias httpd tcp//httpd:verbose,debug + +external + +: httpd ( -- ) + + ['] noop to httpd-exit-hook + + " httpd" open-dev dup 0= abort" Can't open httpd" ( ih ) >r + " httpd-loop" r@ ['] $call-method catch if 3drop then + r> close-dev + + httpd-exit-hook +; + +headers +\ LICENSE_BEGIN +\ Copyright (c) 2006 FirmWorks +\ +\ Permission is hereby granted, free of charge, to any person obtaining +\ a copy of this software and associated documentation files (the +\ "Software"), to deal in the Software without restriction, including +\ without limitation the rights to use, copy, modify, merge, publish, +\ distribute, sublicense, and/or sell copies of the Software, and to +\ permit persons to whom the Software is furnished to do so, subject to +\ the following conditions: +\ +\ The above copyright notice and this permission notice shall be +\ included in all copies or substantial portions of the Software. +\ +\ THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, +\ EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF +\ MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND +\ NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE +\ LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION +\ OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION +\ WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. +\ +\ LICENSE_END Added: ofw/inetv6/httpdpkg.fth =================================================================== --- ofw/inetv6/httpdpkg.fth (rev 0) +++ ofw/inetv6/httpdpkg.fth 2007-08-02 21:37:59 UTC (rev 518) @@ -0,0 +1,1002 @@ +\ See license at end of file +purpose: HTTPD Server package + +\ To use this code, be certain that you have an "index.htm" +\ in the ROM as a dropin along with a "homelogo.gif". + +hex +headers + +\needs httpd-port d# 80 constant httpd-port + +false value httpd-debug? +: ?httpd-show ( adr len mask -- ) + httpd-debug? and if type space else 2drop then +; +[ifndef] show" +: ?show ( adr len -- ) 1 ?httpd-show ; +: show" ( "str" -- ) postpone " postpone ?show ; immediate +[then] +[ifndef] state" +: ?state ( adr len -- ) 2 ?httpd-show ; +: state" ( "str" -- ) postpone " postpone ?state ; immediate +[then] +[ifndef] url" +: ?url ( adr len -- ) 4 ?httpd-show ; +: url" ( "str" -- ) postpone " postpone ?url ; immediate +[then] +\needs init-display : init-display ( adr len -- ) 2drop ; + +true value key-interrupt? +" " 2value pending-cmd + +0 value hbuf \ Accumulator for incoming data +h# 800 constant /hbuf +0 value hbuf-ptr + +0 value sbuf \ A temporary string buffer +h# 40 constant /sbuf + +0 value obuf \ A buffer for constructing headers +h# 800 constant /obuf +0 value obuf-ptr + +\ The TCP stack on NT appears to do a better job of collecting data and +\ sending it all at once. If our receive buffer is too short, then +\ Netscape on NT will choke. A value of h# 100 will not work here. +0 value thbuf \ Intermediate buffer to hold data +h# 200 constant /thbuf \ from TCP stack + +: +hptr ( -- ) hbuf-ptr 1+ to hbuf-ptr ; +: reset-hbuf-ptr ( -- ) 0 to hbuf-ptr ; + +: hbuf@ ( index -- b ) + hbuf + c@ +; + +: hbuf-adr ( -- adr ) hbuf hbuf-ptr + ; + +0 instance value verbose? +0 instance value preprocess? +0 instance value authenticate? + +: parse-args ( -- ) + my-args + begin dup while ( rem$ ) + ascii , left-parse-string ( rem$' head$ ) + 2dup " debug" $= if true to httpd-debug? else ( rem$' head$ ) + 2dup " verbose" $= if true to verbose? else ( rem$' head$ ) + 2dup " preprocess" $= if true to preprocess? else ( rem$' head$ ) + 2dup " authenticate" $= if true to authenticate? else ( rem$' head$ ) + 2dup " nokey" $= if false to key-interrupt? else ( rem$' head$ ) + then then then then then ( rem$' head$ ) + 2drop + repeat + 2drop +; + +: .ipb ( adr -- adr' ) dup 1+ swap c@ (.) type ; +: .ipaddr ( addr-buff -- ) + push-decimal + 3 0 do .ipb ." ." loop .ipb drop + pop-base +; + +false instance value connected? +: ?bailout ( -- ) + key-interrupt? if + key? if key drop abort then + then + pending-cmd dup if + " " to pending-cmd include-buffer + else + 2drop + then +; +: connect ( -- ) + httpd-debug? if ." Waiting for new connection" cr then + state" W" + begin + ?bailout + httpd-port " accept" $call-parent + until + true to connected? + reset-hbuf-ptr \ Clear the buffer for a new connection + httpd-debug? if ." Connected" cr then + state" C" +; + +: open ( -- flag ) + parse-args + + " my-ip-addr" $call-parent collect( .ipaddr )collect + 2dup init-display + verbose? if + ." http://" + 2dup type + cr + key-interrupt? if + ." Type any key to stop." cr + then + then + 2drop + + /hbuf alloc-mem to hbuf + /sbuf alloc-mem to sbuf + /thbuf alloc-mem to thbuf + /obuf alloc-mem to obuf + true +; + +\ in-progress? is true while we are collecting and processing a request. +\ It is false while we are polling for a new request on a persistent +\ connection or while there is no open connection. +false value in-progress? + +\ This is a special hack that is used by the Swing Solutions application, +\ which has some HTTP requests that do not complete until an exernal event +\ occurs. The requester can abort the request by dropping the TCP +\ connection, but there are some cases where the TCP drop does not +\ appear to be propagated to the responder. Executing abort-on-reconnect +\ marks the current TCP connection so that the receipt of a new connection +\ request will abort the current one. +: abort-on-reconnect ( -- ) " abort-on-reconnect" $call-parent ; + +: reset-connection ( -- ) + " disconnect" $call-parent + false to connected? + false to in-progress? +; + +: close ( -- ) + hbuf /hbuf free-mem + sbuf /sbuf free-mem + thbuf /thbuf free-mem + obuf /obuf free-mem +; + +: read ( adr len -- actual ) + " read" $call-parent dup -1 = if + connected? if show" HDROP" then + false to connected? + then +; +: write ( adr len -- actual ) " write" $call-parent ; + +: match? ( match$ -- match? ) hbuf over $= ; + +: (send-all) ( adr len -- ) + dup 0= if 2drop exit then + tuck write 2dup <> if ( len actual ) + dup -1 = if + ." Connection closed prematurely" cr + show" HSDROP" + else + ." Write failure" cr + show" HWERR" + then + then + 2drop +; +defer send-all ' (send-all) to send-all + +: >obuf ( adr len -- ) + tuck obuf-ptr swap move obuf-ptr + to obuf-ptr +; +: init-obuf ( -- ) + ['] >obuf to send-all + obuf to obuf-ptr +; +: send-obuf ( -- ) + ['] (send-all) to send-all + obuf obuf-ptr over - send-all +; + +: send-crlf ( -- ) " "r"n" send-all ; + +: num>ascii ( n -- $ ) (u.) ; + +\ A vrsion of cat that re-uses the same buffer, rather that continually +\ using alloc-mem to create a new string. +: $cat2 ( $1 $2 -- $3 ) + \ First figure final length + 2 pick over + >r ( $1 $2 ) ( r: 3len ) + + \ Move the first string to buffer, saving length + 2swap dup >r sbuf swap move r> ( $2 len ) ( r: 3len ) + + \ Now move second string + sbuf + swap move ( ) ( r: len ) + + \ Now go.. + sbuf r> ( $3 ) +; + +: create-num$ ( len -- num$ ) + base @ >r decimal ( len ) ( r: base ) + num>ascii ( num$ ) + r> base ! ( num$ ) +; + +: get-type ( adr len -- c ) + 0 -rot + bounds do + i c@ [char] . = if drop i then ( adr ) + loop + 1+ c@ +; + +: send-content-type ( type$ -- ) + " Content-Type: " 2swap $cat2 ( adr len ) + " "r"n" $cat2 ( adr len' ) + httpd-debug? if 2dup type then ( adr len' ) + send-all +; +: presume-content-type ( url$ -- type$ ) + get-type upc ( type-char ) + case + ascii H of " text/html" endof + ascii B of " image/bmp" endof + ascii G of " image/gif" endof + ascii J of " image/jpeg" endof + ( default ) >r " text/html" r> + endcase +; + +: send-agent ( -- ) " User-Agent: FirmWorks/1.0"r"n" send-all ; +: 200-header ( -- ) " HTTP/1.0 200 OK"r"n" send-all ; +: 202-header ( -- ) " HTTP/1.0 202 Accepted"r"n" send-all ; +: 204-header ( -- ) " HTTP/1.0 204 No Content"r"n" send-all ; +: 401-header ( -- ) " HTTP/1.0 401 Not Authorized"r"n" send-all ; +: 404-header ( -- ) " HTTP/1.0 404 Not Found"r"n" send-all ; + +defer send-header +['] 200-header to send-header + +false value persistent? \ False means to disconnect after xfers + +: send-connection ( -- ) + persistent? if \ HTTP 1.1 needs to be persistent + " Connection: Keep-Alive"r"n" ( adr len ) + httpd-debug? if 2dup type then ( adr len ) + send-all ( ) + then +; + +: count-content ( data$ .. n -- data$ .. n len ) + 0 over 0 ?do ( data$ .. n len ) + i 2* 2+ pick + ( data$ .. n len' ) + loop +; +: send-content-length ( data$ .. n -- data$ .. n ) + count-content ( data$ .. n len ) + " Content-Length: " ( data$ .. n len adr len ) + rot create-num$ $cat2 ( data$ .. n adr len' ) + " "r"n" $cat2 ( data$ .. n adr len'' ) + httpd-debug? if 2dup type then ( data$ .. n adr len'' ) + send-all ( data$ .. n ) +; + +: send-pieces ( data$ .. n -- ) + 0 ?do send-all loop +; + +: type-cr ( adr len -- ) type cr ; + +\ full-response is what is used to respond to HTTP 1.0 or higher requests. +: full-response ( data$ .. n type$ -- ) + httpd-debug? if ." Sending: " 2dup type-cr then + init-obuf + send-header ( data$ .. n type$ ) + send-agent ( data$ .. n type$ ) + send-connection ( data$ .. n type$ ) + send-content-type ( data$ .. n ) + send-content-length ( data$ .. n ) + send-crlf ( data$ .. n ) \ Data separator + send-obuf + send-pieces ( ) \ Send all segments of the data +; + +\ simple-response is used to respond to HTTP 0.9 requests +: simple-response ( data$ .. n type$ -- ) 2drop send-pieces ; + +: send-response-header ( data$ .. n header$ -- ) + httpd-debug? if ." Sending: " 2dup type-cr then + init-obuf + send-header ( data$ .. n header$ ) + send-all ( data$ .. n ) + send-crlf ( data$ .. n ) \ Data separator + send-obuf + send-pieces ( ) \ Send all segments of the data +; + +defer (send) +['] full-response to (send) \ Default to HTTP 1.0 full-responses for now + +: respond ( data$ .. n type$ -- ) + state" R" + connected? 0= if ( data$ .. n type$ ) + httpd-debug? if ." Discarding response to aborted connection" cr then + 2drop 0 ?do 2drop loop + exit + then + (send) + state" S" +; + +\ Send a block of preformatted data +: send-html ( adr len -- ) 1 " text/html" respond ; + +: hbuf@++ ( -- char ) hbuf-ptr hbuf@ +hptr ; +: skip-til-white ( -- ) begin hbuf@++ bl = until ; +: skip-til ( char -- ) begin dup hbuf@++ = until drop ; +: skip-til-crlf ( -- ) carret skip-til +hptr ; + +: skip-til-white-or-? ( -- ) + begin hbuf@++ dup bl = swap [char] ? = or until +; + +: extract-url ( -- option$ url$ ) \ Pull URL $ from incomming request + reset-hbuf-ptr ( ) + skip-til-white ( ) + hbuf-adr ( start-adr ) + skip-til-white-or-? ( start-adr ) + hbuf-adr over - 1- ( start-adr len ) + + \ Kill off leading "/" from return + dup 1 >= if over c@ [char] / = if 1 /string then then + + dup 0= if ( url$ ) \ But is it real? + 2drop 0 0 ( 0 0 ) + " index.htm" ( 0 0 url$ ) \ Our default + exit ( 0 0 url$ ) \ Get out of dodge... + then + + hbuf-ptr 1- hbuf@ ascii ? = if \ We have options... + hbuf-adr ( url$ opt-adr ) + skip-til-white ( url$ opt-adr ) + hbuf-adr over - 1- ( url$ opt-adr opt-len ) + 2swap ( opt$ url$ ) + else + 0 0 2swap ( 0 0 url$ ) \ No options + then +; + +\ Dump preformatted tag into output stream +: create-pre ( -- ) " <PRE>" type-cr ; + +\ Dump end-preformatted tag into output stream +: create-endpre ( -- ) " </PRE>" type-cr ; + +\ Dump a basic HTML header into output stream +: create-header ( -- ) + no-page + " <HTML>" type-cr + " <HEAD>" type-cr + " <TITLE>Internet ROM</TITLE>" type-cr + " </HEAD>" type-cr + " <BODY TEXT=""#000000"" BGCOLOR=""#FFFFFF"" LINK=""#0000FF"" " type-cr + " VLINK=""#FF4400"">" type-cr + " <hr>" type-cr +; + +\ Dump a link to home into output stream +: et-go-home ( -- ) + " <CENTER><A href=""index.htm"" target=""_top"">Back to Main Page</A></CENTER>" type-cr +; + +\ Dump a footer into the output stream +: create-footer ( -- ) + " " type-cr + et-go-home + " <hr>" type-cr + " <CENTER><IMG SRC=""homelogo.gif""></CENTER>" type-cr + " </BODY>" type-cr + " </HTML>" type-cr + page-mode +; + +\ Collect output from execute ROM command +: collect-data ( xt -- adr len ) + collect( ( xt ) + create-header ( xt ) + create-pre ( xt ) + guarded ( ) + create-endpre ( ) + create-footer ( ) + )collect ( adr len ) +; + +\needs auth-header : auth-header ( -- $ ) " WWW-Authenticate: Basic realm=""OFW"""n"r" ; + +: send-204 ( -- ) + httpd-debug? if ." Sending 204" cr then + ['] 200-header to send-header + ['] banner collect-data send-html + ['] 200-header to send-header +; + +: send-401 ( -- ) + httpd-debug? if ." Sending 401" cr then + ['] 401-header to send-header + ['] send-response-header to (send) + 0 auth-header respond + ['] 200-header to send-header +; + +: send-404 ( -- ) + httpd-debug? if ." Sending 404" cr then + ['] 404-header to send-header + " The ROM cannot supply this information." send-html + ['] 200-header to send-header +; + +\ HTML preprocessing before sending to browser. + +0 0 instance 2value rem$ +0 instance value #data$ +: #data$+ ( -- ) #data$ 1+ to #data$ ; +: find$ ( s$ t$ -- offset find? ) + 2>r ( s$ ) ( R: t$ ) + 0 -rot begin ( offset s$ ) ( R: t$ ) + over 2r@ comp 0= if 2r> 2drop 2drop true exit then + 1 /string ( offset s$' ) ( R: t$ ) + rot 1+ -rot ( offset' s$ ) ( R: t$ ) + dup 0= until 2r> 2drop 2drop false ( offset ) +; +: eval-forth ( -- data$ ... ) + rem$ 7 /string 2dup to rem$ ( adr len ) + " </FORTH>" find$ 0= if ." Missing </FORTH>" abort then ( offset ) + rem$ drop swap ( forth$ ) + rem$ 2 pick 8 + /string to rem$ ( forth$ ) + evaluate ( data$ ... n ) + #data$ + to #data$ ( data$ ... ) +; +: swap-data$ ( data$ ... -- data$' ... n ) + #data$ if + #data$ begin + dup 2* pick over 2* pick 2>r + 1- ?dup 0= + until + #data$ 0 do 2drop loop + #data$ begin + 2r> rot 1- ?dup 0= + until + then #data$ +; +: (preprocess-html) ( data$ -- data$' ... n ) + to rem$ + begin + rem$ " <FORTH>" find$ over ( offset found? offset ) + #data$+ + rem$ drop swap 2>r ( offset found? ) ( R: data$ ) + swap rem$ rot /string to rem$ 2r> ( found? data$ ) + rot if eval-forth then ( data$ ... ) + rem$ nip 0= + until + swap-data$ ( data$ ... n ) +; +: preprocess-html ( url$ data$ -- data$' ... n' ) + preprocess? if ( url$ data$ ) + 0 to #data$ ( url$ data$ ) + 2swap get-type upc ascii H = if ( data$ ) + (preprocess-html) ( data$' ... n ) + else ( data$ ) + 1 ( data$ n ) + then + else ( url$ data$ ) + 2swap 2drop 1 ( data$ n ) + then +; + +: transaction-done ( -- ) + state" T" + persistent? if + url" tdonefw" + " flush-writes" $call-parent + reset-hbuf-ptr + false to in-progress? + else + \ url" tdonerc" + reset-connection + then + state" D" +; + +[ifndef] urls +also forth definitions +vocabulary urls +previous definitions +[then] + +: handle-url ( opt$ url$ -- ) + 2dup ['] urls search-wordlist if ( opt$ url$ xt ) + execute ( data$ .. n type$ ) + respond ( ) + state" H" + exit ( ) + then ( opt$ url$ ) + + 2dup find-drop-in if ( opt$ url$ data$ ) + 2over 2>r ( opt$ url$ data$ ) ( R: url$ ) + 2>r 2>r 2drop 2r> 2r> ( url$ data$ ) ( R: url$ ) + preprocess-html ( data$' n ) ( R: url$ ) + 2r> presume-content-type ( data$ n type$ ) + respond ( ) + exit ( ) + then ( opt$ url$ ) + + 4drop send-404 ( ) +; + +\ Basic HTTP strings all end with "crlf" +: dual-crlf? ( adr -- flag ) 4 - hbuf + " "(0d0a0d0a)" comp 0= ; + +: request-complete? ( -- complete? ) \ Tells us if we have all were going + \ to get. + \ HTTP 0.9 looks like: + \ GET <url> crlf + + \ HTTP 1.0/1.1 looks like: + \ GET <url> HTTP/1.0 crlf ...<a bunch of crlf terminated crud>... crlf + + \ The major difference being that 0.9 is a single line with a single + \ crlf at the end, 1.0 (and higher ) is multi-line (each line terminated + \ by crlf) with an additional crlf at the end of the request. + + \ We need to determine which one we have in the buffer, and if complete, + \ return true so that the request can be processed. We also want to set + \ the response type up here to simple or full depending on 0.9 or 1.x + + hbuf-ptr ( ptr ) \ Save for later + + \ Reset the pointer, then advance it to where HTTP would be if we + \ have HTTP 1.0 request. + + reset-hbuf-ptr ( ptr ) + skip-til-white ( ptr ) + skip-til-white ( ptr ) + + \ Now test the buffer and take action accordingly + + " HTTP" hbuf hbuf-ptr + 4 ( ptr test$ buf$ ) + $= if ( ptr ) \ HTTP 1.x + ['] full-response to (send) + \ Now we have to see if we have all of this request or not + dup dual-crlf? ( ptr flag ) + + \ Now we have to setup to deal with persistent connections. + \ This is a bit of a cheat. We should be looking at the + \ "connection:" field (if it exists) in the incoming URL + \ requset. If it set to "Keep-Alive" then we would set + \ the persistent flag. But so far, *everyone* always sets + \ the Keep-Alive flag. But 1.0 implementations don't work, + \ and 1.1 implementations really want it to. So we just + \ set the persistance based on 1.1ness. + + \ " 1.0" hbuf hbuf-ptr + 5 + 3 $= 0= to persistent? + else \ HTTP 0.9 + \ We have all we are going to get. + ['] simple-response to (send) + true ( ptr true ) + then + + swap to hbuf-ptr ( flag ) \ Restore buffer pointer in case + \ there is more to come. +; + +: b64>6bit ( byte -- 6bit ) + dup ascii A ascii Z between if ascii A - exit then + dup ascii a ascii z between if ascii a - d# 26 + exit then + dup ascii 0 ascii 9 between if ascii 0 - d# 52 + exit then + case + ascii + of 3e endof + ascii / of 3f endof + ( default ) 0 swap + endcase +; + +: b64>ascii ( b64$ -- adr len ) + over dup >r 0 2swap ( adr len b64$ ) ( R: adr ) + bounds ?do ( adr len ) ( R: adr ) + i l@ lbsplit ( adr len b3 b2 b1 b0 ) ( R: adr ) + b64>6bit d# 18 << ( adr len b3 b2 b1 val ) ( R: adr ) + swap b64>6bit d# 12 << or ( adr len b3 b2 val' ) ( R: adr ) + swap b64>6bit d# 6 << or ( adr len b3 val' ) ( R: adr ) + swap b64>6bit or ( adr len val' ) ( R: adr ) + lbsplit drop ( adr len b3 b2 b1 ) ( R: adr ) + 4 pick c! ( adr len b3 b2 ) ( R: adr ) + 3 pick 1+ c! ( adr len b3 ) ( R: adr ) + 2 pick 2 + c! ( adr len ) ( R: adr ) + 3 + swap 3 + swap ( adr' len' ) ( R: adr ) + 4 +loop + dup if \ strip trailing 0's + 3 1 do + over i - c@ 0= if 1- then + loop + then nip ( len' ) + r> swap ( adr len ) +; + +: (authorized?) ( realm$ pwd$ user$ -- authorized? ) + " admin" $= >r " ofw" $= r> and + -rot 2drop +; + +defer authorized? +[ifdef] oem-authorized? + ['] oem-authorized? to authorized? +[else] + ['] (authorized?) to authorized? +[then] + +: extract-auth ( -- realm$ pwd$ user$ ) + begin skip-til-crlf hbuf-adr " "(0d0a)" comp while + hbuf-adr ( adr ) + [char] : skip-til ( adr ) + hbuf-adr over - 1- ( token$ ) + " Authorization" $= if ( ) + skip-til-white ( ) + hbuf-adr ( adr ) + skip-til-white + hbuf-adr over - 1- ( realm$ ) + hbuf-adr ( realm$ adr ) + skip-til-crlf + hbuf-adr over - 2 - ( realm$ base64$ ) + b64>ascii ( realm$ user:pwd$ ) + [char] : left-parse-string ( realm$ pwd$ user$ ) + exit + then + repeat + null$ null$ null$ +; + +: authenticate-request? ( -- authorized? ) + extract-auth ( realm$ pwd$ user$ ) + authorized? +; + +\ Since we serve up the HTML code, we can decide what to support. You +\ can do everything with "GET"s, and do not really need to support +\ POSTs. POSTs are better for security issues, but since this code +\ would not really be executed in the normal case, this should be a +\ minor issue. + +: do-get ( -- ) + request-complete? if + + httpd-debug? if cr hbuf hbuf-ptr type then + + extract-url ( opt$ url$ ) + + httpd-debug? if ( opt$ url$ ) + ." URL: " 2dup type-cr ( opt$ url$ ) + 2over ( opt$ url$ opt$ ) + ?dup if ( opt$ url$ opt$ ) + ." OPT: " type-cr ( opt$ url$ ) + else drop then ( opt$ url$ ) + then ( opt$ url$ ) + + authenticate? if ( opt$ url$ ) + authenticate-request? 0= if ( ) + 4drop ( ) + send-401 + transaction-done + exit + then + then + + handle-url ( ) + + transaction-done + then +; + +: do-post ( -- ) + request-complete? if + httpd-debug? if cr hbuf hbuf-ptr type then + send-204 + transaction-done + then +; + +: handle-buf ( -- ) + " GET" match? if do-get then + " POST" match? if do-post then +; + +false instance value crlf-seen? +: >hbuf ( b -- ) \ Accumulate data, when we get a CRLF pair, go check it + hbuf hbuf-ptr + c! + +hptr + hbuf-ptr 2 >= if + hbuf-ptr hbuf + 2- " "(0d0a)" comp 0= if handle-buf then + then +; + +0 value end-time +d# 5000 constant short-time +d# 30000 constant long-time + +: reset-timer ( -- ) + true to in-progress? + persistent? if long-time else short-time then ( timeout-msecs ) + get-msecs + to end-time +; + +: do-disconnect ( -- ) + httpd-debug? if ." Disconnect reset" cr then + url" discrc" + reset-connection +; +: do-idle ( -- ) + in-progress? if + key-interrupt? if + key? if + key drop + ." HTTPD transaction in progress; interacting " cr + interact + then + then + else + ?bailout + then + + persistent? if exit then + get-msecs end-time - 0> if + httpd-debug? if ." Timeout reset" cr then + url" idlerc" + reset-connection + then +; + +\ Call into the TCP stack, just shovel the data to our collection +\ buffer. The shoveler (>hbuf) will decide when there is enough +\ data to work on. +: httpd-loop ( -- ) + false to in-progress? + begin + connected? 0= if connect reset-timer then + + thbuf /thbuf read case ( -1|-2|actual ) + -1 of do-disconnect endof + -2 of do-idle endof + ( actual ) + reset-timer ( actual ) + thbuf over bounds do i c@ >hbuf loop ( actual ) + endcase + key-interrupt? if key? if key emit exit then then + again +; + + +\ builtin URLs +\ this is essentially demo code + +hex +headers + +\ support for the built-in URLs + +\ Creates return message for setenv +: nice-message ( val$ var$ -- adr len ) + collect( ( val$ var$ ) + create-header ( val$ var$ ) + " ROM Configuration Variable " type ( val$ var$ ) + " " type ( val$ var$ ) + type ( val$ ) + " " type ( val$ ) + " set to " type ( val$ ) + " " type ( val$ ) + type-cr ( ) + " " type ( ) + " " type-cr + create-footer + )collect +; + +\ \ Creates return message for setenv +\ : nice-message1 ( var$ -- adr len ) +\ collect( ( var$ ) +\ create-header ( var$ ) +\ " ROM Configuration Variable " type ( var$ ) +\ " " type ( var$ ) +\ type ( ) +\ " " type ( ) +\ " set to default value" type ( ) +\ " " type ( ) +\ " " type-cr +\ create-footer +\ )collect +\ ; + +\ HTTP strings have a "+" where blanks are suppsed to be. Just whack them. +: fix-blanks ( adr len -- ) + bounds ?do + i c@ [char] + = if bl i c! then + loop +; + +\ HTTP strings mungle up the special characters. Instead of a "/" for +\ example, you get "%2F". This routine looks for the "%" characters, +\ extracts the ascii string after that, converts it to the real hex +\ value and punches it back where the "%" was, then moves everything +\ else to the left by two. +: fixup-string ( adr len -- adr len' ) + 2dup fix-blanks \ First whack the blanks into shape. + dup 3 < if exit then \ Cannot possibly have %xx. + 2dup 2- bounds ?do + i c@ [char] % = if + i 1+ 2 $number 0<> if ." Parsing error" unloop exit then + ( adr len b ) i c! + i 3 + ( adr len src ) + i 1 + ( adr len src dst ) + over 4 pick - ( adr len src dst #ok ) + 3 pick swap - ( adr len src dst len ) + move ( adr len ) + 2- ( adr len' ) + then + loop +; + +also urls definitions + +: stop ( opt$ url$ -- httpd-stuff ) + " abort" to pending-cmd + " Closing remote HTTP server" 1 " text/plain" +; +: reboot ( opt$ url$ -- httpd-stuff ) + " bye" to pending-cmd + " Rebooting remote system" 1 " text/plain" +; + +\ This is really demo code, not ready for primetime. We deal with some +\ special cases with this code example. If a URL comes in as +\ "rom-setconfig-tf", then we go look for some other stuff in the +\ incomming request packet, reformat the whole wad into a "setenv" +\ command and execute it. This "-tf" method looks at the first +\ character of the incoming set string for "t" or "f" and then creates +\ its own "true" or "false" to pass to the setenv command. Helps with +\ people that can't spell. The second special is really a more general +\ case inplementaion. rom-setconfig-string parses out the string that +\ is passed in and sets the environment variable accordingly. Just +\ another way to do it. Demo code after all. If the request URL has +\ "rom-ok" in it, we treat the passed in data as a string that we just +\ pass to the "ok" prompt, returning whatever we get back. Any other +\ request that is prefeaced by "rom-" is assumed to be a method call, so +\ we go look for an XT, then execute it, returning the data. Thus +\ showing four possibilities of how one might interface to the ROM via +\ HTTP. + +: rom-setconfig-tf ( opt$ url$ -- httpd-stuff ) + \ OK, the option string will have what we need in it. We need to + \ extract what we need from it, run the setenv command and return + \ something nice to the user... + 2drop + hbuf swap move ( ) \ Re-use the hbuf XXX this is bad. + reset-hbuf-ptr + [char] = skip-til hbuf-adr ( adr ) + [char] & skip-til hbuf-adr over - 1- ( var$ ) + fixup-string ( var$' ) + [char] = skip-til ( var$' adr ) + hbuf-adr c@ ascii t = if + " true" else " false" ( var$' val$ ) + then + 2swap 4dup ( val$ var$' val$ var$' ) + collect( $setenv )collect ( val$ var$' adr len ) + 2drop ( val$ var$' ) + nice-message 1 " text/html" +; + +: rom-setconfig-string ( opt$ url$ -- httpd-stuff ) + \ OK, the option string will have what we need in it. We need to + \ extract what we need from it, run the setenv command and return + \ something nice to the user... + 2drop + hbuf swap dup >r move ( ) \ Re-use the hbuf + reset-hbuf-ptr + [char] = skip-til hbuf-adr ( adr ) + [char] & skip-til hbuf-adr over - 1- ( var$ ) + fixup-string ( var$' ) + [char] = skip-til ( var$' ) + hbuf-adr ( var$ val-adr ) + hbuf - ( var$ count ) + hbuf r> ( var$ count adr len ) + rot /string ( var$ val$ ) + fixup-string ( var$ val$ ) + 2swap 4dup ( val$ var$' val$ var$' ) + collect( $setenv )collect ( val$ var$' adr len ) + 2drop ( val$ var$' ) + nice-message 1 " text/html" +; + +: rom-setdefault ( opt$ url$ -- httpd-stuff ) + \ OK, the option string will have what we need in it. We need to + \ extract what we need from it, run the set-default command and return + \ something nice to the user... + 2drop + hbuf swap dup >r move ( ) \ Re-use the hbuf + reset-hbuf-ptr + [char] = skip-til hbuf-adr ( adr ) + hbuf - hbuf r> rot /string ( var$ ) + fixup-string 2dup ( var$' var$' ) + collect( + create-header + create-pre + find-option if do-set-default then + (printenv) + create-endpre + create-footer + )collect ( adr len ) + 1 " text/html" +; + +: rom-restart ( opt$ url$ -- ) + \ rom-restart?option_file=url&var=value + 2drop + hbuf swap dup >r move ( ) \ Re-use the hbuf + reset-hbuf-ptr + [char] = skip-til hbuf-adr ( adr ) + [char] & skip-til hbuf-adr over - 1- ( url$ ) + fixup-string ( url$' ) + + 2dup find-drop-in if ( url$ data$ ) + 2over 2>r ( url$ data$ ) ( R: url$ ) + preprocess-html ( data$' n ) + 2r> presume-content-type ( data$ n type$ ) + respond ( ) + transaction-done ( ) + else ( url$ ) + 2drop + then + + hbuf-adr [char] = skip-til ( var ) + hbuf-adr over - 1- ( var$ ) + + hbuf-adr ( var$ val-adr ) + hbuf - ( var$ count ) + hbuf r> ( var$ count adr len ) + rot /string ( var$ val$ ) + fixup-string 2swap ( val$' var$ ) + collect( $setenv )collect 2drop ( ) + + reset-all +; + +\ command?here+.+cr plusses become blanks +\ command?4+5+%2b+.+cr use %2b to get a plus +\ note: the web page encodes the command string before sending it +\ and sends command?command=here+.+cr +: cmdeq ( -- $ ) " command=" ; +: command ( opt$ url$ -- httpd-stuff ) + 2drop + cmdeq 2over sindex 0= if + cmdeq nip /string + then + fixup-string ['] eval collect-data 1 " text/html" +; + +previous definitions +\ LICENSE_BEGIN +\ Copyright (c) 2006 FirmWorks +\ +\ Permission is hereby granted, free of charge, to any person obtaining +\ a copy of this software and associated documentation files (the +\ "Software"), to deal in the Software without restriction, including +\ without limitation the rights to use, copy, modify, merge, publish, +\ distribute, sublicense, and/or sell copies of the Software, and to +\ permit persons to whom the Software is furnished to do so, subject to +\ the following conditions: +\ +\ The above copyright notice and this permission notice shall be +\ included in all copies or substantial portions of the Software. +\ +\ THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, +\ EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF +\ MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND +\ NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE +\ LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION +\ OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION +\ WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. +\ +\ LICENSE_END Added: ofw/inetv6/icmpecho.fth =================================================================== --- ofw/inetv6/icmpecho.fth (rev 0) +++ ofw/inetv6/icmpecho.fth 2007-08-02 21:37:59 UTC (rev 518) @@ -0,0 +1,70 @@ +\ See license at end of file +purpose: Internet Control Message Protocol version 6 (ICMPv6) echo message handlers + +: exchange-byte ( adr1 adr2 -- ) + over c@ over c@ ( adr1 adr2 byte1 byte2 ) + swap rot ( adr1 byte2 byte1 adr2 ) + c! ( adr1 byte2 ) + swap c! ( ) +; +: exchange-bytes ( adr1 adr2 len -- ) + 0 ?do over i + over i + exchange-byte loop 2drop +; +: exchange-mac ( adr len -- ) + drop dup /e + /e exchange-bytes +; +: exchange-ipsv6 ( adr len -- ) drop 8 + dup /ipv6 + /ipv6 exchange-bytes ; +: change-typev6 ( adr len -- ) drop d# 129 swap xc! ; + +: recompute-icmpv6-checksum ( icmp-adr,len ip-adr,len -- ) + 2swap dup 1 and if ( ip-adr,len icmp-adr,len ) + 2dup + 0 swap c! 1+ ( ip-adr,len icmp-adr,len' ) + then ( ip-adr,len icmp-adr,len' ) + 2swap drop 8 + dup /ipv6 + ( icmp-adr,len ipv6-1 ipv6-2 ) + compute-icmpv6-checksum ( ) +; + +: handle-echo-req ( icmp-adr,len -- ) + \ XXX For now, support simplistic IPv6 header + ICMPv6 echo packet. + 2dup /ipv6-header negate /string ( icmp-adr,len ip-adr,len ) + 2dup /ether-header negate /string ( icmp-adr,len ip-adr,len en-adr,len ) + bootnet-debug if + ." Echo request from: " over /e + .enaddr cr + then + 2dup exchange-mac -drot ( en-adr,len icmp-adr,len ip-adr,len ) + 2dup exchange-ipsv6 ( en-adr,len icmp-adr,len ip-adr,len ) + 2over change-typev6 ( en-adr,len icmp-adr,len ip-adr,len ) + recompute-icmpv6-checksum ( en-adr,len ) + tuck " write" $call-parent ( len actual ) + <> if ." Network transmit error" cr then +; + +: handle-echo-reply ( adr len -- ) 2drop ; + +headers + +\ LICENSE_BEGIN +\ Copyright (c) 2006 FirmWorks +\ +\ Permission is hereby granted, free of charge, to any person obtaining +\ a copy of this software and associated documentation files (the +\ "Software"), to deal in the Software without restriction, including +\ without limitation the rights to use, copy, modify, merge, publish, +\ distribute, sublicense, and/or sell copies of the Software, and to +\ permit persons to whom the Software is furnished to do so, subject to +\ the following conditions: +\ +\ The above copyright notice and this permission notice shall be +\ included in all copies or substantial portions of the Software. +\ +\ THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, +\ EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF +\ MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND +\ NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE +\ LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION +\ OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION +\ WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. +\ +\ LICENSE_END + + Added: ofw/inetv6/icmperr.fth =================================================================== --- ofw/inetv6/icmperr.fth (rev 0) +++ ofw/inetv6/icmperr.fth 2007-08-02 21:37:59 UTC (rev 518) @@ -0,0 +1,89 @@ +\ See license at end of file +purpose: Internet Control Message Protocol version 6 (ICMPv6) error message handlers + +: .icmpv6-unknown-err ( type -- ) + ." Unknown error message type: " u. +; + +: .icmpv6-dest-err ( -- ) + icmp-code c@ case + 0 of ." No route to destination" endof + 1 of ." Communication with destination administratively prohibited" endof + 2 of ." Beyond scope of source address" endof + 3 of ." Address unreachable" endof + 4 of ." Port unreachable" endof + 5 of ." Source address failed ingress/egress policy" endof + 6 of ." Eject route to destination" endof + ( default ) ." Unknown destination unreachable code: " dup u. + endcase +; + +: .icmpv6-size-err ( -- ) + ." Packet too big. MTU of next hop link is: " icmp-mtu xl@ u. +; + +: .icmpv6-time-err ( -- ) + icmp-code c@ case + 0 of ." Hop limit exceeded in transit" endof + 1 of ." Fragment reassembly time exceeded" endof + ( default ) ." Unknown time exceeded code: " dup u. + endcase +; + +: .icmpv6-arg-err ( -- ) + icmp-code c@ case + 0 of ." Erroneous header field encountered" endof + 1 of ." Unrecognized next header type encountered" endof + 2 of ." Unrecognized IPv6 option encountered" endof + ( default ) ." Unkown parameter problem code: " dup u. + endcase +; + +: .icmpv6-err ( -- ) + ." ICMPv6: " + icmp-type c@ + case + 1 of .icmpv6-dest-err endof + 2 of .icmpv6-size-err endof + 3 of .icmpv6-time-err endof + 4 of .icmpv6-arg-err endof + ( default ) .icmpv6-unknown-err + endcase + cr +; + +: handle-icmpv6-err ( adr len -- ) + over set-struct ( adr len ) + .icmpv6-err ( adr len ) + icmp-code c@ -rot ( code adr len ) + icmp-type c@ -rot ( code type adr len ) + icmpv6-err-callback-xt execute +; + +headers + +\ LICENSE_BEGIN +\ Copyright (c) 2006 FirmWorks +\ +\ Permission is hereby granted, free of charge, to any person obtaining +\ a copy of this software and associated documentation files (the +\ "Software"), to deal in the Software without restriction, including +\ without limitation the rights to use, copy, modify, merge, publish, +\ distribute, sublicense, and/or sell copies of the Software, and to +\ permit persons to whom the Software is furnished to do so, subject to +\ the following conditions: +\ +\ The above copyright notice and this permission notice shall be +\ included in all copies or substantial portions of the Software. +\ +\ THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, +\ EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF +\ MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND +\ NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE +\ LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION +\ OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION +\ WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. +\ +\ LICENSE_END + + Added: ofw/inetv6/icmpinfo.fth =================================================================== --- ofw/inetv6/icmpinfo.fth (rev 0) +++ ofw/inetv6/icmpinfo.fth 2007-08-02 21:37:59 UTC (rev 518) @@ -0,0 +1,109 @@ +\ See license at end of file +purpose: Internet Control Message Protocol version 6 (ICMPv6) info message handlers + +\ ************************* Multicast Group Management ************************* +: handle-mc-query ( adr len -- ) 2drop ; \ Multicast listener query +: handle-mc-report ( adr len -- ) 2drop ; \ Multicast listener report +: handle-mc-report2 ( adr len -- ) 2drop ; \ Version 2 multicast listener report +: handle-mc-done ( adr len -- ) 2drop ; \ Multicast done + +\ ****************** Neighbor Discovery and Autoconfiguration ****************** +: handle-router-sol ( adr len -- ) 2drop ; \ Router solicitation +: handle-router-ad ( adr len -- ) 2drop ; \ Router advertisement + +: handle-mc-router-ad ( adr len -- ) 2drop ; \ Multicast router advertisement +: handle-mc-router-sol ( adr len -- ) 2drop ; \ Multicast router solicitation +: handle-mc-router-term ( adr len -- ) 2drop ; \ Multicast router termination + +: send-neigh-sol ( -- ) + d# 24 allocate-icmpv6 set-struct \ Dest IPv6 + one option + d# 135 icmp-type xc! + 0 icmp-code xc! + 0 icmp-flags xl! + his-ipv6-addr icmp-data copy-ipv6-addr + h# 101 icmp-data /ipv6 + xw! \ Option type 1 (source mac addr) + \ Length (in 8 octels) + my-en-addr icmp-data /ipv6 + 2 + copy-ipv6-addr + hop-limit >r h# ff to hop-limit \ Save and change hop-limit + the-struct d# 24 2dup send-mc-icmpv6-packet + free-icmpv6 + r> to hop-limit \ Restore hop-limit +; + +: send-neigh-ad ( solicited? -- ) + d# 24 allocate-icmpv6 set-struct \ Dest IPv6 + one option + + d# 136 icmp-type xc! + 0 icmp-code xc! + h# 40 and h# 20 or icmp-flags xl! \ Flags = (un)solicited, override + my-ipv6-addr icmp-data copy-ipv6-addr + h# 201 icmp-data /ipv6 + xw! \ Option type 2 (target mac addr) + \ Length (in 8 octels) + my-en-addr icmp-data /ipv6 + 2 + copy-ipv6-addr + + hop-limit >r h# ff to hop-limit \ Save and change hop-limit + the-struct d# 24 2dup send-icmpv6-packet + free-icmpv6 + r> to hop-limit \ Restore hop-limit +; + +: handle-neigh-sol ( adr len -- ) \ Neighbor solicitation + \ XXX Verify hop limit is 255. + dup d# 24 < if 2drop exit then + bootnet-debug if + ." Neighbor solicitation from MAC: " over d# 26 + .enaddr cr + then + over /icmp-header + my-ipv6-addr ipv6= not if ." Not for me" cr 2drop exit then + 2drop + \ XXX Send Neighbor Advertisement + true send-neigh-ad +; + +: handle-neigh-ad ( adr len -- ) 2drop ; \ Neighbor advertisement + +: handle-inv-neigh-sol ( adr len -- ) 2drop ; \ Inverse neighbor discovery solicitation +: handle-inv-neigh-ad ( adr len -- ) 2drop ; \ Inverse neighbor discovery advertisement + +: handle-redirect-msg ( adr len -- ) 2drop ; \ Redirect message + +: handle-cert-sol ( adr len -- ) 2drop ; \ Certification path solicitation +: handle-cert-ad ( adr len -- ) 2drop ; \ Certification path advertisement + +: handle-router-renum ( adr len -- ) 2drop ; \ Router renumbering + +: handle-info-query ( adr len -- ) 2drop ; \ ICMP node information query +: handle-info ( adr len -- ) 2drop ; \ ICMP node information response + +\ ******************************** Mobile IPv6 ********************************* +: handle-ha-request ( adr len -- ) 2drop ; \ ICMP home agent address discovery request +: handle-ha-reply ( adr len -- ) 2drop ; \ ICMP home agent address discovery reply +: handle-mobile-sol ( adr len -- ) 2drop ; \ ICMP mobile prefix solicitation +: handle-mobile-ad ( adr len -- ) 2drop ; \ ICMP mobile prefix advertisement + +headers + +\ LICENSE_BEGIN +\ Copyright (c) 2006 FirmWorks +\ +\ Permission is hereby granted, free of charge, to any person obtaining +\ a copy of this software and associated documentation files (the +\ "Software"), to deal in the Software without restriction, including +\ without limitation the rights to use, copy, modify, merge, publish, +\ distribute, sublicense, and/or sell copies of the Software, and to +\ permit persons to whom the Software is furnished to do so, subject to +\ the following conditions: +\ +\ The above copyright notice and this permission notice shall be +\ included in all copies or substantial portions of the Software. +\ +\ THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, +\ EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF +\ MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND +\ NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE +\ LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION +\ OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION +\ WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. +\ +\ LICENSE_END + + Added: ofw/inetv6/icmpv6.fth =================================================================== --- ofw/inetv6/icmpv6.fth (rev 0) +++ ofw/inetv6/icmpv6.fth 2007-08-02 21:37:59 UTC (rev 518) @@ -0,0 +1,136 @@ +\ See license at end of file +purpose: Internet Control Message Protocol version 6 (ICMPv6) + +' 4drop instance value icmpv6-err-callback-xt ( code type adr len -- ) +' 2drop instance value icmpv6-info-callback-xt ( adr len -- ) +: set-icmpv6-err-callback ( xt -- ) to icmpv6-err-callback-xt ; +: set-icmpv6-info-callback ( xt -- ) to icmpv6-info-callback-xt ; + +struct ( ICMP ) + /c sfield icmp-type + /c sfield icmp-code + /w sfield icmp-checksum + 0 sfield icmp-flags + 0 sfield icmp-mtu + /w sfield icmp-id + /w sfield icmp-seq + 0 sfield icmp-data +constant /icmp-header + +0 instance value icmpv6-packet +0 instance value /icmpv6-packet + +: allocate-icmpv6 ( len -- adr ) /icmp-header + allocate-ipv6 ; +: free-icmpv6 ( adr len -- ) /icmp-header + free-ipv6 ; + +variable icmp-temp +: pseudo-hdr-checksum ( len ipv6-1 ipv6-2 -- chksum ) + 0 swap /ipv6 (oc-checksum) ( len ipv6-1 chksum ) + swap /ipv6 (oc-checksum) ( len chksum' ) + swap icmp-temp be-l! ( chksum ) + icmp-temp /l (oc-checksum) ( chksum' ) + IP_HDR_ICMPV6 icmp-temp be-l! ( chksum ) + icmp-temp /l (oc-checksum) ( chksum' ) +; + +: compute-icmpv6-checksum ( adr len ipv6-1 ipv6-2 -- ) + 2>r dup 2r> ( adr len len ipv6-1 ipv6-2 ) + pseudo-hdr-checksum >r ( adr len ) ( R: chksum ) + over set-struct ( adr len ) ( R: chksum ) + 0 icmp-checksum be-w! ( adr len ) ( R: chksum ) \ Zap ICMP checksum + r> -rot oc-checksum ( sum ) + icmp-checksum be-w! ( ) +; + +: send-icmpv6-packet ( adr len -- ) \ len = length of ICMP data (does not include header) + /icmp-header + 2dup his-ipv6-addr my-ipv6-addr compute-icmpv6-checksum + IP_HDR_ICMPV6 send-ipv6-packet +; + +/ipv6 buffer: his-ipv6-temp +: send-mc-icmpv6-packet ( adr len -- ) \ Send to his multicast IPv6 address + his-ipv6-addr his-ipv6-temp copy-ipv6-addr + his-mc-ipv6-addr his-ipv6-addr copy-ipv6-addr + send-icmpv6-packet + his-ipv6-temp his-ipv6-addr copy-ipv6-addr +; + +\ ICMPv6 error handlers (icmp-type: 0-127) +fload ${BP}/ofw/inetv6/icmperr.fth \ Error handling routines + +\ ICMPv6 info handlers (icmp-type: 128-255) +fload ${BP}/ofw/inetv6/icmpecho.fth \ Echo handling routines +fload ${BP}/ofw/inetv6/icmpinfo.fth \ Other info message handling routines + +decimal +: handle-icmpv6-info ( adr len -- ) + over c@ case + 128 of handle-echo-req endof \ Echo request + 129 of handle-echo-reply endof \ Echo reply + 130 of handle-mc-query endof \ Multicast listener query + 131 of handle-mc-report endof \ Multicast listener report + 132 of handle-mc-done endof \ Multicast done + 133 of handle-router-sol endof \ Router solicitation + 134 of handle-router-ad endof \ Router advertisement + 135 of handle-neigh-sol endof \ Neighbor solicitation + 136 of handle-neigh-ad endof \ Neighbor advertisement + 137 of handle-redirect-msg endof \ Redirect message + 138 of handle-router-renum endof \ Router renumbering + 139 of handle-info-query endof \ ICMP node information query + 140 of handle-info endof \ ICMP node information response + 141 of handle-inv-neigh-sol endof \ Inverse neighbor discovery solicitation + 142 of handle-inv-neigh-ad endof \ Inverse neighbor discovery advertisement + 143 of handle-mc-report2 endof \ Version 2 multicast listener report + 144 of handle-ha-request endof \ ICMP home agent address discovery request + 145 of handle-ha-reply endof \ ICMP home agent address discovery reply + 146 of handle-mobile-sol endof \ ICMP mobile prefix solicitation + 147 of handle-mobile-ad endof \ ICMP mobile prefix advertisement + 148 of handle-cert-sol endof \ Certification path solicitation + 149 of handle-cert-ad endof \ Certification path advertisement + 151 of handle-mc-router-ad endof \ Multicast router advertisement + 152 of handle-mc-router-sol endof \ Multicast router solicitation + 153 of handle-mc-router-term endof \ Multicast router termination + ( default ) nip nip + endcase +; + +hex + +: (handle-icmpv6) ( adr len protocol -- ) + IP_HDR_ICMPV6 <> if 2drop exit then \ Not an ICMPv6 packet + dup if \ Nonzero length + \ XXX verify checksum + the-struct >r \ Save the-struct + over c@ h# 80 and if handle-icmpv6-info else handle-icmpv6-err then + r> set-struct \ Restore the-struct + else + 2drop + then +; +' (handle-icmpv6) to handle-icmpv6 + +headers + +\ LICENSE_BEGIN +\ Copyright (c) 2006 FirmWorks +\ +\ Permission is hereby granted, free of charge, to any person obtaining +\ a copy of this software and associated documentation files (the +\ "Software"), to deal in the Software without restriction, including +\ without limitation the rights to use, copy, modify, merge, publish, +\ distribute, sublicense, and/or sell copies of the Software, and to +\ permit persons to whom the Software is furnished to do so, subject to +\ the following conditions: +\ +\ The above copyright notice and this permission notice shall be +\ included in all copies or substantial portions of the Software. +\ +\ THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, +\ EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF +\ MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND +\ NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE +\ LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION +\ OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION +\ WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. +\ +\ LICENSE_END Added: ofw/inetv6/ip.fth =================================================================== --- ofw/inetv6/ip.fth (rev 0) +++ ofw/inetv6/ip.fth 2007-08-02 21:37:59 UTC (rev 518) @@ -0,0 +1,234 @@ +\ See license at end of file +purpose: Simple Internet Protocol (IP) implementation + + +\ Internet protocol (IP). + +decimal + +4 constant /i \ Bytes per IP address + +: copy-ip-addr ( src dst -- ) /i move ; + +/i buffer: my-ip-addr +/i buffer: subnetmask + +headerless +\ Give the net up to 4 seconds to respond to packets +instance variable timeout-msecs d# 4000 timeout-msecs ! + +struct ( ip-header ) + 1 sfield ip-version \ Actually, this is VVVVLLLL, where LLLL is the + \ header length in 32-bit words. + 1 sfield ip-service + 2 sfield ip-length + 2 sfield ip-id + 2 sfield ip-fragment + 1 sfield ip-ttl + 1 sfield ip-protocol + 2 sfield ip-checksum + /i sfield ip-source-addr + /i sfield ip-dest-addr +\ It is possible to have a variable-length list of options here at the end. +\ Options contain information like source routing lists, return route lists, +\ and error reports. The low nibble of the ip-version byte gives the length +\ of the header including the options. +constant /ip-header + +\ These things hardly ever change, so we make them variables +instance variable ttl d# 123 ttl ! +instance variable ip-sequence +d# 256 buffer: 'domain-name +headers +/i buffer: his-ip-addr +/i buffer: name-server-ip +' 'domain-name " domain-name" chosen-string + +headerless + +decimal +h# 800 constant IP_TYPE + +instance variable total-length + +instance variable bufptr +: -buf, ( c -- ) -1 bufptr +! bufptr @ c! ; + +/i buffer: broadcast-ip-addr + +create def-broadcast-ip h# ff c, h# ff c, h# ff c, h# ff c, +create unknown-ip-addr h# 00 c, h# 00 c, h# 00 c, h# 00 c, + +: ip= ( ip-addr1 ip-addr2 -- flag ) /i comp 0= ; + +: unknown-ip-addr? ( adr-buf -- flag ) unknown-ip-addr ip= ; +: known? ( adr-buf -- flag ) unknown-ip-addr? 0= ; + +\ Offsets 0,1,2 into this array yield default netmasks for classes C,B,A +create default-netmasks d# 255 c, d# 255 c, d# 255 c, 0 c, 0 c, 0 c, + +: default-netmask ( -- 'netmask ) + default-netmasks ( 'netmask-c ) + my-ip-addr known? if ( 'netmask-c ) + my-ip-addr c@ h# 80 and 0= if 2+ exit then ( 'netmask-c ) + my-ip-addr c@ h# 40 and 0= if 1+ exit then ( 'netmask-c ) + then ( 'netmask-c ) +; + +\ either h# ffffffff or h# 0 is broadcast ip addr +: broadcast-ip-addr? ( adr-buf -- flag ) + dup broadcast-ip-addr ip= swap unknown-ip-addr? or +; + +: netmask ( -- 'ip ) + subnetmask unknown-ip-addr? if default-netmask else subnetmask then +; +[ifndef] c@+ +: c@+ ( adr -- adr' b ) dup 1+ swap c@ ; +[then] +: ip-prefix=? ( ip1 ip2 -- flag ) + netmask /i 0 do ( ip1 ip2 nm ) + rot c@+ >r ( ip2 nm ip1' r: b1 ) + rot c@+ >r ( nm ip1' ip2' r: b1 b2 ) + rot c@+ ( ip1' ip2' nm' bn r: b1 b2 ) + dup r> and swap r> and ( ip1 ip2 nm b2' b1' ) + <> if 3drop false unloop exit then ( ip1 ip2 nm ) + loop ( ip1 ip2 nm ) + 3drop true +; + +/i buffer: router-ip-addr +: use-router? ( -- flag ) router-ip-addr known? ; + +/i buffer: server-ip-addr +: use-server? ( -- flag ) server-ip-addr known? ; + + +: dec-byte ( n -- ) u#s ascii . hold drop ; +: (.ipaddr) ( buf -- ) + push-decimal ( buf ) + <# dup /i + 1- do i c@ dec-byte -1 +loop 0 u#> 1 /string ( adr len ) + pop-base + type space +; +: .ipaddr ( buf -- ) + dup unknown-ip-addr? if drop ." none" exit then ( buf ) + dup broadcast-ip-addr? if drop ." broadcast" exit then ( buf ) + (.ipaddr) +; +partial-headers +: indent ( -- ) bootnet-debug if ." " then ; +headerless +: .my-ip-addr ( -- ) ." My IP: " my-ip-addr .ipaddr ; +: .his-ip-addr ( -- ) ." His IP: " his-ip-addr .ipaddr ; + +0 instance value last-ip-packet + +headers +: set-dest-ip ( buf -- ) + dup his-ip-addr ip= if + drop + else + his-ip-addr copy-ip-addr + unlock-link-addr + then +; + +: lock-ip-address ( -- ) + the-struct >r last-ip-packet set-struct + \ Don't change his-ip-addr for booting over gateway + use-router? if \ booting over a gateway. + bootnet-debug if indent ." Using router" cr then + else + \ In case of direct booting, i.e. booting over specified server + \ don't change his addresses + use-server? 0= if ip-source-addr set-dest-ip then + lock-link-addr + then + bootnet-debug if indent .his-link-addr .his-ip-addr then + r> set-struct +; +: unlock-ip-address ( -- ) + unknown-ip-addr set-dest-ip + unknown-ip-addr server-ip-addr copy-ip-addr +; +headerless + +\ This is a hook for handling IP packets addressed to us that are +\ of a different type than the expected one. This could be used +\ to handle "behind the scenes" things like ICMP if necessary. +defer handle-ip ( adr len protocol -- ) +defer handle-other-ip ( adr len -- ) +headers +: (handle-ip) ( adr len protocol -- ) + bootnet-debug if + dup ." (Discarding IP packet of protocol " u. ." )" cr + then + 3drop +; +' (handle-ip) is handle-ip + +: (handle-other-ip) ( adr len -- ) + bootnet-debug if + ." (Discarding IP packet because of IP address mismatch)" cr + then + 2drop +; +' (handle-other-ip) is handle-other-ip +headerless + +: ip-payload ( len -- adr' len' ) + drop ip-length xw@ ip-version c@ h# f and /l* payload +; + +: ip-addr-match? ( -- flag ) + \ If we know the server's IP address (e.g. the user specified one, or + \ we chose one from a RARP or BOOTP reply, or we locked onto one that + \ responded to a TFTP broadcast), then we silently discard IP packets + \ from other hosts. + his-ip-addr broadcast-ip-addr? 0= if + his-ip-addr ip-source-addr ip= 0= if false exit then + then + + \ Accept IP broadcast packets + ip-dest-addr broadcast-ip-addr? if true exit then + + \ If we don't know our own IP address yet, we accept every IP packet + my-ip-addr unknown-ip-addr? if true exit then + + \ Otherwise, we know our IP address, so we filter out packets addressed + \ to other destinations. + my-ip-addr ip-dest-addr ip= +; + +: allocate-ip ( payload-len -- payload-adr ) + /ip-header + allocate-ethernet /ip-header + +; +: free-ip ( payload-adr payload-len -- ) + /ip-header negate /string free-ethernet +; + +headers +\ LICENSE_BEGIN +\ Copyright (c) 2006 FirmWorks +\ +\ Permission is hereby granted, free of charge, to any person obtaining +\ a copy of this software and associated documentation files (the +\ "Software"), to deal in the Software without restriction, including +\ without limitation the rights to use, copy, modify, merge, publish, +\ distribute, sublicense, and/or sell copies of the Software, and to +\ permit persons to whom the Software is furnished to do so, subject to +\ the following conditions: +\ +\ The above copyright notice and this permission notice shall be +\ included in all copies or substantial portions of the Software. +\ +\ THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, +\ EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF +\ MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND +\ NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE +\ LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION +\ OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION +\ WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. +\ +\ LICENSE_END Added: ofw/inetv6/ipfr.fth =================================================================== --- ofw/inetv6/ipfr.fth (rev 0) +++ ofw/inetv6/ipfr.fth 2007-08-02 21:37:59 UTC (rev 518) @@ -0,0 +1,390 @@ +\ See license at end of file +purpose: Internet Protocol (IP) fragmentation/reassembly implementation + +headers +: max-ip-payload ( -- n ) + max-link-payload /ip-header - + h# ffff.fff8 and +; + +headerless +: ihl ( -- len ) ip-version c@ h# f and /l* ; + +: (send-ip-packet) ( adr len protocol fragment -- ) + 3 pick /ip-header - set-struct ( adr len protocol fragment ) + ( fragment ) ip-fragment xw! ( adr len protocol ) + ( protocol ) ip-protocol xc! ( adr len ) + swap drop ( len ) + h# 45 ip-version xc! ( 45 is ip version 4, length 5 longwords ) + 0 ip-service xc! + ( len ) /ip-header + dup ip-length xw! ( ip-len ) + ip-sequence @ ip-id xw! + ttl @ ip-ttl xc! + 0 ip-checksum xw! + my-ip-addr ip-source-addr copy-ip-addr + his-ip-addr ip-dest-addr copy-ip-addr + 0 the-struct /ip-header oc-checksum ip-checksum xw! + ( ip-len ) + the-struct swap ( ip-adr ip-len ) + + ip-dest-addr IP_TYPE send-link-packet ( ) +; + +0 value oaddr \ original data packet address +0 value olen \ original data packet length +0 value oprotocol \ original protocol +0 value fadr \ fragment address + +: send-ip-fragment ( offset -- ) + >r fadr ( fadr ) + olen r@ - max-ip-payload min ( fadr flen ) + 2dup oaddr r@ + -rot move ( fadr flen ) + oprotocol ( fadr flen protocol ) + r@ 8 / ( fadr flen protocol fo ) + r> max-ip-payload + olen < if h# 2000 or then ( fadr flen protocol fo ) + (send-ip-packet) ( ) +; + +: send-ip-packet ( adr len protocol -- ) + 1 ip-sequence +! + over max-ip-payload /mod swap 0> if 1+ then ( adr len protocol #frags ) + dup 1 = if + drop 0 (send-ip-packet) + else + >r to oprotocol to olen to oaddr r> + max-ip-payload allocate-ip to fadr + 0 do + i max-ip-payload * send-ip-fragment + loop + fadr max-ip-payload free-ip + then +; + +list: iplist +listnode + /n field >ip-dghead \ head of list of datagrams + /n field >ip-dgtail \ tail of list of datagrams + /n field >ip-timer \ timeout value in ms + /n field >ip-len \ total length of original data + /n field >ip-dg0 \ pointer to datagram with fragment offset 0 + /n field >ip-rangelist \ pointer to range info + /i field >ip-source-addr + /i field >ip-dest-addr + 2 field >ip-id + 1 field >ip-protocol +nodetype: ipnode \ list of reassembly in process + +0 iplist ! +0 ipnode ! + +struct + /n field >dg-adr + /n field >dg-len + /n field >dg-next +constant /dglist + +struct + /n field >rl-begin + /n field >rl-end + /n field >rl-next + /n field >rl-prev +constant /rangelist + +0 instance value reassembled-adr +0 instance value reassembled-len \ ihl + data len +d# 15 d# 1000 * constant tlb \ 15 seconds for initial timer setting + +: ip-id=? ( node-adr -- id=? ) + >r + r@ >ip-id xw@ ip-id xw@ = dup if + drop r@ >ip-protocol c@ ip-protocol c@ = dup if + drop r@ >ip-source-addr ip-source-addr ip= dup if + drop r@ >ip-dest-addr ip-dest-addr ip= + then then then + r> drop +; + +: find-ip? ( -- prev-node this-node | 0 ) + iplist ['] ip-id=? find-node +; + +: alloc-ip ( last-node -- node ) + ipnode allocate-node tuck swap insert-after + >r + 0 r@ >ip-dghead ! + 0 r@ >ip-dgtail ! + get-msecs tlb + r@ >ip-timer ! + 0 r@ >ip-len ! + 0 r@ >ip-dg0 ! + 0 r@ >ip-rangelist ! + ip-source-addr r@ >ip-source-addr copy-ip-addr + ip-dest-addr r@ >ip-dest-addr copy-ip-addr + ip-id xw@ r@ >ip-id xw! + ip-protocol c@ r@ >ip-protocol xc! + r> +; + +: save-ip ( node -- ) + >r + ip-length xw@ dup alloc-mem ( len this-dg ) + 2dup swap the-struct -rot move ( len this-dg ) + ip-fragment xw@ h# 1fff and 0= if + dup r@ >ip-dg0 ! + then + /dglist alloc-mem ( len this-dg this-dglist ) + tuck >dg-adr ! ( len this-dglist ) + tuck >dg-len ! ( this-dglist ) + 0 over >dg-next ! ( this-dglist ) + r@ >ip-dghead @ 0= if dup r@ >ip-dghead ! then ( this-dglist ) + r@ >ip-dgtail @ ?dup 0<> if >dg-next over swap ! then ( this-dglist ) + r> >ip-dgtail ! ( ) +; + +: reset-timer ( node -- ) + >ip-timer dup @ get-msecs ip-ttl c@ d# 1000 * + max swap ! +; + +: free-dg ( dg -- ) + begin ?dup while ( 'dg ) + dup >dg-adr @ over >dg-len @ free-mem ( 'dg ) + dup >dg-next @ ( 'dg 'dg-next ) + swap /dglist free-mem ( 'dg-nest ) + repeat ( ) +; + +: free-rangelist ( rl -- ) + begin ?dup while ( rl ) + dup >rl-next @ swap /rangelist free-mem ( rl-next ) + repeat ( ) +; + +: free-ipnode ( prev -- ) + delete-after + dup ipnode free-node + dup >ip-dghead @ free-dg + >ip-rangelist @ free-rangelist +; + +: free-iplist ( -- ) + find-ip? if free-ipnode else drop then +; + +: ip-timeout? ( node -- flag ) + >ip-timer @ get-msecs <= +; + +: process-timeout? ( -- flag ) + iplist ['] ip-timeout? find-node if free-ipnode true else drop false then +; + +: update-len ( node -- ) + ip-fragment xw@ h# 2000 and 0= if + ip-length xw@ ihl - + ip-fragment xw@ h# 1fff and 8 * + + swap >ip-len ! + else + drop + then +; + +0 value rlb +0 value rle +0 value last-rl + +: create-rangelist ( -- rl ) + /rangelist alloc-mem ( rl ) + rle over >rl-end ! ( rl ) + rlb over >rl-begin ! ( rl ) +; + +: insert-before-rangelist ( node rl -- ) + create-rangelist >r ( node rl ) + dup r@ >rl-next ! ( node rl ) + dup >rl-prev @ dup r@ >rl-prev ! ( node rl rl-prev ) + ?dup 0<> if >rl-next r@ swap ! then ( node rl ) + r@ over >rl-prev ! ( node rl ) + r> -rot ( new node rl ) + over >ip-rangelist @ = if >ip-rangelist ! else 2drop then +; + +: insert-endof-rangelist ( node rl -- ) + create-rangelist ( node rl new ) + 0 over >rl-next ! ( node rl new ) + 2dup >rl-prev ! ( node rl new ) + -rot tuck ( new rl node rl ) + 0= if nip >ip-rangelist ! else drop >rl-next ! then +; + +\ New range = b:e +\ Current node = x:y +\ if e<x-1, add node to front and exit +\ if b>y+1, goto examine next node +\ if b<x, x=b +\ if e>y, y=e and exit +\ if all the nodes have been examined, add node to end and exit +\ +: (update-rangelist) ( ofs len node -- ) + -rot over + 1- to rle to rlb ( node ) + 0 to last-rl ( node ) + dup >ip-rangelist @ ( node rl ) + begin ?dup while + >r ( node ) + rle r@ >rl-begin @ 1- < if r> insert-before-rangelist exit then + rlb r@ >rl-end @ 1+ <= if ( node ) + rlb r@ >rl-begin @ < if rlb r@ >rl-begin ! then + rle r@ >rl-end @ > if rle r@ >rl-end ! then + r> 2drop + exit + then + r@ to last-rl ( node ) + r> >rl-next @ ( node rl ) + repeat ( node ) + last-rl insert-endof-rangelist +; + +: update-rangelist ( node -- ) + ip-fragment xw@ h# 1fff and 8 * ( node ofs ) + ip-length xw@ ihl - ( node ofs len ) + rot (update-rangelist) +; + +: rl-complete? ( rl -- complete? ) + 0 swap ( 0 rl ) + begin ( e rl ) + 2dup >rl-begin @ 1- < ( e rl gap? ) + if 2drop false exit then ( e rl ) + dup >rl-end @ rot max swap ( e' rl ) + >rl-next @ ?dup 0= ( e' rl-next ) + until ( e' ) + drop true +; + +: ip-done? ( node -- done? ) + dup >ip-len @ 0= if + drop false + else + >ip-rangelist @ rl-complete? + then +; + +: (reassemble-ip) ( adr dg -- ) + the-struct >r + begin ?dup while ( adr dg ) + 2dup >dg-adr @ set-struct ( adr dg adr ) + ip-fragment xw@ h# 1fff and 8 * + ( adr dg ofs ) + ihl dup ( adr dg ofs ihl ihl ) + ip-length xw@ swap - ( adr dg ofs ihl len ) + swap the-struct + -rot move ( adr dg ) + >dg-next @ ( adr dg-next ) + repeat ( adr ) + drop r> set-struct + reassembled-len ip-length xw! + 0 ip-fragment xw! + 0 ip-checksum xw! + 0 the-struct ihl oc-checksum ip-checksum xw! +; + +: reassemble-ip ( node -- ip-adr,len ) + >r + r@ >ip-len @ ( dlen ) + r@ >ip-dg0 @ set-struct ihl tuck + ( ihl rlen ) + dup to reassembled-len ( ihl rlen ) + alloc-mem to reassembled-adr ( ihl ) + r@ >ip-dg0 @ over reassembled-adr swap move ( ihl ) + reassembled-adr dup set-struct + ( content-adr ) + r> >ip-dghead @ (reassemble-ip) ( ) + reassembled-adr reassembled-len ( ip-adr,len ) + free-iplist +; + +: process-datagram ( node -- false | ip-adr,len true) + dup save-ip ( node ) + dup update-len ( node ) + dup update-rangelist ( node ) + dup ip-done? if ( node ) + reassemble-ip ( ip-adr,len ) + true ( ip-adr,len true ) + else ( node ) + reset-timer ( ) + false ( false ) + then +; + +: process-done-ip ( -- ) + reassembled-len 0> if + reassembled-adr reassembled-len free-mem + 0 to reassembled-adr 0 to reassembled-len + then +; + +: process-ipv4-packet ( adr len type -- [len] flag ) + rot ( len type adr ) + dup set-struct to last-ip-packet ( len type ) + ip-addr-match? if ( len type ) + ip-protocol c@ = ( len flag ) + dup 0= if swap ip-payload ip-protocol c@ handle-ip then + else ( len type ) + drop ip-payload handle-other-ip ( ) + false \ Discard other's packets ( false ) + then ( [len] flag ) + + if ( len ) + ip-fragment xw@ h# 3fff and 0= if + free-iplist + true ( true ) + else + drop + find-ip? ?dup if nip else alloc-ip then + process-datagram + if swap to last-ip-packet true else false then + then ( flag ) + else ( ) + false ( false ) + then ( [len] flag ) +; + +: receive-ip-packet ( type -- true | contents-adr,len false ) + process-done-ip + + begin ( type ) + IP_TYPE receive-ethernet-packet ( type [ip-adr,len] flag ) + if drop process-timeout? drop true exit then + + over ipv4? if + 2 pick process-ipv4-packet ( type [len] flag ) + else + false ( type false ) + then + + ?dup 0= if ( type [len] flag ) + process-timeout? if drop true exit then + false + then + until ( type len ) + + nip ip-payload false ( contents-adr,len false ) +; +headers +\ LICENSE_BEGIN +\ Copyright (c) 2006 FirmWorks +\ +\ Permission is hereby granted, free of charge, to any person obtaining +\ a copy of this software and associated documentation files (the +\ "Software"), to deal in the Software without restriction, including +\ without limitation the rights to use, copy, modify, merge, publish, +\ distribute, sublicense, and/or sell copies of the Software, and to +\ permit persons to whom the Software is furnished to do so, subject to +\ the following conditions: +\ +\ The above copyright notice and this permission notice shall be +\ included in all copies or substantial portions of the Software. +\ +\ THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, +\ EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF +\ MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND +\ NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE +\ LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION +\ OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION +\ WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. +\ +\ LICENSE_END Added: ofw/inetv6/ipfrv6.fth =================================================================== --- ofw/inetv6/ipfrv6.fth (rev 0) +++ ofw/inetv6/ipfrv6.fth 2007-08-02 21:37:59 UTC (rev 518) @@ -0,0 +1,205 @@ +\ See license at end of file +purpose: Internet Protocol version 6 (IPv6) fragmentation/reassembly implementation + +headerless + +d# 0 constant IP_HDR_HOP \ Hop-by-hop option +d# 1 constant IP_HDR_ICMPV4 \ Internet control message protocol - IPv4 +d# 2 constant IP_HDR_IGMPV4 \ Internet group management protocol - IPv4 +d# 4 constant IP_HDR_IPV4 +d# 6 constant IP_HDR_TCP +d# 8 constant IP_HDR_EGP \ Exterior gateway protocol +d# 9 constant IP_HDR_IGP \ Cisco private interior gateway +d# 17 constant IP_HDR_UDP +d# 41 constant IP_HDR_IPV6 +d# 43 constant IP_HDR_ROUTING \ Routing header +d# 44 constant IP_HDR_FRAGMENT +d# 45 constant IP_HDR_IDRP \ Interdomain routing protocol +d# 46 constant IP_HDR_RSVP \ Resource reservation protocol +d# 47 constant IP_HDR_GRE \ General routing encapsulation +d# 50 constant IP_HDR_SECURE \ Encrypted security payload +d# 51 constant IP_HDR_AUTHEN \ Authentication +d# 58 constant IP_HDR_ICMPV6 +d# 59 constant IP_HDR_NONE \ No next header +d# 60 constant IP_HDR_DEST \ Destination options +d# 88 constant IP_HDR_EIGRP +d# 89 constant IP_HDR_OSPF +d# 108 constant IP_HDR_COMP \ IP payload compression protocol +d# 115 constant IP_HDR_L2TP \ Layer 2 tunneling protocol +d# 132 constant IP_HDR_SCTP \ Stream control transmission protocol +d# 135 constant IP_HDR_MOBILITY \ Mobile IPV6 + +struct ( ipv6-frag-header ) + 1 sfield ipv6-fh-next-hdr + 1 sfield ipv6-fh-len + 2 sfield ipv6-fh-frag-offset \ OOOO.OOOO.OOOO.OxxM + \ Os contain the fragment offset; M=1=more fragments + 4 sfield ipv6-fh-frag-id + \ Maybe followed by zero or more of headers in following order: + \ - Hop-by-Hop Options header + \ - Destination Options header (for first destination, plus destinations in the + \ Routing header) + \ - Routing header + \ - Fragment header + \ - Authentication header + \ - Encapsulating Security Payload header + \ - Destionation Options header (for final destination) + \ - Upper-Layer header +constant /ipv6-frag-hdr + +instance variable frag-id +0 instance value hop-limit + +headers + +\ ********************************************************************************* +\ Send IP packet +\ ********************************************************************************* + +[ifndef] include-ipv4 +: send-ip-packet ( adr len protocol -- ) 3drop ; +[then] + +: max-ipv6-payload ( -- n ) + max-link-payload /ipv6-header - + h# ffff.fff8 and +; +: max-ipv6-fragment ( -- n ) + max-link-payload /ipv6-header - /ipv6-frag-hdr - + h# ffff.fff8 and +; + +headerless +: (send-ipv6-packet) ( adr len protocol -- ) + rot /ipv6-header - set-struct ( len protocol ) + h# 6000.0000 ipv6-version xl! \ version 6 + ( protocol ) ipv6-next-hdr xc! ( len ) + ( len ) dup ipv6-length xw! ( len ) + hop-limit ipv6-hop-limit xc! ( len ) + my-ipv6-addr ipv6-source-addr copy-ipv6-addr ( len ) + his-ipv6-addr ipv6-dest-addr copy-ipv6-addr ( len ) + /ipv6-header + ( ip-len ) + the-struct swap ( ip-adr ip-len ) + ipv6-dest-addr IPV6_TYPE send-link-packet ( ) +; + +0 value oaddr \ original data packet address +0 value olen \ original data packet length +0 value oprotocol \ original protocol +0 value fadr \ fragment address + +: send-ipv6-fragment ( offset -- ) + >r fadr ( fadr ) ( R: offset ) + olen r@ - max-ipv6-fragment min ( fadr flen ) ( R: offset ) + 2dup oaddr r@ + -rot move ( fadr flen ) ( R: offset ) + fadr set-struct ( fadr flen ) ( R: offset ) + oprotocol ipv6-fh-next-hdr xc! \ Next header in fragment header + 0 ipv6-fh-len xc! \ Length of header in units of 8 bytes - 1 + frag-id ipv6-fh-frag-id xl! \ Fragment id + dup r@ + olen < 1 and ( fadr flen more? ) ( R: offset ) + r> 3 << or ipv6-fh-frag-offset xw! ( fadr flen ) + /ipv6-frag-hdr + ( fadr flen' ) + IP_HDR_FRAGMENT (send-ipv6-packet) ( ) +; + +: send-ipv6-packet ( adr len protocol -- ) + over max-ipv6-payload <= if + (send-ipv6-packet) + else + 1 frag-id +! + over max-ipv6-fragment /mod swap 0> if 1+ then ( adr len protocol #frags ) + >r to oprotocol to olen to oaddr r> ( #frags ) + max-ipv6-payload allocate-ipv6 to fadr ( #frags ) + ( #frags ) 0 do ( ) + i max-ipv6-fragment * send-ipv6-fragment + loop + fadr max-ipv6-payload free-ipv6 + then +; + +: send-ip-packet ( adr len protocol -- ) + use-ipv6? if send-ipv6-packet else send-ip-packet then +; + +\ ********************************************************************************* +\ Receive IP packet +\ ********************************************************************************* + +defer handle-icmpv6 ( contents-adr,len protocol -- ) ' 3drop to handle-icmpv6 + +[ifndef] include-ipv4 +: process-timeout? ( -- flag ) false ; +: process-ipv4-packet ( adr len type -- flag ) + 3drop ." Discarding IPv4 packet" cr false +; +: ip-payload ( len -- adr len' ) .ipv4-not-supported ; +[then] + +: process-ipv6-packet ( adr len type -- false | contents-adr,len true ) + \ XXX Not complete. Need to process additional headers and fragmentation. + \ XXX Assume no additional headers for now. + + nip swap ( type adr ) + dup set-struct to last-ip-packet ( type ) + ipv6-addr-match? if ( type ) + ipv6-next-hdr c@ dup >r = dup if ( type=? ) ( R: next-hdr ) + ipv6-payload rot ( contents-adr,len true ) ( R: next-hdr ) + then ( false | contents-adr,len true ) ( R: next-hdr ) + r> IP_HDR_ICMPV6 = if ( false | contents-adr,len true ) + ipv6-payload IP_HDR_ICMPV6 handle-icmpv6 \ Handle ICMPv6 packets + else + dup not if ipv6-payload ipv6-next-hdr c@ handle-ipv6 then + \ Handle other unexpected packets + then ( false | contents-adr,len true ) + else + drop ipv6-payload handle-other-ipv6 \ Handle packets for other address + false ( false ) + then ( false | contents-adr,len true ) +; + +: receive-ip-packet ( type -- true | contents-adr,len false ) + begin + use-ipv6? if IPV6_TYPE else IP_TYPE then + receive-ethernet-packet ( type [ip-adr,len] flag ) + if drop process-timeout? drop true exit then + + over ipv4? if + 2 pick process-ipv4-packet ( type [len] flag ) + if ip-payload true else false then ( type [contents-adr,len] flag ) + else + 2 pick process-ipv6-packet ( type [contents-adr,len] flag ) + then + + ?dup 0= if ( type ) + process-timeout? if drop true exit then + false + then + until ( type contents-adr,len ) + rot drop false ( contents-adr,len false ) +; + +headers + +\ LICENSE_BEGIN +\ Copyright (c) 2006 FirmWorks +\ +\ Permission is hereby granted, free of charge, to any person obtaining +\ a copy of this software and associated documentation files (the +\ "Software"), to deal in the Software without restriction, including +\ without limitation the rights to use, copy, modify, merge, publish, +\ distribute, sublicense, and/or sell copies of the Software, and to +\ permit persons to whom the Software is furnished to do so, subject to +\ the following conditions: +\ +\ The above copyright notice and this permission notice shall be +\ included in all copies or substantial portions of the Software. +\ +\ THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, +\ EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF +\ MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND +\ NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE +\ LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION +\ OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION +\ WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. +\ +\ LICENSE_END Added: ofw/inetv6/ippkg.fth =================================================================== --- ofw/inetv6/ippkg.fth (rev 0) +++ ofw/inetv6/ippkg.fth 2007-08-02 21:37:59 UTC (rev 518) @@ -0,0 +1,112 @@ +\ See license at end of file +purpose: IP redirector package + +dev /packages +new-device +" ip" device-name + +headerless +0 value #ip-opens +0 value we-opened? + +: call-tftp: ( "name" -- ) + create does> body> find-name name>string $call-parent +; + +headers +: close ( -- ) + #ip-opens 1- dup 0 max to #ip-opens ( open-level ) + 0= if + we-opened? false to we-opened? if exit then + then + 0 to my-parent +; + +: open ( -- flag ) + #ip-opens 1+ to #ip-opens + + obp-tftp-ih if + obp-tftp-ih to my-parent + true exit + then + + " net//obp-tftp:last" open-dev to my-parent ( ) + + \ XXX probably should catch this + " configure" $call-parent ( ) + + true to we-opened? + true +; + +call-tftp: send-udp-packet ( adr len src-port dst-port -- ) +call-tftp: receive-udp-packet ( dst-port -- true | adr len src-port false ) +call-tftp: send-ip-packet ( adr len protocol -- ) +call-tftp: receive-ip-packet ( type -- true | adr len false ) + +[ifdef] include-ipv4 +call-tftp: allocate-udp ( payload-len -- payload-adr ) +call-tftp: free-udp ( payload-adr payload-len -- ) +call-tftp: allocate-ip ( payload-len -- payload-adr ) +call-tftp: free-ip ( payload-adr payload-len -- ) +call-tftp: unlock-ip-address ( -- ) +call-tftp: name-server-ip ( -- 'ip ) +call-tftp: my-ip-addr ( -- 'ip ) +call-tftp: his-ip-addr ( -- 'ip ) +call-tftp: set-dest-ip ( 'ip -- ) +call-tftp: max-ip-payload ( -- n ) +call-tftp: netmask ( -- 'ip ) +[then] + +[ifdef] include-ipv6 +call-tftp: use-ipv6? ( -- flag ) +call-tftp: send-ipv6-packet ( adr len protocol -- ) +call-tftp: allocate-udpv6 ( payload-len -- payload-adr ) +call-tftp: free-udpv6 ( payload-adr payload-len -- ) +call-tftp: allocate-ipv6 ( payload-len -- payload-adr ) +call-tftp: free-ipv6 ( payload-adr payload-len -- ) +call-tftp: unlock-ipv6-address ( -- ) +call-tftp: name-server-ipv6 ( -- 'ip ) +call-tftp: my-ipv6-addr ( -- 'ip ) +call-tftp: his-ipv6-addr ( -- 'ip ) +call-tftp: set-dest-ipv6 ( 'ip -- ) +call-tftp: max-ipv6-payload ( -- n ) +call-tftp: prefix-match? ( 'ip1 'ip2 -- flag ) +call-tftp: his-mc-ipv6-addr? ( 'ip -- flag ) +[then] + +call-tftp: set-timeout ( #milliseconds -- ) +call-tftp: update-timeout ( -- ) +call-tftp: compute-srtt ( -- ) +call-tftp: domain-name ( -- 'ip ) +call-tftp: next-xid ( -- id ) +call-tftp: $set-host ( hostname$ -- ) +call-tftp: oc-checksum ( n adr len -- n' ) +call-tftp: link-mtu ( -- n ) + +finish-device +device-end + +\ LICENSE_BEGIN +\ Copyright (c) 2006 FirmWorks +\ +\ Permission is hereby granted, free of charge, to any person obtaining +\ a copy of this software and associated documentation files (the +\ "Software"), to deal in the Software without restriction, including +\ without limitation the rights to use, copy, modify, merge, publish, +\ distribute, sublicense, and/or sell copies of the Software, and to +\ permit persons to whom the Software is furnished to do so, subject to +\ the following conditions: +\ +\ The above copyright notice and this permission notice shall be +\ included in all copies or substantial portions of the Software. +\ +\ THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, +\ EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF +\ MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND +\ NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE +\ LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION +\ OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION +\ WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. +\ +\ LICENSE_END Added: ofw/inetv6/ipv6.fth =================================================================== --- ofw/inetv6/ipv6.fth (rev 0) +++ ofw/inetv6/ipv6.fth 2007-08-02 21:37:59 UTC (rev 518) @@ -0,0 +1,225 @@ +\ See license at end of file +purpose: Simple Internet Protocol version 6 (IPv6) implementation + + +\ Internet protocol version 6 (IPv6). + +decimal + +headerless + +[ifndef] include-ipv4 +\ Give the net up to 4 seconds to respond to packets +instance variable timeout-msecs d# 4000 timeout-msecs ! +[then] + +struct ( ipv6-header ) + 4 sfield ipv6-version \ Actually, this is VVVVCCCC.CCCCFFFF.FFFFFFFF.FFFFFFFF + \ VVVV is the version + \ CCCCCCCC is the traffic class + \ FFFF.FFFFFFFF.FFFFFFFF is the flow label + 2 sfield ipv6-length + 1 sfield ipv6-next-hdr + 1 sfield ipv6-hop-limit +/ipv6 sfield ipv6-source-addr +/ipv6 sfield ipv6-dest-addr + \ There maybe extension headers here. +constant /ipv6-header + +[ifndef] include-ipv4 +d# 256 buffer: 'domain-name +' 'domain-name " domain-name" chosen-string +: use-server? ( -- flag ) false ; +: use-router? ( -- flag ) false ; +[then] + +headers +0 instance value prefix +/ipv6 buffer: his-ipv6-addr +/ipv6 buffer: name-server-ipv6 + +headerless + +\ link-local scope multicast all-nodes address +create my-mc-ipv6-addr h# ff c, 2 c, 0 w, 0 l, 0 w, 0 c, 1 c, h# ff c, 0 c, 0 c, 0 c, +create his-mc-ipv6-addr h# ff c, 2 c, 0 w, 0 l, 0 w, 0 c, 1 c, h# ff c, 0 c, 0 c, 0 c, +create unknown-ipv6-addr h# 00 l, h# 00 l, h# 00 l, h# 00 l, + +: ipv6= ( ip-addr1 ip-addr2 -- flag ) /ipv6 comp 0= ; + +: unknown-ipv6-addr? ( adr-buf -- flag ) unknown-ipv6-addr ipv6= ; +: knownv6? ( adr-buf -- flag ) unknown-ipv6-addr? 0= ; + +: bits>mask ( bits -- mask ) + ?dup 0= if 0 exit then + 0 swap 0 7 ?do ( mask bits ) + 1 i << rot or swap ( mask' bits ) + 1- dup 0= if leave then ( mask bits' ) + -1 +loop drop ( mask ) +; + +: prefix-match? ( ip1 ip2 -- flag ) + prefix 8 /mod 2over 2 pick ( ip1 ip2 rem quot ip1 ip2 quot ) + comp 0= if + swap bits>mask >r ( ip1 ip2 quot ) ( R: mask ) + tuck + c@ r@ and ( ip1 quot [ip2+quot]&mask ) ( R: mask ) + -rot + c@ r> and = ( flag ) + else + 4drop false + then +; + +: set-his-mc-ipv6-addr ( -- ) + his-ipv6-addr /ipv6 + 3 - his-mc-ipv6-addr /ipv6 + 3 - 3 move +; +: set-my-mc-ipv6-addr ( -- ) + my-ipv6-addr /ipv6 + 3 - my-mc-ipv6-addr /ipv6 + 3 - 3 move +; + +: his-mc-ipv6-addr? ( adr-buf -- flag ) + dup his-mc-ipv6-addr ipv6= swap unknown-ipv6-addr? or +; +: my-mc-ipv6-addr? ( adr-buf -- flag ) + dup my-mc-ipv6-addr ipv6= swap unknown-ipv6-addr? or +; + +/ipv6 buffer: router-ipv6-addr +: use-routerv6? ( -- flag ) router-ipv6-addr knownv6? ; +: use-router? ( -- flag ) + use-ipv6? if use-routerv6? else use-router? then +; + +/ipv6 buffer: server-ipv6-addr +: use-serverv6? ( -- flag ) server-ipv6-addr knownv6? ; +: use-server? ( -- flag ) + use-ipv6? if use-serverv6? else use-server? then +; + +\ Generate his multicast MAC address from his IPv6 address +: set-his-mc-en ( -- ) + his-ipv6-addr be-w@ h# fe80 = + his-ipv6-addr d# 11 + be-w@ h# fffe = and if + multicast-en-addr his-en-addr 3 move + his-ipv6-addr d# 13 + his-en-addr 3 + 3 move + then +; + +partial-headers +[ifndef] include-ipv4 +: indent ( -- ) bootnet-debug if ." " then ; +[then] +headerless +: .my-ipv6-addr ( -- ) ." My IP: " my-ipv6-addr .ipv6 ; +: .his-ipv6-addr ( -- ) ." His IP: " his-ipv6-addr .ipv6 ; + +[ifndef] include-ipv4 +0 instance value last-ip-packet +[then] + +headers +: set-dest-ipv6 ( buf -- ) + dup his-ipv6-addr ipv6= if + drop + else + his-ipv6-addr copy-ipv6-addr + set-his-mc-ipv6-addr + unlock-link-addr + then +; + +: lock-ipv6-address ( -- ) + the-struct >r last-ip-packet set-struct + \ Don't change his-ipv6-addr for booting over gateway + use-routerv6? if \ booting over a gateway. + bootnet-debug if indent ." Using router" cr then + else + \ In case of direct booting, i.e. booting over specified server + \ don't change his addresses + use-serverv6? 0= if ipv6-source-addr set-dest-ipv6 then + lock-link-addr + then + bootnet-debug if indent .his-link-addr .his-ipv6-addr then + r> set-struct +; +: unlock-ipv6-address ( -- ) + unknown-ipv6-addr set-dest-ipv6 + unknown-ipv6-addr server-ipv6-addr copy-ipv6-addr +; +headerless + +\ This is a hook for handling IP packets addressed to us that are +\ of a different type than the expected one. This could be used +\ to handle "behind the scenes" things like ICMP if necessary. +defer handle-ipv6 ( adr len protocol -- ) +defer handle-other-ipv6 ( adr len -- ) +headers +: (handle-ipv6) ( adr len protocol -- ) + bootnet-debug if + dup ." (Discarding IPv6 packet of protocol " u. ." )" cr + then + 3drop +; +' (handle-ipv6) is handle-ipv6 + +: (handle-other-ipv6) ( adr len -- ) + bootnet-debug if + ." (Discarding IPv6 packet because of IP address mismatch)" cr + then + 2drop +; +' (handle-other-ipv6) is handle-other-ipv6 +headerless + +: ipv6-payload ( -- adr len ) the-struct /ipv6-header + ipv6-length xw@ ; + +: ipv6-addr-match? ( -- flag ) + \ If we know the server's IP address (e.g. the user specified one, or + \ we chose one from a RARP or BOOTP reply, or we locked onto one that + \ responded to a TFTP broadcast), then we silently discard IP packets + \ from other hosts. + his-ipv6-addr his-mc-ipv6-addr? 0= if + his-ipv6-addr ipv6-source-addr ipv6= 0= if false exit then + then + + \ Accept IP multicast packets + ipv6-dest-addr my-mc-ipv6-addr? if true exit then + + \ If we don't know our own IP address yet, we accept every IP packet + my-ipv6-addr unknown-ipv6-addr? if true exit then + + \ Otherwise, we know our IP address, so we filter out packets addressed + \ to other destinations. + my-ipv6-addr ipv6-dest-addr ipv6= +; + +: allocate-ipv6 ( payload-len -- payload-adr ) + /ipv6-header + allocate-ethernet /ipv6-header + +; +: free-ipv6 ( payload-adr payload-len -- ) + /ipv6-header negate /string free-ethernet +; + +headers +\ LICENSE_BEGIN +\ Copyright (c) 2006 FirmWorks +\ +\ Permission is hereby granted, free of charge, to any person obtaining +\ a copy of this software and associated documentation files (the +\ "Software"), to deal in the Software without restriction, including +\ without limitation the rights to use, copy, modify, merge, publish, +\ distribute, sublicense, and/or sell copies of the Software, and to +\ permit persons to whom the Software is furnished to do so, subject to +\ the following conditions: +\ +\ The above copyright notice and this permission notice shall be +\ included in all copies or substantial portions of the Software. +\ +\ THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, +\ EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF +\ MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND +\ NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE +\ LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION +\ OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION +\ WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. +\ +\ LICENSE_END Added: ofw/inetv6/loadmail.fth =================================================================== --- ofw/inetv6/loadmail.fth (rev 0) +++ ofw/inetv6/loadmail.fth 2007-08-02 21:37:59 UTC (rev 518) @@ -0,0 +1,30 @@ +\ See license at end of file +purpose: Load file for POP3 and SMTP code + +fload ${BP}/ofw/inet/mailbuff.fth +\ fload ${BP}/ofw/inet/pop3.fth +fload ${BP}/ofw/inet/smtp.fth + +\ LICENSE_BEGIN +\ Copyright (c) 2006 FirmWorks +\ +\ Permission is hereby granted, free of charge, to any person obtaining +\ a copy of this software and associated documentation files (the +\ "Software"), to deal in the Software without restriction, including +\ without limitation the rights to use, copy, modify, merge, publish, +\ distribute, sublicense, and/or sell copies of the Software, and to +\ permit persons to whom the Software is furnished to do so, subject to +\ the following conditions: +\ +\ The above copyright notice and this permission notice shall be +\ included in all copies or substantial portions of the Software. +\ +\ THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, +\ EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF +\ MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND +\ NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE +\ LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION +\ OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION +\ WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. +\ +\ LICENSE_END Added: ofw/inetv6/loadpkg.fth =================================================================== --- ofw/inetv6/loadpkg.fth (rev 0) +++ ofw/inetv6/loadpkg.fth 2007-08-02 21:37:59 UTC (rev 518) @@ -0,0 +1,59 @@ +purpose: Interior load file for obp-tftp support package + +fload ${BP}/ofw/inetv6/config.fth \ Networking stack configuration + +fload ${BP}/ofw/inetv6/support.fth \ Miscellaneous support function +[ifdef] include-ipv6 +fload ${BP}/ofw/inetv6/supportv6.fth +[then] + +fload ${BP}/ofw/inetv6/ethernet.fth \ Ethernet Address +fload ${BP}/ofw/inetv6/occhksum.fth \ IP checksum + +[ifdef] include-ipv4 +fload ${BP}/ofw/inetv6/ip.fth \ Internet Protocol +fload ${BP}/ofw/inetv6/ipfr.fth \ IP fragmentation/reassembly +[then] +[ifdef] include-ipv6 +fload ${BP}/ofw/inetv6/ipv6.fth +fload ${BP}/ofw/inetv6/ipfrv6.fth \ IP fragmentation/reassembly +fload ${BP}/ofw/inetv6/icmpv6.fth \ ICMPv6 +[then] + +[ifdef] include-ipv4 +fload ${BP}/ofw/inetv6/arp.fth \ [Reverse] Addr Resolution Protocol +[then] + +[ifdef] include-ipv4 +fload ${BP}/ofw/inetv6/udp.fth \ User Datagram Protocol +[then] +[ifdef] include-ipv6 +fload ${BP}/ofw/inetv6/udpv6.fth \ User Datagram Protocol +[then] + +fload ${BP}/ofw/inetv6/random.fth \ Random number generator +fload ${BP}/ofw/inetv6/adaptime.fth \ Adaptive timeout + +[ifdef] include-ipv4 +fload ${BP}/ofw/inetv6/bootp.fth \ Bootp Protocol +fload ${BP}/ofw/inetv6/dhcp.fth \ Dynamic Host Config. Protocol +fload ${BP}/ofw/inetv6/tftp.fth \ Trivial File Transfer Protocol +fload ${BP}/ofw/inetv6/netload.fth \ Network boot loading package +fload ${BP}/ofw/inetv6/attr-ip.fth \ Save IP info in /chosen +[then] +[ifdef] include-ipv6 +\ fload ${BP}/ofw/inetv6/bootpv6.fth \ Bootp Protocol +\ fload ${BP}/ofw/inetv6/dhcpv6.fth \ Dynamic Host Config. Protocol +fload ${BP}/ofw/inetv6/tftp.fth \ Trivial File Transfer Protocol +fload ${BP}/ofw/inetv6/netloadv6.fth \ Network boot loading package +fload ${BP}/ofw/inetv6/neighdis.fth \ Neighbor discovery +fload ${BP}/ofw/inetv6/attr-ipv6.fth \ Save IP info in /chosen +[then] + +fload ${BP}/ofw/inetv6/encdec.fth \ Packet encoding/decoding primitives +[ifdef] include-ipv4 +fload ${BP}/ofw/inetv6/dns.fth \ Domain name resolver (RFC1034/5) +[then] +[ifdef] include-ipv6 +fload ${BP}/ofw/inetv6/dnsv6.fth \ Domain name resolver (RFC3596) +[then] Added: ofw/inetv6/loadtcp.fth =================================================================== --- ofw/inetv6/loadtcp.fth (rev 0) +++ ofw/inetv6/loadtcp.fth 2007-08-02 21:37:59 UTC (rev 518) @@ -0,0 +1,75 @@ +\ See license at end of file +purpose: Load file for TCP extensions + +fload ${BP}/ofw/inetv6/config.fth + +create ip-redirector + +[ifdef] ip-redirector +fload ${BP}/ofw/inetv6/ippkg.fth +devalias ip //ip +[else] +devalias ip net//obp-tftp:last +[then] + +devalias tcp ip//tcp +devalias http tcp//http +devalias httpd tcp//httpd:verbose +devalias nfs ip//nfs + +[ifdef] include-ipv4 +fload ${BP}/ofw/inetv6/ping.fth +[then] +[ifdef] include-ipv6 +fload ${BP}/ofw/inetv6/pingv6.fth +[then] + +fload ${BP}/ofw/inetv6/tcpapp.fth +fload ${BP}/ofw/inetv6/finger.fth +fload ${BP}/ofw/inetv6/telnet.fth +fload ${BP}/ofw/inetv6/loadmail.fth + +warning @ warning off +autoload: telnetd defines: telnetd +warning ! + +also forth definitions +" " d# 64 config-string http-proxy +previous definitions + +fload ${BP}/ofw/inetv6/httpd.fth + +[ifdef] resident-packages +support-package: tcp +[ifdef] include-ipv4 + fload ${BP}/ofw/inetv6/tcp.fth +[then] +[ifdef] include-ipv6 + fload ${BP}/ofw/inetv6/tcpv6.fth +[then] +end-support-package +[then] + +\ LICENSE_BEGIN +\ Copyright (c) 2006 FirmWorks +\ +\ Permission is hereby granted, free of charge, to any person obtaining +\ a copy of this software and associated documentation files (the +\ "Software"), to deal in the Software without restriction, including +\ without limitation the rights to use, copy, modify, merge, publish, +\ distribute, sublicense, and/or sell copies of the Software, and to +\ permit persons to whom the Software is furnished to do so, subject to +\ the following conditions: +\ +\ The above copyright notice and this permission notice shall be +\ included in all copies or substantial portions of the Software. +\ +\ THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, +\ EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF +\ MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND +\ NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE +\ LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION +\ OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION +\ WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. +\ +\ LICENSE_END Added: ofw/inetv6/loadtftp.fth =================================================================== --- ofw/inetv6/loadtftp.fth (rev 0) +++ ofw/inetv6/loadtftp.fth 2007-08-02 21:37:59 UTC (rev 518) @@ -0,0 +1,91 @@ +\ See license at end of file +purpose: Load file for (TFTP) network booting package + + +\ Load file for Trivial File Transfer Protocol (TFTP) network booting package + +headers +fload ${BP}/ofw/inetv6/macaddr.fth \ MAC address sensing and display + +defer show-progress +\ : show-address ( adr -- adr ) dup (cr . ; + +0 value meter-counter +: -/|\ ( -- adr ) " -/|\" drop ; +: show-meter ( adr -- adr ) \ show progress by toggle meter + meter-counter 1+ dup is meter-counter ( counter ) + \ one can change frequency of display by changing following number + d# 10 + /mod swap if ( smaller-counter ) + drop + else ( smaller-counter ) + 4 mod -/|\ + c@ emit 1 backspaces + then ( ) +; +' show-meter is show-progress + +headers +0 value bootnet-debug \ XXX ???? XXX +: debug-net ( -- ) true to bootnet-debug ; +: undebug-net ( -- ) false to bootnet-debug ; + +0 value udp-checksum? +d# 100 constant tftp-retries + +defer setup-ip-attr +['] noop is setup-ip-attr \ for proms not requiring ip-addr as properties. + +create use-dhcp +create do-ip-frag-reasm + +0 value rpc-xid +0 value obp-tftp-ih + +[ifdef] resident-packages +dev /packages new-device + start-module + " obp-tftp" device-name + fload ${BP}/ofw/inetv6/loadpkg.fth + end-module +finish-device device-end +[then] + +\ params: debug-net debug-ip debug-udp debug-bootp undebug-net +: (show-net) ( adr len -- ) + 0 0 " obp-tftp" $open-package ?dup if + dup >r $call-method + r> close-package + else + 2drop + then +; +: show-net ( -- ) " debug-net" (show-net) ; +: show-ip ( -- ) " debug-ip" (show-net) ; +: show-udp ( -- ) " debug-udp" (show-net) ; +: show-bootp ( -- ) " debug-bootp" (show-net) ; + +fload ${BP}/ofw/inetv6/watchnet.fth \ Watch-net command + +\ LICENSE_BEGIN +\ Copyright (c) 2006 FirmWorks +\ +\ Permission is hereby granted, free of charge, to any person obtaining +\ a copy of this software and associated documentation files (the +\ "Software"), to deal in the Software without restriction, including +\ without limitation the rights to use, copy, modify, merge, publish, +\ distribute, sublicense, and/or sell copies of the Software, and to +\ permit persons to whom the Software is furnished to do so, subject to +\ the following conditions: +\ +\ The above copyright notice and this permission notice shall be +\ included in all copies or substantial portions of the Software. +\ +\ THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, +\ EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF +\ MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND +\ NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE +\ LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION +\ OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION +\ WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. +\ +\ LICENSE_END Added: ofw/inetv6/macaddr.fth =================================================================== --- ofw/inetv6/macaddr.fth (rev 0) +++ ofw/inetv6/macaddr.fth 2007-08-02 21:37:59 UTC (rev 518) @@ -0,0 +1,48 @@ +\ See license at end of file +purpose: MAC (Ethernet) address reporting and display functions + +headers +false config-flag local-mac-address? +: mac-address ( -- adr len ) + local-mac-address? if + " local-mac-address" get-inherited-property 0= if ( adr len ) + dup 6 = if exit else 2drop then + then + then + + \ Didn't get a valid "local-mac-address" property, so use the system one + system-mac-address ( adr len ) +; + +\ Display Ethernet address +: u.. ( n -- ) (.2) type ; +: .enaddr ( addr-buff -- ) + push-hex + 5 0 do dup c@ u.. 1+ ." :" loop c@ u.. + pop-base +; +headers +: .enet-addr ( -- ) system-mac-address drop .enaddr ; +\ LICENSE_BEGIN +\ Copyright (c) 2006 FirmWorks +\ +\ Permission is hereby granted, free of charge, to any person obtaining +\ a copy of this software and associated documentation files (the +\ "Software"), to deal in the Software without restriction, including +\ without limitation the rights to use, copy, modify, merge, publish, +\ distribute, sublicense, and/or sell copies of the Software, and to +\ permit persons to whom the Software is furnished to do so, subject to +\ the following conditions: +\ +\ The above copyright notice and this permission notice shall be +\ included in all copies or substantial portions of the Software. +\ +\ THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, +\ EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF +\ MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND +\ NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE +\ LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION +\ OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION +\ WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. +\ +\ LICENSE_END Added: ofw/inetv6/mailbuff.fth =================================================================== --- ofw/inetv6/mailbuff.fth (rev 0) +++ ofw/inetv6/mailbuff.fth 2007-08-02 21:37:59 UTC (rev 518) @@ -0,0 +1,169 @@ +\ See license at end of file +purpose: Common code for POP3 and SMTP buffer management + +false value debug-mail? + +: debug-mail ( -- ) true to debug-mail? ; +: no-debug-mail ( -- ) false to debug-mail? ; + +0 value mail-buffer +h# 1000 constant /mail-buffer +0 value mail-ptr + +: >mail-buffer ( adr len -- ) + dup to mail-ptr + mail-buffer swap move +; + +: mail-append ( $ -- ) + dup mail-ptr + mail-ptr swap to mail-ptr ( $ insert ) \ Set final length + mail-buffer + swap ( adr dest len ) + move ( ) +; + +: add-crlf ( -- ) \ Append a CRLF pir into the message buffer + h# 0d mail-buffer mail-ptr + c! + h# 0a mail-buffer mail-ptr + 1+ c! + mail-ptr 2+ to mail-ptr +; + +: ptr+ ( -- ) mail-ptr 1+ to mail-ptr ; +: buf@ ( index -- b ) mail-buffer + c@ ; + +: skip-forward ( -- ) + begin + mail-ptr buf@ + h# 20 <> + while + ptr+ + repeat +; + +: skip-to-non-blank ( -- ) + begin + mail-ptr buf@ + h# 20 = + while + ptr+ + repeat +; + +: set-ptr ( -- ) \ Sets buffer pointer to end of first line + 0 to mail-ptr + begin + mail-ptr buf@ ( t1 ) + mail-ptr 1+ buf@ ( t1 t2 ) + h# 0a = swap ( flag t1 ) + h# 0d = and 0= ( flag' ) + while + ptr+ + repeat +; + +: get-number ( field -- # ) \ Extract a number from a response + \ Responses come back as ascii. This method extracts a number from + \ a specified field within the returned data. The response data always + \ starts with "+OK" followed by a space, then ascii, then a space, and + \ more ascii. When calling this method, do not count the "+OK" as a + \ field + + 0 to mail-ptr ( field ) + 0 do ( ) + skip-forward \ Move to blank spot + skip-to-non-blank \ move to non-blank spot + loop + + \ mail-ptr is now pointing at first ascii digit of the number we want. + \ The numbers are in decimal format. + + 0 \ Starting value + begin + mail-buffer mail-ptr + c@ h# 30 h# 39 between + while + d# 10 * + mail-buffer mail-ptr + c@ h# 0f and + + mail-ptr 1+ to mail-ptr + repeat ( # ) +; + +: reply-good? ( expected$ -- ok? ) + mail-buffer over $= +; + +: allocate-mail-buffer ( -- ) + /mail-buffer alloc-mem to mail-buffer +; +: free-mail-buffer ( -- ) + mail-buffer /mail-buffer free-mem +; + +d# 50 value #retries +d# 500 value wait-time + +: call-tcp ( ... -- ... ) tcp-ih $call-method ; +: read-tcp ( adr len -- actual ) " read" call-tcp ; +: write-tcp ( adr len -- actual ) " write" call-tcp ; + +: get-reply ( -- actual ) + #retries 0 do + mail-buffer /mail-buffer read-tcp dup -2 <> if ( read ) + debug-mail? if mail-buffer over type cr then ( read ) + unloop exit ( read ) + else ( read ) + drop ( ) + wait-time ms ( ) + then ( ) + loop + 0 ( 0 ) +; + +: send-request ( -- actual ) mail-buffer mail-ptr write-tcp ; + +: send ( expected$ -- ok? ) + add-crlf ( expected$ ) + + send-request 0= if ( ) + 2drop ( ) + ." Send Failure" cr ( ) + false ( false ) + exit ( false ) + then ( false ) + + ( expected$ ) + + get-reply 0= if + 2drop + ." No reply to message" cr + false + exit + then + + ( expected$ ) reply-good? ( ok? ) +; + +: missing-var ( adr len -- ) + ." Missing environment variable: " type cr +; +\ LICENSE_BEGIN +\ Copyright (c) 2006 FirmWorks +\ +\ Permission is hereby granted, free of charge, to any person obtaining +\ a copy of this software and associated documentation files (the +\ "Software"), to deal in the Software without restriction, including +\ without limitation the rights to use, copy, modify, merge, publish, +\ distribute, sublicense, and/or sell copies of the Software, and to +\ permit persons to whom the Software is furnished to do so, subject to +\ the following conditions: +\ +\ The above copyright notice and this permission notice shall be +\ included in all copies or substantial portions of the Software. +\ +\ THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, +\ EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF +\ MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND +\ NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE +\ LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION +\ OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION +\ WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. +\ +\ LICENSE_END Added: ofw/inetv6/neighdis.fth =================================================================== --- ofw/inetv6/neighdis.fth (rev 0) +++ ofw/inetv6/neighdis.fth 2007-08-02 21:37:59 UTC (rev 518) @@ -0,0 +1,173 @@ +\ See license at end of file +purpose: Neighbor Discovery + +headerless + +" " d# 40 config-string ipv6-dns-server +" " d# 64 config-string ipv6-domain +" " d# 40 config-string ipv6-router +" stateless" d# 40 config-string ipv6-address \ leave room +\ " dhcp" ' ipv6-address set-config-string-default + +[ifndef] include-ipv4 +: configure ( -- ) ; +[then] + +: got-nd-ad? ( adr len -- flag ) + drop + dup c@ d# 136 <> if drop false exit then \ Neighbor advertisement? + dup 8 + his-ipv6-addr ipv6= not if drop false exit then \ Check IP address + dup 4 + c@ h# 60 and h# 60 <> if drop false exit then \ Solicited, override + dup d# 24 + c@ 2 <> if drop false exit then \ Target link address + d# 26 + his-en-addr copy-en-addr \ Set his-en-addr + true +; + +: do-neighbor-discovery ( -- ) + bootnet-debug if + ." ICMPv6 ND protocol: Getting MAC address for IP address: " + his-ipv6-addr .ipv6 cr + then + + set-his-mc-en \ Set his multicast link address + send-neigh-sol \ Neighbor solicitation + + current-timeout >r + timeout-msecs @ set-timeout + begin + IP_HDR_ICMPV6 receive-ip-packet ?dup 0= if got-nd-ad? then + until + r> restore-timeout + + bootnet-debug if ." Got MAC address: " his-en-addr .enaddr cr then +; + +: do-discovery ( -- ) + \ XXX need to do DHCPv6 discovery + his-ipv6-addr be-w@ h# fe80 = if do-neighbor-discovery then +; + +: (resolve-en-addrv6) ( 'dest-adr type -- 'en-adr type ) + dup IP_TYPE = if ( 'ip-adr ip-type ) +[ifdef] include-ipv4 + swap dup broadcast-ip-addr? if ( ip-type 'ip-adr ) + drop ( ip-type ) + broadcast-en-addr his-en-addr copy-en-addr ( ip-type ) + else ( ip-type 'ip-adr ) + his-ip-addr copy-ip-addr ( ip-type ) + his-en-addr broadcast-en-addr en= if do-arp then ( ip-type ) + then + his-en-addr swap +[then] + exit + else ( 'dest-adr type ) + dup IPV6_TYPE = if + swap his-ipv6-addr copy-ipv6-addr + his-en-addr broadcast-en-addr en= if do-discovery then + his-en-addr swap exit + then + then + + nip his-en-addr swap +; + +: s-all-ipv6 ( -- ) \ See discovery info + bootnet-debug if + ." Initial configuration: (fixed) " cr + indent .my-ipv6-addr cr + indent .my-link-addr cr + then +; + +: configure-ipv6 ( -- ) \ Get discovery info + ['] 4drop to icmpv6-err-callback-xt + ['] 2drop to icmpv6-info-callback-xt + + d# 64 to prefix + " fe80::259:08ff:feb4:0061" my-ipv6-addr $ipv6# + set-my-mc-ipv6-addr + + \ XXX Duplicate address discovery; Router discovery + \ ::0 => ff02::1:ffb4:0061 hop-by-hop, multicast listener report + \ ::0 => ff02::2 router solicitation + \ ::0 => ff02::1:ffb4:0061 DAD, neighbor solicitation with target addr + \ Wait for router advertisement, if gotten, continue + \ For each prefix in router advertisement, combine prefix with interface id + \ Add address to the list of assigned addresses for the interface + \ All addresses must be verified with DAD + \ fe80::259:08ff:feb4:0061 => ff02::1:ffb4:0061 hop-by-hop, multicast listener report +; + +: configure ( -- ) + use-ipv6? \ Save IPv6 flag + false to use-ipv6? configure + to use-ipv6? \ Restore IPv6 flag + configure-ipv6 +; + +: parse-args ( -- ) + false to use-bootp? + true to use-last? +; + +: close ( -- ) +[ifdef] include-ipv4 + close +[else] + close-link + 0 to obp-tftp-ih +[then] +; + +\ complete syntax: +\ net:[bootp]server-ip,filename,client-ip,router-ip, ... +\ ... #bootp-retries,#tftp-retries +\ syntax for booting - net[:sipaddr[,[file-name][,[tipaddr][,gipaddr]]]] +\ syntax for booting over a router (1 hop): net:sipaddr,[file-name],[tipaddr],gipaddr +\ Note: if user provides gipaddr, user must provide sipaddr +\ Once use-server? is set, never broadcast tftp. + +: open ( -- ok? ) +[ifdef] include-ipv4 + false to use-ipv6? + open 0= if false exit then \ IPv4 open +[else] + open-link + parse-args + mac-address drop my-en-addr copy-en-addr + my-self to obp-tftp-ih +[then] + true to use-ipv6? + ['] (resolve-en-addrv6) to resolve-en-addr + configure-ipv6 + set-mc-hash if close false exit then + s-all-ipv6 + setup-ip-attr + true +; + + +headers +\ LICENSE_BEGIN +\ Copyright (c) 2006 FirmWorks +\ +\ Permission is hereby granted, free of charge, to any person obtaining +\ a copy of this software and associated documentation files (the +\ "Software"), to deal in the Software without restriction, including +\ without limitation the rights to use, copy, modify, merge, publish, +\ distribute, sublicense, and/or sell copies of the Software, and to +\ permit persons to whom the Software is furnished to do so, subject to +\ the following conditions: +\ +\ The above copyright notice and this permission notice shall be +\ included in all copies or substantial portions of the Software. +\ +\ THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, +\ EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF +\ MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND +\ NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE +\ LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION +\ OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION +\ WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. +\ +\ LICENSE_END Added: ofw/inetv6/netload.fth =================================================================== --- ofw/inetv6/netload.fth (rev 0) +++ ofw/inetv6/netload.fth 2007-08-02 21:37:59 UTC (rev 518) @@ -0,0 +1,486 @@ +\ See license at end of file +purpose: Network loading using TFTP. + +\ Network loading using TFTP. Loads either a named file using the "dload" +\ command, or the default tftpboot file whose name is constructed from +\ the Internet address (derived from the Ethernet address with RARP) +\ and the CPU architecture type. + +headerless +: ?ip-error ( flag -- ) abort" Invalid number in IP address" ; +: decimal-byte ( adr,len -- n ) + push-decimal ['] safe->number catch pop-base ( n 0 | x x error ) + ?ip-error ( n ) + dup d# 255 u> ?ip-error ( n ) +; + +\ Parse the text string "ip-str" as a decimal IP address (e.g. 129.144.12.4), +\ storing it as binary bytes at "buf" +: $ip# ( ip-str buf -- ) + dup /i erase ( ip-str buf ) + /i bounds do ( ip-str ) + ascii . left-parse-string ( r-str l-str ) + decimal-byte i c! ( r-str ) + loop ( r-str ) + 2drop +; + +: show-router-addr ( -- ) + bootnet-debug if ." Router IP: = " router-ip-addr .ipaddr cr then +; + +: show-all-en-ip-address ( -- ) + bootnet-debug if + ." Using addresses: " cr + indent .my-link-addr .my-ip-addr cr + indent .his-link-addr .his-ip-addr cr + use-router? if indent show-router-addr then + then +; + +d# 32 buffer: tmpname + +partial-headers +\ Construct the file name for the second-stage boot program from +\ the IP address and the architecture. +: boot-filename ( -- adr len ) + file-name-buf cscount dup if exit then ( adr len ) + 2drop + push-hex + my-ip-addr be-l@ (.8) 2dup upper ( adr len ) + pop-base + tmpname place + cpu-arch dup if " ." tmpname $cat tmpname $cat else 2drop then + tmpname count file-name-buf place-cstr drop + file-name-buf cscount +; + +headerless +: parse-field ( adr len -- rem-adr,len first-adr,len ) + ascii , left-parse-string +; +: un-field ( rem$ field$ -- rem$' ) drop -rot + over - ; +: next-field ( adr len -- rem-adr,len first-adr,len true | rem-adr,len false ) + dup 0= if false exit then + parse-field dup if true else 2drop false then +; +: get-into-tftp-buf ( adr len -- ) + file-name-buf place-cstr ( cstr ) + \ process file-name to be passed onto tftpread + cscount bounds ?do + i c@ ascii | = i c@ ascii \ = or if ascii / i c! then + loop +; + +: .t/f ( n -- ) if ." true " else ." false " then ; + +headers + +true instance value use-bootp? +false instance value use-last? +false instance value use-nfs? + +headerless + +: s-all ( -- ) \ see ip-addr/bootp info. + bootnet-debug if + ." Initial configuration: " + use-last? if + ." Using the previous configuration" cr + exit + then + use-bootp? if + ." Use DHCP/BOOTP to get configuration" cr + else + cr + my-ip-addr known? if + indent ." My IP address: " my-ip-addr .ipaddr cr + else + indent ." Use RARP to get my IP address" cr + then + use-server? if + indent ." Boot server: " server-ip-addr .ipaddr cr + then + use-router? if + indent ." Router: " router-ip-addr .ipaddr cr + then + then + file-name-buf c@ if + indent ." Boot filename: " file-name-buf cscount type cr + then + then +; + +\ When router ip addr is supplied, server's ip addr +\ must also be supplied by user. So confirm "server" is non-broadcast? +: init-router ( -- ) +; + +: init-ip-addr ( -- ) + unknown-ip-addr server-ip-addr copy-ip-addr + unknown-ip-addr router-ip-addr copy-ip-addr + def-broadcast-ip broadcast-ip-addr copy-ip-addr + 0 file-name-buf c! 0 server-name c! 0 bootp-name-buf c! + clear-net-addresses +; + +\ handle diskless/client's ip address +: get-client-ip ( rem-str -- rem'-str ) + next-field if ( rem-str my-ip# ) + \ move user supplied client ip addr in my-ip-addr + my-ip-addr $ip# ( rem-str ) + false to use-bootp? + then ( rem-str ) +; +: get-router-ip ( rem-str -- rem'-str ) + next-field if ( rem-str router-ip# ) + router-ip-addr $ip# ( rem-str ) + use-router? if + use-server? 0= if + collect( +." obp-tftp argument error:" cr +." If the router is specified, the server must also be specified." cr +." e.g. boot net:<server-ipaddr>,<file>,<client-ipaddr>,<router-ipaddr>" cr + )collect $abort + then + then + then +; + +: get-number ( rem-str -- rem'-str n ) + next-field if ( rem-str field$ ) + push-decimal + $number if ( rem-str ) + ." Bad number in network arguments" cr + ." Network argument syntax:" cr +." server-ip,filename,client-ip,router-ip,#bootp-retries,#tftp-retries" cr + \ Discard the rest of the arguments because we're probably + \ out of sync. + drop 0 ( rem-str' ) + -1 ( rem-str' n ) + then ( rem-str' n ) + pop-base ( rem-str' n ) + else ( rem-str ) + -1 ( rem-str' n ) + then ( rem-str' n ) +; + +: get-bootp-retries ( rem-str -- rem'-str ) get-number to bootp-retries ; +: get-tftp-retries ( rem-str -- rem'-str ) get-number to tftp-retries ; + +\ The NVRAM variable boot-file's value is passed to first level booter. +\ It is not the file prom boots first. The name of first level boot file +\ comes from either command lin, or as a part of "devalias net" or +\ as part of NVRAM variable boot-device. +: get-boot-filename ( rem-str -- rem'-str ) + next-field if ( rem-str file-name-str ) + \ getting file name from command line + get-into-tftp-buf + then +; + +: get-server-ip ( rem$ -- rem$' ) + next-field if ( rem$ field$ ) + 2dup server-ip-addr ['] $ip# catch if ( rem$ field$ x x x ) + 3drop un-field ( rem$ ) + \ Erase possible partial IP address + unknown-ip-addr server-ip-addr copy-ip-addr ( rem$ ) + else ( rem$ field$ ) + 2drop ( rem$ ) + then ( rem$ ) + then ( rem$ ) +; + +: tftp-args ( rem$ -- ) + get-server-ip ( rem$ ) + get-boot-filename ( rem$' ) + get-client-ip ( rem$' ) + get-router-ip ( rem$' ) + get-bootp-retries ( rem$' ) + get-tftp-retries ( rem$' ) + 2drop + + \ If we got our IP address, we don't need BOOTP + my-ip-addr known? if false to use-bootp? then +; + +" " d# 15 config-string ip-dns-server +" 255.255.255.0" d# 15 config-string ip-netmask +" " d# 64 config-string ip-domain +" " d# 15 config-string ip-router +" 255.255.255.255" d# 15 config-string ip-address \ leave room +\ " dhcp" ' ip-address set-config-string-default + +\ OBP-TFTP recommended practice says that bootp is the preferred +\ protocol. The first field, if present, represents serverip-addr. +\ Extend the RP to optionally recognize "bootp" or "rarp" to override +\ the default protocol. If the first field is null, protocol is bootp +\ and all parameters are retrieved from the server. +: arg-fields ( arg$ -- ) + true to use-bootp? ( rem$ ) \ Default + + parse-field ( rem$ field$ ) + + \ If the first field is "last" and we already know our IP address, ignore + \ all other fields and don't re-initialize all the internal variables + 2dup " last" $= if 2drop ( rem$ ) + my-ip-addr unknown-ip-addr? if ( rem$ ) + \ If we are supposed to use the last good configuration, but + \ there is none, ignore the "last" and handle the rest as if + \ "last" were absent. + parse-field ( rem$ field$ ) + else ( rem$ ) + 2drop ( ) + true to use-last? ( ) + false to use-bootp? ( ) + exit + then + then ( rem$ field$ ) + + \ Otherwise, re-initialize the internal variables + init-ip-addr ( rem$ field$ ) + + \ If the first field is "nfs", arrange to use NFS for booting and + \ restart the parsing for the rest of the fields + 2dup " nfs" $= if 2drop ( rem$ ) + true to use-nfs? ( rem$ ) + parse-field ( rem$ field$ ) + then ( rem$ field$ ) + + 2dup " rarp" $= if 2drop ( rem$ ) + false to use-bootp? ( rem$ ) + else ( rem$ field$ ) + + 2dup " bootp" $= >r 2dup " dhcp" $= r> or if ( rem$ field$ ) + 2drop ( rem$ ) + else ( rem$ field$' ) + \ The first field is not one of the special values listed + \ above, so restore it to the argument string + un-field ( rem$ ) + then then ( rem$ ) + + tftp-args ( ) +; + +: parse-args ( -- ) + my-args dup if ( adr len ) + bootnet-debug if ." my-args = " 2dup type cr then + arg-fields ( ) + else ( adr len ) + 2drop ( ) + init-ip-addr ( ) + then +; + +headerless + +partial-headers +defer modify-boot-file +: bootp-modify-file ( -- ) + bootp-name-buf count nip if \ Override if bootp modified the name + bootp-name-buf count file-name-buf place-cstr drop + then +; +' bootp-modify-file to modify-boot-file + +: dhcp-modify-file ( -- ) + file-name-buf c@ 0= if bootp-modify-file then +; + +headerless +\ bootp syntax is - boot net:bootp[,[server-ip-addr][,file-name]]. +\ or - boot net:[[server-ip-addr][,file-name]]. +\ Open routine has taken file-name from command line in file-name-buf. +\ If there was none, bootp will use default +\ file coming from bootp server (mentioned in bootptab) +\ Currently the one specified on cmd line overwrites that from bootp reply. + +: process-bootp ( -- ) \ handle bootp request +[ifdef] use-dhcp do-dhcp [else] do-bootp [then] + modify-boot-file +; + +: delim? ( char -- flag ) dup [char] / = swap [char] \ = or ; +d# 128 buffer: nfs-filename +: nfs-read ( adr filename$ -- len ) + dup if ( adr filename$ ) + \ If the name is relative; construct a full pathname + over c@ delim? 0= if ( adr filename$ ) + \ Prepend root path (if present) or "/" + 'root-path cscount dup 0= if ( adr filename$ root$ ) + 2drop " /" ( adr filename$ root$ ) + then ( adr filename$ ) + nfs-filename pack ( adr filename$ 'buf ) + + \ Insert a "/" after the root path if necessary + count + 1- c@ delim? 0= if ( adr filename$ ) + " /" nfs-filename $cat ( adr filename$ ) + then ( adr filename$ ) + + \ Append the filename + nfs-filename $cat nfs-filename count ( adr filename$' ) + then + then + bootnet-debug if ." NFS protocol: Reading file: " 2dup type cr then + " nfs" $open-package >r r@ 0= if + collect( + ." NFS open failed." cr + [ifdef] .dhcp-server .dhcp-server [then] + ." NFS Server: " his-ip-addr .ipaddr cr + ." Filename: " nfs-filename count type cr + )collect $abort + then ( adr r: ih ) + " load" r@ $call-method ( len ) + r> close-package +; + +: url? ( filename$ -- flag ) + " /\" lex if ( rem$ head$ delim ) + drop 2swap 2drop ( head$ ) + then ( head$ | filename$ ) + " :" lex if 5drop true exit then ( head$ ) + 2drop false ( false ) +; +char / constant delim + +d# 255 instance buffer: pathbuf +: fix-delims ( adr len -- adr' len' ) + pathbuf pack count 2dup + bounds ?do ( adr len ) + i c@ [char] / = if [char] \ i c! then + loop +; + +: load-url ( adr filename$ -- len ) + fix-delims + 2dup open-dev >r r@ 0= if ( adr filename$ ) + collect( + ." Can't open " type cr + [ifdef] .dhcp-server .dhcp-server [then] + )collect $abort + then ( adr filename$ r: ih ) + 2drop " load" r@ $call-method ( len ) + r> close-dev +; + +: read-file ( adr filename$ -- len ) + 2dup url? if load-url exit then ( adr filename$ ) + +[ifdef] use-dhcp + use-bootp? use-server? 0= and bootp-only? 0= and + abort" The DHCP server did not specify a boot server" +[then] + + use-nfs? if nfs-read else tftpread then +; + +headers +: next-xid ( -- id ) rpc-xid 1+ dup to rpc-xid ; +: allocate-packet ( len -- adr ) allocate-udp ; +: free-packet ( len -- adr ) free-udp ; +: send ( adr len src-port dst-port -- ) send-udp-packet ; +: receive ( dst-port -- true | adr len false ) receive-udp-packet ; + +: nvram-ip? ( -- flag ) + ip-address dup if ( adr len ) + 2dup " dhcp" $= 0= if ( adr len ) + 2dup " bootp" $= 0= if ( adr len ) + my-ip-addr ['] $ip# catch 0= if ( ) + ip-netmask subnetmask ['] $ip# catch if 3drop then + \ XXX in the absence of a netmask value, we should determine + \ it from my-ip-addr + ip-dns-server name-server-ip ['] $ip# catch if 3drop then + ip-router router-ip-addr ['] $ip# catch if 3drop then + ip-domain dup if 'domain-name place-cstr drop else 2drop then + true exit + then ( x x x ) + drop ( x x ) + unknown-ip-addr my-ip-addr copy-ip-addr ( x x ) + then then then ( adr len ) + 2drop false +; + +defer configured ' noop to configured +: configure ( -- ) + use-last? if configured exit then + use-bootp? if + nvram-ip? 0= if process-bootp then + else + \ Use RARP to find the client's IP address if it was not specified + \ in the arguments. + my-ip-addr unknown-ip-addr? if + \ RARP gives my-ip-addr, his-ip-addr, his-en-addr, + \ The default boot file name is derived from my-ip-addr + do-rarp + else + use-server? if + bootnet-debug if + ." Using the server IP address specified in the arguments." cr + then + then + then + + \ At this point, we know my-ip-addr, and we might know his-ip-addr + \ from RARP. However, if a server was specified in the arguments, + \ the his-ip-addr value from RARP is not necessarily the same as + \ the IP address for the user-specified server, so we override + \ his-ip-addr below. (If a server was not specified and we don't know + \ his-ip-addr from RARP, then we will broadcast the TFTP request.) + use-server? if + server-ip-addr set-dest-ip + then + then + show-all-en-ip-address + configured +; + +\ complete syntax: +\ net:[bootp|rarp,]server-ip,filename,client-ip,router-ip, ... +\ ... #bootp-retries,#tftp-retries +\ syntax for booting - net[:sipaddr[,[file-name][,[tipaddr][,gipaddr]]]] +\ syntax for booting over a router (1 hop): net:sipaddr,[file-name],[tipaddr],gipaddr +\ Note: if user provides gipaddr, user must provide sipaddr +\ Once use-server? is set, never broadcast tftp. + +: open ( -- okay? ) + open-link + parse-args + mac-address drop my-en-addr copy-en-addr + configure + s-all + my-self to obp-tftp-ih \ Publish so IP redirector can attach to us + true +; + +: close ( -- ) +[ifdef] process-done-ip + process-done-ip +[then] + close-link + 0 to obp-tftp-ih +; + +: load ( adr -- len ) boot-filename read-file ; +\ LICENSE_BEGIN +\ Copyright (c) 2006 FirmWorks +\ +\ Permission is hereby granted, free of charge, to any person obtaining +\ a copy of this software and associated documentation files (the +\ "Software"), to deal in the Software without restriction, including +\ without limitation the rights to use, copy, modify, merge, publish, +\ distribute, sublicense, and/or sell copies of the Software, and to +\ permit persons to whom the Software is furnished to do so, subject to +\ the following conditions: +\ +\ The above copyright notice and this permission notice shall be +\ included in all copies or substantial portions of the Software. +\ +\ THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, +\ EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF +\ MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND +\ NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE +\ LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION +\ OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION +\ WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. +\ +\ LICENSE_END Added: ofw/inetv6/netloadv6.fth =================================================================== --- ofw/inetv6/netloadv6.fth (rev 0) +++ ofw/inetv6/netloadv6.fth 2007-08-02 21:37:59 UTC (rev 518) @@ -0,0 +1,143 @@ +\ See license at end of file +purpose: Network loading using TFTP/IPv6. + +\ Network loading using TFTP. Loads either a named file using the "dload" +\ command, or the default tftpboot file whose name is constructed from +\ the Internet address (derived from the Neighbor Discovery) +\ and the CPU architecture type. + +[ifndef] include-ipv4 +partial-headers +d# 128 buffer: file-name-buf +d# 256 buffer: 'root-path +d# 32 buffer: tmpname +false instance value bootp-only? + +\ Construct the file name for the second-stage boot program from +\ the IP address and the architecture. +: boot-filename ( -- adr len ) + file-name-buf cscount dup if exit then ( adr len ) + 2drop + push-hex + \ XXX Questionable code for IPv6 + my-ipv6-addr be-l@ (.8) 2dup upper ( adr len ) + pop-base + tmpname place + cpu-arch dup if " ." tmpname $cat tmpname $cat else 2drop then + tmpname count file-name-buf place-cstr drop + file-name-buf cscount +; + +headers + +true instance value use-bootp? +false instance value use-last? +false instance value use-nfs? +[then] + +headerless + +: delim? ( char -- flag ) dup [char] / = swap [char] \ = or ; + +d# 128 buffer: nfs-filename + +: nfs-read ( adr filename$ -- len ) + dup if ( adr filename$ ) + \ If the name is relative; construct a full pathname + over c@ delim? 0= if ( adr filename$ ) + \ Prepend root path (if present) or "/" + 'root-path cscount dup 0= if ( adr filename$ root$ ) + 2drop " /" ( adr filename$ root$ ) + then ( adr filename$ ) + nfs-filename pack ( adr filename$ 'buf ) + + \ Insert a "/" after the root path if necessary + count + 1- c@ delim? 0= if ( adr filename$ ) + " /" nfs-filename $cat ( adr filename$ ) + then ( adr filename$ ) + + \ Append the filename + nfs-filename $cat nfs-filename count ( adr filename$' ) + then + then + bootnet-debug if ." NFS protocol: Reading file: " 2dup type cr then + " nfs" $open-package >r r@ 0= if + collect( + ." NFS open failed." cr + [ifdef] .dhcp-server .dhcp-server [then] + ." NFS Server: " his-ipv6-addr .ipv6 cr + ." Filename: " nfs-filename count type cr + )collect $abort + then ( adr r: ih ) + " load" r@ $call-method ( len ) + r> close-package +; + +: url? ( filename$ -- flag ) + " /\" lex if ( rem$ head$ delim ) + drop 2swap 2drop ( head$ ) + then ( head$ | filename$ ) + " :" lex if 5drop true exit then ( head$ ) + 2drop false ( false ) +; +char / constant delim + +d# 255 instance buffer: pathbuf +: fix-delims ( adr len -- adr' len' ) + pathbuf pack count 2dup + bounds ?do ( adr len ) + i c@ [char] / = if [char] \ i c! then + loop +; + +: load-url ( adr filename$ -- len ) + fix-delims + 2dup open-dev >r r@ 0= if ( adr filename$ ) + collect( + ." Can't open " type cr + [ifdef] .dhcp-server .dhcp-server [then] + )collect $abort + then ( adr filename$ r: ih ) + 2drop " load" r@ $call-method ( len ) + r> close-dev +; + +: read-file ( adr filename$ -- len ) + 2dup url? if load-url exit then ( adr filename$ ) + +[ifdef] use-dhcp + use-bootp? use-server? 0= and bootp-only? 0= and + abort" The DHCP server did not specify a boot server" +[then] + + use-nfs? if nfs-read else tftpread then +; + +headers +: next-xid ( -- id ) rpc-xid 1+ dup to rpc-xid ; + +: load ( adr -- len ) boot-filename read-file ; + +\ LICENSE_BEGIN +\ Copyright (c) 2006 FirmWorks +\ +\ Permission is hereby granted, free of charge, to any person obtaining +\ a copy of this software and associated documentation files (the +\ "Software"), to deal in the Software without restriction, including +\ without limitation the rights to use, copy, modify, merge, publish, +\ distribute, sublicense, and/or sell copies of the Software, and to +\ permit persons to whom the Software is furnished to do so, subject to +\ the following conditions: +\ +\ The above copyright notice and this permission notice shall be +\ included in all copies or substantial portions of the Software. +\ +\ THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, +\ EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF +\ MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND +\ NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE +\ LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION +\ OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION +\ WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. +\ +\ LICENSE_END Added: ofw/inetv6/occhksum.fth =================================================================== --- ofw/inetv6/occhksum.fth (rev 0) +++ ofw/inetv6/occhksum.fth 2007-08-02 21:37:59 UTC (rev 518) @@ -0,0 +1,70 @@ +\ See license at end of file +purpose: Internet checksum (one's complement of 16-bit words) + +\ The complete checksum calculation consists of: +\ a) add together all the 16-bit big-endian words in the buffer, with +\ wrap-around carry (i.e. a carry out of the high bit is added back +\ in at the low bit). +\ b) Take the one's complement of the result, preserving only the +\ least-significant 16 bits. +\ c) If the result is 0, change it to ffff. + +\ The process of computing a checksum for UDP packets involves the +\ creation of a "pseudo header" containing selected information +\ from the IP header, and checksumming the combination of that pseudo +\ header and the UDP packet. To do so, it is convenient to perform +\ step (a) of the calculation separately on the two pieces (pseudo header +\ and UDP packet). Thus we factor the checksum calculation code with +\ a separate primitive "(oc-checksum)" that performs step (a). That +\ primitive is worth optimizing; steps (b) and (c) are typically not. + +headerless +[ifndef] (oc-checksum) +\ High-level version, in case an optimized version is not available. + +\ This algorithm depends on the assumption that the buffer is +\ short enough so that we never have a carry out of the high +\ 16 bit word. Assuming worst case data (all bytes ff), the +\ buffer would have to be 128K + 3 bytes long for this to happen. +\ The maximum length of an IP packet is 64K bytes, so we are safe. +\ This allows us to accumulate the end-around carries in the high +\ 16-bit word and add them in one operation at the end. + +: (oc-checksum) ( accumulator addr count -- checksum ) + 2dup 2>r bounds do i xw@ + /w +loop ( sum r: adr,len ) + \ Subtract the extra byte at the end + 2r> dup 1 and if + c@ - else 2drop then +; +[then] + +: oc-checksum ( accumulator addr count -- checksum ) + (oc-checksum) ( checksum' ) + lwsplit + lwsplit + ( checksum" ) + invert h# 0.ffff and ( checksum ) + \ Return ffff if the checksum is 0 + ?dup 0= if h# 0.ffff then ( checksum ) +; +headers +\ LICENSE_BEGIN +\ Copyright (c) 2006 FirmWorks +\ +\ Permission is hereby granted, free of charge, to any person obtaining +\ a copy of this software and associated documentation files (the +\ "Software"), to deal in the Software without restriction, including +\ without limitation the rights to use, copy, modify, merge, publish, +\ distribute, sublicense, and/or sell copies of the Software, and to +\ permit persons to whom the Software is furnished to do so, subject to +\ the following conditions: +\ +\ The above copyright notice and this permission notice shall be +\ included in all copies or substantial portions of the Software. +\ +\ THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, +\ EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF +\ MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND +\ NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE +\ LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION +\ OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION +\ WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. +\ +\ LICENSE_END Added: ofw/inetv6/ping.fth =================================================================== --- ofw/inetv6/ping.fth (rev 0) +++ ofw/inetv6/ping.fth 2007-08-02 21:37:59 UTC (rev 518) @@ -0,0 +1,273 @@ +\ See license at end of file +purpose: Ping (ICMP echo) and ping daemon (ICMP echo server) + +: (ip-checksum) ( accumulator addr count -- checksum ) + 2dup 2>r bounds do i be-w@ + /w +loop ( sum r: adr,len ) + \ Subtract the extra byte at the end + 2r> dup 1 and if + c@ - else 2drop then +; + +: ip-checksum ( accumulator addr count -- checksum ) + (ip-checksum) ( checksum' ) + lwsplit + lwsplit + ( checksum" ) + invert h# 0.ffff and ( checksum ) + \ Return ffff if the checksum is 0 +\ ?dup 0= if h# 0.ffff then ( checksum ) +; + +0 value ping-ih +: open-net ( pathname$ -- ) + dup 0= if 2drop " net" then ( pathname$' ) + open-dev to ping-ih + ping-ih 0= abort" Can't open network device" +; +: close-net ( -- ) ping-ih close-dev ; +: $call-net ( ? name$ -- ? ) ping-ih $call-method ; + +true value first? +0 value /packet +d# 1600 constant /packet-max +/packet-max buffer: packet + +: get-packet? ( -- packet? ) + packet /packet-max " read" $call-net to /packet + /packet -1 = if cr ." Packet error" cr false exit then + /packet -2 = if false exit then + ." ." true +; +d# 14 constant /ether-header +0 value ip-offset + +: ip-header ( -- adr ) packet ip-offset + ; + +: ip? ( -- flag ) ip-header c@ 4 rshift 4 = ; +: link-level-ok? ( -- flag ) + packet c@ 1 and if + 0 to ip-offset + \ It's either a multicast Ethernet packet or a direct IP packet + ip? if true exit then + else + packet d# 12 + be-w@ h# 800 = if + /ether-header to ip-offset + ip? if true exit then + then + then + false +; + +: >/ip-header ( ip-header -- len ) c@ h# f and /l* ; +: ip-payload ( -- adr len ) + ip-header dup >/ip-header ( ip-adr length ) + over + ( ip-adr payload-adr ) + swap dup 2+ be-w@ + ( payload-adr payload-end ) + over - ( payload-adr payload-len ) +; +: icmp? ( -- flag ) ip-header 9 + c@ 1 = ; +: echo? ( -- flag ) ip-payload drop c@ 8 = ; +: -exit ( flag -- ) 0= if r> drop then ; +: .ipb ( adr -- adr' ) dup 1+ swap c@ (.) type ; +: .ipaddr ( addr-buff -- ) + push-decimal + 3 0 do .ipb ." ." loop .ipb drop + pop-base +; +: .ip ( -- ) + ." My IP address is " + ip-header d# 16 + .ipaddr +; +: ping? ( -- flag ) + false + ip? -exit + first? if .ip false to first? then + + icmp? -exit + echo? -exit + 0= +; + +: exchange-byte ( adr1 adr2 -- ) + over c@ over c@ ( adr1 adr2 byte1 byte2 ) + swap rot ( adr1 byte2 byte1 adr2 ) + c! ( adr1 byte2 ) + swap c! ( ) +; +: exchange-bytes ( adr1 adr2 len -- ) + 0 ?do over i + over i + exchange-byte loop 2drop +; +: exchange-macs ( -- ) + ip-offset /ether-header = if + packet packet 6 + 6 exchange-bytes + then +; +: exchange-ips ( -- ) ip-header d# 12 + dup 4 + 4 exchange-bytes ; +: change-type ( -- ) 0 ip-payload drop c! ; +: recompute-ip-checksum ( -- ) + 0 ip-header d# 10 + be-w! \ Zap IP checksum + ip-header dup >/ip-header ( adr len ) + 0 -rot ip-checksum ip-header d# 10 + be-w! +; + +0 instance value the-struct +: set-struct ( adr -- ) to the-struct ; +: sfield ( offset size -- new-offset ) + create over , + + does> @ the-struct + +; + +struct ( ICMP ) + /c sfield icmp-type + /c sfield icmp-code + /w sfield icmp-checksum + /w sfield icmp-id + /w sfield icmp-seq + 0 sfield icmp-data +constant /icmp-header + +: compute-icmp-checksum ( adr len -- ) + over set-struct ( adr len' ) + 0 icmp-checksum be-w! ( adr len ) \ Zap ICMP checksum + 0 -rot ip-checksum ( sum ) + icmp-checksum be-w! ( ) +; +: recompute-icmp-checksum ( -- ) + ip-payload dup 1 and if ( adr len ) + 2dup + 0 swap c! 1+ ( adr len' ) + then ( adr len' ) + compute-icmp-checksum ( ) +; + +: send-packet ( -- ) + packet /packet " write" $call-net + /packet <> if cr ." Send failed" cr then +; + +: echo-packet ( -- ) + exchange-macs + exchange-ips + change-type + recompute-ip-checksum + recompute-icmp-checksum + send-packet +; +: ?echo-packet ( -- ) ping? if echo-packet then ; +: handle-requests ( -- ) + ." Type any key to quit" cr + begin + key? if key drop exit then + get-packet? if ?echo-packet then + again +; + +: $pingd ( pathname$ -- ) + true to first? + open-net handle-requests close-net +; + +: pingd ( "device" -- ) parse-word $pingd ; + +d# 64 value ping-size +d# 512 value /ping-max +d# 10 value ping-seconds +d# 1 value #pings +d# 0 value icmp-sequence# +d# 1000 value ping-gap + +0 value ping-packet +0 value ping-sent-time + +: send-ping ( -- ) + ping-packet to the-struct + get-msecs to ping-sent-time + + ping-seconds d# 1000 * " set-timeout" $call-net + + 8 icmp-type c! + 0 icmp-code c! + 0 icmp-id be-w! + icmp-sequence# dup icmp-seq be-w! 1+ to icmp-sequence# + icmp-data ping-size 0 do i icmp-data i + c! loop drop ( ) + + the-struct ping-size /icmp-header + 2dup compute-icmp-checksum + + 1 " send-ip-packet" $call-net \ 1 is the ICMP protocol number +; +: .ping-data ( -- ) + get-msecs ping-sent-time - ( ms ) + ?dup if .d else ." <1 " then ." ms" cr +; + +: reply-okay? ( adr len -- flag ) + swap set-struct ( len ) + + \ Ignore ICMP packets other then echo replies + icmp-type c@ if drop false exit then ( len ) + + \ Verify the packet length + /icmp-header ping-size + 2dup <> if ( len exp ) + ." Wrong ping reply packet size - expected " ( len exp ) + .d ." , got " .d cr ( ) + else ( len exp ) + 2drop ( ) + then ( ) + + icmp-seq be-w@ icmp-sequence# 1- 2dup <> if ( rseq sseq ) + ." Sent sequence number " .d ( rseq ) + ." , received " .d cr ( ) + else ( rseq sseq ) + 2drop ( ) + then ( ) + true +; +: ping-reply? ( -- okay? ) + begin + 1 " receive-ip-packet" $call-net if false exit then ( adr len ) + reply-okay? + until + true +; + +: 1ping ( -- ) + send-ping + ping-reply? if .ping-data else ." Timeout" cr then +; +: try-pings ( -- ) + 1ping + #pings 1 ?do + ping-gap ms + 1ping + key? if key drop leave then + loop +; + +: $ping ( ip$ -- ) + " net//obp-tftp:last" open-net " $set-host" $call-net + /ping-max " allocate-ip" $call-net to ping-packet + try-pings + ping-packet /ping-max " free-ip" $call-net + close-net +; + +: ping ( "host" -- ) safe-parse-word $ping ; +\ LICENSE_BEGIN +\ Copyright (c) 2006 FirmWorks +\ +\ Permission is hereby granted, free of charge, to any person obtaining +\ a copy of this software and associated documentation files (the +\ "Software"), to deal in the Software without restriction, including +\ without limitation the rights to use, copy, modify, merge, publish, +\ distribute, sublicense, and/or sell copies of the Software, and to +\ permit persons to whom the Software is furnished to do so, subject to +\ the following conditions: +\ +\ The above copyright notice and this permission notice shall be +\ included in all copies or substantial portions of the Software. +\ +\ THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, +\ EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF +\ MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND +\ NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE +\ LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION +\ OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION +\ WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. +\ +\ LICENSE_END Added: ofw/inetv6/pingv6.fth =================================================================== --- ofw/inetv6/pingv6.fth (rev 0) +++ ofw/inetv6/pingv6.fth 2007-08-02 21:37:59 UTC (rev 518) @@ -0,0 +1,164 @@ +\ See license at end of file +purpose: Ping (ICMP echo) and ping daemon (ICMP echo server) + +d# 58 constant ICMPV6_TYPE + +[ifndef] ping +0 value ping-ih +: open-net ( pathname$ -- ) + dup 0= if 2drop " net" then ( pathname$' ) + open-dev to ping-ih + ping-ih 0= abort" Can't open network device" +; +: close-net ( -- ) ping-ih close-dev ; +: $call-net ( ? name$ -- ? ) ping-ih $call-method ; +[then] + +\ XXX There may be additional headers. +d# 40 constant /ipv6-header + +[ifndef] ping +0 instance value the-struct +: set-struct ( adr -- ) to the-struct ; +: sfield ( offset size -- new-offset ) + create over , + + does> @ the-struct + +; + +struct ( ICMP ) + /c sfield icmp-type + /c sfield icmp-code + /w sfield icmp-checksum + /w sfield icmp-id + /w sfield icmp-seq + 0 sfield icmp-data +constant /icmp-header +[then] + +: handle-requestsv6 ( -- ) + ." Type any key to quit" cr + begin + key? if key drop exit then + ICMPV6_TYPE " receive-ip-packet" $call-net 0= if 2drop then + again +; + +: $pingd6 ( pathname$ -- ) + open-net handle-requestsv6 close-net +; + +: pingd6 ( ["device"] -- ) + parse-word ?dup 0= if drop " net//obp-tftp:last" then + $pingd6 +; + +[ifndef] ping +d# 64 value ping-size +d# 512 value /ping-max +d# 10 value ping-seconds +d# 1 value #pings +d# 0 value icmp-sequence# +d# 1000 value ping-gap + +0 value ping-packet +0 value ping-sent-time +[then] + +: send-pingv6 ( -- ) + ping-packet to the-struct + get-msecs to ping-sent-time + + ping-seconds d# 1000 * " set-timeout" $call-net + + d# 128 icmp-type c! + 0 icmp-code c! + 0 icmp-id be-w! + icmp-sequence# dup icmp-seq be-w! 1+ to icmp-sequence# + icmp-data ping-size 0 do i icmp-data i + c! loop drop ( ) + + the-struct ping-size " send-icmpv6-packet" $call-net +; + +[ifndef] ping +: .ping-data ( -- ) + get-msecs ping-sent-time - ( ms ) + ?dup if .d else ." <1 " then ." ms" cr +; +[then] + +: reply-okayv6? ( adr len -- flag ) + swap set-struct ( len ) + + \ Ignore ICMP packets other then echo replies + icmp-type c@ d# 129 <> if drop false exit then ( len ) + + \ Verify the packet length + /icmp-header ping-size + 2dup <> if ( len exp ) + ." Wrong ping reply packet size - expected " ( len exp ) + .d ." , got " .d cr ( ) + else ( len exp ) + 2drop ( ) + then ( ) + + icmp-seq be-w@ icmp-sequence# 1- 2dup <> if ( rseq sseq ) + ." Sent sequence number " .d ( rseq ) + ." , received " .d cr ( ) + else ( rseq sseq ) + 2drop ( ) + then ( ) + true +; +: ping-replyv6? ( -- okay? ) + begin + ICMPV6_TYPE " receive-ip-packet" $call-net if false exit then ( adr len ) + reply-okayv6? + until + true +; + +: 1pingv6 ( -- ) + send-pingv6 + ping-replyv6? if .ping-data else ." Timeout" cr then +; +: try-pingsv6 ( -- ) + 1pingv6 + #pings 1 ?do + ping-gap ms + 1pingv6 + key? if key drop leave then + loop +; + +: $ping6 ( ip$ -- ) + " net//obp-tftp:last" open-net " $set-host" $call-net + /ping-max " allocate-ipv6" $call-net to ping-packet + try-pingsv6 + ping-packet /ping-max " free-ipv6" $call-net + close-net +; + +: ping6 ( "host" -- ) safe-parse-word $ping6 ; + +\ LICENSE_BEGIN +\ Copyright (c) 2006 FirmWorks +\ +\ Permission is hereby granted, free of charge, to any person obtaining +\ a copy of this software and associated documentation files (the +\ "Software"), to deal in the Software without restriction, including +\ without limitation the rights to use, copy, modify, merge, publish, +\ distribute, sublicense, and/or sell copies of the Software, and to +\ permit persons to whom the Software is furnished to do so, subject to +\ the following conditions: +\ +\ The above copyright notice and this permission notice shall be +\ included in all copies or substantial portions of the Software. +\ +\ THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, +\ EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF +\ MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND +\ NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE +\ LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION +\ OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION +\ WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. +\ +\ LICENSE_END Added: ofw/inetv6/pop3.fth =================================================================== --- ofw/inetv6/pop3.fth (rev 0) +++ ofw/inetv6/pop3.fth 2007-08-02 21:37:59 UTC (rev 518) @@ -0,0 +1,283 @@ +\ See license at end of file +purpose: Read your mail from the firmware + +\ Connect to a POP3 server and read your mail. + +0 value #messages + +: open-pop3-connection ( pop-server$ -- ok? ) + \ The TCP port # for POP3 is d# 110 + " $set-host" call-tcp + d# 110 " connect" call-tcp ( ok? ) +; + +: close-pop3-connection ( -- ) + " disconnect" call-tcp +; + +: close-pop3 ( -- ) + close-pop3-connection ( ) + tcp-ih close-dev ( ) + 0 to tcp-ih ( ) + free-mail-buffer ( ) +; + + +: verify-pop3 ( -- ok? ) + get-reply 0= if ( ) + false exit ( bad ) + then ( bad ) + " +OK" reply-good? ( ok? ) +; + +: send-one ( $ -- ok? ) >mail-buffer " +OK" send ( ok? ) ; +: send-two ( $2 $1 -- ok? ) >mail-buffer mail-append " +OK" send ( ok? ) ; + +: send-user-name ( -- ok? ) + " pop-user" $getenv drop ( adr len ) + " USER " send-two ( ok? ) +; +: send-password ( -- ok? ) + " pop-password" $getenv drop ( adr len ) + " PASS " send-two ( ok? ) +; + +: number? ( b -- ascii? ) + h# 30 h# 39 between if + true + else + false + then +; + +h# 8 buffer: pop3-buf +0 value tbuf-ptr + +: +tbuf ( -- ) tbuf-ptr 1+ to tbuf-ptr ; + +: >tbuf ( n -- ) + dup number? 0= if + drop + 0 pop3-buf tbuf-ptr + c! + exit + then + pop3-buf tbuf-ptr + c! + +tbuf +; + +: convert# ( -- # ) + 0 to tbuf-ptr + 0 \ Starting value + begin + pop3-buf tbuf-ptr + c@ h# 30 h# 39 between + while + d# 10 * + pop3-buf tbuf-ptr + c@ h# 0f and + + +pop3-buf + repeat ( # ) +; + +: get-num ( -- ) + 0 to pop3-buf-ptr + begin + begin key? until + key dup emit ( key ) + dup >tbuf ( key ) + number? 0= ( flag ) + until +; + +: quit-mail ( -- ok? ) " QUIT" send-one ( ok? ) ; +: get-status ( -- ok? ) " STAT" send-one ( ok? ) ; +: flush ( -- ) begin key? while key drop repeat ; + +: num>ascii ( n -- $ ) + (u.) +; + +: (get-msg) ( n$ cmd$ -- count ) + >mail-buffer + mail-append + " +OK" send ( ok ) + 0= if false exit then + + \ Get message text... + get-reply ( count ) +; +: get-msg ( i -- ok? ) + num>ascii ( n$ ) + " RETR " ( n$ cmd$ ) + (get-msg) ( len ) +; + +: get-list ( -- ) + cr + #messages 0= if ." You have no messages." cr exit then + + #messages 1+ 1 do + i . ." " i get-msg drop set-ptr mail-buffer mail-ptr type cr + loop + cr +; + +: read-msg ( -- ) + cr + #messages 0= if ." You have no messages." cr exit then + + flush + begin + ." Enter message number: " + get-num cr ( ) + convert# ( # ) + dup #messages > if ( #' ) + drop false ( false ) + ." Invalid message number. Try again" cr + else + true ( #' true ) + then + until ( #' ) + + #line off + + get-msg ( actual ) + cr + mail-buffer swap list + cr +; + +: get-com ( -- b ) begin key? until key dup emit ; + +: dialog ( -- ) + flush + begin + ." Enter Command (List Read Quit): " + get-com ( char ) + upc dup ( char char ) + ascii Q <> + while ( char ) + case + ascii L of get-list endof + ascii R of read-msg endof + ascii I of abort endof \ Path to debugging... + ( default ) ." Bad input, try again..." cr + endcase + repeat + drop + quit-mail drop +; + +: rmail ( -- ) + + false + + " pop-server" $getenv if + cr + ." Missing pop-server environment variable" cr + ." Use ""$setenv"" to set the pop-server name:" cr + ." "" <servername>"" "" pop-server"" $setenv" cr + drop true + else 2drop then + + " pop-user" $getenv if + cr + ." Missing pop-user environment variable" cr + ." Use ""$setenv"" to set the pop-user name:" cr + ." "" <username>"" "" pop-user"" $setenv" cr + drop true + else 2drop then + + " pop-password" $getenv if + cr + ." Missing pop-password environment variable" cr + ." Use ""$setenv"" to set the pop-password name:" cr + ." "" <password>"" "" pop-password"" $setenv" cr + drop true + else 2drop then + + if exit then + + debug-mail? if ." Opening TCP stack..." cr then + + " tcp" open-dev to tcp-ih + tcp-ih 0= if ." Failed to open tcp stack!" exit then + + allocate-mail-buffer + + " pop-server" $getenv drop open-pop3-connection 0= if + close-pop3 exit + then + + debug-mail? if ." Connection established" cr then + + verify-pop3 0= if + debug-mail? if ." Connection did not verify" cr then + close-pop3 exit + then + + debug-mail? if ." Sending USER name..." cr then + send-user-name if + debug-mail? if ." USER accepted" cr then + else + debug-mail? if ." Bad USER" cr then + close-pop3 + exit + then + + debug-mail? if ." Sending password..." cr then + send-password if + debug-mail? if ." Password accepted" cr then + else + debug-mail? if ." Bad Password" cr then + close-pop3 + exit + then + + debug-mail? if ." Getting status..." cr then + 0 to #messages + get-status if + 1 get-number ( #msgs ) + to #messages ( ) + ." You have " #messages .d ." messages." cr + else + debug-mail? if ." Get status failed" cr then + then + + dialog + + close-pop3 +; + +: (show-pop3) ( adr len -- ) + 2dup $getenv if missing-var else + 2swap type ." : " type cr + then +; + +: show-pop3 ( -- ) + " pop-server" (show-pop3) + " pop-user" (show-pop3) + " pop-password" (show-pop3) +; +\ LICENSE_BEGIN +\ Copyright (c) 2006 FirmWorks +\ +\ Permission is hereby granted, free of charge, to any person obtaining +\ a copy of this software and associated documentation files (the +\ "Software"), to deal in the Software without restriction, including +\ without limitation the rights to use, copy, modify, merge, publish, +\ distribute, sublicense, and/or sell copies of the Software, and to +\ permit persons to whom the Software is furnished to do so, subject to +\ the following conditions: +\ +\ The above copyright notice and this permission notice shall be +\ included in all copies or substantial portions of the Software. +\ +\ THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, +\ EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF +\ MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND +\ NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE +\ LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION +\ OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION +\ WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. +\ +\ LICENSE_END Added: ofw/inetv6/random.fth =================================================================== --- ofw/inetv6/random.fth (rev 0) +++ ofw/inetv6/random.fth 2007-08-02 21:37:59 UTC (rev 518) @@ -0,0 +1,32 @@ +\ See license at end of file +purpose: Random number generator (using linear congruence) + +instance variable rn \ Random number + +: random ( -- n ) + rn @ d# 1103515245 * d# 12345 + h# 7FFFFFFF and dup rn ! +; + +\ LICENSE_BEGIN +\ Copyright (c) 2006 FirmWorks +\ +\ Permission is hereby granted, free of charge, to any person obtaining +\ a copy of this software and associated documentation files (the +\ "Software"), to deal in the Software without restriction, including +\ without limitation the rights to use, copy, modify, merge, publish, +\ distribute, sublicense, and/or sell copies of the Software, and to +\ permit persons to whom the Software is furnished to do so, subject to +\ the following conditions: +\ +\ The above copyright notice and this permission notice shall be +\ included in all copies or substantial portions of the Software. +\ +\ THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, +\ EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF +\ MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND +\ NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE +\ LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION +\ OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION +\ WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. +\ +\ LICENSE_END Added: ofw/inetv6/smtp.fth =================================================================== --- ofw/inetv6/smtp.fth (rev 0) +++ ofw/inetv6/smtp.fth 2007-08-02 21:37:59 UTC (rev 518) @@ -0,0 +1,191 @@ +\ See license at end of file +purpose: SMTP, Send mail from the firmware. + +\ Connect to an SMTP server, send some mail. + +: open-smtp-connection ( smtp-server$ -- ok? ) + \ The TCP port # for SMTP is d# 25 + " $set-host" call-tcp + d# 25 " connect" call-tcp ( ok? ) +; + +: close-smtp-connection ( -- ) + " disconnect" call-tcp +; + +: close-smtp ( -- ) + close-smtp-connection ( ) + tcp-ih close-dev ( ) + 0 to tcp-ih ( ) + mail-buffer /mail-buffer free-mem ( ) +; + +: verify-smtp ( -- ok? ) + get-reply 0= if ( ) + false exit ( bad ) + then ( bad ) + " 220" reply-good? ( ok? ) +; + +: smtp-quit ( -- ok? ) + " QUIT" >mail-buffer ( ) + " 221" send ( ok? ) +; + +: smtp-rset ( -- ok? ) + " RSET" >mail-buffer ( ) + " 250" send ( ok? ) +; + +: smtp-hello ( -- ok? ) + " HELO " >mail-buffer + " smtp-my-hostname" $getenv drop mail-append + " 250" send ( ok? ) +; + +: add-terminator ( -- ) \ Send "crlf . crlf" + add-crlf ( ) + " ." mail-append ( ) +; + +: smtp-mail ( -- ok? ) + " MAIL " >mail-buffer + " FROM:" mail-append + " smtp-from-path" $getenv drop mail-append + " 250" send ( ok? ) +; + +: smtp-rcpt ( -- ok? ) + " RCPT " >mail-buffer + " TO:" mail-append + " smtp-to-path" $getenv drop mail-append + " 250" send ( ok? ) +; + +: smtp-data ( adr len -- ok? ) + " DATA " >mail-buffer ( adr len ) + " 354" send ( adr len ok? ) + 0= if ( adr len ) + debug-mail? if ( adr len ) + ." Data send failure" cr ( adr len ) + then ( adr len ) + 2drop 0 ( 0 ) + exit ( 0 ) + then ( 0 ) + + >mail-buffer ( ) + add-terminator ( ) + + " 250" send ( ok? ) +; + +: sendmail ( adr len -- ok? ) + + ?dup 0= if drop false exit then \ no data, no send + + false + + " smtp-server" $getenv if + cr + ." Missing smtp-server environment variable" cr + ." Use ""$setenv"" to set the smtp-server name:" cr + ." "" <servername>"" "" smtp-server"" $setenv" cr + drop true + else 2drop then + + " smtp-from-path" $getenv if + cr + ." Missing smtp-from-path environment variable" cr + ." Use ""$setenv"" to set the smtp-from-path name:" cr + ." "" <return-address>"" "" smtp-from-path"" $setenv" cr + drop true + else 2drop then + + " smtp-to-path" $getenv if + cr + ." Missing smtp-to-path environment variable" cr + ." Use ""$setenv"" to set the smtp-to-path name:" cr + ." "" <address>"" "" smtp-to-path"" $setenv" cr + drop true + else 2drop then + + " smtp-my-hostname" $getenv if + cr + ." Missing smtp-my-hostname environment variable" cr + ." Use ""$setenv"" to set the smtp-my-hostname name:" cr + ." "" <hostname>"" "" smtp-my-hostname"" $setenv" cr + drop true + else 2drop then + + if false exit then ( false ) \ Error out + + debug-mail? if ." Opening TCP stack..." cr then + + " tcp" open-dev to tcp-ih + tcp-ih 0= if ." Failed to open tcp stack!" exit then + + allocate-mail-buffer + + " smtp-server" $getenv drop open-smtp-connection 0= if + close-smtp exit + then + + debug-mail? if ." Connection established" cr then + + verify-smtp 0= if + debug-mail? if ." Connection did not verify" cr then + close-smtp exit + then + + smtp-hello drop ( adr len ) + + ( adr len ) smtp-rset 0= if close-smtp false exit then ( 0 ) + ( adr len ) smtp-mail 0= if close-smtp false exit then ( 0 ) + ( adr len ) smtp-rcpt 0= if close-smtp false exit then ( 0 ) + ( adr len ) smtp-data 0= if close-smtp false exit then ( 0 ) + + smtp-quit drop ( ) + + close-smtp ( ) + true ( ok ) +; + +: test-msg ( -- adr len ) + " "n"nThis message was brought to you by FirmWorks' SMTP package"r"n" +; + +: (show-smtp) ( adr len -- ) + 2dup $getenv if missing-var else + 2swap type ." : " type cr + then +; + +: show-smtp ( -- ) + " smtp-server" (show-smtp) + " smtp-from-path" (show-smtp) + " smtp-to-path" (show-smtp) + " smtp-my-hostname" (show-smtp) +; +\ LICENSE_BEGIN +\ Copyright (c) 2006 FirmWorks +\ +\ Permission is hereby granted, free of charge, to any person obtaining +\ a copy of this software and associated documentation files (the +\ "Software"), to deal in the Software without restriction, including +\ without limitation the rights to use, copy, modify, merge, publish, +\ distribute, sublicense, and/or sell copies of the Software, and to +\ permit persons to whom the Software is furnished to do so, subject to +\ the following conditions: +\ +\ The above copyright notice and this permission notice shall be +\ included in all copies or substantial portions of the Software. +\ +\ THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, +\ EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF +\ MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND +\ NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE +\ LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION +\ OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION +\ WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. +\ +\ LICENSE_END Added: ofw/inetv6/support.fth =================================================================== --- ofw/inetv6/support.fth (rev 0) +++ ofw/inetv6/support.fth 2007-08-02 21:37:59 UTC (rev 518) @@ -0,0 +1,69 @@ +\ See license at end of file +purpose: Support functions for IP stack + +true value friendly? \ True for verbose messages + +[ifdef] include-ipv4 false [else] true [then] +instance value use-ipv6? + +0 instance value the-struct +: set-struct ( adr -- ) to the-struct ; +: +struct ( offset -- ) the-struct + set-struct ; + +: payload ( length header-length -- contents-adr,len ) + the-struct -rot /string +; + +: sfield ( offset size -- new-offset ) + create over , + + does> @ the-struct + +; + +\ Access to composite data in Internet byte order (big-endian) + +alias xc! c! +alias xw! be-w! +alias xw@ be-w@ +\ : xw! ( w adr -- ) >r wbsplit r@ c! r> 1+ c! ; +\ : xw@ ( adr -- w ) dup 1+ c@ swap c@ bwjoin ; +alias xl! be-l! +alias xl@ be-l@ + +instance variable alarmtime +headers +: current-timeout ( -- n ) alarmtime @ ; +: restore-timeout ( n -- ) alarmtime ! ; +: set-timeout ( interval -- ) + dup if get-msecs + then alarmtime ! +; + +headerless + +: timeout? ( -- flag ) + alarmtime @ if get-msecs alarmtime @ >= else true then +; +: ipv4? ( ip-adr -- flag ) 2 - xw@ h# 800 = ; + +\ LICENSE_BEGIN +\ Copyright (c) 2006 FirmWorks +\ +\ Permission is hereby granted, free of charge, to any person obtaining +\ a copy of this software and associated documentation files (the +\ "Software"), to deal in the Software without restriction, including +\ without limitation the rights to use, copy, modify, merge, publish, +\ distribute, sublicense, and/or sell copies of the Software, and to +\ permit persons to whom the Software is furnished to do so, subject to +\ the following conditions: +\ +\ The above copyright notice and this permission notice shall be +\ included in all copies or substantial portions of the Software. +\ +\ THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, +\ EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF +\ MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND +\ NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE +\ LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION +\ OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION +\ WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. +\ +\ LICENSE_END Added: ofw/inetv6/supportv6.fth =================================================================== --- ofw/inetv6/supportv6.fth (rev 0) +++ ofw/inetv6/supportv6.fth 2007-08-02 21:37:59 UTC (rev 518) @@ -0,0 +1,149 @@ +\ See license at end of file +purpose: Internet Protocol version 6 (IPv6) miscellaneous methods + +hex + +d# 16 constant /ipv6 \ Bytes per IP address +/ipv6 buffer: my-ipv6-addr + +: copy-ipv6-addr ( src dst -- ) /ipv6 move ; + +: .ipv6 ( buf -- ) + push-hex + <# dup /ipv6 + 2 - do i be-w@ u#s ascii : hold drop -2 +loop 0 u#> 1 /string + pop-base + type space +; + +0 value ipv6-ptr +0 value ipv6-cur-ptr +0 value ipv6-::-ptr +: ipv6-end-ptr ( -- adr ) ipv6-ptr /ipv6 + ; +: ipv6-c! ( n -- ) ipv6-cur-ptr tuck c! ca1+ to ipv6-cur-ptr ; +: ipv6-w! ( n -- ) ipv6-cur-ptr tuck be-w! wa1+ to ipv6-cur-ptr ; +: ipv6-end? ( -- flag ) ipv6-cur-ptr ipv6-end-ptr u>= ; +: ipv4-ok? ( -- flag ) ipv6-end-ptr ipv6-cur-ptr - 4 >= ; +: decimal-byte ( adr,len -- n ) + push-decimal ['] safe->number catch pop-base ( n 0 | x x error ) + throw + dup d# 255 u> throw ( n ) +; +: hex-word ( adr,len -- n ) + push-hex ['] safe->number catch pop-base ( n 0 | x x error ) + throw ( n ) + dup h# ffff u> throw ( n ) +; +: ($ipv6#) ( ip$ buf -- ) + 0 to ipv6-::-ptr + dup /ipv6 erase + dup to ipv6-ptr to ipv6-cur-ptr + begin dup while ( ip$ ) + ascii : left-parse-string ( r$ l$ ) + ?dup if \ hex-word or decimal ipv4 address + ipv6-end? throw + 2 pick if \ Not the last field: hex-word + hex-word ipv6-w! ( r$ ) + else \ Last field: hex-word or ipv4 adr + ascii . left-parse-string ( r$' l$ ) + 2 pick if \ Decimal ipv4 address + ipv4-ok? not throw + decimal-byte ipv6-c! + 3 0 do + ascii . left-parse-string ( r$ l$ ) + decimal-byte ipv6-c! + loop 2drop ( r$ ) + else + hex-word ipv6-w! 2drop ( r$ ) + then + then + else + drop ( r$ ) + ipv6-::-ptr throw + then + dup if + over c@ ascii : = if + ipv6-::-ptr throw + 1 /string ipv6-cur-ptr to ipv6-::-ptr + then + then + repeat 2drop ( ) + ipv6-::-ptr if \ :: encountered, insert zeroes + ipv6-cur-ptr ipv6-::-ptr - >r \ # of bytes to shift right + ipv6-::-ptr ipv6-end-ptr r@ - r@ move \ Shift right + ipv6-::-ptr ipv6-end-ptr r> - over - erase \ Zero for :: + else + ipv6-end? 0= throw + then +; + +: $ipv6# ( ip$ buf -- ) + ['] ($ipv6#) catch abort" Invalid IPv6 address" +; + +: .ipv4-not-supported ( -- ) + " IPv4 is not supported." $abort +; + +0 [if] + +Test cases: + +" 2001:0DB8:0000:0000:0202:B3FF:FE1E:8329" +" 2001:db8:0:0:202:b3ff:fe1e:8329" +" 2001:db8::202:b3ff:fe1e:8329" +" 2001:db8::" +" 2000::" +" fe80::a00:46ff:fe64:768d" +" ::" +" ::1234" +" ::192.168.0.2" +" 0:0:0:0:0:0:192.168.0.2" +" ::c0a8:2" + +Erroneous test cases: + +" 123::456::789" +" xyz::" +" ::xyz" +" 123::456:xyz" +" xyz:123::456" +" 123:::456" \ Error was not caught! +" 123" +" 123:456" +" ::192.xy.1.102" +" 192.168.1.102" +" ::192.168.1.2:1234" +" 0:0:0:0:0:192.168.0.2" +" 0:0:0:0:0:0:0:192.168.0.2" +" 0:1:2:3:4:5:6:7:8:9:a:b:c:d:e:f:10:11:12" + +load-base $ipv6# +load-base .ipv6 + +[then] + +headers + +\ LICENSE_BEGIN +\ Copyright (c) 2006 FirmWorks +\ +\ Permission is hereby granted, free of charge, to any person obtaining +\ a copy of this software and associated documentation files (the +\ "Software"), to deal in the Software without restriction, including +\ without limitation the rights to use, copy, modify, merge, publish, +\ distribute, sublicense, and/or sell copies of the Software, and to +\ permit persons to whom the Software is furnished to do so, subject to +\ the following conditions: +\ +\ The above copyright notice and this permission notice shall be +\ included in all copies or substantial portions of the Software. +\ +\ THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, +\ EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF +\ MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND +\ NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE +\ LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION +\ OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION +\ WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. +\ +\ LICENSE_END Added: ofw/inetv6/tcp.fth =================================================================== --- ofw/inetv6/tcp.fth (rev 0) +++ ofw/inetv6/tcp.fth 2007-08-02 21:37:59 UTC (rev 518) @@ -0,0 +1,2418 @@ +\ See license at end of file +purpose: TCP package + +hex + +[ifndef] show" +also forth definitions +: show" [char] " parse 2drop ; immediate +previous definitions +[then] +\ : xh 2dup type space ($header) ; ' xh is $header + +false instance value debug? +false instance value abort-on-reconnect? + +\ : ( postpone .( cr ; immediate +: l+! +! ; + +\ : debug" postpone ." postpone cr ; immediate +: (drop$) skipstr 2drop ; +: drop$ +level postpone (drop$) ," -level ; immediate +: debug" debug? if postpone ." postpone cr else postpone drop$ then ; immediate + +alias l>n noop +: ?exit if r> drop then ; +4 constant /i +: copy-ip-addr /i move ; +: oc-checksum ( n adr len -- n' ) " oc-checksum" $call-parent ; + +2 constant pr_slowhz + +false instance value alive? +0 instance value the-struct + +: sfield ( offset size -- new-offset ) + create over , + + does> @ the-struct + +; + +: set-struct ( adr -- ) to the-struct ; +: +struct ( offset -- ) the-struct + set-struct ; + + +\ Check: +\ unsigned comparison +\ segment wraparound + +0 constant closed \ closed +1 constant listen \ listening for connection +2 constant syn_sent \ active, have sent syn +3 constant syn_received \ have send and received syn +\ states < ESTABLISHED are those where connections not established +4 constant established \ established +5 constant close_wait \ rcvd fin, waiting for close +\ states > CLOSE_WAIT are those where user has closed +6 constant fin_wait_1 \ have closed, sent fin +7 constant closing \ closed xchd FIN; await FIN ACK +8 constant last_ack \ had fin and close; await FIN ACK +\ states > CLOSE_WAIT && < FIN_WAIT_2 await ACK of FIN +9 constant fin_wait_2 \ have closed, fin is acked +d# 10 constant time_wait \ in 2*msl quiet wait after close + +struct \ ip-pseudoheader + 9 sfield ih_x1 + 1 sfield ih_pr + 2 sfield ih_len + /i sfield ih_src + /i sfield ih_dst +constant /pip + +struct \ tcphdr + /w sfield th_sport \ source port + /w sfield th_dport \ destination port + /l sfield th_seq \ sequence number + /l sfield th_ack \ acknowledgement number + /c sfield th_off4 \ Data offset in high nibble + /c sfield th_flags +h# 01 constant fin +h# 02 constant syn +h# 04 constant rst +h# 08 constant th_push +h# 10 constant ack +h# 20 constant urg + /w sfield th_win \ window + /w sfield th_sum \ checksum + /w sfield th_urp \ urgent pointer +constant /tcphdr + +: ip-struct ( -- ) /pip negate +struct ; +: tcp-struct ( -- ) /pip +struct ; + +listnode + /n field >offset \ Offset into buf of the still-useful data + /n field >len \ Length, including out-of-band data + /n field >dlen \ Length, excluding out-of-band data + /n field >bufadr \ Buffer address + /n field >bufsize \ Total length of buffer + /l field >seq \ Sequence number + /c field >flags \ Flags +nodetype: tcpqnode + +instance variable tcpq \ Linked list of packets to be reassembled +0 tcpq ! + +3 constant tcprexmtthresh \ Retransmission threshold + +d# 512 constant mssdflt \ Default value for maximum segment size +3 constant rttdflt +pr_slowhz rttdflt * constant srttdflt \ assumed RTT if no info + +pr_slowhz d# 30 * constant tcptv_msl \ max seg lifetime (hah!) + + +d# 4096 constant mssmax \ Our (arbitrary) maximum value for + \ Maximum segment size, to conserve memory + +0 value rbuf-adr +0 value rbuf-len +0 value rbuf-actual +: rbuf-space ( -- n ) rbuf-len rbuf-actual - ; + +\ State of this TCP +0 instance value t_flags +h# 01 constant acknow \ ack peer immediately +h# 02 constant delack \ ack, but try to delay it +h# 04 constant nodelay \ don't delay packets to coalesce +h# 08 constant noopt \ don't use tcp options +h# 10 constant sentfin \ have sent FIN +0 [if] +h# 20 constant req_scale \ have/will request window scaling +h# 40 constant rcvd_scale \ other side has requested scaling +[then] + +string-array state-names + ," CLOSED" + ," LISTEN" + ," SYN_SENT" + ," SYN_RECEIVED" + ," ESTABLISHED" + ," CLOSE_WAIT" + ," FIN_WAIT_1" + ," CLOSING" + ," LAST_ACK" + ," FIN_WAIT_2" + ," TIME_WAIT" +end-string-array + +d# 512 instance value t_maxseg \ maximum segment size +0 instance value ts \ state of this connection +: set-state ( state -- ) + to ts + debug? if ts state-names count type cr then +; + +\ Timers +instance variable tcpt_rexmt tcpt_rexmt off +instance variable tcpt_persist tcpt_persist off +instance variable tcpt_keep tcpt_keep off +instance variable tcpt_2msl tcpt_2msl off + +: canceltimers ( -- ) + tcpt_rexmt off + tcpt_persist off + tcpt_keep off + tcpt_2msl off +; +0 instance value t_dupacks \ consecutive dup acks recd +0 instance value t_force \ true if forcing out a byte + +\ receive sequence variables +0 instance value rcv_wnd \ receive window +0 instance value rcv_nxt \ receive next +0 instance value rcv_up \ receive urgent pointer +0 instance value irs \ initial receive sequence number + +0 instance value rcv_adv \ advertised window + +: .flags ( flags -- ) + dup fin and if ." FIN " then + dup syn and if ." SYN " then + dup rst and if ." RST " then + dup th_push and if ." PUSH " then + dup ack and if ." ACK " then + dup urg and if ." URG " then + drop +; +: .pkt ( flags win ack seq -- ) + push-hex + ." Seq: " th_seq be-l@ 8 u.r + ." Ack: " th_ack be-l@ 8 u.r + ." Win: " th_win be-w@ 4 u.r + ." Len: " ip-struct ih_len be-w@ /tcphdr - 4 u.r tcp-struct + ." Flags: " th_flags c@ .flags + cr + pop-base +; + + +: +rcv_nxt ( n -- ) rcv_nxt + to rcv_nxt ; + +0 value wbuf-start +0 value wbuf-adr +0 value wbuf-top +0 value wbuf-end +0 value wbuf-threshold + +d# 1024 d# 16 * constant /wbuf +: wbuf-clear ( -- ) + wbuf-start /wbuf + to wbuf-end + wbuf-start dup to wbuf-adr to wbuf-top + wbuf-start /wbuf 2/ + to wbuf-threshold +; +: wbuf-allocate ( -- ) + /wbuf alloc-mem to wbuf-start + wbuf-clear +; + +: wbuf-actual ( -- n ) wbuf-top wbuf-adr - ; +: wbuf-avail ( -- n ) wbuf-end wbuf-top - ; + +\ Remove n bytes of data from the beginning of the write buffer +: wbuf-drop ( n -- ) + wbuf-adr + to wbuf-adr + \ If there are enough empty bytes at the beginning to make + \ it worthwhile to do so, copy the data down to make more + \ space at the end. + wbuf-adr wbuf-threshold >= if + wbuf-adr wbuf-start wbuf-actual move \ Copy bytes down + wbuf-actual wbuf-start + to wbuf-top \ Fix pointers + wbuf-start to wbuf-adr + then +; + +\ send sequence variables +0 instance value snd_una \ send unacknowledged +0 instance value snd_nxt \ send next +0 instance value snd_up \ send urgent pointer +0 instance value snd_wl1 \ window update seg seq number +0 instance value snd_wl2 \ window update seg ack number +0 instance value snd_wnd \ send window +1 value iss \ initial send sequence number +true value first-time? \ Used to prime iss. +1 value tcp_iss \ initial send sequence number + +0 instance value snd_max \ highest sequence number send + \ used to recognize retransmits + +d# 65535 constant maxwin \ largest value for unscaled window +d# 12 constant maxrxtshift \ maximum retransmits + +d# 120 d# 60 * pr_slowhz * + constant keepidle \ time before keepalive probes begin + +d# 75 pr_slowhz * + constant keepintvl \ time between keepalive probes + +d# 75 pr_slowhz * + constant keep_init \ initial connect keep alive + +0 instance value maxidle + +\ congestion control (for slow start, source quench, retransmit after loss) +maxwin instance value snd_cwnd \ congestion-controlled window +maxwin instance value snd_ssthresh \ snd_cwnd size threshhold for slow + \ start exponential to linear switch + +\ transmit timing stuff. See below for scale of srtt and rttvar. +\ "Variance" is actually smoothed difference. + \ Init srtt to 0, so we can tell that we have no + \ rtt estimate. Set rttvar so that srtt + 2 * rttvar gives + \ reasonable initial retransmit time. + +0 instance value t_idle \ inactivity time +0 instance value t_rtt \ round trip time +0 instance value t_rtseq \ sequence number being timed +0 instance value t_srtt \ smoothed round-trip time +3 pr_slowhz * 2 2+ 1- lshift + instance value t_rttvar \ variance in round-trip time +pr_slowhz instance value t_rttmin \ minimum rtt allowed +0 instance value max_sndwnd \ largest window peer has offered + +\ out-of-band data +0 instance value t_oobflags \ have some + 1 constant havedata + 2 constant haddata +0 instance value t_iobc \ input character + + +0 instance value xmit_buf + +\ Information about the current packet + +0 value iflags \ Copy of input packet flags +0 value iseq \ Copy of input packet sequence number +0 value iack \ Copy of input packet sequence number +0 value iwin \ Copy of input packet sequence window pointer +0 value iurp \ Copy of input packet urgent pointer +0 value ilen \ Copy of input packet length (from IP header) +0 value ilen-save \ Copy of input packet length (from IP header), unmolested + +0 value doff \ Offset to data (after options) +0 value #oob \ # of urgent data bytes elided +: idata ( -- adr ) the-struct doff + ; +: idlen ( -- len ) ilen #oob - ; +: -ilen ( n -- ) negate ilen + to ilen ; + +d# 64 pr_slowhz * constant rexmtmax +: rexmtval ( -- n ) t_srtt 3 rshift t_rttvar 2 rshift + ; + +0 instance value t_rxtshift \ log(2) of rexmt exp. backoff +rexmtval pr_slowhz max pr_slowhz d# 64 * min + instance value t_rxtcur \ current retransmit value + +: set-snd_nxt ( n -- ) to snd_nxt ; +: set-cwnd ( n -- ) to snd_cwnd debug? if ." snd_cwnd set to " snd_cwnd u. cr then ; + +: +snd_nxt ( n -- ) snd_nxt + set-snd_nxt ; + +alias seq@ be-l@ +alias len@ be-w@ + +\ Sequence numbers are 32-bit integers that use circular arithmetic +: s< ( s1 s2 -- flag ) - l>n 0< ; +: s> ( s1 s2 -- flag ) - l>n 0> ; +: s<= ( s1 s2 -- flag ) - l>n 0<= ; +: s>= ( s1 s2 -- flag ) - l>n 0>= ; + +: rcvseqinit ( -- ) irs 1+ dup to rcv_adv to rcv_nxt ; + +: sendseqinit ( -- ) + iss dup to snd_up dup to snd_max dup set-snd_nxt to snd_una +; +d# 125 d# 1024 * constant issincr \ Increments for iss each second + +: his-ip-addr ( -- 'ip ) " his-ip-addr" $call-parent ; +: my-ip-addr ( -- 'ip ) " my-ip-addr" $call-parent ; +: $set-host ( $ -- ) " $set-host" $call-parent ; +: set-dest-ip ( 'ip -- ) " set-dest-ip" $call-parent ; +: local? ( -- flag ) + " netmask" $call-parent unaligned-l@ >r + my-ip-addr l@ r@ and his-ip-addr l@ r> and = +; + +0 instance value my-tcp-port +0 instance value his-tcp-port +/tcphdr /pip + instance buffer: t_template +: make-template ( -- ) + t_template set-struct + the-struct /tcphdr /pip + erase + + 6 ih_pr c! \ IPPROTO_TCP + my-ip-addr ih_src copy-ip-addr + his-ip-addr ih_dst copy-ip-addr + + tcp-struct + + my-tcp-port th_sport be-w! + his-tcp-port th_dport be-w! + + 5 4 lshift th_off4 c! +; + +: copy-to-rbuf ( adr len -- ) + tuck rbuf-adr rbuf-actual + swap move ( len ) + rbuf-actual + to rbuf-actual ( ) +; +: copy-from-rbuf ( adr len -- len' ) + rbuf-actual min tuck ( len' adr len' ) + rbuf-adr -rot move ( len' ) + dup rbuf-actual = if ( len' ) + 0 to rbuf-actual ( len' ) + else ( len' ) + \ Shuffle the remaining data down in the buffer + rbuf-actual over - to rbuf-actual ( len' ) + rbuf-adr over + rbuf-adr rbuf-actual move ( len' ) + then ( len' ) +; + +\ Reassembly queue management + +: release-tcpnode ( prev this -- ) + \ Release the packet buffer + dup >bufsize @ ?dup if ( prev this len ) + over >bufadr @ swap free-mem ( prev this ) + then ( prev this ) + drop delete-after tcpqnode free-node ( ) +; + +\ Present data to caller, advancing rcv_nxt through +\ completed sequence space. +: present-data ( -- flags ) + \ Exit if we have no buffer space in which to return data + rbuf-len 0= if 0 exit then + + \ Exit if the connection is not up + ts established < if 0 exit then + + \ Exit if the queue is empty (i.e. there's no data to present) + tcpq >next-node ?dup 0= if 0 exit then ( first-node ) + + \ Exit if the data to be returned next has not yet arrived + dup >seq l@ rcv_nxt <> if drop 0 exit then ( first-node ) + + \ Exit if we're not quite connected + \ This can't happen because of the earlier check for ts=established +\ dup >dlen @ 0<> ts syn_received = and if drop 0 exit then ( node ) + + begin ( node ) + dup >flags c@ fin and swap ( flags node ) + + \ Compute the copy length + dup >dlen @ rbuf-len min ( flags node len ) + + \ Update rcv_nxt in sequence space, which include out-of-band data. + \ If len > dlen, the difference represents removed out-of-band data. + 2dup over >len @ rot >dlen @ - + +rcv_nxt ( flags node len ) + + \ Copy the data into the user buffer + over dup >bufadr @ swap >offset @ + ( flags node len adr ) + over copy-to-rbuf ( flags node len ) + + \ "remove" the data from the list node + 2dup negate swap 2dup >dlen +! >len +! ( flags node len ) + + \ If we haven't consumed all the data in this node, update + \ its variables and exit. + over >dlen @ if ( flags node len ) + 2dup swap >seq l+! ( flags node len ) + 2dup swap >offset +! ( flags node len ) + + \ There is no point in continuing, as the user buffer must be + \ full (otherwise we would have consumed all the node data). + 2drop exit + then ( flags node len ) + + \ We have used all the node's data, so we can release the node. + drop ( flags node ) + + \ Release the node and its buffer + tcpq swap release-tcpnode ( flags ) + + \ If the user buffer is full, we can exit now + rbuf-len 0= ?exit ( flags ) + + \ Otherwise advance to the next node + tcpq >next-node ( flags node ) + ?dup while ( flags node ) + nip ( node ) + repeat ( flags ) +; + + +0 value trim-offset \ "local" variable used for reassembly queue insertion + +\ If there is a preceding segment, it may provide some of +\ our data already. If so, drop the data from the incoming +\ segment. If it provides all of our data, drop us. +: ?trim-prev ( prev -- enclosed? ) + 0 to trim-offset + dup tcpq = if drop false exit then ( prev ) + dup >seq l@ swap >len l@ + iseq - l>n \ Wraparound ( n ) + + \ Exit if the segments don't overlap + dup 0<= if drop false exit then ( n ) + + \ Return true if the new packet is enclosed by the old segment + dup ilen >= if drop true exit then ( n ) + + \ Otherwise trim the packet. + dup to trim-offset ( n ) + dup iseq + l>n to iseq ( n ) + -ilen +; +: ?trim-nexts ( prev this -- prev this' ) + begin dup while ( prev node ) + iseq ilen + over >seq l@ - l>n ( prev node n ) + + \ Exit if no overlap + dup 0<= if 3drop exit then ( prev node n ) + + 2dup swap >len @ < if ( prev node n ) + \ Partial overlap - trim node and exit + 2dup negate swap >len +! ( prev node n ) + 2dup swap >seq l+! ( prev node n ) + 2dup swap >offset l+! ( prev node ) + exit + then ( prev node n ) + \ Complete overlap - discard node ( prev node n ) + drop ( prev node ) + 2dup >next-node 2swap ( prev next prev node ) + release-tcpnode ( prev next ) + repeat ( prev next ) +; +: new-node ( -- ) + tcpqnode allocate-node ( new ) + 0 over >offset ! ( new ) + ilen over >len ! ( new ) + idlen over >dlen ! ( new ) + iseq over >seq l! ( new ) + \ XXX this is what BSD does, but it seems to me that it + \ should be "iflags" instead of "th_flags c@", because + \ it would seem that you want the FIN flag to be trimmed + \ if it is outside the receive window. + th_flags c@ over >flags c! ( new ) + idlen over >bufsize ! ( new ) + idlen if ( new ) + idlen alloc-mem ( new buf ) + 2dup swap >bufadr ! ( new buf ) + idata trim-offset + swap ilen move ( new ) + then ( new ) +; +: next-seg ( node-data-adr -- flag ) >seq l@ iseq - 0> ; +: reassemble ( -- flags ) + tcpq ['] next-seg find-node ( prev-node this-node|0 ) + over ?trim-prev if 2drop 0 exit then ( prev this ) + ?trim-nexts ( prev this ) + + \ Create a new fragment queue entry and insert it into place + drop new-node ( prev new ) + swap insert-after ( ) + + present-data +; + +\ End of reassembly queue management + +\ Assumes active struct is set to the TCP header + +\ For now we assume no IP options; the IP layer should probably +\ strip them for us anyway + +: sum-bad? ( adr len -- flag ) + swap /pip - set-struct ( len ) + ih_x1 9 erase ( len ) \ Zap unnecessary fields + dup ih_len be-w! ( len ) \ Put length field back + 0 the-struct rot /pip + oc-checksum h# ffff <> +; + +0 value optp 0 value optlen +0 value acked +0 value needoutput +0 value cantrcvmore? + +: set-flag ( bitmask -- ) t_flags or to t_flags ; +: set-acknow ( -- ) acknow set-flag ; +: clear-iflag ( flag -- ) iflags swap invert and to iflags ; +: iflag? ( bitmask -- ) iflags and 0<> ; +: t_flag? ( bitmask -- ) t_flags and 0<> ; +: take-data ( -- ) + ilen +rcv_nxt + + \ Set DELACK for segments received in order, but ack immediately + \ when segments are out of order (so fast retransmit can work). + idata idlen copy-to-rbuf + iflags th_push and if acknow else delack then set-flag +; + +: set-rxtcur ( val limit -- ) max rexmtmax min to t_rxtcur ; + +\ Collect new round-trip time estimate +\ and update averages and current timeout +: xmit_timer ( rtt -- ) + 1- ( rtt ) + t_srtt if ( rtt ) + \ srtt is stored as fixed point with 3 bits after the + \ binary point (i.e., scaled by 8). The following magic + \ is equivalent to the smoothing algorithm in rfc793 with + \ an alpha of .875 (srtt = rtt/8 + srtt*7/8 in fixed + \ point). Adjust rtt to origin 0. + dup 2 lshift t_srtt 3 rshift - ( rtt delta ) + dup t_srtt + 1 max to t_srtt ( rtt delta ) + + \ We accumulate a smoothed rtt variance (actually, a + \ smoothed mean difference), then set the retransmit + \ timer to smoothed rtt + 4 times the smoothed variance. + \ rttvar is stored as fixed point with 2 bits after the + \ binary point (scaled by 4). The following is + \ equivalent to rfc793 smoothing with an alpha of .75 + \ (rttvar = rttvar*3/4 + |delta| / 4). This replaces + \ rfc793's wired-in beta. + abs t_rttvar 2 rshift - ( rtt delta' ) + 1 max to t_rttvar ( rtt ) + else + \ No rtt measurement yet - use the unsmoothed rtt. + \ Set the variance to half the rtt (so our first + \ retransmit happens at 3*rtt). + dup 5 lshift to t_srtt ( rtt ) ( 5 is 3 + 2 ) + dup 3 lshift to t_rttvar ( rtt ) + then ( rtt ) + 0 to t_rtt ( rtt ) + 0 to t_rxtshift ( rtt ) + + \ the retransmit should happen at rtt + 4 * rttvar. + \ Because of the way we do the smoothing, srtt and rttvar + \ will each average +1/2 tick of bias. When we compute + \ the retransmit timer, we want 1/2 tick of rounding and + \ 1 extra tick because of +-1/2 tick uncertainty in the + \ firing of the timer. The bias will give us exactly the + \ 1.5 tick we need. But, because the bias is + \ statistical, we have to test that we don't drop below + \ the minimum feasible timer (which is 2 ticks). + + 2+ rexmtval set-rxtcur +; + +: ack-una ( -- ) + iack to snd_una + snd_nxt snd_una s< if snd_una set-snd_nxt then +; + +\ Determine a reasonable value for maxseg size. +\ If the route is known, check route for mtu. +\ If none, use an mss that can be handled on the outgoing +\ interface without forcing IP to fragment; if bigger than +\ an mbuf cluster (MCLBYTES), round down to nearest multiple of MCLBYTES +\ to utilize large mbufs. If no route is found, route has no mtu, +\ or the destination isn't local, use a default, hopefully conservative +\ size (usually 512 or the default IP max size, but no more than the mtu +\ of the interface), as we can't discover anything about intervening +\ gateways or networks. We also initialize the congestion/slow start +\ window to be a single segment if the destination isn't local. +\ While looking at the routing entry, we also initialize other path-dependent +\ parameters from pre-set or cached values in the routing entry. + +: tcp_mss ( offer -- chosen ) + \ XXX we probably should try to first determine whether or not we + \ know anything about the route, and if not, just return mssdflt + + \ Use link MTU on a LAN, otherwise use a conservative default + \ not larger than the link MTU + + " max-ip-payload" $call-parent /tcphdr - ( offer limit ) + mssmax min ( offer limit ) + local? 0= if mssdflt min then ( offer limit ) + + \ If offer is nonzero, use the computed value, otherwise use the + \ smaller of the offer and the computed value. + over if over min then ( offer chosen ) + + \ But in all cases, use at least 32 bytes + d# 32 max ( offer chosen' ) + + \ If this results in a smaller segment size than we're currently + \ using, or if offer is nonzero, then reduce the current size. + dup t_maxseg < rot 0<> or if ( chosen ) + dup to t_maxseg ( chosen ) + debug? if ." Maxseg set to " t_maxseg u. cr then + then ( chosen ) + + \ Set the slow-open window size + dup set-cwnd ( chosen ) +; + +\ Output code + +0 value len +0 value ourfinisacked? + +0 value idle? +0 value sendalot? + +\ Flags used when sending segments in tcp_output. +\ Basic flags (TH_RST,TH_ACK,TH_SYN,TH_FIN) are totally +\ determined by state, with the proviso that TH_FIN is sent only +\ if all data queued for output is included in the segment. +create outflags + rst ack or c, \ 0 closed + 0 c, \ 1 listen + syn c, \ 2 syn_sent + syn ack or c, \ 3 syn_received + ack c, \ 4 established + ack c, \ 5 close_wait + fin ack or c, \ 6 fin_wait_1 + fin ack or c, \ 7 closing + fin ack or c, \ 8 last_ack + ack c, \ 9 fin_wait_2 + ack c, \ 10 time_wait + +0 value oflags +: oflag? ( bitmask -- flag ) oflags and 0<> ; +: fin-off ( -- ) oflags fin invert and to oflags ; + +create backoff +base @ decimal + 1 , 2 , 4 , 8 , 16 , 32 , 64 , 64 , 64 , 64 , 64 , 64 , 64 , +base ! + +pr_slowhz 5 * constant persmin +pr_slowhz d# 60 * constant persmax + +: setpersist ( -- ) + t_srtt 2 rshift t_rttvar + 1 rshift ( t ) + + \ Start/restart persistance timer. + backoff t_rxtshift na+ @ * ( t*backoff ) + + persmin max persmax min tcpt_persist ! + + t_rxtshift 1+ maxrxtshift min to t_rxtshift +; + +0 value win +0 value offs +: dont-send? ( -- exit? ) + false + + \ Sender silly window avoidance. If connection is idle and can send + \ all data, a maximum segment, at least a maximum default-size segment + \ do it, or are forced, do it; otherwise don't bother. + \ If peer's buffer is tiny, then send when window is at least half open. + \ If retransmitting (possibly after persist timer forced us + \ to send into a small window), then must resend. + + len if + len t_maxseg = ?exit + + idle? nodelay t_flag? or len offs + wbuf-actual >= and ?exit + + t_force ?exit + + len max_sndwnd 2/ >= ?exit + + snd_nxt snd_max s< ?exit + then + + \ Compare available window to amount of window known to peer (as + \ advertised window less next expected input). If the difference + \ is at least two max size segments, or at least 50% of the maximum + \ possible window, then want to send a window update to peer. + + win 0> if + \ "adv" is the amount we can increase the window, + \ taking into account that we are limited by MAXWIN + + maxwin win min rcv_adv rcv_nxt - - ( adv ) + dup t_maxseg 2* >= if drop exit then ( adv ) + + 2* rbuf-len >= ?exit ( ) + then + + \ Send if we owe peer an ACK. + + acknow t_flag? ?exit + syn rst or oflag? ?exit + snd_up snd_una s> ?exit + + \ If our state indicates that FIN should be sent + \ and we have not yet done so, or we're retransmitting the FIN, + \ then we need to send. + + fin oflag? + sentfin t_flag? 0= snd_nxt snd_una = or and ?exit + + \ TCP window updates are not reliable, rather a polling protocol + \ using ``persist'' packets is used to insure receipt of window + \ updates. The three ``states'' for the output side are: + \ idle not doing retransmits or persists + \ persisting to move a small or zero window + \ (re)transmitting and thereby not persisting + \ + \ TCPT_PERSIST is set when we are in persist state. + \ t_force is set when we are called to send a persist packet. + \ TCPT_REXMT is set when we are retransmitting + \ + \ The output side is idle when both timers are zero. + \ + \ If send window is too small, there is data to transmit, and no + \ retransmit or persist is pending, then go to persist state. + \ If nothing happens soon, send when timer expires: + \ if window is nonzero, transmit what we can, otherwise force out a byte. + + wbuf-actual 0<> tcpt_rexmt @ 0= and tcpt_persist @ 0= and if + 0 to t_rxtshift + setpersist + then + + drop true +; + +\ TCP output routine: figure out what should be sent and send it. +d# 32 buffer: opt +0 value hdrlen + +: make-options ( -- ) + \ Before ESTABLISHED, force sending of initial options + \ unless TCP set not to do any options. + \ NOTE: we assume that we have space for the IP/TCP header plus TCP + \ options, leaving room for a maximum link header, i.e. + \ max_linkhdr + sizeof (struct tcpiphdr) + optlen <= buflen + + 0 to optlen + /tcphdr to hdrlen + syn oflag? if + iss set-snd_nxt + noopt t_flag? 0= if + 2 opt c! \ tcpopt_maxseg + 4 opt 1+ c! \ option length + debug? if ." Sending " then + 0 tcp_mss opt 2+ be-w! \ option value + 4 to optlen + then + then + + optlen hdrlen + to hdrlen + + \ Adjust data length if insertion of options will + \ bump the packet length beyond the t_maxseg length. + + len t_maxseg optlen - > if + t_maxseg optlen - to len + fin-off + true to sendalot? + then +; +: insert-data ( -- ) + \ Grab a transmit buffer, attaching a copy of data to + \ be transmitted, and initialize the header from + \ the template for sends on this connection. + + xmit_buf set-struct + + len if + wbuf-adr offs + xmit_buf hdrlen + len move + + \ If we're sending everything we've got, set PUSH. + \ (This will keep happy those implementations which only + \ give data to the user when a buffer fills or + \ a PUSH comes in.) + + offs len + wbuf-actual = + len snd_cwnd = or \ Also PUSH when we have a lot + if + oflags th_push or to oflags + then + then +; +: set-window ( -- ) + \ Calculate receive window. Don't shrink window, + \ but avoid silly window syndrome. + + win rbuf-len 4 / < win t_maxseg < and if 0 to win then + + win maxwin min rcv_adv rcv_nxt - max th_win be-w! + + snd_up snd_nxt s> if + snd_up snd_nxt - th_urp be-w! + th_flags c@ urg or th_flags c! + else + \ If no urgent pointer to send, then we pull + \ the urgent pointer to the left edge of the send window + \ so that it doesn't drift into the send window on sequence + \ number wraparound. + snd_una to snd_up + then +; +: set-timers ( -- ) + \ In transmit state, time the transmission and arrange for + \ the retransmit. In persist state, just set snd_max. + + t_force 0= tcpt_persist @ 0= or if + snd_nxt ( startseq ) + + \ Advance snd_nxt over sequence space of this segment. + + syn oflag? if 1 +snd_nxt then + fin oflag? if 1 +snd_nxt sentfin set-flag then + + len +snd_nxt + + snd_nxt snd_max s> if + snd_nxt to snd_max + + \ Time this transmission if not a retransmission and + \ not currently timing anything. + t_rtt 0= if 1 to t_rtt dup to t_rtseq then ( startseq ) + then + + \ We're done with startseq + drop ( ) + + \ Set retransmit timer if not currently set, + \ and not doing an ack or a keep-alive probe. + \ Initial value for retransmit timer is smoothed + \ round-trip time + 2 * round-trip time variance. + \ Initialize shift counter which is used for backoff + \ of retransmit time. + + tcpt_rexmt @ 0= snd_nxt snd_una <> and if + t_rxtcur tcpt_rexmt ! + tcpt_persist @ if tcpt_persist off 0 to t_rxtshift then + then + else + snd_nxt len + snd_max s> if snd_nxt len + to snd_max then + then +; + +\ Called only from tcp_output +: send ( -- ) + make-options + + insert-data + + t_template xmit_buf /pip - /tcphdr /pip + move \ Copy in header + + \ Fill in fields, remembering maximum advertised + \ window for use in delaying messages about window sizes. + \ If resending a FIN, be sure not to use a new sequence number. + + fin oflag? sentfin t_flag? and + snd_nxt snd_max = and if -1 +snd_nxt then + + \ If we are doing retransmissions, then snd_nxt will not reflect the first + \ unsent octet. For ACK only packets, we do not want the sequence number + \ of the retransmitted packet, we want the sequence number of the next + \ unsent octet. So, if there is no data (and no SYN or FIN), use snd_max + \ instead of snd_nxt when filling in iseq. But if we are in persist + \ state, snd_max might reflect one byte beyond the right edge of the + \ window, so use snd_nxt in that case, since we know we aren't doing a + \ retransmission. (retransmit and persist are mutually exclusive...) + + len 0<> syn fin or oflag? or tcpt_persist @ 0<> or if + snd_nxt + else + snd_max + then + th_seq be-l! + + rcv_nxt th_ack be-l! + optlen if + opt the-struct /tcphdr + optlen move + /tcphdr optlen + 2 rshift 4 lshift th_off4 c! + then + + oflags th_flags c! + + set-window + + \ Put TCP length in extended header, and then + \ checksum extended header and data. + + ip-struct + ih_x1 9 erase + /tcphdr optlen + len + ih_len be-w! ( ) + 0 the-struct hdrlen len + /pip + oc-checksum ( sum ) + tcp-struct ( sum ) + th_sum be-w! ( ) + + set-timers + + debug? if ." XMT " .pkt then + + \ Send to IP level. + + the-struct hdrlen len + 6 " send-ip-packet" $call-parent \ 6 is IPPROTO_TCP + + \ Data sent (as far as we can tell). + \ If this advertises a larger window than any other segment, + \ then remember the size of the advertised window. + \ Any pending ACK has now been sent. + + win 0> rcv_nxt win + rcv_adv s> and if + rcv_nxt win + to rcv_adv + then + t_flags acknow delack or invert and to t_flags +; + +: tcp_output ( -- ) + \ Determine length of data that should be transmitted, + \ and flags that will be used. + \ If there is some data or critical controls (SYN, RST) + \ to send, then transmit; otherwise, investigate further. + + snd_max snd_una = to idle? + idle? t_idle t_rxtcur >= and if + \ We have been idle for "a while" and no acks are expected to clock out + \ any data we send -- slow start to get ack "clock" running again. + t_maxseg set-cwnd + then + begin + false to sendalot? + snd_nxt snd_una - to offs + snd_wnd snd_cwnd min to win + outflags ts ca+ c@ to oflags + + \ If in persist timeout with window of 0, send 1 byte. + \ Otherwise, if window is small but nonzero and timer expired, + \ we will send what we can and go to transmit state. + + t_force if + win if + tcpt_persist off + 0 to t_rxtshift + else + \ If we still have some data to send, then clear the FIN bit. + \ Usually this would happen below when it realizes that we + \ aren't sending all the data. However, if we have exactly + \ 1 byte of unset data, then it won't clear the FIN bit below, + \ and if we are in persist state, we wind up sending the packet + \ without recording that we sent the FIN bit. + \ + \ We can't just blindly clear the FIN bit, because if we don't + \ have any more data to send then the probe will be the FIN itself. + off wbuf-actual < if fin-off then + 1 to win + then + then + + win wbuf-actual < if fin-off win else wbuf-actual then ( n ) + offs - to len + + len 0< if + \ If FIN has been sent but not acked, but we haven't been called + \ to retransmit, len will be -1. Otherwise, window shrank + \ after we sent into it. If window shrank to 0, cancel pending + \ retransmit and pull snd_nxt back to (closed) window. We will + \ enter persist state below. If the window didn't close completely, + \ just wait for an ACK. + 0 to len + win 0= if tcpt_rexmt off snd_una set-snd_nxt then + then + + len t_maxseg > if t_maxseg to len fin-off true to sendalot? then + + rbuf-space to win + + dont-send? ?exit + + send + sendalot? 0= until +; + +: fast-path? ( -- flag ) + \ Header prediction: check for the two common cases + \ of a uni-directional data xfer. If the packet has + \ no control flags, is in-sequence, the window didn't + \ change and we're not retransmitting, it's a + \ candidate. If the length is zero and the ack moved + \ forward, we're the sender side of the xfer. Just + \ free the data acked & wake any higher level process + \ that was blocked waiting for space. If the length + \ is non-zero and the ack didn't move, we're the + \ receiver side. If we're getting packets in-order + \ (the reassembly queue is empty), add the data to + \ the socket buffer and note that we need a delayed ack. + + ts established = \ Connection up? + iflags h# 37 and ack = and \ No control flags? + iseq rcv_nxt = and \ In sequence? + iwin 0<> and \ Window didn't change? + iwin snd_wnd = and \ Window didn't change? + snd_nxt snd_max = and if \ Not retransmitting? + ilen if + \ Incoming data + + iack snd_una = \ in sequence data packet? + tcpq >next-node 0= and \ reassembly queue empty? + ilen rbuf-space <= and if \ enough space to take it? + take-data + true exit + then + false exit + then + + \ ACK for outgoing data + + iack snd_una - 0> + iack snd_max - 0<= and + snd_cwnd snd_wnd >= and + t_dupacks tcprexmtthresh < and if + \ This is a pure ack for outstanding data + t_rtt 0<> iack t_rtseq - 0> and if + t_rtt xmit_timer + then + iack snd_una - to acked + \ XXX drop-snd needs to "wakeup" the sender + acked wbuf-drop + iack to snd_una + \ We are now finished with the packet data + + \ If all outstanding data are acked, stop + \ retransmit timer, otherwise restart timer + \ using current (possibly backed-off) value. + \ If process is waiting for space, + \ wakeup/selwakeup/signal. If data + \ are ready to send, let output + \ decide between more output or persist. + + snd_una snd_max = if tcpt_rexmt off else + tcpt_persist @ 0= if t_rxtcur tcpt_rexmt ! then then + + wbuf-actual if tcp_output then + true exit + then + false exit + then + + false +; + +: get-info ( -- ) + th_flags c@ to iflags + th_seq be-l@ to iseq + th_ack be-l@ to iack + th_win be-w@ to iwin + th_urp be-w@ to iurp +; + +: pull-options ( -- error ) + \ Handle options + th_off4 c@ 4 rshift /l* to doff ( ) + doff /tcphdr < doff ilen > or if true exit then + + doff -ilen + doff /tcphdr - dup to optlen if the-struct /tcphdr + to optp then + false +; +: update-window ( -- ) + \ Update window information. + \ Don't look at window if no ACK: TAC's send garbage on first SYN. + ack iflag? snd_wl1 iseq s< and + snd_wl1 iseq = snd_wl2 iack s< and or + snd_wl2 iack = iwin snd_wnd > and or if + \ keep track of pure window updates + \ ilen 0= snd_wl2 iack = and iwin snd_wnd > and if ( +stats ) then + iwin to snd_wnd + iseq to snd_wl1 + iack to snd_wl2 + + snd_wnd max_sndwnd > if snd_wnd to max_sndwnd then + true to needoutput + then +; + +\ Move the byte of urgent data out of the in-band data stream, +\ placing it in t_iobc. + +: pulloutofband ( -- ) + iurp 1- ( off ) \ Offset to OOB byte + idata over + ( off adr ) \ Address of OOB byte + dup c@ to t_iobc ( off adr ) \ Get OOB byte + t_oobflags havedata or to t_oobflags ( off adr ) \ Note its existence + dup ca1+ swap rot ( adr+1 adr off ) \ Setup to remove + ilen swap - 1- move ( ) \ byte from in-band data + #oob 1+ to #oob \ Note elided byte +; + +: do-urgent ( -- ) + \ Process segments with URG. + urg iflag? iurp 0<> and ts time_wait < and if + \ This is a kludge, but if we receive and accept + \ random urgent pointers, we'll crash in + \ soreceive. It's hard to imagine someone + \ actually wanting to send this much urgent data. + + iurp rbuf-actual + rbuf-len > if + 0 to iurp + urg clear-iflag + exit + then + + \ If this segment advances the known urgent pointer, + \ then mark the data stream. This should not happen + \ in CLOSE_WAIT, CLOSING, LAST_ACK or TIME_WAIT STATES since + \ a FIN has been received from the remote side. + \ In these states we ignore the URG. + \ + \ According to RFC961 (Assigned Protocols), + \ the urgent pointer points to the last octet + \ of urgent data. We continue, however, + \ to consider it to indicate the first octet + \ of data past the urgent section as the original + \ spec states (in one of two places). + + iseq iurp + rcv_up s> if + iseq iurp + to rcv_up +\ rbuf-actual rcv_up rcv_nxt - + 1- to so_oobmark + \ XXX if (so_oobmark == 0) so_state |= SS_RCVATMARK; + \ XXX sohasoutofband(so); + t_oobflags havedata haddata or invert and to t_oobflags + then + + \ Remove out of band data so doesn't get presented to user. + \ This can happen independent of advancing the URG pointer, + \ but if two URG's are pending at once, some out-of-band + \ data may creep in... ick. + + iurp ilen u<= if pulloutofband then + else + \ If no out of band data is expected, pull receive + \ urgent pointer along with the receive window. + rcv_nxt rcv_up s> if rcv_nxt to rcv_up then + then +; +: do-data ( -- ) + \ Process the segment text, merging it into the TCP sequencing queue, + \ and arranging for acknowledgment of receipt if necessary. + \ This process logically involves adjusting rcv_wnd as data + \ is presented to the user (this happens in tcp_usrreq + \ case PRU_RCVD). If a FIN has already been received on this + \ connection then we just ignore the text. + + ilen 0<> fin iflag? or ts time_wait < and if + iseq rcv_nxt = + tcpq >next-node 0<> and + ts established = and if + \ The segment need not be queued for reassembly, because + \ this is the next segment and the queue is empty. + take-data + \ XXX this is what BSD does, but it seems to me that it + \ should be "iflags" instead of "th_flags c@", because + \ it would seem that you want the FIN flag to be trimmed + \ if it is outside the receive window. + th_flags c@ fin and to iflags + else + \ Insert the segment into the reassembly queue + reassemble to iflags + set-acknow + then + + \ Note the amount of data that peer has sent into our + \ window, in order to estimate the sender's buffer size. + + \ XXX NetBSD sets this, but then doesn't use the value + \ rbuf-len rcv_adv rcv_nxt - - to len + else + fin clear-iflag + then + + \ If FIN is received ACK the FIN and let the user know + \ that the connection is closing. Ignore a FIN received before + \ the connection is fully established. + + fin iflag? ts established >= and if + ts time_wait < if + true to cantrcvmore? + set-acknow + 1 +rcv_nxt \ Advance sequence number past FIN + then + ts case + + \ In ESTABLISHED STATE enter the CLOSE_WAIT state. + established of close_wait set-state endof + + \ If still in FIN_WAIT_1 STATE FIN has not been acked so + \ enter the CLOSING state. + fin_wait_1 of closing set-state endof + + \ In FIN_WAIT_2 state enter the TIME_WAIT state, + \ starting the time-wait timer, turning off the other + \ standard timers. + + fin_wait_2 of + time_wait set-state + canceltimers + tcptv_msl 2* tcpt_2msl ! + \ soisdisconnected + endof + + \ In TIME_WAIT state restart the 2 MSL time_wait timer. + time_wait of tcptv_msl 2* tcpt_2msl ! endof + endcase + then + + \ Return any desired output. + needoutput acknow t_flag? or if tcp_output then +; +: dropafterack ( -- ) + \ Generate an ACK dropping incoming segment if it occupies + \ sequence space, where the ACK reflects our state. + rst iflag? ?exit + set-acknow + tcp_output +; + +\ Called with the-struct set to a TCP header +: respond ( ack seq flags -- ) + \ Copy to the transmit area so we can modify it + ip-struct + the-struct xmit_buf /pip - /tcphdr /pip + move + xmit_buf set-struct + + \ Now the-struct points to the copy + + ( ack seq flags ) + th_flags c! ( ack seq ) + th_seq be-l! ( ack ) + th_ack be-l! ( ) + /tcphdr 2 rshift 4 lshift th_off4 c! + rbuf-space th_win be-w! + 0 th_urp be-w! + 0 th_sum be-w! + + \ Prepare the pseudo-header for checksumming + ip-struct + ih_x1 9 erase + /tcphdr ih_len be-w! + 0 the-struct /tcphdr /pip + oc-checksum ( sum ) + tcp-struct + th_sum be-w! + + debug? if ." Xrs " .pkt then + + \ XXX this will always send to our server; it should + \ be able to send to anybody. + the-struct /tcphdr 6 " send-ip-packet" $call-parent +\ the-struct /tcphdr 6 dst-ip (send-ip-packet) +; + +: swap-addresses ( -- ) + ip-struct + ih_src unaligned-l@ ih_dst unaligned-l@ + ih_src unaligned-l! ih_dst unaligned-l! + + tcp-struct + th_sport w@ th_dport w@ th_sport w! th_dport w! +; +: ip-multicast? ( adr -- flag ) c@ h# f0 and h# e0 = ; +: multicast-dst? ( -- flag ) + ip-struct ih_dst tcp-struct ( adr ) ip-multicast? +; +/i buffer: tmp-ip +: dropwithreset ( -- ) + \ Generate a RST, dropping incoming segment. + \ Make ACK acceptable to originator of segment. + \ Don't bother to respond if destination was broadcast/multicast. + + rst iflag? ?exit + + \ XXX we also need to reject broadcast source addresses +\ m_flags bcast mcast or and ?exit + multicast-dst? ?exit + + swap-addresses + ack iflag? if + 0 iack rst + else + syn iflag? if -1 -ilen then + iseq ilen + 0 rst ack or + then ( ack seq flags ) + + his-ip-addr tmp-ip copy-ip-addr + ip-struct ih_dst set-dest-ip tcp-struct + respond ( ) + tmp-ip set-dest-ip +; + +: step6 ( -- ) + update-window + do-urgent + do-data +; +: trimthenstep6 ( -- ) + \ Advance iseq to correspond to first data byte. + \ If data, trim to stay within window, + \ dropping FIN if necessary. + iseq 1+ to iseq + ilen rcv_wnd > if + rcv_wnd to ilen + iflags fin invert and to iflags + then + iseq 1- to snd_wl1 + iseq to rcv_up + step6 +; + +\ Close a TCP control block, freeing all space +: tcp_close ( -- ) + \ Release reassmbly queue nodes + begin tcpq >next-node while tcpq dup >next-node release-tcpnode repeat + + closed set-state + false to alive? + false to abort-on-reconnect? +; + +\ Drop a TCP connection, reporting the specified error. +\ If connection is synchronized, then send a RST to peer. +: tcp_drop ( -- ) + ts syn_received >= if closed set-state tcp_output then + tcp_close +; + +: next-iss ( -- ) + tcp_iss to iss + issincr 2/ tcp_iss + to tcp_iss +; + +: do-syn-sent? ( -- done? ) + ts syn_sent <> if false exit then + + \ If the state is SYN_SENT: + \ if seg contains an ACK, but not for our SYN, drop the input. + \ if seg contains a RST, then drop the connection. + \ if seg does not contain SYN, then drop it. + \ Otherwise this is an acceptable SYN segment + \ initialize rcv_nxt and irs + \ if seg contains ack then advance snd_una + \ if SYN has been acked change to ESTABLISHED else SYN_RCVD state + \ arrange for segment to be acked (eventually) + \ continue processing rest of data/controls, beginning with URG + + ack iflag? iack iss s<= iack snd_max s> or and if + dropwithreset true exit + then + + rst iflag? if + ack iflag? if + debug" Connection refused" + tcp_drop + then \ Connection refused + true exit + then + + syn iflag? 0= if true exit then + + ack iflag? if ack-una then + + tcpt_rexmt off + iseq to irs + rcvseqinit + set-acknow + ack iflag? snd_una iss s> and if + established set-state + present-data drop + \ if we didn't have to retransmit the SYN, + \ use its rtt as our initial srtt & rtt var. + t_rtt if t_rtt xmit_timer then + else + syn_received set-state + then + + trimthenstep6 true +; + + +: ?drop-some ( -- ) + rcv_nxt iseq - dup 0<= if drop exit then ( #todrop ) + syn iflag? if + syn clear-iflag + iseq 1+ to iseq + iurp 1 > if + iurp 1- to iurp + else + urg clear-iflag + then + 1- ( #todrop' ) + then ( #todrop ) + + dup ilen >= if ( #todrop ) + \ Any valid FIN must be to the left of the + \ window. At this point, FIN must be a + \ duplicate or out-of-sequence, so drop it. + fin clear-iflag + + \ Send ACK to resynchronize, and drop any data, + \ but keep on processing for RST or ACK. + set-acknow ( #todrop ) + drop ilen ( #todrop' ) + then ( #todrop ) + + dup doff + to doff ( #todrop ) + dup iseq + to iseq ( #todrop ) + dup -ilen ( #todrop ) + iurp over > if ( #todrop ) + iurp over - to iurp ( #todrop ) + else ( #todrop ) + urg clear-iflag ( #todrop ) + 0 to iurp ( #todrop ) + then ( #todrop ) + drop ( ) +; + +: seg-after-win? ( -- done? ) + \ If segment ends after window, drop trailing data + \ (and PUSH and FIN); if nothing left, just ACK. + + iseq ilen + rcv_nxt rcv_wnd + - ( #todrop ) + dup 0<= if drop false exit then ( #todrop ) + + dup ilen >= if ( #todrop ) + \ If a new connection request is received + \ while in TIME_WAIT, drop the old connection + \ and start over if the sequence numbers + \ are above the previous ones. Otherwise, queue it + \ for later processing. + syn iflag? if + ts time_wait = iseq rcv_nxt s> and if ( #todrop ) + rcv_nxt issincr + to iss + tcp_close + \ XXX we need to find some way to get back to findpcb: + \ goto findpcb + \ XXX this is moot since a new instance of this TCP + \ package must be created in order to accept a new + \ connection. + drop true exit + else + drop false exit + then + then ( #todrop ) + + \ If window is closed can only take segments at + \ window edge, and have to drop data and PUSH from + \ incoming segments. Continue processing, but + \ remember to ack. Otherwise, drop segment and ack. + + rcv_wnd 0= iseq rcv_nxt = and if ( #todrop ) + set-acknow + else ( #todrop ) + drop dropafterack true exit + then ( #todrop ) + then ( #todrop ) + + \ Drop the extra data from the end of the packet + -ilen ( ) + th_push fin or clear-iflag ( ) + false +; + +: do-rst ( -- ) + \ If the RST bit is set examine the state: + \ SYN_RECEIVED STATE: + \ If passive open, return to LISTEN state. + \ If active open, inform user that connection was refused. + \ ESTABLISHED, FIN_WAIT_1, FIN_WAIT2, CLOSE_WAIT STATES: + \ Inform user that connection was reset, and close tcb. + \ CLOSING, LAST_ACK, TIME_WAIT STATES + \ Close the tcb. + + ts syn_received = if debug" Connection refused" closed set-state then + + ts established = + ts fin_wait_1 = or + ts fin_wait_2 = or + ts close_wait = or if debug" Connection reset" closed set-state then + + tcp_close +; + +\ Discard from the buffer the transmitted data that was acked +: release-data ( -- flag ) + acked wbuf-actual > dup if ( flag ) + snd_wnd wbuf-actual - to snd_wnd ( flag ) + wbuf-actual wbuf-drop ( flag ) + else ( flag ) + acked wbuf-drop ( flag ) + snd_wnd acked - to snd_wnd ( flag ) + then ( flag ) +; +: do-ack ( -- done? ) + ts syn_received = if + \ In SYN_RECEIVED state if the ack ACKs our SYN then enter + \ ESTABLISHED state and continue processing, otherwise + \ send an RST. + snd_una iack s> iack snd_max s> or if + dropwithreset true exit + then + established set-state + present-data drop + iseq 1- to snd_wl1 + then + + \ In ESTABLISHED and subsequent states: drop duplicate ACKs; ACK out + \ of range ACKs. If the ack is in the range + \ snd_una < iack <= snd_max + \ then advance snd_una to iack and drop + \ data from the retransmission queue. If this ACK reflects + \ more up to date window information we update our window information. + + iack snd_una s<= if + ilen 0= iwin snd_wnd = and if + \ If we have outstanding data (other than a window probe), + \ this is a completely duplicate ack (i.e., window info didn't + \ change), the ack is the biggest we've seen, and we've seen + \ exactly our rexmt threshhold of them, assume a packet + \ has been dropped and retransmit it. Kludge snd_nxt & the + \ congestion window so we send only this one packet. + \ + \ We know we're losing at the current window size so do + \ congestion avoidance (set ssthresh to half the current window + \ and pull our congestion window back to the new ssthresh). + \ + \ Dup acks mean that packets have left the network (they're now + \ cached at the receiver) so bump cwnd by the amount in the receiver + \ to keep a constant cwnd packets in the network. + + tcpt_rexmt @ 0= iack snd_una <> or if + 0 to t_dupacks + else t_dupacks 1+ dup to t_dupacks tcprexmtthresh = if + snd_nxt ( onxt ) + snd_wnd snd_cwnd min 2/ t_maxseg / 2 umax ( onxt win ) + t_maxseg u* to snd_ssthresh ( onxt ) + tcpt_rexmt off ( onxt ) + 0 to t_rtt ( onxt ) + iack set-snd_nxt ( onxt ) + t_maxseg set-cwnd ( onxt ) + tcp_output ( onxt ) + t_maxseg t_dupacks * snd_ssthresh + set-cwnd ( onxt ) + dup snd_nxt s> if set-snd_nxt else drop then ( ) + true exit + else t_dupacks tcprexmtthresh > if + snd_cwnd t_maxseg + set-cwnd + tcp_output + true exit + then then then + else + 0 to t_dupacks + then + + false exit + then + + \ If the congestion window was inflated to account + \ for the other side's cached packets, retract it. + + t_dupacks tcprexmtthresh >= + snd_cwnd snd_ssthresh > and if snd_ssthresh set-cwnd then + 0 to t_dupacks + + iack snd_max s> if dropafterack true exit then + + iack snd_una - to acked + + \ If transmit timer is running and timed sequence + \ number was acked, update smoothed round trip time. + \ Since we now have an rtt measurement, cancel the + \ timer backoff (cf., Phil Karn's retransmit alg.). + \ Recompute the initial retransmit timer. + + t_rtt 0<> iack t_rtseq s> and if t_rtt xmit_timer then + + \ If all outstanding data is acked, stop retransmit + \ timer and remember to restart (more output or persist). + \ If there is more data to be acked, restart retransmit + \ timer, using current (possibly backed-off) value. + + iack snd_max = if + tcpt_rexmt off + 1 to needoutput + else + tcpt_persist @ 0= if t_rxtcur tcpt_rexmt ! then + then + + \ When new data is acked, open the congestion window. If the window + \ gives us less than ssthresh packets in flight, open exponentially + \ (maxseg per packet). Otherwise open linearly: maxseg per window + \ (maxseg^2 / cwnd per packet), plus a constant fraction of a packet + \ (maxseg/8) to help larger windows open quickly enough. + t_maxseg + snd_cwnd snd_ssthresh u> if dup u* snd_cwnd / then ( cwnd-increment ) + snd_cwnd + maxwin min set-cwnd + + release-data to ourfinisacked? + + \ wakeup-sender + + ack-una + + ts case + + \ In FIN_WAIT_1 STATE in addition to the processing + \ for the ESTABLISHED state if our FIN is now acknowledged + \ then enter FIN_WAIT_2. + + fin_wait_1 of + ourfinisacked? if + \ If we can't receive any more data, then closing user can proceed. + \ Starting the timer is contrary to the specification, but if we + \ don't get a FIN we'll hang forever. + + cantrcvmore? if + \ XXX false to soisconnected + maxidle tcpt_2msl ! + then + fin_wait_2 set-state + then + endof + + \ In CLOSING STATE in addition to the processing for + \ the ESTABLISHED state if the ACK acknowledges our FIN + \ then enter the TIME-WAIT state, otherwise ignore + \ the segment. + + closing of + ourfinisacked? if + time_wait set-state + canceltimers + tcptv_msl 2* tcpt_2msl ! + then + endof + + \ In LAST_ACK, we may still be waiting for data to drain + \ and/or to be acked, as well as for the ack of our FIN. + \ If our FIN is now acknowledged, delete the TCB, + \ enter the closed state and return. + + last_ack of + ourfinisacked? if tcp_close true exit then + endof + + \ In TIME_WAIT state the only thing that should arrive + \ is a retransmission of the remote FIN. Acknowledge + \ it and restart the finack timer. + + time_wait of + tcptv_msl 2* tcpt_2msl ! + dropafterack true exit + endof + endcase + false +; + +: optbyte ( adr len -- adr' len' b ) 1- swap dup c@ swap 1+ -rot ; +: dooptions ( adr len -- ) + begin dup while ( adr len ) + optbyte case ( adr' len' option ) + 0 of 2drop exit endof ( adr len option ) \ EOL + 1 of 0 endof ( adr len option ) \ NOP + 2 of ( adr len ) \ MAXSEG + optbyte 2- ( adr len optlen ) + iflags syn and if ( adr len optlen ) + debug? if ." Received " then + 2 pick be-w@ tcp_mss drop ( adr len optlen ) + then ( adr len optlen ) + endof +[ifdef] notdef + 3 of ( adr len ) \ WINDOW + optbyte 2- ( adr len optlen ) + iflags syn and if ( adr len optlen ) + rcvd_scale set-flag ( adr len optlen ) + then ( adr len optlen ) + endof +[then] + ( default ) >r optbyte 2- r> ( adr len optlen option ) + endcase ( adr len optlen ) + /string ( adr' len' ) + repeat ( adr len ) + 2drop +; + +: do-listen ( -- ) + th_dport be-w@ my-tcp-port <> ?exit + rst iflag? ?exit + ack iflag? if dropwithreset exit then + syn iflag? 0= ?exit + + \ XXX we also need to reject broadcast source addresses +\ m_flags bcast mcast or and ?exit + multicast-dst? ?exit + + \ It is tempting to call "lock-ip-address", but that doesn't + \ work if the DHCP server has specified a router. + ip-struct ih_src set-dest-ip tcp-struct + + th_sport be-w@ to his-tcp-port \ Lock onto his source port + + make-template + + optp optlen dooptions + next-iss + iseq to irs + sendseqinit + rcvseqinit + set-acknow + syn_received set-state + keep_init tcpt_keep ! + trimthenstep6 +; + +\ TCP SYN queue methods + +list: tcplist +listnode + /n field >tcp-adr + /n field >tcp-len + 1 field >tcp-deq? +nodetype: tcpnode + +0 tcplist ! +0 tcpnode ! + +: free-tcpnode ( prev -- ) + delete-after + dup tcpnode free-node + dup >tcp-adr @ swap >tcp-len free-mem +; + +: tcp-deq? ( node-adr -- tcp-deq? ) >tcp-deq? c@ ; + +: purge-que ( -- ) + tcplist ['] tcp-deq? find-node if free-tcpnode else drop then +; + +: tcp-any? ( node-adr -- true ) drop true ; + +: find-first-node ( -- first-node ) tcplist ['] tcp-any? find-node nip ; + +: enque ( adr len -- ) + dup alloc-mem swap 2dup 2>r move 2r> ( adr' len ) + tcpnode allocate-node ( adr len node ) + dup tcplist last-node insert-after ( adr len node ) + tuck >tcp-len ! ( adr node ) + tuck >tcp-adr ! ( node ) + 0 swap >tcp-deq? c! ( ) +; + +\ Determines whether a node in the queue matches the packet that +\ is about to be enqued by comparing their pseudo-IP and TCP headers. +0 value test-adr +: duplicate-syn? ( node-adr -- flag ) + dup tcp-deq? if drop false exit then ( node-adr ) + >tcp-adr @ test-adr /pip /tcphdr + comp 0= ( flag ) +; + +\ Enque an incoming SYN packet unless it is a duplicate of one that +\ is already in the queue. +: ?enque ( adr len -- ) + over to test-adr + tcplist ['] duplicate-syn? find-node nip if 2drop else enque then +; + +: dequeue? ( -- 0 | adr len true ) + purge-que + find-first-node dup 0= if exit then \ nothing in queue + + ( node ) + true over >tcp-deq? c! ( node ) + dup >tcp-adr @ swap >tcp-len @ true ( adr len true ) +; + +: queue-syn ( -- ) + the-struct /pip - ilen-save /pip + ?enque + + \ If the current connection has been declared to be abortable, + \ kill it upon receipt of a new connection request. This is + \ a special hack that is used by the Swing Solutions application, + \ which has some HTTP requests that do not complete until an + \ external event occurs. The requester can abort the request + \ by dropping the TCP connection, but there are some cases where + \ the TCP drop does not appear to be propagated to the responder. + + abort-on-reconnect? if tcp_drop then +; + +: input ( adr len -- ) + 2dup sum-bad? if + show" TCHKSUM" + debug" Bad TCP checksum" 2drop exit + then ( adr len ) + dup to ilen-save to ilen set-struct ( ) + 0 to #oob + + pull-options ?exit + + get-info + + debug? if ." RCV " .pkt then + +\ findpcb: + + \ Here we should do something to ensure that the source port + \ matches this one. Perhaps that is handled by the IP layer. + + \ XXX If we get at TCP packet that doesn't match, we should do a + \ dropwithreset and exit ... + + \ When we get a packet from a port other than the one we are currently + \ talking to, we either queue it for later (if it contains a SYN), + \ or discard it. + his-tcp-port th_sport be-w@ <> if + \ If we are waiting for an incoming connection, we just fall through + \ and handle the new connection request farther down. + ts listen <> if + \ If a SYN is in the window, then we queue it and handle it + \ later, after the current transaction finishes. + syn iflag? if queue-syn then + exit + then + then + + alive? 0= if dropwithreset exit then + ts closed = ?exit + + 0 to t_idle + keepidle tcpt_keep ! + + ts listen <> if optp optlen dooptions then + + fast-path? ?exit + + \ At this point, we have handled the most common cases; + \ It gets complicated from here on out + + \ Calculate amount of space in receive window, + \ and then do TCP input processing. + \ Receive window is amount of space in rcv queue, + \ but not less than advertised window. + rcv_adv rcv_nxt - rbuf-space max to rcv_wnd + + ts listen = if do-listen exit then + + do-syn-sent? ?exit + ?drop-some + + \ If data is received after closing, RST the other end + ts close_wait > ilen 0<> and if tcp_close dropwithreset exit then + + seg-after-win? ?exit + + rst iflag? if do-rst exit then + + \ If a SYN is in the window, then it is queued until the current + \ transaction finishes cleanly. + syn iflag? if queue-syn then + + \ If the ACK bit is off we drop the segment and return. + ack iflag? 0= ?exit + + \ ACK processing + do-ack ?exit + step6 +; + +: ?receive ( -- ) + \ If the state is listen, check the queue + ts listen = if + dequeue? if ( adr len ) /pip - swap /pip + swap input exit then + then + \ Check for a new packet + 6 " receive-ip-packet" $call-parent 0= if input then +; + + +\ We accomplish the creation of a TCP control block by instantiating +\ this package +: newtcpcb ( -- ) ; + +\ d# 32 is the maximum TCP options size +/tcphdr d# 32 + mssmax + constant /xmit-max + +\ This is basically attach +: alloc-buffers ( -- ) + wbuf-allocate + d# 1024 d# 16 * to rbuf-len + rbuf-len alloc-mem to rbuf-adr + 0 to rbuf-actual + + /xmit-max " allocate-ip" $call-parent to xmit_buf +; + +: free-buffers ( -- ) + wbuf-start /wbuf free-mem + rbuf-adr rbuf-len free-mem + xmit_buf /xmit-max " free-ip" $call-parent +; + +\ User issued close, and wish to trail through shutdown states: +\ if never received SYN, just forget it. If got a SYN from peer, +\ but haven't sent FIN, then go to FIN_WAIT_1 state to send peer a FIN. +\ If already got a FIN from peer, then almost done; go to LAST_ACK +\ state. In all other cases, have already sent FIN to peer (e.g. +\ after PRU_SHUTDOWN), and just have to play tedious game waiting +\ for peer to send FIN or not respond to keep-alives, etc. +\ We can let the user exit from the close as soon as the FIN is acked. +: usrclosed ( -- ) + ts case \ action next-state + closed of tcp_close endof + listen of tcp_close endof + syn_sent of tcp_close endof + syn_received of fin_wait_1 set-state endof + established of fin_wait_1 set-state endof + close_wait of last_ack set-state endof + ( default ) \ Do nothing + endcase + + + alive? ts fin_wait_2 >= and if + \ soisdisconnected + + \ If we are in FIN_WAIT_2, we arrived here because the + \ application did a shutdown of the send side. Like the + \ case of a transition from FIN_WAIT_1 to FIN_WAIT_2 after + \ a full close, we start a timer to make sure sockets are + \ not left in FIN_WAIT_2 forever. + ts fin_wait_2 = if maxidle tcpt_2msl ! then + then +; + +\ When a source quench is received, close congestion window +\ to one segment. We will gradually open it again as we proceed. +\ XXX we probably have no way to invoke this. +\ : quench ( -- ) alive? if t_maxseg set-cwnd then ; + +\ Fast timeout routine for processing delayed acks +false instance value do-delack? +: do-delack ( -- ) + do-delack? if + t_flags delack invert and acknow or to t_flags + tcp_output + false to do-delack? + then +; +: delack-tick ( -- ) t_flags delack and 0<> to do-delack? ; \ alarm handler + +\ 2 MSL timeout in shutdown went off. If we're closed but +\ still waiting for peer to close and connection has been idle +\ too long, or if 2MSL time is up from TIME_WAIT, delete connection +\ control block. Otherwise, check again in a bit. +: do-2msl ( -- ) + debug? if ." 2msl" cr then + ts time_wait <> t_idle maxidle <= and if + keepintvl tcpt_2msl ! + else + tcp_close + then +; + +\ Retransmission timer went off. Message has not +\ been acked within retransmit interval. Back off +\ to a longer retransmit interval and retransmit one segment. +: do-rexmt ( -- ) + debug? if ." Retransmit" cr then + t_rxtshift 1+ dup to t_rxtshift maxrxtshift > if + maxrxtshift to t_rxtshift + tcp_drop + exit + then + rexmtval backoff t_rxtshift na+ @ * t_rttmin set-rxtcur + t_rxtcur tcpt_rexmt ! + +[ifdef] notdef \ We have no way to try for a better route + + \ If losing, let the lower level know and try for + \ a better route. Also, if we backed off this far, + \ our srtt estimate is probably bogus. Clobber it + \ so we'll take the next rtt measurement as our srtt; + \ move the current srtt into rttvar to keep the current + \ retransmit times until then. + + if (t_rxtshift > TCP_MAXRXTSHIFT / 4) { + in_losing(t_inpcb); + t_rttvar += (t_srtt >> TCP_RTT_SHIFT); + t_srtt = 0; + } +[then] + snd_una set-snd_nxt + + \ If timing a segment in this window, stop the timer. + 0 to t_rtt + + \ Close the congestion window down to one segment + \ (we'll open it by one segment for each ack we get). + \ Since we probably have a window's worth of unacked + \ data accumulated, this "slow start" keeps us from + \ dumping all that data as back-to-back packets (which + \ might overwhelm an intermediate gateway). + \ + \ There are two phases to the opening: Initially we + \ open by one mss on each ack. This makes the window + \ size increase exponentially with time. If the + \ window is larger than the path can handle, this + \ exponential growth results in dropped packet(s) + \ almost immediately. To get more time between + \ drops but still "push" the network to take advantage + \ of improving conditions, we switch from exponential + \ to linear window opening at some threshhold size. + \ For a threshhold, we use half the current window + \ size, truncated to a multiple of the mss. + \ + \ (the minimum cwnd that will give us exponential + \ growth is 2 mss. We don't allow the threshhold + \ to go below this.) + + snd_wnd snd_cwnd min 2/ t_maxseg / 2 max ( win ) + t_maxseg set-cwnd ( win ) + t_maxseg * to snd_ssthresh ( ) + 0 to t_dupacks + + tcp_output +; + +\ Persistance timer into zero window. +\ Force a byte to be output, if possible. +: do-persist ( -- ) + debug? if ." Persist" cr then + setpersist + true to t_force + tcp_output + false to t_force +; + +0 instance value keepalive? \ A configuration flag we can set + +\ Keep-alive timer went off; send something +\ or drop connection if idle for too long. +: do-keep ( -- ) + debug? if ." Keep" cr then + ts established < if tcp_drop exit then + keepalive? ts close_wait <= and if + t_idle keepidle maxidle + >= if tcp_drop exit then + + \ Send a packet designed to force a response if the peer is up + \ and reachable: either an ACK if the connection is still alive, + \ or an RST if the peer has closed the connection due to timeout or + \ reboot. Using sequence number snd_una-1 causes the transmitted + \ zero-length segment to lie outside the receive window; by the + \ protocol spec, this requires the correspondent TCP to respond. + + t_template to the-struct rcv_nxt snd_una 1- ack respond + keepintvl tcpt_keep ! + else + keepidle tcpt_keep ! + then +; + +: countdown? ( adr -- expired? ) + dup @ if ( adr ) + dup @ 1- ( adr count' ) + tuck swap ! 0= + else + drop false + then +; + +\ Tcp protocol timeout routine called every 500 ms. +\ Updates the timers, causing finite state machine actions when they expire. + +0 instance value protocol-timer? +: do-protocol ( -- ) + protocol-timer? 0= ?exit + false to protocol-timer? + + 8 d# 75 * pr_slowhz * to maxidle \ 8 probes at 75-second intervals + + tcpt_rexmt countdown? if do-rexmt then + tcpt_persist countdown? if do-persist then + tcpt_keep countdown? if do-keep then + tcpt_2msl countdown? if do-2msl then + + t_idle 1+ to t_idle + t_rtt if t_rtt 1+ to t_rtt then +; +: protocol-tick ( -- ) + alive? to protocol-timer? + + \ XXX If we have multiple simultaneous TCPs, we only want to + \ do this in one of them. How? + tcp_iss issincr pr_slowhz / + to tcp_iss +; + +\ Initiate connection to peer. +\ Create a template for use in transmissions on this connection. +\ Enter SYN_SENT state, and mark socket as connecting. +\ Start keep-alive timer, and seed output sequence space. +\ Send initial segment on connection. + +: start-connect ( port# -- ) + to his-tcp-port + \ XXX how do we get our local port number??? + + make-template + syn_sent set-state + keep_init tcpt_keep ! + next-iss + sendseqinit + tcp_output +; + +\ After a receive, possibly send window update to peer. +\ XXX - we need to call output after taking the receive data +\ See: case PRU_RCVD + +: tcp-abort ( -- ) tcp_drop ; + +\ Get the out-of-band data without consuming it +: peek-oob ( adr len -- actual ) + \ XXX check this; there may be some data waiting during a later state + ts established <> if 2drop -1 exit then + + t_oobflags havedata and 0= if 2drop -2 exit then + 0= if drop 0 exit then + t_iobc swap c! 1 +; + +\ Get the out-of-band data +: read-oob ( adr len -- actual ) + peek-oob ( actual ) + dup 0> if + t_oobflags havedata haddata or xor to t_oobflags + then +; + +: poll ( -- ) + do-delack do-protocol + ?receive +; + +: wbuf-set ( adr len -- ) over to wbuf-adr + to wbuf-top ; +: wbuf-add ( adr len -- #added ) + wbuf-avail min ( adr #added ) + dup if ( adr #added ) + tuck wbuf-top swap move ( #added ) + dup wbuf-top + to wbuf-top ( #added ) + else ( adr 0 ) + nip ( 0 ) + then ( #added ) +; + +: write ( adr len -- actual ) + tuck begin ( len adr remaining ) + alive? 0= if 3drop -1 exit then + 2dup wbuf-add /string ( len adr' remaining' ) + dup while ( len adr' remaining' ) + tcp_output poll ( len adr' remaining' ) + repeat ( len adr 0 ) + 2drop ( len ) +; + +\ Do a send by putting data in output queue and updating urgent +\ marker if URG set. Possibly send more data. +: write-oob ( adr len -- actual ) + \ According to RFC961 (Assigned Protocols), the urgent pointer points + \ to the last octet of urgent data. BSD makes it point to the + \ the first octet of data past the urgent section. We follow the RFC. + dup 0= if nip exit then + dup snd_una + 1- to snd_up ( adr len ) + true to t_force ( adr len ) + write ( len|-1 ) + false to t_force ( len|-1 ) +; + +: polls ( n -- ) 0 do poll d# 50 ms loop ; + +: connect ( port# -- okay? ) + true to alive? + start-connect + begin poll ts established < while + debug? if key? if key drop interact then then + alive? 0= if false exit then + repeat + true +; + +\ Other things we may need to do: +\ in_setsockaddr +\ in_setpeeraddr + +: read ( adr len -- actual ) + poll ( adr len ) + + rbuf-actual if ( adr len ) + copy-from-rbuf tcp_output exit ( actual ) + then ( adr len ) + + 2drop + ts established <> if -1 else -2 tcp_output then +; + +: init-variables ( -- ) + 0 tcpq ! + listen set-state + 0 to t_flags + d# 512 to t_maxseg + canceltimers + 0 to t_dupacks + 0 to t_force + 0 to rcv_wnd + 0 to rcv_nxt + 0 to rcv_up + 0 to irs + + 0 to snd_una + 0 to snd_nxt + 0 to snd_up + 0 to snd_wl1 + 0 to snd_wl2 + 0 to snd_wnd + 0 to iss + + 0 to rcv_adv + 0 to snd_max + maxwin to snd_cwnd + maxwin to snd_ssthresh + + 0 to t_idle + 0 to t_rtt + 0 to t_rtseq + 0 to t_srtt + 3 pr_slowhz * 2 2+ 1- lshift to t_rttvar + pr_slowhz to t_rttmin + 0 to max_sndwnd + + 0 to t_oobflags + 0 to t_iobc + + 0 to t_rxtshift + rexmtval pr_slowhz set-rxtcur + + false to do-delack? + false to keepalive? + false to protocol-timer? +; +: accept ( port# -- connected? ) + to my-tcp-port + ts closed = if + init-variables + \ Tell the IP stack to accept packets from anybody + " unlock-ip-address" $call-parent + then + true to alive? + poll + \ XXX if state is now "closed", we need to return an error code + ts established = +; + +: parse-args ( -- ) + my-args + begin dup while ( rem$ ) + ascii , left-parse-string ( rem$' head$ ) + 2dup " debug" $= if true to debug? else ( rem$' head$ ) + 2dup $set-host then ( rem$' head$ ) + 2drop + repeat + 2drop +; +: open ( -- ) + parse-args + + first-time? if + false to first-time? + " next-xid" $call-parent to tcp_iss + then + + 0 " set-timeout" $call-parent + + alloc-buffers + ['] delack-tick d# 200 alarm + + ['] protocol-tick d# 500 alarm + + h# 555 to my-tcp-port \ XXX + true to alive? + + true +; + +d# 5000 constant close-wait-ms +: drain ( -- ) + get-msecs close-wait-ms + ( msecs ) + begin ts time_wait < alive? and while ( msecs ) + poll ( msecs ) + get-msecs over - 0>= if drop exit then + repeat ( msecs ) + drop +; + +: flush-writes ( -- ) + \ If the connection is already down, just blow away any pending data + ts closed = if wbuf-clear exit then + + get-msecs + begin + wbuf-actual 0<> ( start-time flag ) + get-msecs 2 pick - d# 10000 < ( start-time flag flag ) + and ( start-time flag' ) + while ( start-time ) + tcp_output poll ( start-time ) + repeat ( start-time ) + drop ( ) + + wbuf-actual 0<> if + show" TDROP" + debug" TCP Timeout!" + wbuf-clear + then +; + +\ Close the current TCP connection and wait for the state machine +\ to make its way through the sequence of termination states. +: disconnect ( -- ) + usrclosed + flush-writes + alive? if tcp_output then + drain + alive? if tcp_close then +; + +\ external +: set-nodelay ( -- ) nodelay set-flag ; +: abort-on-reconnect ( -- ) true to abort-on-reconnect? ; +: close ( -- ) + disconnect + ['] delack-tick 0 alarm + ['] protocol-tick 0 alarm + free-buffers +; +\ LICENSE_BEGIN +\ Copyright (c) 2006 FirmWorks +\ +\ Permission is hereby granted, free of charge, to any person obtaining +\ a copy of this software and associated documentation files (the +\ "Software"), to deal in the Software without restriction, including +\ without limitation the rights to use, copy, modify, merge, publish, +\ distribute, sublicense, and/or sell copies of the Software, and to +\ permit persons to whom the Software is furnished to do so, subject to +\ the following conditions: +\ +\ The above copyright notice and this permission notice shall be +\ included in all copies or substantial portions of the Software. +\ +\ THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, +\ EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF +\ MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND +\ NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE +\ LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION +\ OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION +\ WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. +\ +\ LICENSE_END Added: ofw/inetv6/tcpapp.fth =================================================================== --- ofw/inetv6/tcpapp.fth (rev 0) +++ ofw/inetv6/tcpapp.fth 2007-08-02 21:37:59 UTC (rev 518) @@ -0,0 +1,52 @@ +\ See license at end of file +purpose: TCP application convenience words + +0 value tcp-ih +: $call-tcp ( ?? name$ -- ?? ) tcp-ih $call-method ; + +: close-tcp ( -- ) tcp-ih close-dev 0 to tcp-ih ; +: open-tcp ( -- ) + tcp-ih if exit then + " tcp" open-dev to tcp-ih + tcp-ih 0= abort" Can't open TCP/IP stack" +; +: set-tcp-server ( hostname$ -- ) + dup if " $set-host" $call-tcp else 2drop then +; +: tcp-connect ( port# -- ) + " connect" $call-tcp 0= abort" Connection refused +; +: tcp-disconnect ( -- ) " disconnect" $call-tcp ; +: open-tcp-connection ( hostname$ port# -- ) + open-tcp -rot set-tcp-server tcp-connect +; + +: tcp-read ( adr len -- actual ) " read" $call-tcp ; +: tcp-type ( adr len -- ) " write" $call-tcp drop ; + +variable tcp-out +: tcp-emit ( c -- ) tcp-out c! tcp-out 1 tcp-type ; + +\ LICENSE_BEGIN +\ Copyright (c) 2006 FirmWorks +\ +\ Permission is hereby granted, free of charge, to any person obtaining +\ a copy of this software and associated documentation files (the +\ "Software"), to deal in the Software without restriction, including +\ without limitation the rights to use, copy, modify, merge, publish, +\ distribute, sublicense, and/or sell copies of the Software, and to +\ permit persons to whom the Software is furnished to do so, subject to +\ the following conditions: +\ +\ The above copyright notice and this permission notice shall be +\ included in all copies or substantial portions of the Software. +\ +\ THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, +\ EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF +\ MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND +\ NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE +\ LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION +\ OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION +\ WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. +\ +\ LICENSE_END Added: ofw/inetv6/tcpv6.fth =================================================================== --- ofw/inetv6/tcpv6.fth (rev 0) +++ ofw/inetv6/tcpv6.fth 2007-08-02 21:37:59 UTC (rev 518) @@ -0,0 +1,2538 @@ +\ See license at end of file +purpose: TCPv6 package + +hex + +true instance value use-ipv6? + +[ifndef] show" +also forth definitions +: show" [char] " parse 2drop ; immediate +previous definitions +[then] +\ : xh 2dup type space ($header) ; ' xh is $header + +[ifndef] include-ipv4 +false instance value debug? +false instance value abort-on-reconnect? + +\ : ( postpone .( cr ; immediate +: l+! +! ; + +\ : debug" postpone ." postpone cr ; immediate +: (drop$) skipstr 2drop ; +: drop$ +level postpone (drop$) ," -level ; immediate +: debug" debug? if postpone ." postpone cr else postpone drop$ then ; immediate + +alias l>n noop +: ?exit if r> drop then ; +[then] + +d# 16 constant /ipv6 +: copy-ipv6-addr /ipv6 move ; + +[ifndef] include-ipv4 +: oc-checksum ( n adr len -- n' ) " oc-checksum" $call-parent ; + +2 constant pr_slowhz + +false instance value alive? +0 instance value the-struct + +: sfield ( offset size -- new-offset ) + create over , + + does> @ the-struct + +; + +: set-struct ( adr -- ) to the-struct ; +: +struct ( offset -- ) the-struct + set-struct ; + + +\ Check: +\ unsigned comparison +\ segment wraparound + +0 constant closed \ closed +1 constant listen \ listening for connection +2 constant syn_sent \ active, have sent syn +3 constant syn_received \ have send and received syn +\ states < ESTABLISHED are those where connections not established +4 constant established \ established +5 constant close_wait \ rcvd fin, waiting for close +\ states > CLOSE_WAIT are those where user has closed +6 constant fin_wait_1 \ have closed, sent fin +7 constant closing \ closed xchd FIN; await FIN ACK +8 constant last_ack \ had fin and close; await FIN ACK +\ states > CLOSE_WAIT && < FIN_WAIT_2 await ACK of FIN +9 constant fin_wait_2 \ have closed, fin is acked +d# 10 constant time_wait \ in 2*msl quiet wait after close + +[then] + +struct \ ipv6-pseudoheader + 2 sfield ihv6_len + 2 sfield ihv6_pr + /ipv6 sfield ihv6_src + /ipv6 sfield ihv6_dst +constant /pipv6 + +[ifndef] include-ipv4 +struct \ tcphdr + /w sfield th_sport \ source port + /w sfield th_dport \ destination port + /l sfield th_seq \ sequence number + /l sfield th_ack \ acknowledgement number + /c sfield th_off4 \ Data offset in high nibble + /c sfield th_flags +h# 01 constant fin +h# 02 constant syn +h# 04 constant rst +h# 08 constant th_push +h# 10 constant ack +h# 20 constant urg + /w sfield th_win \ window + /w sfield th_sum \ checksum + /w sfield th_urp \ urgent pointer +constant /tcphdr +[then] + +: ipv6-struct ( -- ) /pipv6 negate +struct ; +: tcpv6-struct ( -- ) /pipv6 +struct ; + +[ifndef] include-ipv4 +listnode + /n field >offset \ Offset into buf of the still-useful data + /n field >len \ Length, including out-of-band data + /n field >dlen \ Length, excluding out-of-band data + /n field >bufadr \ Buffer address + /n field >bufsize \ Total length of buffer + /l field >seq \ Sequence number + /c field >flags \ Flags +nodetype: tcpqnode + +instance variable tcpq \ Linked list of packets to be reassembled +0 tcpq ! + +3 constant tcprexmtthresh \ Retransmission threshold + +d# 512 constant mssdflt \ Default value for maximum segment size +3 constant rttdflt +pr_slowhz rttdflt * constant srttdflt \ assumed RTT if no info + +pr_slowhz d# 30 * constant tcptv_msl \ max seg lifetime (hah!) + + +d# 4096 constant mssmax \ Our (arbitrary) maximum value for + \ Maximum segment size, to conserve memory + +0 value rbuf-adr +0 value rbuf-len +0 value rbuf-actual +: rbuf-space ( -- n ) rbuf-len rbuf-actual - ; + +\ State of this TCP +0 instance value t_flags +h# 01 constant acknow \ ack peer immediately +h# 02 constant delack \ ack, but try to delay it +h# 04 constant nodelay \ don't delay packets to coalesce +h# 08 constant noopt \ don't use tcp options +h# 10 constant sentfin \ have sent FIN +0 [if] +h# 20 constant req_scale \ have/will request window scaling +h# 40 constant rcvd_scale \ other side has requested scaling +[then] + +string-array state-names + ," CLOSED" + ," LISTEN" + ," SYN_SENT" + ," SYN_RECEIVED" + ," ESTABLISHED" + ," CLOSE_WAIT" + ," FIN_WAIT_1" + ," CLOSING" + ," LAST_ACK" + ," FIN_WAIT_2" + ," TIME_WAIT" +end-string-array + +d# 512 instance value t_maxseg \ maximum segment size +0 instance value ts \ state of this connection +: set-state ( state -- ) + to ts + debug? if ts state-names count type cr then +; + +\ Timers +instance variable tcpt_rexmt tcpt_rexmt off +instance variable tcpt_persist tcpt_persist off +instance variable tcpt_keep tcpt_keep off +instance variable tcpt_2msl tcpt_2msl off + +: canceltimers ( -- ) + tcpt_rexmt off + tcpt_persist off + tcpt_keep off + tcpt_2msl off +; +0 instance value t_dupacks \ consecutive dup acks recd +0 instance value t_force \ true if forcing out a byte + +\ receive sequence variables +0 instance value rcv_wnd \ receive window +0 instance value rcv_nxt \ receive next +0 instance value rcv_up \ receive urgent pointer +0 instance value irs \ initial receive sequence number + +0 instance value rcv_adv \ advertised window + +: .flags ( flags -- ) + dup fin and if ." FIN " then + dup syn and if ." SYN " then + dup rst and if ." RST " then + dup th_push and if ." PUSH " then + dup ack and if ." ACK " then + dup urg and if ." URG " then + drop +; +: .pkt ( flags win ack seq -- ) 4drop ; +[then] + +: .pktv6 ( flags win ack seq -- ) + push-hex + ." Seq: " th_seq be-l@ 8 u.r + ." Ack: " th_ack be-l@ 8 u.r + ." Win: " th_win be-w@ 4 u.r + ." Len: " ipv6-struct ihv6_len be-w@ /tcphdr - 4 u.r tcpv6-struct + ." Flags: " th_flags c@ .flags + cr + pop-base +; +: .pkt ( flags win ack seq -- ) use-ipv6? if .pktv6 else .pkt then ; + +[ifndef] include-ipv4 +: +rcv_nxt ( n -- ) rcv_nxt + to rcv_nxt ; + +0 value wbuf-start +0 value wbuf-adr +0 value wbuf-top +0 value wbuf-end +0 value wbuf-threshold + +d# 1024 d# 16 * constant /wbuf +: wbuf-clear ( -- ) + wbuf-start /wbuf + to wbuf-end + wbuf-start dup to wbuf-adr to wbuf-top + wbuf-start /wbuf 2/ + to wbuf-threshold +; +: wbuf-allocate ( -- ) + /wbuf alloc-mem to wbuf-start + wbuf-clear +; + +: wbuf-actual ( -- n ) wbuf-top wbuf-adr - ; +: wbuf-avail ( -- n ) wbuf-end wbuf-top - ; + +\ Remove n bytes of data from the beginning of the write buffer +: wbuf-drop ( n -- ) + wbuf-adr + to wbuf-adr + \ If there are enough empty bytes at the beginning to make + \ it worthwhile to do so, copy the data down to make more + \ space at the end. + wbuf-adr wbuf-threshold >= if + wbuf-adr wbuf-start wbuf-actual move \ Copy bytes down + wbuf-actual wbuf-start + to wbuf-top \ Fix pointers + wbuf-start to wbuf-adr + then +; + +\ send sequence variables +0 instance value snd_una \ send unacknowledged +0 instance value snd_nxt \ send next +0 instance value snd_up \ send urgent pointer +0 instance value snd_wl1 \ window update seg seq number +0 instance value snd_wl2 \ window update seg ack number +0 instance value snd_wnd \ send window +1 value iss \ initial send sequence number +true value first-time? \ Used to prime iss. +1 value tcp_iss \ initial send sequence number + +0 instance value snd_max \ highest sequence number send + \ used to recognize retransmits + +d# 65535 constant maxwin \ largest value for unscaled window +d# 12 constant maxrxtshift \ maximum retransmits + +d# 120 d# 60 * pr_slowhz * + constant keepidle \ time before keepalive probes begin + +d# 75 pr_slowhz * + constant keepintvl \ time between keepalive probes + +d# 75 pr_slowhz * + constant keep_init \ initial connect keep alive + +0 instance value maxidle + +\ congestion control (for slow start, source quench, retransmit after loss) +maxwin instance value snd_cwnd \ congestion-controlled window +maxwin instance value snd_ssthresh \ snd_cwnd size threshhold for slow + \ start exponential to linear switch + +\ transmit timing stuff. See below for scale of srtt and rttvar. +\ "Variance" is actually smoothed difference. + \ Init srtt to 0, so we can tell that we have no + \ rtt estimate. Set rttvar so that srtt + 2 * rttvar gives + \ reasonable initial retransmit time. + +0 instance value t_idle \ inactivity time +0 instance value t_rtt \ round trip time +0 instance value t_rtseq \ sequence number being timed +0 instance value t_srtt \ smoothed round-trip time +3 pr_slowhz * 2 2+ 1- lshift + instance value t_rttvar \ variance in round-trip time +pr_slowhz instance value t_rttmin \ minimum rtt allowed +0 instance value max_sndwnd \ largest window peer has offered + +\ out-of-band data +0 instance value t_oobflags \ have some + 1 constant havedata + 2 constant haddata +0 instance value t_iobc \ input character +[then] + +0 instance value xmit_bufv6 + +[ifndef] include-ipv4 +\ Information about the current packet + +0 value iflags \ Copy of input packet flags +0 value iseq \ Copy of input packet sequence number +0 value iack \ Copy of input packet sequence number +0 value iwin \ Copy of input packet sequence window pointer +0 value iurp \ Copy of input packet urgent pointer +0 value ilen \ Copy of input packet length (from IP header) +0 value ilen-save \ Copy of input packet length (from IP header), unmolested + +0 value doff \ Offset to data (after options) +0 value #oob \ # of urgent data bytes elided +: idata ( -- adr ) the-struct doff + ; +: idlen ( -- len ) ilen #oob - ; +: -ilen ( n -- ) negate ilen + to ilen ; + +d# 64 pr_slowhz * constant rexmtmax +: rexmtval ( -- n ) t_srtt 3 rshift t_rttvar 2 rshift + ; + +0 instance value t_rxtshift \ log(2) of rexmt exp. backoff +rexmtval pr_slowhz max pr_slowhz d# 64 * min + instance value t_rxtcur \ current retransmit value + +: set-snd_nxt ( n -- ) to snd_nxt ; +: set-cwnd ( n -- ) to snd_cwnd debug? if ." snd_cwnd set to " snd_cwnd u. cr then ; + +: +snd_nxt ( n -- ) snd_nxt + set-snd_nxt ; + +alias seq@ be-l@ +alias len@ be-w@ + +\ Sequence numbers are 32-bit integers that use circular arithmetic +: s< ( s1 s2 -- flag ) - l>n 0< ; +: s> ( s1 s2 -- flag ) - l>n 0> ; +: s<= ( s1 s2 -- flag ) - l>n 0<= ; +: s>= ( s1 s2 -- flag ) - l>n 0>= ; + +: rcvseqinit ( -- ) irs 1+ dup to rcv_adv to rcv_nxt ; + +: sendseqinit ( -- ) + iss dup to snd_up dup to snd_max dup set-snd_nxt to snd_una +; +d# 125 d# 1024 * constant issincr \ Increments for iss each second + +[then] + +: his-ipv6-addr ( -- 'ip ) " his-ipv6-addr" $call-parent ; +: my-ipv6-addr ( -- 'ip ) " my-ipv6-addr" $call-parent ; +: $set-host ( $ -- ) " $set-host" $call-parent ; +: set-dest-ipv6 ( 'ip -- ) " set-dest-ipv6" $call-parent ; +: local-ipv6? ( -- flag ) + my-ipv6-addr his-ipv6-addr " prefix-match?" $call-parent +; + +[ifndef] include-ipv4 +0 instance value my-tcp-port +0 instance value his-tcp-port +[then] + +/tcphdr /pipv6 + instance buffer: tv6_template +: make-templatev6 ( -- ) + tv6_template set-struct + the-struct /tcphdr /pipv6 + erase + + 6 ihv6_pr be-w! \ IPPROTO_TCP + my-ipv6-addr ihv6_src copy-ipv6-addr + his-ipv6-addr ihv6_dst copy-ipv6-addr + + tcpv6-struct + + my-tcp-port th_sport be-w! + his-tcp-port th_dport be-w! + + 5 4 lshift th_off4 c! +; + +[ifndef] include-ipv4 +: copy-to-rbuf ( adr len -- ) + tuck rbuf-adr rbuf-actual + swap move ( len ) + rbuf-actual + to rbuf-actual ( ) +; +: copy-from-rbuf ( adr len -- len' ) + rbuf-actual min tuck ( len' adr len' ) + rbuf-adr -rot move ( len' ) + dup rbuf-actual = if ( len' ) + 0 to rbuf-actual ( len' ) + else ( len' ) + \ Shuffle the remaining data down in the buffer + rbuf-actual over - to rbuf-actual ( len' ) + rbuf-adr over + rbuf-adr rbuf-actual move ( len' ) + then ( len' ) +; + +\ Reassembly queue management + +: release-tcpnode ( prev this -- ) + \ Release the packet buffer + dup >bufsize @ ?dup if ( prev this len ) + over >bufadr @ swap free-mem ( prev this ) + then ( prev this ) + drop delete-after tcpqnode free-node ( ) +; + +\ Present data to caller, advancing rcv_nxt through +\ completed sequence space. +: present-data ( -- flags ) + \ Exit if we have no buffer space in which to return data + rbuf-len 0= if 0 exit then + + \ Exit if the connection is not up + ts established < if 0 exit then + + \ Exit if the queue is empty (i.e. there's no data to present) + tcpq >next-node ?dup 0= if 0 exit then ( first-node ) + + \ Exit if the data to be returned next has not yet arrived + dup >seq l@ rcv_nxt <> if drop 0 exit then ( first-node ) + + \ Exit if we're not quite connected + \ This can't happen because of the earlier check for ts=established +\ dup >dlen @ 0<> ts syn_received = and if drop 0 exit then ( node ) + + begin ( node ) + dup >flags c@ fin and swap ( flags node ) + + \ Compute the copy length + dup >dlen @ rbuf-len min ( flags node len ) + + \ Update rcv_nxt in sequence space, which include out-of-band data. + \ If len > dlen, the difference represents removed out-of-band data. + 2dup over >len @ rot >dlen @ - + +rcv_nxt ( flags node len ) + + \ Copy the data into the user buffer + over dup >bufadr @ swap >offset @ + ( flags node len adr ) + over copy-to-rbuf ( flags node len ) + + \ "remove" the data from the list node + 2dup negate swap 2dup >dlen +! >len +! ( flags node len ) + + \ If we haven't consumed all the data in this node, update + \ its variables and exit. + over >dlen @ if ( flags node len ) + 2dup swap >seq l+! ( flags node len ) + 2dup swap >offset +! ( flags node len ) + + \ There is no point in continuing, as the user buffer must be + \ full (otherwise we would have consumed all the node data). + 2drop exit + then ( flags node len ) + + \ We have used all the node's data, so we can release the node. + drop ( flags node ) + + \ Release the node and its buffer + tcpq swap release-tcpnode ( flags ) + + \ If the user buffer is full, we can exit now + rbuf-len 0= ?exit ( flags ) + + \ Otherwise advance to the next node + tcpq >next-node ( flags node ) + ?dup while ( flags node ) + nip ( node ) + repeat ( flags ) +; + + +0 value trim-offset \ "local" variable used for reassembly queue insertion + +\ If there is a preceding segment, it may provide some of +\ our data already. If so, drop the data from the incoming +\ segment. If it provides all of our data, drop us. +: ?trim-prev ( prev -- enclosed? ) + 0 to trim-offset + dup tcpq = if drop false exit then ( prev ) + dup >seq l@ swap >len l@ + iseq - l>n \ Wraparound ( n ) + + \ Exit if the segments don't overlap + dup 0<= if drop false exit then ( n ) + + \ Return true if the new packet is enclosed by the old segment + dup ilen >= if drop true exit then ( n ) + + \ Otherwise trim the packet. + dup to trim-offset ( n ) + dup iseq + l>n to iseq ( n ) + -ilen +; +: ?trim-nexts ( prev this -- prev this' ) + begin dup while ( prev node ) + iseq ilen + over >seq l@ - l>n ( prev node n ) + + \ Exit if no overlap + dup 0<= if 3drop exit then ( prev node n ) + + 2dup swap >len @ < if ( prev node n ) + \ Partial overlap - trim node and exit + 2dup negate swap >len +! ( prev node n ) + 2dup swap >seq l+! ( prev node n ) + 2dup swap >offset l+! ( prev node ) + exit + then ( prev node n ) + \ Complete overlap - discard node ( prev node n ) + drop ( prev node ) + 2dup >next-node 2swap ( prev next prev node ) + release-tcpnode ( prev next ) + repeat ( prev next ) +; +: new-node ( -- ) + tcpqnode allocate-node ( new ) + 0 over >offset ! ( new ) + ilen over >len ! ( new ) + idlen over >dlen ! ( new ) + iseq over >seq l! ( new ) + \ XXX this is what BSD does, but it seems to me that it + \ should be "iflags" instead of "th_flags c@", because + \ it would seem that you want the FIN flag to be trimmed + \ if it is outside the receive window. + th_flags c@ over >flags c! ( new ) + idlen over >bufsize ! ( new ) + idlen if ( new ) + idlen alloc-mem ( new buf ) + 2dup swap >bufadr ! ( new buf ) + idata trim-offset + swap ilen move ( new ) + then ( new ) +; +: next-seg ( node-data-adr -- flag ) >seq l@ iseq - 0> ; +: reassemble ( -- flags ) + tcpq ['] next-seg find-node ( prev-node this-node|0 ) + over ?trim-prev if 2drop 0 exit then ( prev this ) + ?trim-nexts ( prev this ) + + \ Create a new fragment queue entry and insert it into place + drop new-node ( prev new ) + swap insert-after ( ) + + present-data +; + +[then] + +\ End of reassembly queue management + +\ Assumes active struct is set to the TCP header + +\ For now we assume no IP options; the IP layer should probably +\ strip them for us anyway + +: sumv6-bad? ( adr len -- flag ) + swap /pipv6 - set-struct ( len ) + dup ihv6_len be-w! ( len ) \ Put length field back + 6 ihv6_pr be-w! ( len ) \ TCP protocol + 0 the-struct rot /pipv6 + oc-checksum h# ffff <> +; + +[ifndef] include-ipv4 +0 value optp 0 value optlen +0 value acked +0 value needoutput +0 value cantrcvmore? + +: set-flag ( bitmask -- ) t_flags or to t_flags ; +: set-acknow ( -- ) acknow set-flag ; +: clear-iflag ( flag -- ) iflags swap invert and to iflags ; +: iflag? ( bitmask -- ) iflags and 0<> ; +: t_flag? ( bitmask -- ) t_flags and 0<> ; +: take-data ( -- ) + ilen +rcv_nxt + + \ Set DELACK for segments received in order, but ack immediately + \ when segments are out of order (so fast retransmit can work). + idata idlen copy-to-rbuf + iflags th_push and if acknow else delack then set-flag +; + +: set-rxtcur ( val limit -- ) max rexmtmax min to t_rxtcur ; + +\ Collect new round-trip time estimate +\ and update averages and current timeout +: xmit_timer ( rtt -- ) + 1- ( rtt ) + t_srtt if ( rtt ) + \ srtt is stored as fixed point with 3 bits after the + \ binary point (i.e., scaled by 8). The following magic + \ is equivalent to the smoothing algorithm in rfc793 with + \ an alpha of .875 (srtt = rtt/8 + srtt*7/8 in fixed + \ point). Adjust rtt to origin 0. + dup 2 lshift t_srtt 3 rshift - ( rtt delta ) + dup t_srtt + 1 max to t_srtt ( rtt delta ) + + \ We accumulate a smoothed rtt variance (actually, a + \ smoothed mean difference), then set the retransmit + \ timer to smoothed rtt + 4 times the smoothed variance. + \ rttvar is stored as fixed point with 2 bits after the + \ binary point (scaled by 4). The following is + \ equivalent to rfc793 smoothing with an alpha of .75 + \ (rttvar = rttvar*3/4 + |delta| / 4). This replaces + \ rfc793's wired-in beta. + abs t_rttvar 2 rshift - ( rtt delta' ) + 1 max to t_rttvar ( rtt ) + else + \ No rtt measurement yet - use the unsmoothed rtt. + \ Set the variance to half the rtt (so our first + \ retransmit happens at 3*rtt). + dup 5 lshift to t_srtt ( rtt ) ( 5 is 3 + 2 ) + dup 3 lshift to t_rttvar ( rtt ) + then ( rtt ) + 0 to t_rtt ( rtt ) + 0 to t_rxtshift ( rtt ) + + \ the retransmit should happen at rtt + 4 * rttvar. + \ Because of the way we do the smoothing, srtt and rttvar + \ will each average +1/2 tick of bias. When we compute + \ the retransmit timer, we want 1/2 tick of rounding and + \ 1 extra tick because of +-1/2 tick uncertainty in the + \ firing of the timer. The bias will give us exactly the + \ 1.5 tick we need. But, because the bias is + \ statistical, we have to test that we don't drop below + \ the minimum feasible timer (which is 2 ticks). + + 2+ rexmtval set-rxtcur +; + +: ack-una ( -- ) + iack to snd_una + snd_nxt snd_una s< if snd_una set-snd_nxt then +; +[then] + +\ Determine a reasonable value for maxseg size. +\ If the route is known, check route for mtu. +\ If none, use an mss that can be handled on the outgoing +\ interface without forcing IP to fragment; if bigger than +\ an mbuf cluster (MCLBYTES), round down to nearest multiple of MCLBYTES +\ to utilize large mbufs. If no route is found, route has no mtu, +\ or the destination isn't local, use a default, hopefully conservative +\ size (usually 512 or the default IP max size, but no more than the mtu +\ of the interface), as we can't discover anything about intervening +\ gateways or networks. We also initialize the congestion/slow start +\ window to be a single segment if the destination isn't local. +\ While looking at the routing entry, we also initialize other path-dependent +\ parameters from pre-set or cached values in the routing entry. + +: tcp_mssv6 ( offer -- chosen ) + \ XXX we probably should try to first determine whether or not we + \ know anything about the route, and if not, just return mssdflt + + \ Use link MTU on a LAN, otherwise use a conservative default + \ not larger than the link MTU + + " max-ipv6-payload" $call-parent /tcphdr - ( offer limit ) + mssmax min ( offer limit ) + local-ipv6? 0= if mssdflt min then ( offer limit ) + + \ If offer is nonzero, use the computed value, otherwise use the + \ smaller of the offer and the computed value. + over if over min then ( offer chosen ) + + \ But in all cases, use at least 32 bytes + d# 32 max ( offer chosen' ) + + \ If this results in a smaller segment size than we're currently + \ using, or if offer is nonzero, then reduce the current size. + dup t_maxseg < rot 0<> or if ( chosen ) + dup to t_maxseg ( chosen ) + debug? if ." Maxseg set to " t_maxseg u. cr then + then ( chosen ) + + \ Set the slow-open window size + dup set-cwnd ( chosen ) +; + +[ifndef] include-ipv4 + +\ Output code + +0 value len +0 value ourfinisacked? + +0 value idle? +0 value sendalot? + +\ Flags used when sending segments in tcp_output. +\ Basic flags (TH_RST,TH_ACK,TH_SYN,TH_FIN) are totally +\ determined by state, with the proviso that TH_FIN is sent only +\ if all data queued for output is included in the segment. +create outflags + rst ack or c, \ 0 closed + 0 c, \ 1 listen + syn c, \ 2 syn_sent + syn ack or c, \ 3 syn_received + ack c, \ 4 established + ack c, \ 5 close_wait + fin ack or c, \ 6 fin_wait_1 + fin ack or c, \ 7 closing + fin ack or c, \ 8 last_ack + ack c, \ 9 fin_wait_2 + ack c, \ 10 time_wait + +0 value oflags +: oflag? ( bitmask -- flag ) oflags and 0<> ; +: fin-off ( -- ) oflags fin invert and to oflags ; + +create backoff +base @ decimal + 1 , 2 , 4 , 8 , 16 , 32 , 64 , 64 , 64 , 64 , 64 , 64 , 64 , +base ! + +pr_slowhz 5 * constant persmin +pr_slowhz d# 60 * constant persmax + +: setpersist ( -- ) + t_srtt 2 rshift t_rttvar + 1 rshift ( t ) + + \ Start/restart persistance timer. + backoff t_rxtshift na+ @ * ( t*backoff ) + + persmin max persmax min tcpt_persist ! + + t_rxtshift 1+ maxrxtshift min to t_rxtshift +; + +0 value win +0 value offs +: dont-send? ( -- exit? ) + false + + \ Sender silly window avoidance. If connection is idle and can send + \ all data, a maximum segment, at least a maximum default-size segment + \ do it, or are forced, do it; otherwise don't bother. + \ If peer's buffer is tiny, then send when window is at least half open. + \ If retransmitting (possibly after persist timer forced us + \ to send into a small window), then must resend. + + len if + len t_maxseg = ?exit + + idle? nodelay t_flag? or len offs + wbuf-actual >= and ?exit + + t_force ?exit + + len max_sndwnd 2/ >= ?exit + + snd_nxt snd_max s< ?exit + then + + \ Compare available window to amount of window known to peer (as + \ advertised window less next expected input). If the difference + \ is at least two max size segments, or at least 50% of the maximum + \ possible window, then want to send a window update to peer. + + win 0> if + \ "adv" is the amount we can increase the window, + \ taking into account that we are limited by MAXWIN + + maxwin win min rcv_adv rcv_nxt - - ( adv ) + dup t_maxseg 2* >= if drop exit then ( adv ) + + 2* rbuf-len >= ?exit ( ) + then + + \ Send if we owe peer an ACK. + + acknow t_flag? ?exit + syn rst or oflag? ?exit + snd_up snd_una s> ?exit + + \ If our state indicates that FIN should be sent + \ and we have not yet done so, or we're retransmitting the FIN, + \ then we need to send. + + fin oflag? + sentfin t_flag? 0= snd_nxt snd_una = or and ?exit + + \ TCP window updates are not reliable, rather a polling protocol + \ using ``persist'' packets is used to insure receipt of window + \ updates. The three ``states'' for the output side are: + \ idle not doing retransmits or persists + \ persisting to move a small or zero window + \ (re)transmitting and thereby not persisting + \ + \ TCPT_PERSIST is set when we are in persist state. + \ t_force is set when we are called to send a persist packet. + \ TCPT_REXMT is set when we are retransmitting + \ + \ The output side is idle when both timers are zero. + \ + \ If send window is too small, there is data to transmit, and no + \ retransmit or persist is pending, then go to persist state. + \ If nothing happens soon, send when timer expires: + \ if window is nonzero, transmit what we can, otherwise force out a byte. + + wbuf-actual 0<> tcpt_rexmt @ 0= and tcpt_persist @ 0= and if + 0 to t_rxtshift + setpersist + then + + drop true +; + +\ TCP output routine: figure out what should be sent and send it. +d# 32 buffer: opt +0 value hdrlen +[then] + +: make-optionsv6 ( -- ) + \ Before ESTABLISHED, force sending of initial options + \ unless TCP set not to do any options. + \ NOTE: we assume that we have space for the IP/TCP header plus TCP + \ options, leaving room for a maximum link header, i.e. + \ max_linkhdr + sizeof (struct tcpiphdr) + optlen <= buflen + + 0 to optlen + /tcphdr to hdrlen + syn oflag? if + iss set-snd_nxt + noopt t_flag? 0= if + 2 opt c! \ tcpopt_maxseg + 4 opt 1+ c! \ option length + debug? if ." Sending " then + 0 tcp_mssv6 opt 2+ be-w! \ option value + 4 to optlen + then + then + + optlen hdrlen + to hdrlen + + \ Adjust data length if insertion of options will + \ bump the packet length beyond the t_maxseg length. + + len t_maxseg optlen - > if + t_maxseg optlen - to len + fin-off + true to sendalot? + then +; + +: insert-datav6 ( -- ) + \ Grab a transmit buffer, attaching a copy of data to + \ be transmitted, and initialize the header from + \ the template for sends on this connection. + + xmit_bufv6 set-struct + + len if + wbuf-adr offs + xmit_bufv6 hdrlen + len move + + \ If we're sending everything we've got, set PUSH. + \ (This will keep happy those implementations which only + \ give data to the user when a buffer fills or + \ a PUSH comes in.) + + offs len + wbuf-actual = + len snd_cwnd = or \ Also PUSH when we have a lot + if + oflags th_push or to oflags + then + then +; + +[ifndef] include-ipv4 +: set-window ( -- ) + \ Calculate receive window. Don't shrink window, + \ but avoid silly window syndrome. + + win rbuf-len 4 / < win t_maxseg < and if 0 to win then + + win maxwin min rcv_adv rcv_nxt - max th_win be-w! + + snd_up snd_nxt s> if + snd_up snd_nxt - th_urp be-w! + th_flags c@ urg or th_flags c! + else + \ If no urgent pointer to send, then we pull + \ the urgent pointer to the left edge of the send window + \ so that it doesn't drift into the send window on sequence + \ number wraparound. + snd_una to snd_up + then +; +: set-timers ( -- ) + \ In transmit state, time the transmission and arrange for + \ the retransmit. In persist state, just set snd_max. + + t_force 0= tcpt_persist @ 0= or if + snd_nxt ( startseq ) + + \ Advance snd_nxt over sequence space of this segment. + + syn oflag? if 1 +snd_nxt then + fin oflag? if 1 +snd_nxt sentfin set-flag then + + len +snd_nxt + + snd_nxt snd_max s> if + snd_nxt to snd_max + + \ Time this transmission if not a retransmission and + \ not currently timing anything. + t_rtt 0= if 1 to t_rtt dup to t_rtseq then ( startseq ) + then + + \ We're done with startseq + drop ( ) + + \ Set retransmit timer if not currently set, + \ and not doing an ack or a keep-alive probe. + \ Initial value for retransmit timer is smoothed + \ round-trip time + 2 * round-trip time variance. + \ Initialize shift counter which is used for backoff + \ of retransmit time. + + tcpt_rexmt @ 0= snd_nxt snd_una <> and if + t_rxtcur tcpt_rexmt ! + tcpt_persist @ if tcpt_persist off 0 to t_rxtshift then + then + else + snd_nxt len + snd_max s> if snd_nxt len + to snd_max then + then +; +: send ( -- ) ; +[then] + +\ Called only from tcp_output +: sendv6 ( -- ) + make-optionsv6 + + insert-datav6 + + tv6_template xmit_bufv6 /pipv6 - /tcphdr /pipv6 + move \ Copy in header + + \ Fill in fields, remembering maximum advertised + \ window for use in delaying messages about window sizes. + \ If resending a FIN, be sure not to use a new sequence number. + + fin oflag? sentfin t_flag? and + snd_nxt snd_max = and if -1 +snd_nxt then + + \ If we are doing retransmissions, then snd_nxt will not reflect the first + \ unsent octet. For ACK only packets, we do not want the sequence number + \ of the retransmitted packet, we want the sequence number of the next + \ unsent octet. So, if there is no data (and no SYN or FIN), use snd_max + \ instead of snd_nxt when filling in iseq. But if we are in persist + \ state, snd_max might reflect one byte beyond the right edge of the + \ window, so use snd_nxt in that case, since we know we aren't doing a + \ retransmission. (retransmit and persist are mutually exclusive...) + + len 0<> syn fin or oflag? or tcpt_persist @ 0<> or if + snd_nxt + else + snd_max + then + th_seq be-l! + + rcv_nxt th_ack be-l! + optlen if + opt the-struct /tcphdr + optlen move + /tcphdr optlen + 2 rshift 4 lshift th_off4 c! + then + + oflags th_flags c! + + set-window + + \ Put TCP length in extended header, and then + \ checksum extended header and data. + + ipv6-struct + 6 ihv6_pr be-w! + /tcphdr optlen + len + ihv6_len be-w! ( ) + 0 the-struct hdrlen len + /pipv6 + oc-checksum ( sum ) + tcpv6-struct ( sum ) + th_sum be-w! ( ) + + set-timers + + debug? if ." XMT " .pkt then + + \ Send to IP level. + + the-struct hdrlen len + 6 " send-ipv6-packet" $call-parent \ 6 is IPPROTO_TCP + + \ Data sent (as far as we can tell). + \ If this advertises a larger window than any other segment, + \ then remember the size of the advertised window. + \ Any pending ACK has now been sent. + + win 0> rcv_nxt win + rcv_adv s> and if + rcv_nxt win + to rcv_adv + then + t_flags acknow delack or invert and to t_flags +; + +: tcp_outputv6 ( -- ) + \ Determine length of data that should be transmitted, + \ and flags that will be used. + \ If there is some data or critical controls (SYN, RST) + \ to send, then transmit; otherwise, investigate further. + + snd_max snd_una = to idle? + idle? t_idle t_rxtcur >= and if + \ We have been idle for "a while" and no acks are expected to clock out + \ any data we send -- slow start to get ack "clock" running again. + t_maxseg set-cwnd + then + begin + false to sendalot? + snd_nxt snd_una - to offs + snd_wnd snd_cwnd min to win + outflags ts ca+ c@ to oflags + + \ If in persist timeout with window of 0, send 1 byte. + \ Otherwise, if window is small but nonzero and timer expired, + \ we will send what we can and go to transmit state. + + t_force if + win if + tcpt_persist off + 0 to t_rxtshift + else + \ If we still have some data to send, then clear the FIN bit. + \ Usually this would happen below when it realizes that we + \ aren't sending all the data. However, if we have exactly + \ 1 byte of unset data, then it won't clear the FIN bit below, + \ and if we are in persist state, we wind up sending the packet + \ without recording that we sent the FIN bit. + \ + \ We can't just blindly clear the FIN bit, because if we don't + \ have any more data to send then the probe will be the FIN itself. + off wbuf-actual < if fin-off then + 1 to win + then + then + + win wbuf-actual < if fin-off win else wbuf-actual then ( n ) + offs - to len + + len 0< if + \ If FIN has been sent but not acked, but we haven't been called + \ to retransmit, len will be -1. Otherwise, window shrank + \ after we sent into it. If window shrank to 0, cancel pending + \ retransmit and pull snd_nxt back to (closed) window. We will + \ enter persist state below. If the window didn't close completely, + \ just wait for an ACK. + 0 to len + win 0= if tcpt_rexmt off snd_una set-snd_nxt then + then + + len t_maxseg > if t_maxseg to len fin-off true to sendalot? then + + rbuf-space to win + + dont-send? ?exit + + sendv6 + sendalot? 0= until +; + +: fast-pathv6? ( -- flag ) + \ Header prediction: check for the two common cases + \ of a uni-directional data xfer. If the packet has + \ no control flags, is in-sequence, the window didn't + \ change and we're not retransmitting, it's a + \ candidate. If the length is zero and the ack moved + \ forward, we're the sender side of the xfer. Just + \ free the data acked & wake any higher level process + \ that was blocked waiting for space. If the length + \ is non-zero and the ack didn't move, we're the + \ receiver side. If we're getting packets in-order + \ (the reassembly queue is empty), add the data to + \ the socket buffer and note that we need a delayed ack. + + ts established = \ Connection up? + iflags h# 37 and ack = and \ No control flags? + iseq rcv_nxt = and \ In sequence? + iwin 0<> and \ Window didn't change? + iwin snd_wnd = and \ Window didn't change? + snd_nxt snd_max = and if \ Not retransmitting? + ilen if + \ Incoming data + + iack snd_una = \ in sequence data packet? + tcpq >next-node 0= and \ reassembly queue empty? + ilen rbuf-space <= and if \ enough space to take it? + take-data + true exit + then + false exit + then + + \ ACK for outgoing data + + iack snd_una - 0> + iack snd_max - 0<= and + snd_cwnd snd_wnd >= and + t_dupacks tcprexmtthresh < and if + \ This is a pure ack for outstanding data + t_rtt 0<> iack t_rtseq - 0> and if + t_rtt xmit_timer + then + iack snd_una - to acked + \ XXX drop-snd needs to "wakeup" the sender + acked wbuf-drop + iack to snd_una + \ We are now finished with the packet data + + \ If all outstanding data are acked, stop + \ retransmit timer, otherwise restart timer + \ using current (possibly backed-off) value. + \ If process is waiting for space, + \ wakeup/selwakeup/signal. If data + \ are ready to send, let output + \ decide between more output or persist. + + snd_una snd_max = if tcpt_rexmt off else + tcpt_persist @ 0= if t_rxtcur tcpt_rexmt ! then then + + wbuf-actual if tcp_outputv6 then + true exit + then + false exit + then + + false +; + +[ifndef] include-ipv4 +: get-info ( -- ) + th_flags c@ to iflags + th_seq be-l@ to iseq + th_ack be-l@ to iack + th_win be-w@ to iwin + th_urp be-w@ to iurp +; + +: pull-options ( -- error ) + \ Handle options + th_off4 c@ 4 rshift /l* to doff ( ) + doff /tcphdr < doff ilen > or if true exit then + + doff -ilen + doff /tcphdr - dup to optlen if the-struct /tcphdr + to optp then + false +; +: update-window ( -- ) + \ Update window information. + \ Don't look at window if no ACK: TAC's send garbage on first SYN. + ack iflag? snd_wl1 iseq s< and + snd_wl1 iseq = snd_wl2 iack s< and or + snd_wl2 iack = iwin snd_wnd > and or if + \ keep track of pure window updates + \ ilen 0= snd_wl2 iack = and iwin snd_wnd > and if ( +stats ) then + iwin to snd_wnd + iseq to snd_wl1 + iack to snd_wl2 + + snd_wnd max_sndwnd > if snd_wnd to max_sndwnd then + true to needoutput + then +; + +\ Move the byte of urgent data out of the in-band data stream, +\ placing it in t_iobc. + +: pulloutofband ( -- ) + iurp 1- ( off ) \ Offset to OOB byte + idata over + ( off adr ) \ Address of OOB byte + dup c@ to t_iobc ( off adr ) \ Get OOB byte + t_oobflags havedata or to t_oobflags ( off adr ) \ Note its existence + dup ca1+ swap rot ( adr+1 adr off ) \ Setup to remove + ilen swap - 1- move ( ) \ byte from in-band data + #oob 1+ to #oob \ Note elided byte +; + +: do-urgent ( -- ) + \ Process segments with URG. + urg iflag? iurp 0<> and ts time_wait < and if + \ This is a kludge, but if we receive and accept + \ random urgent pointers, we'll crash in + \ soreceive. It's hard to imagine someone + \ actually wanting to send this much urgent data. + + iurp rbuf-actual + rbuf-len > if + 0 to iurp + urg clear-iflag + exit + then + + \ If this segment advances the known urgent pointer, + \ then mark the data stream. This should not happen + \ in CLOSE_WAIT, CLOSING, LAST_ACK or TIME_WAIT STATES since + \ a FIN has been received from the remote side. + \ In these states we ignore the URG. + \ + \ According to RFC961 (Assigned Protocols), + \ the urgent pointer points to the last octet + \ of urgent data. We continue, however, + \ to consider it to indicate the first octet + \ of data past the urgent section as the original + \ spec states (in one of two places). + + iseq iurp + rcv_up s> if + iseq iurp + to rcv_up +\ rbuf-actual rcv_up rcv_nxt - + 1- to so_oobmark + \ XXX if (so_oobmark == 0) so_state |= SS_RCVATMARK; + \ XXX sohasoutofband(so); + t_oobflags havedata haddata or invert and to t_oobflags + then + + \ Remove out of band data so doesn't get presented to user. + \ This can happen independent of advancing the URG pointer, + \ but if two URG's are pending at once, some out-of-band + \ data may creep in... ick. + + iurp ilen u<= if pulloutofband then + else + \ If no out of band data is expected, pull receive + \ urgent pointer along with the receive window. + rcv_nxt rcv_up s> if rcv_nxt to rcv_up then + then +; +[then] + +: do-datav6 ( -- ) + \ Process the segment text, merging it into the TCP sequencing queue, + \ and arranging for acknowledgment of receipt if necessary. + \ This process logically involves adjusting rcv_wnd as data + \ is presented to the user (this happens in tcp_usrreq + \ case PRU_RCVD). If a FIN has already been received on this + \ connection then we just ignore the text. + + ilen 0<> fin iflag? or ts time_wait < and if + iseq rcv_nxt = + tcpq >next-node 0<> and + ts established = and if + \ The segment need not be queued for reassembly, because + \ this is the next segment and the queue is empty. + take-data + \ XXX this is what BSD does, but it seems to me that it + \ should be "iflags" instead of "th_flags c@", because + \ it would seem that you want the FIN flag to be trimmed + \ if it is outside the receive window. + th_flags c@ fin and to iflags + else + \ Insert the segment into the reassembly queue + reassemble to iflags + set-acknow + then + + \ Note the amount of data that peer has sent into our + \ window, in order to estimate the sender's buffer size. + + \ XXX NetBSD sets this, but then doesn't use the value + \ rbuf-len rcv_adv rcv_nxt - - to len + else + fin clear-iflag + then + + \ If FIN is received ACK the FIN and let the user know + \ that the connection is closing. Ignore a FIN received before + \ the connection is fully established. + + fin iflag? ts established >= and if + ts time_wait < if + true to cantrcvmore? + set-acknow + 1 +rcv_nxt \ Advance sequence number past FIN + then + ts case + + \ In ESTABLISHED STATE enter the CLOSE_WAIT state. + established of close_wait set-state endof + + \ If still in FIN_WAIT_1 STATE FIN has not been acked so + \ enter the CLOSING state. + fin_wait_1 of closing set-state endof + + \ In FIN_WAIT_2 state enter the TIME_WAIT state, + \ starting the time-wait timer, turning off the other + \ standard timers. + + fin_wait_2 of + time_wait set-state + canceltimers + tcptv_msl 2* tcpt_2msl ! + \ soisdisconnected + endof + + \ In TIME_WAIT state restart the 2 MSL time_wait timer. + time_wait of tcptv_msl 2* tcpt_2msl ! endof + endcase + then + + \ Return any desired output. + needoutput acknow t_flag? or if tcp_outputv6 then +; +: dropafterackv6 ( -- ) + \ Generate an ACK dropping incoming segment if it occupies + \ sequence space, where the ACK reflects our state. + rst iflag? ?exit + set-acknow + tcp_outputv6 +; + +\ Called with the-struct set to a TCP header +: respondv6 ( ack seq flags -- ) + \ Copy to the transmit area so we can modify it + ipv6-struct + the-struct xmit_bufv6 /pipv6 - /tcphdr /pipv6 + move + xmit_bufv6 set-struct + + \ Now the-struct points to the copy + + ( ack seq flags ) + th_flags c! ( ack seq ) + th_seq be-l! ( ack ) + th_ack be-l! ( ) + /tcphdr 2 rshift 4 lshift th_off4 c! + rbuf-space th_win be-w! + 0 th_urp be-w! + 0 th_sum be-w! + + \ Prepare the pseudo-header for checksumming + ipv6-struct + 6 ihv6_pr be-w! + /tcphdr ihv6_len be-w! + 0 the-struct /tcphdr /pipv6 + oc-checksum ( sum ) + tcpv6-struct + th_sum be-w! + + debug? if ." Xrs " .pkt then + + \ XXX this will always send to our server; it should + \ be able to send to anybody. + the-struct /tcphdr 6 " send-ip-packet" $call-parent +\ the-struct /tcphdr 6 dst-ip (send-ip-packet) +; + +: swap-addressesv6 ( -- ) + ipv6-struct + ihv6_src unaligned-l@ ihv6_dst unaligned-l@ + ihv6_src unaligned-l! ihv6_dst unaligned-l! + + tcpv6-struct + th_sport w@ th_dport w@ th_sport w! th_dport w! +; +: multicast-dstv6? ( -- flag ) + ipv6-struct ihv6_dst tcpv6-struct ( adr ) " his-mc-ipv6-addr?" $call-parent +; +/ipv6 buffer: tmp-ipv6 +: dropwithresetv6 ( -- ) + \ Generate a RST, dropping incoming segment. + \ Make ACK acceptable to originator of segment. + \ Don't bother to respond if destination was broadcast/multicast. + + rst iflag? ?exit + + \ XXX we also need to reject broadcast source addresses +\ m_flags bcast mcast or and ?exit + multicast-dstv6? ?exit + + swap-addressesv6 + ack iflag? if + 0 iack rst + else + syn iflag? if -1 -ilen then + iseq ilen + 0 rst ack or + then ( ack seq flags ) + + his-ipv6-addr tmp-ipv6 copy-ipv6-addr + ipv6-struct ihv6_dst set-dest-ipv6 tcpv6-struct + respondv6 ( ) + tmp-ipv6 set-dest-ipv6 +; + +: step6v6 ( -- ) + update-window + do-urgent + do-datav6 +; + +: trimthenstep6v6 ( -- ) + \ Advance iseq to correspond to first data byte. + \ If data, trim to stay within window, + \ dropping FIN if necessary. + iseq 1+ to iseq + ilen rcv_wnd > if + rcv_wnd to ilen + iflags fin invert and to iflags + then + iseq 1- to snd_wl1 + iseq to rcv_up + step6v6 +; + +\ Close a TCP control block, freeing all space +: tcp_close ( -- ) + \ Release reassmbly queue nodes + begin tcpq >next-node while tcpq dup >next-node release-tcpnode repeat + + closed set-state + false to alive? + false to abort-on-reconnect? +; +[then] + +\ Drop a TCP connection, reporting the specified error. +\ If connection is synchronized, then send a RST to peer. +: tcp_drop ( -- ) + ts syn_received >= if closed set-state tcp_outputv6 then + tcp_close +; + +[ifndef] include-ipv4 +: next-iss ( -- ) + tcp_iss to iss + issincr 2/ tcp_iss + to tcp_iss +; +[then] + +: do-syn-sentv6? ( -- done? ) + ts syn_sent <> if false exit then + + \ If the state is SYN_SENT: + \ if seg contains an ACK, but not for our SYN, drop the input. + \ if seg contains a RST, then drop the connection. + \ if seg does not contain SYN, then drop it. + \ Otherwise this is an acceptable SYN segment + \ initialize rcv_nxt and irs + \ if seg contains ack then advance snd_una + \ if SYN has been acked change to ESTABLISHED else SYN_RCVD state + \ arrange for segment to be acked (eventually) + \ continue processing rest of data/controls, beginning with URG + + ack iflag? iack iss s<= iack snd_max s> or and if + dropwithresetv6 true exit + then + + rst iflag? if + ack iflag? if + debug" Connection refused" + tcp_drop + then \ Connection refused + true exit + then + + syn iflag? 0= if true exit then + + ack iflag? if ack-una then + + tcpt_rexmt off + iseq to irs + rcvseqinit + set-acknow + ack iflag? snd_una iss s> and if + established set-state + present-data drop + \ if we didn't have to retransmit the SYN, + \ use its rtt as our initial srtt & rtt var. + t_rtt if t_rtt xmit_timer then + else + syn_received set-state + then + + trimthenstep6v6 true +; + +[ifndef] include-ipv4 +: ?drop-some ( -- ) + rcv_nxt iseq - dup 0<= if drop exit then ( #todrop ) + syn iflag? if + syn clear-iflag + iseq 1+ to iseq + iurp 1 > if + iurp 1- to iurp + else + urg clear-iflag + then + 1- ( #todrop' ) + then ( #todrop ) + + dup ilen >= if ( #todrop ) + \ Any valid FIN must be to the left of the + \ window. At this point, FIN must be a + \ duplicate or out-of-sequence, so drop it. + fin clear-iflag + + \ Send ACK to resynchronize, and drop any data, + \ but keep on processing for RST or ACK. + set-acknow ( #todrop ) + drop ilen ( #todrop' ) + then ( #todrop ) + + dup doff + to doff ( #todrop ) + dup iseq + to iseq ( #todrop ) + dup -ilen ( #todrop ) + iurp over > if ( #todrop ) + iurp over - to iurp ( #todrop ) + else ( #todrop ) + urg clear-iflag ( #todrop ) + 0 to iurp ( #todrop ) + then ( #todrop ) + drop ( ) +; +[then] + +: seg-after-winv6? ( -- done? ) + \ If segment ends after window, drop trailing data + \ (and PUSH and FIN); if nothing left, just ACK. + + iseq ilen + rcv_nxt rcv_wnd + - ( #todrop ) + dup 0<= if drop false exit then ( #todrop ) + + dup ilen >= if ( #todrop ) + \ If a new connection request is received + \ while in TIME_WAIT, drop the old connection + \ and start over if the sequence numbers + \ are above the previous ones. Otherwise, queue it + \ for later processing. + syn iflag? if + ts time_wait = iseq rcv_nxt s> and if ( #todrop ) + rcv_nxt issincr + to iss + tcp_close + \ XXX we need to find some way to get back to findpcb: + \ goto findpcb + \ XXX this is moot since a new instance of this TCP + \ package must be created in order to accept a new + \ connection. + drop true exit + else + drop false exit + then + then ( #todrop ) + + \ If window is closed can only take segments at + \ window edge, and have to drop data and PUSH from + \ incoming segments. Continue processing, but + \ remember to ack. Otherwise, drop segment and ack. + + rcv_wnd 0= iseq rcv_nxt = and if ( #todrop ) + set-acknow + else ( #todrop ) + drop dropafterackv6 true exit + then ( #todrop ) + then ( #todrop ) + + \ Drop the extra data from the end of the packet + -ilen ( ) + th_push fin or clear-iflag ( ) + false +; + +[ifndef] include-ipv4 +: do-rst ( -- ) + \ If the RST bit is set examine the state: + \ SYN_RECEIVED STATE: + \ If passive open, return to LISTEN state. + \ If active open, inform user that connection was refused. + \ ESTABLISHED, FIN_WAIT_1, FIN_WAIT2, CLOSE_WAIT STATES: + \ Inform user that connection was reset, and close tcb. + \ CLOSING, LAST_ACK, TIME_WAIT STATES + \ Close the tcb. + + ts syn_received = if debug" Connection refused" closed set-state then + + ts established = + ts fin_wait_1 = or + ts fin_wait_2 = or + ts close_wait = or if debug" Connection reset" closed set-state then + + tcp_close +; + +\ Discard from the buffer the transmitted data that was acked +: release-data ( -- flag ) + acked wbuf-actual > dup if ( flag ) + snd_wnd wbuf-actual - to snd_wnd ( flag ) + wbuf-actual wbuf-drop ( flag ) + else ( flag ) + acked wbuf-drop ( flag ) + snd_wnd acked - to snd_wnd ( flag ) + then ( flag ) +; +[then] + +: do-ackv6 ( -- done? ) + ts syn_received = if + \ In SYN_RECEIVED state if the ack ACKs our SYN then enter + \ ESTABLISHED state and continue processing, otherwise + \ send an RST. + snd_una iack s> iack snd_max s> or if + dropwithresetv6 true exit + then + established set-state + present-data drop + iseq 1- to snd_wl1 + then + + \ In ESTABLISHED and subsequent states: drop duplicate ACKs; ACK out + \ of range ACKs. If the ack is in the range + \ snd_una < iack <= snd_max + \ then advance snd_una to iack and drop + \ data from the retransmission queue. If this ACK reflects + \ more up to date window information we update our window information. + + iack snd_una s<= if + ilen 0= iwin snd_wnd = and if + \ If we have outstanding data (other than a window probe), + \ this is a completely duplicate ack (i.e., window info didn't + \ change), the ack is the biggest we've seen, and we've seen + \ exactly our rexmt threshhold of them, assume a packet + \ has been dropped and retransmit it. Kludge snd_nxt & the + \ congestion window so we send only this one packet. + \ + \ We know we're losing at the current window size so do + \ congestion avoidance (set ssthresh to half the current window + \ and pull our congestion window back to the new ssthresh). + \ + \ Dup acks mean that packets have left the network (they're now + \ cached at the receiver) so bump cwnd by the amount in the receiver + \ to keep a constant cwnd packets in the network. + + tcpt_rexmt @ 0= iack snd_una <> or if + 0 to t_dupacks + else t_dupacks 1+ dup to t_dupacks tcprexmtthresh = if + snd_nxt ( onxt ) + snd_wnd snd_cwnd min 2/ t_maxseg / 2 umax ( onxt win ) + t_maxseg u* to snd_ssthresh ( onxt ) + tcpt_rexmt off ( onxt ) + 0 to t_rtt ( onxt ) + iack set-snd_nxt ( onxt ) + t_maxseg set-cwnd ( onxt ) + tcp_outputv6 ( onxt ) + t_maxseg t_dupacks * snd_ssthresh + set-cwnd ( onxt ) + dup snd_nxt s> if set-snd_nxt else drop then ( ) + true exit + else t_dupacks tcprexmtthresh > if + snd_cwnd t_maxseg + set-cwnd + tcp_outputv6 + true exit + then then then + else + 0 to t_dupacks + then + + false exit + then + + \ If the congestion window was inflated to account + \ for the other side's cached packets, retract it. + + t_dupacks tcprexmtthresh >= + snd_cwnd snd_ssthresh > and if snd_ssthresh set-cwnd then + 0 to t_dupacks + + iack snd_max s> if dropafterackv6 true exit then + + iack snd_una - to acked + + \ If transmit timer is running and timed sequence + \ number was acked, update smoothed round trip time. + \ Since we now have an rtt measurement, cancel the + \ timer backoff (cf., Phil Karn's retransmit alg.). + \ Recompute the initial retransmit timer. + + t_rtt 0<> iack t_rtseq s> and if t_rtt xmit_timer then + + \ If all outstanding data is acked, stop retransmit + \ timer and remember to restart (more output or persist). + \ If there is more data to be acked, restart retransmit + \ timer, using current (possibly backed-off) value. + + iack snd_max = if + tcpt_rexmt off + 1 to needoutput + else + tcpt_persist @ 0= if t_rxtcur tcpt_rexmt ! then + then + + \ When new data is acked, open the congestion window. If the window + \ gives us less than ssthresh packets in flight, open exponentially + \ (maxseg per packet). Otherwise open linearly: maxseg per window + \ (maxseg^2 / cwnd per packet), plus a constant fraction of a packet + \ (maxseg/8) to help larger windows open quickly enough. + t_maxseg + snd_cwnd snd_ssthresh u> if dup u* snd_cwnd / then ( cwnd-increment ) + snd_cwnd + maxwin min set-cwnd + + release-data to ourfinisacked? + + \ wakeup-sender + + ack-una + + ts case + + \ In FIN_WAIT_1 STATE in addition to the processing + \ for the ESTABLISHED state if our FIN is now acknowledged + \ then enter FIN_WAIT_2. + + fin_wait_1 of + ourfinisacked? if + \ If we can't receive any more data, then closing user can proceed. + \ Starting the timer is contrary to the specification, but if we + \ don't get a FIN we'll hang forever. + + cantrcvmore? if + \ XXX false to soisconnected + maxidle tcpt_2msl ! + then + fin_wait_2 set-state + then + endof + + \ In CLOSING STATE in addition to the processing for + \ the ESTABLISHED state if the ACK acknowledges our FIN + \ then enter the TIME-WAIT state, otherwise ignore + \ the segment. + + closing of + ourfinisacked? if + time_wait set-state + canceltimers + tcptv_msl 2* tcpt_2msl ! + then + endof + + \ In LAST_ACK, we may still be waiting for data to drain + \ and/or to be acked, as well as for the ack of our FIN. + \ If our FIN is now acknowledged, delete the TCB, + \ enter the closed state and return. + + last_ack of + ourfinisacked? if tcp_close true exit then + endof + + \ In TIME_WAIT state the only thing that should arrive + \ is a retransmission of the remote FIN. Acknowledge + \ it and restart the finack timer. + + time_wait of + tcptv_msl 2* tcpt_2msl ! + dropafterackv6 true exit + endof + endcase + false +; + +[ifndef] include-ipv4 +: optbyte ( adr len -- adr' len' b ) 1- swap dup c@ swap 1+ -rot ; +[then] + +: dooptionsv6 ( adr len -- ) + begin dup while ( adr len ) + optbyte case ( adr' len' option ) + 0 of 2drop exit endof ( adr len option ) \ EOL + 1 of 0 endof ( adr len option ) \ NOP + 2 of ( adr len ) \ MAXSEG + optbyte 2- ( adr len optlen ) + iflags syn and if ( adr len optlen ) + debug? if ." Received " then + 2 pick be-w@ tcp_mssv6 drop ( adr len optlen ) + then ( adr len optlen ) + endof +[ifdef] notdef + 3 of ( adr len ) \ WINDOW + optbyte 2- ( adr len optlen ) + iflags syn and if ( adr len optlen ) + rcvd_scale set-flag ( adr len optlen ) + then ( adr len optlen ) + endof +[then] + ( default ) >r optbyte 2- r> ( adr len optlen option ) + endcase ( adr len optlen ) + /string ( adr' len' ) + repeat ( adr len ) + 2drop +; + +: do-listenv6 ( -- ) + th_dport be-w@ my-tcp-port <> ?exit + rst iflag? ?exit + ack iflag? if dropwithresetv6 exit then + syn iflag? 0= ?exit + + \ XXX we also need to reject broadcast source addresses +\ m_flags bcast mcast or and ?exit + multicast-dstv6? ?exit + + \ It is tempting to call "lock-ip-address", but that doesn't + \ work if the DHCP server has specified a router. + ipv6-struct ihv6_src set-dest-ipv6 tcpv6-struct + + th_sport be-w@ to his-tcp-port \ Lock onto his source port + + make-templatev6 + + optp optlen dooptionsv6 + next-iss + iseq to irs + sendseqinit + rcvseqinit + set-acknow + syn_received set-state + keep_init tcpt_keep ! + trimthenstep6v6 +; + +[ifndef] include-ipv4 +\ TCP SYN queue methods + +list: tcplist +listnode + /n field >tcp-adr + /n field >tcp-len + 1 field >tcp-deq? +nodetype: tcpnode + +0 tcplist ! +0 tcpnode ! + +: free-tcpnode ( prev -- ) + delete-after + dup tcpnode free-node + dup >tcp-adr @ swap >tcp-len free-mem +; + +: tcp-deq? ( node-adr -- tcp-deq? ) >tcp-deq? c@ ; + +: purge-que ( -- ) + tcplist ['] tcp-deq? find-node if free-tcpnode else drop then +; + +: tcp-any? ( node-adr -- true ) drop true ; + +: find-first-node ( -- first-node ) tcplist ['] tcp-any? find-node nip ; + +: enque ( adr len -- ) + dup alloc-mem swap 2dup 2>r move 2r> ( adr' len ) + tcpnode allocate-node ( adr len node ) + dup tcplist last-node insert-after ( adr len node ) + tuck >tcp-len ! ( adr node ) + tuck >tcp-adr ! ( node ) + 0 swap >tcp-deq? c! ( ) +; + +\ Determines whether a node in the queue matches the packet that +\ is about to be enqued by comparing their pseudo-IP and TCP headers. +0 value test-adr +[then] + +: duplicate-synv6? ( node-adr -- flag ) + dup tcp-deq? if drop false exit then ( node-adr ) + >tcp-adr @ test-adr /pipv6 /tcphdr + comp 0= ( flag ) +; + +\ Enque an incoming SYN packet unless it is a duplicate of one that +\ is already in the queue. +: ?enquev6 ( adr len -- ) + over to test-adr + tcplist ['] duplicate-synv6? find-node nip if 2drop else enque then +; + +: dequeue? ( -- 0 | adr len true ) + purge-que + find-first-node dup 0= if exit then \ nothing in queue + + ( node ) + true over >tcp-deq? c! ( node ) + dup >tcp-adr @ swap >tcp-len @ true ( adr len true ) +; + +: queue-synv6 ( -- ) + the-struct /pipv6 - ilen-save /pipv6 + ?enquev6 + + \ If the current connection has been declared to be abortable, + \ kill it upon receipt of a new connection request. This is + \ a special hack that is used by the Swing Solutions application, + \ which has some HTTP requests that do not complete until an + \ external event occurs. The requester can abort the request + \ by dropping the TCP connection, but there are some cases where + \ the TCP drop does not appear to be propagated to the responder. + + abort-on-reconnect? if tcp_drop then +; + +: inputv6 ( adr len -- ) + 2dup sumv6-bad? if + show" TCHKSUM" + debug" Bad TCP checksum" 2drop exit + then ( adr len ) + dup to ilen-save to ilen set-struct ( ) + 0 to #oob + + pull-options ?exit + + get-info + + debug? if ." RCV " .pkt then + +\ findpcb: + + \ Here we should do something to ensure that the source port + \ matches this one. Perhaps that is handled by the IP layer. + + \ XXX If we get at TCP packet that doesn't match, we should do a + \ dropwithreset and exit ... + + \ When we get a packet from a port other than the one we are currently + \ talking to, we either queue it for later (if it contains a SYN), + \ or discard it. + his-tcp-port th_sport be-w@ <> if + \ If we are waiting for an incoming connection, we just fall through + \ and handle the new connection request farther down. + ts listen <> if + \ If a SYN is in the window, then we queue it and handle it + \ later, after the current transaction finishes. + syn iflag? if queue-synv6 then + exit + then + then + + alive? 0= if dropwithresetv6 exit then + ts closed = ?exit + + 0 to t_idle + keepidle tcpt_keep ! + + ts listen <> if optp optlen dooptionsv6 then + + fast-pathv6? ?exit + + \ At this point, we have handled the most common cases; + \ It gets complicated from here on out + + \ Calculate amount of space in receive window, + \ and then do TCP input processing. + \ Receive window is amount of space in rcv queue, + \ but not less than advertised window. + rcv_adv rcv_nxt - rbuf-space max to rcv_wnd + + ts listen = if do-listenv6 exit then + + do-syn-sentv6? ?exit + ?drop-some + + \ If data is received after closing, RST the other end + ts close_wait > ilen 0<> and if tcp_close dropwithresetv6 exit then + + seg-after-winv6? ?exit + + rst iflag? if do-rst exit then + + \ If a SYN is in the window, then it is queued until the current + \ transaction finishes cleanly. + syn iflag? if queue-synv6 then + + \ If the ACK bit is off we drop the segment and return. + ack iflag? 0= ?exit + + \ ACK processing + do-ackv6 ?exit + step6v6 +; + +: ?receivev6 ( -- ) + \ If the state is listen, check the queue + ts listen = if + dequeue? if ( adr len ) /pipv6 - swap /pipv6 + swap input exit then + then + \ Check for a new packet + 6 " receive-ip-packet" $call-parent 0= if inputv6 then +; + +[ifndef] include-ipv4 +\ We accomplish the creation of a TCP control block by instantiating +\ this package +: newtcpcb ( -- ) ; + +\ d# 32 is the maximum TCP options size +/tcphdr d# 32 + mssmax + constant /xmit-max + +: alloc-buffers ( -- ) + wbuf-allocate + d# 1024 d# 16 * to rbuf-len + rbuf-len alloc-mem to rbuf-adr + 0 to rbuf-actual +; +: free-buffers ( -- ) + wbuf-start /wbuf free-mem + rbuf-adr rbuf-len free-mem +; +[then] + +\ This is basically attach +: alloc-buffersv6 ( -- ) + /xmit-max " allocate-ipv6" $call-parent to xmit_bufv6 +; + +: free-buffersv6 ( -- ) + free-buffers + xmit_bufv6 /xmit-max " free-ipv6" $call-parent +; + +[ifndef] include-ipv4 +\ User issued close, and wish to trail through shutdown states: +\ if never received SYN, just forget it. If got a SYN from peer, +\ but haven't sent FIN, then go to FIN_WAIT_1 state to send peer a FIN. +\ If already got a FIN from peer, then almost done; go to LAST_ACK +\ state. In all other cases, have already sent FIN to peer (e.g. +\ after PRU_SHUTDOWN), and just have to play tedious game waiting +\ for peer to send FIN or not respond to keep-alives, etc. +\ We can let the user exit from the close as soon as the FIN is acked. +: usrclosed ( -- ) + ts case \ action next-state + closed of tcp_close endof + listen of tcp_close endof + syn_sent of tcp_close endof + syn_received of fin_wait_1 set-state endof + established of fin_wait_1 set-state endof + close_wait of last_ack set-state endof + ( default ) \ Do nothing + endcase + + + alive? ts fin_wait_2 >= and if + \ soisdisconnected + + \ If we are in FIN_WAIT_2, we arrived here because the + \ application did a shutdown of the send side. Like the + \ case of a transition from FIN_WAIT_1 to FIN_WAIT_2 after + \ a full close, we start a timer to make sure sockets are + \ not left in FIN_WAIT_2 forever. + ts fin_wait_2 = if maxidle tcpt_2msl ! then + then +; + +\ When a source quench is received, close congestion window +\ to one segment. We will gradually open it again as we proceed. +\ XXX we probably have no way to invoke this. +\ : quench ( -- ) alive? if t_maxseg set-cwnd then ; + +\ Fast timeout routine for processing delayed acks +false instance value do-delack? +[then] + +: do-delackv6 ( -- ) + do-delack? if + t_flags delack invert and acknow or to t_flags + tcp_outputv6 + false to do-delack? + then +; + +[ifndef] include-ipv4 +: delack-tick ( -- ) t_flags delack and 0<> to do-delack? ; \ alarm handler + +\ 2 MSL timeout in shutdown went off. If we're closed but +\ still waiting for peer to close and connection has been idle +\ too long, or if 2MSL time is up from TIME_WAIT, delete connection +\ control block. Otherwise, check again in a bit. +: do-2msl ( -- ) + debug? if ." 2msl" cr then + ts time_wait <> t_idle maxidle <= and if + keepintvl tcpt_2msl ! + else + tcp_close + then +; +[then] + +\ Retransmission timer went off. Message has not +\ been acked within retransmit interval. Back off +\ to a longer retransmit interval and retransmit one segment. +: do-rexmtv6 ( -- ) + debug? if ." Retransmit" cr then + t_rxtshift 1+ dup to t_rxtshift maxrxtshift > if + maxrxtshift to t_rxtshift + tcp_drop + exit + then + rexmtval backoff t_rxtshift na+ @ * t_rttmin set-rxtcur + t_rxtcur tcpt_rexmt ! + +[ifdef] notdef \ We have no way to try for a better route + + \ If losing, let the lower level know and try for + \ a better route. Also, if we backed off this far, + \ our srtt estimate is probably bogus. Clobber it + \ so we'll take the next rtt measurement as our srtt; + \ move the current srtt into rttvar to keep the current + \ retransmit times until then. + + if (t_rxtshift > TCP_MAXRXTSHIFT / 4) { + in_losing(t_inpcb); + t_rttvar += (t_srtt >> TCP_RTT_SHIFT); + t_srtt = 0; + } +[then] + snd_una set-snd_nxt + + \ If timing a segment in this window, stop the timer. + 0 to t_rtt + + \ Close the congestion window down to one segment + \ (we'll open it by one segment for each ack we get). + \ Since we probably have a window's worth of unacked + \ data accumulated, this "slow start" keeps us from + \ dumping all that data as back-to-back packets (which + \ might overwhelm an intermediate gateway). + \ + \ There are two phases to the opening: Initially we + \ open by one mss on each ack. This makes the window + \ size increase exponentially with time. If the + \ window is larger than the path can handle, this + \ exponential growth results in dropped packet(s) + \ almost immediately. To get more time between + \ drops but still "push" the network to take advantage + \ of improving conditions, we switch from exponential + \ to linear window opening at some threshhold size. + \ For a threshhold, we use half the current window + \ size, truncated to a multiple of the mss. + \ + \ (the minimum cwnd that will give us exponential + \ growth is 2 mss. We don't allow the threshhold + \ to go below this.) + + snd_wnd snd_cwnd min 2/ t_maxseg / 2 max ( win ) + t_maxseg set-cwnd ( win ) + t_maxseg * to snd_ssthresh ( ) + 0 to t_dupacks + + tcp_outputv6 +; + +\ Persistance timer into zero window. +\ Force a byte to be output, if possible. +: do-persistv6 ( -- ) + debug? if ." Persist" cr then + setpersist + true to t_force + tcp_outputv6 + false to t_force +; + +[ifndef] include-ipv4 +0 instance value keepalive? \ A configuration flag we can set +[then] + +\ Keep-alive timer went off; send something +\ or drop connection if idle for too long. +: do-keepv6 ( -- ) + debug? if ." Keep" cr then + ts established < if tcp_drop exit then + keepalive? ts close_wait <= and if + t_idle keepidle maxidle + >= if tcp_drop exit then + + \ Send a packet designed to force a response if the peer is up + \ and reachable: either an ACK if the connection is still alive, + \ or an RST if the peer has closed the connection due to timeout or + \ reboot. Using sequence number snd_una-1 causes the transmitted + \ zero-length segment to lie outside the receive window; by the + \ protocol spec, this requires the correspondent TCP to respond. + + tv6_template to the-struct rcv_nxt snd_una 1- ack respondv6 + keepintvl tcpt_keep ! + else + keepidle tcpt_keep ! + then +; + +[ifndef] include-ipv4 +: countdown? ( adr -- expired? ) + dup @ if ( adr ) + dup @ 1- ( adr count' ) + tuck swap ! 0= + else + drop false + then +; + +\ Tcp protocol timeout routine called every 500 ms. +\ Updates the timers, causing finite state machine actions when they expire. + +0 instance value protocol-timer? +[then] + +: do-protocolv6 ( -- ) + protocol-timer? 0= ?exit + false to protocol-timer? + + 8 d# 75 * pr_slowhz * to maxidle \ 8 probes at 75-second intervals + + tcpt_rexmt countdown? if do-rexmtv6 then + tcpt_persist countdown? if do-persistv6 then + tcpt_keep countdown? if do-keepv6 then + tcpt_2msl countdown? if do-2msl then + + t_idle 1+ to t_idle + t_rtt if t_rtt 1+ to t_rtt then +; + +[ifndef] include-ipv4 +: protocol-tick ( -- ) + alive? to protocol-timer? + + \ XXX If we have multiple simultaneous TCPs, we only want to + \ do this in one of them. How? + tcp_iss issincr pr_slowhz / + to tcp_iss +; +[then] + +\ Initiate connection to peer. +\ Create a template for use in transmissions on this connection. +\ Enter SYN_SENT state, and mark socket as connecting. +\ Start keep-alive timer, and seed output sequence space. +\ Send initial segment on connection. + +: start-connectv6 ( port# -- ) + to his-tcp-port + \ XXX how do we get our local port number??? + + make-templatev6 + syn_sent set-state + keep_init tcpt_keep ! + next-iss + sendseqinit + tcp_outputv6 +; + +[ifndef] include-ipv4 +\ After a receive, possibly send window update to peer. +\ XXX - we need to call output after taking the receive data +\ See: case PRU_RCVD + +: tcp-abort ( -- ) tcp_drop ; + +\ Get the out-of-band data without consuming it +: peek-oob ( adr len -- actual ) + \ XXX check this; there may be some data waiting during a later state + ts established <> if 2drop -1 exit then + + t_oobflags havedata and 0= if 2drop -2 exit then + 0= if drop 0 exit then + t_iobc swap c! 1 +; + +\ Get the out-of-band data +: read-oob ( adr len -- actual ) + peek-oob ( actual ) + dup 0> if + t_oobflags havedata haddata or xor to t_oobflags + then +; +[then] + +: pollv6 ( -- ) + do-delackv6 do-protocolv6 + ?receivev6 +; + +[ifndef] include-ipv4 +: wbuf-set ( adr len -- ) over to wbuf-adr + to wbuf-top ; +: wbuf-add ( adr len -- #added ) + wbuf-avail min ( adr #added ) + dup if ( adr #added ) + tuck wbuf-top swap move ( #added ) + dup wbuf-top + to wbuf-top ( #added ) + else ( adr 0 ) + nip ( 0 ) + then ( #added ) +; +: read ( adr len -- actual ) 2drop 0 ; +: write ( adr len -- actual ) 2drop 0 ; +: write-oob ( adr len -- actual ) 2drop 0 ; +: connect ( port# -- okay? ) drop false ; +[then] + +: writev6 ( adr len -- actual ) + tuck begin ( len adr remaining ) + alive? 0= if 3drop -1 exit then + 2dup wbuf-add /string ( len adr' remaining' ) + dup while ( len adr' remaining' ) + tcp_outputv6 pollv6 ( len adr' remaining' ) + repeat ( len adr 0 ) + 2drop ( len ) +; + +: write ( adr len -- actual ) + use-ipv6? if writev6 else write then +; + +\ Do a send by putting data in output queue and updating urgent +\ marker if URG set. Possibly send more data. +: write-oobv6 ( adr len -- actual ) + \ According to RFC961 (Assigned Protocols), the urgent pointer points + \ to the last octet of urgent data. BSD makes it point to the + \ the first octet of data past the urgent section. We follow the RFC. + dup 0= if nip exit then + dup snd_una + 1- to snd_up ( adr len ) + true to t_force ( adr len ) + writev6 ( len|-1 ) + false to t_force ( len|-1 ) +; +: write-oob ( adr len -- actual ) + use-ipv6? if write-oobv6 else write-oob then +; + +: connectv6 ( port# -- okay? ) + true to alive? + start-connectv6 + begin pollv6 ts established < while + debug? if key? if key drop interact then then + alive? 0= if false exit then + repeat + true +; +: connect ( port# -- okay? ) + " use-ipv6?" $call-parent dup to use-ipv6? + if connectv6 else connect then +; + +\ Other things we may need to do: +\ in_setsockaddr +\ in_setpeeraddr + +: readv6 ( adr len -- actual ) + pollv6 ( adr len ) + + rbuf-actual if ( adr len ) + copy-from-rbuf tcp_outputv6 exit ( actual ) + then ( adr len ) + + 2drop + ts established <> if -1 else -2 tcp_outputv6 then +; +: read ( adr len -- actual ) + use-ipv6? if readv6 else read then +; + +[ifndef] include-ipv4 +: init-variables ( -- ) + 0 tcpq ! + listen set-state + 0 to t_flags + d# 512 to t_maxseg + canceltimers + 0 to t_dupacks + 0 to t_force + 0 to rcv_wnd + 0 to rcv_nxt + 0 to rcv_up + 0 to irs + + 0 to snd_una + 0 to snd_nxt + 0 to snd_up + 0 to snd_wl1 + 0 to snd_wl2 + 0 to snd_wnd + 0 to iss + + 0 to rcv_adv + 0 to snd_max + maxwin to snd_cwnd + maxwin to snd_ssthresh + + 0 to t_idle + 0 to t_rtt + 0 to t_rtseq + 0 to t_srtt + 3 pr_slowhz * 2 2+ 1- lshift to t_rttvar + pr_slowhz to t_rttmin + 0 to max_sndwnd + + 0 to t_oobflags + 0 to t_iobc + + 0 to t_rxtshift + rexmtval pr_slowhz set-rxtcur + + false to do-delack? + false to keepalive? + false to protocol-timer? +; +: accept ( port# -- connected? ) drop false ; +[then] + +: acceptv6 ( port# -- connected? ) + to my-tcp-port + ts closed = if + init-variables + \ Tell the IP stack to accept packets from anybody + " unlock-ipv6-address" $call-parent + then + true to alive? + pollv6 + \ XXX if state is now "closed", we need to return an error code + ts established = +; +: accept ( port# -- connected? ) + use-ipv6? if acceptv6 else accept then +; + +\ XXX new args: ipv4, ipv6 +[ifndef] include-ipv4 +: parse-args ( -- ) + my-args + begin dup while ( rem$ ) + ascii , left-parse-string ( rem$' head$ ) + 2dup " debug" $= if true to debug? else ( rem$' head$ ) + 2dup $set-host then ( rem$' head$ ) + 2drop + repeat + 2drop +; +[then] + +: open ( -- ) + alloc-buffersv6 +[ifdef] open + open +[else] + parse-args + alloc-buffers + + first-time? if + false to first-time? + " next-xid" $call-parent to tcp_iss + then + + 0 " set-timeout" $call-parent + + ['] delack-tick d# 200 alarm + + ['] protocol-tick d# 500 alarm + + h# 555 to my-tcp-port \ XXX + true to alive? + + true +[then] +; + +[ifndef] include-ipv4 +d# 5000 constant close-wait-ms +: drain ( -- ) ; +: flush-writes ( -- ) ; +[then] + +: drainv6 ( -- ) + get-msecs close-wait-ms + ( msecs ) + begin ts time_wait < alive? and while ( msecs ) + pollv6 ( msecs ) + get-msecs over - 0>= if drop exit then + repeat ( msecs ) + drop +; + +: flush-writesv6 ( -- ) + \ If the connection is already down, just blow away any pending data + ts closed = if wbuf-clear exit then + + get-msecs + begin + wbuf-actual 0<> ( start-time flag ) + get-msecs 2 pick - d# 10000 < ( start-time flag flag ) + and ( start-time flag' ) + while ( start-time ) + tcp_outputv6 pollv6 ( start-time ) + repeat ( start-time ) + drop ( ) + + wbuf-actual 0<> if + show" TDROP" + debug" TCP Timeout!" + wbuf-clear + then +; + +\ Close the current TCP connection and wait for the state machine +\ to make its way through the sequence of termination states. +: disconnectv6 ( -- ) + usrclosed + flush-writes + flush-writesv6 + alive? if tcp_outputv6 then + drain + drainv6 + alive? if tcp_close then +; + +[ifndef] include-ipv4 +\ external +: set-nodelay ( -- ) nodelay set-flag ; +: abort-on-reconnect ( -- ) true to abort-on-reconnect? ; +[then] + +: close ( -- ) + disconnectv6 +[ifdef] close + close +[else] + ['] delack-tick 0 alarm + ['] protocol-tick 0 alarm +[then] + free-buffersv6 +; + +\ LICENSE_BEGIN +\ Copyright (c) 2006 FirmWorks +\ +\ Permission is hereby granted, free of charge, to any person obtaining +\ a copy of this software and associated documentation files (the +\ "Software"), to deal in the Software without restriction, including +\ without limitation the rights to use, copy, modify, merge, publish, +\ distribute, sublicense, and/or sell copies of the Software, and to +\ permit persons to whom the Software is furnished to do so, subject to +\ the following conditions: +\ +\ The above copyright notice and this permission notice shall be +\ included in all copies or substantial portions of the Software. +\ +\ THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, +\ EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF +\ MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND +\ NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE +\ LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION +\ OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION +\ WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. +\ +\ LICENSE_END Added: ofw/inetv6/telnet.fth =================================================================== --- ofw/inetv6/telnet.fth (rev 0) +++ ofw/inetv6/telnet.fth 2007-08-02 21:37:59 UTC (rev 518) @@ -0,0 +1,140 @@ +\ See license at end of file +purpose: Telnet client + +decimal + +\ i/o + +0 value telnet-done? +variable tcp-in +: tcp-getc ( -- c ) + tcp-in 1 tcp-read dup 0< if ( err ) + dup -1 = if true to telnet-done? then ( err ) + exit + then + drop tcp-in c@ +; + +\ escapes + +240 constant #se \ End of subnegotiation parameters +\ 241 constant #nop \ No operation +\ 242 constant #synch \ The data stream portion of a Synch +\ 243 constant #brk \ NVT break character +\ 244 constant #ip \ Interrupt Process +\ 245 constant #ao \ Abort output +\ 246 constant #ayt \ Are You There +\ 247 constant #ec \ Erase character +\ 248 constant #el \ Erase Line +\ 249 constant #ga \ Go ahead +250 constant #sb \ Suboption negotiation +251 constant #will +252 constant #wont +253 constant #do +254 constant #dont +255 constant #iac \ interpret as command + +24 constant #term-type +0 constant #is +1 constant #send + +: send-is ( string option -- ) + " "(ff fa)" tcp-type tcp-emit 0 tcp-emit tcp-type " "(ff f0)" tcp-type +; + +: tel-sub ( -- ) + tcp-getc case + #term-type of + tcp-getc #send = if " vt100" #term-type send-is then + endof + endcase +; + +: send-option ( option request -- ) #iac tcp-emit tcp-emit tcp-emit ; +: i-will ( option -- ) #will send-option ; +: i-wont ( option -- ) #wont send-option ; +: i-do ( option -- ) #do send-option ; +: i-dont ( option -- ) #dont send-option ; + +: he-will ( option -- ) i-do ; \ offer +: he-wont ( option -- ) i-dont ; \ offer +: he-does ( option -- ) \ request + dup case + #term-type of i-will endof + ( default ) i-wont + endcase +; +: he-dont ( option -- ) i-wont ; \ request + +: telnet-command ( command -- ) + case + #se of endof +\ #nop of endof +\ #synch of endof +\ #brk of endof +\ #ip of endof +\ #ao of endof +\ #ayt of endof +\ #ec of endof +\ #el of endof +\ #ga of endof + #sb of tel-sub endof + #will of tcp-getc he-will endof + #wont of tcp-getc he-wont endof + #do of tcp-getc he-does endof + #dont of tcp-getc he-dont endof + endcase +; +: telnet1 ( c -- ) + dup #iac <> if emit exit then drop + + tcp-getc dup #se < if emit exit then ( c ) + + telnet-command +; +: telnet-out ( -- ) + d# 80 0 do + tcp-getc dup 0< if ( c ) + drop leave + else ( c ) + telnet1 + then + loop +; +: (telnet) ( -- ) + false to telnet-done? + begin telnet-done? 0= while + key? if + key dup control ] = if drop exit then + tcp-emit + then + telnet-out + repeat +; +: $telnet ( hostname$ -- ) d# 23 open-tcp-connection (telnet) close-tcp ; +: telnet ( "hostname" -- ) safe-parse-word $telnet ; + +hex +\ LICENSE_BEGIN +\ Copyright (c) 2006 FirmWorks +\ +\ Permission is hereby granted, free of charge, to any person obtaining +\ a copy of this software and associated documentation files (the +\ "Software"), to deal in the Software without restriction, including +\ without limitation the rights to use, copy, modify, merge, publish, +\ distribute, sublicense, and/or sell copies of the Software, and to +\ permit persons to whom the Software is furnished to do so, subject to +\ the following conditions: +\ +\ The above copyright notice and this permission notice shall be +\ included in all copies or substantial portions of the Software. +\ +\ THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, +\ EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF +\ MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND +\ NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE +\ LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION +\ OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION +\ WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. +\ +\ LICENSE_END Added: ofw/inetv6/telnetd.fth =================================================================== --- ofw/inetv6/telnetd.fth (rev 0) +++ ofw/inetv6/telnetd.fth 2007-08-02 21:37:59 UTC (rev 518) @@ -0,0 +1,245 @@ +\ See license at end of file +purpose: Telnet server - allows external systems to telnet to the firmware + +\ To use this feature, execute "telnetd" on the firmware system, then +\ use telnet on the remote host to connect to the firmware system. +\ When done, execute "exit-telnet" or just close the connection. + +support-package: telnet +false value debug-options? + +: (read) ( adr len -- actual ) " read" $call-parent ; +: (write) ( adr len -- actual ) " write" $call-parent ; + +\ Discard the first byte in the array by copying the rest down +: swallow ( rem$ -- rem$' ) + 1- 2dup over 1+ -rot move +; +1 instance buffer: the-byte +: getbyte ( -- byte ) + begin + the-byte 1 (read) case + 1 of the-byte c@ exit endof + -1 of abort endof + endcase + again +; +: putbyte ( byte -- ) the-byte c! the-byte 1 (write) drop ; +: next-cmd-byte ( rem$ -- rem$' char ) + \ If there is more data in the buffer, return the next byte + dup if over c@ >r swallow r> exit then ( rem$ ) + + \ Otherwise, get a character from the TCP connection + getbyte ( rem$ char ) +; + +: show-option ( option command$ dir$ -- option ) + debug-options? if + [ifndef] install-uart-io " install-uart-io" evaluate [then] + type space type space dup .d cr + console-io + else + 2drop 2drop + then +; +: .got ( option command$ -- ) " RCVD" show-option ; +: .sent ( option command$ -- ) " SENT" show-option ; + + +: send-option ( option request -- ) #iac putbyte putbyte putbyte ; +: send-will ( option -- ) " WILL" .sent d# 251 send-option ; +: send-wont ( option -- ) " WONT" .sent d# 252 send-option ; +: send-do ( option -- ) " DO" .sent d# 253 send-option ; +: send-dont ( option -- ) " DONT" .sent d# 254 send-option ; + +: will ( rem$ -- rem$' ) + next-cmd-byte " WILL" .got + dup case + 0 of send-do endof + +\ Since we have already sent "do suppressGA", there is no need to re-ack it +\ 3 of send-do endof \ Suppress go-ahead + 3 of drop endof \ Suppress go-ahead + + ( default ) swap send-dont + endcase +; + +: wont ( rem$ -- rem$' ) + next-cmd-byte " WONT " .got + drop +; + +: tdo ( rem$ -- rem$' ) + next-cmd-byte " DO" .got + dup case + 0 of send-will endof \ Binary transmission + +\ Since we have already sent "will echo", there is no need to re-ack it +\ 1 of send-will endof \ Echo + 1 of drop endof + + 3 of send-will endof \ Suppress go-ahead + ( default ) swap send-wont + endcase +; + +: dont ( rem$ -- rem$' ) + next-cmd-byte " DONT" .got + drop +; + +: subnegotiate ( rem$ -- rem$' ) + next-cmd-byte " SUBNEGOTIATE" .got + \ XXX we should eat everything up to the SE marker; + \ on the other hand, we should never get here, because + \ we don't express willingness to subnegotiate anything. + drop +; + +: reinsert ( rem$ char -- rem$' ) + >r + 2dup over 1+ swap move ( rem$ r: char ) + r> 2 pick c! 1+ ( rem$' ) +; +: do-command ( rem$ -- rem$' ) + swallow \ Discard the IAC itself + next-cmd-byte ( rem$ char ) + case +\ d# 240 of endof \ end subnegotiation +\ d# 241 of endof \ nop +\ d# 242 of endof \ data mark (end urgent) + d# 243 of user-abort endof \ break + d# 244 of user-abort endof \ interrupt process +\ d# 245 of endof \ abort-output +\ d# 246 of endof \ are-you-there? + d# 247 of control h reinsert endof \ erase character + d# 248 of control u reinsert endof \ erase line + d# 249 of endof \ go-ahead + d# 250 of subnegotiate endof + d# 251 of will endof + d# 252 of wont endof + d# 253 of tdo endof + d# 254 of dont endof + #iac of #iac reinsert endof + endcase +; + +: process-escapes ( adr len -- len' ) + over swap ( adr rem$ ) + begin dup while ( adr rem$ ) + over c@ #iac = if ( adr rem$ ) + do-command ( adr rem$' ) + else ( adr rem$ ) + 1 /string ( adr rem$' ) + then ( adr rem$ ) + repeat ( adr end-adr 0 ) + drop swap - ( len' ) +; +: read ( adr len -- actual ) + over swap (read) ( adr actual ) + dup 0< if nip exit then ( adr actual ) + process-escapes ( actual' ) +; +: write ( adr len -- actual ) + tuck begin ( len adr len ) + #iac split-string ( len head$ tail$ ) + dup while ( len head$ tail$ ) + 2swap (write) drop ( len tail$ ) + #iac putbyte ( len tail$ ) \ Send an escape + over 1 (write) ( len tail$ ) \ Send the ff in the string + 1 /string ( len tail$' ) \ Remove it from the string + repeat ( len head$ null$ ) + 2drop (write) drop ( len ) +; + +0 instance value verbose? + +: open ( -- flag ) + my-args " verbose" $= to verbose? + + verbose? if + ." telnet://" " my-ip-addr" $call-parent .ipaddr cr + then + + begin d# 23 " accept" $call-parent until + + verbose? if ." Connected" cr then + + 3 send-do \ You suppress go-ahead + 0 send-do \ Be binary + 1 send-will \ I will echo + + get-msecs ( time ) + begin + get-msecs over d# 300 + - 0< + while + the-byte 1 (read) case ( msecs [byte] ) + 1 of drop get-msecs the-byte 1 process-escapes drop endof + -1 of drop false exit endof + endcase + repeat + drop + + true +; +: close ( -- ) ; +end-support-package + + +0 value old-in +0 value old-out +0 value telnet-ih + +defer getchar-hook ' = to getchar-hook +patch getchar-hook = stdin-getchar + +: exit-telnet ( -- ) + telnet-ih close-dev + old-out stdout ! + old-in stdin ! + ['] = to getchar-hook +; + +: ?telnet-closed ( read-return 1 -- flag ) + over -1 = if ( -1 1 ) + exit-telnet ( -1 1 ) + carret pending-char c! ( 1 1 ) + ." Connection closed" \ cr + 2drop true exit + then ( read-return 1 ) + = +; + +devalias telnetd tcp//telnet:verbose + +: telnetd ( -- ) + " telnetd" open-dev dup 0= abort" Can't open telnet" ( ih ) + to telnet-ih + stdin @ to old-in stdout @ to old-out + telnet-ih dup stdin ! stdout ! + ['] ?telnet-closed to getchar-hook +; +\ LICENSE_BEGIN +\ Copyright (c) 2006 FirmWorks +\ +\ Permission is hereby granted, free of charge, to any person obtaining +\ a copy of this software and associated documentation files (the +\ "Software"), to deal in the Software without restriction, including +\ without limitation the rights to use, copy, modify, merge, publish, +\ distribute, sublicense, and/or sell copies of the Software, and to +\ permit persons to whom the Software is furnished to do so, subject to +\ the following conditions: +\ +\ The above copyright notice and this permission notice shall be +\ included in all copies or substantial portions of the Software. +\ +\ THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, +\ EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF +\ MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND +\ NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE +\ LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION +\ OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION +\ WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. +\ +\ LICENSE_END Added: ofw/inetv6/tftp.fth =================================================================== --- ofw/inetv6/tftp.fth (rev 0) +++ ofw/inetv6/tftp.fth 2007-08-02 21:37:59 UTC (rev 518) @@ -0,0 +1,354 @@ +\ See license at end of file +purpose: Trivial File Transfer Protocol (TFTP) implementation + +\ Trivial File Transfer Protocol + +decimal + +headerless + +1 constant rrq-pkt +2 constant wrq-pkt +3 constant data-pkt +4 constant ack-pkt +5 constant err-pkt + + +struct ( tftp packet ) + 2 sfield opcode + 0 sfield block# + 0 sfield filename + 2 sfield errorcode + 0 sfield errmsg + 512 sfield data +constant /tftp-packet + +instance variable sid +instance variable did +instance variable this-block +instance variable #retries +false instance value first-try? + +0 instance value tftp-packet \ Buffer address +instance variable #packet + +[ifndef] include-ipv6 +0 value server-ipv6-addr +: .ipv6 ( adr -- ) drop ; +[then] +[ifndef] include-ipv4 +0 value server-ip-addr +: .ipaddr ( adr -- ) drop ; +[then] + + +: too-many-tries? ( -- flag ) \ flag true if too many retries + bootnet-debug if + #retries @ 3 and 3 = if ." #retries = " #retries @ .d cr then + then + #retries @ tftp-retries u>= +; + +\ Unlock from the server so we can capture another one +: .merror ( tftp-adr,len -- tftp-adr,len ) + \ Unfortunately, we cannot give good error information in the usual + \ case where use-server? is false (meaning that we aren't sure which + \ server to use). If use-server? is false and the first server we try + \ (i.e. the one that responded to the RARP or BOOTP request) doesn't + \ have the file, we then try to broadcast the request. We mustn't + \ display the error message from the first server because that would + \ cause spurious complaints in the case where the subsequent broadcast + \ TFTP operation will succeed. However, if the subsequent broadcast + \ TFTP attempt fails, we won't get an error response because TFTP + \ servers typically return error responses only for unicast requests. + use-server? bootnet-debug or if ( tftp-adr,len ) + collect( + ." TFTP error: " errmsg cscount ( tftp-adr,len msg-adr,len ) + \ Some TFTP implementations neglect to null-terminate the message. + 2 pick 4 - min type cr + [ifdef] .dhcp-server .dhcp-server [then] + ." TFTP Server: " + use-ipv6? if + server-ipv6-addr .ipv6 cr + else + server-ip-addr .ipaddr cr + then + ." Filename: " tftp-packet set-struct filename cscount type cr + )collect + use-server? if $abort else type then + then + d# 69 did ! +; + +: $cstrput ( from-adr,len to-adr -- end-adr ) + over >r place-cstr r> + 1+ +; + +: setup-request ( filename$ rrq-pkt/wrq-pkt -- ) + 0 this-block ! + tftp-packet set-struct + 1 sid +! + d# 69 did ! ( filename$ rrq-pkt/wrq-pkt ) + opcode xw! ( filename$ ) + filename $cstrput ( mode-adr ) + " octet" rot $cstrput ( end-adr ) + tftp-packet - #packet ! +; + +: setup-read-request ( filename$ -- ) + rrq-pkt setup-request + 1 this-block +! +; + +: setup-write-request ( filename$ -- ) + wrq-pkt setup-request +; + +: setup-ack-packet ( -- ) + tftp-packet set-struct + ack-pkt opcode xw! + this-block @ block# xw! + 4 #packet ! + 1 this-block +! +; + +: send-packet ( tftp-adr tftp-len -- ) + ( tftp-adr tftp-len ) sid @ did @ send-udp-packet +; + +0 instance value error-packet \ Buffer address + +: send-error-packet ( src-port -- ) + /tftp-packet allocate-udp is error-packet + did @ >r + ( src-port ) did ! \ set the udp-source-port to the port indicated + \ in the received error packet. + error-packet set-struct + err-pkt opcode xw! + 5 ( Unknown transfer ID ) errorcode xw! + " Unknown source address" errmsg $cstrput ( end-address ) + error-packet tuck - ( packet-adr len ) + send-packet + r> did ! \ restore the previous did + error-packet /tftp-packet free-udp +; + +\ Check source port against destination id. +\ If it mismatches, error unless did is currently 69 +: bad-src-port? ( src-port -- error ) \ assumes the-struct is UDP packet + dup did @ <> if ( src-port ) + did @ d# 69 = if \ Lock on to his port ( src-port ) + did ! ( ) + bootnet-debug if ." Locking onto TFTP server" cr then + lock-udp-address \ Lock onto his addresses ( ) + else ( src-port ) + send-error-packet ( ) + true exit ( true ) + then ( ) + else ( src-port ) + drop ( ) + then ( ) + false +; + +\ Check block number. Assumes the-struct is TFTP packet. +: bad-block#? ( -- error? ) block# xw@ this-block @ <> ; + +: send-current-packet ( -- ) tftp-packet #packet @ send-packet ; + +defer handle-tftp +headers +: (handle-tftp) ( tftp-adr len -- ) + bootnet-debug if + ." Bad TFTP source port; sending TFTP error packet" cr + then + 2drop +; +' (handle-tftp) is handle-tftp +headerless + +: receive-tftp-packet ( -- true | tftp-packet-adr tftp-len false ) + begin + sid @ receive-udp-packet if true exit then ( tftp-adr,len src-port ) + 2 pick set-struct ( tftp-adr,len src-port ) + bad-src-port? ( tftp-adr,len flag ) + while ( tftp-adr,len ) + \ Shut down lingering TFTP server processes from our old attempts + handle-tftp ( ) + repeat ( tftp-adr,len ) + false +; + +: receive-data-packet ( -- true | data-adr data-len false ) + update-timeout + + \ We don't retry at this level because all possible errors here + \ cause a resend of the request packet. + + receive-tftp-packet if true exit then ( tftp-adr tftp-len ) + + \ Check packet type + opcode xw@ err-pkt = if .merror 2drop true exit then + opcode xw@ data-pkt <> if ." Got a non-data packet" 2drop true exit then + bad-block#? if 2drop true exit then ( tftp-adr tftp-len ) + + false is first-try? ( tftp-adr tftp-len ) + 4 /string false ( data-adr,len false ) + compute-srtt ( data-adr,len false ) +; + +: ?try-broadcast ( -- ) + first-try? if + bootnet-debug if + ." Trying a different TFTP server by broadcasting" cr + then + clear-his-address + \ Relock the destination port number + d# 69 did ! + \ Give the server time to come back up. Delay + \ re-broadcasting to avoid network congestion. + #retries @ if 5000 ms then + else + bootnet-debug if ." TFTP timeout - retrying" cr then + then +; + +: .receive-failed ( -- ) ." Receive failed" cr ; + +: get-data-packet ( adr -- adr' more? ) + #retries off + begin + opcode xw@ err-pkt <> if \ if this is an error packet, do not resend + \ it. The error packet had been sent out + \ in receive-tftp-packet already. + send-current-packet ( adr ) + then + receive-data-packet ( adr [ data-adr data-len ] flag ) + while ( adr ) + ?try-broadcast ( adr ) + 1 #retries +! + too-many-tries? if .receive-failed false exit then + repeat ( adr data-adr data-len ) + + \ Copy data from packet to our buffer at addr + >r over r@ move ( adr ) + + r@ + ( adr' ) + r> d# 512 = ( adr' more? ) +; + +: tftp-init ( -- ) + true is first-try? + /tftp-packet allocate-udp is tftp-packet + + \ Use user port numbers to avoid reserved system ports + get-msecs h# 0ffff and d# 2048 or sid ! \ "random" number +; +: tftp-close ( -- ) tftp-packet /tftp-packet free-udp ; + +headers +: tftpread ( adr filename$ -- size ) + bootnet-debug if ." TFTP protocol: Reading file: " 2dup type cr then + tftp-init ( adr filename$ ) + setup-read-request ( adr ) + dup ( adr adr ) + begin ( adr adr ) + get-data-packet ( adr adr' more? ) + while ( adr adr' ) + show-progress setup-ack-packet + repeat ( adr adr' ) + \ Send the final acknowledge. Don't send if receive error. + too-many-tries? 0= if + setup-ack-packet + send-current-packet + then + swap - + \ set ip addresses, for some proms ( client,server,router) + \ By default, setup-ip-attr is a noop. + setup-ip-attr + too-many-tries? tftp-close abort" tftp failed" +; + +headerless + +\ previous definitions + +\ *** New routines for tftpwrite *** + +: receive-ack-packet ( -- true | ack-packet-adr ack-len false ) + receive-tftp-packet if true exit then ( tftp-adr,len ) + + \ Check packet type + opcode xw@ err-pkt = if .merror 2drop true exit then + opcode xw@ ack-pkt <> if ." Got a non-ack packet" 2drop true exit then + bad-block#? if 2drop true exit then ( tftp-adr,len ) + 4 /string false ( ack-adr,len false ) +; + +: get-ack-packet ( -- ack-received? ) + #retries off + begin + send-current-packet + receive-ack-packet ( [ ack-packet-adr ack-len ] flag ) + while + 1 #retries +! + +\ XXX we need to be able to retry the whole transaction at a higher +\ level, so we should exit more gracefully than we do here. + + too-many-tries? if .receive-failed false exit then + repeat 2drop true +; + +: setup-data-packet ( adr sizeleft -- adr' sizeleft' done? ) + dup 0< if true exit then + tftp-packet set-struct + data-pkt opcode xw! + 1 this-block +! + this-block @ block# xw! ( adr sizeleft ) + 2dup d# 512 min ( adr sizeleft adr size<=512 ) + dup 4 + #packet ! + data swap move + d# 512 - \ decrease size remaining + swap d# 512 + swap \ adjust addr for remaining data + false +; + +\ also forth definitions + +headers + +: tftpwrite ( adr size filename$ -- ) + tftp-init ( adr size filename$ ) + setup-write-request ( adr size ) + begin + get-ack-packet if + setup-data-packet ( adr' sizeleft' done? ) + else true \ error exit from loop + then + until 2drop + tftp-close +; +\ LICENSE_BEGIN +\ Copyright (c) 2006 FirmWorks +\ +\ Permission is hereby granted, free of charge, to any person obtaining +\ a copy of this software and associated documentation files (the +\ "Software"), to deal in the Software without restriction, including +\ without limitation the rights to use, copy, modify, merge, publish, +\ distribute, sublicense, and/or sell copies of the Software, and to +\ permit persons to whom the Software is furnished to do so, subject to +\ the following conditions: +\ +\ The above copyright notice and this permission notice shall be +\ included in all copies or substantial portions of the Software. +\ +\ THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, +\ EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF +\ MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND +\ NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE +\ LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION +\ OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION +\ WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. +\ +\ LICENSE_END Added: ofw/inetv6/udp.fth =================================================================== --- ofw/inetv6/udp.fth (rev 0) +++ ofw/inetv6/udp.fth 2007-08-02 21:37:59 UTC (rev 518) @@ -0,0 +1,147 @@ +\ See license at end of file +purpose: Simple User Datagram Protocol (UDP) implementation +decimal + +headers +\ udp-checksum? controls checksum calculation +\ of outgoing UPD Packets +\ 0 value udp-checksum? +headerless +d# 17 constant UDP + +instance variable my-udp-port +instance variable his-udp-port + +struct ( udp-header ) + 2 sfield udp-source-port + 2 sfield udp-dest-port + 2 sfield udp-length + 2 sfield udp-checksum +constant /udp-header + +struct ( udp-pseudo-hdr ) + /i field udp-src-addr + /i field udp-dst-addr + 2 field udp-protocol-id + 2 field udp-len-copy +constant /udp-pseudo-hdr + +/udp-pseudo-hdr instance buffer: udp-pseudo-hdr + +0 instance value udp-len + +\ Assumes the-struct is the UDP packet. +: fill-udp-pseudo-hdr ( -- ) + /ip-header negate +struct + udp-pseudo-hdr ( udp-pseudo-addr ) + ip-source-addr over udp-src-addr copy-ip-addr ( udp-pseudo-addr ) + ip-dest-addr over udp-dst-addr copy-ip-addr ( udp-pseudo-addr ) + UDP over udp-protocol-id xw! ( udp-pseudo-addr ) + /ip-header +struct ( udp-pseudo-addr ) + udp-length xw@ swap udp-len-copy xw! ( ) +; + +\ Assumes the-struct is the UDP packet. +: calc-udp-checksum ( -- checksum ) + fill-udp-pseudo-hdr + 0 udp-pseudo-hdr /udp-pseudo-hdr (oc-checksum) ( cksum ) + 0 udp-checksum xw! + the-struct udp-length xw@ oc-checksum +; + +headers +: send-udp-packet ( data-addr data-len src-port dst-port -- ) + 2swap swap /udp-header - set-struct -rot ( data-len src-port dst-port ) + udp-dest-port xw! udp-source-port xw! ( data-len ) + /udp-header + dup udp-length xw! ( udp-len ) + 0 udp-checksum xw! ( udp-len ) + + udp-checksum? if ( udp-len ) + calc-udp-checksum udp-checksum xw! ( udp-len ) + then ( udp-len ) + + the-struct swap UDP send-ip-packet ( ) +; +: allocate-udp ( payload-len -- payload-adr ) + /udp-header + allocate-ip /udp-header + +; +: free-udp ( payload-adr payload-len -- ) + /udp-header negate /string free-ip +; +headerless + +: bad-udp-checksum? ( -- bad? ) + udp-checksum xw@ dup if ( checksum ) + calc-udp-checksum <> ( bad? ) + then ( bad? ) +; + +: lock-udp-address ( -- ) lock-ip-address ; + +defer handle-udp ( adr len src-port dst-port -- ) +defer handle-bad-udp ( adr len src-port -- ) +headers +: (handle-udp) ( adr len src-port dst-port -- ) + bootnet-debug if + 2dup swap + ." (Discarding UDP packet, source port: " u. ." dest port: " u. ." )" cr + then + 4drop +; +' (handle-udp) is handle-udp +: (handle-bad-udp) ( adr len src-port -- ) + bootnet-debug if + dup + ." (Discarding UDP packet with bad checksum, source port: " u. ." )" cr + then + 3drop +; +' (handle-bad-udp) is handle-bad-udp +headerless + +: udp-payload ( len -- adr' len' src-port ) + drop + the-struct udp-length xw@ /udp-header /string udp-source-port xw@ +; +headers +: receive-udp-packet ( dst-port -- true | udp-packet-adr,len src-port false ) + begin ( port ) + UDP receive-ip-packet if drop true exit then ( port udp-adr,len ) + swap set-struct ( port len ) + bad-udp-checksum? if ( port len ) + udp-payload handle-bad-udp ( port ) + drop true exit \ Discard garbled packet and retry + else ( port len ) + over udp-dest-port xw@ = if ( port len ) + true ( port len true ) + else ( port len ) + udp-payload udp-dest-port xw@ handle-udp ( port ) + false ( port false ) + then ( port [ len ] flag ) + then ( port [ len ] flag ) + until ( port len ) + nip udp-payload false ( adr len port false ) +; +\ LICENSE_BEGIN +\ Copyright (c) 2006 FirmWorks +\ +\ Permission is hereby granted, free of charge, to any person obtaining +\ a copy of this software and associated documentation files (the +\ "Software"), to deal in the Software without restriction, including +\ without limitation the rights to use, copy, modify, merge, publish, +\ distribute, sublicense, and/or sell copies of the Software, and to +\ permit persons to whom the Software is furnished to do so, subject to +\ the following conditions: +\ +\ The above copyright notice and this permission notice shall be +\ included in all copies or substantial portions of the Software. +\ +\ THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, +\ EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF +\ MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND +\ NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE +\ LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION +\ OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION +\ WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. +\ +\ LICENSE_END Added: ofw/inetv6/udpv6.fth =================================================================== --- ofw/inetv6/udpv6.fth (rev 0) +++ ofw/inetv6/udpv6.fth 2007-08-02 21:37:59 UTC (rev 518) @@ -0,0 +1,167 @@ +\ See license at end of file +purpose: Simple User Datagram Protocol version 6 (UDP) implementation +decimal + +headerless + +[ifndef] include-ipv4 +struct ( udp-header ) + 2 sfield udp-source-port + 2 sfield udp-dest-port + 2 sfield udp-length + 2 sfield udp-checksum +constant /udp-header + +: clear-his-address ( -- ) ; +: lock-udp-address ( -- ) ; +: send-udp-packet ( data-addr data-len src-port dst-port -- ) .ipv4-not-supported ; +: allocate-udp ( payload-len -- payload-adr ) .ipv4-not-supported ; +: free-udp ( payload-adr payload-len -- ) .ipv4-not-supported ; +[then] + +struct ( udpv6-pseudo-hdr ) + /ipv6 field udpv6-src-addr + /ipv6 field udpv6-dst-addr + 4 field udpv6-len-copy + 4 field udpv6-protocol-id +constant /udpv6-pseudo-hdr + +/udpv6-pseudo-hdr instance buffer: udpv6-pseudo-hdr + +\ Assumes the-struct is the UDP packet. +: fill-udpv6-pseudo-hdr ( -- ) + /ipv6-header negate +struct + udpv6-pseudo-hdr ( udp-pseudo-addr ) + my-ipv6-addr over udpv6-src-addr copy-ipv6-addr ( udp-pseudo-addr ) + his-ipv6-addr over udpv6-dst-addr copy-ipv6-addr ( udp-pseudo-addr ) + IP_HDR_UDP over udpv6-protocol-id xl! ( udp-pseudo-addr ) + /ipv6-header +struct ( udp-pseudo-addr ) + udp-length xw@ swap udpv6-len-copy xl! ( ) +; + +\ Assumes the-struct is the UDP packet. +: calc-udpv6-checksum ( -- checksum ) + fill-udpv6-pseudo-hdr + 0 udpv6-pseudo-hdr /udpv6-pseudo-hdr (oc-checksum) ( cksum ) + 0 udp-checksum xw! + the-struct udp-length xw@ oc-checksum +; + +headers +: send-udpv6-packet ( data-addr data-len src-port dst-port -- ) + 2swap swap /udp-header - set-struct -rot ( data-len src-port dst-port ) + udp-dest-port xw! udp-source-port xw! ( data-len ) + /udp-header + dup udp-length xw! ( udp-len ) + 0 udp-checksum xw! ( udp-len ) + + calc-udpv6-checksum udp-checksum xw! ( udp-len ) + + the-struct swap IP_HDR_UDP send-ipv6-packet ( ) +; +: allocate-udpv6 ( payload-len -- payload-adr ) + /udp-header + allocate-ipv6 /udp-header + +; +: free-udpv6 ( payload-adr payload-len -- ) + /udp-header negate /string free-ipv6 +; + +: send-udp-packet ( data-addr data-len src-port dst-port -- ) + use-ipv6? if send-udpv6-packet else send-udp-packet then +; +: allocate-udp ( payload-len -- payload-adr ) + use-ipv6? if allocate-udpv6 else allocate-udp then +; +: free-udp ( payload-adr payload-len -- ) + use-ipv6? if free-udpv6 else free-udp then +; +headerless + +: bad-udpv6-checksum? ( -- bad? ) + udp-checksum xw@ dup if ( checksum ) + calc-udpv6-checksum <> ( bad? ) + then ( bad? ) +; + +: lock-udpv6-address ( -- ) lock-ipv6-address ; +: lock-udp-address ( -- ) + use-ipv6? if lock-udpv6-address else lock-udp-address then +; + +[ifndef] include-ipv4 +defer handle-udp ( adr len src-port dst-port -- ) +defer handle-bad-udp ( adr len src-port -- ) +headers +: receive-udp-packet ( dst-port -- true ) drop true ; +: (handle-udp) ( adr len src-port dst-port -- ) + bootnet-debug if + 2dup swap + ." (Discarding UDP packet, source port: " u. ." dest port: " u. ." )" cr + then + 4drop +; +' (handle-udp) is handle-udp +: (handle-bad-udp) ( adr len src-port -- ) + bootnet-debug if + dup + ." (Discarding UDP packet with bad checksum, source port: " u. ." )" cr + then + 3drop +; +' (handle-bad-udp) is handle-bad-udp + +headerless + +: udp-payload ( len -- adr' len' src-port ) + drop + the-struct udp-length xw@ /udp-header /string udp-source-port xw@ +; +[then] + +headers +: receive-udp-packetv6 ( dst-port -- true | udp-packet-adr,len src-port false ) + begin ( port ) + IP_HDR_UDP receive-ip-packet if drop true exit then ( port udp-adr,len ) + swap set-struct ( port len ) + bad-udpv6-checksum? if ( port len ) + udp-payload handle-bad-udp ( port ) + drop true exit \ Discard garbled packet and retry + else ( port len ) + over udp-dest-port xw@ = if ( port len ) + true ( port len true ) + else ( port len ) + udp-payload udp-dest-port xw@ handle-udp ( port ) + false ( port false ) + then ( port [ len ] flag ) + then ( port [ len ] flag ) + until ( port len ) + nip udp-payload false ( adr len port false ) +; + +: receive-udp-packet ( dst-port -- true | udp-packet-adr,len src-port false ) + use-ipv6? if receive-udp-packetv6 else receive-udp-packet then +; + + +\ LICENSE_BEGIN +\ Copyright (c) 2006 FirmWorks +\ +\ Permission is hereby granted, free of charge, to any person obtaining +\ a copy of this software and associated documentation files (the +\ "Software"), to deal in the Software without restriction, including +\ without limitation the rights to use, copy, modify, merge, publish, +\ distribute, sublicense, and/or sell copies of the Software, and to +\ permit persons to whom the Software is furnished to do so, subject to +\ the following conditions: +\ +\ The above copyright notice and this permission notice shall be +\ included in all copies or substantial portions of the Software. +\ +\ THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, +\ EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF +\ MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND +\ NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE +\ LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION +\ OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION +\ WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. +\ +\ LICENSE_END Added: ofw/inetv6/watchnet.fth =================================================================== --- ofw/inetv6/watchnet.fth (rev 0) +++ ofw/inetv6/watchnet.fth 2007-08-02 21:37:59 UTC (rev 518) @@ -0,0 +1,70 @@ +\ See license at end of file +purpose: watch-net network debugging command + +headerless +0 value net-ih +0 value max-packet +0 value packet-buf +: (watch-net) ( ihandle -- ) + to net-ih + " max-frame-size" net-ih ihandle>phandle get-package-property if ( ) + d# 2000 ( length ) + else ( adr len ) + get-encoded-int ( length ) + then ( length ) + to max-packet ( ) + max-packet alloc-mem to packet-buf + ." Watching network traffic." cr + ." '.' is a good packet, 'X' is a bad packet. Type any key to stop." cr + begin + packet-buf max-packet " read" net-ih $call-method case + -2 of endof + -1 of ." X" endof + ." ." + endcase + key? until key drop cr + packet-buf max-packet free-mem + net-ih close-dev +; +headers + +: watch-net ( [ "name" ] -- ) + parse-word dup 0= if 2drop " net" then ( name ) + + 2dup " watch-net" execute-device-method if + 2drop + else + "temp place + " :promiscuous" "temp $cat + "temp count open-dev + dup 0= abort" Can't open network device" + (watch-net) + then +; + +: watch-net-all ( -- ) + optional-arg-or-/$ " watch-net" execute-all-methods +; +\ LICENSE_BEGIN +\ Copyright (c) 2006 FirmWorks +\ +\ Permission is hereby granted, free of charge, to any person obtaining +\ a copy of this software and associated documentation files (the +\ "Software"), to deal in the Software without restriction, including +\ without limitation the rights to use, copy, modify, merge, publish, +\ distribute, sublicense, and/or sell copies of the Software, and to +\ permit persons to whom the Software is furnished to do so, subject to +\ the following conditions: +\ +\ The above copyright notice and this permission notice shall be +\ included in all copies or substantial portions of the Software. +\ +\ THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, +\ EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF +\ MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND +\ NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE +\ LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION +\ OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION +\ WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. +\ +\ LICENSE_END

1 0

r517 - dev/olpc/spiflash
by svn＠openbios.org 02 Aug '07

02 Aug '07

Author: wmb Date: 2007-08-02 12:32:34 +0200 (Thu, 02 Aug 2007) New Revision: 517 Modified: dev/olpc/spiflash/spiui.fth Log: OLPC trac 2636 - Increase the inter-chunk delay to 200 mS, because 100 mS isn't entirely reliable. Modified: dev/olpc/spiflash/spiui.fth =================================================================== --- dev/olpc/spiflash/spiui.fth 2007-08-02 10:24:38 UTC (rev 516) +++ dev/olpc/spiflash/spiui.fth 2007-08-02 10:32:34 UTC (rev 517) @@ -248,10 +248,9 @@ \ It works around the problem that continuous CPU access to the \ SPI FLASH starves the EC of instruction fetch cycles, often \ causing it to turn off the system. - rom-va flash-buf /flash 0 do rom-va i + flash-buf i + h# 1.0000 lmove - d# 100 ms + d# 200 ms h# 1.0000 +loop \ Replace the manufacturing data block with all FF

1 0

r516 - cpu/x86/pc/olpc
by svn＠openbios.org 02 Aug '07

02 Aug '07

Author: wmb Date: 2007-08-02 12:24:38 +0200 (Thu, 02 Aug 2007) New Revision: 516 Modified: cpu/x86/pc/olpc/versions.fth Log: Version q2c22. Modified: cpu/x86/pc/olpc/versions.fth =================================================================== --- cpu/x86/pc/olpc/versions.fth 2007-08-02 10:23:58 UTC (rev 515) +++ cpu/x86/pc/olpc/versions.fth 2007-08-02 10:24:38 UTC (rev 516) @@ -2,7 +2,7 @@ \ The overall firmware revision macro: FW_MAJOR C -macro: FW_MINOR 21 +macro: FW_MINOR 22 \ The EC microcode macro: EC_VERSION c20

1 0

r515 - dev/olpc/spiflash
by svn＠openbios.org 02 Aug '07

02 Aug '07

Author: wmb Date: 2007-08-02 12:23:58 +0200 (Thu, 02 Aug 2007) New Revision: 515 Modified: dev/olpc/spiflash/spiui.fth Log: SPI FLASH selftest - OLPC trac 2636 - Workaround a hardware design deficiency by throttling access to the SPI FLASH in the /flash selftest method. If the CPU accesses the SPI FLASH too frequently, the EC apparently can't do its instruction fetches, and the system resets. The workaround is to access the SPI FLASH in 64K chunks, waiting 100 mS between chunks. Modified: dev/olpc/spiflash/spiui.fth =================================================================== --- dev/olpc/spiflash/spiui.fth 2007-08-02 05:35:04 UTC (rev 514) +++ dev/olpc/spiflash/spiui.fth 2007-08-02 10:23:58 UTC (rev 515) @@ -243,8 +243,17 @@ 0 value rom-va : selftest ( -- error? ) rom-va 0= if rom-pa /flash root-map-in to rom-va then - rom-va flash-buf /flash move + \ This is a slower version of "rom-va flash-buf /flash lmove" + \ It works around the problem that continuous CPU access to the + \ SPI FLASH starves the EC of instruction fetch cycles, often + \ causing it to turn off the system. + rom-va flash-buf + /flash 0 do + rom-va i + flash-buf i + h# 1.0000 lmove + d# 100 ms + h# 1.0000 +loop + \ Replace the manufacturing data block with all FF flash-buf mfg-data-offset + /flash-block h# ff fill

1 0

r514 - cpu/x86/pc/olpc
by svn＠openbios.org 02 Aug '07

02 Aug '07

Author: wmb Date: 2007-08-02 07:35:04 +0200 (Thu, 02 Aug 2007) New Revision: 514 Modified: cpu/x86/pc/olpc/versions.fth Log: q2c21 Modified: cpu/x86/pc/olpc/versions.fth =================================================================== --- cpu/x86/pc/olpc/versions.fth 2007-08-02 05:26:07 UTC (rev 513) +++ cpu/x86/pc/olpc/versions.fth 2007-08-02 05:35:04 UTC (rev 514) @@ -2,7 +2,7 @@ \ The overall firmware revision macro: FW_MAJOR C -macro: FW_MINOR 20e +macro: FW_MINOR 21 \ The EC microcode macro: EC_VERSION c20

1 0

r513 - dev/olpc/kb3700
by svn＠openbios.org 02 Aug '07

02 Aug '07

Author: wmb Date: 2007-08-02 07:26:07 +0200 (Thu, 02 Aug 2007) New Revision: 513 Modified: dev/olpc/kb3700/battery.fth Log: OLPC watch-battery - OLPC track 2620 - Use EC commands for reading battery status, instead of indexed I/O to EC RAM locations. Modified: dev/olpc/kb3700/battery.fth =================================================================== --- dev/olpc/kb3700/battery.fth 2007-08-01 19:17:30 UTC (rev 512) +++ dev/olpc/kb3700/battery.fth 2007-08-02 05:26:07 UTC (rev 513) @@ -11,16 +11,23 @@ : bat-b@ h# f900 + ec@ ; : bat-w@ dup 1+ bat-b@ swap bat-b@ bwjoin ; : eram-w@ h# f400 + dup 1+ ec@ swap ec@ bwjoin ; -: uvolt@ 0 bat-w@ d# 9760 d# 32 */ ; -: cur@ 2 bat-w@ wextend d# 15625 d# 120 */ ; \ Base unit for temperature is 1/256 degrees C : >degrees-c 7 rshift 1+ 2/ ; \ Round to nearest degree -: pcb-temp 8 bat-w@ >degrees-c ; -: bat-temp 6 bat-w@ >degrees-c ; : .% ( n -- ) .d ." %" ; -: soc h# 10 bat-b@ ; +\ : uvolt@ 0 bat-w@ d# 9760 d# 32 */ ; +\ : cur@ 2 bat-w@ wextend d# 15625 d# 120 */ ; +\ : pcb-temp 8 bat-w@ >degrees-c ; +\ : bat-temp 6 bat-w@ >degrees-c ; +\ : soc h# 10 bat-b@ ; : bat-state h# 11 bat-b@ ; : bat-cause@ h# 70 bat-b@ ; + +: uvolt@ bat-voltage@ d# 9760 d# 32 */ ; +: cur@ bat-current@ wextend d# 15625 d# 120 */ ; +: pcb-temp ambient-temp@ >degrees-c ; +: bat-temp bat-temp@ >degrees-c ; +: soc bat-soc@ ; + string-array bat-causes ( 00) ," " ( 01) ," Bus Stuck at Zero" @@ -50,10 +57,20 @@ ," abnormal: " end-string-array -: .bat-state - bat-state dup bat-states count type - 8 = if .bat-cause then +: .bat-status + bat-status@ + ." AC " dup h# 10 and if ." on " else ." off " then + + dup 1 and if + dup 2 and if ." Battery full " then + dup 4 and if ." Battery low " then + dup 8 and if ." Battery destroyed " then + else + ." No battery" + then + drop ; + : .milli ( -- ) push-decimal dup abs d# 10,000 / <# u# u# [char] . hold u#s swap sign u#> type @@ -65,7 +82,7 @@ uvolt@ .milli ." V " cur@ .milli ." A " bat-temp .d ." C " - .bat-state + .bat-status ." (PCB " pcb-temp .d ." C)" ; : watch-battery ( -- )

1 0

Re: [OpenBIOS] [Qemu-devel] IBM makes AIX 6 beta available for download for everyone
by Blue Swirl 01 Aug '07

01 Aug '07

The correct place for these questions would be the OpenBIOS list (blatantly cross-posted). On 7/30/07, Andreas Färber <andreas.faerber(a)web.de> wrote: > > Am 19.07.2007 um 09:23 schrieb Natalia Portillo: > > > El jue, 19-07-2007 a las 00:46 +0200, Andreas Färber escribió: > >> Am 18.07.2007 um 18:26 schrieb Blue Swirl: > >> > >>>>> It looks like open hack'ware is pretty much stalled, so its hard > >>>>> telling > >>>>> what progress will be made futurewise. > >>>> > >>>> Might it be possible to replace it with OpenBIOS? > >>> > >>> Sure, and as both are GPL useful, code can be shared. But some PPC > >>> developers are needed. It may still be easier to fix the OHW bugs > >>> than > >>> start over anew. > >> > >> Not sure I understand... I thought Open Firmware was based on > >> platform independent Forth code? > >> I'm running on ppc64 and could try to compile something under Linux > >> in case that's the problem. > > Yes, OF is basically a Forth-interpreter. > > Of course this Forth-interpreter is in C and compile to machine > > code :p > > Yes, that is obvious. Not so obvious was what ppc *developers* were > needed for. > I got the other answer afterwards saying that HFS etc. support needed > to be added. > > > > Try to compile OpenBIOS under Linux/PPC (using 32bit compiler, not > > ppc64) and comment us. > > I tried SVN HEAD of both fcode-utils and openbios-devel. > > OpenBIOS supposedly has support for ppc and cross-ppc archs but that > is not true. It currently only has support for cross-ppc (for the old > PearPC emulator it seems). I copied these files as ppc_config.xml and > ppc_rules.xml respectively to get the ppc target, in ppc_rules.xml > changed the tool names to use the standard gcc etc. and was able to > compile okay. Products based on this unmodified configuration were > among others an openbios-pearpc.elf file - I thus changed ppc_rom.bin > in some ppc files to this filename. Launching qemu-system-sparc -boot > d -cdrom /dev/cdrom with a Debian Etch DVD inserted resulted in an > opcode error. My guess thus is that this OpenBIOS file is not suited > for qemu in that configuration? > > Some observations that might be of interest: > - OpenBIOS has support for some (not all) PowerPC processors > according to some Readme > - it specifically mentions ppc/AIX and has some apparent IBM > contributions despite the missing ppc target > - the cross-ppc config mentions HFS and HFSP which I guess refer to > HFS and HFS+ filesystems respectively (HFS was set to false, HFSP to > true) > > Maybe someone can shed some more light on what exactly needs to be > changed config-wise or is missing in OpenBIOS or qemu in order to > boot AIX 6 or any Linux. > > Andreas > >

1 0

r512 - cpu/x86/pc/olpc
by svn＠openbios.org 01 Aug '07

01 Aug '07

Author: rsmith Date: 2007-08-01 21:17:30 +0200 (Wed, 01 Aug 2007) New Revision: 512 Modified: cpu/x86/pc/olpc/versions.fth Log: OLPC: Updater version number to q2c20e Modified: cpu/x86/pc/olpc/versions.fth =================================================================== --- cpu/x86/pc/olpc/versions.fth 2007-08-01 08:32:03 UTC (rev 511) +++ cpu/x86/pc/olpc/versions.fth 2007-08-01 19:17:30 UTC (rev 512) @@ -2,7 +2,7 @@ \ The overall firmware revision macro: FW_MAJOR C -macro: FW_MINOR 21 +macro: FW_MINOR 20e \ The EC microcode macro: EC_VERSION c20

1 0

r511 - cpu/x86/pc/olpc
by svn＠openbios.org 01 Aug '07

01 Aug '07

Author: wmb Date: 2007-08-01 10:32:03 +0200 (Wed, 01 Aug 2007) New Revision: 511 Modified: cpu/x86/pc/olpc/versions.fth Log: Version Q2C21. Modified: cpu/x86/pc/olpc/versions.fth =================================================================== --- cpu/x86/pc/olpc/versions.fth 2007-08-01 08:25:31 UTC (rev 510) +++ cpu/x86/pc/olpc/versions.fth 2007-08-01 08:32:03 UTC (rev 511) @@ -2,7 +2,7 @@ \ The overall firmware revision macro: FW_MAJOR C -macro: FW_MINOR 20 +macro: FW_MINOR 21 \ The EC microcode macro: EC_VERSION c20

1 0

r510 - cpu/x86/pc/olpc dev/olpc/cafenand
by svn＠openbios.org 01 Aug '07

01 Aug '07

Author: wmb Date: 2007-08-01 10:25:31 +0200 (Wed, 01 Aug 2007) New Revision: 510 Modified: cpu/x86/pc/olpc/copynand.fth dev/olpc/cafenand/badblock.fth dev/olpc/cafenand/cafenand.fth Log: OLPC copy-nand - OLPC trac 2614. Made copy-nand abort not only on a CRC mismatch, but also on a NAND write error. Modified: cpu/x86/pc/olpc/copynand.fth =================================================================== --- cpu/x86/pc/olpc/copynand.fth 2007-08-01 03:15:29 UTC (rev 509) +++ cpu/x86/pc/olpc/copynand.fth 2007-08-01 08:25:31 UTC (rev 510) @@ -148,7 +148,8 @@ (cr i . read-image-block i ?check-crc - load-base " copy-block" nandih $call-method + load-base " copy-block" nandih $call-method ( error? ) + " Error writing to NAND FLASH" ?nand-abort loop cr ." Filling with cleanmarkers ..." Modified: dev/olpc/cafenand/badblock.fth =================================================================== --- dev/olpc/cafenand/badblock.fth 2007-08-01 03:15:29 UTC (rev 509) +++ dev/olpc/cafenand/badblock.fth 2007-08-01 08:25:31 UTC (rev 510) @@ -132,7 +132,10 @@ dup if ( signature$ page# ) dup erase-block ( signature$ page# ) bbt over /bbt /page / bounds ?do ( signature$ page# adr ) - dup i write-page ( signature$ page# adr ) + dup i write-page if ( signature$ page# adr ) + ." Error writing Bad Block Table - page# " i .x cr + 3drop unloop exit + then /page + ( signature$ page# adr' ) loop ( signature$ page# adr' ) drop ( signature$ page# ) @@ -253,13 +256,15 @@ over block-bad? if 3drop 0 exit then then - dup >r ( adr page# #pages r: #pages ) - bounds ?do ( adr ) - \ XXX need some error handling - dup i write-page ( adr ) - /page + ( adr' ) - loop ( adr ) - drop r> + over >r dup >r ( adr page# #pages r: page# #pages ) + bounds ?do ( adr r: page# #pages ) + dup i write-page if ( adr r: page# #pages ) + drop r> drop i r> - ( #written ) + unloop exit + then ( adr r: page# #pages ) + /page + ( adr' r: page# #pages ) + loop ( adr r: page# #pages ) + drop r> r> drop ( #pages ) ; : erase-blocks ( page# #pages -- #pages ) @@ -364,12 +369,14 @@ : start-scan ( -- ) pages/eblock negate to scan-page# ; \ Must erase all (wipe) first -: copy-block ( adr -- ) +: copy-block ( adr -- error? ) next-page# pages/eblock bounds ?do ( adr ) - dup i write-page ( adr ) + dup i write-page if ( adr ) + drop true unloop exit ( true ) + then ( adr ) /page + ( adr' ) loop ( adr ) - drop ( ) + drop false ( false ) ; : put-cleanmarkers ( -- ) Modified: dev/olpc/cafenand/cafenand.fth =================================================================== --- dev/olpc/cafenand/cafenand.fth 2007-08-01 03:15:29 UTC (rev 509) +++ dev/olpc/cafenand/cafenand.fth 2007-08-01 08:25:31 UTC (rev 510) @@ -119,7 +119,7 @@ \ : read-id ( -- ) 0 0 set-page read-id-cmd 0 cmd wait-cmd h# 30 cl@ ; : dma-off ( -- ) 0 h# 40 cl! ; -: wait-write-done ( -- ) +: wait-write-done ( -- error? ) 0 ( status ) begin ( status ) drop ( ) @@ -127,7 +127,8 @@ dup h# 40 and ( status flag ) until ( status ) \ If the value is completely 0 I think it means write protect - 1 and if ." NAND write error" cr then + 1 and 0<> ( error? ) + write-disable ; \ Assumes that the range doesn't straddle a page boundary @@ -149,18 +150,17 @@ dma-off set-page dup datalen ( adr len ) chip h# 2000 + swap move ( ) write-cmd h# 0000.0110 cmd wait-cmd ( ) \ No Auto ECC - wait-write-done - write-disable + wait-write-done ( error? ) + drop ; -: pio-write-page ( adr page# -- ) +: pio-write-page ( adr page# -- error? ) write-enable dma-off ( adr page# ) 0 set-page ( adr ) /page h# e + dup datalen ( adr len ) chip h# 2000 + swap move ( ) write-cmd h# 4800.0110 cmd wait-cmd ( ) \ 4000. Auto ECC, 0800. R/S ECC - wait-write-done - write-disable + wait-write-done ( error? ) ; : read-oob ( page# -- adr ) @@ -228,22 +228,21 @@ set-page ( adr len ) dup false dma-setup ( ) write-cmd h# 110 cmd wait-cmd ( ) - wait-write-done ( ) - dma-release ( ) - write-disable ( ) + wait-write-done ( error? ) + dma-release ( error? ) + drop ; -: dma-write-page ( adr page# -- ) \ Size is fixed +: dma-write-page ( adr page# -- error? ) \ Size is fixed write-enable ( adr page# ) 0 set-page ( adr ) h# 800 h# 80e false dma-setup ( ) write-cmd h# 4800.0110 cmd wait-cmd ( ) \ Auto-ECC, RS, write cmd - wait-write-done ( ) + wait-write-done ( error? ) \ dma-release - write-disable ( ) ; -: write-page ( adr page# -- ) dma-write-page ; +: write-page ( adr page# -- error? ) dma-write-page ; : write-bytes ( adr len page# offset -- ) pio-write-raw ; 3 value #erase-adr-bytes \ Chip dependent @@ -251,8 +250,8 @@ write-enable set-erase-page h# 20.0060 0 #erase-adr-bytes >cmd h# 1d0 cmd - wait-write-done - write-disable + wait-write-done ( error? ) + drop ; : read-id ( -- adr ) 8 0 0 h# c420.0090 0 generic-read ;

1 0

r509 - in cpu/x86/pc: . biosload
by svn＠openbios.org 01 Aug '07

01 Aug '07

Author: wmb Date: 2007-08-01 05:15:29 +0200 (Wed, 01 Aug 2007) New Revision: 509 Modified: cpu/x86/pc/biosload/addrs.fth cpu/x86/pc/biosload/config.fth cpu/x86/pc/biosload/fw.bth cpu/x86/pc/biosload/ofw.bth cpu/x86/pc/elfhdr.fth cpu/x86/pc/resetend.fth Log: Patch from Jens Freimann to support running OFW under LinuxBIOS on QEMU. Modified: cpu/x86/pc/biosload/addrs.fth =================================================================== --- cpu/x86/pc/biosload/addrs.fth 2007-08-01 03:13:15 UTC (rev 508) +++ cpu/x86/pc/biosload/addrs.fth 2007-08-01 03:15:29 UTC (rev 509) @@ -9,9 +9,15 @@ \ copies it to get it out of the way of things like OS load areas. [ifdef] linuxbios-loaded -h# fff8.0000 constant dropin-base \ Location of payload in FLASH -h# 08.0000 constant dropin-size -dropin-base h# 80 + h# 20 + constant ResetBase \ Location of "reset" dropin in ROM + [ifdef] qemu-loaded + \ when running in qemu OFW is not in ROM but loaded to RAM by elfboot + h# 198.0080 constant dropin-base \ Location of payload in RAM + dropin-base h# 20 + constant ResetBase \ Location of "reset" dropin in RAM + [else] + h# fff8.0000 constant dropin-base \ Location of payload in FLASH + dropin-base h# 80 + h# 20 + constant ResetBase \ Location of "reset" dropin in ROM + [then] + h# 08.0000 constant dropin-size [then] \needs dropin-base h# 198.0000 constant dropin-base Modified: cpu/x86/pc/biosload/config.fth =================================================================== --- cpu/x86/pc/biosload/config.fth 2007-08-01 03:13:15 UTC (rev 508) +++ cpu/x86/pc/biosload/config.fth 2007-08-01 03:15:29 UTC (rev 509) @@ -21,6 +21,9 @@ \ - ELF format (no pheader) - ROM - LinuxBIOS direct \ create linuxbios-loaded +\ Load and run in qemu +\ create qemu-loaded + [ifdef] pc-serial create serial-console create pc Modified: cpu/x86/pc/biosload/fw.bth =================================================================== --- cpu/x86/pc/biosload/fw.bth 2007-08-01 03:13:15 UTC (rev 508) +++ cpu/x86/pc/biosload/fw.bth 2007-08-01 03:15:29 UTC (rev 509) @@ -257,7 +257,10 @@ auto-banner? if " Probing" ?type probe-all + \ install-console doesn't work with qemu, use -serial `tty` instead + [ifndef] qemu-loaded " Install console" ?type install-console + [then] banner then Modified: cpu/x86/pc/biosload/ofw.bth =================================================================== --- cpu/x86/pc/biosload/ofw.bth 2007-08-01 03:13:15 UTC (rev 508) +++ cpu/x86/pc/biosload/ofw.bth 2007-08-01 03:15:29 UTC (rev 509) @@ -32,21 +32,25 @@ [ifdef] grub-loaded fload ${BP}/cpu/x86/pc/elfhdr.fth -[ifdef] etherboot-variant - .( --- Saving as ofwnet.elf - GRUB multiboot format) cr - writing ofwnet.elf -[else] - .( --- Saving as ofwgrub.elf - GRUB multiboot format) cr - writing ofwgrub.elf + [ifdef] etherboot-variant + .( --- Saving as ofwnet.elf - GRUB multiboot format) cr + writing ofwnet.elf + [else] + .( --- Saving as ofwgrub.elf - GRUB multiboot format) cr + writing ofwgrub.elf + [then] + elf-header /elf-header ofd @ fputs [then] - elf-header /elf-header ofd @ fputs -[then] [ifdef] linuxbios-loaded .( --- Saving as ofwlb.elf - LinuxBIOS payload format) cr fload ${BP}/cpu/x86/pc/elfhdr.fth writing ofwlb.elf + [ifdef] qemu-loaded + elf-header /elf-header ofd @ fputs + [else] elf-header /elf-header 0 " elf-header" write-dropin + [then] [then] [ifdef] syslinux-loaded @@ -118,4 +122,12 @@ pad 4 ofd @ fputs \ Patch file size pad 4 ofd @ fputs \ Patch memory size [then] + +[ifdef] qemu-loaded + ofd @ fsize pad ! \ file size; store in memory for convenience below + h# 44 ofd @ fseek \ Seek to file size field; see elfhdr.bth + pad 4 ofd @ fputs \ Patch file size + pad 4 ofd @ fputs \ Patch memory size +[then] + ofd @ fclose Modified: cpu/x86/pc/elfhdr.fth =================================================================== --- cpu/x86/pc/elfhdr.fth 2007-08-01 03:13:15 UTC (rev 508) +++ cpu/x86/pc/elfhdr.fth 2007-08-01 03:15:29 UTC (rev 509) @@ -18,6 +18,10 @@ \ elf-header is not a dropin, so we only need to skip OBMD header of reset \ we adjust the load-address below at position 0x40 dropin-base h# 20 + l, \ 0x18 entry point virtual address +[then] +[ifdef] qemu-loaded + \ skip OBMD header but keep elf-header because elfboot in LinuxBIOS needs it + dropin-base h# 20 + l, \ 0x18 entry point virtual address [else] \ Skip this ELF dropin (80) + the OBMD header of the next dropin (20) dropin-base h# 80 + h# 20 + l, \ 0x18 entry point virtual address @@ -29,6 +33,9 @@ h# 20 w, \ 0x2a program header table entry size [ifdef] grub-loaded 1 w, \ 0x2c program header table entry count (one pheader) +[then] +[ifdef] qemu-loaded + 1 w, \ 0x2c program header table entry count (one pheader) [else] 0 w, \ 0x2c program header table entry count (no pheaders) [then] @@ -41,22 +48,39 @@ 1 l, \ 0x34 entry type PT_LOAD h# 54 l, \ 0x38 file offset 0 l, \ 0x3c vaddr +[then] + +[ifdef] qemu-loaded \ Pheader causes elfboot to copy us to RAM + \ 0x34 Pheader + 1 l, \ 0x34 entry type PT_LOAD + 0 l, \ 0x38 file offset + dropin-base 80 - l, \ 0x3c vaddr +[then] + [ifdef] etherboot-variant \ we need to skip what left of elf-hdr. to get it to point to a dropin \ why is it 0x14 ? I would have thought it should be the size of the multiboot header \ which is 0x0c dropin-base h# 14 - l, \ 0x40 paddr \ Where to put the bits +[then] + +[ifdef] qemu-loaded + dropin-base h# 80 - l, \ 0x40 paddr \ Where to put the bits [else] dropin-base l, \ 0x40 paddr \ Where to put the bits [then] h# ffffffff l, \ 0x44 file size \ backpatched later h# ffffffff l, \ 0x48 memory size \ backpatched later + +[ifndef] qemu-loaded 0 l, 0 l, +[then] 7 l, \ 0x4c entry flags RWX 0 l, \ 0x50 alignment \ 0x54 End of pheader - +[then] +[ifdef] grub-loaded \ "Multiboot" header that GRUB looks for h# 1BADB002 , \ 0x54 h# 0 , \ 0x58 Modified: cpu/x86/pc/resetend.fth =================================================================== --- cpu/x86/pc/resetend.fth 2007-08-01 03:13:15 UTC (rev 508) +++ cpu/x86/pc/resetend.fth 2007-08-01 03:15:29 UTC (rev 509) @@ -4,6 +4,7 @@ \ The memory layout information from the start dropin is stored in low \ memory. +[ifndef] qemu-loaded \ Move GDT to low memory. We use the first location at gdt-pa as \ scratch memory for sgdt, and put the actual gdt at gdt-pa + 0x10 gdt-pa # ax mov @@ -30,10 +31,10 @@ \ Next time segment registers are changed, they will be \ reloaded from memory. + \ qemu hangs when trying to do this here asm-base - ResetBase + 7 + h# 60 #) far jmp \ 7-byte instruction \ nop nop nop nop - h# 20 # al mov al h# 80 # out \ begin again h# 68 # ax mov ax ds mov @@ -41,7 +42,10 @@ ax fs mov ax gs mov ax ss mov +[then] + h# 20 # al mov al h# 80 # out + [ifdef] mem-info-pa gdt-pa /page round-up # ax mov \ Current low-memory high water mark ax mem-info-pa 2 la+ #) mov \ Store in memory info area

1 0

r508 - in dev: . olpc/touchpad
by svn＠openbios.org 01 Aug '07

01 Aug '07

Author: wmb Date: 2007-08-01 05:13:15 +0200 (Wed, 01 Aug 2007) New Revision: 508 Modified: dev/i8042.fth dev/olpc/touchpad/touchpad.fth Log: PS2 drivers - Added debugging features to help in debugging ESD-induced resets of the OLPC touchpad. Modified: dev/i8042.fth =================================================================== --- dev/i8042.fth 2007-08-01 03:11:46 UTC (rev 507) +++ dev/i8042.fth 2007-08-01 03:13:15 UTC (rev 508) @@ -19,6 +19,12 @@ 1 " #address-cells" integer-property 0 " #size-cells" integer-property +0 value debug? +also forth definitions +: debug-ps2 ( -- ) true to debug? ; +: undebug-ps2 ( -- ) false to debug? ; +previous definitions + hex [ifndef] $= @@ -97,7 +103,8 @@ headerless : stat@ ( -- byte ) cmd-status-reg rb@ ; -: data@ ( -- byte ) data-port rb@ ; +: data@ ( -- byte ) data-port rb@ debug? if ." <" dup . then ; +: data! ( byte -- ) debug? if ." >" dup . then data-port rb! ; \ *** Following delay can be reduced after testing *** @@ -144,14 +151,16 @@ ; headerless -: put-ctlr-cmd ( cmd -- ) in-wait cmd-status-reg rb! ; +: put-ctlr-cmd ( cmd -- ) + in-wait debug? if ." ^" dup . then cmd-status-reg rb! +; headers : put-data ( data -- ) port if - lock[ h# d4 put-ctlr-cmd in-wait data-port rb! ]unlock + lock[ h# d4 put-ctlr-cmd in-wait data! ]unlock else - in-wait data-port rb! + in-wait data! then ; Modified: dev/olpc/touchpad/touchpad.fth =================================================================== --- dev/olpc/touchpad/touchpad.fth 2007-08-01 03:11:46 UTC (rev 507) +++ dev/olpc/touchpad/touchpad.fth 2007-08-01 03:13:15 UTC (rev 508) @@ -236,6 +236,13 @@ h# cf of decode-pt true exit endof h# ff of decode-gs true exit endof \ h# eb of decode-simultaneous exit endof + h# aa of + 0 d# 28 at-xy red-screen white-letters + ." Unexpected touchpad reset" + white-screen black-letters + cr + start gs-only false exit + endof ( default ) \ If the high bit is set it means it's the first byte \ of a packet. Abort if we don't recognize the type. @@ -379,7 +386,11 @@ background gs-only begin - begin pad? if track then key? until + begin + ['] pad? catch ?dup if .error close true exit then + if track then + key? until + key upc case [char] P of cursor-on

1 0

r507 - ofw/fs/fatfs
by svn＠openbios.org 01 Aug '07

01 Aug '07

Author: wmb Date: 2007-08-01 05:11:46 +0200 (Wed, 01 Aug 2007) New Revision: 507 Modified: ofw/fs/fatfs/bpb.fth ofw/fs/fatfs/fat.fth Log: FAT filesystem - OLPC trac 2609. Fixed FAT32 cluster allocation bug. The "next cluster" field in the fsinfo structure was being treated as a definitive free cluster number, instead of as a hint for where to begin searching. In addition, it was off by one - that field typically contains the number of the most recently written cluster, whereas the code was treating it as the next available cluster number. Modified: ofw/fs/fatfs/bpb.fth =================================================================== --- ofw/fs/fatfs/bpb.fth 2007-07-30 21:08:57 UTC (rev 506) +++ ofw/fs/fatfs/bpb.fth 2007-08-01 03:11:46 UTC (rev 507) @@ -91,21 +91,11 @@ d# 16 constant fat16 d# 32 constant fat32 -: fs-lelop ( adr op -- ) - fsinfo @ 0<> if - over lel@ swap execute swap lel! - true fsinfos-dirty c! - else - 2drop - then -; -: fs-free#+ ( -- ) fs_freecluster# ['] 1+ fs-lelop ; -: fs-free#- ( -- ) fs_freecluster# ['] 1- fs-lelop ; -: fs-#free+ ( -- ) fs_#freeclusters ['] 1+ fs-lelop ; -: fs-#free- ( -- ) fs_#freeclusters ['] 1- fs-lelop ; +: fs-#free+ ( -- ) fs_#freeclusters dup lel@ 1+ swap lel! true fsinfos-dirty c! ; +: fs-#free- ( -- ) fs_#freeclusters dup lel@ 1- swap lel! true fsinfos-dirty c! ; +: fs-free#! ( cluster# -- ) fs_freecluster# lel! true fsinfos-dirty c! ; - \ LICENSE_BEGIN \ Copyright (c) 2006 FirmWorks \ Modified: ofw/fs/fatfs/fat.fth =================================================================== --- ofw/fs/fatfs/fat.fth 2007-07-30 21:08:57 UTC (rev 506) +++ ofw/fs/fatfs/fat.fth 2007-08-01 03:11:46 UTC (rev 507) @@ -179,23 +179,20 @@ max-cl# l@ 1+ fatc-end @ search-up if mark-cluster exit then false ; -: allocate-cluster ( hint-cluster# -- cluster# true | false ) - fsinfo @ 0<> if - fs_#freeclusters lel@ 0= if - drop false - else - fs_freecluster# lel@ max-cl# l@ > if - (allocate-cluster) - dup if fs-#free- then - else - drop fs_freecluster# lel@ mark-cluster - fs-free#+ - fs-#free- - then - then - else - (allocate-cluster) - then +: allocate-cluster ( hint-cluster# -- false | cluster# true ) + fsinfo @ if ( hint ) + fs_#freeclusters lel@ if ( hint ) + fs_freecluster# lel@ max-cl# l@ <= if ( hint ) + drop fs_freecluster# lel@ ( hint' ) + then ( hint ) + (allocate-cluster) ( false | cluster# true ) + dup if over fs-free#! fs-#free- then ( false | cluster# true ) + else ( hint ) + drop false ( false ) + then ( false | cluster# true ) + else ( hint ) + (allocate-cluster) ( false | cluster# true ) + then ( false | cluster# true ) ; \ Frees first-cl# and all clusters linked after it. @@ -205,7 +202,7 @@ while ( cluster# ) dup cluster@ ( cluster# next-cluster# ) 0 rot cluster! ( next-cluster# ) - fs-#free+ + fsinfo @ if fs-#free+ then ( next-cluster# ) repeat drop ?flush-fat-cache

1 0

r506 - cpu/x86/pc/olpc
by svn＠openbios.org 30 Jul '07

30 Jul '07

Author: rsmith Date: 2007-07-30 23:08:57 +0200 (Mon, 30 Jul 2007) New Revision: 506 Modified: cpu/x86/pc/olpc/versions.fth Log: olpc: Update wireless firmware version Modified: cpu/x86/pc/olpc/versions.fth =================================================================== --- cpu/x86/pc/olpc/versions.fth 2007-07-30 18:40:53 UTC (rev 505) +++ cpu/x86/pc/olpc/versions.fth 2007-07-30 21:08:57 UTC (rev 506) @@ -13,4 +13,4 @@ \ The wireless LAN module firmware macro: WLAN_RPM ${WLAN_VERSION}-1.olpc1 -macro: WLAN_VERSION 5.220.10.p5 +macro: WLAN_VERSION 5.110.16.p1

1 0

r505 - cpu/x86/pc/olpc
by svn＠openbios.org 30 Jul '07

30 Jul '07

Author: wmb Date: 2007-07-30 20:40:53 +0200 (Mon, 30 Jul 2007) New Revision: 505 Modified: cpu/x86/pc/olpc/versions.fth Log: Version q2c20 Modified: cpu/x86/pc/olpc/versions.fth =================================================================== --- cpu/x86/pc/olpc/versions.fth 2007-07-30 18:19:56 UTC (rev 504) +++ cpu/x86/pc/olpc/versions.fth 2007-07-30 18:40:53 UTC (rev 505) @@ -2,10 +2,10 @@ \ The overall firmware revision macro: FW_MAJOR C -macro: FW_MINOR 16 +macro: FW_MINOR 20 \ The EC microcode -macro: EC_VERSION c16 +macro: EC_VERSION c20 \ Alternate command for getting EC microcode, for testing new versions. \ Temporarily uncomment the line and modify the path as necessary

1 0

r504 - forth/kernel forth/lib ofw/core
by svn＠openbios.org 30 Jul '07

30 Jul '07

Author: wmb Date: 2007-07-30 20:19:56 +0200 (Mon, 30 Jul 2007) New Revision: 504 Modified: forth/kernel/kernel.fth forth/kernel/sysio.fth forth/lib/loadcomm.fth forth/lib/stringop.fth ofw/core/ofwcore.fth Log: Added string macro expansion to the base build. Modified: forth/kernel/kernel.fth =================================================================== --- forth/kernel/kernel.fth 2007-07-28 17:45:18 UTC (rev 503) +++ forth/kernel/kernel.fth 2007-07-30 18:19:56 UTC (rev 504) @@ -38,6 +38,7 @@ defer resize ( adr #bytes -- adr' ior ) defer sync-cache ( adr len -- ) ' 2drop is sync-cache +defer $getenv ( adr len -- false | adr' len' true ) defer #out ( -- adr ) defer #line ( -- adr ) @@ -50,6 +51,8 @@ : default-type ( adr len -- ) 0 max bounds ?do pause i c@ (emit loop ; +: null-$getenv ( adr len -- true ) 2drop true ; + \ headerless \ from campus version nuser (#out \ number of characters emitted \ headers \ from campus version @@ -61,6 +64,7 @@ ' key1 is key ' (#out is #out ' (#line is #line +' null-$getenv is $getenv decimal Modified: forth/kernel/sysio.fth =================================================================== --- forth/kernel/sysio.fth 2007-07-28 17:45:18 UTC (rev 503) +++ forth/kernel/sysio.fth 2007-07-30 18:19:56 UTC (rev 504) @@ -161,6 +161,10 @@ : sys-sync-cache ( adr len -- ) swap 116 syscall 2drop ; +: sys-$getenv ( adr len -- true | adr' len' false ) + $cstr d# 84 syscall drop retval dup if cscount false else drop true then +; + : install-wrapper-alloc ( -- ) \ Don't use "is" in case a relocation map needs to be allocated first ['] sys-alloc-mem ['] alloc-mem >body >user token! @@ -185,6 +189,7 @@ install-wrapper-alloc \ init-relocation goes here, for versions that need it install-wrapper-key + ['] sys-$getenv is $getenv ; headers Modified: forth/lib/loadcomm.fth =================================================================== --- forth/lib/loadcomm.fth 2007-07-28 17:45:18 UTC (rev 503) +++ forth/lib/loadcomm.fth 2007-07-30 18:19:56 UTC (rev 504) @@ -25,6 +25,7 @@ fload ${BP}/forth/kernel/endian.fth fload ${BP}/forth/lib/strings.fth +fload ${BP}/forth/lib/stringop.fth fload ${BP}/forth/lib/fastspac.fth Modified: forth/lib/stringop.fth =================================================================== --- forth/lib/stringop.fth 2007-07-28 17:45:18 UTC (rev 503) +++ forth/lib/stringop.fth 2007-07-30 18:19:56 UTC (rev 504) @@ -1,10 +1,6 @@ \ See license at end of file purpose: String tools to manipulate OS file pathnames -: $getenv ( adr len -- false | adr' len' true ) - $cstr d# 84 syscall drop retval dup if cscount true then -; - \ head$ is the portion of str3 preceding str2, and tail$ is the portion \ of str3 following str2 : break$ ( str2 str3 -- head$ tail$ ) @@ -38,13 +34,25 @@ ; vocabulary macros -: macro: ( "name" "value" -- ) - also macros definitions create previous definitions 0 parse ", +: $set-macro ( value$ name$ -- ) + warning @ warning off + also macros definitions $header create-cf previous definitions ( value$ ) + warning ! + ", does> ( -- adr len ) count ; +: $get-macro ( name$ -- true | value$ false ) + ['] macros search-wordlist if execute false else true then +; + +: macro: ( "name" "value" -- ) safe-parse-word 0 parse 2swap $set-macro ; + : expansion ( macro-name$ -- macro-value$ ) - 2dup ['] macros search-wordlist if nip nip execute exit then ( name$ ) - $getenv 0= if " " then + 2dup $get-macro if ( name$ ) + $getenv if " " then ( value$ ) + else ( name$ value$ ) + 2nip ( value$ ) + then ( value$ ) ; \ Expand references to environment variables within str1 @@ -82,24 +90,25 @@ : remaining ( -- adr len ) source >in @ /string ; \ The complexity with last-delim is necessary in order to handle the \ case where files" is at the very end of a line. -0 value last-delim +variable last-delim : files" ( "strings" -- adr len ) - 0 to last-delim + last-delim off here begin #remaining if [char] " parse ( adr len ) $, - source drop >in @ + 1- c@ to last-delim + source drop >in @ + 1- c@ last-delim ! then #remaining 0= while - >in @ if last-delim [char] " <> else true then + >in @ if last-delim @ [char] " <> else true then while bl c, refill 0= until then then ( adr ) here over - ; + \ LICENSE_BEGIN \ Copyright (c) 2006 FirmWorks \ Modified: ofw/core/ofwcore.fth =================================================================== --- ofw/core/ofwcore.fth 2007-07-28 17:45:18 UTC (rev 503) +++ ofw/core/ofwcore.fth 2007-07-30 18:19:56 UTC (rev 504) @@ -501,7 +501,7 @@ config-ro ; -: $getenv ( name$ -- true | value$ false ) +: ofw-$getenv ( name$ -- true | value$ false ) 2dup $find-option if ( name$ xt ) nip nip ( xt ) >r r@ get r> decode -null false ( prop$ false ) @@ -3717,6 +3717,7 @@ ['] heap-alloc-mem is alloc-mem ['] heap-free-mem is free-mem ['] resize-memory is resize + ['] ofw-$getenv is $getenv ; headers

1 0

r167 - openbios-devel/arch/sparc32
by svn＠openbios.org 29 Jul '07

29 Jul '07

Author: blueswirl Date: 2007-07-29 22:20:46 +0200 (Sun, 29 Jul 2007) New Revision: 167 Modified: openbios-devel/arch/sparc32/lib.c openbios-devel/arch/sparc32/romvec.c Log: Maximally align allocations Modified: openbios-devel/arch/sparc32/lib.c =================================================================== --- openbios-devel/arch/sparc32/lib.c 2007-07-20 11:23:30 UTC (rev 166) +++ openbios-devel/arch/sparc32/lib.c 2007-07-29 20:20:46 UTC (rev 167) @@ -72,8 +72,7 @@ if( !size ) return NULL; - if( size & 3 ) - size += 4 - (size & 3); + size = (size + 7) & ~7; size += sizeof(alloc_desc_t); /* look in the freelist */ Modified: openbios-devel/arch/sparc32/romvec.c =================================================================== --- openbios-devel/arch/sparc32/romvec.c 2007-07-20 11:23:30 UTC (rev 166) +++ openbios-devel/arch/sparc32/romvec.c 2007-07-29 20:20:46 UTC (rev 167) @@ -416,6 +416,7 @@ { static unsigned int next_free_address = 0xFFEDA000; + size = (size + 7) & ~7; totmap[0].num_bytes -= size; DPRINTF("obp_dumb_memalloc req 0x%x of %d at 0x%x\n", va, size, totmap[0].num_bytes);

1 0

r503 - cpu/x86/pc/olpc
by svn＠openbios.org 28 Jul '07

28 Jul '07

Author: wmb Date: 2007-07-28 19:45:18 +0200 (Sat, 28 Jul 2007) New Revision: 503 Modified: cpu/x86/pc/olpc/mfgtree.fth Log: OLPC - "invent" SN (0) and U# (0) properties in /mfg-data for systems that have no manufacturing data. Modified: cpu/x86/pc/olpc/mfgtree.fth =================================================================== --- cpu/x86/pc/olpc/mfgtree.fth 2007-07-27 05:29:41 UTC (rev 502) +++ cpu/x86/pc/olpc/mfgtree.fth 2007-07-28 17:45:18 UTC (rev 503) @@ -12,7 +12,18 @@ >r encode-bytes r> 2 property ( adr ) repeat ( adr ) drop + " SN" get-property if + " SHF00000000" " SN" string-property + else + 2drop + then + " U#" get-property if + " 00000000-0000-0000-0000-000000000000" " S#" string-property + else + 2drop + then device-end + ; \ LICENSE_BEGIN

1 0

r502 - ofw/termemu
by svn＠openbios.org 27 Jul '07

27 Jul '07

Author: wmb Date: 2007-07-27 07:29:41 +0200 (Fri, 27 Jul 2007) New Revision: 502 Modified: ofw/termemu/fb16.fth Log: fb16.fth - Added a "d#" for paranoia. Modified: ofw/termemu/fb16.fth =================================================================== --- ofw/termemu/fb16.fth 2007-07-27 05:28:47 UTC (rev 501) +++ ofw/termemu/fb16.fth 2007-07-27 05:29:41 UTC (rev 502) @@ -251,7 +251,7 @@ ['] fb16-delete-characters is delete-characters ['] fb16-insert-lines is insert-lines - bytes/line16 16 mod if + bytes/line16 d# 16 mod if ['] fb16-delete-lines-slow else ['] fb16-delete-lines

1 0

r501 - dev/geode/display
by svn＠openbios.org 27 Jul '07

27 Jul '07

Author: wmb Date: 2007-07-27 07:28:47 +0200 (Fri, 27 Jul 2007) New Revision: 501 Added: dev/geode/display/gp.fth Log: Geode graphics processor support - initial revision, not integrated with the OFW console mechanism. Added: dev/geode/display/gp.fth =================================================================== --- dev/geode/display/gp.fth (rev 0) +++ dev/geode/display/gp.fth 2007-07-27 05:28:47 UTC (rev 501) @@ -0,0 +1,98 @@ +purpose: Geode LX graphics acceleration +\ See license at end of file + +dev screen + +alias depth+ wa+ + +: gp! ( l reg -- ) gp-base + rl! ; +: gp@ ( reg -- l ) gp-base + rl@ ; + +: dst! ( x y -- ) bytes/line16 * swap depth+ 0 gp! ; +: src! ( x y -- ) bytes/line16 * swap depth+ 4 gp! ; +: stride! ( dst-stride src-stride -- ) wljoin 8 gp! ; +: wh! ( width height -- ) swap wljoin h# c gp! ; +\ : fg! ( foreground-color -- ) h# 10 gp! ; +\ : bg! ( background-color -- ) h# 14 gp! ; +: pattern! ( color pat# -- ) h# 18 swap la+ gp! ; +: ropmode! ( mode -- ) h# 38 gp! ; +: blt! ( blt -- ) h# 40 gp! ; +: offset! ( ch3 src dst -- ) + h# ffc0.0000 and ( ch3 src dst' ) + swap h# ffc0.0000 and d# 10 rshift or ( ch3 src+dst ) + swap h# ffc0.0000 and d# 20 rshift or ( ch3+src+dst ) + h# 4c gp! +; + +\ Ready to accept a command +: gp-wait-ready ( -- ) begin h# 44 gp@ 4 and 0= until ; + +\ Finished with all the queued-up commands +: gp-wait-done ( -- ) begin h# 44 gp@ 1 and 0= until ; + +\ Do this once +: gp-setup ( -- ) + frame-buffer-adr >physical dup dup offset! + bytes/line16 dup stride! +; + +\ This one is a big win compared to doing it with the CPU +\ Scrolling the whole screen takes about 3.4 mS (GP) or 74 mS (CPU) +: gp-move ( src-x,y dst-x,y w,h -- ) + gp-wait-ready + wh! dst! src! + h# 6000.00cc ropmode! \ RGB565, Output = source + 1 blt! \ Source data from framebuffer + gp-wait-done +; + +\ gp-fill takes 2/3 as long wfill, and about the same time as lfill +\ gp-fill of the entire OLPC screen takes 2 mS; one character row 120 uS +: gp-fill ( color dst-x,y w,h -- ) + gp-wait-ready + wh! dst! 0 pattern! + h# 6000.00f0 ropmode! \ RGB565, Output = pattern + h# 0 blt! \ No source or destination data from framebuffer + gp-wait-done +; + +\ some tests +1 [if] +: gp-fill-screen ( color -- ) + 0 0 screen-width screen-height gp-fill +; +: gp-scroll-screen ( -- ) + 0 char-height 0 0 screen-width ( src-x,y dst-x,y ) + screen-height char-height - gp-move +; +: gp-fill-last-line ( color -- ) + bg16 0 screen-height char-height - screen-width char-height gp-fill +; +[then] + + +dend + +\ LICENSE_BEGIN +\ Copyright (c) 2006 FirmWorks +\ +\ Permission is hereby granted, free of charge, to any person obtaining +\ a copy of this software and associated documentation files (the +\ "Software"), to deal in the Software without restriction, including +\ without limitation the rights to use, copy, modify, merge, publish, +\ distribute, sublicense, and/or sell copies of the Software, and to +\ permit persons to whom the Software is furnished to do so, subject to +\ the following conditions: +\ +\ The above copyright notice and this permission notice shall be +\ included in all copies or substantial portions of the Software. +\ +\ THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, +\ EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF +\ MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND +\ NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE +\ LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION +\ OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION +\ WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. +\ +\ LICENSE_END

1 0

r500 - cpu/x86/pc/olpc ofw/core
by svn＠openbios.org 26 Jul '07

26 Jul '07

Author: wmb Date: 2007-07-26 18:39:29 +0200 (Thu, 26 Jul 2007) New Revision: 500 Modified: cpu/x86/pc/olpc/linux.fth ofw/core/bootparm.fth Log: Made a new /chosen property "ramdisk" so loading the Linux ramdisk doesn't overwrite the "bootpath" property. Modified: cpu/x86/pc/olpc/linux.fth =================================================================== --- cpu/x86/pc/olpc/linux.fth 2007-07-26 16:00:48 UTC (rev 499) +++ cpu/x86/pc/olpc/linux.fth 2007-07-26 16:39:29 UTC (rev 500) @@ -178,13 +178,22 @@ linux-params to %esi ; +d# 256 buffer: ramdisk-buf +' ramdisk-buf " ramdisk" chosen-string + : load-ramdisk ( -- ) - " ramdisk" eval dup 0= if 2drop exit then - 0 to /ramdisk - ." Loading ramdisk image from " 2dup type ." ..." - boot-read + " ramdisk" eval dup 0= if 2drop exit then ( name$ ) + 0 to /ramdisk ( name$ ) + + ['] load-path behavior >r ( name$ r: xt ) + ['] ramdisk-buf to load-path ( name$ r: xt ) + + ." Loading ramdisk image from " 2dup type ." ..." ( name$ r: xt ) + ['] boot-read catch ( throw-code r: xt ) + cr ( throw-code r: xt ) + r> to load-path ( throw-code ) + throw loaded to /ramdisk to ramdisk-adr - cr ; : claim-params ( -- ) Modified: ofw/core/bootparm.fth =================================================================== --- ofw/core/bootparm.fth 2007-07-26 16:00:48 UTC (rev 499) +++ ofw/core/bootparm.fth 2007-07-26 16:39:29 UTC (rev 500) @@ -78,6 +78,9 @@ defer load-started ' noop to load-started defer load-done ' noop to load-done +defer load-path +' path-buf is load-path + headerless : (boot-read) ( adr len -- ) opened-ih if ( adr len ) @@ -89,7 +92,7 @@ ( print-probe-list ) true abort" "r"nCan't open boot device"r"n" then ( fileid ) - dup ihandle>devname path-buf place-cstr drop ( fileid ) + dup ihandle>devname load-path place-cstr drop ( fileid ) >r ( ) load-started 0 !load-size load-base ( load-adr )

1 0

r499 - cpu/x86/pc/olpc
by svn＠openbios.org 26 Jul '07

26 Jul '07

Author: wmb Date: 2007-07-26 18:00:48 +0200 (Thu, 26 Jul 2007) New Revision: 499 Modified: cpu/x86/pc/olpc/devices.fth Log: OLCP - set screen-height appropriately for the XO display. Thanks to Luke Gorrie. Modified: cpu/x86/pc/olpc/devices.fth =================================================================== --- cpu/x86/pc/olpc/devices.fth 2007-07-26 16:00:10 UTC (rev 498) +++ cpu/x86/pc/olpc/devices.fth 2007-07-26 16:00:48 UTC (rev 499) @@ -321,6 +321,7 @@ end-package devalias screen /display +also hidden d# 34 to display-height previous \ For editing fload ${BP}/dev/geode/acpi.fth \ Power management

1 0

r498 - cpu/x86
by svn＠openbios.org 26 Jul '07

26 Jul '07

Author: wmb Date: 2007-07-26 18:00:10 +0200 (Thu, 26 Jul 2007) New Revision: 498 Modified: cpu/x86/tsc.fth Log: x86 t( .. )t - use us-factor instead of hardcoding clock speed. Thanks to Luke Gorrie for the patch. Modified: cpu/x86/tsc.fth =================================================================== --- cpu/x86/tsc.fth 2007-07-26 06:42:10 UTC (rev 497) +++ cpu/x86/tsc.fth 2007-07-26 16:00:10 UTC (rev 498) @@ -42,7 +42,7 @@ 2variable timestamp : t( ( -- ) tsc@ timestamp 2! ; : )t ( -- ) - tsc@ timestamp 2@ d- d# 367 um/mod nip ( microseconds ) + tsc@ timestamp 2@ d- us-factor um/mod nip ( microseconds ) push-decimal <# u# u# u# [char] , hold u# u#s u#> type ." uS " pop-base

1 0

r497 - dev/mmc/sdhci
by svn＠openbios.org 26 Jul '07

26 Jul '07

Author: wmb Date: 2007-07-26 08:42:10 +0200 (Thu, 26 Jul 2007) New Revision: 497 Modified: dev/mmc/sdhci/sdhci.fth Log: OLPC trac 2371 - SD is flaky in high-speed (50 MHz) mode on B1, probably as a result of the FPGA-based CaFe chips on B1. The firmware fix is to check for a B1 system and avoid switching to 50 MHz card clock thereon. Modified: dev/mmc/sdhci/sdhci.fth =================================================================== --- dev/mmc/sdhci/sdhci.fth 2007-07-26 01:14:50 UTC (rev 496) +++ dev/mmc/sdhci/sdhci.fth 2007-07-26 06:42:10 UTC (rev 497) @@ -154,7 +154,12 @@ ; : card-clock-50 ( -- ) card-clock-off - h# 003 h# 2c cw! \ Set divisor to 2^0, leaving internal clock on + h# 003 \ division = 2^0, clocks on + + \ OLPC-specific hack: fast clock doesn't work on the FPGA CaFe chip + " board-revision" evaluate h# b20 < if drop h# 103 then + + h# 2c cw! \ Set divisor to 2^0, leaving internal clock on card-clock-on ;

1 0

r496 - cpu/x86/pc/olpc dev/olpc/cafenand
by svn＠openbios.org 26 Jul '07

26 Jul '07

Author: wmb Date: 2007-07-26 03:14:50 +0200 (Thu, 26 Jul 2007) New Revision: 496 Modified: cpu/x86/pc/olpc/copynand.fth dev/olpc/cafenand/badblock.fth Log: OLPC NAND driver/copy-nand - Added JFFS2 cleanmarkers to erased blocks to speed up startup time on the first boot of the OS after copy-nand. Modified: cpu/x86/pc/olpc/copynand.fth =================================================================== --- cpu/x86/pc/olpc/copynand.fth 2007-07-25 01:58:15 UTC (rev 495) +++ cpu/x86/pc/olpc/copynand.fth 2007-07-26 01:14:50 UTC (rev 496) @@ -150,6 +150,10 @@ i ?check-crc load-base " copy-block" nandih $call-method loop + + cr ." Filling with cleanmarkers ..." + " put-cleanmarkers" nandih $call-method cr + close-nand-ihs ; Modified: dev/olpc/cafenand/badblock.fth =================================================================== --- dev/olpc/cafenand/badblock.fth 2007-07-25 01:58:15 UTC (rev 495) +++ dev/olpc/cafenand/badblock.fth 2007-07-26 01:14:50 UTC (rev 496) @@ -341,11 +341,18 @@ headers -: find-good-block ( -- ) - scan-page# ( page# ) - begin pages/eblock + dup block-bad? 0= until - to scan-page# +: (next-page#) ( -- true | page# false ) + usable-page-limit scan-page# pages/eblock + ?do + i block-bad? 0= if + i to scan-page# + scan-page# false unloop exit + then + pages/eblock +loop + true ; +: next-page# ( -- page# ) + (next-page#) if ." No more good NAND blocks" cr abort then +; 0 value test-page @@ -358,17 +365,22 @@ \ Must erase all (wipe) first : copy-block ( adr -- ) - find-good-block - scan-page# pages/eblock bounds ?do ( adr ) + next-page# pages/eblock bounds ?do ( adr ) dup i write-page ( adr ) /page + ( adr' ) loop ( adr ) drop ( ) ; +: put-cleanmarkers ( -- ) + begin (next-page#) 0= while ( page# ) + " "(85 19 03 20 08 00 00 00 00 00 00 00)" ( page# adr len ) + rot /page /ecc + write-bytes ( ) + repeat ( ) +; + : read-next-block ( adr -- ) - find-good-block - scan-page# pages/eblock bounds ?do ( adr ) + next-page# pages/eblock bounds ?do ( adr ) dup i read-page if ( adr ) ." Uncorrectable error in page 0x" i .x cr then

1 0

r495 - cpu/x86/pc cpu/x86/pc/olpc dev dev/geode/ac97 dev/geode/display dev/mmc/sdhci dev/olpc/cafecamera dev/olpc/cafenand dev/pci
by svn＠openbios.org 25 Jul '07

25 Jul '07

Author: wmb Date: 2007-07-25 03:58:15 +0200 (Wed, 25 Jul 2007) New Revision: 495 Added: cpu/x86/pc/olpc/crypto.fth Modified: cpu/x86/pc/flashpkg.fth cpu/x86/pc/olpc/config.fth cpu/x86/pc/olpc/devices.fth cpu/x86/pc/olpc/fw.bth cpu/x86/pc/olpc/pcinode.fth dev/geode/ac97/ac97.fth dev/geode/display/gxfb.fth dev/geode/display/gxpci.fth dev/i8042.fth dev/mmc/sdhci/sdhci.fth dev/mmc/sdhci/sdmmc.fth dev/olpc/cafecamera/cafecamera.fth dev/olpc/cafenand/cafenand.fth dev/pci/isa.fth dev/pci/isaall.fth dev/pci/isamisc.fth dev/pcibus.fth Log: OLPC trac #553 - lots of device tree tweaks, mostly stuff that the OS doesn't care about. Modified: cpu/x86/pc/flashpkg.fth =================================================================== --- cpu/x86/pc/flashpkg.fth 2007-07-24 20:33:58 UTC (rev 494) +++ cpu/x86/pc/flashpkg.fth 2007-07-25 01:58:15 UTC (rev 495) @@ -119,6 +119,7 @@ size rot 0 d- ( d.#bytes ) ; +[ifdef] flash-is-parent \ These allow us to sub-address the FLASH device to access the PROMICE AI port 1 " #address-cells" integer-property @@ -126,6 +127,8 @@ : encode-unit ( phys -- adr len ) push-hex (u.) pop-base ; : map-in ( offset size -- virt ) drop device-base + ; : map-out ( virt size -- virt ) 2drop ; +[then] + \ LICENSE_BEGIN \ Copyright (c) 2006 FirmWorks \ Modified: cpu/x86/pc/olpc/config.fth =================================================================== --- cpu/x86/pc/olpc/config.fth 2007-07-24 20:33:58 UTC (rev 494) +++ cpu/x86/pc/olpc/config.fth 2007-07-25 01:58:15 UTC (rev 495) @@ -37,7 +37,11 @@ \ create use-watch-all \ create use-root-isa create no-floppy-node +create no-com2-node +create no-lpt-node create use-pci-isa +create basic-isa +create isa-dma-only create use-null-nvram Added: cpu/x86/pc/olpc/crypto.fth =================================================================== --- cpu/x86/pc/olpc/crypto.fth (rev 0) +++ cpu/x86/pc/olpc/crypto.fth 2007-07-25 01:58:15 UTC (rev 495) @@ -0,0 +1,127 @@ +purpose: Interface to cryptographic code for firmware image validation +\ See license at end of file + +h# c0000 constant crypto-base \ The address the code is linked to run at +h# c0000 constant hasher-base \ The address the code is linked to run at + +variable hashlen +d# 128 buffer: hashbuf + +: hash ( data$ hashname$ -- result$ ) + " hasher" find-drop-in 0= if 4drop true exit then ( data$ hashname$ prog$ ) + 2dup hasher-base swap move free-mem ( data$ hashname$ ) + + d# 128 hashlen ! + 2>r swap hashlen hashbuf 2swap 2r> $cstr ( &reslen resbuf datalen databuf hashname-cstr ) + + hasher-base dup h# 10 - sp-call abort" Hash failed" drop 4drop ( ) + hashbuf hashlen @ +; + +h# f value which-hashes +: signature-bad? ( data$ sig$ -- mismatch? ) + " crypto" find-drop-in 0= if 4drop true exit then ( data$ sig$ prog$ ) + 2dup crypto-base swap move free-mem ( data$ sig$ ) + + " pubkey" find-drop-in 0= if 4drop true exit then ( data$ sig$ key$ ) + 2>r ( data$ sig$ r: key$ ) + swap 2swap swap ( siglen sigadr datalen dataadr r: key$ ) + 2r@ swap 2swap ( siglen sigadr keylen keyadr datalen dataadr r: key$ ) + + which-hashes + + crypto-base dup h# 10 - sp-call >r 3drop 4drop r> ( result r: key$ ) + 2r> free-mem + +\ XXX free-mem in suspend.fth and fw.bth after find-drop-in +\ XXX clean out dead code in usb.fth +; + +1 [if] + +\ Check that the version is an upgrade? + +: >rom-name$ ( device$ -- path$ ) + image-name-buf place ( ) + " :\boot\olpcfw.rom" image-name-buf $cat ( ) + image-name$ +; +: sig-name$ ( -- path$ ) + image-name$ + 4 - " .rom" caps-comp 0= if + " sig" image-name$ + 3 - swap move + image-name$ + else + 2drop " " + then +; +: $dev-update-flash ( device$ -- ) + >rom-name$ $get-image if exit then ( data$ ) + + sig-name$ $get-image if + ." Missing firmware update signature file: " sig-name$ type cr + free-mem exit + then ( data$ sig$ ) + + 2over 2over signature-bad? if ( data$ sig$ ) + ." Firmware update image signature mismatch: " sig-name$ type cr + free-mem free-mem exit + then ( data$ sig$ ) + + free-mem ( data$ ) + + 2dup flash-buf swap move ( data$ ) + tuck free-mem ( data-len ) + ['] ?image-valid catch if ( x ) + drop ." Firmware image failed sanity checks" cr ( ) + exit + then ( x ) + + true to file-loaded? + reflash +; +[then] + +: getbin " usb8388.bin" find-drop-in 0= abort" No usb8388.bin" ; +: getsig " usb8388.sig" find-drop-in 0= abort" No usb8388.sig" ; +: tc ( -- ) + getbin getsig + signature-bad? if + ." Signature was bad, expected good" cr + then + + getbin over 1 swap +! + getsig + signature-bad? 0= if + ." Signature was good, expected bad (corrupt image)" cr + then + + getbin + getsig over 40 + 1 swap +! + signature-bad? 0= if + ." Signature was good, expected bad (corrupt signature)" cr + then +; + +\ LICENSE_BEGIN +\ Copyright (c) 2007 FirmWorks +\ +\ Permission is hereby granted, free of charge, to any person obtaining +\ a copy of this software and associated documentation files (the +\ "Software"), to deal in the Software without restriction, including +\ without limitation the rights to use, copy, modify, merge, publish, +\ distribute, sublicense, and/or sell copies of the Software, and to +\ permit persons to whom the Software is furnished to do so, subject to +\ the following conditions: +\ +\ The above copyright notice and this permission notice shall be +\ included in all copies or substantial portions of the Software. +\ +\ THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, +\ EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF +\ MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND +\ NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE +\ LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION +\ OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION +\ WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. +\ +\ LICENSE_END Modified: cpu/x86/pc/olpc/devices.fth =================================================================== --- cpu/x86/pc/olpc/devices.fth 2007-07-24 20:33:58 UTC (rev 494) +++ cpu/x86/pc/olpc/devices.fth 2007-07-25 01:58:15 UTC (rev 495) @@ -27,9 +27,14 @@ fload ${BP}/cpu/x86/tsc.fth stand-init: - gx? if d# 366,666,667 else d# 433,333,333 then ( cpu-clock-hz ) + gx? if + d# 366,666,667 " AMD,Geode GX" + else + d# 433,333,333 " AMD,Geode LX" + then ( cpu-clock-hz model$ ) - " /cpu" find-device ( cpu-clock-hz ) + " /cpu" find-device ( cpu-clock-hz model$ ) + " model" string-property ( cpu-clock-hz ) dup " clock-frequency" integer-property ( cpu-clock-hz ) device-end ( cpu-clock-hz ) @@ -64,12 +69,18 @@ h# 20 to vector-base0 h# 28 to vector-base1 device-end -[then] +warning @ warning off +: probe-pci ( -- ) + probe-pci + " /pci" " make-interrupt-map" execute-device-method drop +; +warning ! + 0 0 dropin-base <# u#s u#> " /" begin-package " flash" device-name -[ifdef] addresses-assigned dropin-size [else] h# 4.0000 [then] + h# 10.0000 dup value /device constant /device-phys my-address my-space /device-phys reg Modified: cpu/x86/pc/olpc/fw.bth =================================================================== --- cpu/x86/pc/olpc/fw.bth 2007-07-24 20:33:58 UTC (rev 494) +++ cpu/x86/pc/olpc/fw.bth 2007-07-25 01:58:15 UTC (rev 495) @@ -64,6 +64,7 @@ dev / 1 encode-int " #address-cells" property +1 encode-int " #size-cells" property " OLPC" encode-string " architecture" property device-end @@ -378,6 +379,8 @@ fload ${BP}/dev/olpc/keyboard/selftest.fth \ Keyboard diagnostic fload ${BP}/dev/olpc/touchpad/touchpad.fth \ Touchpad diagnostic fload ${BP}/dev/olpc/kb3700/battery.fth \ Battery status reports +fload ${BP}/cpu/x86/pc/olpc/copynand.fth +fload ${BP}/cpu/x86/pc/olpc/crypto.fth \ Cryptographic image validation [then] \ Eliminate 4 second delay in install console for the case where @@ -546,6 +549,7 @@ ?start-sound ['] false to interrupt-auto-boot? probe-usb + " nand" $dev-update-flash interpreter-init [ifndef] lx-devel enable-power-button @@ -573,7 +577,9 @@ quit ; -fload ${BP}/cpu/x86/pc/olpc/copynand.fth +: newrom + " flash http:\\10.20.0.109\new.rom" eval +; \ This helps with TeraTerm, which sends ESC-O as the arrow key prefix also hidden also keys-forth definitions Modified: cpu/x86/pc/olpc/pcinode.fth =================================================================== --- cpu/x86/pc/olpc/pcinode.fth 2007-07-24 20:33:58 UTC (rev 494) +++ cpu/x86/pc/olpc/pcinode.fth 2007-07-25 01:58:15 UTC (rev 495) @@ -1,7 +1,7 @@ \ See license at end of file purpose: PCI bus package -0 [if] addresses-assigned +0 [if] \ Suppress PCI address assignment; use the addresses the BIOS assigned patch false true master-probe patch noop assign-all-addresses prober @@ -13,6 +13,7 @@ patch or-w! my-w! find-fcode? patch 2drop my-w! find-fcode? [then] + [ifdef] addresses-assigned \ patch false true master-probe : nonvirtual-probe-state? ( -- flag ) @@ -61,7 +62,7 @@ [ifdef] lx-devel " 2,3,4,5,6,7,8,9,a,b,c,d,e,f" exit [then] - " c,f" + " 1,c,f" ; \ " c,f" dup config-string pci-probe-list @@ -100,6 +101,45 @@ drop h# 3c + config-b@ true ; +0 value interrupt-parent + +1 " #interrupt-cells" integer-property +0 0 encode-bytes 0000.ff00 +i 0+i 0+i 7 +i " interrupt-map-mask" property + +: +map ( adr len dev# int-pin# int-level -- adr' len' ) + >r >r ( $ dev# R: level pin ) + +i ( $' R: level pin ) + 0+i 0+i r> +i ( $' R: level ) + interrupt-parent +i ( $' R: level ) + r> +i 0 +i ( $' ) \ 0 is active low, level senstive for ISA +; + +external + +: make-interrupt-map ( -- ) + " /isa/interrupt-controller" find-package 0= if exit then to interrupt-parent + + 0 0 encode-bytes ( prop$ ) + + h# 10000 0 do ( prop$ ) + i h# 3d + config-b@ ( prop$ pin# ) + dup 0<> over h# ff <> and if ( prop$ pin# ) + i h# 3c + config-b@ ( prop$ pin# level ) + i -rot +map ( prop$' ) + else ( prop$ pin# ) + drop ( prop$ ) + then ( prop$ ) + h# 100 +loop ( prop$ ) + " interrupt-map" property ( ) +; + +also known-int-properties definitions +\ In some systems the number of interrupt-map ints is variable, +\ but on OLPC, the only node with an interrupt-map is PCI. +: interrupt-map 7 ; +: interrupt-map-mask 4 ; +previous definitions + \ Just use the global versions warning @ warning off : config-b@ ( config-adr -- b ) config-b@ ; Modified: dev/geode/ac97/ac97.fth =================================================================== --- dev/geode/ac97/ac97.fth 2007-07-24 20:33:58 UTC (rev 494) +++ dev/geode/ac97/ac97.fth 2007-07-25 01:58:15 UTC (rev 495) @@ -12,9 +12,9 @@ d# 16 encode-int " sample-frame-size" property \ frame-rate encode-int " input-frame-rates" property \ frame-rate encode-int " output-frame-rates" property -" 16bit-LE-unsigned-linear" 2dup encode-string " input-encoding-types" property +" 16bit-LE-signed-linear" 2dup encode-string " input-encoding-types" property encode-string " output-encoding-types" property -" AC97,CODEC" encode-string " compatible" property +" AD1888" encode-string " AC97,CODEC" encode-string encode+ " compatible" property d# 128 constant /chipbase Modified: dev/geode/display/gxfb.fth =================================================================== --- dev/geode/display/gxfb.fth 2007-07-24 20:33:58 UTC (rev 494) +++ dev/geode/display/gxfb.fth 2007-07-25 01:58:15 UTC (rev 495) @@ -541,7 +541,7 @@ h# 0f color@ h# ff color! \ Set color ff to white (same as 15) ; -: init ( -- ) \ Initializes the controller +: init-all ( -- ) \ Initializes the controller smb-init map-io-regs \ Enable IO registers init-controller \ Setup the video controller @@ -566,7 +566,7 @@ 0 0 encode-bytes " iso6429-1983-colors" property : display-install ( -- ) - init + init-all default-font set-font /scanline bytes/pixel / #scanlines ( width height ) over char-width / over char-height / ( width height rows cols ) Modified: dev/geode/display/gxpci.fth =================================================================== --- dev/geode/display/gxpci.fth 2007-07-24 20:33:58 UTC (rev 494) +++ dev/geode/display/gxpci.fth 2007-07-25 01:58:15 UTC (rev 495) @@ -30,6 +30,13 @@ : (map-frame-buffer) ( -- adr ) h# 10 h# 80.0000 map-membar ; + +\ This is called during probing by make-function-node +: init ( -- ) + " make-compatible-property" my-parent ihandle>phandle find-method if execute then + " make-power-property" my-parent ihandle>phandle find-method if execute then +; + \ LICENSE_BEGIN \ Copyright (c) 2006 FirmWorks \ Modified: dev/i8042.fth =================================================================== --- dev/i8042.fth 2007-07-24 20:33:58 UTC (rev 494) +++ dev/i8042.fth 2007-07-25 01:58:15 UTC (rev 495) @@ -26,7 +26,7 @@ [then] \ 0 means the keyboard port, 1 means the aux port -: encode-unit ( n -- adr len ) if " aux" else " " then ; +: encode-unit ( n -- adr len ) if " aux" else " kbd" then ; : decode-unit ( adr len -- n ) " aux" $= 0= if 0 else 1 then ; \ Queues for distributing bytes sent from the two devices Modified: dev/mmc/sdhci/sdhci.fth =================================================================== --- dev/mmc/sdhci/sdhci.fth 2007-07-24 20:33:58 UTC (rev 494) +++ dev/mmc/sdhci/sdhci.fth 2007-07-25 01:58:15 UTC (rev 495) @@ -15,6 +15,8 @@ 0 " #address-cells" integer-property 0 " #size-cells" integer-property +" sdhci" " compatible" string-property + h# 4000 constant /regs : phys+ encode-phys encode+ ; Modified: dev/mmc/sdhci/sdmmc.fth =================================================================== --- dev/mmc/sdhci/sdmmc.fth 2007-07-24 20:33:58 UTC (rev 494) +++ dev/mmc/sdhci/sdmmc.fth 2007-07-25 01:58:15 UTC (rev 495) @@ -3,6 +3,7 @@ " disk" device-name " sdmmc" " iconname" string-property +" block" device-type 0 instance value label-package Modified: dev/olpc/cafecamera/cafecamera.fth =================================================================== --- dev/olpc/cafecamera/cafecamera.fth 2007-07-24 20:33:58 UTC (rev 494) +++ dev/olpc/cafecamera/cafecamera.fth 2007-07-25 01:58:15 UTC (rev 495) @@ -7,6 +7,8 @@ " camera" device-name " olpc,camera" model " camera" device-type +" olpc,camera" " compatible" string-property +" OV7670" " sensor" string-property h# 4000 constant /regs Modified: dev/olpc/cafenand/cafenand.fth =================================================================== --- dev/olpc/cafenand/cafenand.fth 2007-07-24 20:33:58 UTC (rev 494) +++ dev/olpc/cafenand/cafenand.fth 2007-07-25 01:58:15 UTC (rev 495) @@ -3,7 +3,7 @@ " nandflash" device-name " olpc,cafenand" model -" disk" device-type +" olpc,cafenand" " compatible" string-property h# 4000 constant /regs Modified: dev/pci/isa.fth =================================================================== --- dev/pci/isa.fth 2007-07-24 20:33:58 UTC (rev 494) +++ dev/pci/isa.fth 2007-07-25 01:58:15 UTC (rev 495) @@ -6,6 +6,9 @@ " isa" device-name " isa" device-type +2 " #address-cells" integer-property +1 " #size-cells" integer-property + my-address my-space encode-phys 0 encode-int encode+ h# 0 encode-int encode+ " reg" property Modified: dev/pci/isaall.fth =================================================================== --- dev/pci/isaall.fth 2007-07-24 20:33:58 UTC (rev 494) +++ dev/pci/isaall.fth 2007-07-25 01:58:15 UTC (rev 495) @@ -3,7 +3,7 @@ fload ${BP}/dev/pci/isacom.fth \ Serial ports -[ifndef] no-lpt +[ifndef] no-lpt-node 0 0 " i378" " /isa" begin-package fload ${BP}/dev/pci/isalpt.fth \ Parallel port end-package Modified: dev/pci/isamisc.fth =================================================================== --- dev/pci/isamisc.fth 2007-07-24 20:33:58 UTC (rev 494) +++ dev/pci/isamisc.fth 2007-07-25 01:58:15 UTC (rev 495) @@ -15,7 +15,9 @@ 0 1 10 encode-reg 80 1 20 encode-reg encode+ c0 1 20 encode-reg encode+ -[ifndef] isa-dma-only +[ifdef] isa-dma-only + 481 1 f encode-reg encode+ \ High page registers +[else] [ifdef] PREP 40a 1 2 encode-reg encode+ \ AIX wants this [else] @@ -91,9 +93,7 @@ " pnpPNP,0" " compatible" string-property 20 1 2 encode-reg a0 1 2 encode-reg encode+ -[ifndef] basic-isa 4d0 1 2 encode-reg encode+ -[then] " reg" property fload ${BP}/dev/i8259.fth Modified: dev/pcibus.fth =================================================================== --- dev/pcibus.fth 2007-07-24 20:33:58 UTC (rev 494) +++ dev/pcibus.fth 2007-07-25 01:58:15 UTC (rev 495) @@ -40,8 +40,6 @@ headers " pci" encode-string " name" property -7 encode-int " scsi-initiator-id" property - \ There are no visible PCI registers \ my-address encode-int /pci-regs encode-int encode+ " reg" property

1 0

r494 - cpu/x86/pc/olpc
by svn＠openbios.org 24 Jul '07

24 Jul '07

Author: wmb Date: 2007-07-24 22:33:58 +0200 (Tue, 24 Jul 2007) New Revision: 494 Modified: cpu/x86/pc/olpc/linux.fth Log: OLPC trac #2335 - changed boot order to USB before SD. Modified: cpu/x86/pc/olpc/linux.fth =================================================================== --- cpu/x86/pc/olpc/linux.fth 2007-07-24 19:02:06 UTC (rev 493) +++ cpu/x86/pc/olpc/linux.fth 2007-07-24 20:33:58 UTC (rev 494) @@ -11,7 +11,7 @@ \needs ramdisk " " d# 128 config-string ramdisk " " ' boot-file set-config-string-default \ Let the olpcboot.fth file set the cmdline -" sd:\boot\olpc.fth disk:\boot\olpc.fth nand:\boot\olpc.fth /prober /usb/ethernet /usb/wlan" ' boot-device set-config-string-default +" disk:\boot\olpc.fth sd:\boot\olpc.fth nand:\boot\olpc.fth /prober /usb/ethernet /usb/wlan" ' boot-device set-config-string-default 0 value ramdisk-adr 0 value /ramdisk

1 0

r493 - in ofw: disklabel fs/ext2fs
by svn＠openbios.org 24 Jul '07

24 Jul '07

Author: wmb Date: 2007-07-24 21:02:06 +0200 (Tue, 24 Jul 2007) New Revision: 493 Added: ofw/fs/ext2fs/partition.fth Modified: ofw/disklabel/loadpkg.fth ofw/disklabel/methods.fth Log: Partition type decoder - handle mismatch between partition type code and actual filesystem. Warn of the mismatch, but use the actual filesystem. OLPC trac #635. Modified: ofw/disklabel/loadpkg.fth =================================================================== --- ofw/disklabel/loadpkg.fth 2007-07-24 01:21:22 UTC (rev 492) +++ ofw/disklabel/loadpkg.fth 2007-07-24 19:02:06 UTC (rev 493) @@ -4,11 +4,15 @@ fload ${BP}/ofw/disklabel/common.fth fload ${BP}/ofw/fs/fatfs/partition.fth fload ${BP}/ofw/fs/cdfs/partition.fth +[ifdef] ufs-support fload ${BP}/ofw/fs/ufs/partition.fth +[then] +fload ${BP}/ofw/fs/ext2fs/partition.fth [ifdef] hfs-support fload ${BP}/ofw/fs/macfs/partition.fth [then] fload ${BP}/ofw/disklabel/methods.fth + \ LICENSE_BEGIN \ Copyright (c) 2006 FirmWorks \ Modified: ofw/disklabel/methods.fth =================================================================== --- ofw/disklabel/methods.fth 2007-07-24 01:21:22 UTC (rev 492) +++ ofw/disklabel/methods.fth 2007-07-24 19:02:06 UTC (rev 493) @@ -48,11 +48,13 @@ then then +[ifdef] ufs-support \ If the partition type is UFS and a filename is specified, select \ one of the UFS sub-partitions. Otherwise use the raw partition. partition-type ufs-type = if filename nip if ufs-map then then +[then] ; : select-partition ( -- ) @@ -83,6 +85,7 @@ iso-9660? if exit then +[ifdef] ufs-support \ If this disk has a UFS partition map that is not subordinate to \ an FDISK map and either a UFS partition letter or a filename is \ specified, select one of the UFS sub-partitions. @@ -90,6 +93,7 @@ ufs? if ufs-partition 0<> filename nip 0<> or if ufs-map exit then then +[then] \ Nothing we tried worked. abort @@ -106,15 +110,32 @@ \ ( change sector-offset and size.low,high ) ... [then] + 2 read-sector + ext2? if + partition-type ext2fs-type <> if + ." Warning: Filesystem is ext2/3, but partition type is 0x" + partition-type .x ." (should be 0x83)." cr + then + " ext2-file-system" exit + then + +[ifdef] ufs-support partition-type ufs-type = if " ufs-file-system" exit then - partition-type ext2fs-type = if " ext2-file-system" exit then - partition-type minix-type = if " minix-file-system" exit then +[then] + partition-type minix-type = if " minix-file-system" exit then 0 read-sector \ Get the first sector of the selected partition dropin? if " dropin-file-system" exit then zip? if " zip-file-system" exit then + fat? if + partition-type ext2fs-type = if + ." Warning: Filesystem is FAT, but partition type is 0x83 (ext2/3)." cr + then + " fat-file-system" exit + then - " fat-file-system" + ." Error: Unknown file system" cr + abort ; \ If the arguments include a filename, we determine the type of filesystem Added: ofw/fs/ext2fs/partition.fth =================================================================== --- ofw/fs/ext2fs/partition.fth (rev 0) +++ ofw/fs/ext2fs/partition.fth 2007-07-24 19:02:06 UTC (rev 493) @@ -0,0 +1,33 @@ +\ See license at end of file +purpose: Ext2/3 partition map decoding support + +\ Returns true if the sector buffer appears to contain an ext2/3 super block +\ which signifies the beginning of a DOS "FAT" file system. +: ext2? ( -- flag ) + sector-buf h# 38 + w@ ( magic ) + dup h# ef53 = swap h# 53ef = or ( ext2? ) +; + +\ LICENSE_BEGIN +\ Copyright (c) 2007 FirmWorks +\ +\ Permission is hereby granted, free of charge, to any person obtaining +\ a copy of this software and associated documentation files (the +\ "Software"), to deal in the Software without restriction, including +\ without limitation the rights to use, copy, modify, merge, publish, +\ distribute, sublicense, and/or sell copies of the Software, and to +\ permit persons to whom the Software is furnished to do so, subject to +\ the following conditions: +\ +\ The above copyright notice and this permission notice shall be +\ included in all copies or substantial portions of the Software. +\ +\ THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, +\ EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF +\ MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND +\ NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE +\ LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION +\ OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION +\ WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. +\ +\ LICENSE_END

1 0

r492 - dev/olpc/cafenand
by svn＠openbios.org 24 Jul '07

24 Jul '07

Author: wmb Date: 2007-07-24 03:21:22 +0200 (Tue, 24 Jul 2007) New Revision: 492 Modified: dev/olpc/cafenand/badblock.fth dev/olpc/cafenand/cafenand.fth dev/olpc/cafenand/ecc.fth Log: OLPC CaFe NAND driver - turned on ECC correction. Trac 738 Modified: dev/olpc/cafenand/badblock.fth =================================================================== --- dev/olpc/cafenand/badblock.fth 2007-07-23 20:24:48 UTC (rev 491) +++ dev/olpc/cafenand/badblock.fth 2007-07-24 01:21:22 UTC (rev 492) @@ -170,7 +170,10 @@ bbt swap /bbt /page / ( adr page# #pages ) \ Can't use read-blocks because of block-bad? dependency bounds ?do ( adr ) - dup i read-page ( adr ) + dup i read-page if ( adr ) + ." BBT has uncorrectable errors" cr + abort + then ( adr ) /page + ( adr' ) loop ( adr ) drop @@ -232,13 +235,15 @@ over block-bad? if 3drop 0 exit then then - dup >r ( adr page# #pages r: #pages ) - bounds ?do ( adr ) - \ XXX need some error handling - dup i read-page ( adr ) - /page + ( adr' ) - loop ( adr ) - drop r> + rot >r 2dup r> -rot ( page# #pages adr page# #pages ) + bounds ?do ( page# #pages adr ) + dup i read-page if ( page# #pages adr ) + 2drop i swap - ( #read ) + unloop exit + then ( page# #pages adr ) + /page + ( page# #pages adr' ) + loop ( page# #pages adr ) + drop nip ; : write-blocks ( adr page# #pages -- #written ) @@ -364,7 +369,9 @@ : read-next-block ( adr -- ) find-good-block scan-page# pages/eblock bounds ?do ( adr ) - dup i read-page ( adr ) + dup i read-page if ( adr ) + ." Uncorrectable error in page 0x" i .x cr + then /page + ( adr' ) loop ( adr ) drop ( ) @@ -381,7 +388,7 @@ \ : verify-block ( adr -- false | page# true ) \ find-good-block \ scan-page# pages/eblock bounds ?do ( adr ) -\ test-page i read-page ( adr ) +\ test-page i read-page drop ( adr ) \ dup test-page /page comp if ( adr ) \ drop ( ) \ i true exit ( -- page# true ) @@ -401,7 +408,7 @@ : block-erased? ( page# -- flag ) pages/eblock bounds ?do - test-page i read-page + test-page i read-page drop test-page /page erased? 0= if false unloop exit then pages/eblock +loop true Modified: dev/olpc/cafenand/cafenand.fth =================================================================== --- dev/olpc/cafenand/cafenand.fth 2007-07-23 20:24:48 UTC (rev 491) +++ dev/olpc/cafenand/cafenand.fth 2007-07-24 01:21:22 UTC (rev 492) @@ -22,6 +22,7 @@ : cl! ( l adr -- ) chip + rl! ; : cl@ ( adr -- l ) chip + rl@ ; +: cw@ ( adr -- w ) chip + rw@ ; : map-regs ( -- ) 0 0 h# 0200.0010 my-space + /regs " map-in" $call-parent to chip @@ -199,16 +200,27 @@ 0 instance value dma-buf-pa 0 instance value dma-buf-va defer do-lmove +h# 10 buffer: syndrome-buf +: syndrome ( -- adr ) + 8 0 do h# 50 i wa+ cw@ i syndrome-buf array! loop + syndrome-buf +; -\ XXX should check ECC -: read-page ( adr page# -- ) +: read-page ( adr page# -- error? ) 0 set-page ( adr ) - /page ( /oob + ) h# 18 cl! ( adr ) + /page /ecc + h# 18 cl! ( adr ) dma-buf-pa h# 44 cl! ( adr ) 0 h# 48 cl! ( adr ) /page h# a000.0000 or h# 40 cl! ( adr ) read-cmd h# 0800.0130 cmd wait-dma ( adr ) - dma-buf-va swap /page do-lmove ( ) + + h# 3c cl@ h# 40000 and if ( adr ) \ ECC error + dma-buf-va syndrome correct-ecc ( adr uncorrectable? ) + else ( adr ) + false ( adr error? ) + then ( adr error? ) + + dma-buf-va rot /page do-lmove ( error? ) ; : dma-write-raw ( adr len page# offset -- ) @@ -231,7 +243,6 @@ write-disable ( ) ; -\ : read-page ( adr page# -- ) dma-read-page ; : write-page ( adr page# -- ) dma-write-page ; : write-bytes ( adr len page# offset -- ) pio-write-raw ; Modified: dev/olpc/cafenand/ecc.fth =================================================================== --- dev/olpc/cafenand/ecc.fth 2007-07-23 20:24:48 UTC (rev 491) +++ dev/olpc/cafenand/ecc.fth 2007-07-24 01:21:22 UTC (rev 492) @@ -3,8 +3,8 @@ hex -: array! ( value index adr -- ) swap wa+ ! ; -: array@ ( index adr -- value ) swap wa+ @ ; +: array! ( value index adr -- ) swap wa+ w! ; +: array@ ( index adr -- value ) swap wa+ w@ ; \ Split or join a number, size of low half is n bits. : #split ( x n -- x.lo x.hi ) @@ -330,10 +330,10 @@ [ifdef] notdef \ Test vectors -CREATE s1 001 , 6c6 , 291 , d91 , 1ef , e26 , a19 , 8c0 , -CREATE s2 0f8 , de1 , 5e5 , 287 , 566 , 756 , f5f , 253 , -CREATE s3 001 , 001 , 001 , 001 , 001 , 001 , 001 , 001 , -CREATE s4 41e , b7a , 37c , 885 , c32 , a87 , 218 , b08 , +CREATE s1 001 w, 6c6 w, 291 w, d91 w, 1ef w, e26 w, a19 w, 8c0 w, +CREATE s2 0f8 w, de1 w, 5e5 w, 287 w, 566 w, 756 w, f5f w, 253 w, +CREATE s3 001 w, 001 w, 001 w, 001 w, 001 w, 001 w, 001 w, 001 w, +CREATE s4 41e w, b7a w, 37c w, 885 w, c32 w, a87 w, 218 w, b08 w, : #aligned negate swap negate and negate ;

1 0

r491 - ofw/termemu
by svn＠openbios.org 23 Jul '07

23 Jul '07

Author: wmb Date: 2007-07-23 22:24:48 +0200 (Mon, 23 Jul 2007) New Revision: 491 Added: ofw/termemu/15x30pc.license ofw/termemu/15x30pc.psf Log: Checked-in 15x30pc font and associated license text. Added: ofw/termemu/15x30pc.license =================================================================== --- ofw/termemu/15x30pc.license (rev 0) +++ ofw/termemu/15x30pc.license 2007-07-23 20:24:48 UTC (rev 491) @@ -0,0 +1,5 @@ +15x30pc.psf was created by Albert Cahalan as a modification of the DejaVu fonts. +Such modification, and incorporation of a typeface within a larger software +package, is permitted by the following license: + +http://dejavu.sourceforge.net/wiki/index.php/License Added: ofw/termemu/15x30pc.psf =================================================================== (Binary files differ) Property changes on: ofw/termemu/15x30pc.psf ___________________________________________________________________ Name: svn:mime-type + application/octet-stream

1 0

r490 - cpu/x86/pc/biosload/build
by svn＠openbios.org 23 Jul '07

23 Jul '07

Author: wmb Date: 2007-07-23 22:04:51 +0200 (Mon, 23 Jul 2007) New Revision: 490 Modified: cpu/x86/pc/biosload/build/ Log: svn: Ignore .elf files in cpu/x86/pc/biosload/build directory Property changes on: cpu/x86/pc/biosload/build ___________________________________________________________________ Name: svn:ignore - build builton.fth ofw.c32 + build builton.fth ofw.c32 *.elf

1 0

r489 - cpu/x86/pc/olpc/build
by svn＠openbios.org 23 Jul '07

23 Jul '07

Author: wmb Date: 2007-07-23 21:53:45 +0200 (Mon, 23 Jul 2007) New Revision: 489 Modified: cpu/x86/pc/olpc/build/ Log: svn: Ignore .md5 files in build directory Property changes on: cpu/x86/pc/olpc/build ___________________________________________________________________ Name: svn:ignore - build ofw.elf builton.fth *.rom *.bin *.version forth sourceurl + build ofw.elf builton.fth *.rom *.bin *.version forth sourceurl *.md5

1 0

r488 - in cpu/ppc: . olpc olpc/build
by svn＠openbios.org 23 Jul '07

23 Jul '07

Author: wmb Date: 2007-07-23 21:40:40 +0200 (Mon, 23 Jul 2007) New Revision: 488 Added: cpu/ppc/cacheon.bth cpu/ppc/cachinfl.bth cpu/ppc/inflate.bth cpu/ppc/olpc/olpc.bth cpu/ppc/olpc/resetvec.bth cpu/ppc/olpc/start.bth Modified: cpu/ppc/olpc/build/ cpu/ppc/olpc/devalias.fth cpu/ppc/olpc/fw.bth cpu/ppc/olpc/fwuboot.bth cpu/ppc/olpc/pcinode.fth cpu/ppc/ppcboot.fth Log: PowerPC OLPC build - Checkpoint. Added: cpu/ppc/cacheon.bth =================================================================== --- cpu/ppc/cacheon.bth (rev 0) +++ cpu/ppc/cacheon.bth 2007-07-23 19:40:40 UTC (rev 488) @@ -0,0 +1,55 @@ +purpose: Code to prepend to the inflater to run it with the cache on +copyright: Copyright 1995 Firmworks All Rights Reserved + +command: &builder &this +build-now + +fload ${BP}/cpu/ppc/asmtools.fth + +start-assembling + +\ This module use C calling and register usage conventions +\ On entry, +\ r1: C stack pointer +\ r3: pointer to compressed image, +\ r4: pointer to base of firmware RAM, +\ r5: pointer to workspace area +\ r6: size of firmware RAM + +label entry ( <as above> -- ) + mfspr r0,lr \ C stack linkage and register saving + stw r31,-4(r1) + stw r0,8(r1) + stwu r1,h#-18(r1) + + mfspr r31,hid0 \ r31: hid0 + + ori r0,r31,h#8800 \ Merge-in bits to invalidate and enable the Icache + sync isync + mtspr hid0,r0 \ Invalidate and enable Icache + isync sync + + here 0 , \ Reserve space for a call instruction + + sync isync + mtspr hid0,r31 \ Restore hid0 to its previous value + isync sync + + addi r1,r1,h#18 \ C stack un-linkage and register restoration + lwz r0,8(r1) + mtspr lr,r0 + lwz r31,-4(r1) + + mtspr lr,r0 \ Return to caller + bclr 20,0 + +here swap put-call \ Put a call to the following code in the place + \ that was reserved. The code to be called will + \ be concatenated to the end of this binary file. +end-code + +end-assembling + +writing cacheon.img +asm-base here over - ofd @ fputs +ofd @ fclose Added: cpu/ppc/cachinfl.bth =================================================================== --- cpu/ppc/cachinfl.bth (rev 0) +++ cpu/ppc/cachinfl.bth 2007-07-23 19:40:40 UTC (rev 488) @@ -0,0 +1,36 @@ +purpose: Build script for the cacheon+inflater dropin +copyright: Copyright 1997 FirmWorks All Rights Reserved + +command: &builder &this +in: cacheon.img +in: inflate.bin +build-now + +\needs $add-dropin fload ${BP}/tools/mkdropin.fth + +\ Concatentate cacheon.img and inflate.bin and write it as a dropin file + +0 value bigbuf +0 value /bigbuf + +: bufs+ ( adr1 len1 adr2 len2 -- adr3 len3 ) + 2swap tuck ( adr2 len2 len1 adr1 len1 ) + 3 pick + ( adr2 len2 len1 adr1 len3 ) + tuck resize throw ( adr2 len2 len1 len3 adr3 ) + tuck 2>r ( adr2 len2 len1 adr3 ) ( r: len3,adr3 ) + + swap move ( ) ( r: len3,adr3 ) + 2r> swap ( adr3 len3 ) +; + + +" cachinfl.di" $new-file + " cacheon.img" $read-file ( adr1 len1 ) + " inflate.bin" $read-file ( adr1 len1 adr2 len2 ) + + bufs+ ( adr3 len3 ) + + 2dup 0 " inflate" write-dropin ( adr3 len3 ) + + free-mem + +ofd @ fclose Added: cpu/ppc/inflate.bth =================================================================== --- cpu/ppc/inflate.bth (rev 0) +++ cpu/ppc/inflate.bth 2007-07-23 19:40:40 UTC (rev 488) @@ -0,0 +1,7 @@ +purpose: Build script for the inflater +copyright: Copyright 1997 FirmWorks All Rights Reserved + +command: &builder &this +build-now + +fload ${BP}/cpu/ppc/inflate.fth Property changes on: cpu/ppc/olpc/build ___________________________________________________________________ Name: svn:ignore - *.rom ppcforth + *.rom ppcforth builton.fth sourceurl inflate.bin Modified: cpu/ppc/olpc/devalias.fth =================================================================== --- cpu/ppc/olpc/devalias.fth 2007-07-23 19:34:43 UTC (rev 487) +++ cpu/ppc/olpc/devalias.fth 2007-07-23 19:40:40 UTC (rev 488) @@ -1,20 +1,12 @@ purpose: Platform-specific device aliases \ See license at end of file -devalias net /pci/ethernet@e +devalias net /pci/ethernet +devalias disk /pci/disk +devalias c /pci/disk +devalias u /pci/usb/disk +devalias com1 /serial -.( XXX olpc/devalias.fth) cr -devalias disk0 /pci/disk@0,0:1 -devalias disk1 /pci/scsi@c/disk@1,0:1 -devalias disk2 /pci/scsi@c/disk@2,0:1 -devalias cdrom /pci/scsi@c/disk@5,0 - -devalias c /pci/scsi@c/disk@0,0 - -devalias disk /pci/scsi@c/disk@0,0:1 - -devalias com1 /serial@f1012000 - \ LICENSE_BEGIN \ Copyright (c) 2007 FirmWorks \ Modified: cpu/ppc/olpc/fw.bth =================================================================== --- cpu/ppc/olpc/fw.bth 2007-07-23 19:34:43 UTC (rev 487) +++ cpu/ppc/olpc/fw.bth 2007-07-23 19:40:40 UTC (rev 488) @@ -6,7 +6,6 @@ build-now \ Configuration defines -create bailout-early true to stand-init-debug? true constant real-mode? @@ -100,7 +99,7 @@ h# 0200.0000 value fw-virt-size headers -0 value memsize +h# 1000.0000 value memsize fload ${BP}/cpu/ppc/loadvmem.fth \ /mmu node stand-init: MMU @@ -185,20 +184,15 @@ \ fload ${BP}/arch/prep/eagle.fth \ Eagle configuration registers fload ${BP}/cpu/ppc/ppcboot.fth \ Forth startup code -[ifdef] bailout-early -: startup quit ; +\ --- -install-rom-cold - -.( --- Saving fw.dic ---) cr p" fw.dic" save-forth -bye -[then] - fload ${BP}/cpu/ppc/olpc/rootnode.fth \ Methods for root node fload ${BP}/cpu/ppc/olpc/pcinode.fth \ System-specific words for PCI -" " dup config-string pci-probe-list +\ Don't probe 0; it is the host bridge thing and bad things +\ happen if you change its BARs. +" 7,8" dup config-string pci-probe-list 6 buffer: 'system-mac-address : get-mac-address ( -- ) @@ -240,7 +234,7 @@ " /nvram" open-dev to nvram-node init-config-vars ; -[endif] +[then] \ fload ${BP}/dev/isa/irq.fth @@ -254,26 +248,29 @@ fload ${BP}/cpu/ppc/olpc/devalias.fth \ Device aliases -0 0 " fff00000" " /" begin-package +0 0 " 0ff00000" " /" begin-package " flash" device-name - h# 8.0000 constant /device + h# 10.0000 dup constant /device + constant /device-phys my-address my-space /device reg fload ${BP}/cpu/x86/pc/flashpkg.fth end-package -devalias rom /flash@fff00000 +devalias rom /flash@0ff00000 +[ifdef] notyet fload ${BP}/cpu/ppc/olpc/flash.fth \ Low-level FLASH access +[then] -fload ${BP}/pkg/flash/saveflsh.fth \ FLASH to disk and back - \ ' false to interrupt-auto-boot? \ Don't do countdown patch noop fw-title rom-cold \ Superseded by banner +: startup quit ; + install-rom-cold -.( --- Saving subset.dic ---) cr p" subset.dic" save-forth +.( --- Saving fw.dic ---) cr p" fw.dic" save-forth \ LICENSE_BEGIN \ Copyright (c) 2007 FirmWorks Modified: cpu/ppc/olpc/fwuboot.bth =================================================================== --- cpu/ppc/olpc/fwuboot.bth 2007-07-23 19:34:43 UTC (rev 487) +++ cpu/ppc/olpc/fwuboot.bth 2007-07-23 19:40:40 UTC (rev 488) @@ -2,7 +2,7 @@ \ See license at end of file command: &builder &this -in: ${BP}/cpu/ppc/olpc/build/fw.dic +in: ${BP}/cpu/ppc/olpc/build/olpc.img build-now create uboot-header @@ -10,8 +10,8 @@ 0 be-l, \ Header CRC, set later 0 be-l, \ Timestamp 0 be-l, \ Data size - h# 0f000000 be-l, \ Load address - h# 0f000000 be-l, \ Entry address + h# 0ff00000 be-l, \ Load address + h# 0ff00100 be-l, \ Entry address 0 be-l, \ Data CRC, set later 5 c, \ OS type - Linux 7 c, \ CPU type - PowerPC @@ -26,7 +26,7 @@ fload ${BP}/forth/lib/crc32.fth -reading fw.dic +reading olpc.img ifd @ fsize constant /image /image buffer: filebuf filebuf /image ifd @ fgets /image <> abort" Can't read image" Added: cpu/ppc/olpc/olpc.bth =================================================================== --- cpu/ppc/olpc/olpc.bth (rev 0) +++ cpu/ppc/olpc/olpc.bth 2007-07-23 19:40:40 UTC (rev 488) @@ -0,0 +1,65 @@ +purpose: Top-level build script for DDI DragonFly ROM +copyright: Copyright 1997 FirmWorks All Rights Reserved + +command: &builder &this +in: ${BP}/cpu/ppc/olpc/build/builton.fth +in: ${BP}/cpu/ppc/olpc/build/resetvec.di +in: ${BP}/cpu/ppc/olpc/build/cachinfl.di +in: ${BP}/cpu/ppc/olpc/build/start.di +in: ${BP}/cpu/ppc/olpc/build/fw.dic +in: ${BP}/dev/mmc/sdhci/build/sdhci.fc +in: ${BP}/dev/mmc/sdhci/build/sdmmc.fc +in: ${BP}/dev/usb2/hcd/ohci/build/ohci.fc +in: ${BP}/dev/usb2/hcd/ehci/build/ehci.fc +in: ${BP}/dev/usb2/device/hub/build/hub.fc +in: ${BP}/dev/usb2/device/net/build/usbnet.fc +in: ${BP}/dev/usb2/device/serial/build/usbserial.fc +in: ${BP}/dev/usb2/device/storage/build/usbstorage.fc +in: ${BP}/dev/usb2/device/keyboard/build/usbkbd.fc +in: ${BP}/dev/usb2/device/wlan/build/usb8388.fc +in: ${BP}/dev/olpc/cafenand/build/cafenand.fc +in: ${BP}/dev/olpc/cafecamera/build/cafecamera.fc +in: ${BP}/dev/pci/build/pcibridg.fc +\ in: ${BP}/dev/ide/build/idehier.fc +\ in: usb8388.bin +build-now + +\ Always re-create the builton.fth file when we make a new rom.img +fload ${BP}/cpu/x86/pc/builton.bth +\ fload ${BP}/cpu/x86/pc/olpc/sourceurl.fth + +writing olpc.img + " resetvec.di" $add-file + " start.di" $add-file + " cachinfl.di" $add-file + +\ " fw.dic" " firmware" $add-deflated-dropin + " fw.dic" " firmware" $add-dropin + + " builton.fth" " probe-" $add-dropin +\ " help.img" " help" $add-deflated-dropin + + " ${BP}/dev/pci/build/pcibridg.fc" " class060400" $add-deflated-dropin +\ " ${BP}/dev/ide/build/idehier.fc" " pci-ide" $add-deflated-dropin + + " ${BP}/dev/usb2/hcd/ohci/build/ohci.fc" " class0c0310" $add-dropin + " ${BP}/dev/usb2/hcd/ehci/build/ehci.fc" " class0c0320" $add-dropin + " ${BP}/dev/usb2/device/hub/build/hub.fc" " usb,class9" $add-dropin + " ${BP}/dev/usb2/device/net/build/usbnet.fc" " usbnet" $add-dropin + " ${BP}/dev/usb2/device/keyboard/build/usbkbd.fc" " usb,class3" $add-dropin + " ${BP}/dev/usb2/device/serial/build/usbserial.fc" " usbserial" $add-dropin + " ${BP}/dev/usb2/device/storage/build/usbstorage.fc" " usbstorage" $add-dropin +\ " ${BP}/dev/usb2/device/wlan/build/usb8388.fc" " usb1286,2001" $add-deflated-dropin +\ " usb8388.bin" " usb8388.bin" $add-deflated-dropin + + \ XXX the PCI device IDs should be different for the different CaFe functions + " ${BP}/dev/olpc/cafenand/build/cafenand.fc" " class050101" $add-dropin + " ${BP}/dev/olpc/cafecamera/build/cafecamera.fc" " pci11ab,4102" $add-dropin + + " ${BP}/dev/mmc/sdhci/build/sdhci.fc" " pci11ab,4101" $add-dropin + " ${BP}/dev/mmc/sdhci/build/sdmmc.fc" " sdmmc" $add-dropin + " ${BP}/dev/geode/nandflash/build/nandflash.fc" " nand5536" $add-dropin + + " ${BP}/ofw/inet/telnetd.fth" " telnetd" $add-deflated-dropin + +ofd @ fclose Modified: cpu/ppc/olpc/pcinode.fth =================================================================== --- cpu/ppc/olpc/pcinode.fth 2007-07-23 19:34:43 UTC (rev 487) +++ cpu/ppc/olpc/pcinode.fth 2007-07-23 19:40:40 UTC (rev 488) @@ -32,7 +32,6 @@ \ Could do interrupt routing here ; -[ifdef] notyet headerless \ Determine the parent interrupt information (the "interrupt line" in PCI @@ -43,6 +42,8 @@ \ This table describes the wiring of PCI interrupt pins at the PCI slots \ to PIRQ inputs on the 82378zb chip. The wiring varies from slot to slot. +[ifdef] notyet + create slot-map \ Pin A Pin B Pin C Pin D Dev# @@ -61,9 +62,11 @@ c - 4 * + slot-map + c@ ( pirq#|ff ) dup h# ff = if drop true else false then ; +[then] headers +[ifdef] notyet : assign-int-line ( phys.hi.func int-pin -- false | int-line true ) dup 0= if 2drop false exit then ( phys.hi.func int-pin# ) 1- swap d# 11 rshift h# 1f and ( int-pin0 dev# ) @@ -75,11 +78,16 @@ true ; +[else] +.( XXX implement assign-int-line) cr +: assign-int-line ( phys.hi.func int-pin -- false | int-line true ) + 2drop false exit +; +[then] -h# 700 encode-int \ Mask of implemented slots +h# 180 encode-int \ Mask of implemented slots " PCI 1" encode-string encode+ -" PCI 2" encode-string encode+ -" PCI 3" encode-string encode+ " slot-names" property +" PCI 2" encode-string encode+ " slot-names" property [then] device-end Added: cpu/ppc/olpc/resetvec.bth =================================================================== --- cpu/ppc/olpc/resetvec.bth (rev 0) +++ cpu/ppc/olpc/resetvec.bth 2007-07-23 19:40:40 UTC (rev 488) @@ -0,0 +1,7 @@ +purpose: Build script for the reset vector startup code +copyright: Copyright 1997 FirmWorks All Rights Reserved + +command: &builder &this +build-now + +fload ${BP}/cpu/ppc/resetvec.fth Added: cpu/ppc/olpc/start.bth =================================================================== --- cpu/ppc/olpc/start.bth (rev 0) +++ cpu/ppc/olpc/start.bth 2007-07-23 19:40:40 UTC (rev 488) @@ -0,0 +1,76 @@ +purpose: Load file for start.di dropin +copyright: Copyright 1997 FirmWorks. All rights resrved. + +command: &builder &this +build-now + +h# 0ff0.0000 constant /ram +h# 20.0000 constant /fw-ram + +true value stand-init-debug? +\ false value stand-init-debug? + +\needs start-assembling fload ${BP}/cpu/ppc/asmtools.fth + +hex + +start-assembling + +label my-entry + 0 , \ To be patched later +end-code + +fload ${BP}/cpu/ppc/olpc/reports.fth +\ fload ${BP}/cpu/ppc/olpc/initcom1.fth + +\ fload ${BP}/cpu/ppc/olpc/mem.fth +\ fload ${BP}/cpu/ppc/scrub.fth + +label start-memory ( -- ) + mfspr r31,lr + +\ init-com1 bl * + +\ eagle-mem bl * \ Configure memory +\ eagle-mem-size bl * \ r7 = actual RAMtop + /ram set r7,* + mr r30,r7 + +[ifdef] notdef + /fw-ram set r4,* \ Firmware memory size + subf r3,r4,r30 \ Firmware memory base address + scrub-memory bl * + + set r4,h#4000 \ size of low memory int vectors + set r3,0 + scrub-memory bl * +[then] + + stw r30,0(r0) \ Actual memory size in low-memory structure + + addi r3,r0,0 \ We don't know the memory speed + stw r3,4(r0) \ Memory speed in low-memory structure + + set r3,d#800000000 + stw r3,8(r0) \ CPU speed in low-memory structure + + set r3,d#200000000 + stw r3,12(r0) \ Bus speed in low-memory structure + + addi r3,r0,0 \ Null board type + stw r3,16(r0) \ Board type in low-memory structure + + /fw-ram set r4,* \ FW memory size, passed to reset code in r4 + subf r3,r4,r30 \ FW memory base addr., passed to reset code in r3 + + mtspr lr,r31 + bclr 20,0 +end-code + +start-memory my-entry put-branch + +end-assembling + +writing start.di +asm-base here over - 0 " start" write-dropin +ofd @ fclose Modified: cpu/ppc/ppcboot.fth =================================================================== --- cpu/ppc/ppcboot.fth 2007-07-23 19:34:43 UTC (rev 487) +++ cpu/ppc/ppcboot.fth 2007-07-23 19:40:40 UTC (rev 488) @@ -187,7 +187,7 @@ end-code [then] -create uboot-entry +\ create uboot-entry label rom-cold-code ( r3:fw-RAM-base r4:fw-RAM-size -- ) [ifdef] uboot-entry

1 0

r487 - dev/geode/ac97
by svn＠openbios.org 23 Jul '07

23 Jul '07

Author: wmb Date: 2007-07-23 21:34:43 +0200 (Mon, 23 Jul 2007) New Revision: 487 Modified: dev/geode/ac97/ac97.fth Log: AC97 audio driver - added a 30 ms delay after turning on the amplifier, thus ensuring that the amp is actually on before starting send it audio. Modified: dev/geode/ac97/ac97.fth =================================================================== --- dev/geode/ac97/ac97.fth 2007-07-23 19:32:55 UTC (rev 486) +++ dev/geode/ac97/ac97.fth 2007-07-23 19:34:43 UTC (rev 487) @@ -215,7 +215,7 @@ : codec-set ( bitmask reg# -- ) dup >r codec@ or r> codec! ; : codec-clr ( bitmask reg# -- ) dup >r codec@ swap invert and r> codec! ; : amplifier-on ( -- ) - h# 8000 h# 26 amp-default-on? if codec-clr else codec-set then + h# 8000 h# 26 amp-default-on? if codec-clr else codec-set then d# 30 ms ; : amplifier-off ( -- ) h# 8000 h# 26 amp-default-on? if codec-set else codec-clr then

1 0

r486 - cpu/x86
by svn＠openbios.org 23 Jul '07

23 Jul '07

Author: wmb Date: 2007-07-23 21:32:55 +0200 (Mon, 23 Jul 2007) New Revision: 486 Modified: cpu/x86/tsc.fth Log: x86 timing-measurement: Made t( and )t store the starting timestamp in a variable instead of on the stack, so you can now measure code sequences that change the stack depth. Modified: cpu/x86/tsc.fth =================================================================== --- cpu/x86/tsc.fth 2007-07-23 19:30:35 UTC (rev 485) +++ cpu/x86/tsc.fth 2007-07-23 19:32:55 UTC (rev 486) @@ -39,11 +39,12 @@ ' (ms) to ms \ Timing tools -: t( ( -- d.timestamp ) tsc@ ; -: )t ( d.timestamp -- ) - tsc@ 2swap d- d# 367 um/mod nip ( microseconds ) +2variable timestamp +: t( ( -- ) tsc@ timestamp 2! ; +: )t ( -- ) + tsc@ timestamp 2@ d- d# 367 um/mod nip ( microseconds ) push-decimal - <# u# u# u# [char] , hold u# u#s u#> type ." usec" + <# u# u# u# [char] , hold u# u#s u#> type ." uS " pop-base ;

1 0

r485 - cpu/x86/pc
by svn＠openbios.org 23 Jul '07

23 Jul '07

Author: wmb Date: 2007-07-23 21:30:35 +0200 (Mon, 23 Jul 2007) New Revision: 485 Modified: cpu/x86/pc/paging.bth Log: x86 - Fixed crash that occurs after a long sequence of memory mapping operations, caused by an error in the early init code. One of the pages that is used by the memory management code was on the free list. Modified: cpu/x86/pc/paging.bth =================================================================== --- cpu/x86/pc/paging.bth 2007-07-23 06:51:54 UTC (rev 484) +++ cpu/x86/pc/paging.bth 2007-07-23 19:30:35 UTC (rev 485) @@ -147,11 +147,6 @@ loopa then -[ifdef] mem-info-pa - si mem-info-pa 1 la+ #) mov \ Report top of page table area -\ di mem-info-pa 2 la+ #) mov \ Report top of page table area -[then] - [ifdef] rom-pa \ Page Directory Entry /ptab # si sub @@ -175,6 +170,10 @@ loopa [then] +[ifdef] mem-info-pa + si mem-info-pa 1 la+ #) mov \ Report top of page table area +[then] + ascii P report \ enable paging bx cr3 mov \ Set Page Directory Base Register

1 0

r484 - dev/mmc/sdhci
by svn＠openbios.org 23 Jul '07

23 Jul '07

Author: wmb Date: 2007-07-23 08:51:54 +0200 (Mon, 23 Jul 2007) New Revision: 484 Modified: dev/mmc/sdhci/sdhci.fth Log: SDHCI: OLPC trac 1377 - added MMC support and prefixed error message with "SDHCI:" Modified: dev/mmc/sdhci/sdhci.fth =================================================================== --- dev/mmc/sdhci/sdhci.fth 2007-07-22 08:49:28 UTC (rev 483) +++ dev/mmc/sdhci/sdhci.fth 2007-07-23 06:51:54 UTC (rev 484) @@ -89,6 +89,7 @@ ; 0 instance value sd-clk +0 instance value mmc? \ 1 is reset_all, 2 is reset CMD line, 4 is reset DAT line : sw-reset ( mask -- ) @@ -138,6 +139,12 @@ : card-clock-on ( -- ) h# 2c cw@ 4 or h# 2c cw! ; : card-clock-off ( -- ) h# 2c cw@ 4 invert and h# 2c cw! ; +: card-clock-slow ( -- ) \ Less than 400 kHz, for init + card-clock-off + h# 8003 h# 2c cw! \ Set divisor to 2^128, leaving internal clock on + card-clock-on +; + : card-clock-25 ( -- ) card-clock-off h# 103 h# 2c cw! \ Set divisor to 2^1, leaving internal clock on @@ -219,7 +226,7 @@ dup 1 = if true to timeout? 2drop exit then then ( isr esr ) - ." Error: ISR = " swap u. + ." SDHCI: Error: ISR = " swap u. ." ESR = " dup u. decode-esr ." Stopping" cr abort \ debug-me @@ -242,7 +249,7 @@ get-msecs d# 1000 + ( limit ) begin present-state@ 1 and while ( limit ) dup get-msecs - 0< if - ." SDHCI command ready timeout" cr + ." SDHCI: command ready timeout" cr abort then repeat ( limit ) @@ -283,7 +290,12 @@ \ Store in the buffer in little-endian form : get-response136 ( buf -- ) \ 128 bits (16 bytes) of data. - h# 20 h# 10 do i cl@ buf+! 4 +loop drop +\ h# 20 h# 10 do i cl@ buf+! 4 +loop drop + >r + h# 1c cl@ 8 lshift h# 1b cb@ or r@ 0 la+ l! + h# 18 cl@ 8 lshift h# 17 cb@ or r@ 1 la+ l! + h# 14 cl@ 8 lshift h# 13 cb@ or r@ 2 la+ l! + h# 10 cl@ 8 lshift r> 3 la+ l! ; d# 64 instance buffer: scratch-buf @@ -297,11 +309,14 @@ : reset-card ( -- ) 0 0 0 cmd 0 to rca ; \ 0 - +: send-op-cond ( voltage-range -- ocr ) h# 0102 0 cmd response ; \ R3 + \ Get card ID; Result is in cid buffer : get-all-cids ( -- ) 0 h# 0209 0 cmd cid get-response136 ; \ 2 R2 \ Get relative card address -: get-rca ( -- ) 0 h# 031a 0 cmd response h# ffff0000 and to rca ; \ 3 R6 +: get-rca ( -- ) 0 h# 031a 0 cmd response h# ffff0000 and to rca ; \ 3 R6 - SD +: set-rca ( rca -- ) to rca rca h# 031a 0 cmd ; \ 3 R1 - MMC : set-dsr ( -- ) 0 h# 0400 0 cmd ; \ 4 - UNTESTED @@ -317,8 +332,10 @@ : deselect-card ( -- ) 0 h# 0700 0 cmd ; \ 7 - with null RCA : select-card ( -- ) rca h# 071b 0 cmd ; \ 7 R1b -: send-if-cond ( -- ) h# 1aa h# 081a 0 cmd ( response h# 1aa <> if ." Error" then ) ; \ 8 R7 +: send-if-cond ( -- ) h# 1aa h# 081a 0 cmd ( response h# 1aa <> if ." Error" then ) ; \ 8 R7 (SD) +\ : send-ext-csd ( adr -- ) 0 h# 0812 0 cmd ; \ 8 R1 (MMC) Untested - requires data transfer + \ Get Card-specific data : get-csd ( -- ) rca h# 0909 0 cmd csd get-response136 ; \ 9 R2 : get-cid ( -- ) rca h# 0a09 0 cmd cid get-response136 ; \ 10 R2 UNTESTED @@ -385,67 +402,114 @@ scratch-buf ; -\ Version 2 of the spec add CMD8. Pre-v2 cards will time out on CMD8. -: sd2? ( -- flag ) - true to allow-timeout? false to timeout? - send-if-cond - false to allow-timeout? +9 instance value address-shift +h# 8010.0000 value oc-mode \ Voltage settings, etc. - timeout? 0= -; +: wait-powered ( -- error? ) + false to mmc? -0 instance value address-shift -h# 8010.0000 value oc-mode \ Voltage settings, etc. + 9 to address-shift -: wait-powered ( -- ocr ) d# 100 0 do - oc-mode set-oc ( ocr ) \ acmd41 - dup h# 8000.0000 and ( card-powered-on? ) - if unloop exit then + + false to timeout? + mmc? if + oc-mode send-op-cond \ cmd2 ( ocr ) + timeout? if drop true unloop exit then ( ocr ) + else + oc-mode set-oc \ acmd41 ( ocr ) + timeout? if drop true to mmc? 0 then ( ocr ) + then ( ocr ) + + dup h# 8000.0000 and if ( card-powered-on? ) + + \ Card Capacity Status bit - High Capacity cards are addressed + \ in blocks, so the block number does not have to be shifted. + \ Standard capacity cards are addressed in bytes, so the block + \ number must be left-shift by 9 (multiplied by 512). + h# 4000.0000 and if 0 to address-shift then + + unloop false exit + then drop d# 10 ms loop ( ) - ." Card didn't power up after 1 second" cr + + ." SDHCI: Card didn't power up after 1 second" cr abort ; -: set-operating-conditions ( -- ) - sd2? if h# 4030.0000 else h# 0030.0000 then to oc-mode +: set-operating-conditions ( -- error? ) + false to mmc? + true to allow-timeout? - wait-powered + \ SD version 2 adds CMD3. Pre-v2 cards will time out. + false to timeout? send-if-cond ( ) + timeout? if h# 0030.0000 else h# 4030.0000 then to oc-mode - \ Card Capacity Status bit - High Capacity cards are addressed - \ in blocks, so the block number does not have to be shifted. - \ Standard capacity cards are addressed in bytes, so the block - \ number must be left-shift by 9 (multiplied by 512). + wait-powered if true exit then - h# 4000.0000 and if 0 else 9 then to address-shift + false to allow-timeout? + false ; -: configure-transfer ( -- ) - 2 set-bus-width \ acmd6 - bus width 4 - 4-bit +: set-timeout ( -- ) \ The h# c below is supposed to be h# b, but there is a CaFe bug \ in which the timeout code is off by one, which makes the timeout \ be half the requested length. h# c data-timeout! \ 2^24 / 48 MHz = 0.35 sec - /block set-blocklen \ Cmd 16 ; -: ?high-speed ( -- ) - \ High speed didn't exist until SD spec version 1.10 - \ The low nibble of the first byte of SCR data is 0 for v1.0 and v1.01, - \ 1 for v1.10, and 2 for v2. - get-scr c@ h# f and 0= if exit then +: configure-transfer ( -- ) + mmc? if + 1-bit + \ We don't support 4-bit mode for MMC yet - \ Ask if high-speed is supported - h# 00ff.fff1 switch-function d# 13 + c@ 2 and if - h# 80ff.fff1 switch-function drop \ Perform the switch - \ Bump the host controller clock - host-high-speed \ Changes the clock edge - card-clock-50 + \ We don't support switching to high speed on MMC yet. + \ Doing so requires reading the EXT_CSD block + else + 2 set-bus-width \ acmd6 - bus width 4 + 4-bit + /block set-blocklen \ Cmd 16 + + \ High speed didn't exist until SD spec version 1.10 + \ The low nibble of the first byte of SCR data is 0 for v1.0 and v1.01, + \ 1 for v1.10, and 2 for v2. + get-scr c@ h# f and 0= if exit then + + \ Ask if high-speed is supported + h# 00ff.fff1 switch-function d# 13 + c@ 2 and if + h# 80ff.fff1 switch-function drop \ Perform the switch + \ Bump the host controller clock + host-high-speed \ Changes the clock edge + card-clock-50 + else + card-clock-25 + then then ; +\ Extract bit fields from CSD or CID (adr is either csd or cid) +: @bits ( bit# #bits adr -- bits ) + rot 8 - ( #bits adr bit# ) \ -8 accounts for elided CRC + d# 32 /mod ( #bits adr off long# ) + /l* rot + >r ( #bits off r: ladr ) + 2dup + d# 32 > if ( #bits off r: ladr ) + \ Get two longs and splice + r@ l@ over rshift ( #bits off l.low r: ladr ) + r> la1+ l@ ( #bits off l.low l.high ) + rot d# 32 swap - ( #bits l.low l.high #shift ) + lshift or ( #bits l ) + else ( #bits off r: ladr ) + \ The field is contained in one longword + r> l@ swap rshift ( #bits l ) + then ( #bits l ) + swap dup d# 32 = if ( l #bits ) + drop ( bits ) + else ( l #bits ) + 1 swap lshift 1- and ( bits ) + then ( bits ) +; + 0 instance value writing? \ This is the correct way to wait for programming complete. @@ -455,7 +519,7 @@ get-msecs d# 1000 + ( limit ) begin get-status 9 rshift h# f and 7 = while ( limit ) dup get-msecs - 0< if - ." SDHCI wait-write-done timeout" cr + ." SDHCI: wait-write-done timeout" cr abort then repeat ( limit ) @@ -473,20 +537,29 @@ card-inserted? 0= if card-power-off false exit then - card-clock-25 d# 10 ms \ This delay is just a guess + card-clock-slow d# 10 ms \ This delay is just a guess reset-card \ Cmd 0 - ['] set-operating-conditions catch if false exit then + set-operating-conditions if false exit then get-all-cids \ Cmd 2 - get-rca \ Cmd 3 - Get relative card address - get-csd \ Cmd 9 - Get card-specific data - select-card \ Cmd 7 - Select + mmc? if + h# 10000 set-rca \ Cmd 3 (MMC) - Get relative card address + else + get-rca \ Cmd 3 (SD) - Get relative card address + then + card-clock-25 + + get-csd \ Cmd 9 - Get card-specific data + + select-card \ Cmd 7 - Select + configure-transfer - ?high-speed + set-timeout + true ;

1 0

Re: [OpenBIOS] [Qemu-devel] Re: What is the current support state for Sparc emulation
by Blue Swirl 22 Jul '07

22 Jul '07

On 7/19/07, spectral(a)op.pl <spectral(a)op.pl> wrote: > Unhandled Exception 0x00000007 > PC = 0xffd0a55c NPC = 0xffd09374 > Stopping execution > > So this is my report, I hope it can be of some use. I'll try to boot sparc version of OpenSolaris soon and I'l let you know how it went. Thanks for the report. Exception 7 is unaligned access, support for detection of unaligned accesses in QEMU was improved recently. The exception happens inside OpenBIOS: 0xffd0a55c is in lstore (kernel/forth.c:649). 644 645 static void lstore(void) 646 { 647 const u32 *aaddr = (u32 *)cell2pointer(POP()); 648 const u32 longval = POP(); 649 write_long(aaddr, longval); 650 } Maybe write_long should handle unaligned addresses?

2 3

r483 - dev/16550pkg
by svn＠openbios.org 22 Jul '07

22 Jul '07

Author: wmb Date: 2007-07-22 10:49:28 +0200 (Sun, 22 Jul 2007) New Revision: 483 Modified: dev/16550pkg/16550.fth Log: serial driver - Fixed a bug caused by a name conflict between x86 "msr@" and PowerPC "msr@", which are not compatible. The net result was that the OFW "com1" driver did not work at all on x86. Modified: dev/16550pkg/16550.fth =================================================================== --- dev/16550pkg/16550.fth 2007-07-22 01:17:56 UTC (rev 482) +++ dev/16550pkg/16550.fth 2007-07-22 08:49:28 UTC (rev 483) @@ -12,12 +12,14 @@ 0 instance value uart-base \ Virtual address of UART; set later : uart-base-adr ( -- adr ) - [ifdef] msr@ uart-base - msr@ h# 30 and 0= if h# fff and io-base + then - [else] - uart-base - [then] +\ The following code is a PowerPC-specific hack that +\ handles the case where memory mapping is turned off +\ (in which case the 0x30 bit in MSR is 0). Note that +\ the PowerPC msr@ is not compatible with the x86 msr@. +\ [ifdef] msr@ +\ msr@ h# 30 and 0= if h# fff and io-base + then +\ [then] ; : uart@ ( reg# -- byte ) uart-base-adr + rb@ ; \ Read from a UART register : uart! ( byte reg# -- ) uart-base-adr + rb! ; \ Write to a UART register

1 0

r482 - forth/lib
by svn＠openbios.org 22 Jul '07

22 Jul '07

Author: wmb Date: 2007-07-22 03:17:56 +0200 (Sun, 22 Jul 2007) New Revision: 482 Added: forth/lib/base64decode.fth forth/lib/base64encode.fth Log: Added base64 encoding and decoding functions. Added: forth/lib/base64decode.fth =================================================================== --- forth/lib/base64decode.fth (rev 0) +++ forth/lib/base64decode.fth 2007-07-22 01:17:56 UTC (rev 482) @@ -0,0 +1,127 @@ +purpose: Decode base64 (RFC 1341) +\ See license at end of file + +0 [if] +\ Constructing the map on the fly takes almost as much space as including +\ it verbatim. The verbatim copy is probably smaller when compressed. + +h# 100 buffer: base64-map + +: ?make-map ( -- ) + base64-map c@ h# ff <> if + base64-map h# 100 h# ff fill + " ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/" + bounds ?do i base64-map i c@ + c! loop + h# fe base64-map [char] = + c! + then +; + +[else] + +base @ hex +create base64-map +ff c, ff c, ff c, ff c, ff c, ff c, ff c, ff c, +ff c, ff c, ff c, ff c, ff c, ff c, ff c, ff c, +ff c, ff c, ff c, ff c, ff c, ff c, ff c, ff c, +ff c, ff c, ff c, ff c, ff c, ff c, ff c, ff c, +ff c, ff c, ff c, ff c, ff c, ff c, ff c, ff c, +ff c, ff c, ff c, 3e c, ff c, ff c, ff c, 3f c, \ + / +34 c, 35 c, 36 c, 37 c, 38 c, 39 c, 3a c, 3b c, \ 0-7 +3c c, 3d c, ff c, ff c, ff c, fe c, ff c, ff c, \ 89= +ff c, 0 c, 1 c, 2 c, 3 c, 4 c, 5 c, 6 c, \ A-G + 7 c, 8 c, 9 c, a c, b c, c c, d c, e c, \ H-O + f c, 10 c, 11 c, 12 c, 13 c, 14 c, 15 c, 16 c, \ P-W +17 c, 18 c, 19 c, ff c, ff c, ff c, ff c, ff c, \ X-Z +ff c, 1a c, 1b c, 1c c, 1d c, 1e c, 1f c, 20 c, \ a-g +21 c, 22 c, 23 c, 24 c, 25 c, 26 c, 27 c, 28 c, \ h-o +29 c, 2a c, 2b c, 2c c, 2d c, 2e c, 2f c, 30 c, \ p-w +31 c, 32 c, 33 c, ff c, ff c, ff c, ff c, ff c, \ x-z +ff c, ff c, ff c, ff c, ff c, ff c, ff c, ff c, +ff c, ff c, ff c, ff c, ff c, ff c, ff c, ff c, +ff c, ff c, ff c, ff c, ff c, ff c, ff c, ff c, +ff c, ff c, ff c, ff c, ff c, ff c, ff c, ff c, +ff c, ff c, ff c, ff c, ff c, ff c, ff c, ff c, +ff c, ff c, ff c, ff c, ff c, ff c, ff c, ff c, +ff c, ff c, ff c, ff c, ff c, ff c, ff c, ff c, +ff c, ff c, ff c, ff c, ff c, ff c, ff c, ff c, +ff c, ff c, ff c, ff c, ff c, ff c, ff c, ff c, +ff c, ff c, ff c, ff c, ff c, ff c, ff c, ff c, +ff c, ff c, ff c, ff c, ff c, ff c, ff c, ff c, +ff c, ff c, ff c, ff c, ff c, ff c, ff c, ff c, +ff c, ff c, ff c, ff c, ff c, ff c, ff c, ff c, +ff c, ff c, ff c, ff c, ff c, ff c, ff c, ff c, +ff c, ff c, ff c, ff c, ff c, ff c, ff c, ff c, +ff c, ff c, ff c, ff c, ff c, ff c, ff c, ff c, +base ! +[then] + +variable base64-buf \ Bit buffer, collects 6-bit groups into 3 bytes +variable base64-nbits \ Number of bits currently in bit buffer +variable base64-trim \ Number of bytes to trim at the end +\needs base64-outp variable base64-outp \ Output buffer pointer + +: base64-bits ( 6bits -- ) + base64-buf @ 6 lshift or base64-buf ! + 6 base64-nbits +! + base64-nbits @ d# 24 = if + base64-buf @ lbsplit drop ( b2 b1 b0 ) + base64-outp @ tuck c! 1+ tuck c! 1+ tuck c! 1+ ( adr' ) + base64-outp ! + base64-nbits off + then +; + +\ where must be large enough to hold the result including up to 2 padding bytes +\ Trivially, ( inlen ) 3 + 4 / 3 * ( outlen ) +\ but that ignores the fact that, in practice, the line length is limited to +\ to 76 characters, so some embedded newlines are skipped. That makes the +\ actual output length smaller than the calculation above, so the above is safe. +\ In-place decoding is possible, since the output pointer can never catch up +\ to the input pointer. + +: decode-base64 ( adr len where -- len' ) +[ifdef] ?make-map ?make-map [then] + base64-nbits off 0 base64-trim ! ( adr len where ) + dup base64-outp ! -rot ( where adr len ) + + bounds ?do ( where ) + i c@ base64-map + c@ ( where sym ) + dup h# ff = if ( where sym ) + drop ( where ) + else ( where sym ) + dup h# fe = if ( where sym ) + 1 base64-trim +! ( where sym ) + base64-trim @ 2 > abort" Bad base64 input" + drop 0 base64-bits ( where ) + else ( where sym ) + base64-trim @ 0<> abort" Bad base64 input" + base64-bits ( where ) + then ( where ) + then ( where ) + loop ( where ) + base64-outp @ swap - base64-trim @ - ( len ) +; + +\ LICENSE_BEGIN +\ Copyright (c) 2007 FirmWorks +\ +\ Permission is hereby granted, free of charge, to any person obtaining +\ a copy of this software and associated documentation files (the +\ "Software"), to deal in the Software without restriction, including +\ without limitation the rights to use, copy, modify, merge, publish, +\ distribute, sublicense, and/or sell copies of the Software, and to +\ permit persons to whom the Software is furnished to do so, subject to +\ the following conditions: +\ +\ The above copyright notice and this permission notice shall be +\ included in all copies or substantial portions of the Software. +\ +\ THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, +\ EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF +\ MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND +\ NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE +\ LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION +\ OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION +\ WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. +\ +\ LICENSE_END Added: forth/lib/base64encode.fth =================================================================== --- forth/lib/base64encode.fth (rev 0) +++ forth/lib/base64encode.fth 2007-07-22 01:17:56 UTC (rev 482) @@ -0,0 +1,118 @@ +purpose: Encode in base64 (RFC 1341) +\ See license at end of file + +variable base64-linelen + +defer base64-emit + +: base64-putcr ( -- ) + carret base64-emit linefeed base64-emit + base64-linelen off +; + +: base64-putb ( char -- ) + base64-emit 1 base64-linelen +! + base64-linelen @ d# 72 = if base64-putcr then +; + +: base64-out ( 6bits -- ) + h# 3f and ( bits ) + " ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/" ( bits adr len ) + drop + c@ ( char ) + base64-putb ( ) +; + +: base64-put= ( -- ) [char] = base64-putb debug-me ; + +: base64-encbyte ( adr bits #rshift -- adr' bits' ) + >r ( adr bits' r: #rshift ) + 8 lshift over c@ or ( adr bits' r: #rshift ) \ Get 8 new bits + swap 1+ swap ( adr bits' r: #rshift ) \ Increment address + dup r> rshift base64-out ( adr bits' ) \ Output 6 high bits +; + +: encode-base64 ( adr len -- ) + base64-linelen off ( adr len ) + bounds ( endadr adr ) + begin 2dup 3 + >= while ( endadr adr ) + 0 ( endadr adr 0bits ) + 2 base64-encbyte ( endadr adr' 2bits ) + 4 base64-encbyte ( endadr adr' 4bits ) + 6 base64-encbyte ( endadr adr' 6bits ) + base64-out ( endadr adr ) + repeat ( endadr adr ) + + tuck - case ( adr ) + 1 of ( adr ) + 0 ( adr 0bits ) + 2 base64-encbyte ( adr' 2bits ) + 4 lshift base64-out ( adr ) + base64-put= base64-put= ( adr ) + endof + + 2 of ( adr ) + 0 ( adr 0bits ) + 2 base64-encbyte ( adr' 2bits ) + 4 base64-encbyte ( adr' 4bits ) + 2 lshift base64-out ( adr ) + base64-put= ( adr ) + endof + endcase ( adr ) + + drop ( ) + + base64-linelen @ if base64-putcr then ( ) +; + +: stream-encode-base64 ( adr len -- ) + ['] emit to base64-emit + encode-base64 +; + +\ "where" must have enough space to hold the result +\ +\ : outlen ( inlen -- outlen ) +\ \ Account for symbol expansion +\ 2 + 3 / 4 * ( #6bit-symbols ) +\ \ Account for CR-LFs +\ d# 72 /mod d# 74 * ( lastline-symbols fullline-bytes ) +\ \ CR-LF on possible short last line +\ swap ?dup if + 2+ then +\ ; + +\needs base64-outp variable base64-outp \ Output buffer pointer +variable base64-outbase +: base64-memout ( char -- ) base64-outp @ c! 1 base64-outp +! ; + +: mem-encode-base64 ( adr len where -- outlen ) + dup base64-outp ! base64-outbase ! + ['] base64-memout to base64-emit + + encode-base64 + + base64-outp @ base64-outbase @ - +; + +\ LICENSE_BEGIN +\ Copyright (c) 2007 FirmWorks +\ +\ Permission is hereby granted, free of charge, to any person obtaining +\ a copy of this software and associated documentation files (the +\ "Software"), to deal in the Software without restriction, including +\ without limitation the rights to use, copy, modify, merge, publish, +\ distribute, sublicense, and/or sell copies of the Software, and to +\ permit persons to whom the Software is furnished to do so, subject to +\ the following conditions: +\ +\ The above copyright notice and this permission notice shall be +\ included in all copies or substantial portions of the Software. +\ +\ THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, +\ EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF +\ MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND +\ NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE +\ LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION +\ OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION +\ WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. +\ +\ LICENSE_END

1 0

r481 - cpu/x86/pc/olpc
by svn＠openbios.org 20 Jul '07

20 Jul '07

Author: wmb Date: 2007-07-20 23:16:58 +0200 (Fri, 20 Jul 2007) New Revision: 481 Modified: cpu/x86/pc/olpc/copynand.fth Log: OLPC trac 1115 - copy-nand improvements: a) Checked for a number of error cases - empty .img file, .img file not a multiple of the NAND erase block size, .crc file length not a multiple of the CRC record length, .crc file length wrong for the .img file. b) Read the CRC file into a buffer at the beginning, so copy-nand works over HTTP. Modified: cpu/x86/pc/olpc/copynand.fth =================================================================== --- cpu/x86/pc/olpc/copynand.fth 2007-07-20 02:51:52 UTC (rev 480) +++ cpu/x86/pc/olpc/copynand.fth 2007-07-20 21:16:58 UTC (rev 481) @@ -10,10 +10,22 @@ 0 value nand-pages/block 0 value #nand-pages +0 value #image-eblocks +0 value #crc-records + +0 value crc-buf + +: >crc ( index -- crc ) crc-buf swap la+ l@ ; + : close-nand-ihs ( -- ) - fileih ?dup if 0 to fileih close-dev then - nandih ?dup if 0 to nandih close-dev then + fileih ?dup if 0 to fileih close-dev 0 to #image-eblocks then + nandih ?dup if 0 to nandih close-dev 0 to #nand-pages then crc-ih ?dup if 0 to crc-ih close-dev then + #crc-records if + crc-buf #crc-records /l* free-mem + 0 to crc-buf + 0 to #crc-records + then ; : ?nand-abort ( flag msg$ -- ) @@ -48,37 +60,63 @@ true ; - +\ Open the CRC file and parse all the CRC values into an integer array : open-crcs ( name$ -- ) open-dev to crc-ih crc-ih 0= " Can't open CRC file" ?nand-abort + + " size" crc-ih $call-method 9 um/mod ( residue #lines ) + swap 0<> " CRC file length is not a multiple of the CRC record length" ?nand-abort + + to #crc-records ( ) + #crc-records /l* alloc-mem to crc-buf + + #crc-records 0 ?do + next-crc 0= " CRC record read failure" ?nand-abort ( crc ) + crc-buf i la+ l! + loop + + crc-ih close-dev 0 to crc-ih ; h# 100 buffer: image-name-buf : image-name$ ( -- adr len ) image-name-buf count ; +h# 100 buffer: crc-name-buf +: crc-name$ ( -- adr len ) crc-name-buf count ; - : ?open-crcs ( -- ) image-name$ + 4 - " .img" caps-comp 0= if - " crc" image-name$ + 3 - swap move - image-name$ open-crcs - else - 0 to crc-ih + image-name$ crc-name-buf place + " crc" crc-name$ + 3 - swap move + crc-name$ open-crcs then - crc-ih if ." Check file is " image-name$ type cr then + #crc-records if + ." Check file is " crc-name$ type cr + then ; +: get-img-filename ( -- ) safe-parse-word image-name-buf place ; + : open-img ( "devspec" -- ) - safe-parse-word 2dup image-name-buf place ( devspec$ ) - open-dev to fileih + image-name$ open-dev to fileih fileih 0= " Can't open NAND image file" ?nand-abort + " size" fileih $call-method /nand-block um/mod ( residue #eblocks ) + to #image-eblocks ( residue ) + 0<> " Image file size is not a multiple of the NAND erase block size" ?nand-abort + #image-eblocks 0= " Image file is empty" ?nand-abort + + #crc-records if + #image-eblocks #crc-records <> " CRC file length is wrong" ?nand-abort + then ; -: #records ( ih /record -- n ) - swap " size" rot $call-method rot um/mod nip +: read-image-block ( -- ) + load-base /nand-block " read" fileih $call-method ( len ) + /nand-block <> " Bad read of .img file" ?nand-abort ( ) ; -: check-mem-crc ( crc -- ) +: check-mem-crc ( record# -- ) + >crc ( crc ) load-base /nand-block $crc ( crc actual-crc ) 2dup <> if cr ." CRC miscompare - expected " swap . ." got " . cr @@ -89,79 +127,70 @@ then ( ) ; -: ?check-crc ( -- ) - crc-ih if - next-crc 0= " Premature end of .crc file" ?nand-abort - check-mem-crc - then +: ?check-crc ( record# -- ) + #crc-records if check-mem-crc else drop then ; + : copy-nand ( "devspec" -- ) open-nand + get-img-filename + ?open-crcs open-img - ?open-crcs ['] noop to show-progress ." Erasing..." cr " wipe" nandih $call-method - cr ." Writing " fileih /nand-block #records . ." blocks" cr - 0 - begin - load-base /nand-block " read" fileih $call-method - 0> while - (cr dup . 1+ - ?check-crc + cr ." Writing " #image-eblocks . ." blocks" cr + + #image-eblocks 0 ?do + (cr i . + read-image-block + i ?check-crc load-base " copy-block" nandih $call-method - repeat - drop + loop close-nand-ihs ; : verify-nand ( "devspec" -- ) open-nand + get-img-filename open-img ['] noop to show-progress - ." Verifing " fileih /nand-block #records . ." blocks" cr + ." Verifing " #image-eblocks . ." blocks" cr - 0 - begin ( block# ) - load-base /nand-block " read" fileih $call-method ( block# #read ) - 0> while ( block# ) - (cr dup . 1+ ( block#' ) - load-base /nand-block + " read-next-block" nandih $call-method ( block# ) - load-base load-base /nand-block + /nand-block comp if ( block# ) - cr ." Miscompare in block starting at page# " ( block# ) - " scan-page#" nandih $call-method .x cr ( block# ) + #image-eblocks 0 ?do + (cr i . + read-image-block + load-base /nand-block + " read-next-block" nandih $call-method ( ) + load-base load-base /nand-block + /nand-block comp if ( ) + cr ." Miscompare in block starting at page# " ( ) + " scan-page#" nandih $call-method .x cr ( ) ?key-stop - then ( block# ) - repeat ( block# ) - drop ( ) + then ( ) + repeat ( ) close-nand-ihs ; : crc-img ( "img-devspec" -- ) hex open-nand close-nand-ihs \ To set sizes + get-img-filename + ?open-crcs open-img - ?open-crcs - crc-ih 0= " No CRC file" ?nand-abort + #crc-records 0= " No CRC file" ?nand-abort ['] noop to show-progress - ." Verifying " crc-ih 9 #records . ." blocks" cr + ." Verifying " #crc-records . ." blocks" cr - 0 - begin next-crc while ( block# crc ) - swap (cr dup . 1+ swap ( block#' crc ) - - load-base /nand-block " read" fileih $call-method ( block# crc len ) - /nand-block <> " Short img file" ?nand-abort ( block# crc ) - - check-mem-crc ( block# ) - repeat ( block# ) - drop ( ) + #crc-records 0 ?do + (cr i . + read-image-block + i check-mem-crc + loop close-nand-ihs ; @@ -171,25 +200,23 @@ safe-parse-word open-crcs ['] noop to show-progress - ." Verifying " crc-ih 9 #records . ." blocks" cr + ." Verifying " #crc-records . ." blocks" cr - 0 - begin next-crc while ( block# crc ) - swap (cr dup . 1+ swap ( block#' crc ) + #crc-records 0 ?do + (cr i . - load-base " read-next-block" nandih $call-method ( block# crc ) + load-base " read-next-block" nandih $call-method ( ) - load-base /nand-block $crc ( block# crc actual-crc ) - 2dup <> if - cr ." CRC miscompare - expected " swap . ." got " . + load-base /nand-block $crc i >crc ( actual-crc expected-crc ) + 2dup <> if ( actual-crc expected-crc ) + cr ." CRC miscompare - expected " . ." got " . ( ) ." in NAND block starting at page " " scan-page#" nandih $call-method . cr ?key-stop - else - 2drop - then ( block# ) - repeat ( block# ) - drop ( ) + else ( actual-crc expected-crc ) + 2drop ( ) + then ( ) + repeat ( ) close-nand-ihs ;

1 0

r166 - in openbios-devel: arch/sparc32 drivers
by svn＠openbios.org 20 Jul '07

20 Jul '07

Author: blueswirl Date: 2007-07-20 13:23:30 +0200 (Fri, 20 Jul 2007) New Revision: 166 Modified: openbios-devel/arch/sparc32/init.fs openbios-devel/arch/sparc32/romvec.c openbios-devel/drivers/iommu.c openbios-devel/drivers/obio.c Log: Fix mapping of a single byte area, fix reset and poweroff Modified: openbios-devel/arch/sparc32/init.fs =================================================================== --- openbios-devel/arch/sparc32/init.fs 2007-07-11 19:48:31 UTC (rev 165) +++ openbios-devel/arch/sparc32/init.fs 2007-07-20 11:23:30 UTC (rev 166) @@ -52,12 +52,6 @@ device-end -: sparc32-reset-all - h# 71f00000 1 iow! - ; - -' sparc32-reset-all to reset-all - : rmap@ ( virt -- rmentry ) drop 0 ; Modified: openbios-devel/arch/sparc32/romvec.c =================================================================== --- openbios-devel/arch/sparc32/romvec.c 2007-07-11 19:48:31 UTC (rev 165) +++ openbios-devel/arch/sparc32/romvec.c 2007-07-20 11:23:30 UTC (rev 166) @@ -244,7 +244,7 @@ static void obp_reboot(char *str) { - extern volatile int *reset_reg; + extern volatile unsigned char *reset_reg; printk("rebooting (%s)\n", str); *reset_reg = 1; @@ -254,7 +254,7 @@ static void obp_abort(void) { - extern volatile int *power_reg; + extern volatile unsigned char *power_reg; printk("abort, power off\n"); *power_reg = 1; @@ -264,7 +264,7 @@ static void obp_halt(void) { - extern volatile int *power_reg; + extern volatile unsigned char *power_reg; printk("halt, power off\n"); *power_reg = 1; Modified: openbios-devel/drivers/iommu.c =================================================================== --- openbios-devel/drivers/iommu.c 2007-07-11 19:48:31 UTC (rev 165) +++ openbios-devel/drivers/iommu.c 2007-07-20 11:23:30 UTC (rev 166) @@ -195,7 +195,7 @@ unsigned int mva; off = pa & (PAGE_SIZE - 1); - npages = (off + (size - 1) + (PAGE_SIZE - 1)) / PAGE_SIZE; + npages = (off + size - 1) / PAGE_SIZE + 1; pa &= ~(PAGE_SIZE - 1); va = mem_alloc(&cio, npages * PAGE_SIZE, PAGE_SIZE); Modified: openbios-devel/drivers/obio.c =================================================================== --- openbios-devel/drivers/obio.c 2007-07-11 19:48:31 UTC (rev 165) +++ openbios-devel/drivers/obio.c 2007-07-20 11:23:30 UTC (rev 166) @@ -812,9 +812,15 @@ fword("finish-device"); } -volatile int *power_reg, *reset_reg; +volatile unsigned char *power_reg, *reset_reg; static void +sparc32_reset_all(void) +{ + *reset_reg = 1; +} + +static void ob_power_init(uint64_t base, uint64_t offset, int intr) { ob_new_obio_device("power", NULL); @@ -824,6 +830,10 @@ // Not in device tree reset_reg = map_io(base + (uint64_t)SLAVIO_RESET, RESET_REGS); + bind_func("sparc32-reset-all", sparc32_reset_all); + push_str("' sparc32-reset-all to reset-all"); + fword("eval"); + ob_intr(intr); fword("finish-device");

1 0

r480 - cpu/i8051
by svn＠openbios.org 20 Jul '07

20 Jul '07

Author: wmb Date: 2007-07-20 04:51:52 +0200 (Fri, 20 Jul 2007) New Revision: 480 Modified: cpu/i8051/kernel.bth Log: 8051 - enabled headerless Modified: cpu/i8051/kernel.bth =================================================================== --- cpu/i8051/kernel.bth 2007-07-20 02:13:21 UTC (rev 479) +++ cpu/i8051/kernel.bth 2007-07-20 02:51:52 UTC (rev 480) @@ -35,7 +35,8 @@ fload ${BP}/cpu/i8051/metainit.fth \ Turn on the metacompiler -always-headers \ Don't omit any headers +\ always-headers \ Don't omit any headers +sometimes-headers \ Omit headers according to headers/headerless \ Comment out the following lines when debugging -1 threshold ! \ Turn OFF ALL debugging messages

1 0

r479 - cpu/i8051/build
by svn＠openbios.org 20 Jul '07

20 Jul '07

Author: wmb Date: 2007-07-20 04:13:21 +0200 (Fri, 20 Jul 2007) New Revision: 479 Modified: cpu/i8051/build/Makefile Log: 8051 Makefile - Fixed silly error in sim target. Modified: cpu/i8051/build/Makefile =================================================================== --- cpu/i8051/build/Makefile 2007-07-20 01:45:12 UTC (rev 478) +++ cpu/i8051/build/Makefile 2007-07-20 02:13:21 UTC (rev 479) @@ -17,7 +17,7 @@ @make -C ${HOSTDIR} forth sim: kernel.hex - s51 -s ${SIMTTY} -X 32M /c/Temp/kernel.hex + s51 -s ${SIMTTY} -X 32M kernel.hex build: ${HOSTDIR}/forth @ln -sf ${HOSTDIR}/forth $@

1 0

r478 - cpu/i8051/build
by svn＠openbios.org 20 Jul '07

20 Jul '07

Author: wmb Date: 2007-07-20 03:45:12 +0200 (Fri, 20 Jul 2007) New Revision: 478 Modified: cpu/i8051/build/Makefile Log: 8051 Makefile: Fixed HOSTDIR Modified: cpu/i8051/build/Makefile =================================================================== --- cpu/i8051/build/Makefile 2007-07-20 01:00:03 UTC (rev 477) +++ cpu/i8051/build/Makefile 2007-07-20 01:45:12 UTC (rev 478) @@ -5,7 +5,7 @@ # XXX need a better way of determining this HOST := x86 -XHOSTDIR := $(shell eval "(cd ../../${HOST}/${OS}; pwd)") +HOSTDIR := $(shell eval "(cd ../../${HOST}/${OS}; pwd)") all: kernel.hex @@ -13,17 +13,17 @@ .PRECIOUS: kernel.img -${XHOSTDIR}/forth: - @make -C ${XHOSTDIR} forth +${HOSTDIR}/forth: + @make -C ${HOSTDIR} forth sim: kernel.hex s51 -s ${SIMTTY} -X 32M /c/Temp/kernel.hex -build: ${XHOSTDIR}/forth - @ln -sf ${XHOSTDIR}/forth $@ +build: ${HOSTDIR}/forth + @ln -sf ${HOSTDIR}/forth $@ %.img: FORCE build - ./build $@ + HOSTDIR=${HOSTDIR} ./build $@ %.hex: %.img objcopy -I binary -O ihex $< $@

1 0

r477 - forth/wrapper
by svn＠openbios.org 20 Jul '07

20 Jul '07

Author: wmb Date: 2007-07-20 03:00:03 +0200 (Fri, 20 Jul 2007) New Revision: 477 Modified: forth/wrapper/wrapper.c Log: wrapper: Improved the ifdef structure so it is slightly less hideous. Modified: forth/wrapper/wrapper.c =================================================================== --- forth/wrapper/wrapper.c 2007-07-20 00:34:15 UTC (rev 476) +++ forth/wrapper/wrapper.c 2007-07-20 01:00:03 UTC (rev 477) @@ -162,7 +162,6 @@ #else # ifdef __i386__ # ifndef CKERNEL - char *host_cpu = "x86"; # define LinuxX86 # define HOST_LITTLE_ENDIAN # endif @@ -172,12 +171,8 @@ #ifdef NT char *host_os = "nt"; -#ifdef POWERPC -char *host_cpu = "powerpc"; -#else char *host_cpu = "x86"; #endif -#endif #ifdef OSF1 char *host_os = "osf1"; @@ -185,7 +180,7 @@ #endif -#ifdef POWERPC +#ifdef TARGET_POWERPC char *target_cpu = "powerpc"; #ifndef LinuxPOWERPC #define TOCCALL @@ -284,7 +279,7 @@ #include <signal.h> -#ifdef POWERPC +#ifdef TARGET_POWERPC #ifdef LinuxPOWERPC #define NOGLUE #else @@ -308,10 +303,6 @@ #endif #endif -#ifdef SIM -#define HELPER -#endif - #ifdef WIN32 #define isatty _isatty #define kbhit _kbhit @@ -352,7 +343,7 @@ INTERNAL long f_ioctl(); INTERNAL long f_lseek(); INTERNAL long f_crstr(); -#ifdef SIM +#ifdef PPCSIM /* These are not INTERNAL because the PowerPC simulator uses then */ long c_key(); long s_bye(); @@ -397,9 +388,6 @@ INTERNAL long s_ioperm(); INTERNAL long f_mkdir(); INTERNAL long f_rmdir(); -#ifdef SIM -INTERNAL long printnum(); -#endif #ifdef DLOPEN extern long dlopen(), dlsym(), dlerror(), dlclose(); #endif @@ -988,7 +976,7 @@ dictsize = sizeof(header) + imagesize + extrasize ; dictsize += 16; /* Allow for alignment */ -# ifdef SIM +# ifdef PPCSIM printf("PowerPC Instruction Set Simulator\n"); printf("Copyright 1994 FirmWorks All rights reserved\n"); # endif @@ -1016,7 +1004,7 @@ f_close(f); -# if defined(POWERPC) && defined(HOST_LITTLE_ENDIAN) +# if defined(TARGET_POWERPC) && defined(HOST_LITTLE_ENDIAN) lbflips((long *)(loadaddr + sizeof(header) + header.h_tlen), header.h_dlen); qlbflips((long *)(loadaddr + sizeof(header)), @@ -1059,7 +1047,7 @@ argc, argv)); #endif -#ifdef HELPER +#ifdef PPCSIM simulate(0L, loadaddr+sizeof(header)+START_OFFSET, loadaddr, functions, ((long)loadaddr+dictsize - 16) & ~15, argc, argv, 1 /* 0=POWER, 1=PowerPC */); @@ -1081,7 +1069,7 @@ } # elif !defined(TOCCALL) -# ifdef POWERPC +# ifdef TARGET_POWERPC s_bye((*(long (*) ())(loadaddr+sizeof(header)+START_OFFSET)) (loadaddr, ((char *)functions)+1, ((long)loadaddr+dictsize - 16) & ~15, argc, argv, 1)); @@ -2227,13 +2215,6 @@ return((long)mem); } -#ifdef SIM -INTERNAL long printnum(n1,n2,n3) -long n1,n2,n3; -{ - printf("%x %x %x\n", n3,n2,n1); -} -#endif /* ARGSUSED */ INTERNAL long

1 0

r476 - in cpu/i8051: . build
by svn＠openbios.org 20 Jul '07

20 Jul '07

Author: wmb Date: 2007-07-20 02:34:15 +0200 (Fri, 20 Jul 2007) New Revision: 476 Added: cpu/i8051/build/Makefile Modified: cpu/i8051/build/ cpu/i8051/kernel.bth cpu/i8051/target.fth Log: i8051 kernel - Checkpoint Property changes on: cpu/i8051/build ___________________________________________________________________ Name: svn:ignore + *.hex build Added: cpu/i8051/build/Makefile =================================================================== --- cpu/i8051/build/Makefile (rev 0) +++ cpu/i8051/build/Makefile 2007-07-20 00:34:15 UTC (rev 476) @@ -0,0 +1,32 @@ +SIMTTY = /dev/pts/1 + +OS := $(shell uname) + +# XXX need a better way of determining this +HOST := x86 + +XHOSTDIR := $(shell eval "(cd ../../${HOST}/${OS}; pwd)") + +all: kernel.hex + +.PHONY: FORCE all clean + +.PRECIOUS: kernel.img + +${XHOSTDIR}/forth: + @make -C ${XHOSTDIR} forth + +sim: kernel.hex + s51 -s ${SIMTTY} -X 32M /c/Temp/kernel.hex + +build: ${XHOSTDIR}/forth + @ln -sf ${XHOSTDIR}/forth $@ + +%.img: FORCE build + ./build $@ + +%.hex: %.img + objcopy -I binary -O ihex $< $@ + +clean: + rm -f *.img *.hex *.log headers *~ build Modified: cpu/i8051/kernel.bth =================================================================== --- cpu/i8051/kernel.bth 2007-07-19 22:28:50 UTC (rev 475) +++ cpu/i8051/kernel.bth 2007-07-20 00:34:15 UTC (rev 476) @@ -18,7 +18,7 @@ fload ${BP}/forth/kernel/meta1.fth only forth also meta also definitions -\needs 8015-assembler caps @ caps on fload ${BP}/cpu/i8051/assem.fth caps ! +fload ${BP}/cpu/i8051/assem.fth only forth also meta assembler also meta definitions : assembler ( -- ) 8051-assembler ; Modified: cpu/i8051/target.fth =================================================================== --- cpu/i8051/target.fth 2007-07-19 22:28:50 UTC (rev 475) +++ cpu/i8051/target.fth 2007-07-20 00:34:15 UTC (rev 476) @@ -91,9 +91,8 @@ : link-t@ ( host-address -- target-address ) a-t@ ; : link-t! ( target-address host-address -- ) a-t! ; -\ Machine independent : a-t, ( target-address -- ) here /a-t allot a-t! ; -: token-t, ( target-address -- ) here /token-t allot token!-t ; +: token-t, ( target-address -- ) here /token-t allot token-t! ; \ Dictionary linked list; the list head is in the metacompiler environment \ during metacompilation

1 0

r475 - cpu/i8051
by svn＠openbios.org 20 Jul '07

20 Jul '07

Author: wmb Date: 2007-07-20 00:28:50 +0200 (Fri, 20 Jul 2007) New Revision: 475 Modified: cpu/i8051/assem.fth Log: 8051 assembler - fixed but in <resolve; it was not allot'ing the offset byte, so the next instruction overwrote it. Modified: cpu/i8051/assem.fth =================================================================== --- cpu/i8051/assem.fth 2007-07-19 09:51:02 UTC (rev 474) +++ cpu/i8051/assem.fth 2007-07-19 22:28:50 UTC (rev 475) @@ -358,7 +358,7 @@ here swap rel! ; : <mark ( -- to ) here ; -: <resolve ( from -- ) here rel! ; +: <resolve ( to -- ) rel, ; : but ( mark1 mark1 -- mark2 mark1 ) swap ; : yet ( mark -- mark mark ) dup ;

1 0

r474 - cpu/i8051
by svn＠openbios.org 19 Jul '07

19 Jul '07

Author: wmb Date: 2007-07-19 11:51:02 +0200 (Thu, 19 Jul 2007) New Revision: 474 Modified: cpu/i8051/assem.fth Log: 8051 assembler - Turn off jmp and call length optimizations for now. Modified: cpu/i8051/assem.fth =================================================================== --- cpu/i8051/assem.fth 2007-07-19 04:18:00 UTC (rev 473) +++ cpu/i8051/assem.fth 2007-07-19 09:51:02 UTC (rev 474) @@ -88,7 +88,7 @@ ; : byte-offset? ( offset -- flag ) h# -80 h# 7f between ; : rel! ( to from -- ) - tuck - ( from offset ) + tuck 1+ - ( from offset ) dup byte-offset? 0= abort" Bad branch offset" swap asm8! ; @@ -317,11 +317,15 @@ : pop ( iram -- ) h# d0 asm8, iram, ; : xjmp ( adr -- ) - dup here - byte-offset? if sjmp else ljmp then +\ Turn off this optimizations for now for simplicity +\ dup here - byte-offset? if sjmp else ljmp then + ljmp ; : xcall ( adr -- ) - dup here 2+ xor h# f800 and ( adr page-different? ) - if lcall else acall then ( adr ) +\ Turn off this optimizations for now for simplicity +\ dup here 2+ xor h# f800 and ( adr page-different? ) +\ if lcall else acall then ( adr ) + lcall ; : put-ljmp ( to from -- ) >r

1 0

r473 - ofw/fs/jffs2
by svn＠openbios.org 19 Jul '07

19 Jul '07

Author: wmb Date: 2007-07-19 06:18:00 +0200 (Thu, 19 Jul 2007) New Revision: 473 Modified: ofw/fs/jffs2/jffs2.fth Log: JFFS2 driver - Fixed OLPC trac #2292 (failure of "size" method) and also improved the speed of directory operations by a factor of about 4. Modified: ofw/fs/jffs2/jffs2.fth =================================================================== --- ofw/fs/jffs2/jffs2.fth 2007-07-18 05:09:39 UTC (rev 472) +++ ofw/fs/jffs2/jffs2.fth 2007-07-19 04:18:00 UTC (rev 473) @@ -437,8 +437,12 @@ l@+ ( hash adr' ) w@+ ( hash w adr' ) swap ?dup if ( hash adr' w ) \ Short form - swap -rot ( adr' hash w ) - /l* dirent-offset +! ( adr' hash ) +\ swap -rot ( adr' hash w ) +\ /l* dirent-offset +! ( adr' hash ) + + /l* dirent-offset +! ( hash adr' ) + swap ( adr' hash ) + dirent-offset @ ( adr' hash offset ) cur-pino @ rot ( adr' offset pino hash ) else ( hash adr' ) \ Long form @@ -449,6 +453,110 @@ true ; + +\ Information that we need about the working file/directory +\ The working file changes at each level of a path search + +0 instance value wd-inum \ Inumber of directory +0 instance value wf-inum \ Inumber of file or directory +0 instance value wf-type \ Type - 4 for directory, d# 10 for symlink, etc + +1 [if] +code (next-pino-match) ( adr next-dirent pino cur-pino dirent-offset -- false | adr' offset hash true ) + dx pop \ dx: dirent-offset + cx pop \ cx: cur-pino + bx pop \ bx: pino + 0 [sp] bp xchg \ bp: next-dirent + 4 [sp] si xchg \ si: adr + + si bp cmp = if + 0 [sp] bp mov \ restore bp + 4 [sp] si mov \ restore si + 4 # sp add \ clean stack + ax ax xor 0 # 0 [sp] mov \ return false + next + then + + \ If the first encoded dirent is short-form, the pino is the same as + \ before and thus matches. + ax ax xor op: 4 [si] ax mov \ ax: w + ax ax or 0<> if \ Short form + 2 # ax shl ax 0 [dx] add \ Update dirent-offset + 0 [si] cx mov \ cx: hash + 6 # si add \ skip long hash and word offset + 4 [sp] si xchg \ Put adr back on stack and restore si + 0 [dx] bp mov \ bp: offset + 0 [sp] bp xchg \ Put offset on stack and restore bp + cx push \ Put hash on stack + -1 # push \ Put true on stack + next + then + + long-offsets on + begin + ax ax xor op: 4 [si] ax mov \ ax: w + ax ax or 0<> if \ Short form + 2 # ax shl ax 0 [dx] add \ Update dirent-offset + 6 # si add \ skip long hash and word offset + else + d# 10 [si] ax mov ax 0 [dx] mov \ Update dirent-offset + d# 6 [si] ax mov ax 0 [cx] mov \ Update cur-pino + d# 14 # si add \ skip record + ax bx cmp = if + d# -14 [si] cx mov \ cx: hash + 4 [sp] si xchg \ Put adr back on stack and restore si + 0 [dx] bp mov \ bp: offset + 0 [sp] bp xchg \ Put offset on stack and restore bp + cx push \ Put hash on stack + -1 # push \ Put true on stack + next + then + then + bp si cmp = until + long-offsets off + + 0 [sp] bp mov \ restore bp + 4 [sp] si mov \ restore si + 4 # sp add \ clean stack + ax ax xor 0 # 0 [sp] mov \ return false +c; +: next-pino-match ( adr -- false | pino adr' offset hash true ) + next-dirent wd-inum cur-pino dirent-offset (next-pino-match) +; +[then] + +[ifndef] next-pino-match +: next-pino-match ( adr -- false | adr' offset hash true ) + dup next-dirent >= if drop false exit then + + \ If the first encoded dirent is short-form, the pino is the same as + \ before and thus matches. + dup la1+ w@ ?dup if ( adr w ) + /l* dirent-offset +! ( adr ) + dirent-offset @ ( adr offset ) + swap l@+ wa1+ ( offset hash adr' ) + -rot true ( offset hash adr' ) + exit + then ( adr ) + + begin ( adr ) + la1+ w@+ swap ?dup if ( adr' w ) + /l* dirent-offset +! ( adr' ) + else ( adr' ) + l@+ swap cur-pino ! ( adr' ) + l@+ swap dirent-offset ! ( adr' ) + wd-inum cur-pino @ = if ( adr' ) + dirent-offset @ ( adr' offset ) + over -3 la+ -1 wa+ l@ ( adr' offset hash ) + true ( adr' offset hash true ) + exit + then ( adr ) + then ( adr ) + dup next-dirent >= until ( adr ) + drop false ( false ) +; +[then] + \ Copy summary dirent from FLASH to memory \ Summary dirent: w.nodetype l.totlen l.offset l.pino l.version \ l.ino c.nsize c.type name @@ -758,13 +866,6 @@ ; -\ Information that we need about the working file/directory -\ The working file changes at each level of a path search - -0 instance value wd-inum \ Inumber of directory -0 instance value wf-inum \ Inumber of file or directory -0 instance value wf-type \ Type - 4 for directory, d# 10 for symlink, etc - : set-root ( -- ) 1 to wd-inum 1 to wf-inum 4 to wf-type ; \ latest-node is for symlinks and directories, which have only one data node. @@ -886,6 +987,23 @@ r> drop ; +\ This is related to play-log, but instead of going forward and +\ reading the data, it goes backward and just looks for the last +\ good node, from which it extracts the total size field. +: find-size ( -- size ) + -1 to the-eblock# + -1 to have-eblock# + next-minode begin dup minodes <> while ( 'minode ) + 8 - dup na1+ @ get-node ( 'minode' inode ) + dup inode-good? if ( 'minode inode ) + nip riisize@ ( size ) + exit ( -- size ) + then ( 'minode inode ) + drop ( 'minode ) + repeat ( 'minode ) + drop 0 ( size ) +; + : play-log ( -- ) get-inflater @@ -896,7 +1014,16 @@ release-inflater ; -: ?play-log ( -- ) file-size -1 = if play-log then ; +: ?play-log ( -- ) + file-size -1 = if + file-buf -1 = if + \ This is the value we will use for file-buf if we use read and seek + \ For load, the buffer address is given to us + next-minode to file-buf + then + play-log + then +; : +dirent ( adr -- adr' ) na1+ dup w@ 0= if 2 na+ then wa1+ ; @@ -942,21 +1069,21 @@ wd-inum crctab 2over ($crc) >r ( name$ r: hash ) 0 dirent-offset ! - dirents begin decode-dirent while ( name$ adr' offset pino' hash' ) - nip ( name$ adr offset hash' ) + dirents begin next-pino-match while ( name$ adr' offset hash ) \ Check for a hash match r@ = if ( name$ adr offset ) 2over ?update-dirent ( name$ adr ) else ( name$ adr offset ) drop ( name$ adr ) then ( name$ adr ) - repeat ( name$ adr r: hash ) + repeat ( name$ r: hash ) 2drop r> drop ( ) my-vers 0< if true exit then ( ) wf-type 4 = if wf-inum to wd-inum then false ; + \ The work file is a symlink. Resolve it to a new dirent : dir-link ( -- error? ) delimiter >r [char] / to delimiter @@ -1064,13 +1191,10 @@ : prep-dirents ( -- ) minodes 'next-minode ! \ Empty the list - dirents begin decode-dirent while ( adr offset pino hash ) - drop wd-inum = if ( adr offset ) - insert-dirent ( adr ) - else ( adr offset ) - drop ( adr ) - then ( adr ) - repeat ( ) + dirents ( adr ) + begin next-pino-match while ( adr' offset hash ) + drop insert-dirent ( adr ) + repeat ( ) ; \ End of "tdirent" section @@ -1181,6 +1305,27 @@ : ?release ( flag -- flag ) dup 0= if release-buffers then ; +\ Starting at the current directory (wd-inum), process all the path components, +\ resolving symlinks until either a directory or an ordinary file is found. +\ If the resulting final component is a directory, leave wd-inum set to it. +\ If the resulting final component is a file, collect its data nodes so that +\ "seek", "read", and "load" will access its data. + +: $find-file ( name$ -- found? ) + $resolve-path if false exit then ( ) + + begin + \ We now have the dirent for the file at the end of the string + wf-type case + 4 of wf-inum to wd-inum true exit endof \ Directory + 8 of collect-nodes exit endof \ Regular file + d# 10 of dir-link if false exit then endof \ Link + ( default ) \ Anything else (special file) is error + drop false exit + endcase + again +; + : open ( -- flag ) \ This lets us open the node during compilation standalone? 0= if true exit then @@ -1193,30 +1338,19 @@ scan-occupied ( ) - \ This is the value we will use for file-buf if we use read and seek - next-inode to file-buf - false to first-time? my-args " <NoFile>" $= if true exit then - my-args set-root $resolve-path if false ?release exit then ( ) - - begin - \ We now have the dirent for the file at the end of the string - wf-type case - 4 of wf-inum to wd-inum true exit endof \ Directory - 8 of collect-nodes ?release exit endof \ Regular file - d# 10 of dir-link if false ?release exit then endof \ Link - ( default ) \ Anything else (special file) is error - drop false ?release exit - endcase - again + set-root + my-args $find-file ( okay? ) + ?release ; : close ( -- ) release-buffers ; -: size ( -- d.size ) ?play-log file-size 0 ; +: size ( -- d.size ) find-size 0 ; + : read ( adr len -- actual ) ?play-log ( adr len ) clip-size tuck ( len' len' adr len' )

1 0

r472 - cpu/i8051
by svn＠openbios.org 18 Jul '07

18 Jul '07

Author: wmb Date: 2007-07-18 07:09:39 +0200 (Wed, 18 Jul 2007) New Revision: 472 Added: cpu/i8051/assem.fth Log: Initial revision Added: cpu/i8051/assem.fth =================================================================== --- cpu/i8051/assem.fth (rev 0) +++ cpu/i8051/assem.fth 2007-07-18 05:09:39 UTC (rev 472) @@ -0,0 +1,471 @@ + +vocabulary 8051-assembler +: assembler 8051-assembler ; +assembler also definitions + +defer asm8@ also forth ' c@ previous is asm8@ +defer asm8! also forth ' c! previous is asm8! +defer here also forth ' here previous is here +defer asm-allot also forth ' allot previous is asm-allot + +\ append values to the end of a code definition which is being built. +\ always little-endian: +: asm8, ( n -- ) here 1 asm-allot asm8! ; + +d# -1 constant # +d# -2 constant @R0 +d# -3 constant @R1 +d# -4 constant R7 +d# -5 constant R6 +d# -6 constant R5 +d# -7 constant R4 +d# -8 constant R3 +d# -9 constant R2 +d# -10 constant R1 +d# -11 constant R0 +d# -12 constant A + +\ Port bits +: bitnum: create , does> @ + ; +8 0 do i bitnum: loop .0 .1 .2 .3 .4 .5 .6 .7 + +\ SFRs +h# 80 constant p0 +h# 81 constant sp +h# 82 constant dpl +h# 83 constant dph +h# 87 constant pcon +h# 88 constant tcon +h# 89 constant tmod +h# 8a constant tl0 +h# 8b constant tl1 +h# 8c constant th0 +h# 8d constant th1 +h# 90 constant p1 +h# 98 constant scon +h# 99 constant sbuf \ not bit-addressable +h# a0 constant p2 +h# a8 constant ie +h# b0 constant p3 +h# b8 constant ip +h# d0 constant psw +h# e0 constant acc +h# f0 constant b + +\ KB3700 extensions/changes +h# 80 constant p0ie \ Bits enable corresponding interrupt +h# 86 constant pcon2 \ Various, see KB3700 manual (page 35) +h# 90 constant p1ie \ Bits enable corresponding interrupt +h# 9a constant scon2 \ Extended baud rate divisor, low byte +h# 9b constant scon3 \ Extended baud rate divisor, high byte +h# b0 constant p3ie \ Bits enable corresponding interrupt +h# d8 constant p0if \ Bits report corresponding interrupt status +h# e8 constant p1if \ Bits report corresponding interrupt status +h# f8 constant p3if \ Bits report corresponding interrupt status + + +: acall ( adr -- ) \ ppp1.0001 llll.llll + \ XXX check that adr matches high 5 bits of PC + h# 7ff and wbsplit ( low high ) + 5 lshift h# 11 or asm8, ( low ) + asm8, +; +: ajmp ( adr -- ) \ ppp1.0001 llll.llll + \ XXX check that adr matches high 5 bits of PC + h# 7ff and wbsplit ( low high ) + 5 lshift h# 01 or asm8, ( low ) + asm8, +; + +: iram, ( n -- ) + dup h# ff > abort" IRAM address too large" + asm8, +; + +: immed, ( n -- ) + dup h# ff > abort" Immediate value too large" + asm8, +; +: byte-offset? ( offset -- flag ) h# -80 h# 7f between ; +: rel! ( to from -- ) + tuck - ( from offset ) + dup byte-offset? 0= abort" Bad branch offset" + swap asm8! +; +: rel, ( n -- ) here rel! 1 asm-allot ; + +: add ( n [ # or @ ] -- ) + dup # = if drop h# 24 asm8, immed, exit then + + dup @R0 = if drop h# 26 asm8, exit then + dup @R1 = if drop h# 27 asm8, exit then + dup R0 R7 between if R0 - h# 28 + asm8, exit then + + h# 25 asm8, iram, +; + +: addc ( n [ # or @ ] -- ) + dup # = if drop h# 34 asm8, immed, exit then + + dup @R0 = if drop h# 36 asm8, exit then + dup @R1 = if drop h# 37 asm8, exit then + dup R0 R7 between if R0 - h# 38 + asm8, exit then + + h# 35 asm8, iram, +; + +: subb ( n # | n | @Rn | Rn ] -- ) + dup # = if drop h# 94 asm8, immed, exit then + + dup @R0 = if drop h# 96 asm8, exit then + dup @R1 = if drop h# 97 asm8, exit then + dup R0 R7 between if R0 - h# 98 + asm8, exit then + + h# 95 asm8, iram, +; + +: anl ( n # | n | @Rn | Rn ] -- ) + dup # = if drop h# 54 asm8, immed, exit then + + dup @R0 = if drop h# 56 asm8, exit then + dup @R1 = if drop h# 57 asm8, exit then + dup R0 R7 between if R0 - h# 58 + asm8, exit then + h# 55 asm8, iram, +; + +: anlr ( iram -- ) h# 52 asm8, asm8, ; +: anli ( data iram -- ) h# 53 asm8, asm8, asm8, ; \ ANL iramadr,#data +: anlc ( bit-addr -- ) h# 82 asm8, asm8, asm8, ; +: anlc/ ( bit-addr -- ) h# b0 asm8, asm8, asm8, ; + +: orl ( n # | n | @Rn | Rn ] -- ) + dup # = if drop h# 44 asm8, immed, exit then + + dup @R0 = if drop h# 46 asm8, exit then + dup @R1 = if drop h# 47 asm8, exit then + dup R0 R7 between if R0 - h# 48 + asm8, exit then + + h# 45 asm8, iram, +; + +: orlr ( iram -- ) h# 42 asm8, asm8, ; +: orli ( data iram -- ) h# 43 asm8, asm8, asm8, ; \ ANL iramadr,#data +: orlc ( bit-addr -- ) h# 72 asm8, asm8, asm8, ; +: orlc/ ( bit-addr -- ) h# a0 asm8, asm8, asm8, ; + +: xrli ( data iram -- ) h# 63 asm8, asm8, asm8, ; \ XRL iramadr,#data +: xrl ( n # | n | @Rn | Rn ] -- ) + dup # = if drop h# 64 asm8, immed, exit then + + dup @R0 = if drop h# 66 asm8, exit then + dup @R1 = if drop h# 67 asm8, exit then + + dup R0 R7 between if R0 - h# 68 + asm8, exit then + + h# 65 asm8, iram, +; + +: mov ( ? -- ) \ a,src + dup # = if drop h# 74 asm8, immed, exit then + + dup @R0 = if drop h# e6 asm8, exit then + dup @R1 = if drop h# e7 asm8, exit then + + dup R0 R7 between if R0 - h# e8 + asm8, exit then + + h# e5 asm8, iram, +; + +: movr ( ? -- ) \ dst,a + dup @R0 = if drop h# f6 asm8, exit then + dup @R1 = if drop h# f7 asm8, exit then + + dup R0 R7 between if R0 - h# f8 + asm8, exit then + + h# f5 asm8, iram, +; + +: movc ( bit -- ) h# a2 asm8, asm8, ; + +: movi ( data ea -- ) \ ea,#data + dup @R0 = if drop h# 76 asm8, immed, exit then + dup @R1 = if drop h# 77 asm8, immed, exit then + + dup R0 R7 between if R0 - h# 78 + asm8, immed, exit then + h# 75 asm8, iram, immed, +; + +: mov_to_iram ( ea iram -- ) \ iram,ea + swap + dup @R0 = if drop h# 86 asm8, iram, exit then + dup @R1 = if drop h# 87 asm8, iram, exit then + + dup R0 R7 between if R0 - h# 88 + asm8, iram, exit then + h# 85 asm8, iram, iram, +; + +: mov_from_iram ( iram ea -- ) \ ea,iram + dup @R0 = if drop h# a6 asm8, iram, exit then + dup @R1 = if drop h# a7 asm8, iram, exit then + + dup R0 R7 between if R0 - h# a8 + asm8, iram, exit then + drop true abort" illegal addressing mode" +; + +: xchg ( n | @Rn | Rn ] -- ) + dup @R0 = if drop h# c6 asm8, exit then + dup @R1 = if drop h# c7 asm8, exit then + + dup R0 R7 between if R0 - h# c8 + asm8, exit then + + h# c5 asm8, iram, +; + +: dec ( n | A | @Rn | Rn ] -- ) + dup A = if drop h# 14 asm8, exit then + + dup @R0 = if drop h# 16 asm8, exit then + dup @R1 = if drop h# 17 asm8, exit then + dup R0 R7 between if R0 - h# 18 + asm8, exit then + + h# 15 asm8, iram, +; + +: djnz ( adr n | @Rn | Rn ] -- ) + dup R0 R7 between if R0 - h# d8 + asm8, rel, exit then + + h# d5 asm8, iram, rel, +; + +: inc ( n | A | @Rn | Rn ] -- ) + dup A = if drop h# 04 asm8, exit then + + dup @R0 = if drop h# 06 asm8, exit then + dup @R1 = if drop h# 07 asm8, exit then + dup R0 R7 between if R0 - h# 08 + asm8, exit then + + h# 05 asm8, iram, +; + +: orlr ( iram -- ) h# 62 asm8, asm8, ; +: orli ( data iram -- ) h# 63 asm8, asm8, asm8, ; \ ANL iramadr,#data + +: cjne ( adr n # | n | @Rn | Rn ] -- ) + dup # = if drop h# b4 asm8, immed, rel, exit then + + dup @R0 = if drop h# b6 asm8, rel, exit then + dup @R1 = if drop h# b7 asm8, rel, exit then + + dup R0 R7 between if R0 - h# b8 + asm8, rel, exit then + + h# b5 asm8, iram, rel, +; + +: cpl ( bit -- ) h# b2 asm8, asm8, ; +: clr ( bit -- ) h# c2 asm8, asm8, ; +: setb ( bit -- ) h# d2 asm8, asm8, ; +: jc ( reladdr -- ) h# 40 asm8, rel, ; +: jnc ( reladdr -- ) h# 50 asm8, rel, ; +: jz ( reladdr -- ) h# 60 asm8, rel, ; +: jnz ( reladdr -- ) h# 70 asm8, rel, ; +: sjmp ( reladdr -- ) h# 80 asm8, rel, ; +: jb ( reladdr bit -- ) h# 20 asm8, asm8, rel, ; +: jbc ( reladdr bit -- ) h# 10 asm8, asm8, rel, ; +: jnb ( reladdr bit -- ) h# 30 asm8, asm8, rel, ; + +: 1mi create c, does> c@ asm8, ; + +h# d6 1mi xchd_a,@R0 +h# d7 1mi xchd_a,@R1 + +h# 00 1mi nop + +h# 22 1mi ret +h# 32 1mi reti + +h# 03 1mi rr +h# 13 1mi rrc +h# 23 1mi rl +h# 33 1mi rlc +h# 73 1mi jmp@a+dptr +h# a3 1mi incdptr +h# b3 1mi cplc +h# c3 1mi clrc +h# d3 1mi setbc + +h# 84 1mi div +h# a4 1mi mulab +h# c4 1mi swapa +h# d4 1mi da +h# e4 1mi clra +h# f4 1mi cpla + +h# e0 1mi movx_a,@dptr +h# e2 1mi movx_a,@r0 +h# e3 1mi movx_a,@r1 +h# f0 1mi movx_@dptr,a +h# f2 1mi movx_@r0,a +h# f3 1mi movx_@r1,a +h# 83 1mi movc_a,@a+pc +h# 93 1mi movc_a,@a+dptr + +: ladr, ( adr -- ) wbsplit asm8, asm8, ; +: ljmp ( adr -- ) h# 02 asm8, ladr, ; +: lcall ( adr -- ) h# 12 asm8, ladr, ; + +: push ( iram -- ) h# c0 asm8, iram, ; +: pop ( iram -- ) h# d0 asm8, iram, ; + +: xjmp ( adr -- ) + dup here - byte-offset? if sjmp else ljmp then +; +: xcall ( adr -- ) + dup here 2+ xor h# f800 and ( adr page-different? ) + if lcall else acall then ( adr ) +; +: put-ljmp ( to from -- ) + >r + h# 12 r@ asm8! ( to r: from ) + wbsplit ( to.lo to.hi r: from ) + r@ 1+ asm8! ( to.lo r: from ) + r> 2+ asm8! ( ) +; + +hex + +h# 10 constant bit-set?&clr \ JBC +h# 20 constant bit-clr? \ JB +h# 30 constant bit-set? \ JNB +h# 40 constant no-carry? \ JC +h# 50 constant carry? \ JNC +h# 60 constant 0<> \ JZ +h# 70 constant 0= \ JNZ + +: put-cond ( [ bit# ] cond -- ) + dup asm8, \ Conditional branch + h# 40 < if asm8, then \ Include bit# if necessary +; + +\ >mark must return the address of the opcode, not the address +\ of the offset, in order for loclabel.fth to work. +: >mark ( -- from ) here ; +: >resolve ( from -- ) + dup asm8@ h# 40 < if 2+ else 1+ then \ Skip opcode [ and bit# ] + here swap rel! +; +: <mark ( -- to ) here ; +: <resolve ( from -- ) here rel! ; + +: but ( mark1 mark1 -- mark2 mark1 ) swap ; +: yet ( mark -- mark mark ) dup ; + +\ Assemble DJNZ in either Rn or direct form +: ,loop ( to [ iram | reg ] -- ) + dup R0 R7 between if ( to reg ) + R0 - h# d8 + asm8, ( to ) \ 2-byte Rn form + else ( to iram ) + h# d5 asm8, asm8, ( to iram ) \ 3-byte direct form + then ( to ) + <resolve +; + +\ After we start redefining control structure words, we have to be +\ careful not to use them with the expectation of their Forth meanings. +: if ( [ bit# ] cond -- from ) >mark >r put-cond 0 asm8, r> ; +: until ( to [ bit# ] cond -- ) h# 10 xor put-cond here rel! ; + +: then ( from -- ) >resolve ; +: begin ( -- to ) <mark ; +: ahead ( -- from ) h# 80 if ; \ SJMP +: else ( from -- from' ) ahead but then ; +: again ( to -- ) h# 80 asm8, <resolve ; \ SJMP +: while ( to -- from to ) if but ; +: repeat ( from to -- ) again then ; + +only forth also definitions + +\ If xxxx.1rrr bit is set, it is a regular form where the EA is R0..7 +\ If xxxx.0100 the EA is often #immed +\ If xxxx.0101 the EA is often iram +\ If xxxx.0110 the EA is always @R0 +\ If xxxx.0111 the EA is always @R1 + +\ nop 0000.0000 + +\ jbc bit reladr 0001.0000 bit reladr +\ jb bit reladr 0010.0000 bit reladr +\ jnb bit reladr 0011.0000 bit reladr + +\ jc reladr 0100.0000 reladr +\ jnc reladr 0101.0000 reladr +\ jz reladr 0110.0000 reladr +\ jnz reladr 0111.0000 reladr +\ sjmp reladr 1000.0000 reladr + +\ movx_a,@dptr 1110.0000 +\ movx_@dptr,a 1111.0000 + +\ acall ppp1.0001 llll.llll +\ ajmp ppp0.0001 llll.llll + +\ orl c,/bit 1010.0000 n n +\ anl c,/bit 1011.0000 n n +\ push 1100.0000 iram +\ pop 1101.0000 iram + +\ orl c,bit 0111.0010 n n +\ anl c,bit 1000.0010 n n +\ clr bit 1100.0010 bit +\ setb bit 1101.0010 bit + + +\ ljmp adr 0000.0010 adr adr +\ lcall adr 0001.0010 adr adr +\ ret 0010.0010 +\ reti 0011.0010 + +\ movx_a,@r0 1110.0010 +\ movx_@r0,a 1111.0010 + +\ rr 0000.0011 +\ rrc 0001.0011 +\ rl 0010.0011 +\ rlc 0011.0011 + +\ jmp@a+dptr 0111.0011 +\ movc_a,@a+pc 1000.0011 +\ movc_a,@a+dptr 1001.0011 + +\ clrc 1100.0011 +\ setbc 1101.0011 +\ movx_a,@r1 1110.0011 +\ movx_@r1,a 1111.0011 + +\ div 1000.0100 (shoehorned into mov iram,ea) +\ mulab 1010.0100 (shoehorned into mov ea,iram) +\ swap 1100.0100 (shoehorned into xchg) +\ da 1101.0100 (shoehorned into djnz) +\ clra 1110.0100 (shoehorned into mov a,ea) + +\ xchd a,@r0 1101.0110 (shoehorned into djnz) +\ xchd a,@r1 1101.0111 (shoehorned into djnz) + +\ inc 0000.mmmm +\ dec 0001.mmmm +\ add 0010.mmmm +\ addc 0011.mmmm +\ orl 0100.mmmm +\ anl 0101.mmmm +\ xrl 0110.mmmm +\ mov ea,# 0111.mmmm data +\ mov iram,ea 1000.mmmm iram +\ subb 1001.mmmm +\ mov ea,iram 1010.mmmm iram +\ cjne 1011.mmmm idata reladdr (cplc shoehorned at 3, cplbit at 2) +\ xchg 1100.mmmm reladdr +\ djnz 1101.mmmm reladdr (da shoehorned at 4, xchd at 6,7) +\ mov a,ea 1110.mmmm (clr shoehorned at 4) +\ mov ea,a 1111.mmmm (cpla shoehorned at 4) +\ cpl a 1111.0100 + +\ undef 1010.0101 \ shoehorned into mov ea,iram (redundant with 85)

1 0

r471 - in cpu: i8051 ppc/Linux
by svn＠openbios.org 18 Jul '07

18 Jul '07

Author: wmb Date: 2007-07-18 07:08:52 +0200 (Wed, 18 Jul 2007) New Revision: 471 Modified: cpu/i8051/kernel.bth cpu/i8051/metainit.fth cpu/i8051/target.fth cpu/ppc/Linux/Makefile Log: Checkpoint of 8051 scaffolding. Modified: cpu/i8051/kernel.bth =================================================================== --- cpu/i8051/kernel.bth 2007-07-16 07:15:59 UTC (rev 470) +++ cpu/i8051/kernel.bth 2007-07-18 05:08:52 UTC (rev 471) @@ -42,7 +42,7 @@ warning-t off \ Turn OFF target warning messages \ Uncomment the following line(s) for more debug output -\ show? on 1 granularity ! 1 threshold ! +\ show? on 1 granularity ! 540 threshold ! \ warning-t on fload ${BP}/cpu/i8051/kerncode.fth \ CPU-dependent Forth kernel Modified: cpu/i8051/metainit.fth =================================================================== --- cpu/i8051/metainit.fth 2007-07-16 07:15:59 UTC (rev 470) +++ cpu/i8051/metainit.fth 2007-07-18 05:08:52 UTC (rev 471) @@ -26,17 +26,12 @@ \ This number is a target token rather than an absolute address. hex -0.0000 org 0.0000 voc-link-t token-t! +0 voc-link-t token-t! -ps-size-t equ ps-size +\ ps-size-t equ ps-size assembler -\ This is at the first location in the Forth image. - -hex -mlabel cld - \ LICENSE_BEGIN \ Copyright (c) 2007 FirmWorks \ Modified: cpu/i8051/target.fth =================================================================== --- cpu/i8051/target.fth 2007-07-16 07:15:59 UTC (rev 470) +++ cpu/i8051/target.fth 2007-07-18 05:08:52 UTC (rev 471) @@ -7,17 +7,21 @@ only forth also meta definitions +: note-string-t ( adr len -- adr len ) ; + : lobyte h# 0ff and ; : hibyte 8 rshift lobyte ; 2 constant /w-t -/l-t constant /n-t +: /l-t true abort" /l-t called" ; +: l,-t true abort" l,-t called" ; +/w-t constant /n-t /w-t constant /a-t /a-t constant /thread-t -/w-t constant /token-t +3 constant /token-t \ ljmp <adr> /w-t constant /link-t /token-t constant /defer-t -\ /n-t h# 600 * constant user-size-t +h# 80 constant user-size-t \ /n-t h# 100 * constant ps-size-t \ /n-t h# 100 * constant rs-size-t /w-t constant /user#-t @@ -27,14 +31,20 @@ \ 32 bit host Forth compiling 16-bit target Forth : n->n-t ; immediate +: n->l-t ; immediate +: s->l-t ; immediate : c!-t ( n add -- ) >hostaddr c! ; : c@-t ( target-address -- n ) >hostaddr c@ ; -\ Intel processors are little-endian +\ Store data in little endian : w!-t ( n add -- ) over lobyte over c!-t ca1+ swap hibyte swap c!-t ; : w@-t ( target-address -- n ) dup c@-t swap 1+ c@-t 8 << or ; +\ ljmp addresses are big endian +: be-w!-t ( n target-address -- ) over lobyte over ca1+ c!-t swap hibyte swap c!-t ; +: be-w@-t ( target-address -- n ) dup + c@-t swap c@-t 8 << or ; + alias le-w!-t w!-t alias le-w@-t w@-t @@ -57,15 +67,13 @@ : a@-t ( target-address -- target-address ) w@-t origin-t + ; : a!-t ( token target-address -- ) swap origin-t - swap w!-t ; -: token@-t ( target-address -- target-acf ) a@-t ; -: token!-t ( acf target-address -- ) a!-t ; +: token@-t ( target-address -- target-acf ) 1+ a@-t ; +: token!-t ( acf target-address -- ) h# 12 over c!-t 1+ be-w!-t ; \ lcall instruction : rlink@-t ( occurrence -- next-occurrence ) w@-t origin-t + ; : rlink!-t ( next-occurrence occurrence -- ) swap origin-t - swap w!-t ; -\ Machine independent : a,-t ( adr -- ) here-t /a-t allot-t a!-t ; -: token,-t ( token -- ) here-t /token-t allot-t token!-t ; \ These versions of linkx-t are for absolute links : link@-t ( target-address -- target-address' ) a@-t ; @@ -85,7 +93,7 @@ \ Machine independent : a-t, ( target-address -- ) here /a-t allot a-t! ; -: token-t, ( target-address -- ) here /token-t allot token-t! ; +: token-t, ( target-address -- ) here /token-t allot token!-t ; \ Dictionary linked list; the list head is in the metacompiler environment \ during metacompilation @@ -112,6 +120,8 @@ userarea-t >hostaddr user-size-t erase ; +: >body-t ( cfa-t -- pfa-t ) 3 + w@-t ; + : (>user-t) ( cfa-t -- user-address-t ) >body-t w@-t userarea-t + ; : >user-t ( cfa-t -- user-address-h ) (>user-t) >hostaddr ; @@ -158,7 +168,7 @@ /link +loop ; : initmeta ( -- ) - init-relocation-t +\ init-relocation-t threads-t clear-threads-t threads-t current-t ! ; @@ -170,9 +180,6 @@ : branch! ( from-t target-addr-t -- ) over - swap ( offset from-t ) w!-t ; : branch, ( target-t -- ) here-t - w,-t ; -\ XXX FIXME for subroutine threaded -: >body-t ( cfa-t -- pfa-t ) /n-t + ; \ This version is for indirect threaded - \ Store actions for some data types. : isuser ( n acf -- ) >user-t n-t! ; @@ -187,6 +194,7 @@ ['] here-t is here ['] allot-t is asm-allot ['] c!-t is asm8! + ['] c@-t is asm8@ [ previous meta ] ; : install-host-assembler ( -- ) [ assembler ] resident [ meta ] ; Modified: cpu/ppc/Linux/Makefile =================================================================== --- cpu/ppc/Linux/Makefile 2007-07-16 07:15:59 UTC (rev 470) +++ cpu/ppc/Linux/Makefile 2007-07-18 05:08:52 UTC (rev 471) @@ -2,8 +2,11 @@ WRAPPER = pforth OPT = -O # OPT = -CFLAGS = -DUNIX -DSYS5 -DSIM -DPOWERPC -DARGREGS -DSIMNEXT +BP=../../.. + +CFLAGS = -DUNIX -DPPCSIM -DTARGET_POWERPC + CC = gcc WRDIR = ${BP}/forth/wrapper @@ -12,8 +15,8 @@ ZIPOBJS = zipmem.o deflate.o trees.o bits.o util.o inflate.o -OBJS = wrapper.o ppcsim.o logger.o ${ZIPOBJS} -TRACEOBJS = wrapper.o ppcsim.trace.o logger.o ${ZIPOBJS} +OBJS = wrapsim.o ppcsim.o logger.o ${ZIPOBJS} +TRACEOBJS = wrapsim.o ppcsim.trace.o logger.o ${ZIPOBJS} SIMROMOBJS = simrom.o ppcsim.simrom.o all: ppcforth ppcforth.trace @@ -27,6 +30,9 @@ simrom: $(SIMROMOBJS) $(CC) $(LFLAGS) $(SIMROMOBJS) -o $@ +wrapsim.o: ${WRDIR}/wrapper.c + ${CC} -c ${CFLAGS} $< -o $@ + %.o: ${WRDIR}/%.c ${CC} -c ${CFLAGS} $< -o $@ @@ -34,16 +40,16 @@ ${CC} -c ${CFLAGS} -I${ZIPDIR} $< -o $@ ppcsim.o: $(SIMDIR)/ppcsim.c - $(CC) $(OPT) $(CFLAGS) -c $< -o $@ + $(CC) $(OPT) $(CFLAGS) -DARGREGS -DSIMNEXT -c $< -o $@ ppcsim.trace.o: $(SIMDIR)/ppcsim.c - $(CC) $(OPT) $(CFLAGS) -DTRACE -c $< -o $@ + $(CC) $(OPT) $(CFLAGS) -DARGREGS -DSIMNEXT -DTRACE -c $< -o $@ ppcsim.simrom.o: $(SIMDIR)/ppcsim.c - $(CC) $(CFLAGS) -DTRACE -DSIMROM -c $< -o $@ + $(CC) $(CFLAGS) -DARGREGS -DSIMNEXT -DTRACE -DSIMROM -c $< -o $@ simrom.o: $(SIMDIR)/simrom.c - $(CC) $(CFLAGS) -DTRACE -DSIMROM -c $< -o $@ + $(CC) $(CFLAGS) -DARGREGS -DSIMNEXT -DTRACE -DSIMROM -c $< -o $@ clean: @rm -f *.o ppcforth ppcforth.trace

1 0

r470 - cpu/i8051
by svn＠openbios.org 16 Jul '07

16 Jul '07

Author: wmb Date: 2007-07-16 09:15:59 +0200 (Mon, 16 Jul 2007) New Revision: 470 Added: cpu/i8051/build/ Log: Added i8051 build directory.

1 0

r469 - cpu cpu/i8051 forth/kernel
by svn＠openbios.org 16 Jul '07

16 Jul '07

Author: wmb Date: 2007-07-16 09:10:05 +0200 (Mon, 16 Jul 2007) New Revision: 469 Added: cpu/i8051/ cpu/i8051/kernel.bth cpu/i8051/metainit.fth cpu/i8051/target.fth forth/kernel/conf16.fth Log: Added basic structure for 8051 Forth kernel. Added: cpu/i8051/kernel.bth =================================================================== --- cpu/i8051/kernel.bth (rev 0) +++ cpu/i8051/kernel.bth 2007-07-16 07:10:05 UTC (rev 469) @@ -0,0 +1,103 @@ +purpose: Load file for x86 Forth kernel +\ See license at end of file + +command: &builder &this +build-now + +: \Tags [compile] \ ; immediate +: \NotTags ; immediate + +\ ' $report-name is include-hook ' noop is include-exit-hook + ' noop is include-hook ' noop is include-exit-hook + +warning off \ Turn OFF the warning messages + +: resident ; + +fload ${BP}/forth/kernel/conf16.fth +fload ${BP}/forth/kernel/meta1.fth + +only forth also meta also definitions +\needs 8015-assembler caps @ caps on fload ${BP}/cpu/i8051/assem.fth caps ! + +only forth also meta assembler also meta definitions +: assembler ( -- ) 8051-assembler ; + +only forth also meta also assembler definitions +fload ${BP}/forth/lib/loclabel.fth \ Local label assembler feature + +\ : : : lastacf .name cr ; \ Debugging tool + +fload ${BP}/cpu/i8051/target.fth \ Target configuration + +fload ${BP}/forth/kernel/forward.fth \ Metacompiler forward referencing +fload ${BP}/forth/kernel/metacompile.fth \ Metacompiler + +fload ${BP}/cpu/i8051/metainit.fth \ Turn on the metacompiler + +always-headers \ Don't omit any headers + +\ Comment out the following lines when debugging +-1 threshold ! \ Turn OFF ALL debugging messages +warning-t off \ Turn OFF target warning messages + +\ Uncomment the following line(s) for more debug output +\ show? on 1 granularity ! 1 threshold ! +\ warning-t on + +fload ${BP}/cpu/i8051/kerncode.fth \ CPU-dependent Forth kernel + +[ifdef] notdef \ This is the FirmWorks Forth kernel high-level code +: \tagvoc ; immediate +: \nottagvoc [compile] \ ; immediate + +\ fload ${BP}/forth/kernel/uservars.fth +\ fload ${BP}/forth/kernel/double.fth +\ \ : (d.) ( d -- adr len ) tuck dabs <# #s rot sign #> ; +\ \ fload ${BP}/forth/kernel/dmuldiv.fth + +\ fload ${BP}/forth/lib/bitops.fth +\ fload ${BP}/forth/lib/struct.fth +\ fload ${BP}/forth/kernel/kernel.fth +\ fload ${BP}/forth/kernel/sysio.fth +\ fload ${BP}/forth/lib/dumballo.fth +\ fload ${BP}/cpu/x86/syscall.fth +\ fload ${BP}/cpu/x86/boot.fth +\ fload ${BP}/forth/kernel/init.fth +\ fload ${BP}/cpu/x86/finish.fth +[then] + +' (do-literal) is do-literal + +\ Save the result to a file +writing kernel.img +origin-t >hostaddr here-t origin-t - ofd @ fputs +ofd @ fclose + +warning on + +hex + +\ LICENSE_BEGIN +\ Copyright (c) 2007 FirmWorks +\ +\ Permission is hereby granted, free of charge, to any person obtaining +\ a copy of this software and associated documentation files (the +\ "Software"), to deal in the Software without restriction, including +\ without limitation the rights to use, copy, modify, merge, publish, +\ distribute, sublicense, and/or sell copies of the Software, and to +\ permit persons to whom the Software is furnished to do so, subject to +\ the following conditions: +\ +\ The above copyright notice and this permission notice shall be +\ included in all copies or substantial portions of the Software. +\ +\ THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, +\ EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF +\ MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND +\ NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE +\ LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION +\ OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION +\ WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. +\ +\ LICENSE_END Added: cpu/i8051/metainit.fth =================================================================== --- cpu/i8051/metainit.fth (rev 0) +++ cpu/i8051/metainit.fth 2007-07-16 07:10:05 UTC (rev 469) @@ -0,0 +1,62 @@ +\ See license at end of file +\ Metacompiler initialization + +\ Debugging aids + + +\ Threshold is the word number to start reporting progress +\ granularity is how often (how many words) to report progress +0 #words ! h# 0 threshold ! h# 10 granularity ! + +warning off +forth definitions + +metaon +meta definitions + +\ We want the kernel to be romable, so we put variables in the user area +:-h variable ( -- ) nuser ;-h +alias \m \ + +initmeta + +h# 10000 alloc-mem target-image \ Allocate space for the target image + +\ org sets the lowest address that is used by Forth kernel. +\ This number is a target token rather than an absolute address. +hex + +0.0000 org 0.0000 voc-link-t token-t! + +ps-size-t equ ps-size + +assembler + +\ This is at the first location in the Forth image. + +hex +mlabel cld + +\ LICENSE_BEGIN +\ Copyright (c) 2007 FirmWorks +\ +\ Permission is hereby granted, free of charge, to any person obtaining +\ a copy of this software and associated documentation files (the +\ "Software"), to deal in the Software without restriction, including +\ without limitation the rights to use, copy, modify, merge, publish, +\ distribute, sublicense, and/or sell copies of the Software, and to +\ permit persons to whom the Software is furnished to do so, subject to +\ the following conditions: +\ +\ The above copyright notice and this permission notice shall be +\ included in all copies or substantial portions of the Software. +\ +\ THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, +\ EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF +\ MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND +\ NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE +\ LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION +\ OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION +\ WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. +\ +\ LICENSE_END Added: cpu/i8051/target.fth =================================================================== --- cpu/i8051/target.fth (rev 0) +++ cpu/i8051/target.fth 2007-07-16 07:10:05 UTC (rev 469) @@ -0,0 +1,216 @@ +\ See license at end of file +\ Target configuration - i8051 + +only forth also definitions + +decimal + +only forth also meta definitions + +: lobyte h# 0ff and ; +: hibyte 8 rshift lobyte ; + +2 constant /w-t +/l-t constant /n-t +/w-t constant /a-t +/a-t constant /thread-t +/w-t constant /token-t +/w-t constant /link-t +/token-t constant /defer-t +\ /n-t h# 600 * constant user-size-t +\ /n-t h# 100 * constant ps-size-t +\ /n-t h# 100 * constant rs-size-t +/w-t constant /user#-t + +\ user-size-t h# 10000 + constant max-kernel-t + +\ 32 bit host Forth compiling 16-bit target Forth + +: n->n-t ; immediate + +: c!-t ( n add -- ) >hostaddr c! ; +: c@-t ( target-address -- n ) >hostaddr c@ ; + +\ Intel processors are little-endian +: w!-t ( n add -- ) over lobyte over c!-t ca1+ swap hibyte swap c!-t ; +: w@-t ( target-address -- n ) dup c@-t swap 1+ c@-t 8 << or ; + +alias le-w!-t w!-t +alias le-w@-t w@-t + +: !-t ( n add -- ) w!-t ; +: @-t ( target-address -- n ) w@-t ; + +\ Store target data types into the host address space. +: c-t! ( c host-address -- ) c! ; +: w-t! ( w host-address -- ) + over lobyte over c-t! ca1+ swap hibyte swap c-t! +; +: n-t! ( n host-address -- ) w-t! ; + +\ Next 2 are machine-independent +: c,-t ( byte -- ) dp-t @ c!-t 1 dp-t +! ; +: w,-t ( word -- ) dp-t @ w!-t /w-t dp-t +! ; + +: ,-t ( n -- ) w,-t ; +: ,user#-t ( user# -- ) w,-t ; + +: a@-t ( target-address -- target-address ) w@-t origin-t + ; +: a!-t ( token target-address -- ) swap origin-t - swap w!-t ; +: token@-t ( target-address -- target-acf ) a@-t ; +: token!-t ( acf target-address -- ) a!-t ; + +: rlink@-t ( occurrence -- next-occurrence ) w@-t origin-t + ; +: rlink!-t ( next-occurrence occurrence -- ) swap origin-t - swap w!-t ; + +\ Machine independent +: a,-t ( adr -- ) here-t /a-t allot-t a!-t ; +: token,-t ( token -- ) here-t /token-t allot-t token!-t ; + +\ These versions of linkx-t are for absolute links +: link@-t ( target-address -- target-address' ) a@-t ; +: link!-t ( target-address target-address -- ) a!-t ; +: link,-t ( target-address -- ) a,-t ; + +: a-t@ ( host-address -- target-address ) w@ origin-t + ; +: a-t! ( target-address host-address -- ) swap origin-t - swap w! ; +: rlink-t@ ( host-adr -- target-adr ) w@ origin-t + ; +: rlink-t! ( target-adr host-adr -- ) swap origin-t - swap w! ; + +: token-t@ ( host-address -- target-acf ) a-t@ ; +: token-t! ( target-acf host-address -- ) a-t! ; + +: link-t@ ( host-address -- target-address ) a-t@ ; +: link-t! ( target-address host-address -- ) a-t! ; + +\ Machine independent +: a-t, ( target-address -- ) here /a-t allot a-t! ; +: token-t, ( target-address -- ) here /token-t allot token-t! ; + +\ Dictionary linked list; the list head is in the metacompiler environment +\ during metacompilation +1 constant #threads-t +create threads-t #threads-t /link-t * allot + +\ Choose the dictionary list head based on the word name +: $hash-t ( str-addr voc-ptr -- thread ) + nip swap c@ #threads-t 1- and /thread-t * + +; + +\ The user area image lives in the host address space. +\ We wish to store into the user area with -t commands so as not +\ to need separate words to store target items into host addresses. +\ That is why user+ returns a target address. + +\ Machine Independent + +0 constant userarea-t +: setup-user-area ( -- ) + here-t ['] userarea-t >body l! + here-t ['] init-user-area >body ! + user-size-t allot-t + userarea-t >hostaddr user-size-t erase +; + +: (>user-t) ( cfa-t -- user-address-t ) >body-t w@-t userarea-t + ; +: >user-t ( cfa-t -- user-address-h ) (>user-t) >hostaddr ; + +: n>link-t ( anf-t -- alf-t ) /link-t - ; +: l>name-t ( alf-t -- anf-t ) /link-t + ; + +decimal +1 constant #align-t +1 constant #talign-t +#align-t constant #acf-align-t + +1 constant #linkalign-t +: aligned-t ( n1 -- n2 ) #align-t 1- + #align-t negate and ; +: acf-aligned-t ( n1 -- n2 ) #acf-align-t 1- + #acf-align-t negate and ; + +: align-t ( -- ) + begin here-t #align-t 1- and while 0 c,-t repeat +; +: talign-t ( -- ) + begin here-t #talign-t 1- and while 0 c,-t repeat +; +: linkalign-t ( -- ) + begin here-t #linkalign-t 1- and while 0 c,-t repeat +; +: acf-align-t ( -- ) align-t ; + +: entercode ( -- ) + only forth also labels also meta also 8051-assembler +; + +\ Next 4 are Machine Independent +: cmove-t ( from to-t n -- ) + 0 ?do over c@ over c!-t 1+ swap 1+ swap loop 2drop +; +: place-cstr-t ( adr len cstr-adr-t -- cstr-adr-t ) + >r tuck r@ swap cmove-t ( len ) r@ + 0 swap c!-t r> +; +: "copy-t ( from to-t -- ) over c@ 2+ cmove-t ; +: toggle-t ( addr-t n -- ) swap >r r@ c@-t xor r> c!-t ; + +: clear-threads-t ( hostaddr -- ) + #threads-t /link-t * bounds do + origin-t i link-t! + /link +loop +; +: initmeta ( -- ) + init-relocation-t + threads-t clear-threads-t threads-t current-t ! +; + +\ For compiling branch offsets used by control constructs. +\ These compile relative branches. + +\ XXX this is wrong. We need to do some stuff like "lcall zerosense; jz <target>" +/w-t constant /branch +: branch! ( from-t target-addr-t -- ) over - swap ( offset from-t ) w!-t ; +: branch, ( target-t -- ) here-t - w,-t ; + +\ XXX FIXME for subroutine threaded +: >body-t ( cfa-t -- pfa-t ) /n-t + ; \ This version is for indirect threaded + +\ Store actions for some data types. + +: isuser ( n acf -- ) >user-t n-t! ; +: istuser ( acf1 acf -- ) (>user-t) >hostaddr token-t! ; +: isvalue ( n acf -- ) >user-t n-t! ; +: isdefer ( acf acf -- ) (>user-t) >hostaddr token-t! ; +: thread-t! ( thread adr -- ) link-t! ; + +only forth also meta also definitions +: install-target-assembler ( -- ) + [ also assembler ] + ['] here-t is here + ['] allot-t is asm-allot + ['] c!-t is asm8! + [ previous meta ] +; +: install-host-assembler ( -- ) [ assembler ] resident [ meta ] ; + +\ LICENSE_BEGIN +\ Copyright (c) 2007 FirmWorks +\ +\ Permission is hereby granted, free of charge, to any person obtaining +\ a copy of this software and associated documentation files (the +\ "Software"), to deal in the Software without restriction, including +\ without limitation the rights to use, copy, modify, merge, publish, +\ distribute, sublicense, and/or sell copies of the Software, and to +\ permit persons to whom the Software is furnished to do so, subject to +\ the following conditions: +\ +\ The above copyright notice and this permission notice shall be +\ included in all copies or substantial portions of the Software. +\ +\ THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, +\ EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF +\ MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND +\ NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE +\ LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION +\ OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION +\ WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. +\ +\ LICENSE_END Added: forth/kernel/conf16.fth =================================================================== --- forth/kernel/conf16.fth (rev 0) +++ forth/kernel/conf16.fth 2007-07-16 07:10:05 UTC (rev 469) @@ -0,0 +1,45 @@ +\ See license at end of file +purpose: Configure metacompiler to build a 16bit subroutine-threaded kernel + +only forth also definitions + +warning @ warning off +: 16\ ; immediate +: 32\ [compile] \ ; immediate +: 64\ [compile] \ ; immediate +warning ! + +: \itc-t ( -- ) [compile] \ ; immediate +: \dtc-t ( -- ) [compile] \ ; immediate +: \stc-t ( -- ) ; immediate +: \ttc-t ( -- ) [compile] \ ; immediate +: \t8-t ( -- ) [compile] \ ; immediate +: \t16-t ( -- ) ; immediate +: \t32-t ( -- ) [compile] \ ; immediate +: \t16-t ( -- ) [compile] \ ; immediate +: \tagvoc-t ( -- ) ; immediate +: \nottagvoc-t ( -- ) [compile] \ ; immediate + +\ LICENSE_BEGIN +\ Copyright (c) 2007 FirmWorks +\ +\ Permission is hereby granted, free of charge, to any person obtaining +\ a copy of this software and associated documentation files (the +\ "Software"), to deal in the Software without restriction, including +\ without limitation the rights to use, copy, modify, merge, publish, +\ distribute, sublicense, and/or sell copies of the Software, and to +\ permit persons to whom the Software is furnished to do so, subject to +\ the following conditions: +\ +\ The above copyright notice and this permission notice shall be +\ included in all copies or substantial portions of the Software. +\ +\ THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, +\ EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF +\ MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND +\ NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE +\ LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION +\ OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION +\ WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. +\ +\ LICENSE_END

1 0

r165 - openbios-devel/arch/sparc64
by svn＠openbios.org 11 Jul '07

11 Jul '07

Author: blueswirl Date: 2007-07-11 21:48:31 +0200 (Wed, 11 Jul 2007) New Revision: 165 Modified: openbios-devel/arch/sparc64/openbios.c Log: NVRAM support (temporary location) Modified: openbios-devel/arch/sparc64/openbios.c =================================================================== --- openbios-devel/arch/sparc64/openbios.c 2007-07-11 19:46:26 UTC (rev 164) +++ openbios-devel/arch/sparc64/openbios.c 2007-07-11 19:48:31 UTC (rev 165) @@ -21,17 +21,92 @@ static unsigned char intdict[256 * 1024]; // XXX -void arch_nvram_put() +#define NVRAM_SIZE 0x2000 +#define NVRAM_IDPROM 0x1fd0 +#define NVRAM_OB_OFFSET 256 +#define NVRAM_OB_SIZE ((NVRAM_IDPROM - NVRAM_OB_OFFSET) & ~15) + +static struct qemu_nvram_v1 { + char id_string[16]; + uint32_t version; + uint32_t nvram_size; // not used in Sun4m + char unused1[8]; + char arch[12]; + char curr_cpu; + char smp_cpus; + char unused2; + char nographic; + uint32_t ram_size; + char boot_device; + char unused3[3]; + uint32_t kernel_image; + uint32_t kernel_size; + uint32_t cmdline; + uint32_t cmdline_size; + uint32_t initrd_image; + uint32_t initrd_size; + uint32_t nvram_image; + uint16_t width; + uint16_t height; + uint16_t depth; + char unused4[158]; + uint16_t crc; +} nv_info; + +#define OBIO_CMDLINE_MAX 256 +static char obio_cmdline[OBIO_CMDLINE_MAX]; + +void arch_nvram_get(char *data) { + unsigned short i; + unsigned char *nvptr = &nv_info; + uint32_t size; + extern uint32_t kernel_image; + extern uint32_t kernel_size; + extern uint32_t cmdline; + extern uint32_t cmdline_size; + extern char boot_device; + + for (i = 0; i < sizeof(struct qemu_nvram_v1); i++) { + outb(i & 0xff, 0x74); + outb(i >> 8, 0x75); + *nvptr++ = inb(0x77); + } + + kernel_image = nv_info.kernel_image; + kernel_size = nv_info.kernel_size; + size = nv_info.cmdline_size; + if (size > OBIO_CMDLINE_MAX - 1) + size = OBIO_CMDLINE_MAX - 1; + memcpy(obio_cmdline, nv_info.cmdline, size); + obio_cmdline[size] = '\0'; + cmdline = obio_cmdline; + cmdline_size = size; + printk("kernel addr %x size %x\n", kernel_image, kernel_size); + if (size) + printk("kernel cmdline %s\n", obio_cmdline); + + for (i = 0; i < NVRAM_OB_SIZE; i++) { + outb((i + NVRAM_OB_OFFSET) & 0xff, 0x74); + outb((i + NVRAM_OB_OFFSET) >> 8, 0x75); + data[i] = inb(0x77); + } } -void arch_nvram_get() +void arch_nvram_put(char *data) { + unsigned short i; + + for (i = 0; i < NVRAM_OB_SIZE; i++) { + outb((i + NVRAM_OB_OFFSET) & 0xff, 0x74); + outb((i + NVRAM_OB_OFFSET) >> 8, 0x75); + outb(data[i], 0x77); + } } int arch_nvram_size() { - return 8192; + return NVRAM_OB_SIZE; } void setup_timers() @@ -132,6 +207,9 @@ enterforth((xt_t)PC); arch_init(); // XXX + printk("force boot\n"); + push_str("/pci/isa/ide0/disk@0,0:a"); + boot(); // XXX printk("falling off...\n"); return 0; }

1 0

r164 - openbios-devel/modules
by svn＠openbios.org 11 Jul '07

11 Jul '07

Author: blueswirl Date: 2007-07-11 21:46:26 +0200 (Wed, 11 Jul 2007) New Revision: 164 Modified: openbios-devel/modules/client.c Log: Make client interface 64 bits wide on Sparc64 Modified: openbios-devel/modules/client.c =================================================================== --- openbios-devel/modules/client.c 2007-07-11 19:45:12 UTC (rev 163) +++ openbios-devel/modules/client.c 2007-07-11 19:46:26 UTC (rev 164) @@ -28,8 +28,8 @@ typedef struct prom_args { const char *service; - int nargs; - int nret; + long nargs; + long nret; ulong args[10]; /* MAX NUM ARGS! */ } prom_args_t;

1 0

r163 - openbios-devel/arch/sparc64
by svn＠openbios.org 11 Jul '07

11 Jul '07

Author: blueswirl Date: 2007-07-11 21:45:12 +0200 (Wed, 11 Jul 2007) New Revision: 163 Modified: openbios-devel/arch/sparc64/boot.c openbios-devel/arch/sparc64/entry.S openbios-devel/arch/sparc64/ldscript Log: Change virtual address below 4G Map first 16M of RAM Execute a kernel if loaded by Qemu Modified: openbios-devel/arch/sparc64/boot.c =================================================================== --- openbios-devel/arch/sparc64/boot.c 2007-07-09 16:27:25 UTC (rev 162) +++ openbios-devel/arch/sparc64/boot.c 2007-07-11 19:45:12 UTC (rev 163) @@ -28,11 +28,13 @@ char altpath[256]; if (kernel_size) { - int (*entry)(const void *romvec, int p2, int p3, int p4, int p5); + void (*entry)(unsigned long p1, unsigned long p2, unsigned long p3, + unsigned long p4, unsigned long p5); + extern int of_client_interface( int *params ); printk("[sparc64] Kernel already loaded\n"); - entry = (void *) kernel_image; - entry(0, 0, 0, 0, 0); + entry = (void *) (unsigned long)kernel_image; + entry(0, 0, 0, 0, (unsigned long)&of_client_interface); } if(!path) { Modified: openbios-devel/arch/sparc64/entry.S =================================================================== --- openbios-devel/arch/sparc64/entry.S 2007-07-09 16:27:25 UTC (rev 162) +++ openbios-devel/arch/sparc64/entry.S 2007-07-11 19:45:12 UTC (rev 163) @@ -12,6 +12,8 @@ #include "pstate.h" #include "lsu.h" +#define PROM_ADDR 0x1fff0000000 + .globl entry, _entry .section ".text", "ax" @@ -110,18 +112,19 @@ srlx %g5, 16, %g6 ! %g6 = # of 64k .rodata pages set 48, %g7 set 0x10000, %g5 + setx PROM_ADDR, %l1, %l2 1: stxa %g4, [%g7] ASI_DMMU ! vaddr = _rodata, ctx=0 set 0xa0000000, %g3 sllx %g3, 32, %g3 or %g3, 0x74, %g3 - or %g4, %g3, %g3 + or %l2, %g3, %g3 ! valid, 64k, locked, cacheable(I/E/C), priv ! paddr = _rodata + N * 0x10000 stxa %g3, [%g0] ASI_DTLB_DATA_IN add %g4, %g5, %g4 deccc %g6 bne 1b - nop + add %l2, %g5, %l2 ! setup VGA buffer setx 0x1ff004a0000, %g7, %g4 @@ -141,16 +144,24 @@ bne 1b nop -#if 0 - ! setup 0-4M +#if 1 + ! setup 0-16M + mov %g0, %g4 + mov 4, %g6 set 48, %g7 - stxa %g0, [%g7] ASI_DMMU ! vaddr = 0, ctx=0 + set 0x400000, %g5 +1: stxa %g4, [%g7] ASI_DMMU ! vaddr = 0, ctx=0 set 0xe0000000, %g3 sllx %g3, 32, %g3 or %g3, 0x36, %g3 + or %g4, %g3, %g3 ! valid, 4M, cacheable(I/E/C), priv, writable ! paddr = 0 stxa %g3, [%g0] ASI_DTLB_DATA_IN + add %g4, %g5, %g4 + deccc %g6 + bne 1b + nop #endif membar #Sync @@ -159,30 +170,39 @@ setx _rodata, %g7, %g5 sub %g5, %g4, %g5 srlx %g5, 16, %g6 ! %g6 = # of 64k .text pages + set 0x10000, %g5 set 48, %g7 + setx PROM_ADDR, %l1, %l2 1: stxa %g4, [%g7] ASI_IMMU ! vaddr = _start, ctx=0 set 0xa0000000, %g3 sllx %g3, 32, %g3 or %g3, 0x74, %g3 - or %g4, %g3, %g3 + or %l2, %g3, %g3 ! valid, 64k, locked, cacheable(I/E/C), priv ! paddr = _start + N * 0x10000 stxa %g3, [%g0] ASI_ITLB_DATA_IN - set 0x10000, %g5 add %g4, %g5, %g4 deccc %g6 bne 1b - nop + add %l2, %g5, %l2 -#if 0 - ! setup 0-4M - stxa %g0, [%g7] ASI_IMMU ! vaddr = 0, ctx=0 +#if 1 + ! setup 0-16M + mov %g0, %g4 + mov 4, %g6 + set 0x400000, %g5 +1: stxa %g4, [%g7] ASI_IMMU ! vaddr = 0, ctx=0 set 0xe0000000, %g3 sllx %g3, 32, %g3 or %g3, 0x34, %g3 + or %g4, %g3, %g3 ! valid, 4M, cacheable(I/E/C), priv ! paddr = 0 stxa %g3, [%g0] ASI_ITLB_DATA_IN + add %g4, %g5, %g4 + deccc %g6 + bne 1b + nop #endif flush %g4 @@ -193,18 +213,26 @@ sta %g0, [%g2] ASI_DMMU ! set primary ctx=0 ! Enable I/D MMUs and caches + setx lowmem, %g2, %g1 set LSU_CONTROL_DM|LSU_CONTROL_IM|LSU_CONTROL_DC|LSU_CONTROL_IC, %g2 - stxa %g2, [%g0] ASI_LSU_CONTROL + jmp %g1 + stxa %g2, [%g0] ASI_LSU_CONTROL +lowmem: /* Copy the DATA section from ROM. */ setx _data - 8, %o7, %o0 ! First address of DATA setx _bss, %o7, %o1 ! Last address of DATA + setx _start, %o7, %o2 + sub %o0, %o2, %o2 ! _data - _start + setx PROM_ADDR, %o7, %o3 + add %o3, %o2, %o2 ! PROM_ADDR + (_data - _start) ba 2f nop 1: - ldxa [%o0] ASI_PHYS_BYPASS_EC_E, %g1 + ldxa [%o2] ASI_PHYS_BYPASS_EC_E, %g1 stx %g1, [%o0] 2: + add %o2, 0x8, %o2 subcc %o0, %o1, %g0 bl 1b add %o0, 0x8, %o0 Modified: openbios-devel/arch/sparc64/ldscript =================================================================== --- openbios-devel/arch/sparc64/ldscript 2007-07-09 16:27:25 UTC (rev 162) +++ openbios-devel/arch/sparc64/ldscript 2007-07-11 19:45:12 UTC (rev 163) @@ -8,7 +8,7 @@ /* Initial load address */ -BASE_ADDR = 0x000001fff0000000; +BASE_ADDR = 0x00000000ffd00000; /* 16KB heap and stack */ HEAP_SIZE = 16384;

1 0

r468 - ofw/fs/fatfs
by svn＠openbios.org 09 Jul '07

09 Jul '07

Author: wmb Date: 2007-07-09 20:54:01 +0200 (Mon, 09 Jul 2007) New Revision: 468 Modified: ofw/fs/fatfs/partition.fth Log: disk-label partition handler - Removed a kludge that caused the presence of an ext2 partition to appear to be marked as bootable even if it wasn't. The problem symptom was that on a disk with a FAT FS in partition 1 and an EXT2 FS in partition 2, neither marked bootable, OFW would use partition 2 by default. Modified: ofw/fs/fatfs/partition.fth =================================================================== --- ofw/fs/fatfs/partition.fth 2007-07-08 18:59:17 UTC (rev 467) +++ ofw/fs/fatfs/partition.fth 2007-07-09 18:54:01 UTC (rev 468) @@ -102,12 +102,13 @@ : is-ufs? ( type -- type flag ) dup ufs-type = ; \ Matches partitions with the bootable flag set -\ : bootable? ( boot? type -- boot? type flag ) over h# 80 = ; -\ XXX kludge for Linux: bootable flag is not always set, accept ext2fs-type -: bootable? ( boot? type -- boot? type flag ) - over h# 80 = over h# 83 = or -; +: bootable? ( boot? type -- boot? type flag ) over h# 80 = ; +\ Kludge for Linux: bootable flag is not always set, accept ext2fs-type +\ : bootable? ( boot? type -- boot? type flag ) +\ over h# 80 = over h# 83 = or +\ ; + \ Matches the Nth partition, where N is initially stored in the value #part : nth? ( -- flag ) #part 1- dup to #part 0= ;

1 0

r162 - openbios-devel/drivers
by svn＠openbios.org 09 Jul '07

09 Jul '07

Author: blueswirl Date: 2007-07-09 18:27:25 +0200 (Mon, 09 Jul 2007) New Revision: 162 Modified: openbios-devel/drivers/ide.c Log: Fix read only location write attempt Modified: openbios-devel/drivers/ide.c =================================================================== --- openbios-devel/drivers/ide.c 2007-07-09 16:25:32 UTC (rev 161) +++ openbios-devel/drivers/ide.c 2007-07-09 16:27:25 UTC (rev 162) @@ -1293,7 +1293,7 @@ char * nodetemp_chan = "/pci/isa/ide%d"; char * nodetemp = "/pci/isa/ide%d/%s"; - char * nodebuff = "/pci/isa/ide / "; + char nodebuff[32]; phandle_t dnode; for (i = 0; i < IDE_NUM_CHANNELS; i++) {

1 0

r161 - openbios-devel/include/sparc64
by svn＠openbios.org 09 Jul '07

09 Jul '07

Author: blueswirl Date: 2007-07-09 18:25:32 +0200 (Mon, 09 Jul 2007) New Revision: 161 Modified: openbios-devel/include/sparc64/io.h Log: Fix Sparc64 insw and outsw Modified: openbios-devel/include/sparc64/io.h =================================================================== --- openbios-devel/include/sparc64/io.h 2007-07-08 19:56:05 UTC (rev 160) +++ openbios-devel/include/sparc64/io.h 2007-07-09 16:25:32 UTC (rev 161) @@ -43,8 +43,8 @@ * are arrays of bytes, and byte-swapping is not appropriate in * that case. - paulus */ -#define insw(port, buf, ns) _insw_ns((uint16_t *)((port)+_IO_BASE), (buf), (ns)) -#define outsw(port, buf, ns) _outsw_ns((uint16_t *)((port)+_IO_BASE), (buf), (ns)) +#define insw(port, buf, ns) _insw((uint16_t *)((port)+_IO_BASE), (buf), (ns)) +#define outsw(port, buf, ns) _outsw((uint16_t *)((port)+_IO_BASE), (buf), (ns)) #define inb(port) in_8((uint8_t *)((port)+_IO_BASE)) #define outb(val, port) out_8((uint8_t *)((port)+_IO_BASE), (val))

1 0

Qemu/OpenBIOS Sparc64 system emulation progress
by Blue Swirl 08 Jul '07

08 Jul '07

Hi, Current versions of Qemu (with the attached PCI patch) and OpenBIOS get this far: OpenBIOS for Sparc64 boot arg = 0x0 00000000-08000000 RAM 128 MB forth started. initializing memory...done Initializing PCI devices... 0:0.0 - 108e:a000 - /pci/pci108e,a000 - host 0:1.0 - 108e:5000 - /pci/pci108e,5000 - pci 0:1.1 - 108e:5000 - /pci/pci108e,5000 - pci 0:2.0 - 1013:b8 - /pci/pci1013,b8 - display 0:3.0 - 10ec:8029 - /pci/pci10ec,8029 - ethernet 0:4.0 - 1095:646 - /pci/pci1095,646 - ide floppy_init FDC is a S82078B floppy_reset floppy_motor_off SENSEI 20 00 status = 80, reply_buffer= 20 0 fdc_specify FD_SPECIFY(c1, 11) set_drive status = 80, new_dor = 10 floppy_recalibrate fdc_state.version = 0062 invalid nvram partition length nvram error detected, zapping pram falling off... Unhandled Exception 0x0000000000000008 PC = 0x0000000000000008 NPC = 0x000000000000000c Stopping execution For some reason some C functions do not get called from Forth, so the booting does not start and execution falls off the main function. The PCI patch is just a quick hack to get PCI probing succeed, I won't commit it in yet.

1 0

r160 - openbios-devel/arch/sparc64
by svn＠openbios.org 08 Jul '07

08 Jul '07

Author: blueswirl Date: 2007-07-08 21:56:05 +0200 (Sun, 08 Jul 2007) New Revision: 160 Modified: openbios-devel/arch/sparc64/openbios.c Log: Fix nvram size, arch_init hack Modified: openbios-devel/arch/sparc64/openbios.c =================================================================== --- openbios-devel/arch/sparc64/openbios.c 2007-07-08 19:53:20 UTC (rev 159) +++ openbios-devel/arch/sparc64/openbios.c 2007-07-08 19:56:05 UTC (rev 160) @@ -29,7 +29,10 @@ { } -int arch_nvram_size; +int arch_nvram_size() +{ + return 8192; +} void setup_timers() { @@ -128,5 +131,7 @@ #endif enterforth((xt_t)PC); + arch_init(); // XXX + printk("falling off...\n"); return 0; }

1 0

r159 - openbios-devel/arch/sparc64
by svn＠openbios.org 08 Jul '07

08 Jul '07

Author: blueswirl Date: 2007-07-08 21:53:20 +0200 (Sun, 08 Jul 2007) New Revision: 159 Modified: openbios-devel/arch/sparc64/entry.S Log: Revert previous patch Modified: openbios-devel/arch/sparc64/entry.S =================================================================== --- openbios-devel/arch/sparc64/entry.S 2007-07-07 21:01:29 UTC (rev 158) +++ openbios-devel/arch/sparc64/entry.S 2007-07-08 19:53:20 UTC (rev 159) @@ -35,7 +35,7 @@ ! Extract NWINDOWS from %ver rdpr %ver, %g1 and %g1, 0xf, %g1 - sub %g1, 2, %g1 + dec %g1 wrpr %g1, 0, %cleanwin wrpr %g1, 0, %cansave wrpr %g0, 0, %canrestore

1 0

r467 - cpu/x86/pc/olpc
by svn＠openbios.org 08 Jul '07

08 Jul '07

Author: wmb Date: 2007-07-08 20:59:17 +0200 (Sun, 08 Jul 2007) New Revision: 467 Modified: cpu/x86/pc/olpc/linux.fth Log: OLPC help - Changed to a C series firmware in the example. Trac #1972. Modified: cpu/x86/pc/olpc/linux.fth =================================================================== --- cpu/x86/pc/olpc/linux.fth 2007-07-05 17:31:27 UTC (rev 466) +++ cpu/x86/pc/olpc/linux.fth 2007-07-08 18:59:17 UTC (rev 467) @@ -318,8 +318,8 @@ warning @ warning off : help ( -- ) blue-letters ." UPDATES:" black-letters mcr - ." flash u:\q2b74.rom Rewrite the firmware from USB key" mcr - ." flash nand:\q2b74.rom Rewrite the firmware from NAND file" mcr + ." flash u:\q2c18.rom Rewrite the firmware from USB key" mcr + ." flash nand:\q2c18.rom Rewrite the firmware from NAND file" mcr ." copy-nand u:\boot\nand290.img Rewrite the OS on NAND from USB key" mcr mcr blue-letters ." DIRECTORY LISTING:" black-letters mcr

1 0

r158 - openbios-devel/arch/sparc64
by svn＠openbios.org 07 Jul '07

07 Jul '07

Author: blueswirl Date: 2007-07-07 23:01:29 +0200 (Sat, 07 Jul 2007) New Revision: 158 Modified: openbios-devel/arch/sparc64/entry.S Log: Fix wrong number of clean/saveable windows Modified: openbios-devel/arch/sparc64/entry.S =================================================================== --- openbios-devel/arch/sparc64/entry.S 2007-06-27 20:25:34 UTC (rev 157) +++ openbios-devel/arch/sparc64/entry.S 2007-07-07 21:01:29 UTC (rev 158) @@ -35,7 +35,7 @@ ! Extract NWINDOWS from %ver rdpr %ver, %g1 and %g1, 0xf, %g1 - dec %g1 + sub %g1, 2, %g1 wrpr %g1, 0, %cleanwin wrpr %g1, 0, %cansave wrpr %g0, 0, %canrestore

1 0

r466 - cpu/x86/pc/olpc/sdtools
by svn＠openbios.org 05 Jul '07

05 Jul '07

Author: wmb Date: 2007-07-05 19:31:27 +0200 (Thu, 05 Jul 2007) New Revision: 466 Modified: cpu/x86/pc/olpc/sdtools/ Log: Ignore .tgz files in sdkit directory. Property changes on: cpu/x86/pc/olpc/sdtools ___________________________________________________________________ Name: svn:ignore + *.tgz

1 0

r465 - cpu/x86/pc/olpc/sdtools
by svn＠openbios.org 05 Jul '07

05 Jul '07

Author: wmb Date: 2007-07-05 19:29:32 +0200 (Thu, 05 Jul 2007) New Revision: 465 Added: cpu/x86/pc/olpc/sdtools/ecio.fth Log: OLPC SDkit - added EC I/O routines. Added: cpu/x86/pc/olpc/sdtools/ecio.fth =================================================================== --- cpu/x86/pc/olpc/sdtools/ecio.fth (rev 0) +++ cpu/x86/pc/olpc/sdtools/ecio.fth 2007-07-05 17:29:32 UTC (rev 465) @@ -0,0 +1,223 @@ +\ See license at end of file +purpose: Driver for "EC" (KB3700) chip + +\ EC access primitives + +h# 380 constant iobase + +: ec@ ( index -- b ) wbsplit iobase 1+ pc! iobase 2+ pc! iobase 3 + pc@ ; +: ec! ( b index -- ) wbsplit iobase 1+ pc! iobase 2+ pc! iobase 3 + pc! ; + +: ec-dump ( offset len -- ) + ." Addr 0 1 2 3 4 5 6 7 8 9 a b c d e f" cr cr + push-hex + bounds ?do + i 4 u.r space + i h# 10 bounds do i ec@ 3 u.r loop cr + exit? ?leave + h# 10 +loop + pop-base +; + +\ EC internal addresses + +: wait-ib-empty ( -- ) + d# 1000 0 do h# 6c pc@ 2 and 0= if unloop exit then 1 ms loop + true abort" EC port 6c input buffer timeout" +; +: ec-cmd-out ( cmd -- ) wait-ib-empty h# 6c pc! ; +: ec-wb ( -- ) wait-ib-empty h# 68 pc! ; +: ec-rb ( -- b ) + d# 1000 0 do + h# 6c pc@ 3 and 1 = if + h# 68 pc@ + unloop exit + then + 1 ms + loop + true abort" EC port 6c output buffer timeout" +; + +: ec-cmd ( cmd -- response ) ec-cmd-out ec-rb ; + +: ec-cmd66 ( byte -- ) + h# 66 pc! + \ It typically requires about 200 polls + d# 4000 0 do 1 ms h# 66 pc@ 2 and 0= if unloop exit then loop + true abort" EC didn't respond to port 66 command" +; + +: ec-rw ( -- w ) ec-rb ec-rb swap bwjoin ; +: ec-ww ( -- w ) wbsplit ec-wb ec-wb ; + +: ec-cmd-w@ ( cmd -- w ) ec-cmd-out ec-rw ; +: ec-cmd-b@ ( cmd -- b ) ec-cmd ; +: ec-cmd-b! ( b cmd -- ) ec-cmd-out ec-wb ; + +: bat-voltage@ ( -- w ) h# 10 ec-cmd-w@ ; +: bat-current@ ( -- w ) h# 11 ec-cmd-w@ ; +: bat-acr@ ( -- w ) h# 12 ec-cmd-w@ ; +: bat-temp@ ( -- w ) h# 13 ec-cmd-w@ ; +: ambient-temp@ ( -- w ) h# 14 ec-cmd-w@ ; +: bat-status@ ( -- b ) h# 15 ec-cmd-b@ ; +: bat-soc@ ( -- b ) h# 16 ec-cmd-b@ ; +: bat-gauge-id@ ( -- sn0 .. sn7 ) h# 17 ec-cmd-out 8 0 do ec-rb loop ; +: bat-gauge@ ( -- b ) h# 18 ec-cmd-out h# 31 ec-wb ec-rb ; \ 31 is the EEPROM address +: board-id@ ( -- b ) h# 19 ec-cmd-b@ ; +: sci-source@ ( -- b ) h# 1a ec-cmd-b@ ; +: sci-mask! ( b -- ) h# 1b ec-cmd-b! ; +: sci-mask@ ( -- b ) h# 1c ec-cmd-b@ ; +: game-key@ ( -- w ) h# 1d ec-cmd-out ec-rw ; +: ec-date! ( day month year -- ) h# 1e ec-cmd-out ec-wb ec-wb ec-wb ; +: ec-abnormal@ ( -- b ) h# 1f ec-cmd-b@ ; + +: bat-init-lifepo4 ( -- ) h# 21 ec-cmd-out ; +: bat-init-nimh ( -- ) h# 22 ec-cmd-out ; +: wlan-off ( -- ) 0 h# 23 ec-cmd-b! ; +: wlan-on ( -- ) 1 h# 23 ec-cmd-b! ; +: wlan-wake ( -- ) h# 24 ec-cmd-out ; +: wlan-reset ( -- ) h# 25 ec-cmd-out ; +: dcon-disable ( -- ) 0 h# 26 ec-cmd-b! ; +: dcon-enable ( -- ) 1 h# 26 ec-cmd-b! ; +: reset-ec-warm ( -- ) h# 27 ec-cmd-out ; +: reset-ec ( -- ) h# 28 ec-cmd-out ; +: write-protect-fw ( -- ) h# 29 ec-cmd-out ; +: ebook-mode? ( -- b ) h# 2a ec-cmd-b@ ; + +\ EC mailbox access words + +: ec-mb-adr@ ( -- w ) h# 80 ec-cmd-out ec-rw ; +: ec-mb-adr! ( w -- ) h# 81 ec-cmd-out ec-ww ; +: ec-mb-setup ( cmd w -- ) ec-mb-adr! ec-cmd-out ; + +: ec-mb-b@ ( adr -- b ) h# 8a ec-mb-setup h# 84 ec-cmd-b@ ; +: ec-mb-w@ ( adr -- w ) h# 88 ec-mb-setup h# 82 ec-cmd-w@ ; +: ec-mb-b! ( b adr -- ) h# 85 ec-mb-setup ec-wb h# 8b ec-cmd-out ; +: ec-mb-w! ( w adr -- ) h# 83 ec-mb-setup ec-ww h# 89 ec-cmd-out ; + +\ SCI source codes: +\ SCI_WAKEUP_EVENT 0x01 // Game button, +\ SCI_BATTERY_STATUS_CHANGE 0x02 // AC plugged/unplugged, ... +\ Battery inserted/remove, Battery Low, Battery full, Battery destroy +\ SCI_SOC_CHANGE 0x04 // SOC Change +\ SCI_ABNORMAL_EVENT 0x08 +\ SCI_EB_MODE_CHANGE 0x10 +\ SCI_WAKEUP_WLAN_EVENT 0x20 + +\ This command hard-resets the EC deeply enough for the SP write-protect to +\ be off when the system is powered up again. + +: ec-reset ( -- ) 5 ec-cmd ; + +: kb3920? ( -- flag ) h# 6c pc@ h# ff = if true exit then 9 ec-cmd 9 = ; + +\ This makes the EC stop generating a flood of SCIs every time you do +\ the port 66 command sequence. +: sci-quiet ( -- ) h# 50 h# ff03 ec! ; + +\ While accessing the SPI FLASH, we have to turn off the keyboard controller, +\ because it continuously fetches from the SPI FLASH when it's on. That +\ interferes with our accesses. + +0 value kbc-off? +: kbc-off ( -- ) + kbc-off? if exit then \ Fast bail out + h# d8 ec-cmd66 \ Prepare for reset + h# ff14 ec@ 1 or h# ff14 ec! + true to kbc-off? +; + +: ec-power-off ( -- ) + 1 h# ff14 ec! + 1 h# ff01 ec! \ Tell the EC to bounce us on restart + 0 h# ff14 ec! +; + +\ Unfortunately, since the system reset is mediated by the keyboard +\ controller, turning the keyboard controller back on resets the system. + +: kbc-on ( -- ) + h# ff14 ec@ 1 invert and h# ff14 ec! \ Innocuous if already on + + false to kbc-off? +; +: fancy-kbc-on ( -- ) + 2 h# ff01 ec! \ Prevent full system reset + h# ff14 ec@ 1 invert and h# ff14 ec! \ Innocuous if already on + d# 400 ms \ Give the EC time to start up + h# 44 h# fc80 ec! \ Re-enable scan code conversion and system flag + h# 43 h# fc81 ec! \ Re-enable fast gate and ibf/obf interrupts + + h# f h# fe51 ec! \ Clear pending interrupts + h# f h# fe50 ec! \ Re-enable GPT interrupts + h# 0 h# fea7 ec! \ Clear FLASH write enable + h# 4 h# fead ec! \ fast read mode + h# fe95 ec@ h# 80 or h# fe95 ec! \ Write-protect LPC + h# 3 h# ff04 ec! \ enable IBF/OBF interrupts +\ h# 40 h# ff08 ec! \ Clear some interrupt + h# ff30 ec@ h# 10 or h# ff30 ec! \ Enable interrupt from GPIO04, PCI_RST# + + false to kbc-off? +; + +\ kbc-pause temporarily halts execution of the keyboard controller microcode. +\ kbc-resume makes it run again, picking up where it left off. +\ This is useful for accessing the SPI FLASH in cases where you do not +\ overwrite the keyboard controller microcodes. + +: kbc-pause ( -- ) h# dd ec-cmd66 ; +: kbc-resume ( -- ) h# df ec-cmd66 ; + +: io-spi@ ( reg# -- b ) h# fea8 + ec@ ; +: io-spi! ( b reg# -- ) h# fea8 + ec! ; + +\ We need the spi-cmd-wait because the data has to go out +\ serially on the SPI bus and that is a bit slower than +\ the IO port access. We must wait to avoid overwriting +\ the command register during the serial tranfer. + +: io-spi-out ( b -- ) spicmd! spi-cmd-wait ; + +: io-spi-reprogrammed ( -- ) + ." Powering off..." d# 2000 ms cr + power-off +\ kbc-on +\ ." Keyboard back on" cr +; + +: io-spi-start ( -- ) + ['] io-spi@ to spi@ + ['] io-spi! to spi! + ['] io-spi-out to spi-out + ['] io-spi-reprogrammed to spi-reprogrammed + h# fff0.0000 to flash-base + + 7 to spi-us \ Measured time for "1 fea9 ec!" is 7.9 uS + + kbc-off +; +: use-local-ec ( -- ) ['] io-spi-start to spi-start ; +use-local-ec +\ LICENSE_BEGIN +\ Copyright (c) 2006 FirmWorks +\ +\ Permission is hereby granted, free of charge, to any person obtaining +\ a copy of this software and associated documentation files (the +\ "Software"), to deal in the Software without restriction, including +\ without limitation the rights to use, copy, modify, merge, publish, +\ distribute, sublicense, and/or sell copies of the Software, and to +\ permit persons to whom the Software is furnished to do so, subject to +\ the following conditions: +\ +\ The above copyright notice and this permission notice shall be +\ included in all copies or substantial portions of the Software. +\ +\ THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, +\ EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF +\ MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND +\ NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE +\ LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION +\ OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION +\ WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. +\ +\ LICENSE_END

1 0

r464 - dev forth/kernel
by svn＠openbios.org 05 Jul '07

05 Jul '07

Author: wmb Date: 2007-07-05 19:28:08 +0200 (Thu, 05 Jul 2007) New Revision: 464 Added: dev/diaguart.fth forth/kernel/dmuldiv.fth Log: Added some common files needed by the PowerPC version. Added: dev/diaguart.fth =================================================================== --- dev/diaguart.fth (rev 0) +++ dev/diaguart.fth 2007-07-05 17:28:08 UTC (rev 464) @@ -0,0 +1,38 @@ +purpose: Diagnostic (before console installation) access to serial port +copyright: Copyright 1994 Firmworks All Rights Reserved + +headerless +d# 1843200 constant uart-clock-frequency + +[ifndef] uart@ +h# 3f8 value uart-base \ Virtual address of UART; set later + +: uart@ ( reg# -- byte ) uart-base + pc@ ; \ Read from a UART register +: uart! ( byte reg# -- ) uart-base + pc! ; \ Write to a UART register +[then] + +: baud ( baud-rate -- ) + uart-clock-frequency d# 16 / swap rounded-/ ( baud-rate-divisor ) + + begin 5 uart@ h# 40 and until \ Wait until transmit done + + 3 uart@ dup >r h# 80 or 3 uart! \ divisor latch access bit on + dup h# ff and 0 uart! 8 >> 1 uart! \ Write lsb and msb + r> 3 uart! \ Restore old state +; + +: inituarts ( -- ) + 3 3 uart! \ 8 bits, no parity + 7 2 uart! \ Clear and enable FIFOs +\ d# 38400 baud + d# 9600 baud +; + +: ukey? ( -- flag ) 5 uart@ 1 and 0<> ; \ Test for rcv character +: uemit? ( -- flag ) 5 uart@ h# 20 and 0<> ; \ Test for xmit ready +: ubreak? ( -- flag ) 5 uart@ h# 10 and 0<> ; \ Test for received break +: clear-break ( -- ) 5 uart@ drop ; \ Clear break indication + +: ukey ( -- char ) begin ukey? until 0 uart@ ; \ Receive a character +: uemit ( char -- ) begin uemit? until 0 uart! ; \ Transmit a character +headers Added: forth/kernel/dmuldiv.fth =================================================================== --- forth/kernel/dmuldiv.fth (rev 0) +++ forth/kernel/dmuldiv.fth 2007-07-05 17:28:08 UTC (rev 464) @@ -0,0 +1,172 @@ +purpose: Extended precision multiplication and division +\ See license at end of file + +\ alias um* u*x ( u1 u2 -- ud ) + +headerless +/n-t 4 * constant bits/half-cell + +: scale-up ( -- ) bits/half-cell << ; +: scale-down ( -- ) bits/half-cell >> ; +: split-halves ( n -- low-half high-half ) + dup 1 scale-up 1- and swap scale-down +; + +headers +\ This is the elementary school long-division algorithm, base 2^^16 (on a +\ 32-bit system) or 2^32 (on a 64-bit system). +\ It depends on the assumption that "/" can accurately divide a single-cell +\ (i.e. 32 or 64 bit) number by a half-cell (i.e. 16 or 32 bit) number. +\ Each "digit" is a half-cell number; thus the dividend is a 4-digit +\ number "ABCD" and the divisor is a 2-digit number "EF". + +\ It would be interesting to compare the performance of this to a +\ "bit-banging" non-restoring division loop. +: um/mod ( ud u -- urem uquot ) + 2dup u>= if \ Overflow; return max-uint for quotient + 0= if 0 / then \ Force divide by zero trap + 2drop 0 -1 exit ( 0 max-u ) + then ( ud u ) + + \ Split the divisor into two 16-bit "digits" + dup split-halves ( ud u ulow uhigh ) + + \ If the high "digit" of the divisor is zero, we can skip a lot + \ of the steps. In this case, we only have to worry about the + \ middle two digits of the dividend in developing the quotient. + ?dup 0= if ( ud u ulow ) + + \ Approximate the high digit of the quotient by dividing the "BC" + \ digits by the "F" digit. The answer could by low by one, but if + \ so it will be fixed in the next step. + 2over swap scale-down swap scale-up + over / scale-up + ( ud u ulow guess<< ) + + \ Multiply the trial quotient by the divisor + rot over um* ( ud ulow guess<< udtemp ) + + \ Subtract the trial product from the dividend, giving the remainder + 2swap >r >r d- drop ( error ) ( r: guess<< ulow ) + + \ Divide the remainder by the divisor, giving the rest of the + \ quotient. + dup r@ u/mod nip ( error guess1 ) + r> r> ( error guess1 ulow guess<< ) + + \ Merge the two halves of the quotient + 2 pick + >r ( error guess1 ulow ) ( r: uquot ) + + \ Calculate the remainder + * - r> ( urem uquot ) + exit + then ( ud u ulow uhigh ) + + \ The high divisor digit is non-zero, so we have to deal with + \ both digits, dividing "ABCD" by "EF". + + \ Approximate the high digit of the quotient. + 3 pick over u/mod nip ( ud u ulow uhigh guess ) + + \ Reduce guess by one if "E" = "A" + dup 1 scale-up = if 1- then ( ud u ulow uhigh guess' ) + + \ Multiply the trial quotient by the divisor + 3 pick over scale-up um* ( ud u ulow uhigh guess' ud.temp ) + + \ Subtract the trial product from the dividend, giving the remainder + >r >r 2rot r> r> d- ( u ulow uhigh guess' d.resid ) + + \ If the remainder is negative, add the divisor and reduce the trial + \ quotient by one. The following loop executes at most twice. + begin dup 0< while ( u ulow uhigh guess' d.resid ) + rot 1- -rot ( u ulow uhigh guess+ d.resid ) + 4 pick scale-up 4 pick d+ ( u ulow uhigh guess+ d.resid' ) + repeat ( u ulow uhigh guess+ +d.resid ) + + \ Now we have the correct high quotient digit; save it for later + rot scale-up >r ( u ulow uhigh +d.resid ) ( r: q.high ) + + \ Repeat the above process, using the partial remainder as the + \ dividend. Ulow is no longer needed + 3 roll drop ( u uhigh +d.resid ) + + \ Trial quotient digit... + 2dup scale-up swap scale-down + 3 roll u/mod nip + ( u +d.resid guess1 ) ( r: q.high ) + dup 1 scale-up = if 1- then ( u +d.resid guess1' ) + + \ Trial product + 3 pick over um* ( u +d.resid guess1' d.err ) + + \ New partial remainder + rot >r d- ( u d.resid' ) ( r: q.high guess1' ) + + \ Adjust quotient digit until partial remainder is positive + begin dup 0< while ( u d.resid' ) ( r: q.high guess1' ) + r> 1- >r ( u d.resid' ) ( r: q.high guess1' ) + 2 pick m+ ( u d.resid'' ) ( r: q.high guess1' ) + repeat ( u +d.resid ) ( r: q.high guess1' ) + + \ Discard divisior and high cell of quotient (which must be zero) + rot 2drop ( u.rem ) + + \ Merge quotient digits + r> r> + ( u.rem u.quot ) +; +: sm/rem ( d n -- rem quot ) + 0 ( d n sign ) + 2 pick 0< if ( d n sign ) + 1+ 2swap dnegate 2swap ( +d n sign ) + then ( +d n sign ) + over 0< if ( +d n sign ) + 2+ swap negate swap ( +d +n sign ) + then ( +d +n sign ) + >r um/mod r> ( u.rem u.quot sign ) + case + 1 of swap negate swap negate endof \ -dividend, +divisor + 2 of negate endof \ +dividend, -divisor + 3 of swap negate swap endof \ -dividend, -divisor + endcase +; +: fm/mod ( d.dividend n.divisor -- n.rem n.quot ) + 2dup xor 0< if \ Fixup only if operands have opposite signs + dup >r sm/rem ( rem' quot' r: divisor ) + over if 1- swap r> + swap else r> drop then + exit + then + \ In the usual case of similar signs (i.e. positive quotient), + \ sm/rem gives the correct answer + sm/rem ( n.rem' n.quot' ) +; + +" m*" $sfind [if] drop [else] 2drop +: m* ( n1 n2 -- d ) + 2dup xor >r abs swap abs um* r> 0< if dnegate then +; +[then] +: */mod ( n1 n2 n3 -- n.mod n.quot ) >r m* r> fm/mod ; +: */ ( n1 n2 n3 -- n4 ) */mod nip ; + +\ LICENSE_BEGIN +\ Copyright (c) 1994 FirmWorks +\ +\ Permission is hereby granted, free of charge, to any person obtaining +\ a copy of this software and associated documentation files (the +\ "Software"), to deal in the Software without restriction, including +\ without limitation the rights to use, copy, modify, merge, publish, +\ distribute, sublicense, and/or sell copies of the Software, and to +\ permit persons to whom the Software is furnished to do so, subject to +\ the following conditions: +\ +\ The above copyright notice and this permission notice shall be +\ included in all copies or substantial portions of the Software. +\ +\ THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, +\ EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF +\ MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND +\ NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE +\ LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION +\ OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION +\ WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. +\ +\ LICENSE_END

1 0

r463 - forth/lib ofw/core
by svn＠openbios.org 05 Jul '07

05 Jul '07

Author: wmb Date: 2007-07-05 19:26:58 +0200 (Thu, 05 Jul 2007) New Revision: 463 Added: forth/lib/binhdr.fth ofw/core/clntmap.fth ofw/core/startup.fth Log: Added some common files needed by the PowerPC version. Added: forth/lib/binhdr.fth =================================================================== --- forth/lib/binhdr.fth (rev 0) +++ forth/lib/binhdr.fth 2007-07-05 17:26:58 UTC (rev 463) @@ -0,0 +1,58 @@ +purpose: Header for Forth ".exe" file to be executed by the C wrapper program. +\ See license at end of file + +hex + +only forth also hidden also +forth definitions +headerless + +hidden definitions +th 20 buffer: bin-header +: hfield \ name ( offset size -- offset' ) + create + over , + + does> ( struct-base -- field-addr ) + @ bin-header + +; +: long 4 hfield ; + +struct ( Binary header) + long h_magic ( 0) \ Magic Number + long h_tlen ( 4) \ length of text (code) + long h_dlen ( 8) \ length of initialized data + long h_blen ( c) \ length of BSS unitialized data + long h_slen ( 10) \ length of symbol table + long h_entry ( 14) \ Entry address + long h_trlen ( 18) \ Text Relocation Table length + long h_drlen ( 1c) \ Data Relocation Table length +constant /bin-header ( 20) + +: text-size ( -- size-of-dictionary ) dictionary-size aligned ; +headers + +only forth also definitions + +\ LICENSE_BEGIN +\ Copyright (c) 2007 FirmWorks +\ +\ Permission is hereby granted, free of charge, to any person obtaining +\ a copy of this software and associated documentation files (the +\ "Software"), to deal in the Software without restriction, including +\ without limitation the rights to use, copy, modify, merge, publish, +\ distribute, sublicense, and/or sell copies of the Software, and to +\ permit persons to whom the Software is furnished to do so, subject to +\ the following conditions: +\ +\ The above copyright notice and this permission notice shall be +\ included in all copies or substantial portions of the Software. +\ +\ THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, +\ EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF +\ MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND +\ NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE +\ LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION +\ OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION +\ WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. +\ +\ LICENSE_END Added: ofw/core/clntmap.fth =================================================================== --- ofw/core/clntmap.fth (rev 0) +++ ofw/core/clntmap.fth 2007-07-05 17:26:58 UTC (rev 463) @@ -0,0 +1,62 @@ +purpose: Use client callbacks, if installed, for address translation +\ See license at end of file + +warning off +: map ( phys.. virtual size mode -- ) + vector @ 0= if map exit then +[ifdef] 2-address-cells + \ ??? is the operand order correct? Other possibilities are: + \ dup 2 pick 4 pick 6 pick 8 pick + \ 4 pick 4 pick 4 pick 4 pick 4 pick + dup 2 pick 4 pick 7 pick 7 pick 5 " map" ['] $callback catch if + 3drop 3drop 2drop map + else ( phys.lo phys.hi virtual size mode 0 ) + 3drop 3drop + then +[else] + dup 2 pick 4 pick 6 pick 4 " map" ['] $callback catch if + 3drop 3drop drop map + else ( phys virtual size mode 0 ) + 3drop 2drop + then +[then] +; +: translate ( virtual -- false | physical mode true ) + vector @ 0= if translate exit then + dup 1 " translate" ['] $callback catch if ( virtual x x x x ) + 2drop 2drop translate exit + then ( false 1 | phys.. mode true n ) + drop +; +: unmap ( virtual len -- ) + vector @ 0= if unmap exit then + dup 2 pick 2 " unmap" ['] $callback catch if ( virt len x x x x x ) + 2drop 3drop unmap exit + then ( virt len #returns ) + 3drop +; +warning on + +\ LICENSE_BEGIN +\ Copyright (c) 2007 FirmWorks +\ +\ Permission is hereby granted, free of charge, to any person obtaining +\ a copy of this software and associated documentation files (the +\ "Software"), to deal in the Software without restriction, including +\ without limitation the rights to use, copy, modify, merge, publish, +\ distribute, sublicense, and/or sell copies of the Software, and to +\ permit persons to whom the Software is furnished to do so, subject to +\ the following conditions: +\ +\ The above copyright notice and this permission notice shall be +\ included in all copies or substantial portions of the Software. +\ +\ THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, +\ EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF +\ MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND +\ NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE +\ LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION +\ OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION +\ WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. +\ +\ LICENSE_END Added: ofw/core/startup.fth =================================================================== --- ofw/core/startup.fth (rev 0) +++ ofw/core/startup.fth 2007-07-05 17:26:58 UTC (rev 463) @@ -0,0 +1,48 @@ +purpose: Standard last-phase startup sequence +copyright: Copyright 1997 Firmworks All Rights Reserved + +: restore-stdout ( -- ) + " restore" stdout @ ['] $call-method catch if 3drop then +; + +defer secondary-diagnostics ' noop to secondary-diagnostics + +defer kbd-extras \ for fan, key-chord +' noop to kbd-extras + +: startup ( -- ) + standalone? 0= if exit then + + copy-reboot-info + + \ Ensure a clean startup state regardless of the development + \ environment's use of these variables + 0 stdin ! 0 stdout ! 0 to my-self + + " nvramrc" ?type + use-nvramrc? if nvramrc safe-evaluate then + + install-alarm + + auto-banner? if + " Probing" ?type probe-all + " Install console" ?type install-console + banner + then + + hex + warning on + only forth also definitions + +\ install-alarm + + #line off + + secondary-diagnostics + + kbd-extras + auto-boot + restore-stdout + + user-interface +;

1 0

r462 - in cpu: ppc/Linux ppc/build ppc/olpc/build x86/Linux
by svn＠openbios.org 05 Jul '07

05 Jul '07

Author: wmb Date: 2007-07-05 19:21:56 +0200 (Thu, 05 Jul 2007) New Revision: 462 Modified: cpu/ppc/Linux/ cpu/ppc/build/ cpu/ppc/olpc/build/ cpu/x86/Linux/ Log: Set some ignore properties in new directories. Property changes on: cpu/ppc/Linux ___________________________________________________________________ Name: svn:ignore + ppcforth.trace ppcforth Property changes on: cpu/ppc/build ___________________________________________________________________ Name: svn:ignore + ppcforth Property changes on: cpu/ppc/olpc/build ___________________________________________________________________ Name: svn:ignore + *.rom ppcforth Property changes on: cpu/x86/Linux ___________________________________________________________________ Name: svn:ignore - forth x86forth + forth x86forth ppcforth

1 0

r461 - in cpu: . ppc ppc/Linux ppc/olpc ppc/ppcsim
by svn＠openbios.org 05 Jul '07

05 Jul '07

Author: wmb Date: 2007-07-05 19:19:17 +0200 (Thu, 05 Jul 2007) New Revision: 461 Added: cpu/ppc/ cpu/ppc/Linux/ cpu/ppc/Linux/Makefile cpu/ppc/aiport.fth cpu/ppc/asmmacro.fth cpu/ppc/asmtools.fth cpu/ppc/assem.fth cpu/ppc/banner.fth cpu/ppc/basefw.bth cpu/ppc/bat.fth cpu/ppc/bat601.fth cpu/ppc/batf601.fth cpu/ppc/batfault.fth cpu/ppc/batmap.fth cpu/ppc/boot.fth cpu/ppc/build/ cpu/ppc/builder.bth cpu/ppc/cache601.fth cpu/ppc/cache603.fth cpu/ppc/cache823.fth cpu/ppc/call.fth cpu/ppc/catchexc.fth cpu/ppc/centry.fth cpu/ppc/code.fth cpu/ppc/cpubpsup.fth cpu/ppc/cpuclass.fth cpu/ppc/cpunode.fth cpu/ppc/cpustate.fth cpu/ppc/ctrace.fth cpu/ppc/debugm.fth cpu/ppc/decompm.fth cpu/ppc/dectrap.fth cpu/ppc/disinflt.fth cpu/ppc/epic.fth cpu/ppc/fb8-ops.fth cpu/ppc/field.fth cpu/ppc/filecode.fth cpu/ppc/filefld.fth cpu/ppc/finish.fth cpu/ppc/fixvoc.fth cpu/ppc/flipdic.fth cpu/ppc/flips.fth cpu/ppc/forthint.fth cpu/ppc/ftrace.fth cpu/ppc/gdb.fth cpu/ppc/getms.fth cpu/ppc/hacks.fth cpu/ppc/htabmmu.fth cpu/ppc/inflate.fth cpu/ppc/initpgm.fth cpu/ppc/kerncode.fth cpu/ppc/kernel.bth cpu/ppc/kernrel.fth cpu/ppc/loadmach.fth cpu/ppc/loadvmem.fth cpu/ppc/metainit.fth cpu/ppc/metarel.fth cpu/ppc/minifth.fth cpu/ppc/msr.fth cpu/ppc/ntctrace.fth cpu/ppc/objects.fth cpu/ppc/objsup.fth cpu/ppc/occhksum.fth cpu/ppc/olpc/ cpu/ppc/olpc/build/ cpu/ppc/olpc/devalias.fth cpu/ppc/olpc/elf.fth cpu/ppc/olpc/flash.fth cpu/ppc/olpc/fw.bth cpu/ppc/olpc/fwuboot.bth cpu/ppc/olpc/mappci.fth cpu/ppc/olpc/pciconfig.fth cpu/ppc/olpc/pcinode.fth cpu/ppc/olpc/probemem.fth cpu/ppc/olpc/reports.fth cpu/ppc/olpc/reset.fth cpu/ppc/olpc/rootnode.fth cpu/ppc/pause.fth cpu/ppc/ppcboot.fth cpu/ppc/ppcsim/ cpu/ppc/ppcsim/ppcsim.c cpu/ppc/ppcsim/simrom.c cpu/ppc/realcif.fth cpu/ppc/reboot.fth cpu/ppc/reenter.fth cpu/ppc/regacc.fth cpu/ppc/register.fth cpu/ppc/resetvec.fth cpu/ppc/rombp.fth cpu/ppc/rootnode.fth cpu/ppc/savefort.fth cpu/ppc/savemeta.fth cpu/ppc/scrub.fth cpu/ppc/scrub601.fth cpu/ppc/scrub823.fth cpu/ppc/segreg.fth cpu/ppc/spr.fth cpu/ppc/swapdic.fth cpu/ppc/syscall.fth cpu/ppc/tagwords.fth cpu/ppc/target.fth cpu/ppc/testmmu.fth cpu/ppc/tlb.fth cpu/ppc/tlb601.fth cpu/ppc/tlbmiss.fth cpu/ppc/tlbms823.fth cpu/ppc/tmmu823.fth cpu/ppc/tools.bth cpu/ppc/touchall.fth cpu/ppc/unalign.fth cpu/ppc/xadd.fth Log: PowerPC - initial checkin of PowerPC Open Firmware files. Added: cpu/ppc/Linux/Makefile =================================================================== --- cpu/ppc/Linux/Makefile (rev 0) +++ cpu/ppc/Linux/Makefile 2007-07-05 17:19:17 UTC (rev 461) @@ -0,0 +1,51 @@ +# Flags for the simulator version +WRAPPER = pforth +OPT = -O +# OPT = +CFLAGS = -DUNIX -DSYS5 -DSIM -DPOWERPC -DARGREGS -DSIMNEXT + +CC = gcc + +WRDIR = ${BP}/forth/wrapper +ZIPDIR = ${WRDIR}/zip +SIMDIR = ../ppcsim + +ZIPOBJS = zipmem.o deflate.o trees.o bits.o util.o inflate.o + +OBJS = wrapper.o ppcsim.o logger.o ${ZIPOBJS} +TRACEOBJS = wrapper.o ppcsim.trace.o logger.o ${ZIPOBJS} +SIMROMOBJS = simrom.o ppcsim.simrom.o + +all: ppcforth ppcforth.trace + +ppcforth: $(OBJS) + $(CC) $(LFLAGS) $(OBJS) -o $@ + +ppcforth.trace: $(TRACEOBJS) + $(CC) $(LFLAGS) $(TRACEOBJS) -o $@ + +simrom: $(SIMROMOBJS) + $(CC) $(LFLAGS) $(SIMROMOBJS) -o $@ + +%.o: ${WRDIR}/%.c + ${CC} -c ${CFLAGS} $< -o $@ + +%.o: ${ZIPDIR}/%.c + ${CC} -c ${CFLAGS} -I${ZIPDIR} $< -o $@ + +ppcsim.o: $(SIMDIR)/ppcsim.c + $(CC) $(OPT) $(CFLAGS) -c $< -o $@ + +ppcsim.trace.o: $(SIMDIR)/ppcsim.c + $(CC) $(OPT) $(CFLAGS) -DTRACE -c $< -o $@ + +ppcsim.simrom.o: $(SIMDIR)/ppcsim.c + $(CC) $(CFLAGS) -DTRACE -DSIMROM -c $< -o $@ + +simrom.o: $(SIMDIR)/simrom.c + $(CC) $(CFLAGS) -DTRACE -DSIMROM -c $< -o $@ + +clean: + @rm -f *.o ppcforth ppcforth.trace + +FRC: Added: cpu/ppc/aiport.fth =================================================================== --- cpu/ppc/aiport.fth (rev 0) +++ cpu/ppc/aiport.fth 2007-07-05 17:19:17 UTC (rev 461) @@ -0,0 +1,76 @@ +purpose: Assembly-language driver for Promice Analysis Interface "serial port" +\ See copyright at end of file + +\ Requires the following external definitions: +\ ai-serial ( -- n ) \ Returns the base address of the AI port registers + +label init-serial ( -- ) \ Destroys: r3 + begin + ai-serial set r3,* + lbz r3,3(r3) \ Read status register + cmpi 0,0,r3,h#cc \ 0xcc is status_invalid + <> until \ Wait for port to become active + + ai-serial set r3,* + lbz r3,2(r3) \ Read data port (because the docs say to) + bclr 20,0 +end-code + +label putchar ( r3 -- ) \ Destroys: r1, r2 + ai-serial set r1,* + begin + lbz r2,3(r1) \ Read status register + andi. r0,r2,1 \ Transmitter ready bit + 0= until \ Wait for ready + + \ send char + lbz r2,1(r1) \ start bit + + andi. r3,r3,h#ff \ Clear high bits just in case + + ori r3,r3,h#100 \ merge in stop bit + begin + \ use the fact that ONE = 1 and ZERO = 0 + andi. r2,r3,1 + lbzx r2,r1,r2 \ send bit + rlwinm. r3,r3,31,1,31 \ last bit will be stop bit + 0= until + + bclr 20,0 +end-code + +label getchar ( -- r3 ) + begin \ wait for byte + ai-serial set r3,* + lbz r3,3(r3) \ Read status register + andi. r0,r3,2 \ Test received byte available bit + 0<> until + + ai-serial set r3,* + lbz r3,2(r3) \ Read received byte + bclr 20,0 +end-code + +\ LICENSE_BEGIN +\ Copyright (c) 2007 FirmWorks +\ +\ Permission is hereby granted, free of charge, to any person obtaining +\ a copy of this software and associated documentation files (the +\ "Software"), to deal in the Software without restriction, including +\ without limitation the rights to use, copy, modify, merge, publish, +\ distribute, sublicense, and/or sell copies of the Software, and to +\ permit persons to whom the Software is furnished to do so, subject to +\ the following conditions: +\ +\ The above copyright notice and this permission notice shall be +\ included in all copies or substantial portions of the Software. +\ +\ THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, +\ EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF +\ MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND +\ NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE +\ LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION +\ OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION +\ WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. +\ +\ LICENSE_END Added: cpu/ppc/asmmacro.fth =================================================================== --- cpu/ppc/asmmacro.fth (rev 0) +++ cpu/ppc/asmmacro.fth 2007-07-05 17:19:17 UTC (rev 461) @@ -0,0 +1,42 @@ +purpose: Handy assembler macros +\ See copyright at end of file + +also forth definitions +: c$, ( adr len -- ) + 1+ here swap note-string dup allot move 4 (align) +; +previous definitions + +also ppc-assembler definitions +: $-to-r3 ( adr len -- ) + dup 5 + 4 round-up here + " bl *" evaluate \ Assemble code to skip string + c$, \ Place string + " mfspr r3,lr" evaluate \ Assemble code to get str adr +; +: pop-to-t0 " lwz t0,0(sp) addi sp,sp,1cell" evaluate ; +previous definitions + +\ LICENSE_BEGIN +\ Copyright (c) 2007 FirmWorks +\ +\ Permission is hereby granted, free of charge, to any person obtaining +\ a copy of this software and associated documentation files (the +\ "Software"), to deal in the Software without restriction, including +\ without limitation the rights to use, copy, modify, merge, publish, +\ distribute, sublicense, and/or sell copies of the Software, and to +\ permit persons to whom the Software is furnished to do so, subject to +\ the following conditions: +\ +\ The above copyright notice and this permission notice shall be +\ included in all copies or substantial portions of the Software. +\ +\ THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, +\ EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF +\ MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND +\ NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE +\ LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION +\ OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION +\ WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. +\ +\ LICENSE_END + Added: cpu/ppc/asmtools.fth =================================================================== --- cpu/ppc/asmtools.fth (rev 0) +++ cpu/ppc/asmtools.fth 2007-07-05 17:19:17 UTC (rev 461) @@ -0,0 +1,111 @@ +purpose: Tools for creating disembodied assembly code sequences +\ See license at end of file + +[ifndef] set-transize +fload ${BP}/forth/lib/transien.fth +true is suppress-transient? \ Disable transient definitions for now +[then] + +\needs suppress-headerless? fload ${BP}/forth/lib/headless.fth + +[ifndef] ppc-assembler +fload ${BP}/cpu/ppc/assem.fth +fload ${BP}/cpu/ppc/code.fth +fload ${BP}/forth/lib/loclabel.fth +[then] + +also ppc-assembler definitions +\needs $-to-r3 fload ${BP}/cpu/ppc/asmmacro.fth + +: $find-dropin, ( adr len -- ) + $-to-r3 \ Assemble string and skip it + " find-dropin bl *" evaluate \ and call find routine +; +previous definitions + +false value transient-labels? +0 value asm-origin +0 value asm-base +: pad-to ( n -- ) + begin dup here asm-base - asm-origin + u> while 0 , repeat drop +; +: align-to ( boundary -- ) + here asm-base - swap round-up pad-to +; + +: put-call ( target-adr branch-adr -- ) + tuck [ also assembler ] offset-26 [ previous ] + h# 4800.0001 + swap + [ also assembler ] asm! [ previous ] \ bl offset +; + +[ifndef] enable-transient? +: enable-transient ( -- ) + suppress-transient? if + unused 4 / d# 1000 set-transize + false is suppress-transient? + false is suppress-headerless? + then +; +[then] +enable-transient + +: tconstant ( value "name" -- ) + transient? 0= dup >r if transient then + constant + r> if resident then +; +: label ( "name" -- ) + transient-labels? if + here tconstant + [ also assembler ] init-labels [ previous ] !csp entercode + else + label + then +; + +: set-asm-origin ( -- ) + here to asm-base + 0 to asm-origin +; + +0 0 2value old-asms +: start-assembling ( -- ) + \ Use "is" instead of "to" in the next line because "to" is a PowerPC + \ assembly mnemonic (trap on overflow). + [ also assembler ] + ['] asm@ behavior ['] asm! behavior to old-asms + ['] be-l@ is asm@ ['] be-l! is asm! + [ previous ] + set-asm-origin + true to transient-labels? +; +: end-assembling ( -- ) + [ also assembler ] old-asms is asm! is asm@ [ previous ] + false to transient-labels? +; + + +\ LICENSE_BEGIN +\ Copyright (c) 2007 FirmWorks +\ +\ Permission is hereby granted, free of charge, to any person obtaining +\ a copy of this software and associated documentation files (the +\ "Software"), to deal in the Software without restriction, including +\ without limitation the rights to use, copy, modify, merge, publish, +\ distribute, sublicense, and/or sell copies of the Software, and to +\ permit persons to whom the Software is furnished to do so, subject to +\ the following conditions: +\ +\ The above copyright notice and this permission notice shall be +\ included in all copies or substantial portions of the Software. +\ +\ THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, +\ EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF +\ MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND +\ NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE +\ LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION +\ OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION +\ WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. +\ +\ LICENSE_END Added: cpu/ppc/assem.fth =================================================================== --- cpu/ppc/assem.fth (rev 0) +++ cpu/ppc/assem.fth 2007-07-05 17:19:17 UTC (rev 461) @@ -0,0 +1,1324 @@ +purpose: PowerPC assembler +\ See license at end of file + +decimal + +\needs $vfind fload ${BP}/forthlang/lib/strings.fth +\needs left-parse-string fload ${BP}/forthlang/lib/parses1.fth + +vocabulary ppc-assembler + +also ppc-assembler definitions + +headerless +false value disassembling? +variable instruction +variable end-found +headers +variable pc +variable display-offset 0 display-offset ! +: +offset ( adr -- adr' ) display-offset @ + ; +' ul. is showaddr + +headerless +h# 40 /token * constant /op-map create op-map /op-map allot +h# 10 /token /n + * constant /19-map create 19-map /19-map allot +h# 400 /token * constant /31-map create 31-map /31-map allot +h# 20 /token * constant /59-map create 59-map /59-map allot +h# 20 /token /n + * constant /63-map create 63-map /63-map allot + +: unimp ( -- ) + end-found on + ." Not an instruction: " instruction @ + base @ >r hex 9 u.r r> base ! space + false is disassembling? +; + +: (.name) ( acf -- ) + dup ['] unimp = if execute else >name name>string type then +; + +: find-sparse-entry ( entry map -- acf ) + begin dup @ -1 <> while ( entry mapp ) + 2dup @ = if ( entry mapp ) + nip na1+ token@ exit ( acf ) + then ( entry mapp ) + na1+ ta1+ + repeat + 2drop ['] unimp +; +: find-indexed-entry ( entry map -- acf ) swap ta+ token@ ; + +: init-map ( adr len -- ) bounds ?do ['] unimp i token! /token +loop ; +: init-sparse-map ( adr len -- ) + bounds ?do -1 i ! ['] unimp i na1+ token! /token na1+ +loop +; + +variable start-column +variable need-comma +: ?, ( -- ) need-comma @ if ." ," else need-comma on then ; +: to-operand-column ( -- ) d# 8 start-column @ + to-column need-comma off ; +: ibits ( right-bit# width -- bits ) + tuck - 1+ instruction l@ swap << 32 rot - >> +; + +: init-maps ( -- ) + op-map /op-map init-map + 31-map /31-map init-map + 59-map /59-map init-map + 19-map /19-map init-sparse-map + 63-map /63-map init-sparse-map +; +init-maps + +headers +defer here +defer asm-allot +defer asm@ +defer asm! + +\ Install as a resident assembler +\ : xx see ; immediate +: resident-assembler ( -- ) + [ forth ] ['] here [ ppc-assembler ] is here + [ forth ] ['] allot [ ppc-assembler ] is asm-allot + [ forth ] ['] @ [ ppc-assembler ] is asm@ + [ forth ] ['] instruction! [ ppc-assembler ] is asm! +; +resident-assembler + +headerless +2variable operands + +: get-field ( -- adr len ) + operands 2@ ascii , left-parse-string 2swap operands 2! ( adr len ) +; +: field-or-number ( ? -- n true | adr len false ) + disassembling? if false exit then + get-field + 2dup " *" $= dup if nip nip then +; +\ If adr2,len2 is an initial substring of adr1,len1, return the remainder +\ of the adr1,len1 string following that initial substring. +\ Otherwise, return adr1,len1 +: ?remove ( adr1 len1 adr2 len2 -- adr3 len3 removed? ) + 2 pick over u< if 2drop false exit then \ len2 too long? + 3 pick rot 2 pick ( adr len1 len2 adr1 adr2 len2 ) + caps-comp 0= if /string true else drop false then +; +: set-base ( adr len -- adr' len' ) + " h#" ?remove if hex exit then + " 0x" ?remove if hex exit then + " d#" ?remove if decimal exit then + " o#" ?remove if octal exit then + " b#" ?remove if binary exit then +; + +headers +\ Define symbolic names for constants in this vocabulary +vocabulary constant-names + +headerless +: get-based-number ( adr len -- true | n false ) + ['] constant-names $vfind if execute false exit then + base @ >r decimal + set-base + $number + r> base ! +; +: number ( -- n ) + disassembling? if ?, exit then + field-or-number if exit then + get-based-number abort" Bad number" +; + +: reg-name ( adr1 len1 adr2 len2 -- n ) \ adr2 len2 is the register prefix + disassembling? if ?, type exit then + ?remove drop + base @ >r decimal + $number + r> base ! + abort" Bad register number" +; + +\ The two 5-bit halves of the special register field are interchanged +: flip5 ( n -- n' ) dup h# 1f and 5 << swap 5 >> or ; + +headers +: sp-reg: ( n -- ) flip5 constant ; + +vocabulary sp-registers +also sp-registers definitions +1011 sp-reg: tbar \ This is not really a PowerPC register; + \ I invented it as a way of communicating + \ the trap base address to the simulator + \ to avoid slowing the simulator down with + \ absolute addressing + + 0 sp-reg: mq + 1 sp-reg: xer + 4 sp-reg: rtcu \ mfspr version + 5 sp-reg: rtcl \ mfspr version + 8 sp-reg: lr + 9 sp-reg: ctr + 18 sp-reg: dsisr + 19 sp-reg: dar + 20 sp-reg: rtcu \ mtspr version + 21 sp-reg: rtcl \ mtspr version + 22 sp-reg: dec + 25 sp-reg: sdr1 + 26 sp-reg: srr0 + 27 sp-reg: srr1 + 268 sp-reg: tb \ For reading + 269 sp-reg: tbu \ For reading + 272 sp-reg: sprg0 + 273 sp-reg: sprg1 + 274 sp-reg: sprg2 + 275 sp-reg: sprg3 + 280 sp-reg: asr \ 620-specific + 282 sp-reg: ear + 284 sp-reg: tb.w \ For writing + 285 sp-reg: tbu.w \ For writing + 287 sp-reg: pvr + 528 sp-reg: ibat0u + 529 sp-reg: ibat0l + 530 sp-reg: ibat1u + 531 sp-reg: ibat1l + 532 sp-reg: ibat2u + 533 sp-reg: ibat2l + 534 sp-reg: ibat3u + 535 sp-reg: ibat3l + 536 sp-reg: dbat0u + 537 sp-reg: dbat0l + 538 sp-reg: dbat1u + 539 sp-reg: dbat1l + 540 sp-reg: dbat2u + 541 sp-reg: dbat2l + 542 sp-reg: dbat3u + 543 sp-reg: dbat3l + +1008 sp-reg: check \ Exponential 704-specific +1008 sp-reg: checkstop 1008 sp-reg: hid0 +1009 sp-reg: debug-mode 1009 sp-reg: hid1 +1010 sp-reg: iabr 1010 sp-reg: hid2 +1013 sp-reg: dabr 1013 sp-reg: hid5 +1016 sp-reg: buscsr \ 620-specific +1017 sp-reg: l2cr \ 620-specific +1018 sp-reg: l2sr \ 620-specific +1023 sp-reg: pir 1023 sp-reg: hid15 + + \ 603-specific + 976 sp-reg: dmiss + 977 sp-reg: dcmp + 978 sp-reg: hash1 + 979 sp-reg: hash2 + 980 sp-reg: imiss + 981 sp-reg: icmp + 982 sp-reg: rpa + +\ 604-specific + 952 sp-reg: mmcr0 \ 604-specific reg + 953 sp-reg: pmc1 \ 604-specific reg + 954 sp-reg: pmc2 \ 604-specific reg + 955 sp-reg: sia \ 604-specific reg + 959 sp-reg: sda \ 604-specific reg + +\ Exponential 704-specific: also uses some 603-specific registers + 276 sp-reg: sprg4 \ Exponential 704-specific + 277 sp-reg: sprg5 \ Exponential 704-specific + 278 sp-reg: sprg6 \ Exponential 704-specific + 279 sp-reg: sprg7 \ Exponential 704-specific + 953 sp-reg: event \ Exponential 704-specific + 954 sp-reg: modes \ Exponential 704-specific + 977 sp-reg: cmp \ Similar to 603 dcmp + 982 sp-reg: tlblru0 \ Similar to 603 rpa + 983 sp-reg: tlbmrf \ Exponential 704-specific + 985 sp-reg: bpctl \ Exponential 704-specific + 987 sp-reg: tlblru1 \ Exponential 704-specific + 988 sp-reg: misr \ Exponential 704-specific + 989 sp-reg: mar \ Exponential 704-specific +1012 sp-reg: l2cdr \ Exponential 704-specific +1014 sp-reg: xdabr \ Exponential 704-specific +1019 sp-reg: l2ctl \ Exponential 704-specific + +\ 823-specific + 80 sp-reg: eie + 81 sp-reg: eid + 82 sp-reg: nri + 144 sp-reg: cmpa + 145 sp-reg: cmpb + 146 sp-reg: cmpc + 147 sp-reg: cmpd + 148 sp-reg: icr + 149 sp-reg: der + 150 sp-reg: counta + 151 sp-reg: countb + 152 sp-reg: cmpe + 153 sp-reg: cmpf + 154 sp-reg: cmpg + 155 sp-reg: cmph + 156 sp-reg: lctrl1 + 157 sp-reg: lctrl2 + 158 sp-reg: ictrl + 159 sp-reg: bar + 560 sp-reg: ic-csr + 561 sp-reg: ic-adr + 562 sp-reg: ic-dat + 568 sp-reg: dc-csr + 569 sp-reg: dc-adr + 570 sp-reg: dc-dat + 630 sp-reg: dpdr + 631 sp-reg: dpir + 638 sp-reg: immr + 784 sp-reg: mi-ctr + 786 sp-reg: mi-ap + 787 sp-reg: mi-epn + 789 sp-reg: mi-twc + 790 sp-reg: mi-rpn + 816 sp-reg: mi-cam + 817 sp-reg: mi-ram0 + 818 sp-reg: mi-ram1 + 792 sp-reg: md-ctr + 793 sp-reg: m-casid + 794 sp-reg: md-ap + 795 sp-reg: md-epn + 796 sp-reg: m-twb + 797 sp-reg: md-twc + 798 sp-reg: md-rpn + 799 sp-reg: m-tw + 824 sp-reg: md-cam + 825 sp-reg: md-ram0 + 826 sp-reg: md-ram1 + + +previous definitions + +\ Define symbolic names for registers in this vocabulary +vocabulary register-names + +headerless +: r-reg-name ( adr len -- n ) + disassembling? 0= if + ['] register-names $vfind if execute exit then + then + " r" reg-name +; +: r-register ( -- n ) + field-or-number if exit then + r-reg-name +; +: crf-register ( -- n ) field-or-number if exit then " crf" reg-name ; +: crb-bit ( -- n ) field-or-number if exit then " crb" reg-name ; +: fr-register ( -- n ) field-or-number if exit then " fr" reg-name ; +: u.d ( n -- ) base @ >r decimal (u.) type r> base ! ; + +\ Nasty hack to handle the RTCU/RTCL SPR encoding difference +\ between mfspr and mtspr +: ?fix-rtc ( sp-reg# -- sp-reg#' ) + dup h# 280 = over h# 2a0 = or if \ rtcu or rtcl? + here /l - asm@ h# 100 and 0= if \ mfspr? + h# 200 - + then + then +; + +: sp-register ( -- n ) + disassembling? if + ?, + 20 10 ibits ( n ) + ['] sp-registers follow + begin another? while + name> dup execute ( n acf constant ) + 2 pick = if (.name) drop exit then ( n acf ) + drop + repeat + ." spr" flip5 u.d + else + field-or-number if exit then + ['] sp-registers $vfind 0= if + ." Bad special register name: " type cr abort + then + execute + ?fix-rtc + then +; +: relative? ( -- flag ) here 4 - asm@ 2 and 0= ; +: ?aligned ( adr -- adr ) + dup 3 and abort" Misaligned branch target" +; +: convert-target ( adr -- n ) + ?aligned + relative? if here 4 - - then +; +: safe-get-number ( adr len -- n ) + get-based-number abort" Bad branch target address" +; +: branch-target ( -- adr ) + field-or-number 0= if ( adr len ) + dup 2 >= if ( adr len ) + over " .+" comp 0= if ( adr len ) + 2 /string safe-get-number here /l - + exit + then ( adr len ) + over " .-" comp 0= if ( adr len ) + 2 /string safe-get-number negate here /l - + exit + then + then + safe-get-number + then +; + +: add-bits ( n -- ) + here /l - dup asm@ rot or swap asm! +; + +: >16-bits? ( n -- u flag ) + dup h# ffff and swap h# -8000 h# 8000 within 0= +; +: ?simm ( n -- n ) + >16-bits? abort" Signed immediate value out of range" +; + +: high-mask ( #low-zeroes -- mask ) 1 swap << 1- invert ; +: bit-field ( n shift width -- ) + disassembling? if ibits u.d exit then + high-mask 2 pick and abort" Value too large for bit field" + 31 swap - << add-bits +; +: 5bit-field ( -- ) 5 bit-field ; +: rd-field ( n -- ) 10 5bit-field ; +: ra-field ( n -- ) 15 5bit-field ; +: rb-field ( n -- ) 20 5bit-field ; +: rc-bit ( n -- ) 31 1 bit-field ; +: oe-bit ( n -- ) 21 1 bit-field ; + +: imm-field ( n -- ) 31 16 bit-field ; +: sign-extend-16 ( n1 -- n2 ) 16 << 16 >>a ; +: h#.x ( n -- ) + dup -9 9 between 0= if ." h#" then + base @ >r hex (.) type r> base ! +; +: simm ( n -- ) + disassembling? if + ?, 31 16 ibits sign-extend-16 h#.x + else + number ?simm imm-field + then +; +: ?uimm ( u -- u ) + dup h# ffff u> abort" Unsigned immediate value too large" +; +: uimm ( u -- ) + disassembling? if + ?, 31 16 ibits h#.x + else + number ?uimm + imm-field + then +; +\ In principle, this is a signed field, but it makes the code +\ incredibly hard to read if we display it as such. +: simms ( n -- ) + disassembling? if + ?, 31 16 ibits ( sign-extend-16 ) h#.x ." ...." + else + simm + then +; +: uimms ( n -- ) + disassembling? if + \ 64-bit: we will need to handle this differently for the 64-bit version + simms + else + uimm + then +; +: imm ( -- ) number 19 4 bit-field ; +: rd ( -- ) r-register rd-field ; +: ra ( -- ) r-register ra-field ; +: rb ( -- ) r-register rb-field ; +: rs ( -- ) rd ; +: crfd ( -- ) crf-register 8 3 bit-field ; +: crfs ( -- ) crf-register 13 3 bit-field ; +: crbd ( -- ) crb-bit rd-field ; +: crba ( -- ) crb-bit ra-field ; +: crbb ( -- ) crb-bit rb-field ; +: fm ( -- ) number 14 8 bit-field ; +: l ( -- ) number 10 1 bit-field ; +false value numeric-conditionals? +variable suppress-cond +: bo ( -- ) + disassembling? if + 10 5 ibits + numeric-conditionals? if ?, u.d exit then + dup h# 14 and h# 14 = if + ?, ." always" suppress-cond on + else + dup h# 4 and 0= if \ Decrement and test counter register + ?, ." ctr" + dup 2 and if ." =0" then + then + dup h# 10 and if + suppress-cond on + else + suppress-cond off + dup h# 8 and 0= if ?, ." not" then + then + then + 1 and if ?, ." Y" then + else + number rd-field + then +; + +headers +: set-y ( -- ) h# 0020.0000 add-bits ; + +headerless +string-array condnames ," lt" ," gt" ," eq" ," so" end-string-array +: bi ( -- ) + disassembling? if + 15 5 ibits + numeric-conditionals? if ?, u.d exit then + suppress-cond @ if + drop + else + ?, + 4 /mod ?dup if ." cr" u.d ." +" then + condnames ". + then + else + number ra-field + then +; +: frd ( -- ) fr-register rd-field ; +: frs ( -- ) fr-register rd-field ; +: fra ( -- ) fr-register ra-field ; +: frb ( -- ) fr-register rb-field ; +: frc ( -- ) fr-register 25 5bit-field ; +: spr ( -- ) sp-register disassembling? 0= if 20 10 bit-field then ; +: tbr ( -- ) sp-register disassembling? 0= if 20 10 bit-field then ; +: sr ( -- ) number 15 4 bit-field ; +: crm ( -- ) number 19 8 bit-field ; +\ Don't overload the Forth word "to" +: tox ( -- ) number rd-field ; +: mb ( -- ) number 25 5bit-field ; +: me ( -- ) number 30 5bit-field ; +: md ( -- ) number dup h# 1f and 25 5bit-field 5 >> 26 1 bit-field ; +: sh ( -- ) number rb-field ; +: shd ( -- ) number dup h# 1f and rb-field 5 >> 30 1 bit-field ; +: nb ( -- ) number rb-field ; +: set-bd-field ( adr -- ) convert-target ?simm 2 >> 29 14 bit-field ; +: bd ( -- ) + disassembling? if + ?, 29 14 ibits 2 << + 30 1 ibits 0= if sign-extend-16 pc @ + then showaddr + else + branch-target set-bd-field + then +; +: ?offset-26 ( target -- target-masked ) + dup h# fe00.0000 h# 200.0000 within 0= + abort" Branch target out of 26-bit range" + h# 3ff.ffff and +; +: lif ( -- ) + disassembling? if + ?, 29 24 ibits 8 << 6 >>a \ Sign extend + 30 1 ibits 0= if pc @ + then showaddr + else + branch-target + convert-target + ?offset-26 2 >> 29 24 bit-field + then + +; +: parse-d(ra) ( -- disp ra ) + field-or-number if exit then ( adr len ) + ascii ( left-parse-string ( rem-str disp-str ) + dup 0= if ( rem-str disp-str ) + 2drop 0 ( rem-str 0 ) + else ( rem-str disp-str ) + get-based-number abort" Bad displacement" ( rem-str disp ) + then ( rem-str disp ) + -rot ascii ) left-parse-string ( disp rem-str reg-str ) + 2swap 2drop r-reg-name ( disp ra ) +; +: d(ra) ( -- ) + disassembling? if + ?, + 31 16 ibits sign-extend-16 h#.x + need-comma off + 15 5 ibits if ." (" ra ." )" then + else + parse-d(ra) ra-field ?simm imm-field + then +; +: ds(ra) ( -- ) + disassembling? if + ?, + 29 14 ibits 2 lshift sign-extend-16 h#.x + need-comma off + 15 5 ibits if ." (" ra ." )" then + else + parse-d(ra) ra-field ?simm + dup 3 and abort" offset must be 4-byte aligned" + imm-field + then +; + +\ Operand formats +: rd,ra rd ra ; +: rd,ra,rb rd,ra rb ; +: rd,ra,simm rd,ra simm ; +: rd,ra,simms rd,ra simms ; +: crbd,crba,crbb crbd crba crbb ; +: ra,rs ra rs ; +: ra,rb ra rb ; +: rs,ra,rb rs ra rb ; +: rs,rb rs rb ; +: ra,rs,rb ra,rs rb ; +: ra,rs,uimm ra,rs uimm ; +: ra,rs,uimms ra,rs uimms ; +: bo,bi bo bi end-found on ; +: bo,bi,bd bo bi bd ; +: crfd,l,ra crfd l ra ; +: crfd,crfs crfd crfs ; +: crfd,l,ra,rb crfd,l,ra rb ; +: frd,frb frd frb ; +: frd,fra,frb frd fra frb ; +: frd,fra,frc frd fra frc ; +: crfd,fra,frb crfd fra frb ; +: frd,fra,frc,frb frd fra frc frb ; +: crfd,imm crfd imm ; +: crfd,l,ra,uimm crfd,l,ra uimm ; +: crfd,l,ra,simm crfd,l,ra simm ; +: frs,ra,rb frs ra rb ; +: frd,ra,rb frd ra rb ; +: rd,spr rd spr ; +: rd,tbr rd tbr ; +: rd,sr rd sr ; +: crm,rs crm rs ; +: spr,rs spr rs ; +: sr,rs sr rs ; +: to,ra,rb tox ra rb ; +: to,ra,simm tox ra simm ; +: rd,d(ra) rd d(ra) ; +: rs,d(ra) rs d(ra) ; +: rd,ds(ra) rd ds(ra) ; +: rs,ds(ra) rs ds(ra) ; +: frd,d(ra) frd d(ra) ; +: frs,d(ra) frs d(ra) ; +: ra,rs,rb,mb,me ra rs rb mb me ; +: ra,rs,sh,mb,me ra rs sh mb me ; +: ra,rs,shd,md ra rs shd md ; +: ra,rs,rb,md ra rs rb md ; +: ra,rs,sh ra rs sh ; +: ra,rs,shd ra rs shd ; +: fm,frb fm frb ; +: rd,ra,nb rd ra nb ; +: rs,ra,nb rs ra nb ; +: rd,rb rd rb ; +: no-args ; + +: no-. ; + +alias power noop +\ alias power \ + +\ alias 64bit \ +alias 64bit noop + +: >op2-field ( template -- op2 ) 1 >> h# 3fff and ; +: find-free ( map -- entry-adr ) + begin dup @ -1 <> while na1+ ta1+ repeat +; +headers + +transient +: set-indexed-map ( op2 map -- ) swap ta+ lastacf swap token! ; +: set-sparse-map ( op2 map -- ) + find-free tuck ! lastacf swap na1+ token! +; +: set-map ( opcode-template -- ) + dup >op2-field swap 26 >> ( op2 opcd ) + case + 19 of 19-map set-sparse-map endof + 31 of 31-map set-indexed-map endof + 59 of 59-map set-indexed-map endof + 63 of 63-map set-sparse-map endof + ( default ) op-map set-indexed-map + endcase +; +resident + +: asm, ( n -- ) here /l asm-allot asm! ; + +headerless +: ?. ( -- ) 31 1 ibits if ." ." then ; +: dis-operands ( acf -- ) + dup ['] unimp = if drop exit then + to-operand-column >body na1+ token@ execute +; +variable op-class \ Used for handling the "." forms of the rlw... opcodes +: dis-name&operands ( acf -- ) + dup (.name) + op-class @ d# 20 d# 23 between if ?. then + dis-operands +; + +: bust ( n -- ) + base @ >r decimal + dup 26 >> 2 u.r + dup 21 >> h# 1f and 3 u.r + dup 16 >> h# 1f and 3 u.r + dup 11 >> h# 1f and 3 u.r + dup 1 >> h# 3ff and 5 u.r + 1 and 2 u.r ( cr ) + r> base ! +; + +headers +: ppc-disasm ( 32b -- ) + dup instruction l! + true is disassembling? + 26 >> dup op-class ! op-map find-indexed-entry execute +; +also forth definitions +alias disasm ppc-disasm +: dis1 ( -- ) + ??cr + pc @ showaddr 4 spaces + #out @ start-column ! + pc @ +offset l@ disasm cr + /l pc +! +; +: +dis ( -- ) + base @ >r hex + end-found off + begin dis1 end-found @ exit? or until + r> base ! +; +: dis ( adr -- ) pc l! +dis ; +alias (dis dis +previous definitions + +headerless +\ Try to interpret the word with the "." removed, and then with the "o" +\ removed. +: interpreted? ( adr len -- adr len false | true ) + $find dup if swap execute then +; +: ?peel ( adr1 len1 char -- adr2 len2 flag ) + >r 2dup 1- + c@ r> = if 1- true else false then +; +: $ppc-assem-do-undefined ( adr len -- ) + ascii . ?peel if ( adr len ) + interpreted? if 1 rc-bit exit then ( adr len ) + ascii o ?peel if ( adr len ) + interpreted? if 1 oe-bit 1 rc-bit exit then + then ( adr len ) + else + ascii o ?peel if + interpreted? if 1 oe-bit exit then + then + then ( adr len ) + .not-found abort +; +: get-operands ( -- ) parse-word operands 2! ; + +: op: ( opcode-template -- ) + create dup set-map , \ Remember opcode template + + \ Remember argument parsing word + parse-word $find 0= abort" Missing argument specification" token, + + does> + disassembling? if + body> dis-name&operands + false is disassembling? + else + dup @ asm, \ Place opcode + na1+ token@ dup ['] no-args <> if get-operands then + execute \ Handle arguments + then +; + +[ifdef] notdef +: .binary ( n -- ) + base @ >r 2 base ! + <# 32 0 do # loop #> type space + r> base ! +; +[then] + +headers +transient +: can-. ( -- ) ; \ "." form is available +: can-o ( -- ) ; \ "o" form is available + +\ Opcode formats +resident +: >op ( op0 -- ) 26 << ; + +transient +: d: ( op0 -- ) >op op: ; +: b: ( op0 aa lk -- ) swap 1 << + swap >op + op: ; +: o: ( op1 op0 -- ) swap 1 << swap >op + op: ; + +: dl: ( op0 low -- ) swap >op + op: ; +: rd: ( low -- ) 2 << 30 >op + op: ; + +: r: ( op0 -- ) d: can-. ; + +: xl: ( op1 -- ) 19 o: ; +: x: ( op1 -- ) 31 o: ; +: s: ( op1 -- ) 59 o: can-. ; +: f: ( op1 -- ) 63 o: can-. ; + +\ : x: 31 swap 1 << swap >op + .binary newline word ". cr ; + +: xc: ( op1 -- ) x: can-. ; +: xo: ( op1 oe -- ) xc: can-o ; +resident + +\ Put a branch instruction from high-level Forth code + +: offset-26 ( target-address branch-address -- masked-displacement ) + swap ?aligned swap ?aligned + - ?offset-26 +; + +also forth definitions +: put-branch ( target-adr branch-adr -- ) + tuck offset-26 h# 4800.0000 + swap asm! \ b offset +; +previous definitions + +: cond ( bo bi -- ) + swap 5 << or 16 << create , does> @ +; +: -cond ( condition -- not-condition ) + dup h# 0080.0000 and 0= if h# 0040.0000 xor then \ CTR condition + dup h# 0200.0000 and 0= if h# 0100.0000 xor then \ CR condition +; + +headerless +: offset-16 ( target-address branch-address -- masked-displacement ) + dup 3 and abort" Unaligned branch displacement" + - + >16-bits? abort" branch displacement out of 16-bit range" +; + +headers +: brif ( address condition -- ) + h# 4000.0000 or swap here offset-16 or asm, +; + +: mr ( -- ) \ rdest,rsrc + 444 1 << 31 >op + asm, \ "or rdest,rsrc,rsrc" + get-operands + ra r-register dup rd-field rb-field +; +: li ( -- ) \ rdest,value + get-operands + 14 >op asm, \ "addi rdest,r0,value" + r-register rd-field 0 ra-field number ?simm imm-field +; +: lis ( -- ) + 15 >op asm, \ "addis rdest,r0,high(value)" + get-operands + r-register rd-field 0 ra-field number 16 >>a imm-field +; +: set ( -- ) \ rdest,value + \ We can't keep rd on the stack because a number might be there, + \ waiting for a "*" in the number field to pick it up + get-operands r-register >r number ( value ) ( r: register ) + dup >16-bits? if ( value val.low ) + swap ( val.low value ) + 15 >op asm, \ "addis rdest,r0,high(value)" ( val.low value ) + r@ rd-field 0 ra-field 16 >> imm-field ( val.low ) + ?dup if + 24 >op asm, \ "ori rdest,rdest,low(value) ( ) + imm-field r@ rd-field r@ ra-field + then ( ) + else ( value val.low ) + nip + 14 >op asm, \ "addi rdest,r0,value" ( val.low reg ) + r@ rd-field 0 ra-field imm-field ( ) + then + r> drop +; +: countdown ( adr -- ) 16 >op asm, 16 rd-field 0 ra-field set-bd-field ; +: nop ( -- ) 24 >op asm, ; \ ori r0,r0,0 + + \ 0,1 are unassigned + +64bit 2 d: tdi to,ra,simm + 3 d: twi to,ra,simm + + \ 4,5,6 are unassigned + + 7 d: mulli rd,ra,simm + 8 d: subfic rd,ra,simm +power 9 d: dozi rd,ra,simm + 10 d: cmpli crfd,l,ra,uimm + 11 d: cmpi crfd,l,ra,simm + 12 d: addic rd,ra,simm + 13 d: addic. rd,ra,simm + 14 d: addi rd,ra,simm + 15 d: addis rd,ra,simms + + \ 16 is bcX + \ 17 is sc + \ 18 is bX + \ 19 is xl: and bclr,bctr + + 20 r: rlwimi ra,rs,sh,mb,me + 21 r: rlwinm ra,rs,sh,mb,me +power 22 r: rlmi ra,rs,rb,mb,me + 23 r: rlwnm ra,rs,rb,mb,me + + 24 d: ori ra,rs,uimm + 25 d: oris ra,rs,uimms + 26 d: xori ra,rs,uimm + 27 d: xoris ra,rs,uimms + 28 d: andi. ra,rs,uimm + 29 d: andis. ra,rs,uimms + +64bit 0 rd: rldicl ra,rs,shd,md +64bit 1 rd: rldicr ra,rs,shd,md +64bit 2 rd: rldic ra,rs,shd,md +64bit 3 rd: rldimi ra,rs,shd,md +64bit 8 rd: rldcl ra,rs,rb,md +64bit 9 rd: rldcr ra,rs,rb,md + + \ 31 is x: xc: xo: + + 32 d: lwz rd,d(ra) + 33 d: lwzu rd,d(ra) + 34 d: lbz rd,d(ra) + 35 d: lbzu rd,d(ra) + 36 d: stw rs,d(ra) + 37 d: stwu rs,d(ra) + 38 d: stb rs,d(ra) + 39 d: stbu rs,d(ra) + 40 d: lhz rd,d(ra) + 41 d: lhzu rd,d(ra) + 42 d: lha rd,d(ra) + 43 d: lhau rd,d(ra) + 44 d: sth rs,d(ra) + 45 d: sthu rs,d(ra) + 46 d: lmw rd,d(ra) + 47 d: stmw rs,d(ra) + 48 d: lfs frd,d(ra) + 49 d: lfsu frd,d(ra) + 50 d: lfd frd,d(ra) + 51 d: lfdu frd,d(ra) + 52 d: stfs frs,d(ra) + 53 d: stfsu frs,d(ra) + 54 d: stfd frs,d(ra) + 55 d: stfdu frs,d(ra) + +\ 56,57 are unassigned + +64bit 58 0 dl: ld rd,ds(ra) +64bit 58 1 dl: ldu rd,ds(ra) +64bit 58 2 dl: lwa rd,ds(ra) + +\ 59 is s: words +\ 60,61 are unassigned + +64bit 62 0 dl: std rs,ds(ra) +64bit 62 1 dl: stdu rs,ds(ra) + +\ 63 is f: + + + 16 0 0 b: bc bo,bi,bd + 16 0 1 b: bca bo,bi,bd + 16 1 0 b: bcl bo,bi,bd + 16 1 1 b: bcla bo,bi,bd + + 17 1 0 b: sc no-args + + 18 0 0 b: b lif + 18 0 1 b: bl lif + 18 1 0 b: ba lif + 18 1 1 b: bla lif + +\ Opcode 19 + + 19 16 0 b: bclr bo,bi + 19 16 1 b: bclrl bo,bi + + 19 528 0 b: bcctr bo,bi + 19 528 1 b: bcctrl bo,bi + + 0 xl: mcrf crfd,crfs + + 50 xl: rfi no-args + 150 xl: isync no-args + + 33 xl: crnor crbd,crba,crbb + 129 xl: crandc crbd,crba,crbb + 193 xl: crxor crbd,crba,crbb + 225 xl: crnand crbd,crba,crbb + 257 xl: crand crbd,crba,crbb + 289 xl: creqv crbd,crba,crbb + 417 xl: crorc crbd,crba,crbb + 449 xl: cror crbd,crba,crbb + +\ Opcode 31 + + 8 xo: subfc rd,ra,rb + 10 xo: addc rd,ra,rb + 40 xo: subf rd,ra,rb + 104 xo: neg rd,ra +power 107 xo: mul rd,ra,rb + 136 xo: subfe rd,ra,rb + 138 xo: adde rd,ra,rb + 200 xo: subfze rd,ra + 202 xo: addze rd,ra + 232 xo: subfme rd,ra + 234 xo: addme rd,ra + 235 xo: mullw rd,ra,rb +power 264 xo: doz rd,ra,rb + 266 xo: add rd,ra,rb + 331 xo: div rd,ra,rb +power 360 xo: abs rd,ra + 363 xo: divs rd,ra,rb +64bit 457 xo: divdu rd,ra,rb + 459 xo: divwu rd,ra,rb + 491 xo: divw rd,ra,rb +power 488 xo: nabs rd,ra +64bit 233 xo: mulld rd,ra,rb +64bit 489 xo: divd rd,ra,rb + + 28 xc: and ra,rs,rb + 60 xc: andc ra,rs,rb + 124 xc: nor ra,rs,rb + 284 xc: eqv ra,rs,rb + 316 xc: xor ra,rs,rb + 412 xc: orc ra,rs,rb + 444 xc: or ra,rs,rb + 476 xc: nand ra,rs,rb + + 11 xc: mulhwu rd,ra,rb + 75 xc: mulhw rd,ra,rb +64bit 9 xc: mulhdu rd,ra,rb +64bit 73 xc: mulhd rd,ra,rb + 922 xc: extsh ra,rs + 954 xc: extsb ra,rs +64bit 986 xc: extsw ra,rs + + 24 xc: slw ra,rs,rb + 536 xc: srw ra,rs,rb + 792 xc: sraw ra,rs,rb + 824 xc: srawi ra,rs,sh +64bit 27 xc: sld ra,rs,rb +64bit 539 xc: srd ra,rs,rb +64bit 413 xc: sradi ra,rs,shd +64bit 794 xc: srad ra,rs,rb + + 26 xc: cntlzw ra,rs +64bit 58 xc: cntlzd ra,rs + + 150 xc: stwcx rs,ra,rb \ XXX the non-dotted form doesn't exist! +64bit 214 xc: stdcx rs,ra,rb \ XXX the non-dotted form doesn't exist! + +power 277 xc: lscbx rd,ra,rb + +power 29 xc: maskg ra,rs,rb +power 541 xc: maskir ra,rs,rb +power 537 xc: rrib ra,rs,rb +power 153 xc: sle ra,rs,rb +power 217 xc: sleq ra,rs,rb +power 216 xc: sllq ra,rs,rb +power 152 xc: slq ra,rs,rb +power 184 xc: sliq ra,rs,sh +power 248 xc: slliq ra,rs,sh +power 952 xc: sraiq ra,rs,sh +power 920 xc: sraq ra,rs,rb +power 665 xc: sre ra,rs,rb +power 921 xc: srea ra,rs,rb +power 729 xc: sreq ra,rs,rb +power 696 xc: sriq ra,rs,sh +power 760 xc: srliq ra,rs,sh +power 728 xc: srlq ra,rs,rb +power 664 xc: srq ra,rs,rb + + 531 x: clcs rd,ra + + 0 x: cmp crfd,l,ra,rb + 32 x: cmpl crfd,l,ra,rb + + 86 x: dcbf ra,rb + 470 x: dcbi ra,rb + 54 x: dcbst ra,rb + 278 x: dcbt ra,rb + 246 x: dcbtst ra,rb + 1014 x: dcbz ra,rb + + 310 x: eciwx rd,ra,rb + 438 x: ecowx rs,ra,rb + 854 x: eieio no-args + + 982 x: icbi ra,rb + + 87 x: lbzx rd,ra,rb + 119 x: lbzux rd,ra,rb + 343 x: lhax rd,ra,rb + 375 x: lhaux rd,ra,rb + 790 x: lhbrx rd,ra,rb + 279 x: lhzx rd,ra,rb + 311 x: lhzux rd,ra,rb + 23 x: lwzx rd,ra,rb + 55 x: lwzux rd,ra,rb + 20 x: lwarx rd,ra,rb + 534 x: lwbrx rd,ra,rb + 533 x: lswx rd,ra,rb + 597 x: lswi rd,ra,nb + +64bit 21 x: ldx rd,ra,rb +64bit 53 x: ldux rd,ra,rb +64bit 84 x: ldarx rd,ra,rb +64bit 341 x: lwax rd,ra,rb +64bit 373 x: lwaux rd,ra,rb + + 542 x: lwdx rd,ra,rb \ exponential + 670 x: stwdx rd,ra,rb \ exponential + + 215 x: stbx rs,ra,rb + 247 x: stbux rs,ra,rb + 407 x: sthx rs,ra,rb + 439 x: sthux rs,ra,rb + 918 x: sthbrx rs,ra,rb + 662 x: stwbrx rs,ra,rb + 151 x: stwx rs,ra,rb + 183 x: stwux rs,ra,rb + +64bit 149 x: stdx rs,ra,rb +64bit 181 x: stdux rs,ra,rb + + 725 x: stswi rs,ra,nb + 661 x: stswx rs,ra,rb + + 727 x: stfdx frs,ra,rb + 759 x: stfdux frs,ra,rb + 663 x: stfsx frs,ra,rb + 695 x: stfsux frs,ra,rb + +64bit 983 x: stfiwx frs,ra,rb + + 631 x: lfdux frd,ra,rb + 599 x: lfdx frd,ra,rb + 567 x: lfsux frd,ra,rb + 535 x: lfsx frd,ra,rb + + 512 x: mcrxr crfd + 19 x: mfcr rd + + 83 x: mfmsr rd + 339 x: mfspr rd,spr + 595 x: mfsr rd,sr + 659 x: mfsrin rd,rb + 144 x: mtcrf crm,rs + 146 x: mtmsr rs + 467 x: mtspr spr,rs + 210 x: mtsr sr,rs + 242 x: mtsrin rs,rb + 371 x: mftb rd,tbr \ tbr register is tb or tbu + +64bit 434 x: slbie no-args +64bit 498 x: slbia no-args + 566 x: tlbsync no-args +64bit 370 x: tlbia no-args + 598 x: sync no-args + 306 x: tlbie rb + 978 x: tlbld rb \ 603-specific + 1010 x: tlbli rb \ 603-specific + 4 x: tw to,ra,rb +64bit 68 x: td to,ra,rb + +\ Opcode 59 + + 18 s: fdivw frd,fra,frb + 20 s: fsubs frd,fra,frb + 21 s: fadds frd,fra,frb + 25 s: fmuls frd,fra,frc + 28 s: fmsubs frd,fra,frc,frb + 29 s: fmadds frd,fra,frc,frb + 30 s: fnmsubs frd,fra,frc,frb + 31 s: fnmadds frd,fra,frc,frb + +\ Opcode 63 + + 18 f: fdiv frd,fra,frb + 20 f: fsub frd,fra,frb + 21 f: fadd frd,fra,frb + 25 f: fmul frd,fra,frc + 28 f: fmsub frd,fra,frc,frb + 29 f: fmadd frd,fra,frc,frb + 30 f: fnmsub frd,fra,frc,frb + 31 f: fnmadd frd,fra,frc,frb + + 12 f: frsp frd,frb + 14 f: fctiw frd,frb + 15 f: fctiwz frd,frb +64bit 22 f: fsqrt frd,frb +64bit 23 f: fsel frd,frb +64bit 24 f: fres frd,frb +64bit 26 f: fsqrte frd,frb + 40 f: fneg frd,frb + 72 f: fmr frd,frb + 136 f: fnabs frd,frb + 264 f: fabs frd,frb + +64bit 814 f: fctid frd,frb +64bit 815 f: fctidz frd,frb +64bit 846 f: fcfid frd,frb + + 0 f: fcmpu crfd,fra,frb + 32 f: fcmpo crfd,fra,frb + + 38 f: mtfsb1 crbd + 64 f: mcrfs crfd,crfs ( no-. ) + 70 f: mtfsxl crbd + 134 f: mtfsfi crfd,imm + 583 f: mffs frd + 711 f: mtfsf fm,frb + +\ This definition prevents "add." from being parsed as a number. +: add. ( -- ) add 1 rc-bit ; + +headerless +: dis-16 ( -- ) + 31 2 ibits case + 0 of ['] bc endof + 1 of ['] bcl endof + 2 of ['] bca endof + 3 of ['] bcla endof + endcase + dis-name&operands +; + +16 op-map set-indexed-map +: dis-18 ( -- ) + 31 2 ibits case + 0 of ['] b endof + 1 of ['] bl endof + 2 of ['] ba endof + 3 of ['] bla endof + endcase + dis-name&operands +; +18 op-map set-indexed-map + +: dis-19 ( -- ) + 30 10 ibits 19-map find-sparse-entry + dup (.name) ( acf ) + 31 1 ibits if ." l" then + dis-operands +; +19 op-map set-indexed-map + +: dis-31 ( -- ) + 28 3 ibits 2 = if \ xo form, with o and . modifiers + 30 9 ibits 31-map find-indexed-entry dup (.name) ( acf ) + 21 1 ibits if ." o" then + else + 30 10 ibits 31-map find-indexed-entry dup (.name) ( acf ) + then ( acf ) + ?. dis-operands +; +31 op-map set-indexed-map + +: dis-59 ( -- ) + 30 5 ibits 59-map find-indexed-entry dup (.name) ?. dis-operands +; +59 op-map set-indexed-map + +: dis-63 ( -- ) + 30 10 ibits 63-map find-sparse-entry dup (.name) ?. dis-operands +; +63 op-map set-indexed-map + + +headers +\ Structured conditionals + +\ Condition names. There are more of these near the end of the file. +\ BO bits: 16 no-cond 8 cc bit true 4 no-ctr 2 ctr=0 +\ B1 values: 0 lt 1 gt 2 eq + +20 0 cond always +12 00 cond lt 04 00 cond ge +12 01 cond gt 04 01 cond le +12 02 cond eq 04 02 cond ne +12 03 cond vs 04 03 cond vc + +: ctr<>0 ( cond -- cond' ) + h# 0080.0000 invert [ also forth ] and [ previous ] +; +: ctr=0 ( cond -- cond' ) + ctr<>0 h# 0040.0000 [ also forth ] or [ previous ] +; + +headerless +: mark ( -- >mark ) here ; +: >resolve ( >mark -- ) here over offset-16 over asm@ + swap asm! ; +: <resolve ( -- ) ; + +headers +: but ( mark1 mark2 -- mark2 mark1 ) swap ; +: yet ( mark -- mark mark ) dup ; + +: ahead ( -- >mark ) >mark here always brif ; +: if ( cond -- >mark ) >mark here rot -cond brif ; +: then ( >mark -- ) >resolve ; +: else ( >mark -- >mark1 ) ahead but then ; +: begin ( -- mark mark <mark ) if but ; + +\ Define these last to delay overloading of the forth versions + +\ There are no explicit condition codes for unsigned comparison; +\ there is a "cmpl" instruction that performs an unsigned ("logical") +\ comparison, setting the regular less-than and greater-than bits. + +12 00 cond 0< 04 00 cond 0>= +12 00 cond < 04 00 cond >= +12 01 cond 0> 04 01 cond 0<= +12 01 cond > 04 01 cond <= +12 02 cond 0= 04 02 cond 0<> +12 02 cond = 04 02 cond <> + +previous definitions + +\ LICENSE_BEGIN +\ Copyright (c) 2007 FirmWorks +\ +\ Permission is hereby granted, free of charge, to any person obtaining +\ a copy of this software and associated documentation files (the +\ "Software"), to deal in the Software without restriction, including +\ without limitation the rights to use, copy, modify, merge, publish, +\ distribute, sublicense, and/or sell copies of the Software, and to +\ permit persons to whom the Software is furnished to do so, subject to +\ the following conditions: +\ +\ The above copyright notice and this permission notice shall be +\ included in all copies or substantial portions of the Software. +\ +\ THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, +\ EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF +\ MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND +\ NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE +\ LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION +\ OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION +\ WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. +\ +\ LICENSE_END Added: cpu/ppc/banner.fth =================================================================== --- cpu/ppc/banner.fth (rev 0) +++ cpu/ppc/banner.fth 2007-07-05 17:19:17 UTC (rev 461) @@ -0,0 +1,35 @@ +purpose: Displays banner describing system configuration +\ See license at end of file + +\ Display the startup message. + +: fw-title ( -- ) + ." Power Firmware(TM) by FirmWorks" + " build-date" $find if ." , Built " execute type else 2drop then cr + ?spaces ." Copyright (c) 1995-2000, FirmWorks. All Rights Reserved." cr +; +' fw-title to .firmware + +\ LICENSE_BEGIN +\ Copyright (c) 2007 FirmWorks +\ +\ Permission is hereby granted, free of charge, to any person obtaining +\ a copy of this software and associated documentation files (the +\ "Software"), to deal in the Software without restriction, including +\ without limitation the rights to use, copy, modify, merge, publish, +\ distribute, sublicense, and/or sell copies of the Software, and to +\ permit persons to whom the Software is furnished to do so, subject to +\ the following conditions: +\ +\ The above copyright notice and this permission notice shall be +\ included in all copies or substantial portions of the Software. +\ +\ THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, +\ EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF +\ MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND +\ NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE +\ LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION +\ OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION +\ WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. +\ +\ LICENSE_END Added: cpu/ppc/basefw.bth =================================================================== --- cpu/ppc/basefw.bth (rev 0) +++ cpu/ppc/basefw.bth 2007-07-05 17:19:17 UTC (rev 461) @@ -0,0 +1,113 @@ +purpose: Load file for base firmware - no platform specifics +\ See license at end of file + +dictionary: ${BP}/cpu/ppc/build/tools.dic +command: &ppcforth &dictionary &this +build-now + +hex + +\ ' $report-name is include-hook + +\ create use-prep-nvram + +create include-help \ Include help facility + +fload ${BP}/cpu/ppc/occhksum.fth \ IP checksum primitive + +alias cfill fill +fload ${BP}/ofw/core/ofwcore.fth \ Device tree and other OBP routines +fload ${BP}/ofw/core/ofwfw.fth \ FirmWorks enhancements + +fload ${BP}/ofw/core/memops.fth \ Call memory node methods +fload ${BP}/ofw/core/mmuops.fth \ Call MMU node methods +\ : cfill fill ; + +fload ${BP}/cpu/ppc/cpuclass.fth \ CPU characterization + +\ Load millisecond timer +fload ${BP}/cpu/ppc/getms.fth \ Timer access + +fload ${BP}/cpu/ppc/call.fth \ Primitive subroutine calls +fload ${BP}/cpu/ppc/centry.fth \ Low-level client entry and exit +fload ${BP}/cpu/ppc/fb8-ops.fth \ S Machine code for fb8 + +fload ${BP}/ofw/confvar/loadcv.fth \ Configuration variables +fload ${BP}/ofw/core/silentmd.fth \ NVRAM variable silent-mode? + +fload ${BP}/ofw/termemu/loadfb.fth \ Frame buffer support +fload ${BP}/ofw/termemu/difont.fth \ Get font from a dropin module + +fload ${BP}/ofw/gui/alert.fth \ Basic dialogs and alerts +fload ${BP}/dev/stringio.fth \ Output diversion + +fload ${BP}/ofw/core/loadmore.fth \ Load additional core stuff + +fload ${BP}/ofw/inet/loadtftp.fth \ Trivial File Transfer Protocol pkg. + +fload ${BP}/cpu/ppc/forthint.fth \ Alarm handler + +fload ${BP}/cpu/ppc/regacc.fth \ Register access words + +fload ${BP}/ofw/fcode/loadfcod.fth \ S Fcode interpreter + +fload ${BP}/ofw/fcode/regcodes.fth \ Register access words +fload ${BP}/ofw/fcode/extcodes.fth \ Firmworks extension FCodes + +\ File system readers +fload ${BP}/ofw/core/initprog.fth \ FCode and Forth source load formats + +fload ${BP}/ofw/core/infltdi.fth \ Support for compressed dropin drivers +' in-little-endian? to flip-code? \ Flip inflated code when in LE mode + +[ifdef] resident-packages +support-package: fat-file-system + fload ${BP}/ofw/fs/fatfs/loadpkg.fth \ FAT file system reader +end-support-package + +support-package: iso9660-file-system + fload ${BP}/ofw/fs/cdfs/loadpkg.fth \ ISO 9660 CD-ROM file system reader +end-support-package + +support-package: disk-label + fload ${BP}/ofw/disklabel/loadpkg.fth \ Disk label package +end-support-package +[then] + +[ifdef] resident-packages +fload ${BP}/ofw/fs/fatfs/fdisk2.fth \ Partition map administration +[else] +autoload: fdisk2.fth +defines: $.partitions +defines: .partitions +\ defines: init-nt-disk +defines: $partition +[then] + +[ifndef] no-heads +.( --- Saving basefw.dic --- ) cr "" basefw.dic save-forth +[then] + +\ LICENSE_BEGIN +\ Copyright (c) 2007 FirmWorks +\ +\ Permission is hereby granted, free of charge, to any person obtaining +\ a copy of this software and associated documentation files (the +\ "Software"), to deal in the Software without restriction, including +\ without limitation the rights to use, copy, modify, merge, publish, +\ distribute, sublicense, and/or sell copies of the Software, and to +\ permit persons to whom the Software is furnished to do so, subject to +\ the following conditions: +\ +\ The above copyright notice and this permission notice shall be +\ included in all copies or substantial portions of the Software. +\ +\ THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, +\ EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF +\ MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND +\ NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE +\ LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION +\ OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION +\ WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. +\ +\ LICENSE_END Added: cpu/ppc/bat.fth =================================================================== --- cpu/ppc/bat.fth (rev 0) +++ cpu/ppc/bat.fth 2007-07-05 17:19:17 UTC (rev 461) @@ -0,0 +1,236 @@ +purpose: Block Address Translation register access +\ See license at end of file + +hex + +headerless +code ibat! ( bat-lo bat-hi ibat# -- ) + lwz t0,0(sp) + lwz t1,1cell(sp) + + cmpi 0,0,tos,0 + = if + sync isync + mtspr ibat0u,t0 + mtspr ibat0l,t1 + sync isync + else + + cmpi 0,0,tos,1 + = if + sync isync + mtspr ibat1u,t0 + mtspr ibat1l,t1 + sync isync + else + + cmpi 0,0,tos,2 + = if + sync isync + mtspr ibat2u,t0 + mtspr ibat2l,t1 + sync isync + else + + cmpi 0,0,tos,3 + = if + sync isync + mtspr ibat3u,t0 + mtspr ibat3l,t1 + sync isync + then then then then + + lwz tos,2cells(sp) + addi sp,sp,3cells +c; + +code dbat! ( bat-lo bat-hi dbat# -- ) + lwz t0,0(sp) + lwz t1,1cell(sp) + + cmpi 0,0,tos,0 + = if + sync isync + mtspr dbat0u,t0 + mtspr dbat0l,t1 + sync isync + else + + cmpi 0,0,tos,1 + = if + sync isync + mtspr dbat1u,t0 + mtspr dbat1l,t1 + sync isync + else + + cmpi 0,0,tos,2 + = if + sync isync + mtspr dbat2u,t0 + mtspr dbat2l,t1 + sync isync + else + + cmpi 0,0,tos,3 + = if + sync isync + mtspr dbat3u,t0 + mtspr dbat3l,t1 + sync isync + then then then then + + lwz tos,2cells(sp) + addi sp,sp,3cells +c; + +code ibat@ ( ibat# -- bat-lo bat-hi ) + cmpi 0,0,tos,0 + = if + mfspr tos,ibat0u + mfspr t1,ibat0l + else + + cmpi 0,0,tos,1 + = if + mfspr tos,ibat1u + mfspr t1,ibat1l + else + + cmpi 0,0,tos,2 + = if + mfspr tos,ibat2u + mfspr t1,ibat2l + else + + cmpi 0,0,tos,3 + = if + mfspr tos,ibat3u + mfspr t1,ibat3l + then then then then + + stwu t1,-1cell(sp) +c; + +code dbat@ ( dbat# -- bat-lo bat-hi ) + cmpi 0,0,tos,0 + = if + mfspr tos,dbat0u + mfspr t1,dbat0l + else + + cmpi 0,0,tos,1 + = if + mfspr tos,dbat1u + mfspr t1,dbat1l + else + + cmpi 0,0,tos,2 + = if + mfspr tos,dbat2u + mfspr t1,dbat2l + else + + cmpi 0,0,tos,3 + = if + mfspr tos,dbat3u + mfspr t1,dbat3l + then then then then + + stwu t1,-1cell(sp) +c; + +headers +0 constant ibat +1 constant dbat +2 constant i&dbats + +headerless +false value l1-writethru? + +: cache-mode ( io? -- mode ) + if 38 else 10 l1-writethru? if 40 or then then +; +: mask-bat-adr ( adr -- hi-bits ) 1.ffff invert and ; + +headers +: bat! ( pa va len io? bat# which -- ) + >r >r >r >r ( pa va ) ( R: which bat# io? len ) + mask-bat-adr r> ( pa BEPI len ) ( R: which bat# io) + 1- h# 11 >> 2 << or 2 or ( supervisor ) ( pa bat-hi ) + swap mask-bat-adr ( bat-hi BRPN ) + \ Coherent in both cases, no cache for I/O + r> cache-mode or ( bat-hi BRPN|WIMG ) ( R: wh bat# ) + 2 or ( r/w ) swap ( bat-lo bat-hi ) ( R: which bat# ) + r> r> case + dbat of dbat! endof + ibat of ibat! endof + i&dbats of 3dup dbat! ibat! endof + endcase +; + +: bat@ ( bat# which -- false | pa va len flags true ) + dbat = if dbat@ else ibat@ then ( bat-lo bat-hi ) + dup 3 and 0= if 2drop false exit then ( bat-lo bat-hi ) + over h# 7f and >r ( bat-lo bat-hi r: flags ) + swap mask-bat-adr swap ( pa bat-hi ) + dup mask-bat-adr swap ( pa va bat-hi ) + 2 >> 7ff and 1+ h# 11 << ( pa va len ) + r> true +; +headerless + +\ Motorola says that the BAT registers can become corrupted if +\ two of them happen to map overlapping ranges, even if address +\ translation is turned off, and that said corruption can be prevented +\ by invalidating all the BAT registers before programming any of them. + +: clear-bats ( -- ) 4 0 do 0 0 i ibat! 0 0 i dbat! loop ; +: clear-srs ( -- ) 10 0 do 0 i sr! loop ; + +: .xbats ( ibat|dbat -- ) + 4 0 do + dup ibat = if ." I" else ." D" then + i . + i over bat@ if ( pa va len flags ) + rot 9 u.r rot d# 10 u.r swap 9 u.r ( flags ) + binary 2 spaces <# u# u# 2/ ascii . hold u# u# u# u# u#> type hex + else + ." --invalid--" + then + cr + loop + drop +; +headers +: .bats ( -- ) + base @ >r hex + ." # Virtual Physical Length WIMG.PP" cr + ibat .xbats + dbat .xbats + r> base ! +; + +\ LICENSE_BEGIN +\ Copyright (c) 2007 FirmWorks +\ +\ Permission is hereby granted, free of charge, to any person obtaining +\ a copy of this software and associated documentation files (the +\ "Software"), to deal in the Software without restriction, including +\ without limitation the rights to use, copy, modify, merge, publish, +\ distribute, sublicense, and/or sell copies of the Software, and to +\ permit persons to whom the Software is furnished to do so, subject to +\ the following conditions: +\ +\ The above copyright notice and this permission notice shall be +\ included in all copies or substantial portions of the Software. +\ +\ THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, +\ EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF +\ MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND +\ NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE +\ LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION +\ OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION +\ WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. +\ +\ LICENSE_END Added: cpu/ppc/bat601.fth =================================================================== --- cpu/ppc/bat601.fth (rev 0) +++ cpu/ppc/bat601.fth 2007-07-05 17:19:17 UTC (rev 461) @@ -0,0 +1,100 @@ +purpose: Block Address Translation register access for PowerPC 601 +\ See license at end of file + +hex + +\ PPC 601 has a unified cache and a single set of BAT registers, accessed +\ with the SPR numbers used for IBATs + +\ The layout of the 601 BAT bits is different from the standard PPC layout + +: bat!-601 ( pa va len io? bat# which -- ) + drop >r >r >r ( pa va ) ( R: bat# io? len ) + + swap mask-bat-adr \ phys block # ( va PBN ) + r> 1- h# 11 >> or \ block length ( va PBN|BL) ( R: bat# io? ) + h# 40 or \ valid bit ( va bat-lo ) + + swap mask-bat-adr \ log. page index ( bat-lo BLPI ) + \ no cache for I/O, coherent and no protection in both cases + r> if h# 32 else h# 12 then or ( bat-lo bat-hi ) ( R: bat# ) + + r> ibat! +; + +: bat@-601 ( bat# which -- false | pa va len flags true ) + drop ibat@ ( bat-lo bat-hi ) + over h# 40 and 0= if 2drop false exit then ( bat-lo bat-hi ) + over mask-bat-adr ( bat-lo bat-hi pa ) + over mask-bat-adr ( bat-lo bat-hi pa va ) + 2swap swap h# 3f and 1+ h# 11 << ( pa va bat-hi len ) + swap h# 7f and true ( pa va len flags t ) +; + +\ On some processors, the BAT registers can become corrupted if +\ two of them happen to map overlapping ranges, even if address +\ translation is turned off, and that said corruption can be prevented +\ by invalidating all the BAT registers before programming any of them. + +: clear-bats-601 ( -- ) + 4 0 do 0 0 i ibat! loop +; + +: .bats-601 ( -- ) + base @ >r hex + ." # Virtual Physical Length WIMsuPP" cr + 4 0 do + i . + i ibat bat@-601 if ( pa va len flags ) + rot 9 u.r rot d# 10 u.r swap 8 u.r ( flags ) + binary 2 spaces <# u# u# u# u# u# u# u# u#> type hex + else + ." --invalid--" + then + cr + loop + r> base ! +; + +warning @ warning off +\ Overlay standard PowerPC versions with switchable versions +: bat@ ( pa va len io? bat# which -- ) + 601? if bat@-601 exit then + bat@ +; +: bat! ( pa va len io? bat# which -- ) + 601? if bat!-601 exit then + bat! +; +: clear-bats ( -- ) + 601? if clear-bats-601 exit then + clear-bats +; +: .bats ( -- ) + 601? if .bats-601 exit then .bats +; +warning ! + +\ LICENSE_BEGIN +\ Copyright (c) 2007 FirmWorks +\ +\ Permission is hereby granted, free of charge, to any person obtaining +\ a copy of this software and associated documentation files (the +\ "Software"), to deal in the Software without restriction, including +\ without limitation the rights to use, copy, modify, merge, publish, +\ distribute, sublicense, and/or sell copies of the Software, and to +\ permit persons to whom the Software is furnished to do so, subject to +\ the following conditions: +\ +\ The above copyright notice and this permission notice shall be +\ included in all copies or substantial portions of the Software. +\ +\ THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, +\ EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF +\ MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND +\ NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE +\ LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION +\ OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION +\ WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. +\ +\ LICENSE_END Added: cpu/ppc/batf601.fth =================================================================== --- cpu/ppc/batf601.fth (rev 0) +++ cpu/ppc/batf601.fth 2007-07-05 17:19:17 UTC (rev 461) @@ -0,0 +1,184 @@ +purpose: Block address translation (BAT) fault handler +\ See license at end of file + +\ This handler for the DSI interrupt treats the BAT registers +\ as a 4-entry software-filled TLB. 4 BAT registers are not +\ enough to hold all of the translations that the firmware and +\ the client program might need, so we use the BATs as a translation +\ cache. When a translation fault occurs, we pick a BAT register +\ and change its value to translate the address at which the fault +\ occurred. + +\ The 601 BAT registers are not compliant with the PowerPC architecture. +\ The locations of some fields are different, and each 601 BAT can only +\ map 8 MBytes, as opposed to 256 MBytes for PPC BATs. In order to +\ minimize memory usage, and to keep the same mapping granularity +\ between the 601 and PPC, we allow mapping only at 256 MByte granularity, +\ simulating that granularity in software in this implementation by +\ copying logical address bits 4-8 to the physical address. + +\ This allows us to make the mapping table quite small, so it will +\ fit nicely in otherwise-unused space in the trap vector. + +\ Each table entry uses 8 bits - 4 for the physical block number +\ and 4 for the WIMG bits - so we use 8-bit table entries. +\ The other BAT register bits are either fixed values or can be +\ derived from the logical address. + +\ For 601, the BAT registers do not support the "G" bit, so we mask it out. + +\ We use a round-robin replacement policy. + +\ Low memory usage: +\ Firmware private area: +\ e0: save r3 and t1 +\ e4: save lr and t2 +\ e8: save t0 +\ DSI vector: +\ 300.. jump to dsi-handler +\ 37f: next-bat (1 byte) +\ 380: bat-table (16 bytes) + +headerless + +label bat-fault-handler-601 + \ We assume that t0 has been saved at location f8 and now contains + \ the fault address. + + lwz r3,h#e4(r0) \ Restore lr + mtspr lr,r3 + lwz r3,h#e0(r0) \ Restore r3 + + stw t1,h#e0(r0) + stw t2,h#e4(r0) + mfcr t2 + stw t2,h#ec(r0) \ Save CR + +\ [ifdef] notyet +\ \ Determine the fault type +\ mfspr t1,dsisr \ SPR18 +\ add. t1,t1,t1 \ Test bit 1 by shifting it to the sign bit +\ 0>= if \ Not a translation fault +\ \ Restore registers and jump to unexpected exception handler +\ then +\ [then] + + \ Fault address is in t0 + + \ Index into translation table and get translation info + rlwinm t2,t0,4,28,31 \ Convert high 4 bits to a table index + lbz t2,h#380(t2) \ Translation entry in t2 + + \ Format lower BAT entry + rlwinm t1,t2,24,0,3 \ Shift up physical block number + rlwimi t1,t0,0,4,8 \ Merge in bits 4-8 of virtual address + ori t1,t1,h#7f \ valid (40 bit) and 8 MByte size (3f bits) + + \ Format upper BAT entry + + rlwinm t0,t0,0,0,8 \ Mask out lower bits, leaving page index + rlwimi t0,t2,3,25,27 \ Shift WIMG bits into place, masking out G + ori t0,t0,2 \ Allow all accesses + + lbz t2,h#37f(r0) \ Select a BAT + + \ Replace BAT value + \ On average, it takes more instructions to do an indexed jump + \ than to do explicit compares for this number of cases. + + cmpi 0,0,t2,0 + = if + sync isync + mtspr ibat0u,t0 + mtspr ibat0l,t1 + sync isync + set t2,1 + else + + cmpi 0,0,t2,1 + = if + sync isync + mtspr ibat1u,t0 + mtspr ibat1l,t1 + sync isync + set t2,2 + else + + cmpi 0,0,t2,2 + = if + sync isync + mtspr ibat2u,t0 + mtspr ibat2l,t1 + sync isync + set t2,3 + else + + sync isync + mtspr ibat3u,t0 + mtspr ibat3l,t1 + sync isync + set t2,0 + then then then + + stb t2,h#37f(r0) \ Update BAT replacement pointer + + + \ Restore registers + lwz t0,h#ec(r0) + mtcrf h#ff,t0 \ Restore CR + lwz t0,h#e8(r0) \ Restore t0 + lwz t1,h#e0(r0) \ Restore t1 + lwz t2,h#e4(r0 \ Restore t2 + + \ Return from interrupt + rfi +end-code + +label bat-dsi-handler-601 + stw t0,h#e8(r0) \ Save t0 in the exception table area + mfspr t0,dar \ Get fault address + bat-fault-handler-601 again \ Jump to common code +end-code + +label bat-isi-handler-601 + stw t0,h#e8(r0) \ Save t0 in the exception table area + mfspr t0,srr0 \ Get fault address + bat-fault-handler-601 again \ Jump to common code +end-code + +: install-bat-handler-601 ( -- ) + init-paged-mmu + + bat-dsi-handler-601 h# 300 put-exception + bat-isi-handler-601 h# 400 put-exception +; +warning @ warning off +: install-bat-handler ( -- ) + 601? if install-bat-handler-601 exit then + install-bat-handler +; +warning ! + +\ LICENSE_BEGIN +\ Copyright (c) 2007 FirmWorks +\ +\ Permission is hereby granted, free of charge, to any person obtaining +\ a copy of this software and associated documentation files (the +\ "Software"), to deal in the Software without restriction, including +\ without limitation the rights to use, copy, modify, merge, publish, +\ distribute, sublicense, and/or sell copies of the Software, and to +\ permit persons to whom the Software is furnished to do so, subject to +\ the following conditions: +\ +\ The above copyright notice and this permission notice shall be +\ included in all copies or substantial portions of the Software. +\ +\ THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, +\ EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF +\ MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND +\ NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE +\ LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION +\ OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION +\ WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. +\ +\ LICENSE_END Added: cpu/ppc/batfault.fth =================================================================== --- cpu/ppc/batfault.fth (rev 0) +++ cpu/ppc/batfault.fth 2007-07-05 17:19:17 UTC (rev 461) @@ -0,0 +1,321 @@ +purpose: Block address translation (BAT) fault handler +\ See license at end of file + +\ This handler for the DSI interrupt treats the BAT registers +\ as a 4-entry software-filled TLB. 4 BAT registers are not +\ enough to hold all of the translations that the firmware and +\ the client program might need, so we use the BATs as a translation +\ cache. When a translation fault occurs, we pick a BAT register +\ and change its value to translate the address at which the fault +\ occurred. + +\ For simplicity, we use a fixed block size. For memory economy, +\ we use the largest possible block size (256 MBytes), thus requiring +\ a 16-entry in-memory translation table indexed by the high 4 bits +\ of the logical address. + +\ Each table entry uses 8 bits - 4 for the physical block number +\ and 4 for the WIMG bits - so we use 8-bit table entries. +\ The other BAT register bits are either fixed values or can be +\ derived from the logical address. + +\ We use a round-robin replacement policy. + +\ We store the translation table in the DSI handler vector area so +\ it is easy to access from the fault handlers. + +h# 300 /exc + constant bat-table +bat-table h# 10 + constant 'next-bat +\ /exc h# 18 + constant /dsi-footprint + +\ On entry: +\ r2, r3, and lr have been saved. r2 points to this cpu's exception-area, + +\ Low memory usage: +\ Firmware private area: +\ 0: save r3 and t1 +\ 4: save r2 +\ 8: save lr and t2 +\ c: save t0 +\ 10: save cr +\ DSI vector: +\ 300.. jump to dsi-handler +\ 3x0: bat-table (16 bytes) +\ 3y0: next-bat (1 byte) + +\ Note: next-bat should be cpu specific: 3yc ? + +label bat-dsi-handler + mfcr r3 + stw r3,h#10(r2) \ Save CR + + \ Determine the fault type + mfspr r3,dsisr \ SPR18 + rlwinm. r3,r3,0,1,1 \ Test bit 1 + 0= if \ Not a translation fault +( Label ) begin but + \ Restore registers and jump to unexpected exception handler + lwz r3,h#10(r2) + mtcrf h#ff,r3 \ Restore CR + addi r3,r0,h#300 \ Exception address +\ XXX we need to jump to the physical address of save-state + save-state b * \ branch to exception handler + then + + mfspr r3,dar \ Get fault address + rlwinm r3,r3,4,28,31 \ Convert high 4 bits to a table index + lbz r3,h#380(r3) \ Translation entry in t2 + cmpi 0,0,r3,0 + <> until \ Jump back to Label if no translation + + lwz r3,h#08(r2) \ Restore lr + mtspr lr,r3 + + stw t0,h#0c(r2) \ Save t0 in the exception table area + stw t2,h#08(r2) \ Save t2 + + mfspr t0,dar \ Get fault address + + \ Index into translation table and get translation info + rlwinm t2,t0,4,28,31 \ Convert high 4 bits to a table index + lbz t2,h#380(t2) \ Translation entry in t2 + + \ Format Upper BAT entry + rlwinm t0,t0,0,0,3 \ Mask out lower bits, leaving page index + ori t0,t0,h#1ffe \ 256M block size, supervisor mode + + \ Format Lower BAT entry + rlwinm r3,t2,24,0,3 \ Shift up physical block number + rlwimi r3,t2,3,25,28 \ Shift WIMG bits into place + ori r3,r3,2 \ Allow all accesses + + lbz t2,h#37f(r0) \ Select a BAT + + \ Replace BAT value + \ On average, it takes more instructions to do an indexed jump + \ than to do explicit compares for this number of cases. + + cmpi 0,0,t2,0 = if + sync isync mtspr dbat0u,t0 mtspr dbat0l,r3 sync isync + set t2,1 + else + + cmpi 0,0,t2,1 = if + sync isync mtspr dbat1u,t0 mtspr dbat1l,r3 sync isync + set t2,2 + else + +[ifdef] NTkludge + \ Some earlier NT HALs have a bug that causes them to hang + \ if the KSEG0 (virt 8000.0000 -> phys 0) mapping resides in + \ IBAT3, so to be safe, we avoid using either IBAT3 or DBAT3. + sync isync mtspr dbat2u,t0 mtspr dbat2l,r3 sync isync + set t2,0 + then then +[else] + cmpi 0,0,t2,2 = if + sync isync mtspr dbat2u,t0 mtspr dbat2l,r3 sync isync + set t2,3 + else + sync isync mtspr dbat3u,t0 mtspr dbat3l,r3 sync isync + set t2,0 + then then then +[then] + + stb t2,h#37f(r0) \ Update BAT replacement pointer + + \ Restore registers + lwz t0,h#10(r2) + mtcrf h#ff,t0 \ Restore CR + lwz t0,h#0c(r2) \ Restore t0 + lwz r3,h#00(r2) \ Restore r3 + lwz t2,h#08(r2) \ Restore t2 + lwz r2,h#04(r2) \ Restore r2 + + \ Return from interrupt + rfi +end-code + +label bat-isi-handler + mfcr r3 + stw r3,h#10(r2) \ Save CR + + \ In violation of the PowerPC architecture definition, the 603 does + \ not implement the translation fault bit for instruction accesses, + \ so we assume that any 603 instruction fault is a translation fault. + \ This is tolerable because instruction accesses to non-existent devices + \ do not occur on purpose - probing to determine the presence of devices + \ is done with data accesses. + +\ However, the 603 ISI exception is front-ended by the ITLB miss handler, +\ in which we set the translation fault bit. + +\ mfspr r3,pvr +\ rlwinm r3,r3,16,16,31 +\ cmpi 0,0,r3,3 +\ 0<> if + + \ Determine the fault type + mfspr r3,srr1 \ Fault type is in SRR1 for I faults + rlwinm. r3,r3,0,1,1 \ Test bit 1 + 0= if \ Not a translation fault +( Label ) begin but + \ Restore registers and jump to unexpected exception handler + lwz r3,h#10(r2) + mtcrf h#ff,r3 \ Restore CR + addi r3,r0,h#400 \ Exception address + save-state b * \ branch to exception handler + then +\ then + + mfspr r3,srr0 \ Get fault address + rlwinm r3,r3,4,28,31 \ Convert high 4 bits to a table index + lbz r3,h#380(r3) \ Translation entry in t2 + cmpi 0,0,r3,0 + <> until \ Jump back to Label if no translation + + lwz r3,h#08(r2) \ Restore lr + mtspr lr,r3 + + stw t0,h#0c(r2) \ Save t0 in the exception table area + stw t2,h#08(r2) \ Save t2 + + mfspr t0,srr0 \ Get fault address + + \ Index into translation table and get translation info + rlwinm t2,t0,4,28,31 \ Convert high 4 bits to a table index + lbz t2,h#380(t2) \ Translation entry in t2 + + \ Format Upper BAT entry + rlwinm t0,t0,0,0,3 \ Mask out lower bits, leaving page index + ori t0,t0,h#1ffe \ 256M block size, supervisor mode + + \ Format Lower BAT entry + rlwinm r3,t2,24,0,3 \ Shift up physical block number + rlwimi r3,t2,3,25,27 \ Shift WIM bits into place, masking off G + ori r3,r3,2 \ Allow all accesses + + lbz t2,h#37f(r0) \ Select a BAT + + \ Replace BAT value + \ On average, it takes more instructions to do an indexed jump + \ than to do explicit compares for this number of cases. + + cmpi 0,0,t2,0 = if + sync isync mtspr ibat0u,t0 mtspr ibat0l,r3 sync isync + set t2,1 + else + + cmpi 0,0,t2,1 = if + sync isync mtspr ibat1u,t0 mtspr ibat1l,r3 sync isync + set t2,2 + else + + cmpi 0,0,t2,2 = if + sync isync mtspr ibat2u,t0 mtspr ibat2l,r3 sync isync + set t2,3 + else + sync isync mtspr ibat3u,t0 mtspr ibat3l,r3 sync isync + set t2,0 + then then then + + stb t2,h#37f(r0) \ Update BAT replacement pointer + + \ Restore registers + lwz t0,h#10(r2) + mtcrf h#ff,t0 \ Restore CR + lwz t0,h#0c(r2) \ Restore t0 + lwz r3,h#00(r2) \ Restore r3 + lwz t2,h#08(r2) \ Restore t2 + lwz r2,h#04(r2) \ Restore r2 + + \ Return from interrupt + rfi +end-code + +label tlb-miss-template \ 603-specific + mfspr r3,srr1 + set r2,h#40000000 \ Translation fault bit + rlwinm. r1,r3,0,13,13 + 0<> if \ Itlb + mtcrf h#80,r3 \ Restore Condition Register + or r3,r3,r2 \ Set instruction translation fault bit + mtspr srr1,r3 \ .. in SRR1 + else + mtcrf h#80,r3 \ Restore Condition Register + mtspr dsisr,r2 \ Set data translation fault bit + mfspr r2,dmiss \ Put the miss address + mtspr dar,r2 \ in the data address register + then + + mfmsr r3 + rlwinm r3,r3,0,15,13 \ Clear TGPR bit to reveal real registers + mtmsr r3 +end-code +here tlb-miss-template - constant /miss + +/miss la1+ to /rm-tlbmiss + +: put-tlb-miss-entry ( entry-vector target-vector -- ) + swap + tlb-miss-template /miss bounds ?do ( target-vector entry-vector ) + i l@ over instruction! la1+ + /l +loop ( target-vector entry-vector' ) + put-branch +; + +code invalidate-tlbs ( #entries -- ) + sync isync + + rlwinm tos,tos,12,0,19 + + begin + addic. tos,tos,h#-1000 + tlbie tos + 0= until + + tlbsync + + lwz tos,0(sp) + addi sp,sp,1cell +c; + +: install-bat-handler ( -- ) + init-paged-mmu + + bat-dsi-handler h# 300 put-exception + bat-isi-handler h# 400 put-exception + + software-tlb-miss? if + h# 1000 h# 400 put-tlb-miss-entry \ Instruction fetch TLB miss + h# 1100 h# 300 put-tlb-miss-entry \ Data load TLB + h# 1200 h# 300 put-tlb-miss-entry \ Data store TLB + else + then + + configure-tlb #tlb-lines invalidate-tlbs +; + +\ LICENSE_BEGIN +\ Copyright (c) 2007 FirmWorks +\ +\ Permission is hereby granted, free of charge, to any person obtaining +\ a copy of this software and associated documentation files (the +\ "Software"), to deal in the Software without restriction, including +\ without limitation the rights to use, copy, modify, merge, publish, +\ distribute, sublicense, and/or sell copies of the Software, and to +\ permit persons to whom the Software is furnished to do so, subject to +\ the following conditions: +\ +\ The above copyright notice and this permission notice shall be +\ included in all copies or substantial portions of the Software. +\ +\ THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, +\ EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF +\ MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND +\ NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE +\ LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION +\ OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION +\ WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. +\ +\ LICENSE_END Added: cpu/ppc/batmap.fth =================================================================== --- cpu/ppc/batmap.fth (rev 0) +++ cpu/ppc/batmap.fth 2007-07-05 17:19:17 UTC (rev 461) @@ -0,0 +1,57 @@ +purpose: Block address translation (BAT) mapping setup +\ See license at end of file + +\ This code's data structures are shared with the low-level code +\ in batfault.fth and batf601.fth . See those files for a description. + +: >bat-map ( va -- adr ) h# 380 swap d# 28 rshift ca+ ; +: bat-invalid ( va -- ) 0 swap >bat-map c! ; +: bat-mapping ( va -- false | pa wim true ) + >bat-map c@ dup if dup 4 >> d# 28 << swap h# f and true then +; +: bat-set ( pa wimg va -- ) + -rot swap d# 28 rshift d# 4 lshift or ( va bte ) + swap >bat-map c! +; +: bat-map ( pa io? va -- ) + \ WIM bits - don't cache,coherent,guarded for I/O, coherent for memory + -rot if 7 else 2 then rot ( pa WIMG va ) + bat-set +; +h# 1000.0000 constant /bat-region +: clear-bat-table ( -- ) + 0 h# 37f c! \ bat entry 0 is next in line for replacement + + \ Invalidate all entries in the bat translation table + 0 0 do i bat-invalid /bat-region +loop +; +: setup-real-bat-table ( -- ) + 0 h# 37f c! \ bat entry 0 is next in line for replacement + + \ map first half of address space cacheable, rest non-cacheable. + 0 0 do i i 0< i bat-map /bat-region +loop +; + +\ LICENSE_BEGIN +\ Copyright (c) 2007 FirmWorks +\ +\ Permission is hereby granted, free of charge, to any person obtaining +\ a copy of this software and associated documentation files (the +\ "Software"), to deal in the Software without restriction, including +\ without limitation the rights to use, copy, modify, merge, publish, +\ distribute, sublicense, and/or sell copies of the Software, and to +\ permit persons to whom the Software is furnished to do so, subject to +\ the following conditions: +\ +\ The above copyright notice and this permission notice shall be +\ included in all copies or substantial portions of the Software. +\ +\ THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, +\ EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF +\ MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND +\ NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE +\ LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION +\ OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION +\ WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. +\ +\ LICENSE_END Added: cpu/ppc/boot.fth =================================================================== --- cpu/ppc/boot.fth (rev 0) +++ cpu/ppc/boot.fth 2007-07-05 17:19:17 UTC (rev 461) @@ -0,0 +1,183 @@ +purpose: Boot code (cold and warm start) for PowerPC +\ See license at end of file + +\ Version for running Forth underneath a "wrapper" program + +\ The cold start code is executed when Forth is initially started. +\ Its job is to initialize the Forth virtual machine registers. +\ The warm start code is executed when Forth is re-entered, +\ perhaps as a result of an exception. + +hex + +only forth also labels also meta also definitions + +0 constant main-task +: init-user (s -- ) +; + +\ Stuff initialized at cold start time + +nuser memtop \ The top of the memory used by Forth +0 value #args \ The process's argument count +0 value args \ The process's argument list + +\ Defining these two in code is a significant performance optimization +\ for Open Firmware +code package( ( ihandle -- ) + 'user my-self lwz t0,* + stwu t0,-1cell(rp) + 'user my-self stw tos,* + pop-tos +c; +code )package ( -- ) + lwz t0,0(rp) + rdrop + 'user my-self stw t0,* +c; + +headerless + +label cold-code ( -- ) + +\ called with forth_startup(header-adr, functions, mem_end, &gargc, &gargv) +\ r3 r4 r5 r6 r7 + +\ Get some registers + \ XXX should save registers + +\ here origin - . cr + + nop + +\ Find the base address + here-t 4 + bl * \ Absolute address of next instruction + here-t set base,* \ Relative address of this instruction + mfspr t0,lr + subfc base,base,t0 \ Base address of Forth kernel + \ ( Use subfc for POWER compatibility) + \ Synchronize caches + addi t1,r5,31 \ round end address up ... + rlwinm t1,t1,0,0,26 \ ... to next cache line boundary + + sync isync + + begin + addi t1,t1,-32 cmpl 0,0,t1,r3 \ Down one cache line + dcbst r0,t1 sync isync icbi r0,t1 \ Synchronize it + <= until + + sync isync + +\ Find the user area size from the header + lwz t1,4(r3) \ Text size = offset to start of data + lwz t0,8(r3) \ Data size = user area size in t4 + + mr t5,r5 \ We'll need this later for memtop + +\ Allocate high memory for the stacks and stuff, starting at memtop and +\ allocating downwards. r5 is the allocation pointer. + +\ Allocate the RAM copy of the User Area + subfc r5,t0,r5 \ ( Use subfc for POWER compatibility) + rlwinm r5,r5,0,0,26 \ cache-line-align by clearing 5 low bits + mr up,r5 \ Set user pointer + + 'body main-task set t2,* \ Allow the exception handler to find the + \ user area by storing the address of the + stwx up,base,t2 \ main user area in the "constant" main-task + + \ Copy the initial User Area image to the RAM copy + add t3,t1,base \ Init-up pointer in t3 + mr t2,up \ Destination pointer + + srawi t0,t0,2 + mtspr ctr,t0 + addi t3,t3,-4 \ Account for pre-incrementing + addi t2,t2,-4 \ Account for pre-incrementing + begin + lwzu t0,4(t3) + stwu t0,4(t2) + countdown + +\ Synchronize the caches in the "next" region + sync isync dcbst r0,up sync isync icbi r0,up sync isync + + 'user powerpc? stw r8,* \ Set the PowerPC flag + +\ Now the user area has been copied to the proper place, so we can set +\ some important user variables whose initial values are determined at +\ run time. + +\ Top of memory and dictionary limit + 'user memtop stw t5,* + +\ Set the up0 user variable + 'user up0 stw up,* + +\ Establish the return stack and set the rp0 user variable + mr rp,r5 \ Set rp + 'user rp0 stw rp,* + rs-size-t negate addi r5,r5,* \ allocate space for the return stack + +\ Establish the Parameter Stack + 'user sp0 stw r5,* + addi sp,r5,4 \ account for the top of stack register + + ps-size-t negate addi r5,r5,* \ Allocate the stuff on the stack + + 'user limit stw r5,* \ Top of dictionary growth area + +\ Set the dictionary pointer + add t1,t1,base \ Base + text size + 'user dp stw t1,* \ Set dp + +\ Save the address of the system call table in the user variable syscall-vec + 'user syscall-vec stw r4,* + +\ Set the value of #args and args + 'user #args stw r6,* + 'user args stw r7,* + +\ Set the next pointer + mtspr ctr,up + +\ Enter Forth + 'body cold 4 - set ip,* + add ip,ip,base +c; + +headers + +[ifdef] little-endian-under-simulator +: sys-init-io + sys-init-io + ['] default-type is (type + ['] dumb-expect is expect + ['] lf-pstr is newline-pstring +; +[then] + +\ LICENSE_BEGIN +\ Copyright (c) 2007 FirmWorks +\ +\ Permission is hereby granted, free of charge, to any person obtaining +\ a copy of this software and associated documentation files (the +\ "Software"), to deal in the Software without restriction, including +\ without limitation the rights to use, copy, modify, merge, publish, +\ distribute, sublicense, and/or sell copies of the Software, and to +\ permit persons to whom the Software is furnished to do so, subject to +\ the following conditions: +\ +\ The above copyright notice and this permission notice shall be +\ included in all copies or substantial portions of the Software. +\ +\ THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, +\ EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF +\ MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND +\ NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE +\ LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION +\ OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION +\ WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. +\ +\ LICENSE_END Added: cpu/ppc/builder.bth =================================================================== --- cpu/ppc/builder.bth (rev 0) +++ cpu/ppc/builder.bth 2007-07-05 17:19:17 UTC (rev 461) @@ -0,0 +1,35 @@ +purpose: Build file for PowerPC builder +\ See license at end of file + +dictionary: ${BP}/cpu/ppc/build/tools.dic +command: &ppcforth &dictionary &this +build-now + +fload ${BP}/ofw/tokenizer/tokenize.fth +fload ${BP}/forth/lib/builder.fth + +.( --- Saving builder.dic --- ) cr "" builder.dic save-forth + +\ LICENSE_BEGIN +\ Copyright (c) 2007 FirmWorks +\ +\ Permission is hereby granted, free of charge, to any person obtaining +\ a copy of this software and associated documentation files (the +\ "Software"), to deal in the Software without restriction, including +\ without limitation the rights to use, copy, modify, merge, publish, +\ distribute, sublicense, and/or sell copies of the Software, and to +\ permit persons to whom the Software is furnished to do so, subject to +\ the following conditions: +\ +\ The above copyright notice and this permission notice shall be +\ included in all copies or substantial portions of the Software. +\ +\ THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, +\ EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF +\ MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND +\ NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE +\ LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION +\ OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION +\ WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. +\ +\ LICENSE_END Added: cpu/ppc/cache601.fth =================================================================== --- cpu/ppc/cache601.fth (rev 0) +++ cpu/ppc/cache601.fth 2007-07-05 17:19:17 UTC (rev 461) @@ -0,0 +1,53 @@ +purpose: Cache driver for PowerPC 601 chip +\ See license at end of file + +code stand-sync-cache-601 ( adr len -- ) + lwz t0,0(sp) + + cmpi 0,0,t0,0 + <> if + addi tos,tos,-1 \ Prevents touching the line past the end + begin + dcbst t0,tos + sync + icbi t0,tos + isync + addic. tos,tos,-32 + 0< until + sync + then + + lwz tos,1cell(sp) + addi sp,sp,2cells +c; + +warning @ warning off +: stand-init ( -- ) + stand-init + 601? if ['] stand-sync-cache-601 to sync-cache then +; +warning ! + +\ LICENSE_BEGIN +\ Copyright (c) 2007 FirmWorks +\ +\ Permission is hereby granted, free of charge, to any person obtaining +\ a copy of this software and associated documentation files (the +\ "Software"), to deal in the Software without restriction, including +\ without limitation the rights to use, copy, modify, merge, publish, +\ distribute, sublicense, and/or sell copies of the Software, and to +\ permit persons to whom the Software is furnished to do so, subject to +\ the following conditions: +\ +\ The above copyright notice and this permission notice shall be +\ included in all copies or substantial portions of the Software. +\ +\ THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, +\ EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF +\ MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND +\ NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE +\ LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION +\ OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION +\ WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. +\ +\ LICENSE_END Added: cpu/ppc/cache603.fth =================================================================== --- cpu/ppc/cache603.fth (rev 0) +++ cpu/ppc/cache603.fth 2007-07-05 17:19:17 UTC (rev 461) @@ -0,0 +1,233 @@ +purpose: Cache driver for 603 PowerPC chip +\ See license at end of file + +\ XXX - Dcache size is 1MB for Pegakid, because L2 cache is always on. +\ Fix this! Maybe parameterize /dcache? + +headerless +d# 32 constant /dcache-block +d# 32 constant /icache-block + +code (603-dcache-off) ( -- ) + \ Don't do anything if the data cache is already off + mfspr t1,hid0 + andi. t1,t1,h#4000 + 0= if + next + then + + \ Disable data translations before the flush loop: we'll run + \ in real mode to make sure there are no mapping problems. + mfmsr t2 + rlwinm t1,t2,0,28,26 \ Disable translation by clearing h#10 bit + sync isync + mtmsr t1 + sync isync + + \ Flush Dcache before turning it off + set t1,h#10.0000 \ Fill Dcache with known addresses + begin + addic. t1,t1,-32 + lwz r0,0(t1) + = until + + set t1,h#10.0000 \ Size of dcache + begin + addic. t1,t1,-32 \ Size of cache line + dcbf r0,t1 \ Flush Dcache line + = until + sync + + isync + mtmsr t2 \ Restore original MSR + sync isync + mfspr t0,hid0 \ Old HID0 value + rlwinm t0,t0,0,18,16 \ Disable cache by clearing h#4000 bit + isync + mtspr hid0,t0 + isync +c; +headers +: 603-dcache-off ( -- ) lock[ (603-dcache-off) ]unlock ; +defer dcache-off ' 603-dcache-off to dcache-off +headerless + +\ Warning: it is tempting to subtract one from the length, so that it refers +\ to the last byte in the range, and then decrement the index inside the loop. +\ However, that doesn't work because some PowerPC processors (e.g 604), when +\ in little-endian mode, do not appear to perform the following cache +\ operations properly when the effective address is unaligned. This was +\ determined empirically. + +code invalidate-603-i$-range ( adr len -- ) + mr t2,tos + lwz t0,0(sp) + lwz tos,1cell(sp) + addi sp,sp,2cells + + \ Don't touch the cache if it's off + mfspr t1,hid0 + andi. t1,t1,h#8000 + 0<> if + add t0,t0,t2 \ Bias the base so we can increment the index + neg. t2,t2 \ Bias the index + ahead begin + icbi t0,t2 + addic. t2,t2,32 + but then 0>= until + sync + then +c; +defer invalidate-i$-range ' invalidate-603-i$-range to invalidate-i$-range + +code flush-603-d$-range ( adr len -- ) + mr t2,tos + lwz t0,0(sp) + lwz tos,1cell(sp) + addi sp,sp,2cells + + \ Don't touch the cache if it's off + mfspr t1,hid0 + andi. t1,t1,h#4000 + 0<> if + add t0,t0,t2 \ Bias the base so we can increment the index + neg. t2,t2 \ Bias the index + ahead begin + dcbf t0,t2 + addic. t2,t2,32 + but then 0>= until + sync + then +c; +headers +defer flush-d$-range ' flush-603-d$-range to flush-d$-range +headerless + +code invalidate-603-d$-range ( adr len -- ) + mr t2,tos + lwz t0,0(sp) + lwz tos,1cell(sp) + addi sp,sp,2cells + + \ Don't touch the cache if it's off + mfspr t1,hid0 + andi. t1,t1,h#4000 + 0<> if + add t0,t0,t2 \ Bias the base so we can increment the index + neg. t2,t2 \ Bias the index + ahead begin + dcbi t0,t2 + addic. t2,t2,32 + but then 0>= until + sync + then +c; +defer invalidate-d$-range ' invalidate-603-d$-range to invalidate-d$-range + +code store-603-d$-range ( adr len -- ) + mr t2,tos + lwz t0,0(sp) + lwz tos,1cell(sp) + addi sp,sp,2cells + + \ Don't touch the cache if it's off + mfspr t1,hid0 + andi. t1,t1,h#4000 + 0<> if + add t0,t0,t2 \ Bias the base so we can increment the index + neg. t2,t2 \ Bias the index + ahead begin + dcbst t0,t2 + addic. t2,t2,32 + but then 0>= until + sync + then +c; +defer store-d$-range ' store-603-d$-range to store-d$-range + +: stand-sync-cache ( adr len -- adr ) + 2dup store-d$-range invalidate-i$-range +; + +defer invalidate-icache ' noop to invalidate-icache + +: invalidate-603-icache ( -- ) hid0@ dup h# 800 or hid0! hid0! ; +: invalidate-604-icache ( -- ) hid0@ h# 800 or hid0! ; + +headers +: 603-icache-on ( -- ) + \ Bail out if it's already on, to avoid causing inconsistencies + \ with L2 caches during invalidation. + hid0@ h# 8000 and if exit then + + hid0@ + sticky-cache-invalidate? if + h# 800 or dup hid0! \ Flush + h# 8000 or dup hid0! \ Turn on + h# 800 invert and hid0! \ Release flush bit + ['] invalidate-603-icache + else \ 604 + h# 8800 or hid0! \ turn on and invalidate + ['] invalidate-604-icache + then + to invalidate-icache +; +defer icache-on ' 603-icache-on to icache-on + +: 603-icache-off ( -- ) + hid0@ h# 800 or h# 8000 invert and hid0! + ['] noop to invalidate-icache +; +defer icache-off ' 603-icache-off to icache-off + +headerless +: 603-dcache-on? ( -- flag ) hid0@ h# 4000 and 0<> ; +: 603-icache-on? ( -- flag ) hid0@ h# 8000 and 0<> ; +defer dcache-on? ' 603-dcache-on? to dcache-on? +defer icache-on? ' 603-icache-on? to icache-on? + +headers +: 603-dcache-on ( -- ) + \ Bail out if it's already on, to avoid causing inconsistencies + \ with L2 caches during invalidation. + dcache-on? if exit then + + hid0@ + sticky-cache-invalidate? if + h# 400 or dup hid0! \ Invalidate + h# 4000 or dup hid0! \ Turn on + h# 400 invert and hid0! \ Release flush bit + else + h# 4400 or hid0! \ Invalidate and turn on + then +; +defer dcache-on ' 603-dcache-on to dcache-on + +\ Do this early so that the debugger will work as early as possible +: stand-init-io ( -- ) stand-init-io + ['] stand-sync-cache to sync-cache +; + +\ LICENSE_BEGIN +\ Copyright (c) 2007 FirmWorks +\ +\ Permission is hereby granted, free of charge, to any person obtaining +\ a copy of this software and associated documentation files (the +\ "Software"), to deal in the Software without restriction, including +\ without limitation the rights to use, copy, modify, merge, publish, +\ distribute, sublicense, and/or sell copies of the Software, and to +\ permit persons to whom the Software is furnished to do so, subject to +\ the following conditions: +\ +\ The above copyright notice and this permission notice shall be +\ included in all copies or substantial portions of the Software. +\ +\ THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, +\ EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF +\ MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND +\ NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE +\ LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION +\ OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION +\ WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. +\ +\ LICENSE_END Added: cpu/ppc/cache823.fth =================================================================== --- cpu/ppc/cache823.fth (rev 0) +++ cpu/ppc/cache823.fth 2007-07-05 17:19:17 UTC (rev 461) @@ -0,0 +1,241 @@ +purpose: Cache driver for 823 PowerPC chip +\ See license at end of file + +headerless +d# 16 constant /dcache-block +d# 16 constant /icache-block + +code (823-dcache-off) ( -- ) + \ Don't do anything if the data cache is already off + mfspr t1,dc-csr + andis. t1,t1,h#8000 + 0= if + next + then + + \ Disable data translations before the flush loop: we'll run + \ in real mode to make sure there are no mapping problems. + mfmsr t2 + rlwinm t1,t2,0,28,26 \ Disable translation by clearing h#10 bit + sync isync + mtmsr t1 + sync isync + + \ Unlock Dcache + set t1,h#0a00.0000 + sync + mtspr dc-csr,t1 + + \ Flush Dcache before turning it off + set t1,h#400 \ Fill Dcache with known addresses + begin + addic. t1,t1,-16 + lwz r0,0(t1) + = until + + set t1,h#400 \ Size of dcache + begin + addic. t1,t1,-16 \ Size of cache line + dcbf r0,t1 \ Flush Dcache line + = until + sync + + isync + mtmsr t2 \ Restore original MSR + set t1,h#0400.0000 + sync + mtspr dc-csr,t1 \ Disable Dcache + isync +c; +headers +: 823-dcache-off ( -- ) lock[ (823-dcache-off) ]unlock ; +defer dcache-off ' 823-dcache-off to dcache-off +headerless + +\ Warning: it is tempting to subtract one from the length, so that it refers +\ to the last byte in the range, and then decrement the index inside the loop. +\ However, that doesn't work because some PowerPC processors (e.g 604), when +\ in little-endian mode, do not appear to perform the following cache +\ operations properly when the effective address is unaligned. This was +\ determined empirically. + +code invalidate-823-i$-range ( adr len -- ) + mr t2,tos \ len in t2 + lwz t3,0(sp) \ adr in t3 + lwz tos,1cell(sp) + addi sp,sp,2cells + + \ Don't touch the cache if it's off + mfspr t1,ic-csr + andis. t1,t1,h#8000 + 0<> if + \ Expand the range to include all affected cache lines + add t0,t3,t2 \ End of range + addi t0,t0,15 \ Round end address up .. + rlwinm t0,t0,0,0,27 \ .. to cache line boundary + rlwinm t3,t3,0,0,27 \ Round start address down + subf. t2,t0,t3 \ Negative of length of expanded range + + ahead begin + icbi t0,t2 + addic. t2,t2,16 + but then 0>= until + sync + then +c; +defer invalidate-i$-range ' invalidate-823-i$-range to invalidate-i$-range + +code flush-823-d$-range ( adr len -- ) + mr t2,tos \ len in t2 + lwz t3,0(sp) \ adr in t3 + lwz tos,1cell(sp) + addi sp,sp,2cells + + \ Don't touch the cache if it's off + mfspr t1,dc-csr + andis. t1,t1,h#8000 + 0<> if + \ Expand the range to include all affected cache lines + add t0,t3,t2 \ End of range + addi t0,t0,15 \ Round end address up .. + rlwinm t0,t0,0,0,27 \ .. to cache line boundary + rlwinm t3,t3,0,0,27 \ Round start address down + subf. t2,t0,t3 \ Negative of length of expanded range + + ahead begin + dcbf t0,t2 + addic. t2,t2,16 + but then 0>= until + sync + then +c; +headers +defer flush-d$-range ' flush-823-d$-range to flush-d$-range +headerless + +code invalidate-823-d$-range ( adr len -- ) + mr t2,tos \ len in t2 + lwz t3,0(sp) \ adr in t3 + lwz tos,1cell(sp) + addi sp,sp,2cells + + \ Don't touch the cache if it's off + mfspr t1,dc-csr + andis. t1,t1,h#8000 + 0<> if + \ Expand the range to include all affected cache lines + add t0,t3,t2 \ End of range + addi t0,t0,15 \ Round end address up .. + rlwinm t0,t0,0,0,27 \ .. to cache line boundary + rlwinm t3,t3,0,0,27 \ Round start address down + subf. t2,t0,t3 \ Negative of length of expanded range + + ahead begin + dcbi t0,t2 + addic. t2,t2,16 + but then 0>= until + sync + then +c; +defer invalidate-d$-range ' invalidate-823-d$-range to invalidate-d$-range + +code store-823-d$-range ( adr len -- ) + mr t2,tos \ len in t2 + lwz t3,0(sp) \ adr in t3 + lwz tos,1cell(sp) + addi sp,sp,2cells + + \ Don't touch the cache if it's off + mfspr t1,dc-csr + andis. t1,t1,h#8000 + 0<> if + \ Expand the range to include all affected cache lines + add t0,t3,t2 \ End of range + addi t0,t0,15 \ Round end address up .. + rlwinm t0,t0,0,0,27 \ .. to cache line boundary + rlwinm t3,t3,0,0,27 \ Round start address down + subf. t2,t0,t3 \ Negative of length of expanded range + + ahead begin + dcbst t0,t2 + addic. t2,t2,16 + but then 0>= until + sync + then +c; +defer store-d$-range ' store-823-d$-range to store-d$-range + +: stand-sync-cache ( adr len -- adr ) + 2dup store-d$-range invalidate-i$-range +; + +: invalidate-823-icache ( -- ) + h# 0a00.0000 ic-csr! \ Unlock all + h# 0e00.0000 ic-csr! \ Invalidate all +; +defer invalidate-icache ' noop to invalidate-icache + +headerless +: 823-dcache-on? ( -- flag ) dc-csr@ h# 8000.0000 and ; +: 823-icache-on? ( -- flag ) ic-csr@ h# 8000.0000 and ; +defer dcache-on? ' 823-dcache-on? to dcache-on? +defer icache-on? ' 823-icache-on? to icache-on? + +headers +: 823-icache-on ( -- ) + \ Bail out if it's already on, to avoid causing inconsistencies + \ with L2 caches during invalidation. + 823-icache-on? if exit then + + invalidate-823-icache \ Unlock and invalidate Icache + h# 0200.0000 ic-csr! \ Enable Icache + ['] invalidate-823-icache to invalidate-icache +; +defer icache-on ' 823-icache-on to icache-on + +: 823-icache-off ( -- ) + h# 0400.0000 ic-csr! \ Disable Icache + ['] noop to invalidate-icache +; +defer icache-off ' 823-icache-off to icache-off + +headers +: 823-dcache-on ( -- ) + \ Bail out if it's already on, to avoid causing inconsistencies + \ with L2 caches during invalidation. + dcache-on? if exit then + + h# 0a00.0000 dc-csr! \ Unlock all + h# 0c00.0000 dc-csr! \ Invalidate all + h# 0200.0000 dc-csr! \ Enable Dcache +; +defer dcache-on ' 823-dcache-on to dcache-on + +\ Do this early so that the debugger will work as early as possible +: stand-init-io ( -- ) stand-init-io + ['] stand-sync-cache to sync-cache +; + +\ LICENSE_BEGIN +\ Copyright (c) 2007 FirmWorks +\ +\ Permission is hereby granted, free of charge, to any person obtaining +\ a copy of this software and associated documentation files (the +\ "Software"), to deal in the Software without restriction, including +\ without limitation the rights to use, copy, modify, merge, publish, +\ distribute, sublicense, and/or sell copies of the Software, and to +\ permit persons to whom the Software is furnished to do so, subject to +\ the following conditions: +\ +\ The above copyright notice and this permission notice shall be +\ included in all copies or substantial portions of the Software. +\ +\ THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, +\ EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF +\ MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND +\ NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE +\ LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION +\ OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION +\ WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. +\ +\ LICENSE_END Added: cpu/ppc/call.fth =================================================================== --- cpu/ppc/call.fth (rev 0) +++ cpu/ppc/call.fth 2007-07-05 17:19:17 UTC (rev 461) @@ -0,0 +1,55 @@ +purpose: Call C subroutines from Forth +\ See license at end of file + +\ From Forth, call the C subroutine whose address is on the stack + +code call ( [ arg5 .. arg0 ] adr -- [ arg5 .. arg0 ] result ) + 'user saved-sp stw sp,* \ Save for callbacks + 'user saved-rp stw rp,* \ Save for callbacks + + \ Pass up to 6 arguments + lwz r3,h#00(sp) + lwz r4,h#04(sp) + lwz r5,h#08(sp) + lwz r6,h#0c(sp) + lwz r7,h#10(sp) + lwz r8,h#14(sp) + + mtspr lr,tos + bclrl 20,0 + + mr tos,r3 \ Return subroutine result + mtspr ctr,up \ Restore "next" pointer +c; + +headerless +code r1! ( adr -- ) mr r1,tos lwz tos,0(sp) addi sp,sp,1cell c; + +headers +: sp-call ( [ arg5 .. arg0 ] adr sp -- [ arg5 .. arg0 ] result ) + h# 10 - r1! call +; + +\ LICENSE_BEGIN +\ Copyright (c) 2007 FirmWorks +\ +\ Permission is hereby granted, free of charge, to any person obtaining +\ a copy of this software and associated documentation files (the +\ "Software"), to deal in the Software without restriction, including +\ without limitation the rights to use, copy, modify, merge, publish, +\ distribute, sublicense, and/or sell copies of the Software, and to +\ permit persons to whom the Software is furnished to do so, subject to +\ the following conditions: +\ +\ The above copyright notice and this permission notice shall be +\ included in all copies or substantial portions of the Software. +\ +\ THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, +\ EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF +\ MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND +\ NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE +\ LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION +\ OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION +\ WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. +\ +\ LICENSE_END Added: cpu/ppc/catchexc.fth =================================================================== --- cpu/ppc/catchexc.fth (rev 0) +++ cpu/ppc/catchexc.fth 2007-07-05 17:19:17 UTC (rev 461) @@ -0,0 +1,433 @@ +purpose: Save the processor state after a signal. +\ See license at end of file + +\ This code is entered as a result of a Unix signal. +\ It saves the processor state, then enters Forth so that the +\ state may be examined, and possibly re-established later. + +\ needs signal signal.f + +\ exception-area is a place to store registers during exception handling. +\ Each cpu gets its own area and uses SPRG0 to point to it. +h# 40 /l* constant /exception-area +0 value exception-area + +decimal + +only forth also hidden also forth definitions + +headers +0 value virt-phys + +headerless +0 value cpu-state-phys + +: enterforth ( -- ) + state-valid on + my-self to %saved-my-self + handle-breakpoint +; + +code (restart ( -- ) + \ Restore the Forth stacks. + + \ Establish the Data and Return stacks + 'user rp0 lwz rp,* + 'user sp0 lwz sp,* + + \ Restore the Forth Data and Return stacks from the save area. + + \ Data Stack + 'user sp0 lwz t3,* + 'user pssave lwz t0,* \ Address of data stack save area + ps-size addi t1,r0,* \ Size of data stack area + add t0,t0,t1 \ End of save area + + srawi t1,t1,2 \ Number of longwords + mtspr ctr,t1 + + begin + lwzu t2,-4(t0) + stwu t2,-4(t3) + bc 16,0,* \ Decrement and branch if nonzero + + \ Return Stack + 'user rp0 lwz t3,* + 'user rssave lwz t0,* \ Address of return stack save area + rs-size addi t1,r0,* \ Size of return stack area + add t0,t0,t1 \ End of save area + + srawi t1,t1,2 \ Number of longwords + mtspr ctr,t1 + + begin + lwzu t2,-4(t0) + stwu t2,-4(t3) + bc 16,0,* \ Decrement and branch if nonzero + + or r0,r0,r0 + + \ The following code communicates with the first part of "save-state". + \ See the description there. + here 4 + bl * \ Get current address + mfspr t0,lr + addi t0,t0,16 + mfspr t2,sprg0 \ Get this cpu's exception-area address + stw t0,h#10(t2) \ Store the address of the next instruction + \ so save-state can recognize it + + \ Take another trap, so we can fix up the PC's in the signal handler + 0 asm, \ Illegal instruction + +end-code + +\ This is the second half of the state saving procedure. It is executed +\ in normal state (not exception state). + +label finish-save + \ The base register is already set + + \ Find the user area + 'body main-task set up,* \ Find the save area + lwzx up,up,base \ Get user pointer + + \ Establish the Data and Return stacks + + \ Copy the entire Forth Data and Return stacks areas to a save area. + + \ Data Stack + 'user sp0 lwz t3,* + 'user pssave lwz t0,* \ Address of data stack save area + ps-size addi t1,r0,* \ Size of data stack area + add t0,t0,t1 \ End of save area + + srawi t1,t1,2 \ Number of longwords + mtspr ctr,t1 + + begin + lwzu t2,-4(t3) + stwu t2,-4(t0) + bc 16,0,* \ Decrement and branch if nonzero + + 'user sp0 lwz sp,* + + \ Return Stack + 'user rp0 lwz t3,* + 'user rssave lwz t0,* \ Address of return stack save area + rs-size addi t1,r0,* \ Size of return stack area + add t0,t0,t1 \ End of save area + + srawi t1,t1,2 \ Number of longwords + mtspr ctr,t1 + + begin + lwzu t2,-4(t3) + stwu t2,-4(t0) + bc 16,0,* \ Decrement and branch if nonzero + + 'user rp0 lwz rp,* + + \ Adjust the stack pointer to account for the top of stack register + addi sp,sp,4 + + \ Restart the Forth interpreter. + + \ Set the next pointer + mtspr ctr,up + + \ Execute enterforth + 'body enterforth 4 - set ip,* + add ip,ip,base +c; + +\ This is the first part of the exception handling sequence. It is +\ executed in exception state. +\ r2, r3, and lr have been saved. r2 points to the this cpu's exception-area, +\ r3 points to the address where the exception occured. +label save-state + stw r3,h#0c(r2) \ Save exception address + lwz r3,h#08(r2) \ Restore lr + mtspr lr,r3 + \ R3 is available + stw base,h#14(r2) \ A register for us to play with + stw up,h#18(r2) \ A register for us to play with + + mfcr base \ CR is saved in base + + \ WARNING: This code is tricky. The goal is to determine whether or not + \ the instruction that caused the exception was the illegal instruction at + \ the end of (restart, just above. It's not safe to access the instruction + \ at the saved PC location, because this handler runs with translations + \ disabled, but the saved PC is virtual address, so accessing it could + \ result in a machine check (which would cause the system to hang) if the + \ PC value is not a valid real-mode address. + \ Instead, we compare the saved PC with the contents of the cell at + \ sprg0+10, depending on the fact that (restart stored the + \ address of its illegal instruction there just before executing that + \ illegal instruction. + + mfspr up,srr0 \ Saved PC + lwz r3,h#10(r2) \ Get magic address + cmp 0,0,up,r3 \ Is it the magic address? + + lwz r3,h#00(r2) \ Restore r3 + + = if + \ This is the second half of (restart, so we restore all the registers + \ from the save area. + + lwz up,h#18(r2) \ Get UP back + +\ 'user cpu-state-phys lwz r31,* \ Get cpu-state buffer address + lwz r31,h#38(r2) + + \ Restore floating point registers if they were saved + 36 /l* 31 lwz r0,* \ saved msr + andi. r0,r0,h#2000 + 0<> if + mfmsr t0 \ Turn on FP unit + ori t0,t0,h#2000 + mtmsr t0 + isync + + 106 /l* 31 lfd 0,* \ Get back fpscr double word into fr0 + mtfsf h#ff,0 \ Move fr0 to fpscr + + \ Assemble 32 "lfd fN,42*4+N*8(r31)" instructions + 32 0 do + i 8 * 42 la+ ( offset ) 31 ( r31 ) i ( reg# ) " lfd *,*" evaluate + loop + then + + 32 /l* 31 lwz r0,* mtspr xer,r0 \ xer + 33 /l* 31 lwz r0,* mtspr lr,r0 \ lr + 34 /l* 31 lwz r0,* mtspr ctr,r0 \ ctr + 35 /l* 31 lwz r0,* mtspr srr0,r0 \ saved pc + 36 /l* 31 lwz r0,* mtspr srr1,r0 \ saved msr + 37 /l* 31 lwz r0,* mtcrf h#ff,r0 \ cr + +\ 108 /l* 31 lwz r0,* mtspr sprg0,r0 \ sprg0 +\ 109 /l* 31 lwz r0,* mtspr sprg1,r0 \ sprg1 +\ 110 /l* 31 lwz r0,* mtspr sprg2,r0 \ sprg2 +\ 111 /l* 31 lwz r0,* mtspr sprg3,r0 \ sprg3 + + \ Assemble 32 "lwz rN,N*4(r31)" instructions + 32 0 do + i 4 * ( offset ) 31 ( r31 ) i ( reg# ) " lwz *,*" evaluate + loop +\ lmw r0,0(up) \ Restore all general registers + + rfi + then + + \ This is not the second half of (restart, so we save all the registers + \ to the save area. + mtcrf h#ff,base \ Restore CR + +\ \ Set the base register +\ here 4 + bl * \ Absolute address of next instruction +\ here origin - set base,* \ Relative address of this instruction +\ mfspr up,lr +\ subf base,base,up \ Base address of Forth kernel + +\ 'body main-task set up,* \ Find the save area +\ lwzx up,up,base \ Get user pointer +\ +\ 'user cpu-state-phys lwz up,* \ Get cpu-state buffer address + + lwz up,h#38(r2) \ Get address from save area + lwz base,h#3c(r2) \ Get address from save area + +\ stmw r0,0(up) \ Save all general registers + \ Assemble 32 "stw rN,N*4(up)" instructions + 32 0 do + i 4 * ( offset ) 27 ( up ) i ( reg# ) " stw *,*" evaluate + loop + + lwz r0,h#14(r2) 26 /l* 27 stw r0,* \ base + lwz r0,h#18(r2) 27 /l* 27 stw r0,* \ up + mfspr r0,xer 32 /l* 27 stw r0,* \ xer + lwz r0,h#08(r2) 33 /l* 27 stw r0,* \ lr + mfspr r0,ctr 34 /l* 27 stw r0,* \ ctr + mfspr r0,srr0 35 /l* 27 stw r0,* \ saved pc + mfspr r0,srr1 36 /l* 27 stw r0,* \ saved msr + mfcr r0 37 /l* 27 stw r0,* \ cr + + lwz r0,h#0c(r2) rlwinm r0,r0,24,24,31 + 38 /l* 27 stw r0,* \ exception# + lwz r2,h#04(r2) 2 /l* 27 stw r2,* \ original r2 + +\ mfspr r0,sprg0 108 /l* 27 stw r0,* \ sprg0 +\ mfspr r0,sprg1 109 /l* 27 stw r0,* \ sprg1 +\ mfspr r0,sprg2 110 /l* 27 stw r0,* \ sprg2 +\ mfspr r0,sprg3 111 /l* 27 stw r0,* \ sprg3 + + \ Save floating point registers if floating point is enabled + mfmsr t0 + andi. t0,t0,h#2000 + 0<> if + \ Assemble 32 "stfd fN,42*4+N*8(up)" instructions + 32 0 do + i 8 * 42 la+ ( offset ) 27 ( up ) i ( reg# ) " stfd *,*" evaluate + loop + \ Now that fp regs are saved, we can trounce on them to get the + \ fpscr register + mffs 0 \ Move fpscr to fp0[63:32] + 106 /l* 27 stfd 0,* \ Move fp0[63:0] to memory + then + + \ Now we set the saved PC to point to the rest of the state save + \ routine, then return from interrupt. + + 'body finish-save set up,* + add up,up,base + mtspr srr0,up + + rfi +end-code + +hidden definitions + +' (restart is restart +' (restart is restart-step + +string-array exception-name +( 00 ) ," Reserved exception 0" +( 01 ) ," System reset" +( 02 ) ," Machine check" +( 03 ) ," Data access exception" +( 04 ) ," Instruction access exception" +( 05 ) ," External interrupt" +( 06 ) ," Alignment exception" +( 07 ) ," Illegal instruction" +( 08 ) ," Floating point unavailable" +( 09 ) ," Decrementer interrupt" +( 0a ) ," I/O controller interface error" +( 0b ) ," Reserved exception 0b" +( 0c ) ," System call" +( 0d ) ," Trace exception" +( 0e ) ," Floating point assist exception" +( 0f ) ," Reserved exception 0f" +( 10 ) ," Instruction translation miss" +( 11 ) ," Data load translation miss" +( 12 ) ," Data store translation miss" +( 13 ) ," Instruction address breakpoint" +( 14 ) ," System management interrupt" +end-string-array + +: (.exception) ( -- ) + exception# dup h# 20 = if + ." Run mode/trace exception" + else + dup h# 15 < if + exception-name count type + else + ." Reserved exception # " .h + then + then + cr +; +' (.exception) is .exception + +: print-breakpoint + .exception \ norm + interactive? 0= if bye then \ Restart only if a human is at the controls + ??cr quit +; +\ ' print-breakpoint is handle-breakpoint + +code hwbp ( adr -- ) + mtspr iabr,tos + lwz tos,0(sp) + addi sp,sp,4 +c; + +code tbar! ( adr -- okay? ) + \ As a side effect of the mfspr *,pvr instruction, the simulator + \ sets its internal trap base address register (which isn't a real + \ part of the PowerPC architecture) to the address contained in the + \ destination register. That instruction was chosen because it + \ is not likely to be used in general code, but it is valid on all + \ PPC implementations. + mfspr tos,pvr +c; + +forth definitions +0 value exc-adr +: exc, ( instruction -- ) exc-adr instruction! exc-adr la1+ to exc-adr ; +: put-exception ( exception-handler-addr exception-addr -- ) + to exc-adr virt-phys - lwsplit + h# 7c51.43a6 exc, \ mtspr sprg1,r2 protect r2 + h# 7c50.42a6 exc, \ mfspr r2,sprg0 set r2 to save area + h# 9062.0000 exc, \ stw r3,0(r2) save r3 + h# 7c71.42a6 exc, \ mfspr r3,sprg1 + h# 9062.0004 exc, \ stw r3,4(r2) save r2 + h# 7c68.02a6 exc, \ mfspr r3,lr + h# 9062.0008 exc, \ stw r3,8(r2) save lr + \ h# 80620020 exc, h# 38630001 exc, h# 90620020 exc, + h# 3c60.0000 or exc, \ set r3,high address half-word + h# 6063.0000 or exc, \ set r3,low address half-word + h# 7c68.03a6 exc, \ mtspr lr,r3 point lr to handler + h# 3860.0000 exc-adr h# ff00 and or exc, \ addi r3,r0,exception-addr + h# 4e80.0020 exc, \ bclr 20,0 jump to handler +; +d# 12 /l* constant /exc \ size of entry made by put-exception +: catch-exception ( exception# -- ) 8 << save-state swap put-exception ; + +headers +: catch-exceptions ( -- ) + /save-area alloc-mem is cpu-state ( ) + clear-save-area ( ) + pssave drop rssave drop \ Force allocation of these buffers + /exception-area alloc-mem ( virt ) + cpu-state virt-phys - over h# 38 + l! ( virt ) + origin over h# 3c + l! ( virt ) + virt-phys - dup is exception-area ( virt' ) + sprg0! \ Save this cpu's exception-area address to SPRG0 + + + 2 catch-exception \ Machine check + 3 catch-exception \ Data access + 4 catch-exception \ Instruction access + 6 catch-exception \ Alignment + 7 catch-exception \ Illegal instruction + 8 catch-exception \ Floating point unavailable +; +: stand-init ( -- ) + msr@ h# 40 invert and msr! + catch-exceptions +; +: sys-init ( -- ) + sys-init + syscall-vec @ 0= if + h# 4000 alloc-mem tbar! if + catch-exceptions + then + then +; + +only forth also definitions + +\ LICENSE_BEGIN +\ Copyright (c) 2007 FirmWorks +\ +\ Permission is hereby granted, free of charge, to any person obtaining +\ a copy of this software and associated documentation files (the +\ "Software"), to deal in the Software without restriction, including +\ without limitation the rights to use, copy, modify, merge, publish, +\ distribute, sublicense, and/or sell copies of the Software, and to +\ permit persons to whom the Software is furnished to do so, subject to +\ the following conditions: +\ +\ The above copyright notice and this permission notice shall be +\ included in all copies or substantial portions of the Software. +\ +\ THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, +\ EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF +\ MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND +\ NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE +\ LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION +\ OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION +\ WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. +\ +\ LICENSE_END Added: cpu/ppc/centry.fth =================================================================== --- cpu/ppc/centry.fth (rev 0) +++ cpu/ppc/centry.fth 2007-07-05 17:19:17 UTC (rev 461) @@ -0,0 +1,124 @@ +purpose: Client interface handler code +\ See license at end of file + +d# 108 buffer: cif-reg-save + +headerless +code cif-return !csp + mr r3,tos + + 'user cif-reg-save lwz r7,* \ Address of register save area in r7 + + lwz r13,00(r7) lwz r14,04(r7) lwz r15,08(r7) lwz r16,12(r7) + lwz r17,16(r7) lwz r18,20(r7) lwz r19,24(r7) lwz r20,28(r7) + lwz r21,32(r7) lwz r22,36(r7) lwz r23,40(r7) lwz r24,44(r7) + lwz r25,48(r7) lwz r26,52(r7) lwz r27,56(r7) lwz r28,60(r7) + lwz r29,64(r7) lwz r30,68(r7) lwz r31,72(r7) lwz r1,76(r7) + lwz r2,80(r7) lwz r4,88(r7) mtspr hid0,r4 + lwz r4,92(r7) mtspr sprg0,r4 lwz r4,96(r7) mtspr sprg1,r4 + lwz r4,100(r7) mtspr sprg2,r4 lwz r4,104(r7) mtspr sprg3,r4 + lwz r4,84(r7) + + mtspr lr,r4 + bclr 20,0 +end-code + +defer rm-cif-entry ' noop to rm-cif-entry +defer rm-cif-exit ' noop to rm-cif-exit + +: cif-exec ( args ... -- ) + rm-cif-entry do-cif rm-cif-exit cif-return +; + +headers +: cif-caller ( -- adr ) cif-reg-save d# 84 + @ ; + +headerless +label cif-handler + \ Registers: + \ r3 argument array pointer + \ r1,r2,r13-r31 must be preserved + \ r0,r4-r12 scratch + + mfspr r4,lr \ Save link register for later + mr r5,base \ Save base register (r26) + mr r6,up \ Save user area pointer register (r27) + + \ Set the base register + here 4 + bl * \ Absolute address of next instruction + here origin - set base,* \ Relative address of this instruction + mfspr up,lr + subf base,base,up \ Base address of Forth kernel in base + + \ Find the user area + 'body main-task set up,* \ Find the save area + lwzx up,up,base \ Get user pointer + + 'user cif-reg-save lwz r7,* \ Address of register save area in r7 + + stw r13,00(r7) stw r14,04(r7) stw r15,08(r7) stw r16,12(r7) + stw r17,16(r7) stw r18,20(r7) stw r19,24(r7) stw r20,28(r7) + stw r21,32(r7) stw r22,36(r7) stw r23,40(r7) stw r24,44(r7) + stw r25,48(r7) stw r5,52(r7) stw r6,56(r7) stw r28,60(r7) + stw r29,64(r7) stw r30,68(r7) stw r31,72(r7) stw r1,76(r7) + stw r2,80(r7) stw r4,84(r7) mfspr r4,hid0 stw r4,88(r7) + mfspr r4,sprg0 stw r4,92(r7) mfspr r4,sprg1 stw r4,96(r7) + mfspr r4,sprg2 stw r4,100(r7) mfspr r4,sprg3 stw r4,104(r7) + + mr tos,r3 + + 'user rp0 lwz rp,* + 'user sp0 lwz sp,* + \ We don't add 4 to account for the top of stack register because + \ there is one item - the argument array address - on the stack + \ (actually it is in the TOS register; logically it's on the stack) + + 'user exception-area lwz r2,* mtspr sprg0,r2 + + mtspr ctr,up \ Set "next" pointer + 'body cif-exec 4 - set ip,* + add ip,ip,base +c; + +0 value callback-stack + +headers +code callback-call ( args vector -- ) + mtspr lr,tos + lwz r3,0(sp) + 'user callback-stack lwz r1,* + lwz tos,1cell(sp) + addi sp,sp,2cells + bclrl 20,0 + mtspr ctr,up +c; + +\ Force allocation of buffer +stand-init: CIF buffers + cif-reg-save drop + h# 1000 dup alloc-mem + to callback-stack +; + +\ LICENSE_BEGIN +\ Copyright (c) 2007 FirmWorks +\ +\ Permission is hereby granted, free of charge, to any person obtaining +\ a copy of this software and associated documentation files (the +\ "Software"), to deal in the Software without restriction, including +\ without limitation the rights to use, copy, modify, merge, publish, +\ distribute, sublicense, and/or sell copies of the Software, and to +\ permit persons to whom the Software is furnished to do so, subject to +\ the following conditions: +\ +\ The above copyright notice and this permission notice shall be +\ included in all copies or substantial portions of the Software. +\ +\ THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, +\ EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF +\ MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND +\ NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE +\ LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION +\ OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION +\ WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. +\ +\ LICENSE_END Added: cpu/ppc/code.fth =================================================================== --- cpu/ppc/code.fth (rev 0) +++ cpu/ppc/code.fth 2007-07-05 17:19:17 UTC (rev 461) @@ -0,0 +1,104 @@ +purpose: Assembler extensions to create Forth words +\ See license at end of file + +\ These words are specific to the virtual machine implementation +: assembler ( -- ) ppc-assembler ; + +only forth also assembler also definitions + +\ Forth Virtual Machine registers + +also register-names definitions +decimal +: t0 20 ; : t1 21 ; : t2 22 ; : t3 23 ; : t4 24 ; : t5 25 ; +: t6 19 ; : t7 18 ; : t8 17 ; : t9 16 ; +: base 26 ; : up 27 ; : tos 28 ; : ip 29 ; : rp 30 ; : sp 31 ; +: w t5 ; +previous definitions + +also constant-names definitions + +/n constant 1cell \ Offsets into the stack +1cell -1 * constant -1cell +1cell 2 * constant 2cells +1cell 3 * constant 3cells +1cell 4 * constant 4cells + +1cell constant /cf \ Size of a code field (except for "create") +/cf -1 * constant -/cf + +1cell constant /token \ Size of a compiled word reference +/token -1 * constant -/token + +1cell constant /branch \ Size of a branch offset + +/token 2 * constant /ccf \ Size of a "create" code field + +/cf 1cell + constant /cf+1cell \ Location of second half of +previous definitions + +\ The next few words are already in the forth vocabulary; +\ we want them in the assembler vocabulary too +alias next next +headerless +: exitcode ( -- ) + ['] $interpret-do-undefined is $do-undefined + previous +; +' exitcode is do-exitcode +headers +alias c; c; + +: 'user# \ name ( -- user# ) + ' ( acf-of-user-variable ) >body @ +; +: 'user \ name ( -- user-addressing-mode ) + [ also ppc-assembler also register-names ] + 'user# up + [ previous previous ] +; +: 'body \ name ( -- variable-apf-offset ) + ' ( acf-of-user-variable ) >body origin - +; +: 'acf \ name ( -- variable-acf-offset ) + ' ( acf-of-user-variable ) origin - +; + +also forth definitions +: entercode ( -- ) + also assembler + false is disassembling? + ['] $ppc-assem-do-undefined is $do-undefined +; +' entercode is do-entercode + +\ "code" is defined in the kernel + +: label \ name ( -- ) + create !csp entercode +; +only forth also definitions + +\ LICENSE_BEGIN +\ Copyright (c) 2007 FirmWorks +\ +\ Permission is hereby granted, free of charge, to any person obtaining +\ a copy of this software and associated documentation files (the +\ "Software"), to deal in the Software without restriction, including +\ without limitation the rights to use, copy, modify, merge, publish, +\ distribute, sublicense, and/or sell copies of the Software, and to +\ permit persons to whom the Software is furnished to do so, subject to +\ the following conditions: +\ +\ The above copyright notice and this permission notice shall be +\ included in all copies or substantial portions of the Software. +\ +\ THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, +\ EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF +\ MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND +\ NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE +\ LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION +\ OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION +\ WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. +\ +\ LICENSE_END Added: cpu/ppc/cpubpsup.fth =================================================================== --- cpu/ppc/cpubpsup.fth (rev 0) +++ cpu/ppc/cpubpsup.fth 2007-07-05 17:19:17 UTC (rev 461) @@ -0,0 +1,91 @@ +purpose: Machine-dependent definitions for breakpoints +\ See license at end of file + +headerless +0 value breakpoint-opcode +defer breakpoint-trap? +' true is breakpoint-trap? \ XXX until arcbpsup is installed... + +: op@ ( adr -- op ) l@ ; +: op! ( op adr -- ) instruction! ; +: bp-address-valid? ( adr -- flag ) 3 and 0= ; +: at-breakpoint? ( adr -- flag ) op@ breakpoint-opcode = ; +: put-breakpoint ( adr -- ) breakpoint-opcode swap op! ; + +headers +: .instruction ( -- ) + %pc [ also assembler ] pc ! dis1 [ previous ] +; + +headerless +\ Find the places to set the next breakpoint for single stepping. + +\ Flag is true if the branch should be followed - we don't follow branches +\ if stepping? is false and the instruction modifies the link register. +: -hop? ( stepping? pc -- stepping? pc flag ) 2dup 1 and 0= or ; +: next-instruction ( stepping? -- next-adr branch-target|0 ) + %pc la1+ swap ( next-adr stepping? ) + + \ If we are hopping (not stepping), then we don't follow subroutine + \ calls (branches that have the link bit set). We needn't bother + \ checking whether or not the instruction is a branch, because if + \ it isn't, we want to do the same thing as for a branch with link. + 0= %pc l@ 1 and and if 0 exit then ( next-adr ) + + %pc ( next-adr pc ) + bclr? if drop %lr exit then ( next-adr pc ) + bcctr? if drop %ctr exit then ( next-adr pc ) + bc? if >bc-target exit then ( next-adr pc ) + b? if >b-target exit then ( next-adr pc ) + drop 0 +; + +: bumppc ( -- ) %pc la1+ to %pc ; + +alias rpc %pc + +code goto ( adr -- ) + mtspr lr,tos + lwz tos,0(sp) + addi sp,sp,4 + bclr 20,0 +end-code + +: return-adr ( -- adr ) %r1 @ 8 + @ ; +: leaf-return-adr ( -- adr ) %lr ; + +: backward-branch? ( adr -- flag ) \ True if adr points to a backward branch + b? if dup >b-target u> exit then ( adr ) + bc? if dup >bc-target u> exit then ( adr ) + drop false +; +: loop-exit-adr ( -- adr ) + %pc begin dup backward-branch? 0= while la1+ repeat la1+ +; + +headers +: set-pc ( adr -- ) to %pc ; + +\ LICENSE_BEGIN +\ Copyright (c) 2007 FirmWorks +\ +\ Permission is hereby granted, free of charge, to any person obtaining +\ a copy of this software and associated documentation files (the +\ "Software"), to deal in the Software without restriction, including +\ without limitation the rights to use, copy, modify, merge, publish, +\ distribute, sublicense, and/or sell copies of the Software, and to +\ permit persons to whom the Software is furnished to do so, subject to +\ the following conditions: +\ +\ The above copyright notice and this permission notice shall be +\ included in all copies or substantial portions of the Software. +\ +\ THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, +\ EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF +\ MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND +\ NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE +\ LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION +\ OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION +\ WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. +\ +\ LICENSE_END Added: cpu/ppc/cpuclass.fth =================================================================== --- cpu/ppc/cpuclass.fth (rev 0) +++ cpu/ppc/cpuclass.fth 2007-07-05 17:19:17 UTC (rev 461) @@ -0,0 +1,97 @@ +purpose: Classify PowerPC CPUs into various general families +\ See license at end of file + +headerless +\ At present, PowerPC CPUs can be grouped into several classes. +\ There are several characteristics that are the same across all +\ members of a class. New classes and new class members appear +\ from time to time. The 601 is handled elsewhere. + +: 603-class? ( -- flag ) + \ CPU-version 81 is for the 8240 + cpu-version dup 3 = over 6 = or over 7 = or over 8 = or swap h# 81 = or +; +: 604-class? ( -- flag ) + cpu-version dup 4 = over 9 = or swap h# a = or +; +: 620-class? ( -- flag ) + cpu-version d# 20 = +; +: 704-class? ( -- flag ) \ remove 54 to drop proto support. + cpu-version dup h# 54 = swap h# 60 = or +; + +: mach-5/pass1? ( -- flag ) + pvr@ lwsplit h# a = swap h# 100 = and +; +: 823-class? ( -- flag ) + cpu-version h# 50 = +; + +\ According to IBM, MACH-5 (PVR = A) revision 100 has a bug that requires +\ the BTAC bit be set to 1 in order to disable cacheing of branch addresses. +\ We set the BTAC disable bit in resetvec, here we turn it off if we are +\ running on anything other than a mach-5, version 100. +\ The BTAC bit is bit 30 of HID0. (Well actually, its the 0x00000002 bit +\ the way we look at it) + +: fastest-mode ( -- ) + 604-class? if + \ Turn on 604 superscalar and dynamic branch prediction modes + \ machine checks, and cache parity checking + \ Turn off cache locks and bus parity checking + hid0@ h# 84 or ( hid0' ) + mach-5/pass1? 0= if ( hid0' ) + h# 02 invert and ( hid0'' ) + then ( hid0 ) + h# f008.3000 invert and hid0! ( ) + then +[ifdef] exponential + \ 704-class? if + cpu-version h# 60 = if \ non-proto x704 + \ Turn on 704 superscalar and set POE + modes@ h# 3.0000 or modes! + then +[then] +; + +\ Some characteristics of various classes + +: software-tlb-miss? ( -- flag ) 603-class? 823-class? or ; +: sticky-cache-invalidate? ( -- flag ) 603-class? ; + +d# 64 value #tlb-lines +: configure-tlb ( -- ) + cpu-version case + 3 of d# 32 endof + 6 of d# 32 endof + h# 50 of d# 8 endof + ( default ) #tlb-lines swap + endcase + to #tlb-lines +; +headers + +\ LICENSE_BEGIN +\ Copyright (c) 2007 FirmWorks +\ +\ Permission is hereby granted, free of charge, to any person obtaining +\ a copy of this software and associated documentation files (the +\ "Software"), to deal in the Software without restriction, including +\ without limitation the rights to use, copy, modify, merge, publish, +\ distribute, sublicense, and/or sell copies of the Software, and to +\ permit persons to whom the Software is furnished to do so, subject to +\ the following conditions: +\ +\ The above copyright notice and this permission notice shall be +\ included in all copies or substantial portions of the Software. +\ +\ THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, +\ EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF +\ MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND +\ NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE +\ LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION +\ OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION +\ WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. +\ +\ LICENSE_END Added: cpu/ppc/cpunode.fth =================================================================== --- cpu/ppc/cpunode.fth (rev 0) +++ cpu/ppc/cpunode.fth 2007-07-05 17:19:17 UTC (rev 461) @@ -0,0 +1,223 @@ +purpose: CPU node +\ See license at end of file + +0 value l2-cache-node +defer probe-l2-cache +' false to probe-l2-cache ( -- false | #sets #bytes write-back? true ) + +\ A hook that can be used on a per-platform basis to amend any +\ information that needs to be changed. +defer get-cpu-info ( -- ) +' noop to get-cpu-info + +headerless +\ Interfaces to platform-dependent code to determine the status of +\ CPUs in an MP system. +1 value max#cpus + +\ keep track of cpu#; may be used by get-cpu-info and probe-l2-cache +0 value cpu + +defer firmware-cpu# ( -- cpu# ) +' 0 to firmware-cpu# + +defer cpu-started? ( cpu# -- flag ) +' 0= to cpu-started? + +headers +d# 100,000,000 value cpu-clock-frequency + +' cpu-node " cpu" chosen-variable + +headerless +0 value cpu-package + +headers +: make-l2-cache-node ( #sets size write-back? -- ) + new-device + " l2-cache" device-name + " cache" device-type + 0 0 encode-bytes " cache-unified" property \ Assumes a unified cache + + drop ( #sets size ) + 2dup " i-cache-size" integer-property " i-cache-sets" integer-property + " d-cache-size" integer-property " d-cache-sets" integer-property + + d# 32 " d-cache-block-size" integer-property + d# 32 " i-cache-block-size" integer-property + + current-device ( phandle ) + finish-device + dup to l2-cache-node + " l2-cache" integer-property +; +headerless + +: make-cache-props ( ts tsz d$s d$b d$sz i$s i$b i$sz -- ) + " i-cache-size" integer-property + dup to /icache-block + " i-cache-block-size" integer-property + " i-cache-sets" integer-property + " d-cache-size" integer-property + dup to /dcache-block + " d-cache-block-size" integer-property + " d-cache-sets" integer-property + " tlb-size" integer-property + " tlb-sets" integer-property +; +: start-cpu-node ( ts tsz d$s d$b d$sz i$s i$b i$sz adr len -- ) + new-device + ( tlb-params cache-params adr len ) device-name + " cpu" device-type +; +: make-603-node ( -- ) + " PowerPC,603" start-cpu-node + d# 64 d# 128 d# 128 d# 32 d# 8192 3dup make-cache-props +; +: make-604-node ( -- ) + " PowerPC,604" start-cpu-node + d# 128 d# 256 d# 128 d# 32 d# 16384 3dup make-cache-props +; +: make-603e-node ( -- ) + " PowerPC,603e" start-cpu-node + d# 64 d# 128 d# 128 d# 32 d# 16384 3dup make-cache-props +; +: make-603ev-node ( -- ) + " PowerPC,603ev" start-cpu-node + d# 64 d# 128 d# 128 d# 32 d# 16384 3dup make-cache-props +; +: make-603eva-node ( -- ) + " PowerPC,603evARTHUR" start-cpu-node + d# 128 d# 256 d# 128 d# 32 d# 32768 3dup make-cache-props +; +: make-604ev-node ( -- ) + " PowerPC,604ev" start-cpu-node + d# 128 d# 256 d# 256 d# 32 d# 32768 3dup make-cache-props +; +: make-604ev5-node ( -- ) + " PowerPC,604ev5" start-cpu-node + d# 128 d# 256 d# 256 d# 32 d# 32768 3dup make-cache-props +; +: make-620-node ( -- ) + " PowerPC,620" start-cpu-node + d# 128 d# 128 d# 64 d# 64 d# 32768 3dup make-cache-props +; +: make-704-node ( -- ) + " PowerPC,X704" start-cpu-node + d# 32 d# 128 d# 64 d# 32 d# 2048 3dup make-cache-props +; +: make-8240-node ( -- ) + " PowerPC,603ev" start-cpu-node + d# 64 d# 128 d# 128 d# 32 d# 16384 3dup make-cache-props +; +: make-823-node ( -- ) + " PowerPC,MPC823" start-cpu-node + d# 32 d# 256 d# 32 d# 16 d# 1024 d# 64 d# 16 d# 2048 make-cache-props +; + +headers +0 0 " " " /" begin-package +" cpus" device-name +1 " #address-cells" integer-property +0 " #size-cells" integer-property + +: decode-unit ( adr len -- phys ) $number if 0 then ; +: encode-unit ( phys -- adr len ) (u.) ; + +: open ( -- true ) true ; +: close ( -- ) ; +end-package + +headerless + +defer make-cpu-extras ' noop to make-cpu-extras + +: make-cpu-node ( cpu# -- ) + to cpu + " /cpus" find-device + + cpu-version case + 3 of make-603-node endof + 4 of make-604-node endof + 6 of make-603e-node endof + 7 of make-603ev-node endof + 8 of make-603eva-node endof + 9 of make-604ev-node endof + h# a of make-604ev5-node endof + d# 20 of make-620-node endof + h# 50 of make-823-node endof + h# 54 of make-704-node endof \ proto... remove! + h# 60 of make-704-node endof + h# 81 of make-8240-node endof + ( default ) ." make-cpu-node: Unknown CPU Version " dup . cr + endcase + + get-cpu-info + + \ ??? cpu-version " arc-key" integer-property + + counts/ms d# 1000 * " timebase-frequency" integer-property + + cpu firmware-cpu# = if current-device to cpu-package then + + cpu " reg" integer-property + + " clock-frequency" " /" find-package drop get-package-property 0= if + " bus-frequency" property + then + + cpu-clock-frequency " clock-frequency" integer-property + " : open true ; : close ;" evaluate + + \ check for in-line (or unshared) cache + probe-l2-cache if + make-l2-cache-node + else + l2-cache-node ?dup if " l2-cache" integer-property then + then + + make-cpu-extras + + finish-device + device-end +; + +: make-cpu-nodes ( -- ) + \ check for look-aside cache + " /cpus" find-device -1 to cpu + probe-l2-cache if make-l2-cache-node then + device-end + max#cpus 0 do + i cpu-started? if i make-cpu-node then + loop +; +headers + +stand-init: CPU nodes + make-cpu-nodes + cpu-package open-phandle cpu-node ! +; + +\ LICENSE_BEGIN +\ Copyright (c) 2007 FirmWorks +\ +\ Permission is hereby granted, free of charge, to any person obtaining +\ a copy of this software and associated documentation files (the +\ "Software"), to deal in the Software without restriction, including +\ without limitation the rights to use, copy, modify, merge, publish, +\ distribute, sublicense, and/or sell copies of the Software, and to +\ permit persons to whom the Software is furnished to do so, subject to +\ the following conditions: +\ +\ The above copyright notice and this permission notice shall be +\ included in all copies or substantial portions of the Software. +\ +\ THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, +\ EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF +\ MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND +\ NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE +\ LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION +\ OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION +\ WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. +\ +\ LICENSE_END Added: cpu/ppc/cpustate.fth =================================================================== --- cpu/ppc/cpustate.fth (rev 0) +++ cpu/ppc/cpustate.fth 2007-07-05 17:19:17 UTC (rev 461) @@ -0,0 +1,40 @@ +purpose: Buffers for saving program state +\ See license at end of file + +headers +\ A place to save the CPU registers when we take a trap +0 value cpu-state \ Pointer to CPU state save area + +headerless +: >state ( offset -- adr ) cpu-state + ; + +ps-size buffer: pssave \ Forth data stack save area +rs-size buffer: rssave \ Forth return stack save area + +headers +defer .exception \ Display the exception type +defer handle-breakpoint \ What to do after saving the state + +\ LICENSE_BEGIN +\ Copyright (c) 2007 FirmWorks +\ +\ Permission is hereby granted, free of charge, to any person obtaining +\ a copy of this software and associated documentation files (the +\ "Software"), to deal in the Software without restriction, including +\ without limitation the rights to use, copy, modify, merge, publish, +\ distribute, sublicense, and/or sell copies of the Software, and to +\ permit persons to whom the Software is furnished to do so, subject to +\ the following conditions: +\ +\ The above copyright notice and this permission notice shall be +\ included in all copies or substantial portions of the Software. +\ +\ THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, +\ EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF +\ MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND +\ NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE +\ LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION +\ OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION +\ WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. +\ +\ LICENSE_END Added: cpu/ppc/ctrace.fth =================================================================== --- cpu/ppc/ctrace.fth (rev 0) +++ cpu/ppc/ctrace.fth 2007-07-05 17:19:17 UTC (rev 461) @@ -0,0 +1,81 @@ +purpose: After a crash, displays a backtrace of C stack frames. +\ See license at end of file + +only forth also hidden also forth definitions +needs (rstrace rstrace.fth +needs >saved savedstk.fth +only forth also hidden also forth definitions + +headerless +: imatch? ( adr match mask -- adr flag ) 2 pick l@ and = ; + +: b? ( adr -- adr flag ) h# 4800.0000 h# fc00.0000 imatch? ; +: bc? ( adr -- adr flag ) h# 4000.0000 h# fc00.0000 imatch? ; +: bclr? ( adr -- adr flag ) h# 4c00.0020 h# fc00.07fe imatch? ; +: bcctr? ( adr -- adr flag ) h# 4c00.0420 h# fc00.07fe imatch? ; + +: >b-target ( adr -- target-adr ) + dup l@ dup d# 6 << d# 6 >>a 3 invert and ( adr instr bd ) + swap 2 and if nip else + then +; +: >bc-target ( adr -- target-adr ) + dup l@ dup d# 16 << d# 16 >>a 3 invert and ( adr instr bd ) + swap 2 and if nip else + then +; +: .subroutine ( call-adr -- ) \ Show subroutine address + b? if >b-target 9 u.r exit then + bc? if >bc-target 9 u.r exit then + bclr? if drop %lr 9 u.r exit then \ only works in leaf context + bcctr? if drop %ctr 9 u.r exit then \ only works in leaf context + drop ." ??????" +; +: .args ( -- ) \ Show C subroutine arguments + ." (" %r3 9 u.r %r4 9 u.r %r5 9 u.r %r6 9 u.r ." ... )" +; +: .leaf ( return-adr -- ) + 4 - + base @ >r hex + dup .subroutine .args ." called from " 9 u.r cr + r> base ! +; +: .subr ( return-adr -- ) + 4 - + base @ >r hex + dup .subroutine ." ( ???? )" ." called from " 9 u.r cr + r> base ! +; +headers +: ctrace ( -- ) \ C stack backtrace + ?saved-state + ." Last Leaf:" cr %lr .leaf + %r1 if + ." On stack:" cr + %r1 ( leaf-frame-adr ) + begin @ dup while ( frame-adr ) dup 8 + @ .subr repeat + drop + then +; + +\ LICENSE_BEGIN +\ Copyright (c) 2007 FirmWorks +\ +\ Permission is hereby granted, free of charge, to any person obtaining +\ a copy of this software and associated documentation files (the +\ "Software"), to deal in the Software without restriction, including +\ without limitation the rights to use, copy, modify, merge, publish, +\ distribute, sublicense, and/or sell copies of the Software, and to +\ permit persons to whom the Software is furnished to do so, subject to +\ the following conditions: +\ +\ The above copyright notice and this permission notice shall be +\ included in all copies or substantial portions of the Software. +\ +\ THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, +\ EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF +\ MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND +\ NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE +\ LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION +\ OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION +\ WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. +\ +\ LICENSE_END Added: cpu/ppc/debugm.fth =================================================================== --- cpu/ppc/debugm.fth (rev 0) +++ cpu/ppc/debugm.fth 2007-07-05 17:19:17 UTC (rev 461) @@ -0,0 +1,110 @@ +purpose: CPU-dependent definitions for the source-level debugger +\ See license at end of file + +headerless +\ \needs at : at ( row column -- ) 2drop ; +\needs kill-line : kill-line ( -- ) ; + +hex + +: low-dictionary-adr ( -- adr ) origin init-user-area + ; + +nuser debug-next \ Pointer to "next" +vocabulary bug bug also definitions +nuser 'debug \ code field for high level trace +nuser <ip \ lower limit of ip +nuser ip> \ upper limit of ip +nuser cnt \ how many times thru debug next + +\ Since we use a shared "next" routine, slow-next and fast-next are no-op's +alias slow-next 2drop ( high low -- ) +alias fast-next 2drop ( high low -- ) + +: copy-next ( -- ) + \ Copy the normal next routine from the user area + here 5 /n* dup allot ( adr size ) + up@ -rot cmove +; + +label normal-next + copy-next +end-code + +label debnext + 'user <ip lwz t0,* + addi t2,ip,4 + cmpl 0,0,t2,t0 + >= if + 'user ip> lwz t0,* + cmpl 0,0,t2,t0 + < if + 'user cnt lwz t0,* + set t1,2 + addi t0,t0,1 + 'user cnt stw t0,* + cmp 0,0,t0,t1 + = if + set t0,0 + 'user cnt stw t0,* + + set t0,h#873d0004 \ lwzu w,4(ip) + stw t0,0(up) + + dcbf r0,up \ flush cache + icbi r0,up \ flush cache + isync + + \ Machine code for 'debug token@ execute + 'user 'debug lwz w,* + + \ Tail of "NEXT" + lwzux t1,w,base \ Read the contents of the code field + add t1,t1,base \ Relocate + mtspr lr,t1 + bclr 20,0 \ Execute the code + then + then + then + copy-next +end-code + +\ Fix the next routine to use the debug version +\ XXX This assumes that the user area and the dictionary are within +\ 16 MBytes of one another. +: pnext ( -- ) + debnext up@ - h# 3ffffff and h# 48000000 or up@ instruction! +; + +\ Turn off debugging +\ h# 873d0004 is "lwzu w,4(ip)", the first instruction of "next" +: unbug ( -- ) h# 873d0004 up@ instruction! ; + +forth definitions +syscall-vec @ 0= if +unbug +then +headers + +\ LICENSE_BEGIN +\ Copyright (c) 2007 FirmWorks +\ +\ Permission is hereby granted, free of charge, to any person obtaining +\ a copy of this software and associated documentation files (the +\ "Software"), to deal in the Software without restriction, including +\ without limitation the rights to use, copy, modify, merge, publish, +\ distribute, sublicense, and/or sell copies of the Software, and to +\ permit persons to whom the Software is furnished to do so, subject to +\ the following conditions: +\ +\ The above copyright notice and this permission notice shall be +\ included in all copies or substantial portions of the Software. +\ +\ THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, +\ EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF +\ MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND +\ NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE +\ LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION +\ OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION +\ WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. +\ +\ LICENSE_END Added: cpu/ppc/decompm.fth =================================================================== --- cpu/ppc/decompm.fth (rev 0) +++ cpu/ppc/decompm.fth 2007-07-05 17:19:17 UTC (rev 461) @@ -0,0 +1,48 @@ +purpose: Machine/implementation-dependent decompiler support +\ See license at end of file + +headerless + +only forth also hidden also definitions +: dictionary-base ( -- adr ) origin ; + +\ True if adr is a reasonable value for the interpreter pointer +: reasonable-ip? ( adr -- flag ) + dup in-dictionary? if ( ip ) + #talign 1- and 0= \ must be token-aligned + else + drop false + then +; + +\ Decompiler extension for 32-bit literals +: .llit ( ip -- ip' ) ta1+ dup l@ n. la1+ ; +: skip-llit ( ip -- ip' ) ta1+ la1+ ; +' (llit) ' .llit ' skip-llit install-decomp + +only forth also definitions +headers + +\ LICENSE_BEGIN +\ Copyright (c) 2007 FirmWorks +\ +\ Permission is hereby granted, free of charge, to any person obtaining +\ a copy of this software and associated documentation files (the +\ "Software"), to deal in the Software without restriction, including +\ without limitation the rights to use, copy, modify, merge, publish, +\ distribute, sublicense, and/or sell copies of the Software, and to +\ permit persons to whom the Software is furnished to do so, subject to +\ the following conditions: +\ +\ The above copyright notice and this permission notice shall be +\ included in all copies or substantial portions of the Software. +\ +\ THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, +\ EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF +\ MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND +\ NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE +\ LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION +\ OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION +\ WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. +\ +\ LICENSE_END Added: cpu/ppc/dectrap.fth =================================================================== --- cpu/ppc/dectrap.fth (rev 0) +++ cpu/ppc/dectrap.fth 2007-07-05 17:19:17 UTC (rev 461) @@ -0,0 +1,36 @@ +purpose: Ignore decrementer interrupt +\ See license at end of file + +headerless +label dec-handler +rfi +end-code + +headers +stand-init: Decrementer + dec-handler l@ h# 900 instruction! +; + +\ LICENSE_BEGIN +\ Copyright (c) 2007 FirmWorks +\ +\ Permission is hereby granted, free of charge, to any person obtaining +\ a copy of this software and associated documentation files (the +\ "Software"), to deal in the Software without restriction, including +\ without limitation the rights to use, copy, modify, merge, publish, +\ distribute, sublicense, and/or sell copies of the Software, and to +\ permit persons to whom the Software is furnished to do so, subject to +\ the following conditions: +\ +\ The above copyright notice and this permission notice shall be +\ included in all copies or substantial portions of the Software. +\ +\ THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, +\ EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF +\ MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND +\ NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE +\ LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION +\ OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION +\ WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. +\ +\ LICENSE_END Added: cpu/ppc/disinflt.fth =================================================================== --- cpu/ppc/disinflt.fth (rev 0) +++ cpu/ppc/disinflt.fth 2007-07-05 17:19:17 UTC (rev 461) @@ -0,0 +1,85 @@ +purpose: Disassemble inflate.bix so it can be re-assembled from Forth +\ See license at end of file + +\ Example use: +\ ppcforth tools.dic ${BP}/cpu/powerpc/disinflt.fth >inflate.dis +\ +\ The output may require some amount of manual editing... +\ To make inflate.bix: xcftobin <inflate.out >inflate.bix + +hex + +4000 buffer: buf +0 value /buf +reading inflate.bix +buf 4000 ifd @ fgets to /buf +ifd @ fclose + +: show-relative ( target -- ) + [ also assembler ] pc [ previous ] @ - + push-hex + ?dup if dup 0< if ." .-" negate else ." .+" then ." h#" ul. then + pop-base +; +: +u. ( adr -- adr' ) dup be-l@ 9 u.r la1+ ; +: dis0 ( 32b -- ) + ?dup if disasm else + [ also assembler ] pc [ previous ] @ + + dup h# 14 + buf /buf + u> if + buf /buf + over do + ." h# " i be-l@ u. ." be-l, " + /l +loop cr + bye + then + + \ Typically produces: + \ Debug: 2041 800b0300 0 49c inflate + \ ^ ^^^ ^^^^^^^ + \ 0 for leaf code name + \ routines length + + cr ." Debug: " la1+ +u. +u. +u. +u. + dup wa1+ swap be-w@ 2dup ." " type cr + + aligned 4 - + [ also assembler ] pc [ previous ] ! + then +; +: keep-going ( adr -- false ) drop false ; +also assembler +true to numeric-conditionals? +patch dis0 disasm dis1 +patch keep-going @ +dis +patch keep-going @ +dis +patch @ keep-going +dis +' show-relative is showaddr +previous + +no-page + +\ buf 20 + dis +buf dis + +\ LICENSE_BEGIN +\ Copyright (c) 2007 FirmWorks +\ +\ Permission is hereby granted, free of charge, to any person obtaining +\ a copy of this software and associated documentation files (the +\ "Software"), to deal in the Software without restriction, including +\ without limitation the rights to use, copy, modify, merge, publish, +\ distribute, sublicense, and/or sell copies of the Software, and to +\ permit persons to whom the Software is furnished to do so, subject to +\ the following conditions: +\ +\ The above copyright notice and this permission notice shall be +\ included in all copies or substantial portions of the Software. +\ +\ THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, +\ EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF +\ MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND +\ NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE +\ LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION +\ OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION +\ WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. +\ +\ LICENSE_END Added: cpu/ppc/epic.fth =================================================================== --- cpu/ppc/epic.fth (rev 0) +++ cpu/ppc/epic.fth 2007-07-05 17:19:17 UTC (rev 461) @@ -0,0 +1,73 @@ +purpose: Driver for Motorola Embedded Programmable Interrupt Controller +\ See license at end of file + +h# fdf0.0000 constant eu-pa +0 value eu-va +: map-eu ( -- ) + eu-pa h# 78 config-l! + eu-pa h# 10.0000 root-map-in to eu-va +; +: +eu ( offset -- adr ) eu-va + ; +: eu! ( l offset -- ) +eu rl! ; +: eu@ ( offset -- l ) +eu rl@ ; + +: priority! ( pri -- ) h# 60080 eu! ; +: vector@ ( -- vector ) h# 600a0 eu@ ; +: eoi ( -- ) 0 h# 600b0 eu! ; +: gcr! ( l -- ) h# 41020 eu! ; +: gcr@ ( -- l ) h# 41020 eu@ ; + +: pi! ( l -- ) h# 41090 eu! ; +: pi@ ( -- l ) h# 41090 eu@ ; + +: spurious! ( n -- ) h# 410e0 eu! ; +: eicr! ( l -- ) h# 41030 eu! ; +: eicr@ ( -- l ) h# 41030 eu@ ; + +: >irq ( channel -- adr ) h# 20 * h# 50200 + ; +: vec/pri! ( l channel -- ) >irq eu! ; +: vec/pri@ ( channel -- l ) >irq eu@ ; +: dest! ( l channel -- ) >irq h# 10 + eu! ; +: dest@ ( channel -- l ) >irq h# 10 + eu@ ; + +\ Other channels: I2C - 0x71, DMA0 - 0x72, DMA1 - 0x73, Message unit - 0x76 + +: reset-epic ( -- ) + gcr@ h# a000.0000 or gcr! + h# 2000.0000 gcr! + \ XXX should configure it for the correct mode - direct, pass-thru, etc. + + \ Eat any pending interrupts + h# 20 0 do + vector@ h# ff = if unloop exit then + eoi + loop + ." The EPIC won't stop interrupting" cr +; +stand-init: Initializing EPIC + map-eu + reset-epic +; +\ LICENSE_BEGIN +\ Copyright (c) 2007 FirmWorks +\ +\ Permission is hereby granted, free of charge, to any person obtaining +\ a copy of this software and associated documentation files (the +\ "Software"), to deal in the Software without restriction, including +\ without limitation the rights to use, copy, modify, merge, publish, +\ distribute, sublicense, and/or sell copies of the Software, and to +\ permit persons to whom the Software is furnished to do so, subject to +\ the following conditions: +\ +\ The above copyright notice and this permission notice shall be +\ included in all copies or substantial portions of the Software. +\ +\ THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, +\ EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF +\ MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND +\ NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE +\ LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION +\ OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION +\ WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. +\ +\ LICENSE_END Added: cpu/ppc/fb8-ops.fth =================================================================== --- cpu/ppc/fb8-ops.fth (rev 0) +++ cpu/ppc/fb8-ops.fth 2007-07-05 17:19:17 UTC (rev 461) @@ -0,0 +1,205 @@ +purpose: Optimized fb8 package support routines +\ See license at end of file + +headerless +decimal + +\ Invert foreground and background colors within a rectangular region +code fb8-invert ( adr width height bytes/line fg-color bg-color -- ) + \ bg-color in tos + lwz t4,0(sp) \ fg-color in t4 + lwzu t0,1cell(sp) \ bytes/line in scr + lwzu t2,1cell(sp) \ height in t1 (outer loop index, >0) + lwzu t1,1cell(sp) \ width in t2 (inner loop index, >0) + lwzu t3,1cell(sp) \ adr in sc3 (starting address) + + mfspr t6,ctr \ Save counter + + subf t0,t1,t0 \ Account for inner loop incrementing + addi t3,t3,-1 \ Account for inner loop incrementing + + begin \ Outer loop + mtspr ctr,t1 \ Starting width value + begin \ Inner loop + lbzu t5,1(t3) \ read byte + cmp 0,0,t5,tos \ Background? + = if + mr t5,t4 \ Set to foreground + else + cmp 0,0,t5,t4 \ Foreground? + = if + mr t5,tos \ Set to background + then + then + stb t5,0(t3) \ store byte + countdown \ End inner loop when width=0 + + addic. t2,t2,-1 \ decrement height until =0 + add t3,t3,t0 \ increment adr to next line + = until \ End outer loop when height=0 + + mtspr ctr,t6 \ Restore counter + lwzu tos,1cell(sp) \ Clean up stack + addi sp,sp,1cell +c; + +\ Draws a character from a 1-bit-deep font into an 8-bit-deep frame buffer +\ Assumptions: Fontbytes is 2; 0 < width <= 16 +\ Fontadr is divisible by 2 +code fb8-paint +( fontadr fontbytes width height screenadr bytes/line fg-color bg-color -- ) + \ tos already there \ bg-color in tos + lwz t9,0(sp) \ fg-color in t9 + lwzu t2,1cell(sp) \ Bytes/line - bytes per scan line + lwzu t3,1cell(sp) \ Screenadr - start address in frame buffer + lwzu t4,1cell(sp) \ Height - character height in pixels + lwzu t5,1cell(sp) \ Width - character width in pixels (bytes) + lwzu t6,1cell(sp) \ Fontbytes - bytes per font line + lwzu t7,1cell(sp) \ Fontadr - start adr of this char in font table + + addi t3,t3,-1 \ Account for pre-incrementing + subf t2,t5,t2 \ Account for inner loop incrementing + mfspr t8,ctr \ Save counter + + addi r0,r0,8 \ Constant 8 (pixels/font-byte), needed below + + + begin \ Outer loop - for all scan lines in char + lbz t0,0(t7) \ Up to 8 font bits into scr + rlwinm t0,t0,23,1,8 \ Align almost to high part of word so that + \ one more shift will affect the sign bit + + mr t1,t5 \ Reset width counter for the new scan line + + ahead \ Branch down to end of loop + begin + + cmpi 0,0,t1,8 + < if + mtspr ctr,t1 \ Set count + subf t1,t1,t1 \ Width is exhausted + else + mtspr ctr,r0 \ Max inner loop count is 8 + addi t1,t1,-8 \ Reduce width by 8 + then + + begin \ Inner loop - for each pixel in a font byte + add. t0,t0,t0 \ Shift next pixel bit to top position + 0< if + stbu t9,1(t3) \ Write foreground color to framebuffer + else + stbu tos,1(t3) \ Write background color to framebuffer + then + countdown \ Repeat until width count = 0 + + but then + cmpi 0,0,t1,0 + = until + + add t7,t7,t6 \ Next scan line in font table + addic. t4,t4,-1 \ Decrement height counter + add t3,t3,t2 \ Increment frame buffer addr to next line + = until \ Repeat until height count = 0 + + mtspr ctr,t8 \ Restore counter + lwzu tos,4(sp) \ Clean up stack + addi sp,sp,4 +c; + +\ Very fast window move, for scrolling +\ Similar to 'move', but only moves #move/line out of every 'bytes/line' bytes +\ Assumes bytes/line is divisible by 8 (for double-long load/stores) +\ Assumes src and dst separated by n*bytes/line +\ Called with: +\ src-start dst-start size bytes/line #move/line fb8-move +\ (break-lo)(cursor-y) (winbot-breaklo) (") (emu-bytes/line) +\ src > dst, so move from start towards end + +\ Note that the 601 is a 32-bit implementation. +\ It would be cool to test here, but the PVR is supervisor-only! +[ifdef] sixtyfour-bit + 8 constant fbalign +[else] + 4 constant fbalign +[then] + +code fb8-window-move ( src-start dst-start size bytes/line #move/line -- ) + \ tos=#move/line + lwz t0,0(sp) \ t0=bytes/line + lwzu t1,1cell(sp) \ t1=size + lwzu t2,1cell(sp) \ t2=dst-start + lwzu t3,1cell(sp) \ t3=src-start + + fbalign 1- addi t5,r0,* \ Get fbalign-1 into a register + + \ First, force src and dst to alignment boundary, adjust #move/line + and t4,t3,t5 \ Any extra bytes at start? + add tos,tos,t4 \ Adjust #move/line by that amount + andc t3,t3,t5 \ Lock src to alignment boundary + andc t2,t2,t5 \ Lock dst to alignment boundary + add tos,tos,t5 \ Round #move/line up to next unit + andc tos,tos,t5 + + subf t4,tos,t0 \ Account for inner loop incrementing + + fbalign negate addi t3,t3,* \ Account for pre-incrementing + fbalign negate addi t2,t2,* \ Account for pre-incrementing +[ifdef] sixtyfour-bit + rlwinm tos,tos,29,3,31 +[else] + rlwinm tos,tos,30,2,31 +[then] + mfspr t7,ctr \ Save counter + + cmpi 0,0,t1,0 + ahead \ Branch to loop end for initial comparison + begin \ Outer loop + mtspr ctr,tos \ Setup inner loop index + + begin \ Inner loop +[ifdef] sixtyfour-bit + ldzu t6,8(t3) + stdu t6,8(t2) +[else] + lwzu t6,4(t3) + stwu t6,4(t2) +[then] + countdown + + subf. t1,t0,t1 \ Decrement size until =0 + add t2,t4,t2 \ Increment src + add t3,t4,t3 \ Increment dst + but then \ Target of "ahead" branch + <= until \ End outer loop when size=0 + + mtspr ctr,t7 \ Restore counter + + lwzu tos,1cell(sp) \ Clean up stack + addi sp,sp,1cell +c; + +headers + +\ LICENSE_BEGIN +\ Copyright (c) 2007 FirmWorks +\ +\ Permission is hereby granted, free of charge, to any person obtaining +\ a copy of this software and associated documentation files (the +\ "Software"), to deal in the Software without restriction, including +\ without limitation the rights to use, copy, modify, merge, publish, +\ distribute, sublicense, and/or sell copies of the Software, and to +\ permit persons to whom the Software is furnished to do so, subject to +\ the following conditions: +\ +\ The above copyright notice and this permission notice shall be +\ included in all copies or substantial portions of the Software. +\ +\ THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, +\ EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF +\ MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND +\ NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE +\ LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION +\ OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION +\ WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. +\ +\ LICENSE_END Added: cpu/ppc/field.fth =================================================================== --- cpu/ppc/field.fth (rev 0) +++ cpu/ppc/field.fth 2007-07-05 17:19:17 UTC (rev 461) @@ -0,0 +1,45 @@ +purpose: Structures and fields for PowerPC +\ See license at end of file + +\ field creates words which add their offset within the structure +\ to the base address of the structure + +: struct ( -- 0 ) 0 ; + +: field \ name ( offset size -- offset+size ) + create over , + + + \ The high level equivalen of what the following machine code is: + \ does> @ file @ + ; + \ We write it in code because the metacompiler facilities for + \ resolving DOES> clauses are clumsy + + ;code ( struct-adr -- field-adr ) + pop-to-t0 \ Get the struct address + lwz tos,0(tos) \ Get the structure member offset + add tos,tos,t0 \ Return the structure member address +c; + +\ LICENSE_BEGIN +\ Copyright (c) 2007 FirmWorks +\ +\ Permission is hereby granted, free of charge, to any person obtaining +\ a copy of this software and associated documentation files (the +\ "Software"), to deal in the Software without restriction, including +\ without limitation the rights to use, copy, modify, merge, publish, +\ distribute, sublicense, and/or sell copies of the Software, and to +\ permit persons to whom the Software is furnished to do so, subject to +\ the following conditions: +\ +\ The above copyright notice and this permission notice shall be +\ included in all copies or substantial portions of the Software. +\ +\ THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, +\ EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF +\ MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND +\ NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE +\ LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION +\ OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION +\ WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. +\ +\ LICENSE_END Added: cpu/ppc/filecode.fth =================================================================== --- cpu/ppc/filecode.fth (rev 0) +++ cpu/ppc/filecode.fth 2007-07-05 17:19:17 UTC (rev 461) @@ -0,0 +1,165 @@ +purpose: File system support code for PowerPC +\ See license at end of file + +headerless +\ signed mixed mode addition +code ln+ (s n1 n2 -- n3 ) pop-to-t0 add tos,tos,t0 c; + +\ &ptr is the address of a pointer. fetch the pointed-to +\ character and post-increment the pointer + +code @c@++ ( &ptr -- char ) + lwz t0,0(tos) \ Fetch the pointer + mr t1,tos \ Copy of the address + lbz tos,0(t0) \ Get the byte + addi t0,t0,1 \ Increment the pointer + stw t0,0(t1) \ Replace the pointer +c; + +\ &ptr is the address of a pointer. store the character into +\ the pointed-to location and post-increment the pointer + +code @c!++ ( char &ptr -- ) + lwz t0,0(tos) \ Fetch the pointer + lwz t1,0(sp) \ char in t1 + stb t1,0(t0) \ Put the byte + addi t0,t0,1 \ Increment the pointer + stw t0,0(tos) \ Replace the pointer + lwz tos,1cell(sp) \ Fixup top of stack + addi sp,sp,2cells \ Adjust stack pointer +c; + +headers +\ "adr1 len2" is the longest initial substring of the string "adr1 len1" +\ that does not contain the character "char". "adr2 len1-len2" is the +\ trailing substring of "adr1 len1" that is not included in "adr1 len2". +\ Accordingly, if there are no occurrences of that character in "adr1 len1", +\ "len2" equals "len1", so the return values are "adr1 len1 adr1+len1 0" + +code split-string ( adr1 len1 char -- adr1 len2 adr1+len2 len1-len2 ) + \ char in tos + lwz t1,0(sp) \ len1 + lwz t0,1cell(sp) \ adr1 + + cmpi 0,0,t1,0 \ Test length + 0<> if + mfspr t5,ctr + mtspr ctr,t1 + + addi t0,t0,-1 \ Account for pre-increment + + begin + lbzu t3,1(t0) \ get the next character + cmp 0,0,t3,tos \ Look for the terminator character + bc 0,2,* + + = if \ Found terminator? + mfspr tos,ctr \ len1-len2-1 + addi tos,tos,1 \ len1-len2 + subfc t1,tos,t1 \ len2 ( Use subfc for POWER compatibility) + stw t1,0(sp) \ store len2 on stack + + stwu t0,-1cell(sp) \ Store adr1+len2 on stack + mtspr ctr,t5 + next + then + mtspr ctr,t5 + then + + \ The test character is not present in the input string + + stwu t0,-1cell(sp) \ Store adr1+len2 on stack + addi tos,r0,0 \ Return rem-len=0 +c; + +headerless +\ Splits a buffer into two parts around the first line delimiter +\ sequence. A line delimiter sequence is either CR, LF, CR followed by LF, +\ or LF followed by CR. +\ adr1 len2 is the initial substring before, but not including, +\ the first line delimiter sequence. +\ adr2 len3 is the trailing substring after, but not including, +\ the first line delimiter sequence. + +code parse-line ( adr1 len1 -- adr1 len2 adr2 len3 ) + mr t1,tos \ len1 + lwz t0,0(sp) \ adr1 + + set tos,10 \ Delimiter 1 (linefeed) + set t4,13 \ Delimiter 2 (carriage return) + + cmpi 0,0,t1,0 \ Test length + 0<> if + mfspr t5,ctr + mtspr ctr,t1 + + addi t0,t0,-1 \ Account for pre-increment + + begin + lbzu t2,1(t0) \ get the next character + cmp 0,0,t2,tos <> if cmp 0,0,t2,t4 then \ Compare to delimiters + bc 0,2,* + + = if \ Found delimiter? + mfspr t3,ctr \ len1-len2 + addi t3,t3,1 + addi t0,t0,1 \ Consume first delimiter + + subfc t1,t3,t1 \ len2 ( Use subfc for POWER compatibility) + stwu t1,-1cell(sp) \ store len2 on stack + + addic. t3,t3,-1 + 0<> if \ Is there another delimiter? + lbz t6,0(t0) \ Get the next character + + \ Compare next character to other delimiter + cmp 0,0,t2,tos = if cmp 0,0,t6,t4 else cmp 0,0,t6,tos then + + = if \ If next character is the other delimiter + addi t0,t0,1 \ ... consume it + addi t3,t3,-1 + then + then + stwu t0,-1cell(sp) \ Store adr1+len2 on stack + + mr tos,t3 \ Return len1-len2 + mtspr ctr,t5 + next + then + mtspr ctr,t5 + then + + \ There is no line delimiter in the input string + + stwu t1,-1cell(sp) \ Store len2 (=len1) on stack + stwu t0,-1cell(sp) \ Store adr1+len2 on stack + addi tos,r0,0 \ Return rem-len=0 +c; + +headers + +nuser delimiter + +\ LICENSE_BEGIN +\ Copyright (c) 2007 FirmWorks +\ +\ Permission is hereby granted, free of charge, to any person obtaining +\ a copy of this software and associated documentation files (the +\ "Software"), to deal in the Software without restriction, including +\ without limitation the rights to use, copy, modify, merge, publish, +\ distribute, sublicense, and/or sell copies of the Software, and to +\ permit persons to whom the Software is furnished to do so, subject to +\ the following conditions: +\ +\ The above copyright notice and this permission notice shall be +\ included in all copies or substantial portions of the Software. +\ +\ THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, +\ EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF +\ MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND +\ NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE +\ LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION +\ OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION +\ WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. +\ +\ LICENSE_END Added: cpu/ppc/filefld.fth =================================================================== --- cpu/ppc/filefld.fth (rev 0) +++ cpu/ppc/filefld.fth 2007-07-05 17:19:17 UTC (rev 461) @@ -0,0 +1,50 @@ +purpose: Code words to support the file system interface +\ See license at end of file + +nuser file + +:-h struct ( -- 0 ) 00 ;-h + +\ Run-time action for fields +code dofield + lwz tos,0(tos) \ Get the structure member offset + 'user file lwz t0,* \ Get the structure base address + add tos,tos,t0 \ Return the structure member address +c; + +\ Assembles the code field when metacompiling a field +:-h file-field-cf ( -- ) + dodoes token,-t + " dofield" $sfind drop resolution@ token,-t \ code field +;-h + +\ Metacompiler defining word for creating fields +:-h file-field \ name ( offset size -- offset' ) + " file-field-cf" header-t \ name field and code field + over ,-t + ?debug \ parameter field +;-h + + +\ LICENSE_BEGIN +\ Copyright (c) 2007 FirmWorks +\ +\ Permission is hereby granted, free of charge, to any person obtaining +\ a copy of this software and associated documentation files (the +\ "Software"), to deal in the Software without restriction, including +\ without limitation the rights to use, copy, modify, merge, publish, +\ distribute, sublicense, and/or sell copies of the Software, and to +\ permit persons to whom the Software is furnished to do so, subject to +\ the following conditions: +\ +\ The above copyright notice and this permission notice shall be +\ included in all copies or substantial portions of the Software. +\ +\ THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, +\ EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF +\ MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND +\ NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE +\ LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION +\ OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION +\ WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. +\ +\ LICENSE_END Added: cpu/ppc/finish.fth =================================================================== --- cpu/ppc/finish.fth (rev 0) +++ cpu/ppc/finish.fth 2007-07-05 17:19:17 UTC (rev 461) @@ -0,0 +1,41 @@ +purpose: Final cleanup for kernel metacompilation +\ See license at end of file + +' init is do-init +' sys-init-io is init-io + +also assembler +'body cold-code 4 + cld 8 + put-branch +previous +variable dodoesaddr + +assembler dodoes meta is dodoesaddr +forth-h +metaoff +only forth also definitions +fix-vocabularies +' symbols fixall + +\ LICENSE_BEGIN +\ Copyright (c) 2007 FirmWorks +\ +\ Permission is hereby granted, free of charge, to any person obtaining +\ a copy of this software and associated documentation files (the +\ "Software"), to deal in the Software without restriction, including +\ without limitation the rights to use, copy, modify, merge, publish, +\ distribute, sublicense, and/or sell copies of the Software, and to +\ permit persons to whom the Software is furnished to do so, subject to +\ the following conditions: +\ +\ The above copyright notice and this permission notice shall be +\ included in all copies or substantial portions of the Software. +\ +\ THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, +\ EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF +\ MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND +\ NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE +\ LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION +\ OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION +\ WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. +\ +\ LICENSE_END Added: cpu/ppc/fixvoc.fth =================================================================== --- cpu/ppc/fixvoc.fth (rev 0) +++ cpu/ppc/fixvoc.fth 2007-07-05 17:19:17 UTC (rev 461) @@ -0,0 +1,52 @@ +purpose: Fixup vocabularies at the end of kernel metacompilation +\ See license at end of file + +only forth meta also forth also definitions +\ Nasty kludge to resolve the to pointer to the does> clause of vocabulary +\ within "forth". The problem is that the code field of "forth" contains +\ a call instruction to the does> clause of vocabulary. This call is a +\ forward reference which cannot be resolved in the same way as compiled +\ addresses. + +: used-t ( definer-acf child-acf -- ) + [ also meta ] token!-t [ previous ] +; + +: fix-vocabularies ( -- ) + [""] <vocabulary> also symbols find previous ( acf true | str false ) + 0= abort" Can't find <vocabulary> in symbols" + dup resolution@ >r ( acf ) ( Return stack: <vocabulary>-adr ) + dup first-occurrence@ ( acf occurrence ) + \ Don't let fixall muck with this entry later + 0 rot >first-occurrence ! ( occurrence ) + begin another-occurrence? while ( occurrence ) + dup [ meta ] token@-t [ forth ] swap ( next-occurrence occurrence ) + \ Calculate the longword offset to the vocabulary does> clause + r@ swap used-t + repeat + r> drop +; + +\ LICENSE_BEGIN +\ Copyright (c) 2007 FirmWorks +\ +\ Permission is hereby granted, free of charge, to any person obtaining +\ a copy of this software and associated documentation files (the +\ "Software"), to deal in the Software without restriction, including +\ without limitation the rights to use, copy, modify, merge, publish, +\ distribute, sublicense, and/or sell copies of the Software, and to +\ permit persons to whom the Software is furnished to do so, subject to +\ the following conditions: +\ +\ The above copyright notice and this permission notice shall be +\ included in all copies or substantial portions of the Software. +\ +\ THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, +\ EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF +\ MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND +\ NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE +\ LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION +\ OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION +\ WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. +\ +\ LICENSE_END Added: cpu/ppc/flipdic.fth =================================================================== --- cpu/ppc/flipdic.fth (rev 0) +++ cpu/ppc/flipdic.fth 2007-07-05 17:19:17 UTC (rev 461) @@ -0,0 +1,71 @@ +purpose: Endian-swap the Forth dictionary for PowerPC +\ See license at end of file + +\needs bittest fload ${BP}/forth/lib/bitops.fth +\needs lbflip \needs lbsplit fload ${BP}/forth/lib/split.fth +\needs lbflip : lbflip ( l1 -- l2 ) lbsplit swap 2swap swap bljoin ; +\needs lbflips : lbflips ( a l -- ) bounds ?do i l@ lbflip i l! /l +loop ; + +0 value header +h# 20 constant /header +0 value dict +0 value /dict +0 value ua +0 value /ua +0 value relmap +0 value total-size + +: ?lbflips ( adr len -- ) + 3 + 4 / 0 ?do ( adr ) + i relmap bittest 0= if ( adr ) + dup i la+ dup l@ lbflip swap l! ( adr ) + then ( adr ) + loop ( adr ) + drop +; + +reading fw.dil +ifd @ fsize to total-size +total-size alloc-mem to header +header total-size ifd @ fgets drop +ifd @ fclose + +header /header + to dict +header 1 la+ l@ to /dict + +dict /dict + to ua +header 2 la+ l@ to /ua + +ua /ua + to relmap + +header /header lbflips +dict /dict ?lbflips +ua /ua lbflips + +writing fw.dic +header total-size ofd @ fputs +ofd @ fclose + +\ LICENSE_BEGIN +\ Copyright (c) 2007 FirmWorks +\ +\ Permission is hereby granted, free of charge, to any person obtaining +\ a copy of this software and associated documentation files (the +\ "Software"), to deal in the Software without restriction, including +\ without limitation the rights to use, copy, modify, merge, publish, +\ distribute, sublicense, and/or sell copies of the Software, and to +\ permit persons to whom the Software is furnished to do so, subject to +\ the following conditions: +\ +\ The above copyright notice and this permission notice shall be +\ included in all copies or substantial portions of the Software. +\ +\ THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, +\ EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF +\ MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND +\ NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE +\ LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION +\ OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION +\ WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. +\ +\ LICENSE_END Added: cpu/ppc/flips.fth =================================================================== --- cpu/ppc/flips.fth (rev 0) +++ cpu/ppc/flips.fth 2007-07-05 17:19:17 UTC (rev 461) @@ -0,0 +1,63 @@ +purpose: Switch to little-endian after the firmware is already running +\ See license at end of file + +code lbflips ( adr len -- ) + mfspr r10,ctr + + mr r6,tos + rlwinm r6,r6,30,2,31 \ Divide by /l + mtspr ctr,r6 + + lwz r5,0(sp) + addi sp,sp,1cell + + begin + lwz r4,0(r5) + stwbrx r4,r0,r5 + addi r5,r5,4 + countdown + mtspr ctr,r10 +c; + +code wbflips ( adr len -- ) + mfspr r10,ctr + + mr r6,tos + rlwinm r6,r6,31,1,31 \ Divide by /w + mtspr ctr,r6 + + lwz r5,0(sp) + addi sp,sp,1cell + + begin + lhz r4,0(r5) + sthbrx r4,r0,r5 + addi r5,r5,2 + countdown + mtspr ctr,r10 +c; + + +\ LICENSE_BEGIN +\ Copyright (c) 2007 FirmWorks +\ +\ Permission is hereby granted, free of charge, to any person obtaining +\ a copy of this software and associated documentation files (the +\ "Software"), to deal in the Software without restriction, including +\ without limitation the rights to use, copy, modify, merge, publish, +\ distribute, sublicense, and/or sell copies of the Software, and to +\ permit persons to whom the Software is furnished to do so, subject to +\ the following conditions: +\ +\ The above copyright notice and this permission notice shall be +\ included in all copies or substantial portions of the Software. +\ +\ THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, +\ EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF +\ MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND +\ NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE +\ LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION +\ OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION +\ WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. +\ +\ LICENSE_END Added: cpu/ppc/forthint.fth =================================================================== --- cpu/ppc/forthint.fth (rev 0) +++ cpu/ppc/forthint.fth 2007-07-05 17:19:17 UTC (rev 461) @@ -0,0 +1,258 @@ +purpose: Low-level handler for alarm interrupt +\ See license at end of file + +headerless +\ Interfaces to system-dependent routines +defer init-dispatcher ( -- ) ' noop to init-dispatcher +defer dispatch-interrupt ' noop to dispatch-interrupt + +h# 400 constant /intstack +hex + +0 value tick-limit +0 value 'rm-intret + +decimal + +label rm-interrupt-return ( -- ) + mfspr r2,sprg0 \ physical address of this cpu's exception-area + + stw t3,h#0c(r2) \ Put derived flag in a safe place + + lwz r31,h#9fc(r0) \ Address of interrupt save area + + \ Now we have to get these guys back into the per-prpcessor + \ save area. They were squirreld away here by interrupt-preamble + 38 /l* 31 lwz r0,* stw r0,0(r2) \ r3 + 39 /l* 31 lwz r0,* stw r0,4(r2) \ r2 + 40 /l* 31 lwz r0,* stw r0,8(r2) \ lr + + 32 /l* 31 lwz r0,* mtspr xer,r0 \ xer + 34 /l* 31 lwz r0,* mtspr ctr,r0 \ ctr + 35 /l* 31 lwz r0,* mtspr srr0,r0 \ saved pc + 36 /l* 31 lwz r0,* mtspr srr1,r0 \ saved msr + +\ XXX the next line is probably unnecessary, because RFI doesn't change the +\ ILE bit, and we are careful to preserve it when we enter the high-level +\ handler. + mfmsr r1 rlwimi r1,r0,0,15,15 mtmsr r1 \ Restore MSR ILE bit - RFI won't + + 37 /l* 31 lwz r0,* stw r0,h#10(r2) \ Put CR in low memory area + + \ Assemble 32 "lwz rN,N*4(r31)" instructions + 32 0 do + i 4 * ( offset ) 31 ( r31 ) i ( reg# ) " lwz *,*" evaluate + loop + + mfspr r2,sprg0 + + \ Now the registers and low-memory values are back to the state that + \ existed upon entry to the interrupt handler. We can use only r3 and lr + \ in the following code. + + lwz r3,h#0c(r2) \ Abort flag + cmpi 0,0,r3,0 + <> if \ Abort if non-zero + lwz r3,h#10(r2) \ Restore CR + mtcrf h#ff,r3 + + lwz r3,h#9f0(r0) \ Save-state address + mtspr lr,r3 + addi r3,r0,-1 \ Indicate an abort + stw r3,h#0c(r2) \ Exception # + bclr 20,0 \ Jump to save-state + then + + lwz r3,h#10(r2) \ Restore CR + mtcrf h#ff,r3 + + lwz r3,h#08(r2) \ Restore LR + mtspr lr,r3 + + lwz r3,h#0(r2) \ Restore r3 + lwz r2,h#04(r2) \ Restore r2 + + rfi +end-code + +code interrupt-return ( -- ) + + \ At the first indication of a keyboard abort, we branch to the + \ Forth entry trap handler. We do the actual branch after we have + \ restored all the state, so it appears as if Forth were entered + \ directly from the program that was running, rather than through + \ the interrupt handler. + + addi t3,r0,0 \ Clear derived abort flag + 'user aborted? lwz t5,* \ Abort flag + + cmpi 0,0,t5,1 + = if + \ Don't abort in the middle of the terminal emulator, because + \ it's not reentrant. + + 'user terminal-locked? lwz t4,* + cmpi 0,0,t4,0 + = if + + \ Increment the abort flag past 1 so that we won't see it again + \ until the interpreter has seen and cleared it. + addi t5,t5,1 + 'user aborted? stw t5,* + + addi t3,r0,-1 \ Set derived abort flag + then + then + + mfmsr t4 + rlwinm t4,t4,0,28,25 \ Get back into real mode so we won't have + mtspr srr1,t4 \ translation faults in the following code. + + 'user 'rm-intret lwz t4,* + mtspr srr0,t4 + + rfi +end-code + +: interrupt-handler ( exc-adr -- ) + h# 900 = if check-alarm else dispatch-interrupt then + interrupt-return +; + +\ This routine is entered in real mode. +\ r2, r3, and lr have been saved. r2 points to the this cpu's exception-area, +\ r3 points to the address where the exception occured. +label interrupt-preamble + stw r3,h#9e8(r0) \ Save exception address + lwz r3,h#9fc(r0) \ Physical address of register save area + + \ Save the registers + + \ Assemble 32 "stw rN,N*4(r3)" instructions + 32 0 do + i 4 * ( offset ) 3 ( r3 ) i ( reg# ) " stw *,*" evaluate + loop + + \ We can't leave these in the sprg save area because they will + \ get trounced if we get a DSI in the hi level part of the handler + lwz r0,0(r2) 38 /l* 3 stw r0,* \ r3 + lwz r0,4(r2) 39 /l* 3 stw r0,* \ r2 + lwz r0,8(r2) 40 /l* 3 stw r0,* \ lr + + mfspr r0,xer 32 /l* 3 stw r0,* \ xer + mfspr r0,ctr 34 /l* 3 stw r0,* \ ctr + mfspr r0,srr0 35 /l* 3 stw r0,* \ saved pc + mfspr r0,srr1 + + \ Save the ILE bit too; it doesn't show up in SRR1, so we get it + \ from the LE bit in in the current MSR value, putting it in its + \ normal position in the saved value. + mfmsr r1 rlwimi r0,r1,16,15,15 + + \ Keep a copy for later use in establishing the MSR value for the + \ high-level interrupt handler, but turn off the EE bit so that the + \ handler can't be re-entered + rlwinm t1,r0,0,17,15 + + 36 /l* 3 stw r0,* \ saved msr + mfcr r0 37 /l* 3 stw r0,* \ cr + + lwz t0,h#9ec(r0) \ Virtual address of interrupt stack area + + \ Set up Forth stacks + addi sp,t0,h#200 \ Data stack pointer + addi rp,sp,h#200 \ Return stack pointer + + lwz t0,h#9f4(r0) \ Get decrementer initial value + mtspr dec,t0 \ Restart ticker + + here 4 + bl * \ Get address of next instruction into LR + here origin - set t0,* \ Relative address of this instruction + mfspr base,lr + subf base,t0,base \ Base register is now set (physical address) + + 'body main-task set up,* \ Relative address of main-task + lwzx up,up,base \ User pointer is now set + + lwz base,h#9f8(r0) \ Virtual address of origin + lwz tos,h#9e8(r0) \ Stack exception address + + 'body interrupt-handler 4 - set ip,* + add ip,ip,base + + mtspr ctr,up \ Pointer to NEXT routine + + \ Restore old MSR value so normal address translation can occur, but + \ don't allow other external interrupts + mtspr srr1,t1 \ Old MSR value + mtspr srr0,up \ Address of NEXT routine + rfi +end-code + +\ code dec! ( #ticks -- ) +\ mtspr dec,tos +\ lwz tos,0(sp) +\ addi sp,sp,1cell +\ c; +\ code dec@ ( -- #ticks ) +\ stwu tos,-1cell(sp) +\ mfspr tos,dec +\ c; + +\ The implementations are defined in msr.fth +' (enable-interrupts) to enable-interrupts +' (disable-interrupts) to disable-interrupts +' (lock) to lock[ +' (unlock) to ]unlock + +: set-tick-limit ( #msecs -- ) + to ms/tick + ms/tick counts/ms * to tick-limit + tick-limit dec! + tick-limit h# 9f4 ! +; +: install-alarm ( -- ) + \ Put various important parameters in real memory where the + \ real-mode part of the interrupt handler can find them. + + /intstack alloc-mem dup h# 9ec ! >physical h# 9fc ! \ Interrupt stack + origin h# 9f8 ! + tick-limit h# 9f4 ! + save-state >physical h# 9f0 ! + + rm-interrupt-return >physical to 'rm-intret + + disable-interrupts + interrupt-preamble h# 500 put-exception \ External interrupt + interrupt-preamble h# 900 put-exception \ Decrementer interrupt + init-dispatcher + d# 10 set-tick-limit + enable-interrupts \ Turn interrupts on +; + +headers +hex + +\ LICENSE_BEGIN +\ Copyright (c) 2007 FirmWorks +\ +\ Permission is hereby granted, free of charge, to any person obtaining +\ a copy of this software and associated documentation files (the +\ "Software"), to deal in the Software without restriction, including +\ without limitation the rights to use, copy, modify, merge, publish, +\ distribute, sublicense, and/or sell copies of the Software, and to +\ permit persons to whom the Software is furnished to do so, subject to +\ the following conditions: +\ +\ The above copyright notice and this permission notice shall be +\ included in all copies or substantial portions of the Software. +\ +\ THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, +\ EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF +\ MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND +\ NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE +\ LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION +\ OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION +\ WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. +\ +\ LICENSE_END Added: cpu/ppc/ftrace.fth =================================================================== --- cpu/ppc/ftrace.fth (rev 0) +++ cpu/ppc/ftrace.fth 2007-07-05 17:19:17 UTC (rev 461) @@ -0,0 +1,33 @@ +purpose: Display a Forth stack backtrace +\ See license at end of file + +only forth also hidden also forth definitions +: ftrace ( -- ) \ Forth stack + ip >saved .traceline + rp >saved rssave-end swap (rstrace +; +only forth also definitions + +\ LICENSE_BEGIN +\ Copyright (c) 2007 FirmWorks +\ +\ Permission is hereby granted, free of charge, to any person obtaining +\ a copy of this software and associated documentation files (the +\ "Software"), to deal in the Software without restriction, including +\ without limitation the rights to use, copy, modify, merge, publish, +\ distribute, sublicense, and/or sell copies of the Software, and to +\ permit persons to whom the Software is furnished to do so, subject to +\ the following conditions: +\ +\ The above copyright notice and this permission notice shall be +\ included in all copies or substantial portions of the Software. +\ +\ THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, +\ EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF +\ MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND +\ NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE +\ LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION +\ OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION +\ WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. +\ +\ LICENSE_END Added: cpu/ppc/gdb.fth =================================================================== --- cpu/ppc/gdb.fth (rev 0) +++ cpu/ppc/gdb.fth 2007-07-05 17:19:17 UTC (rev 461) @@ -0,0 +1,67 @@ +purpose: PowerPC-specific words for remote GDB interface +\ See license at end of file + +only forth also hidden also definitions +headerless + +: ppc-read-registers ( -- ) + xbuf + %r0 gr %r1 gr %r2 gr %r3 gr %r4 gr %r5 gr %r6 gr %r7 gr + %r8 gr %r9 gr %r10 gr %r11 gr %r12 gr %r13 gr %r14 gr %r15 gr + %r16 gr %r17 gr %r18 gr %r19 gr %r20 gr %r21 gr %r22 gr %r23 gr + %r24 gr %r25 gr %r26 gr %r27 gr %r28 gr %r29 gr %r30 gr %r31 gr + + %f0 dr %f1 dr %f2 dr %f3 dr %f4 dr %f5 dr %f6 dr %f7 dr + %f8 dr %f9 dr %f10 dr %f11 dr %f12 dr %f13 dr %f14 dr %f15 dr + %f16 dr %f17 dr %f18 dr %f19 dr %f20 dr %f21 dr %f22 dr %f23 dr + %f24 dr %f25 dr %f26 dr %f27 dr %f28 dr %f29 dr %f30 dr %f31 dr + +\ %y gr %psr gr %wim gr %tbr gr %pc gr %npc gr %fpsr gr %cpsr gr + xbuf tuck - putpkt +; +: ppc-write-registers ( -- ) + rbuf 1+ + v to %r0 v to %r1 v to %r2 v to %r3 v to %r4 v to %r5 v to %r6 v to %r7 + v to %r8 v to %r9 v to %r10 v to %r11 v to %r12 v to %r13 v to %r14 v to %r15 + v to %r16 v to %r17 v to %r18 v to %r19 v to %r20 v to %r21 v to %r22 v to %r23 + v to %r24 v to %r25 v to %r26 v to %r27 v to %r28 v to %r29 v to %r30 v to %r31 + + w to %f0 w to %f1 w to %f2 w to %f3 w to %f4 w to %f5 w to %f6 w to %f7 + w to %f8 w to %f9 w to %f10 w to %f11 w to %f12 w to %f13 w to %f14 w to %f15 + w to %f16 w to %f17 w to %f18 w to %f19 w to %f20 w to %f21 w to %f22 w to %f23 + w to %f24 w to %f25 w to %f26 w to %f27 w to %f28 w to %f29 w to %f30 w to %f31 + +\ v to %y v to %psr v to %wim v to %tbr v to %pc v to %npc +\ v to %fpsr v to %cpsr gr + drop + okay-reply +; +' ppc-read-registers to read-registers +' ppc-write-registers to write-registers + +headers +only forth also definitions + +\ LICENSE_BEGIN +\ Copyright (c) 2007 FirmWorks +\ +\ Permission is hereby granted, free of charge, to any person obtaining +\ a copy of this software and associated documentation files (the +\ "Software"), to deal in the Software without restriction, including +\ without limitation the rights to use, copy, modify, merge, publish, +\ distribute, sublicense, and/or sell copies of the Software, and to +\ permit persons to whom the Software is furnished to do so, subject to +\ the following conditions: +\ +\ The above copyright notice and this permission notice shall be +\ included in all copies or substantial portions of the Software. +\ +\ THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, +\ EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF +\ MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND +\ NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE +\ LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION +\ OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION +\ WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. +\ +\ LICENSE_END Added: cpu/ppc/getms.fth =================================================================== --- cpu/ppc/getms.fth (rev 0) +++ cpu/ppc/getms.fth 2007-07-05 17:19:17 UTC (rev 461) @@ -0,0 +1,261 @@ +purpose: Interval timing functions +\ See license at end of file + +headerless +code 601? ( -- flag ) + stwu tos,-1cell(sp) + mfspr tos,pvr + rlwinm tos,tos,16,16,31 + cmpi 0,0,tos,1 + = if + set tos,-1 + else + set tos,0 + then +c; + +\ 604 TB is incremented at 1/4 the speed of the system bus. +\ at 40Mhz sysclk, there are 10000 counts/ms. +\ at 50Mhz sysclk, there are 12500 counts/ms. +\ default: 50Mhz +\ d# 8250 value counts/ms \ For a 603 with a 33 MHz bus clock +\ d# 10000 value counts/ms \ For a 604 with a 40 MHz bus clock +\ d# 12500 value counts/ms \ For a 604 with a 50 MHz bus clock +\ d# 16500 value counts/ms \ For a 604 with a 66 MHz bus clock + +headers +d# 8250 value counts/ms \ For a 603 with a 33 MHz bus clock + +headerless +\ XXX Put in the actual ratios when IBM gets around to documenting +\ the encoding of the bus ratio field +\ create 620-ratios ? c, ? c, ? c, ? c, +: bus-ratio ( -- n ) + 620-class? if +\ buscsr@ d# 22 2 bits 620-ratios + c@ + 1 \ Temporary value + else + 4 + then +; +headers +\ We want "microseconds" to have a range of at least 1 second +\ (1,000,000 microseconds) and as good a precision as possible +\ given that constraint. We do this by choosing multiplier and +\ divisor values accordingly. +0 value us-multiplier +0 value us-divisor +: calibrate-microseconds ( -- ) + \ The starting multiplier is counts/ms and the starting divisor is + \ 1000 (microseconds/millisecond). We can eliminate common factors + \ without introducing inaccuracy, so we go ahead and do that. The + \ factors of 1000 are 2x2x2x5x5x5. + + d# 1000 counts/ms ( denominator numerator ) + + \ Remove powers of two + begin 2dup or 1 and 0= while swap 2/ swap 2/ repeat ( den' num' ) + + \ Remove powers of 5 + begin ( den num ) + over 5 mod 0= over 5 mod 0= and ( den num flag ) + while ( den num ) + swap 5 / swap 5 / ( den' num' ) + repeat ( den num ) + + \ At this point, if the numerator is still too large (unlikely), + \ we divide the numerator by the denominator and accept the loss + \ in precision. + dup d# 4294 > if ( den num ) + swap / 1 swap ( 1 num' ) + then + + \ If the numerator is *still* too large, we just live with the + \ loss in range. We could do something like use 64-bit arithmetic + \ or loop over several calls to the low-level primitive, but we will + \ cross that bridge when we get to it (it won't happen until we see + \ a processor with a timebase tick rate of > 4K ticks/microsecond; + \ the timebase rate is typically scaled down considerably from the + \ instruction rate). + to us-multiplier to us-divisor +; + +\ The 601 increments the RTC register pair and decrements the +\ decrementer register by 128 counts every 128 nsec, thus their +\ count values represent nanoseconds. Other PowerPC processors +\ count bus clocks, with no absolute calibration. +: calibrate-ticker ( -- ) + 601? if + d# 1000000 + else + d# 8250 + + \ Current PowerPC processors run the timebase at 1/4 the bus clock + " /" find-package if + " clock-frequency" rot get-package-property 0= if ( n adr len ) + rot drop get-encoded-int d# 1000 / ( n' ) + bus-ratio / + then + then + + then + to counts/ms + calibrate-microseconds +; +headerless + +code get-rtclu ( -- nsec sec ) + stwu tos,-4(sp) + begin \ Loop until we get a consistent sample + mfspr t1,rtcu + mfspr t0,rtcl + mfspr tos,rtcu + cmp 0,0,t1,tos + = until + stwu t0,-4(sp) +c; +code get-tb ( -- ticks.lo ticks.hi ) + stwu tos,-4(sp) + begin \ Loop until we get a consistent sample + isync + mftb t1,tbu + mftb t0,tb + mftb tos,tbu + cmp 0,0,t1,tos + = until + stwu t0,-4(sp) +c; +: get-msecs-601 ( -- ms ) + get-rtclu d# 40000000 mod d# 1000 * swap counts/ms / + +; +: get-msecs-ppc ( -- ms ) get-tb counts/ms um/mod nip ; +: (get-msecs) ( -- ms ) 601? if get-msecs-601 else get-msecs-ppc then ; +' (get-msecs) to get-msecs + +: ms-601 ( n -- ) + d# 1000 /mod ( msec sec ) + swap counts/ms * swap ( nsec sec ) + get-rtclu ( nsec sec nsec sec ) + rot + -rot + dup d# 1000000000 >= if + d# 1000000000 - swap 1+ + else + swap + then ( target-nsec target-sec ) + + begin + get-rtclu ( target-nsec target-sec nsec sec ) + 2 pick 2dup u> if 5drop exit then ( t-n t-s n s t-s ) + = if + 2 pick ( t-n t-s n t-n ) u>= if 2drop exit then + else + drop + then + again +; +: ms-ppc ( n -- ) + counts/ms um* ( d.nsec ) + get-tb d+ ( d.target-ticks ) + + begin + get-tb ( d.target-ticks d.ticks ) + 2over d- ( d.target-ticks d.diff ) + nip 0>= + until + 2drop +; +: (ms) ( n -- ) 601? if ms-601 else ms-ppc then ; +' (ms) to ms + +code dec! ( #ticks -- ) \ Store the decrementer register + sync + mtspr dec,tos + sync + lwz tos,0(sp) + addi sp,sp,1cell +c; + +code dec@ ( -- #ticks ) \ Read the decrementer rgister + stwu tos,-1cell(sp) + sync + mfspr tos,dec +c; +code tb@ ( -- ticks.lo ) + stwu tos,-4(sp) + isync + mftb tos,tb +c; + + +\ On a 60 MHz 8xx, the fixed overhead of this word is about .5 microseconds, +\ so the actual time delay is about half a count longer. On faster processors, +\ the overhead might be somewhat smaller, although the multiply time, the +\ time to enable and disable interrupts, and the time to read the time base +\ register might not quite scale with the clock rate. + +\ Delay at least n microseconds. Interrupts remain enabled. +code unlocked-microseconds ( #microseconds -- ) + 'user us-multiplier lwz t0,* \ Multiplier + mullw tos,t0,tos \ Counts*125 + 'user us-divisor lwz t0,* \ Divisor + divwu tos,tos,t0 \ Counts + mftb t0,tb \ Current time + add tos,tos,t0 \ Target time + begin + mftb t0,tb \ Get time + subf. t0,tos,t0 \ Compare to target using circular arithmetic + 0>= until \ Spin until target time reached + lwz tos,0(sp) \ Clean up stack + addi sp,sp,4 +c; + +\ Delay n microseconds with interrupts disabled. This gives more precise +\ timing but keeps the processor from doing other things. +code microseconds ( #microseconds -- ) + mfmsr t1 + rlwinm t2,t1,0,17,15 \ Clear interrupt enable bit + mtmsr t2 \ Disable interrupts + + 'user us-multiplier lwz t0,* \ Multiplier + mullw tos,t0,tos \ Counts*125 + 'user us-divisor lwz t0,* \ Divisor + divwu tos,tos,t0 \ Counts + mftb t0,tb \ Current time + add tos,tos,t0 \ Target time + begin + mftb t0,tb \ Get time + subf. t0,tos,t0 \ Compare to target using circular arithmetic + 0>= until \ Spin until target time reached + lwz tos,0(sp) \ Clean up stack + addi sp,sp,4 + + mtmsr t1 \ Restore interrupts +c; + +headers +stand-init: Calibrate + calibrate-ticker +; + +\ LICENSE_BEGIN +\ Copyright (c) 2007 FirmWorks +\ +\ Permission is hereby granted, free of charge, to any person obtaining +\ a copy of this software and associated documentation files (the +\ "Software"), to deal in the Software without restriction, including +\ without limitation the rights to use, copy, modify, merge, publish, +\ distribute, sublicense, and/or sell copies of the Software, and to +\ permit persons to whom the Software is furnished to do so, subject to +\ the following conditions: +\ +\ The above copyright notice and this permission notice shall be +\ included in all copies or substantial portions of the Software. +\ +\ THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, +\ EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF +\ MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND +\ NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE +\ LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION +\ OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION +\ WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. +\ +\ LICENSE_END Added: cpu/ppc/hacks.fth =================================================================== --- cpu/ppc/hacks.fth (rev 0) +++ cpu/ppc/hacks.fth 2007-07-05 17:19:17 UTC (rev 461) @@ -0,0 +1,43 @@ +purpose: Little code fragments to clip out and paste in real programs as needed +\ See license at end of file + +\ For startup code - displays I and D if caches on, i and d if caches off +mfspr t0,hid0 +andi. t0,t0,h#4000 +0<> if + ascii D ?report +else + ascii d ?report +then + +mfspr t0,hid0 +andi. t0,t0,h#8000 +0<> if + ascii I ?report +else + ascii i ?report +then + +\ LICENSE_BEGIN +\ Copyright (c) 2007 FirmWorks +\ +\ Permission is hereby granted, free of charge, to any person obtaining +\ a copy of this software and associated documentation files (the +\ "Software"), to deal in the Software without restriction, including +\ without limitation the rights to use, copy, modify, merge, publish, +\ distribute, sublicense, and/or sell copies of the Software, and to +\ permit persons to whom the Software is furnished to do so, subject to +\ the following conditions: +\ +\ The above copyright notice and this permission notice shall be +\ included in all copies or substantial portions of the Software. +\ +\ THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, +\ EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF +\ MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND +\ NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE +\ LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION +\ OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION +\ WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. +\ +\ LICENSE_END Added: cpu/ppc/htabmmu.fth =================================================================== --- cpu/ppc/htabmmu.fth (rev 0) +++ cpu/ppc/htabmmu.fth 2007-07-05 17:19:17 UTC (rev 461) @@ -0,0 +1,753 @@ +purpose: HTAB paged MMU driver +\ See license at end of file + +also forth definitions + +headers + +h# 1.0000 value /htab +/htab value htab +/htab value htab-phys + +headerless + +false value mmu64? +h# 40 value tag-h +h# 8000.0000 value tag-v + 8 value /htab-entry +/htab-entry 8 * value /htab-group +previous definitions + +also +: invalidate-pte ( pte-adr -- ) 0 swap l! ; + +\ Data in exception vector area: +\ 4f0: save-state address +\ 4f4: PTEG roving replacement offset +\ 4f8: physical base address of "translations" list +\ 4fc: virtual base address of "translations" list + +\ Data in this cpu's exception area (exception-area) +\ 00: save r3 +\ 04: save r2 +\ 08: save lr +\ 0c: save exception number +\ 10: save cr +\ 14: save base +\ 18: save ip +\ 1c: save lr +\ 20-3c: save registers + +\ fault - r4 node - r5 offset - r6 adr - r7 end - r8 +\ Physical address +also assembler also register-names definitions +warning @ warning off +4 constant fault +5 constant node +6 constant offset +7 constant adr +8 constant end +9 constant temp +warning ! +previous previous definitions + +\ get-phys searches the "translations" list, which is the master copy of +\ the information describing the current set of virtual to physical +\ address translations. The input (in r3) is the virtual address. The +\ output (in r3) is -1 if there was no mapping for that virtual address, +\ or the physical word of the PTE, containing the physical page number and +\ the mode bits, otherwise. + +\ Input: r4 - virtual address of fault +\ Output: r3 - physical_PTE_word or -1 +\ Destroys: r4-r8 +label get-phys + lwz node,h#4f8(r0) \ Physical base address of translation list + lwz offset,h#4fc(r0) \ Virtual base address of translation list + ahead begin + subf node,offset,node \ Convert node virtual address to physical + lwz adr,1cell(node) \ Beginning virtual address of range + cmpl 0,0,adr,fault \ Test beginning of range + <= if + lwz end,2cells(node) \ Length of mapped range + add end,adr,end \ Ending virtual address of range + cmpl 0,0,end,fault \ Test end of range + > if +1 L: + \ We found it + rlwinm temp,fault,0,0,19 \ Zero fault address page offset bits + subf adr,adr,temp \ Compute page offset within range + lwz r3,3cells(node) \ Physical page# + rlwinm r3,r3,12,0,19 \ Shift page# into place + add r3,r3,adr \ physical address portion is complete + lwz adr,4cells(node) \ WIMG.PP + or r3,r3,adr \ PTE physical word is complete +2 L: + bclr 20,0 + then + + \ If the ending address is 0, it really means 2^32, which is + \ larger than any possible fault address. + cmpi 0,0,end,0 + 1 B: = brif + + then + + but then + lwz node,0(node) \ Next node + cmpi 0,0,node,0 + = until + + \ No translation found + set r3,-1 + + 2 B: again +end-code + +\ r3:phys r4:fault r5:vsid r6:pteg r7:htab/ctr_save r8:mask r9:temp + +also assembler also register-names definitions +warning @ warning off +5 constant vsid +6 constant pteg +7 constant htab +8 constant mask +warning ! +previous previous definitions + +label find-pte ( r4: virtual -- r5: vsid r6: 'pte ) + mfsrin vsid,fault \ Get virtual segment ID + rlwinm vsid,vsid,0,13,31 \ Keep the low 19 bits (omit protection bits) + rlwinm pteg,fault,20,16,31 \ Move page index bits into place + xor pteg,vsid,pteg \ Compute hash value + + mfspr htab,sdr1 \ Get hash table base address and size mask + +mfspr mask,pvr +rlwinm mask,mask,16,16,31 +cmpi 0,0,mask,20 +<> if \ 32-bit code + addi mask,r0,h#3ff \ Set low 10 bits of mask + rlwimi mask,htab,10,13,21 \ merge in upper 9 bits + rlwinm mask,mask,6,7,25 \ Move up 6 bits to align with PTEG address + + rlwinm pteg,pteg,6,7,25 \ Move into place + and pteg,pteg,mask \ Compute low bits of pte + + rlwinm htab,htab,0,0,15 \ Eliminate mask bits + or pteg,htab,pteg \ Insert hash table base into the high bits + + \ Now we have the address of the primary page table entry group in "pteg". + \ We also need to preserve "mask" in case we need to find the secondary + \ PTEG, and "fault" and "vsid" to generate the first word of the new PTE. + + mfspr htab,ctr \ htab is no longer needed so we re-use it + + \ Generate the tag for the first word of the new PTE + rlwinm vsid,vsid,7,1,24 + rlwimi vsid,fault,10,26,31 \ Move bits 4-9 to 26-31 + \ vsid is now the new PTE tag + + \ In little-endian mode, addresses within a PTE are swizzled from the + \ viewpoint of code executing on the CPU, which does 32-bit or smaller + \ accesses, but not from the viewpoint of the table-search hardware, + \ which appears to do 64-bit accesses. Consequently, in little-endian + \ mode, the tag word appears at offset 4 and the physical word at offset 0. + mfmsr temp + andi. temp,temp,1 + <> if \ Little-endian + addi pteg,pteg,4 \ Tag is in second longword when in LE mode + then + + addi pteg,pteg,-8 + set temp,8 + mtspr ctr,temp + begin + lwzu temp,8(pteg) + cmpi 0,0,temp,0 + 1 F: >= brif + countdown + + \ Didn't find room in the primary PTEG - search the secondary PTEG + addi pteg,pteg,h#-38 \ Reset the lower bits + xor pteg,pteg,mask \ Invert the hash bits - to secondary PTEG + + ori vsid,vsid,h#40 \ Set the "H" bit in the tag + + addi pteg,pteg,-8 + set temp,8 + mtspr ctr,temp + begin + lwzu temp,8(pteg) + cmpi 0,0,temp,0 + 1 F: >= brif + countdown + + \ Didn't find room in the secondary PTEG - replace a primary entry. + addi pteg,pteg,h#-38 \ Reset the lower bits + xor pteg,pteg,mask \ Invert the hash bits - back to primary PTEG + rlwinm vsid,vsid,0,26,24 \ Clear the "H" bit in the tag + + \ It might be nice to use the statistics bits to implement a pseudo-LRU + \ replacement policy, but that is too complicated for now (especially + \ since I don't want to bother with the complexity of a periodic process + \ to test the bits), so I'm using a roving replacement pointer instead. + \ The performance difference is probably entirely negligeable in this + \ environment, and might favor the roving pointer anyway. + lwz temp,h#4f4(r0) \ Get replacement index + add pteg,temp,pteg \ Address of PTE to replace + + addi temp,temp,8 \ Update replacement pointer + cmpi 0,0,temp,h#40 + = if + set temp,0 + then + stw temp,h#4f4(r0) + + set temp,0 + stw temp,0(pteg) \ Invalidate tag word +else + set mask,h#4.0000 \ Smallest hash table size +\ TRYME rldcr mask,mask,htab,45 \ Shift to actual size + rlwnm mask,mask,htab,0,13 \ Shift to actual size + addi mask,mask,-1 \ Convert to mask + rlwinm mask,mask,0,0,24 \ Clear low 7 bits to align to PTEG base + +\ TRYME rldic pteg,pteg,7,0 \ Move hash value into place + rlwinm pteg,pteg,7,0,24 \ Move hash value into place + and pteg,pteg,mask \ Compute low bits of PTE + +\ TRYME rldicr htab,htab,0,45 \ Eliminate mask bits + rlwinm htab,htab,0,0,13 \ Eliminate mask bits + or pteg,htab,pteg \ Insert hash table base into the high bits + + \ Now we have the address of the primary page table entry group in "pteg". + \ We also need to preserve "mask" in case we need to find the secondary + \ PTEG, and "fault" and "vsid" to generate the first word of the new PTE. + + mfspr htab,ctr \ htab is no longer needed so we re-use it + + \ Generate the tag for the first word of the new PTE +\ TRYME rldicr vsid,vsid,12,51 + rlwinm vsid,vsid,12,0,19 + rlwimi vsid,fault,16,20,24 \ Move bits 4-8 to 20-24 (64-bit: okay as-is) + \ vsid is now the new PTE tag + +\ ZZZ 23/5/96 was 16 + addi pteg,pteg,-16 \ Account for pre-increment + set temp,8 + mtspr ctr,temp + begin + ldu temp,16(pteg) + andi. temp,temp,1 \ Test valid bit + 1 F: >= brif + countdown + + \ Didn't find room in the primary PTEG - search the secondary PTEG + addi pteg,pteg,h#-70 \ Reset the lower bits + xor pteg,pteg,mask \ Invert the hash bits - to secondary PTEG + + ori vsid,vsid,2 \ Set the "H" bit in the tag + + addi pteg,pteg,-16 + set temp,8 + mtspr ctr,temp + begin + ldu temp,16(pteg) + andi. temp,temp,1 \ Test valid bit + 1 F: >= brif + countdown + + \ Didn't find room in the secondary PTEG - replace a primary entry. + addi pteg,pteg,h#-70 \ Reset the lower bits + xor pteg,pteg,mask \ Invert the hash bits - back to primary PTEG + rlwinm vsid,vsid,0,31,29 \ Clear the "H" bit in the tag + + \ It might be nice to use the statistics bits to implement a pseudo-LRU + \ replacement policy, but that is too complicated for now (especially + \ since I don't want to bother with the complexity of a periodic process + \ to test the bits), so I'm using a roving replacement pointer instead. + \ The performance difference is probably entirely negligeable in this + \ environment, and might favor the roving pointer anyway. + lwz temp,h#4f4(r0) \ Get replacement index + add pteg,temp,pteg \ Address of PTE to replace + + addi temp,temp,16 \ Update replacement pointer + cmpi 0,0,temp,h#80 + = if + set temp,0 + then + stw temp,h#4f4(r0) + + set temp,0 + std temp,0(pteg) \ Invalidate tag word + +\ ZZZ AEC 23/5/1996 added ; 620 errata: tlbia does not work +\ tlbia + sync +then + + sync + tlbie pteg + sync + tlbsync + sync + +1 L: + mtspr ctr,htab + bclr 20,0 +end-code + +\ Common code for HTAB ISI and DSI miss handlers. +\ Input: r3: virtual address +\ r2: exception-area +\ Output: none (returns from interrupt) +\ Side effects: +\ If the input virtual address is mapped, adds or replaces an HTAB entry, +\ clearing the TLB as needed, to reflect that mapping. +\ If the input virtual address is not mapped, transfers control to the +\ unexpected exception handler. +\ Destroys: nothing +\ Requirements: +\ The pre-trap value of R3 must be in memory location 0(sprg0) +\ The pre-trap value of CR must be in memory location h#10(sprg0) +\ Those register values are restored before returning. +\ Uses: +\ Memory location h#0c(sprg0) to store the exception address. +\ Memory locations h#20-h#34(sprg0) for saving registers. + +label htab-miss-handler + + stw r4,h#20(r2) stw r5,h#24(r2) stw r6,h#28(r2) \ Save GPRs + stw r7,h#2c(r2) stw r8,h#30(r2) stw r9,h#34(r2) + + mr fault,r3 + + \ Determine the physical address, if any, to which the virtual address + \ that caused the fault is mapped. + + get-phys bl * \ ( virtual -- pte-phys|-1 ) + + \ If there is no valid mapping for that virtual address, invoke the + \ unexpected exception handler. + cmpi 0,0,r3,-1 \ If no + = if + lwz r4,h#20(r2) lwz r5,h#24(r2) lwz r6,h#28(r2) \ Restore GPRs + lwz r7,h#2c(r2) lwz r8,h#30(r2) lwz r9,h#34(r2) + + \ Restore registers and jump to unexpected exception handler + lwz r3,h#10(r2) mtcrf h#80,r3 \ Restore CR + lwz r3,h#4f0(r0) \ save-state address + mtspr lr,r3 + lwz r3,h#0c(r2) \ Exception address + bclr 20,0 \ branch to exception handler + then + + find-pte bl * ( r4: fault-address -- r6: 'pte ) + + mfspr temp,pvr + rlwinm temp,temp,16,16,31 + cmpi 0,0,temp,20 + <> if \ 32-bit processor + \ pteg now points to the tag word of an invalid PTE; replace its value + \ See clause 4.12.1 of the PPC architecture spec (hard-back book) + \ for an explanation of this sequence. + mfmsr temp + andi. temp,temp,1 + <> if \ Little-endian + stw r3,-4(pteg) \ Replace physical address portion + else + stw r3,4(pteg) \ Replace physical address portion + then + + stw vsid,0(pteg) \ Replace the tag word with valid bit clear + sync + oris vsid,vsid,h#8000 \ Set the valid bit + stw vsid,0(pteg) \ Replace the tag word with valid bit set + else \ 64-bit processor + \ pteg now points to the tag word of an invalid PTE; replace its value + \ See clause 4.12.1 of the PPC architecture spec (hard-back book) + \ for an explanation of this sequence. + std r3,8(pteg) \ Replace physical address portion + std vsid,0(pteg) \ Replace the tag word with valid bit clear + sync + ori vsid,vsid,1 \ Set the valid bit + std vsid,0(pteg) \ Replace the tag word with valid bit set + then + + \ Restore registers used herein + + lwz r4,h#20(r2) lwz r5,h#24(r2) lwz r6,h#28(r2) \ Restore GPRs + lwz r7,h#2c(r2) lwz r8,h#30(r2) lwz r9,h#34(r2) + + \ Restore registers used by the generic trap preamble + lwz r3,h#10(r2) mtcrf h#80,r3 \ Restore CR + lwz r3,h#08(r2) mtspr lr,r3 \ Restore LR + lwz r3,h#00(r2) \ Restore r3 + lwz r2,h#04(r2) \ Restore r2 + + \ Return from interrupt + rfi +end-code + +\ r2, r3, and lr have been saved. r2 points to the this cpu's exception-area, +\ r3 points to the address where the exception occured. +label htab-isi-handler + stw r3,h#0c(r2) \ Save exception number + mfcr r3 + stw r3,h#10(r2) \ Save CR + + \ Determine the fault type + mfspr r3,srr1 \ Fault type is in SRR1 for I faults + rlwinm. r3,r3,0,1,1 \ Test bit 1 + 0= if \ Not a translation fault + \ Restore registers and jump to unexpected exception handler + lwz r3,h#10(r2) mtcrf h#80,r3 \ Restore CR + lwz r3,h#4f0(r0) \ save-state address + mtspr lr,r3 + lwz r3,h#0c(r2) \ Exception address + bclr 20,0 \ branch to exception handler + then + + mfspr r3,srr0 \ Get fault address + + htab-miss-handler b * \ Jump to common code +end-code + +\ r2, r3, and lr have been saved. r2 points to the this cpu's exception-area, +\ r3 points to the address where the exception occured. +label htab-dsi-handler + stw r3,h#0c(r2) \ Save exception number + mfcr r3 + stw r3,h#10(r2) \ Save CR + + \ Determine the fault type + mfspr r3,dsisr \ SPR18 + rlwinm. r3,r3,0,1,1 \ Test bit 1 + 0= if \ Not a translation fault + \ Restore registers and jump to unexpected exception handler + lwz r3,h#10(r2) mtcrf h#80,r3 \ Restore CR + lwz r3,h#4f0(r0) \ save-state address + mtspr lr,r3 + lwz r3,h#0c(r2) \ Exception address + bclr 20,0 \ branch to exception handler + then + + mfspr r3,dar \ Get fault address + + htab-miss-handler b * \ Jump to common code +end-code + +previous + +headers +\ sdr1@ and sdr1! are okay for 64-bit implementations if the physical +\ address of the page table is in the lower 4GB of memory, which is a +\ fairly safe assumption. +code sdr1! ( n -- ) + mtspr sdr1,tos + lwz tos,0(sp) + addi sp,sp,1cell +c; +code sdr1@ ( -- n ) + stwu tos,-1cell(sp) + mfspr tos,sdr1 +c; + +headerless +\ We could use "fill" for this, but it is slightly faster to do it this way, +\ because we only have to touch every other word. +code invalidate-htab-64 ( -- ) + mfspr t3,sdr1 + rlwinm t3,t3,0,27,31 \ Compute hash table size from shift count + set t4,h#4.0000 \ Shift count 0 means 256K + rlwnm t3,t4,t3,0,31 + + 'user htab lwz t0,* \ Virtual address of hash table + + \ Hardware accesses PTEs as doublewords, so address swizzling doesn't occur. + addi t0,t0,-16 \ Account for pre-increment + + rlwinm t3,t3,28,4,31 \ Divide by 16; we'll touch each PTE once + set t2,0 + mtspr ctr,t3 \ Set loop count + begin + stdu t2,16(t0) \ Clear the tag word of each PTE + countdown + mtspr ctr,up \ Restore CTR register +c; + +\ We could use "fill" for this, but it is slightly faster to do it this way, +\ because we only have to touch every other word. +code invalidate-htab-32 ( -- ) + mfspr t3,sdr1 + rlwinm t3,t3,16,7,15 \ Compute hash table size from mask bits + ori t3,t3,h#ffff \ MAX(hashbits,64k-1) + addi t3,t3,1 + + 'user htab lwz t0,* \ Virtual address of hash table + + \ Hardware accesses PTEs as doublewords, so address swizzling doesn't occur. + \ Consequently, when accessing a PTE from the processor, we must undo + \ its swizzling. + mfmsr t4 + andi. t4,t4,1 \ Test little-endian bit + <> if \ Little endian + addi t0,t0,-4 \ Account for pre-increment and endianness + else + addi t0,t0,-8 \ Account for pre-increment + then + + rlwinm t3,t3,29,3,31 \ Divide by 8; we'll touch each PTE once + set t2,0 + mtspr ctr,t3 \ Set loop count + begin + stwu t2,8(t0) \ Clear the tag word of each PTE + countdown + mtspr ctr,up \ Restore CTR register +c; + +: set-mmu ( -- ) + cpu-version d# 20 = if + true to mmu64? + h# 4.0000 to /htab + 2 to tag-h + 1 to tag-v + d# 16 to /htab-entry + h# 80 to /htab-group + then +; + +: get-htab ( -- phys size ) + sdr1@ dup + mmu64? if + h# 3.ffff invert and h# 4.0000 rot h# 1f and lshift + else + h# ffff invert and swap h# 1ff and 1+ d# 16 lshift + then +; +: set-htab ( phys size -- ) + mmu64? if + log2 d# 18 - ( phys size-code ) + else + 1- d# 16 rshift ( phys size-mask ) + then + or sdr1! +; +: init-paged-mmu ( -- ) + htab /htab 0 mem-claim drop + + \ We don't use invalidate-htab here because we want the HTAB to start + \ out completely clean, and invalidate-htab clears only the tag words. + htab /htab erase + + htab-phys /htab set-htab +[ifdef] invalidate-tlb + invalidate-tlb +[then] +; + +[ifdef] shootdown-range +\ RFE: map? should report BAT mappings and VSID too +\ RFE: MMU driver should account for BAT mappings too + +: >htab-adr ( padr -- vadr ) + htab-phys - htab + + mmu64? if la1+ then + in-little-endian? 4 and xor +; +: htab-@ ( padr -- l ) >htab-adr l@ ; +: htab-! ( l padr -- ) >htab-adr l! ; + +\ HTAB display tools + +: break-pte ( phys-stuff tag -- false | rc.wimg.pp phys api vsid h true ) + \ Check valid bit + dup tag-v and 0= if 2drop false exit then ( phys-stuff tag ) + + \ Extract physical address and type field + over 9 lowbits rot h# fff invert and ( tags rc.wimg.pp phys ) + rot ( rc.wimg.pp phys tags ) + + \ Extract tag information + mmu64? if + d# 7 5 bits d# 23 lshift swap ( rc.wimg.pp phys api tags ) + \ XXX we should extract more vsid bits from the 64-bit tag + dup d# 12 d# 25 bits swap ( rc.wimg.pp phys api vsid tags ) + 1 1 bits ( rc.wimg.pp phys api vsid h ) + else + dup h# 7f and d# 22 lshift swap ( rc.wimg.pp phys api tags ) + dup 7 d# 19 bits swap ( rc.wimg.pp phys api vsid tags ) + 6 1 bits ( rc.wimg.pp phys api vsid h ) + then + true +; +headers +: pte@ ( adr -- phys-stuff tag ) + dup /htab-entry 2/ + htab-@ swap htab-@ +; +headerless +: hold. ( -- ) ascii . hold ; +: .mode ( mode -- ) + push-binary + ." RC.WIMG.PP: " <# u# u# hold. 2/ u# u# u# u# hold. u# u# u#> type + pop-base +; +: .phys ( phys -- ) push-hex ." Physical: " u. pop-base ; +: .pte ( tags phys-stuff -- ) + break-pte if + push-hex + ." H: " . + ." Virtual: " <# u# ascii , hold u#s u#> type ( rc.wimg.pp phys api ) + d# 20 >> (.2) type ." X.Xxxx" ( rc.wimg.pp phys ) + pop-base + ." " .phys .mode + else + ." Invalid" + then + cr +; + +\ See, for example, figure 7-24 in the 603 manual +\ >vsid is valid on 64-bit implementations only if the implementation +\ also supports mtsr and mfsr, as does the 620. +: >vsid ( virtual -- sr ) + d# 28 4 bits sr@ mmu64? if d# 24 lowbits then +; +: virtual>hash ( virtual -- tag hash ) + dup + mmu64? if + d# 23 5 ( virtual bit# #bits ) + else + d# 22 6 ( virtual bit# #bits ) + then + bits ( virtual api ) + mmu64? if 7 lshift then ( virtual api' ) + over >vsid tuck ( virtual vsid api vsid ) + mmu64? if d# 12 else 7 then ( virtual vsid api vsid bit# ) + lshift or tag-v or ( virtual vsid tag ) + rot d# 12 d# 16 bits ( vsid tag page-index ) + rot ( tag page-index vsid ) + \ 39 or 19 bit hash codes + mmu64? 0= if h# 7ffff and then ( tag page-index vsid' ) + xor ( tag hash ) +; +: hash>ptegs ( hash -- 'pteg1 'pteg2 ) + /htab-group * ( hash<< ) + get-htab 1- ( hash<< base size-mask ) + /htab-group 1- invert and ( hash<< base size-mask' ) + + rot over and ( base size-mask masked-hash ) + rot or tuck xor ( 'pteg1 'pteg2 ) +; +: virtual>pteg ( virtual -- tag 'pteg1 'pteg2 ) virtual>hash hash>ptegs ; + +: virtual>pte ( virtual -- false | pte-adr true ) + virtual>pteg -rot ( 'pteg2 tag 'pteg1 ) + /htab-group bounds do ( 'pteg2 tag ) + dup i htab-@ = if ( 'pteg2 tag ) + 2drop i true unloop exit + then ( 'pteg2 tag ) + /htab-entry +loop ( 'pteg2 tag ) + tag-h or swap ( tag' pteg2 ) + /htab-group bounds do ( tag ) + dup i htab-@ = if ( tag ) + drop i true unloop exit + then ( tag ) + /htab-entry +loop ( tag ) + drop false +; +: .pteg ( 'pteg -- ) d# 64 bounds ?do i pte@ .pte 8 +loop ; +headers +: pteg? ( virtual -- ) + virtual>pteg ( tag 'pteg1 'pteg2 ) + swap ." Primary PTEG" cr .pteg ( tag 'pgeg2 ) + ." Secondary PTEG" cr .pteg ( tag ) + drop +; +: pte? ( virtual -- ) + virtual>pte if pte@ .pte else ." Not in HTAB" cr then +; + +headerless +: (shootdown-range) ( virtual len -- ) + \ If we have to shootdown more than about 8 pages, + \ it's faster to blow away the whole thing; searching + \ for matching PTEs is pretty time-consuming. + dup h# 8000 u> if ( virtual len ) + 2drop + mmu64? if invalidate-htab-64 else invalidate-htab-32 then + invalidate-tlb ( ) + exit + then ( virtual len ) + bounds ?do ( ) + i virtual>pte if 0 swap htab-! i invalidate-tlb-entry then + pagesize +loop +; +' (shootdown-range) to shootdown-range + +: (map-mode) ( phys.. mode -- mode' ) + >r memory? r> ( memory? mode ) + dup -2 -1 between if ( memory? -1 ) + drop if ( ) + h# 12 \ For memory, WIMG.x.PP is 0010.0.10, i.e. M=1, PP=10 + else ( ) + h# 3a \ For I/O, WIMG.x.PP is 0111.0.10, i.e. I=1,M=1,G=1, PP=10 + then ( mode' ) + else ( memory? mode ) + nip ( mode ) + then ( mode' ) +; +' (map-mode) to map-mode + +headers +[ifdef] NOTYET +\ : init ( -- ) ; + +\ finish-device + +warning @ warning off +only forth also definitions +: stand-init ( -- ) + stand-init + " /mmu" open-dev mmu-node ! +; +warning ! +[then] + +: map? ( virtual -- ) +[ifdef] NOTYET + " translate" mmu-node @ $call-method if +[else] + translate if +[then] + >r .phys r> .mode + else + ." Not mapped" cr + then +; +[then] + +\ LICENSE_BEGIN +\ Copyright (c) 2007 FirmWorks +\ +\ Permission is hereby granted, free of charge, to any person obtaining +\ a copy of this software and associated documentation files (the +\ "Software"), to deal in the Software without restriction, including +\ without limitation the rights to use, copy, modify, merge, publish, +\ distribute, sublicense, and/or sell copies of the Software, and to +\ permit persons to whom the Software is furnished to do so, subject to +\ the following conditions: +\ +\ The above copyright notice and this permission notice shall be +\ included in all copies or substantial portions of the Software. +\ +\ THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, +\ EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF +\ MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND +\ NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE +\ LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION +\ OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION +\ WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. +\ +\ LICENSE_END Added: cpu/ppc/inflate.fth =================================================================== --- cpu/ppc/inflate.fth (rev 0) +++ cpu/ppc/inflate.fth 2007-07-05 17:19:17 UTC (rev 461) @@ -0,0 +1,1396 @@ +purpose: Inflater - source code in Forth-assembler format +\ See license at end of file + +\ The following code uses only non-privileged instructions, and knows +\ nothing about the "operating environment" portion of the PowerPC +\ architecture. Please keep it that way! +\ For use in the firmware environment, this code is typically called +\ from a routine that handles operating-environment details, such as +\ setting up memory mappings, turning on caches, etc. + +\ The body of the code below was created by disassembling the stripped +\ output of GCC. The script that runs the disassembler is in +\ cpu/ppc/disinflt.fth + +fload ${BP}/cpu/ppc/asmtools.fth + +: number, ( -- ) + safe-parse-word ( adr len ) + push-hex $number abort" Invalid argument to debug:" pop-base ( n ) + be-l, +; +: debug: + 0 be-l, number, number, number, number, + safe-parse-word dup wbsplit c, c, ( adr len ) + here over allot ( adr len here ) + swap move align + postpone \ +; + +start-assembling + +\ The following routines use Power/Open C calling conventions: +\ e.g. arguments in r3, r4, ... +\ r1 must point to a stack area. r2 is ostensibly the TOC pointer, +\ but the C code and compilation flags were carefully set up so that +\ the generated code does not use a data segment or external linkage, +\ so there are no references to r2 in the code below. + +label inflate ( r3: &compressed-image r4: &destination r5: &scratch -- ... ) + ( ... -- r3: length-of-uncompressed-image ) + mfspr r0,lr + stw r21,h#-2c(r1) + stw r22,h#-28(r1) + stw r23,h#-24(r1) + stw r24,h#-20(r1) + stw r25,h#-1c(r1) + stw r26,h#-18(r1) + stw r27,h#-14(r1) + stw r28,h#-10(r1) + stw r29,h#-c(r1) + stw r30,-8(r1) + stw r31,-4(r1) + stw r0,8(r1) + stwu r1,h#-568(r1) + or r21,r4,r4 + or r27,r21,r21 + or r30,r5,r5 + addi r0,r30,h#80 + stw r0,h#7c(r30) + or r4,r30,r30 + bl .+h#46c + addi r0,r0,0 + addic r0,r0,1 + lwz r11,8(r30) + cmpi crf1,0,r0,2 + addi r9,r11,1 + stw r9,8(r30) + bc 4,5,.-h#14 + addi r0,r9,1 + stw r0,8(r30) + addi r0,r0,0 + lbz r10,1(r11) + addic r0,r0,1 + lwz r11,8(r30) + cmpi crf1,0,r0,5 + addi r9,r11,1 + stw r9,8(r30) + bc 4,5,.-h#14 + andi. r0,r10,8 + bc 12,2,.+h#30 + addi r0,r9,1 + stw r0,8(r30) + lbz r0,1(r11) + cmpi crf1,0,r0,0 + bc 12,6,.+h#1c + lwz r9,8(r30) + addi r0,r9,1 + stw r0,8(r30) + lbz r0,0(r9) + cmpi crf1,0,r0,0 + bc 4,6,.-h#14 + addi r26,r0,1 + addi r3,r0,1 + lwz r4,0(r30) + or r5,r30,r30 + bl .+h#7a0 + or r4,r3,r3 + rlwinm r25,r4,0,31,31 + addi r3,r0,2 + rlwinm r4,r4,31,1,31 + lwz r0,4(r30) + or r5,r30,r30 + addic r0,r0,-1 + stw r0,4(r30) + bl .+h#77c + or r4,r3,r3 + rlwinm r9,r4,0,30,31 + rlwinm r4,r4,30,2,31 + cmpi crf1,0,r9,0 + lwz r0,4(r30) + stw r4,0(r30) + addic r0,r0,-2 + stw r0,4(r30) + bc 4,6,.+h#b8 + addi r3,r0,h#10 + lwz r0,4(r30) + or r5,r30,r30 + rlwinm r31,r0,0,29,31 + subf r0,r31,r0 + stw r0,4(r30) + srw r4,r4,r31 + bl .+h#738 + or r4,r3,r3 + rlwinm r31,r4,0,16,31 + addi r3,r0,h#10 + rlwinm r4,r4,16,16,31 + lwz r0,4(r30) + or r5,r30,r30 + addic r0,r0,h#-10 + stw r0,4(r30) + bl .+h#714 + or r4,r3,r3 + nor r0,r4,r4 + rlwinm r9,r0,0,16,31 + cmp crf1,0,r31,r9 + bc 4,6,.+h#bc + rlwinm r4,r4,16,16,31 + lwz r0,4(r30) + cmpi crf1,0,r9,0 + addi r31,r31,-1 + addic r0,r0,h#-10 + stw r0,4(r30) + bc 12,6,.+h#3c + addi r3,r0,8 + or r5,r30,r30 + bl .+h#6d8 + or r4,r3,r3 + stb r4,0(r27) + addi r27,r27,1 + rlwinm r4,r4,24,8,31 + or r9,r31,r31 + lwz r0,4(r30) + cmpi crf1,0,r9,0 + addi r31,r31,-1 + addic r0,r0,-8 + stw r0,4(r30) + bc 4,6,.-h#34 + stw r4,0(r30) + b .+h#27c + cmpi crf1,0,r9,1 + bc 4,6,.+h#30 + or r3,r22,r22 + addi r4,r1,h#528 + addi r5,r1,h#52c + addi r6,r1,h#530 + addi r7,r1,h#534 + addi r8,r1,h#38 + or r9,r30,r30 + bl .+h#d20 + cmpi crf1,0,r3,0 + bc 4,6,.+h#30 + b .+h#34 + or r3,r22,r22 + addi r4,r1,h#528 + addi r5,r1,h#52c + addi r6,r1,h#530 + addi r7,r1,h#534 + addi r8,r1,h#38 + or r9,r30,r30 + bl .+h#e54 + cmpi crf1,0,r3,0 + bc 12,6,.+h#c + addi r25,r0,1 + b .+h#218 + lwz r9,h#530(r1) + lwz r10,0(r30) + lwz r0,h#534(r1) + slw r9,r26,r9 + addi r23,r9,-1 + slw r0,r26,r0 + addic r24,r0,-1 + or r4,r10,r10 + lwz r3,h#530(r1) + or r5,r30,r30 + bl .+h#614 + or r10,r3,r3 + and r9,r10,r23 + lwz r11,h#528(r1) + rlwinm r9,r9,3,0,28 + lbzx r31,r9,r11 + cmpli crf1,0,r31,h#10 + add r29,r9,r11 + bc 4,5,.+h#58 + cmpi crf1,0,r31,h#63 + bc 12,6,.+h#1c4 + addi r31,r31,h#-10 + or r3,r31,r31 + lbz r4,1(r29) + lwz r0,4(r30) + or r5,r30,r30 + subf r0,r4,r0 + stw r0,4(r30) + srw r4,r10,r4 + bl .+h#5c8 + or r10,r3,r3 + slw r9,r26,r31 + addi r9,r9,-1 + and r9,r10,r9 + lwz r11,4(r29) + rlwinm r9,r9,3,0,28 + lbzx r31,r9,r11 + cmpli crf1,0,r31,h#10 + add r29,r9,r11 + bc 12,5,.-h#50 + cmpi crf1,0,r31,h#10 + lbz r9,1(r29) + lwz r0,4(r30) + srw r10,r10,r9 + subf r0,r9,r0 + stw r0,4(r30) + bc 4,6,.+h#14 + lhz r0,2(r29) + stb r0,0(r27) + addi r27,r27,1 + b .-h#ac + cmpi crf1,0,r31,h#f + bc 12,6,.+h#138 + or r3,r31,r31 + or r4,r10,r10 + or r5,r30,r30 + bl .+h#55c + or r10,r3,r3 + srw r4,r10,r31 + or r5,r30,r30 + slw r0,r26,r31 + addic r0,r0,-1 + and r0,r10,r0 + lwz r3,h#534(r1) + lhz r11,2(r29) + lwz r9,4(r30) + add r28,r11,r0 + subf r9,r31,r9 + stw r9,4(r30) + bl .+h#528 + or r10,r3,r3 + and r9,r10,r24 + lwz r11,h#52c(r1) + rlwinm r9,r9,3,0,28 + lbzx r31,r9,r11 + cmpli crf1,0,r31,h#10 + add r29,r9,r11 + bc 4,5,.+h#58 + cmpi crf1,0,r31,h#63 + bc 12,6,.+h#d8 + addi r31,r31,h#-10 + or r3,r31,r31 + lbz r4,1(r29) + lwz r0,4(r30) + or r5,r30,r30 + subf r0,r4,r0 + stw r0,4(r30) + srw r4,r10,r4 + bl .+h#4dc + or r10,r3,r3 + slw r9,r26,r31 + addi r9,r9,-1 + and r9,r10,r9 + lwz r11,4(r29) + rlwinm r9,r9,3,0,28 + lbzx r31,r9,r11 + cmpli crf1,0,r31,h#10 + add r29,r9,r11 + bc 12,5,.-h#50 + or r3,r31,r31 + lbz r4,1(r29) + lwz r0,4(r30) + or r5,r30,r30 + subf r0,r4,r0 + stw r0,4(r30) + srw r4,r10,r4 + bl .+h#494 + or r10,r3,r3 + slw r9,r26,r31 + addi r9,r9,-1 + and r9,r10,r9 + srw r10,r10,r31 + or r11,r28,r28 + addi r28,r28,-1 + cmpi crf1,0,r11,0 + lwz r0,4(r30) + lhz r11,2(r29) + subf r0,r31,r0 + stw r0,4(r30) + add r11,r11,r9 + bc 12,6,.-h#1c4 + subf r9,r11,r27 + or r0,r28,r28 + lbz r9,0(r9) + cmpi crf1,0,r0,0 + addi r28,r28,-1 + stb r9,0(r27) + addi r27,r27,1 + bc 4,6,.-h#1c + b .-h#1e8 + lwz r0,h#20(r30) + stw r10,0(r30) + stw r0,h#7c(r30) + cmpi crf1,0,r25,0 + bc 12,6,.-h#388 + subf r3,r21,r27 + addi r1,r1,h#568 + lwz r0,8(r1) + mtspr lr,r0 + lwz r21,h#-2c(r1) + lwz r22,h#-28(r1) + lwz r23,h#-24(r1) + lwz r24,h#-20(r1) + lwz r25,h#-1c(r1) + lwz r26,h#-18(r1) + lwz r27,h#-14(r1) + lwz r28,h#-10(r1) + lwz r29,h#-c(r1) + lwz r30,-8(r1) + lwz r31,-4(r1) + bclr 20,0 + + Debug: 2041 800b0300 0 49c inflate + + addi r11,r0,0 + stw r11,0(r4) + stw r11,4(r4) + stw r3,8(r4) + addi r8,r0,0 + addi r10,r0,3 + lwz r9,h#7c(r4) + lwz r0,h#7c(r4) + stw r9,h#c(r4) + addic r0,r0,h#4c + stw r0,h#7c(r4) + lwz r9,h#c(r4) + addi r0,r0,h#10 + stw r0,0(r9) + addi r0,r0,h#11 + stwu r0,4(r9) + addi r0,r0,h#12 + stwu r0,4(r9) + stwu r11,4(r9) + addi r0,r0,8 + stwu r0,4(r9) + addi r0,r0,7 + stwu r0,4(r9) + addi r0,r0,9 + stwu r0,4(r9) + addi r0,r0,6 + stwu r0,4(r9) + addi r0,r0,h#a + stwu r0,4(r9) + addi r0,r0,5 + stwu r0,4(r9) + addi r0,r0,h#b + stwu r0,4(r9) + addi r0,r0,4 + stwu r0,4(r9) + addi r0,r0,h#c + stwu r0,4(r9) + addi r0,r0,3 + stwu r0,4(r9) + addi r0,r0,h#d + stwu r0,4(r9) + addi r0,r0,2 + stwu r0,4(r9) + addi r0,r0,h#e + stwu r0,4(r9) + addi r0,r0,1 + stwu r0,4(r9) + addi r0,r0,h#f + stw r0,4(r9) + lwz r9,h#7c(r4) + lwz r0,h#7c(r4) + stw r9,h#10(r4) + addic r0,r0,h#40 + stw r0,h#7c(r4) + lwz r9,h#10(r4) + addi r0,r0,3 + sth r0,0(r9) + addi r0,r0,4 + sthu r0,2(r9) + addi r0,r0,5 + sthu r0,2(r9) + addi r0,r0,6 + sthu r0,2(r9) + addi r0,r0,7 + sthu r0,2(r9) + addi r0,r0,8 + sthu r0,2(r9) + addi r0,r0,9 + sthu r0,2(r9) + addi r0,r0,h#a + sthu r0,2(r9) + addi r0,r0,h#b + sthu r0,2(r9) + addi r0,r0,h#d + sthu r0,2(r9) + addi r0,r0,h#f + sthu r0,2(r9) + addi r0,r0,h#11 + sthu r0,2(r9) + addi r0,r0,h#13 + sthu r0,2(r9) + addi r0,r0,h#17 + sthu r0,2(r9) + addi r0,r0,h#1b + sthu r0,2(r9) + addi r0,r0,h#1f + sthu r0,2(r9) + addi r0,r0,h#23 + sthu r0,2(r9) + addi r0,r0,h#2b + sthu r0,2(r9) + addi r0,r0,h#33 + sthu r0,2(r9) + addi r0,r0,h#3b + sthu r0,2(r9) + addi r0,r0,h#43 + sthu r0,2(r9) + addi r0,r0,h#53 + sthu r0,2(r9) + addi r0,r0,h#63 + sthu r0,2(r9) + addi r0,r0,h#73 + sthu r0,2(r9) + addi r0,r0,h#83 + sthu r0,2(r9) + addi r0,r0,h#a3 + sthu r0,2(r9) + addi r0,r0,h#c3 + sthu r0,2(r9) + addi r0,r0,h#e3 + sthu r0,2(r9) + addi r0,r0,h#102 + sthu r0,2(r9) + addi r0,r0,0 + sthu r0,2(r9) + addi r9,r9,2 + sth r0,0(r9) + lwz r9,h#7c(r4) + lwz r0,h#7c(r4) + stw r9,h#14(r4) + addic r0,r0,h#40 + stw r0,h#7c(r4) + lwz r9,h#14(r4) + addic. r10,r10,-1 + sth r8,0(r9) + addi r9,r9,2 + bc 4,0,.-h#c + addi r10,r0,4 + addi r0,r10,-1 + srawi r0,r0,2 + addze r0,r0 + sth r0,0(r9) + sthu r0,2(r9) + addi r10,r10,4 + cmpi crf1,0,r10,h#1b + sthu r0,2(r9) + sthu r0,2(r9) + addi r9,r9,2 + bc 4,5,.-h#28 + addi r11,r0,0 + sth r11,0(r9) + addi r0,r0,h#63 + sthu r0,2(r9) + sth r0,2(r9) + lwz r9,h#7c(r4) + lwz r0,h#7c(r4) + stw r9,h#18(r4) + addic r0,r0,h#40 + stw r0,h#7c(r4) + lwz r9,h#18(r4) + addi r0,r0,1 + sth r0,0(r9) + addi r0,r0,2 + sthu r0,2(r9) + addi r0,r0,3 + sthu r0,2(r9) + addi r0,r0,4 + sthu r0,2(r9) + addi r0,r0,5 + sthu r0,2(r9) + addi r0,r0,7 + sthu r0,2(r9) + addi r0,r0,9 + sthu r0,2(r9) + addi r0,r0,h#d + sthu r0,2(r9) + addi r0,r0,h#11 + sthu r0,2(r9) + addi r0,r0,h#19 + sthu r0,2(r9) + addi r0,r0,h#21 + sthu r0,2(r9) + addi r0,r0,h#31 + sthu r0,2(r9) + addi r0,r0,h#41 + sthu r0,2(r9) + addi r0,r0,h#61 + sthu r0,2(r9) + addi r0,r0,h#81 + sthu r0,2(r9) + addi r0,r0,h#c1 + sthu r0,2(r9) + addi r0,r0,h#101 + sthu r0,2(r9) + addi r0,r0,h#181 + sthu r0,2(r9) + addi r0,r0,h#201 + sthu r0,2(r9) + addi r0,r0,h#301 + sthu r0,2(r9) + addi r0,r0,h#401 + sthu r0,2(r9) + addi r0,r0,h#601 + sthu r0,2(r9) + addi r0,r0,h#801 + sthu r0,2(r9) + addi r0,r0,h#c01 + sthu r0,2(r9) + addi r0,r0,h#1001 + sthu r0,2(r9) + addi r0,r0,h#1801 + sthu r0,2(r9) + addi r0,r0,h#2001 + sthu r0,2(r9) + addi r0,r0,h#3001 + sthu r0,2(r9) + addi r0,r0,h#4001 + sthu r0,2(r9) + addi r0,r0,h#6001 + sth r0,2(r9) + lwz r0,h#7c(r4) + addi r10,r0,2 + stw r0,h#1c(r4) + lwz r0,h#7c(r4) + lwz r9,h#1c(r4) + addic r0,r0,h#40 + stw r0,h#7c(r4) + sth r11,0(r9) + sthu r11,2(r9) + addi r9,r9,2 + addi r0,r10,-1 + srawi r0,r0,1 + addze r0,r0 + addi r10,r10,2 + cmpi crf1,0,r10,h#1d + sth r0,0(r9) + sthu r0,2(r9) + addi r9,r9,2 + bc 4,5,.-h#20 + lwz r0,h#7c(r4) + stw r0,h#20(r4) + bclr 20,0 + + Debug: 2040 200 0 3a0 init_var + + lwz r0,4(r5) + or r8,r3,r3 + cmpl crf1,0,r0,r8 + or r3,r4,r4 + bclr 4,4 + lwz r11,8(r5) + lwz r10,4(r5) + addi r0,r11,1 + stw r0,8(r5) + addi r9,r10,8 + cmpl crf1,0,r9,r8 + lbz r0,0(r11) + stw r9,4(r5) + slw r0,r0,r10 + or r3,r3,r0 + bc 12,4,.-h#28 + bclr 20,0 + + Debug: 2040 300 0 44 NEEDBITS + + cmpi crf1,0,r5,0 + addi r5,r5,-1 + bclr 12,6 + lbz r0,0(r4) + addi r4,r4,1 + cmpi crf1,0,r5,0 + addi r5,r5,-1 + stb r0,0(r3) + addi r3,r3,1 + bc 4,6,.-h#18 + bclr 20,0 + + Debug: 2040 300 0 2c memcpy + + mfspr r0,lr + stw r13,h#-4c(r1) + stw r14,h#-48(r1) + stw r15,h#-44(r1) + stw r16,h#-40(r1) + stw r17,h#-3c(r1) + stw r18,h#-38(r1) + stw r19,h#-34(r1) + stw r20,h#-30(r1) + stw r21,h#-2c(r1) + stw r22,h#-28(r1) + stw r23,h#-24(r1) + stw r24,h#-20(r1) + stw r25,h#-1c(r1) + stw r26,h#-18(r1) + stw r27,h#-14(r1) + stw r28,h#-10(r1) + stw r29,h#-c(r1) + stw r30,-8(r1) + stw r31,-4(r1) + stw r0,8(r1) + stwu r1,h#-5f8(r1) + stw r4,h#588(r1) + or r13,r5,r5 + stw r6,h#58c(r1) + stw r7,h#590(r1) + or r7,r8,r8 + or r8,r9,r9 + or r6,r10,r10 + addi r9,r1,h#38 + addi r11,r0,0 + addi r0,r0,0 + stwx r11,r9,r0 + addic r0,r0,4 + cmpli crf1,0,r0,h#40 + bc 4,5,.-h#c + or r24,r3,r3 + addi r11,r1,h#38 + lwz r28,h#588(r1) + lwz r9,0(r24) + rlwinm r9,r9,2,0,29 + lwzx r0,r9,r11 + addi r24,r24,4 + addic r0,r0,1 + stwx r0,r9,r11 + addic. r28,r28,-1 + bc 12,2,.+h#8 + b .-h#20 + lwz r0,h#38(r1) + lwz r12,h#588(r1) + cmp crf1,0,r0,r12 + bc 4,6,.+h#14 + stw r28,0(r7) + stw r28,0(r8) + addi r3,r0,0 + b .+h#4a0 + addi r30,r0,1 + addi r11,r1,h#38 + addi r9,r0,4 + lwz r22,0(r8) + lwzx r0,r9,r11 + cmpi crf1,0,r0,0 + bc 4,6,.+h#14 + addi r30,r30,1 + cmpli crf1,0,r30,h#10 + addi r9,r9,4 + bc 4,5,.-h#18 + or r19,r30,r30 + subfc r9,r19,r22 + subfe r9,r9,r9 + nand r9,r9,r9 + nor r0,r9,r9 + and r0,r0,r19 + and r9,r22,r9 + or r22,r9,r0 + addi r28,r0,h#10 + addi r11,r1,h#38 + addi r9,r0,h#40 + lwzx r0,r9,r11 + cmpi crf1,0,r0,0 + bc 4,6,.+h#14 + addi r9,r9,-4 + addic. r28,r28,-1 + bc 12,2,.+h#8 + b .-h#18 + or r14,r28,r28 + subfc r9,r22,r14 + subfe r9,r9,r9 + nand r9,r9,r9 + nor r0,r9,r9 + and r0,r0,r14 + and r9,r22,r9 + or r22,r9,r0 + cmpl crf1,0,r30,r14 + stw r22,0(r8) + addi r0,r0,1 + slw r18,r0,r30 + bc 4,4,.+h#2c + addi r11,r1,h#38 + rlwinm r9,r30,2,0,29 + lwzx r0,r9,r11 + subf. r18,r0,r18 + bc 12,0,.+h#2c + addi r30,r30,1 + cmpl crf1,0,r30,r28 + addi r9,r9,4 + rlwinm r18,r18,1,0,30 + bc 12,4,.-h#1c + rlwinm r11,r28,2,0,29 + addi r9,r1,h#38 + lwzx r0,r11,r9 + subf. r18,r0,r18 + bc 4,0,.+h#c + addi r3,r0,2 + b .+h#3b4 + add r0,r18,r0 + stwx r0,r11,r9 + addi r30,r0,0 + stw r30,h#548(r1) + addi r24,r1,h#3c + addi r9,r1,h#54c + addic. r28,r28,-1 + bc 4,2,.+h#8 + b .+h#24 + lwz r0,0(r24) + addi r24,r24,4 + add r30,r30,r0 + stw r30,0(r9) + addi r9,r9,4 + addic. r28,r28,-1 + bc 12,2,.+h#8 + b .-h#1c + or r24,r3,r3 + addi r28,r0,0 + addi r10,r1,h#38 + lwz r30,0(r24) + cmpi crf1,0,r30,0 + addi r24,r24,4 + bc 12,6,.+h#24 + rlwinm r9,r30,2,0,29 + add r9,r9,r10 + lwz r11,h#50c(r9) + addi r0,r11,1 + stw r0,h#50c(r9) + rlwinm r11,r11,2,0,29 + add r11,r11,r10 + stw r28,h#8c(r11) + lwz r12,h#588(r1) + addi r28,r28,1 + cmpl crf1,0,r28,r12 + bc 12,4,.-h#3c + addi r28,r0,0 + stw r28,h#544(r1) + addi r24,r1,h#c4 + addi r20,r0,-1 + neg r27,r22 + cmp crf1,0,r19,r14 + stw r28,h#84(r1) + addi r26,r0,0 + addi r25,r0,0 + bc 12,5,.+h#2c0 + addi r17,r1,h#38 + addi r16,r0,1 + addi r12,r1,h#80 + stw r12,h#598(r1) + rlwinm r15,r19,2,0,29 + lwzx r21,r15,r17 + or r0,r21,r21 + cmpi crf1,0,r0,0 + addi r21,r21,-1 + bc 12,6,.+h#288 + stw r15,h#594(r1) + add r9,r27,r22 + cmp crf1,0,r19,r9 + bc 4,5,.+h#120 + rlwinm r0,r20,2,0,29 + add r29,r0,r17 + or r23,r0,r0 + addi r29,r29,4 + addi r23,r23,4 + addi r20,r20,1 + or r27,r9,r9 + subf r25,r27,r14 + subfc r9,r25,r22 + subfe r9,r9,r9 + nand r9,r9,r9 + nor r11,r9,r9 + subf r30,r27,r19 + slw r31,r16,r30 + addi r0,r21,1 + cmpl crf1,0,r31,r0 + and r11,r11,r22 + and r9,r25,r9 + or r25,r9,r11 + bc 4,5,.+h#40 + addi r30,r30,1 + addi r0,r31,-1 + cmpl crf1,0,r30,r25 + lwz r12,h#594(r1) + subf r31,r21,r0 + add r9,r17,r12 + bc 4,4,.+h#24 + lwzu r0,4(r9) + rlwinm r31,r31,1,0,30 + cmpl crf1,0,r31,r0 + bc 4,5,.+h#14 + addi r30,r30,1 + cmpl crf1,0,r30,r25 + subf r31,r0,r31 + bc 12,4,.-h#1c + slw r25,r16,r30 + addi r0,r25,1 + rlwinm r0,r0,3,0,28 + lwz r26,h#7c(r6) + cmpi crf1,0,r20,0 + add r0,r0,r26 + stw r0,h#7c(r6) + addi r9,r26,8 + stw r9,0(r7) + addi r7,r26,4 + addi r0,r0,0 + stw r0,4(r26) + or r26,r9,r9 + stw r26,h#4c(r29) + bc 12,6,.+h#4c + stw r28,h#50c(r29) + stb r22,h#7d(r1) + addi r0,r30,h#10 + stb r0,h#7c(r1) + stw r26,h#80(r1) + subf r0,r22,r27 + srw r30,r28,r0 + addi r4,r1,h#7c + addi r5,r0,8 + lwz r12,h#598(r1) + rlwinm r3,r30,3,0,28 + lwzx r0,r23,r12 + stw r6,h#59c(r1) + stw r7,h#5a0(r1) + add r3,r3,r0 + bl .-h#408 + lwz r6,h#59c(r1) + lwz r7,h#5a0(r1) + add r9,r27,r22 + cmp crf1,0,r19,r9 + bc 12,5,.-h#10c + lwz r12,h#588(r1) + addi r0,r1,h#c4 + rlwinm r9,r12,2,0,29 + add r0,r0,r9 + cmpl crf1,0,r24,r0 + subf r0,r27,r19 + stb r0,h#7d(r1) + bc 12,4,.+h#10 + addi r0,r0,h#63 + stb r0,h#7c(r1) + b .+h#64 + lwz r0,0(r24) + cmpl crf1,0,r0,r13 + bc 4,4,.+h#28 + subfic r0,r0,h#ff + subfe r0,r0,r0 + rlwinm r9,r0,0,28,31 + nor r0,r0,r0 + rlwinm r0,r0,0,27,27 + or r9,r9,r0 + stb r9,h#7c(r1) + lwz r0,0(r24) + b .+h#2c + subf r0,r13,r0 + lwz r12,h#590(r1) + rlwinm r0,r0,1,0,30 + lhzx r0,r12,r0 + stb r0,h#7c(r1) + lwz r0,0(r24) + lwz r12,h#58c(r1) + subf r0,r13,r0 + rlwinm r0,r0,1,0,30 + lhzx r0,r12,r0 + addi r24,r24,4 + sth r0,h#7e(r1) + srw r30,r28,r27 + cmpl crf1,0,r30,r25 + subf r0,r27,r19 + slw r31,r16,r0 + bc 4,4,.+h#40 + rlwinm r0,r30,3,0,28 + add r29,r0,r26 + or r3,r29,r29 + addi r4,r1,h#7c + addi r5,r0,8 + stw r6,h#59c(r1) + stw r7,h#5a0(r1) + bl .-h#4dc + add r30,r30,r31 + cmpl crf1,0,r30,r25 + rlwinm r0,r31,3,0,28 + add r29,r29,r0 + lwz r6,h#59c(r1) + lwz r7,h#5a0(r1) + bc 12,4,.-h#30 + addi r0,r19,-1 + slw r30,r16,r0 + and. r0,r28,r30 + bc 12,2,.+h#14 + xor r28,r28,r30 + rlwinm r30,r30,31,1,31 + and. r0,r28,r30 + bc 4,2,.-h#c + xor r28,r28,r30 + slw r0,r16,r27 + addic r0,r0,-1 + rlwinm r9,r20,2,0,29 + add r11,r9,r17 + lwz r9,h#50c(r11) + and r0,r28,r0 + cmp crf1,0,r0,r9 + bc 12,6,.+h#2c + addi r10,r0,1 + addi r11,r11,-4 + subf r27,r22,r27 + slw r0,r10,r27 + addic r0,r0,-1 + lwz r9,h#50c(r11) + and r0,r28,r0 + cmp crf1,0,r0,r9 + addi r20,r20,-1 + bc 4,6,.-h#20 + or r0,r21,r21 + cmpi crf1,0,r0,0 + addi r21,r21,-1 + bc 4,6,.-h#27c + addi r19,r19,1 + cmp crf1,0,r19,r14 + addi r15,r15,4 + bc 4,5,.-h#2a4 + neg r0,r18 + and r0,r0,r18 + cntlzw r0,r0 + subfic r0,r0,h#20 + neg r0,r0 + rlwinm r0,r0,1,31,31 + xori r3,r14,1 + neg r12,r3 + and r12,r12,r3 + cntlzw r12,r12 + subfic r12,r12,h#20 + or r3,r12,r12 + neg r3,r3 + rlwinm r3,r3,1,31,31 + and r3,r0,r3 + addi r1,r1,h#5f8 + lwz r0,8(r1) + mtspr lr,r0 + lwz r13,h#-4c(r1) + lwz r14,h#-48(r1) + lwz r15,h#-44(r1) + lwz r16,h#-40(r1) + lwz r17,h#-3c(r1) + lwz r18,h#-38(r1) + lwz r19,h#-34(r1) + lwz r20,h#-30(r1) + lwz r21,h#-2c(r1) + lwz r22,h#-28(r1) + lwz r23,h#-24(r1) + lwz r24,h#-20(r1) + lwz r25,h#-1c(r1) + lwz r26,h#-18(r1) + lwz r27,h#-14(r1) + lwz r28,h#-10(r1) + lwz r29,h#-c(r1) + lwz r30,-8(r1) + lwz r31,-4(r1) + bclr 20,0 + + Debug: 2041 80130800 0 5d8 huft_build + + mfspr r0,lr + stw r28,h#-10(r1) + stw r29,h#-c(r1) + stw r30,-8(r1) + stw r31,-4(r1) + stw r0,8(r1) + stwu r1,h#-48(r1) + or r11,r4,r4 + or r28,r5,r5 + or r29,r7,r7 + or r31,r8,r8 + or r30,r9,r9 + addi r9,r0,8 + addi r0,r0,h#23c + stwx r9,r31,r0 + addic. r0,r0,-4 + bc 4,0,.-h#8 + addi r3,r0,h#90 + addi r9,r0,9 + addi r0,r0,h#240 + addi r3,r3,1 + cmpi crf1,0,r3,h#ff + stwx r9,r31,r0 + addic r0,r0,4 + bc 4,5,.-h#10 + cmpi crf1,0,r3,h#117 + bc 12,5,.+h#20 + addi r9,r0,7 + rlwinm r0,r3,2,0,29 + addi r3,r3,1 + cmpi crf1,0,r3,h#117 + stwx r9,r31,r0 + addic r0,r0,4 + bc 4,5,.-h#10 + cmpi crf1,0,r3,h#11f + bc 12,5,.+h#1c + addi r0,r0,8 + rlwinm r3,r3,2,0,29 + stwx r0,r3,r31 + addi r3,r3,4 + cmpi crf1,0,r3,h#47c + bc 4,5,.-h#c + addi r0,r0,7 + stw r0,0(r6) + or r3,r31,r31 + addi r4,r0,h#120 + addi r5,r0,h#101 + or r8,r11,r11 + or r9,r6,r6 + lwz r6,h#10(r30) + lwz r7,h#14(r30) + or r10,r30,r30 + bl .-h#6c8 + or. r3,r3,r3 + bc 4,2,.+h#48 + addi r9,r0,5 + addi r0,r0,0 + stwx r9,r31,r0 + addic r0,r0,4 + cmpi crf1,0,r0,h#74 + bc 4,5,.-h#c + addi r0,r0,5 + stw r0,0(r29) + or r3,r31,r31 + addi r4,r0,h#1e + addi r5,r0,0 + or r8,r28,r28 + or r9,r29,r29 + lwz r6,h#18(r30) + lwz r7,h#1c(r30) + or r10,r30,r30 + bl .-h#714 + addi r1,r1,h#48 + lwz r0,8(r1) + mtspr lr,r0 + lwz r28,h#-10(r1) + lwz r29,h#-c(r1) + lwz r30,-8(r1) + lwz r31,-4(r1) + bclr 20,0 + + Debug: 2041 80040700 0 140 huft_fixed + + mfspr r0,lr + stw r16,h#-40(r1) + stw r17,h#-3c(r1) + stw r18,h#-38(r1) + stw r19,h#-34(r1) + stw r20,h#-30(r1) + stw r21,h#-2c(r1) + stw r22,h#-28(r1) + stw r23,h#-24(r1) + stw r24,h#-20(r1) + stw r25,h#-1c(r1) + stw r26,h#-18(r1) + stw r27,h#-14(r1) + stw r28,h#-10(r1) + stw r29,h#-c(r1) + stw r30,-8(r1) + stw r31,-4(r1) + stw r0,8(r1) + stwu r1,h#-78(r1) + or r20,r4,r4 + or r21,r5,r5 + or r23,r6,r6 + or r16,r7,r7 + or r25,r8,r8 + or r28,r9,r9 + addi r3,r0,5 + lwz r4,0(r28) + or r5,r28,r28 + bl .-h#874 + or r30,r3,r3 + addi r3,r0,5 + rlwinm r4,r30,27,5,31 + lwz r0,4(r28) + or r5,r28,r28 + addic r0,r0,-5 + stw r0,4(r28) + rlwinm r0,r30,0,27,31 + addic r19,r0,h#101 + bl .-h#89c + or r30,r3,r3 + addi r3,r0,4 + rlwinm r4,r30,27,5,31 + lwz r0,4(r28) + or r5,r28,r28 + addic r0,r0,-5 + stw r0,4(r28) + rlwinm r0,r30,0,27,31 + addic r18,r0,1 + bl .-h#8c4 + or r30,r3,r3 + rlwinm r10,r30,0,28,31 + rlwinm r30,r30,28,4,31 + subfic r11,r19,h#11e + subfe r11,r11,r11 + neg r11,r11 + subfic r9,r18,h#1e + subfe r9,r9,r9 + neg r9,r9 + or. r8,r11,r9 + lwz r0,4(r28) + addi r29,r10,4 + addic r0,r0,-4 + stw r0,4(r28) + bc 4,2,.+h#2fc + addi r31,r0,0 + cmpl crf1,0,r31,r29 + bc 4,4,.+h#4c + addi r3,r0,3 + or r4,r30,r30 + or r5,r28,r28 + bl .-h#91c + or r30,r3,r3 + rlwinm r9,r31,2,0,29 + addi r31,r31,1 + lwz r11,h#c(r28) + rlwinm r0,r30,0,29,31 + lwzx r9,r9,r11 + cmpl crf1,0,r31,r29 + rlwinm r9,r9,2,0,29 + stwx r0,r9,r25 + lwz r0,4(r28) + rlwinm r30,r30,29,3,31 + addic r0,r0,-3 + stw r0,4(r28) + bc 12,4,.-h#44 + cmpli crf1,0,r31,h#12 + bc 12,5,.+h#28 + addi r10,r0,0 + rlwinm r11,r31,2,0,29 + addi r31,r31,1 + lwz r9,h#c(r28) + cmpli crf1,0,r31,h#12 + lwzx r0,r11,r9 + rlwinm r0,r0,2,0,29 + stwx r10,r25,r0 + bc 4,5,.-h#1c + addi r0,r0,7 + stw r0,0(r23) + or r3,r25,r25 + addi r4,r0,h#13 + addi r5,r0,h#13 + addi r6,r0,0 + addi r7,r0,0 + or r8,r20,r20 + or r9,r23,r23 + or r10,r28,r28 + bl .-h#900 + or. r29,r3,r3 + bc 12,2,.+h#c + cmpi crf1,0,r29,1 + bc 12,6,.+h#240 + addi r26,r0,0 + addi r29,r0,0 + add r24,r19,r18 + lwz r0,0(r23) + cmpl crf1,0,r29,r24 + addi r9,r0,1 + slw r9,r9,r0 + addi r17,r9,-1 + bc 4,4,.+h#1d4 + addi r22,r0,0 + addi r27,r0,0 + or r4,r30,r30 + lwz r3,0(r23) + or r5,r28,r28 + bl .-h#9f8 + or r30,r3,r3 + and r9,r30,r17 + lwz r0,0(r20) + rlwinm r9,r9,3,0,28 + add r9,r9,r0 + stw r9,0(r21) + lbz r31,1(r9) + lwz r0,4(r28) + subf r0,r31,r0 + stw r0,4(r28) + lwz r9,0(r21) + srw r30,r30,r31 + lhz r31,2(r9) + cmpli crf1,0,r31,h#f + bc 12,5,.+h#18 + or r26,r31,r31 + stwx r26,r27,r25 + addi r27,r27,4 + addi r29,r29,1 + b .+h#164 + cmpi crf1,0,r31,h#10 + bc 4,6,.+h#74 + addi r3,r0,2 + or r4,r30,r30 + or r5,r28,r28 + bl .-h#a60 + or r30,r3,r3 + rlwinm r11,r30,0,30,31 + addi r31,r11,3 + add r9,r29,r31 + lwz r0,4(r28) + cmpl crf1,0,r9,r24 + rlwinm r30,r30,30,2,31 + addic r0,r0,-2 + stw r0,4(r28) + bc 12,5,.+h#174 + or r0,r31,r31 + cmpi crf1,0,r0,0 + addi r31,r11,2 + bc 12,6,.+h#114 + rlwinm r9,r29,2,0,29 + stwx r26,r9,r25 + addi r9,r9,4 + or r0,r31,r31 + cmpi crf1,0,r0,0 + addi r27,r27,4 + addi r29,r29,1 + addi r31,r31,-1 + bc 4,6,.-h#1c + b .+h#ec + cmpi crf1,0,r31,h#11 + bc 4,6,.+h#74 + addi r3,r0,3 + or r4,r30,r30 + or r5,r28,r28 + bl .-h#ad8 + or r30,r3,r3 + rlwinm r11,r30,0,29,31 + addi r31,r11,3 + add r9,r29,r31 + lwz r0,4(r28) + cmpl crf1,0,r9,r24 + rlwinm r30,r30,29,3,31 + addic r0,r0,-3 + stw r0,4(r28) + bc 12,5,.+h#fc + or r0,r31,r31 + cmpi crf1,0,r0,0 + addi r31,r11,2 + bc 12,6,.+h#98 + rlwinm r9,r29,2,0,29 + stwx r22,r9,r25 + addi r9,r9,4 + or r0,r31,r31 + cmpi crf1,0,r0,0 + addi r27,r27,4 + addi r29,r29,1 + addi r31,r31,-1 + bc 4,6,.-h#1c + b .+h#70 + addi r3,r0,7 + or r4,r30,r30 + or r5,r28,r28 + bl .-h#b48 + or r30,r3,r3 + rlwinm r11,r30,0,25,31 + addi r31,r11,h#b + add r9,r29,r31 + lwz r0,4(r28) + cmpl crf1,0,r9,r24 + rlwinm r30,r30,25,7,31 + addic r0,r0,-7 + stw r0,4(r28) + bc 12,5,.+h#8c + or r0,r31,r31 + cmpi crf1,0,r0,0 + addi r31,r11,h#a + bc 12,6,.+h#28 + rlwinm r9,r29,2,0,29 + stwx r22,r9,r25 + addi r9,r9,4 + or r0,r31,r31 + cmpi crf1,0,r0,0 + addi r27,r27,4 + addi r29,r29,1 + addi r31,r31,-1 + bc 4,6,.-h#1c + addi r26,r0,0 + cmpl crf1,0,r29,r24 + bc 12,4,.-h#1c4 + stw r30,0(r28) + or r3,r25,r25 + or r4,r19,r19 + addi r5,r0,h#101 + or r8,r20,r20 + lwz r0,h#20(r28) + or r9,r23,r23 + stw r0,h#7c(r28) + addi r0,r0,9 + stw r0,0(r9) + lwz r6,h#10(r28) + lwz r7,h#14(r28) + or r10,r28,r28 + bl .-h#b3c + or. r29,r3,r3 + bc 12,2,.+h#14 + or r3,r29,r29 + b .+h#48 + addi r3,r0,1 + b .+h#40 + addi r0,r0,6 + stw r0,0(r16) + rlwinm r3,r19,2,0,29 + add r3,r25,r3 + or r4,r18,r18 + addi r5,r0,0 + or r8,r21,r21 + or r9,r16,r16 + lwz r6,h#18(r28) + lwz r7,h#1c(r28) + or r10,r28,r28 + bl .-h#b84 + or. r29,r3,r3 + bc 12,2,.+h#8 + or r3,r29,r29 + addi r1,r1,h#78 + lwz r0,8(r1) + mtspr lr,r0 + lwz r16,h#-40(r1) + lwz r17,h#-3c(r1) + lwz r18,h#-38(r1) + lwz r19,h#-34(r1) + lwz r20,h#-30(r1) + lwz r21,h#-2c(r1) + lwz r22,h#-28(r1) + lwz r23,h#-24(r1) + lwz r24,h#-20(r1) + lwz r25,h#-1c(r1) + lwz r26,h#-18(r1) + lwz r27,h#-14(r1) + lwz r28,h#-10(r1) + lwz r29,h#-c(r1) + lwz r30,-8(r1) + lwz r31,-4(r1) + bclr 20,0 + + Debug: 2041 80100700 0 48c huft_dynamic + +\ I'm not sure what this is; perhaps part of the TOC, or something like that +\ The code above doesn't appear to depend on it. + h# 0 be-l, h# 153c be-l, h# 0 be-l, + +end-code + +end-assembling + +writing inflate.bin +asm-base here over - ofd @ fputs +ofd @ fclose + +\ LICENSE_BEGIN +\ Copyright (c) 2007 FirmWorks +\ +\ Permission is hereby granted, free of charge, to any person obtaining +\ a copy of this software and associated documentation files (the +\ "Software"), to deal in the Software without restriction, including +\ without limitation the rights to use, copy, modify, merge, publish, +\ distribute, sublicense, and/or sell copies of the Software, and to +\ permit persons to whom the Software is furnished to do so, subject to +\ the following conditions: +\ +\ The above copyright notice and this permission notice shall be +\ included in all copies or substantial portions of the Software. +\ +\ THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, +\ EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF +\ MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND +\ NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE +\ LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION +\ OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION +\ WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. +\ +\ LICENSE_END Added: cpu/ppc/initpgm.fth =================================================================== --- cpu/ppc/initpgm.fth (rev 0) +++ cpu/ppc/initpgm.fth 2007-07-05 17:19:17 UTC (rev 461) @@ -0,0 +1,50 @@ +purpose: Generic tools for load image handlers +\ See license at end of file + +: +base ( n -- adr ) load-base + ; + +: (init-program) ( pc sp -- ) + clear-save-area state-valid on + \ PowerPC calling conventions store the link register at SP+8, + \ so we start with r1 a little below the top of the allocated region + h# 20 - to %r1 to %pc + cif-handler to %r5 + + msr@ interrupt-enable-bit invert and to %msr + + restartable? on + true to already-go? +; + +dev /client-services +: chain ( len args entry size virt -- ) + release ( len args entry ) + h# 8000 alloc-mem h# 8000 + (init-program) ( len args ) + to %r6 to %r7 + go +; +device-end + +\ LICENSE_BEGIN +\ Copyright (c) 2007 FirmWorks +\ +\ Permission is hereby granted, free of charge, to any person obtaining +\ a copy of this software and associated documentation files (the +\ "Software"), to deal in the Software without restriction, including +\ without limitation the rights to use, copy, modify, merge, publish, +\ distribute, sublicense, and/or sell copies of the Software, and to +\ permit persons to whom the Software is furnished to do so, subject to +\ the following conditions: +\ +\ The above copyright notice and this permission notice shall be +\ included in all copies or substantial portions of the Software. +\ +\ THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, +\ EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF +\ MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND +\ NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE +\ LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION +\ OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION +\ WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. +\ +\ LICENSE_END Added: cpu/ppc/kerncode.fth =================================================================== --- cpu/ppc/kerncode.fth (rev 0) +++ cpu/ppc/kerncode.fth 2007-07-05 17:19:17 UTC (rev 461) @@ -0,0 +1,1479 @@ +purpose: Kernel code words +\ See license at end of file + +\ In the portions of the code than are used while incrementally compiling on +\ the host system, we use "subfc" instead of "subf" instructions, because the +\ POWER, as opposed to PowerPC, instruction set architecture does not have +\ "subf". This allows us to compile on POWER-based RS6000 systems. +\ In code that is only used in a target firmware environment, we can use "subf" +\ "subf" may execute somewhat faster than "subfc", because the carry bit +\ represents an interaction between the integer unit and the branch unit, +\ but the difference is likely to be insignificant in the Forth environment. +\ However, there are cases in interrupt handlers where "subfc" modification +\ of the carry bit represents an undesireable change to the value of the +\ XER register, complicating the process of restoring the state of the +\ interrupted code. + +meta +hex + +\ Allocate and clear the initial user area image +mlabel init-user-area +setup-user-area + +extend-meta-assembler + +\ ---- Assembler macros that reside in the host environment +\ and assemble code for the target environment + +\ Forth Virtual Machine registers + +\ Note that the Forth Stack Pointer (r31) is NOT the same register that +\ C uses for the stack frame pointer (r1). + +register-names definitions + +decimal +:-h t0 20 ;-h :-h t1 21 ;-h :-h t2 22 ;-h :-h t3 23 ;-h +:-h t4 24 ;-h :-h t5 25 ;-h +:-h base 26 ;-h :-h up 27 ;-h :-h tos 28 ;-h :-h ip 29 ;-h +:-h rp 30 ;-h :-h sp 31 ;-h +:-h w t5 ;-h +:-h t6 19 ;-h +hex + + +\ Constants defining virtual machine implementation parameters + +constant-names definitions + +also meta /n-t previous ( /n-t ) + constant-h 1cell \ Offsets into the stack +1cell -1 * constant-h -1cell +1cell 2 * constant-h 2cells +1cell 3 * constant-h 3cells +1cell 4 * constant-h 4cells +1cell 5 * constant-h 5cells + +1cell constant-h /cf \ Size of a code field (except for "create") +/cf -1 * constant-h -/cf + +1cell constant-h /token \ Size of a compiled word reference +/token -1 * constant-h -/token + +1cell constant-h /branch \ Size of a branch offset + +/token 2 * constant-h /ccf \ Size of a "create" code field + +/cf 1cell + constant-h /cf+1cell \ Location of second half of + +previous previous definitions + +\ assembler macros for common sequences +extend-meta-assembler + +:-h next-tail1 " add t1,t1,base mtspr lr,t1 bclr 20,0" evaluate ;-h +:-h next-tail " lwzux t1,w,base next-tail1" evaluate ;-h +:-h push-tos " stwu tos,-1cell(sp)" evaluate ;-h +:-h push-t0 " stwu t0,-1cell(sp)" evaluate ;-h +:-h pop-tos " lwz tos,0(sp) addi sp,sp,1cell" evaluate ;-h +:-h pop1 " lwz tos,1cell(sp) addi sp,sp,2cells" evaluate ;-h +:-h pop2 " lwz tos,2cells(sp) addi sp,sp,3cells" evaluate ;-h +:-h second-to-t0 " lwz t0,0(sp)" evaluate ;-h +:-h pop-to-t0 " second-to-t0 addi sp,sp,1cell" evaluate ;-h +:-h double-tos " add tos,tos,tos" evaluate ;-h +:-h third-to-t1 " lwz t1,1cell(sp)" evaluate ;-h +:-h user#-to-t0 " lwz t0,/cf(w)" evaluate ;-h +:-h take-branch " lwz t0,/branch(ip) add ip,ip,t0" evaluate ;-h +:-h skip-branch " addi ip,ip,/branch" evaluate ;-h +:-h literal-to-tos " lwzu tos,/token(ip)" evaluate ;-h +:-h literal-to-t0 " lwzu t0,/token(ip)" evaluate ;-h +:-h rdrop " addi rp,rp,1cell" evaluate ;-h +:-h rdrop3 " addi rp,rp,3cells" evaluate ;-h + +\ We create the shared code for the "next" routine so that: +\ a) It will be in RAM for speed (ROM is often slow) +\ b) We can use the user pointer as its base address, for quick jumping + +also forth +compilation-base here-t \ Save meta dictionary pointer +0 dp-t ! userarea-t is compilation-base \ Point it to user area +previous + +mlabel (next) \ Shared code for next; will be copied into user area + lwzu w,/token(ip) + next-tail +end-code + +also forth +dp-t ! is compilation-base previous \ Restore meta dict. pointer + +d# 32 equ #user-init \ Leaves space for the shared "next" + +only forth also labels also meta also assembler definitions + +\ assembler macro to assemble next +:-h next " bcctr 20,0" evaluate ;-h + +:-h c; next end-code ;-h + +previous definitions + +code-field: docolon + stwu ip,-1cell(rp) \ Push the ip register on the return stack + mr ip,w \ Set ip to apf of the colon definition +c; + +code-field: dovariable + push-tos + addi tos,w,/cf \ Put pfa in top-of-stack register +c; + +code-field: dolabel + + push-tos + addi tos,w,/cf \ Put pfa in top-of-stack register +c; + +code-field: douser + push-tos + user#-to-t0 + add tos,t0,up \ Add the base address of the user area +c; + +code-field: dovalue + push-tos + user#-to-t0 + lwzx tos,t0,up \ Get the contents of the user area location +c; + +code-field: dodefer + user#-to-t0 + lwzx w,t0,up \ Get the acf stored in that user location + next-tail +end-code + +code-field: doconstant + push-tos + lwz tos,/cf(w) \ Get the constant's value +c; + +code-field: do2constant + push-tos + lwzu tos,/cf(w) \ Get the constant's value + push-tos \ Put it on the memory stack + lwz tos,1cell(w) \ Get the top constant's value +c; + +code-field: dodoes + \ The child word's code field contains the token of dodoes, followed + \ by the token of the does clause. + + push-tos + addi tos,w,/ccf \ Put pfa in top-of-stack register + lwz w,/cf(w) \ Set w to acf of the definition + next-tail +end-code + +:-h code-cf ( -- ) here /token + aligned token,-t align-t ;-h +:-h label-cf ( -- ) dolabel token,-t align-t ;-h +:-h colon-cf ( -- ) docolon token,-t ;-h +:-h constant-cf ( -- ) doconstant token,-t ;-h +:-h variable-cf ( -- ) dovariable token,-t ;-h +:-h user-cf ( -- ) douser token,-t ;-h +:-h value-cf ( -- ) dovalue token,-t ;-h +:-h defer-cf ( -- ) dodefer token,-t ;-h +:-h startdoes ( -- ) colon-cf ;-h +:-h start;code ( -- ) code-cf ;-h +:-h create-cf ( -- ) dodoes token,-t compile-t noop ;-h +:-h vocabulary-cf ( -- ) dodoes token,-t compile-t <vocabulary> ;-h + +meta definitions + +\ dovariable constant dovariable +\ dodoes constant dodoes + +code (lit) (s -- n ) + push-tos + literal-to-tos +c; +code (wlit) (s -- n ) + push-tos + literal-to-tos +c; + +\ Execute a Forth word given a code field address +code execute (s acf -- ) + mr w,tos + pop-tos + lwz t1,0(w) \ Read the contents of the code field + next-tail1 +end-code + +\ High level branch. The branch offset is compiled in-line. +code branch (s -- ) +mlabel bran1 + take-branch +c; + +\ High level conditional branch. +code ?branch (s f -- ) \ Takes the branch if the flag is false + cmpi 0,0,tos,0 + pop-tos + + bran1 0= brif + + skip-branch +c; + +\ Run time word for loop +code (loop) (s -- ) + lwz t0,0(rp) + addic. t1,t0,1 \ Increment index + stw t1,0(rp) \ Write back the loop index + bran1 0>= brif \ Result still positive; continue looping + cmpi 0,0,t0,0 \ Result negative, so check operand + bran1 0< brif \ If operand is negative too, continue looping + + \ The internal "i" value went from positive to negative, so the loop ends + rdrop3 \ remove loop params from stack + skip-branch +c; + +\ Run time word for +loop +code (+loop) (s increment -- ) + lwz t0,0(rp) + add t1,t0,tos \ increment loop index + stw t1,0(rp) \ Write back the loop index + xor. t3,t0,tos \ Compare operand signs + pop-tos + bran1 0< brif \ Operand signs different + + xor. t2,t1,t0 \ Compare result with an operand + bran1 0>= brif \ Result has same sign as operand; continue looping + + \ The result sign differs from the operand signs; so the loop ends + rdrop3 \ remove loop params from stack + skip-branch +c; + +\ Run time word for do +code (do) (s l i -- ) + mr t1,tos \ i in t1 + second-to-t0 \ l in t0 + pop1 \ Finish popping stack +mlabel pd0 ( -- r: loop-end-offset l+0x8000 i-l-0x8000 ) + stwu ip,-1cell(rp) \ remember the do offset address + addi ip,ip,/branch \ Skip the do offset + addis t0,t0,h#-8000 \ Bias by h#8000.0000 + stwu t0,-1cell(rp) \ Push biased limit on return stack + subfc t1,t0,t1 \ ( Use subfc for POWER compatibility) + stwu t1,-1cell(rp) \ Push biased index on return stack +c; +meta + +\ Run time word for ?do +code (?do) (s l i -- ) + second-to-t0 \ l in t0 + mr t1,tos \ i in t1 + pop1 \ Finish popping stack + cmp 0,0,t0,t1 + pd0 <> brif + + take-branch +c; + +\ Loop index for current do loop +code i (s -- n ) + push-tos + lwz tos,0(rp) + lwz t0,1cell(rp) + add tos,tos,t0 +c; + +\ Loop index for next enclosing do loop +code j (s -- n ) + push-tos + lwz tos,12(rp) + lwz t0,16(rp) + add tos,tos,t0 +c; + +code (leave) (s -- ) +mlabel pleave + lwz ip,2cells(rp) \ Get the address of the ending offset + rdrop3 \ get rid of the loop indices + + take-branch +c; + +code (?leave) (s f -- ) + cmpi 0,0,tos,0 + pop-tos + pleave 0<> brif +c; + +code unloop ( -- ) rdrop3 c; \ Discard the loop indices + +code (of) ( selector test -- [ selector ] ) + pop-to-t0 \ Test in tos, Selector in t0 + cmp 0,0,t0,tos + mr tos,t0 \ Copy selector to tos + = if + pop-tos \ Overwrite tos if selector matches + skip-branch + next + then + + take-branch +c; + +\ (endof) is the same as branch, and (endcase) is the same as drop, +\ but redefining them this way makes the decompiler much easier. +code (endof) (s -- ) + take-branch +c; +code (endcase) (s n -- ) + pop-tos +c; + +assembler +mlabel dofalse + addi tos,r0,0 + next +meta + +\ Convert a character to a digit according to the current base +code digit (s char base -- digit true | char false ) + mr t0,tos \ base in t0 + lwz tos,0(sp) \ char in tos + addic. tos,tos,h#-30 \ convert to number \ 30 is ascii 0 + dofalse 0< brif \ Anything less than ascii 0 isn't a digit + cmpi 0,0,tos,10 \ Test for >= 10 + 0>= if \ Try for a letter representing a digit + ascii A ascii 0 - cmpi 0,0,tos,* + dofalse < brif \ bad if > '9' and < 'A' + ascii a ascii 0 - cmpi 0,0,tos,* \ >= 'a' + >= if + ascii a ascii 0 - d# 10 - negate addi tos,tos,* + else + ascii A ascii 0 - d# 10 - negate addi tos,tos,* + then + then + cmp 0,0,tos,t0 \ Compare digit to base + dofalse 0>= brif \ Error if digit is bigger than base + stw tos,0(sp) \ Replace the char on the stack with the digit + addi tos,r0,-1 \ True to indicate success +c; + +\ Copy cnt characters starting at from-addr to to-addr. Copying is done +\ strictly from low to high addresses, so be careful of overlap between the +\ two buffers. + +code cmove ( src dst cnt -- ) \ Copy from bottom to top + second-to-t0 \ Dst into t0 + third-to-t1 \ Src into t1 + + cmpi 0,0,tos,0 + 0<> if + addi t0,t0,-1 \ Account for pre-incrementing + addi t1,t1,-1 \ Account for pre-incrementing + mfspr t2,ctr \ Save count register + mtspr ctr,tos \ Count in count register + begin + lbzu t3,1(t1) \ Load byte + stbu t3,1(t0) \ Store byte + countdown \ Decrement & Branch if nonzero + mtspr ctr,t2 \ Restore count register + then + + pop2 +c; + +code cmove> ( src dst cnt -- ) \ Copy from top to bottom + second-to-t0 \ Dst into t0 + third-to-t1 \ Src into t1 + + cmpi 0,0,tos,0 + 0<> if + add t0,t0,tos \ Top of dst range + add t1,t1,tos \ Top of src range + mfspr t2,ctr \ Save count register + mtspr ctr,tos \ Count in count register + begin + lbzu t3,-1(t1) \ Load byte + stbu t3,-1(t0) \ Store byte + countdown \ Decrement & Branch if nonzero + mtspr ctr,t2 \ Restore count register + then + + pop2 +c; + +code lshift (s n1 cnt -- n2 ) pop-to-t0 slw tos,t0,tos c; +code rshift (s n1 cnt -- n2 ) pop-to-t0 srw tos,t0,tos c; +code << (s n1 cnt -- n2 ) pop-to-t0 slw tos,t0,tos c; +code >> (s n1 cnt -- n2 ) pop-to-t0 srw tos,t0,tos c; +code >>a (s n1 cnt -- n2 ) pop-to-t0 sraw tos,t0,tos c; + +code and (s n1 n2 -- n3 ) pop-to-t0 and tos,tos,t0 c; +code or (s n1 n2 -- n3 ) pop-to-t0 or tos,tos,t0 c; +code xor (s n1 n2 -- n3 ) pop-to-t0 xor tos,tos,t0 c; + +code + (s n1 n2 -- n3 ) pop-to-t0 add tos,tos,t0 c; + +\ ( Use subfc for POWER compatibility) +code - (s n1 n2 -- n3 ) pop-to-t0 subfc tos,tos,t0 c; + +code min (s n1 n2 -- n3 ) + pop-to-t0 cmp 0,0,t0,tos < if mr tos,t0 then +c; +code max (s n1 n2 -- n3 ) + pop-to-t0 cmp 0,0,t0,tos > if mr tos,t0 then +c; +code umin (s n1 n2 -- n3 ) + pop-to-t0 cmpl 0,0,t0,tos < if mr tos,t0 then +c; +code umax (s n1 n2 -- n3 ) + pop-to-t0 cmpl 0,0,t0,tos > if mr tos,t0 then +c; + +code invert (s n1 -- n2 ) nor tos,tos,tos c; +code negate (s n1 -- n2 ) neg tos,tos c; +code abs (s n1 -- n2 ) cmpi 0,0,tos,0 0< if neg tos,tos then c; + +code up@ (s -- addr ) push-tos mr tos,up c; +code sp@ (s -- addr ) push-tos mr tos,sp c; +code rp@ (s -- addr ) push-tos mr tos,rp c; +code up! (s addr -- ) mr up,tos pop-tos c; +code sp! (s addr -- ) mr sp,tos pop-tos c; +code rp! (s addr -- ) mr rp,tos pop-tos c; + +code >r (s n -- ) stwu tos,-1cell(rp) pop-tos c; +code r> (s -- n ) push-tos lwz tos,0(rp) rdrop c; +code r@ (s -- n ) push-tos lwz tos,0(rp) c; + +code 2>r (s n1 n2 -- ) + second-to-t0 stwu t0,-1cell(rp) stwu tos,-1cell(rp) pop1 +c; +code 2r> (s -- n1 n2 ) + push-tos lwz tos,1cell(rp) push-tos lwz tos,0(rp) addi rp,rp,2cells +c; +code 2r@ (s -- n1 n2 ) + push-tos lwz tos,1cell(rp) push-tos lwz tos,0(rp) +c; + +code ip> (s -- n ) push-tos lwz tos,0(rp) rdrop addi tos,tos,/token c; +code ip@ (s -- n ) push-tos lwz tos,0(rp) addi tos,tos,/token c; +code >ip (s n -- ) addi tos,tos,-/token stwu tos,-1cell(rp) pop-tos c; +code ip>token ( ip -- token-adr ) c; + +code exit (s -- ) lwz ip,0(rp) rdrop c; +code unnest (s -- ) lwz ip,0(rp) rdrop c; + +code tuck (s n1 n2 -- n2 n1 n2 ) second-to-t0 push-t0 stw tos,1cell(sp) c; +code nip (s n1 n2 -- n2 ) addi sp,sp,1cell c; +code flip (s w1 -- w2 ) \ byte swap + rlwinm t0,tos,24,24,31 \ high half to low half + rlwimi t0,tos,8,16,23 \ low to high and insert + mr tos,t0 +c; + +assembler definitions + +\ macro to assemble code to leave a flag on the stack +:-h leaveflag (s condition -- ) + " if addi tos,r0,-1 else addi tos,r0,0 then" evaluate +;-h + +:-h compare " pop-to-t0 cmp 0,0,t0,tos" evaluate ;-h +:-h compareu " pop-to-t0 cmpl 0,0,t0,tos" evaluate ;-h +:-h compare0 " cmpi 0,0,tos,0" evaluate ;-h + +meta definitions +code 0< (s n -- f ) compare0 0< leaveflag c; +code 0> (s n -- f ) compare0 0> leaveflag c; +code 0<= (s n -- f ) compare0 0<= leaveflag c; +code 0>= (s n -- f ) compare0 0>= leaveflag c; +code 0= (s n -- f ) compare0 0= leaveflag c; +code 0<> (s n -- f ) compare0 0<> leaveflag c; + +code = (s n1 n2 -- f ) compare = leaveflag c; +code <> (s n1 n2 -- f ) compare <> leaveflag c; + +code < (s n1 n2 -- f ) compare < leaveflag c; +code >= (s n1 n2 -- f ) compare >= leaveflag c; +code > (s n1 n2 -- f ) compare > leaveflag c; +code <= (s n1 n2 -- f ) compare <= leaveflag c; +code u< (s n1 n2 -- f ) compareu < leaveflag c; +code u>= (s n1 n2 -- f ) compareu >= leaveflag c; +code u> (s n1 n2 -- f ) compareu > leaveflag c; +code u<= (s n1 n2 -- f ) compareu <= leaveflag c; + +code drop (s n -- ) pop-tos c; +code dup (s n -- n n ) push-tos c; +code over (s n1 n2 -- n1 n2 n1 ) push-tos lwz tos,1cell(sp) c; +code swap (s n1 n2 -- n2 n1 ) second-to-t0 stw tos,0(sp) mr tos,t0 c; +code rot (s n1 n2 n3 -- n2 n3 n1 ) + second-to-t0 + third-to-t1 + stw t0,1cell(sp) + stw tos,0(sp) + mr tos,t1 +c; +code -rot (s n1 n2 n3 -- n3 n1 n2 ) + second-to-t0 + third-to-t1 + stw tos,1cell(sp) + stw t1,0(sp) + mr tos,t0 +c; +code 2drop (s d -- ) pop1 c; +code 2dup (s d -- d d ) second-to-t0 push-tos push-t0 c; +code 2over (s d1 d2 -- d1 d2 d1 ) + push-tos + lwz tos,12(sp) + push-tos + lwz tos,12(sp) +c; +code 2swap (s d1 d2 -- d2 d1 ) + lwz t2,2cells(sp) + third-to-t1 + second-to-t0 + stw t0,2cells(sp) + stw tos,1cell(sp) + stw t2,0(sp) + mr tos,t1 +c; +code 3drop (s n1 n2 n3 -- ) pop2 c; +code 3dup (s n1 n2 n3 -- n1 n2 n3 n1 n2 n3 ) + third-to-t1 + second-to-t0 + push-tos + stwu t1,-1cell(sp) + push-t0 +c; +code 4drop (s n1 n2 n3 n4 -- ) + lwz tos,3cells(sp) addi sp,sp,4cells +c; +code 5drop (s n1 n2 n3 n4 n5 -- ) + lwz tos,4cells(sp) addi sp,sp,5cells +c; + +code pick (s nm ... n1 n0 k -- nm ... n2 n0 nk ) + add tos,tos,tos + add tos,tos,tos \ Multiply by /n + lwzx tos,tos,sp +c; + +code 1+ (s n1 -- n2 ) addi tos,tos,1 c; +code 2+ (s n1 -- n2 ) addi tos,tos,2 c; +code 1- (s n1 -- n2 ) addi tos,tos,-1 c; +code 2- (s n1 -- n2 ) addi tos,tos,-2 c; + +code 2/ (s n1 -- n2 ) srawi tos,tos,1 c; +code u2/ (s n1 -- n2 ) rlwinm tos,tos,31,1,31 c; +code 4/ (s n1 -- n2 ) srawi tos,tos,2 c; +code 2* (s n1 -- n2 ) rlwinm tos,tos,1,0,30 c; +code 4* (s n1 -- n2 ) rlwinm tos,tos,2,0,29 c; +code 8* (s n1 -- n2 ) rlwinm tos,tos,3,0,28 c; + +code on (s addr -- ) addi t0,r0,-1 stw t0,0(tos) pop-tos c; +code off (s addr -- ) addi t0,r0,0 stw t0,0(tos) pop-tos c; + +code +! (s n addr -- ) + second-to-t0 + lwz t1,0(tos) + add t1,t1,t0 + stw t1,0(tos) + pop1 +c; + +code @ (s adr -- n ) lwz tos,0(tos) c; \ longword aligned +code l@ (s adr -- l ) lwz tos,0(tos) c; \ longword aligned +code w@ (s adr -- w ) lhz tos,0(tos) c; \ 16-bit word aligned +code <w@ (s adr -- w ) lha tos,0(tos) c; \ with sign extension +code c@ (s adr -- c ) lbz tos,0(tos) c; +code be-w@ ( a -- w ) + lbz t0,0(tos) + lbz tos,1(tos) + rlwimi tos,t0,8,16,23 +c; +code le-w@ ( a -- w ) + lbz t0,1(tos) + lbz tos,0(tos) + rlwimi tos,t0,8,16,23 +c; + +code ! (s n adr -- ) second-to-t0 stw t0,0(tos) pop1 c; +code l! (s n adr -- ) second-to-t0 stw t0,0(tos) pop1 c; +code w! (s w adr -- ) second-to-t0 sth t0,0(tos) pop1 c; +code c! (s c adr -- ) second-to-t0 stb t0,0(tos) pop1 c; +code be-w! ( w a -- ) + second-to-t0 + rlwinm t1,t0,24,24,31 \ high byte + stb t1,0(tos) + stb t0,1(tos) + pop1 +c; +code le-w! ( w a -- ) + second-to-t0 + rlwinm t1,t0,24,24,31 \ high byte + stb t1,1(tos) + stb t0,0(tos) + pop1 +c; + +[ifdef] 64bit-hardware +[else] +\ XXX Use 64-bit oper +: d@ (s adr -- low high ) dup na1+ @ swap @ ; +: d! (s low high adr -- ) tuck ! na1+ ! ; +[then] + +: instruction! (s n adr -- ) tuck ! /l sync-cache ; + +code 2@ (s adr -- d ) lwz t0,1cell(tos) push-t0 lwz tos,0(tos) c; +code 2! (s d adr -- ) + second-to-t0 + stw t0,0(tos) + lwz t0,1cell(sp) + stw t0,1cell(tos) + pop2 +c; + +code fill (s start-adr count char -- ) + \ char in tos + second-to-t0 \ count in t0 + third-to-t1 \ dst in t1 + + cmpli 0,0,t0,h#1000 \ Optimize only if the count is large + >= if + or r0,t1,t0 \ Collect low bits of count and address + andi. r0,r0,3 \ Optimize only if the address and count are aligned + 0= if + addi t1,t1,-1cell \ Account for pre-increment + rlwinm t0,t0,30,2,31 \ Divide count by 4 + rlwimi tos,tos,8,16,23 \ Replicate low byte into low halfword + rlwimi tos,tos,16,0,15 \ Replicate low halfword into word + mfspr t2,ctr \ Save CTR + mtspr ctr,t0 + begin + stwu tos,1cell(t1) + countdown + mtspr ctr,t2 + + pop2 next + then + + then + + cmpi 0,0,t0,0 + 0<> if + addi t1,t1,-1 \ Account for pre-increment + mfspr t2,ctr \ Save CTR + mtspr ctr,t0 + begin + stbu tos,1(t1) \ Store byte + countdown \ Decrement and Branch if nonzero + mtspr ctr,t2 + then + + pop2 +c; + +code noop (s -- ) c; + +code lowbyte (s n -- low ) andi. tos,tos,h#ff c; + +code wbsplit (s w -- b.low b.high ) \ split a word into two bytes + andi. t0,tos,h#ff + push-t0 + rlwinm tos,tos,24,24,31 +c; +code bwjoin (s b.low b.high -- w ) + pop-to-t0 + andi. t0,t0,h#ff + rlwimi t0,tos,8,16,23 + mr tos,t0 +c; +code lwsplit (s l -- w.low w.high ) \ split a long into two words + andi. t0,tos,h#ffff + push-t0 + rlwinm tos,tos,16,16,31 +c; +code wljoin (s w.low w.high -- l ) + pop-to-t0 + rlwimi t0,tos,16,0,15 + mr tos,t0 +c; + +1 constant /c +2 constant /w +4 constant /l +/l constant /n + +code ca+ (s addr index -- addr+index*/c ) + pop-to-t0 + add tos,tos,t0 +c; +code wa+ (s addr index -- addr+index*/w ) + pop-to-t0 + add tos,tos,tos + add tos,tos,t0 +c; +code la+ (s addr index -- addr+index*/l ) + pop-to-t0 + add tos,tos,tos + add tos,tos,tos + add tos,tos,t0 +c; +code na+ (s addr index -- addr+index*/n ) + pop-to-t0 + add tos,tos,tos + add tos,tos,tos + add tos,tos,t0 +c; +code ta+ (s addr index -- addr+index*/t ) + pop-to-t0 + add tos,tos,tos + add tos,tos,tos + add tos,tos,t0 +c; + +code ca1+ (s addr -- addr+/w ) addi tos,tos,1 c; +code char+ (s addr -- addr+/w ) addi tos,tos,1 c; +code wa1+ (s addr -- addr+/w ) addi tos,tos,2 c; +code la1+ (s addr -- addr+/l ) addi tos,tos,4 c; +code na1+ (s addr -- addr+/n ) addi tos,tos,1cell c; +code cell+ (s addr -- addr+/n ) addi tos,tos,1cell c; +code ta1+ (s addr -- addr+/token ) addi tos,tos,/token c; + +code /c* (s n -- n*/c ) c; +code chars (s n -- n*/c ) c; +code /w* (s n -- n*/w ) add tos,tos,tos c; +code /l* (s n -- n*/l ) add tos,tos,tos add tos,tos,tos c; +code /n* (s n -- n*/n ) add tos,tos,tos add tos,tos,tos c; +code cells (s n -- n*/n ) add tos,tos,tos add tos,tos,tos c; + +code upc (s char -- upper-case-char ) + ascii a cmpi 0,0,tos,* >= if + ascii z cmpi 0,0,tos,* <= if + addi tos,tos,h#-20 + then + then +c; +code lcc (s char -- upper-case-char ) + ascii A cmpi 0,0,tos,* >= if + ascii Z cmpi 0,0,tos,* <= if + addi tos,tos,h#20 + then + then +c; + +code c@+ (s adr -- adr' char ) addi t0,tos,1 push-t0 lbz tos,0(tos) c; + +code comp ( addr1 addr2 len -- -1 | 0 | 1 ) + second-to-t0 \ addr2 + third-to-t1 \ addr1 + addi sp,sp,2cells + mr t2,tos \ len + set tos,0 \ default result + + addi t0,t0,-1 \ Account for pre-incrementing + addi t1,t1,-1 \ Account for pre-incrementing + begin + cmpi 0,0,t2,0 0<> while + addi t2,t2,-1 + lbzu t3,1(t0) \ Load byte + lbzu t4,1(t1) \ Load byte + cmp 0,0,t3,t4 <> if \ mismatch + < if addi tos,tos,1 else addi tos,tos,-1 then + next + then + repeat +c; + +: caps-comp (s addr1 addr2 len -- -1 | 0 | 1 ) +\ XXX optimize me + rot 0 swap 2swap ( 0 addr1 addr2 len ) + bounds ?do ( 0 addr1' ) + c@+ lcc i c@ lcc <> if ( 0 addr1' ) + nip dup 1- c@ lcc i c@ lcc < + if -1 else 1 then ( addr1' flag ) + swap leave ( flag addr1' ) + then ( 0 addr1' ) + loop + drop +; + +code pack ( str-adr len dest -- dest ) + second-to-t0 \ len + third-to-t1 \ str-adr + addi sp,sp,2cells + mr t2,tos \ dest + stb t0,0(tos) \ requires length < 256 + + cmpi 0,0,t0,0 + 0<> if + addi t1,t1,-1 \ Account for pre-incrementing + mfspr t4,ctr \ Save count register + mtspr ctr,t0 \ Count in count register + begin + lbzu t3,1(t1) \ Load byte + stbu t3,1(t2) \ Store byte + countdown \ Decrement & Branch if nonzero + set t3,0 + stbu t3,1(t2) \ Store a null byte at the end + mtspr ctr,t4 \ Restore count register + then +c; + +code (') (s -- acf ) push-tos literal-to-tos add tos,tos,base c; + +\ Modifies caller's ip to skip over an in-line string +code skipstr (s -- adr len) + push-tos + lwz t0,0(rp) \ Get string address in t0 + lbzu tos,/token(t0) \ Get length byte in tos + addi t0,t0,1 \ Address of data bytes + push-t0 \ Push adr + + \ Now we have to skip the string + add t0,t0,tos \ Scr now points past the last data byte + +\ ! We don't want to add 4 because IP is pre-incremented inside NEXT +\ addi t0,t0,4 \ Round up to token boundary + null byte (4= #align) + + rlwinm t0,t0,0,0,29 \ Round down to token boundary + stw t0,0(rp) \ Put the modified ip back +c; + +code (") (s -- adr len) + push-tos + lbzu tos,/token(ip) \ Get length byte in tos + addi ip,ip,1 \ Address of data bytes + stwu ip,-1cell(sp) \ Push adr + + \ Now we have to skip the string + add ip,ip,tos \ ip now points past the last data byte + +\ ! We don't want to add 4 because IP is pre-incremented inside NEXT +\ addi ip,ip,4 \ Round up to a token boundary, plus null byte (#talign + + rlwinm ip,ip,0,0,29 +c; + +code count (s adr -- adr+1 len ) + addi tos,tos,1 + lbz t0,-1(tos) + push-tos + mr tos,t0 +c; + +code origin (s -- addr ) push-tos mr tos,base c; + +code origin+ (s n -- adr ) add tos,base,tos c; +code origin- (s n -- adr ) subf tos,base,tos c; + +: acf-align (s -- ) + begin here #acf-align 1- and while 0 c, repeat + here 'lastacf token! +; + +headerless + +\ Place the "standard" code field + +: set-cf (s action-adr -- ) acf-align origin+ token, ; + +headers +\ : place-cf (s action-adr -- ) acf-align token, ; +\ This is only used in action: . We define it as a no-op so that +\ "doaction" can do all the work. +: place-cf (s -- ) ; + +\ Create code field for code word +: code-cf (s -- ) acf-align here ta1+ aligned token, align ; + +: >code ( acf-of-code-word -- address-of-start-of-machine-code ) token@ ; +: code? ( acf -- f ) \ True if the acf is for a code word + dup token@ swap >body = +; + +\ Assemble "next" routine at the end of a code definition. +\ This is not needed for the kernel to run; it is used later +\ after the resident assembler has been loaded + +: next (s -- ) + here /l allot h# 4e800420 swap instruction! ( "bcctr 20,0" ) +; + +: create-cf (s -- ) [ dodoes ] literal set-cf ['] noop token, ; +: variable-cf (s -- ) [ dovariable ] literal set-cf ; + +: place-;code (s -- ) code-cf ; +: place-does (s -- ) [ docolon ] literal set-cf ; + +\ Ip is assumed to point to (;code . flag is true if +\ the code at ip is a does> clause as opposed to a ;code clause. +: does-ip? ( ip -- ip' flag ) + dup token@ ['] (does>) = ( ip flag ) swap ta1+ ta1+ swap +; + +: put-cf (s action-clause-adr where -- ) token! ; + +\ uses sets the code field of the indicated word so that +\ it will execute the code at action-clause-adr +: uses (s action-clause-adr xt -- ) + tuck /token + put-cf + [ dodoes ] literal origin+ swap put-cf +; + +\ used sets the code field of the most-recently-defined word so that +\ it executes the word at action-clause-adr +: used (s action-clause-adr -- ) lastacf uses ; + +: colon-cf? ( possible-acf -- flag ) + dup token@ [ docolon ] literal origin+ = if + /token - token@ + dup ['] branch <> + over ['] ?branch <> and + over ['] (of) <> and + over ['] (leave) <> and + over ['] (?leave) <> and + over ['] (do) <> and + over ['] (?do) <> and + swap ['] (lit) <> and + else + drop false + then +; +: colon-cf (s -- ) [ docolon ] literal set-cf ; +: user-cf (s -- ) [ douser ] literal set-cf ; +: value-cf (s -- ) [ dovalue ] literal set-cf ; +: constant-cf (s -- ) [ doconstant ] literal set-cf ; +: defer-cf (s -- ) [ dodefer ] literal set-cf ; +: 2constant-cf (s -- ) [ do2constant ] literal set-cf ; + +4 constant /branch +: branch, ( offset -- ) , ; +: branch! ( offset where -- ) ! ; + +: branch@ ( where -- offset ) @ ; +\ >target depends on the way that branches are compiled +: >target ( ip-of-branch-instruction -- target ) ta1+ dup branch@ + ; +headerless + +/a constant /a + +headers + +code a@ ( adr -- adr' ) + lwz tos,0(tos) + add tos,tos,base +c; + +\ R : a! ( adr1 adr2 -- ) set-relocation-bit l! ; +code a! ( adr1 adr2 -- ) + pop-to-t0 + subfc t0,base,t0 \ ( Use subfc for POWER compatibility) + stw t0,0(tos) + pop-tos +c; +: a, ( adr -- ) here /a allot a! ; + +/token constant /token +code token@ (s adr -- cfa ) lwz tos,0(tos) add tos,tos,base c; +\ R : token! (s cfa adr -- ) set-relocation-bit l! ; +code token! (s cfa addr -- ) + second-to-t0 + subfc t0,base,t0 \ ( Use subfc for POWER compatibility) + stw t0,0(tos) + pop1 +c; + + +: token, (s cfa -- ) here /token allot token! ; + +: null ( -- token ) origin ; +: !null-link ( adr -- ) null swap link! ; +: !null-token ( adr -- ) null swap token! ; +: non-null? ( link -- false | link true ) + dup origin = if drop false else true then +; +\ code non-null? ( link -- false | link true ) +\ tos base cmp +\ <> if +\ false t0 mr \ Delay slot +\ +\ push-tos +\ true t0 mr +\ then +\ t0 tos mr +\ c; +: get-token? ( adr -- false | acf true ) token@ non-null? ; +: another-link? ( adr -- false | link true ) link@ non-null? ; + +\ The "word type" is a number which distinguishes one type of word +\ from another. This is highly implementation-dependent. + +\ For the PowerPC implementation, the magic number returned by word-type +\ is the absolute address of the action code. + +: long-cf? (s acf -- flag ) token@ origin- [ dodoes ] literal = ; + +: word-type (s acf -- word-type ) dup long-cf? if ta1+ then token@ ; + +: body> (s apfa -- acf ) + /token - dup /token - long-cf? if /token - then +; +: >body (s acf -- apf ) dup long-cf? if ta1+ then ta1+ ; + +4 constant /user# + +\ Move to a machine alignment boundary. + +: aligned (s adr -- adr' ) /n round-up ; + +code acf-aligned (s adr -- adr' ) + addi tos,tos,3 +\ addi t0,r0,-4 +\ and tos,tos,t0 + rlwinm tos,tos,0,0,29 +c; + +\ Floored division is prescribed by the Forth 83 standard. +\ The quotient is rounded toward negative infinity, and the +\ remainder has the same sign as the divisor. + +: /mod (s dividend divisor -- remainder quotient ) + \ Check if either factor is negative + 2dup ( n1 n2 n1 n2) + or 0< if ( n1 n2) + + \ Both factors not non-negative; do division by: + \ Take absolute value and do unsigned division + \ Convert to truncated signed divide by: + \ if dividend is negative then negate the remainder + \ if dividend and divisor have opposite signs then negate the quotient + \ Then convert to floored signed divide by: + \ if quotient is negative and remainder is non-zero + \ add divisor to remainder and decrement quotient + + 2dup swap abs swap abs ( n1 n2 u1 u2) \ Absolute values + + u/mod ( n1 n2 urem uqout) \ Unsigned divide + >r >r ( n1 n2) ( uquot urem) + + over 0< if ( n1 n2) ( uquot urem) + r> negate >r \ Negative dividend; negate remainder + then ( n1 n2) ( uquot trem) + + swap over ( n2 n1 n2) ( uquot trem) + xor 0< if ( n2) ( uquot trem) + r> r> + negate ( n2 trem tquot) \ Opposite signs; negate quotient + -rot ( tquot n2 trem) + dup 0<> if + + ( tquot rem) \ Negative quotient & non-zero remainder + swap 1- ( rem quot) \ add divisor to rem. & decrement quot. + else + nip swap ( rem quot) + then + else + drop r> r> ( rem quot) + then + + else \ Both factors non-negative + + u/mod ( rem quot) + then +; + +\ 64-bit addition and subtraction +: dabs ( d# -- d# ) dup 0< if dnegate then ; +: dmax ( d1 d2 -- d3 ) 2over 2over d- nip 0< if 2swap then 2drop ; + +code d+ ( d1 d2 -- d3 ) + lwz t1,0(sp) \ d2.low + lwz t3,2cells(sp) \ d1.low + lwz t2,1cell(sp) \ d1.high + addi sp,sp,2cells \ Pop args + addc t1,t1,t3 \ d3.low + adde tos,tos,t2 \ d3.high + stw t1,0(sp) \ Push result (d3.high already in tos) +c; +code d- ( d1 d2 -- d3 ) + lwz t1,0(sp) \ x2.low + lwz t2,1cell(sp) \ x1.high + lwz t3,2cells(sp) \ x1.low + addi sp,sp,2cells \ Pop args + subfc t1,t1,t3 \ x3.low + subfe tos,tos,t2 \ x3.high + stw t1,0(sp) \ Push result (x3.high already in tos) +c; +code s>d ( n -- d ) push-tos srawi tos,tos,31 c; +code dnegate ( d -- -d ) + second-to-t0 + subfic t0,t0,0 + stw t0,0(sp) + subfze tos,tos +c; + +only forth also labels also meta also assembler definitions + +:-h 'user# \ name ( -- user# ) + [ meta ]-h ' ( acf-of-user-variable ) >body-t + @-t +;-h +:-h 'user \ name ( -- user-addressing-mode ) + [ also assembler also register-names ]-h 'user# up + [ previous previous ]-h +;-h +:-h 'body \ name ( -- variable-apf ) + [ meta ]-h ' ( acf-of-user-variable ) >body-t +;-h +:-h 'acf \ name ( -- variable-apf ) + [ meta ]-h ' ( acf-of-user-variable ) >body-t +;-h + +only forth also labels also meta also definitions + +: m+ ( d1|ud1 n -- ) s>d d+ ; + +fload ${BP}/forth/kernel/dmuldiv.fth + +: m/mod (s l.dividend n.divisor -- n.remainder n.quotient ) fm/mod ; + +code * ( n1 n2 -- n3 ) pop-to-t0 mullw tos,t0,tos c; + +: ul* (s un1 un2 -- lproduct ) * ; +: u* (s un1 un2 -- uproduct ) * ; + + +\ PowerPC version is dynamically relocated, so we don't need a bitmap +: clear-relocation-bits ( adr len -- ) 2drop ; + +: move ( src dst cnt -- ) + >r 2dup u< if r> cmove> else r> cmove then +; + +init-user-area constant init-user-area + +code (llit) (s -- l ) push-tos literal-to-tos c; +code (dlit) (s -- d ) push-tos literal-to-tos literal-to-t0 push-t0 c; + +\ Select a vocabulary thread by hashing the lookup name. +\ Hashing function: Use the lower bits of the first character in the +\ name to select one of #threads threads in the array pointed-to by +\ the user number in the parameter field of voc-acf. +code hash (s str-addr voc-acf -- thread ) + \ The next 2 lines are equivalent to ">threads", which in this + \ implementation happens to be the same as ">body >user" + lwz tos,/ccf(tos) \ Get the user number + add tos,tos,up \ Find the address of the threads + + pop-to-t0 \ str-adr in t0 + lbz t0,1(t0) \ First byte of string + #threads-t 1- andi. t0,t0,* \ Extract low bits + add t0,t0,t0 + add t0,t0,t0 \ Convert index to longword offset + add tos,tos,t0 +c; + +\ Search a vocabulary thread (link) for a name matching string. +\ If found, return its code field address and -1 if immediate, 1 if not +\ immediate. If not found, return the string and 0. + +\ Name field: +\ name: forth-style packed string, no tag bits +\ flag: 40 bit is immediate bit +\ Padding is optionally inserted between the name and the flags +\ so that the byte after the flag byte is on an even boundary. + +[ifdef] notdef +code (find) (s string link origin -- acf -1 | acf 1 | string 0 ) + pop-tos \ link in tos + +\ Registers: +\ tos alf of word being tested +\ t0 string +\ t1 name being tested +\ t2 # of characters left to test +\ string is kept on the top of the external stack + +\ 1 F: always brif \ Branch to test at end of list +\ begin + begin cmp 0,0,tos,base <> while + addi t1,tos,/token \ Get name address of word to test + second-to-t0 \ Get string address + lbz t2,0(t0) \ get the name field length + addi t0,t0,-1 \ Account for pre-increment + addi t1,t1,-1 \ Account for pre-increment + begin + lbzu t3,1(t0) \ Compare 2 characters + lbzu t4,1(t1) + cmp 0,0,t3,t4 = while \ Keep looking as long as characters match + addic. t2,t2,-1 \ Decrement byte counter + 0< if \ If we've tested all chars, the names match. + lbzu tos,1(t1) \ Get flags byte into tos register + + addi t1,t1,/cf \ Now find the code field by +\ addi t2,r0,-/cf +\ and t1,t1,t2 \ aligning to the next 4 byte boundary + rlwinm t1,t1,0,0,29 + + andi. t2,tos,h#20 \ Test the alias flag + 0<> if + lwz t1,0(t1) \ Get acf + add t1,t1,base \ Relocate + then + + stw t1,0(sp) \ Replace string on stack with acf + andi. t2,tos,h#40 \ Test the immediate flag + 0<> if + addi tos,r0,1 \ Immediate + else + addi tos,r0,-1 \ Not immediate + then + next + then + repeat + + \ The names did not match, so check the next name in the list + lwz tos,0(tos) \ Fetch next link ( next acf ) + add tos,tos,base \ Relocate +1 L: +\ cmp 0,0,tos,base +\ = until +repeat + + \ If we get here, we've checked all the names with no luck + addi tos,r0,0 +c; +[then] + +code ($find-next) (s adr len link -- adr len alf true | adr len false ) +\ Registers: +\ tos alf of word being tested +\ t0 string +\ t1 anf of word being tested +\ t2 saves ctr register value +\ t3 character from string +\ t4 character from name +\ t5 string length +\ string is kept on the top of the external stack + + lwz t0,1cell(sp) \ Get string address + lwz t5,0(sp) \ get the name field length + addi t0,t0,-1 \ Account for pre-increment + + mfspr t2,ctr \ Save CTR register + + ahead + begin + addi tos,tos,-/token \ >link + addi t1,tos,-2 \ t1 points before count byte at string *end* + subfc t1,t5,t1 \ t1 points to beginning of string + \ ( Use subfc for POWER compatibility) + mr t6,t0 + + mtspr ctr,t5 \ Set starting loop index + begin + lbzu t4,1(t1) \ Get character from name field + lbzu t3,1(t6) \ Get character from search string + cmp 0,0,t3,t4 \ Compare 2 characters + bc 8,2,* \ Branch while characters match and count non0 + + = if \ If we've tested all name chars, we + lbzu t4,1(t1) \ may have a match; check the count byte + andi. t4,t4,h#1f + cmp 0,0,t4,t5 \ Compare count bytes + = if + push-tos \ Push alf above pstr + addi tos,r0,-1 \ True on top of stack means "found" + mtspr ctr,t2 \ Restore CTR register + next + then + then + + but then + \ The names did not match, so check the next name in the list + lwz tos,0(tos) \ Fetch next link ( next acf ) + add tos,tos,base \ Relocate + cmp 0,0,tos,base + = until + + \ If we get here, we've checked all the names with no luck + addi tos,r0,0 + mtspr ctr,t2 \ Restore CTR register +c; + +: ?negate (s n1 n2 -- n3 ) if negate then ; + +code wflip (s l1 -- l2 ) \ word swap + rlwinm t0,tos,16,16,31 \ high half to low half + rlwimi t0,tos,16,0,15 \ low to high and insert + mr tos,t0 +c; + +code lwflip ( l -- l' ) + rlwinm t0,tos,16,0,15 + rlwimi t0,tos,16,16,31 + mr tos,t0 +c; + +code lbflip ( l -- l' ) + rlwinm t0,tos,24,0,7 + rlwimi t0,tos,8,8,15 + rlwimi t0,tos,24,16,23 + rlwimi t0,tos,8,24,31 + mr tos,t0 +c; + +code wbflip ( w -- w' ) + rlwinm t0,tos,8,16,23 + rlwimi t0,tos,24,24,31 + mr tos,t0 +c; + +code lwflips ( adr len -- ) + lwz t0,0(sp) \ adr in t0, len in tos + + addi tos,tos,3 \ Round up to longword boundary + rlwinm. tos,tos,30,2,31 \ Divide by 4 + + 0<> if + addi t0,t0,-4 \ Account for pre-increment + addi r0,r0,0 + + mtspr ctr,tos + + begin + lwzu t1,4(t0) \ Load one way + rlwinm t2,t1,16,0,15 + rlwimi t2,t1,16,16,31 + stw t2,0(t0) \ Store the other + countdown + + mtspr ctr,up + then + + lwz tos,1cell(sp) + addi sp,sp,2cells +c; + +code lbflips ( adr len -- ) + lwz t0,0(sp) \ adr in t0, len in tos + + addi tos,tos,3 \ Round up to longword boundary + rlwinm. tos,tos,30,2,31 \ Divide by 4 + + 0<> if + addi t0,t0,-4 \ Account for pre-increment + addi r0,r0,0 + + mtspr ctr,tos + + begin + lwzu t1,4(t0) \ Load one way + stwbrx t1,r0,t0 \ Store the other + countdown + + mtspr ctr,up + then + + lwz tos,1cell(sp) + addi sp,sp,2cells +c; + +code wbflips ( adr len -- ) + lwz t0,0(sp) \ adr in t0, len in tos + + addi tos,tos,1 \ Round up to longword boundary + rlwinm. tos,tos,31,1,31 \ Divide by 4 + + 0<> if + addi t0,t0,-2 \ Account for pre-increment + addi r0,r0,0 + + mtspr ctr,tos + + begin + lhzu t1,2(t0) \ Load one way + sthbrx t1,r0,t0 \ Store the other + countdown + + mtspr ctr,up + then + + lwz tos,1cell(sp) + addi sp,sp,2cells +c; + +\ these are not used. remove? +: cset (s byte-mask adr -- ) tuck c@ or swap c! ; +: creset (s byte-mask adr -- ) swap invert over c@ and swap c! ; +: ctoggle (s byte-mask adr -- ) tuck c@ xor swap c! ; +: toggle (s adr byte-mask -- ) swap ctoggle ; + + +code s->l (s n.signed -- l ) c; +code n->l (s n.unsigned -- l ) c; +code n->a (s n -- a ) c; +code l->n (s l -- n ) c; +code l->w (s l -- w ) andi. tos,tos,h#ffff c; +code n->w (s n -- w ) andi. tos,tos,h#ffff c; +code w->l (s w -- l ) + andi. t0,tos,h#8000 0<> if + set t1,h#ffff.0000 + or tos,tos,t1 + then +c; + + +code l>r (s l -- ) stwu tos,-1cell(rp) pop-tos c; +code lr> (s -- l ) push-tos lwz tos,0(rp) rdrop c; +code lr@ (s -- l ) push-tos lwz tos,0(rp) c; + +code /t* (s n -- n*/t ) add tos,tos,tos add tos,tos,tos c; + +[ifdef] oldmeta +: >name ( acf -- anf ) + 1- begin 1- dup c@ bl > until \ Find the end of the name + /token 1- invert and \ Move to token boundary + begin dup c@ bl >= while /token - repeat +; +[then] +#align-t constant #align +#acf-align-t constant #acf-align +#talign-t constant #talign + +: align (s -- ) #align (align) ; +: taligned (s adr -- adr' ) #talign round-up ; +: talign (s -- ) #talign (align) ; + +\ LICENSE_BEGIN +\ Copyright (c) 2007 FirmWorks +\ +\ Permission is hereby granted, free of charge, to any person obtaining +\ a copy of this software and associated documentation files (the +\ "Software"), to deal in the Software without restriction, including +\ without limitation the rights to use, copy, modify, merge, publish, +\ distribute, sublicense, and/or sell copies of the Software, and to +\ permit persons to whom the Software is furnished to do so, subject to +\ the following conditions: +\ +\ The above copyright notice and this permission notice shall be +\ included in all copies or substantial portions of the Software. +\ +\ THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, +\ EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF +\ MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND +\ NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE +\ LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION +\ OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION +\ WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. +\ +\ LICENSE_END Added: cpu/ppc/kernel.bth =================================================================== --- cpu/ppc/kernel.bth (rev 0) +++ cpu/ppc/kernel.bth 2007-07-05 17:19:17 UTC (rev 461) @@ -0,0 +1,107 @@ +purpose: Load file for PowerPC Forth kernel +\ See license at end of file + +command: &builder &this +build-now + +\ ' $report-name is include-hook ' noop is include-exit-hook + ' noop is include-hook ' noop is include-exit-hook + + +\ Don't accept ',' as numeric punctuation because doing so makes +\ the forward referencing mechanism think that "c," is a number! +ascii . ascii , npatch numdelim? + +warning off \ Turn OFF the warning messages + +alias constant-h constant + +fload ${BP}/forth/kernel/conft32.fth +fload ${BP}/forth/kernel/meta1.fth + +only forth also meta also definitions +: sx .s cr ; +\needs ppc-assembler fload ${BP}/cpu/ppc/assem.fth + +only forth also meta definitions +: assembler ( -- ) ppc-assembler ; + +only forth also meta also assembler definitions +\needs L: fload ${BP}/forth/lib/loclabel.fth +init-labels + +only forth also definitions + +fload ${BP}/forth/kernel/swapmap.fth +\ : : : lastacf .name cr ; +fload ${BP}/cpu/ppc/target.fth +fload ${BP}/forth/kernel/forward.fth +fload ${BP}/cpu/ppc/fixvoc.fth +fload ${BP}/forth/kernel/metacompile.fth + +only forth meta also forth also definitions +sometimes-headers +only forth also definitions + +fload ${BP}/cpu/ppc/metainit.fth + +\ Comment out the following line(s) when debugging +-1 threshold ! \ Turn OFF ALL debugging messages +warning-t off \ Turn OFF target warning messages + +\ Uncomment the following line(s) for more debug output +\ show? on 1 granularity ! 1 threshold ! +\ warning-t on + +fload ${BP}/cpu/ppc/kerncode.fth + +fload ${BP}/forth/kernel/uservars.fth +fload ${BP}/forth/kernel/double.fth + +fload ${BP}/forth/lib/bitops.fth +fload ${BP}/cpu/ppc/kernrel.fth + +fload ${BP}/forth/lib/struct.fth + +fload ${BP}/cpu/ppc/unalign.fth + +fload ${BP}/forth/kernel/kernel.fth + +fload ${BP}/forth/kernel/sysio.fth +fload ${BP}/forth/lib/dumballo.fth +fload ${BP}/cpu/ppc/syscall.fth + +fload ${BP}/cpu/ppc/filecode.fth + +fload ${BP}/cpu/ppc/boot.fth +fload ${BP}/forth/kernel/init.fth +fload ${BP}/cpu/ppc/finish.fth + +fload ${BP}/cpu/ppc/savemeta.fth + +.( --- Saving kernel.dic ---) "" kernel.dic save-meta +cr + +\ LICENSE_BEGIN +\ Copyright (c) 2006 FirmWorks +\ +\ Permission is hereby granted, free of charge, to any person obtaining +\ a copy of this software and associated documentation files (the +\ "Software"), to deal in the Software without restriction, including +\ without limitation the rights to use, copy, modify, merge, publish, +\ distribute, sublicense, and/or sell copies of the Software, and to +\ permit persons to whom the Software is furnished to do so, subject to +\ the following conditions: +\ +\ The above copyright notice and this permission notice shall be +\ included in all copies or substantial portions of the Software. +\ +\ THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, +\ EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF +\ MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND +\ NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE +\ LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION +\ OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION +\ WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. +\ +\ LICENSE_END Added: cpu/ppc/kernrel.fth =================================================================== --- cpu/ppc/kernrel.fth (rev 0) +++ cpu/ppc/kernrel.fth 2007-07-05 17:19:17 UTC (rev 461) @@ -0,0 +1,69 @@ +purpose: Maintain a byte swap table for the Forth dictionary +\ See license at end of file + +decimal + +0 value swap-map + +\ The swap map has one bit for every 32-bit word, since we assume +\ that relocated longwords must start on a 32-bit boundary +d# 32 constant bits/swapbit + +\ Number of bytes in bitmap +: >swap-map-size ( end-adr -- ) + origin - bits/swapbit /mod swap if 1+ then +; +: /swap-map ( -- n ) memtop @ >swap-map-size ; + +defer set-swap-bit +: (set-swap-bit) ( addr -- ) + origin - 2 >> ( lword-index ) + dup 3 >> /swap-map u< if swap-map bitset else drop then +; + +\ The upper endpoint must be aligned in case the lower endpoint +\ is unaligned and the lower endpoint straddles an alignment boundary. +\ In that case, if we didn't align the upper endpoint, the last +\ word of the range would not be marked. +: note-string ( adr len -- adr len ) + 2dup over + aligned swap ?do i set-swap-bit /n +loop +; + +defer init-swap-map +: (init-swap-map) ( -- ) + /swap-map alloc-mem is swap-map + swap-map /swap-map erase + \ Copy in old swap map + here user-size + swap-map here >swap-map-size move + ['] (set-swap-bit) is set-swap-bit +; +' (init-swap-map) is init-swap-map + +\ Plug this into init-swap-map to turn off swap-map management +: no-swap-map ( -- ) ['] drop is set-swap-bit ; + +: init ( -- ) init init-swap-map ; + +\ LICENSE_BEGIN +\ Copyright (c) 2007 FirmWorks +\ +\ Permission is hereby granted, free of charge, to any person obtaining +\ a copy of this software and associated documentation files (the +\ "Software"), to deal in the Software without restriction, including +\ without limitation the rights to use, copy, modify, merge, publish, +\ distribute, sublicense, and/or sell copies of the Software, and to +\ permit persons to whom the Software is furnished to do so, subject to +\ the following conditions: +\ +\ The above copyright notice and this permission notice shall be +\ included in all copies or substantial portions of the Software. +\ +\ THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, +\ EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF +\ MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND +\ NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE +\ LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION +\ OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION +\ WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. +\ +\ LICENSE_END Added: cpu/ppc/loadmach.fth =================================================================== --- cpu/ppc/loadmach.fth (rev 0) +++ cpu/ppc/loadmach.fth 2007-07-05 17:19:17 UTC (rev 461) @@ -0,0 +1,73 @@ +purpose: Load file for machine-dependent Forth tools +\ See license at end of file + +assembler? [if] +fload ${BP}/cpu/ppc/assem.fth +fload ${BP}/cpu/ppc/code.fth +fload ${BP}/forth/lib/loclabel.fth +[else] +transient fload ${BP}/cpu/ppc/assem.fth resident +fload ${BP}/cpu/ppc/code.fth +transient fload ${BP}/forth/lib/loclabel.fth resident +[then] + +fload ${BP}/cpu/ppc/decompm.fth + +: be-l, ( l -- ) here 4 note-string allot be-l! ; + +[ifndef] partial-no-heads transient [then] +fload ${BP}/forth/lib/binhdr.fth +fload ${BP}/cpu/ppc/savefort.fth +\ alias save-forth save-forth +[ifndef] partial-no-heads resident [then] + +fload ${BP}/forth/lib/instdis.fth + +fload ${BP}/cpu/ppc/objsup.fth +fload ${BP}/forth/lib/objects.fth + +fload ${BP}/cpu/ppc/call.fth \ C subroutine calls + +fload ${BP}/cpu/ppc/cpustate.fth +fload ${BP}/cpu/ppc/register.fth + +fload ${BP}/forth/lib/savedstk.fth +fload ${BP}/forth/lib/rstrace.fth +fload ${BP}/cpu/ppc/ftrace.fth +fload ${BP}/cpu/ppc/ctrace.fth + +fload ${BP}/cpu/ppc/debugm.fth \ Forth debugger support +fload ${BP}/forth/lib/debug.fth \ Forth debugger + +start-module \ Breakpointing +fload ${BP}/cpu/ppc/cpubpsup.fth \ Breakpoint support +fload ${BP}/forth/lib/breakpt.fth +end-module + +fload ${BP}/cpu/ppc/msr.fth \ Stuff in the Machine State Register +fload ${BP}/cpu/ppc/spr.fth \ Various special registers +fload ${BP}/cpu/ppc/catchexc.fth + +\ LICENSE_BEGIN +\ Copyright (c) 2007 FirmWorks +\ +\ Permission is hereby granted, free of charge, to any person obtaining +\ a copy of this software and associated documentation files (the +\ "Software"), to deal in the Software without restriction, including +\ without limitation the rights to use, copy, modify, merge, publish, +\ distribute, sublicense, and/or sell copies of the Software, and to +\ permit persons to whom the Software is furnished to do so, subject to +\ the following conditions: +\ +\ The above copyright notice and this permission notice shall be +\ included in all copies or substantial portions of the Software. +\ +\ THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, +\ EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF +\ MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND +\ NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE +\ LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION +\ OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION +\ WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. +\ +\ LICENSE_END Added: cpu/ppc/loadvmem.fth =================================================================== --- cpu/ppc/loadvmem.fth (rev 0) +++ cpu/ppc/loadvmem.fth 2007-07-05 17:19:17 UTC (rev 461) @@ -0,0 +1,63 @@ +purpose: Load file for virtual memory node +\ See license at end of file + +headers +false value use-real-mode? +true value in-real-mode? +0 value /rm-tlbmiss + +fload ${BP}/ofw/core/allocmor.fth \ S Allow alloc-mem to use more memory + +dev / +new-device +" mmu" device-name +fload ${BP}/ofw/core/virtlist.fth \ Virtual memory allocator +fload ${BP}/ofw/core/maplist.fth \ Manage translation list +fload ${BP}/ofw/core/clntmap.fth \ OS callbacks for address translation +\ fload ${BP}/arch/prep/memcb.fth \ Memory allocation callback + +fload ${BP}/cpu/ppc/tlb.fth +fload ${BP}/cpu/ppc/tlbmiss.fth +fload ${BP}/cpu/ppc/htabmmu.fth +fload ${BP}/cpu/ppc/batfault.fth +fload ${BP}/cpu/ppc/batmap.fth +[ifdef] exponential +fload ${BP}/cpu/ppc/exptlb.fth +[then] + +: .t translations translation-node .list ; + +fload ${BP}/cpu/ppc/testmmu.fth + +' 2drop is ?splice + +finish-device +device-end + +: map? ( virtual -- ) " map?" mmu-node @ $call-method ; +: .t ( -- ) " .t" mmu-node @ $call-method ; + + +\ LICENSE_BEGIN +\ Copyright (c) 2007 FirmWorks +\ +\ Permission is hereby granted, free of charge, to any person obtaining +\ a copy of this software and associated documentation files (the +\ "Software"), to deal in the Software without restriction, including +\ without limitation the rights to use, copy, modify, merge, publish, +\ distribute, sublicense, and/or sell copies of the Software, and to +\ permit persons to whom the Software is furnished to do so, subject to +\ the following conditions: +\ +\ The above copyright notice and this permission notice shall be +\ included in all copies or substantial portions of the Software. +\ +\ THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, +\ EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF +\ MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND +\ NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE +\ LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION +\ OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION +\ WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. +\ +\ LICENSE_END Added: cpu/ppc/metainit.fth =================================================================== --- cpu/ppc/metainit.fth (rev 0) +++ cpu/ppc/metainit.fth 2007-07-05 17:19:17 UTC (rev 461) @@ -0,0 +1,70 @@ +purpose: Metacompiler initialization +\ See license at end of file + +\ Debugging aids + +0 #words ! h# 480 threshold ! 10 granularity ! + +warning off + +metaon +meta definitions + +\ We want the kernel to be romable, so we put variables in the user area +:-h variable ( -- ) nuser ;-h +alias \m \ + +initmeta + +th 11000 alloc-mem target-image \ Allocate space for the target image + +\ org sets the lowest address that is used by Forth kernel. +hex + +0.0000 org 0.0000 + voc-link-t token-t! + +200 equ ps-size + +assembler + +\ This is at the first location in the Forth image. + +\ init-forth is the initialization entry point. It should be called +\ exactly once, with arguments (dictionary_start, dictionary_size). +\ init-forth sets up some global variables which allow Forth to locate +\ its RAM areas, including the data stack, return stack, user area, +\ cpu-state save area, and dictionary. + +hex +mlabel cld + b 0 \ The address will be fixed later. + nop \ Delay slot + nop + nop + +meta + +\ LICENSE_BEGIN +\ Copyright (c) 2007 FirmWorks +\ +\ Permission is hereby granted, free of charge, to any person obtaining +\ a copy of this software and associated documentation files (the +\ "Software"), to deal in the Software without restriction, including +\ without limitation the rights to use, copy, modify, merge, publish, +\ distribute, sublicense, and/or sell copies of the Software, and to +\ permit persons to whom the Software is furnished to do so, subject to +\ the following conditions: +\ +\ The above copyright notice and this permission notice shall be +\ included in all copies or substantial portions of the Software. +\ +\ THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, +\ EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF +\ MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND +\ NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE +\ LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION +\ OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION +\ WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. +\ +\ LICENSE_END Added: cpu/ppc/metarel.fth =================================================================== --- cpu/ppc/metarel.fth (rev 0) +++ cpu/ppc/metarel.fth 2007-07-05 17:19:17 UTC (rev 461) @@ -0,0 +1,50 @@ +purpose: Maintain a byte swap table for the Forth kernel during metacompilation +\ See license at end of file + +decimal + +only forth also meta also definitions +h# 10000 constant max-kernel-t + +\ The swap map has one bit for every 32-bit word, since we assume +\ that relocated longwords must start on a 32-bit boundary +d# 32 constant bits/swapbit-t + +\ Number of bytes in bitmap +: >swap-map-size-t ( end-adr -- ) + origin-t - bits/swapbit-t /mod swap if 1+ then +; + +max-kernel-t >swap-map-size-t constant /swap-map-t \ Number of bytes in bitmap +/swap-map-t buffer: swap-map-t + +: set-swap-bit-t ( addr -- ) origin-t - 2 >> swap-map-t bitset ; +: note-string-t ( adr len -- adr len ) + 2dup bounds ?do i set-swap-bit-t /n +loop +; + +: init-swap-t ( -- ) swap-map-t /swap-map-t erase ; + +\ LICENSE_BEGIN +\ Copyright (c) 2007 FirmWorks +\ +\ Permission is hereby granted, free of charge, to any person obtaining +\ a copy of this software and associated documentation files (the +\ "Software"), to deal in the Software without restriction, including +\ without limitation the rights to use, copy, modify, merge, publish, +\ distribute, sublicense, and/or sell copies of the Software, and to +\ permit persons to whom the Software is furnished to do so, subject to +\ the following conditions: +\ +\ The above copyright notice and this permission notice shall be +\ included in all copies or substantial portions of the Software. +\ +\ THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, +\ EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF +\ MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND +\ NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE +\ LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION +\ OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION +\ WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. +\ +\ LICENSE_END Added: cpu/ppc/minifth.fth =================================================================== --- cpu/ppc/minifth.fth (rev 0) +++ cpu/ppc/minifth.fth 2007-07-05 17:19:17 UTC (rev 461) @@ -0,0 +1,986 @@ +purpose: Forth-like peek/poke/memory-test monitor using only registers +\ See license at end of file + +\ Requires the following external definitions: +\ isa-io-pa ( -- n ) \ Returns the base address of IO space +\ init-serial ( -- ) \ May destroy r3-r7 +\ getchar ( -- r3: char ) \ May destroy r3-r7 +\ putchar ( r3: char -- ) \ May destroy r3-r7 + +\ The following code must run entirely from registers. The following +\ register allocation conventions are used: +\ r3-r7 Argument passing and return, scratch registers for subroutines +\ r8 Return address for level 1 routines, scratch use for level 2+ +\ r9 Return address for level 2 routines, scratch use for level 3+ +\ r10-r11 Used as needed within higher-level subroutines +\ r12 Global state flags +\ r13 As-yet unassigned +\ r14-r17 4-element stack +\ r18 script pointer + +\ Send a space character to the output device. +label putspace ( -- ) \ Level 0, destroys: r3-r7 (because it calls putchar) + set r3,h#20 + putchar b * +end-code + +\ Send a newline sequence (CR-LF) to the output device. +label putcr ( -- ) \ Level 1, destroys: r3-r8 (because it calls putchar) + mfspr r8,lr + set r3,h#0d putchar bl * + set r3,h#0a putchar bl * + mtspr lr,r8 + bclr 20,0 +end-code + +\ Send ": " to the output device. +label putcolon ( -- ) \ Level 1, destroys: r3-r8 + mfspr r8,lr + char : set r3,* putchar bl * + putspace bl * + mtspr lr,r8 + bclr 20,0 +end-code + +\ Accept input characters, packing up to 8 of them into the register pair +\ r3,r4. The first character is placed in the least-significant byte of +\ r4, and for each subsequent character, the contents of r3,r4 are shifted +\ left by 8 bits to make room for the new character (shifting the most- +\ significant byte of r4 into the least-significant byte of r3). +\ A backspace character causes r3,r4 to be shifted right, discarding the +\ previous character. +\ The process terminates when a space or carriage return is seen. The +\ terminating character is not stored in r3,r4. Any unused character +\ positions in r3,r4 contain binary 0 bytes. +label getword ( -- r3,r4 ) \ Level 4, destroys r3-r11 + mfspr r9,lr + set r10,0 \ Clear high temporary holding register + set r11,0 \ Clear low temporary holding register + + begin + andi. r3,r12,4 0<> if + lbz r3,0(r18) + addi r18,r18,1 + \ Translate linefeed to carriage return in script mode + cmpi 0,0,r3,h#0a = if set r3,h#0d then + else + getchar bl * ( char in r3 ) + then + + cmpi 0,0,r3,h#0d = if \ carriage return + andi. r0,r12,8 0= if \ Check no-echo flag + putcr bl * \ Echo CR-LF + then + mr r3,r10 mr r4,r11 \ Return packed word in r3,r4 + mtspr lr,r9 + bclr 20,0 \ Return + then + + control h cmpi 0,0,r3,* <> if \ backspace + cmpi 0,0,r3,h#20 = if \ white space + andi. r0,r12,8 0= if \ Check no-echo flag + \ In quiet mode, echo the input character; otherwise echo CR-LF + andi. r0,r12,2 0<> if putchar bl * else putcr bl * then + then + mr r3,r10 mr r4,r11 \ Return packed word in r3,r4 + mtspr lr,r9 + bclr 20,0 \ Return + then + then + + mr r8,r3 \ Save character + andi. r0,r12,8 0= if \ Check no-echo flag + putchar bl * \ Echo the character + then + + control h cmpi 0,0,r8,* = if + \ Double-shift right one byte + rlwinm r11,r11,24,8,31 + rlwimi r11,r10,24,0,7 + rlwinm r10,r10,24,0,23 + else + \ Double-shift left one byte and merge in the new character + rlwinm r10,r10,8,0,23 + rlwimi r10,r11,8,24,31 + rlwinm r11,r11,8,0,23 + or r11,r11,r8 + then + again +end-code + +\ Convert the ASCII hexadecimal characters packed into r3,r4 into a +\ 32-bit binary number, returning the result in r3 and non-zero in r4 +\ if the operation succeeded. +\ If the operation failed (because of the presence of non-hex characters), +\ return 0 in r4, and an undefined value in r3. + +\ Level 1, destroys: r3-r8 +label convert-number ( r3,r4: ascii -- r3: binary r4: okay? ) + mr r8,r3 \ Move high 4 ASCII characters away from r3 + set r3,0 \ Accumulator for output + + set r6,8 \ Loop counter - convert 8 nibbles + mtspr ctr,r6 + begin + \ Shift r8,r4 left one byte, putting result in r6 + rlwinm r6,r8,8,24,31 \ High byte in r6 + rlwinm r8,r8,8,0,23 \ Shift high word + rlwimi r8,r4,8,24,31 \ Merge from low word to high word + rlwinm r4,r4,8,0,23 \ Shift low word + + cmpi 0,0,r6,0 <> if + + char 0 cmpi 0,0,r6,* + < if + set r4,0 + bclr 20,0 \ Exit if < '0' + then + + char 9 cmpi 0,0,r6,* <= if \ Good digit from 0-9 + char 0 negate addi r6,r6,* + else + char A cmpi 0,0,r6,* + < if + set r4,0 + bclr 20,0 \ Exit if < 'A' + then + + char F cmpi 0,0,r6,* <= if + char A d# 10 - negate addi r6,r6,* + else + char a cmpi 0,0,r6,* \ possibly lower case hex digit + < if + set r4,0 + bclr 20,0 \ Exit if < 'a' + then + + char f cmpi 0,0,r6,* + > if + set r4,0 + bclr 20,0 \ Exit if > 'f' + then + + char a d# 10 - negate addi r6,r6,* + then + then + rlwinm r3,r3,4,0,27 + or r3,r3,r6 + then + countdown + + set r4,-1 + + bclr 20,0 +end-code + +\ Display the number in r3 as an 8-digit unsigned hexadecimal number +label dot ( r3 -- ) \ Level 3, destroys: r3-r10 + mfspr r8,lr + set r9,8 + mtspr ctr,r9 + mr r9,r3 + begin + rlwinm r9,r9,4,0,31 + andi. r3,r9,h#f + cmpi 0,0,r3,10 + >= if + char a d# 10 - addi r3,r3,* + else + char 0 addi r3,r3,* + then + putchar bl * + countdown + + set r3,h#20 putchar bl * + + mtspr lr,r8 + bclr 20,0 +end-code + +transient +\ Macros for managing the mini-stack +: pop1 ( -- ) + " mr r14,r15 mr r15,r16 mr r16,r17" evaluate +; +: pop2 ( -- ) + " mr r14,r16 mr r15,r17 mr r16,r17" evaluate +; +: pop3 ( -- ) + " mr r14,r17 mr r15,r17 mr r16,r17" evaluate +; +: push1 ( -- ) + " mr r17,r16 mr r16,r15 mr r15,r15" evaluate +; +: spush ( -- ) + " mr r17,r16 mr r16,r15 mr r15,r14 mr r14,r3" evaluate +; + +\ Macros to assemble code to begin and end command definitions +8 buffer: name-buf + +\ Start a command definition +: t: ( "name" -- cond ) + \ Get a name from the input stream at compile time and pack it + \ into a buffer in the same form it will appear in the register + \ pair when the mini-interpreter is executed at run-time + name-buf 8 erase ( ) + parse-word ( adr len ) + dup 8 - 0 max /string ( adr' len' ) \ Keep last 8 + 8 min 8 over - name-buf + swap move ( ) + + \ Assemble code to compare the register-pair contents against the name. + name-buf be-l@ " set r6,* cmp 0,0,r3,r6 = if" evaluate + name-buf 4 + be-l@ " set r6,* cmp 0,0,r4,r6 then = if" evaluate +; + +\ End a command definition by: +\ a) Assembling code to jump back to the beginning of the loop after the +\ current definition has executed ("over again") +\ b) Resolve the "if" (conditional branch) that skips the current definition +\ if the name the user has entered does not match this definition. + +: t; ( loop-begin-adr if-adr --- loop-begin-adr ) + " over again then" evaluate +; +resident + +label minifth ( -- <does not return> ) \ Level 5 + init-serial bl * + +[ifdef] notdef +set r10,0 +begin + mr r3,r10 + dot bl * + putcr bl * + addi r10,r10,1 +again +[then] + + set r14,0 set r15,0 set r16,0 set r17,0 \ Init stack + set r12,0 \ Init loop flag + + begin ( loop-begin-adr ) + andi. r0,r12,6 0= if \ Display stack if neither silent nor scripting + \ mr r3,r17 dot bl * + mr r3,r16 dot bl * + mr r3,r15 dot bl * + mr r3,r14 dot bl * + char o set r3,* putchar bl * + char k set r3,* putchar bl * + putspace bl * + then + + getword bl * \ Result in r3 and r4 + + \ If the word is null (i.e. a bare space or return), do nothing + cmpi 0,0,r3,0 = if cmpi 0,0,r4,0 then + yet <> until \ Branch back to the "begin" if r3,r4 = 0 + + t: showstack ( -- ) + rlwinm r12,r12,0,31,29 \ Clear the 2 bit + t; + + t: quiet ( -- ) + or r12,r12,2 + t; + + t: clear ( ?? -- ) + set r14,0 set r15,0 set r16,0 set r17,0 \ Init stack + t; + + t: @ ( adr -- n ) + andi. r0,r12,1 <> if + begin lwz r3,0(r14) again + then + lwz r14,0(r14) + t; + + t: ! ( n adr -- ) + andi. r0,r12,1 <> if + begin stw r15,0(r14) again + then + stw r15,0(r14) + pop2 + t; + + t: l@ ( adr -- l ) + andi. r0,r12,1 <> if + begin lwz r3,0(r14) again + then + lwz r14,0(r14) + t; + + t: l! ( l adr -- ) + andi. r0,r12,1 <> if + begin stw r15,0(r14) again + then + stw r15,0(r14) + pop2 + t; + + t: c@ ( adr -- b ) + andi. r0,r12,1 <> if + begin lbz r3,0(r14) again + then + lbz r14,0(r14) + t; + + t: c! ( b adr -- ) + andi. r0,r12,1 <> if + begin stb r15,0(r14) again + then + stb r15,0(r14) + pop2 + t; + + t: w@ ( adr -- w ) + andi. r0,r12,1 <> if + begin lhz r3,0(r14) again + then + lhz r14,0(r14) + t; + + t: w! ( w adr -- ) + andi. r0,r12,1 <> if + begin sth r15,0(r14) again + then + sth r15,0(r14) + pop2 + t; + + t: pc@ ( port# -- b ) + isa-io-pa set r3,* + andi. r0,r12,1 <> if + begin lbzx r4,r14,r3 again + then + + lbzx r14,r14,r3 + t; + + t: pc! ( b port# -- ) + isa-io-pa set r3,* + andi. r0,r12,1 <> if + begin stbx r15,r14,r3 again + then + stbx r15,r14,r3 + pop2 + t; + + t: pw@ ( port# -- w ) + isa-io-pa set r3,* + andi. r0,r12,1 <> if + begin lhzx r4,r14,r3 again + then + lhzx r14,r14,r3 + t; + + t: pw! ( w port# -- ) + isa-io-pa set r3,* + andi. r0,r12,1 <> if + begin sthx r15,r14,r3 again + then + sthx r15,r14,r3 + pop2 + t; + + t: pl@ ( port# -- l ) + isa-io-pa set r3,* + andi. r0,r12,1 <> if + begin lwzx r4,r14,r3 again + then + lwzx r14,r14,r3 + t; + + t: pl! ( l port# -- ) + isa-io-pa set r3,* + andi. r0,r12,1 <> if + begin stwx r15,r14,r3 again + then + stwx r15,r14,r3 + pop2 + t; + + t: config-l! ( l config-adr -- ) + set r3,h#8000.0000 + or r14,r14,r3 \ Set access enable bit + config-addr set r3,* + stwbrx r14,0,r3 \ Set address + sync + config-data set r3,* + andi. r0,r12,1 <> if + begin stwbrx r15,0,r3 sync again + then + stwbrx r15,0,r3 sync + pop2 + t; + + t: cl! ( l config-adr -- ) \ Shorter name + set r3,h#8000.0000 + or r14,r14,r3 \ Set access enable bit + config-addr set r3,* + stwbrx r14,0,r3 \ Set address + sync + config-data set r3,* + andi. r0,r12,1 <> if + begin stwbrx r15,0,r3 sync again + then + stwbrx r15,0,r3 sync + pop2 + t; + + t: config-l@ ( config-adr -- l ) + set r3,h#8000.0000 + or r14,r14,r3 \ Set access enable bit + config-addr set r3,* + stwbrx r14,0,r3 \ Set address + sync + config-data set r3,* + andi. r0,r12,1 <> if + begin lwbrx r14,0,r3 sync again + then + lwbrx r14,0,r3 sync + t; + + t: cl@ ( config-adr -- l ) \ Shorter name + set r3,h#8000.0000 + or r14,r14,r3 \ Set access enable bit + config-addr set r3,* + stwbrx r14,0,r3 \ Set address + sync + config-data set r3,* + andi. r0,r12,1 <> if + begin lwbrx r14,0,r3 sync again + then + lwbrx r14,0,r3 sync + t; + + t: + ( n1 n2 -- n1+n2 ) + add r14,r15,r14 mr r15,r16 mr r16,r17 + t; + + t: - ( n1 n2 -- n1-n2 ) + subf r14,r14,r15 mr r15,r16 mr r16,r17 + t; + + t: and ( n1 n2 -- n1&n2 ) + and r14,r15,r14 mr r15,r16 mr r16,r17 + t; + + t: or ( n1 n2 -- n1|n2 ) + or r14,r15,r14 mr r15,r16 mr r16,r17 + t; + + t: xor ( n1 n2 -- n1^n2 ) + xor r14,r15,r14 mr r15,r16 mr r16,r17 + t; + + t: lshift ( n1 n2 -- n1<<n2 ) + slw r14,r14,r15 mr r15,r16 mr r16,r17 + t; + + t: rshift ( n1 n2 -- n1>>n2 ) + srw r14,r14,r15 mr r15,r16 mr r16,r17 + t; + + t: invert ( n -- ~n ) + nor r14,r14,r14 + t; + + t: negate ( n -- -n ) + neg r14,r14 + t; + + t: spin ( -- ) \ Modifies next @/!-class command to loop forever + set r12,1 + t; + + t: * ( n1 n2 -- n1*n2 ) + mullw r14,r15,r14 + t; + + t: . ( n -- ) + mr r3,r14 + dot bl * + putcr bl * + pop1 + t; + + t: move ( src dst len -- ) + cmpi 0,0,r14,0 + <> if + cmpl 0,0,r15,r16 + < if + begin + lbz r3,0(r16) + addi r16,r16,1 + stb r3,0(r15) + addi r15,r15,1 + addic. r14,r14,-1 + 0= until + else + begin + addic. r14,r14,-1 + lbzx r3,r16,r14 + stbx r3,r15,r14 + 0= until + then + then + pop3 + t; + + t: compare ( adr1 adr2 len -- -1 | offset ) + mr r4,r14 \ Save len for later + set r3,-1 \ -1 - provisional return value + addi r14,r14,1 + begin + addic. r14,r14,-1 + 0> while + lbz r5,0(r15) + lbz r6,0(r16) + cmp 0,0,r5,r6 + <> if subf. r3,r14,r4 then + <> until + then + pop3 + push1 + mr r14,r3 + t; + + t: fill ( adr len b -- ) + cmpi 0,0,r15,0 <> if + addi r16,r16,-1 + mtspr ctr,r15 + begin + stbu r14,1(r16) + countdown + then + pop3 + t; + + t: lfill ( adr len l -- ) + cmpi 0,0,r15,0 <> if + addi r16,r16,-4 +\ rlwinm r15,r15,2,0,29 + rlwinm r15,r15,30,2,31 + mtspr ctr,r15 + begin + stwu r14,4(r16) + countdown + then + pop3 + t; + + t: afill ( adr len -- ) + cmpi 0,0,r14,0 <> if +\ rlwinm r14,r14,2,0,29 + rlwinm r14,r14,30,2,31 + mtspr ctr,r14 + begin + stw r15,(r15) + addi r15,r15,4 + countdown + then + pop2 + t; + + t: check ( adr len b -- ) + addi r16,r16,-1 + begin + addic. r15,r15,-1 + >= while + lbzu r11,1(r16) + cmp 0,0,r11,r14 + <> if + mr r3,r16 dot bl * + putcolon bl * + mr r3,r11 dot bl * + putcr bl * + then + repeat + + pop3 + t; + + t: lcheck ( adr len l -- ) + addi r16,r16,-4 + begin + addic. r15,r15,-4 + >= while + lwzu r11,4(r16) + cmp 0,0,r11,r14 + <> if + mr r3,r16 dot bl * + putcolon bl * + mr r3,r11 dot bl * + putcr bl * + then + repeat + pop3 + t; + + t: acheck ( adr len -- ) + addi r15,r15,-4 + begin + addic. r14,r14,-4 + >= while + lwzu r11,4(r15) + cmp 0,0,r11,r15 + <> if + mr r3,r15 dot bl * + putcolon bl * + mr r3,r11 dot bl * + putcr bl * + then + repeat + pop2 + t; + + t: erase ( adr len -- ) + set r3,0 + cmpi 0,0,r14,0 <> if + addi r15,r15,-1 + begin + stbu r3,1(r15) + countdown + then + pop2 + t; + + t: dump ( adr len -- ) + begin + addic. r14,r14,-1 + >= while + mr r3,r15 dot bl * + putcolon bl * + lbz r3,0(r15) dot bl * + putcr bl * + addi r15,r15,1 + repeat + pop2 + t; + + t: ldump ( adr len -- ) + begin + addic. r14,r14,-4 + >= while + mr r3,r15 dot bl * + putcolon bl * + lwz r3,0(r15) dot bl * + putcr bl * + addi r15,r15,4 + repeat + pop2 + t; + + t: dup ( n -- n n ) + mr r17,r16 mr r16,r15 mr r15,r14 + t; + + t: drop ( n -- ) + mr r14,r15 mr r15,r16 mr r16,r17 + t; + + t: swap ( n1 n2 -- n2 n1 ) + mr r3,r15 mr r15,r14 mr r14,r3 + t; + + t: over ( n1 n2 -- n1 n2 n1 ) + mr r17,r16 mr r16,r15 mr r15,r14 mr r14,r16 + t; + + t: rot ( n1 n2 n3 -- n2 n3 n1 ) + mr r3,r16 mr r16,r15 mr r15,r14 mr r14,r3 + t; + + t: -rot ( n1 n2 n3 -- n3 n1 n2 ) + mr r3,r16 mr r16,r14 mr r14,r15 mr r15,r3 + t; + + t: script ( address -- ) + mr r18,r14 + ori r12,r12,h#c \ Set script and no-echo flags + pop1 + t; + + t: rom-script ( offset -- ) + rom-pa set r10,* + add r18,r14,r10 + ori r12,r12,h#c \ Set script and no-echo flags + pop1 + t; + + t: fexit ( -- ) + rlwinm r12,r12,0,30,27 \ Clear script and no-echo flags (h#0c) + t; + + t: scripts ( -- ) + set r10,0 + rom-pa h# 10000 + 1- set r11,* + begin + lbzu r0,1(r11) + ascii \ cmpi 0,0,r0,* \ If the script aread begings + = if \ with a comment character + \ display "s#: " + ascii s set r3,* putchar bl * + ascii 0 addi r3,r10,* putchar bl * + ascii : set r3,* putchar bl * + putspace bl * + begin \ display the first comment line + lbzu r3,1(r11) \ Get comment byte + cmpi 0,0,r3,h#0d \ Carriage return? + <> if cmpi 0,0,r3,h#0a then \ Line feed? + <> while + putchar bl * + repeat + putcr bl * + then + rlwinm r11,r11,0,0,19 \ Clear 12 low bits + addi r11,r11,h#fff \ Advance to next script + addi r10,r10,1 + cmpi 0,0,r10,10 + = until + t; + + t: s0 ( -- ) + rom-pa h# 10000 + 1- set r18,* + ori r12,r12,h#c \ Set script and no-echo flags + t; + + t: s1 ( -- ) + rom-pa h# 11000 + 1- set r18,* + ori r12,r12,h#c \ Set script and no-echo flags + t; + + t: s2 ( -- ) + rom-pa h# 12000 + 1- set r18,* + ori r12,r12,h#c \ Set script and no-echo flags + t; + + t: s3 ( -- ) + rom-pa h# 13000 + 1- set r18,* + ori r12,r12,h#c \ Set script and no-echo flags + t; + + t: s4 ( -- ) + rom-pa h# 14000 + 1- set r18,* + ori r12,r12,h#c \ Set script and no-echo flags + t; + + t: s5 ( -- ) + rom-pa h# 15000 + 1- set r18,* + ori r12,r12,h#c \ Set script and no-echo flags + t; + + t: s6 ( -- ) + rom-pa h# 16000 + 1- set r18,* + ori r12,r12,h#c \ Set script and no-echo flags + t; + + t: s7 ( -- ) + rom-pa h# 17000 + 1- set r18,* + ori r12,r12,h#c \ Set script and no-echo flags + t; + + t: s8 ( -- ) + rom-pa h# 18000 + 1- set r18,* + ori r12,r12,h#c \ Set script and no-echo flags + t; + + t: s9 ( -- ) + rom-pa h# 19000 + 1- set r18,* + ori r12,r12,h#c \ Set script and no-echo flags + t; + + \ The original intention of "no-echo" and its inverse "echo" was + \ to create a capability like "dl" whereby one could download a + \ script over the serial line, but without requiring the use of + \ memory. However, this has the serious problem that there is + \ no flow control, so commands that can take a long time (like + \ memory tests) potentially cause input overrun. Consequently, + \ it's better to use quiet mode. However, quiet mode has its own + \ problem: few if any terminal programs support its character-echo + \ flow control technique. Character-echo flow control is not + \ particularly great anyway - it can be fooled by generated output + \ that happens to contain the next input character. + t: no-echo ( -- ) + ori r12,r12,h#8 \ Set no-echo flag + t; + + t: echo ( -- ) + rlwinm r12,r12,0,29,27 \ Clear no-echo flag + t; + + t: cr ( -- ) + putcr bl * + t; + + t: key ( -- char ) + getchar bl * + push1 mr r14,r3 + t; + + t: emit ( char -- ) + mr r3,r14 + putchar bl * + pop1 + t; + + \ This is useful for diagnostics in script mode, but essentially + \ useless otherwise. + t: .( ( "string" -- ) + begin + andi. r3,r12,4 0<> if \ Script mode + lbz r3,0(r18) + addi r18,r18,1 + else \ Normal mode + getchar bl * ( char in r3 ) + then + char ) cmpi 0,0,r3,* + <> while + putchar bl * + repeat + t; + + \ This is useful for commentary in script mode, but essentially + \ useless otherwise. + t: \ ( "rest-of-line" -- ) + begin + andi. r3,r12,4 0<> if \ Script mode + lbz r3,0(r18) + else \ Normal mode + getchar bl * ( char in r3 ) + then + cmpi 0,0,r3,h#0a + <> if cmpi 0,0,r3,h#0d then + = until + t; + + t: goto ( address -- ) + mr r3,r11 mr r4,r12 mr r5,r13 + mtspr lr,r15 + bclr 20,0 + t; + + t: gettext ( address -- length ) + addi r8,r14,-1 + begin + getchar bl * + cmpi 0,0,r3,4 \ Control-D (ASCII EOT) + <> while + stbu r0,1(r8) + repeat + + addi r8,r8,1 + subf r14,r14,r8 + t; + + t: getbytes ( address length -- ) + begin + addic. r14,r14,-1 + 0>= while + getchar bl * + stb r3,0(r15) + addi r15,r15,1 + repeat + pop2 + t; + +[ifdef] rom-pa + t: rom ( -- adr ) + push1 rom-pa set r14,* + t; +[then] + +[ifdef] isa-io-pa + t: io ( -- adr ) + push1 isa-io-pa set r14,* + t; +[then] + +[ifdef] mem0-pa + t: mem0 ( -- adr ) + push1 mem0-pa set r14,* + t; +[then] + +[ifdef] mem1-pa + t: mem1 ( -- adr ) + push1 mem1-pa set r14,* + t; +[then] + +[ifdef] mem2-pa + t: mem2 ( -- adr ) + push1 mem2-pa set r14,* + t; +[then] + +[ifdef] mem3-pa + t: mem3 ( -- adr ) + push1 mem3-pa set r14,* + t; +[then] + + t: 1m ( -- n ) + push1 set r14,h#100000 + t; + + t: 2m ( -- n ) + push1 set r14,h#200000 + t; + + t: 4m ( -- n ) + push1 set r14,h#400000 + t; + + t: 8m ( -- n ) + push1 set r14,h#800000 + t; + + t: 16m ( -- n ) + push1 set r14,h#1000000 + t; + + t: 32m ( -- n ) + push1 set r14,h#2000000 + t; + +[ifdef] load-nano-extras load-nano-extras [then] + + \ The word was not recognized; parse it as a number or complain + convert-number bl * cmpi 0,0,r4,0 <> if \ Number in r3 + \ Push the number + spush ( -- n ) + else + \ The word was neither recognized nor numeric; complain + char ? set r3,* putchar bl * putcr bl * + then + + again + +end-code + +\ LICENSE_BEGIN +\ Copyright (c) 2007 FirmWorks +\ +\ Permission is hereby granted, free of charge, to any person obtaining +\ a copy of this software and associated documentation files (the +\ "Software"), to deal in the Software without restriction, including +\ without limitation the rights to use, copy, modify, merge, publish, +\ distribute, sublicense, and/or sell copies of the Software, and to +\ permit persons to whom the Software is furnished to do so, subject to +\ the following conditions: +\ +\ The above copyright notice and this permission notice shall be +\ included in all copies or substantial portions of the Software. +\ +\ THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, +\ EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF +\ MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND +\ NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE +\ LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION +\ OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION +\ WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. +\ +\ LICENSE_END Added: cpu/ppc/msr.fth =================================================================== --- cpu/ppc/msr.fth (rev 0) +++ cpu/ppc/msr.fth 2007-07-05 17:19:17 UTC (rev 461) @@ -0,0 +1,65 @@ +purpose: Machine Status Register access +\ See license at end of file + +code msr@ ( -- n ) + stwu tos,-4(sp) + mfmsr tos +c; +code msr! ( n -- ) + sync isync + mtmsr tos + sync isync + lwz tos,0(sp) + addi sp,sp,4 +c; + +h# 8000 constant interrupt-enable-bit +: interrupt-enable@ ( -- n ) msr@ interrupt-enable-bit and ; +: interrupt-enable! ( n -- ) + msr@ interrupt-enable-bit invert and or msr! +; + +headerless +: (enable-interrupts) ( -- ) msr@ interrupt-enable-bit or msr! ; +: (disable-interrupts) ( -- ) msr@ interrupt-enable-bit invert and msr! ; +: interrupts-enabled? ( -- yes? ) interrupt-enable@ ; + +code (lock) ( -- ) ( R: -- oldMSR ) + mfmsr t0 + stwu t0,-1cell(rp) + rlwinm t0,t0,0,17,15 \ Clear EE bit + mtmsr t0 +c; +code (unlock) ( -- ) ( R: oldMSR -- ) + lwz t0,0(rp) + mtmsr t0 + addi rp,rp,1cell +c; + +: mapping-on ( -- ) msr@ h# 30 or msr! ; +: mapping-off ( -- ) msr@ h# 30 invert and msr! ; +headers + +\ LICENSE_BEGIN +\ Copyright (c) 2007 FirmWorks +\ +\ Permission is hereby granted, free of charge, to any person obtaining +\ a copy of this software and associated documentation files (the +\ "Software"), to deal in the Software without restriction, including +\ without limitation the rights to use, copy, modify, merge, publish, +\ distribute, sublicense, and/or sell copies of the Software, and to +\ permit persons to whom the Software is furnished to do so, subject to +\ the following conditions: +\ +\ The above copyright notice and this permission notice shall be +\ included in all copies or substantial portions of the Software. +\ +\ THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, +\ EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF +\ MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND +\ NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE +\ LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION +\ OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION +\ WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. +\ +\ LICENSE_END Added: cpu/ppc/ntctrace.fth =================================================================== --- cpu/ppc/ntctrace.fth (rev 0) +++ cpu/ppc/ntctrace.fth 2007-07-05 17:19:17 UTC (rev 461) @@ -0,0 +1,85 @@ +purpose: Stack backtrace for Microsoft/Motorola compiler +\ See license at end of file + +headerless +\ Search forward for a "bclr" instruction, then search backward for +\ "lwz r0,XXX(r1), then get the contents of that effective address. +: pc>caller ( fp pc -- call-point-adr ) + \ XXX we need to determine where we are in the function - if we are + \ before the place where the frame pointer is updated, or after the + \ place where it is restored, we must treat the function as a leaf + \ routine and get the caller address directly from LR. It is probably + \ a good idea to first check to see if the function is a pure leaf + \ routine, by searching for a "stwu r1,XX(r1)" instruction between + \ the beginning and the bclr. Hmmm... I wonder if the beginning + \ address of a leaf routine can be determined? It might not begin + \ with a "mfspr r0,lr". + + begin dup l@ h# 4e800020 <> while la1+ repeat ( fp end-adr ) + begin -1 la+ dup l@ d# 16 >> h# 8001 = until ( fp lwz-adr ) + l@ h# ffff and + l@ -1 la+ +; +\ Search forward for an "mfspr r0,lr" instruction +: pc>function ( pc -- entry-adr ) + begin dup l@ h# 7c0802a6 <> while -1 la+ repeat ( mfspr-r0,lr-adr ) +; + +\ Determine the stack frame size of the function containing the given PC +\ by finding the first "stwu r1,XXX(r1)" instruction in the function. +: pc>framesize ( pc -- /frame ) + pc>function + begin dup l@ d# 16 >> h# 9421 <> while la1+ repeat ( stwu-adr ) + + \ The offset is negative, so merge in the sign bits and negate it + l@ h# ffff invert or negate +; + +: .adr base @ >r hex 9 u.r r> base ! ; + +: .call ( fp caller function -- ) + .adr ." () called from" .adr ." FP: " .x cr +; + +\ This must agree with the stack initialization jointly established by +\ init-pe-program and (init-program). +: pe-stack-top ( -- adr ) pe-image-base h# 20 - ; + +headers +\ XXX show TOC too +: ms-ctrace ( -- ) + ?saved-state + %r1 %pc ( frame-ptr pc ) + begin ( frame-ptr pc ) + over pe-stack-top <> ( frame-ptr pc ) + while ( frame-ptr pc ) + dup pc>function >r ( frame-ptr pc ) + 2dup pc>caller >r over r> r> .call ( frame-ptr pc ) + 2dup pc>caller -rot pc>framesize + swap ( frame-ptr' pc' ) + exit? if 2drop exit then ( frame-ptr' pc' ) + repeat ( frame-ptr' pc' ) + 2drop 0 pe-image-base .call ( ) +; + +\ LICENSE_BEGIN +\ Copyright (c) 2007 FirmWorks +\ +\ Permission is hereby granted, free of charge, to any person obtaining +\ a copy of this software and associated documentation files (the +\ "Software"), to deal in the Software without restriction, including +\ without limitation the rights to use, copy, modify, merge, publish, +\ distribute, sublicense, and/or sell copies of the Software, and to +\ permit persons to whom the Software is furnished to do so, subject to +\ the following conditions: +\ +\ The above copyright notice and this permission notice shall be +\ included in all copies or substantial portions of the Software. +\ +\ THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, +\ EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF +\ MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND +\ NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE +\ LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION +\ OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION +\ WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. +\ +\ LICENSE_END Added: cpu/ppc/objects.fth =================================================================== --- cpu/ppc/objects.fth (rev 0) +++ cpu/ppc/objects.fth 2007-07-05 17:19:17 UTC (rev 461) @@ -0,0 +1,214 @@ +purpose: Action definition for multiple-code-field words. +\ See license at end of file + +\ Data structures: +\ nth-action-does-clause acfs unnest +\ n-1th-action-does-clause acfs unnest +\ ... +\ 1th-action-does-clause acfs unnest +\ nth-adr +\ n-1th-adr +\ ... +\ 1th-adr +\ n +\ 0th-action-does-clause acfs unnest +\ object-header build-acfs +\ (') 0th-adr uses + +needs doaction objsup.fth \ Machine-dependent support routines + +decimal +headerless + +0 value action# +0 value #actions +0 value action-adr +headers +: actions ( #actions -- ) + is #actions + #actions 1- /token * na1+ allot ( #actions ) \ Make the jump table + \ The default action is a code field, which must be aligned + align acf-align here is action-adr + 0 is action# + #actions action-adr /n - n! +; +headerless +\ Sets the address entry in the action table +: set-action ( -- ) + action# #actions > abort" Too many actions defined" + lastacf action-adr action# /token * - /n - token! +; +headers +: action: ( -- ) + action# if \ Not the default action + doaction set-action + else \ The default action, like does> + place-does + then + + action# 1+ is action# + !csp + ] +; +: action-code ( -- ) + action# if \ Not the default action + acf-align start-code set-action + else \ The default action, like ;code + start-;code + then + + \ For the default action, the apf of the child word is found in + \ the same way as with ;code words. + + action# 1+ is action# + do-entercode +; +: use-actions ( -- ) + state @ if + compile (') action-adr token, compile used + else + action-adr used + then +; immediate + +headerless +: .object-error + ( object-acf action-adr false | acf action# #actions true -- ... ) + ( ... -- object-acf action-adr ) + if + ." Unimplemented action # " swap .d ." on object " swap .name + ." , whose maximum action # is " 1- .d cr + abort + then +; + +headers + +\ Run-time code for "to". This is important enough to deserve special +\ optimization. +code to ( -- ) + lwzu t0,4(ip) \ Object acf in t0 + add t0,t0,base \ Relocate + + stwu tos,-4(sp) \ Save the top-of-stack register on memory stack + addi tos,t0,8 \ Put pfa in top-of-stack register + + lwz t1,4(t0) \ Token of default action + add t1,t1,base \ Relocate + lwz w,-8(t1) \ Token of "to" action clause + + \ Tail of "NEXT" + lwzux t1,w,base \ Read the contents of the code field + add t1,t1,base \ Relocate + mtspr lr,t1 + bclr 20,0 \ Execute the code +end-code + +code dispatch-action ( acf action-adr -- ) + \ action-adr in tos + lwz t0,0(sp) \ Object acf in t0 + addi sp,sp,4 + + move w,tos \ Token of action clause + + addi tos,t0,8 \ Put pfa in top-of-stack register + + lwz t1,0(w) \ Read the contents of the code field + \ next-tail1 + add t1,t1,base \ Relocate + mtspr lr,t1 + bclr 20,0 \ Execute the code +end-code + +\ Executes the numbered action of the indicated object +\ It might be worthwhile to implement perform-action entirely in code. +: perform-action ( object-acf action# -- ) + dup if + >action-adr .object-error ( object-acf action-adr ) + dispatch-action + else + drop execute + then +; + +: action-name \ name ( action-offset-adr -- ) + create 1+ /token * negate , + ;code + + lwzu t0,4(ip) \ Object acf in t0 + add t0,t0,base \ Relocate + + lwz t1,4(t0) \ Token of default action + add t1,t1,base \ Relocate + lwz tos,0(tos) \ Get action offset + lwzx w,tos,t1 \ Token of indicated action clause + + addi tos,t0,8 \ Put pfa in top-of-stack register + + \ Tail of "NEXT" + lwzux t1,w,base \ Read the contents of the code field + add t1,t1,base \ Relocate + mtspr lr,t1 + bclr 20,0 \ Execute the code +end-code + +\ 1 action-name to +2 action-name addr + +: action-compiler: \ name ( -- ) + bl word dup find 0= ?missing \ pstr acf + swap "create token, immediate + does> ( apf ) + +level ( apf ) \ Enter temporary compile state if necessary + token@ (compile) \ Compile run-time action-name word + ' (compile) \ Compile object acf + -level \ Exit temporary compile state, perhaps run word +; +\ action-compiler: to +action-compiler: addr + + +\ Makes "is" and "to" synonymous. "is" first checks to see if the +\ object is of one of the kernel object types (which don't have multiple +\ code fields), and if so, compiles or executes the "(is) <token>" form. +\ If the object is not of one of the kernel object types, "is" calls +\ "to-hook" to handle the object as a multiple-code field type object. + +: (to) ( [data] acf -- ) +level compile to (compile) -level ; +' (to) is to-hook +alias to is + +\ 3 actions +\ action: @ ; +\ action: ! ; ( is ) +\ action: ; ( addr ) +\ : value \ name ( initial-value -- ) +\ create , +\ use-actions +\ ; + +\ Need inheritance + +\ LICENSE_BEGIN +\ Copyright (c) 2007 FirmWorks +\ +\ Permission is hereby granted, free of charge, to any person obtaining +\ a copy of this software and associated documentation files (the +\ "Software"), to deal in the Software without restriction, including +\ without limitation the rights to use, copy, modify, merge, publish, +\ distribute, sublicense, and/or sell copies of the Software, and to +\ permit persons to whom the Software is furnished to do so, subject to +\ the following conditions: +\ +\ The above copyright notice and this permission notice shall be +\ included in all copies or substantial portions of the Software. +\ +\ THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, +\ EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF +\ MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND +\ NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE +\ LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION +\ OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION +\ WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. +\ +\ LICENSE_END Added: cpu/ppc/objsup.fth =================================================================== --- cpu/ppc/objsup.fth (rev 0) +++ cpu/ppc/objsup.fth 2007-07-05 17:19:17 UTC (rev 461) @@ -0,0 +1,102 @@ +purpose: Machine dependent support routines for multiple-code-field "objects" +\ See license at end of file + +\ These words know intimate details about the Forth virtual machine +\ implementation. + +\ Assembles the common code executed by actions. That code +\ extracts the next token (which is the acf of the object) from the +\ code stream and leaves the corresponding apf on the stack. + +headerless + +: start-code ( -- ) code-cf !csp ; + +\ Assembles code to begin a ;code clause +: start-;code ( -- ) start-code ; + +\ Code field for an object action. +: doaction ( -- ) acf-align colon-cf ; + +\ Returns the address of the code executed by the word whose code field +\ address is acf +: >code-adr ( acf -- code-adr ) token@ ; + +code >action-adr ( object-acf action# -- ) + ( ... -- object-acf action# #actions true | object-apf action-adr false ) + \ action# in tos + lwz t0,0(sp) \ object-acf in t0 + lwz t1,1cell(t0) \ code offset in t1 + add t1,t1,base \ Relocate; code address in t1 + lwz t2,-1cell(t1) \ #actions in t2 + cmp 0,0,t2,tos \ Test action number + <= if \ "true" branch is error + stwu tos,-1cell(sp) \ Push action# + stwu t2,-1cell(sp) \ Push #actions + addi tos,r0,-1 \ Return true for error + else + addi t0,t0,/cf+1cell \ Compute object-apf from object-acf + stw t0,0(sp) \ Put action-apf on stack + + rlwinm tos,tos,2,0,29 \ Convert index to byte offset + subfc t1,tos,t1 \ Skip back #actions tokens + \ ( Use subfc for POWER compatibility) + lwz t1,-1cell(t1) \ Get token, accounting for action# field + add t1,t1,base \ Relocate + stwu t1,-1cell(sp) \ Push action-adr + addi tos,r0,0 \ Return false for no error + then +c; + +headers +: action-name \ name ( action# -- ) + create , \ Store action number in data field + ;code ( -- object-pfa ) + lwz t0,0(tos) \ Action# in t0 + + lwzu t1,/token(ip) \ Object acf in t1 + add t1,t1,base \ Relocate + + addi tos,t1,/cf+1cell \ Compute and push object-apf + + lwz t1,1cell(t1) \ relative version of .. + add t1,t1,base \ default action code address + + rlwinm t0,t0,2,0,29 \ Convert index to byte offset + subfc t1,t0,t1 \ Skip back action# tokens + \ ( Use subfc for POWER compatibility) + + lwz w,-1cell(t1) \ Get token, accounting for action# field + + lwzux t1,w,base \ next-tail ... + add t1,t1,base + mtspr lr,t1 + bclr 20,0 +end-code + +: >action# ( apf -- action# ) @ ; +headers + +\ LICENSE_BEGIN +\ Copyright (c) 2007 FirmWorks +\ +\ Permission is hereby granted, free of charge, to any person obtaining +\ a copy of this software and associated documentation files (the +\ "Software"), to deal in the Software without restriction, including +\ without limitation the rights to use, copy, modify, merge, publish, +\ distribute, sublicense, and/or sell copies of the Software, and to +\ permit persons to whom the Software is furnished to do so, subject to +\ the following conditions: +\ +\ The above copyright notice and this permission notice shall be +\ included in all copies or substantial portions of the Software. +\ +\ THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, +\ EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF +\ MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND +\ NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE +\ LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION +\ OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION +\ WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. +\ +\ LICENSE_END Added: cpu/ppc/occhksum.fth =================================================================== --- cpu/ppc/occhksum.fth (rev 0) +++ cpu/ppc/occhksum.fth 2007-07-05 17:19:17 UTC (rev 461) @@ -0,0 +1,102 @@ +purpose: Internet checksum (one's complement of 16-bit words) primitive +\ See license at end of file + +\ The complete checksum calculation consists of: +\ a) add together all the 16-bit big-endian words in the buffer, with +\ wrap-around carry (i.e. a carry out of the high bit is added back +\ in at the low bit). +\ b) Take the one's complement of the result, preserving only the +\ least-significant 16 bits. +\ c) If the result is 0, change it to ffff. + +\ The process of computing a checksum for UDP packets involves the +\ creation of a "pseudo header" containing selected information +\ from the IP header, and checksumming the combination of that pseudo +\ header and the UDP packet. To do so, it is convenient to perform +\ step (a) of the calculation separately on the two pieces (pseudo header +\ and UDP packet). Thus we factor the checksum calculation code with +\ a separate primitive "(oc-checksum)" that performs step (a). That +\ primitive is worth optimizing; steps (b) and (c) are typically not. + +headerless +\ This algorithm depends on the assumption that the buffer is +\ short enough so that we never have a carry out of the high +\ 16 bit word. Assuming worst case data (all bytes ff), the +\ buffer would have to be 128K + 3 bytes long for this to happen. +\ The maximum length of an IP packet is 64K bytes, so we are safe. +\ This allows us to accumulate the end-around carries in the high +\ 16-bit word and add them in one operation at the end. + +code (oc-checksum) ( accum adr len -- checksum ) + mr t1,tos \ t1: len + lwz t0,0(sp) \ t0: adr + lwz tos,4(sp) \ tos: accum + addi sp,sp,8 \ clean up stack + + mr t2,t1 \ t2: copy of len + cmpi 0,0,t1,2 \ Are there any complete words to do? + >= if + + mfspr t5,ctr \ Save counter + + rlwinm t1,t1,31,1,31 \ Convert to word count + mtspr ctr,t1 + + 'user in-little-endian? lwz t3,* \ Which endian + 0= if \ If BE, use word accesses + addi t0,t0,-2 \ Account for pre-increment + + begin + lhzu t3,2(t0) \ Read word and increment pointer + add tos,tos,t3 \ Update checksum + countdown + + addi t0,t0,2 \ Point to next byte + else \ If LE, use byte accesses + addi t0,t0,-1 \ Account for pre-increment + + begin + lbzu t4,1(t0) \ Read high byte and increment pointer + lbzu t3,1(t0) \ Read low byte and increment pointer + rlwimi t3,t4,8,16,23 \ Merge high and low bytes into t3 + add tos,tos,t3 \ Update checksum + countdown + + addi t0,t0,1 \ Point to next byte + then + + mtspr ctr,t5 \ Restore counter + then + + andi. r0,t2,1 \ Is there a leftover byte? + 0<> if + lbz t3,0(t0) \ Get the byte + rlwinm t3,t3,8,16,23 \ Move it to the correct position in the word + add tos,tos,t3 \ Update checksum + then + +c; + +\ LICENSE_BEGIN +\ Copyright (c) 2007 FirmWorks +\ +\ Permission is hereby granted, free of charge, to any person obtaining +\ a copy of this software and associated documentation files (the +\ "Software"), to deal in the Software without restriction, including +\ without limitation the rights to use, copy, modify, merge, publish, +\ distribute, sublicense, and/or sell copies of the Software, and to +\ permit persons to whom the Software is furnished to do so, subject to +\ the following conditions: +\ +\ The above copyright notice and this permission notice shall be +\ included in all copies or substantial portions of the Software. +\ +\ THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, +\ EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF +\ MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND +\ NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE +\ LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION +\ OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION +\ WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. +\ +\ LICENSE_END Added: cpu/ppc/olpc/devalias.fth =================================================================== --- cpu/ppc/olpc/devalias.fth (rev 0) +++ cpu/ppc/olpc/devalias.fth 2007-07-05 17:19:17 UTC (rev 461) @@ -0,0 +1,40 @@ +purpose: Platform-specific device aliases +\ See license at end of file + +devalias net /pci/ethernet@e + +.( XXX olpc/devalias.fth) cr +devalias disk0 /pci/disk@0,0:1 +devalias disk1 /pci/scsi@c/disk@1,0:1 +devalias disk2 /pci/scsi@c/disk@2,0:1 +devalias cdrom /pci/scsi@c/disk@5,0 + +devalias c /pci/scsi@c/disk@0,0 + +devalias disk /pci/scsi@c/disk@0,0:1 + +devalias com1 /serial@f1012000 + +\ LICENSE_BEGIN +\ Copyright (c) 2007 FirmWorks +\ +\ Permission is hereby granted, free of charge, to any person obtaining +\ a copy of this software and associated documentation files (the +\ "Software"), to deal in the Software without restriction, including +\ without limitation the rights to use, copy, modify, merge, publish, +\ distribute, sublicense, and/or sell copies of the Software, and to +\ permit persons to whom the Software is furnished to do so, subject to +\ the following conditions: +\ +\ The above copyright notice and this permission notice shall be +\ included in all copies or substantial portions of the Software. +\ +\ THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, +\ EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF +\ MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND +\ NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE +\ LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION +\ OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION +\ WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. +\ +\ LICENSE_END Added: cpu/ppc/olpc/elf.fth =================================================================== --- cpu/ppc/olpc/elf.fth (rev 0) +++ cpu/ppc/olpc/elf.fth 2007-07-05 17:19:17 UTC (rev 461) @@ -0,0 +1,126 @@ +purpose: Load image handler for ELF (Extended Linker Format) +\ See license at end of file + +hex + +headerless +: elf? ( -- flag ) 0 +base 4 " "(7f)ELF" $= ; +: elf-le? ( -- flag ) 5 +base c@ 1 = ; +: elfl@ ( adr -- n ) elf-le? if le-l@ else be-l@ then ; +: elfw@ ( adr -- w ) elf-le? if le-w@ else be-w@ then ; + +: eh-l@ ( offset -- l ) +base elfl@ ; +: eh-w@ ( offset -- w ) +base elfw@ ; + +: +elfl@ ( adr offset -- n ) + elfl@ ; + +\ XXX the following code assumes that the value of load-base is such that +\ the copying of program sections to their correct locations does not +\ overwrite portions of other sections that have not yet been copied. + +\ One sufficient condition is that the program sections are stored in the +\ ELF file in ascending order of their execution addresses (vaddr fields) +\ and that load-base is large enough that the sections must be moved to +\ lower addresses. + +0 value high-water +0 value low-water +: record-extent ( adr len -- ) + bounds low-water umin to low-water high-water umax to high-water +; + +: prepare-elf-program ( -- entry-point ) + 0 to high-water + -1 to low-water + + \ Copy all pheaders to allocated memory to protect them from being + \ overwritten when we copy the programs to their final destinations. + + \ e_entry e_phentsize e_phnum + h# 18 eh-l@ h# 2a eh-w@ dup h# 2c eh-w@ * ( entry phentsize phsize) + dup alloc-mem swap ( entry phentsize pbbuf phsize ) + + \ e_phoff + 2dup 1c eh-l@ +base -rot move ( entry phentsize phbuf phsize ) + + \ Scan the program sections and determine how much memory is needed + 2dup bounds ?do ( entry phentsize phbuf phsize ) \ throughout loop + \ p_type PT_LOAD + i 0 +elfl@ 1 = if + \ p_vaddr p_memsz + i 8 +elfl@ i h# 14 +elfl@ record-extent + then + 2 pick +loop ( entry phentsize phbuf phsize ) + + \ XXX Ultimatelty we need to allocate physical memory and map + \ it appropriately, but for now we just claim the virtual address + \ space, assuming that it is already mapped. + + low-water 0 high-water low-water - 0 mem-claim drop ( adr ) + low-water <> abort" Couldn't claim the program's memory" + + 2dup bounds ?do ( entry phentsize phbuf phsize ) \ throughout loop + \ p_type PT_LOAD + i 0 +elfl@ 1 = if + + \ XXX we need to acquire and map the memory first! + + \ Move it into the correct vaddr. + \ p_offset p_vaddr p_filesz + i 4 +elfl@ +base i 8 +elfl@ i h# 10 +elfl@ ( src dst len ) + 2dup 2>r move 2r> sync-cache + + \ Zero any bytes that are not stored in the file + \ p_vaddr p_memsz p_filesz + i 8 +elfl@ i h# 14 +elfl@ i h# 10 +elfl@ /string erase + then + 2 pick +loop ( entry phentsize phbuf phsize ) + free-mem drop ( entry ) +; + +defer verify-machine-type +: (verify-machine-type) ( -- ) + h# 10 eh-w@ 2 <> abort" The loaded file is not executable" + h# 12 eh-w@ dup d# 17 <> swap d# 20 <> and + abort" The loaded file is not a PowerPC program" +; +' (verify-machine-type) to verify-machine-type + +: init-elf-program ( -- ) + verify-machine-type + + prepare-elf-program ( pc ) + + h# 8000 alloc-mem h# 8000 + ( pc sp ) + + (init-program) +; + +headers +warning @ warning off +: init-program ( -- ) elf? if init-elf-program else init-program then ; +warning ! + +\ LICENSE_BEGIN +\ Copyright (c) 2007 FirmWorks +\ +\ Permission is hereby granted, free of charge, to any person obtaining +\ a copy of this software and associated documentation files (the +\ "Software"), to deal in the Software without restriction, including +\ without limitation the rights to use, copy, modify, merge, publish, +\ distribute, sublicense, and/or sell copies of the Software, and to +\ permit persons to whom the Software is furnished to do so, subject to +\ the following conditions: +\ +\ The above copyright notice and this permission notice shall be +\ included in all copies or substantial portions of the Software. +\ +\ THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, +\ EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF +\ MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND +\ NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE +\ LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION +\ OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION +\ WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. +\ +\ LICENSE_END Added: cpu/ppc/olpc/flash.fth =================================================================== --- cpu/ppc/olpc/flash.fth (rev 0) +++ cpu/ppc/olpc/flash.fth 2007-07-05 17:19:17 UTC (rev 461) @@ -0,0 +1,65 @@ +purpose: Setup for Flash ROM access +\ See license at end of file + +h# 8.0000 to /flash +h# fff0.0000 constant rom0-pa +h# fff8.0000 constant rom1-pa +rom0-pa value rom-pa +0 value rom0 + +0 value flashbase + +: ?swizzle ( adr -- adr' ) in-little-endian? if 7 xor then ; +: (fctl!) ( n a -- ) flashbase + ?swizzle c! ; ' (fctl!) to fctl! +: (fdata!) ( n a -- ) flashbase + ?swizzle c! ; ' (fdata!) to fdata! +: (fc@) ( a -- n ) flashbase + ?swizzle c@ ; ' (fc@) to fc@ + + +: open-flash ( -- ) + flashbase 0= if + rom-pa /flash root-map-in to flashbase + then + h# a8 config-l@ h# 00001000 or h# a8 config-l! +; +: close-flash ( -- ) + flashbase /flash root-map-out 0 to flashbase + h# a8 config-l@ h# 00001000 invert and h# a8 config-l! +; +' open-flash to enable-flash-writes + +: (use-rom) ( adr -- ) flashbase if close-flash then to rom-pa ; +: use-rom1 ( -- ) rom1-pa (use-rom) ; +: use-rom0 ( -- ) rom0-pa (use-rom) ; + +\ Copy ROM0 to ROM1 + +\ (flash) is a forward reference. +: copy-rom ( -- ) + rom-pa >r + " rom0" $read-file use-rom1 " (flash)" evaluate + r> (use-rom) +; + +\ LICENSE_BEGIN +\ Copyright (c) 2007 FirmWorks +\ +\ Permission is hereby granted, free of charge, to any person obtaining +\ a copy of this software and associated documentation files (the +\ "Software"), to deal in the Software without restriction, including +\ without limitation the rights to use, copy, modify, merge, publish, +\ distribute, sublicense, and/or sell copies of the Software, and to +\ permit persons to whom the Software is furnished to do so, subject to +\ the following conditions: +\ +\ The above copyright notice and this permission notice shall be +\ included in all copies or substantial portions of the Software. +\ +\ THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, +\ EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF +\ MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND +\ NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE +\ LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION +\ OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION +\ WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. +\ +\ LICENSE_END Added: cpu/ppc/olpc/fw.bth =================================================================== --- cpu/ppc/olpc/fw.bth (rev 0) +++ cpu/ppc/olpc/fw.bth 2007-07-05 17:19:17 UTC (rev 461) @@ -0,0 +1,300 @@ +purpose: Load file for fw.dic for OLPC School Server +\ See license at end of file + +dictionary: ${BP}/cpu/ppc/build/basefw.dic +command: &ppcforth &dictionary &this +build-now + +\ Configuration defines +create bailout-early +true to stand-init-debug? +true constant real-mode? + +\ ' $report-name is include-hook + +headerless +h# 1000 to pagesize +d# 12 to pageshift + +headers +true value chrp? \ Change as needed + +dev / +1 encode-int " #address-cells" property +device-end + +\ Memory management services +fload ${BP}/ofw/core/clntmem1.fth \ client services for memory +fload ${BP}/ofw/core/memlist.fth \ Resource list common routines +fload ${BP}/ofw/core/showlist.fth \ Linked list display tool +fload ${BP}/ofw/core/allocph1.fth \ S Physical memory allocator +fload ${BP}/ofw/core/availpm.fth \ Available memory list + +headerless +: (memory?) ( phys -- flag ) h# 8000.0000 u< ; \ The CHRP boundary is 0x4000.0000 +' (memory?) to memory? + +headers +\ Handy tools to mark device nodes with the "built-in" property +: mark-builtin ( -- false ) + 0 package( 0 0 encode-bytes " built-in" property )package + false +; +: mark-builtin-all ( -- ) + ['] mark-builtin ['] search-preorder catch 2drop +; + +\ Load file format handlers + +fload ${BP}/cpu/ppc/initpgm.fth \ Basic boot handler +fload ${BP}/cpu/ppc/olpc/elf.fth \ handler for ELF booting +fload ${BP}/ofw/inet/loadtcp.fth \ TCP extensions + +\ Reboot and re-entry code +fload ${BP}/cpu/ppc/reboot.fth \ Restart the client program +fload ${BP}/cpu/ppc/reenter.fth \ Various entries into Forth + +\ Miscellaneous hardware interface words +fload ${BP}/cpu/ppc/cache603.fth \ Cache synchronization +fload ${BP}/cpu/ppc/segreg.fth \ Segment register access +fload ${BP}/cpu/ppc/bat.fth \ BAT mapping register access +fload ${BP}/cpu/ppc/scrub.fth \ Fast memory scrubbing using "dcbz" + +hex +warning on + +h# 40.0000 ' load-base set-config-int-default + +headerless +: (initial-heap) ( -- adr len ) sp0 @ ps-size - limit tuck - ; +' (initial-heap) is initial-heap +headers + +" /openprom" find-device + " FirmWorks,3.0" encode-string " model" property +device-end + +\ XXX this may need to change for L2 cache support +warning @ warning off +\ We can't turn on the dcache until we have set up BAT mapping +stand-init: Instruction cache on + icache-on? 0= if icache-on then +; +warning ! + +fload ${BP}/cpu/ppc/dectrap.fth \ Null decrementer handler +stand-init: Enable machine check exceptions + msr@ h# 1000 or msr! +; + +headerless +defer set-memory-map ' noop to set-memory-map + +headers +stand-init: Set Memory Map + set-memory-map +; + +headerless +h# 6000.0000 value fw-virt-base \ 32 megs of mapping space +h# 0200.0000 value fw-virt-size + +headers +0 value memsize + +fload ${BP}/cpu/ppc/loadvmem.fth \ /mmu node +stand-init: MMU + " /mmu" open-dev mmu-node ! +; + +fload ${BP}/cpu/ppc/realcif.fth \ Real-mode client interface fixups + +fload ${BP}/cpu/ppc/rootnode.fth \ Methods for root node +stand-init: Root node + " /" " init" execute-device-method drop +; +stand-init: Data cache on + msr@ h# 10 and dcache-on? 0= and if dcache-on then +; +stand-init: Fast CPU mode + fastest-mode +; + +0 0 " " " /" begin-package +fload ${BP}/cpu/ppc/olpc/mappci.fth \ PCI-to-root-node address translation +fload ${BP}/dev/pcibus.fth \ Generic PCI bus package +end-package +stand-init: PCI host bridge + " /pci" " init" execute-device-method drop +; + +fload ${BP}/dev/pciprobe.fth +defer probe-all ' probe-pci to probe-all + +fload ${BP}/cpu/ppc/cpunode.fth + +fload ${BP}/ofw/core/bailout.fth + +fload ${BP}/cpu/ppc/olpc/reset.fth \ Reset via "92" register + +fload ${BP}/ofw/core/countdwn.fth \ Startup countdown +fload ${BP}/cpu/ppc/banner.fth \ Startup banner + +fload ${BP}/forth/lib/pattern.fth \ Text string pattern matching +fload ${BP}/ofw/core/filecmds.fth \ File commands: dir, del, ren, etc. + +\ fload ${BP}/pkg/flash/flash.fth +\ fload ${BP}/dev/amd29fxx.fth + +\ fload ${BP}/cpu/ppc/ntctrace.fth + +fload ${BP}/ofw/core/startup.fth + +warning on + +h# 4.0000 constant initial-heap-size + +\ fload builton.fth \ Automatic version stamp +\ dev /openprom +\ built-date-int encode-int " built-on" property +\ 0 0 encode-bytes " arc-interrupt-level=vector" property +\ device-end + +\ fload ${BP}/arch/prep/loadcvar.fth \ PREP NVRAM layout + +\ fload ${BP}/arch/prep/ultra/fixednv.fth \ Offsets of fixed regions of NVRAM + +h# f100.0000 constant mv64660-base \ Needs to be mapped to a VA + +: mv-b@ ( offset -- byte ) mv64660-base + rb@ ; +: mv-b! ( byte offset -- ) mv64660-base + rb! ; +: mv-w@ ( offset -- byte ) mv64660-base + rw@ ; +: mv-w! ( byte offset -- ) mv64660-base + rw! ; +: mv-l@ ( offset -- byte ) mv64660-base + rl@ ; +: mv-l! ( byte offset -- ) mv64660-base + rl! ; +: uart@ ( reg# -- byte ) /l* h# 1.2000 + mv-b@ ; +: uart! ( byte reg# -- ) /l* h# 1.2000 + mv-b! ; +fload ${BP}/dev/diaguart.fth \ Diagnostic driver for PC-compatible serial port + +fload ${BP}/forth/lib/sysuart.fth \ Plug UART routines into key and emit +' ukey is diag-key \ Feed UART input to "dl" + +fload ${BP}/cpu/ppc/olpc/reports.fth \ Low-level character output routines + +fload ${BP}/cpu/ppc/olpc/pciconfig.fth \ Configuration space access +\ fload ${BP}/arch/prep/eagle.fth \ Eagle configuration registers +fload ${BP}/cpu/ppc/ppcboot.fth \ Forth startup code + +[ifdef] bailout-early +: startup quit ; + +install-rom-cold + +.( --- Saving fw.dic ---) cr p" fw.dic" save-forth +bye +[then] + +fload ${BP}/cpu/ppc/olpc/rootnode.fth \ Methods for root node + +fload ${BP}/cpu/ppc/olpc/pcinode.fth \ System-specific words for PCI + +" " dup config-string pci-probe-list + +6 buffer: 'system-mac-address +: get-mac-address ( -- ) + " /ethernet" find-package if + " local-mac-address" rot get-package-property 0= if ( a 6 ) + 'system-mac-address swap move exit + then + then + " 123456" 'system-mac-address swap move \ better than nothing? +; +: (system-mac-address) ( -- addr len ) 'system-mac-address 6 ; +' (system-mac-address) is system-mac-address + +: (probe-all) ( -- ) + " probe-" do-drop-in + probe-pci ( probe-pci-e probe-pci-x ) get-mac-address + " probe+" do-drop-in +; +' (probe-all) to probe-all + +[ifdef] notyet +0 0 " ????????" " /" begin-package \ Real-time clock node +fload ${BP}/dev/ds1385r.fth +end-package +stand-init: RTC + " /rtc" open-dev clock-node ! +; + +0 0 " i74" " /pci/isa" begin-package \ NVRAM node +fload ${BP}/dev/ds1385n.fth + +" ds1385-nvram" encode-string +" pnpPNP,8" encode-string encode+ +" compatible" property + +env-end-offset to /nvram +end-package +stand-init: NVRAM + " /nvram" open-dev to nvram-node + init-config-vars +; +[endif] + +\ fload ${BP}/dev/isa/irq.fth + +stand-init: Keyboard overrides + ?bailout +; + +\ fload ${BP}/cpu/ppc/olpc/cpunode.fth \ CPU node additions + +fload ${BP}/cpu/ppc/olpc/probemem.fth \ Memory probing + +fload ${BP}/cpu/ppc/olpc/devalias.fth \ Device aliases + +0 0 " fff00000" " /" begin-package + " flash" device-name + h# 8.0000 constant /device + my-address my-space /device reg + fload ${BP}/cpu/x86/pc/flashpkg.fth +end-package + +devalias rom /flash@fff00000 + +fload ${BP}/cpu/ppc/olpc/flash.fth \ Low-level FLASH access + +fload ${BP}/pkg/flash/saveflsh.fth \ FLASH to disk and back + +\ ' false to interrupt-auto-boot? \ Don't do countdown + +patch noop fw-title rom-cold \ Superseded by banner + +install-rom-cold + +.( --- Saving subset.dic ---) cr p" subset.dic" save-forth + +\ LICENSE_BEGIN +\ Copyright (c) 2007 FirmWorks +\ +\ Permission is hereby granted, free of charge, to any person obtaining +\ a copy of this software and associated documentation files (the +\ "Software"), to deal in the Software without restriction, including +\ without limitation the rights to use, copy, modify, merge, publish, +\ distribute, sublicense, and/or sell copies of the Software, and to +\ permit persons to whom the Software is furnished to do so, subject to +\ the following conditions: +\ +\ The above copyright notice and this permission notice shall be +\ included in all copies or substantial portions of the Software. +\ +\ THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, +\ EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF +\ MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND +\ NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE +\ LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION +\ OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION +\ WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. +\ +\ LICENSE_END Added: cpu/ppc/olpc/fwuboot.bth =================================================================== --- cpu/ppc/olpc/fwuboot.bth (rev 0) +++ cpu/ppc/olpc/fwuboot.bth 2007-07-05 17:19:17 UTC (rev 461) @@ -0,0 +1,71 @@ +purpose: Create a Uboot-format image +\ See license at end of file + +command: &builder &this +in: ${BP}/cpu/ppc/olpc/build/fw.dic +build-now + +create uboot-header + h# 27051956 be-l, + 0 be-l, \ Header CRC, set later + 0 be-l, \ Timestamp + 0 be-l, \ Data size + h# 0f000000 be-l, \ Load address + h# 0f000000 be-l, \ Entry address + 0 be-l, \ Data CRC, set later + 5 c, \ OS type - Linux + 7 c, \ CPU type - PowerPC + 1 c, \ Image type - standalone (kernel is 2) + 0 c, \ Compression type - none + + here h# 20 blank + " Open Firmware" here swap move + h# 20 allot + +here uboot-header - constant /uboot-header + +fload ${BP}/forth/lib/crc32.fth + +reading fw.dic +ifd @ fsize constant /image +/image buffer: filebuf +filebuf /image ifd @ fgets /image <> abort" Can't read image" +ifd @ fclose + +/image uboot-header 3 la+ be-l! + +\ Compute the image CRC and store it in the uboot header +-1 crctab filebuf /image ($crc) invert uboot-header 6 la+ be-l! + +\ Compute the header CRC and store it in the uboot header +-1 crctab uboot-header /uboot-header ($crc) invert uboot-header 1 la+ be-l! + +.( --- Saving as fwuboot.rom) cr +writing fwuboot.rom +uboot-header /uboot-header ofd @ fputs +filebuf /image ofd @ fputs +ofd @ fclose + +\ LICENSE_BEGIN +\ Copyright (c) 2007 FirmWorks +\ +\ Permission is hereby granted, free of charge, to any person obtaining +\ a copy of this software and associated documentation files (the +\ "Software"), to deal in the Software without restriction, including +\ without limitation the rights to use, copy, modify, merge, publish, +\ distribute, sublicense, and/or sell copies of the Software, and to +\ permit persons to whom the Software is furnished to do so, subject to +\ the following conditions: +\ +\ The above copyright notice and this permission notice shall be +\ included in all copies or substantial portions of the Software. +\ +\ THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, +\ EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF +\ MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND +\ NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE +\ LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION +\ OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION +\ WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. +\ +\ LICENSE_END Added: cpu/ppc/olpc/mappci.fth =================================================================== --- cpu/ppc/olpc/mappci.fth (rev 0) +++ cpu/ppc/olpc/mappci.fth 2007-07-05 17:19:17 UTC (rev 461) @@ -0,0 +1,38 @@ +purpose: PCI physical address mapping to root node +\ See license at end of file + +headerless +: map-pci-phys ( paddr io? phys.hi size -- vaddr ) + >r drop ( paddr io? R: size ) + if h# c800.0000 else h# a000.0000 then ( paddr R: size ) + or r> " map-in" $call-parent +; +: >pci-devaddr ( root-devaddr -- pci-devaddr ) + chrp? 0= if h# 8000.0000 + then +; +: pci-devaddr> ( pci-devaddr -- root-devaddr ) ; +headers + +\ LICENSE_BEGIN +\ Copyright (c) 2007 FirmWorks +\ +\ Permission is hereby granted, free of charge, to any person obtaining +\ a copy of this software and associated documentation files (the +\ "Software"), to deal in the Software without restriction, including +\ without limitation the rights to use, copy, modify, merge, publish, +\ distribute, sublicense, and/or sell copies of the Software, and to +\ permit persons to whom the Software is furnished to do so, subject to +\ the following conditions: +\ +\ The above copyright notice and this permission notice shall be +\ included in all copies or substantial portions of the Software. +\ +\ THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, +\ EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF +\ MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND +\ NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE +\ LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION +\ OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION +\ WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. +\ +\ LICENSE_END Added: cpu/ppc/olpc/pciconfig.fth =================================================================== --- cpu/ppc/olpc/pciconfig.fth (rev 0) +++ cpu/ppc/olpc/pciconfig.fth 2007-07-05 17:19:17 UTC (rev 461) @@ -0,0 +1,47 @@ +purpose: PCI configuration space access for Marvell MV64660 +\ See license at end of file + +\ Ostensibly this applies to the PCI bus and thus should be in the PCI node. +\ However, many of the host bridge registers are accessed via this mechanism, +\ so it is convenient to make the configuration access words globally-visible. +\ This mechanism works for several different PCI host bridges. + +headerless + +: config-map ( config-adr -- port ) + dup 3 invert and h# 8000.0000 or h# 3.0c78 mv-l! ( config-adr ) + 3 and h# 3.0c7c or +; + +headers + +: config-l@ ( config-addr -- l ) config-map mv-l@ ; +: config-l! ( l config-addr -- ) config-map mv-l! ; +: config-w@ ( config-addr -- w ) config-map mv-w@ ; +: config-w! ( w config-addr -- ) config-map mv-w! ; +: config-b@ ( config-addr -- c ) config-map mv-b@ ; +: config-b! ( c config-addr -- ) config-map mv-b! ; + +\ LICENSE_BEGIN +\ Copyright (c) 2007 FirmWorks +\ +\ Permission is hereby granted, free of charge, to any person obtaining +\ a copy of this software and associated documentation files (the +\ "Software"), to deal in the Software without restriction, including +\ without limitation the rights to use, copy, modify, merge, publish, +\ distribute, sublicense, and/or sell copies of the Software, and to +\ permit persons to whom the Software is furnished to do so, subject to +\ the following conditions: +\ +\ The above copyright notice and this permission notice shall be +\ included in all copies or substantial portions of the Software. +\ +\ THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, +\ EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF +\ MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND +\ NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE +\ LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION +\ OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION +\ WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. +\ +\ LICENSE_END Added: cpu/ppc/olpc/pcinode.fth =================================================================== --- cpu/ppc/olpc/pcinode.fth (rev 0) +++ cpu/ppc/olpc/pcinode.fth 2007-07-05 17:19:17 UTC (rev 461) @@ -0,0 +1,109 @@ +purpose: System-specific portions of PCI bus package +\ See license at end of file + +dev /pci + +d# 66,666,666 encode-int " clock-frequency" property + +headers + +\ These package methods use the global versions of the configuration +\ access words. This is appropriate only for single-PCI-bus systems. + +: config-l@ ( config-addr -- l ) config-l@ ; +: config-l! ( l config-addr -- ) config-l! ; +: config-w@ ( config-addr -- w ) config-w@ ; +: config-w! ( w config-addr -- ) config-w! ; +: config-b@ ( config-addr -- c ) config-b@ ; +: config-b! ( c config-addr -- ) config-b! ; + +\ ------PCI Address------- ---Host Address-- -- size -- +\ phys.hi .mid .low phys.hi .lo .hi .lo + +.( XXX - ranges properties for PCI node) cr +0 0 encode-bytes +0100.0000 +i 0+i 0+i c800.0000 +i 0+i 0800.0000 +i \ PCI I/O +0200.0000 +i 0+i 0+i a000.0000 +i 0+i 2000.0000 +i \ PCI Mem + " ranges" property + +headers + +: init ( -- ) + \ Could do interrupt routing here +; + +[ifdef] notyet +headerless + +\ Determine the parent interrupt information (the "interrupt line" in PCI +\ parlance) from the child's "interrupt pin" and the child's address, +\ returning "int-line true" if the child's interrupt line register should +\ be set or "false" otherwise. + +\ This table describes the wiring of PCI interrupt pins at the PCI slots +\ to PIRQ inputs on the 82378zb chip. The wiring varies from slot to slot. + +create slot-map + +\ Pin A Pin B Pin C Pin D Dev# + + 2 c, ff c, ff c, ff c, \ c SCSI + ff c, ff c, ff c, ff c, \ d nothing + 0 c, ff c, ff c, ff c, \ e Ethernet + 3 c, ff c, ff c, ff c, \ f Display + 0 c, 1 c, 2 c, 2 c, \ 10 Slot 1 (the riser connects INTC and INTD) + 1 c, 2 c, 2 c, 0 c, \ 11 Slot 2 (the riser connects INTC and INTD) + 2 c, 2 c, 0 c, 1 c, \ 12 Slot 3 (the riser connects INTC and INTD) + +: pin,dev>pirq ( pin# dev# -- true | pirq# false ) + dup c 12 between 0= if 2drop true exit then ( int-pin dev# ) + + c - 4 * + slot-map + c@ ( pirq#|ff ) + dup h# ff = if drop true else false then +; + +headers + +: assign-int-line ( phys.hi.func int-pin -- false | int-line true ) + dup 0= if 2drop false exit then ( phys.hi.func int-pin# ) + 1- swap d# 11 rshift h# 1f and ( int-pin0 dev# ) + + \ Bail out for non-existent device IDs + pin,dev>pirq if false exit then ( pirq# ) + + pirq>irq ( irq# ) + + true +; + +h# 700 encode-int \ Mask of implemented slots +" PCI 1" encode-string encode+ +" PCI 2" encode-string encode+ +" PCI 3" encode-string encode+ " slot-names" property +[then] + +device-end + +\ LICENSE_BEGIN +\ Copyright (c) 2007 FirmWorks +\ +\ Permission is hereby granted, free of charge, to any person obtaining +\ a copy of this software and associated documentation files (the +\ "Software"), to deal in the Software without restriction, including +\ without limitation the rights to use, copy, modify, merge, publish, +\ distribute, sublicense, and/or sell copies of the Software, and to +\ permit persons to whom the Software is furnished to do so, subject to +\ the following conditions: +\ +\ The above copyright notice and this permission notice shall be +\ included in all copies or substantial portions of the Software. +\ +\ THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, +\ EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF +\ MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND +\ NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE +\ LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION +\ OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION +\ WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. +\ +\ LICENSE_END Added: cpu/ppc/olpc/probemem.fth =================================================================== --- cpu/ppc/olpc/probemem.fth (rev 0) +++ cpu/ppc/olpc/probemem.fth 2007-07-05 17:19:17 UTC (rev 461) @@ -0,0 +1,52 @@ +purpose: Memory probing +\ See license at end of file + +" /memory" find-device + +\ This assumes, without checking, that bottom and top are each aligned on +\ a cache block boundary +: scrub&release ( bottom top -- ) + 2dup = if 2drop exit then + over - 2dup berase + release +; + +: probe ( -- ) + 0 memsize reg \ Put all memory in the "reg" property value + + h# 4000 origin pagesize round-down scrub&release + + memtop @ memsize scrub&release +; + +device-end + +also forth definitions +stand-init: Probing memory + " probe" memory-node @ $call-method +; +previous definitions + +\ LICENSE_BEGIN +\ Copyright (c) 2007 FirmWorks +\ +\ Permission is hereby granted, free of charge, to any person obtaining +\ a copy of this software and associated documentation files (the +\ "Software"), to deal in the Software without restriction, including +\ without limitation the rights to use, copy, modify, merge, publish, +\ distribute, sublicense, and/or sell copies of the Software, and to +\ permit persons to whom the Software is furnished to do so, subject to +\ the following conditions: +\ +\ The above copyright notice and this permission notice shall be +\ included in all copies or substantial portions of the Software. +\ +\ THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, +\ EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF +\ MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND +\ NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE +\ LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION +\ OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION +\ WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. +\ +\ LICENSE_END Added: cpu/ppc/olpc/reports.fth =================================================================== --- cpu/ppc/olpc/reports.fth (rev 0) +++ cpu/ppc/olpc/reports.fth 2007-07-05 17:19:17 UTC (rev 461) @@ -0,0 +1,132 @@ +purpose: Simple serial output routines for debugging startup code +\ See license at end of file + +transient +\ Assembler macro to assemble code to set the location "isa-adr" in +\ ISA I/O space to the value "data". Assumes that r1 is already set +\ to the base addess of ISA I/O space. +: isa-c! ( data isa-adr -- ) + swap " set r3,*" evaluate 1 " eieio stb r3,*" evaluate +; + +resident + +h# f101.2000 constant uart-base + +label putbyte ( r3: byte -- ) \ Destroys r0-r1 + uart-base set r1,* + begin lbz r0,h#14(r1) andi. r0,r0,h#20 0<> until + eieio stb r3,h#0(r1) + begin lbz r0,h#14(r1) andi. r0,r0,h#20 0<> until + bclr 20,0 +end-code + +\ destroys: r0-r4 +label putdigit ( r3: nibble -- ) \ print 4-bit value in r3 + mfspr r4,lr + andi. r3,r3,h#0f cmpi 0,0,r3,9 > if addi r3,r3,h#27 then + addi r3,r3,h#30 + putbyte bl * + mtspr lr,r4 + bclr 20,0 +end-code + +transient +: be-report ( char -- ) " set r3,* be-putbyte bl *" evaluate ; +resident + +\ destroys: r0-r6 +label dot ( r3: n -- ) \ print 32-bit value in r3 + mfspr r5,lr + mr r6,r3 + + set r3,h#20 putbyte bl * + + rlwinm r3,r6,04,28,31 putdigit bl * + rlwinm r3,r6,08,28,31 putdigit bl * + rlwinm r3,r6,12,28,31 putdigit bl * + rlwinm r3,r6,16,28,31 putdigit bl * + rlwinm r3,r6,20,28,31 putdigit bl * + rlwinm r3,r6,24,28,31 putdigit bl * + rlwinm r3,r6,28,28,31 putdigit bl * + rlwinm r3,r6,00,28,31 putdigit bl * + + set r3,h#20 putbyte bl * + mtspr lr,r5 + bclr 20,0 +end-code + +\ destroys: r0-r4 +label dcr ( -- ) + mfspr r4,lr + carret set r3,* putbyte bl * + linefeed set r3,* putbyte bl * + mtspr lr,r4 + bclr 20,0 +end-code + +[ifdef] pc@ +stand-init-debug? [if] +: putc ( char -- ) + begin 5 uart@ h# 20 and until + 0 uart! + begin 5 uart@ h# 20 and until +; +: ?putc ( "char" -- ) postpone [char] postpone putc ; immediate +[else] +transient +: ?putc ( "char" -- ) safe-parse-word 2drop ; immediate +resident +[then] +[then] + +[ifdef] notdef +: digits " 0123456789abcdef" drop ; +: xx. 0 d# 28 do dup i >> h# f and digits + c@ emit -4 +loop space drop ; +[then] + +headers +transient +: .r3 ( -- ) " dot bl *" evaluate ; + +[ifdef] stand-init-debug? +: ?report ( char -- ) + stand-init-debug? if + " set r3,* putbyte bl *" evaluate + else + drop + then +; +[else] +: ?report ( char -- ) " set r3,* putbyte bl *" evaluate ; +[then] + +resident + +transient +: spins ( n -- ) " set r0,* mtspr ctr,r0 begin countdown" evaluate ; +resident + +\ LICENSE_BEGIN +\ Copyright (c) 2007 FirmWorks +\ +\ Permission is hereby granted, free of charge, to any person obtaining +\ a copy of this software and associated documentation files (the +\ "Software"), to deal in the Software without restriction, including +\ without limitation the rights to use, copy, modify, merge, publish, +\ distribute, sublicense, and/or sell copies of the Software, and to +\ permit persons to whom the Software is furnished to do so, subject to +\ the following conditions: +\ +\ The above copyright notice and this permission notice shall be +\ included in all copies or substantial portions of the Software. +\ +\ THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, +\ EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF +\ MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND +\ NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE +\ LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION +\ OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION +\ WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. +\ +\ LICENSE_END Added: cpu/ppc/olpc/reset.fth =================================================================== --- cpu/ppc/olpc/reset.fth (rev 0) +++ cpu/ppc/olpc/reset.fth 2007-07-05 17:19:17 UTC (rev 461) @@ -0,0 +1,35 @@ +purpose: Reset system - this version works on many PR*P systems +\ See license at end of file + +headerless +.( XXX: cpu/ppc/olpc/reset.fth - Implement reset-all ) cr +: (reset-all) ( -- ) + icache-off dcache-off + +; +' (reset-all) to reset-all +headers + +\ LICENSE_BEGIN +\ Copyright (c) 2007 FirmWorks +\ +\ Permission is hereby granted, free of charge, to any person obtaining +\ a copy of this software and associated documentation files (the +\ "Software"), to deal in the Software without restriction, including +\ without limitation the rights to use, copy, modify, merge, publish, +\ distribute, sublicense, and/or sell copies of the Software, and to +\ permit persons to whom the Software is furnished to do so, subject to +\ the following conditions: +\ +\ The above copyright notice and this permission notice shall be +\ included in all copies or substantial portions of the Software. +\ +\ THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, +\ EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF +\ MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND +\ NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE +\ LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION +\ OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION +\ WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. +\ +\ LICENSE_END Added: cpu/ppc/olpc/rootnode.fth =================================================================== --- cpu/ppc/olpc/rootnode.fth (rev 0) +++ cpu/ppc/olpc/rootnode.fth 2007-07-05 17:19:17 UTC (rev 461) @@ -0,0 +1,35 @@ +purpose: Properties and Methods for root node +\ See license at end of file + +dev / + +" olpc,School Server 1" " model" string-property + +.( XXX - clock-frequency of root node) cr +d# 666,666,666 " clock-frequency" integer-property \ For root bus + +device-end + +\ LICENSE_BEGIN +\ Copyright (c) 2007 FirmWorks +\ +\ Permission is hereby granted, free of charge, to any person obtaining +\ a copy of this software and associated documentation files (the +\ "Software"), to deal in the Software without restriction, including +\ without limitation the rights to use, copy, modify, merge, publish, +\ distribute, sublicense, and/or sell copies of the Software, and to +\ permit persons to whom the Software is furnished to do so, subject to +\ the following conditions: +\ +\ The above copyright notice and this permission notice shall be +\ included in all copies or substantial portions of the Software. +\ +\ THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, +\ EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF +\ MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND +\ NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE +\ LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION +\ OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION +\ WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. +\ +\ LICENSE_END Added: cpu/ppc/pause.fth =================================================================== --- cpu/ppc/pause.fth (rev 0) +++ cpu/ppc/pause.fth 2007-07-05 17:19:17 UTC (rev 461) @@ -0,0 +1,60 @@ +purpose: Code words for multitasking +\ See license at end of file + +code (pause (s -- ) \ go see if anybody else wants service + stwu tos,-4(sp) + + 'user saved-ip stw ip,* + 'user saved-rp stw rp,* + 'user saved-sp stw sp,* + + 'user link lwz up,* \ get up for new task + add up,up,base \ Relocate it + 'user entry lwz t0,* \ get pc for new task + add t0,t0,base + mtspr lr,t0 + bclr 20,0 +end-code + +label to-next-task (s -- address-of-"next-task"-code ) + 'user link lwz up,* \ get up for new task + add up,up,base \ Relocate it + 'user entry lwz t0,* \ get pc for new task + add t0,t0,base + mtspr lr,t0 + bclr 20,0 +end-code + +\ Called with up set to the user area address of the task to run +label task-resume (s -- ) \ start a task + stwu tos,-4(sp) + 'user saved-ip lwz ip,* + 'user saved-rp lwz rp,* + 'user saved-sp lwz sp,* + lwz tos,0(sp) + addi sp,sp,4 +c; + +\ LICENSE_BEGIN +\ Copyright (c) 2007 FirmWorks +\ +\ Permission is hereby granted, free of charge, to any person obtaining +\ a copy of this software and associated documentation files (the +\ "Software"), to deal in the Software without restriction, including +\ without limitation the rights to use, copy, modify, merge, publish, +\ distribute, sublicense, and/or sell copies of the Software, and to +\ permit persons to whom the Software is furnished to do so, subject to +\ the following conditions: +\ +\ The above copyright notice and this permission notice shall be +\ included in all copies or substantial portions of the Software. +\ +\ THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, +\ EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF +\ MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND +\ NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE +\ LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION +\ OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION +\ WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. +\ +\ LICENSE_END Added: cpu/ppc/ppcboot.fth =================================================================== --- cpu/ppc/ppcboot.fth (rev 0) +++ cpu/ppc/ppcboot.fth 2007-07-05 17:19:17 UTC (rev 461) @@ -0,0 +1,377 @@ +purpose: PowerPC Forth startup code +\ See license at end of file + +hex + +\ Boot code (cold and warm start). The cold start code is executed +\ when Forth is initially started. Its job is to initialize the Forth +\ virtual machine registers. The warm start code is executed when Forth +\ is re-entered, perhaps as a result of an exception. + +hex + +warning @ warning off +: stand-init-io ( -- ) + stand-init-io + +\ inituarts \ Already done in startup code + install-uart-io + + ['] noop to mark-error + ['] noop to show-error + ['] reset-all to bye + ['] crlf-pstr to newline-pstring + ['] no-swap-map to init-swap-map + + real-mode? to use-real-mode? +; +warning ! + +headerless +defer rom-init-io +headers \ Debugging is difficult if rom-init-environment is headerless +defer rom-init-environment +headerless +defer rom-cold-hook + +: rom-cold (s -- ) + hex +\ ?putc $ + rom-init-io \ Memory allocator and character I/O +\ ?putc # + do-init \ Kernel +\ ?putc % + stand-init-debug? if + cr ." Type 'i' to interrupt stand-init sequence" cr + d# 200 ms + key? if key drop ." Interacting" cr interact then + then + ['] rom-init-environment guarded \ Environmental dependencies + ['] rom-cold-hook guarded \ Open Firmware final startup + + fw-title + quit +; + +[ifndef] ,64bit? +: ,64bit? ( -- ) + " mfspr r0,pvr rlwinm r0,r0,16,16,31 cmpi 0,0,r0,20 =" evaluate +; +[then] + +label synchronize-caches ( scratch: r0 r3 r4 ) + + \ Flush Dcache if it's on + + mfspr r3,hid0 + andi. r3,r3,h#4000 + 0<> if + ,64bit? if + h# 10000 64 / set r4,* \ #cache-lines + mtspr ctr,r4 + set r4,64 \ /cache-line + else + h# 10000 32 / set r4,* \ #cache-lines + mtspr ctr,r4 + set r4,32 \ /cache-line + then + + neg r3,r4 \ Begin at 0 - /cache-line + + begin + lbzux r0,r3,r4 \ Touch each cache block + countdown \ from [0 to 64K) (0x800 * 0x20) + + neg r4,r4 \ Prepare to count down + begin + dcbf r0,r3 \ Flush each block + add. r3,r3,r4 \ on the way back down to 0 + 0<> until + then + + \ Invalidate Icache if it's on + + mfspr r3,hid0 + andi. r3,r3,h#8000 + 0<> if + mfspr r3,hid0 + ori r0,r3,h#800 + sync isync + mtspr hid0,r0 \ Set the invalidate bit + sync isync + mtspr hid0,r3 \ Clear the invalidate bit for 603 + sync isync + then + + bclr 20,0 +end-code + +[ifndef] nv-adr-low +h# 74 constant nv-adr-low +h# 75 constant nv-adr-high +h# 77 constant nv-data +[then] + +create force-big-endian +\ \needs read-le-flag fload ${BP}/arch/prep/leflag.fth + +label memcpy ( r3: dst r4: src r5: n -- r3: dst ) + mtspr ctr,r5 + mr r6,r3 + + addi r3,r3,-1 \ Account for pre-decrement + addi r4,r4,-1 \ Account for pre-decrement + begin + lbzu r5,1(r4) + stbu r5,1(r3) + countdown + + mr r3,r6 \ Return dst + bclr 20,0 +end-code + +[ifdef] switcheroo +label ?switch-endian + mfspr r30,lr + + switcheroo origin - set r4,* + add r4,r4,base \ Absolute address of switcheroo code + set r3,h#1000 \ Temporary RAM location for switcheroo code + /switcheroo set r5,* + memcpy bl * + + bla h#1000 \ Execute the RAM copy of switcheroo + + nop nop nop nop \ Endian-independent landing pad + + mtspr lr,r30 + bclr 20,0 +end-code +[else] + +label move-user-area +\ move-user-area copies the initial user area image to its final RAM location + +\ In: r13: header-adr r14: little-endian? r15: allocation pointer +\ Destroys: r20-r24 +\ Out: up: final user area address r15: updated allocation pointer + +\ Find the user area size from the header + lwz r21,4(r13) \ Text size = offset to start of data + lwz r20,8(r13) \ Data size = user area size in r20 + +\ Allocate high memory for the stacks and stuff, starting at memtop and +\ allocating downwards. r15 is the allocation pointer. + +\ Allocate the RAM copy of the User Area + subf r15,r20,r15 + rlwinm r15,r15,0,0,28 \ doubleword-align by clearing 3 low bits + mr up,r15 \ Set user pointer + + \ Copy the initial User Area image to the RAM copy + add r23,r21,base \ Init-up pointer in r23 + mr r22,up \ Destination pointer + + srawi r20,r20,2 + mtspr ctr,r20 + addi r23,r23,-4 \ Account for pre-incrementing + addi r22,r22,-4 \ Account for pre-incrementing + begin \ Copy without byte swapping + lwzu r20,4(r23) + stwu r20,4(r22) + countdown + + bclr 20,0 + nop + +end-code +[then] + +create uboot-entry +label rom-cold-code ( r3:fw-RAM-base r4:fw-RAM-size -- ) + +[ifdef] uboot-entry + set r13,h#0f000000 \ Firmware memory base address in r13 + set r11,h#00200000 \ Firmware memory size in r11 +[else] + mr r13,r3 \ Firmware memory base address in r13 + mr r11,r4 \ Firmware memory size in r11 +[then] + + lwz r12,0(r0) \ Get memsize from low memory + + add r15,r13,r11 \ r15 is the allocation pointer + +carret ?report +linefeed ?report +ascii A ?report + +[ifdef] force-big-endian + set r14,0 +[else] + read-le-flag bl * + mr r14,r3 +[then] + + \ Allocate HTAB + ,64bit? if \ 64-bit CPUs + set r22,h#40000 \ /htab-64 + else \ 32-bit CPUs + set r22,h#10000 \ /htab-32 + then + rlwinm r2,base,0,0,19 \ Round base down to page boundary + + subf r15,r22,r15 + mr r6,r15 + +ascii B ?report +\ Find the base address + here 4 + bl * \ Absolute address of next instruction + here origin - set base,* \ Relative address of this instruction + mfspr r0,lr + subf base,base,r0 \ Base address of Forth kernel + +[ifdef] ?switch-endian + ?switch-endian bl * + +" ppcboot.fth: Do we need to sync caches after endian switch?" ?reminder +\ set r3,h#1f0.0000 set r4,h#10.0000 sync-cache bl * +\ mr r3,up user-size set r4,* sync-cache bl * +[else] +\ mr r3,r13 .r3 +\ lwz r3,4(r13) .r3 + lwz r3,8(r13) .r3 + + move-user-area bl * +[then] + +ascii Q ?report +[ifdef] ?enter-virtual-mode + mr r3,r13 \ Firmware memory base address + mr r4,r11 \ Firmware memory size + + ?enter-virtual-mode bl * \ Returns virt minus phys offset + mr r16,r3 +[else] + set r16,0 \ Set virtual-physical offset to 0 +[then] + +ascii R ?report + add r15,r15,r16 \ Convert allocation pointer to virtual + add up,up,r16 \ Convert user pointer to virtual + + \ This must be done after we switch modes because longwords may be + \ exchanged in the RAM copy of the user area prior to the mode switch. + 'user in-little-endian? stw r14,* \ Assert mode for Forth code + 'user virt-phys stw r16,* \ Assert mode for Forth code + + 'user htab-phys stw r6,* \ Allocated address of hash table + add r2,r2,r16 \ Convert htab address to virtual + 'user htab stw r6,* \ Allocated address of hash table + +ascii J ?report + +\ Find the base address + here 4 + bl * \ Absolute address of next instruction + here origin - set base,* \ Relative address of this instruction + mfspr r22,lr + subf base,base,r22 \ Base address of Forth kernel + +\ Now the user area has been copied to the proper place, so we can set +\ some important user variables whose inital values are determined at +\ run time. + + 'body main-task set r22,* \ Allow the exception handler to find the + \ user area by storing the address of the + stwx up,base,r22 \ main user area in the "constant" main-task + + set r0,-1 + 'user powerpc? stw r0,* + +\ Top of memory and dictionary limit + add r0,r11,r13 \ Compute memtop + 'user memtop stw r0,* + 'user memsize stw r12,* + +\ Set the up0 user variable + 'user up0 stw up,* + +\ Establish the return stack and set the rp0 user variable + mr rp,r15 \ Set rp + 'user rp0 stw rp,* + rs-size negate addi r15,r15,* \ allocate space for the return stack + +ascii K ?report +\ Establish the Parameter Stack + 'user sp0 stw r15,* + addi sp,r15,4 \ account for the top of stack register + + ps-size negate addi r15,r15,* \ Allocate the stuff on the stack + + initial-heap-size set r22,* \ Reserve some space for the heap + subf r15,r22,r15 + 'user limit stw r15,* \ Top of dictionary growth area + +\ Set the dictionary pointer + add r21,r21,base \ Base + text size + 'user dp stw r21,* \ Set dp + +ascii L ?report +\ Save the address of the system call table in the user variable syscall-vec + set r0,0 + 'user syscall-vec stw r0,* + +\ Set the value of #args and args + 'user #args stw r0,* + 'user args stw r0,* + + synchronize-caches bl * + +ascii M ?report +\ Set the next pointer + mtspr ctr,up + +ascii N ?report +\ Enter Forth + 'body rom-cold 4 - set ip,* + add ip,ip,base +\ ctr:np w:r25, base:r26, up:r27, tos:r28, ip:r29, rp:r30, sp: r31 +h# 20 ?report +mfspr r3,ctr .r3 mr r3,base .r3 mr r3,up .r3 mr r3,ip .r3 mr r3,rp .r3 mr r3,sp .r3 +lwz r3,0(ip) .r3 +carret ?report +c; + +: install-rom-cold ( -- ) + " stand-init-io" $find-name is rom-init-io + " stand-init" $find-name is rom-init-environment + " startup" $find-name is rom-cold-hook + + rom-cold-code origin put-branch +; + +headers + +\ LICENSE_BEGIN +\ Copyright (c) 2007 FirmWorks +\ +\ Permission is hereby granted, free of charge, to any person obtaining +\ a copy of this software and associated documentation files (the +\ "Software"), to deal in the Software without restriction, including +\ without limitation the rights to use, copy, modify, merge, publish, +\ distribute, sublicense, and/or sell copies of the Software, and to +\ permit persons to whom the Software is furnished to do so, subject to +\ the following conditions: +\ +\ The above copyright notice and this permission notice shall be +\ included in all copies or substantial portions of the Software. +\ +\ THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, +\ EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF +\ MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND +\ NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE +\ LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION +\ OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION +\ WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. +\ +\ LICENSE_END Added: cpu/ppc/ppcsim/ppcsim.c =================================================================== --- cpu/ppc/ppcsim/ppcsim.c (rev 0) +++ cpu/ppc/ppcsim/ppcsim.c 2007-07-05 17:19:17 UTC (rev 461) @@ -0,0 +1,2092 @@ +// See license at end of file +/* + * PowerPC instruction set simulator for Forth + */ + +#include <stdio.h> + +#define BI_ENDIAN + +extern long s_bye(); +extern long c_key(); + +typedef unsigned char u_char; +typedef unsigned short u_short; +typedef unsigned int u_int; +typedef unsigned long u_long; + +#define MAXMEM 0x80000 + +union { + u_long all; + struct { + u_long SO :1; + u_long OV :1; + u_long CA :1; + u_long res:13; + } bits; +} XER; + +union { + u_long all; + struct { + u_long LTGTEQ :3; + u_long SO :1; + u_long res:12; + } bits; +} CR; + + +#define ILLEGAL goto illegal + +#ifdef TRACE +#define INSTR(a) trace(a, instruction, pc) +#else +#define INSTR(a) +#endif + +#define CMP(a,b) ((a < b) ? 4 : ((a > b) ? 2 : 1 )) + +#define DO_UPDATE_SO CR.bits.SO = XER.bits.SO +#define DO_UPDATE_SO_CRFD(crfd) { \ + CR.all &= ~(1 << ((7-crfd)<<2)); \ + CR.all |= (XER.bits.SO << ((7-crfd)<<2));\ + } + +#define DO_UPDATE_OV(dest,src1,src2) \ + if (OE) { \ + XER.bits.SO |= \ + (XER.bits.OV = \ + ((((long)(dest))^((long)(src1))) < 0) && \ + ((((long)(src1))^((long)(src2))) >= 0)); \ + } + +#ifdef OVERFLOWS +#define UPDATE_SO DO_UPDATE_SO +#define UPDATE_SO_CRFD(crfd) DO_UPDATE_SO_CRFD(crfd) +#define UPDATE_OV(a,b,c) DO_UPDATE_OV(a,b,c) +#else +#define UPDATE_SO +#define UPDATE_SO_CRFD(a) +#define UPDATE_OV(a,b,c) +#endif + +#define UPDATE_CA(res,op) XER.bits.CA = ((u_long)res < (u_long)op) + +#define DO_UPDATE_CRFD(dest,src,crfd) \ + { \ + CR.all &= ~(0xe << ((7-crfd)<<2)); \ + CR.all |= (CMP(dest, src) << (((7-crfd)<<2)+1)); \ + UPDATE_SO_CRFD(crfd); \ + } + +#ifdef notdef +#define DO_UPDATE_CR(dest,src) \ + { \ + CR.bits.LTGTEQ = CMP(dest, src); \ + UPDATE_SO; \ + } +#else +#define DO_UPDATE_CR(dest,src) DO_UPDATE_CRFD(dest,src,0) +#endif + +#define UPDATE_CR(dest) \ + if (RC) { \ + DO_UPDATE_CR((long)dest, 0); \ + } + +/* Add/subtract with carry */ +#define ADDC(b,a) \ + temp = (b)+(a); \ + UPDATE_OV(temp,(b),(a)); \ + UPDATE_CA((temp),(a)); \ + UPDATE_CR(temp); \ + RD = temp; + +#define SUBC(b,a) \ + temp = (b)-(a); \ + UPDATE_OV(temp,(b),(a)); \ + XER.bits.CA = (b) >= (a); \ + UPDATE_CR(temp); \ + RD = temp; + +/* Add/subtract without carry */ +#define ADD(b,a) \ + temp = (b)+(a); \ + UPDATE_OV(temp,(b), (a)); \ + UPDATE_CR(temp); \ + RD = temp; \ + break; + +/* logical operations - and, or, shifts, etc */ +#define LOGIC(expr) \ + RA = expr; \ + UPDATE_CR(RA); \ + break; + +/* Condition/counter evaluation for bcXXX */ +#define CONDITION \ + /* \ + * If (BO&0x10), don't test condition. \ + * Otherwise the CR[BI] and the 0x8 bit of BO must be the same. \ + */ \ + cond_ok = ((BO & 0x10) \ + || ((long)((CR.all << BI) ^ (BO << 28)) >= 0)); \ + if ((BO & 4) == 0) { /* Update and test counter */ \ + CTR -= 1; \ + cond_ok &= ((CTR != 0) ^ ((BO >> 1) & 1)); \ + } \ + if (LK) \ + LR = CIA+4; + + +#define UFIELD(lbit,nbits) ((instruction << lbit) >> (32 - nbits)) +#define SFIELD(lbit,nbits) ((long)(instruction << lbit) >> (32 - nbits)) + +#define OPCD (instruction >> 26) +#define OP2 UFIELD(21,10) + +/* These bits are never used as indices; only as flags */ +#define LK (instruction & 1) +#define RC (instruction & 1) +#define AA (instruction & 2) +#define SHD (instruction & 2) + +#define LI SFIELD( 6,24) + +#define RD reg[UFIELD( 6, 5)] +#define RS reg[UFIELD( 6, 5)] +#define FRD reg[UFIELD( 6, 5)] +#define FRS reg[UFIELD( 6, 5)] +#define BO UFIELD( 6, 5) +#define CRBD UFIELD( 6, 5) + +#define RA reg[UFIELD(11, 5)] +#define FRA reg[UFIELD(11, 5)] +#define BI UFIELD(11, 5) +#define CRBA UFIELD(11, 5) +#define TO UFIELD(11, 5) +#define RA0 (UFIELD(11, 5) ? RA : 0) + +#define RB reg[UFIELD(16, 5)] +#define FRB reg[UFIELD(16, 5)] +#define CRBB UFIELD(16, 5) +#define NB UFIELD(16, 5) +#define SH UFIELD(16, 5) + +#define FRC reg[UFIELD(21, 5)] +#define MB UFIELD(21, 5) + +#define ME UFIELD(26, 5) + +#define BD SFIELD(16,14) +#define DS SFIELD(16,14) + +#define D SFIELD(16,16) +#define SIMM SFIELD(16,16) +#define UIMM UFIELD(16,16) + +#define CRFD UFIELD( 6, 3) +#define FM UFIELD( 7, 8) +#define L UFIELD(10, 1) +#define CRFS UFIELD(11, 3) +#define SPR (UFIELD(11,5) | (UFIELD(16,5) << 5)) +#define TBR UFIELD(11,10) +#define CRM UFIELD(12, 8) +#define SR seg[UFIELD(12, 4)] +#define IMM UFIELD(16, 4) +#define XO UFIELD(21,10) +#define OE UFIELD(21, 1) + +#define MASK ((MB <= ME) ? (u_long)(-1L << (31-ME+MB)) >> MB \ + : (u_long)(-1L << (31-ME)) | ((u_long)-1L >> MB)) + +#define ROTATE(val, cnt) (((val) >> (32-(cnt))) | ((val) << (cnt))) + +u_long TBAR; + +#ifdef MMU + +/* + * This is not an accurate simulation of the PowerPC MMU behavior + * a) BATs aren't implemented. + * b) the simulated TLB is much much larger than a real one + * c) segment register values are limited to the range 0..f + */ +u_long mmutab[0x100000]; +void +init_tlb() +{ + int i; + for (i = 0; i < 0x100000; i++) + mmutab[i] = 0xffffffff; +} +u_long +tlb_miss(vaddr) + register u_long vaddr; +{ + /* References: 603 manual, sections 7.6.1.4 and 7.6.3.1 */ + register u_long temp, vsid, mask; + vsid = seg[vaddr >> 28]; + temp = ((vaddr >> 12) & 0xffff) | vsid; + mask = ((((SDR1 & 0x1ff) << 10) | 0x3ff) << 6; + DMISS = IMISS = vaddr; + HASH1 = (SDR1 & 0xffff0000) | ((temp << 6) & mask); + HASH2 = HASH1 ^ mask; + DCMP = ICMP = 0x80000000 | (vsid << 7) | ((vaddr >> 22) & 0x3f); +} +tlbie(vaddr) + register u_long vaddr; +{ + mmutab[vaddr >> 12] = 0xffffffff; +} +u_long +MAP(vaddr) + register u_long vaddr; +{ + register u_long phys; + register u_long pageno; + pageno = (seg[vaddr >> 28] << 16) | ((vaddr >> 12) & 0xffff); + + if ((phys = mmutab[pageno]) == 0xffffffff) + mmutab[pageno] = phys = tlb_miss(vaddr); + return (phys | (vaddr & 0xfff)); +} +#else +#ifdef SIMNT +/* + * Most PPC kernel stuff wants to run in what used to be kseg0 (long + * long ago in a galaxy far far away). This little deal maps virtual + * to physical. + */ +u_long +MAP(vaddr) + u_long vaddr; +{ + if (vaddr > 0x80000000 && vaddr < 0xf0000000) + vaddr &= ~0x80000000; + return(vaddr < 0x10000 ? vaddr + 0x50000 : vaddr); +} +#else +#ifdef TRACE +#ifndef SIMROM +/* This can't be a macro because of side effects of operand evaluation */ +u_long +MAP(vaddr) + register u_long vaddr; +{ + return ((vaddr < 0x1000) ? (vaddr + TBAR) : vaddr); +} +#else +#define MAP(vaddr) (vaddr) +#endif +#else +#define MAP(vaddr) (vaddr) +#endif +#endif +#endif + +#ifdef NOTDEF +#define CIA ((u_char *)MAP(pc) - mem) +#else +#define CIA ((u_long)MAP(pc)) +#endif +#define UNIMP(str) { opname = str; goto unimplemented; } +#define POWER(str) { opname = str; goto power; } + +#ifdef BI_ENDIAN +#define MEM(type, size, adr) *(type *)(&mem[MAP((adr) ^ size)]) +#else +#define MEM(type, size, adr) *(type *)(&mem[MAP(adr)]) +#endif + +u_long greg[32]; +u_long seg[16]; + +#ifdef TRACE +u_long instruction; +u_long pc; +u_long CTR; +u_long LR; +#endif + +u_long IABR; +u_long HID0; +u_long DEC, SRR0, SRR1, SPRG0, SPRG1, SPRG2, SPRG3, MSR; + +u_char *xmem; + +void +simulate(mem, start, arg0, arg1, arg2, arg3, arg4, arg5) + register u_char *mem; + u_long start; + u_long arg0, arg1, arg2, arg3, arg4, arg5; +{ + register u_long *reg = &greg[0]; +#ifndef TRACE + register u_long instruction; + register u_long pc; + register u_long CTR; + register u_long LR; +#endif +#ifdef BI_ENDIAN + register u_long BYTE = 0; /* 7 for little-endian */ + register u_long WORD = 0; /* 6 for little-endian */ + register u_long LONG = 0; /* 4 for little-endian */ +#endif + + + register int cond_ok; + register u_long temp; + u_long scratch; + char *msg; + char *opname; + + xmem = mem; + + reg[3] = arg0; + + /* + * Pass 0 as the system call vector to let the kernel know it's + * running on the simulator. + */ + reg[4] = 0; /* Was reg[4] = arg1; */ + reg[5] = arg2; + reg[6] = arg3; + reg[7] = arg4; + reg[8] = arg5; + +#ifdef TRACE + catch_signals(); +#endif + + for (pc = start; ; pc += 4) { + +#ifdef TRACE + if (DEC-- == 0 && (MSR & 0x8000) && TBAR) { + SRR0 = CIA; + SRR1 = MSR; + pc = TBAR + 0x900 - 4; + continue; + } +#endif + + instruction = MEM(u_long , LONG, pc); + +switch(OPCD) { + +case 0: ILLEGAL; +case 1: ILLEGAL; +case 2: ILLEGAL; +case 3: /* UNIMP("twi"); */ +/* Hack to speed-up Forth dictionary searches */ + RA = (u_long) xfindnext((u_char *)reg[3], (long)reg[4], (long)reg[5], + (u_long)reg[6], (u_long *)reg[7]); + break; +case 4: ILLEGAL; +case 5: ILLEGAL; +case 6: ILLEGAL; +case 7: INSTR("mulli"); RD = RA * SIMM; break; + +case 8: INSTR("subfic"); + RD = SIMM - RA; + UPDATE_CA(RD,SIMM); + break; + +case 9: POWER("dozi"); + +case 10: INSTR("cmpli"); +/*DEBUG*/ if (L) UNIMP("cmpli - 64-bit"); + if (CRFD) + DO_UPDATE_CRFD(RA, UIMM, CRFD) + else + DO_UPDATE_CR(RA, UIMM) + break; + +case 11: INSTR("cmpi"); +/*DEBUG*/ if (L) UNIMP("cmpi - 64-bit"); + if (CRFD) + DO_UPDATE_CRFD((long)RA, SIMM, CRFD) + else + DO_UPDATE_CR((long)RA, SIMM) + break; + +case 12: INSTR("addic"); + RD = RA + SIMM; + UPDATE_CA(RD,SIMM); + break; + +case 13: INSTR("addic."); + RD = RA + SIMM; + UPDATE_CA(RD,SIMM); + DO_UPDATE_CR((long)RD, 0); + break; + +case 14: INSTR("addi"); RD = RA0 + SIMM; break; +case 15: INSTR("addis"); RD = RA0 + (SIMM << 16); break; + +case 16: INSTR("bcX"); + CONDITION + if ( cond_ok ) + pc = (BD << 2) + (AA ? 0 : CIA) - 4; + break; + +case 17: UNIMP("sc"); + +case 18: INSTR("bX"); + if (LK) + LR = CIA+4; + pc = (LI << 2) + (AA ? 0 : CIA) - 4; + break; + +case 19: + switch(OP2) { + case 16: INSTR("bclr"); + CONDITION +/* XXX Possible problem with updating the link register before using it */ + if ( cond_ok ) + pc = LR - 4; + break; + case 50: INSTR("rfi"); + MSR = SRR1; + pc = SRR0 - 4; + break; + case 150: INSTR("isync"); break; + case 528: INSTR("bcctr"); +#ifdef SIMNEXT +#define W reg[25] +#define BASE reg[26] +#define UP reg[27] +#define IP reg[29] +#define RP reg[30] +#define DOCOLON 0x10 +#define UNNEST 0x848 + if (instruction == 0x4e800420 && CTR == UP +/* + * If the first instruction of next is a branch, the Forth source + * debugger is active, in which case we don't want to do the fast + * next simulation. + */ + && (MEM(u_long, LONG, CTR) >> 26) != 18) { + + next: + + /* Recognize unnest from the unrelocated token value */ + IP += sizeof(u_long); + while ((temp = *(u_long *)IP) == UNNEST) { + IP += sizeof(u_long); + IP = *(u_long *)RP; + RP += sizeof(u_long); + } + + /* Recognize docolon from the unrelocated code field */ + if ((temp = *(u_long *)(W = temp + BASE)) == DOCOLON) { + RP -= sizeof(u_long); + *(u_long *)RP = IP; + IP = W; + goto next; + } + + /* -4 is an artifact of the simulator implementation */ + pc = temp + BASE - 4; + break; + } +#endif + CONDITION + if ( cond_ok ) + pc = CTR - 4; + break; + default: UNIMP("CR logical ops"); + } + break; +case 20: INSTR("rlwimi"); RA = (RA & ~MASK) | (ROTATE(RS,SH) & MASK); + UPDATE_CR(RA); break; +case 21: INSTR("rlwinm"); RA = ROTATE(RS,SH) & MASK; UPDATE_CR(RA); break; +case 22: POWER("rlmi"); +case 23: INSTR("rlwnm"); RA = ROTATE(RS,RB) & MASK; UPDATE_CR(RA); break; +case 24: INSTR("ori"); RA = RS | UIMM; break; +case 25: INSTR("oris"); RA = RS | (UIMM << 16); break; +case 26: INSTR("xori"); RA = RS ^ UIMM; break; +case 27: INSTR("xoris"); RA = RS ^ (UIMM << 16); break; +case 28: INSTR("andi."); RA = RS & UIMM; + DO_UPDATE_CR((long)RA, 0); break; +case 29: INSTR("andis."); RA = RS & (UIMM << 16); + DO_UPDATE_CR((long)RA, 0); break; +case 30: ILLEGAL; +/* case 31 is at the end */ +case 32: INSTR("lwz"); RD = MEM(u_long , LONG, RA0+ D ); break; +case 33: INSTR("lwzu"); RD = MEM(u_long , LONG, RA = (RA + D)); break; +case 34: INSTR("lbz"); RD = MEM(u_char , BYTE, RA0+ D ); break; +case 35: INSTR("lbzu"); RD = MEM(u_char , BYTE, RA = (RA + D)); break; +case 36: INSTR("stw"); MEM(u_long , LONG, RA0+ D ) = RS; break; +case 37: INSTR("stwu"); MEM(u_long , LONG, RA = (RA + D)) = RS; break; +case 38: INSTR("stb"); MEM(u_char , BYTE, RA0+ D ) = RS; break; +case 39: INSTR("stbu"); MEM(u_char , BYTE, RA = (RA + D)) = RS; break; +case 40: INSTR("lhz"); RD = MEM(u_short, WORD, RA0+ D ); break; +case 41: INSTR("lhzu"); RD = MEM(u_short, WORD, RA = (RA + D)); break; +case 42: INSTR("lha"); RD = MEM( short, WORD, RA0+ D ); break; +case 43: INSTR("lhau"); RD = MEM( short, WORD, RA = (RA + D)); break; +case 44: INSTR("sth"); MEM(u_short, WORD, RA0+ D ) = RS; break; +case 45: INSTR("sthu"); MEM(u_short, WORD, RA = (RA + D)) = RS; break; +case 46: INSTR("lmw"); { + u_long *src, *dst; +#ifdef BI_ENDIAN + if (LONG) + goto illegal; + /* Should be an alignment exception */ +#endif + dst = &(RD); + src = (u_long *)(&mem[MAP(RA0+D)]); + while (dst < &reg[32]) + *dst++ = *src++; + } + break; +case 47: INSTR("stmw"); { + u_long *src, *dst; +#ifdef BI_ENDIAN + if (LONG) + goto illegal; + /* Should be an alignment exception */ +#endif + dst = (u_long *)(&mem[MAP(RA0+D)]); + src = &(RS); + while (src < &reg[32]) + *dst++ = *src++; + } + break; +case 48: UNIMP("lfs"); +case 49: UNIMP("lfsu"); +case 50: UNIMP("lfd"); +case 51: UNIMP("lfdu"); +case 52: UNIMP("stfs"); +case 53: UNIMP("stfsu"); +case 54: UNIMP("stfd"); +case 55: UNIMP("stfdu"); +case 56: ILLEGAL; +case 57: ILLEGAL; +case 58: ILLEGAL; +case 59: UNIMP("Single Floating Point"); +case 60: ILLEGAL; +case 61: ILLEGAL; +case 62: ILLEGAL; +case 63: UNIMP("Double Floating Point"); +case 31: + +switch(OP2) { +case 0: INSTR("cmp"); +/*DEBUG*/ if (L) UNIMP("cmp - 64-bit"); + if (CRFD) + DO_UPDATE_CRFD((long)RA, (long)RB, CRFD) + else + DO_UPDATE_CR((long)RA, (long)RB) + + break; +case 1: ILLEGAL; +case 2: ILLEGAL; +case 3: ILLEGAL; +case 4: +#ifdef notdef + UNIMP("tw"); +#else + /* tw */ + /* Handle Forth wrapper calls - the call# is in RA */ + reg[3] = (*(long (*) ())(*(long *)(arg1 + RA))) + (reg[3],reg[4],reg[5],reg[6],reg[7], reg[8]); + break; +#endif +case 5: ILLEGAL; +case 6: ILLEGAL; +case 7: ILLEGAL; +case 8: INSTR("subfc"); SUBC(RB,RA); break; +case 9: ILLEGAL; +case 10: INSTR("addc"); ADDC(RB,RA); break; +case 11: INSTR("mulhwu"); + umtimes((u_long *)&RD, (u_long *)&scratch, RA, RB); UPDATE_CR(RD); break; +case 12: ILLEGAL; +case 13: ILLEGAL; +case 14: ILLEGAL; +case 15: ILLEGAL; +case 16: ILLEGAL; +case 17: ILLEGAL; +case 18: ILLEGAL; +case 19: INSTR("mfcr"); RD = CR.all; break; +case 20: UNIMP("lwarx"); +case 21: ILLEGAL; +case 22: ILLEGAL; +case 23: INSTR("lwzx"); RD = MEM(u_long , LONG, RA0 + RB); break; +case 24: INSTR("slw"); LOGIC( (RB & 0x20 ? 0 : RS << (RB & 0x1f)) ); break; +case 25: ILLEGAL; +case 26: INSTR("cntlzw"); + temp = RS; + for(scratch = 0; + scratch < 32 && ((temp & 0x80000000) == 0); + scratch++) { + temp <<= 1; + } + UPDATE_CR(scratch); + RA = scratch; + break; +case 27: ILLEGAL; +case 28: INSTR("and"); LOGIC( RS & RB ); +case 29: POWER("maskg"); +case 30: ILLEGAL; +case 31: ILLEGAL; +case 32: INSTR("cmpl"); +/*DEBUG*/ if (L) UNIMP("cmpl - 64-bit"); + if (CRFD) + DO_UPDATE_CRFD(RA, RB, CRFD) + else + DO_UPDATE_CR(RA, RB) + break; +case 33: ILLEGAL; +case 34: ILLEGAL; +case 35: ILLEGAL; +case 36: ILLEGAL; +case 37: ILLEGAL; +case 38: ILLEGAL; +case 39: ILLEGAL; +case 40: INSTR("subf"); ADD(RB,-RA); +case 41: ILLEGAL; +case 42: ILLEGAL; +case 43: ILLEGAL; +case 44: ILLEGAL; +case 45: ILLEGAL; +case 46: ILLEGAL; +case 47: ILLEGAL; +case 48: ILLEGAL; +case 49: ILLEGAL; +case 50: ILLEGAL; +case 51: ILLEGAL; +case 52: ILLEGAL; +case 53: ILLEGAL; +case 54: INSTR("dcbst"); break; +case 55: INSTR("lwzux"); RD = MEM(u_long , LONG, RA = (RA + RB)); break; +case 56: ILLEGAL; +case 57: ILLEGAL; +case 58: ILLEGAL; +case 59: ILLEGAL; +case 60: INSTR("andc"); LOGIC( RS & ~RB ); +case 61: ILLEGAL; +case 62: ILLEGAL; +case 63: ILLEGAL; +case 64: ILLEGAL; +case 65: ILLEGAL; +case 66: ILLEGAL; +case 67: ILLEGAL; +case 68: ILLEGAL; +case 69: ILLEGAL; +case 70: ILLEGAL; +case 71: ILLEGAL; +case 72: ILLEGAL; +case 73: ILLEGAL; +case 74: ILLEGAL; +case 75: INSTR("mulhw"); + { + int negative = ((long)(RA ^ RB)) < 0; + long highres; + long op1 = ((long)RA < 0) ? -(long)RA : RA; + long op2 = ((long)RB < 0) ? -(long)RB : RB; + umtimes((u_long *)&highres, (u_long *)&scratch, op1, op2); + RD = negative ? (~highres) + (scratch==0) : highres; + UPDATE_CR(RD); + break; + } + +case 76: ILLEGAL; +case 77: ILLEGAL; +case 78: ILLEGAL; +case 79: ILLEGAL; +case 80: ILLEGAL; +case 81: ILLEGAL; +case 82: ILLEGAL; +case 83: INSTR("mfmsr"); RD = MSR; break; +case 84: ILLEGAL; +case 85: ILLEGAL; +case 86: INSTR("dcbf"); break; +case 87: INSTR("lbzx"); RD = MEM(u_char , BYTE, RA0 + RB); break; +case 88: ILLEGAL; +case 89: ILLEGAL; +case 90: ILLEGAL; +case 91: ILLEGAL; +case 92: ILLEGAL; +case 93: ILLEGAL; +case 94: ILLEGAL; +case 95: ILLEGAL; +case 96: ILLEGAL; +case 97: ILLEGAL; +case 98: ILLEGAL; +case 99: ILLEGAL; +case 100: ILLEGAL; +case 101: ILLEGAL; +case 102: ILLEGAL; +case 103: ILLEGAL; +case 104: INSTR("neg"); ADD(0,-RA); +case 105: ILLEGAL; +case 106: ILLEGAL; +case 107: POWER("mul"); +case 108: ILLEGAL; +case 109: ILLEGAL; +case 110: ILLEGAL; +case 111: ILLEGAL; +case 112: ILLEGAL; +case 113: ILLEGAL; +case 114: ILLEGAL; +case 115: ILLEGAL; +case 116: ILLEGAL; +case 117: ILLEGAL; +case 118: ILLEGAL; +case 119: INSTR("lbzux"); RD = MEM(u_char , BYTE, RA = (RA + RB)); break; +case 120: ILLEGAL; +case 121: ILLEGAL; +case 122: ILLEGAL; +case 123: ILLEGAL; +case 124: INSTR("nor"); LOGIC( ~(RS | RB) ); +case 125: ILLEGAL; +case 126: ILLEGAL; +case 127: ILLEGAL; +case 128: ILLEGAL; +case 129: ILLEGAL; +case 130: ILLEGAL; +case 131: ILLEGAL; +case 132: ILLEGAL; +case 133: ILLEGAL; +case 134: ILLEGAL; +case 135: ILLEGAL; +case 136: INSTR("subfe"); + if (XER.bits.CA) { + SUBC(RB,RA); + } else { + ADDC(RB,~RA); + } + break; +case 137: ILLEGAL; +case 138: INSTR("adde"); +/* printf("adde: XER.bits.CA=%d RB %x -~RA %x\n", XER.bits.CA, RB, -(~RA)); */ + if (XER.bits.CA) { + ADDC(RB,-(~RA)); + } else { + ADDC(RB,RA); + } + break; +case 139: ILLEGAL; +case 140: ILLEGAL; +case 141: ILLEGAL; +case 142: ILLEGAL; +case 143: ILLEGAL; +case 144: INSTR("mtcrf"); CR.all = RS; break; /* XXX Ignores field mask */ +case 145: ILLEGAL; +case 146: INSTR("mtmsr"); MSR = RD; break; +case 147: ILLEGAL; +case 148: ILLEGAL; +case 149: ILLEGAL; +case 150: UNIMP("stwcx"); +case 151: INSTR("stwx"); MEM(u_long , LONG, RA0 + RB) = RS; break; +case 152: POWER("slq"); +case 153: POWER("sle"); +case 154: ILLEGAL; +case 155: ILLEGAL; +case 156: ILLEGAL; +case 157: ILLEGAL; +case 158: ILLEGAL; +case 159: ILLEGAL; +case 160: ILLEGAL; +case 161: ILLEGAL; +case 162: ILLEGAL; +case 163: ILLEGAL; +case 164: ILLEGAL; +case 165: ILLEGAL; +case 166: ILLEGAL; +case 167: ILLEGAL; +case 168: ILLEGAL; +case 169: ILLEGAL; +case 170: ILLEGAL; +case 171: ILLEGAL; +case 172: ILLEGAL; +case 173: ILLEGAL; +case 174: ILLEGAL; +case 175: ILLEGAL; +case 176: ILLEGAL; +case 177: ILLEGAL; +case 178: ILLEGAL; +case 179: ILLEGAL; +case 180: ILLEGAL; +case 181: ILLEGAL; +case 182: ILLEGAL; +case 183: INSTR("stwux"); MEM(u_long , LONG, RA = (RA + RB)) = RS; break; +case 184: POWER("sliq"); +case 185: ILLEGAL; +case 186: ILLEGAL; +case 187: ILLEGAL; +case 188: ILLEGAL; +case 189: ILLEGAL; +case 190: ILLEGAL; +case 191: ILLEGAL; +case 192: ILLEGAL; +case 193: ILLEGAL; +case 194: ILLEGAL; +case 195: ILLEGAL; +case 196: ILLEGAL; +case 197: ILLEGAL; +case 198: ILLEGAL; +case 199: ILLEGAL; +case 200: INSTR("subfze"); ADDC(~RA,XER.bits.CA); break; +case 201: ILLEGAL; +case 202: INSTR("addze"); ADDC(RA,XER.bits.CA); break; +case 203: ILLEGAL; +case 204: ILLEGAL; +case 205: ILLEGAL; +case 206: ILLEGAL; +case 207: ILLEGAL; +case 208: ILLEGAL; +case 209: ILLEGAL; +case 210: +#ifdef MMU + INSTR("mtsr"); SR = RS; break; +#else + UNIMP("mtsr"); +#endif +case 211: ILLEGAL; +case 212: ILLEGAL; +case 213: ILLEGAL; +case 214: ILLEGAL; +case 215: INSTR("stbx"); MEM(u_char , BYTE, RA0 + RB) = RS; break; +case 216: POWER("sllq"); +case 217: POWER("sleq"); +case 218: ILLEGAL; +case 219: ILLEGAL; +case 220: ILLEGAL; +case 221: ILLEGAL; +case 222: ILLEGAL; +case 223: ILLEGAL; +case 224: ILLEGAL; +case 225: ILLEGAL; +case 226: ILLEGAL; +case 227: ILLEGAL; +case 228: ILLEGAL; +case 229: ILLEGAL; +case 230: ILLEGAL; +case 231: ILLEGAL; +case 232: UNIMP("subfme"); +case 233: ILLEGAL; +case 234: UNIMP("addme"); +case 235: INSTR("mullw"); + umtimes((u_long *)&scratch, (u_long *)&RD, RA, RB); +#ifdef OVERFLOWS + if (OE) { + XER.bits.SO |= (XER.bits.OV = (scratch != 0)); + } +#endif + UPDATE_CR(RD); + break; +case 236: ILLEGAL; +case 237: ILLEGAL; +case 238: ILLEGAL; +case 239: ILLEGAL; +case 240: ILLEGAL; +case 241: ILLEGAL; +case 242: +#ifdef MMU + INSTR("mtsrin"); seg[RB] = RS; break; +#else + UNIMP("mtsrin"); +#endif +case 243: ILLEGAL; +case 244: ILLEGAL; +case 245: ILLEGAL; +case 246: INSTR("dcbtst"); break; +case 247: INSTR("stbux"); MEM(u_char , BYTE, RA = (RA + RB)) = RS; break; +case 248: POWER("slliq"); +case 249: ILLEGAL; +case 250: ILLEGAL; +case 251: ILLEGAL; +case 252: ILLEGAL; +case 253: ILLEGAL; +case 254: ILLEGAL; +case 255: ILLEGAL; +case 256: ILLEGAL; +case 257: ILLEGAL; +case 258: ILLEGAL; +case 259: ILLEGAL; +case 260: ILLEGAL; +case 261: ILLEGAL; +case 262: ILLEGAL; +case 263: ILLEGAL; +case 264: POWER("doz"); +case 265: ILLEGAL; +case 266: INSTR("add"); + temp = RB + RA; + UPDATE_OV(temp,RB,RA); + UPDATE_CR(temp); + RD = temp; + break; +case 267: ILLEGAL; +case 268: ILLEGAL; +case 269: ILLEGAL; +case 270: ILLEGAL; +case 271: ILLEGAL; +case 272: ILLEGAL; +case 273: ILLEGAL; +case 274: ILLEGAL; +case 275: ILLEGAL; +case 276: ILLEGAL; +case 277: POWER("lscbx"); +case 278: INSTR("dcbt"); break; +case 279: INSTR("lhzx"); RD = MEM(u_short, WORD, RA0 + RB); break; +case 280: ILLEGAL; +case 281: ILLEGAL; +case 282: ILLEGAL; +case 283: ILLEGAL; +case 284: INSTR("eqv"); LOGIC( ~(RS ^ RB) ); +case 285: ILLEGAL; +case 286: ILLEGAL; +case 287: ILLEGAL; +case 288: ILLEGAL; +case 289: ILLEGAL; +case 290: ILLEGAL; +case 291: ILLEGAL; +case 292: ILLEGAL; +case 293: ILLEGAL; +case 294: ILLEGAL; +case 295: ILLEGAL; +case 296: ILLEGAL; +case 297: ILLEGAL; +case 298: ILLEGAL; +case 299: ILLEGAL; +case 300: ILLEGAL; +case 301: ILLEGAL; +case 302: ILLEGAL; +case 303: ILLEGAL; +case 304: ILLEGAL; +case 305: ILLEGAL; +case 306: +#ifdef MMU + INSTR("tlbie"); tlbie(RB); break; +#else + UNIMP("tlbie"); +#endif +case 307: ILLEGAL; +case 308: ILLEGAL; +case 309: ILLEGAL; +case 310: UNIMP("eciwx"); /* uses RA0 */ +case 311: INSTR("lhzux"); RD = MEM(u_short, WORD, RA = (RA + RB)); break; +case 312: ILLEGAL; +case 313: ILLEGAL; +case 314: ILLEGAL; +case 315: ILLEGAL; +case 316: INSTR("xor"); LOGIC( RS ^ RB ); +case 317: ILLEGAL; +case 318: ILLEGAL; +case 319: ILLEGAL; +case 320: ILLEGAL; +case 321: ILLEGAL; +case 322: ILLEGAL; +case 323: ILLEGAL; +case 324: ILLEGAL; +case 325: ILLEGAL; +case 326: ILLEGAL; +case 327: ILLEGAL; +case 328: ILLEGAL; +case 329: ILLEGAL; +case 330: ILLEGAL; +case 331: POWER("div"); +case 332: ILLEGAL; +case 333: ILLEGAL; +case 334: ILLEGAL; +case 335: ILLEGAL; +case 336: ILLEGAL; +case 337: ILLEGAL; +case 338: ILLEGAL; +case 339: INSTR("mfspr"); + switch(SPR) { + case 1: RD = XER.all; break; + case 8: RD = LR; break; + case 9: RD = CTR; break; + case 22: RD = DEC; break; +#ifdef MMU + case 25: SDR1 = RD; break; +#endif + case 26: RD = SRR0; break; + case 27: RD = SRR1; break; + case 272: RD = SPRG0; break; + case 273: RD = SPRG1; break; + case 274: RD = SPRG2; break; + case 275: RD = SPRG3; break; + /* + * Special simulator reg. The return value indicates + * whether or not page-zero addressing is supported. + */ +#ifdef TRACE + case 287: TBAR = RD; RD = 1; break; +#else + case 287: TBAR = RD; RD = 0; break; +#endif + case 1008: RD = HID0; break; + case 1010: RD = IABR; break; + case 1023: RD = 0; break; + default: UNIMP("mfspr - bad SPR"); + } + break; +case 340: ILLEGAL; +case 341: ILLEGAL; +case 342: ILLEGAL; +case 343: INSTR("lhax"); RD = MEM(short , WORD, RA0 + RB); break; +case 344: ILLEGAL; +case 345: ILLEGAL; +case 346: ILLEGAL; +case 347: ILLEGAL; +case 348: ILLEGAL; +case 349: ILLEGAL; +case 350: ILLEGAL; +case 351: ILLEGAL; +case 352: ILLEGAL; +case 353: ILLEGAL; +case 354: ILLEGAL; +case 355: ILLEGAL; +case 356: ILLEGAL; +case 357: ILLEGAL; +case 358: ILLEGAL; +case 359: ILLEGAL; +case 360: POWER("abs"); +case 361: ILLEGAL; +case 362: ILLEGAL; +case 363: POWER("divs"); +case 364: ILLEGAL; +case 365: ILLEGAL; +case 366: ILLEGAL; +case 367: ILLEGAL; +case 368: ILLEGAL; +case 369: ILLEGAL; +case 370: ILLEGAL; +case 371: INSTR("mftb"); + { + extern void gettime(); + + switch(SPR) { + case 268: gettime((long *)0, (long *)&RD); break; + case 269: gettime((long *)&RD, (long *)0); break; + default: UNIMP("mftbf - bad TBR"); + } + } + break; + +case 372: ILLEGAL; +case 373: ILLEGAL; +case 374: ILLEGAL; +case 375: INSTR("lhaux"); RD = MEM(short , WORD, RA = (RA + RB)); break; +case 376: ILLEGAL; +case 377: ILLEGAL; +case 378: ILLEGAL; +case 379: ILLEGAL; +case 380: ILLEGAL; +case 381: ILLEGAL; +case 382: ILLEGAL; +case 383: ILLEGAL; +case 384: ILLEGAL; +case 385: ILLEGAL; +case 386: ILLEGAL; +case 387: ILLEGAL; +case 388: ILLEGAL; +case 389: ILLEGAL; +case 390: ILLEGAL; +case 391: ILLEGAL; +case 392: ILLEGAL; +case 393: ILLEGAL; +case 394: ILLEGAL; +case 395: ILLEGAL; +case 396: ILLEGAL; +case 397: ILLEGAL; +case 398: ILLEGAL; +case 399: ILLEGAL; +case 400: ILLEGAL; +case 401: ILLEGAL; +case 402: ILLEGAL; +case 403: ILLEGAL; +case 404: ILLEGAL; +case 405: ILLEGAL; +case 406: ILLEGAL; +case 407: INSTR("sthx"); MEM(u_short, WORD, RA0 + RB) = RS; break; +case 408: ILLEGAL; +case 409: ILLEGAL; +case 410: ILLEGAL; +case 411: ILLEGAL; +case 412: INSTR("orc"); LOGIC( RS | ~RB); +case 413: ILLEGAL; +case 414: ILLEGAL; +case 415: ILLEGAL; +case 416: ILLEGAL; +case 417: ILLEGAL; +case 418: ILLEGAL; +case 419: ILLEGAL; +case 420: ILLEGAL; +case 421: ILLEGAL; +case 422: ILLEGAL; +case 423: ILLEGAL; +case 424: ILLEGAL; +case 425: ILLEGAL; +case 426: ILLEGAL; +case 427: ILLEGAL; +case 428: ILLEGAL; +case 429: ILLEGAL; +case 430: ILLEGAL; +case 431: ILLEGAL; +case 432: ILLEGAL; +case 433: ILLEGAL; +case 434: ILLEGAL; +case 435: ILLEGAL; +case 436: ILLEGAL; +case 437: ILLEGAL; +case 438: UNIMP("ecowx"); /* uses RA0 */ +case 439: INSTR("sthux"); MEM(u_short, WORD, RA = (RA + RB)) = RS; break; +case 440: ILLEGAL; +case 441: ILLEGAL; +case 442: ILLEGAL; +case 443: ILLEGAL; +case 444: INSTR("or"); LOGIC( RS | RB ); +case 445: ILLEGAL; +case 446: ILLEGAL; +case 447: ILLEGAL; +case 448: ILLEGAL; +case 449: ILLEGAL; +case 450: ILLEGAL; +case 451: ILLEGAL; +case 452: ILLEGAL; +case 453: ILLEGAL; +case 454: ILLEGAL; +case 455: ILLEGAL; +case 456: ILLEGAL; +case 457: ILLEGAL; +case 458: ILLEGAL; +case 459: INSTR("divwu"); RD = (u_long)RA / (u_long)RB; UPDATE_CR(RD); break; + /* XXX Overflow is not handled */ +case 460: ILLEGAL; +case 461: ILLEGAL; +case 462: ILLEGAL; +case 463: ILLEGAL; +case 464: ILLEGAL; +case 465: ILLEGAL; +case 466: ILLEGAL; +case 467: INSTR("mtspr"); + switch (SPR) { + case 1: XER.all = RD; break; + case 8: LR = RD; break; + case 9: CTR = RD; break; + case 22: DEC = RD; break; +#ifdef MMU + case 25: SDR1 = RD; break; +#endif + case 26: SRR0 = RD; break; + case 27: SRR1 = RD; break; + case 272: SPRG0 = RD; break; + case 273: SPRG1 = RD; break; + case 274: SPRG2 = RD; break; + case 275: SPRG3 = RD; break; + case 1008: HID0 = RD; +#ifdef BI_ENDIAN + if (HID0 & 8) { + LONG = 4; WORD = 6; BYTE = 7; + } else { + LONG = 0; WORD = 0; BYTE = 0; + } +#endif + break; + case 1010: IABR = RD; break; + default: UNIMP("mtspr - bad SPR"); + } + break; +case 468: ILLEGAL; +case 469: ILLEGAL; +case 470: INSTR("dcbi"); break; +case 471: ILLEGAL; +case 472: ILLEGAL; +case 473: ILLEGAL; +case 474: ILLEGAL; +case 475: ILLEGAL; +case 476: INSTR("nand"); LOGIC( ~(RS & RB) ); +case 477: ILLEGAL; +case 478: ILLEGAL; +case 479: ILLEGAL; +case 480: ILLEGAL; +case 481: ILLEGAL; +case 482: ILLEGAL; +case 483: ILLEGAL; +case 484: ILLEGAL; +case 485: ILLEGAL; +case 486: ILLEGAL; +case 487: ILLEGAL; +case 488: POWER("nabs"); +case 489: ILLEGAL; +case 490: ILLEGAL; +case 491: INSTR("divw"); RD = RA / RB; UPDATE_CR(RD); break; + /* XXX Overflow is not handled */ +case 492: ILLEGAL; +case 493: ILLEGAL; +case 494: ILLEGAL; +case 495: ILLEGAL; +case 496: ILLEGAL; +case 497: ILLEGAL; +case 498: ILLEGAL; +case 499: ILLEGAL; +case 500: ILLEGAL; +case 501: ILLEGAL; +case 502: ILLEGAL; +case 503: ILLEGAL; +case 504: ILLEGAL; +case 505: ILLEGAL; +case 506: ILLEGAL; +case 507: ILLEGAL; +case 508: ILLEGAL; +case 509: ILLEGAL; +case 510: ILLEGAL; +case 511: ILLEGAL; +case 512: UNIMP("mcrxr"); +case 513: ILLEGAL; +case 514: ILLEGAL; +case 515: ILLEGAL; +case 516: ILLEGAL; +case 517: ILLEGAL; +case 518: ILLEGAL; +case 519: ILLEGAL; +case 520: ILLEGAL; +case 521: ILLEGAL; +case 522: ILLEGAL; +case 523: ILLEGAL; +case 524: ILLEGAL; +case 525: ILLEGAL; +case 526: ILLEGAL; +case 527: ILLEGAL; +case 528: ILLEGAL; +case 529: ILLEGAL; +case 530: ILLEGAL; +case 531: POWER("clcs"); +case 532: ILLEGAL; +case 533: UNIMP("lswx"); +case 534: INSTR("lwbrx"); + temp = MEM(u_long , LONG, RA0 + RB); + RD = ((temp << 24) & 0xff000000) | + ((temp << 8) & 0x00ff0000) | + ((temp >> 8) & 0x0000ff00) | + ((temp >> 24) & 0x000000ff); + break; +case 535: UNIMP("lfsx"); +/* XXX is it bit 16 or bit 26? */ +case 536: INSTR("srw"); LOGIC( (RB & 0x10020 ? 0 : RS >> (RB & 0x1f)) ); break; +case 537: POWER("rrib"); +case 538: ILLEGAL; +case 539: ILLEGAL; +case 540: ILLEGAL; +case 541: POWER("maskir"); +case 542: ILLEGAL; +case 543: ILLEGAL; +case 544: ILLEGAL; +case 545: ILLEGAL; +case 546: ILLEGAL; +case 547: ILLEGAL; +case 548: ILLEGAL; +case 549: ILLEGAL; +case 550: ILLEGAL; +case 551: ILLEGAL; +case 552: ILLEGAL; +case 553: ILLEGAL; +case 554: ILLEGAL; +case 555: ILLEGAL; +case 556: ILLEGAL; +case 557: ILLEGAL; +case 558: ILLEGAL; +case 559: ILLEGAL; +case 560: ILLEGAL; +case 561: ILLEGAL; +case 562: ILLEGAL; +case 563: ILLEGAL; +case 564: ILLEGAL; +case 565: ILLEGAL; +case 566: +#ifdef MMU + INSTR("tlbsync"); break; +#else + UNIMP("tlbsync"); +#endif +case 567: UNIMP("lfsux"); +case 568: ILLEGAL; +case 569: ILLEGAL; +case 570: ILLEGAL; +case 571: ILLEGAL; +case 572: ILLEGAL; +case 573: ILLEGAL; +case 574: ILLEGAL; +case 575: ILLEGAL; +case 576: ILLEGAL; +case 577: ILLEGAL; +case 578: ILLEGAL; +case 579: ILLEGAL; +case 580: ILLEGAL; +case 581: ILLEGAL; +case 582: ILLEGAL; +case 583: ILLEGAL; +case 584: ILLEGAL; +case 585: ILLEGAL; +case 586: ILLEGAL; +case 587: ILLEGAL; +case 588: ILLEGAL; +case 589: ILLEGAL; +case 590: ILLEGAL; +case 591: ILLEGAL; +case 592: ILLEGAL; +case 593: ILLEGAL; +case 594: ILLEGAL; +case 595: +#ifdef MMU + INSTR("mfsr"); RD = SR; break; +#else + UNIMP("mfsr"); +#endif +case 596: ILLEGAL; +case 597: UNIMP("lswi"); +case 598: INSTR("sync"); break; +case 599: UNIMP("lfdx"); +case 600: ILLEGAL; +case 601: ILLEGAL; +case 602: ILLEGAL; +case 603: ILLEGAL; +case 604: ILLEGAL; +case 605: ILLEGAL; +case 606: ILLEGAL; +case 607: ILLEGAL; +case 608: ILLEGAL; +case 609: ILLEGAL; +case 610: ILLEGAL; +case 611: ILLEGAL; +case 612: ILLEGAL; +case 613: ILLEGAL; +case 614: ILLEGAL; +case 615: ILLEGAL; +case 616: ILLEGAL; +case 617: ILLEGAL; +case 618: ILLEGAL; +case 619: ILLEGAL; +case 620: ILLEGAL; +case 621: ILLEGAL; +case 622: ILLEGAL; +case 623: ILLEGAL; +case 624: ILLEGAL; +case 625: ILLEGAL; +case 626: ILLEGAL; +case 627: ILLEGAL; +case 628: ILLEGAL; +case 629: ILLEGAL; +case 630: ILLEGAL; +case 631: UNIMP("lfdux"); +case 632: ILLEGAL; +case 633: ILLEGAL; +case 634: ILLEGAL; +case 635: ILLEGAL; +case 636: ILLEGAL; +case 637: ILLEGAL; +case 638: ILLEGAL; +case 639: ILLEGAL; +case 640: ILLEGAL; +case 641: ILLEGAL; +case 642: ILLEGAL; +case 643: ILLEGAL; +case 644: ILLEGAL; +case 645: ILLEGAL; +case 646: ILLEGAL; +case 647: ILLEGAL; +case 648: ILLEGAL; +case 649: ILLEGAL; +case 650: ILLEGAL; +case 651: ILLEGAL; +case 652: ILLEGAL; +case 653: ILLEGAL; +case 654: ILLEGAL; +case 655: ILLEGAL; +case 656: ILLEGAL; +case 657: ILLEGAL; +case 658: ILLEGAL; +case 659: +#ifdef MMU + INSTR("mfsrin"); RD = seg[RB]; break; +#else + UNIMP("mfsrin"); +#endif +case 660: ILLEGAL; +case 661: UNIMP("stswx"); +case 662: INSTR("stwbrx"); + temp = RS; + MEM(u_long , LONG, RA0 + RB) = + ((temp << 24) & 0xff000000) | + ((temp << 8) & 0x00ff0000) | + ((temp >> 8) & 0x0000ff00) | + ((temp >> 24) & 0x000000ff); + break; +case 663: UNIMP("stfsx"); +case 664: POWER("srq"); +case 665: POWER("sre"); +case 666: ILLEGAL; +case 667: ILLEGAL; +case 668: ILLEGAL; +case 669: ILLEGAL; +case 670: ILLEGAL; +case 671: ILLEGAL; +case 672: ILLEGAL; +case 673: ILLEGAL; +case 674: ILLEGAL; +case 675: ILLEGAL; +case 676: ILLEGAL; +case 677: ILLEGAL; +case 678: ILLEGAL; +case 679: ILLEGAL; +case 680: ILLEGAL; +case 681: ILLEGAL; +case 682: ILLEGAL; +case 683: ILLEGAL; +case 684: ILLEGAL; +case 685: ILLEGAL; +case 686: ILLEGAL; +case 687: ILLEGAL; +case 688: ILLEGAL; +case 689: ILLEGAL; +case 690: ILLEGAL; +case 691: ILLEGAL; +case 692: ILLEGAL; +case 693: ILLEGAL; +case 694: ILLEGAL; +case 695: UNIMP("stfsux"); +case 696: POWER("sriq"); +case 697: ILLEGAL; +case 698: ILLEGAL; +case 699: ILLEGAL; +case 700: ILLEGAL; +case 701: ILLEGAL; +case 702: ILLEGAL; +case 703: ILLEGAL; +case 704: ILLEGAL; +case 705: ILLEGAL; +case 706: ILLEGAL; +case 707: ILLEGAL; +case 708: ILLEGAL; +case 709: ILLEGAL; +case 710: ILLEGAL; +case 711: ILLEGAL; +case 712: ILLEGAL; +case 713: ILLEGAL; +case 714: ILLEGAL; +case 715: ILLEGAL; +case 716: ILLEGAL; +case 717: ILLEGAL; +case 718: ILLEGAL; +case 719: ILLEGAL; +case 720: ILLEGAL; +case 721: ILLEGAL; +case 722: ILLEGAL; +case 723: ILLEGAL; +case 724: ILLEGAL; +case 725: UNIMP("stswi"); +case 726: ILLEGAL; +case 727: UNIMP("stfdx"); +case 728: POWER("srlq"); +case 729: POWER("sreq"); +case 730: ILLEGAL; +case 731: ILLEGAL; +case 732: ILLEGAL; +case 733: ILLEGAL; +case 734: ILLEGAL; +case 735: ILLEGAL; +case 736: ILLEGAL; +case 737: ILLEGAL; +case 738: ILLEGAL; +case 739: ILLEGAL; +case 740: ILLEGAL; +case 741: ILLEGAL; +case 742: ILLEGAL; +case 743: ILLEGAL; +case 744: ILLEGAL; +case 745: ILLEGAL; +case 746: ILLEGAL; +case 747: ILLEGAL; +case 748: ILLEGAL; +case 749: ILLEGAL; +case 750: ILLEGAL; +case 751: ILLEGAL; +case 752: ILLEGAL; +case 753: ILLEGAL; +case 754: ILLEGAL; +case 755: ILLEGAL; +case 756: ILLEGAL; +case 757: ILLEGAL; +case 758: ILLEGAL; +case 759: UNIMP("stfdux"); +case 760: POWER("srliq"); +case 761: ILLEGAL; +case 762: ILLEGAL; +case 763: ILLEGAL; +case 764: ILLEGAL; +case 765: ILLEGAL; +case 766: ILLEGAL; +case 767: ILLEGAL; +case 768: ILLEGAL; +case 769: ILLEGAL; +case 770: ILLEGAL; +case 771: ILLEGAL; +case 772: ILLEGAL; +case 773: ILLEGAL; +case 774: ILLEGAL; +case 775: ILLEGAL; +case 776: ILLEGAL; +case 777: ILLEGAL; +case 778: ILLEGAL; +case 779: ILLEGAL; +case 780: ILLEGAL; +case 781: ILLEGAL; +case 782: ILLEGAL; +case 783: ILLEGAL; +case 784: ILLEGAL; +case 785: ILLEGAL; +case 786: ILLEGAL; +case 787: ILLEGAL; +case 788: ILLEGAL; +case 789: ILLEGAL; +case 790: INSTR("lhbrx"); + temp = MEM(u_short, WORD, RA0 + RB); + RD = ((temp & 0xff) << 8 ) | (temp >> 8); + break; +case 791: ILLEGAL; +case 792: INSTR("sraw"); + LOGIC( (RB & 0x20 ? (long)RS >> 31 : (long)RS >> (RB & 0x1f)) ); + break; + /* XXX handle XER.bits.CA */ +case 793: ILLEGAL; +case 794: ILLEGAL; +case 795: ILLEGAL; +case 796: ILLEGAL; +case 797: ILLEGAL; +case 798: ILLEGAL; +case 799: ILLEGAL; +case 800: ILLEGAL; +case 801: ILLEGAL; +case 802: ILLEGAL; +case 803: ILLEGAL; +case 804: ILLEGAL; +case 805: ILLEGAL; +case 806: ILLEGAL; +case 807: ILLEGAL; +case 808: ILLEGAL; +case 809: ILLEGAL; +case 810: ILLEGAL; +case 811: ILLEGAL; +case 812: ILLEGAL; +case 813: ILLEGAL; +case 814: ILLEGAL; +case 815: ILLEGAL; +case 816: ILLEGAL; +case 817: ILLEGAL; +case 818: ILLEGAL; +case 819: ILLEGAL; +case 820: ILLEGAL; +case 821: ILLEGAL; +case 822: ILLEGAL; +case 823: ILLEGAL; +case 824: INSTR("srawi"); LOGIC( (long)RS >> SH );/* XXX handle XER.bits.CA */ +case 825: ILLEGAL; +case 826: ILLEGAL; +case 827: ILLEGAL; +case 828: ILLEGAL; +case 829: ILLEGAL; +case 830: ILLEGAL; +case 831: ILLEGAL; +case 832: ILLEGAL; +case 833: ILLEGAL; +case 834: ILLEGAL; +case 835: ILLEGAL; +case 836: ILLEGAL; +case 837: ILLEGAL; +case 838: ILLEGAL; +case 839: ILLEGAL; +case 840: ILLEGAL; +case 841: ILLEGAL; +case 842: ILLEGAL; +case 843: ILLEGAL; +case 844: ILLEGAL; +case 845: ILLEGAL; +case 846: ILLEGAL; +case 847: ILLEGAL; +case 848: ILLEGAL; +case 849: ILLEGAL; +case 850: ILLEGAL; +case 851: ILLEGAL; +case 852: ILLEGAL; +case 853: ILLEGAL; +case 854: UNIMP("Old MacDonald had a farm - eieio"); +case 855: ILLEGAL; +case 856: ILLEGAL; +case 857: ILLEGAL; +case 858: ILLEGAL; +case 859: ILLEGAL; +case 860: ILLEGAL; +case 861: ILLEGAL; +case 862: ILLEGAL; +case 863: ILLEGAL; +case 864: ILLEGAL; +case 865: ILLEGAL; +case 866: ILLEGAL; +case 867: ILLEGAL; +case 868: ILLEGAL; +case 869: ILLEGAL; +case 870: ILLEGAL; +case 871: ILLEGAL; +case 872: ILLEGAL; +case 873: ILLEGAL; +case 874: ILLEGAL; +case 875: ILLEGAL; +case 876: ILLEGAL; +case 877: ILLEGAL; +case 878: ILLEGAL; +case 879: ILLEGAL; +case 880: ILLEGAL; +case 881: ILLEGAL; +case 882: ILLEGAL; +case 883: ILLEGAL; +case 884: ILLEGAL; +case 885: ILLEGAL; +case 886: ILLEGAL; +case 887: ILLEGAL; +case 888: ILLEGAL; +case 889: ILLEGAL; +case 890: ILLEGAL; +case 891: ILLEGAL; +case 892: ILLEGAL; +case 893: ILLEGAL; +case 894: ILLEGAL; +case 895: ILLEGAL; +case 896: ILLEGAL; +case 897: ILLEGAL; +case 898: ILLEGAL; +case 899: ILLEGAL; +case 900: ILLEGAL; +case 901: ILLEGAL; +case 902: ILLEGAL; +case 903: ILLEGAL; +case 904: ILLEGAL; +case 905: ILLEGAL; +case 906: ILLEGAL; +case 907: ILLEGAL; +case 908: ILLEGAL; +case 909: ILLEGAL; +case 910: ILLEGAL; +case 911: ILLEGAL; +case 912: ILLEGAL; +case 913: ILLEGAL; +case 914: ILLEGAL; +case 915: ILLEGAL; +case 916: ILLEGAL; +case 917: ILLEGAL; +case 918: INSTR("sthbrx"); + temp = RS & 0xffff; + MEM(u_short, WORD, RA0 + RB) = ((temp & 0xff) << 8 ) | (temp >> 8); + break; +case 919: ILLEGAL; +case 920: POWER("sraq"); +case 921: POWER("srea"); +case 922: INSTR("extsh"); LOGIC( (long)(RS << 16) >> 16 ); +case 923: ILLEGAL; +case 924: ILLEGAL; +case 925: ILLEGAL; +case 926: ILLEGAL; +case 927: ILLEGAL; +case 928: ILLEGAL; +case 929: ILLEGAL; +case 930: ILLEGAL; +case 931: ILLEGAL; +case 932: ILLEGAL; +case 933: ILLEGAL; +case 934: ILLEGAL; +case 935: ILLEGAL; +case 936: ILLEGAL; +case 937: ILLEGAL; +case 938: ILLEGAL; +case 939: ILLEGAL; +case 940: ILLEGAL; +case 941: ILLEGAL; +case 942: ILLEGAL; +case 943: ILLEGAL; +case 944: ILLEGAL; +case 945: ILLEGAL; +case 946: ILLEGAL; +case 947: ILLEGAL; +case 948: ILLEGAL; +case 949: ILLEGAL; +case 950: ILLEGAL; +case 951: ILLEGAL; +case 952: POWER("sraiq"); +case 953: ILLEGAL; +case 954: INSTR("extsb"); LOGIC( (long)(RS << 24) >> 24 ); +case 955: ILLEGAL; +case 956: ILLEGAL; +case 957: ILLEGAL; +case 958: ILLEGAL; +case 959: ILLEGAL; +case 960: ILLEGAL; +case 961: ILLEGAL; +case 962: ILLEGAL; +case 963: ILLEGAL; +case 964: ILLEGAL; +case 965: ILLEGAL; +case 966: ILLEGAL; +case 967: ILLEGAL; +case 968: ILLEGAL; +case 969: ILLEGAL; +case 970: ILLEGAL; +case 971: ILLEGAL; +case 972: ILLEGAL; +case 973: ILLEGAL; +case 974: ILLEGAL; +case 975: ILLEGAL; +case 976: ILLEGAL; +case 977: ILLEGAL; +case 978: +#ifdef MMU + INSTR("tlbld"); ONLY603 mmutab[RB >> 12] = RPA & 0xfffff00; break; +#else + UNIMP("tlbld"); +#endif +case 979: ILLEGAL; +case 980: ILLEGAL; +case 981: ILLEGAL; +case 982: INSTR("icbi"); break; +case 983: ILLEGAL; +case 984: ILLEGAL; +case 985: ILLEGAL; +case 986: ILLEGAL; +case 987: ILLEGAL; +case 988: ILLEGAL; +case 989: ILLEGAL; +case 990: ILLEGAL; +case 991: ILLEGAL; +case 992: ILLEGAL; +case 993: ILLEGAL; +case 994: ILLEGAL; +case 995: ILLEGAL; +case 996: ILLEGAL; +case 997: ILLEGAL; +case 998: ILLEGAL; +case 999: ILLEGAL; +case 1000: ILLEGAL; +case 1001: ILLEGAL; +case 1002: ILLEGAL; +case 1003: ILLEGAL; +case 1004: ILLEGAL; +case 1005: ILLEGAL; +case 1006: ILLEGAL; +case 1007: ILLEGAL; +case 1008: ILLEGAL; +case 1009: ILLEGAL; +case 1010: +#ifdef MMU + INSTR("tlbli"); ONLY603 mmutab[RB >> 12] = RPA & 0xfffff00; break; +#else + UNIMP("tlbli"); +#endif +case 1011: ILLEGAL; +case 1012: ILLEGAL; +case 1013: ILLEGAL; +case 1014: UNIMP("dcbz"); +case 1015: ILLEGAL; +case 1016: ILLEGAL; +case 1017: ILLEGAL; +case 1018: ILLEGAL; +case 1019: ILLEGAL; +case 1020: ILLEGAL; +case 1021: ILLEGAL; +case 1022: ILLEGAL; +case 1023: ILLEGAL; + } /* End of big 31-class switch */ + } /* End of main opcode switch */ + + continue; +power: + if (!TBAR) + printf("Unimplemented POWER instruction %08lx (%s) at %lx\n", + (long)instruction, (long)opname, (long)CIA); + goto trapout; + +unimplemented: + if (!TBAR) + printf("Unimplemented instruction %08lx (%s)at %lx\n", + (long)instruction, (long)opname, (long)CIA); + goto trapout; + +illegal: + if (!TBAR) + printf("Illegal instruction %08lx at %lx\n", + (long)instruction, (long)CIA, (long)0); + +trapout: + if (TBAR) { + SRR0 = CIA; + SRR1 = MSR; + pc = TBAR + 0x700 - 4; + continue; + } else + return; + + } /* End of main loop */ +} + + +umtimes(dhighp, dlowp, u1, u2) + u_long *dhighp, *dlowp; + u_long u1, u2; +{ + register u_long ah, al, bh, bl, tmp; + extern void dplus(); + + ah = u1>>16; al = u1 & 0xffff; + bh = u2>>16; bl = u2 & 0xffff; + + *dhighp = ah*bh; *dlowp = al*bl; + + tmp = ah*bl; + dplus((long *)dhighp, (long *)dlowp, (long)(tmp>>16), (long)(tmp<<16)); + + tmp = al*bh; + dplus((long *)dhighp, (long *)dlowp, (long)(tmp>>16), (long)(tmp<<16)); +} + +/* Carry calculation assumes 2's complement arithmetic. */ +#define CARRY(res,b) ((u_long)res < (u_long)b) + +void +dplus(dhighp, dlowp, shigh, slow) + register long *dhighp, *dlowp, shigh, slow; +{ + register long lowres; + + lowres = *dlowp + slow; + *dhighp += shigh + CARRY(lowres, slow); + *dlowp = lowres; +} + + +#ifdef TRACE +#include <sys/signal.h> +dumpregs() +{ +#ifdef ARGREGS + printf( + " r0 r1 r2 r3 r4 r5\n" + ); + printf( + "%8x %8x %8x %8x %8x %8x\n\n", + greg[ 0], greg[ 1], greg[ 2], greg[ 3], greg[ 4], greg[ 5] + ); + + printf( + " r6 r7 r8 r9 r10 r11\n" + ); + printf( + "%8x %8x %8x %8x %8x %8x\n\n", + greg[ 6], greg[ 7], greg[ 8], greg[ 9], greg[10], greg[11] + ); +#endif + printf( + " r20 t0 r21 t1 r22 t2 r23 t3 r24 t4 r25 t5\n" + ); + printf( + "%8x %8x %8x %8x %8x %8x\n\n", + greg[20], greg[21], greg[22], greg[23], greg[24], greg[25] + ); + printf( + " r26 base r27 up r28 tos r29 ip r30 rp r31 sp\n" + ); + printf( + "%8x %8x %8x %8x %8x %8x\n\n", + greg[26], greg[27], greg[28], greg[29], greg[30], greg[31] + ); + printf("pc %x LR %x CTR %x CR %x", + pc, LR, CTR, CR.all + ); +#ifndef SIMROM + printf(" CALLS: %x", greg[29] /* IP */); + + if (greg[30]) + printf(" %x %x %x", + ((u_long *)greg[30])[0], /* Return stack */ + ((u_long *)greg[30])[1], + ((u_long *)greg[30])[2] + ); + printf("\n"); +#endif +} +dumpallregs() +{ + int i; + for (i=0; i<8 ; i++) printf("%9x", greg[i]); putchar('\n'); + for ( ; i<16; i++) printf("%9x", greg[i]); putchar('\n'); + for ( ; i<24; i++) printf("%9x", greg[i]); putchar('\n'); + for ( ; i<32; i++) printf("%9x", greg[i]); putchar('\n'); + + printf("pc %x LR %x CTR %x CR %x ", + pc, LR, CTR, CR.all + ); + printf("\n"); +} + +void +handle_signal(foo) + int foo; +{ + dumpregs(); + s_bye(1); +} +catch_signals() +{ + signal(SIGINT,handle_signal); + signal(SIGILL,handle_signal); + signal(SIGFPE,handle_signal); + signal(SIGSEGV,handle_signal); +#ifdef UNIX + signal(SIGTRAP,handle_signal); +// signal(SIGEMT,handle_signal); + signal(SIGBUS,handle_signal); +#endif +} + +dumpmem(adr) + long adr; +{ + u_long *reladr; + + reladr = (u_long *) &xmem[ (int)adr ]; + printf("%x: %8x %8x %8x %8x %8x %8x %8x %8x\n", + adr, + reladr[0], reladr[1], reladr[2], reladr[3], + reladr[4], reladr[5], reladr[6], reladr[7] + ); +} + +#ifdef SIMROM +#define GETLINE (void)c_key(); +#else +#define GETLINE +#endif +trace(name, instruction) + char *name; + u_long instruction; +{ + int done; + int arg; + int c; + static int stepping = 1; + + if (!stepping & (!IABR || pc != IABR)) + return; + + IABR = 0; + stepping = 1; + + printf("%x %x %s ", pc, greg[29], name); + for (done=0; !done; ) { + printf(" : "); +#ifndef SIMROM + putchar(c = c_key()); + putchar('\n'); +#else + c = c_key(); +#endif + switch(c) + { + case 'b': scanf("%x", &IABR); stepping = 0; break; + case 'n': IABR = greg[27]; stepping = 0; break; + case 'u': scanf("%x", &arg); + dumpmem((long)(greg[27]+arg)); + GETLINE; + break; + case 'm': scanf("%x", &arg); + dumpmem((long)arg); + GETLINE; + break; + case 'q': s_bye(0); break; + case 'r': dumpregs(); + GETLINE; + break; + case 'a': dumpallregs(); + GETLINE; + break; + case 'c': stepping = 0; done=1; GETLINE; break; + default: done=1; break; + } + } +} +#endif + +#ifdef UNIX +#include <sys/time.h> +#else +/* ARGSUSED */ +#endif +void +gettime(secp, nsecp) + long *secp, *nsecp; +{ +#ifdef UNIX + struct timeval t; + extern int gettimeofday(); + + (void) gettimeofday(&t, (struct timezone *)0); + if (secp) + *secp = t.tv_sec; + if (nsecp) + *nsecp = t.tv_usec * 1000; +#endif +} +#define TOKEN 4 +int +xfindnext(adr, strlen, base, link, alf) + register u_char *adr; + register long strlen; + register long base; + register u_long link; + u_long *alf; +{ + register u_char *s, *p; + register int namelen, len; + + while((link = *(u_long *)link + base) != base) { + link -= TOKEN; /* link is now the absolute alf */ + s = (u_char *)(link-1-strlen); + p = adr; + len = strlen; + while (len-- && *s == *p) { + s++; + p++; + } + if ((len < 0) && ((*s & 0x1f) == strlen)) { + *alf = link; + return(-1); + } + } + return(0); +} + +// LICENSE_BEGIN +// Copyright (c) 2007 FirmWorks +// +// Permission is hereby granted, free of charge, to any person obtaining +// a copy of this software and associated documentation files (the +// "Software"), to deal in the Software without restriction, including +// without limitation the rights to use, copy, modify, merge, publish, +// distribute, sublicense, and/or sell copies of the Software, and to +// permit persons to whom the Software is furnished to do so, subject to +// the following conditions: +// +// The above copyright notice and this permission notice shall be +// included in all copies or substantial portions of the Software. +// +// THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, +// EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF +// MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND +// NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE +// LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION +// OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION +// WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. +// +// LICENSE_END Added: cpu/ppc/ppcsim/simrom.c =================================================================== --- cpu/ppc/ppcsim/simrom.c (rev 0) +++ cpu/ppc/ppcsim/simrom.c 2007-07-05 17:19:17 UTC (rev 461) @@ -0,0 +1,62 @@ +// See license at end of file +/* + * Main routine for calling the PowerPC simulator to simulate ROM images + */ + +extern void simulate(); +extern char *malloc(); + +char *loadaddr; + +#define MEMSIZE 0x800000 + +main() +{ + int f; + if((f = open("fw.img", 0)) < 0) { + perror("can't open fw.img"); + exit(1); + } + loadaddr = malloc(MEMSIZE); + (void) read(f, loadaddr, MEMSIZE); + close(f); + simulate(loadaddr, 0x100, 0, 0, 0, 0, 0, 1 /* 0=POWER, 1=PowerPC */); + exit(0); +} +int +c_key() +{ + int i; + if ((i = getchar()) == -1) + exit (0); + return (i); +} +void +s_bye() +{ + exit(0); +} + +// LICENSE_BEGIN +// Copyright (c) 2007 FirmWorks +// +// Permission is hereby granted, free of charge, to any person obtaining +// a copy of this software and associated documentation files (the +// "Software"), to deal in the Software without restriction, including +// without limitation the rights to use, copy, modify, merge, publish, +// distribute, sublicense, and/or sell copies of the Software, and to +// permit persons to whom the Software is furnished to do so, subject to +// the following conditions: +// +// The above copyright notice and this permission notice shall be +// included in all copies or substantial portions of the Software. +// +// THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, +// EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF +// MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND +// NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE +// LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION +// OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION +// WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. +// +// LICENSE_END Added: cpu/ppc/realcif.fth =================================================================== --- cpu/ppc/realcif.fth (rev 0) +++ cpu/ppc/realcif.fth 2007-07-05 17:19:17 UTC (rev 461) @@ -0,0 +1,237 @@ +purpose: Real-mode client interface fixups +\ See license at end of file + +headerless +hex + +\ The client program is required to disable i&d translation and +\ disable interrupts before making a real-mode client interface call. +\ The firmware must save and restore + + +\ XXX finish the space optimization --- after exp fixups? +\ /exc h# 18 + ( dsi ) 20 + ( dbats ) 54 + ( sprs ) +100 ( dsi ) 20 + ( dbats ) 54 + ( sprs ) +\ /rm-tlbmiss 2* + ( dtlbs ) \ add this in stand-init +200 + ( dtlbs ) +value /env + +0 value fw-env +0 value client-env + +code save-sprs ( addr1 -- addr2 ) \ 54 + addi tos,tos,-4 + mfspr t0,sdr1 stwu t0,4(tos) + mfspr t0,sprg0 stwu t0,4(tos) + mfspr t0,sprg1 stwu t0,4(tos) + mfspr t0,sprg2 stwu t0,4(tos) + mfspr t0,sprg3 stwu t0,4(tos) + set t1,h#10 + begin + addi t1,t1,-1 + rlwinm t0,t1,28,0,3 + mfsrin t0,t0 stwu t0,4(tos) + cmpi 0,0,t1,0 <= + until + addi tos,tos,4 +c; +code restore-sprs ( addr1 -- addr2 ) + addi tos,tos,-4 + lwzu t0,4(tos) mtspr sdr1,t0 + lwzu t0,4(tos) mtspr sprg0,t0 + lwzu t0,4(tos) mtspr sprg1,t0 + lwzu t0,4(tos) mtspr sprg2,t0 + lwzu t0,4(tos) mtspr sprg3,t0 + set t1,h#10 + sync \ XXX move syncs inside the loop? + isync \ XXX do we *really* need both syncs both times? + begin + addi t1,t1,-1 + rlwinm t2,t1,28,0,3 + lwzu t0,4(tos) mtsrin t0,t2 + cmpi 0,0,t1,0 <= + until + sync + isync + addi tos,tos,4 +c; + +code save-dbats ( addr1 -- addr2 ) \ 20 + mfspr t0,dbat0u stw t0,0(tos) + mfspr t1,dbat0l stw t1,4(tos) + mfspr t2,dbat1u stw t2,8(tos) + mfspr t3,dbat1l stw t3,12(tos) + mfspr t4,dbat2u stw t4,16(tos) + mfspr t5,dbat2l stw t5,20(tos) + mfspr t6,dbat3u stw t6,24(tos) + mfspr t7,dbat3l stw t7,28(tos) + addi tos,tos,32 +c; +code restore-dbats ( addr1 -- addr2 ) + sync \ XXX move syncs inside the loop? + isync \ XXX do we *really* need both syncs both times? + lwz t0,0(tos) mtspr dbat0u,t0 + lwz t1,4(tos) mtspr dbat0l,t1 + lwz t2,8(tos) mtspr dbat1u,t2 + lwz t3,12(tos) mtspr dbat1l,t3 + lwz t4,16(tos) mtspr dbat2u,t4 + lwz t5,20(tos) mtspr dbat2l,t5 + lwz t6,24(tos) mtspr dbat3u,t6 + lwz t7,28(tos) mtspr dbat3l,t7 + sync + isync + addi tos,tos,32 +c; + +code save-lomem ( addr1 -- addr2 ) \ 120 + addi t0,tos,-4 \ Dst into t0 + + \ save 300-3ff + 300 4 - set t1,* \ Src + 100 4 / set t2,* \ set length + mtspr ctr,t2 \ Count in count register + begin + lbzu t2,4(t1) \ Load byte + stbu t2,4(t0) \ Store byte + countdown \ Decrement & Branch if nonzero + + \ check for 603-class processor + mfspr t3,pvr + rlwinm t3,t3,16,24,31 + cmpi 0,0,t3,6 = if set t3,3 then + cmpi 0,0,t3,7 = if set t3,3 then + cmpi 0,0,t3,3 = if \ this is a 603-class processor + \ save 1100-12ff + 1100 4 - set t1,* \ Src + 200 4 / set t2,* \ set length + mtspr ctr,t2 \ Count in count register + begin + lbzu t2,4(t1) \ Load byte + stbu t2,4(t0) \ Store byte + countdown \ Decrement & Branch if nonzero + then + addi tos,t0,4 \ addr2 + mtspr ctr,up \ Restore "next" pointer +c; +code restore-lomem ( addr1 -- addr2 ) + addi t1,tos,-4 \ Src into t1 + + \ restore 300-3ff + 300 4 - set t0,* \ Dst + 100 4 / set t2,* \ set length + mtspr ctr,t2 \ Count in count register + begin + lbzu t2,4(t1) \ Load byte + stbu t2,4(t0) \ Store byte + countdown \ Decrement & Branch if nonzero + + \ check for 603-class processor + mfspr t3,pvr + rlwinm t3,t3,16,24,31 + cmpi 0,0,t3,6 = if set t3,3 then + cmpi 0,0,t3,7 = if set t3,3 then + cmpi 0,0,t3,3 = if \ this is a 603-class processor + \ restore 1100-12ff + 1100 4 - set t0,* \ Dst + 200 4 / set t2,* \ set length + mtspr ctr,t2 \ Count in count register + begin + lbzu t2,4(t1) \ Load byte + stbu t2,4(t0) \ Store byte + countdown \ Decrement & Branch if nonzero + then + addi tos,t1,4 \ addr2 + mtspr ctr,up \ Restore "next" pointer +c; + +: save-environment ( addr -- ) \ data handlers only??? + save-lomem + save-dbats + save-sprs + drop +; +: restore-environment ( addr -- ) \ data handlers only??? + restore-lomem +\ #tlb-lines invalidate-tlbs + restore-dbats + restore-sprs + drop +; + +: ?real-mode-entry ( -- ) + client-env save-environment + fw-env restore-environment + \ msr@ h# 10 or msr! + msr@ h# 10 and 0= dcache-on? and if dcache-off then +; +: ?real-mode-exit ( -- ) + \ msr@ h# 10 invert and msr! + msr@ h# 10 and 0= if + \ If the cache was on when we entered, turn it back on + cif-reg-save 88 + @ h# 4000 or if dcache-on then + then + client-env restore-environment +; + +headers +stand-init: Real mode CIF +\ : rm-cif ( XXX for testing ) + use-real-mode? if + \ XXX optimize later: + \ 603-class? if /rm-tlbmiss 2* /env + to /env then + \ exp? if /exp-tlbmiss 2* /env + to /env then + /env alloc-mem to fw-env + /env alloc-mem to client-env + ['] ?real-mode-entry to rm-cif-entry + ['] ?real-mode-exit to rm-cif-exit + fw-env save-environment + then +; + +warning off +dev /client-services +: claim ( align size virt -- base ) + in-real-mode? if ( align size virt ) + swap rot dup if ( virt size align ) + rot drop ( size align ) + ['] mem-claim catch if 2drop 0 then + else ( virt size 0 ) + ['] mem-claim catch if 3drop 0 then + then + else + claim + then +; +: release ( size virt -- ) + in-real-mode? if ( virt=phys size ) + swap ?release-mem ( ) + else ( virt size ) + release + then +; +device-end +warning on + +\ LICENSE_BEGIN +\ Copyright (c) 2007 FirmWorks +\ +\ Permission is hereby granted, free of charge, to any person obtaining +\ a copy of this software and associated documentation files (the +\ "Software"), to deal in the Software without restriction, including +\ without limitation the rights to use, copy, modify, merge, publish, +\ distribute, sublicense, and/or sell copies of the Software, and to +\ permit persons to whom the Software is furnished to do so, subject to +\ the following conditions: +\ +\ The above copyright notice and this permission notice shall be +\ included in all copies or substantial portions of the Software. +\ +\ THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, +\ EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF +\ MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND +\ NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE +\ LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION +\ OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION +\ WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. +\ +\ LICENSE_END Added: cpu/ppc/reboot.fth =================================================================== --- cpu/ppc/reboot.fth (rev 0) +++ cpu/ppc/reboot.fth 2007-07-05 17:19:17 UTC (rev 461) @@ -0,0 +1,62 @@ +purpose: Reboot system: save reboot info in nvram configuration variables +\ See license at end of file + +headerless +: put-env-number ( n name$ -- ) hex rot (.) 2swap (put-ge-var) drop ; +: get-env-number ( name$ -- n ) + hex $getenv if 0 else $number if 0 then then +; + +0 value reboot-info +: +rb ( offset -- adr ) reboot-info + ; +: copy-reboot-info ( -- ) + " reboot-command" $getenv if false to reboot? exit then + + d# 140 alloc-mem to reboot-info + " reboot-command" $getenv if " " then d# 0 +rb place + " reboot-line#" get-env-number d# 132 +rb ! + " reboot-column#" get-env-number d# 136 +rb ! + + " reboot-command" $unsetenv + " reboot-line#" $unsetenv + " reboot-column#" $unsetenv + + true to reboot? +; + +: (save-reboot-info) ( cmd$ line# column# -- ) + " reboot-column#" put-env-number + " reboot-line#" put-env-number + " reboot-command" (put-ge-var) drop +; +' (save-reboot-info) to save-reboot-info + +: (get-reboot-info) ( -- cmd$ line# column# ) + 0 +rb count d# 132 +rb @ d# 136 +rb @ +; +' (get-reboot-info) to get-reboot-info +headers + +\ LICENSE_BEGIN +\ Copyright (c) 2007 FirmWorks +\ +\ Permission is hereby granted, free of charge, to any person obtaining +\ a copy of this software and associated documentation files (the +\ "Software"), to deal in the Software without restriction, including +\ without limitation the rights to use, copy, modify, merge, publish, +\ distribute, sublicense, and/or sell copies of the Software, and to +\ permit persons to whom the Software is furnished to do so, subject to +\ the following conditions: +\ +\ The above copyright notice and this permission notice shall be +\ included in all copies or substantial portions of the Software. +\ +\ THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, +\ EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF +\ MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND +\ NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE +\ LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION +\ OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION +\ WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. +\ +\ LICENSE_END Added: cpu/ppc/reenter.fth =================================================================== --- cpu/ppc/reenter.fth (rev 0) +++ cpu/ppc/reenter.fth 2007-07-05 17:19:17 UTC (rev 461) @@ -0,0 +1,78 @@ +purpose: Handle various kinds of entries into Forth from traps, etc. +\ See license at end of file + +headerless +: .go-message ( -- ) + \ Restarting is only possible if the state that was first saved + \ is from a restartable exception. + state-valid @ -1 = already-go? and if + restartable? on + ." Type 'go' to resume" cr + then +; + +: .entry ( -- ) + talign \ ... in case dp is misaligned + + aborted? @ if + aborted? off hex cr ." Keyboard interrupt" cr .go-message exit + then + +[ifdef] notyet + exittomon exittomon-end inside? if + ." Program terminated" cr exit + then + reenter reenter-end inside? if + .go-message %o0 to %tbr + %o2 to %itmr exit + then +[then] + [ also hidden ] (.exception) [ previous ] +; + +headers +stand-init: + ['] .entry is .exception +; + +\ Temporary hacks until we implement these functions correctly + +defer user-interface ' quit to user-interface +also client-services definitions +" reenter.fth: Implement 'exit' client service correctly" ?reminder +: exit ( -- ) + [ also hidden ] breakpoints-installed off [ previous ] + [ifdef] vector vector off [then] + + " restore" stdout @ ['] $call-method catch if 3drop then + " restore" stdin @ ['] $call-method catch if 3drop then + + user-interface +; +: enter ( -- ) interact ; +previous definitions + + +\ LICENSE_BEGIN +\ Copyright (c) 2007 FirmWorks +\ +\ Permission is hereby granted, free of charge, to any person obtaining +\ a copy of this software and associated documentation files (the +\ "Software"), to deal in the Software without restriction, including +\ without limitation the rights to use, copy, modify, merge, publish, +\ distribute, sublicense, and/or sell copies of the Software, and to +\ permit persons to whom the Software is furnished to do so, subject to +\ the following conditions: +\ +\ The above copyright notice and this permission notice shall be +\ included in all copies or substantial portions of the Software. +\ +\ THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, +\ EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF +\ MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND +\ NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE +\ LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION +\ OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION +\ WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. +\ +\ LICENSE_END Added: cpu/ppc/regacc.fth =================================================================== --- cpu/ppc/regacc.fth (rev 0) +++ cpu/ppc/regacc.fth 2007-07-05 17:19:17 UTC (rev 461) @@ -0,0 +1,81 @@ +purpose: Register access words for PowerPC +\ See license at end of file + +code rl! ( l addr -- ) + lwz t0,0(sp) \ value + 'user in-little-endian? lwz t1,* + cmpi 0,0,t1,0 + 0<> if + stw t0,0(tos) + else + stwbrx t0,r0,tos + then + eieio sync + lwz tos,1cell(sp) + addi sp,sp,2cells +c; +code rl@ ( addr -- l ) + 'user in-little-endian? lwz t1,* + cmpi 0,0,t1,0 + 0<> if + lwz tos,0(tos) + else + lwbrx tos,r0,tos + then +c; +code rw! ( w addr -- ) + lwz t0,0(sp) \ value + 'user in-little-endian? lwz t1,* + cmpi 0,0,t1,0 + 0<> if + sth t0,0(tos) + else + sthbrx t0,r0,tos + then + eieio sync + lwz tos,1cell(sp) + addi sp,sp,2cells +c; +code rw@ ( addr -- w ) + 'user in-little-endian? lwz t1,* + cmpi 0,0,t1,0 + 0<> if + lhz tos,0(tos) + else + lhbrx tos,r0,tos + then +c; +code rb@ ( addr -- b ) + lbz tos,0(tos) +c; +code rb! ( b addr -- ) + lwz t0,0(sp) + stb t0,0(tos) + eieio sync + lwz tos,1cell(sp) + addi sp,sp,2cells +c; + +\ LICENSE_BEGIN +\ Copyright (c) 2007 FirmWorks +\ +\ Permission is hereby granted, free of charge, to any person obtaining +\ a copy of this software and associated documentation files (the +\ "Software"), to deal in the Software without restriction, including +\ without limitation the rights to use, copy, modify, merge, publish, +\ distribute, sublicense, and/or sell copies of the Software, and to +\ permit persons to whom the Software is furnished to do so, subject to +\ the following conditions: +\ +\ The above copyright notice and this permission notice shall be +\ included in all copies or substantial portions of the Software. +\ +\ THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, +\ EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF +\ MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND +\ NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE +\ LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION +\ OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION +\ WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. +\ +\ LICENSE_END Added: cpu/ppc/register.fth =================================================================== --- cpu/ppc/register.fth (rev 0) +++ cpu/ppc/register.fth 2007-07-05 17:19:17 UTC (rev 461) @@ -0,0 +1,162 @@ +purpose: Display and modify the saved program state +\ See license at end of file + +\ This code is highly machine-dependent. +\ +\ Requires: +\ +\ >state ( offset -- addr ) +\ Returns an address within the processor state array given the +\ offset into that array +\ +\ Defines: +\ +\ register names +\ .registers + +needs action: objects.fth + +decimal +headerless + +only forth hidden also forth also definitions + +d# 112 /l* constant /save-area + +: state-valid ( -- addr ) d# 40 /l* >state ; +: ?saved-state ( -- ) + state-valid @ 0= abort" No program state has been saved in this session." +; + +: clear-save-area ( -- ) 0 >state /save-area erase ; + +: >vmem ; + +3 actions +action: @ ?saved-state >state @ ; +action: @ >state ! ; ( is ) +action: @ >state ; ( addr ) +: reg \ name ( offset -- ) + create /l* , + use-actions +; +: regs \ name name ... ( start #regs -- ) + bounds ?do i reg loop +; +3 actions +action: @ ?saved-state >state 2@ ; +action: @ >state 2! ; ( is ) +action: @ >state ; ( addr ) +: freg \ name ( offset -- ) + create /l* , + use-actions +; +: fregs \ name name ... ( start #regs -- ) + 2* bounds ?do i freg 2 +loop +; + + +headers + 0 8 regs %r0 %r1 %r2 %r3 %r4 %r5 %r6 %r7 + 8 8 regs %r8 %r9 %r10 %r11 %r12 %r13 %r14 %r15 + +16 8 regs %r16 %r17 %r18 %r19 %r20 %r21 %r22 %r23 +24 8 regs %r24 %r25 %r26 %r27 %r28 %r29 %r30 %r31 +20 12 regs t0 t1 t2 t3 t4 t5 rbase up tos ip rp sp + +32 6 regs %xer %lr %ctr %pc %msr %cr +35 2 regs %srr0 %srr1 + +38 1 regs exception# +39 3 regs %saved-my-self %state-valid %restartable? + +42 8 fregs %f0 %f1 %f2 %f3 %f4 %f5 %f6 %f7 +58 8 fregs %f8 %f9 %f10 %f11 %f12 %f13 %f14 %f15 +74 8 fregs %f16 %f17 %f18 %f19 %f20 %f21 %f22 %f23 +90 8 fregs %f24 %f25 %f26 %f27 %f28 %f29 %f30 %f31 + +106 reg %fpscr +106 freg f-tmp + +108 4 regs %sprg0 %sprg1 %sprg2 %sprg3 + +\ Following words defined here to satisfy the +\ references to these "variables" anywhere else +: saved-my-self ( -- addr ) addr %saved-my-self ; +: restartable? ( -- addr ) addr %restartable? ; + +headerless +: .lx ( l -- ) base @ >r hex 9 u.r r> base ! ; + +headers +: .registers ( -- ) + ?saved-state + ??cr +." pc msr ctr lr xer cr" cr + %pc .lx %msr .lx %ctr .lx %lr .lx %xer .lx %cr .lx +cr cr +." r0 r1 r2 r3 r4 r5 r6 r7" cr + %r0 .lx %r1 .lx %r2 .lx %r3 .lx %r4 .lx %r5 .lx %r6 .lx %r7 .lx +cr cr +." r8 r9 r10 r11 r12 r13 r14 r15" cr + %r8 .lx %r9 .lx %r10 .lx %r11 .lx %r12 .lx %r13 .lx %r14 .lx %r15 .lx +cr cr +." r16 r17 r18 r19 r20 r21 r22 r23" cr + %r16 .lx %r17 .lx %r18 .lx %r19 .lx %r20 .lx %r21 .lx %r22 .lx %r23 .lx +cr cr +." r24 r25 r26 r27 r28 r29 r30 r31" cr + %r24 .lx %r25 .lx %r26 .lx %r27 .lx %r28 .lx %r29 .lx %r30 .lx %r31 .lx +cr cr +." sprg0 sprg1 sprg2 sprg3 srr0 srr1" cr + %sprg0 .lx %sprg1 .lx %sprg2 .lx %sprg3 .lx %srr0 .lx %srr1 .lx +cr cr +; + +headerless +: ud.r ( d #columns -- ) >r <# #s #> r> over - spaces type ; +: .fx ( d -- ) base @ >r hex d# 17 ud.r r> base ! ; + +headers +: .fregisters ( -- ) + ??cr + %msr h# 2000 and 0= if + ." Floating point registers were not saved because the floating point" cr + ." unit was not enabled at the time the registers were saved." cr + exit + then + ." fpcsr " %fpscr .lx cr + ." f0-3 :" %f0 .fx %f1 .fx %f2 .fx %f3 .fx cr + ." f4-7 :" %f4 .fx %f5 .fx %f6 .fx %f7 .fx cr + ." f8-11 :" %f8 .fx %f9 .fx %f10 .fx %f11 .fx cr + ." f12-15 :" %f12 .fx %f13 .fx %f14 .fx %f15 .fx cr + ." f16-19 :" %f16 .fx %f17 .fx %f18 .fx %f19 .fx cr + ." f20-23 :" %f20 .fx %f21 .fx %f22 .fx %f23 .fx cr + ." f24-27 :" %f24 .fx %f25 .fx %f26 .fx %f27 .fx cr + ." f28-31 :" %f28 .fx %f29 .fx %f30 .fx %f31 .fx cr +; + +only forth also definitions + +\ LICENSE_BEGIN +\ Copyright (c) 2007 FirmWorks +\ +\ Permission is hereby granted, free of charge, to any person obtaining +\ a copy of this software and associated documentation files (the +\ "Software"), to deal in the Software without restriction, including +\ without limitation the rights to use, copy, modify, merge, publish, +\ distribute, sublicense, and/or sell copies of the Software, and to +\ permit persons to whom the Software is furnished to do so, subject to +\ the following conditions: +\ +\ The above copyright notice and this permission notice shall be +\ included in all copies or substantial portions of the Software. +\ +\ THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, +\ EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF +\ MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND +\ NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE +\ LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION +\ OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION +\ WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. +\ +\ LICENSE_END Added: cpu/ppc/resetvec.fth =================================================================== --- cpu/ppc/resetvec.fth (rev 0) +++ cpu/ppc/resetvec.fth 2007-07-05 17:19:17 UTC (rev 461) @@ -0,0 +1,234 @@ +purpose: Reset vector handler for dropin-driver format +\ See license at end of file + +\ create debug-reset + +[ifdef] debug-reset +h# 8000.0000 constant io-base \ Wrong for GoldenGate +[then] + +\needs start-assembling fload ${BP}/cpu/ppc/asmtools.fth +\needs write-dropin fload ${BP}/tools/mkdropin.fth + +h# e.0000 d# 16 rshift constant inflate-offset \ Shifted for addis +h# f.0000 d# 16 rshift constant workspace-offset \ Shifted for addis + +\ This code is intended to execute from ROM, in big-endian byte order + +start-assembling +h# 20 to asm-origin \ Skip dropin header + +" Copyright 1995 FirmWorks" c$, + +\ Destroys: r5, r6 +label strcmp ( r3: str1 r4: str2 -- r3: 0 if match, nonzero if mismatch ) + addi r3,r3,-1 \ Account for pre-increment + addi r4,r4,-1 \ Account for pre-increment + begin + lbzu r5,1(r3) + lbzu r6,1(r4) + cmp 0,0,r5,r6 + = while + cmpi 0,0,r5,0 + = if + set r3,0 + bclr 20,0 + then + repeat + + subf r3,r5,r6 + bclr 20,0 +end-code + +label find-dropin ( r3: module-name-ptr -- r3: address|-1 ) + mfspr r31,lr + + mr r30,r3 + + \ Compute ROMbase + here 4 + bl * + mfspr r29,lr + here 4 - asm-base - asm-origin + negate addi r29,r29,* + + begin + lwz r4,0(r29) + set r5,h#4f424d44 \ 'OBMD' + cmp 0,0,r4,r5 + = while + mr r3,r30 + addi r4,r29,16 + strcmp bl * + cmpi 0,0,r3,0 + = if \ It the strings match, we found the dropin + mr r3,r29 + mtspr lr,r31 + bclr 20,0 + then + lwz r3,4(r29) \ Length of dropin image + add r3,r3,r29 \ Added to base address of previous dropin + addi r3,r3,35 \ Plus length of header (32) + roundup (3) + rlwinm r29,r3,0,0,29 \ Aligned to 4-byte boundary = new dropin addr + repeat + + set r3,-1 \ No more dropins; return -1 to indicate failure + + mtspr lr,r31 + bclr 20,0 +end-code + +label memcpy ( r3: dst r4: src r5: n -- r3: dst ) + mtspr ctr,r5 + mr r6,r3 + + addi r3,r3,-1 \ Account for pre-decrement + addi r4,r4,-1 \ Account for pre-decrement + begin + lbzu r5,1(r4) + stbu r5,1(r3) + countdown + + mr r3,r6 \ Return dst + bclr 20,0 +end-code + +\ Firmware startup sequence: +\ 1) Execute a dropin named "start", to initialize the host bridge and memory +\ 2) Locate a dropin named "firmware", either copy it or inflate it into RAM, +\ and execute it from RAM + +\ Add padding so "startup" begins at address h# 100 + +h# 100 pad-to + +[ifdef] debug-reset +label my-entry + 0 , \ To be patched later +end-code + +fload ${BP}/arch/prep/reports.fth +[then] + +label startup ( -- ) + + mfspr r3,hid0 + ori r3,r3,2 + mtspr hid0,r3 + + " start" $find-dropin, \ Assemble call to find-dropin with literal arg + + \ What should we do it this fails? Perhaps call a default routine + \ to try to initialize com1 and display a message? + \ For now, we assume success + + addi r3,r3,32 \ Skip dropin header + mtspr ctr,r3 + bcctrl 20,0 + + mr r26,r3 \ Save firmware load address + mr r27,r4 \ Save firmware RAM size + +[ifdef] debug-reset + ascii 0 ?report +[then] + + " firmware" $find-dropin, \ Assemble call to find-dropin with literal arg + + lwz r4,12(r3) + cmpi 0,0,r4,0 + <> if + \ The firmware dropin is compressed, so we load the inflater into RAM + \ and use it to inflate the firmware into RAM + mr r28,r3 \ Save address of firmware dropin + + " inflate" $find-dropin, \ Assemble call to find-dropin with literal arg + + lwz r5,4(r3) \ Length of inflater + addi r4,r3,32 \ src: Base address of inflater code in ROM + inflate-offset addis r3,r26,* \ Dst: Base address of inflater + + memcpy bl * \ Returns dst + +\ XXX we might want to turn on the cache, or perhaps flush it +\ We should decide whether or not the cache is on when 'start' returns + + mtspr ctr,r3 + +[ifdef] debug-reset + dot bl * + mr r3,r28 dot bl * + mr r3,r26 dot bl * + mr r3,r27 dot bl * + ascii 1 ?report +[then] + + addi r3,r28,32 \ Address of compressed bits of firmware dropin + mr r4,r26 \ Firmware RAM address + workspace-offset addis r5,r26,* \ Scratch RAM for inflater + mr r6,r27 \ Firmware RAM size + add r1,r26,r27 \ Stack for inflater + addi r1,r1,h#-10 \ Because LR is saved at FP+8 + + bcctrl 20,0 \ Inflate the firmware + + else + \ The firmware dropin isn't compressed, so we just copy it to RAM + + addi r4,r3,32 \ Skip dropin header + lwz r5,4(r3) \ Length of image + mr r3,r26 \ Firmware RAM address + memcpy bl * \ Copy the firmware + then + +[ifdef] debug-reset + ascii 2 ?report +[then] + + mr r3,r26 \ Firmware RAM address + mr r4,r27 \ Firmware RAM size + + mtspr ctr,r26 + bcctrl 20,0 \ Execute the firmware + + \ Notreached, in theory + begin again +end-code + +[ifdef] debug-reset +startup my-entry put-branch +[then] + +\ Add padding so this entire module ends at address h# 1e0. Doing so makes +\ it easy to concatenate a dropin driver (with its 32-byte header) to handle +\ other exception vectors, the first of which begins at ROM offset h# 200 + +h# 1e0 pad-to + +end-assembling + +writing resetvec.di +asm-base here over - 0 " reset-vector" write-dropin +ofd @ fclose + +\ LICENSE_BEGIN +\ Copyright (c) 2007 FirmWorks +\ +\ Permission is hereby granted, free of charge, to any person obtaining +\ a copy of this software and associated documentation files (the +\ "Software"), to deal in the Software without restriction, including +\ without limitation the rights to use, copy, modify, merge, publish, +\ distribute, sublicense, and/or sell copies of the Software, and to +\ permit persons to whom the Software is furnished to do so, subject to +\ the following conditions: +\ +\ The above copyright notice and this permission notice shall be +\ included in all copies or substantial portions of the Software. +\ +\ THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, +\ EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF +\ MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND +\ NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE +\ LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION +\ OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION +\ WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. +\ +\ LICENSE_END Added: cpu/ppc/rombp.fth =================================================================== --- cpu/ppc/rombp.fth (rev 0) +++ cpu/ppc/rombp.fth 2007-07-05 17:19:17 UTC (rev 461) @@ -0,0 +1,69 @@ +purpose: Patches to allow limited breakpointing of ROM code +\ See license at end of file + +[ifndef] iabr! +code iabr! ( adr -- ) + mtspr iabr,tos + lwz tos,0(sp) + addi sp,sp,1cell +c; +[then] +headerless +: rom-op! ( op adr -- ) + 2dup instruction! ( op adr ) + 2dup op@ = if ( op adr ) + 2drop ( ) + else ( op adr ) + swap breakpoint-opcode = if ( adr ) + 2 or %msr 5 >> 1 and or ( iabr-val ) + else ( adr ) + drop 0 ( iabr-val=0 ) + then ( iabr-val ) + iabr! ( ) + then +; +: rom-at-bp? ( adr -- flag ) + iabr@ 2 and if + %msr 5 >> 1 and iabr@ 1 and = if + dup iabr@ 3 invert and = if drop breakpoint-opcode exit then + then + then + op@ +; +patch rom-op! instruction! op! +patch rom-at-bp? op@ at-breakpoint? + +headers + +stand-init: + h# 13 catch-exception +; +\ Hacros +: --bp --bp 0 iabr! ; : ++ ff30.0000 + ; +: t --bp ++ till ; \ till +: s ++ to %pc ; \ skip + + +\ LICENSE_BEGIN +\ Copyright (c) 2007 FirmWorks +\ +\ Permission is hereby granted, free of charge, to any person obtaining +\ a copy of this software and associated documentation files (the +\ "Software"), to deal in the Software without restriction, including +\ without limitation the rights to use, copy, modify, merge, publish, +\ distribute, sublicense, and/or sell copies of the Software, and to +\ permit persons to whom the Software is furnished to do so, subject to +\ the following conditions: +\ +\ The above copyright notice and this permission notice shall be +\ included in all copies or substantial portions of the Software. +\ +\ THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, +\ EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF +\ MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND +\ NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE +\ LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION +\ OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION +\ WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. +\ +\ LICENSE_END Added: cpu/ppc/rootnode.fth =================================================================== --- cpu/ppc/rootnode.fth (rev 0) +++ cpu/ppc/rootnode.fth 2007-07-05 17:19:17 UTC (rev 461) @@ -0,0 +1,117 @@ +purpose: Methods for root node +\ See license at end of file + +: root-map-in ( phys len -- virt ) + " /" " map-in" execute-device-method drop +; +: root-map-out ( virt len -- ) + " /" " map-out" execute-device-method drop +; + +dev / +extend-package + +hex + +\ Static methods +: decode-unit ( adr len -- phys ) push-hex $number if 0 then pop-base ; +: encode-unit ( phys -- adr len ) push-hex (u.) pop-base ; + +\ Not-necessarily-static methods +: open ( -- true ) true ; +: close ( -- ) ; + +: map-in ( phys size -- virt ) + in-real-mode? if drop exit then + over mmu-lowbits + pagesize round-up >r ( phys r: size' ) + chrp? if ( phys r: size' ) + dup fw-virt-base dup fw-virt-size + within if + r@ pagesize mmu-claim ( phys virt r: size' ) + else + \ Return virt=phys + dup mmu-highbits ( phys virt r: size' ) + then + else ( phys r: size' ) + r@ pagesize mmu-claim ( phys virt r: size' ) + then ( phys virt r: size' ) + >r dup mmu-highbits ( phys phys' r: size' virt ) + r> r> over >r ( phys phys' virt size r: virt ) + -1 mmu-map ( phys r: virt ) + mmu-lowbits r> + ( virtual ) +; +: map-out ( virtual size -- ) + in-real-mode? if 2drop exit then + chrp? if 2drop exit then + 2dup mmu-unmap mmu-release +; + +: dma-alloc ( size -- virt ) alloc-mem ; +: dma-free ( virt size -- ) free-mem ; + +: dma-map-in ( virt size cacheable -- devaddr ) + drop 2dup flush-d$-range drop ( virt ) + in-real-mode? 0= if + mmu-translate 0= abort" Invalid DMA address" drop ( phys ) + then +; +: dma-map-out ( virt devaddr size -- ) nip flush-d$-range ; + +: dma-sync ( virt devaddr size -- ) nip flush-d$-range ; +: dma-push ( virt devaddr size -- ) nip flush-d$-range ; +: dma-pull ( virt devaddr size -- ) nip flush-d$-range ; + +finish-device + +device-end + +\ Call this after the system-mac-address is determined, which is typically +\ done near the end of the probing process. +: set-system-id ( -- ) + system-mac-address dup if ( adr 6 ) + " /" find-device ( adr 6 ) + + \ Convert the six bytes of the MAC address into a string of the + \ form 0NNNNNNNNNN, where N is an uppercase hex digit. + push-hex ( adr 6 ) + + <# bounds swap 1- ?do ( ) + i c@ u# u# drop ( ) + -1 +loop ( ) + 0 u# u#> ( adr len ) + + 2dup upper ( adr len ) \ Force upper case + + pop-base ( adr len ) + + encode-string " system-id" property ( ) + + device-end + else + 2drop + then +; +headers + +\ LICENSE_BEGIN +\ Copyright (c) 2007 FirmWorks +\ +\ Permission is hereby granted, free of charge, to any person obtaining +\ a copy of this software and associated documentation files (the +\ "Software"), to deal in the Software without restriction, including +\ without limitation the rights to use, copy, modify, merge, publish, +\ distribute, sublicense, and/or sell copies of the Software, and to +\ permit persons to whom the Software is furnished to do so, subject to +\ the following conditions: +\ +\ The above copyright notice and this permission notice shall be +\ included in all copies or substantial portions of the Software. +\ +\ THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, +\ EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF +\ MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND +\ NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE +\ LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION +\ OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION +\ WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. +\ +\ LICENSE_END Added: cpu/ppc/savefort.fth =================================================================== --- cpu/ppc/savefort.fth (rev 0) +++ cpu/ppc/savefort.fth 2007-07-05 17:19:17 UTC (rev 461) @@ -0,0 +1,101 @@ +purpose: Save the Forth dictionary to a file +\ See license at end of file + +\ save-forth ( filename -- ) +\ Saves the Forth dictionary to a file so it may be later used under Unix +\ +\ save-image ( header-adr header-len filename -- ) +\ Primitive save routine. Saves the dictionary image to a file. +\ The header is placed at the start of the file. The latest definition +\ whose name is the same as the "init-routine-name" argument is +\ installed as the init-io routine. + +only forth also hidden also forth definitions + + +headerless +: swap-size ( -- n ) here >swap-map-size ; +: be-lput ( adr -- ) + l@ lbsplit ofd @ fputc ofd @ fputc ofd @ fputc ofd @ fputc +; +: be-fputs ( adr len -- ) bounds ?do i be-lput 4 +loop ; +: ?be-fputs ( adr len -- ) + 3 + 2 >> 0 ?do ( adr ) + dup i la+ ( adr adr' ) + i swap-map bittest if ( adr adr' ) + 4 ofd @ fputs ( adr ) + else ( adr adr' ) + be-lput ( adr ) + then ( adr ) + loop ( adr ) + drop +; +: save-image ( header header-len filename -- ) + ['] ($find-next) is $find-next + + new-file ( header header-len ) + in-little-endian? if + ( header header-len ) be-fputs \ Write header + origin text-size ?be-fputs \ Write dictionary + up@ user-size be-fputs \ Write user area + else + ( header header-len ) ofd @ fputs \ Write header + origin text-size ofd @ fputs \ Write dictionary + up@ user-size ofd @ fputs \ Write user area + then + swap-map swap-size ofd @ fputs \ Write swap map + ofd @ fclose +; +headers + +0 value growth-size + +: make-bin-header ( -- ) + h# 48000020 h_magic l! \ This is a b .+0x20 instruction + text-size h_tlen l! \ Set the text size in program header + user-size h_dlen l! \ Set the data size in program header + growth-size h_blen l! \ Set the bss size in program header + 0 h_slen l! \ Set the symbol size in program header + origin h_entry l! \ Set the current starting address + swap-size h_trlen l! \ Set the relocation size + 0 h_drlen l! \ Set the data relocation size +; + +\ Save an image of the target system in a file. +: save-forth ( str -- ) + 8 (align) \ Make sure image is 8 byte aligned + + >r + + make-bin-header + + " sys-init-io" $find-name is init-io + " sys-init" init-save + bin-header /bin-header r> save-image +; + +only forth also definitions + +\ LICENSE_BEGIN +\ Copyright (c) 2007 FirmWorks +\ +\ Permission is hereby granted, free of charge, to any person obtaining +\ a copy of this software and associated documentation files (the +\ "Software"), to deal in the Software without restriction, including +\ without limitation the rights to use, copy, modify, merge, publish, +\ distribute, sublicense, and/or sell copies of the Software, and to +\ permit persons to whom the Software is furnished to do so, subject to +\ the following conditions: +\ +\ The above copyright notice and this permission notice shall be +\ included in all copies or substantial portions of the Software. +\ +\ THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, +\ EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF +\ MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND +\ NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE +\ LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION +\ OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION +\ WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. +\ +\ LICENSE_END Added: cpu/ppc/savemeta.fth =================================================================== --- cpu/ppc/savemeta.fth (rev 0) +++ cpu/ppc/savemeta.fth 2007-07-05 17:19:17 UTC (rev 461) @@ -0,0 +1,81 @@ +purpose: Save the metacompiled kernel image into a file +\ See license at end of file + +hex +only forth labels also forth also definitions + +\ Program header +create header forth +h# 4800.0020 l, \ Branch past the header + 0 l, \ Text size, actual value will be set later + 0 l, \ Data size, actual value will be set later + 0 l, \ Bss size + 0 l, \ Symbol Table size + 0 l, \ Entry + 0 l, \ Text Relocation Size + 0 l, \ Data Relocation Size +\ End of header. +here header - constant /header + +only forth also meta also forth-h also definitions + +\ Save an image of the target system in the file whose name +\ is the argument on the stack. + +: doubleword-align ( n -- n' ) 7 + 7 invert and ; +: text-base ( -- adr ) origin-t >hostaddr ; +: text-size ( -- n ) here-t origin-t - doubleword-align ; +: swap-size ( -- n ) here-t >swap-map-size-t ; +: user-base ( -- adr ) userarea-t ; +: user-size ( -- n ) user-size-t doubleword-align ; +: save-meta ( str -- ) + + \ Doubleword alignment is required so that the user area image will + \ not be in the same doubleword as the end of the dictionary, thus + \ causing the copy loop to get the wrong value the first time. + begin here-t 7 and while 0 c,-t repeat + + new-file + + \ Set the text and data sizes in the program header + h# 4800.0020 header h# 0 + l-t! \ Branch past the header + text-size header h# 4 + l-t! \ Text size + user-size header h# 8 + l-t! \ Data size + 0 header h# 10 + l-t! \ Symbol table size + + 0 header h# 14 + l-t! \ Entry point + swap-size header h# 18 + l-t! \ Swap map size + + header /header ofd @ fputs + text-base text-size ofd @ fputs + user-base user-size ofd @ fputs + swap-map-t swap-size ofd @ fputs \ Swap map + + ofd @ fclose +; + +only forth also meta also definitions + +\ LICENSE_BEGIN +\ Copyright (c) 2007 FirmWorks +\ +\ Permission is hereby granted, free of charge, to any person obtaining +\ a copy of this software and associated documentation files (the +\ "Software"), to deal in the Software without restriction, including +\ without limitation the rights to use, copy, modify, merge, publish, +\ distribute, sublicense, and/or sell copies of the Software, and to +\ permit persons to whom the Software is furnished to do so, subject to +\ the following conditions: +\ +\ The above copyright notice and this permission notice shall be +\ included in all copies or substantial portions of the Software. +\ +\ THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, +\ EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF +\ MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND +\ NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE +\ LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION +\ OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION +\ WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. +\ +\ LICENSE_END Added: cpu/ppc/scrub.fth =================================================================== --- cpu/ppc/scrub.fth (rev 0) +++ cpu/ppc/scrub.fth 2007-07-05 17:19:17 UTC (rev 461) @@ -0,0 +1,70 @@ +purpose: Fast memory scrubbing +\ See license at end of file + +headerless +code (berase) ( adr #cache-blocks /dcache-block -- ) + \ /dcache-block is already in tos + lwz t1,0(sp) \ #cache-blocks in t1 + lwz t0,1cell(sp) \ Address in t0 + + mfspr t2,ctr + mtspr ctr,t1 + begin + dcbz r0,t0 + dcbf r0,t0 + add t0,t0,tos + countdown + mtspr ctr,t2 + + lwz tos,2cells(sp) + addi sp,sp,3cells +c; + +headers +\ Usage requirements: +\ adr must aligned on a cache line boundary +\ len must a multiple of the cache line size +\ the range must not overlap a 256 MB (h# 1000.0000) boundary +\ the data cache must be turned on +: berase ( adr len -- ) + dcache-on? 0= dup >r if dcache-on then + real-mode? 0= if + over h# f000.0000 and ( adr len adr' ) + dup h# 1000.0000 false 2 dbat ( adr len pa va len io? bat# dbat ) + bat! ( adr len ) + then + \ XXX dcbz does not work on some versions of 620 + 620-class? if + 0 fill + else + /dcache-block / /dcache-block (berase) ( ) + then + real-mode? 0= if + 0 0 2 dbat! + then + r> if dcache-off then +; + +\ LICENSE_BEGIN +\ Copyright (c) 2007 FirmWorks +\ +\ Permission is hereby granted, free of charge, to any person obtaining +\ a copy of this software and associated documentation files (the +\ "Software"), to deal in the Software without restriction, including +\ without limitation the rights to use, copy, modify, merge, publish, +\ distribute, sublicense, and/or sell copies of the Software, and to +\ permit persons to whom the Software is furnished to do so, subject to +\ the following conditions: +\ +\ The above copyright notice and this permission notice shall be +\ included in all copies or substantial portions of the Software. +\ +\ THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, +\ EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF +\ MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND +\ NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE +\ LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION +\ OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION +\ WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. +\ +\ LICENSE_END Added: cpu/ppc/scrub601.fth =================================================================== --- cpu/ppc/scrub601.fth (rev 0) +++ cpu/ppc/scrub601.fth 2007-07-05 17:19:17 UTC (rev 461) @@ -0,0 +1,53 @@ +purpose: Fast memory scrubbing - 601 version +\ See license at end of file + +\ Usage requirements: +\ adr must aligned on a cache line boundary +\ len must a multiple of the cache line size +\ the range must not overlap an 8 MB (h# 80.0000) boundary +\ the data cache must be turned on +: berase-range ( adr len -- ) + over h# ff80.0000 and dup h# 80.0000 false 2 i&dbats bat! + /dcache-block / /dcache-block (berase) + 0 0 2 ibat! +; +: berase-601 ( adr len -- ) + begin dup while ( adr len ) + \ Find the length of a piece that doesn't overlap a BAT boundary + over dup h# 7f.ffff or 1+ swap - ( adr len len-to-boundary ) + over umin ( adr len piece-len ) + >r over r@ berase-range ( adr len ) ( r: piece-len ) + r> /string ( adr' len' ) + repeat ( adr' 0 ) + 2drop +; +warning @ warning off +: berase ( adr len -- ) + 601? if berase-601 exit then + berase +; +warning ! + +\ LICENSE_BEGIN +\ Copyright (c) 2007 FirmWorks +\ +\ Permission is hereby granted, free of charge, to any person obtaining +\ a copy of this software and associated documentation files (the +\ "Software"), to deal in the Software without restriction, including +\ without limitation the rights to use, copy, modify, merge, publish, +\ distribute, sublicense, and/or sell copies of the Software, and to +\ permit persons to whom the Software is furnished to do so, subject to +\ the following conditions: +\ +\ The above copyright notice and this permission notice shall be +\ included in all copies or substantial portions of the Software. +\ +\ THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, +\ EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF +\ MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND +\ NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE +\ LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION +\ OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION +\ WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. +\ +\ LICENSE_END Added: cpu/ppc/scrub823.fth =================================================================== --- cpu/ppc/scrub823.fth (rev 0) +++ cpu/ppc/scrub823.fth 2007-07-05 17:19:17 UTC (rev 461) @@ -0,0 +1,57 @@ +purpose: Fast memory scrubbing +\ See license at end of file + +headerless +code (berase) ( adr #cache-blocks /dcache-block -- ) + \ /dcache-block is already in tos + lwz t1,0(sp) \ #cache-blocks in t1 + lwz t0,1cell(sp) \ Address in t0 + + mfspr t2,ctr + mtspr ctr,t1 + begin + dcbz r0,t0 + dcbf r0,t0 + add t0,t0,tos + countdown + mtspr ctr,t2 + + lwz tos,2cells(sp) + addi sp,sp,3cells +c; + +headers +\ Usage requirements: +\ adr must aligned on a cache line boundary +\ len must a multiple of the cache line size +\ the range must not overlap a 256 MB (h# 1000.0000) boundary +\ the data cache must be turned on +: berase ( adr len -- ) + dcache-on? 0= dup >r if dcache-on then + /dcache-block / /dcache-block (berase) ( ) + r> if dcache-off then +; + +\ LICENSE_BEGIN +\ Copyright (c) 2007 FirmWorks +\ +\ Permission is hereby granted, free of charge, to any person obtaining +\ a copy of this software and associated documentation files (the +\ "Software"), to deal in the Software without restriction, including +\ without limitation the rights to use, copy, modify, merge, publish, +\ distribute, sublicense, and/or sell copies of the Software, and to +\ permit persons to whom the Software is furnished to do so, subject to +\ the following conditions: +\ +\ The above copyright notice and this permission notice shall be +\ included in all copies or substantial portions of the Software. +\ +\ THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, +\ EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF +\ MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND +\ NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE +\ LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION +\ OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION +\ WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. +\ +\ LICENSE_END Added: cpu/ppc/segreg.fth =================================================================== --- cpu/ppc/segreg.fth (rev 0) +++ cpu/ppc/segreg.fth 2007-07-05 17:19:17 UTC (rev 461) @@ -0,0 +1,40 @@ +purpose: Segment register access words +\ See license at end of file + +code sr@ ( sr# -- n ) + rlwinm tos,tos,28,0,3 \ Convert to x000.0000 + mfsrin tos,tos +c; +code sr! ( n sr# -- ) + lwz t1,0(sp) + rlwinm tos,tos,28,0,3 \ Convert to x000.0000 + sync isync + mtsrin t1,tos + sync isync + lwz tos,1cell(sp) + addi sp,sp,2cells +c; + +\ LICENSE_BEGIN +\ Copyright (c) 2007 FirmWorks +\ +\ Permission is hereby granted, free of charge, to any person obtaining +\ a copy of this software and associated documentation files (the +\ "Software"), to deal in the Software without restriction, including +\ without limitation the rights to use, copy, modify, merge, publish, +\ distribute, sublicense, and/or sell copies of the Software, and to +\ permit persons to whom the Software is furnished to do so, subject to +\ the following conditions: +\ +\ The above copyright notice and this permission notice shall be +\ included in all copies or substantial portions of the Software. +\ +\ THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, +\ EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF +\ MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND +\ NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE +\ LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION +\ OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION +\ WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. +\ +\ LICENSE_END Added: cpu/ppc/spr.fth =================================================================== --- cpu/ppc/spr.fth (rev 0) +++ cpu/ppc/spr.fth 2007-07-05 17:19:17 UTC (rev 461) @@ -0,0 +1,456 @@ +purpose: Special Purpose Register access for 604 +\ See license at end of file + +\ XER register: spr 1. +\ contains overflow and carry bits and byte count for string instructions. +code xer@ ( -- n ) + stwu tos,-1cell(sp) + mfspr tos,xer +c; +code xer! ( n -- ) + mtspr xer,tos + lwz tos,0(sp) + addi sp,sp,1cell +c; + +\ link register: spr 8 +code lr@ ( -- n ) + stwu tos,-1cell(sp) + mfspr tos,lr +c; +code lr! ( n -- ) + mtspr lr,tos + lwz tos,0(sp) + addi sp,sp,1cell +c; + +\ count register: spr 9 +code ctr@ ( -- n) + stwu tos,-1cell(sp) + mfspr tos,ctr +c; +code ctr! ( n -- ) + mtspr ctr,tos + lwz tos,0(sp) + addi sp,sp,1cell +c; + +\ DSISR: spr 18 +\ contains the status and cause of the DSI or alignment exception. +\ updated along with DAR. + +code dsisr! ( n -- ) + mtspr dsisr,tos + lwz tos,0(sp) + addi sp,sp,1cell +c; +code dsisr@ ( -- n ) + stwu tos,-1cell(sp) + mfspr tos,dsisr +c; + +\ Data Address Register (DAR): spr 19 +\ contains the faulted address after a DSI or alignment exception. +code dar@ ( -- n) + stwu tos,-1cell(sp) + mfspr tos,dar +c; +\ is this register writable? (ry) +code dar! ( n -- ) + mtspr dar,tos + lwz tos,0(sp) + addi sp,sp,1cell +c; + +\ ------------------------------------------------------------- +\ These are defined in forthint.fth . They should be here. +\ +\ \ Decrementer: spr 22 +\ \ code dec! ( n -- ) +\ mtspr dec,tos +\ lwz tos,0(sp) +\ addi sp,sp,1cell +\ c; +\ code dec@ ( -- n ) +\ stwu tos,-1cell(sp) +\ mfspr tos,dec +\ c; + +\ SDR1 register: spr 25 +code sdr1@ ( -- n) + stwu tos,-1cell(sp) + mfspr tos,sdr1 +c; +code sdr1! ( n -- ) + mtspr sdr1,tos + lwz tos,0(sp) + addi sp,sp,1cell +c; + +\ machine status Save and Restore Registers (SRR0 - SRR1): spr 26 - 27 +code srr0@ ( -- n) + stwu tos,-1cell(sp) + mfspr tos,srr0 +c; +code srr0! ( n -- ) + mtspr srr0,tos + lwz tos,0(sp) + addi sp,sp,1cell +c; + +code srr1@ ( -- n) + stwu tos,-1cell(sp) + mfspr tos,srr1 +c; +code srr1! ( n -- ) + mtspr srr1,tos + lwz tos,0(sp) + addi sp,sp,1cell +c; + +\ SPRG0 to SPRG3: spr 272 - 275 +\ misc. spr for OS usage +code sprg0@ ( -- n) + stwu tos,-1cell(sp) + mfspr tos,sprg0 +c; +code sprg0! ( n -- ) + mtspr sprg0,tos + lwz tos,0(sp) + addi sp,sp,1cell +c; + +code sprg1@ ( -- n) + stwu tos,-1cell(sp) + mfspr tos,sprg1 +c; +code sprg1! ( n -- ) + mtspr sprg1,tos + lwz tos,0(sp) + addi sp,sp,1cell +c; + +code sprg2@ ( -- n) + stwu tos,-1cell(sp) + mfspr tos,sprg2 +c; +code sprg2! ( n -- ) + mtspr sprg2,tos + lwz tos,0(sp) + addi sp,sp,1cell +c; + +code sprg3@ ( -- n) + stwu tos,-1cell(sp) + mfspr tos,sprg3 +c; +code sprg3! ( n -- ) + mtspr sprg3,tos + lwz tos,0(sp) + addi sp,sp,1cell +c; + +\ external address register: spr 282. +\ used with eciwx and ecowx instructions only. +code ear@ ( -- n ) + stwu tos,-1cell(sp) + mfspr tos,ear +c; +\ is this register writable? (ry) +code ear! ( n -- ) + mtspr ear,tos + lwz tos,0(sp) + addi sp,sp,1cell +c; + +\ timebase register (for writing): spr 284 - 285. +\ use get-tb for reading. see getms.fth. +: put-tb ( tbu tbl -- ) + ." writing to Time Base Register pair not implemented. " cr +; + +\ processor version register: spr 287 (read only). +code pvr@ ( -- n ) + stwu tos,-1cell(sp) + mfspr tos,pvr +c; +: cpu-version ( -- n ) pvr@ lwsplit nip ; + +\ instruction Block Address Translation (BAT) registers: spr 528 - 535. +\ data Block Address Translation (BAR) registers: spr 536-543 +\ see bat.fth. + +\ Monitor Mode Control Register 0 (MMCR0): spr 952 +\ Performance Monitor Counters (PMC1-2): spr 953 - 954 +code mmcr0@ ( -- n ) + stwu tos,-1cell(sp) + mfspr tos,mmcr0 +c; +code mmcr0! ( n -- ) + mtspr mmcr0,tos + lwz tos,0(sp) + addi sp,sp,1cell +c; + +code pmc1@ ( -- n ) + stwu tos,-1cell(sp) + mfspr tos,pmc1 +c; +code pmc1! ( n -- ) + mtspr pmc1,tos + lwz tos,0(sp) + addi sp,sp,1cell +c; + +code pmc2@ ( -- n ) + stwu tos,-1cell(sp) + mfspr tos,pmc2 +c; +code pmc2! ( n -- ) + mtspr pmc2,tos + lwz tos,0(sp) + addi sp,sp,1cell +c; + +\ Sampled Instruction/Data Address (SIA, SDA): spr 955, 959 +code sia@ ( -- n ) + stwu tos,-1cell(sp) + mfspr tos,sia +c; +code sia! ( n -- ) + mtspr sia,tos + lwz tos,0(sp) + addi sp,sp,1cell +c; + +code sda@ ( -- n ) + stwu tos,-1cell(sp) + mfspr tos,sda +c; +code sda! ( n -- ) + mtspr sda,tos + lwz tos,0(sp) + addi sp,sp,1cell +c; + +\ Hardware Implementation Dependent Register (HID0): spr 1008. +code hid0@ ( -- n ) + stwu tos,-1cell(sp) + mfspr tos,hid0 +c; +code hid0! ( n -- ) + mtspr hid0,tos + lwz tos,0(sp) + addi sp,sp,1cell +c; + +\ Instr/Data Address Breakpoint Register (IABR, DABR): spr 1010, 1013. +code iabr@ ( -- n ) + stwu tos,-1cell(sp) + mfspr tos,iabr +c; +code iabr! ( n -- ) + mtspr iabr,tos + lwz tos,0(sp) + addi sp,sp,1cell +c; + +code dabr@ ( -- n ) + stwu tos,-1cell(sp) + mfspr tos,dabr +c; +code dabr! ( n -- ) + mtspr dabr,tos + lwz tos,0(sp) + addi sp,sp,1cell +c; + +\ Process Identification Register (PIR): spr 1023 +code pir@ ( -- n ) + stwu tos,-1cell(sp) + mfspr tos,pir +c; +code pir! ( n -- ) + mtspr pir,tos + lwz tos,0(sp) + addi sp,sp,1cell +c; + +code buscsr@ ( -- n ) \ 620-specific + stwu tos,-1cell(sp) + mfspr tos,buscsr +c; + +\ 603-Arthur L2 Cache Control Register (L2CR): spr 1017. +code l2cr@ ( -- n ) + stwu tos,-1cell(sp) + mfspr tos,l2cr +c; +code l2cr! ( n -- ) + mtspr l2cr,tos + lwz tos,0(sp) + addi sp,sp,1cell +c; + +\ 823-specific +code ic-csr@ ( -- n ) + stwu tos,-1cell(sp) + mfspr tos,ic-csr +c; +code ic-csr! ( n -- ) + sync + mtspr ic-csr,tos + isync + lwz tos,0(sp) + addi sp,sp,1cell +c; +code dc-csr@ ( -- n ) + stwu tos,-1cell(sp) + mfspr tos,dc-csr +c; +code dc-csr! ( n -- ) + sync + mtspr dc-csr,tos + lwz tos,0(sp) + addi sp,sp,1cell +c; + +code md-ctr@ ( -- n ) + stwu tos,-1cell(sp) + mfspr tos,md-ctr +c; +code md-ctr! ( n -- ) + mtspr md-ctr,tos + sync isync + lwz tos,0(sp) + addi sp,sp,1cell +c; +code md-epn@ ( -- n ) + stwu tos,-1cell(sp) + mfspr tos,md-epn +c; +code md-epn! ( n -- ) + mtspr md-epn,tos + sync isync + lwz tos,0(sp) + addi sp,sp,1cell +c; +code md-rpn@ ( -- n ) + stwu tos,-1cell(sp) + mfspr tos,md-rpn +c; +code md-rpn! ( n -- ) + mtspr md-rpn,tos + sync isync + lwz tos,0(sp) + addi sp,sp,1cell +c; +code md-twc@ ( -- n ) + stwu tos,-1cell(sp) + mfspr tos,md-twc +c; +code md-twc! ( n -- ) + mtspr md-twc,tos + sync isync + lwz tos,0(sp) + addi sp,sp,1cell +c; +code md-ap@ ( -- n ) + stwu tos,-1cell(sp) + mfspr tos,md-ap +c; +code md-ap! ( n -- ) + mtspr md-ap,tos + sync isync + lwz tos,0(sp) + addi sp,sp,1cell +c; +code md-cam@ ( -- n ) + stwu tos,-1cell(sp) + mfspr tos,md-cam +c; +code md-cam! ( n -- ) + eieio + mtspr md-cam,tos + lwz tos,0(sp) + addi sp,sp,1cell +c; +code md-ram0@ ( -- n ) + stwu tos,-1cell(sp) + mfspr tos,md-ram0 +c; +code md-ram0! ( n -- ) + mtspr md-ram0,tos + lwz tos,0(sp) + addi sp,sp,1cell +c; +code md-ram1@ ( -- n ) + stwu tos,-1cell(sp) + mfspr tos,md-ram1 +c; +code md-ram1! ( n -- ) + mtspr md-ram1,tos + lwz tos,0(sp) + addi sp,sp,1cell +c; +code m-twb@ ( -- n ) + stwu tos,-1cell(sp) + mfspr tos,m-twb +c; +code m-twb! ( n -- ) + mtspr m-twb,tos + lwz tos,0(sp) + addi sp,sp,1cell +c; +code m-casid@ ( -- n ) + stwu tos,-1cell(sp) + mfspr tos,m-casid +c; +code m-casid! ( n -- ) + mtspr m-casid,tos + lwz tos,0(sp) + addi sp,sp,1cell +c; + +code immr@ ( -- n ) + stwu tos,-1cell(sp) + mfspr tos,immr +c; +code immr! ( n -- ) + mtspr immr,tos + lwz tos,0(sp) + addi sp,sp,1cell +c; +code der@ ( -- n ) + stwu tos,-1cell(sp) + mfspr tos,der +c; +code der! ( n -- ) + mtspr immr,tos + lwz tos,0(sp) + addi sp,sp,1cell +c; + +\ LICENSE_BEGIN +\ Copyright (c) 2007 FirmWorks +\ +\ Permission is hereby granted, free of charge, to any person obtaining +\ a copy of this software and associated documentation files (the +\ "Software"), to deal in the Software without restriction, including +\ without limitation the rights to use, copy, modify, merge, publish, +\ distribute, sublicense, and/or sell copies of the Software, and to +\ permit persons to whom the Software is furnished to do so, subject to +\ the following conditions: +\ +\ The above copyright notice and this permission notice shall be +\ included in all copies or substantial portions of the Software. +\ +\ THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, +\ EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF +\ MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND +\ NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE +\ LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION +\ OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION +\ WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. +\ +\ LICENSE_END Added: cpu/ppc/swapdic.fth =================================================================== --- cpu/ppc/swapdic.fth (rev 0) +++ cpu/ppc/swapdic.fth 2007-07-05 17:19:17 UTC (rev 461) @@ -0,0 +1,74 @@ +purpose: Byte-swap the Forth dictionary +\ See license at end of file + +\needs bittest fload ${BP}/forth/lib/bitops.fth + +: lbflip ( n -- n' ) + lbsplit swap 2swap swap bljoin +; +: xlflips ( adr len -- ) + bounds ?do i l@ i la1+ l@ i l! i la1+ l! 2 /l* +loop +; + +h# 20 constant /iheader +0 value /image +0 value /itext +0 value /iuser +0 value /iswap +0 value text-base +0 value user-base +0 value swap-map +0 value buf + +: ?lbflips ( -- ) + /itext 4 / 0 do + i swap-map bittest 0= if text-base i la+ dup l@ lbflip swap l! loop + loop +; + +: +buf ( offset -- adr ) buf + ; +: little-endian-ify ( "infile" "outfile" -- ) + reading writing + + ifd @ fsize to /image + /image 8 round-up alloc-mem to buf + buf /image ifd @ fgets drop ifd @ fclose + + 4 +buf be-l@ to /itext + 8 +buf be-l@ to /iuser + h# 18 +buf be-l@ to /iswap + /iheader +buf to text-base + text-base /itext + to user-base + user-base /iuser + to swap-map + + buf /iheader lbflips + ?lbflips + user-base /iuser lbflips + buf /image xlflips + + buf /image ofd @ fputs ofd @ fclose +; + +\ LICENSE_BEGIN +\ Copyright (c) 2007 FirmWorks +\ +\ Permission is hereby granted, free of charge, to any person obtaining +\ a copy of this software and associated documentation files (the +\ "Software"), to deal in the Software without restriction, including +\ without limitation the rights to use, copy, modify, merge, publish, +\ distribute, sublicense, and/or sell copies of the Software, and to +\ permit persons to whom the Software is furnished to do so, subject to +\ the following conditions: +\ +\ The above copyright notice and this permission notice shall be +\ included in all copies or substantial portions of the Software. +\ +\ THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, +\ EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF +\ MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND +\ NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE +\ LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION +\ OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION +\ WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. +\ +\ LICENSE_END Added: cpu/ppc/syscall.fth =================================================================== --- cpu/ppc/syscall.fth (rev 0) +++ cpu/ppc/syscall.fth 2007-07-05 17:19:17 UTC (rev 461) @@ -0,0 +1,195 @@ +purpose: Low-level I/O interface for use with the C "wrapper" program +\ See license at end of file + +\ The C program provides the Forth kernel with an array of entry-points +\ into C subroutines for performing the actual system calls. +\ This scheme should be reasonably compatible with nearly any Unix +\ implementation. The only difference would be in the implementation of +\ "syscall", which has to look up the address of the actual system call +\ C routine in the system call table provided to it by the C program loader. +\ It then has to convert the stack arguments into the same form as is +\ expected by the C system call routines. This obviously depends on the +\ details of the C calling sequence, but should not be too hard because +\ C compilers usually pass arguments on the stack. +\ Syscall is defined in the kernel, because it is needed for basics like +\ key and emit. + +decimal + +/l ualloc-t dup equ syscall-user# +user syscall-vec \ long address of system call vector +nuser sysretval + +\ I/O for running under an OS with a C program providing actual I/O routines + +meta +code syscall ( call# -- ) + lwz r3,0(sp) \ Get some arguments + lwz r4,4(sp) + lwz r5,8(sp) + lwz r6,12(sp) + lwz r7,16(sp) + lwz r8,20(sp) + + 'user syscall-vec lwz t0,* \ Get address of system call table + cmpi 0,0,t0,0 + 0<> if + andi. r0,t0,1 \ If low bit is set, this is not a TOC-based system + 0<> if + rlwinm t0,t0,0,0,30 \ Clear low bit + lwzx t2,t0,tos \ Code address in t2 + else + lwzx t1,t0,tos \ ptr-glue address in t1 + lwz t2,0(t1) \ Code address + lwz r2,4(t1) \ New TOC + then + mtspr lr,t2 + bclrl 20,0 + mtspr ctr,up \ Restore CTR + else + tw 0,tos,tos \ XXX Hack for use with simulator + then + + 'user sysretval stw r3,* \ Save the result + + lwz tos,0(sp) \ Fix stack + addi sp,sp,4 +c; +: retval ( -- return_value ) sysretval l@ ; +: lretval ( -- l.return_value ) sysretval l@ ; + +nuser errno \ The last system error code +: error? ( return-value -- return-value error? ) + dup 0< dup if 60 syscall retval errno ! then ( return-value flag ) +; + +true value powerpc? \ As opposed to POWER. Set by startup code + +code u/mod (s u.dividend u.divisor -- u.remainder u.quotient ) + second-to-t0 \ dividend + 'user powerpc? lwz t3,* + cmpi 0,0,t3,0 + 0= if \ Use POWER division (RS/6000) + mtspr mq,t0 + addi t0,r0,0 + div t1,t0,tos \ quotient in t1 + mfspr t2,mq + else + divwu t1,t0,tos \ quotient in t1 + mullw t2,t1,tos \ quot*divisor in t2 + subfc t2,t2,t0 \ remainder in t2 \ Use subfc for POWER compatibility + then + stw t2,0(sp) \ Put remainder on stack + mr tos,t1 \ Put quotient on stack +c; + +: / (s n1 n2 -- quot ) /mod nip ; +: mod (s n1 n2 -- rem ) /mod drop ; + +\ 32*32->64 bit unsigned multiply +\ y rs2 y rd + +code um* ( n1 n2 -- x[lo hi] ) + second-to-t0 + 'user powerpc? lwz t3,* + cmpi 0,0,t3,0 + 0= if \ Use POWER, not PowerPC, division + mul tos,t0,tos + mfspr t1,mq + else + mullw t1,t0,tos + mulhwu tos,t0,tos + then + stw t1,0(sp) +c; + +code m* ( n1 n2 -- low high ) + second-to-t0 + 'user powerpc? lwz t3,* \ "patch" div instr for simulator + cmpi 0,0,t3,0 + 0= if \ Use POWER, not PowerPC multiplication + mul tos,t0,tos + mfspr t1,mq + else + mullw t1,t0,tos + mulhw tos,t0,tos + then + stw t1,0(sp) +c; + +\ Rounds down to a block boundary. This causes all file accesses to the +\ underlying operating system to occur on disk block boundaries. Some +\ systems (e.g. CP/M) require this; others which don't require it +\ usually run faster with alignment than without. + +\ Aligns to a 512-byte boundary +hex +: _falign ( l.byte# fd -- l.aligned ) drop 1ff invert and ; +: _dfalign ( d.byte# fd -- d.aligned ) drop swap 1ff invert and swap ; + +code $sim-find-next (s adr len link -- adr len alf true | adr len false ) + mr r6,tos + mr r5,base + lwz r4,0(sp) + lwz r3,1cell(sp) + addi sp,sp,-4 + mr r7,sp + twi 0,tos,0 + or. tos,tos,tos + 0= if + addi sp,sp,4 + then +c; + +: set-endian ( -- ) + here off 1 here c! here @ 1 = is in-little-endian? +; + +\ : aix-flush-cache ( adr -- adr ) 4 swap sys-flush-cache nip ; +: sys-init-io ( -- ) +\ ['] drop origin - ['] set-swap-bit >body >user ! + install-wrapper-io +\ ['] aix-flush-cache is flush-cache + install-disk-io + \ Don't poll the keyboard under Unix; block waiting for a key + ['] (key ['] key (is + syscall-vec @ 0= if ['] $sim-find-next is $find-next then + + set-endian + +\ allocate-buffers + +\ init-keyboard +\ init-disk-files + +\ decimal +; +' sys-init-io is init-io + +: sys-init ; \ Environment initialization chain +' sys-init is init-environment +decimal + +\ LICENSE_BEGIN +\ Copyright (c) 2007 FirmWorks +\ +\ Permission is hereby granted, free of charge, to any person obtaining +\ a copy of this software and associated documentation files (the +\ "Software"), to deal in the Software without restriction, including +\ without limitation the rights to use, copy, modify, merge, publish, +\ distribute, sublicense, and/or sell copies of the Software, and to +\ permit persons to whom the Software is furnished to do so, subject to +\ the following conditions: +\ +\ The above copyright notice and this permission notice shall be +\ included in all copies or substantial portions of the Software. +\ +\ THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, +\ EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF +\ MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND +\ NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE +\ LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION +\ OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION +\ WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. +\ +\ LICENSE_END Added: cpu/ppc/tagwords.fth =================================================================== --- cpu/ppc/tagwords.fth (rev 0) +++ cpu/ppc/tagwords.fth 2007-07-05 17:19:17 UTC (rev 461) @@ -0,0 +1,132 @@ +purpose: Tag all words that are executed; show all tagged words. +\ See license at end of file + +hex + +\ Generic tools for acting on all words + +defer each ( nfa -- ) ' drop to each +: every ( voc -- ) + follow begin another? while each repeat +; +: everywhere ( xt -- ) + to each + voc-link begin another-link? while ( v-link ) + voc> dup every ( voc ) + >voc-link ( v-link' ) + repeat +; + +\ verbose version +hidden also +: .vname ( voc -- ) + ??cr cr .in ['] vocabulary .name space .name cr +; +: show-every ( xt -- ) + to each + voc-link begin another-link? while ( v-link ) + voc> + dup .vname + dup follow + begin another? while + each + exit? if drop exit then + repeat + >voc-link ( v-link' ) + repeat +; +previous forth + +\ \ For reference... +\ label next +\ lwzu w,/token(ip) \ w has token of next word to execute +\ lwzux t1,w,base \ t1 has offset of its code field +\ add t1,t1,base \ t1 has acf +\ mtspr lr,t1 \ go there +\ bclr 20,0 +\ end-code + +\ Special version of "next" tags any word that is executed +label tagnext + lwzu w,/token(ip) \ w has token of next word to execute + + add t1,w,base \ t2 has acf + set t2,h#-10.0000 \ offset to tags + add t1,t1,t2 \ t1 has address of tag byte + \ lbz t2,0(t1) + set t2,h#a5 \ set magic# to tag the word + stb t2,0(t1) + + \ back to "next", which is already in progress... + lwzux t1,w,base \ t1 has offset of its code + add t1,t1,base \ t1 has code address + mtspr lr,t1 \ go there + bclr 20,0 +end-code + +\ Turn on tagnext +: tnext ( -- ) + tagnext up@ - h# 3ffffff and h# 48000000 or up@ instruction! +; +\ Revert to normal next +: nnext ( -- ) [ bug ] unbug [ forth ] ; + +\ \ an example +\ : tryit ( -- ) tnext bl word drop nnext ; + +: clear-tags ( -- ) + origin h# 10.0000 - here origin - erase +; + +\ variable tagged +\ : count-tagged ( nfa -- ) name> 10.0000 - c@ a5 = if 1 tagged +! then ; +\ : tagged? ( -- ) +\ 0 tagged ! +\ ['] count-tagged everywhere +\ tagged ? +\ ; + +: show-tagged? ( nfa -- ) + dup name> 10.0000 - c@ a5 = if + dup name>string nip .tab .id exit? if + exit + then + else + drop + then +; +decimal +: show-tagged ( -- ) + nnext + 0 lmargin ! 64 rmargin ! 14 tabstops ! ??cr + ['] show-tagged? show-every +; + +: stand-init-io ( -- ) + clear-tags tnext + stand-init-io +; + +\ LICENSE_BEGIN +\ Copyright (c) 2007 FirmWorks +\ +\ Permission is hereby granted, free of charge, to any person obtaining +\ a copy of this software and associated documentation files (the +\ "Software"), to deal in the Software without restriction, including +\ without limitation the rights to use, copy, modify, merge, publish, +\ distribute, sublicense, and/or sell copies of the Software, and to +\ permit persons to whom the Software is furnished to do so, subject to +\ the following conditions: +\ +\ The above copyright notice and this permission notice shall be +\ included in all copies or substantial portions of the Software. +\ +\ THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, +\ EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF +\ MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND +\ NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE +\ LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION +\ OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION +\ WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. +\ +\ LICENSE_END Added: cpu/ppc/target.fth =================================================================== --- cpu/ppc/target.fth (rev 0) +++ cpu/ppc/target.fth 2007-07-05 17:19:17 UTC (rev 461) @@ -0,0 +1,291 @@ +purpose: Metacompiler target configuration for PowerPC +\ See license at end of file + +only forth also meta definitions +defer init-relocation-t +defer set-relocation-bit-t + +decimal + +h# c000 constant max-kernel \ Maximum size of the kernel + +only forth also meta assembler definitions +: normal ( -- ) \ Perform target-dependent assembler initialization +; + +only forth also meta definitions + +: lobyte th 0ff and ; +: hibyte 8 >> lobyte ; + +2 constant /w-t +4 constant /l-t +/l-t constant /n-t +/l-t constant /a-t +/a-t constant /thread-t +/l-t constant /token-t +/l-t constant /link-t +/token-t constant /defer-t +/n-t th 800 * constant user-size-t +/n-t th 100 * constant ps-size-t +/n-t th 200 * constant rs-size-t +/l-t constant /user#-t + +\ 32 bit host Forth compiling 32-bit target Forth +: l->n-t ; immediate +: n->l-t ; immediate +: n->n-t ; immediate +: s->l-t ; immediate + +[ifdef] little-endian +\ little-endian versions +\ The address munging (7 xor) with c@/!-t is due to the fact that +\ the system loads the target image in big-endian mode, and then +\ switches to little-endian mode after executing a few instructions. +: c!-t ( n add -- ) >hostaddr 7 xor c! ; +: w!-t ( n add -- ) over lobyte over c!-t ca1+ swap hibyte swap c!-t ; +: l!-t ( l add -- ) >r lwsplit swap r@ w!-t r> /w-t + w!-t ; +: c@-t ( target-address -- n ) >hostaddr 7 xor c@ ; +: w@-t ( target-address -- n ) dup c@-t swap 1+ c@-t 8 << or ; +: l@-t ( target-address -- n ) dup >r /w-t + w@-t r> w@-t swap wljoin ; +[else] +\ big-endian versions +: c!-t ( n add -- ) >hostaddr c! ; +: w!-t ( n add -- ) over hibyte over c!-t ca1+ swap lobyte swap c!-t ; +: l!-t ( l add -- ) ( set-swap-bit-t ) >r lwsplit r@ w!-t r> /w-t + w!-t ; +: c@-t ( target-address -- n ) >hostaddr c@ ; +: w@-t ( target-address -- n ) dup c@-t 8 << swap 1+ c@-t or ; +: l@-t ( target-address -- n ) dup >r /w-t + w@-t r> w@-t wljoin ; +[then] + +: le-l!-t ( l add -- ) >r lwsplit swap r@ w!-t r> /w-t + w!-t ; +: be-l!-t ( l add -- ) >r lwsplit r@ w!-t r> /w-t + w!-t ; + +: !-t ( n add -- ) l!-t ; +: @-t ( target-address -- n ) l@-t ; + +\ Store target data types into the host address space. +: c-t! ( c host-address -- ) c! ; +: w-t! ( w host-address -- ) + over hibyte over c-t! ca1+ swap lobyte swap c-t! +; +: l-t! ( l host-address -- ) >r lwsplit r@ w-t! r> /w-t + w-t! ; +: n-t! ( n host-address -- ) l-t! ; + +: c,-t ( byte -- ) here-t dup set-swap-bit-t 1 allot-t c!-t ; +: w,-t ( word -- ) here-t /w-t allot-t w!-t ; +: l,-t ( long -- ) here-t /l-t allot-t l!-t ; + +: ,-t ( n -- ) l,-t ; \ for 32 bit stacks +: ,user#-t ( user# -- ) l,-t ; + +: a@-t ( target-address -- target-address ) l@-t ; +: a!-t ( token target-address -- ) ( set-relocation-bit-t ) l!-t ; +: token@-t ( target-address -- target-acf ) a@-t ; +: token!-t ( acf target-address -- ) a!-t ; + +: rlink@-t ( occurrence -- next-occurrence ) a@-t ; +: rlink!-t ( next-occurrence occurrence -- ) token!-t ; + + +\ Machine independent +: a,-t ( adr -- ) here-t /a-t allot-t a!-t ; +: token,-t ( token -- ) here-t /token-t allot-t token!-t ; + +\ These versions of linkx-t are for absolute links +: link@-t ( target-address -- target-address' ) a@-t ; +: link!-t ( target-address target-address -- ) a!-t ; +: link,-t ( target-address -- ) a,-t ; + +: a-t@ ( host-address -- target-address ) +[ also forth ] + dup origin here within over up@ dup user-size + within or if +[ previous ] + l@ + else + hostaddr> a@-t + then +; +: a-t! ( target-address host-address -- ) +[ also forth ] + dup origin here within over up@ dup user-size + within or if +[ previous ] + l! + else + hostaddr> a!-t + then +; +: rlink-t@ ( host-adr -- target-adr ) a-t@ ; +: rlink-t! ( target-adr host-adr -- ) a-t! ; + +: token-t@ ( host-address -- target-acf ) a-t@ ; +: token-t! ( target-acf host-address -- ) a-t! ; +: link-t@ ( host-address -- target-address ) a-t@ ; +: link-t! ( target-address host-address -- ) a-t! ; + +\ Machine independent +: a-t, ( target-address -- ) here /a-t allot a-t! ; +: token-t, ( target-address -- ) here /token-t allot token-t! ; +: >body-t ( cfa-t -- pfa-t ) + \ The code fields of DOES> and ;CODE words contain an extra token + " dodoes" ['] labels $vfind if + execute + over token@-t = if /token-t + then + else + drop + then + /token-t + +; + + +\ 32 constant #threads-t +1 constant #threads-t +create (threads-t) #threads-t 1+ /link-t * allot +: threads-t ( -- adr ) (threads-t) 7 + 7 invert and ; + +: $hash-t ( adr len voc-ptr -- thread ) + -rot nip #threads-t 1- and /thread-t * + +; + +\ Should allocate these dynamically. +\ The dictionary space should be dynamically allocated too. + +\ The user area image lives in the host address space. +\ We wish to store into the user area with -t commands so as not +\ to need separate words to store target items into host addresses. +\ That is why user+ returns a target address. + +\ Machine Independent + +0 constant userarea-t +: setup-user-area ( -- ) + user-size-t alloc-mem is userarea-t + userarea-t user-size-t erase +; + +: >user-t ( cfa-t -- user-address-t ) + >body-t + @-t + userarea-t + +; + +: n>link-t ( anf-t -- alf-t ) /link-t - ; +: l>name-t ( alf-t -- anf-t ) /link-t + ; + +decimal +/l constant #align-t +/l constant #talign-t +/l constant #linkalign-t +/l constant #acf-align-t +: aligned-t ( n1 -- n2 ) #align-t 1- + #align-t negate and ; +: acf-aligned-t ( n1 -- n2 ) #acf-align-t 1- + #acf-align-t negate and ; + +\ NullFix bl -> 0 +: align-t ( -- ) + begin here-t #align-t 1- and while 0 c,-t repeat +; +: talign-t ( -- ) + begin here-t #talign-t 1- and while 0 c,-t repeat +; +: linkalign-t ( -- ) + begin here-t #linkalign-t 1- and while 0 c,-t repeat +; +: acf-align-t ( -- ) talign-t ; + +: entercode ( -- ) + only forth also labels also meta also ppc-assembler + [ also ppc-assembler ] + ['] $ppc-assem-do-undefined is $do-undefined + [ previous ] +\ assembler +; + +\ Next 5 are Machine Independent +: cmove-t ( from to-t n -- ) + 0 do over c@ over c!-t 1+ swap 1+ swap loop 2drop +; +: place-cstr-t ( adr len cstr-adr-t -- cstr-adr-t ) + >r tuck r@ swap cmove-t ( len ) r@ + 0 swap c!-t r> +; +: "copy-t ( from to-t -- ) + over c@ 2+ cmove-t +; +: toggle-t ( addr-t n -- ) swap >r r@ c@-t xor r> c!-t ; + +: clear-threads-t ( hostaddr -- ) + #threads-t /link-t * bounds do + origin-t i link-t! + /link +loop +; +: initmeta ( -- ) + init-swap-t + threads-t #threads-t /link-t * bounds do + origin-t i link-t! + /link +loop + threads-t current-t ! +; + +\ For compiling branch offsets used by control constructs. +\ These compile relative branches. + +/l-t constant /branch +: branch! ( offset addr-t -- ) + over - ( from offset ) swap + l!-t +; +: branch, ( offset -- ) + here-t - + l,-t +; + +\ Store actions for some data structures. This has to be in this +\ file because it depends on the location of the user area (in some +\ versions, the user area has to be in the dictionary for +\ relocation to work right, but in other versions, the user area +\ is elsewhere. Ultimately, separate relocation for the user area is +\ needed. + +: isuser ( n acf -- ) >user-t n-t! ; +: istuser ( acf1 acf -- ) >user-t token-t! ; +: isvalue ( n acf -- ) >user-t n-t! ; +: isdefer ( acf acf -- ) >user-t token-t! ; + +: thread-t! ( thread adr -- ) link-t! ; + +only forth also meta also definitions +: install-target-assembler ( -- ) + [ assembler ] +\ ['] dp-t is asmdp + ['] here-t is here + ['] allot-t is asm-allot + ['] l@-t is asm@ + ['] l!-t is asm! + [ meta ] +; +: install-host-assembler ( -- ) + [ assembler ] resident-assembler [ meta ] +; + +\ LICENSE_BEGIN +\ Copyright (c) 2007 FirmWorks +\ +\ Permission is hereby granted, free of charge, to any person obtaining +\ a copy of this software and associated documentation files (the +\ "Software"), to deal in the Software without restriction, including +\ without limitation the rights to use, copy, modify, merge, publish, +\ distribute, sublicense, and/or sell copies of the Software, and to +\ permit persons to whom the Software is furnished to do so, subject to +\ the following conditions: +\ +\ The above copyright notice and this permission notice shall be +\ included in all copies or substantial portions of the Software. +\ +\ THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, +\ EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF +\ MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND +\ NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE +\ LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION +\ OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION +\ WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. +\ +\ LICENSE_END Added: cpu/ppc/testmmu.fth =================================================================== --- cpu/ppc/testmmu.fth (rev 0) +++ cpu/ppc/testmmu.fth 2007-07-05 17:19:17 UTC (rev 461) @@ -0,0 +1,175 @@ +purpose: Initialization code for PowerPC MMU +\ See license at end of file + +headerless +code v>p ( virt -- phys&mode ) + mr r3,tos + get-phys bl * + mr tos,r3 +c; +code vtopte ( virt -- vsid pteg ) + mr fault,tos + find-pte bl * + stwu vsid,-4(sp) + mr tos,pteg +c; +headers +: .htab htab /htab bounds do i @ if i . then 8 +loop ; + +headerless +list: translations-list + +: init-srs ( -- ) h# 10 0 do i i sr! loop ; + +[ifndef] initial-map +also forth definitions +: fw-base ( -- adr ) origin pagesize round-down ; + +headers +defer initial-map +: (initial-map) ( -- ) +[ '#adr-cells @ 2 = ] [if] +\ 0 0 0 2000.0000 -1 map \ Memory + + 0 0 over 2.0000 -1 map \ Hash table and trap vectors + 2.0000 0 over fw-base over - -1 map \ program load area + e0.0000 0 over 10.0000 -1 map \ Displacement flush area + f0.0000 0 over 10.0000 -1 map \ Firmware + + f100.0000 0 over 100.0000 -1 map \ Firmware I/O +\ 2000.0000 0 over e000.0000 -1 map \ I/O +[else] + 0 0 memsize -1 map \ Trap vects, pgm load area + fw-base virt-phys - fw-base htab /htab + over - -1 map \ Firmware +[then] + +[ifdef] io-base + io-base io-base h# 10000 -1 map +[then] +; +' (initial-map) to initial-map + +headerless +defer unmap-temp-io +: (unmap-temp-io) ( virt -- ) \ Remove temporary I/O mapping +[ifdef] io-base + dup io-base = if drop else h# 1000 unmap then +[else] + drop +[then] +; +' (unmap-temp-io) to unmap-temp-io +[then] +previous definitions +[then] + +: init-virtual-list ( -- ) + 0 memrange ! \ Clear free list + d# 500 memrange more-nodes \ Get enough nodes "forever" + + \ Create the available memory list from which the firmware is allowed + \ to dynamically allocate virtual memory. + + fw-virt-base fw-virt-size set-node fwvirt insert-after + + \ Setup the virtual list from which the firmware isn't permitted to allocate + 0 fw-virt-base add-os-piece + fw-virt-base fw-virt-size + ?dup if 0 add-os-piece then + +[ '#adr-cells @ 2 = ] [if] + \ XXX Claim the firmware and displacement flush areas for now + e0.0000 20.0000 claim-virtual drop +[else] + fw-base htab /htab + over - claim-virtual drop +[then] +; + +headers +warning off +: open ( -- ) + init-srs + + use-real-mode? if + install-bat-handler + setup-real-bat-table + clear-bats mapping-on + true exit + then + + set-mmu + + init-virtual-list + + translations-list to translations + + d# 50 translation-node more-nodes + + translations virt-phys - 4f8 ! \ physical + virt-phys 4fc ! \ virtual minus physical + 0 4f4 ! \ Replacement offset + save-state virt-phys - 4f0 ! \ fallback handler address + + init-paged-mmu + + initial-map + + configure-tlb + +[ifdef] install-tlb-miss +[ifdef] exponential + 704-class? if + install-exp-tlb-miss + else + install-tlb-miss + then +[else] + install-tlb-miss +[then] +[then] + + htab-dsi-handler h# 300 put-exception + htab-isi-handler h# 400 put-exception + + virt-phys if mapping-on clear-bats else clear-bats mapping-on then + + false to in-real-mode? + + true +; +warning on + +[ifdef] NOTYET +Allocate contiguous physical memory and add nodes to the translations +list. The memory should have one extra cell at the beginning, which is +the list head. Set "translations" to the virtual base address of the +beginning of that memory. +Store the difference between the physical and virtual base address of +that memory somewhere that the trap handler can find. +This is necessary because the fault handler runs in real mode, and needs +a convenient way to chase the list links without having to apply different +translations to different list nodes. +[then] + +\ LICENSE_BEGIN +\ Copyright (c) 2007 FirmWorks +\ +\ Permission is hereby granted, free of charge, to any person obtaining +\ a copy of this software and associated documentation files (the +\ "Software"), to deal in the Software without restriction, including +\ without limitation the rights to use, copy, modify, merge, publish, +\ distribute, sublicense, and/or sell copies of the Software, and to +\ permit persons to whom the Software is furnished to do so, subject to +\ the following conditions: +\ +\ The above copyright notice and this permission notice shall be +\ included in all copies or substantial portions of the Software. +\ +\ THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, +\ EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF +\ MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND +\ NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE +\ LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION +\ OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION +\ WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. +\ +\ LICENSE_END Added: cpu/ppc/tlb.fth =================================================================== --- cpu/ppc/tlb.fth (rev 0) +++ cpu/ppc/tlb.fth 2007-07-05 17:19:17 UTC (rev 461) @@ -0,0 +1,61 @@ +purpose: TLB invalidation +\ See license at end of file + +headerless +code invalidate-tlb-entry ( virtual -- ) + sync isync + tlbie tos + + mfspr tos,pvr + rlwinm tos,tos,16,16,31 + cmpi 0,0,tos,1 + <> if + tlbsync + then + + lwz tos,0(sp) + addi sp,sp,1cell +c; +code invalidate-tlb ( -- ) + 'user #tlb-lines lwz t0,* + + sync isync + rlwinm t0,t0,12,4,19 + + begin + addic. t0,t0,h#-1000 + tlbie t0 + 0= until + + mfspr t0,pvr + rlwinm t0,t0,16,16,31 + cmpi 0,0,t0,1 + <> if + tlbsync + then +c; +headers + +\ LICENSE_BEGIN +\ Copyright (c) 2007 FirmWorks +\ +\ Permission is hereby granted, free of charge, to any person obtaining +\ a copy of this software and associated documentation files (the +\ "Software"), to deal in the Software without restriction, including +\ without limitation the rights to use, copy, modify, merge, publish, +\ distribute, sublicense, and/or sell copies of the Software, and to +\ permit persons to whom the Software is furnished to do so, subject to +\ the following conditions: +\ +\ The above copyright notice and this permission notice shall be +\ included in all copies or substantial portions of the Software. +\ +\ THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, +\ EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF +\ MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND +\ NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE +\ LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION +\ OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION +\ WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. +\ +\ LICENSE_END Added: cpu/ppc/tlb601.fth =================================================================== --- cpu/ppc/tlb601.fth (rev 0) +++ cpu/ppc/tlb601.fth 2007-07-05 17:19:17 UTC (rev 461) @@ -0,0 +1,59 @@ +purpose: TLB invalidation for 601 +\ See license at end of file + +code invalidate-tlb-entry ( virtual -- ) + sync isync + tlbie tos + + mfspr tos,pvr + rlwinm tos,tos,16,16,31 + cmpi 0,0,tos,1 + <> if + tlbsync + then + + lwz tos,0(sp) + addi sp,sp,1cell +c; +code invalidate-tlb ( -- ) + 'user #tlb-lines lwz t0,* + + sync isync + rlwinm t0,t0,12,4,19 + + begin + addic. t0,t0,h#-1000 + tlbie t0 + 0= until + + mfspr tos,pvr + rlwinm tos,tos,16,16,31 + cmpi 0,0,tos,1 + <> if + tlbsync + then +c; + +\ LICENSE_BEGIN +\ Copyright (c) 2007 FirmWorks +\ +\ Permission is hereby granted, free of charge, to any person obtaining +\ a copy of this software and associated documentation files (the +\ "Software"), to deal in the Software without restriction, including +\ without limitation the rights to use, copy, modify, merge, publish, +\ distribute, sublicense, and/or sell copies of the Software, and to +\ permit persons to whom the Software is furnished to do so, subject to +\ the following conditions: +\ +\ The above copyright notice and this permission notice shall be +\ included in all copies or substantial portions of the Software. +\ +\ THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, +\ EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF +\ MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND +\ NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE +\ LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION +\ OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION +\ WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. +\ +\ LICENSE_END Added: cpu/ppc/tlbmiss.fth =================================================================== --- cpu/ppc/tlbmiss.fth (rev 0) +++ cpu/ppc/tlbmiss.fth 2007-07-05 17:19:17 UTC (rev 461) @@ -0,0 +1,318 @@ +purpose: TLB miss handlers for 603-style (software PTE search) MMU +\ See license at end of file + +also assembler definitions +\needs set-y : set-y ( -- ) h# 0020.0000 add-bits ; +previous definitions + +headerless +label itlb-miss + \ Adapted from the code in section 7.6.3.2.2 of the 603 manual + mfspr r2,hash1 \ PTEG address + mfspr r0,ctr \ Save CTR + mfspr r3,icmp \ Comparison value + begin + mfmsr r1 + andi. r1,r1,1 + <> if \ Little-endian + addi r2,r2,-4 \ Account for pre-increment and endianness + else + addi r2,r2,-8 \ Account for pre-increment + then + addi r1,0,8 \ PTEs per PTEG + mtspr ctr,r1 \ Load CTR + begin + lwzu r1,8(r2) \ Get first word of PTE + cmp 0,0,r1,r3 \ Found PTE? + = ctr=0 until + = if \ Found? + \ Found a matching TLB entry + mfmsr r1 + andi. r1,r1,1 + <> if \ Little-endian + addi r2,r2,-8 \ Bias address to account for endianness + then + lwz r1,4(r2) \ Get physical word of matching TLB entry + andi. r3,r1,8 \ Check G bit + 1 F: <> brif \ ISI because of ifetch of guarded page + + mtspr ctr,r0 \ Restore CTR + mfspr r0,imiss \ Miss address + mfspr r3,srr1 \ saved cr0 bits + mtcrf h#80,r3 \ Restore CR0 + mtspr rpa,r1 \ Set PTE + ori r1,r1,h#100 \ Set the reference bit + tlbli r0 \ Load the TLB entry + tlbsync \ wait for tlbli to complete + stw r1,4(r2) \ update page table with R bit set + sync \ wait for page table store to complete + rfi + then + + \ Not found; try secondary hash or signal exception + andi. r1,r3,h#40 \ See if we have done second hash + 0= while + mfspr r2,hash2 \ Try secondary hash + ori r3,r3,h#40 \ Set H bit in compare value + repeat + + \ No HTAB entry; let the normal IAE handler take care of it + mfspr r3,srr1 \ Get SRR1 + rlwinm r2,r3,0,16,31 \ Clear high bits + addis r2,r2,h#4000 \ Or in srr1<1> = 1 to flag PTE not found + 2 F: always brif \ Branch to common IAE code + +1 L: \ Protection violation (guarded page) + mfspr r3,srr1 \ Get SRR1 + rlwinm r2,r3,0,16,31 \ Clear high bits + addis r2,r2,h#0800 \ Or in srr1<4> = 1 to flag prot. violation + +2 L: \ Common code for instruction access exception + mtspr ctr,r0 \ Restore CTR + mtspr srr1,r2 \ Put back fixed SRR1 + mfmsr r0 \ Get MSR + xoris r0,r0,h#0002 \ Flip the MSR<tgpr> bit + mtcrf h#80,r3 \ Restore CR0 + mtmsr r0 \ Go back to the normal GPRs + h# 400 ba * \ Go to the normal ISI handler +end-code +here itlb-miss - constant /itlb-miss + +\ This handler is used for both load and store exceptions because, since +\ we don't do demand paging, we need not maintain the "C" (changed) bit. + +label dtlb-r-miss + \ Adapted from the code in section 7.6.3.2.2 of the 603 manual + mfspr r2,hash1 \ PTEG address + mfspr r0,ctr \ Save CTR + mfspr r3,dcmp \ Comparison value + begin + mfmsr r1 + andi. r1,r1,1 + <> if \ Little-endian + addi r2,r2,-4 \ Account for pre-increment and endianness + else + addi r2,r2,-8 \ Account for pre-increment + then + addi r1,0,8 \ PTEs per PTEG + mtspr ctr,r1 \ Load CTR + begin + lwzu r1,8(r2) \ Get first word of PTE + cmp 0,0,r1,r3 \ Found PTE? + = ctr=0 until + = if + \ Found a matching TLB entry + mfmsr r1 + andi. r1,r1,1 + <> if \ Little-endian + addi r2,r2,-8 \ Bias address to account for endianness + then + lwz r1,4(r2) \ Get physical word of matching TLB entry + mtspr ctr,r0 \ Restore CTR + mfspr r0,dmiss \ Miss address + mfspr r3,srr1 \ saved cr0 bits + mtcrf h#80,r3 \ Restore CR0 + mtspr rpa,r1 \ Set PTE + ori r1,r1,h#100 \ Set the referenced bit + tlbld r0 \ Load the TLB entry + tlbsync \ Wait for tlbld to complete + stw r1,4(r2) \ Update TLB entry + sync \ Wait for page table store to complete + rfi + then + + \ Not found; try secondary hash or signal exception + andi. r1,r3,h#40 \ See if we have done second hash + 0= while + mfspr r2,hash2 \ Try secondary hash + ori r3,r3,h#40 \ Set H bit in compare value + repeat + + set r1,h#4000.0000 \ Set dsisr1<1> = 1 to flag PTE not found + + mfspr r3,srr1 \ Get SRR1 + mtspr ctr,r0 \ Restore CTR + rlwinm r2,r3,0,16,31 \ Clear upper bits of SRR1 + mtspr srr1,r2 \ Put back fixed SRR1 + mtspr dsisr,r1 \ Set DSISR + mfspr r1,dmiss \ Get miss address + + rlwinm. r2,r2,0,31,31 \ Test LE bit + <> if \ Little-endian + \ Note: this is naive; the processor's address + \ swizzling is size-dependent. However, this + \ is what the example code in the 603 data + \ book does. + xori r1,r1,7 \ convert to little-endian data address + then + + mtspr dar,r1 \ Set DAR + mfmsr r0 \ Get MSR + xoris r0,r0,h#0002 \ Flip the MSR<tgpr> bit + mtcrf h#80,r3 \ Restore CR0 + mtmsr r0 \ Go back to the normal GPRs + h# 300 ba * \ Go to the normal DSI handler +end-code +here dtlb-r-miss - constant /dtlb-r-miss + +label dtlb-w-miss + \ Adapted from the code in section 7.6.3.2.2 of the 603 manual + mfspr r2,hash1 \ PTEG address + mfspr r0,ctr \ Save CTR + mfspr r3,dcmp \ Comparison value + begin + mfmsr r1 + andi. r1,r1,1 + <> if \ Little-endian + addi r2,r2,-4 \ Account for pre-increment and endianness + else + addi r2,r2,-8 \ Account for pre-increment + then + addi r1,0,8 \ PTEs per PTEG + mtspr ctr,r1 \ Load CTR + begin + lwzu r1,8(r2) \ Get first word of PTE + cmp 0,0,r1,r3 \ Found PTE? + = ctr=0 until + = if + \ Found a matching TLB entry + + mfmsr r1 + andi. r1,r1,1 + <> if \ Little-endian + addi r2,r2,-8 \ Bias address to account for endianness + then + + lwz r1,4(r2) \ Get physical word of matching TLB entry + andi. r3,r1,h#80 \ Check the C bit + 0 F: = brif \ If (C==0) goto cEq0ChkProt (check prot modes) + +1 L: \ (ceq2:) + mtspr ctr,r0 \ Restore CTR + mfspr r0,dmiss \ Miss address + mfspr r3,srr1 \ saved cr0 bits + mtcrf h#80,r3 \ Restore CR0 + mtspr rpa,r1 \ Set PTE + tlbld r0 \ Load the TLB entry + tlbsync \ Wait for tlbld to complete + sync + rfi + then + + \ Not found; try secondary hash or signal exception + andi. r1,r3,h#40 \ See if we have done second hash + 0= while + mfspr r2,hash2 \ Try secondary hash + ori r3,r3,h#40 \ Set H bit in compare value + repeat + + set r1,h#4200.0000 \ Set dsisr1<1> = 1 to flag PTE not found, + \ <6>=1 to denote "store" operation) + 3 F: always brif + +2 L: + set r1,h#0a00.0000 \ Set dsisr1<4> = 1 to flag prot. violation + \ <6> = 1 to denote "store" operation +3 L: + mfspr r3,srr1 \ Get SRR1 + mtspr ctr,r0 \ Restore CTR + rlwinm r2,r3,0,16,31 \ Clear upper bits of SRR1 + mtspr srr1,r2 \ Put back fixed SRR1 + mtspr dsisr,r1 \ Set DSISR + mfspr r1,dmiss \ Get miss address + + rlwinm. r2,r2,0,31,31 \ Test LE bit + <> if \ Little-endian + \ Note: this is naive; the processor's address + \ swizzling is size-dependent. However, this + \ is what the example code in the 603 data + \ book does. + xori r1,r1,7 \ convert to little-endian data address + then + + mtspr dar,r1 \ Set DAR + mfmsr r0 \ Get MSR + xoris r0,r0,h#0002 \ Flip the MSR<tgpr> bit + mtcrf h#80,r3 \ Restore CR0 + mtmsr r0 \ Go back to the normal GPRs + h# 300 ba * \ Go to the normal DSI handler + +0 L: \ (cEq0ChkProt:) +\ We found the PTE in the page table and it has the +\ C (changed) bit set to zero. Check the protection bits. +\ PP: 00 SRSW +\ 01 SRWUR +\ 10 SRWURW +\ 11 SRUR + rlwinm. r3,r1,30,0,1 \ test PP + + < if \ if (PP==10 or PP==11) + andi. r3,r1,1 \ test PP[0] + 4 F: = brif set-y \ return if PP==10 + 2 B: always brif \ else Data Access Exception Protection (PP=11) + + then + + \ (chk0:) + \ PP==00 or PP==01 + \ Test MSR[PR] to determine protection violation. + + mfspr r3,srr1 \ get old msr + andi. r3,r3,0x4000 \ test PR bit + + <> if set-y \ if (PR!=0) + mfspr r3,dmiss \ get miss address + mfsrin r3,r3 \ get associated segment register + andis. r3,r3,0x2000 \ test Kp bit + 4 F: = brif set-y \ if (Kp==0) goto chk2 + 2 B: always brif \ else Data Access Exception Protection + then + + mfspr r3,dmiss \ get miss address (chk1:) + mfsrin r3,r3 \ get associated segment register + andis. r3,r3,0x4000 \ test Ks bit + 4 F: = brif set-y \ if (Ks==0) goto chk2 + 2 B: always brif \ else Data Access Exception Protection + +4 L: \ (chk2:) No protection violation + ori r1,r1,0x180 \ set reference and change bit + stw r1,4(r2) \ update page table + 1 B: always brif \ go back to main-line handler code + +end-code +here dtlb-w-miss - constant /dtlb-w-miss + +: put-handler ( adr exc-adr len -- ) 2dup 2>r move 2r> sync-cache ; + +: install-tlb-miss ( -- ) + software-tlb-miss? if + itlb-miss h# 1000 /itlb-miss put-handler \ Ifetch TLB miss + dtlb-r-miss h# 1100 /dtlb-r-miss put-handler \ Data load TLB miss + dtlb-w-miss h# 1200 /dtlb-w-miss put-handler \ Data store TLB miss + then +; +headers + +\ LICENSE_BEGIN +\ Copyright (c) 2007 FirmWorks +\ +\ Permission is hereby granted, free of charge, to any person obtaining +\ a copy of this software and associated documentation files (the +\ "Software"), to deal in the Software without restriction, including +\ without limitation the rights to use, copy, modify, merge, publish, +\ distribute, sublicense, and/or sell copies of the Software, and to +\ permit persons to whom the Software is furnished to do so, subject to +\ the following conditions: +\ +\ The above copyright notice and this permission notice shall be +\ included in all copies or substantial portions of the Software. +\ +\ THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, +\ EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF +\ MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND +\ NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE +\ LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION +\ OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION +\ WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. +\ +\ LICENSE_END Added: cpu/ppc/tlbms823.fth =================================================================== --- cpu/ppc/tlbms823.fth (rev 0) +++ cpu/ppc/tlbms823.fth 2007-07-05 17:19:17 UTC (rev 461) @@ -0,0 +1,127 @@ +purpose: TLB miss handlers for 823-style MMU +\ See license at end of file + +also assembler definitions +\needs set-y : set-y ( -- ) h# 0020.0000 add-bits ; +previous definitions + +headerless + +h# 00d constant twc-mem \ Unguarded, 8MB, writeback +h# 01f constant twc-io \ Guarded, 8MB, writethrough +h# 9fd constant rpn-mem \ Cacheable +h# 9ff constant rpn-io \ Cache inhibit + +\ On entry: +\ sprg0 = &exception-save-area (don't clobber it!) + +\ Save registers in: +\ sprg1 = cr +\ sprg2 = r2 +\ sprg3 = r3 + +label dtlb-miss + + mtspr sprg3,r3 \ Save R3 + mtspr sprg2,r2 \ Save R2 + + mfcr r3 + mtspr sprg1,r3 \ Save cr + + mfmsr r3 + rlwinm r3,r3,0,15,28,26 \ Disable DR + mtmsr r3 + + \ Generate new TLB + set r3,h#2000.0000 + mfspr r2,md-epn \ Get effective address + rlwinm r2,r2,0,0,19 + cmpl 0,0,r2,r3 + < if + twc-mem set r3,* + mtspr md-twc,r3 \ Table Walk Control Reg + rpn-mem set r3,* + else + twc-io set r3,* + mtspr md-twc,r3 \ Table Walk Control Reg + rpn-io set r3,* + then + + or r3,r3,r2 + mtspr md-rpn,r3 \ Real Page Number Reg + sync isync + + \ Restore registers + mfmsr r3 + ori r3,r3,h#10 \ Enable DR + mtmsr r3 + + mfspr r3,sprg1 + mtcrf h#ff,r3 \ Restore CR + mfspr r2,sprg2 \ Restore R2 + mfspr r3,sprg3 \ Restore R3 + + \ Return from interrupt + rfi +end-code +here dtlb-miss - constant /dtlb-miss + +: init-dtlb ( -- ) + 0 m-casid! \ Current address space + 0 md-ap! \ Access protection groups + h# 0400.0000 md-ctr! \ PowerPC mode, Page res protection, TWAN=1 + \ DTLB_INDX dec mod 8, ignore problem/privilege + \ DTLB_INDX=0 +; +: init-tlb-entries ( -- ) + h# 0000.0200 md-epn! \ EPN=0 + twc-mem md-twc! + h# 0000.0000 rpn-mem or md-rpn! \ RPN=EPN + + h# 0080.0200 md-epn! \ EPN=80.0000 + twc-mem md-twc! + h# 0080.0000 rpn-mem or md-rpn! \ RPN=EPN + + h# fa20.0200 md-epn! \ EPN=FA20.0000 + twc-io md-twc! + h# fa20.0000 rpn-io or md-rpn! \ RPN=EPN +; +defer init-tlb ' init-dtlb to init-tlb + +: put-handler ( adr exc-adr len -- ) 2dup 2>r move 2r> sync-cache ; + +: install-tlb-miss ( -- ) + software-tlb-miss? if + dtlb-miss h# 1200 /dtlb-miss put-handler \ Data TLB miss + then + \ Redirect the implementation-dependent emulation trap, which + \ is what the 8xx PPC core generates instead of the usual program + \ interrupt, to the program interrupt vector. + h# 700 h# 1000 put-branch +; +headers + + +\ LICENSE_BEGIN +\ Copyright (c) 2007 FirmWorks +\ +\ Permission is hereby granted, free of charge, to any person obtaining +\ a copy of this software and associated documentation files (the +\ "Software"), to deal in the Software without restriction, including +\ without limitation the rights to use, copy, modify, merge, publish, +\ distribute, sublicense, and/or sell copies of the Software, and to +\ permit persons to whom the Software is furnished to do so, subject to +\ the following conditions: +\ +\ The above copyright notice and this permission notice shall be +\ included in all copies or substantial portions of the Software. +\ +\ THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, +\ EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF +\ MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND +\ NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE +\ LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION +\ OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION +\ WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. +\ +\ LICENSE_END Added: cpu/ppc/tmmu823.fth =================================================================== --- cpu/ppc/tmmu823.fth (rev 0) +++ cpu/ppc/tmmu823.fth 2007-07-05 17:19:17 UTC (rev 461) @@ -0,0 +1,114 @@ +purpose: Initialization code for PowerPC 823 MMU +\ See license at end of file + +headerless +: dmapping-on ( -- ) msr@ h# 10 or msr! ; +: dmapping-off ( -- ) msr@ h# 10 invert and msr! ; + +headerless +list: translations-list + +[ifndef] initial-map +also forth definitions +: fw-base ( -- adr ) origin pagesize round-down ; + +headers +defer initial-map +: (initial-map) ( -- ) +[ '#adr-cells @ 2 = ] [if] +\ 0 0 0 2000.0000 -1 map \ Memory + + 0 0 over 2.0000 -1 map \ Hash table and trap vectors + 2.0000 0 over fw-base over - -1 map \ program load area + e0.0000 0 over 10.0000 -1 map \ Displacement flush area + f0.0000 0 over 10.0000 -1 map \ Firmware + + f100.0000 0 over 100.0000 -1 map \ Firmware I/O +\ 2000.0000 0 over e000.0000 -1 map \ I/O +[else] + 0 0 memsize -1 map \ Trap vects, pgm load area + fw-base virt-phys - fw-base 20.0000 -1 map \ Firmware +[then] +; +' (initial-map) to initial-map + +headerless +defer unmap-temp-io ' noop to unmap-temp-io +[then] +previous definitions +[then] + +: init-virtual-list ( -- ) + 0 memrange ! \ Clear free list + d# 500 memrange more-nodes \ Get enough nodes "forever" + + \ Create the available memory list from which the firmware is allowed + \ to dynamically allocate virtual memory. + + fw-virt-base fw-virt-size set-node fwvirt insert-after + + \ Setup the virtual list from which the firmware isn't permitted to allocate + 0 fw-virt-base add-os-piece + fw-virt-base fw-virt-size + ?dup if 0 add-os-piece then + + fw-base 20.0000 claim-virtual drop +; + +headers +warning off +: open ( -- ) + init-virtual-list + + translations-list to translations + + d# 50 translation-node more-nodes + + translations virt-phys - 4f8 ! \ physical + virt-phys 4fc ! \ virtual minus physical + 0 4f4 ! \ Replacement offset + save-state virt-phys - 4f0 ! \ fallback handler address + + configure-tlb + init-tlb + invalidate-tlb + init-tlb-entries + initial-map + install-tlb-miss + dmapping-on + + true to in-real-mode? + true +; + +: tlb0! ( rpn -- ) + 200 md-epn! d md-twc! md-rpn! + md-ctr@ 700 invert and md-ctr! + 0 md-cam! + md-cam@ u. md-ram0@ u. md-ram1@ u. cr +; +warning on + + +\ LICENSE_BEGIN +\ Copyright (c) 2007 FirmWorks +\ +\ Permission is hereby granted, free of charge, to any person obtaining +\ a copy of this software and associated documentation files (the +\ "Software"), to deal in the Software without restriction, including +\ without limitation the rights to use, copy, modify, merge, publish, +\ distribute, sublicense, and/or sell copies of the Software, and to +\ permit persons to whom the Software is furnished to do so, subject to +\ the following conditions: +\ +\ The above copyright notice and this permission notice shall be +\ included in all copies or substantial portions of the Software. +\ +\ THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, +\ EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF +\ MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND +\ NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE +\ LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION +\ OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION +\ WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. +\ +\ LICENSE_END Added: cpu/ppc/tools.bth =================================================================== --- cpu/ppc/tools.bth (rev 0) +++ cpu/ppc/tools.bth 2007-07-05 17:19:17 UTC (rev 461) @@ -0,0 +1,49 @@ +purpose: Load file for Forth toolkit, without firmware +\ See license at end of file + +dictionary: ${BP}/cpu/ppc/build/kernel.dic +command: &ppcforth &dictionary &this +build-now + +\ ' $report-name is include-hook +\ ' noop is include-hook +\ : rn (cr 2dup type 15 spaces ; ' rn is include-hook + +create resident-packages + +fload ${BP}/forth/lib/fwsetup.fth + +transient +true value assembler? \ False to discard assembler after compilation +resident + +fload ${BP}/forth/lib/loadcomm.fth \ CPU-independent Forth tools +fload ${BP}/cpu/ppc/loadmach.fth \ CPU and OS-specific extensions + +[ifndef] no-heads +.( --- Saving tools.dic --- ) "" tools.dic save-forth cr +[then] + +\ LICENSE_BEGIN +\ Copyright (c) 2007 FirmWorks +\ +\ Permission is hereby granted, free of charge, to any person obtaining +\ a copy of this software and associated documentation files (the +\ "Software"), to deal in the Software without restriction, including +\ without limitation the rights to use, copy, modify, merge, publish, +\ distribute, sublicense, and/or sell copies of the Software, and to +\ permit persons to whom the Software is furnished to do so, subject to +\ the following conditions: +\ +\ The above copyright notice and this permission notice shall be +\ included in all copies or substantial portions of the Software. +\ +\ THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, +\ EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF +\ MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND +\ NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE +\ LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION +\ OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION +\ WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. +\ +\ LICENSE_END Added: cpu/ppc/touchall.fth =================================================================== --- cpu/ppc/touchall.fth (rev 0) +++ cpu/ppc/touchall.fth 2007-07-05 17:19:17 UTC (rev 461) @@ -0,0 +1,43 @@ +purpose: Forces all translations into the HTAB +\ See license at end of file + +: touch ( -- ) + " /mmu" find-device + " translations" get-property abort" No translations property" ( adr len ) + begin dup while + decode-int >r ( r: virt ) + decode-int >r ( r: virt size ) + decode-int drop ( r: virt size ) \ Discard phys.hi + decode-int drop ( r: virt size ) \ Discard phys.lo + decode-int h# 20 and if ( r: virt size ) \ I/O + 2r> 2drop + else + r> r> swap bounds ?do i c@ drop pagesize +loop + then + repeat + 2drop +; + +\ LICENSE_BEGIN +\ Copyright (c) 2007 FirmWorks +\ +\ Permission is hereby granted, free of charge, to any person obtaining +\ a copy of this software and associated documentation files (the +\ "Software"), to deal in the Software without restriction, including +\ without limitation the rights to use, copy, modify, merge, publish, +\ distribute, sublicense, and/or sell copies of the Software, and to +\ permit persons to whom the Software is furnished to do so, subject to +\ the following conditions: +\ +\ The above copyright notice and this permission notice shall be +\ included in all copies or substantial portions of the Software. +\ +\ THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, +\ EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF +\ MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND +\ NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE +\ LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION +\ OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION +\ WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. +\ +\ LICENSE_END Added: cpu/ppc/unalign.fth =================================================================== --- cpu/ppc/unalign.fth (rev 0) +++ cpu/ppc/unalign.fth 2007-07-05 17:19:17 UTC (rev 461) @@ -0,0 +1,115 @@ +purpose: Unaligned memory access primitives +\ See license at end of file + +0 value in-little-endian? + +code unaligned-l@ (s adr -- l ) + 'user in-little-endian? lwz t1,* + cmpi 0,0,t1,0 + <> if \ Little endian + lbz t0,0(tos) \ low byte + lbz t1,1(tos) \ next byte + rlwimi t0,t1,8,16,23 + lbz t1,2(tos) \ next byte + rlwimi t0,t1,16,8,15 + lbz t1,3(tos) \ High byte + rlwimi t0,t1,24,0,7 + else \ Big endian + lbz t0,3(tos) \ low byte + lbz t1,2(tos) \ next byte + rlwimi t0,t1,8,16,23 + lbz t1,1(tos) \ next byte + rlwimi t0,t1,16,8,15 + lbz t1,0(tos) \ High byte + rlwimi t0,t1,24,0,7 + then + mr tos,t0 +c; +: unaligned-@ (s adr -- l ) unaligned-l@ ; +code unaligned-w@ (s adr -- w ) + 'user in-little-endian? lwz t1,* + cmpi 0,0,t1,0 + <> if \ Little endian + lbz t0,1(tos) \ High byte + lbz t1,0(tos) \ low byte + else \ Big endian + lbz t0,0(tos) \ High byte + lbz t1,1(tos) \ low byte + then + rlwimi t1,t0,8,16,23 + mr tos,t1 +c; +code unaligned-l! (s n adr -- ) + second-to-t0 \ n in t0 + + 'user in-little-endian? lwz t1,* + cmpi 0,0,t1,0 + <> if \ Little endian + stb t0,0(tos) + rlwinm t0,t0,24,0,31 + stb t0,1(tos) + rlwinm t0,t0,24,0,31 + stb t0,2(tos) + rlwinm t0,t0,24,0,31 + stb t0,3(tos) + else \ Big endian + \ XXX I think the hardware will do this for you + stb t0,3(tos) + rlwinm t0,t0,24,0,31 + stb t0,2(tos) + rlwinm t0,t0,24,0,31 + stb t0,1(tos) + rlwinm t0,t0,24,0,31 + stb t0,0(tos) + then + + pop1 +c; + +: unaligned-d! ( d adr -- ) + >r in-little-endian? if swap then + r@ unaligned-! r> na1+ unaligned-! +; + +: unaligned-! (s n adr -- ) unaligned-l! ; +code unaligned-w! (s w adr -- ) + second-to-t0 \ n in t0 + + 'user in-little-endian? lwz t1,* + cmpi 0,0,t1,0 + <> if \ Little endian + stb t0,0(tos) + rlwinm t0,t0,24,24,31 + stb t0,1(tos) + else \ Big endian + \ XXX I think the hardware will do this for you + stb t0,1(tos) + rlwinm t0,t0,24,24,31 + stb t0,0(tos) + then + pop1 +c; + +\ LICENSE_BEGIN +\ Copyright (c) 2007 FirmWorks +\ +\ Permission is hereby granted, free of charge, to any person obtaining +\ a copy of this software and associated documentation files (the +\ "Software"), to deal in the Software without restriction, including +\ without limitation the rights to use, copy, modify, merge, publish, +\ distribute, sublicense, and/or sell copies of the Software, and to +\ permit persons to whom the Software is furnished to do so, subject to +\ the following conditions: +\ +\ The above copyright notice and this permission notice shall be +\ included in all copies or substantial portions of the Software. +\ +\ THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, +\ EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF +\ MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND +\ NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE +\ LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION +\ OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION +\ WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. +\ +\ LICENSE_END Added: cpu/ppc/xadd.fth =================================================================== --- cpu/ppc/xadd.fth (rev 0) +++ cpu/ppc/xadd.fth 2007-07-05 17:19:17 UTC (rev 461) @@ -0,0 +1,45 @@ +purpose: 64-bit addition and subtraction +\ See license at end of file + +code x+ ( x1 x2 -- x3 ) + lwz t1,0(sp) \ x2.low + lwz t3,8(sp) \ x1.low + lwz t2,4(sp) \ x1.high + addi sp,sp,8 \ Pop args + addc t1,t1,t3 \ x3.low + adde tos,tos,t2 \ x3.high + stw t1,0(sp) \ Push result (x3.high already in tos) +c; +code x- ( x1 x2 -- x3 ) + lwz t1,0(sp) \ x2.low + lwz t2,4(sp) \ x1.high + lwz t3,8(sp) \ x1.low + addi sp,sp,8 \ Pop args + subfc t1,t1,t3 \ x3.low + subfe tos,tos,t2 \ x3.high + stw t1,0(sp) \ Push result (x3.high already in tos) +c; + +\ LICENSE_BEGIN +\ Copyright (c) 2007 FirmWorks +\ +\ Permission is hereby granted, free of charge, to any person obtaining +\ a copy of this software and associated documentation files (the +\ "Software"), to deal in the Software without restriction, including +\ without limitation the rights to use, copy, modify, merge, publish, +\ distribute, sublicense, and/or sell copies of the Software, and to +\ permit persons to whom the Software is furnished to do so, subject to +\ the following conditions: +\ +\ The above copyright notice and this permission notice shall be +\ included in all copies or substantial portions of the Software. +\ +\ THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, +\ EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF +\ MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND +\ NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE +\ LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION +\ OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION +\ WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. +\ +\ LICENSE_END

1 0

r460 - ofw/fs/fatfs
by svn＠openbios.org 05 Jul '07

05 Jul '07

Author: wmb Date: 2007-07-05 19:14:59 +0200 (Thu, 05 Jul 2007) New Revision: 460 Modified: ofw/fs/fatfs/lookup.fth Log: FAT filesystem - trivial performance optimization. Modified: ofw/fs/fatfs/lookup.fth =================================================================== --- ofw/fs/fatfs/lookup.fth 2007-07-05 17:14:30 UTC (rev 459) +++ ofw/fs/fatfs/lookup.fth 2007-07-05 17:14:59 UTC (rev 460) @@ -296,7 +296,7 @@ dup 1 >= if over c@ ascii \ = if 1 /string - fat-type c@ fat32 = if rdirclus l@ else 0 then + rdirclus l@ else dv_cwd-cl l@ then

1 0

r459 - ofw/fs/fatfs
by svn＠openbios.org 05 Jul '07

05 Jul '07

Author: wmb Date: 2007-07-05 19:14:30 +0200 (Thu, 05 Jul 2007) New Revision: 459 Modified: ofw/fs/fatfs/device.fth Log: FAT filesystem - trivial performance optimization. Modified: ofw/fs/fatfs/device.fth =================================================================== --- ofw/fs/fatfs/device.fth 2007-07-05 17:14:00 UTC (rev 458) +++ ofw/fs/fatfs/device.fth 2007-07-05 17:14:30 UTC (rev 459) @@ -14,7 +14,7 @@ fat-type c@ case fat12 of 2 * 3 / endof fat16 of 2/ endof - fat32 of 4 / endof + fat32 of 2/ 2/ endof endcase ;

1 0

r458 - forth/wrapper
by svn＠openbios.org 05 Jul '07

05 Jul '07

Author: wmb Date: 2007-07-05 19:14:00 +0200 (Thu, 05 Jul 2007) New Revision: 458 Modified: forth/wrapper/wrapper.c Log: wrapper.c - Changes the ifdefs to use standard GCC predefined macros like __linux__, instead of ad-hoc names like Linux, thus simplifying makefiles. Modified: forth/wrapper/wrapper.c =================================================================== --- forth/wrapper/wrapper.c 2007-07-05 17:12:04 UTC (rev 457) +++ forth/wrapper/wrapper.c 2007-07-05 17:14:00 UTC (rev 458) @@ -153,15 +153,16 @@ #define HOST_LITTLE_ENDIAN #endif -#ifdef Linux +#ifdef __linux__ char *host_os = "Linux"; #define SYS5 1 #ifdef HOSTPOWERPC #define LinuxPOWERPC char *host_cpu = "powerpc"; #else -# ifndef CKERNEL -# ifndef MIPS +# ifdef __i386__ +# ifndef CKERNEL + char *host_cpu = "x86"; # define LinuxX86 # define HOST_LITTLE_ENDIAN # endif @@ -398,7 +399,6 @@ INTERNAL long f_rmdir(); #ifdef SIM INTERNAL long printnum(); -extern int close(), open(); #endif #ifdef DLOPEN extern long dlopen(), dlsym(), dlerror(), dlclose(); @@ -1037,7 +1037,7 @@ signal(SIGFPE,exit_handler); signal(SIGBUS,exit_handler); signal(SIGSEGV,exit_handler); -#ifndef Linux +#ifndef __linux__ signal(SIGEMT,exit_handler); signal(SIGSYS,exit_handler); #endif @@ -1197,7 +1197,7 @@ } #endif -#ifdef Linux +#ifdef __linux__ static void /* set file associated with fd to */ waitchar (int fd) /* "wait for character" */ { @@ -1259,7 +1259,7 @@ #else # ifdef UNIX # ifdef SYS5 -# ifdef Linux +# ifdef __linux__ no_waitchar (0); nchars = read(0, &c[0], 1) > 0; waitchar (0); @@ -2356,7 +2356,7 @@ char *adr; long len; { -#if defined(Linux) && defined(MIPS) +#if defined(__linux__) && defined(MIPS) extern int cacheflush(char *addr, int nbytes, int cache); (void) cacheflush(adr, len, BCACHE); #endif

1 0

r457 - forth/lib
by svn＠openbios.org 05 Jul '07

05 Jul '07

Author: wmb Date: 2007-07-05 19:12:04 +0200 (Thu, 05 Jul 2007) New Revision: 457 Modified: forth/lib/cmdcpl.fth Log: Command completion - don't erase back to longest possible match. This helps when you try to complete a filename. Filename completion isn't implemented (and would be very hard to implement), but it isn't nice when someone tries to complete a filename and thus loses most of what they have already typed. Modified: forth/lib/cmdcpl.fth =================================================================== --- forth/lib/cmdcpl.fth 2007-07-05 17:09:48 UTC (rev 456) +++ forth/lib/cmdcpl.fth 2007-07-05 17:12:04 UTC (rev 457) @@ -153,6 +153,7 @@ /n +loop ( flag ) ; +0 [if] : do-erase ( -- ) \ Side effect: span and bufcursor may be reduced begin word-to-string ( addr ) @@ -163,6 +164,7 @@ cerase repeat ; +[then] : do-expand ( -- ) expand-initial-substring @@ -173,7 +175,9 @@ : expand-word ( -- ) collect-string find-candidates ( ) - #candidates @ if do-expand else do-erase then + #candidates @ if do-expand else +[ifdef] do-erase do-erase [else] beep [then] + then ; : show-candidates ( -- )

1 0

r456 - forth/kernel
by svn＠openbios.org 05 Jul '07

05 Jul '07

Author: wmb Date: 2007-07-05 19:09:48 +0200 (Thu, 05 Jul 2007) New Revision: 456 Modified: forth/kernel/kernel.fth Log: Kernel.fth - reinstated header on #-buf for PowerPC. Modified: forth/kernel/kernel.fth =================================================================== --- forth/kernel/kernel.fth 2007-07-05 17:09:11 UTC (rev 455) +++ forth/kernel/kernel.fth 2007-07-05 17:09:48 UTC (rev 456) @@ -88,8 +88,8 @@ 0 value tib +0 value #-buf headerless -0 value #-buf : init ( -- ) init [ /n h# 10 * 8 + ] literal dup alloc-mem + is #-buf /tib alloc-mem is tib

1 0

r455 - dev/olpc/cafenand
by svn＠openbios.org 05 Jul '07

05 Jul '07

Author: wmb Date: 2007-07-05 19:09:11 +0200 (Thu, 05 Jul 2007) New Revision: 455 Modified: dev/olpc/cafenand/cafenand.fth Log: OLPC CaFe NAND driver - relaxed a couple of timings per Marvell's recommendation. Modified: dev/olpc/cafenand/cafenand.fth =================================================================== --- dev/olpc/cafenand/cafenand.fth 2007-07-05 17:07:58 UTC (rev 454) +++ dev/olpc/cafenand/cafenand.fth 2007-07-05 17:09:11 UTC (rev 455) @@ -47,7 +47,7 @@ \ The following timing values are calculated from the Hynix and Samsung \ datasheets based on a clock cycle time of 10.4 nS. h# 1010.0900 h# 24 cl! \ Timing1 - h# 1.0101 h# 28 cl! \ Timing2 + h# 1.0102 h# 28 cl! \ Timing2 - recommended by Marvell h# 1000.0000 h# 2c cl! \ Timing3 ; [ifdef] notdef @@ -94,7 +94,7 @@ \ h# 90 4 1 >cmd constant read-id-cmd \ Not needed h# 20.0070 1 0 >cmd constant read-status-cmd h# 0420.0000 0 5 >cmd constant read-cmd -h# 0220.0080 0 5 >cmd constant write-cmd +h# 0220.0080 0 6 >cmd constant write-cmd \ The 6 adds a dummy address cycle to meet tADR for Hynix : wait-mask ( bitmask -- ) begin dup h# 10 cl@ and until ( bitmask )

1 0

r454 - cpu/x86
by svn＠openbios.org 05 Jul '07

05 Jul '07

Author: wmb Date: 2007-07-05 19:07:58 +0200 (Thu, 05 Jul 2007) New Revision: 454 Modified: cpu/x86/kernel.bth Log: Cleaned out some unused cruft that was already commented-out. Modified: cpu/x86/kernel.bth =================================================================== --- cpu/x86/kernel.bth 2007-06-26 17:17:25 UTC (rev 453) +++ cpu/x86/kernel.bth 2007-07-05 17:07:58 UTC (rev 454) @@ -4,8 +4,6 @@ command: &builder &this build-now -\ Copyright 1994 FirmWorks All Rights Reserved. - \ [ifdef] use-postfix-assembler \ use-postfix-assembler \ ' 386-assembler >link fence a! @@ -39,19 +37,9 @@ "" loadkern.fth last-filename "copy [then] -: lconstant constant ; -\needs lbsplit fload ${BP}/forth/lib/split.fth -\needs bitset fload ${BP}/forth/lib/bitops.fth -\ \needs name>string : name>string count ; -\ \needs id: alias id: \ -\ \needs purpose: alias purpose: \ -\ \needs copyright: alias copyright: \ -\ \needs round-up : round-up ( a b -- a' ) 1- tuck + swap not and ; - : resident ; fload ${BP}/forth/kernel/conft32.fth - fload ${BP}/forth/kernel/meta1.fth only forth also meta also definitions @@ -69,6 +57,7 @@ fload ${BP}/forth/kernel/forward.fth fload ${BP}/cpu/x86/fixvoc.fth fload ${BP}/forth/kernel/metacompile.fth + fload ${BP}/cpu/x86/metarel.fth only forth meta also forth also definitions

1 0

r157 - openbios-devel/arch/sparc32
by svn＠openbios.org 27 Jun '07

27 Jun '07

Author: blueswirl Date: 2007-06-27 22:25:34 +0200 (Wed, 27 Jun 2007) New Revision: 157 Modified: openbios-devel/arch/sparc32/entry.S Log: Allow boot start PC to be different from virtual location (boot mode) Modified: openbios-devel/arch/sparc32/entry.S =================================================================== --- openbios-devel/arch/sparc32/entry.S 2007-06-27 20:19:09 UTC (rev 156) +++ openbios-devel/arch/sparc32/entry.S 2007-06-27 20:25:34 UTC (rev 157) @@ -241,7 +241,7 @@ ba 2f nop 1: - lda [%g4] ASI_M_BYPASS, %g1 + lda [%g4] ASI_M_KERNELTXT, %g1 sta %g1, [%g3] ASI_M_BYPASS 2: cmp %g4, %g5 @@ -254,9 +254,11 @@ sta %g7, [%g2] ASI_M_MMUREGS ! set ctx table ptr set AC_M_CXR, %g2 sta %g0, [%g2] ASI_M_MMUREGS ! context 0 + set highmem, %g2 set 1, %g1 - sta %g1, [%g0] ASI_M_MMUREGS ! enable mmu - + jmp %g2 + sta %g1, [%g0] ASI_M_MMUREGS ! enable mmu +highmem: /* * The code which enables traps is a simplified version of * kernel head.S.

1 0

r156 - openbios-devel
by svn＠openbios.org 27 Jun '07

27 Jun '07

Author: blueswirl Date: 2007-06-27 22:19:09 +0200 (Wed, 27 Jun 2007) New Revision: 156 Modified: openbios-devel/Makefile Log: Hack for building on CIFS directory Modified: openbios-devel/Makefile =================================================================== --- openbios-devel/Makefile 2007-06-27 20:16:01 UTC (rev 155) +++ openbios-devel/Makefile 2007-06-27 20:19:09 UTC (rev 156) @@ -33,16 +33,21 @@ directories: clean @printf "Initializing build tree..." @mkdir $(ODIR) + @mkdir -p $(ODIR)/target @mkdir -p $(ODIR)/target/include + @mkdir -p $(ODIR)/target/arch @mkdir -p $(ODIR)/target/arch/unix @mkdir -p $(ODIR)/target/arch/$(ARCH) + @mkdir -p $(ODIR)/target/arch/ppc @mkdir -p $(ODIR)/target/arch/ppc/briq # no autodetection of those.. @mkdir -p $(ODIR)/target/arch/ppc/pearpc @mkdir -p $(ODIR)/target/arch/ppc/mol + @mkdir -p $(ODIR)/target/arch/x86 @mkdir -p $(ODIR)/target/arch/x86/xbox @mkdir -p $(ODIR)/target/libgcc @mkdir -p $(ODIR)/target/kernel @mkdir -p $(ODIR)/target/modules + @mkdir -p $(ODIR)/target/fs @mkdir -p $(ODIR)/target/fs/grubfs @mkdir -p $(ODIR)/target/fs/hfs @mkdir -p $(ODIR)/target/fs/hfsplus

1 0

r155 - in openbios-devel: arch/sparc32 drivers modules
by svn＠openbios.org 27 Jun '07

27 Jun '07

Author: blueswirl Date: 2007-06-27 22:16:01 +0200 (Wed, 27 Jun 2007) New Revision: 155 Modified: openbios-devel/arch/sparc32/boot.c openbios-devel/drivers/esp.c openbios-devel/drivers/obio.c openbios-devel/modules/bindings.c openbios-devel/modules/video.c Log: Fix pop_fstr_copy memory leaks - console one prevented Debian 3.1r1 from installing in console=prom mode - fixing this also needed the real malloc/free Modified: openbios-devel/arch/sparc32/boot.c =================================================================== --- openbios-devel/arch/sparc32/boot.c 2007-06-27 20:11:08 UTC (rev 154) +++ openbios-devel/arch/sparc32/boot.c 2007-06-27 20:16:01 UTC (rev 155) @@ -45,18 +45,18 @@ } else { switch (boot_device) { case 'a': - path = "/obio/SUNW,fdtwo"; + path = strdup("/obio/SUNW,fdtwo"); oldpath = "fd()"; unit = 0; break; case 'c': - path = "disk"; + path = strdup("disk"); oldpath = "sd(0,0,0):d"; unit = 0; break; default: case 'd': - path = "cdrom"; + path = strdup("cdrom"); // FIXME: hardcoding this looks almost definitely wrong. // With sd(0,2,0):b we get to see the solaris kernel though //oldpath = "sd(0,2,0):d"; @@ -64,7 +64,7 @@ unit = 2; break; case 'n': - path = "net"; + path = strdup("net"); oldpath = "le()"; unit = 0; break; Modified: openbios-devel/drivers/esp.c =================================================================== --- openbios-devel/drivers/esp.c 2007-06-27 20:11:08 UTC (rev 154) +++ openbios-devel/drivers/esp.c 2007-06-27 20:16:01 UTC (rev 155) @@ -279,8 +279,14 @@ *sd = &global_esp->sd[id]; #ifdef CONFIG_DEBUG_ESP - fword("my-args"); - DPRINTF("opening drive %d args %s\n", id, pop_fstr_copy()); + { + char *args; + + fword("my-args"); + args = pop_fstr_copy(); + DPRINTF("opening drive %d args %s\n", id, args); + free(args); + } #endif selfword("open-deblocker"); Modified: openbios-devel/drivers/obio.c =================================================================== --- openbios-devel/drivers/obio.c 2007-06-27 20:11:08 UTC (rev 154) +++ openbios-devel/drivers/obio.c 2007-06-27 20:16:01 UTC (rev 155) @@ -223,10 +223,13 @@ *address = *prop; fword("my-args"); args = pop_fstr_copy(); - if (args && args[0] == 'a') - *address += 4; + if (args) { + if (args[0] == 'a') + *address += 4; + //printk("zs_open: address %lx, args %s\n", *address, args); + free(args); + } - //printk("zs_open: address %lx, args %s\n", *address, args); RET ( -1 ); } Modified: openbios-devel/modules/bindings.c =================================================================== --- openbios-devel/modules/bindings.c 2007-06-27 20:11:08 UTC (rev 154) +++ openbios-devel/modules/bindings.c 2007-06-27 20:16:01 UTC (rev 155) @@ -253,6 +253,8 @@ if( !len ) return NULL; str = malloc( len + 1 ); + if( !str ) + return NULL; memcpy( str, p, len ); str[len] = 0; return str; Modified: openbios-devel/modules/video.c =================================================================== --- openbios-devel/modules/video.c 2007-06-27 20:11:08 UTC (rev 154) +++ openbios-devel/modules/video.c 2007-06-27 20:16:01 UTC (rev 155) @@ -253,6 +253,7 @@ addr = pop_fstr_copy(); console_draw_str(addr); + free(addr); PUSH(len); }

1 0

r154 - openbios-devel/arch/sparc32
by svn＠openbios.org 27 Jun '07

27 Jun '07

Author: blueswirl Date: 2007-06-27 22:11:08 +0200 (Wed, 27 Jun 2007) New Revision: 154 Modified: openbios-devel/arch/sparc32/romvec.c Log: Update totavail when memory is allocated by dumb memory allocator Modified: openbios-devel/arch/sparc32/romvec.c =================================================================== --- openbios-devel/arch/sparc32/romvec.c 2007-06-27 20:09:08 UTC (rev 153) +++ openbios-devel/arch/sparc32/romvec.c 2007-06-27 20:11:08 UTC (rev 154) @@ -53,8 +53,6 @@ static struct linux_romvec romvec0; -static unsigned long free_ram; - static void doublewalk(__attribute__((unused)) unsigned int ptab1, __attribute__((unused)) unsigned int va) { @@ -418,8 +416,9 @@ { static unsigned int next_free_address = 0xFFEDA000; - free_ram -= size; - DPRINTF("obp_dumb_memalloc req 0x%x of %d at 0x%x\n", va, size, free_ram); + totmap[0].num_bytes -= size; + DPRINTF("obp_dumb_memalloc req 0x%x of %d at 0x%x\n", va, size, + totmap[0].num_bytes); // If va is null, the allocator is supposed to pick a "suitable" address. // (See OpenSolaric prom_alloc.c) There's not any real guidance as @@ -432,7 +431,7 @@ DPRINTF("obp_dumb_memalloc req null -> 0x%x\n", va); } - obp_dumb_mmap(va, 0, free_ram, size); + obp_dumb_mmap(va, 0, totmap[0].num_bytes, size); return va; } @@ -499,8 +498,6 @@ void * init_openprom(unsigned long memsize) { - free_ram = va2pa((int)&_start) - PAGE_SIZE; - ptphys = totphys; ptmap = totmap; ptavail = totavail; @@ -514,7 +511,7 @@ totavail[0].theres_more = NULL; totavail[0].start_adr = (char *) 0; - totavail[0].num_bytes = free_ram; + totavail[0].num_bytes = va2pa((int)&_start) - PAGE_SIZE; totmap[0].theres_more = NULL; totmap[0].start_adr = &_start;

1 0

r153 - openbios-devel/arch/sparc32
by svn＠openbios.org 27 Jun '07

27 Jun '07

Author: blueswirl Date: 2007-06-27 22:09:08 +0200 (Wed, 27 Jun 2007) New Revision: 153 Modified: openbios-devel/arch/sparc32/lib.c Log: Get a real memory allocator for Sparc, based on PPC ofmem Modified: openbios-devel/arch/sparc32/lib.c =================================================================== --- openbios-devel/arch/sparc32/lib.c 2007-06-27 20:07:37 UTC (rev 152) +++ openbios-devel/arch/sparc32/lib.c 2007-06-27 20:09:08 UTC (rev 153) @@ -32,16 +32,127 @@ return i; } +typedef struct alloc_desc { + struct alloc_desc *next; + int size; /* size (including) this struct */ +} alloc_desc_t; + +typedef struct mem_range { + struct mem_range *next; + ulong start; + ulong size; +} range_t; + +typedef struct trans { + struct trans *next; + ulong virt; /* chain is sorted by virt */ + ulong size; + ulong phys; + int mode; +} translation_t; + +static struct { + char *next_malloc; + int left; + alloc_desc_t *mfree; /* list of free malloc blocks */ + + range_t *phys_range; + range_t *virt_range; + + translation_t *trans; /* this is really a translation_t */ +} ofmem; +#define ALLOC_BLOCK (64 * 1024) + void *malloc(int size) { - extern struct mem cmem; + alloc_desc_t *d, **pp; + char *ret; + extern struct mem cmem; - return mem_alloc(&cmem, size, 4); + if( !size ) + return NULL; + + if( size & 3 ) + size += 4 - (size & 3); + size += sizeof(alloc_desc_t); + + /* look in the freelist */ + for( pp=&ofmem.mfree; *pp && (**pp).size < size; pp = &(**pp).next ) + ; + + /* waste at most 4K by taking an entry from the freelist */ + if( *pp && (**pp).size < size + 0x1000 ) { + ret = (char*)*pp + sizeof(alloc_desc_t); + memset( ret, 0, (**pp).size - sizeof(alloc_desc_t) ); + *pp = (**pp).next; + return ret; + } + + if( !ofmem.next_malloc || ofmem.left < size) { + unsigned long alloc_size = ALLOC_BLOCK; + if (size > ALLOC_BLOCK) + alloc_size = size; + // Recover possible leftover + if (ofmem.left > sizeof(alloc_desc_t) + 4) { + alloc_desc_t *d; + + d = (alloc_desc_t*)ofmem.next_malloc; + d->size = ofmem.left - sizeof(alloc_desc_t); + free((unsigned long)d + sizeof(alloc_desc_t)); + } + + ofmem.next_malloc = mem_alloc(&cmem, alloc_size, 4); + ofmem.left = alloc_size; + } + + if( ofmem.left < size) { + printk("out of malloc memory (%x)!\n", size ); + return NULL; + } + d = (alloc_desc_t*) ofmem.next_malloc; + ofmem.next_malloc += size; + ofmem.left -= size; + + d->next = NULL; + d->size = size; + + ret = (char*)d + sizeof(alloc_desc_t); + memset( ret, 0, size - sizeof(alloc_desc_t) ); + return ret; } void free(void *ptr) { - /* Nothing yet */ + alloc_desc_t **pp, *d; + + /* it is legal to free NULL pointers (size zero allocations) */ + if( !ptr ) + return; + + d = (alloc_desc_t*)((unsigned long)ptr - sizeof(alloc_desc_t)); + d->next = ofmem.mfree; + + /* insert in the (sorted) freelist */ + for( pp=&ofmem.mfree; *pp && (**pp).size < d->size ; pp = &(**pp).next ) + ; + d->next = *pp; + *pp = d; } +void * +realloc( void *ptr, size_t size ) +{ + alloc_desc_t *d = (alloc_desc_t*)((unsigned long)ptr - sizeof(alloc_desc_t)); + char *p; + if( !ptr ) + return malloc( size ); + if( !size ) { + free( ptr ); + return NULL; + } + p = malloc( size ); + memcpy( p, ptr, MIN(d->size - sizeof(alloc_desc_t),size) ); + free( ptr ); + return p; +}

1 0

r152 - openbios-devel/drivers
by svn＠openbios.org 27 Jun '07

27 Jun '07

Author: blueswirl Date: 2007-06-27 22:07:37 +0200 (Wed, 27 Jun 2007) New Revision: 152 Modified: openbios-devel/drivers/iommu.c Log: Fix mapping more than 2G memory Modified: openbios-devel/drivers/iommu.c =================================================================== --- openbios-devel/drivers/iommu.c 2007-06-10 15:56:42 UTC (rev 151) +++ openbios-devel/drivers/iommu.c 2007-06-27 20:07:37 UTC (rev 152) @@ -93,7 +93,8 @@ pa &= ~(align - 1); p = (char *)pa2va(pa); - if (p >= t->uplim || p + size > t->uplim) + if ((unsigned long)p >= (unsigned long)t->uplim || + (unsigned long)p + size > (unsigned long)t->uplim) return 0; t->curp = p + size;

1 0

r453 - cpu/x86/pc/olpc
by svn＠openbios.org 26 Jun '07

26 Jun '07

Author: wmb Date: 2007-06-26 19:17:25 +0200 (Tue, 26 Jun 2007) New Revision: 453 Modified: cpu/x86/pc/olpc/usb8388.bth Log: OLPC - Minor fix to last commit to usb8388.bth Modified: cpu/x86/pc/olpc/usb8388.bth =================================================================== --- cpu/x86/pc/olpc/usb8388.bth 2007-06-26 15:46:28 UTC (rev 452) +++ cpu/x86/pc/olpc/usb8388.bth 2007-06-26 17:17:25 UTC (rev 453) @@ -5,7 +5,7 @@ fload ${BP}/cpu/x86/pc/olpc/versions.fth -" rm usb8388.bin" expand$ $sh +" rm -f usb8388.bin" expand$ $sh " wget -q http://dev.laptop.org/pub/firmware/libertas/usb8388-${WLAN_VERSION}.bin" expand$ $sh

1 0

r452 - cpu/x86/pc/olpc
by svn＠openbios.org 26 Jun '07

26 Jun '07

Author: wmb Date: 2007-06-26 17:46:28 +0200 (Tue, 26 Jun 2007) New Revision: 452 Modified: cpu/x86/pc/olpc/usb8388.bth Log: OLPC build process - Changed usb8388.bth to fetch the wireless firmware from http://dev.laptop.org/pub/firmware/libertas/ instead of a RedHat RPM repository. Modified: cpu/x86/pc/olpc/usb8388.bth =================================================================== --- cpu/x86/pc/olpc/usb8388.bth 2007-06-15 19:53:41 UTC (rev 451) +++ cpu/x86/pc/olpc/usb8388.bth 2007-06-26 15:46:28 UTC (rev 452) @@ -5,16 +5,16 @@ fload ${BP}/cpu/x86/pc/olpc/versions.fth -" rm -rf ./lib" $sh -" wget -O - http://download.fedora.redhat.com/pub/fedora/projects/olpc/development/i386… | rpm2cpio - | cpio -i -u --make-directories --no-absolute-filenames" expand$ $sh +" rm usb8388.bin" expand$ $sh +" wget -q http://dev.laptop.org/pub/firmware/libertas/usb8388-${WLAN_VERSION}.bin" expand$ $sh -\ reading libertas.version -\ here dup d# 50 ifd @ fgets ( adr len ) -\ ifd @ fclose ( adr len ) +" wget -q -O - http://dev.laptop.org/pub/firmware/libertas/MD5SUMS | grep ${WLAN_VERSION} >usb8388.md5" expand$ $sh -" cp ./lib/firmware/usb8388.bin ." $sh +" md5sum usb8388-${WLAN_VERSION}.bin | cmp - usb8388.md5" expand$ $sh +" mv usb8388-${WLAN_VERSION}.bin usb8388.bin" expand$ $sh + \ This forces the creation of a .log file, so we don't re-fetch writing usb8388.version " ${WLAN_VERSION}"n" expand$ ofd @ fputs

1 0

install/boot question
by gpguard-openbios＠yahoo.com 26 Jun '07

26 Jun '07

Hey folks, I wanted to create a VMware image that would boot into OpenBios, and simply present the user with a Forth command line. Is this feasible. In fact, taking the question up a level, how would you "install" OpenBIOS on any x86 machine? I have done Linux installs where you go through this process of formatting the disks, setting a swap, then placing a bootloader on the boot partition. I would assume that some sort of openbios "machine code" needs to be installed to the boot sector of the x86 machine in order for it to work. Is this correct, or am I missing something. Thanks for your help, as you can probably tell I am new to the list, and still trying to wrap my head around the OpenBIOS concepts. Geoff

2 1

r451 - cpu/x86/pc/olpc
by svn＠openbios.org 15 Jun '07

15 Jun '07

Author: wmb Date: 2007-06-15 21:53:41 +0200 (Fri, 15 Jun 2007) New Revision: 451 Modified: cpu/x86/pc/olpc/resume.bth Log: OLPC resume - reset DCON SMBus controller during resume by sending an address cycle. Modified: cpu/x86/pc/olpc/resume.bth =================================================================== --- cpu/x86/pc/olpc/resume.bth 2007-06-15 19:52:57 UTC (rev 450) +++ cpu/x86/pc/olpc/resume.bth 2007-06-15 19:53:41 UTC (rev 451) @@ -20,6 +20,7 @@ \ This code will be copied to RAM at suspend-base \ create save-display +create reset-smbus create restore-usb-power h# fe00.0000 constant gp-pa @@ -477,6 +478,45 @@ al lods dx inc al dx out \ Reg 6 al lods dx dec al dx out \ Reg 5 with the enable bit +[ifdef] reset-smbus + \ This little dance resets the DCON's SMbus interface + h# 1 # al mov \ START + h# 18b3 # dx mov \ SMBUS control 1 + al dx out \ Initiate an SMBUS cycle to the DCON + + \ We could split here and move the following down, so as to overlap + \ the delay time with other work, but it doesn't matter because the + \ later CaFe chip setup will stall anyway. + + d# 32 # cx mov \ Loop count (usually ready in 20 uS) + h# 18b1 # dx mov \ SMBUS status + begin + dx al in + h# 40 # al test + loope \ Wait for ready to accept byte or timeout + + h# 1a # al mov \ Address byte + h# 18b0 # dx mov \ SMBUS data + al dx out \ Initiate address out cycle + + \ Another possible split point, in case we should need to overlap + d# 256 # cx mov \ Loop count (usually ready in 172 uS) + h# 18b1 # dx mov \ SMBUS status + begin + dx al in + h# 50 # al test + loope \ Wait for done or error or timeout + + h# 2 # al mov \ Stop + h# 18b3 # dx mov \ SMBUS status + al dx out \ Initiate STOP + + h# 10 # al mov \ Ack NEGACK + h# 18b1 # dx mov \ SMBUS status + al dx out \ While acking the NEGACK + \ End of DCON SMbus reset dance +[then] + \ MFGPTs 0-5. MFGPT 6 and 7 are in the standby domain, live during suspend h# 1800 # dx mov \ MFGPT base port h# 18 # cx mov

1 0

r450 - dev/olpc/cafenand
by svn＠openbios.org 15 Jun '07

15 Jun '07

Author: wmb Date: 2007-06-15 21:52:57 +0200 (Fri, 15 Jun 2007) New Revision: 450 Modified: dev/olpc/cafenand/badblock.fth Log: CaFe NAND - suppress expected bad block messages because they confuse people. Modified: dev/olpc/cafenand/badblock.fth =================================================================== --- dev/olpc/cafenand/badblock.fth 2007-06-15 19:20:30 UTC (rev 449) +++ dev/olpc/cafenand/badblock.fth 2007-06-15 19:52:57 UTC (rev 450) @@ -288,7 +288,7 @@ bbt if usable-page-limit 0 ?do i block-bad? if - cr ." Skipping bad block" i .page-byte cr +\ cr ." Skipping bad block" i .page-byte cr else (cr i . i erase-block

1 0

r449 - cpu/x86/pc/olpc
by svn＠openbios.org 15 Jun '07

15 Jun '07

Author: wmb Date: 2007-06-15 21:20:30 +0200 (Fri, 15 Jun 2007) New Revision: 449 Modified: cpu/x86/pc/olpc/fw.bth Log: OLPC - Ignore game keys on B1 and lower systems; they don't work reliably there. Modified: cpu/x86/pc/olpc/fw.bth =================================================================== --- cpu/x86/pc/olpc/fw.bth 2007-06-15 19:19:29 UTC (rev 448) +++ cpu/x86/pc/olpc/fw.bth 2007-06-15 19:20:30 UTC (rev 449) @@ -439,9 +439,13 @@ 0 value game-key-mask -: read-game-keys ( -- f) +: read-game-keys ( -- ) [ifdef] lx-devel false exit [then] - atest? if true exit then + board-revision h# b20 < if + h# 100 to game-key-mask + exit + then + game-key@ dup to game-key-mask if ." Release the game key to continue" cr begin d# 100 ms game-key@ 0= until

1 0

r448 - dev/olpc/dcon
by svn＠openbios.org 15 Jun '07

15 Jun '07

Author: wmb Date: 2007-06-15 21:19:29 +0200 (Fri, 15 Jun 2007) New Revision: 448 Modified: dev/olpc/dcon/dconsmb.fth Log: OLPC DCON SMBus - The handling of missing ACKs from the device was wrong; the code wasn't waiting for the address cycle to finish before looking for the ACK. Modified: dev/olpc/dcon/dconsmb.fth =================================================================== --- dev/olpc/dcon/dconsmb.fth 2007-06-14 09:42:50 UTC (rev 447) +++ dev/olpc/dcon/dconsmb.fth 2007-06-15 19:19:29 UTC (rev 448) @@ -29,8 +29,17 @@ : smb-init ( -- ) smb-on smb-stop smb-off smb-on ; : smb-status ( -- b ) - 1 smb@ dup 1 smb! - dup h# 20 and abort" SMB Bus conflict" + 1 smb@ ( dup 1 smb! ) + dup h# 20 and if + smb-stop + h# 20 1 smb! + true abort" SMB Bus conflict" + then + dup h# 10 and if + smb-stop + h# 10 1 smb! \ Acknowledge NEGACK, only works after stop + true abort" No ACK" + then ; : wait-ready ( -- ) @@ -42,10 +51,7 @@ true abort" SMB wait-ready timed out" ; -: smb-byte-out ( b -- ) - wait-ready 0 smb! - smb-status h# 10 and abort" No ACK" -; +: smb-byte-out ( b -- ) wait-ready 0 smb! ; : wait-start ( -- ) d# 1000 0 do @@ -57,15 +63,12 @@ ; : smb-start ( addr-byte -- ) 1 3 smb! \ Start condition - wait-start - smb-byte-out \ Send address and R/W ; - : dcon@ ( reg# -- w ) - h# 1a smb-start smb-byte-out \ Address and reg# + h# 1a smb-start smb-byte-out wait-ready \ Address and reg# h# 1b smb-start \ Switch to read wait-ready 0 smb@ ( low-byte )

1 0

r447 - cpu/x86/pc/olpc
by svn＠openbios.org 14 Jun '07

14 Jun '07

Author: wmb Date: 2007-06-14 11:42:50 +0200 (Thu, 14 Jun 2007) New Revision: 447 Modified: cpu/x86/pc/olpc/fw.bth Log: OLPC - Added USB probing back into fastboot sequence at Quanta's request. Modified: cpu/x86/pc/olpc/fw.bth =================================================================== --- cpu/x86/pc/olpc/fw.bth 2007-06-11 10:23:45 UTC (rev 446) +++ cpu/x86/pc/olpc/fw.bth 2007-06-14 09:42:50 UTC (rev 447) @@ -541,6 +541,7 @@ probe-pci ?start-sound ['] false to interrupt-auto-boot? + probe-usb interpreter-init [ifndef] lx-devel enable-power-button @@ -548,7 +549,7 @@ auto-boot screen-ih stdout ! open-keyboard - optional-startup + ?usb-keyboard else banner probe-pci

1 0

r446 - cpu/x86/pc/olpc
by svn＠openbios.org 11 Jun '07

11 Jun '07

Author: wmb Date: 2007-06-11 12:23:45 +0200 (Mon, 11 Jun 2007) New Revision: 446 Modified: cpu/x86/pc/olpc/copynand.fth Log: xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx OLPC trac #498 - make ".img" check case-independent to fix problem noted in comment 17 - mixed or upper case spelling of ".img" prevent CRC checking. Modified: cpu/x86/pc/olpc/copynand.fth =================================================================== --- cpu/x86/pc/olpc/copynand.fth 2007-06-11 10:12:35 UTC (rev 445) +++ cpu/x86/pc/olpc/copynand.fth 2007-06-11 10:23:45 UTC (rev 446) @@ -59,7 +59,7 @@ : ?open-crcs ( -- ) - image-name$ + 4 - 4 " .img" $= if + image-name$ + 4 - " .img" caps-comp 0= if " crc" image-name$ + 3 - swap move image-name$ open-crcs else

1 0

r445 - dev/olpc/cafenand
by svn＠openbios.org 11 Jun '07

11 Jun '07

Author: wmb Date: 2007-06-11 12:12:35 +0200 (Mon, 11 Jun 2007) New Revision: 445 Added: dev/olpc/cafenand/ecc.fth Modified: dev/olpc/cafenand/cafenand.bth Log: Initial check-in of ECC code for CaFe NAND. It builds okay when added to the cafenand driver, but the main cafenand driver doesn't call it yet. Modified: dev/olpc/cafenand/cafenand.bth =================================================================== --- dev/olpc/cafenand/cafenand.bth 2007-06-08 05:44:36 UTC (rev 444) +++ dev/olpc/cafenand/cafenand.bth 2007-06-11 10:12:35 UTC (rev 445) @@ -9,6 +9,7 @@ FCode-version2 +fload ${BP}/dev/olpc/cafenand/ecc.fth fload ${BP}/dev/olpc/cafenand/cafenand.fth fload ${BP}/dev/olpc/cafenand/configure.fth fload ${BP}/dev/olpc/cafenand/badblock.fth Added: dev/olpc/cafenand/ecc.fth =================================================================== --- dev/olpc/cafenand/ecc.fth (rev 0) +++ dev/olpc/cafenand/ecc.fth 2007-06-11 10:12:35 UTC (rev 445) @@ -0,0 +1,436 @@ +\ CAFE NAND error correction +\ See license at end of file. + +hex + +: array! ( value index adr -- ) swap wa+ ! ; +: array@ ( index adr -- value ) swap wa+ @ ; + +\ Split or join a number, size of low half is n bits. +: #split ( x n -- x.lo x.hi ) + 2dup rshift ( x n x.hi ) + tuck >r ( x x.hi n r: x.hi ) + lshift xor ( x.lo r: x.hi ) + r> ( x.lo x.hi ) +; +: #join ( x.lo x.hi n -- x ) lshift or ; + + +\ The fields we use. 0 represents 0, 1 represents 1. + +\ Finite field of 64 elements: K := F_2[X]/(X**6+X+1) +\ X**n is represented by bit value 2**n +[ifdef] 386-assembler +code K* ( a b -- a*b ) + dx dx xor \ Result in DX + bx pop ax pop \ b in BX, a in AX + + 6 # cx mov \ Loop count in CX + begin + \ Accumulate B if low bit of a is set + 1 # al test 0<> if bx dx xor then + + \ Square B to give B' + bx bx add h# 40 # bx test 0<> if h# 43 # bx xor then + + \ Shift out low bit of A + 1 # ax shr + loopne + dx push +c; +[then] + +[ifndef] k* +\ This is "bit banging multiplication" with GF arithmetic +: K* ( a b -- a*b ) + 0 -rot 6 0 do ( res a b ) + \ Accumulate B if low bit of A is set + over 1 and if rot over xor -rot then ( res' a b ) + swap 2/ swap ( res a' b ) \ Next A bit + 2* dup h# 40 and if h# 43 xor then ( res a' b' ) \ "Square" B + loop ( res a b ) + 2drop ( a*b ) +; +[then] + +[ifdef] notdef \ Segher's original version +: KX* ( a -- aX ) 2* dup h# 40 and if h# 43 xor then ; + +: K* ( a b -- a*b ) + 0 6 0 do ( a b res ) + >r tuck ( b a b r: res ) + KX* >r ( b a r: res bX ) + 1 #split >r ( b a.lobit r: res bX a.hi ) + 0<> and ( b' r: res bX a.hi ) + r> r> rot ( a.hi bX b' r: res ) + r> xor ( a.hi bX res' ) + loop ( a.hi bX res ) + nip nip ( a*b ) +; +[then] + +\ Finite field of 4096 elements: L := K[X]/(X**2+X+A**-1) +\ with A the generator of K; aX+b is represented as 64a+b +\ This is place-value multiplication, GF style +: L* ( a b -- a*b ) + over 6 #split xor ( a b a' ) + over 6 #split xor ( a b a' b' ) + K* >r >r ( a r: a'*b' b ) + 6 #split ( a.lo a.hi r: a'*b' b ) + r> 6 #split ( a.lo a.hi b.lo b.hi r: a'*b' ) + rot K* ( a.lo b.lo a.hi*b.hi r: a'*b' ) + h# 21 K* >r ( a.lo b.lo r: a'*b' a.hi*b.hi*21 ) + K* dup r> ( a.lo*b.lo a.lo*b.lo a.hi*b.hi*21 r: a'*b' ) + xor swap ( hi a.lo*b.lo r: a'*b' ) + r> xor ( hi a.lo*b.lo^a'*b' ) + 6 #join ( a*b ) +; + +\ Inverse of 0 gives 0; this simplifies some algorithms +: Linv ( a -- a**-1 ) dup d# 10 0 do 2dup L* L* loop dup L* nip ; + + +\ Polynomials. Element i represents the X**i term, there are always 9 terms. + +\ Find the degree of a polynomial. The degree of the 0 polynomial is 0. +: poly-deg ( poly -- ) + 0 9 1 do ( 'poly degree ) + over i wa+ @ if drop i then ( 'poly degree' ) + loop ( 'poly degree ) + nip ( degree ) +; + +\ Set poly to multiplicative identity. +: poly-set-unity ( poly -- ) dup 9 /w* erase 1 swap ! ; + + +\ +\ Find the error locator polynomial by using the Berlekamp-Massey algorithm. +\ + +9 /w* buffer: _l \ Error locator polynomial - Lambda +9 /w* buffer: _b \ BM b polynomial + +: discrepancy ( syndrome len -- discr ) + tuck ( len syndrome len ) + 1- wa+ ( len end-adr ) + 0 ( len end-adr acc ) + rot 0 do ( end-adr acc ) + over i /w* - @ ( end-adr acc syndrome-data ) + i _l array@ L* ( end-adr acc syndrome*locator ) + xor ( end-adr acc' ) + loop ( end-adr acc ) + nip ( discr ) +; + +: bm-step-even ( discr r -- ) + 0 swap 1+ 0 do ( discr acc ) + 2dup L* ( discr acc discr*acc ) + i _l array@ xor i _l array! ( discr acc ) + i _b array@ swap i _b array! ( discr acc' ) + loop 2drop ( ) +; +: bm-step-odd ( discr r -- ) + 0 swap 1+ 0 do ( discr acc ) + over L* ( discr acc' ) + i _l array@ tuck xor i _l array! ( discr acc' ) + over Linv L* ( discr acc' ) + i _b array@ swap i _b array! ( discr acc' ) + loop 2drop ( ) +; +: bm-step ( discr r -- ) + dup 1 and if bm-step-odd else bm-step-even then +; + +: berlekamp-massey ( syndrome -- ) \ Leaves the result in _l + _l poly-set-unity ( syndrome ) + _b poly-set-unity ( syndrome ) + 9 1 do ( syndrome ) + dup i discrepancy ( syndrome discrepancy ) + i bm-step ( syndrome ) + loop drop ( ) +; + +\ Solving the error locator polynomial + +\ The roots of the locator polynomial. +variable nroots +4 /w* buffer: roots + +\ Evaluate the locator polynomial at given point. +: eval-l ( x -- l ) + 0 9 0 do ( x acc ) + over L* ( x acc' ) + 8 i - _l array@ ( x acc locator ) + xor ( x acc' ) + loop nip ( l ) +; + +: solve-locator ( -- unsolvable? ) + _l poly-deg dup nroots ! ( degree ) + dup 0= if drop true exit then \ paranoia + + \ special case for degree one polynomials + 1 = if 1 _l array@ Linv roots ! 0 exit then + + \ Otherwise we use the brute force approach of evaluating at every + \ possible point; the ones that evaluate to 0 are roots. + \ This is slow, but should happen extremely rarely in practice. + 0 h# 1000 0 do ( root# ) + i eval-l 0= if ( root# ) + i over roots array! ( root# ) + 1+ ( root#' ) + then ( root# ) + loop ( root# ) + nroots @ <> ( unsolvable? ) +; + +\ Finding the errors. + +\ Error evaluator polynomial. +4 /w* buffer: _o \ Omega +: compute-evaluator ( syndrome -- ) + 4 0 do ( syndrome ) + dup i 1+ discrepancy ( syndrome discrepancy ) + i _o array! ( syndrome ) + loop drop ( ) +; + +\ Error values per root. +: compute-num ( root -- num ) + dup Linv ( root root**-1 ) + 0 4 0 do ( root root**n num ) + over i _o array@ L* ( root root**n num _o*root**n ) + xor ( root root**n num' ) + >r over L* r> ( root root**n' num' ) + loop ( root root**n' num' ) + nip nip ( num ) +; +: compute-den ( root -- den ) + dup L* ( r ) \ r is root**2 + 1 0 ( r 1 den=0 ) + 4 0 do ( r r**n den ) + \ Accumulate the odd elements of the locator array + over i 2* 1+ _l array@ L* ( r r**n den locator*r**n ) + xor ( r r**n den' ) + >r over L* r> ( r r**n' den' ) + loop ( r r**n den ) + nip nip ( den ) +; +: compute-error ( root -- error ) + dup compute-num ( root num ) + swap compute-den ( num den ) + Linv L* ( num/den ) +; + +h# e01 constant alpha +\ Error location. +: compute-location ( root -- loc ) + >r 1 alpha ( loc alpha**n r: root ) + begin dup r@ <> while ( loc alpha**n r: root ) + swap 1+ swap alpha L* ( loc' alpha**n' r: root ) + repeat ( loc' alpha**n' r: root ) + + \ Segher says: + \ aa1 is a fudge factor to make the code indices line up with + \ the data block. The data is actually numbered from the + \ right, including the parity data. The roots of the locator + \ polynomial are the inverse of the data locations, so their + \ logarithm (computed just above) is the negative of element + \ inidces. The leftmost byte of the data is index h# 555, + \ so "h# aa1 -" does the whole mapping. + r> 2drop h# aa1 - ( loc ) +; + +[ifdef] later +: compute-location ( root -- loc ) + alpha 0 h# aa0 do ( root alpha**n ) + 2dup = if 2drop i unloop exit then ( root alpha**n ) + alpha L* ( root alpha**n' ) + -1 +loop ( root alpha**n' ) + 2drop -1 +; +[then] + +\ Correct the errors. +: xor-it ( x c-addr -- ) tuck c@ xor swap c! ; + +\ The "locs" below are indices into an array of 12-bit numbers. +\ The "values" below are 12-bit masks telling which bits to flip. + +\ (fix-error) +: (fix-error) ( data-adr value loc -- ) + rot over 3 * 2 / + >r ( value loc r: byte-adr ) + + \ If loc is 0, XOR the low 8 bits of the 12-bit value with the first byte + \ The other 4 bits (which are 0) would be for the nibble before start-of-buffer + + dup 0= if ( value loc r: byte-adr ) + drop r> xor-it exit + then ( value loc r: byte-adr ) + + \ If loc is 555, XOR the high 8 bit of the 12-bit value with the last byte + \ The other 4 bits would be for the nibble after end-of-buffer (in the + \ parity data). + dup h# 555 = if + drop 4 rshift r> xor-it exit + then ( value loc r: byte-adr ) + + 1 and if ( value r: byte-adr ) + \ XOR with the bytes at adr and adr+1 + dup 4 rshift ( value value.hi r: byte-adr ) + r@ xor-it ( value r: byte-adr ) + 4 lshift ( value.lo r: byte-adr ) + r> 1+ xor-it ( ) + else ( value loc r: byte-adr ) + \ XOR with the bytes at adr and adr-1 + dup 8 rshift ( value value.hi r: byte-adr ) + r@ 1- xor-it ( value r: byte-adr ) + r> xor-it ( ) + then ( ) +; + +: fix-error ( data value loc -- uncorrectable? ) + \ Impossible locations or values mean uncorrectable errors happened. + dup h# 55e u> if 3drop true exit then ( data value loc ) + +\ The use of "u>" above takes care of this possibility +\ dup 0< if 3drop true exit then ( data value loc ) + + dup 0= if ( data value loc ) + over h# f00 and if 3drop true exit then ( data value loc ) + then ( data value loc ) + + \ If the error is in out-of-band data, there is nothing to do. + dup h# 555 > if 3drop false exit then ( data value loc ) + + (fix-error) false ( uncorrectable? ) +; + +: fix-errors ( data -- uncorrectable? ) + nroots @ 0 do ( data ) + dup i roots array@ ( data data root ) + dup compute-error ( data data root value ) + swap compute-location ( data data value loc ) + fix-error if ( data ) + drop true unloop exit + then ( data ) + loop ( data ) + drop false ( uncorrectable? ) +; + +\ The only entry point for the whole thing. Syndromes is an array of cells, +\ data is at 2048 byte block. +: correct-ecc ( data syndrome -- uncorrectable? ) + dup berlekamp-massey ( data syndrome ) + solve-locator if 2drop true exit then ( data syndrome ) + compute-evaluator ( data ) + fix-errors ( uncorrectable? ) +; + +[ifdef] notdef +\ Test vectors +CREATE s1 001 , 6c6 , 291 , d91 , 1ef , e26 , a19 , 8c0 , +CREATE s2 0f8 , de1 , 5e5 , 287 , 566 , 756 , f5f , 253 , +CREATE s3 001 , 001 , 001 , 001 , 001 , 001 , 001 , 001 , +CREATE s4 41e , b7a , 37c , 885 , c32 , a87 , 218 , b08 , + + +: #aligned negate swap negate and negate ; +: #align here swap #aligned here - allot ; + +1000 #align here 800 allot CONSTANT data + + +\ Testing utility stuff -- only used for debug, remove... + +: 0.r 0 swap <# 0 ?DO # LOOP #> 2dup lower type ; +: .L 3 0.r space ; + +\ Print terms, dropping leading zeroes. +: .poly ( poly -- ) dup poly-deg 1+ 0 DO i over array@ .L LOOP drop ; + +: tt + cr ." syn: " dup .poly + dup berlekamp-massey + cr ." locator: " _l .poly + solve-locator if cr ." unsolvable" exit then + cr nroots ? ." roots: " nroots @ 0 do i roots array@ . loop + compute-evaluator + cr ." omega: " 4 0 do i _o array@ .l loop + cr ." errors: " nroots @ 0 do i roots array@ dup compute-error 3 0.r + compute-location ." @" u. loop +; + +: t ( syndrome -- ) + data 800 erase data swap correct-ecc if cr ." Uncorrectable!" + else data 800 dump then +; +\ Expected results: + +ok s1 tt +syn: 001 6c6 291 d91 1ef e26 a19 8c0 3aa +locator: 001 6c6 +1 roots: 2db +omega: 001 000 000 000 +errors: 001@0 + +ok s2 tt +syn: 0f8 de1 5e5 287 566 756 f5f 253 ??? +locator: 001 6c6 +1 roots: 2db +omega: 0f8 000 000 000 +errors: 0f8@0 + +ok s3 tt +syn: 001 001 001 001 001 001 001 001 ??? +locator: 001 001 +1 roots: 1 +omega: 001 000 000 000 +errors: 001@55e + +ok s4 tt +syn: 41e b7a 37c 885 c32 a87 218 b08 ??? +locator: 001 ade e67 e84 e7c +4 roots: 1fa 3e1 913 b11 +omega: 41e b36 321 7f2 +errors: 00e@48e e00@3c8 010@1a5 a00@fa + +ok s1 t +01 at offset 0, all else 0 + +ok s2 t +f8 at offset 0, all else 0 + +ok s3 t +all 0 (error is in the check bytes) + +ok s4 t +0a at 176, 01 at 277, 0e at 5ab, 0e at 6d5 + +[then] + +\ LICENSE_BEGIN +\ Copyright 2007 Segher Boessenkool <segher(a)kernel.crashing.org> +\ Copyright (c) 2007 FirmWorks +\ +\ Permission is hereby granted, free of charge, to any person obtaining +\ a copy of this software and associated documentation files (the +\ "Software"), to deal in the Software without restriction, including +\ without limitation the rights to use, copy, modify, merge, publish, +\ distribute, sublicense, and/or sell copies of the Software, and to +\ permit persons to whom the Software is furnished to do so, subject to +\ the following conditions: +\ +\ The above copyright notice and this permission notice shall be +\ included in all copies or substantial portions of the Software. +\ +\ THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, +\ EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF +\ MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND +\ NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE +\ LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION +\ OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION +\ WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. +\ +\ LICENSE_END

1 0