diff options
| author |   RajithaY <rajithax.yerrumsetty@intel.com> | 2017-04-25 03:31:15 -0700 |
|---|---|---|
| committer | Rajitha Yerrumchetty <rajithax.yerrumsetty@intel.com> | 2017-05-22 06:48:08 +0000 |
| commit | bb756eebdac6fd24e8919e2c43f7d2c8c4091f59 (patch) | |
| tree | ca11e03542edf2d8f631efeca5e1626d211107e3 /qemu/roms/SLOF/slof/fs | |
| parent | a14b48d18a9ed03ec191cf16b162206998a895ce (diff) | |
Adding qemu as a submodule of KVMFORNFV
This Patch includes the changes to add qemu as a submodule to
kvmfornfv repo and make use of the updated latest qemu for the
execution of all testcase
Change-Id: I1280af507a857675c7f81d30c95255635667bdd7
Signed-off-by:RajithaY<rajithax.yerrumsetty@intel.com>
Diffstat (limited to 'qemu/roms/SLOF/slof/fs')
93 files changed, 0 insertions, 15726 deletions
diff --git a/qemu/roms/SLOF/slof/fs/accept.fs b/qemu/roms/SLOF/slof/fs/accept.fs deleted file mode 100644 index 7e8e2717e..000000000 --- a/qemu/roms/SLOF/slof/fs/accept.fs +++ /dev/null @@ -1,410 +0,0 @@ -\ ***************************************************************************** -\ * Copyright (c) 2004, 2008 IBM Corporation -\ * All rights reserved. -\ * This program and the accompanying materials -\ * are made available under the terms of the BSD License -\ * which accompanies this distribution, and is available at -\ * http://www.opensource.org/licenses/bsd-license.php -\ * -\ * Contributors: -\ * IBM Corporation - initial implementation -\ ****************************************************************************/ - - -\ Implementation of ACCEPT. Using ECMA-48 for terminal control. - -: beep bell emit ; - -: TABLE-EXECUTE - CREATE DOES> swap cells+ @ ?dup IF execute ELSE beep THEN ; - -0 VALUE accept-adr -0 VALUE accept-max -0 VALUE accept-len -0 VALUE accept-cur - -: esc 1b emit ; -: csi esc 5b emit ; - -: move-cursor ( -- ) - esc ." 8" accept-cur IF - csi base @ decimal accept-cur 0 .r base ! ." C" - THEN -; - -: redraw-line ( -- ) - accept-cur accept-len = IF EXIT THEN - move-cursor - accept-adr accept-len accept-cur /string type - csi ." K" move-cursor -; - -: full-redraw-line ( -- ) - accept-cur 0 to accept-cur move-cursor - accept-adr accept-len type - csi ." K" to accept-cur move-cursor -; - -: redraw-prompt ( -- ) - cr depth . [char] > emit -; - -: insert-char ( char -- ) - accept-len accept-max = IF drop beep EXIT THEN - accept-cur accept-len <> IF csi ." @" dup emit - accept-adr accept-cur + dup 1+ accept-len accept-cur - move - ELSE dup emit THEN - accept-adr accept-cur + c! - accept-cur 1+ to accept-cur - accept-len 1+ to accept-len redraw-line -; - -: delete-char ( -- ) - accept-cur accept-len = IF beep EXIT THEN - accept-len 1- to accept-len - accept-adr accept-cur + dup 1+ swap accept-len accept-cur - move - csi ." P" redraw-line -; - -\ * -\ * History handling -\ * - -STRUCT -cell FIELD his>next -cell FIELD his>prev -cell FIELD his>len - 0 FIELD his>buf -CONSTANT /his -0 VALUE his-head -0 VALUE his-tail -0 VALUE his-cur - -: add-history ( -- ) - accept-len 0= IF EXIT THEN - /his accept-len + alloc-mem - his-tail IF dup his-tail his>next ! ELSE dup to his-head THEN - his-tail over his>prev ! 0 over his>next ! dup to his-tail - accept-len over his>len ! accept-adr swap his>buf accept-len move -; - -: history ( -- ) - his-head BEGIN dup WHILE - cr dup his>buf over his>len @ type - his>next @ REPEAT drop -; - -: select-history ( his -- ) - dup to his-cur dup IF - dup his>len @ accept-max min dup to accept-len to accept-cur - his>buf accept-adr accept-len move ELSE - drop 0 to accept-len 0 to accept-cur THEN - full-redraw-line -; - - -\ -\ tab completion -\ - -\ tab completion state variables -0 value ?tab-pressed -0 value tab-last-adr -0 value tab-last-len - -\ compares two strings and returns the longest equal substring. -: $same-string ( addr-1 len-1 addr-2 len-2 -- addr-1 len-1' ) - dup 0= IF \ The second parameter is not a string. - 2drop EXIT \ bail out - THEN - rot min 0 0 -rot ( addr1 addr2 0 len' 0 ) - DO ( addr1 addr2 len-1' ) - 2 pick i + c@ lcc - 2 pick i + c@ lcc - = IF 1 + ELSE leave THEN - LOOP - nip -; - -: $tab-sift-words ( text-addr text-len -- sift-count ) - sift-compl-only >r true to sift-compl-only \ save sifting mode - - last BEGIN @ ?dup WHILE \ loop over all words - $inner-sift IF \ any completions possible? - \ convert to lower case for user interface sanity - 2dup bounds DO I c@ lcc I c! LOOP - ?tab-pressed IF 2dup type space THEN \ <tab><tab> prints possibilities - tab-last-adr tab-last-len $same-string \ find matching substring ... - to tab-last-len to tab-last-adr \ ... and save it - THEN - repeat - 2drop - - #sift-count 0 to #sift-count \ how many words were found? - r> to sift-compl-only \ restore sifting completion mode -; - -\ 8< node sifting for tab completion on device tree nodes below this line 8< - -#include <stack.fs> - -10 new-stack device-stack - -: (next-dev) ( node -- node' addr len ) - device-stack - dup (node>path) rot - dup child IF dup push child -rot EXIT THEN - dup peer IF peer -rot EXIT THEN - drop - BEGIN - stack-depth - WHILE - pop peer ?dup IF -rot EXIT THEN - REPEAT - 0 -rot -; - -: $inner-sift-nodes ( text-addr text-len node -- ... path-addr path-len true | false ) - (next-dev) ( text-addr text-len node' path-addr path-len ) - dup 0= IF drop false EXIT THEN - 2dup 6 pick 6 pick find-isubstr ( text-addr text-len node' path-addr path-len pos ) - 0= IF - #sift-count 1+ to #sift-count \ count completions - true - ELSE - 2drop false - THEN -; - -\ -\ test function for (next-dev) -: .nodes ( -- ) - s" /" find-node BEGIN dup WHILE - (next-dev) - type cr - REPEAT - drop - reset-stack -; - -\ node sifting wants its own pockets -create sift-node-buffer 1000 allot -0 value sift-node-num -: sift-node-buffer - sift-node-buffer sift-node-num 100 * + - sift-node-num 1+ dup 10 = IF drop 0 THEN - to sift-node-num -; - -: $tab-sift-nodes ( text-addr text-len -- sift-count ) - s" /" find-node BEGIN dup WHILE - $inner-sift-nodes IF \ any completions possible? - sift-node-buffer swap 2>r 2r@ move 2r> \ make an almost permanent copy without strdup - ?tab-pressed IF 2dup type space THEN \ <tab><tab> prints possibilities - tab-last-adr tab-last-len $same-string \ find matching substring ... - to tab-last-len to tab-last-adr \ ... and save it - THEN - REPEAT - 2drop drop - #sift-count 0 to #sift-count \ how many words were found? - reset-stack -; - -: $tab-sift ( text-addr text-len -- sift-count ) - ?tab-pressed IF beep space THEN \ cosmetical fix for <tab><tab> - - dup IF bl rsplit dup IF 2swap THEN ELSE 0 0 THEN >r >r - - 0 dup to tab-last-len to tab-last-adr \ reset last possible match - current-node @ IF \ if we are in a node? - 2dup 2>r \ save text - $tab-sift-words to #sift-count \ search in current node first - 2r> \ fetch text to complete, again - THEN - 2dup 2>r - current-node @ >r 0 set-node \ now search in global words - $tab-sift-words to #sift-count - r> set-node - 2r> $tab-sift-nodes - \ concatenate previous commands - r> r> dup IF s" " $cat THEN tab-last-adr tab-last-len $cat - to tab-last-len to tab-last-adr \ ... and save the whole string -; - -\ 8< node sifting for tab completion on device tree nodes above this line 8< - -: handle-^A - 0 to accept-cur move-cursor ; -: handle-^B - accept-cur ?dup IF 1- to accept-cur ( csi ." D" ) move-cursor THEN ; -: handle-^D - delete-char ( redraw-line ) ; -: handle-^E - accept-len to accept-cur move-cursor ; -: handle-^F - accept-cur accept-len <> IF accept-cur 1+ to accept-cur csi ." C" THEN ; -: handle-^H - accept-cur 0= IF beep EXIT THEN - handle-^B delete-char -; -: handle-^I - accept-adr accept-len - $tab-sift 0 > IF - ?tab-pressed IF - redraw-prompt full-redraw-line - false to ?tab-pressed - ELSE - tab-last-adr accept-adr tab-last-len move \ copy matching substring - tab-last-len dup to accept-len to accept-cur \ len and cursor position - full-redraw-line \ redraw new string - true to ?tab-pressed \ second tab will print possible matches - THEN - THEN -; - -: handle-^K - BEGIN accept-cur accept-len <> WHILE delete-char REPEAT ; -: handle-^L - history redraw-prompt full-redraw-line ; -: handle-^N - his-cur IF his-cur his>next @ ELSE his-head THEN - dup to his-cur select-history -; -: handle-^P - his-cur IF his-cur his>prev @ ELSE his-tail THEN - dup to his-cur select-history -; -: handle-^Q \ Does not handle terminal formatting yet. - key insert-char ; -: handle-^R - full-redraw-line ; -: handle-^U - 0 to accept-len 0 to accept-cur full-redraw-line ; - -: handle-fn - key drop beep -; - -TABLE-EXECUTE handle-CSI -0 , ' handle-^P , ' handle-^N , ' handle-^F , -' handle-^B , 0 , 0 , 0 , -' handle-^A , 0 , 0 , ' handle-^E , -0 , 0 , 0 , 0 , -0 , 0 , 0 , 0 , -0 , 0 , 0 , 0 , -0 , 0 , 0 , 0 , -0 , 0 , 0 , 0 , - -TABLE-EXECUTE handle-meta -0 , 0 , 0 , 0 , -0 , 0 , 0 , 0 , -0 , 0 , 0 , 0 , -0 , 0 , 0 , ' handle-fn , -0 , 0 , 0 , 0 , -0 , 0 , 0 , 0 , -0 , 0 , 0 , ' handle-CSI , -0 , 0 , 0 , 0 , - -: handle-ESC-O - key - dup 48 = IF - handle-^A - ELSE - dup 46 = IF - handle-^E - THEN - THEN drop -; - -: handle-ESC-5b - key - dup 31 = IF \ HOME - key drop ( drops closing 7e ) handle-^A - ELSE - dup 33 = IF \ DEL - key drop handle-^D - ELSE - dup 34 = IF \ END - key drop handle-^E - ELSE - dup 1f and handle-CSI - THEN - THEN - THEN drop -; - -: handle-ESC - key - dup 5b = IF - handle-ESC-5b - ELSE - dup 4f = IF - handle-ESC-O - ELSE - dup 1f and handle-meta - THEN - THEN drop -; - -TABLE-EXECUTE handle-control -0 , \ ^@: -' handle-^A , -' handle-^B , -0 , \ ^C: -' handle-^D , -' handle-^E , -' handle-^F , -0 , \ ^G: -' handle-^H , -' handle-^I , \ tab -0 , \ ^J: -' handle-^K , -' handle-^L , -0 , \ ^M: enter: handled in main loop -' handle-^N , -0 , \ ^O: -' handle-^P , -' handle-^Q , -' handle-^R , -0 , \ ^S: -0 , \ ^T: -' handle-^U , -0 , \ ^V: -0 , \ ^W: -0 , \ ^X: -0 , \ ^Y: insert save buffer -0 , \ ^Z: -' handle-ESC , -0 , \ ^\: -0 , \ ^]: -0 , \ ^^: -0 , \ ^_: - -: (accept) ( adr len -- len' ) - cursor-on - to accept-max to accept-adr - 0 to accept-len 0 to accept-cur - 0 to his-cur - 1b emit 37 emit - BEGIN - key dup 0d <> - WHILE - dup 9 <> IF 0 to ?tab-pressed THEN \ reset state machine - dup 7f = IF drop 8 THEN \ Handle DEL as if it was BS. ??? bogus - dup bl < IF handle-control ELSE - dup 80 and IF - dup a0 < IF 7f and handle-meta ELSE drop beep THEN - ELSE - insert-char - THEN - THEN - REPEAT - drop add-history - accept-len to accept-cur - move-cursor space - accept-len - cursor-off -; - -' (accept) to accept - diff --git a/qemu/roms/SLOF/slof/fs/alloc-mem-debug.fs b/qemu/roms/SLOF/slof/fs/alloc-mem-debug.fs deleted file mode 100644 index d4ca70bbd..000000000 --- a/qemu/roms/SLOF/slof/fs/alloc-mem-debug.fs +++ /dev/null @@ -1,116 +0,0 @@ -\ ***************************************************************************** -\ * Copyright (c) 2011 IBM Corporation -\ * All rights reserved. -\ * This program and the accompanying materials -\ * are made available under the terms of the BSD License -\ * which accompanies this distribution, and is available at -\ * http://www.opensource.org/licenses/bsd-license.php -\ * -\ * Contributors: -\ * IBM Corporation - initial implementation -\ ****************************************************************************/ -\ * Dynamic memory allocation/de-allocation debug functions -\ ***************************************************************************** - - -\ Uncomment the following code for debugging bad write accesses beyond -\ the end of the allocated block: -\ Store magic value past the end of the block during alloc-mem and -\ check for this magic value when free-mem has been called. -#if 1 -: alloc-mem ( len -- addr ) - dup /n + alloc-mem ( len addr ) - 2dup + 3141592653589793 swap ! nip -; - -: free-mem ( addr len -- ) - 2dup + @ 3141592653589793 <> IF - cr ." Detected memory corrupt during free-mem of " - swap . . cr EXIT - THEN - /n + free-mem -; -#endif - - -\ Never ever assume that allocated memory is pre-initialized with 0 ... -: alloc-mem ( len -- addr ) - dup alloc-mem swap 2dup ff fill drop -; - -\ Make sure that memory block do not contain "valid" data after free-mem: -: free-mem ( addr len -- ) - 2dup ff fill free-mem -; - - -\ The following definitions are used for debugging the parameters of free-mem: -\ Store block address and size of allocated blocks -\ in an array, then check for right values on free-mem. - -1000 CONSTANT max-malloced-blocks -CREATE malloced-blocks max-malloced-blocks 2 * cells allot -malloced-blocks max-malloced-blocks 2 * cells erase - - -: alloc-mem ( len -- addr ) - dup alloc-mem dup 0= IF - cr ." alloc-mem returned 0 for size " swap . cr EXIT - THEN ( len addr ) - malloced-blocks max-malloced-blocks 0 DO ( len addr m-blocks-ptr ) - dup @ 0= IF ( len addr m-blocks-ptr ) - \ Found a free entry: store addr and len - over >r dup >r ! - r> cell+ ! - r> UNLOOP EXIT - THEN - cell+ cell+ ( len addr next-m-blocks-ptr ) - LOOP - ." Please increase max-malloced-blocks." cr ( len addr next-m-blocks-ptr ) - drop nip -; - - -: free-mem ( addr len -- ) - malloced-blocks max-malloced-blocks 0 DO ( addr len m-blocks-ptr ) - dup @ ?dup IF - ( addr len m-blocks-ptr s-addr ) - 3 pick = IF - ( addr len m-blocks-ptr ) - dup cell+ @ ( addr len m-blocks-ptr s-len ) - 2 pick = IF ( addr len m-blocks-ptr ) - \ All right, addr and len matched, - \ clear entry and call original free-mem. - dup cell+ 0 swap ! - 0 swap ! - free-mem - ELSE - >r swap cr - ." free-mem called for block " . ." with wrong size=" . cr - ." ( correct size should be: " r> cell+ @ . ." )" cr - THEN - UNLOOP EXIT - THEN ( addr len m-blocks-ptr ) - THEN - cell+ cell+ ( addr len next-m-blocks-ptr ) - LOOP - drop swap cr - ." free-mem called for block " . - ." ( size=" . - ." ) which has never been allocated before!" cr -; - - -\ Enable these for verbose debug messages: -#if 0 -: alloc-mem - cr ." alloc-mem with len=" dup . - alloc-mem - ." returned addr=" dup . cr -; - -: free-mem - cr ." free mem addr=" over . ." len=" dup . cr - free-mem -; -#endif diff --git a/qemu/roms/SLOF/slof/fs/alloc-mem.fs b/qemu/roms/SLOF/slof/fs/alloc-mem.fs deleted file mode 100644 index 59381a72b..000000000 --- a/qemu/roms/SLOF/slof/fs/alloc-mem.fs +++ /dev/null @@ -1,75 +0,0 @@ -\ ***************************************************************************** -\ * Copyright (c) 2004, 2008 IBM Corporation -\ * All rights reserved. -\ * This program and the accompanying materials -\ * are made available under the terms of the BSD License -\ * which accompanies this distribution, and is available at -\ * http://www.opensource.org/licenses/bsd-license.php -\ * -\ * Contributors: -\ * IBM Corporation - initial implementation -\ ****************************************************************************/ - -#include <claim.fs> -\ Memory "heap" (de-)allocation. - -\ Keep a linked list of free blocks per power-of-two size. -\ Never coalesce entries when freed; split blocks when needed while allocating. - -\ 3f CONSTANT (max-heads#) -heap-end heap-start - log2 1+ CONSTANT (max-heads#) - -CREATE heads (max-heads#) cells allot -heads (max-heads#) cells erase - - -: size>head ( size -- headptr ) log2 3 max cells heads + ; - - -\ Allocate a memory block -: alloc-mem ( len -- a-addr ) - dup 0= IF EXIT THEN - 1 over log2 3 max ( len 1 log_len ) - dup (max-heads#) >= IF cr ." Out of internal memory." cr 3drop 0 EXIT THEN - lshift >r ( len R: 1<<log_len ) - size>head dup @ IF - dup @ dup >r @ swap ! r> r> drop EXIT - THEN ( headptr R: 1<<log_len) - r@ 2* recurse dup ( headptr a-addr2 a-addr2 R: 1<<log_len) - dup 0= IF r> 2drop 2drop 0 EXIT THEN - r> + >r 0 over ! swap ! r> -; - - -\ Free a memory block - -: free-mem ( a-addr len -- ) - dup 0= IF 2drop EXIT THEN size>head 2dup @ swap ! ! -; - - -: #links ( a -- n ) - @ 0 BEGIN over WHILE 1+ swap @ swap REPEAT nip -; - - -: .free ( -- ) - 0 (max-heads#) 0 DO - heads i cells + #links dup IF - cr dup . ." * " 1 i lshift dup . ." = " * dup . - THEN - + - LOOP - cr ." Total " . -; - - -\ Start with just one free block. -heap-start heap-end heap-start - free-mem - - -\ : free-mem ( a-addr len -- ) 2drop ; - -\ Uncomment the following line for debugging: -\ #include <alloc-mem-debug.fs> - diff --git a/qemu/roms/SLOF/slof/fs/available.fs b/qemu/roms/SLOF/slof/fs/available.fs deleted file mode 100644 index 5eb8fa93a..000000000 --- a/qemu/roms/SLOF/slof/fs/available.fs +++ /dev/null @@ -1,72 +0,0 @@ -\ ***************************************************************************** -\ * Copyright (c) 2004, 2008 IBM Corporation -\ * All rights reserved. -\ * This program and the accompanying materials -\ * are made available under the terms of the BSD License -\ * which accompanies this distribution, and is available at -\ * http://www.opensource.org/licenses/bsd-license.php -\ * -\ * Contributors: -\ * IBM Corporation - initial implementation -\ ****************************************************************************/ - -VARIABLE chosen-memory-ih 0 chosen-memory-ih ! - -\ + -\ Maintain "available" property. -\ Sun has a single memory node with "available" property -\ and separate memory controller nodes. -\ We corespond memory nodes with their respective memory controllers -\ and use /chosen/memory as default memory node to hold the "available" map -\ NOTE -> /chosen/memory is expected 2B initialized before using claim/release -\ + - -: (chosen-memory-ph) ( -- phandle ) - chosen-memory-ih @ ?dup 0= IF - s" memory" get-chosen IF - decode-int nip nip dup chosen-memory-ih ! - ihandle>phandle - ELSE 0 THEN - ELSE ihandle>phandle THEN -; - -: (set-available-prop) ( prop plen -- ) - s" available" - (chosen-memory-ph) ?dup 0<> IF set-property ELSE - cr ." Can't find chosen memory node - " - ." no available property created" cr - 2dup 2dup - THEN -; - -: update-available-property ( available-ptr -- ) - dup >r available>size@ - 0= r@ available AVAILABLE-SIZE /available * + >= or IF - available r> available - encode-bytes (set-available-prop) - ELSE - r> /available + RECURSE - THEN -; - -: update-available-property available update-available-property ; - -\ \\\\\\\\\\\\\\ Exported Interface: -\ + -\ IEEE 1275 implementation: -\ claim -\ Claim the region with given start address and size (if align parameter is 0); -\ alternatively claim any region of given alignment -\ + -\ Throw an exception if failed -\ + -: claim ( [ addr ] len align -- base ) claim update-available-property ; - -\ + -\ IEEE 1275 implementation: -\ release -\ Free the region with given start address and size -\ + -: release ( addr len -- ) release update-available-property ; - -update-available-property - diff --git a/qemu/roms/SLOF/slof/fs/banner.fs b/qemu/roms/SLOF/slof/fs/banner.fs deleted file mode 100644 index efdba0c5a..000000000 --- a/qemu/roms/SLOF/slof/fs/banner.fs +++ /dev/null @@ -1,23 +0,0 @@ -\ ***************************************************************************** -\ * Copyright (c) 2004, 2008 IBM Corporation -\ * All rights reserved. -\ * This program and the accompanying materials -\ * are made available under the terms of the BSD License -\ * which accompanies this distribution, and is available at -\ * http://www.opensource.org/licenses/bsd-license.php -\ * -\ * Contributors: -\ * IBM Corporation - initial implementation -\ ****************************************************************************/ - -: banner - cr ." Type 'boot' and press return to continue booting the system." - s" /packages/sms" find-node IF - cr ." Type 'sms-start' and press return to enter the configuration menu." - THEN - cr ." Type 'reset-all' and press return to reboot the system." - cr cr -; - -: .banner banner console-clean-fifo ; - diff --git a/qemu/roms/SLOF/slof/fs/base.fs b/qemu/roms/SLOF/slof/fs/base.fs deleted file mode 100644 index 03e77e54f..000000000 --- a/qemu/roms/SLOF/slof/fs/base.fs +++ /dev/null @@ -1,609 +0,0 @@ -\ ***************************************************************************** -\ * Copyright (c) 2004, 2008 IBM Corporation -\ * All rights reserved. -\ * This program and the accompanying materials -\ * are made available under the terms of the BSD License -\ * which accompanies this distribution, and is available at -\ * http://www.opensource.org/licenses/bsd-license.php -\ * -\ * Contributors: -\ * IBM Corporation - initial implementation -\ ****************************************************************************/ - -\ Hash for faster lookup -#include <find-hash.fs> - -: >name ( xt -- nfa ) \ note: still has the "immediate" field! - BEGIN char- dup c@ UNTIL ( @lastchar ) - dup dup aligned - cell+ char- ( @lastchar lenmodcell ) - dup >r - - BEGIN dup c@ r@ <> WHILE - cell- r> cell+ >r - REPEAT - r> drop char- -; - -\ Words missing in *.in files -VARIABLE mask -1 mask ! - -VARIABLE huge-tftp-load 1 huge-tftp-load ! -\ Default implementation for sms-get-tftp-blocksize that return 1432 (decimal) -: sms-get-tftp-blocksize 598 ; - -: default-hw-exception s" Exception #" type . ; - -' default-hw-exception to hw-exception-handler - -: diagnostic-mode? false ; \ 2B DOTICK'D later in envvar.fs - -: memory-test-suite ( addr len -- fail? ) - diagnostic-mode? IF - ." Memory test mask value: " mask @ . cr - ." No memory test suite currently implemented! " cr - THEN - false -; - -: 0.r 0 swap <# 0 ?DO # LOOP #> type ; - -\ count the number of bits equal 1 -\ the idea is to clear in each step the least significant bit -\ v&(v-1) does exactly this, so count the steps until v == 0 -: cnt-bits ( 64-bit-value -- #bits=1 ) - dup IF - 41 1 DO dup 1- and dup 0= IF drop i LEAVE THEN LOOP - THEN -; - -: bcd-to-bin ( bcd -- bin ) - dup f and swap 4 rshift a * + -; - -\ calcs the exponent of the highest power of 2 not greater than n -: 2log ( n -- lb{n} ) - 8 cells 0 DO 1 rshift dup 0= IF drop i LEAVE THEN LOOP -; - -\ calcs the exponent of the lowest power of 2 not less than n -: log2 ( n -- log2-n ) - 1- 2log 1+ -; - - -CREATE $catpad 400 allot -: $cat ( str1 len1 str2 len2 -- str3 len3 ) - >r >r dup >r $catpad swap move - r> dup $catpad + r> swap r@ move - r> + $catpad swap ; - -\ WARNING: The following two ($cat-comm & $cat-space) are dirty in a sense -\ that they add 1 or 2 characters to str1 before executing $cat -\ The ASSUMPTION is that str1 buffer provides that extra space and it is -\ responsibility of the code owner to ensure that -: $cat-comma ( str2 len2 str1 len1 -- "str1, str2" len1+len2+2 ) - 2dup + s" , " rot swap move 2+ 2swap $cat -; - -: $cat-space ( str2 len2 str1 len1 -- "str1 str2" len1+len2+1 ) - 2dup + bl swap c! 1+ 2swap $cat -; -: $cathex ( str len val -- str len' ) - (u.) $cat -; - - -: 2CONSTANT CREATE , , DOES> [ here ] 2@ ; - -\ Save XT of 2CONSTANT, put on the stack by "[ here ]" : -CONSTANT <2constant> - -: $2CONSTANT $CREATE , , DOES> 2@ ; - -: 2VARIABLE CREATE 0 , 0 , DOES> ; - - -: (is-user-word) ( name-str name-len xt -- ) -rot $CREATE , DOES> @ execute ; - -: zplace ( str len buf -- ) 2dup + 0 swap c! swap move ; -: rzplace ( str len buf -- ) 2dup + 0 swap rb! swap rmove ; - -: strdup ( str len -- dupstr len ) here over allot swap 2dup 2>r move 2r> ; - -: str= ( str1 len1 str2 len2 -- equal? ) - rot over <> IF 3drop false ELSE comp 0= THEN ; - -: test-string ( param len -- true | false ) - 0 ?DO - dup i + c@ \ Get character / byte at current index - dup 20 < swap 7e > OR IF \ Is it out of range 32 to 126 (=ASCII) - drop FALSE UNLOOP EXIT \ FALSE means: No ASCII string - THEN - LOOP - drop TRUE \ Only ASCII found --> it is a string -; - -: #aligned ( adr alignment -- adr' ) negate swap negate and negate ; -: #join ( lo hi #bits -- x ) lshift or ; -: #split ( x #bits -- lo hi ) 2dup rshift dup >r swap lshift xor r> ; - -: /string ( str len u -- str' len' ) - >r swap r@ chars + swap r> - ; -: skip ( str len c -- str' len' ) - >r BEGIN dup WHILE over c@ r@ = WHILE 1 /string REPEAT THEN r> drop ; -: scan ( str len c -- str' len' ) - >r BEGIN dup WHILE over c@ r@ <> WHILE 1 /string REPEAT THEN r> drop ; -: split ( str len char -- left len right len ) - >r 2dup r> findchar IF >r over r@ 2swap r> 1+ /string ELSE 0 0 THEN ; -\ reverse findchar -- search from the end of the string -: rfindchar ( str len char -- offs true | false ) - swap 1 - 0 swap do - over i + c@ - over dup bl = if <= else = then if - 2drop i dup dup leave - then - -1 +loop = -; -\ reverse split -- split at the last occurrence of char -: rsplit ( str len char -- left len right len ) - >r 2dup r> rfindchar IF >r over r@ 2swap r> 1+ /string ELSE 0 0 THEN ; - -: left-parse-string ( str len char -- R-str R-len L-str L-len ) - split 2swap ; -: replace-char ( str len chout chin -- ) - >r -rot BEGIN 2dup 4 pick findchar WHILE tuck - -rot + r@ over c! swap REPEAT - r> 2drop 2drop -; -\ Duplicate string and replace \ with / -: \-to-/ ( str len -- str' len ) strdup 2dup [char] \ [char] / replace-char ; - -: isdigit ( char -- true | false ) - 30 39 between -; - -: ishexdigit ( char -- true | false ) - 30 39 between 41 46 between OR 61 66 between OR -; - -\ Variant of $number that defaults to decimal unless "0x" is -\ a prefix -: $dh-number ( addr len -- true | number false ) - base @ >r - decimal - dup 2 > IF - over dup c@ [char] 0 = - over 1 + c@ 20 or [char] x = - AND IF hex 2 + swap 2 - rot THEN drop - THEN - $number - r> base ! -; - -: // dup >r 1- + r> / ; \ division, round up - -: c@+ ( adr -- c adr' ) dup c@ swap char+ ; -: 2c@ ( adr -- c1 c2 ) c@+ c@ ; -: 4c@ ( adr -- c1 c2 c3 c4 ) c@+ c@+ c@+ c@ ; -: 8c@ ( adr -- c1 c2 c3 c4 c5 c6 c7 c8 ) c@+ c@+ c@+ c@+ c@+ c@+ c@+ c@ ; - - -: 4dup ( n1 n2 n3 n4 -- n1 n2 n3 n4 n1 n2 n3 n4 ) 2over 2over ; -: 4drop ( n1 n2 n3 n4 -- ) 2drop 2drop ; - -\ yes sometimes even something like this is needed -: 5dup ( 1 2 3 4 5 -- 1 2 3 4 5 1 2 3 4 5 ) - 4 pick 4 pick 4 pick 4 pick 4 pick ; -: 5drop 4drop drop ; -: 5nip - nip nip nip nip nip ; - -: 6dup ( 1 2 3 4 5 6 -- 1 2 3 4 5 6 1 2 3 4 5 6 ) - 5 pick 5 pick 5 pick 5 pick 5 pick 5 pick ; - -\ convert a 32 bit signed into a 64 signed -\ ( propagate bit 31 to all bits 32:63 ) -: signed ( n1 -- n2 ) dup 80000000 and IF FFFFFFFF00000000 or THEN ; - -: <l@ ( addr -- x ) l@ signed ; - -: -leading BEGIN dup WHILE over c@ bl <= WHILE 1 /string REPEAT THEN ; -: (parse-line) skipws 0 parse ; - - -\ Append two character to hex byte, if possible - -: hex-byte ( char0 char1 -- value true|false ) - 10 digit IF - swap 10 digit IF - 4 lshift or true EXIT - ELSE - 2drop 0 - THEN - ELSE - drop - THEN - false EXIT -; - -\ Parse hex string within brackets - -: parse-hexstring ( dst-adr -- dst-adr' ) - [char] ) parse cr ( dst-adr str len ) - bounds ?DO ( dst-adr ) - i c@ i 1+ c@ hex-byte IF ( dst-adr hex-byte ) - >r dup r> swap c! 1+ 2 ( dst-adr+1 2 ) - ELSE - drop 1 ( dst-adr 1 ) - THEN - +LOOP -; - -\ Add special character to string - -: add-specialchar ( dst-adr special -- dst-adr' ) - over c! 1+ ( dst-adr' ) - 1 >in +! \ advance input-index -; - -\ Parse up to next " - -: parse-" ( dst-adr -- dst-adr' ) - [char] " parse dup 3 pick + >r ( dst-adr str len R: dst-adr' ) - >r swap r> move r> ( dst-adr' ) -; - -: (") ( dst-adr -- dst-adr' ) - begin ( dst-adr ) - parse-" ( dst-adr' ) - >in @ dup span @ >= IF ( dst-adr' >in-@ ) - drop - EXIT - THEN - - ib + c@ - CASE - [char] ( OF parse-hexstring ENDOF - [char] " OF [char] " add-specialchar ENDOF - dup OF EXIT ENDOF - ENDCASE - again -; - -CREATE "pad 100 allot - -\ String with embedded hex strings -\ Example: " ba"( 12 34,4567)ab" -> >x62x61x12x34x45x67x61x62< - -: " ( [text<">< >] -- text-str text-len ) - state @ IF \ compile sliteral, pstr into dict - "pad dup (") over - ( str len ) - ['] sliteral compile, dup c, ( str len ) - bounds ?DO i c@ c, LOOP - align ['] count compile, - ELSE - pocket dup (") over - \ Interpretation, put string - THEN \ in temp buffer -; immediate - - -\ Output the carriage-return character -: (cr carret emit ; - - -\ Remove command old-name and all subsequent definitions - -: $forget ( str len -- ) - 2dup last @ ( str len str len last-bc ) - BEGIN - dup >r ( str len str len last-bc R: last-bc ) - cell+ char+ count ( str len str len found-str found-len R: last-bc ) - string=ci IF ( str len R: last-bc ) - r> @ last ! 2drop clean-hash EXIT ( -- ) - THEN - 2dup r> @ dup 0= ( str len str len next-bc next-bc ) - UNTIL - drop 2drop 2drop \ clean hash table -; - -: forget ( "old-name<>" -- ) - parse-word $forget -; - -#include <search.fs> - -\ The following constants are required in some parts -\ of the code, mainly instance variables and see. Having to reverse -\ engineer our own CFAs seems somewhat weird, but we gained a bit speed. - -\ Each colon definition is surrounded by colon and semicolon -\ constant below contain address of their xt - -: (function) ; -defer (defer) -0 value (value) -0 constant (constant) -variable (variable) -create (create) -alias (alias) (function) -cell buffer: (buffer:) - -' (function) @ \ ( <colon> ) -' (function) cell + @ \ ( ... <semicolon> ) -' (defer) @ \ ( ... <defer> ) -' (value) @ \ ( ... <value> ) -' (constant) @ \ ( ... <constant> ) -' (variable) @ \ ( ... <variable> ) -' (create) @ \ ( ... <create> ) -' (alias) @ \ ( ... <alias> ) -' (buffer:) @ \ ( ... <buffer:> ) - -\ now clean up the test functions -forget (function) - -\ and remember the constants -constant <buffer:> -constant <alias> -constant <create> -constant <variable> -constant <constant> -constant <value> -constant <defer> -constant <semicolon> -constant <colon> - -' lit constant <lit> -' sliteral constant <sliteral> -' 0branch constant <0branch> -' branch constant <branch> -' doloop constant <doloop> -' dotick constant <dotick> -' doto constant <doto> -' do?do constant <do?do> -' do+loop constant <do+loop> -' do constant <do> -' exit constant <exit> -' doleave constant <doleave> -' do?leave constant <do?leave> - - -\ provide the memory management words -\ #include <claim.fs> -\ #include "memory.fs" -#include <alloc-mem.fs> - -#include <node.fs> - -: find-substr ( basestr-ptr basestr-len substr-ptr substr-len -- pos ) - \ if substr-len == 0 ? - dup 0 = IF - \ return 0 - 2drop 2drop 0 exit THEN - \ if substr-len <= basestr-len ? - dup 3 pick <= IF - \ run J from 0 to "basestr-len"-"substr-len" and I from 0 to "substr-len"-1 - 2 pick over - 1+ 0 DO dup 0 DO - \ substr-ptr[i] == basestr-ptr[j+i] ? - over i + c@ 4 pick j + i + c@ = IF - \ (I+1) == substr-len ? - dup i 1+ = IF - \ return J - 2drop 2drop j unloop unloop exit THEN - ELSE leave THEN - LOOP LOOP - THEN - \ if there is no match then exit with basestr-len as return value - 2drop nip -; - -: find-isubstr ( basestr-ptr basestr-len substr-ptr substr-len -- pos ) - \ if substr-len == 0 ? - dup 0 = IF - \ return 0 - 2drop 2drop 0 exit THEN - \ if substr-len <= basestr-len ? - dup 3 pick <= IF - \ run J from 0 to "basestr-len"-"substr-len" and I from 0 to "substr-len"-1 - 2 pick over - 1+ 0 DO dup 0 DO - \ substr-ptr[i] == basestr-ptr[j+i] ? - over i + c@ lcc 4 pick j + i + c@ lcc = IF - \ (I+1) == substr-len ? - dup i 1+ = IF - \ return J - 2drop 2drop j unloop unloop exit THEN - ELSE leave THEN - LOOP LOOP - THEN - \ if there is no match then exit with basestr-len as return value - 2drop nip -; - -: find-nextline ( str-ptr str-len -- pos ) - \ run I from 0 to "str-len"-1 and check str-ptr[i] - dup 0 ?DO over i + c@ CASE - \ 0x0a (=LF) found ? - 0a OF - \ if current cursor is at end position (I == "str-len"-1) ? - dup 1- i = IF - \ return I+1 - 2drop i 1+ unloop exit THEN - \ if str-ptr[I+1] == 0x0d (=CR) ? - over i 1+ + c@ 0d = IF - \ return I+2 - 2drop i 2+ ELSE - \ else return I+1 - 2drop i 1+ THEN - unloop exit - ENDOF - \ 0x0d (=CR) found ? - 0d OF - \ if current cursor is at end position (I == "str-len"-1) ? - dup 1- i = IF - \ return I+1 - 2drop i 1+ unloop exit THEN - \ str-ptr[I+1] == 0x0a (=LF) ? - over i 1+ + c@ 0a = IF - \ return I+2 - 2drop i 2+ ELSE - \ return I+1 - 2drop i 1+ THEN - unloop exit - ENDOF - ENDCASE LOOP nip -; - -: string-at ( str1-ptr str1-len pos -- str2-ptr str2-len ) - -rot 2 pick - -rot swap chars + swap -; - -\ appends the string beginning at addr2 to the end of the string -\ beginning at addr1 -\ !!! THERE MUST BE SUFFICIENT MEMORY RESERVED FOR THE STRING !!! -\ !!! BEGINNING AT ADDR1 (cp. 'strcat' in 'C' ) !!! - -: string-cat ( addr1 len1 addr2 len2 -- addr1 len1+len2 ) - \ len1 := len1+len2 - rot dup >r over + -rot - ( addr1 len1+len2 dest-ptr src-ptr len2 ) - 3 pick r> chars + -rot - ( ... dest-ptr src-ptr ) - 0 ?DO - 2dup c@ swap c! - char+ swap char+ swap - LOOP 2drop -; - -\ appends a character to the end of the string beginning at addr -\ !!! THERE MUST BE SUFFICIENT MEMORY RESERVED FOR THE STRING !!! -\ !!! BEGINNING AT ADDR1 (cp. 'strcat' in 'C' ) !!! - -: char-cat ( addr len character -- addr len+1 ) - -rot 2dup >r >r 1+ rot r> r> chars + c! -; - -\ Returns true if source and destination overlap -: overlap ( src dest size -- true|false ) - 3dup over + within IF 3drop true ELSE rot tuck + within THEN -; - -: parse-2int ( str len -- val.lo val.hi ) -\ ." parse-2int ( " 2dup swap . . ." -- " - [char] , split ?dup IF eval ELSE drop 0 THEN - -rot ?dup IF eval ELSE drop 0 THEN -\ 2dup swap . . ." )" cr -; - -\ peek/poke minimal implementation, just to support FCode drivers -\ Any implmentation with full error detection will be platform specific -: cpeek ( addr -- false | byte true ) c@ true ; -: cpoke ( byte addr -- success? ) c! true ; -: wpeek ( addr -- false | word true ) w@ true ; -: wpoke ( word addr -- success? ) w! true ; -: lpeek ( addr -- false | lword true ) l@ true ; -: lpoke ( lword addr -- success? ) l! true ; - -defer reboot ( -- ) -defer halt ( -- ) -defer disable-watchdog ( -- ) -defer reset-watchdog ( -- ) -defer set-watchdog ( +n -- ) -defer set-led ( type instance state -- status ) -defer get-flashside ( -- side ) -defer set-flashside ( side -- status ) -defer read-bootlist ( -- ) -defer furnish-boot-file ( -- adr len ) -defer set-boot-file ( adr len -- ) -defer mfg-mode? ( -- flag ) -defer of-prompt? ( -- flag ) -defer debug-boot? ( -- flag ) -defer bmc-version ( -- adr len ) -defer cursor-on ( -- ) -defer cursor-off ( -- ) - -: nop-reboot ( -- ) ." reboot not available" abort ; -: nop-halt ( -- ) ." halt not available" abort ; -: nop-disable-watchdog ( -- ) ; -: nop-reset-watchdog ( -- ) ; -: nop-set-watchdog ( +n -- ) drop ; -: nop-set-led ( type instance state -- status ) drop drop drop ; -: nop-get-flashside ( -- side ) ." Cannot get flashside" cr ABORT ; -: nop-set-flashside ( side -- status ) ." Cannot set flashside" cr ABORT ; -: nop-read-bootlist ( -- ) ; -: nop-furnish-bootfile ( -- adr len ) s" net:" ; -: nop-set-boot-file ( adr len -- ) 2drop ; -: nop-mfg-mode? ( -- flag ) false ; -: nop-of-prompt? ( -- flag ) false ; -: nop-debug-boot? ( -- flag ) false ; -: nop-bmc-version ( -- adr len ) s" XXXXX" ; -: nop-cursor-on ( -- ) ; -: nop-cursor-off ( -- ) ; - -' nop-reboot to reboot -' nop-halt to halt -' nop-disable-watchdog to disable-watchdog -' nop-reset-watchdog to reset-watchdog -' nop-set-watchdog to set-watchdog -' nop-set-led to set-led -' nop-get-flashside to get-flashside -' nop-set-flashside to set-flashside -' nop-read-bootlist to read-bootlist -' nop-furnish-bootfile to furnish-boot-file -' nop-set-boot-file to set-boot-file -' nop-mfg-mode? to mfg-mode? -' nop-of-prompt? to of-prompt? -' nop-debug-boot? to debug-boot? -' nop-bmc-version to bmc-version -' nop-cursor-on to cursor-on -' nop-cursor-off to cursor-off - -: reset-all reboot ; - -\ load-base is an env. variable now, but it can -\ be overriden temporarily provided users use -\ get-load-base rather than load-base directly -\ -\ default-load-base is set here and can be -\ overriden by the board code. It will be used -\ to set the default value of the envvar "load-base" -\ when booting without a valid nvram - -10000000 VALUE default-load-base -2000000 VALUE flash-load-base -0 VALUE load-base-override - -: get-load-base - load-base-override 0<> IF load-base-override ELSE - " load-base" evaluate - THEN -; - -\ provide first level debug support -#include "debug.fs" -\ provide 7.5.3.1 Dictionary search -#include "dictionary.fs" -\ provide a simple run time preprocessor -#include <preprocessor.fs> - -: $dnumber base @ >r decimal $number r> base ! ; -: (.d) base @ >r decimal (.) r> base ! ; - -\ IP address conversion - -: (ipaddr) ( "a.b.c.d" -- FALSE | n1 n2 n3 n4 TRUE ) - base @ >r decimal - over s" 000.000.000.000" comp 0= IF 2drop false r> base ! EXIT THEN - [char] . left-parse-string $number IF 2drop false r> base ! EXIT THEN -rot - [char] . left-parse-string $number IF 2drop false r> base ! EXIT THEN -rot - [char] . left-parse-string $number IF 2drop false r> base ! EXIT THEN -rot - $number IF false r> base ! EXIT THEN - true r> base ! -; - -: (ipformat) ( n1 n2 n3 n4 -- str len ) - base @ >r decimal - 0 <# # # # [char] . hold drop # # # [char] . hold - drop # # # [char] . hold drop # # #s #> - r> base ! -; - -: ipformat ( n1 n2 n3 n4 -- ) (ipformat) type ; - - diff --git a/qemu/roms/SLOF/slof/fs/boot.fs b/qemu/roms/SLOF/slof/fs/boot.fs deleted file mode 100644 index e0b628140..000000000 --- a/qemu/roms/SLOF/slof/fs/boot.fs +++ /dev/null @@ -1,296 +0,0 @@ -\ ***************************************************************************** -\ * Copyright (c) 2004, 2008 IBM Corporation -\ * All rights reserved. -\ * This program and the accompanying materials -\ * are made available under the terms of the BSD License -\ * which accompanies this distribution, and is available at -\ * http://www.opensource.org/licenses/bsd-license.php -\ * -\ * Contributors: -\ * IBM Corporation - initial implementation -\ ****************************************************************************/ - -0 VALUE load-size -0 VALUE go-entry -VARIABLE state-valid false state-valid ! -CREATE go-args 2 cells allot go-args 2 cells erase - -\ \\\\\\\\\\\\\\ Structure/Implementation Dependent Methods - -: $bootargs - bootargs 2@ ?dup IF - ELSE s" diagnostic-mode?" evaluate and IF s" diag-file" evaluate - ELSE s" boot-file" evaluate THEN THEN -; - -: $bootdev ( -- device-name len ) - bootdevice 2@ dup IF s" " $cat THEN - s" diagnostic-mode?" evaluate IF - s" diag-device" evaluate - ELSE - s" boot-device" evaluate - THEN - $cat \ prepend bootdevice setting from vpd-bootlist - strdup - ?dup 0= IF - disable-watchdog - drop true ABORT" No boot device!" - THEN -; - - -\ \\\\\\\\\\\\\\ Implementation Independent Methods (Depend on Previous) -\ * -\ * -: set-boot-args ( str len -- ) dup IF strdup ELSE nip dup THEN bootargs 2! ; - -: (set-boot-device) ( str len -- ) - ?dup IF 1+ strdup 1- ELSE drop 0 0 THEN bootdevice 2! -; - -' (set-boot-device) to set-boot-device - -: (add-boot-device) ( str len -- ) \ Concatenate " str" to "bootdevice" - bootdevice 2@ ?dup IF $cat-space ELSE drop THEN set-boot-device -; - -' (add-boot-device) to add-boot-device - -0 value claim-list - -: no-go ( -- ) -64 boot-exception-handler ABORT ; - -defer go ( -- ) - -: go-32 ( -- ) - state-valid @ IF - 0 ciregs >r3 ! 0 ciregs >r4 ! - go-args 2@ go-entry start-elf client-data - claim-list elf-release 0 to claim-list - THEN - -6d boot-exception-handler ABORT -; - -: go-64 ( args len entry r2 -- ) - 0 ciregs >r3 ! 0 ciregs >r4 ! - start-elf64 client-data - claim-list elf-release 0 to claim-list -; - -: set-le ( -- ) - 1 ciregs >r13 ! -; - -: set-be ( -- ) - 0 ciregs >r13 ! -; - -: go-64-be ( -- ) - state-valid @ IF - set-be - go-args 2@ - go-entry @ - go-entry 8 + @ - go-64 - THEN - -6d boot-exception-handler ABORT -; - - -: go-32-be - set-be - go-32 -; - -: go-32-lev1 - set-le - go-32 -; - -: go-64-lev1 - state-valid @ IF - go-args 2@ - go-entry @ xbflip - go-entry 8 + @ xbflip - set-le - go-64 - THEN - -6d boot-exception-handler ABORT -; - -: go-64-lev2 - state-valid @ IF - go-args 2@ - go-entry 0 - set-le - go-64 - THEN - -6d boot-exception-handler ABORT -; - -: load-elf-init ( arg len file-addr -- success ) - false state-valid ! \ Not valid anymore ... - claim-list IF \ Release claimed mem - claim-list elf-release 0 to claim-list \ from last load - THEN - - true swap -1 ( arg len true file-addr -1 ) - elf-load-claim ( arg len true claim-list entry elftype ) - - ( arg len true claim-list entry elftype ) - CASE - 1 OF ['] go-32-be ENDOF ( arg len true claim-list entry go ) - 2 OF ['] go-64-be ENDOF ( arg len true claim-list entry go ) - 3 OF ['] go-64-lev1 ENDOF ( arg len true claim-list entry go ) - 4 OF ['] go-64-lev2 ENDOF ( arg len true claim-list entry go ) - 5 OF ['] go-32-lev1 ENDOF ( arg len true claim-list entry go ) - dup OF ['] no-go to go - 2drop 3drop false EXIT ENDOF ( false ) - ENDCASE - - to go to go-entry to claim-list - dup state-valid ! -rot - - 2 pick IF - go-args 2! - ELSE - 2drop - THEN -; - -: init-program ( -- ) - $bootargs get-load-base ['] load-elf-init CATCH ?dup IF - boot-exception-handler - 2drop 2drop false \ Could not claim - ELSE IF - 0 ciregs 2dup >r3 ! >r4 ! \ Valid (ELF ) Image - THEN - THEN -; - - -\ \\\\\\\\\\\\\\ Exported Interface: -\ * -\ Generic device load method: -\ * - -: do-load ( devstr len -- img-size ) \ Device method wrapper - use-load-watchdog? IF - \ Set watchdog timer to 10 minutes, multiply with 2 because DHCP - \ needs 1 second per try and add 1 min to avoid race conditions - \ with watchdog timeout. - 4ec set-watchdog - THEN - 2dup " HALT" str= IF 2drop 0 EXIT THEN - my-self >r current-node @ >r \ Save my-self - ." Trying to load: " $bootargs type ." from: " 2dup type ." ... " - 2dup open-dev dup IF - dup to my-self - dup ihandle>phandle set-node - -rot ( ihandle devstr len ) - encode-string s" bootpath" set-chosen - $bootargs encode-string s" bootargs" set-chosen - get-load-base s" load" 3 pick ['] $call-method CATCH IF - -67 boot-exception-handler 3drop drop false - ELSE - dup 0> IF - init-program - ELSE - false state-valid ! - drop 0 \ Could not load - THEN - THEN - swap close-dev device-end dup to load-size - ELSE -68 boot-exception-handler 3drop false THEN - r> set-node r> to my-self \ Restore my-self -; - -: parse-load ( "{devlist}" -- success ) \ Parse-execute boot-device list - cr BEGIN parse-word dup WHILE - de-alias do-load dup 0< IF drop 0 THEN IF - state-valid @ IF ." Successfully loaded" cr THEN - true 0d parse strdup load-list 2! EXIT - THEN - REPEAT 2drop 0 0 load-list 2! false -; - -: load ( "{params}<eol>"} -- success ) \ Client interface to load - parse-word 0d parse -leading 2swap ?dup IF - de-alias - set-boot-device - ELSE - drop - THEN - set-boot-args s" parse-load " $bootdev $cat strdup evaluate -; - -: load-next ( -- success ) \ Continue after go failed - load-list 2@ ?dup IF s" parse-load " 2swap $cat strdup evaluate - ELSE drop false THEN -; - -\ \\\\\\\\\\\\\\\\\\\\\\\\\\ -\ load/go utilities -\ -> Should be in loaders.fs - -: noload false ; - -' no-go to go - -: (go-and-catch) ( -- ) - \ Recommended Practice: Forth Source Support (scripts starting with comment) - get-load-base c@ 5c = get-load-base 1+ c@ 20 = AND IF - load-size alloc-mem ( allocated-addr ) - ?dup 0= IF ." alloc-mem failed." cr EXIT THEN - load-size >r >r ( R: allocate-addr load-size ) - get-load-base r@ load-size move \ Move away from load-base - r@ load-size evaluate \ Run the script - r> r> free-mem - EXIT - THEN - \ Assume it's a normal executable, use "go" to run it: - ['] go behavior CATCH IF -69 boot-exception-handler THEN -; - - -\ if the board does not get the bootlist from the nvram -\ then this word is supposed to be overloaded with the -\ word to get the bootlist from VPD (or from wheresoever) -read-bootlist - -\ \\\\\\\\\\\\\\ Exported Interface: -\ * -\ IEEE 1275 : load (user interface) -\ * -: boot - load 0= IF -65 boot-exception-handler EXIT THEN - disable-watchdog (go-and-catch) - BEGIN load-next WHILE - disable-watchdog (go-and-catch) - REPEAT - - \ When we return from boot print the banner again. - .banner -; - -: load load 0= IF -65 boot-exception-handler THEN ; - -\ \\\\ Temporary hacks for backwards compatibility -: yaboot ." Use 'boot disk' instead " ; - -: netboot ( -- rc ) ." Use 'boot net' instead " ; - -: netboot-arg ( arg-string -- rc ) - s" boot net " 2swap $cat (parse-line) $cat - evaluate -; - -: netload ( -- rc ) (parse-line) - load-base-override >r flash-load-base to load-base-override - s" load net:" strdup 2swap $cat strdup evaluate - r> to load-base-override - load-size -; - -: neteval ( -- ) FLASH-LOAD-BASE netload evaluate ; - diff --git a/qemu/roms/SLOF/slof/fs/bootmsg.fs b/qemu/roms/SLOF/slof/fs/bootmsg.fs deleted file mode 100644 index 524d46908..000000000 --- a/qemu/roms/SLOF/slof/fs/bootmsg.fs +++ /dev/null @@ -1,74 +0,0 @@ -\ ***************************************************************************** -\ * Copyright (c) 2004, 2008 IBM Corporation -\ * All rights reserved. -\ * This program and the accompanying materials -\ * are made available under the terms of the BSD License -\ * which accompanies this distribution, and is available at -\ * http://www.opensource.org/licenses/bsd-license.php -\ * -\ * Contributors: -\ * IBM Corporation - initial implementation -\ ****************************************************************************/ -create debugstr 255 allot -0 VALUE debuglen -\ tbl@ d# 1000 * 196e6aa / VALUE TIME1 -\ 0 VALUE TIME2 - -\ Usage: 42 cp -: cp ( checkpoint -- ) - \ cr depth 2 0.r s" : " type .s cr \ DEBUG - \ cr ." time: " tbl@ d# 1000 * 196e6aa / dup TIME1 - dup . cr TIME2 + TO TIME2 TO TIME1 - bootmsg-cp ; - -: (warning) ( id level ptr len -- ) - dup TO debuglen - debugstr swap move \ copy into buffer - 0 debuglen debugstr + c! \ terminate '\0' - debugstr bootmsg-warning -; - -\ Usage: 42 0 warning" warning-txt" -: warning" ( id level [text<">] -- ) - postpone s" state @ - IF - ['] (warning) compile, - ELSE - (warning) - THEN -; immediate - -: (debug-cp) ( id level ptr len -- ) - dup TO debuglen - debugstr swap move \ copy into buffer - 0 debuglen debugstr + c! \ terminate '\0' - debugstr bootmsg-debugcp -; - -\ Usage: 42 0 debug-cp" debug-cp-txt" -: debug-cp" ( id level [text<">] -- ) - postpone s" state @ - IF - ['] (debug-cp) compile, - ELSE - (debug-cp) - THEN -; immediate - -: (error) ( id ptr len -- ) - dup TO debuglen - debugstr swap move \ copy into buffer - 0 debuglen debugstr + c! \ terminate '\0' - debugstr bootmsg-error -; - -\ Usage: 42 error" error-txt" -: error" ( id level [text<">] -- ) - postpone s" state @ - IF - ['] (error) compile, - ELSE - (error) - THEN -; immediate - -bootmsg-nvupdate diff --git a/qemu/roms/SLOF/slof/fs/claim.fs b/qemu/roms/SLOF/slof/fs/claim.fs deleted file mode 100644 index d012d3db8..000000000 --- a/qemu/roms/SLOF/slof/fs/claim.fs +++ /dev/null @@ -1,415 +0,0 @@ -\ ***************************************************************************** -\ * Copyright (c) 2004, 2011 IBM Corporation -\ * All rights reserved. -\ * This program and the accompanying materials -\ * are made available under the terms of the BSD License -\ * which accompanies this distribution, and is available at -\ * http://www.opensource.org/licenses/bsd-license.php -\ * -\ * Contributors: -\ * IBM Corporation - initial implementation -\ ****************************************************************************/ - -\ \\\\\\\\\\\\\\ Constants -500 CONSTANT AVAILABLE-SIZE -4000 CONSTANT MIN-RAM-RESERVE \ prevent from using first pages - -: MIN-RAM-SIZE \ Initially available memory size - epapr-ima-size IF - epapr-ima-size - ELSE - 20000000 \ assumed minimal memory size - THEN -; -MIN-RAM-SIZE CONSTANT MIN-RAM-SIZE - -\ \\\\\\\\\\\\\\ Structures -\ + -\ The available element size depends strictly on the address/size -\ value formats and will be different for various device types -\ + -STRUCT - cell field available>address - cell field available>size -CONSTANT /available - - -\ \\\\\\\\\\\\\\ Global Data -CREATE available AVAILABLE-SIZE /available * allot available AVAILABLE-SIZE /available * erase -VARIABLE mem-pre-released 0 mem-pre-released ! - -\ \\\\\\\\\\\\\\ Structure/Implementation Dependent Methods -: available>size@ available>size @ ; -: available>address@ available>address @ ; -: available>size! available>size ! ; -: available>address! available>address ! ; - -: available! ( addr size available-ptr -- ) - dup -rot available>size! available>address! -; - -: available@ ( available-ptr -- addr size ) - dup available>address@ swap available>size@ -; - - -\ \\\\\\\\\\\\\\ Implementation Independent Methods (Depend on Previous) -\ + -\ Warning: They are not yet really independent from available formatting -\ + - -\ + -\ Find position in the "available" where given range exists or can be inserted, -\ return pointer and logical found/notfound value -\ If error, return NULL pointer in addition to notfound code -\ + -: (?available-segment<) ( start1 end1 start2 end2 -- true/false ) drop < nip ; - -: (?available-segment>) ( start1 end1 start2 end2 -- true/false ) -rot 2drop > ; - -\ start1 to end1 is the area that should be claimed -\ start2 to end2 is the available segment -\ return true if it can not be claimed, false if it can be claimed -: (?available-segment-#) ( start1 end1 start2 end2 -- true/false ) - 2dup 5 roll -rot ( e1 s2 e2 s1 s2 e2 ) - between >r between r> and not -; - -: (find-available) ( addr addr+size-1 a-ptr a-size -- a-ptr' found ) - ?dup 0= IF -rot 2drop false EXIT THEN \ Not Found - - 2dup 2/ dup >r /available * + - ( addr addr+size-1 a-ptr a-size a-ptr' R: a-size' ) - dup available>size@ 0= IF 2drop r> RECURSE EXIT THEN - - ( addr addr+size-1 a-ptr a-size a-ptr' R: a-size' ) - dup >r available@ - ( addr addr+size-1 a-ptr a-size addr' size' R: a-size' a-ptr' ) - over + 1- 2>r 2swap - ( a-ptr a-size addr addr+size-1 ) - ( R: a-size' a-ptr' addr' addr'+size'-1 ) - - 2dup 2r@ (?available-segment>) IF - 2swap 2r> 2drop r> - /available + -rot r> - 1- nip RECURSE EXIT \ Look Right - THEN - 2dup 2r@ (?available-segment<) IF - 2swap 2r> 2drop r> - 2drop r> RECURSE EXIT \ Look Left - THEN - 2dup 2r@ (?available-segment-#) IF \ Conflict - segments overlap - 2r> 2r> 3drop 3drop 2drop - 1212 throw - THEN - 2r> 3drop 3drop r> r> drop ( a-ptr' -- ) - dup available>size@ 0<> ( a-ptr' found -- ) -; - -: (find-available) ( addr size -- seg-ptr found ) - over + 1- available AVAILABLE-SIZE ['] (find-available) catch IF - 2drop 2drop 0 false - THEN -; - - -: dump-available ( available-ptr -- ) - cr - dup available - /available / AVAILABLE-SIZE swap - 0 ?DO - dup available@ ?dup 0= IF - 2drop UNLOOP EXIT - THEN - swap . . cr - /available + - LOOP - dup -; - -: .available available dump-available ; - -\ + -\ release utils: -\ + - -\ + -\ (drop-available) just blindly compresses space of available map -\ + -: (drop-available) ( available-ptr -- ) - dup available - /available / \ current element index - AVAILABLE-SIZE swap - \ # of remaining elements - - ( first nelements ) 1- 0 ?DO - dup /available + dup available@ - - ( current next next>address next>size ) ?dup 0= IF - 2drop LEAVE \ NULL element - goto last copy - THEN - 3 roll available! ( next ) - LOOP - - \ Last element : just zero it out - 0 0 rot available! -; - -\ + -\ (stick-to-previous-available) merge the segment on stack -\ with the previous one, if possible, and modified segment parameters if merged -\ Return success code -\ + -: (stick-to-previous-available) ( addr size available-ptr -- naddr nsize nptr success ) - dup available = IF - false EXIT \ This was the first available segment - THEN - - dup /available - dup available@ - + 4 pick = IF - nip \ Drop available-ptr since we are going to previous one - rot drop \ Drop start addr, we take the previous one - - dup available@ 3 roll + rot true - ( prev-addr prev-size+size prev-ptr true ) - ELSE - drop false - ( addr size available-ptr false ) - THEN -; - -\ + -\ (insert-available) just blindly makes space for another element on given -\ position -\ + -\ insert-available should also check adjacent elements and merge if new -\ region is contiguos w. others -\ + -: (insert-available) ( available-ptr -- available-ptr ) - dup \ current element - dup available - /available / \ current element index - AVAILABLE-SIZE swap - \ # of remaining elements - - dup 0<= 3 pick available>size@ 0= or IF - \ End of "available" or came to an empty element - Exit - drop drop EXIT - THEN - - over available@ rot - - ( first first/=current/ first>address first>size nelements ) 1- 0 ?DO - 2>r - ( first current R: current>address current>size ) - - /available + dup available@ - ( first current+1/=next/ next>address next>size ) - ( R: current>address current>size ) - - 2r> 4 pick available! dup 0= IF - \ NULL element - last copy - rot /available + available! - UNLOOP EXIT - THEN - LOOP - - ( first next/=last/ last[0]>address last[0]>size ) ?dup 0<> IF - cr ." release error: available map overflow" - cr ." Dumping available property" - .available - cr ." No space for one before last entry:" cr swap . . - cr ." Dying ..." cr 123 throw - THEN - - 2drop -; - -: insert-available ( addr size available-ptr -- addr size available-ptr ) - dup available>address@ 0<> IF - \ Not empty : - dup available>address@ rot dup -rot - - - ( addr available-ptr size available>address@-size ) - - 3 pick = IF \ if (available>address@ - size == addr) - \ Merge w. next segment - no insert needed - - over available>size@ + swap - ( addr size+available>size@ available-ptr ) - - (stick-to-previous-available) IF - \ Merged w. prev & next one : discard extra seg - dup /available + (drop-available) - THEN - ELSE - \ shift the rest of "available" to make space - - swap (stick-to-previous-available) - not IF (insert-available) THEN - THEN - ELSE - (stick-to-previous-available) drop - THEN -; - -defer release - -\ + -\ claim utils: -\ + -: drop-available ( addr size available-ptr -- addr ) - dup >r available@ - ( req_addr req_size segment_addr segment_size R: available-ptr ) - - over 4 pick swap - ?dup 0<> IF - \ Segment starts before requested address : free the head space - dup 3 roll swap r> available! - - - ( req_addr req_size segment_size-segment_addr+req_addr ) - over - ?dup 0= IF - \ That's it - remainder of segment is what we claim - drop - ELSE - \ Both head and tail of segment remain unclaimed : - \ need an extra available element - swap 2 pick + swap release - THEN - ELSE - nip ( req_addr req_size segment_size ) - over - ?dup 0= IF - \ Exact match : drop the whole available segment - drop r> (drop-available) - ELSE - \ We claimed the head, need to leave the tail available - -rot over + rot r> available! - THEN - THEN - ( base R: -- ) -; - -: pwr2roundup ( value -- pwr2value ) - dup CASE - 0 OF EXIT ENDOF - 1 OF EXIT ENDOF - ENDCASE - dup 1 DO drop i dup +LOOP - dup + -; - -: (claim-best-fit) ( len align -- len base ) - pwr2roundup 1- -1 -1 - ( len align-1 best-fit-residue/=-1/ best-fit-base/=-1/ ) - - available AVAILABLE-SIZE /available * + available DO - i \ Must be saved now, before we use Return stack - -rot >r >r swap >r - - ( len i R: best-fit-base best-fit-residue align-1 ) - - available@ ?dup 0= IF drop r> r> r> LEAVE THEN \ EOL - - 2 pick - dup 0< IF - 2drop \ Can't Fit: Too Small - ELSE - dup 2 pick r@ and - 0< IF - 2drop \ Can't Fit When Aligned - ELSE - ( len i>address i>size-len ) - ( R: best-fit-base best-fit-residue align-1 ) - r> -rot dup r@ U< IF - \ Best Fit so far: drop the old one - 2r> 2drop - - ( len align-1 nu-base nu-residue R: ) - \ Now align new base and push to R: - swap 2 pick + 2 pick invert and >r >r >r - ELSE - 2drop >r - THEN - THEN - THEN - r> r> r> - /available +LOOP - - -rot 2drop ( len best-fit-base/or -1 if none found/ ) -; - -: (adjust-release0) ( 0 size -- addr' size' ) - \ segment 0 already pre-relased in early phase: adjust - 2dup MIN-RAM-SIZE dup 3 roll + -rot - - dup 0< IF 2drop ELSE - 2swap 2drop 0 mem-pre-released ! - THEN -; - - -\ \\\\\\\\\\\\\\ Exported Interface: -\ + -\ IEEE 1275 implementation: -\ claim -\ Claim the region with given start address and size (if align parameter is 0); -\ alternatively claim any region of given alignment -\ + -\ Throw an exception if failed -\ + -: claim ( [ addr ] len align -- base ) - ?dup 0<> IF - (claim-best-fit) dup -1 = IF - 2drop cr ." claim error : aligned allocation failed" cr - ." available:" cr .available - 321 throw EXIT - THEN - swap - THEN - - 2dup (find-available) not IF - drop -\ cr ." claim error : requested " . ." bytes of memory at " . -\ ." not available" cr -\ ." available:" cr .available - 2drop - 321 throw EXIT - THEN - ( req_addr req_size available-ptr ) drop-available - - ( req_addr ) -; - - -\ + -\ IEEE 1275 implementation: -\ release -\ Free the region with given start address and size -\ + -: .release ( addr len -- ) - over 0= mem-pre-released @ and IF (adjust-release0) THEN - - 2dup (find-available) IF - drop swap - cr ." release error: region " . ." , " . ." already released" cr - ELSE - ?dup 0= IF - swap - cr ." release error: Bad/conflicting region " . ." , " . - ." or available list full " cr - ELSE - ( addr size available-ptr ) insert-available - - \ NOTE: insert did not change the stack layout - \ but it may have changed any of the three values - \ in order to implement merge of free regions - \ We do not interpret these values any more - \ just blindly copy it in - - ( addr size available-ptr ) available! - THEN - THEN -; - -' .release to release - - -\ pre-release minimal memory size -0 MIN-RAM-SIZE release 1 mem-pre-released ! - -\ claim first pages used for PPC exception vectors -0 MIN-RAM-RESERVE 0 ' claim CATCH IF ." claim failed!" cr 2drop THEN drop - -\ claim region used by firmware (assume 31 MiB size right now) -paflof-start ffff not and 1f00000 0 ' claim CATCH IF - ." claim failed!" cr 2drop -THEN drop diff --git a/qemu/roms/SLOF/slof/fs/client.fs b/qemu/roms/SLOF/slof/fs/client.fs deleted file mode 100644 index 7d537a668..000000000 --- a/qemu/roms/SLOF/slof/fs/client.fs +++ /dev/null @@ -1,311 +0,0 @@ -\ ***************************************************************************** -\ * Copyright (c) 2004, 2008 IBM Corporation -\ * All rights reserved. -\ * This program and the accompanying materials -\ * are made available under the terms of the BSD License -\ * which accompanies this distribution, and is available at -\ * http://www.opensource.org/licenses/bsd-license.php -\ * -\ * Contributors: -\ * IBM Corporation - initial implementation -\ ****************************************************************************/ - - -\ Client interface. - -0 VALUE debug-client-interface? - -\ First, the machinery. - -VOCABULARY client-voc \ We store all client-interface callable words here. - -6789 CONSTANT sc-exit -4711 CONSTANT sc-yield - -VARIABLE client-callback \ Address of client's callback function - -: client-data ciregs >r3 @ ; -: nargs client-data la1+ l@ ; -: nrets client-data la1+ la1+ l@ ; -: client-data-to-stack - client-data 3 la+ nargs 0 ?DO dup l@ swap la1+ LOOP drop ; -: stack-to-client-data - client-data nargs nrets + 2 + la+ nrets 0 ?DO tuck l! /l - LOOP drop ; - -: call-client ( args len client-entry -- ) - \ (args, len) describe the argument string, client-entry is the address of - \ the client's .entry symbol, i.e. where we eventually branch to. - \ ciregs is a variable that describes the register set of the host processor, - \ see slof/fs/exception.fs for details - \ client-entry-point maps to client_entry_point in slof/entry.S which is - \ the SLOF entry point when calling a SLOF client interface word from the - \ client. - \ We pass the arguments for the client in R6 and R7, the client interface - \ entry point address is passed in R5. - >r ciregs >r7 ! ciregs >r6 ! client-entry-point @ ciregs >r5 ! - \ Initialise client-stack-pointer - cistack ciregs >r1 ! - \ jump-client maps to call_client in slof/entry.S - \ When jump-client returns, R3 holds the address of a NUL-terminated string - \ that holds the client interface word the client wants to call, R4 holds - \ the return address. - r> jump-client drop - BEGIN - client-data-to-stack - \ Now create a Forth-style string, look it up in the client dictionary and - \ execute it, guarded by CATCH. Result of xt == 0 is stored on the return - \ stack - client-data l@ zcount - \ XXX: Should only look in client-voc... - ALSO client-voc $find PREVIOUS - dup 0= >r IF - CATCH - \ If a client interface word needs some special treatment, like exit and - \ yield, then the implementation needs to use THROW to indicate its needs - ?dup IF - dup CASE - sc-exit OF drop r> drop EXIT ENDOF - sc-yield OF drop r> drop EXIT ENDOF - ENDCASE - \ Some special call was made but we don't know that to do with it... - THROW - THEN - stack-to-client-data - ELSE - cr type ." NOT FOUND" - THEN - \ Return to the client - r> ciregs >r3 ! ciregs >r4 @ jump-client - UNTIL ; - -: flip-stack ( a1 ... an n -- an ... a1 ) ?dup IF 1 ?DO i roll LOOP THEN ; - -: (callback) ( "service-name<>" "arguments<cr>" -- ) - client-callback @ \ client-callback points to the function prolog - dup 8 + @ ciregs >r2 ! \ Set up the TOC pointer (???) - @ call-client ; \ Resolve the function's address from the prolog -' (callback) to callback - -: (continue-client) - s" " \ make call-client happy, client won't use the string anyways. - ciregs >r4 @ call-client ; -' (continue-client) to continue-client - -\ Utility. -: string-to-buffer ( str len buf len -- len' ) - 2dup erase rot min dup >r move r> ; - -\ Now come the actual client interface words. - -ALSO client-voc DEFINITIONS - -: exit sc-exit THROW ; - -: yield sc-yield THROW ; - -: test ( zstr -- missing? ) - \ XXX: Should only look in client-voc... - zcount - debug-client-interface? IF - ." ci: test " 2dup type cr - THEN - ALSO client-voc $find PREVIOUS IF - drop FALSE - ELSE - 2drop TRUE - THEN -; - -: finddevice ( zstr -- phandle ) - zcount - debug-client-interface? IF - ." ci: finddevice " 2dup type cr - THEN - 2dup " /memory" str= IF - \ Workaround: grub passes /memory instead of /memory@0 - 2drop - " /memory@0" - THEN - find-node dup 0= IF drop -1 THEN -; - -: getprop ( phandle zstr buf len -- len' ) - >r >r zcount rot ( str-adr str-len phandle R: len buf ) - debug-client-interface? IF - ." ci: getprop " 3dup . ." '" type ." '" - THEN - get-property - debug-client-interface? IF - dup IF ." ** not found **" THEN - cr - THEN - 0= IF - r> swap dup r> min swap >r move r> - ELSE - r> r> 2drop -1 - THEN -; - -: getproplen ( phandle zstr -- len ) - zcount rot get-property 0= IF nip ELSE -1 THEN ; - -: setprop ( phandle zstr buf len -- size|-1 ) - dup >r \ save len - encode-bytes ( phandle zstr prop-addr prop-len ) - 2swap zcount rot ( prop-addr prop-len name-addr name-len phandle ) - current-node @ >r \ save current node - set-node \ change to specified node - property \ set property - r> set-node \ restore original node - r> \ always return size, because we can not fail. -; - -\ VERY HACKISH -: canon ( zstr buf len -- len' ) - 2dup erase - >r >r zcount - >r dup c@ [char] / = IF - r> r> swap r> over >r min move r> - ELSE - r> find-alias ?dup 0= IF - r> r> 2drop -1 - ELSE - dup -rot r> swap r> min move - THEN - THEN -; - -: nextprop ( phandle zstr buf -- flag ) \ -1 invalid, 0 end, 1 ok - >r zcount rot next-property IF r> zplace 1 ELSE r> drop 0 THEN ; - -: open ( zstr -- ihandle ) - zcount - debug-client-interface? IF - ." ci: open " 2dup type cr - THEN - open-dev -; - -: close ( ihandle -- ) - debug-client-interface? IF - ." ci: close " dup . cr - THEN - s" stdin" get-chosen IF - decode-int nip nip over = IF - \ End of life of SLOF now, call platform quiesce as quiesce - \ is an undocumented extension and not everybody supports it - close-dev - quiesce - ELSE - close-dev - THEN - ELSE - close-dev - THEN -; - -\ Now implemented: should return -1 if no such method exists in that node -: write ( ihandle str len -- len' ) rot s" write" rot - ['] $call-method CATCH IF 2drop 3drop -1 THEN ; -: read ( ihandle str len -- len' ) rot s" read" rot - ['] $call-method CATCH IF 2drop 3drop -1 THEN ; -: seek ( ihandle hi lo -- status ) swap rot s" seek" rot - ['] $call-method CATCH IF 2drop 3drop -1 THEN ; - -\ A real claim implementation: 3.2% memory fat :-) -: claim ( addr len align -- base ) - debug-client-interface? IF - ." ci: claim " .s cr - THEN - dup IF rot drop - ['] claim CATCH IF 2drop -1 THEN - ELSE - ['] claim CATCH IF 3drop -1 THEN - THEN -; - -: release ( addr len -- ) - debug-client-interface? IF - ." ci: release " .s cr - THEN - release -; - -: instance-to-package ( ihandle -- phandle ) - ihandle>phandle ; - -: package-to-path ( phandle buf len -- len' ) - 2>r node>path 2r> string-to-buffer ; -: instance-to-path ( ihandle buf len -- len' ) - 2>r instance>path 2r> string-to-buffer ; -: instance-to-interposed-path ( ihandle buf len -- len' ) - 2>r instance>qpath 2r> string-to-buffer ; - -: call-method ( str ihandle arg ... arg -- result return ... return ) - nargs flip-stack zcount - debug-client-interface? IF - ." ci: call-method " 2dup type cr - THEN - rot ['] $call-method CATCH - nrets 0= IF drop ELSE \ if called with 0 return args do not return the catch result - dup IF nrets 1 ?DO -444 LOOP THEN - nrets flip-stack - THEN -; - -\ From the PAPR. -: test-method ( phandle str -- missing? ) - zcount - debug-client-interface? IF - ." ci: test-method " 2dup type cr - THEN - rot find-method dup IF nip THEN 0= -; - -: milliseconds milliseconds ; - -: start-cpu ( phandle addr r3 -- ) - >r >r - s" reg" rot get-property 0= IF drop l@ - ELSE true ABORT" start-cpu called with invalid phandle" THEN - r> r> of-start-cpu drop -; - -\ Quiesce firmware and assert that all hardware is in a sane state -\ (e.g. assert that no background DMA is running anymore) -: quiesce ( -- ) - debug-client-interface? IF - ." ci: quiesce" cr - THEN - \ The main quiesce call is defined in quiesce.fs - quiesce -; - -\ -\ Standard for Boot, defined in 6.3.2.5: -\ -: boot ( zstr -- ) - zcount - debug-client-interface? IF - ." ci: boot " 2dup type cr - THEN - " boot " 2swap $cat " boot-command" $setenv (nvupdate) - reset-all -; - -\ -\ User Interface, defined in 6.3.2.6 -\ -: interpret ( ... zstr -- result ... ) - zcount - debug-client-interface? IF - ." ci: interpret " 2dup type cr - THEN - ['] evaluate CATCH -; - -\ Allow the client to register a callback -: set-callback ( newfunc -- oldfunc ) - client-callback @ swap client-callback ! ; - -PREVIOUS DEFINITIONS diff --git a/qemu/roms/SLOF/slof/fs/debug.fs b/qemu/roms/SLOF/slof/fs/debug.fs deleted file mode 100644 index e54f729fe..000000000 --- a/qemu/roms/SLOF/slof/fs/debug.fs +++ /dev/null @@ -1,422 +0,0 @@ -\ ***************************************************************************** -\ * Copyright (c) 2004, 2008 IBM Corporation -\ * All rights reserved. -\ * This program and the accompanying materials -\ * are made available under the terms of the BSD License -\ * which accompanies this distribution, and is available at -\ * http://www.opensource.org/licenses/bsd-license.php -\ * -\ * Contributors: -\ * IBM Corporation - initial implementation -\ ****************************************************************************/ - - -\ Get the name of Forth command whose execution token is xt - -: xt>name ( xt -- str len ) - BEGIN - cell - dup c@ 0 2 within IF - dup 2+ swap 1+ c@ exit - THEN - AGAIN -; - -cell -1 * CONSTANT -cell -: cell- ( n -- n-cell-size ) - [ cell -1 * ] LITERAL + -; - -\ Search for xt of given address -: find-xt-addr ( addr -- xt ) - BEGIN - dup @ <colon> = IF - EXIT - THEN - cell- - AGAIN -; - -: (.immediate) ( xt -- ) - \ is it immediate? - xt>name drop 2 - c@ \ skip len and flags - immediate? IF - ." IMMEDIATE" - THEN -; - -: (.xt) ( xt -- ) - xt>name type -; - -\ Trace back on current return stack. -\ Start at 1, since 0 is return of trace-back itself - -: trace-back ( ) - 1 - BEGIN - cr dup dup . ." : " rpick dup . ." : " - ['] tib here within IF - dup rpick find-xt-addr (.xt) - THEN - 1+ dup rdepth 5 - >= IF cr drop EXIT THEN - AGAIN -; - -VARIABLE see-my-type-column - -: (see-my-type) ( indent limit xt str len -- indent limit xt ) - dup see-my-type-column @ + dup 50 >= IF - -rot over " " comp 0= IF - \ blank causes overflow: just enforce new line with next call - 2drop see-my-type-column ! - ELSE - rot drop ( indent limit xt str len ) - \ Need to copy string since we use (u.) again (kills internal buffer): - pocket swap 2dup >r >r ( indent limit xt str pk len R: len pk ) - move r> r> ( indent limit xt pk len ) - 2 pick (u.) dup -rot - cr type ( indent limit xt pk len xt-len ) - " :" type 1+ ( indent limit xt pk len prefix-len ) - 5 pick dup spaces + ( indent limit xt pk len prefix-len ) - over + see-my-type-column ! ( indent limit xt pk len ) - type - THEN ( indent limit xt ) - ELSE - see-my-type-column ! type ( indent limit xt ) - THEN -; - -: (see-my-type-init) ( -- ) - ffff see-my-type-column ! \ just enforce a new line -; - -: (see-colon-body) ( indent limit xt -- indent limit xt ) - (see-my-type-init) \ enforce new line - BEGIN ( indent limit xt ) - cell+ 2dup <> - over @ - dup <semicolon> <> - rot and ( indent limit xt @xt flag ) - WHILE ( indent limit xt @xt ) - xt>name (see-my-type) " " (see-my-type) - dup @ ( indent limit xt @xt) - CASE - <0branch> OF cell+ dup @ - over + cell+ dup >r - (u.) (see-my-type) r> ( indent limit xt target) - 2dup < IF - over 4 pick 3 + -rot recurse - nip nip nip cell- ( indent limit xt ) - ELSE - drop ( indent limit xt ) - THEN - (see-my-type-init) ENDOF \ enforce new line - <branch> OF cell+ dup @ over + cell+ (u.) - (see-my-type) " " (see-my-type) ENDOF - <do?do> OF cell+ dup @ (u.) (see-my-type) - " " (see-my-type) ENDOF - <lit> OF cell+ dup @ (u.) (see-my-type) - " " (see-my-type) ENDOF - <dotick> OF cell+ dup @ xt>name (see-my-type) - " " (see-my-type) ENDOF - <doloop> OF cell+ dup @ (u.) (see-my-type) - " " (see-my-type) ENDOF - <do+loop> OF cell+ dup @ (u.) (see-my-type) - " " (see-my-type) ENDOF - <doleave> OF cell+ dup @ over + cell+ (u.) - (see-my-type) " " (see-my-type) ENDOF - <do?leave> OF cell+ dup @ over + cell+ (u.) - (see-my-type) " " (see-my-type) ENDOF - <sliteral> OF cell+ " """ (see-my-type) dup count dup >r - (see-my-type) " """ (see-my-type) - " " (see-my-type) - r> -cell and + ENDOF - ENDCASE - REPEAT - drop -; - -: (see-colon) ( xt -- ) - (see-my-type-init) - 1 swap 0 swap ( indent limit xt ) - " : " (see-my-type) dup xt>name (see-my-type) - rot drop 4 -rot (see-colon-body) ( indent limit xt ) - rot drop 1 -rot (see-my-type-init) " ;" (see-my-type) - 3drop -; - -\ Create words are a bit tricky. We find out where their code points. -\ If this code is part of SLOF, it is not a user generated CREATE. - -: (see-create) ( xt -- ) - dup cell+ @ - CASE - <2constant> OF - dup cell+ cell+ dup @ swap cell+ @ . . ." 2CONSTANT " - ENDOF - - <instancevalue> OF - dup cell+ cell+ @ . ." INSTANCE VALUE " - ENDOF - - <instancevariable> OF - ." INSTANCE VARIABLE " - ENDOF - - dup OF - ." CREATE " - ENDOF - ENDCASE - (.xt) -; - -\ Decompile Forth command whose execution token is xt - -: (see) ( xt -- ) - cr dup dup @ - CASE - <variable> OF ." VARIABLE " (.xt) ENDOF - <value> OF dup execute . ." VALUE " (.xt) ENDOF - <constant> OF dup execute . ." CONSTANT " (.xt) ENDOF - <defer> OF dup cell+ @ swap ." DEFER " (.xt) ." is " (.xt) ENDOF - <alias> OF dup cell+ @ swap ." ALIAS " (.xt) ." " (.xt) ENDOF - <buffer:> OF ." BUFFER: " (.xt) ENDOF - <create> OF (see-create) ENDOF - <colon> OF (see-colon) ENDOF - dup OF ." ??? PRIM " (.xt) ENDOF - ENDCASE - (.immediate) cr - ; - -\ Decompile Forth command old-name - -: see ( "old-name<>" -- ) - ' (see) -; - -\ Work in progress... - -0 value forth-ip -true value trace>stepping? -true value trace>print? -true value trace>up? -0 value trace>depth -0 value trace>rdepth -0 value trace>recurse -: trace-depth+ ( -- ) trace>depth 1+ to trace>depth ; -: trace-depth- ( -- ) trace>depth 1- to trace>depth ; - -: stepping ( -- ) - true to trace>stepping? -; - -: tracing ( -- ) - false to trace>stepping? -; - -: trace-print-on ( -- ) - true to trace>print? -; - -: trace-print-off ( -- ) - false to trace>print? -; - - -\ Add n to ip - -: fip-add ( n -- ) - forth-ip + to forth-ip -; - -\ Save execution token address and content - -0 value debug-last-xt -0 value debug-last-xt-content - -: trace-print ( -- ) - forth-ip cr u. ." : " - forth-ip @ - dup ['] breakpoint = IF drop debug-last-xt-content THEN - xt>name type ." " - ." ( " .s ." ) | " -; - -: trace-interpret ( -- ) - rdepth 1- to trace>rdepth - BEGIN - depth . [char] > dup emit emit space - source expect ( str len ) - ['] interpret catch print-status - AGAIN -; - -\ Main trace routine, trace a colon definition - -: trace-xt ( xt -- ) - trace>recurse IF - r> drop \ Drop return of 'trace-xt call - cell+ \ Step over ":" - ELSE - debug-last-xt-content <colon> = IF - \ debug colon-definition - ['] breakpoint @ debug-last-xt ! \ Re-arm break point - r> drop \ Drop return of 'trace-xt call - cell+ \ Step over ":" - ELSE - ['] breakpoint debug-last-xt ! \ Re-arm break point - 2r> 2drop - THEN - THEN - - to forth-ip - true to trace>print? - BEGIN - trace>print? IF trace-print THEN - - forth-ip ( ip ) - trace>stepping? IF - BEGIN - key - CASE - [char] d OF dup @ @ <colon> = IF \ recurse only into colon definitions - trace-depth+ - 1 to trace>recurse - dup >r @ recurse - THEN true ENDOF - [char] u OF trace>depth IF tracing trace-print-off true ELSE false THEN ENDOF - [char] f OF drop cr trace-interpret ENDOF \ quit trace and start interpreter FIXME rstack - [char] c OF tracing true ENDOF - [char] t OF trace-back false ENDOF - [char] q OF drop cr quit ENDOF - 20 OF true ENDOF - dup OF cr ." Press d: Down into current word" cr - ." Press u: Up to caller" cr - ." Press f: Switch to forth interpreter, 'resume' will continue tracing" cr - ." Press c: Switch to tracing" cr - ." Press <space>: Execute current word" cr - ." Press q: Abort execution, switch to interpreter" cr - false ENDOF - ENDCASE - UNTIL - THEN ( ip' ) - dup to forth-ip @ ( xt ) - dup ['] breakpoint = IF drop debug-last-xt-content THEN - dup ( xt xt ) - - CASE - <sliteral> OF drop forth-ip cell+ dup dup c@ + -cell and to forth-ip ENDOF - <dotick> OF drop forth-ip cell+ @ cell fip-add ENDOF - <lit> OF drop forth-ip cell+ @ cell fip-add ENDOF - <doto> OF drop forth-ip cell+ @ cell+ ! cell fip-add ENDOF - <(doito)> OF drop forth-ip cell+ @ cell+ cell+ @ >instance ! cell fip-add ENDOF - <0branch> OF drop IF - cell fip-add - ELSE - forth-ip cell+ @ cell+ fip-add THEN - ENDOF - <do?do> OF drop 2dup <> IF - swap >r >r cell fip-add - ELSE - forth-ip cell+ @ cell+ fip-add 2drop THEN - ENDOF - <branch> OF drop forth-ip cell+ @ cell+ fip-add ENDOF - <doleave> OF drop r> r> 2drop forth-ip cell+ @ cell+ fip-add ENDOF - <do?leave> OF drop IF - r> r> 2drop forth-ip cell+ @ cell+ fip-add - ELSE - cell fip-add - THEN - ENDOF - <doloop> OF drop r> 1+ r> 2dup = IF - 2drop cell fip-add - ELSE >r >r - forth-ip cell+ @ cell+ fip-add THEN - ENDOF - <do+loop> OF drop r> + r> 2dup >= IF - 2drop cell fip-add - ELSE >r >r - forth-ip cell+ @ cell+ fip-add THEN - ENDOF - - <semicolon> OF trace>depth 0> IF - trace-depth- 1 to trace>recurse - stepping drop r> recurse - ELSE - drop exit THEN - ENDOF - <exit> OF trace>depth 0> IF - trace-depth- stepping drop r> recurse - ELSE - drop exit THEN - ENDOF - dup OF execute ENDOF - ENDCASE - forth-ip cell+ to forth-ip - AGAIN -; - -\ Resume execution from tracer -: resume ( -- ) - trace>rdepth rdepth! - forth-ip cell - trace-xt -; - -\ Turn debug off, by erasing breakpoint - -: debug-off ( -- ) - debug-last-xt IF - debug-last-xt-content debug-last-xt ! \ Restore overwritten token - 0 to debug-last-xt - THEN -; - - - -\ Entry point for debug - -: (break-entry) ( -- ) - debug-last-xt dup @ ['] breakpoint <> swap ( debug-addr? debug-last-xt ) - debug-last-xt-content swap ! \ Restore overwritten token - r> drop \ Don't return to bp, but to caller - debug-last-xt-content <colon> <> and IF \ Execute non colon definition - debug-last-xt cr u. ." : " - debug-last-xt xt>name type ." " - ." ( " .s ." ) | " - key drop - debug-last-xt execute - ELSE - debug-last-xt 0 to trace>depth 0 to trace>recurse trace-xt \ Trace colon definition - THEN -; - -\ Put entry point bp defer -' (break-entry) to BP - -\ Mark an address for debugging - -: debug-address ( addr -- ) - debug-off ( xt ) \ Remove active breakpoint - dup to debug-last-xt ( xt ) \ Save token for later debug - dup @ to debug-last-xt-content ( xt ) \ Save old value - ['] breakpoint swap ! -; - -\ Mark the command indicated by xt for debugging - -: (debug ( xt -- ) - debug-off ( xt ) \ Remove active breakpoint - dup to debug-last-xt ( xt ) \ Save token for later debug - dup @ to debug-last-xt-content ( xt ) \ Save old value - ['] breakpoint @ swap ! -; - -\ Mark the command indicated by xt for debugging - -: debug ( "old-name<>" -- ) - parse-word $find IF \ Get xt for old-name - (debug - ELSE - ." undefined word " type cr - THEN -; diff --git a/qemu/roms/SLOF/slof/fs/devices/pci-class_02.fs b/qemu/roms/SLOF/slof/fs/devices/pci-class_02.fs deleted file mode 100644 index 271420f03..000000000 --- a/qemu/roms/SLOF/slof/fs/devices/pci-class_02.fs +++ /dev/null @@ -1,37 +0,0 @@ -\ ***************************************************************************** -\ * Copyright (c) 2004, 2008 IBM Corporation -\ * All rights reserved. -\ * This program and the accompanying materials -\ * are made available under the terms of the BSD License -\ * which accompanies this distribution, and is available at -\ * http://www.opensource.org/licenses/bsd-license.php -\ * -\ * Contributors: -\ * IBM Corporation - initial implementation -\ ****************************************************************************/ - -s" network [ " type my-space pci-class-name type s" ]" type - -my-space pci-device-generic-setup -my-space pci-alias-net - -s" network" device-type - -cr - -INSTANCE VARIABLE obp-tftp-package -: open ( -- okay? ) - open IF \ enables PCI mem, io and Bus master and returns TRUE - my-args s" obp-tftp" $open-package obp-tftp-package ! true - ELSE - false - THEN ; - -: close ( -- ) - obp-tftp-package @ close-package - close ; \ disables PCI mem, io and Bus master - -: load ( addr -- len ) - s" load" obp-tftp-package @ $call-method ; - -: ping ( -- ) s" ping" obp-tftp-package @ $call-method ; diff --git a/qemu/roms/SLOF/slof/fs/devices/pci-class_0c.fs b/qemu/roms/SLOF/slof/fs/devices/pci-class_0c.fs deleted file mode 100644 index 39453fbc0..000000000 --- a/qemu/roms/SLOF/slof/fs/devices/pci-class_0c.fs +++ /dev/null @@ -1,71 +0,0 @@ -\ ***************************************************************************** -\ * Copyright (c) 2004, 2011 IBM Corporation -\ * All rights reserved. -\ * This program and the accompanying materials -\ * are made available under the terms of the BSD License -\ * which accompanies this distribution, and is available at -\ * http://www.opensource.org/licenses/bsd-license.php -\ * -\ * Contributors: -\ * IBM Corporation - initial implementation -\ ****************************************************************************/ - -s" serial bus [ " type my-space pci-class-name type s" ]" type cr - -my-space pci-device-generic-setup - -STRUCT - /n FIELD hcd>base - /n FIELD hcd>type - /n FIELD hcd>num - /n FIELD hcd>ops - /n FIELD hcd>priv - /n FIELD hcd>nextaddr -CONSTANT /hci-dev - -: usb-setup-hcidev ( num hci-dev -- ) - >r - 10 config-l@ F AND case - 0 OF 10 config-l@ translate-my-address ENDOF \ 32-bit memory space - 4 OF \ 64-bit memory space - 14 config-l@ 20 lshift \ Read two bars - 10 config-l@ OR translate-my-address - ENDOF - ENDCASE - F not AND - ( io-base ) r@ hcd>base ! - 08 config-l@ 8 rshift 0000000F0 AND 4 rshift - ( usb-type ) r@ hcd>type ! - ( usb-num ) r@ hcd>num ! - r> drop -; - -\ Handle USB OHCI controllers: -: handle-usb-class ( -- ) - \ set Memory Write and Invalidate Enable, SERR# Enable - \ (see PCI 3.0 Spec Chapter 6.2.2 device control): - 4 config-w@ 110 or 4 config-w! - pci-master-enable \ set PCI Bus master bit and - pci-mem-enable \ memory space enable for USB scan -; - -\ Check PCI sub-class and interface type of Serial Bus Controller -\ to include the appropriate driver: -: handle-sbc-subclass ( -- ) - my-space pci-class@ ffff and CASE \ get PCI sub-class and interface - 0310 OF \ OHCI controller - handle-usb-class - set-ohci-alias - ENDOF - 0320 OF \ EHCI controller - handle-usb-class - set-ehci-alias - ENDOF - 0330 OF \ XHCI controller - handle-usb-class - set-xhci-alias - ENDOF - ENDCASE -; - -handle-sbc-subclass diff --git a/qemu/roms/SLOF/slof/fs/devices/pci-device_10de_0141.fs b/qemu/roms/SLOF/slof/fs/devices/pci-device_10de_0141.fs deleted file mode 100644 index bb3b83516..000000000 --- a/qemu/roms/SLOF/slof/fs/devices/pci-device_10de_0141.fs +++ /dev/null @@ -1,49 +0,0 @@ -\ ***************************************************************************** -\ * Copyright (c) 2004, 2008 IBM Corporation -\ * All rights reserved. -\ * This program and the accompanying materials -\ * are made available under the terms of the BSD License -\ * which accompanies this distribution, and is available at -\ * http://www.opensource.org/licenses/bsd-license.php -\ * -\ * Contributors: -\ * IBM Corporation - initial implementation -\ ****************************************************************************/ - -my-space pci-class-name type - -my-space pci-device-generic-setup - -pci-io-enable -pci-mem-enable - -30 config-l@ pci-find-fcode execute-rom-fcode - -: check-display ( nodepath len -- true|false ) \ true if display found and "screen" alias set -\ check if display available, set screen alias -2dup find-node \ ( path len phandle|0 ) find node -?dup IF - \ node found, get "display-type" property - s" display-type" rot get-property ( path len true|propaddr proplen 0 ) - 0= IF - ( path len propaddr proplen ) \ property found, check if the value is not "NONE" - s" NONE" 0 char-cat ( path len propaddr proplen str strlen ) \ null-terminated NONE string - str= 0= IF - ( path len ) \ "display-type" property is not "NONE" so we can set "screen" alias - s" screen" 2swap set-alias - true ( true ) \ return true - ELSE - 2drop false ( false ) \ return false - THEN - THEN -THEN -; - -get-node node>path s" /NVDA,DISPLAY-A" $cat check-display -0= IF - \ no display found on DISPLAY-A ... check DISPLAY-B - get-node node>path s" /NVDA,DISPLAY-B" $cat check-display - drop \ drop result -THEN - -s" name" get-my-property drop s" ( " type type s" ) " type cr diff --git a/qemu/roms/SLOF/slof/fs/dictionary.fs b/qemu/roms/SLOF/slof/fs/dictionary.fs deleted file mode 100644 index 3e5b29332..000000000 --- a/qemu/roms/SLOF/slof/fs/dictionary.fs +++ /dev/null @@ -1,74 +0,0 @@ -\ ***************************************************************************** -\ * Copyright (c) 2004, 2008 IBM Corporation -\ * All rights reserved. -\ * This program and the accompanying materials -\ * are made available under the terms of the BSD License -\ * which accompanies this distribution, and is available at -\ * http://www.opensource.org/licenses/bsd-license.php -\ * -\ * Contributors: -\ * IBM Corporation - initial implementation -\ ****************************************************************************/ - -: words - last @ - BEGIN ?dup WHILE - dup cell+ char+ count type space @ - REPEAT -; - -: .calls ( xt -- ) - current-node @ >r 0 set-node \ only search commands, according too IEEE1275 - - last BEGIN @ ?dup WHILE ( xt currxt ) - dup cell+ char+ ( xt currxt name* ) - dup dup c@ + 1+ aligned ( xt currxt name* CFA ) - dup @ <colon> = IF ( xt currxt name* CFA ) - BEGIN - cell+ dup @ ['] semicolon <> - WHILE ( xt currxt *name pos ) - dup @ 4 pick = IF ( xt currxt *name pos ) - over count type space - BEGIN cell+ dup @ ['] semicolon = UNTIL cell - \ eat up other occurrences - THEN - REPEAT - THEN - 2drop ( xt currxt ) - REPEAT - drop - - r> set-node \ restore node -; - -0 value #sift-count -false value sift-compl-only - -: $inner-sift ( text-addr text-len LFA -- ... word-addr word-len true | false ) - dup cell+ char+ count \ get word name - 2dup 6 pick 6 pick find-isubstr \ is there a partly match? - \ in tab completion mode the substring has to be at the beginning - sift-compl-only IF 0= ELSE over < THEN - IF - #sift-count 1+ to #sift-count \ count completions - true - ELSE - 2drop false - THEN -; - -: $sift ( text-addr text-len -- ) - current-node @ >r 0 set-node \ only search commands, according too IEEE1275 - sift-compl-only >r false to sift-compl-only \ all substrings, not only compl. - last BEGIN @ ?dup WHILE \ walk the whole dictionary - $inner-sift IF type space THEN - REPEAT - 2drop - 0 to #sift-count \ we don't need completions here. - r> to sift-compl-only \ restore previous sifting mode - r> set-node \ restore node -; - -: sifting ( "text< >" -- ) - parse-word $sift -; - diff --git a/qemu/roms/SLOF/slof/fs/display.fs b/qemu/roms/SLOF/slof/fs/display.fs deleted file mode 100644 index 5bb8797a2..000000000 --- a/qemu/roms/SLOF/slof/fs/display.fs +++ /dev/null @@ -1,123 +0,0 @@ -\ ***************************************************************************** -\ * Copyright (c) 2004, 2008 IBM Corporation -\ * All rights reserved. -\ * This program and the accompanying materials -\ * are made available under the terms of the BSD License -\ * which accompanies this distribution, and is available at -\ * http://www.opensource.org/licenses/bsd-license.php -\ * -\ * Contributors: -\ * IBM Corporation - initial implementation -\ ****************************************************************************/ - -0 VALUE char-height -0 VALUE char-width -0 VALUE fontbytes - -CREATE display-emit-buffer 20 allot - -\ \\\\\\\\\\\\\\ Global Data - -\ \\\\\\\\\\\\\\ Structure/Implementation Dependent Methods - -\ \\\\\\\\\\\\\\ Implementation Independent Methods (Depend on Previous) -\ * -\ * -defer dis-old-emit -' emit behavior to dis-old-emit - -: display-write terminal-write ; -: display-emit dup dis-old-emit display-emit-buffer tuck c! 1 terminal-write drop ; - -\ \\\\\\\\\\\\\\ Exported Interface: -\ * -\ Generic device methods: -\ * - - -\ \\\\\\\\\\\\\\ Exported Interface: -\ * -\ IEEE 1275 : display device driver initialization -\ * -: is-install ( 'open -- ) - s" defer vendor-open to vendor-open" eval - s" : open deadbeef vendor-open dup deadbeef = IF drop true ELSE nip THEN ;" eval - s" defer write ' display-write to write" eval - s" : draw-logo ['] draw-logo CATCH IF 2drop 2drop THEN ;" eval - s" : reset-screen ['] reset-screen CATCH drop ;" eval -; - -: is-remove ( 'close -- ) - s" defer close to close" eval -; - -: is-selftest ( 'selftest -- ) - s" defer selftest to selftest" eval -; - - -STRUCT - cell FIELD font>addr - cell FIELD font>width - cell FIELD font>height - cell FIELD font>advance - cell FIELD font>min-char - cell FIELD font>#glyphs -CONSTANT /font - -CREATE default-font-ctrblk /font allot default-font-ctrblk - dup font>addr 0 swap ! - dup font>width 8 swap ! - dup font>height -10 swap ! - dup font>advance 1 swap ! - dup font>min-char 20 swap ! - font>#glyphs 7f swap ! - -: display-default-font ( str len -- ) - romfs-lookup dup 0= IF drop EXIT THEN - 600 <> IF ." Only support 60x8x16 fonts ! " drop EXIT THEN - default-font-ctrblk font>addr ! -; - -s" default-font.bin" display-default-font - -\ \\\\\\\\\\\\\\ Implementation Independent Methods (Depend on Previous) -\ * -\ * - - -\ \\\\\\\\\\\\\\ Exported Interface: -\ * -\ Generic device methods: -\ * -: .scan-lines ( height -- scanlines ) dup 0>= IF 1- ELSE negate THEN ; - - -\ \\\\\\\\\\\\\\ Exported Interface: -\ * -\ * - -: set-font ( addr width height advance min-char #glyphs -- ) - default-font-ctrblk /font + /font 0 - DO - 1 cells - dup >r ! r> 1 cells - +LOOP drop - default-font-ctrblk dup font>height @ abs to char-height - dup font>width @ to char-width font>advance @ to fontbytes -; - -: >font ( char -- addr ) - dup default-font-ctrblk dup >r font>min-char @ dup r@ font>#glyphs + within - IF - r@ font>min-char @ - - r@ font>advance @ * r@ font>height @ .scan-lines * - r> font>addr @ + - ELSE - drop r> font>addr @ - THEN -; - -: default-font ( -- addr width height advance min-char #glyphs ) - default-font-ctrblk /font 0 DO dup cell+ >r @ r> 1 cells +LOOP drop -; - diff --git a/qemu/roms/SLOF/slof/fs/dma-function.fs b/qemu/roms/SLOF/slof/fs/dma-function.fs deleted file mode 100644 index c1c8716ca..000000000 --- a/qemu/roms/SLOF/slof/fs/dma-function.fs +++ /dev/null @@ -1,36 +0,0 @@ -\ ***************************************************************************** -\ * Copyright (c) 2004, 2014 IBM Corporation -\ * All rights reserved. -\ * This program and the accompanying materials -\ * are made available under the terms of the BSD License -\ * which accompanies this distribution, and is available at -\ * http://www.opensource.org/licenses/bsd-license.php -\ * -\ * Contributors: -\ * IBM Corporation - initial implementation -\ ****************************************************************************/ - -\ DMA memory allocation functions -: dma-alloc ( size -- virt ) - my-phandle TO calling-child - s" dma-alloc" my-phandle parent $call-static - 0 TO calling-child -; - -: dma-free ( virt size -- ) - my-phandle TO calling-child - s" dma-free" my-phandle parent $call-static - 0 TO calling-child -; - -: dma-map-in ( virt size cacheable? -- devaddr ) - my-phandle TO calling-child - s" dma-map-in" my-phandle parent $call-static - 0 TO calling-child -; - -: dma-map-out ( virt devaddr size -- ) - my-phandle TO calling-child - s" dma-map-out" my-phandle parent $call-static - 0 TO calling-child -; diff --git a/qemu/roms/SLOF/slof/fs/dump.fs b/qemu/roms/SLOF/slof/fs/dump.fs deleted file mode 100644 index 90d60c412..000000000 --- a/qemu/roms/SLOF/slof/fs/dump.fs +++ /dev/null @@ -1,42 +0,0 @@ -\ ***************************************************************************** -\ * Copyright (c) 2004, 2008 IBM Corporation -\ * All rights reserved. -\ * This program and the accompanying materials -\ * are made available under the terms of the BSD License -\ * which accompanies this distribution, and is available at -\ * http://www.opensource.org/licenses/bsd-license.php -\ * -\ * Contributors: -\ * IBM Corporation - initial implementation -\ ****************************************************************************/ - - -\ Hex dump facilities. - -1 VALUE /dump -' c@ VALUE 'dump -0 VALUE dump-first -0 VALUE dump-last -0 VALUE dump-cur -: .char ( c -- ) dup bl 7f within 0= IF drop [char] . THEN emit ; -: dump-line ( -- ) - cr dump-cur dup 8 0.r [char] : emit 10 /dump / 0 DO - space dump-cur dump-first dump-last within IF - dump-cur 'dump execute /dump 2* 0.r ELSE - /dump 2* spaces THEN dump-cur /dump + to dump-cur LOOP - /dump 1 <> IF drop EXIT THEN - to dump-cur 2 spaces - 10 0 DO dump-cur dump-first dump-last within IF - dump-cur 'dump execute .char ELSE space THEN dump-cur 1+ to dump-cur LOOP ; -: (dump) ( addr len reader size -- ) - to /dump to 'dump bounds /dump negate and to dump-first to dump-last - dump-first f invert and to dump-cur - base @ hex BEGIN dump-line dump-cur dump-last >= UNTIL base ! ; -: du ( -- ) dump-last 100 'dump /dump (dump) ; -: dump ['] c@ 1 (dump) ; -: wdump ['] w@ 2 (dump) ; -: ldump ['] l@ 4 (dump) ; -: xdump ['] x@ 8 (dump) ; -: rdump ['] rb@ 1 (dump) ; -\ : iodump ['] io-c@ 1 (dump) ; -\ : siodump ['] siocfg@ 1 (dump) ; diff --git a/qemu/roms/SLOF/slof/fs/elf.fs b/qemu/roms/SLOF/slof/fs/elf.fs deleted file mode 100644 index 5a80c78d5..000000000 --- a/qemu/roms/SLOF/slof/fs/elf.fs +++ /dev/null @@ -1,71 +0,0 @@ -\ ***************************************************************************** -\ * Copyright (c) 2004, 2011 IBM Corporation -\ * All rights reserved. -\ * This program and the accompanying materials -\ * are made available under the terms of the BSD License -\ * which accompanies this distribution, and is available at -\ * http://www.opensource.org/licenses/bsd-license.php -\ * -\ * Contributors: -\ * IBM Corporation - initial implementation -\ ****************************************************************************/ - -\ Claim memory for segment -\ Abort, if no memory available - -false value elf-claim? -0 value last-claim - -\ cur-brk is set by elf loader to end of data segment -0 VALUE cur-brk - - -: elf-claim-segment ( addr size -- errorcode ) - 2dup - elf-claim? IF - >r - here last-claim , to last-claim \ Setup ptr to last claim - \ Put addr and size in the data space - dup , r> dup , ( addr size ) - 0 ['] claim CATCH IF - ." Memory for ELF file is already in use!" cr - true ABORT" Memory for ELF file already in use " - THEN - drop - ELSE - 2drop - THEN - + to cur-brk - 0 -; - - -\ Load ELF file and claim the corresponding memory regions. -\ A destination address can be specified. If the parameter is -1 then -\ the file is loaded to the ddress that is specified in its header. -: elf-load-claim ( file-addr destaddr -- claim-list entry imagetype ) - true to elf-claim? - 0 to last-claim - dup -1 = IF \ If destaddr == -1 then load to addr from ELF header - drop ['] elf-load-file CATCH IF false to elf-claim? ABORT THEN - ELSE - ['] elf-load-file-to-addr CATCH IF false to elf-claim? ABORT THEN - THEN - >r - last-claim swap - false to elf-claim? - r> -; - - -\ Release memory claimed before - -: elf-release ( claim-list -- ) - BEGIN - dup cell+ ( claim-list claim-list-addr ) - dup @ swap cell+ @ ( claim-list claim-list-addr claim-list-sz ) - release ( claim-list ) - @ dup 0= ( Next-element ) - UNTIL - drop -; diff --git a/qemu/roms/SLOF/slof/fs/envvar.fs b/qemu/roms/SLOF/slof/fs/envvar.fs deleted file mode 100644 index 33643130c..000000000 --- a/qemu/roms/SLOF/slof/fs/envvar.fs +++ /dev/null @@ -1,412 +0,0 @@ -\ ***************************************************************************** -\ * Copyright (c) 2004, 2012 IBM Corporation -\ * All rights reserved. -\ * This program and the accompanying materials -\ * are made available under the terms of the BSD License -\ * which accompanies this distribution, and is available at -\ * http://www.opensource.org/licenses/bsd-license.php -\ * -\ * Contributors: -\ * IBM Corporation - initial implementation -\ ****************************************************************************/ - - -\ configuration variables - -wordlist CONSTANT envvars - -\ list the names in envvars -: listenv ( -- ) - get-current envvars set-current words set-current -; - -\ create a definition in envvars -: create-env ( "name" -- ) - get-current envvars set-current CREATE set-current -; - -\ lay out the data for the separate envvar types -: env-int ( n -- ) 1 c, align , DOES> char+ aligned @ ; -: env-bytes ( a len -- ) - 2 c, align dup , here swap dup allot move - DOES> char+ aligned dup @ >r cell+ r> -; -: env-string ( str len -- ) 3 c, align dup , here over allot swap move DOES> char+ aligned dup @ >r cell+ r> ; -: env-flag ( f -- ) 4 c, c, DOES> char+ c@ 0<> ; -: env-secmode ( sm -- ) 5 c, c, DOES> char+ c@ ; - -\ create default envvars -: default-int ( n "name" -- ) create-env env-int ; -: default-bytes ( a len "name" -- ) create-env env-bytes ; -: default-string ( a len "name" -- ) create-env env-string ; -: default-flag ( f "name" -- ) create-env env-flag ; -: default-secmode ( sm "name" -- ) create-env env-secmode ; - -: set-option ( option-name len option len -- ) - 2swap encode-string - 2swap s" /options" find-node dup IF set-property ELSE drop 2drop 2drop THEN -; - -\ find an envvar's current and default value, and its type -: findenv ( name len -- adr def-adr type | 0 ) - 2dup envvars voc-find dup 0<> IF ( ABORT" not a configuration variable" ) - link> >body char+ >r (find-order) link> >body dup char+ swap c@ r> swap - ELSE - nip nip - THEN -; - - -: test-flag ( param len -- true | false ) - 2dup s" true" string=ci -rot s" false" string=ci or -; - -: test-secmode ( param len -- true | false ) - 2dup s" none" string=ci -rot 2dup s" command" string=ci -rot s" full" - string=ci or or -; - -: test-int ( param len -- true | false ) - $dh-number IF false ELSE drop true THEN -; - -: findtype ( param len name len -- param len name len type ) - 2dup findenv \ try to find type of envvar - dup IF \ found a type? - nip nip - EXIT - THEN - - \ No type found yet, try to auto-detect: - drop 2swap - 2dup test-flag IF - 4 -rot \ boolean type - ELSE - 2dup test-secmode IF - 5 -rot \ secmode type - ELSE - 2dup test-int IF - 1 -rot \ integer type - ELSE - 2dup test-string - IF 3 ELSE 2 THEN \ 3 = string, 2 = default to bytes - -rot - THEN - THEN - THEN - rot - >r 2swap r> -; - -\ set an envvar -: $setenv ( param len name len -- ) - 4dup set-option - findtype - -rot $CREATE - CASE - 1 OF $dh-number IF 0 THEN env-int ENDOF \ XXX: wants decimal and 0x... - 2 OF env-bytes ENDOF - 3 OF env-string ENDOF - 4 OF evaluate env-flag ENDOF - 5 OF evaluate env-secmode ENDOF \ XXX: recognize none, command, full - ENDCASE -; - -\ print an envvar -: (printenv) ( adr type -- ) - CASE - 1 OF aligned @ . ENDOF - 2 OF aligned dup cell+ swap @ swap . . ENDOF - 3 OF aligned dup @ >r cell+ r> type ENDOF - 4 OF c@ IF ." true" ELSE ." false" THEN ENDOF - 5 OF c@ . ENDOF \ XXX: print symbolically - ENDCASE -; - -: .printenv-header ( -- ) - cr - s" ---environment variable--------current value-------------default value------" - type cr -; - -DEFER old-emit -0 VALUE emit-counter - -: emit-and-count emit-counter 1 + to emit-counter old-emit ; - -: .enable-emit-counter - 0 to emit-counter - ['] emit behavior to old-emit - ['] emit-and-count to emit -; - -: .disable-emit-counter - ['] old-emit behavior to emit -; - -: .spaces ( number-of-spaces -- ) - dup 0 > IF - spaces - ELSE - drop space - THEN -; - -: .print-one-env ( name len -- ) - 3 .spaces - 2dup dup -rot type 1c swap - .spaces - findenv rot over - .enable-emit-counter - (printenv) .disable-emit-counter - 1a emit-counter - .spaces - (printenv) -; - -: .print-all-env - .printenv-header - envvars cell+ - BEGIN - @ dup - WHILE - dup link> >name - name>string .print-one-env cr - REPEAT - drop -; - -: printenv - parse-word dup 0= IF - 2drop .print-all-env - ELSE - findenv dup 0= ABORT" not a configuration variable" - rot over cr ." Current: " (printenv) - cr ." Default: " (printenv) - THEN -; - -\ set envvar(s) to default value -: (set-default) ( def-xt -- ) - dup >name name>string $CREATE dup >body c@ >r execute r> CASE - 1 OF env-int ENDOF - 2 OF env-bytes ENDOF - 3 OF env-string ENDOF - 4 OF env-flag ENDOF - 5 OF env-secmode ENDOF ENDCASE -; - -\ Environment variables might be board specific - -#include <envvar_defaults.fs> - -VARIABLE nvoff \ offset in envvar partition - -: (nvupdate-one) ( adr type -- "value" ) - CASE - 1 OF aligned @ (.d) ENDOF - 2 OF drop 0 0 ENDOF - 3 OF aligned dup @ >r cell+ r> ENDOF - 4 OF c@ IF s" true" ELSE s" false" THEN ENDOF - 5 OF c@ (.) ENDOF \ XXX: print symbolically - ENDCASE -; - -: nvupdate-one ( def-xt -- ) - >r nvram-partition-type-common get-nvram-partition ( part.addr part.len FALSE|TRUE R: def-xt ) - ABORT" No valid NVRAM." r> ( part.addr part.len def-xt ) - >name name>string ( part.addr part.len var.a var.l ) - 2dup findenv nip (nvupdate-one) - ( part.addr part.len var.addr var.len val.addr val.len ) - internal-add-env - drop -; - -: (nvupdate) ( -- ) - nvram-partition-type-common get-nvram-partition ABORT" No valid NVRAM." - erase-nvram-partition drop - envvars cell+ - BEGIN @ dup WHILE dup link> nvupdate-one REPEAT - drop -; - -: nvupdate ( -- ) - ." nvupdate is obsolete." cr -; - -: set-default - parse-word envvars voc-find - dup 0= ABORT" not a configuration variable" link> (set-default) -; - -: (set-defaults) - envvars cell+ - BEGIN @ dup WHILE dup link> (set-default) REPEAT - drop -; - -\ Preset nvram variables in RAM, but do not overwrite them in NVRAM -(set-defaults) - -: set-defaults - (set-defaults) (nvupdate) -; - -: setenv parse-word ( skipws ) 0d parse -leading 2swap $setenv (nvupdate) ; - -: get-nv ( -- ) - nvram-partition-type-common get-nvram-partition ( addr offset not-found | not-found ) \ find partition header - IF - ." No NVRAM common partition, re-initializing..." cr - internal-reset-nvram - (nvupdate) - nvram-partition-type-common get-nvram-partition IF ." NVRAM seems to be broken." cr EXIT THEN - THEN - \ partition header found: read data from nvram - drop ( addr ) \ throw away offset - BEGIN - dup rzcount dup \ make string from offset and make condition - WHILE ( offset offset length ) - 2dup [char] = split \ Split string at equal sign (=) - ( offset offset length name len param len ) - 2swap ( offset offset length param len name len ) - $setenv \ Set envvar - nip \ throw away old string begin - + 1+ \ calc new offset - REPEAT - 2drop drop \ cleanup -; - -get-nv - -: check-for-nvramrc ( -- ) - use-nvramrc? IF - s" Executing following code from nvramrc: " - s" nvramrc" evaluate $cat - nvramlog-write-string-cr - s" (!) Executing code specified in nvramrc" type - cr s" SLOF Setup = " type - \ to remove the string from the console if the nvramrc is broken - \ we need to know how many chars are printed - .enable-emit-counter - s" nvramrc" evaluate ['] evaluate CATCH IF - \ dropping the rest of the nvram string - 2drop - \ delete the chars we do not want to see - emit-counter 0 DO 8 emit LOOP - s" (!) Code in nvramrc triggered exception. " - 2dup nvramlog-write-string - type cr 12 spaces s" Aborting nvramrc execution" 2dup - nvramlog-write-string-cr type cr - s" SLOF Setup = " type - THEN - .disable-emit-counter - THEN -; - - -: (nv-findalias) ( alias-ptr alias-len -- pos ) - \ create a temporary empty string - here 0 - \ append "devalias " to the temporary string - s" devalias " string-cat - \ append "<name-str>" to the temporary string - 3 pick 3 pick string-cat - \ append a SPACE character to the temporary string - s" " string-cat - \ get nvramrc - s" nvramrc" evaluate - \ get position of the temporary string inside of nvramrc - 2swap find-substr - nip nip -; - -: (nv-build-real-entry) ( name-ptr name-len dev-ptr dev-len -- str-ptr str-len ) - \ create a temporary empty string - 2swap here 0 - \ append "devalias " to the temporary string - s" devalias " string-cat - \ append "<name-ptr>" to the temporary string - 2swap string-cat - \ append a SPACE character to the temporary string - s" " string-cat - \ append "<dev-ptr> to the temporary string - 2swap string-cat - \ append a CR character to the temporary string - 0d char-cat - \ append a LF character to the temporary string - 0a char-cat -; - -: (nv-build-null-entry) ( name-ptr name-len dev-ptr dev-len -- str-ptr str-len ) - 4drop here 0 -; - -: (nv-build-nvramrc) ( name-str name-len dev-str dev-len xt-build-entry -- ) - \ *** PART 1: check if there is still an alias definition available *** - ( alias-ptr alias-len path-ptr path-ptr call-build-entry alias-pos ) - 4 pick 4 pick (nv-findalias) - \ if our alias definition is a new one - dup s" nvramrc" evaluate nip >= IF - \ call-build-entry - drop execute - \ append content of "nvramrc" to the temporary string - s" nvramrc" evaluate string-cat - \ Allocate the temporary string - dup allot - \ write the string into nvramrc - s" nvramrc" $setenv - ELSE \ if our alias is still defined in nvramrc - \ *** PART 2: calculate the memory size for the new content of nvramrc *** - \ add number of bytes needed for nvramrc-prefix to number of bytes needed - \ for the new entry - 5 pick 5 pick 5 pick 5 pick 5 pick execute nip over + - ( alias-ptr alias-len path-ptr path-ptr build-entry-xt alias-pos tmp-len ) - \ add number of bytes needed for nvramrc-postfix - s" nvramrc" evaluate 3 pick string-at - 2dup find-nextline string-at nip + - \ *** PART 3: build the new content *** - \ allocate enough memory for new content - alloc-mem 0 - ( alias-ptr alias-len path-ptr path-ptr build-entry-xt alias-pos mem len ) - \ add nvramrc-prefix - s" nvramrc" evaluate drop 3 pick string-cat - \ add new entry - rot >r >r >r execute r> r> 2swap string-cat - ( mem, len ) ( R: alias-pos ) - \ add nvramrc-postfix - s" nvramrc" evaluate r> string-at - 2dup find-nextline string-at string-cat - ( mem len ) - \ write the temporary string into nvramrc and clean up memory - 2dup s" nvramrc" $setenv free-mem - THEN -; - -: $nvalias ( name-str name-len dev-str dev-len -- ) - 4dup ['] (nv-build-real-entry) (nv-build-nvramrc) - set-alias - s" true" s" use-nvramrc?" $setenv - (nvupdate) -; - -: nvalias ( "alias-name< >device-specifier<eol>" -- ) - parse-word parse-word dup 0<> IF - $nvalias - ELSE - 2drop 2drop - cr - " Usage: nvalias (""alias-name< >device-specifier<eol>"" -- )" type - cr - THEN -; - -: $nvunalias ( name-str name-len -- ) - s" " ['] (nv-build-null-entry) (nv-build-nvramrc) - (nvupdate) -; - -: nvunalias ( "alias-name< >" -- ) - parse-word $nvunalias -; - -: diagnostic-mode? ( -- diag-switch? ) diag-switch? ; - diff --git a/qemu/roms/SLOF/slof/fs/envvar_defaults.fs b/qemu/roms/SLOF/slof/fs/envvar_defaults.fs deleted file mode 100644 index 86716eff0..000000000 --- a/qemu/roms/SLOF/slof/fs/envvar_defaults.fs +++ /dev/null @@ -1,44 +0,0 @@ -\ ***************************************************************************** -\ * Copyright (c) 2004, 2008 IBM Corporation -\ * All rights reserved. -\ * This program and the accompanying materials -\ * are made available under the terms of the BSD License -\ * which accompanies this distribution, and is available at -\ * http://www.opensource.org/licenses/bsd-license.php -\ * -\ * Contributors: -\ * IBM Corporation - initial implementation -\ ****************************************************************************/ - -\ the defaults -\ some of those are platform dependent, and should e.g. be -\ created from VPD values -true default-flag auto-boot? -s" " default-string boot-device -s" " default-string boot-file -s" boot" default-string boot-command -s" " default-string diag-device -s" " default-string diag-file -false default-flag diag-switch? -true default-flag fcode-debug? -s" " default-string input-device -s" " default-string nvramrc -s" " default-string oem-banner -false default-flag oem-banner? -0 0 default-bytes oem-logo -false default-flag oem-logo? -s" " default-string output-device -200 default-int screen-#columns -200 default-int screen-#rows -0 default-int security-#badlogins -0 default-secmode security-mode -s" " default-string security-password -0 default-int selftest-#megs -false default-flag use-nvramrc? -false default-flag direct-serial? -true default-flag real-mode? -default-load-base default-int load-base -#ifdef BIOSEMU -true default-flag use-biosemu? -0 default-int biosemu-debug -#endif diff --git a/qemu/roms/SLOF/slof/fs/exception.fs b/qemu/roms/SLOF/slof/fs/exception.fs deleted file mode 100644 index dbf11fb46..000000000 --- a/qemu/roms/SLOF/slof/fs/exception.fs +++ /dev/null @@ -1,154 +0,0 @@ -\ ***************************************************************************** -\ * Copyright (c) 2004, 2008 IBM Corporation -\ * All rights reserved. -\ * This program and the accompanying materials -\ * are made available under the terms of the BSD License -\ * which accompanies this distribution, and is available at -\ * http://www.opensource.org/licenses/bsd-license.php -\ * -\ * Contributors: -\ * IBM Corporation - initial implementation -\ ****************************************************************************/ - -STRUCT - cell FIELD >r0 cell FIELD >r1 cell FIELD >r2 cell FIELD >r3 - cell FIELD >r4 cell FIELD >r5 cell FIELD >r6 cell FIELD >r7 - cell FIELD >r8 cell FIELD >r9 cell FIELD >r10 cell FIELD >r11 - cell FIELD >r12 cell FIELD >r13 cell FIELD >r14 cell FIELD >r15 - cell FIELD >r16 cell FIELD >r17 cell FIELD >r18 cell FIELD >r19 - cell FIELD >r20 cell FIELD >r21 cell FIELD >r22 cell FIELD >r23 - cell FIELD >r24 cell FIELD >r25 cell FIELD >r26 cell FIELD >r27 - cell FIELD >r28 cell FIELD >r29 cell FIELD >r30 cell FIELD >r31 - cell FIELD >cr cell FIELD >xer cell FIELD >lr cell FIELD >ctr - cell FIELD >srr0 cell FIELD >srr1 cell FIELD >dar cell FIELD >dsisr -CONSTANT ciregs-size - - - -: .16 10 0.r 3 spaces ; -: .8 8 spaces 8 0.r 3 spaces ; -: .4regs cr 4 0 DO dup @ .16 8 cells+ LOOP drop ; -: .fixed-regs - cr ." R0 .. R7 R8 .. R15 R16 .. R23 R24 .. R31" - dup 8 0 DO dup .4regs cell+ LOOP drop -; - -: .special-regs - cr ." CR / XER LR / CTR SRR0 / SRR1 DAR / DSISR" - cr dup >cr @ .8 dup >lr @ .16 dup >srr0 @ .16 dup >dar @ .16 - cr dup >xer @ .16 dup >ctr @ .16 dup >srr1 @ .16 >dsisr @ .8 -; - -: .regs - cr .fixed-regs - cr .special-regs - cr cr -; - -: .hw-exception ( reason-code exception-nr -- ) - ." ( " dup . ." ) " - CASE - 200 OF ." Machine Check" ENDOF - 300 OF ." Data Storage" ENDOF - 380 OF ." Data Segment" ENDOF - 400 OF ." Instruction Storage" ENDOF - 480 OF ." Instruction Segment" ENDOF - 500 OF ." External" ENDOF - 600 OF ." Alignment" ENDOF - 700 OF ." Program" ENDOF - 800 OF ." Floating-point unavailable" ENDOF - 900 OF ." Decrementer" ENDOF - 980 OF ." Hypervisor Decrementer" ENDOF - C00 OF ." System Call" ENDOF - D00 OF ." Trace" ENDOF - F00 OF ." Performance Monitor" ENDOF - F20 OF ." VMX Unavailable" ENDOF - 1200 OF ." System Error" ENDOF - 1600 OF ." Maintenance" ENDOF - 1800 OF ." Thermal" ENDOF - dup OF ." Unknown" ENDOF - ENDCASE - ." Exception [ " . ." ]" -; - -: .sw-exception ( exception-nr -- ) - ." Exception [ " . ." ] triggered by boot firmware." -; - -\ this word gets also called for non-hardware exceptions. -: be-hw-exception ( [reason-code] exception-nr -- ) - cr cr - dup 0> IF .hw-exception ELSE .sw-exception THEN - cr eregs .regs -; -' be-hw-exception to hw-exception-handler - -: (boot-exception-handler) ( x1...xn exception-nr -- x1...xn) - dup IF - dup 0 > IF - negate cp 9 emit ." : " type - ELSE - CASE - -6d OF cr ." W3411: Client application returned." cr ENDOF - -6c OF cr ." E3400: It was not possible to boot from any device " - ." specified in the VPD." cr - ENDOF - -6b OF cr ." E3410: Boot list successfully read from VPD " - ." but no useful information received." cr - ENDOF - -6a OF cr ." E3420: Boot list could not be read from VPD." cr - ENDOF - -69 OF - cr ." E3406: Client application returned an error" - abort"-str @ count dup IF - ." : " type cr - ELSE - ." ." cr - 2drop - THEN - ENDOF - -68 OF cr ." E3405: No such device" cr ENDOF - -67 OF cr ." E3404: Not a bootable device!" cr ENDOF - -66 OF cr ." E3408: Failed to claim memory for the executable" cr - ENDOF - -65 OF cr ." E3407: Load failed" cr ENDOF - -64 OF cr ." E3403: Bad executable: " abort"-str @ count type cr - ENDOF - -63 OF cr ." E3409: Unknown FORTH Word" cr ENDOF - -2 OF cr ." E3401: Aborting boot, " abort"-str @ count type cr - ENDOF - dup OF ." E3402: Aborting boot, internal error" cr ENDOF - ENDCASE - THEN - ELSE - drop - THEN -; - -' (boot-exception-handler) to boot-exception-handler - -: throw-error ( error-code "error-string" -- ) - skipws 0a parse rot throw -; - -\ Enable external interrupt in msr - -: enable-ext-int ( -- ) - msr@ 8000 or msr! -; - -\ Disable external interrupt in msr - -: disable-ext-int ( -- ) - msr@ 8000 not and msr! -; - -\ Generate external interrupt through Internal Interrupt Controller of BE - -: gen-ext-int ( -- ) - 7fffffff dec! \ Reset decrementer - enable-ext-int \ Enable interrupt - FF 20000508418 rx! \ Interrupt priority mask - 10 20000508410 rx! \ Interrupt priority -; - diff --git a/qemu/roms/SLOF/slof/fs/fbuffer.fs b/qemu/roms/SLOF/slof/fs/fbuffer.fs deleted file mode 100644 index 47046087d..000000000 --- a/qemu/roms/SLOF/slof/fs/fbuffer.fs +++ /dev/null @@ -1,266 +0,0 @@ -\ ***************************************************************************** -\ * Copyright (c) 2004, 2008 IBM Corporation -\ * All rights reserved. -\ * This program and the accompanying materials -\ * are made available under the terms of the BSD License -\ * which accompanies this distribution, and is available at -\ * http://www.opensource.org/licenses/bsd-license.php -\ * -\ * Contributors: -\ * IBM Corporation - initial implementation -\ ****************************************************************************/ - -#include "terminal.fs" -#include "display.fs" - -\ \\\\\\\\\\\\\\ Global Data - -0 VALUE frame-buffer-adr -0 VALUE screen-height -0 VALUE screen-width -0 VALUE screen-depth -0 VALUE screen-line-bytes -0 VALUE window-top -0 VALUE window-left - -0 VALUE .sc - -: screen-#rows ( -- rows ) - .sc IF - screen-height char-height / - ELSE - true to .sc - s" screen-#rows" eval - false to .sc - THEN -; - -: screen-#columns ( -- columns ) - .sc IF - screen-width char-width / - ELSE - true to .sc - s" screen-#columns" eval - false to .sc - THEN -; - -\ \\\\\\\\\\\\\\ Structure/Implementation Dependent Methods - - -\ \\\\\\\\\\\\\\ Implementation Independent Methods (Depend on Previous) -\ * -\ * - -: fb8-background inverse? ; -: fb8-foreground inverse? invert ; - -: fb8-lines2bytes ( #lines -- #bytes ) char-height * screen-line-bytes * ; -: fb8-columns2bytes ( #columns -- #bytes ) char-width * screen-depth * ; -: fb8-line2addr ( line# -- addr ) - char-height * window-top + screen-line-bytes * - frame-buffer-adr + window-left screen-depth * + -; - -: fb8-erase-block ( addr len ) fb8-background rfill ; - - -0 VALUE .ab -CREATE bitmap-buffer 400 4 * allot - -: active-bits ( -- new ) .ab dup 8 > IF 8 - to .ab 8 ELSE - char-width to .ab ?dup 0= IF recurse THEN - THEN ; - -: fb8-char2bitmap ( font-height font-addr -- bitmap-buffer ) - bitmap-buffer >r - char-height rot 0> IF r> char-width 2dup fb8-erase-block + >r 1- THEN - - r> -rot char-width to .ab - ( fb-addr font-addr font-height ) - fontbytes * bounds ?DO - i c@ active-bits 0 ?DO - dup 80 and IF fb8-foreground ELSE fb8-background THEN - ( fb-addr fbyte colr ) 2 pick ! 1 lshift - swap screen-depth + swap - LOOP drop - LOOP drop - bitmap-buffer -; - -\ \\\\\\\\\\\\\\ Exported Interface: -\ * -\ * IEEE 1275: Frame buffer support routines -\ * - -: fb8-draw-logo ( line# addr width height -- ) ." fb8-draw-logo ( " .s ." )" cr - 2drop 2drop -; - -: fb8-toggle-cursor ( -- ) - line# fb8-line2addr column# fb8-columns2bytes + - char-height 2 - screen-line-bytes * + - 2 0 ?DO - dup char-width screen-depth * invert-region - screen-line-bytes + - LOOP drop -; - -: fb8-draw-character ( char -- ) - >r default-font over + r@ -rot between IF - 2swap 3drop r> >font fb8-char2bitmap ( bitmap-buf ) - line# fb8-line2addr column# fb8-columns2bytes + ( bitmap-buf fb-addr ) - char-height 0 ?DO - 2dup char-width screen-depth * mrmove - screen-line-bytes + >r char-width screen-depth * + r> - LOOP 2drop - ELSE 2drop r> 3drop THEN -; - -: fb8-insert-lines ( n -- ) - fb8-lines2bytes >r line# fb8-line2addr dup dup r@ + - #lines line# - fb8-lines2bytes r@ - rmove - r> fb8-erase-block -; - -: fb8-delete-lines ( n -- ) - fb8-lines2bytes >r line# fb8-line2addr dup dup r@ + swap - #lines fb8-lines2bytes r@ - dup >r rmove - r> + r> fb8-erase-block -; - -: fb8-insert-characters ( n -- ) - line# fb8-line2addr column# fb8-columns2bytes + >r - #columns column# - 2dup >= IF - nip dup 0> IF fb8-columns2bytes r> ELSE r> 2drop EXIT THEN - ELSE - fb8-columns2bytes swap fb8-columns2bytes tuck - - over r@ tuck + rot char-height 0 ?DO - 3dup rmove - -rot screen-line-bytes tuck + -rot + swap rot - LOOP - 3drop r> - THEN - char-height 0 ?DO - dup 2 pick fb8-erase-block screen-line-bytes + - LOOP - 2drop -; - -: fb8-delete-characters ( n -- ) - line# fb8-line2addr column# fb8-columns2bytes + >r - #columns column# - 2dup >= IF - nip dup 0> IF fb8-columns2bytes r> ELSE r> 2drop EXIT THEN - ELSE - fb8-columns2bytes swap fb8-columns2bytes tuck - - over r@ + 2dup + r> swap >r rot char-height 0 ?DO - 3dup rmove - -rot screen-line-bytes tuck + -rot + swap rot - LOOP - 3drop r> over - - THEN - char-height 0 ?DO - dup 2 pick fb8-erase-block screen-line-bytes + - LOOP - 2drop -; - -: fb8-reset-screen ( -- ) ( Left as no-op by design ) ; - -: fb8-erase-screen ( -- ) - frame-buffer-adr screen-height screen-line-bytes * fb8-erase-block -; - -: fb8-invert-screen ( -- ) - frame-buffer-adr screen-height screen-line-bytes * invert-region -; - -: fb8-blink-screen ( -- ) fb8-invert-screen fb8-invert-screen ; - -: fb8-install ( width height #columns #lines -- ) - 1 to screen-depth - 2swap to screen-height to screen-width - screen-width to screen-line-bytes - screen-#rows min to #lines - screen-#columns min to #columns - screen-height char-height #lines * - 2/ to window-top - screen-width char-width #columns * - 2/ to window-left - ['] fb8-toggle-cursor to toggle-cursor - ['] fb8-draw-character to draw-character - ['] fb8-insert-lines to insert-lines - ['] fb8-delete-lines to delete-lines - ['] fb8-insert-characters to insert-characters - ['] fb8-delete-characters to delete-characters - ['] fb8-erase-screen to erase-screen - ['] fb8-blink-screen to blink-screen - ['] fb8-invert-screen to invert-screen - ['] fb8-reset-screen to reset-screen - ['] fb8-draw-logo to draw-logo -; - -: fb-install ( width height #columns #lines depth -- ) - >r - fb8-install - r> to screen-depth - screen-width screen-depth * to screen-line-bytes -; - - -\ Install display related FCODE evaluator tokens -: fb8-set-tokens ( -- ) - ['] is-install 0 11C set-token - ['] is-remove 0 11D set-token - ['] is-selftest 0 11E set-token - - ['] #lines 0 150 set-token - ['] #columns 0 151 set-token - ['] line# 0 152 set-token - ['] column# 0 153 set-token - ['] inverse? 0 154 set-token - ['] inverse-screen? 0 155 set-token - ['] draw-character 0 157 set-token - ['] reset-screen 0 158 set-token - ['] toggle-cursor 0 159 set-token - ['] erase-screen 0 15A set-token - ['] blink-screen 0 15B set-token - ['] invert-screen 0 15C set-token - ['] insert-characters 0 15D set-token - ['] delete-characters 0 15E set-token - ['] insert-lines 0 15F set-token - ['] delete-lines 0 160 set-token - ['] draw-logo 0 161 set-token - ['] frame-buffer-adr 0 162 set-token - ['] screen-height 0 163 set-token - ['] screen-width 0 164 set-token - ['] window-top 0 165 set-token - ['] window-left 0 166 set-token - \ ['] foreground-color 0 168 set-token \ 16-color extension - n/a - \ ['] background-color 0 169 set-token \ 16-color extension - n/a - ['] default-font 0 16A set-token - ['] set-font 0 16B set-token - ['] char-height 0 16C set-token - ['] char-width 0 16D set-token - ['] >font 0 16E set-token - ['] fontbytes 0 16F set-token - - ['] fb8-draw-character 0 180 set-token - ['] fb8-reset-screen 0 181 set-token - ['] fb8-toggle-cursor 0 182 set-token - ['] fb8-erase-screen 0 183 set-token - ['] fb8-blink-screen 0 184 set-token - ['] fb8-invert-screen 0 185 set-token - ['] fb8-insert-characters 0 186 set-token - ['] fb8-delete-characters 0 187 set-token - ['] fb8-insert-lines 0 188 set-token - ['] fb8-delete-lines 0 189 set-token - ['] fb8-draw-logo 0 18A set-token - ['] fb8-install 0 18B set-token -; -fb8-set-tokens - - -\ \\\\\\\\\\\\ Debug Stuff \\\\\\\\\\\\\\\\ - -: fb8-dump-bitmap cr char-height 0 ?do char-width 0 ?do dup c@ if ." @" else ." ." then 1+ loop cr loop drop ; - -: fb8-dump-char >font -b swap fb8-char2bitmap fb8-dump-bitmap ; diff --git a/qemu/roms/SLOF/slof/fs/fcode/1275.fs b/qemu/roms/SLOF/slof/fs/fcode/1275.fs deleted file mode 100644 index c2a67bcc9..000000000 --- a/qemu/roms/SLOF/slof/fs/fcode/1275.fs +++ /dev/null @@ -1,465 +0,0 @@ -\ ***************************************************************************** -\ * Copyright (c) 2004, 2011 IBM Corporation -\ * All rights reserved. -\ * This program and the accompanying materials -\ * are made available under the terms of the BSD License -\ * which accompanies this distribution, and is available at -\ * http://www.opensource.org/licenses/bsd-license.php -\ * -\ * Contributors: -\ * IBM Corporation - initial implementation -\ ****************************************************************************/ - - -: fcode-revision ( -- n ) - 00030000 \ major * 65536 + minor - ; - -: b(lit) ( -- n ) - next-ip read-fcode-num32 - ?compile-mode IF literal, THEN - ; - -: b(") - next-ip read-fcode-string - ?compile-mode IF fc-string, align postpone count THEN - ; - -: b(') - next-ip read-fcode# get-token drop ?compile-mode IF literal, THEN - ; - -: ?jump-direction ( n -- ) - dup 8000 >= IF - 10000 - \ Create cell-sized negative value - THEN - fcode-offset - \ IP is already behind offset, so subtract offset size -; - -: ?negative - 8000 and - ; - -: dest-on-top - 0 >r BEGIN dup @ 0= WHILE >r REPEAT - BEGIN r> dup WHILE swap REPEAT - drop - ; - -: read-fcode-offset - next-ip - ?offset16 IF - read-fcode-num16 - ELSE - read-byte - dup 80 and IF FF00 or THEN \ Fake 16-bit signed offset - THEN -; - -: b?branch ( flag -- ) - ?compile-mode IF - read-fcode-offset ?negative IF - dest-on-top postpone until - ELSE - postpone if - THEN - ELSE - ( flag ) IF - fcode-offset jump-n-ip \ Skip over offset value - ELSE - read-fcode-offset - ?jump-direction jump-n-ip - THEN - THEN -; immediate - -: bbranch ( -- ) - ?compile-mode IF - read-fcode-offset - ?negative IF - dest-on-top postpone again - ELSE - postpone else - get-ip next-ip fcode@ B2 = IF - drop - ELSE - set-ip - THEN - THEN - ELSE - read-fcode-offset ?jump-direction jump-n-ip - THEN -; immediate - -: b(<mark) ( -- ) - ?compile-mode IF postpone begin THEN - ; immediate - -: b(>resolve) ( -- ) - ?compile-mode IF postpone then THEN - ; immediate - -: b(;) - <semicolon> compile, reveal - postpone [ -; immediate - -: b(:) ( -- ) - <colon> compile, ] - ; immediate - -: b(case) ( sel -- sel ) - postpone case - ; immediate - -: b(endcase) - postpone endcase - ; immediate - -: b(of) - postpone of - read-fcode-offset drop \ read and discard offset - ; immediate - -: b(endof) - postpone endof - read-fcode-offset drop - ; immediate - -: b(do) - postpone do - read-fcode-offset drop - ; immediate - -: b(?do) - postpone ?do - read-fcode-offset drop - ; immediate - -: b(loop) - postpone loop - read-fcode-offset drop - ; immediate - -: b(+loop) - postpone +loop - read-fcode-offset drop - ; immediate - -: b(leave) - postpone leave - ; immediate - - -0 VALUE fc-instance? -: fc-instance ( -- ) \ Mark next defining word as instance-specific. - TRUE TO fc-instance? -; - -: new-token \ unnamed local fcode function - align here next-ip read-fcode# 0 swap set-token - ; - -: external-token ( -- ) \ named local fcode function - next-ip read-fcode-string - \ fc-instance? IF cr ." ext instance token: " 2dup type ." in " pwd cr THEN - header ( str len -- ) \ create a header in the current dictionary entry - new-token - ; - -: new-token - eva-debug? IF - s" x" get-ip >r next-ip read-fcode# r> set-ip (u.) $cat strdup - header - THEN - new-token -; - -\ decide wether or not to give a new token an own name in the dictionary -: named-token - fcode-debug? IF - external-token - ELSE - next-ip read-fcode-string 2drop \ Forget about the name - new-token - THEN -; - -: b(to) ( val -- ) - next-ip read-fcode# - get-token drop ( val xt ) - dup @ ( val xt @xt ) - dup <value> = over <defer> = OR IF - \ Destination is value or defer - drop - >body cell - - ( val addr ) - ?compile-mode IF - literal, postpone ! - ELSE - ! - THEN - ELSE - <create> <> IF ( val xt ) - TRUE ABORT" Invalid destination for FCODE b(to)" - THEN - dup cell+ @ ( val xt @xt+1cell ) - dup <instancevalue> <> swap <instancedefer> <> AND IF - TRUE ABORT" Invalid destination for FCODE b(to)" - THEN - \ Destination is instance-value or instance-defer - >body @ ( val instance-offset ) - ?compile-mode IF - literal, postpone >instance postpone ! - ELSE - >instance ! - THEN - ELSE - THEN -; immediate - -: b(value) - fc-instance? IF - <create> , \ Needed for "(instance?)" for example - <instancevalue> , - (create-instance-var) - FALSE TO fc-instance? - ELSE - <value> , , - THEN - reveal -; - -: b(variable) - fc-instance? IF - <create> , \ Needed for "(instance?)" - <instancevariable> , - 0 (create-instance-var) - FALSE TO fc-instance? - ELSE - <variable> , 0 , - THEN - reveal -; - -: b(constant) - <constant> , , reveal - ; - -: undefined-defer - cr cr ." Uninitialized defer word has been executed!" cr cr - true fcode-end ! - ; - -: b(defer) - fc-instance? IF - <create> , \ Needed for "(instance?)" - <instancedefer> , - ['] undefined-defer (create-instance-var) - reveal - FALSE TO fc-instance? - ELSE - <defer> , reveal - postpone undefined-defer - THEN -; - -: b(create) - <variable> , - postpone noop reveal - ; - -: b(field) ( E: addr -- addr+offset ) ( F: offset size -- offset+size ) - <colon> , over literal, - postpone + - <semicolon> compile, - reveal - + -; - -: b(buffer:) ( E: -- a-addr) ( F: size -- ) - fc-instance? IF - <create> , \ Needed for "(instance?)" - <instancebuffer> , - (create-instance-buf) - FALSE TO fc-instance? - ELSE - <buffer:> , allot - THEN - reveal -; - -: suspend-fcode ( -- ) - noop \ has to be implemented more efficiently ;-) - ; - -: offset16 ( -- ) - 2 to fcode-offset - ; - -: version1 ( -- ) - 1 to fcode-spread - 1 to fcode-offset - read-header - ; - -: start0 ( -- ) - 0 to fcode-spread - offset16 - read-header - ; - -: start1 ( -- ) - 1 to fcode-spread - offset16 - read-header - ; - -: start2 ( -- ) - 2 to fcode-spread - offset16 - read-header - ; - -: start4 ( -- ) - 4 to fcode-spread - offset16 - read-header - ; - -: end0 ( -- ) - true fcode-end ! - ; - -: end1 ( -- ) - end0 - ; - -: ferror ( -- ) - clear end0 - cr ." FCode# " fcode-num @ . ." not assigned!" - cr ." FCode evaluation aborted." cr - ." ( -- S:" depth . ." R:" rdepth . ." ) " .s cr - abort - ; - -: reset-local-fcodes - FFF 800 DO ['] ferror 0 i set-token LOOP - ; - -: byte-load ( addr xt -- ) - >r >r - save-evaluator-state - r> r> - reset-fcode-end - 1 to fcode-spread - dup 1 = IF drop ['] rb@ THEN to fcode-rb@ - set-ip - reset-local-fcodes - depth >r - evaluate-fcode - r> depth 1- <> IF - clear end0 - cr ." Ambiguous stack depth after byte-load!" - cr ." FCode evaluation aborted." cr cr - ELSE - restore-evaluator-state - THEN - ['] c@ to fcode-rb@ -; - -\ Functions for accessing memory ... since some FCODE programs use the normal -\ memory access functions for accessing MMIO memory, too, we got to use a little -\ hack to support them: When address is bigger than MIN-RAM-SIZE, assume the -\ FCODE is trying to access MMIO memory and use the register based access -\ functions instead! -: fc-c@ ( addr -- byte ) dup MIN-RAM-SIZE > IF rb@ ELSE c@ THEN ; -: fc-w@ ( addr -- word ) dup MIN-RAM-SIZE > IF rw@ ELSE w@ THEN ; -: fc-<w@ ( addr -- word ) fc-w@ dup 8000 >= IF 10000 - THEN ; -: fc-l@ ( addr -- long ) dup MIN-RAM-SIZE > IF rl@ ELSE l@ THEN ; -: fc-<l@ ( addr -- long ) fc-l@ signed ; -: fc-x@ ( addr -- dlong ) dup MIN-RAM-SIZE > IF rx@ ELSE x@ THEN ; -: fc-c! ( byte addr -- ) dup MIN-RAM-SIZE > IF rb! ELSE c! THEN ; -: fc-w! ( word addr -- ) dup MIN-RAM-SIZE > IF rw! ELSE w! THEN ; -: fc-l! ( long addr -- ) dup MIN-RAM-SIZE > IF rl! ELSE l! THEN ; -: fc-x! ( dlong addr -- ) dup MIN-RAM-SIZE > IF rx! ELSE x! THEN ; - -: fc-fill ( add len byte -- ) 2 pick MIN-RAM-SIZE > IF rfill ELSE fill THEN ; -: fc-move ( src dst len -- ) - 2 pick MIN-RAM-SIZE > \ Check src - 2 pick MIN-RAM-SIZE > \ Check dst - OR IF rmove ELSE move THEN -; - -\ Destroy virtual mapping (should maybe also update "address" property here?) -: free-virtual ( virt size -- ) - s" map-out" $call-parent -; - -\ Map the specified region, return virtual address -: map-low ( phys.lo ... size -- virt ) - my-space swap s" map-in" $call-parent -; - -\ Get MAC address -: mac-address ( -- mac-str mac-len ) - s" local-mac-address" get-my-property IF - 0 0 - THEN -; - -\ Output line and column number - not used yet -VARIABLE #line -0 #line ! -VARIABLE #out -0 #out ! - -\ Display device status -: display-status ( n -- ) - ." Device status: " . cr -; - -\ Obsolete variables: -VARIABLE group-code -0 group-code ! - -\ Obsolete: Allocate memory for DMA -: dma-alloc ( byte -- virtual ) - s" dma-alloc" $call-parent -; - -\ Obsolete: Get params property -: my-params ( -- addr len ) - s" params" get-my-property IF - 0 0 - THEN -; - -\ Obsolete: Convert SBus interrupt level to CPU interrupt level -: sbus-intr>cpu ( sbus-intr# -- cpu-intr# ) -; - -\ Obsolete: Set "intr" property -: intr ( interrupt# vector -- ) - >r sbus-intr>cpu encode-int r> encode-int+ s" intr" property -; - -\ Obsolete: Create the "name" property -: driver ( addr len -- ) - encode-string s" name" property -; - -\ Obsolete: Return type of CPU -: processor-type ( -- cpu-type ) - 0 -; - -\ Obsolete: Return firmware version -: firmware-version ( -- n ) - 10000 \ Just a dummy value -; - -\ Obsolete: Return fcode-version -: fcode-version ( -- n ) - fcode-revision -; diff --git a/qemu/roms/SLOF/slof/fs/fcode/core.fs b/qemu/roms/SLOF/slof/fs/fcode/core.fs deleted file mode 100644 index 8fd98ec19..000000000 --- a/qemu/roms/SLOF/slof/fs/fcode/core.fs +++ /dev/null @@ -1,173 +0,0 @@ -\ ***************************************************************************** -\ * Copyright (c) 2004, 2008 IBM Corporation -\ * All rights reserved. -\ * This program and the accompanying materials -\ * are made available under the terms of the BSD License -\ * which accompanies this distribution, and is available at -\ * http://www.opensource.org/licenses/bsd-license.php -\ * -\ * Contributors: -\ * IBM Corporation - initial implementation -\ ****************************************************************************/ - -: ?offset16 ( -- true|false ) - fcode-offset 2 = - ; - -: ?arch64 ( -- true|false ) - cell 8 = - ; - -: ?bigendian ( -- true|false ) - deadbeef fcode-num ! - fcode-num ?arch64 IF 4 + THEN - c@ de = - ; - -: reset-fcode-end ( -- ) - false fcode-end ! - ; - -: get-ip ( -- n ) - ip @ - ; - -: set-ip ( n -- ) - ip ! - ; - -: next-ip ( -- ) - get-ip 1+ set-ip - ; - -: jump-n-ip ( n -- ) - get-ip + set-ip - ; - -: read-byte ( -- n ) - get-ip fcode-rb@ - ; - -: ?compile-mode ( -- on|off ) - state @ - ; - -: save-evaluator-state - get-ip eva-debug? IF ." saved ip " dup . cr THEN - fcode-end @ eva-debug? IF ." saved fcode-end " dup . cr THEN - fcode-offset eva-debug? IF ." saved fcode-offset " dup . cr THEN -\ local fcodes are currently NOT saved! - fcode-spread eva-debug? IF ." saved fcode-spread " dup . cr THEN - ['] fcode@ behavior eva-debug? IF ." saved fcode@ " dup . cr THEN - ; - -: restore-evaluator-state - eva-debug? IF ." restored fcode@ " dup . cr THEN to fcode@ - eva-debug? IF ." restored fcode-spread " dup . cr THEN to fcode-spread -\ local fcodes are currently NOT restored! - eva-debug? IF ." restored fcode-offset " dup . cr THEN to fcode-offset - eva-debug? IF ." restored fcode-end " dup . cr THEN fcode-end ! - eva-debug? IF ." restored ip " dup . cr THEN set-ip - ; - -: token-table-index ( fcode# -- addr ) - cells token-table + - ; - -: join-immediate ( xt immediate? addr -- xt+immediate? addr ) - -rot + swap - ; - -: split-immediate ( xt+immediate? -- xt immediate? ) - dup 1 and 2dup - rot drop swap - ; - -: literal, ( n -- ) - postpone literal - ; - -: fc-string, - postpone sliteral - dup c, bounds ?do i c@ c, loop - ; - -: set-token ( xt immediate? fcode# -- ) - token-table-index join-immediate ! - ; - -: get-token ( fcode# -- xt immediate? ) - token-table-index @ split-immediate - ; - -( ---------------------------------------------------- ) - -#include "little-big.fs" - -( ---------------------------------------------------- ) - -: read-fcode# ( -- FCode# ) - read-byte - dup 01 0F between IF drop read-fcode-num16 THEN - ; - -: read-header ( adr -- ) - next-ip read-byte drop - next-ip read-fcode-num16 drop - next-ip read-fcode-num32 drop - ; - -: read-fcode-string ( -- str len ) - read-byte \ get string length ( -- len ) - next-ip get-ip \ get string addr ( -- len str ) - swap \ type needs the parameters swapped ( -- str len ) - dup 1- jump-n-ip \ jump to the end of the string in FCode - ; - - --1 VALUE break-fcode-addr -0 VALUE break-fcode-steps - -: evaluate-fcode ( -- ) - BEGIN - get-ip break-fcode-addr = IF - TRUE fcode-end ! - THEN - fcode-end @ 0= - WHILE - fcode@ ( fcode# ) - eva-debug? IF - dup - get-ip 8 u.r ." : " - ." [" 3 u.r ." ] " - THEN - \ When it is not immediate and in compile-mode, then compile - get-token 0= ?compile-mode AND IF ( xt ) - compile, - ELSE \ immediate or "interpretation" mode - eva-debug? IF dup xt>name type space THEN - execute - THEN - eva-debug? IF .s cr THEN - break-fcode-steps IF - break-fcode-steps 1- TO break-fcode-steps - break-fcode-steps 0= IF - TRUE fcode-end ! - THEN - THEN - next-ip - REPEAT -; - -\ Run FCODE for n steps -: steps-fcode ( n -- ) - to break-fcode-steps - break-fcode-addr >r -1 to break-fcode-addr - reset-fcode-end - evaluate-fcode - r> to break-fcode-addr -; - -\ Step through one FCODE instruction -: step-fcode ( -- ) - 1 steps-fcode -; diff --git a/qemu/roms/SLOF/slof/fs/fcode/evaluator.fs b/qemu/roms/SLOF/slof/fs/fcode/evaluator.fs deleted file mode 100644 index 8f0bae527..000000000 --- a/qemu/roms/SLOF/slof/fs/fcode/evaluator.fs +++ /dev/null @@ -1,119 +0,0 @@ -\ ***************************************************************************** -\ * Copyright (c) 2004, 2011 IBM Corporation -\ * All rights reserved. -\ * This program and the accompanying materials -\ * are made available under the terms of the BSD License -\ * which accompanies this distribution, and is available at -\ * http://www.opensource.org/licenses/bsd-license.php -\ * -\ * Contributors: -\ * IBM Corporation - initial implementation -\ ****************************************************************************/ - - -variable ip -variable fcode-end -variable fcode-num - 1 value fcode-spread - 2 value fcode-offset -false value eva-debug? -true value fcode-debug? -defer fcode-rb@ -defer fcode@ - -' c@ to fcode-rb@ - -create token-table 2000 cells allot \ 1000h = 4096d - -#include "core.fs" -#include "1275.fs" -#include "tokens.fs" -#include "locals.fs" - -0 value buff -0 value buff-size - -' read-fcode# to fcode@ - -( ---------------------------------------------------- ) - -: execute-rom-fcode ( addr len | false -- ) - reset-fcode-end - ?dup IF - diagnostic-mode? IF ." , executing ..." cr THEN - dup >r r@ alloc-mem dup >r swap rmove - r@ set-ip evaluate-fcode - diagnostic-mode? IF ." Done." cr THEN - r> r> free-mem - THEN -; - -: rom-code-ignored ( image-addr name len -- image-addr ) - diagnostic-mode? IF - type ." code found in image " dup . ." , ignoring ..." cr - ELSE - 2drop - THEN -; - -: pci-find-rom ( baseaddr -- addr ) - dup IF - dup rw@-le aa55 = IF - diagnostic-mode? IF ." Device ROM header found at " dup . cr THEN - ELSE - drop 0 - THEN - THEN -; - -: pci-find-fcode ( baseaddr -- addr len | false ) - BEGIN - 1ff NOT and \ Image must start at 512 byte boundary - pci-find-rom dup - WHILE - dup 18 + rw@-le + ( pcir-addr ) - \ Check for PCIR magic ... since pcir-addr might not be - \ 4-byte aligned, we've got to use two reads here: - dup rw@-le 4350 ( 'PC' ) <> ( pcir-addr hasPC? ) - over 2+ rw@-le 5249 ( 'IR' ) <> OR IF - diagnostic-mode? IF - ." Invalid PCI Data structure, ignoring ROM contents" cr - THEN - drop false EXIT - THEN ( pcir-addr ) - dup 14 + rb@ CASE \ Get image code type - 0 OF s" Intel x86 BIOS" rom-code-ignored ENDOF - 1 OF - diagnostic-mode? IF - ." Open Firmware FCode found in image at " dup . cr - THEN - dup 1ff NOT AND \ Back to the ROM image header - dup 2+ rw@-le + \ Pointer to FCODE (PCI bus binding ch.9) - swap 10 + rw@-le 200 * \ Image length - EXIT - ENDOF - 2 OF s" HP PA RISC" rom-code-ignored ENDOF - 3 OF s" EFI" rom-code-ignored ENDOF - dup OF s" Unknown type" rom-code-ignored ENDOF - ENDCASE - dup 15 + rb@ 80 and IF \ End of last image? - drop false EXIT - THEN - dup 10 + rw@-le 200 * + \ Next image start - REPEAT -; - - -\ Prepare and run a FCODE program from a PCI Option ROM. -: pci-execute-fcode ( baseaddr -- ) - pci-find-fcode dup 0= IF - 2drop EXIT - THEN ( addr len ) - fc-set-pci-mmio-tokens \ Prepare PCI access functions - \ Now run the FCODE: - ['] execute-rom-fcode CATCH IF - cr ." FCODE failed!" cr - 2drop - THEN - fc-set-normal-mmio-tokens \ Restore normal MMIO access functions -; diff --git a/qemu/roms/SLOF/slof/fs/fcode/little-big.fs b/qemu/roms/SLOF/slof/fs/fcode/little-big.fs deleted file mode 100644 index 309c626a9..000000000 --- a/qemu/roms/SLOF/slof/fs/fcode/little-big.fs +++ /dev/null @@ -1,96 +0,0 @@ -\ ***************************************************************************** -\ * Copyright (c) 2004, 2011 IBM Corporation -\ * All rights reserved. -\ * This program and the accompanying materials -\ * are made available under the terms of the BSD License -\ * which accompanies this distribution, and is available at -\ * http://www.opensource.org/licenses/bsd-license.php -\ * -\ * Contributors: -\ * IBM Corporation - initial implementation -\ ****************************************************************************/ - -\ little- and big-endian FCODE IP access functions - - -?bigendian [IF] \ Big endian access functions first - - -: read-fcode-num16 ( -- n ) - 0 fcode-num ! - ?arch64 IF - read-byte fcode-num 6 + C! - next-ip - read-byte fcode-num 7 + C! - ELSE - read-byte fcode-num 2 + C! - next-ip - read-byte fcode-num 3 + C! - THEN - fcode-num @ -; - -: read-fcode-num32 ( -- n ) - 0 fcode-num ! - ?arch64 IF - read-byte fcode-num 4 + C! - next-ip - read-byte fcode-num 5 + C! - next-ip - read-byte fcode-num 6 + C! - next-ip - read-byte fcode-num 7 + C! - ELSE - read-byte fcode-num 0 + C! - next-ip - read-byte fcode-num 1 + C! - next-ip - read-byte fcode-num 2 + C! - next-ip - read-byte fcode-num 3 + C! - THEN - fcode-num @ -; - - -[ELSE] \ Now the little endian access functions - - -: read-fcode-num16 ( -- n ) - 0 fcode-num ! - ?arch64 IF - read-byte fcode-num 7 + C! - next-ip - read-byte fcode-num 6 + C! - ELSE - read-byte fcode-num 1 + C! - next-ip - read-byte fcode-num 0 + C! - THEN - fcode-num @ -; - -: read-fcode-num32 ( adr -- n ) - 0 fcode-num ! - ?arch64 IF - read-byte fcode-num 7 + C! - next-ip - read-byte fcode-num 6 + C! - next-ip - read-byte fcode-num 5 + C! - next-ip - read-byte fcode-num 4 + C! - ELSE - read-byte fcode-num 3 + C! - next-ip - read-byte fcode-num 2 + C! - next-ip - read-byte fcode-num 1 + C! - next-ip - read-byte fcode-num 0 + C! - THEN - fcode-num @ -; - - -[THEN] diff --git a/qemu/roms/SLOF/slof/fs/fcode/locals.fs b/qemu/roms/SLOF/slof/fs/fcode/locals.fs deleted file mode 100644 index 5381df058..000000000 --- a/qemu/roms/SLOF/slof/fs/fcode/locals.fs +++ /dev/null @@ -1,155 +0,0 @@ -\ ***************************************************************************** -\ * Copyright (c) 2011 IBM Corporation -\ * All rights reserved. -\ * This program and the accompanying materials -\ * are made available under the terms of the BSD License -\ * which accompanies this distribution, and is available at -\ * http://www.opensource.org/licenses/bsd-license.php -\ * -\ * Contributors: -\ * IBM Corporation - initial implementation -\ ****************************************************************************/ -\ * -\ * Support for old-fashioned local values in FCODE. -\ * -\ * There is one old FCODE tokenizer that uses the FCODE opcodes in the range -\ * of 0x407 to 0x41f for supporting Forth local values. Each locals stack -\ * frame contains 8 variables. The opcodes from 0x407 to 0x40f are used to -\ * push 0 up to 8 values from the normal data stack into the current locals -\ * stack frame. All other variables in the current stack frame are not -\ * pre-initialized. -\ * The opcodes from 0x410 to 0x417 can be used for reading the first, second, -\ * ... eighth value out of the locals stack frame, and the opcode from 0x418 -\ * to 0x41f can be used to set the first, second, ... eighth value in the -\ * stack frame respectively. -\ * - -80 cells CONSTANT LOCALS-STACK-SIZE - -LOCALS-STACK-SIZE BUFFER: localsstackbuf - -localsstackbuf VALUE localsstack - - -: fc-local@ ( n -- val ) - cells localsstack swap - @ -; - -: fc-local-1-@ 1 fc-local@ ; -: fc-local-2-@ 2 fc-local@ ; -: fc-local-3-@ 3 fc-local@ ; -: fc-local-4-@ 4 fc-local@ ; -: fc-local-5-@ 5 fc-local@ ; -: fc-local-6-@ 6 fc-local@ ; -: fc-local-7-@ 7 fc-local@ ; -: fc-local-8-@ 8 fc-local@ ; - - -: fc-local! ( val n -- ) - cells localsstack swap - ! -; - -: fc-local-1-! 1 fc-local! ; -: fc-local-2-! 2 fc-local! ; -: fc-local-3-! 3 fc-local! ; -: fc-local-4-! 4 fc-local! ; -: fc-local-5-! 5 fc-local! ; -: fc-local-6-! 6 fc-local! ; -: fc-local-7-! 7 fc-local! ; -: fc-local-8-! 8 fc-local! ; - - -0 VALUE uses-locals? - -\ Create space for the current function on the locals stack. -\ Pre-initialized the n first locals with the n top-most data stack items. -\ Note: Each function can use up to 8 (initialized or uninitialized) locals. -: (fc-push-locals) ( ... n -- ) - \ cr ." pushing " dup . ." locals" cr - 8 cells localsstack + TO localsstack - localsstack localsstackbuf - - LOCALS-STACK-SIZE > ABORT" Locals stack exceeded!" - ?dup IF - ( ... n ) 1 swap DO - i fc-local! \ Store pre-initialized locals - -1 +LOOP - THEN -; - -: fc-push-locals ( n -- ) - \ cr ." compiling push for " dup . ." locals" cr - uses-locals? ABORT" Definition pushes locals multiple times!" - true TO uses-locals? - ( n ) ['] literal execute - ['] (fc-push-locals) compile, -; - -: fc-push-0-locals 0 fc-push-locals ; -: fc-push-1-locals 1 fc-push-locals ; -: fc-push-2-locals 2 fc-push-locals ; -: fc-push-3-locals 3 fc-push-locals ; -: fc-push-4-locals 4 fc-push-locals ; -: fc-push-5-locals 5 fc-push-locals ; -: fc-push-6-locals 6 fc-push-locals ; -: fc-push-7-locals 7 fc-push-locals ; -: fc-push-8-locals 8 fc-push-locals ; - - -: fc-pop-locals ( -- ) - \ ." popping locals" cr - localsstack 8 cells - TO localsstack - localsstack localsstackbuf - 0 < ABORT" Locals stack undeflow!" -; - - -: fc-locals-exit - uses-locals? IF - \ ." compiling pop-locals for exit" cr - ['] fc-pop-locals compile, - THEN - ['] exit compile, -; - -: fc-locals-b(;) - uses-locals? IF - \ ." compiling pop-locals for b(;)" cr - ['] fc-pop-locals compile, - THEN - false TO uses-locals? - ['] b(;) execute -; - - -: fc-set-locals-tokens ( -- ) - ['] fc-push-0-locals 1 407 set-token - ['] fc-push-1-locals 1 408 set-token - ['] fc-push-2-locals 1 409 set-token - ['] fc-push-3-locals 1 40a set-token - ['] fc-push-4-locals 1 40b set-token - ['] fc-push-5-locals 1 40c set-token - ['] fc-push-6-locals 1 40d set-token - ['] fc-push-7-locals 1 40e set-token - ['] fc-push-8-locals 1 40f set-token - - ['] fc-local-1-@ 0 410 set-token - ['] fc-local-2-@ 0 411 set-token - ['] fc-local-3-@ 0 412 set-token - ['] fc-local-4-@ 0 413 set-token - ['] fc-local-5-@ 0 414 set-token - ['] fc-local-6-@ 0 415 set-token - ['] fc-local-7-@ 0 416 set-token - ['] fc-local-8-@ 0 417 set-token - - ['] fc-local-1-! 0 418 set-token - ['] fc-local-2-! 0 419 set-token - ['] fc-local-3-! 0 41a set-token - ['] fc-local-4-! 0 41b set-token - ['] fc-local-5-! 0 41c set-token - ['] fc-local-6-! 0 41d set-token - ['] fc-local-7-! 0 41e set-token - ['] fc-local-8-! 0 41f set-token - - ['] fc-locals-exit 1 33 set-token - ['] fc-locals-b(;) 1 c2 set-token -; -fc-set-locals-tokens diff --git a/qemu/roms/SLOF/slof/fs/fcode/tokens.fs b/qemu/roms/SLOF/slof/fs/fcode/tokens.fs deleted file mode 100644 index 3efc17e06..000000000 --- a/qemu/roms/SLOF/slof/fs/fcode/tokens.fs +++ /dev/null @@ -1,480 +0,0 @@ -\ ***************************************************************************** -\ * Copyright (c) 2004, 2011 IBM Corporation -\ * All rights reserved. -\ * This program and the accompanying materials -\ * are made available under the terms of the BSD License -\ * which accompanies this distribution, and is available at -\ * http://www.opensource.org/licenses/bsd-license.php -\ * -\ * Contributors: -\ * IBM Corporation - initial implementation -\ ****************************************************************************/ - -: fc-abort ." FCode called abort: IP " get-ip . ( ." STACK: " .s ) depth dup 0< IF abort THEN . rdepth . cr abort ; -: fc-0 ." 0(lit): STACK ( S: " depth . ." R: " rdepth . ." ): " depth 0> IF .s THEN 0 ; -: fc-1 ." 1(lit): STACK ( S: " depth . ." R: " rdepth . ." ): " depth 0> IF .s THEN 1 ; - -: parse-1hex 1 hex-decode-unit ; - -\ Adjust functions for accessing MMIO registers. According to IEEE 1275, -\ a bus device can substitute bus-specific implementations of r*@ and r*! -\ for use by its children, e.g. with respect to byte-order. Since PCI is -\ little endian by default, we've got to use the little endian accessor -\ functions for the PCI bus (some FCODE programs are expecting this behavior). -: fc-set-pci-mmio-tokens ( -- ) - ['] rw@-le 0 232 set-token - ['] rw!-le 0 233 set-token - ['] rl@-le 0 234 set-token - ['] rl!-le 0 235 set-token - ['] rx@-le 0 22E set-token - ['] rx!-le 0 22F set-token -; - -\ Set normal MMIO access token behavior: -: fc-set-normal-mmio-tokens ( -- ) - ['] rw@ 0 232 set-token - ['] rw! 0 233 set-token - ['] rl@ 0 234 set-token - ['] rl! 0 235 set-token - ['] rx@ 0 22E set-token - ['] rx! 0 22F set-token -; - -: reset-token-table - FFF 0 DO ['] ferror 0 i set-token LOOP - ; - -reset-token-table - -' end0 0 00 set-token - -\ 01...0F beginning code of 2-byte FCode sequences - -' b(lit) 1 10 set-token - -' b(') 1 11 set-token -' b(") 1 12 set-token -' bbranch 1 13 set-token -' b?branch 1 14 set-token -' b(loop) 1 15 set-token -' b(+loop) 1 16 set-token -' b(do) 1 17 set-token -' b(?do) 1 18 set-token -' i 0 19 set-token -' j 0 1A set-token -' b(leave) 1 1B set-token -' b(of) 1 1C set-token -' execute 0 1D set-token -' + 0 1E set-token -' - 0 1F set-token -' * 0 20 set-token -' / 0 21 set-token -' mod 0 22 set-token -' and 0 23 set-token -' or 0 24 set-token -' xor 0 25 set-token -' invert 0 26 set-token -' lshift 0 27 set-token -' rshift 0 28 set-token -' >>a 0 29 set-token -' /mod 0 2A set-token -' u/mod 0 2B set-token -' negate 0 2C set-token -' abs 0 2D set-token -' min 0 2E set-token -' max 0 2F set-token -' >r 0 30 set-token -' r> 0 31 set-token -' r@ 0 32 set-token -' exit 0 33 set-token -' 0= 0 34 set-token -' 0<> 0 35 set-token -' 0< 0 36 set-token -' 0<= 0 37 set-token -' 0> 0 38 set-token -' 0>= 0 39 set-token -' < 0 3A set-token -' > 0 3B set-token -' = 0 3C set-token -' <> 0 3D set-token -' u> 0 3E set-token -' u<= 0 3F set-token -' u< 0 40 set-token -' u>= 0 41 set-token -' >= 0 42 set-token -' <= 0 43 set-token -' between 0 44 set-token -' within 0 45 set-token -' DROP 0 46 set-token -' DUP 0 47 set-token -' OVER 0 48 set-token -' SWAP 0 49 set-token -' ROT 0 4A set-token -' -ROT 0 4B set-token -' TUCK 0 4C set-token -' nip 0 4D set-token -' pick 0 4E set-token -' roll 0 4F set-token -' ?dup 0 50 set-token -' depth 0 51 set-token -' 2drop 0 52 set-token -' 2dup 0 53 set-token -' 2over 0 54 set-token -' 2swap 0 55 set-token -' 2rot 0 56 set-token -' 2/ 0 57 set-token -' u2/ 0 58 set-token -' 2* 0 59 set-token -' /c 0 5A set-token -' /w 0 5B set-token -' /l 0 5C set-token -' /n 0 5D set-token -' ca+ 0 5E set-token -' wa+ 0 5F set-token -' la+ 0 60 set-token -' na+ 0 61 set-token -' char+ 0 62 set-token -' wa1+ 0 63 set-token -' la1+ 0 64 set-token -' cell+ 0 65 set-token -' chars 0 66 set-token -' /w* 0 67 set-token -' /l* 0 68 set-token -' cells 0 69 set-token -' on 0 6A set-token -' off 0 6B set-token -' +! 0 6C set-token -' @ 0 6D set-token -' fc-l@ 0 6E set-token -' fc-w@ 0 6F set-token -' fc-<w@ 0 70 set-token -' fc-c@ 0 71 set-token -' ! 0 72 set-token -' fc-l! 0 73 set-token -' fc-w! 0 74 set-token -' fc-c! 0 75 set-token -' 2@ 0 76 set-token -' 2! 0 77 set-token -' fc-move 0 78 set-token -' fc-fill 0 79 set-token -' comp 0 7A set-token -' noop 0 7B set-token -' lwsplit 0 7C set-token -' wljoin 0 7D set-token -' lbsplit 0 7E set-token -' bljoin 0 7F set-token -' wbflip 0 80 set-token -' upc 0 81 set-token -' lcc 0 82 set-token -' pack 0 83 set-token -' count 0 84 set-token -' body> 0 85 set-token -' >body 0 86 set-token -' fcode-revision 0 87 set-token -' span 0 88 set-token -' unloop 0 89 set-token -' expect 0 8A set-token -' alloc-mem 0 8B set-token -' free-mem 0 8C set-token -' key? 0 8D set-token -' key 0 8E set-token -' emit 0 8F set-token -' type 0 90 set-token -' (cr 0 91 set-token -' cr 0 92 set-token -' #out 0 93 set-token -' #line 0 94 set-token -' hold 0 95 set-token -' <# 0 96 set-token -' u#> 0 97 set-token -' sign 0 98 set-token -' u# 0 99 set-token -' u#s 0 9A set-token -' u. 0 9B set-token -' u.r 0 9C set-token -' . 0 9D set-token -' .r 0 9E set-token -' .s 0 9F set-token -' base 0 A0 set-token -\ ' convert 0 A1 set-token \ historical, not supported -' $number 0 A2 set-token -' digit 0 A3 set-token -' -1 0 A4 set-token -' 0 0 A5 set-token -' 1 0 A6 set-token -' 2 0 A7 set-token -' 3 0 A8 set-token -' bl 0 A9 set-token -' bs 0 AA set-token -' bell 0 AB set-token -' bounds 0 AC set-token -' here 0 AD set-token -' aligned 0 AE set-token -' wbsplit 0 AF set-token -' bwjoin 0 B0 set-token -' b(<mark) 1 B1 set-token -' b(>resolve) 1 B2 set-token -\ ' set-token-table 0 B3 set-token \ historical, not supported -\ ' set-table 0 B4 set-token \ historical, not supported -' new-token 0 B5 set-token -' named-token 0 B6 set-token -' b(:) 1 B7 set-token -' b(value) 1 B8 set-token -' b(variable) 1 B9 set-token -' b(constant) 1 BA set-token -' b(create) 1 BB set-token -' b(defer) 1 BC set-token -' b(buffer:) 1 BD set-token -' b(field) 1 BE set-token -\ ' b(code) 0 BF set-token \ historical, not supported -' fc-instance 1 C0 set-token -\ ' ferror 0 C1 set-token \ Reserved -' b(;) 1 C2 set-token -' b(to) 1 C3 set-token -' b(case) 1 C4 set-token -' b(endcase) 1 C5 set-token -' b(endof) 1 C6 set-token -' # 0 C7 set-token -' #s 0 C8 set-token -' #> 0 C9 set-token -' external-token 0 CA set-token -' $find 0 CB set-token -' offset16 0 CC set-token -' evaluate 0 CD set-token -\ 0 CE reserved -\ 0 CF reserved -' c, 0 D0 set-token -' w, 0 D1 set-token -' l, 0 D2 set-token -' , 0 D3 set-token -' um* 0 D4 set-token -' um/mod 0 D5 set-token -\ 0 D6 reserved -\ 0 D7 reserved -' d+ 0 D8 set-token -' d- 0 D9 set-token -' get-token 0 DA set-token -' set-token 0 DB set-token -' state 0 DC set-token \ possibly broken -' compile, 0 DD set-token -' behavior 0 DE set-token - -\ Tokens 0xDF to 0xEF are reserved - -' start0 0 F0 set-token -' start1 0 F1 set-token -' start2 0 F2 set-token -' start4 0 F3 set-token - -\ Tokens 0xF4 to 0xFB are reserved - -' ferror 0 FC set-token -' version1 0 FD set-token - -\ ' 4-byte-id 0 FE set-token \ Historical, not supported -' end1 0 FF set-token - -\ 0 100 set-token \ reserved -' dma-alloc 0 101 set-token \ Obsolete -' my-address 0 102 set-token -' my-space 0 103 set-token -\ ' memmap 0 104 set-token \ Obsolete -' free-virtual 0 105 set-token -\ ' >physical 0 106 set-token \ Obsolete - -\ Tokens 0x107 to 0x10e are reserved - -' my-params 0 10f set-token \ Obsolete -' property 0 110 set-token -' encode-int 0 111 set-token -' encode+ 0 112 set-token -' encode-phys 0 113 set-token -' encode-string 0 114 set-token -' encode-bytes 0 115 set-token -' reg 0 116 set-token -' intr 0 117 set-token \ Obsolete -' driver 0 118 set-token \ Obsolete -' model 0 119 set-token -' device-type 0 11A set-token -' parse-2int 0 11B set-token -\ ' is-install 0 11C set-token \ Will be set by framebuffer code -\ ' is-remove 0 11D set-token \ Will be set by framebuffer code -\ ' is-selftest 0 11E set-token \ Will be set by framebuffer code -' new-device 0 11F set-token -' diagnostic-mode? 0 120 set-token -' display-status 0 121 set-token \ Maybe obsolete -' memory-test-suite 0 122 set-token -' group-code 0 123 set-token \ Obsolete -' mask 0 124 set-token -' get-msecs 0 125 set-token -' ms 0 126 set-token -' finish-device 0 127 set-token -' decode-phys 0 128 set-token -\ ' push-package 0 129 set-token \ TODO - from proposal 215 -\ ' pop-package 0 12A set-token \ TODO - from proposal 215 -' interpose 0 12B set-token \ Recommended practice: Interposition - -\ Tokens 0x12C to 0x12F are reserved - -' map-low 0 130 set-token -' sbus-intr>cpu 0 131 set-token \ Obsolete - -\ Tokens 0x132 to 0x14f are reserved - -\ The following tokens will be set by the framebuffer code: -\ ' #lines 0 150 set-token -\ ' #columns 0 151 set-token -\ ' line# 0 152 set-token -\ ' column# 0 153 set-token -\ ' inverse? 0 154 set-token -\ ' inverse-screen? 0 155 set-token -\ ' frame-buffer-busy 0 156 set-token \ Historical, not supported -\ ' draw-character 0 157 set-token -\ ' reset-screen 0 158 set-token -\ ' toggle-cursor 0 159 set-token -\ ' erase-screen 0 15A set-token -\ ' blink-screen 0 15B set-token -\ ' invert-screen 0 15C set-token -\ ' insert-characters 0 15D set-token -\ ' delete-characters 0 15E set-token -\ ' insert-lines 0 15F set-token -\ ' delete-lines 0 160 set-token -\ ' draw-logo 0 161 set-token -\ ' frame-buffer-adr 0 162 set-token -\ ' screen-height 0 163 set-token -\ ' screen-width 0 164 set-token -\ ' window-top 0 165 set-token -\ ' window-left 0 166 set-token -\ ' 0 167 set-token \ Reserved -\ ' foreground-color 0 168 set-token \ From 16-color recommended practice -\ ' background-color 0 169 set-token \ From 16-color recommended practice -\ ' default-font 0 16A set-token -\ ' set-font 0 16B set-token -\ ' char-height 0 16C set-token -\ ' char-width 0 16D set-token -\ ' >font 0 16E set-token -\ ' fontbytes 0 16F set-token - -\ Tokens 0x170 to 0x17C are obsolete fb1 functions -\ Tokens 0x17D to 0x17F are reserved - -\ The following tokens will be set by the framebuffer code, too: -\ ' fb8-draw-character 0 180 set-token -\ ' fb8-reset-screen 0 181 set-token -\ ' fb8-toggle-cursor 0 182 set-token -\ ' fb8-erase-screen 0 183 set-token -\ ' fb8-blink-screen 0 184 set-token -\ ' fb8-invert-screen 0 185 set-token -\ ' fb8-insert-characters 0 186 set-token -\ ' fb8-delete-characters 0 187 set-token -\ ' fb8-insert-lines 0 188 set-token -\ ' fb8-delete-lines 0 189 set-token -\ ' fb8-draw-logo 0 18A set-token -\ ' fb8-install 0 18B set-token - -\ Tokens 0x18C to 0x18F are reserved -\ Tokens 0x190 to 0x196 are obsolete VMEbus tokens -\ Tokens 0x197 to 0x19F are reserved - -\ ' return-buffer 0 1A0 set-token \ Historical, not supported -\ ' xmit-packet 0 1A1 set-token \ Historical, not supported -\ ' poll-packet 0 1A2 set-token \ Historical, not supported -\ 0 1A3 set-token \ reserved -' mac-address 0 1A4 set-token - -\ Tokens 0x1A5 to 0x200 are reserved - -' device-name 0 201 set-token -' my-args 0 202 set-token -' my-self 0 203 set-token -' find-package 0 204 set-token -' open-package 0 205 set-token -' close-package 0 206 set-token -' find-method 0 207 set-token -' call-package 0 208 set-token -' $call-parent 0 209 set-token -' my-parent 0 20A set-token -' ihandle>phandle 0 20B set-token -\ 0 20C set-token \ reserved -' my-unit 0 20D set-token -' $call-method 0 20E set-token -' $open-package 0 20F set-token -' processor-type 0 210 set-token \ Obsolete -' firmware-version 0 211 set-token \ Obsolete -' fcode-version 0 212 set-token \ Obsolete -\ ' alarm 0 213 set-token \ TODO -' (is-user-word) 0 214 set-token -' suspend-fcode 0 215 set-token -' fc-abort 0 216 set-token -' catch 0 217 set-token -' throw 0 218 set-token -\ ' user-abort 0 219 set-token \ TODO -' get-my-property 0 21A set-token -' decode-int 0 21B set-token -' decode-string 0 21C set-token -' get-inherited-property 0 21D set-token -' delete-property 0 21E set-token -' get-package-property 0 21F set-token -' cpeek 0 220 set-token -' wpeek 0 221 set-token -' lpeek 0 222 set-token -' cpoke 0 223 set-token -' wpoke 0 224 set-token -' lpoke 0 225 set-token -' lwflip 0 226 set-token -' lbflip 0 227 set-token -' lbflips 0 228 set-token -\ ' adr-mask 0 229 set-token \ Historical, not supported - -\ Tokens 0x22A to 0x22F are reserved - -' rb@ 0 230 set-token -' rb! 0 231 set-token -fc-set-normal-mmio-tokens \ Set rw@, rw!, rl@, rl!, rx@ and rx! - -' wbflips 0 236 set-token -' lwflips 0 237 set-token -\ ' probe 0 238 set-token \ Obsolete -\ ' probe-virtual 0 239 set-token \ Obsolete -\ 0 23A reserved -' child 0 23B set-token -' peer 0 23C set-token -' next-property 0 23D set-token -' byte-load 0 23E set-token -' set-args 0 23F set-token -' left-parse-string 0 240 set-token - -\ 64-bit extension tokens: -' bxjoin 0 241 set-token -' fc-<l@ 0 242 set-token -' lxjoin 0 243 set-token -' wxjoin 0 244 set-token -' x, 0 245 set-token -' fc-x@ 0 246 set-token -' fc-x! 0 247 set-token -' /x 0 248 set-token -' /x* 0 249 set-token -' xa+ 0 24A set-token -' xa1+ 0 24B set-token -' xbflip 0 24C set-token -' xbflips 0 24D set-token -' xbsplit 0 24E set-token -' xlflip 0 24F set-token -' xlflips 0 250 set-token -' xlsplit 0 251 set-token -' xwflip 0 252 set-token -' xwflips 0 253 set-token -' xwsplit 0 254 set-token - -\ 0 255 RESERVED FCODES -\ ... -\ 0 5FF RESERVED FCODES - -\ 0 600 VENDOR FCODES -\ ... -\ 0 7FF VENDOR FCODES - -\ 0 800 LOCAL FCODES -\ ... -\ 0 FFF LOCAL FCODES - diff --git a/qemu/roms/SLOF/slof/fs/find-hash.fs b/qemu/roms/SLOF/slof/fs/find-hash.fs deleted file mode 100644 index a40ccbd4f..000000000 --- a/qemu/roms/SLOF/slof/fs/find-hash.fs +++ /dev/null @@ -1,77 +0,0 @@ -\ ***************************************************************************** -\ * Copyright (c) 2004, 2008 IBM Corporation -\ * All rights reserved. -\ * This program and the accompanying materials -\ * are made available under the terms of the BSD License -\ * which accompanies this distribution, and is available at -\ * http://www.opensource.org/licenses/bsd-license.php -\ * -\ * Contributors: -\ * IBM Corporation - initial implementation -\ ****************************************************************************/ - -#ifdef HASH_DEBUG -0 value from-hash -0 value not-from-hash -0 value hash-collisions -#endif - -clean-hash - -: hash-find ( str len head -- 0 | link ) - >r 2dup 2dup hash ( str len str len hash R: head ) - dup >r @ dup ( str len str len *hash *hash R: head hash ) - IF ( str len str len *hash R: head hash ) - link>name name>string string=ci ( str len true|false R: head hash ) - dup 0= - IF -#ifdef HASH_DEBUG - hash-collisions 1+ - to hash-collisions -#endif - THEN - ELSE - nip nip ( str len 0 R: head hash ) - THEN - IF \ hash found - 2drop r> @ r> drop ( *hash R: ) -#ifdef HASH_DEBUG - from-hash 1+ to from-hash -#endif - exit - THEN \ hash not found - r> r> swap >r ((find)) ( str len head R: hash=0 ) - dup - IF -#ifdef HASH_DEBUG - not-from-hash 1+ - to not-from-hash -#endif - dup r> ! ( link R: ) - ELSE - r> drop ( 0 R: ) - THEN -; - -: hash-reveal hash off ; - -' hash-reveal to (reveal) -' hash-find to (find) - -#ifdef HASH_DEBUG -\ print out all entries in the hash table -: dump-hash-table ( -- ) - cr - hash-table hash-size 0 DO - dup @ dup 0<> IF - over . s" : " type link>name name>string type cr - ELSE - drop - THEN - cell+ - LOOP drop - s" hash-collisions: " type hash-collisions . cr - s" from-hash: " type from-hash . cr - s" not-from-hash: " type not-from-hash . cr -; -#endif diff --git a/qemu/roms/SLOF/slof/fs/generic-disk.fs b/qemu/roms/SLOF/slof/fs/generic-disk.fs deleted file mode 100644 index 0543c890e..000000000 --- a/qemu/roms/SLOF/slof/fs/generic-disk.fs +++ /dev/null @@ -1,68 +0,0 @@ -\ ***************************************************************************** -\ * Copyright (c) 2004, 2008 IBM Corporation -\ * All rights reserved. -\ * This program and the accompanying materials -\ * are made available under the terms of the BSD License -\ * which accompanies this distribution, and is available at -\ * http://www.opensource.org/licenses/bsd-license.php -\ * -\ * Contributors: -\ * IBM Corporation - initial implementation -\ ****************************************************************************/ - - -\ Generic disk support - -\ Input: -\ name of device ( e.g. "disk", "cdrom", ... ) -\ dev# - -\ Needs from parent in device tree: -\ dev-read-blocks ( addr block# #blocks phys.lo ... phys.hi -- #read ) -\ block-size -\ max-transfer - -\ Provides: -\ open ( -- okay? ) -\ close ( -- ) -\ read ( addr len -- actual ) -\ seek ( pos.lo pos.hi -- status ) -\ read-blocks ( addr block# #blocks -- #read ) -\ Uses: -\ disk-label package interpose for partition and file systems support -\ deblocker package for byte read support - -( str len phys.lo ... phys.hi -- ) -new-device set-unit ( str len ) - 2dup device-name - s" 0 pci-alias-" 2swap $cat evaluate - s" block" device-type - -\ Requiered interface for deblocker - - s" block-size" $call-parent CONSTANT block-size - s" max-transfer" $call-parent CONSTANT max-transfer - -: read-blocks ( addr block# #blocks -- #read ) - my-unit s" dev-read-blocks" $call-parent -; - -INSTANCE VARIABLE deblocker - -: open ( -- okay? ) - 0 0 s" deblocker" $open-package dup deblocker ! dup IF - s" disk-label" find-package IF - my-args rot interpose - THEN - THEN 0<> ; - -: close ( -- ) - deblocker @ close-package ; - -: seek ( pos.lo pos.hi -- status ) - s" seek" deblocker @ $call-method ; - -: read ( addr len -- actual ) - s" read" deblocker @ $call-method ; - -finish-device diff --git a/qemu/roms/SLOF/slof/fs/graphics.fs b/qemu/roms/SLOF/slof/fs/graphics.fs deleted file mode 100644 index 7d5d9306d..000000000 --- a/qemu/roms/SLOF/slof/fs/graphics.fs +++ /dev/null @@ -1,87 +0,0 @@ -\ ***************************************************************************** -\ * Copyright (c) 2015 IBM Corporation -\ * All rights reserved. -\ * This program and the accompanying materials -\ * are made available under the terms of the BSD License -\ * which accompanies this distribution, and is available at -\ * http://www.opensource.org/licenses/bsd-license.php -\ * -\ * Contributors: -\ * IBM Corporation - initial implementation -\ ****************************************************************************/ - -\ Provide some of the functions that are defined in the -\ "OF Recommended Practice: 8bit Graphics Extension" document - -: draw-rectangle ( adr x y w h -- ) - frame-buffer-adr 0= IF 4drop drop EXIT THEN - 0 ?DO - 4dup drop ( adr x y w adr x y ) - \ calculate offset into framebuffer: ((y + i) * width + x) * depth - i + screen-width * + screen-depth * ( adr x y w adr offs ) - frame-buffer-adr + ( adr x y w adr fb_adr ) - over 3 pick screen-depth * i * + ( adr x y w adr fb_adr src ) - swap 3 pick screen-depth * ( adr x y w adr src fb_adr len ) - rmove \ copy line ( adr x y w adr ) - drop ( adr x y w ) - LOOP - 4drop -; - -: fill-rectangle ( col x y w h -- ) - frame-buffer-adr 0= IF 4drop drop EXIT THEN - 0 ?DO - 4dup drop ( col x y w col x y ) - \ calculate offset into framebuffer: ((y + i) * width + x) * depth - i + screen-width * + screen-depth * ( col x y w col offs ) - frame-buffer-adr + ( col x y w col adr ) - 2 pick screen-depth * 2 pick ( col x y w col adr len col ) - rfill \ draw line ( col x y w col ) - drop ( col x y w ) - LOOP - 4drop -; - -: read-rectangle ( adr x y w h -- ) - frame-buffer-adr 0= IF 4drop drop EXIT THEN - 0 ?DO - 4dup drop ( adr x y w adr x y ) - \ calculate offset into framebuffer: ((y + i) * width + x) * depth - i + screen-width * + screen-depth * ( adr x y w adr offs ) - frame-buffer-adr + ( adr x y w adr fb_adr ) - over 3 pick screen-depth * i * + ( adr x y w adr fb_adr dst ) - 3 pick ( adr x y w adr fb_adr dst w ) - rmove \ copy line ( adr x y w adr ) - drop ( adr x y w ) - LOOP - 4drop -; - -: dimensions ( -- width height ) - screen-width screen-height -; - -\ Initialize a default palette (not a standard command, but useful anyway) -: init-default-palette - \ Grayscale ramp for upper colors - 100 10 DO - i i i i color! - LOOP - \ Standard colors from "16-color Text Extension" specification - 00 00 00 0 color! - 00 00 aa 1 color! - 00 aa 00 2 color! - 00 aa aa 3 color! - aa 00 00 4 color! - aa 00 aa 5 color! - aa 55 00 6 color! - aa aa aa 7 color! - 55 55 55 8 color! - 55 55 ff 9 color! - 55 ff 55 a color! - 55 ff ff b color! - ff 55 55 c color! - ff 55 ff d color! - ff ff 55 e color! - ff ff ff f color! -; diff --git a/qemu/roms/SLOF/slof/fs/history.fs b/qemu/roms/SLOF/slof/fs/history.fs deleted file mode 100644 index 2c2c70fe0..000000000 --- a/qemu/roms/SLOF/slof/fs/history.fs +++ /dev/null @@ -1,107 +0,0 @@ -\ ***************************************************************************** -\ * Copyright (c) 2004, 2008 IBM Corporation -\ * All rights reserved. -\ * This program and the accompanying materials -\ * are made available under the terms of the BSD License -\ * which accompanies this distribution, and is available at -\ * http://www.opensource.org/licenses/bsd-license.php -\ * -\ * Contributors: -\ * IBM Corporation - initial implementation -\ ****************************************************************************/ - -\ Create debug section in NVRAM -: debug-init-nvram ( -- ) - nvram-partition-type-debug get-nvram-partition IF - cr ." Could not find debug partition in NVRAM - " - nvram-partition-type-debug s" debug" d# 1024 new-nvram-partition - ABORT" Failed to create DEBUG NVRAM partition" - 2dup erase-nvram-partition drop - ." created." cr - THEN - s" debug-nvram-partition" $2constant -; - -debug-init-nvram - -: debug-add-env ( "name" "value" -- ) debug-nvram-partition 2rot 2rot internal-add-env drop ; -: debug-set-env ( "name" "value" -- ) debug-nvram-partition 2rot 2rot internal-set-env drop ; -: debug-get-env ( "name" -- "value" TRUE | FALSE) debug-nvram-partition 2swap internal-get-env ; - -: debug-get-history-enabled ( -- n ) s" history-enabled?" debug-get-env IF $number IF 0 THEN ELSE 0 THEN ; -: debug-set-history-enabled ( n -- ) (.) s" history-enabled?" 2swap debug-set-env ; - - -debug-get-history-enabled constant nvram-history? - -nvram-history? [IF] - -: history-init-nvram ( -- ) - nvram-partition-type-history get-nvram-partition IF - cr ." Could not find history partition in NVRAM - " - nvram-partition-type-history s" history" d# 2048 new-nvram-partition - ABORT" Failed to create SMS NVRAM partition" - 2dup erase-nvram-partition drop - ." created" cr - THEN - s" history-nvram-partition" $2constant -; - -history-init-nvram - -0 value (history-len) -0 value (history-adr) - -: (history-load-one) ( str len -- len ) - \ 2dup ." loading " type cr - to (history-len) to (history-adr) - /his (history-len) + alloc-mem ( his ) - his-tail 0= IF dup to his-tail THEN - his-head over his>next ! to his-head - his-head his>next @ his>prev his-head swap ! - (history-len) his-head his>len ! - (history-adr) his-head his>buf (history-len) move - (history-len) 1+ -; - -: history-load ( -- ) - history-nvram-partition drop BEGIN dup WHILE - dup rzcount ( part str len ) - dup IF - (history-load-one) + - ELSE - 3drop 0 - THEN - REPEAT - drop -; - -: (history-store-one) ( pos len saddr slen -- FALSE | npos nlen TRUE ) - dup 3 pick < IF \ enough space - dup >r rot >r - \ 2dup ." storing " type cr - bounds DO dup i c@ swap nvram-c! 1+ LOOP - dup 0 swap nvram-c! 1+ - r> r> - 1- true - ELSE - 2drop false - THEN -; - -: history-store ( -- ) - history-nvram-partition erase-nvram-partition drop - history-nvram-partition his-tail BEGIN dup WHILE - dup his>buf over his>len @ - ( position len link saddr slen ) - rot >r (history-store-one) r> - swap IF his>prev @ ELSE drop 0 THEN - REPEAT - 2drop drop -; - -\ redefine "end of SLOF" words to safe history -: reset-all history-store reset-all ; -: reboot history-store reboot ; -: boot history-store boot ; - -[THEN] diff --git a/qemu/roms/SLOF/slof/fs/ide.fs b/qemu/roms/SLOF/slof/fs/ide.fs deleted file mode 100644 index d6f16edd0..000000000 --- a/qemu/roms/SLOF/slof/fs/ide.fs +++ /dev/null @@ -1,612 +0,0 @@ -\ ***************************************************************************** -\ * Copyright (c) 2004, 2008 IBM Corporation -\ * All rights reserved. -\ * This program and the accompanying materials -\ * are made available under the terms of the BSD License -\ * which accompanies this distribution, and is available at -\ * http://www.opensource.org/licenses/bsd-license.php -\ * -\ * Contributors: -\ * IBM Corporation - initial implementation -\ ****************************************************************************/ -\ -\ 26.06.2007 added: two devices (Master/Slave) per channel - -1 encode-int s" #address-cells" property -0 encode-int s" #size-cells" property - -: decode-unit 1 hex-decode-unit ; -: encode-unit 1 hex-encode-unit ; - -0 VALUE >ata \ base address for command-block -0 VALUE >ata1 \ base address for control block - -true VALUE no-timeout \ flag that no timeout occurred - -0c CONSTANT #cdb-bytes \ command descriptor block (12 bytes) -800 CONSTANT atapi-size -200 CONSTANT ata-size - -\ ***************************** -\ Some register access helpers. -\ ***************************** -: ata-ctrl! 2 >ata1 + io-c! ; \ device control reg -: ata-astat@ 2 >ata1 + io-c@ ; \ read alternate status - -: ata-data@ 0 >ata + io-w@ ; \ data reg -: ata-data! 0 >ata + io-w! ; \ data reg -: ata-err@ 1 >ata + io-c@ ; \ error reg -: ata-feat! 1 >ata + io-c! ; \ feature reg -: ata-cnt@ 2 >ata + io-c@ ; \ sector count reg -: ata-cnt! 2 >ata + io-c! ; \ sector count reg -: ata-lbal! 3 >ata + io-c! ; \ lba low reg -: ata-lbal@ 3 >ata + io-c@ ; \ lba low reg -: ata-lbam! 4 >ata + io-c! ; \ lba mid reg -: ata-lbam@ 4 >ata + io-c@ ; \ lba mid reg -: ata-lbah! 5 >ata + io-c! ; \ lba high reg -: ata-lbah@ 5 >ata + io-c@ ; \ lba high reg -: ata-dev! 6 >ata + io-c! ; \ device reg -: ata-dev@ 6 >ata + io-c@ ; \ device reg -: ata-cmd! 7 >ata + io-c! ; \ command reg -: ata-stat@ 7 >ata + io-c@ ; \ status reg - -\ ********************************************************************** -\ ATA / ATAPI Commands specifications: -\ - AT Attachment 8 - ATA/ATAPI Command Set (ATA8-ACS) -\ - ATA Packet Interface for CD-ROMs SFF-8020i -\ - ATA/ATAPI Host Adapters Standard (T13/1510D) -\ ********************************************************************** -00 CONSTANT cmd#nop \ ATA and ATAPI -08 CONSTANT cmd#device-reset \ ATAPI only (mandatory) -20 CONSTANT cmd#read-sector \ ATA and ATAPI -90 CONSTANT cmd#execute-device-diagnostic \ ATA and ATAPI -a0 CONSTANT cmd#packet \ ATAPI only (mandatory) -a1 CONSTANT cmd#identify-packet-device \ ATAPI only (mandatory) -ec CONSTANT cmd#identify-device \ ATA and ATAPI - -\ ***************************** -\ Setup Regs for ATA: -\ BAR 0 & 1 : Device 0 -\ BAR 2 & 3 : Device 1 -\ ***************************** -: set-regs ( n -- ) - dup - 01 and \ only Chan 0 or Chan 1 allowed - 3 lshift dup 10 + config-l@ -4 and to >ata - 14 + config-l@ -4 and to >ata1 - 02 ata-ctrl! \ disable interrupts - 02 and - IF - 10 - ELSE - 00 - THEN - ata-dev! -; - -ata-size VALUE block-size -80000 VALUE max-transfer \ Arbitrary, really - -CREATE sector d# 512 allot -CREATE packet-cdb #cdb-bytes allot -CREATE return-buffer atapi-size allot - -scsi-open \ add scsi functions - -\ ******************************** -\ show all ATAPI-registers -\ data-register not read in order -\ to not influence PIO mode -\ ******************************** -: show-regs - cr - cr ." alt. Status: " ata-astat@ . - cr ." Status : " ata-stat@ . - cr ." Device : " ata-dev@ . - cr ." Error-Reg : " ata-err@ . - cr ." Sect-Count : " ata-cnt@ . - cr ." LBA-Low : " ata-lbal@ . - cr ." LBA-Med : " ata-lbam@ . - cr ." LBA-High : " ata-lbah@ . -; - -\ *************************************************** -\ reads ATAPI-Status and displays it if check-bit set -\ *************************************************** -: status-check ( -- ) - ata-stat@ - dup - 01 and \ is 'check' flag set ? - IF - cr - ." - ATAPI-Status: " . - ata-err@ \ retrieve sense code - dup - 60 = \ sense code = 6 ? - IF - ." ( media changed or reset )" \ 'unit attention' - drop \ drop err-reg content - ELSE - dup - ." (Err : " . \ show err-reg content - space - rshift 4 .sense-text \ show text string - 29 emit - THEN - cr - ELSE - drop \ remove unused status - THEN -; - -\ ************************************* -\ Wait for interface ready condition -\ Bit 7 of Status-Register is busy flag -\ new version with abort after 5 sec. -\ ************************************* -: wait-for-ready - get-msecs \ start timer - BEGIN - ata-stat@ 80 and 0<> \ busy flag still set ? - no-timeout and - WHILE \ yes - dup get-msecs swap - - \ calculate timer difference - FFFF AND \ reduce to 65.5 seconds - d# 5000 > \ difference > 5 seconds ? - IF - false to no-timeout - THEN - REPEAT - drop -; - -\ ************************************* -\ wait for specific status bits -\ new version with abort after 5 sec. -\ ************************************* -: wait-for-status ( val mask -- ) - get-msecs \ initial timer value (start) - >r - BEGIN - 2dup \ val mask - ata-stat@ and <> \ expected status ? - no-timeout and \ and no timeout ? - WHILE - get-msecs r@ - \ calculate timer difference - FFFF AND \ mask-off overflow bits - d# 5000 > \ 5 seconds exceeded ? - IF - false to no-timeout \ set global flag - THEN - REPEAT - r> \ clean return stack - 3drop -; - -\ ********************************* -\ remove extra spaces from string end -\ ********************************* -: cut-string ( saddr nul -- ) - swap - over + - swap - 1 rshift \ bytecount -> wordcount - 0 do - /w - - dup ( addr -- addr addr ) - w@ ( addr addr -- addr nuw ) - dup ( addr nuw -- addr nuw nuw ) - 2020 = - IF - drop - 0 - ELSE - LEAVE - THEN - over - w! - LOOP - drop - drop -; - -\ **************************************************** -\ prints model-string received by identify device -\ **************************************************** -: show-model ( dev# chan# -- ) - 2dup - ." CH " . \ channel 0 / 1 - 0= IF ." / MA" \ Master / Slave - ELSE ." / SL" - THEN - swap - 2 * + ." (@" . ." ) : " \ device number - sector 1 + - c@ - 80 AND 0= - IF - ." ATA-Drive " - ELSE - ." ATAPI-Drive " - THEN - - 22 emit \ start string display with " - sector d# 54 + \ string starts 54 bytes from buffer start - dup - d# 40 \ and is 40 chars long - cut-string \ remove all trailing spaces - - BEGIN - dup - w@ - wbflip - wbsplit - dup 0<> \ first char - IF - emit - dup 0<> \ second char - IF - emit - wa1+ \ increment address for next - false - ELSE \ second char = EndOfString - drop - true - THEN - ELSE \ first char = EndOfString - drop - drop - true - THEN - UNTIL \ end of string detected - drop - 22 emit \ end string display - - sector c@ \ get lower byte of first doublet - 80 AND \ check bit 7 - IF - ." (removable media)" - THEN - - sector 1 + - c@ - 80 AND 0= IF \ is this an ATA drive ? - sector d# 120 + \ get word 60 + 61 - rl@-le \ read 32-bit as little endian value - d# 512 \ standard ATA block-size - swap - .capacity-text ( block-size #blocks -- ) - THEN - - sector d# 98 + \ goto word 49 - w@ - wbflip - 200 and 0= IF cr ." ** LBA is not supported " THEN - - sector c@ \ get lower byte of first doublet - 03 AND 01 = \ we use 12-byte packet commands (=00b) - IF - cr ." packet size = 16 ** not supported ! **" - THEN - no-timeout not \ any timeout occurred so far ? - IF - cr ." ** timeout **" - THEN -; - -\ **************************** -\ ATA functions -\ **************************** -: pio-sector ( addr -- ) 100 0 DO ata-data@ - over w! wa1+ LOOP drop ; -: pio-sector ( addr -- ) - wait-for-ready pio-sector ; -: pio-sectors ( n addr -- ) swap 0 ?DO dup pio-sector 200 + LOOP drop ; - -: lba! lbsplit - 0f and 40 or \ always set LBA-mode + LBA (27..24) - ata-dev@ 10 and or \ add current device-bit (DEV) - ata-dev! \ set LBA (27..24) - ata-lbah! \ set LBA (23..16) - ata-lbam! \ set LBA (15..8) - ata-lbal! \ set LBA (7..0) -; - -: read-sectors ( lba count addr -- ) - >r dup >r ata-cnt! lba! 20 ata-cmd! r> r> pio-sectors ; - -: read-sectors ( lba count addr dev-nr -- ) - set-regs ( lba count addr ) \ Set ata regs - BEGIN >r dup 100 > WHILE - over 100 r@ read-sectors - >r 100 + r> 100 - r> 20000 + REPEAT - r> read-sectors -; - -: ata-read-blocks ( addr block# #blocks dev# -- #read ) - swap dup >r swap >r rot r> ( addr block# #blocks dev # R: #blocks ) - read-sectors r> ( R: #read ) -; - -\ ******************************* -\ ATAPI functions -\ preset LBA register with maximum -\ allowed block-size (16-bits) -\ ******************************* -: set-lba ( block-length -- ) - lbsplit ( quad -- b1.lo b2 b3 b4.hi ) - drop \ skip upper two bytes - drop - ata-lbah! - ata-lbam! -; - -\ ******************************************* -\ gets byte-count and reads a block of words -\ from data-register to a buffer -\ ******************************************* -: read-pio-block ( buff-addr -- buff-addr-new ) - ata-lbah@ 8 lshift \ get block length High - ata-lbam@ or \ get block length Low - 1 rshift \ bcount -> wcount - dup - 0> IF \ any data to transfer? - 0 DO \ words to read - dup \ buffer-address - ata-data@ swap w! \ write 16-bits - wa1+ \ address of next entry - LOOP - ELSE - drop ( buff-addr wcount -- buff-addr ) - THEN - wait-for-ready -; - -\ ******************************************** -\ ATAPI support -\ Send a command block (12 bytes) in PIO mode -\ read data if requested -\ ******************************************** -: send-atapi-packet ( req-buffer -- ) - >r ( R: req-buffer ) - atapi-size set-lba \ set regs to length limit - 00 ata-feat! - cmd#packet ata-cmd! \ A0 = ATAPI packet command - 48 C8 wait-for-status ( val mask -- ) \ BSY:0 DRDY:1 DRQ:1 - 6 0 do - packet-cdb i 2 * + \ transfer command block (12 bytes) - w@ - ata-data! \ 6 doublets PIO transfer to device - loop \ copy packet to data-reg - status-check ( -- ) \ status err bit set ? -> display - wait-for-ready ( -- ) \ busy released ? - BEGIN - ata-stat@ 08 and 08 = WHILE \ Data-Request-Bit set ? - r> \ get last target buffer address - read-pio-block \ only if from device requested - >r \ start of next block - REPEAT - r> \ original value - drop \ return clean -; - -: atapi-packet-io ( -- ) - return-buffer atapi-size erase \ clear return buffer - return-buffer send-atapi-packet \ send 'packet-cdb' , get 'return-buffer' -; - - - -\ ******************************** -\ ATAPI packet commands -\ ******************************** - -\ Methods to access atapi disk - -: atapi-test ( -- true|false ) - packet-cdb scsi-build-test-unit-ready \ command-code: 00 - atapi-packet-io ( ) \ send CDB, get return-buffer - ata-stat@ 1 and IF false ELSE true THEN -; - -: atapi-sense ( -- ascq asc sense-key ) - d# 252 packet-cdb scsi-build-request-sense ( alloc-len cdb -- ) - atapi-packet-io ( ) \ send CDB, get return-buffer - return-buffer scsi-get-sense-data ( cdb-addr -- ascq asc sense-key ) -; - -: atapi-read-blocks ( address block# #blocks dev# -- #read-blocks ) - set-regs ( address block# #blocks ) - dup >r ( address block# #blocks ) - packet-cdb scsi-build-read-10 ( address block# #blocks cdb -- ) - send-atapi-packet ( address -- ) - r> \ return requested number of blocks -; - -\ *************************************** -\ read capacity of drive medium -\ use SCSI-Support Package -\ *************************************** -: atapi-read-capacity ( -- ) - packet-cdb scsi-build-read-cap-10 \ fill block with command - atapi-packet-io ( ) \ send CDB, get return-buffer - return-buffer scsi-get-capacity-10 ( cdb -- block-size #blocks ) - .capacity-text ( block-size #blocks -- ) - status-check ( -- ) -; - -\ *************************************** -\ read capacity of drive medium -\ use SCSI-Support Package -\ *************************************** -: atapi-read-capacity-ext ( -- ) - packet-cdb scsi-build-read-cap-16 \ fill block with command - atapi-packet-io ( ) \ send CDB, get return-buffer - return-buffer scsi-get-capacity-16 ( cdb -- block-size #blocks ) - .capacity-text ( block-size #blocks -- ) - status-check ( -- ) -; - - -\ *********************************************** -\ wait until media in drive is ready ( max 5 sec) -\ *********************************************** -: wait-for-media-ready ( -- true|false ) - get-msecs \ initial timer value (start) - >r - BEGIN - atapi-test \ unit ready? false if not - not - no-timeout and - WHILE - atapi-sense ( -- ascq asc sense-key ) - 02 = \ sense key 2 = media error - IF \ check add. sense code - 3A = \ asc: device not ready ? - IF - false to no-timeout - ." empty (" . 29 emit \ show asc qualifier - ELSE - drop \ discard asc qualifier - THEN \ medium not present, abort waiting - ELSE - drop \ discard asc - drop \ discard ascq - THEN - get-msecs r@ - \ calculate timer difference - FFFF AND \ mask-off overflow bits - d# 5000 > \ 5 seconds exceeded ? - IF - false to no-timeout \ set global flag - THEN - REPEAT - r> - drop - no-timeout -; - -\ ****************************************************** -\ Method pointer for read-blocks methods -\ controller implements 2 channels (primary / secondary) -\ for 2 devices each (master / slasve) -\ ****************************************************** -\ 2 channels (primary/secondary) per controller -2 CONSTANT #chan - -\ 2 devices (master/slave) per channel -2 CONSTANT #dev - -\ results in a total of devices -\ connected to a controller with -\ two separate channels (4) -: #totaldev #dev #chan * ; - -CREATE read-blocks-xt #totaldev cells allot read-blocks-xt #totaldev cells erase - -\ Execute read-blocks of device -: dev-read-blocks ( address block# #blocks dev# -- #read-blocks ) - dup cells read-blocks-xt + @ execute -; - -\ ********************************************************** -\ Read device type -\ Signature ATAPI ATA -\ --------------------------------------------- -\ Sector Count 01h 01h -\ Sector Number 01h 01h -\ Cylinder Low 14h 00h -\ Cylinder High EBh 00h -\ Device/Head 00h or 10h 00h or 01h -\ see also ATA/ATAPI errata at: -\ http://suif.stanford.edu/~csapuntz/blackmagic.html -\ ********************************************************** -: read-ident ( -- true|false ) - false - 00 ata-lbal! \ clear previous signature - 00 ata-lbam! - 00 ata-lbah! - cmd#identify-device ata-cmd! wait-for-ready \ first try ATA, ATAPI aborts command - ata-stat@ CF and 48 = - IF - drop true \ cmd accepted, this is a ATA - d# 512 set-lba \ set LBA to sector-length - ELSE \ ATAPI sends signature instead - ata-lbam@ 14 = IF \ cylinder low = 14 ? - ata-lbah@ EB = IF \ cylinder high = EB ? - cmd#device-reset ata-cmd! wait-for-ready \ only supported by ATAPI - cmd#identify-packet-device ata-cmd! wait-for-ready \ first try ata - ata-stat@ CF and 48 = IF - drop true \ replace flag - THEN - THEN - THEN - THEN - dup IF - ata-stat@ 8 AND IF \ data requested (as expected) ? - sector read-pio-block - drop \ discard address end - ELSE - drop false - THEN - THEN - - no-timeout not IF \ check without any timeout ? - drop - false \ no, detection discarded - THEN -; - -scsi-close \ remove scsi commands from word list - - -\ ************************************************* -\ Init controller ( chan 0 and 1 ) -\ device 0 (= master) and device 1 ( = slave) -\ #dev #chan Dev-ID -\ ---------------------- -\ 0 0 0 Master of Channel 0 -\ 0 1 1 Master of Channel 1 -\ 1 0 2 Slave of Channel 0 -\ 1 1 3 Slave of Channel 1 -\ ************************************************* -: find-disks ( -- ) - #chan 0 DO \ check 2 channels (primary & secondary) - #dev 0 DO \ check 2 devices per channel (master / slave) - i 2 * j + - set-regs \ set base address and dev-register for register access - ata-stat@ 7f and 7f <> \ Check, if device is connected - IF - true to no-timeout \ preset timeout-flag - read-ident ( -- true|false ) - IF - i j show-model \ print manufacturer + device string - sector 1+ c@ C0 and 80 = \ Check for ata or atapi - IF - wait-for-media-ready \ wait up to 5 sec if not ready - no-timeout and - IF - atapi-read-capacity - atapi-size to block-size \ ATAPI: 2048 bytes - 80000 to max-transfer - ['] atapi-read-blocks i 2 * j + cells read-blocks-xt + ! - s" cdrom" strdup i 2 * j + s" generic-disk.fs" included - ELSE - ." -" \ show hint for not registered - THEN - ELSE - ata-size to block-size \ ATA: 512 bytes - 80000 to max-transfer - ['] ata-read-blocks i 2 * j + cells read-blocks-xt + ! - s" disk" strdup i 2 * j + s" generic-disk.fs" included - THEN - cr - THEN - THEN - i 2 * j + 200 + cp - LOOP - LOOP -; - -find-disks - diff --git a/qemu/roms/SLOF/slof/fs/instance.fs b/qemu/roms/SLOF/slof/fs/instance.fs deleted file mode 100644 index 9e5c9215e..000000000 --- a/qemu/roms/SLOF/slof/fs/instance.fs +++ /dev/null @@ -1,193 +0,0 @@ -\ ***************************************************************************** -\ * Copyright (c) 2004, 2011 IBM Corporation -\ * All rights reserved. -\ * This program and the accompanying materials -\ * are made available under the terms of the BSD License -\ * which accompanies this distribution, and is available at -\ * http://www.opensource.org/licenses/bsd-license.php -\ * -\ * Contributors: -\ * IBM Corporation - initial implementation -\ ****************************************************************************/ - -\ Support for device node instances. - -0 VALUE my-self - -400 CONSTANT max-instance-size - -STRUCT - /n FIELD instance>node - /n FIELD instance>parent - /n FIELD instance>args - /n FIELD instance>args-len - /n FIELD instance>size - /n FIELD instance>#units - /n FIELD instance>unit1 \ For instance-specific "my-unit" - /n FIELD instance>unit2 - /n FIELD instance>unit3 - /n FIELD instance>unit4 -CONSTANT /instance-header - -: >instance ( offset -- myself+offset ) - my-self 0= ABORT" No instance!" - dup my-self instance>size @ >= ABORT" Instance access out of bounds!" - my-self + -; - -: (create-instance-var) ( initial-value -- ) - get-node - dup node>instance-size @ cell+ max-instance-size - >= ABORT" Instance is bigger than max-instance-size!" - dup node>instance-template @ ( iv phandle tmp-ih ) - swap node>instance-size dup @ ( iv tmp-ih *instance-size instance-size ) - dup , \ compile current instance ptr - swap 1 cells swap +! ( iv tmp-ih instance-size ) - + ! -; - -: create-instance-var ( "name" initial-value -- ) - CREATE (create-instance-var) PREVIOUS -; - -: (create-instance-buf) ( buffersize -- ) - aligned \ align size to multiples of cells - dup get-node node>instance-size @ + ( buffersize' newinstancesize ) - max-instance-size > ABORT" Instance is bigger than max-instance-size!" - get-node node>instance-template @ get-node node>instance-size @ + - over erase \ clear according to IEEE 1275 - get-node node>instance-size @ ( buffersize' old-instance-size ) - dup , \ compile current instance ptr - + get-node node>instance-size ! \ store new size -; - -: create-instance-buf ( "name" buffersize -- ) - CREATE (create-instance-buf) PREVIOUS -; - -VOCABULARY instance-words ALSO instance-words DEFINITIONS - -: VARIABLE 0 create-instance-var DOES> [ here ] @ >instance ; -: VALUE create-instance-var DOES> [ here ] @ >instance @ ; -: DEFER 0 create-instance-var DOES> [ here ] @ >instance @ execute ; -: BUFFER: create-instance-buf DOES> [ here ] @ >instance ; - -PREVIOUS DEFINITIONS - -\ Save XTs of the above instance-words (put on the stack with "[ here ]") -CONSTANT <instancebuffer> -CONSTANT <instancedefer> -CONSTANT <instancevalue> -CONSTANT <instancevariable> - -\ check whether a value or a defer word is an -\ instance word: It must be a CREATE word and -\ the DOES> part must do >instance as first thing - -: (instance?) ( xt -- xt true|false ) - dup @ <create> = IF - dup cell+ @ cell+ @ ['] >instance = - ELSE - false - THEN -; - -\ This word does instance values in compile mode. -\ It corresponds to DOTO from engine.in -: (doito) ( value R:*CFA -- ) - r> cell+ dup >r - @ cell+ cell+ @ >instance ! -; -' (doito) CONSTANT <(doito)> - -: to ( value wordname<> -- ) - ' (instance?) - state @ IF - \ compile mode handling normal or instance value - IF ['] (doito) ELSE ['] DOTO THEN - , , EXIT - THEN - IF - cell+ cell+ @ >instance ! \ interp mode instance value - ELSE - cell+ ! \ interp mode normal value - THEN -; IMMEDIATE - -: behavior ( defer-xt -- contents-xt ) - dup cell+ @ <instancedefer> = IF \ Is defer-xt an INSTANCE DEFER ? - 2 cells + @ >instance @ - ELSE - behavior - THEN -; - -: INSTANCE ALSO instance-words ; - -: my-parent my-self instance>parent @ ; -: my-args my-self instance>args 2@ swap ; - -\ copy args from original instance to new created -: set-my-args ( old-addr len -- ) - dup IF \ IF len > 0 ( old-addr len ) - dup alloc-mem \ | allocate space for new args ( old-addr len new-addr ) - 2dup my-self instance>args 2! \ | write into instance struct ( old-addr len new-addr ) - swap move \ | and copy the args ( ) - ELSE \ ELSE ( old-addr len ) - my-self instance>args 2! \ | set new args to zero, too ( ) - THEN \ FI -; - -\ Current node has already been set, when this is called. -: create-instance-data ( -- instance ) - get-node dup node>instance-template @ ( phandle instance-template ) - swap node>instance-size @ ( instance-template instance-size ) - dup >r - dup alloc-mem dup >r swap move r> ( instance ) - dup instance>size r> swap ! \ Store size for destroy-instance - dup instance>#units 0 swap ! \ Use node unit by default -; -: create-instance ( -- ) - my-self create-instance-data - dup to my-self instance>parent ! - get-node my-self instance>node ! -; - -: destroy-instance ( instance -- ) - dup instance>args @ ?dup IF \ Free instance args? - over instance>args-len @ free-mem - THEN - dup instance>size @ free-mem -; - -: ihandle>phandle ( ihandle -- phandle ) - dup 0= ABORT" no current instance" instance>node @ -; - -: push-my-self ( ihandle -- ) r> my-self >r >r to my-self ; -: pop-my-self ( -- ) r> r> to my-self >r ; -: call-package push-my-self execute pop-my-self ; -: $call-static ( ... str len node -- ??? ) -\ cr ." call for " 3dup -rot type ." on node " . - find-method IF execute ELSE -1 throw THEN -; - -: $call-my-method ( str len -- ) - my-self ihandle>phandle $call-static -; - -: $call-method ( str len ihandle -- ) - push-my-self - ['] $call-my-method CATCH ?dup IF - pop-my-self THROW - THEN - pop-my-self -; - -0 VALUE calling-child - -: $call-parent - my-self ihandle>phandle TO calling-child - my-parent $call-method - 0 TO calling-child -; diff --git a/qemu/roms/SLOF/slof/fs/little-endian.fs b/qemu/roms/SLOF/slof/fs/little-endian.fs deleted file mode 100644 index 6b4779ee0..000000000 --- a/qemu/roms/SLOF/slof/fs/little-endian.fs +++ /dev/null @@ -1,83 +0,0 @@ -\ ***************************************************************************** -\ * Copyright (c) 2004, 2011 IBM Corporation -\ * All rights reserved. -\ * This program and the accompanying materials -\ * are made available under the terms of the BSD License -\ * which accompanies this distribution, and is available at -\ * http://www.opensource.org/licenses/bsd-license.php -\ * -\ * Contributors: -\ * IBM Corporation - initial implementation -\ ****************************************************************************/ - -deadbeef here l! -here c@ de = CONSTANT ?bigendian -here c@ ef = CONSTANT ?littleendian - - -?bigendian [IF] - -: x!-le >r xbflip r> x! ; -: x@-le x@ xbflip ; - -: l!-le >r lbflip r> l! ; -: l@-le l@ lbflip ; - -: w!-le >r wbflip r> w! ; -: w@-le w@ wbflip ; - -: rx!-le >r xbflip r> rx! ; -: rx@-le rx@ xbflip ; - -: rl!-le >r lbflip r> rl! ; -: rl@-le rl@ lbflip ; - -: rw!-le >r wbflip r> rw! ; -: rw@-le rw@ wbflip ; - -: l!-be l! ; -: l@-be l@ ; - -: w!-be w! ; -: w@-be w@ ; - -: rl!-be rl! ; -: rl@-be rl@ ; - -: rw!-be rw! ; -: rw@-be rw@ ; - - -[ELSE] - -: x!-le x! ; -: x@-le x@ ; - -: l!-le l! ; -: l@-le l@ ; - -: w!-le w! ; -: w@-le w@ ; - -: rx!-le rx! ; -: rx@-le rx@ ; - -: rl!-le rl! ; -: rl@-le rl@ ; - -: rw!-le rw! ; -: rw@-le rw@ ; - -: l!-be >r lbflip r> l! ; -: l@-be l@ lbflip ; - -: w!-be >r wbflip r> w! ; -: w@-be w@ wbflip ; - -: rl!-be >r lbflip r> rl! ; -: rl@-be rl@ lbflip ; - -: rw!-be >r wbflip r> rw! ; -: rw@-be rw@ wbflip ; - -[THEN] diff --git a/qemu/roms/SLOF/slof/fs/loaders.fs b/qemu/roms/SLOF/slof/fs/loaders.fs deleted file mode 100644 index 276ba6bca..000000000 --- a/qemu/roms/SLOF/slof/fs/loaders.fs +++ /dev/null @@ -1,94 +0,0 @@ -\ ***************************************************************************** -\ * Copyright (c) 2004, 2008 IBM Corporation -\ * All rights reserved. -\ * This program and the accompanying materials -\ * are made available under the terms of the BSD License -\ * which accompanies this distribution, and is available at -\ * http://www.opensource.org/licenses/bsd-license.php -\ * -\ * Contributors: -\ * IBM Corporation - initial implementation -\ ****************************************************************************/ - -\ \\\\\\\\\\\\\\ Global Data -CREATE bootdevice 2 cells allot bootdevice 2 cells erase -CREATE bootargs 2 cells allot bootargs 2 cells erase -CREATE load-list 2 cells allot load-list 2 cells erase - -: start-elf ( arg len entry -- ) - msr@ 7fffffffffffffff and 2000 or ciregs >srr1 ! call-client -; - -: start-elf64 ( arg len entry r2 -- ) - msr@ 2000 or ciregs >srr1 ! - ciregs >r2 ! - call-client \ entry point is pointer to .opd -; - -: set-bootpath - s" disk" find-alias - dup IF ELSE drop s" boot-device" evaluate find-alias THEN - dup IF strdup ELSE 0 THEN - encode-string s" bootpath" set-chosen -; - -: set-netbootpath - s" net" find-alias - ?dup IF strdup encode-string s" bootpath" set-chosen THEN -; - -: set-bootargs - skipws 0 parse dup 0= IF - 2drop s" boot-file" evaluate - THEN - encode-string s" bootargs" set-chosen -; - -: .(client-exec) ( arg len -- rc ) - s" snk" romfs-lookup 0<> IF - \ Load SNK client 15 MiB after Paflof... FIXME: Hard-coded offset is ugly! - paflof-start f00000 + - elf-load-file-to-addr drop \ FIXME - check this for LE, currently its BE only - dup @ swap 8 + @ \ populate entry r2 - start-elf64 client-data - ELSE - 2drop false - THEN -; -' .(client-exec) to (client-exec) - -: .client-exec ( arg len -- rc ) set-bootargs (client-exec) ; -' .client-exec to client-exec - -: netflash ( -- rc ) s" netflash 2000000 " (parse-line) $cat set-netbootpath - client-exec -; - -: netsave ( "addr len {filename}[,params]" -- rc ) - (parse-line) dup 0> IF - s" netsave " 2swap $cat set-netbootpath client-exec - ELSE - cr - ." Usage: netsave addr len [bootp|dhcp,]filename[,siaddr][,ciaddr][,giaddr][,bootp-retries][,tftp-retries][,use_ci]" - cr 2drop - THEN -; - -: ping ( "{device-path:[device-args,]server-ip,[client-ip],[gateway-ip][,timeout]}" -- ) - my-self >r current-node @ >r \ Save my-self - (parse-line) open-dev dup IF - dup to my-self dup ihandle>phandle set-node - dup - s" ping" rot ['] $call-method CATCH IF - cr - ." Not a pingable device" - cr 3drop - THEN - swap close-dev - ELSE - cr - ." Usage: ping device-path:[device-args,]server-ip,[client-ip],[gateway-ip][,timeout]" - cr drop - THEN - r> set-node r> to my-self \ Restore my-self -; diff --git a/qemu/roms/SLOF/slof/fs/logging.fs b/qemu/roms/SLOF/slof/fs/logging.fs deleted file mode 100644 index 002c48091..000000000 --- a/qemu/roms/SLOF/slof/fs/logging.fs +++ /dev/null @@ -1,45 +0,0 @@ -\ ***************************************************************************** -\ * Copyright (c) 2004, 2008 IBM Corporation -\ * All rights reserved. -\ * This program and the accompanying materials -\ * are made available under the terms of the BSD License -\ * which accompanies this distribution, and is available at -\ * http://www.opensource.org/licenses/bsd-license.php -\ * -\ * Contributors: -\ * IBM Corporation - initial implementation -\ ****************************************************************************/ - -\ Words to write to nvram log - -defer nvramlog-write-byte - -: .nvramlog-write-byte ( byte -- ) -#if defined(DISABLE_NVRAM) || defined(RTAS_NVRAM) - drop -#else - 0 1 asm-cout -#endif -; - -' .nvramlog-write-byte to nvramlog-write-byte - -: nvramlog-write-string ( str len -- ) - dup 0> IF - 0 DO dup c@ - nvramlog-write-byte char+ LOOP - ELSE - drop - THEN drop ; - -: nvramlog-write-number ( number format -- ) - 0 swap <# 0 ?DO # LOOP #> - nvramlog-write-string ; - -: nvramlog-write-string-cr ( str len -- ) - nvramlog-write-string - a nvramlog-write-byte d nvramlog-write-byte ; - -\ as long as dual-emit is enabled -\ the string is written into NVRAM as well!! -: log-string ( str len -- ) type ; diff --git a/qemu/roms/SLOF/slof/fs/node.fs b/qemu/roms/SLOF/slof/fs/node.fs deleted file mode 100644 index 22bf77b6f..000000000 --- a/qemu/roms/SLOF/slof/fs/node.fs +++ /dev/null @@ -1,766 +0,0 @@ -\ ***************************************************************************** -\ * Copyright (c) 2004, 2008 IBM Corporation -\ * All rights reserved. -\ * This program and the accompanying materials -\ * are made available under the terms of the BSD License -\ * which accompanies this distribution, and is available at -\ * http://www.opensource.org/licenses/bsd-license.php -\ * -\ * Contributors: -\ * IBM Corporation - initial implementation -\ ****************************************************************************/ - - -\ Device nodes. - -false VALUE debug-find-component? - -VARIABLE device-tree -VARIABLE current-node -: get-node current-node @ dup 0= ABORT" No active device tree node" ; - -STRUCT - cell FIELD node>peer - cell FIELD node>parent - cell FIELD node>child - cell FIELD node>properties - cell FIELD node>words - cell FIELD node>instance-template - cell FIELD node>instance-size - cell FIELD node>space? - cell FIELD node>space - cell FIELD node>addr1 - cell FIELD node>addr2 - cell FIELD node>addr3 -END-STRUCT - -: find-method ( str len phandle -- false | xt true ) - node>words @ voc-find dup IF link> true THEN ; - -\ Instances. -#include "instance.fs" - -: create-node ( parent -- new ) - max-instance-size alloc-mem ( parent instance-mem ) - dup max-instance-size erase >r ( parent R: instance-mem ) - align wordlist >r wordlist >r ( parent R: instance-mem wl wl ) - here ( parent new R: instance-mem wl wl ) - 0 , swap , 0 , \ Set node>peer, node>parent & node>child - r> , r> , \ Set node>properties & node>words to wl - r> , /instance-header , \ Set instance-template & instance-size - FALSE , 0 , \ Set node>space? and node>space - 0 , 0 , 0 , \ Set node>addr* -; - -: peer node>peer @ ; -: parent node>parent @ ; -: child node>child @ ; -: peer dup IF peer ELSE drop device-tree @ THEN ; - - -: link ( new head -- ) \ link a new node at the end of a linked list - BEGIN dup @ WHILE @ REPEAT ! ; -: link-node ( parent child -- ) - swap dup IF node>child link ELSE drop device-tree ! THEN ; - -\ Set a node as active node. -: set-node ( phandle -- ) - current-node @ IF previous THEN - dup current-node ! - ?dup IF node>words @ also context ! THEN - definitions ; -: get-parent get-node parent ; - - -: new-node ( -- phandle ) \ active node becomes new node's parent; - \ new node becomes active node -\ XXX: change to get-node, handle root node creation specially - current-node @ dup create-node - tuck link-node dup set-node ; - -: finish-node ( -- ) - \ TODO: maybe resize the instance template buffer here (or in finish-device)? - get-node parent set-node -; - -: device-end ( -- ) 0 set-node ; - -\ Properties. -CREATE $indent 100 allot VARIABLE indent 0 indent ! -#include "property.fs" - -\ Unit address. -: #address-cells s" #address-cells" rot parent get-property - ABORT" parent doesn't have a #address-cells property!" - decode-int nip nip -; - -\ my-#address-cells returns the #address-cells property of the parent node. -\ child-#address-cells returns the #address-cells property of the current node. - -\ This is confusing in several ways: Remember that a node's address is always -\ described in the parent's address space, thus the parent's property is taken -\ into regard, rather than the own. - -\ Also, an address-cell here is always a 32bit cell, no matter whether the -\ "real" cell size is 32bit or 64bit. - -: my-#address-cells ( -- #address-cells ) - get-node #address-cells -; - -: child-#address-cells ( -- #address-cells ) - s" #address-cells" get-node get-property - ABORT" node doesn't have a #address-cells property!" - decode-int nip nip -; - -: child-#size-cells ( -- #address-cells ) - s" #size-cells" get-node get-property - ABORT" node doesn't have a #size-cells property!" - decode-int nip nip -; - -: encode-phys ( phys.hi ... phys.low -- prop len ) - encode-first? IF encode-start ELSE here 0 THEN - my-#address-cells 0 ?DO rot encode-int+ LOOP -; - -: encode-child-phys ( phys.hi ... phys.low -- prop len ) - encode-first? IF encode-start ELSE here 0 THEN - child-#address-cells 0 ?DO rot encode-int+ LOOP -; - -: encode-child-size ( size.hi ... size.low -- prop len ) - encode-first? IF encode-start ELSE here 0 THEN - child-#size-cells 0 ?DO rot encode-int+ LOOP -; - -: decode-phys - my-#address-cells BEGIN dup WHILE 1- >r decode-int r> swap >r REPEAT drop - my-#address-cells BEGIN dup WHILE 1- r> swap REPEAT drop ; -: decode-phys-and-drop - my-#address-cells BEGIN dup WHILE 1- >r decode-int r> swap >r REPEAT 3drop - my-#address-cells BEGIN dup WHILE 1- r> swap REPEAT drop ; -: reg >r encode-phys r> encode-int+ s" reg" property ; - - -: >space node>space @ ; -: >space? node>space? @ ; -: >address dup >r #address-cells dup 3 > IF r@ node>addr3 @ swap THEN - dup 2 > IF r@ node>addr2 @ swap THEN - 1 > IF r@ node>addr1 @ THEN r> drop ; -: >unit dup >r >address r> >space ; - -: (my-phandle) ( -- phandle ) - my-self ?dup IF - ihandle>phandle - ELSE - get-node dup 0= ABORT" no active node" - THEN -; - -: my-space ( -- phys.hi ) - (my-phandle) >space -; -: my-address (my-phandle) >address ; - -\ my-unit returns the unit address of the current _instance_ - that means -\ it returns the same values as my-space and my-address together _or_ it -\ returns a unit address that has been set manually while opening the node. -: my-unit - my-self instance>#units @ IF - 0 my-self instance>#units @ 1- DO - my-self instance>unit1 i cells + @ - -1 +LOOP - ELSE - my-self ihandle>phandle >unit - THEN -; - -\ Return lower 64 bit of address -: my-unit-64 ( -- phys.lo+1|phys.lo ) - my-unit ( phys.lo ... phys.hi ) - (my-phandle) #address-cells ( phys.lo ... phys.hi #ad-cells ) - CASE - 1 OF EXIT ENDOF - 2 OF lxjoin EXIT ENDOF - 3 OF drop lxjoin EXIT ENDOF - dup OF 2drop lxjoin EXIT ENDOF - ENDCASE -; - -: set-space get-node dup >r node>space ! true r> node>space? ! ; -: set-address my-#address-cells 1 ?DO - get-node node>space i cells + ! LOOP ; -: set-unit set-space set-address ; -: set-unit-64 ( phys.lo|phys.hi -- ) - my-#address-cells 2 <> IF - ." set-unit-64: #address-cells <> 2 " abort - THEN - xlsplit set-unit -; - -\ Never ever use this in actual code, only when debugging interactively. -\ Thank you. -: set-args ( arg-str len unit-str len -- ) - s" decode-unit" get-parent $call-static set-unit set-my-args -; - -: $cat-unit - dup parent 0= IF drop EXIT THEN - dup >space? not IF drop EXIT THEN - dup >r >unit s" encode-unit" r> parent $call-static - dup IF - dup >r here swap move s" @" $cat here r> $cat - ELSE - 2drop - THEN -; - -: $cat-instance-unit - dup parent 0= IF drop EXIT THEN - \ No instance unit, use node unit - dup instance>#units @ 0= IF - ihandle>phandle $cat-unit - EXIT - THEN - dup >r push-my-self - ['] my-unit CATCH IF pop-my-self r> drop EXIT THEN - pop-my-self - s" encode-unit" - r> ihandle>phandle parent - $call-static - dup IF - dup >r here swap move s" @" $cat here r> $cat - ELSE - 2drop - THEN -; - -\ Getting basic info about a node. -: node>name dup >r s" name" rot get-property IF r> (u.) ELSE 1- r> drop THEN ; -: node>qname dup node>name rot ['] $cat-unit CATCH IF drop THEN ; -: node>path - here 0 rot - BEGIN dup WHILE dup parent REPEAT - 2drop - dup 0= IF [char] / c, THEN - BEGIN - dup - WHILE - [char] / c, node>qname here over allot swap move - REPEAT - drop here 2dup - allot over - -; - -: interposed? ( ihandle -- flag ) - \ We cannot actually detect if an instance is interposed; instead, we look - \ if an instance is part of the "normal" chain that would be opened by - \ open-dev and friends, if there were no interposition. - dup instance>parent @ dup 0= IF 2drop false EXIT THEN - ihandle>phandle swap ihandle>phandle parent <> ; - -: instance>qname - dup >r interposed? IF s" %" ELSE 0 0 THEN - r@ dup ihandle>phandle node>name - rot ['] $cat-instance-unit CATCH IF drop THEN - $cat r> instance>args 2@ swap - dup IF 2>r s" :" $cat 2r> $cat ELSE 2drop THEN -; - -: instance>qpath \ With interposed nodes. - here 0 rot BEGIN dup WHILE dup instance>parent @ REPEAT 2drop - dup 0= IF [char] / c, THEN - BEGIN dup WHILE [char] / c, instance>qname here over allot swap move - REPEAT drop here 2dup - allot over - ; -: instance>path \ Without interposed nodes. - here 0 rot BEGIN dup WHILE - dup interposed? 0= IF dup THEN instance>parent @ REPEAT 2drop - dup 0= IF [char] / c, THEN - BEGIN dup WHILE [char] / c, instance>qname here over allot swap move - REPEAT drop here 2dup - allot over - ; - -: .node node>path type ; -: pwd get-node .node ; - -: .instance instance>qpath type ; -: .chain dup instance>parent @ ?dup IF recurse THEN - cr dup . instance>qname type ; - - -\ Alias helper -defer find-node -: set-alias ( alias-name len device-name len -- ) - encode-string - 2swap s" /aliases" find-node ?dup IF - set-property - ELSE - 4drop - THEN -; - -: find-alias ( alias-name len -- false | dev-path len ) - s" /aliases" find-node dup IF - get-property 0= IF 1- dup 0= IF nip THEN ELSE false THEN - THEN -; - -: .alias ( alias-name len -- ) - find-alias dup IF type ELSE ." no alias available" THEN ; - -: (.print-alias) ( lfa -- ) - link> dup >name name>string - \ Don't print name property - 2dup s" name" string=ci IF 2drop drop - ELSE cr type space ." : " execute type - THEN ; - -: (.list-alias) ( phandle -- ) - node>properties @ cell+ @ BEGIN dup WHILE dup (.print-alias) @ REPEAT drop ; - -: list-alias ( -- ) - s" /aliases" find-node dup IF (.list-alias) THEN ; - -\ return next available name for aliasing or -\ false if more than MAX-ALIAS aliases found -8 CONSTANT MAX-ALIAS -1 VALUE alias-ind -: get-next-alias ( $alias-name -- $next-alias-name|FALSE ) - 2dup find-alias IF - drop - 1 TO alias-ind - BEGIN - 2dup alias-ind $cathex 2dup find-alias - WHILE - drop 2drop - alias-ind 1 + TO alias-ind - alias-ind MAX-ALIAS = IF - 2drop FALSE EXIT - THEN - REPEAT - strdup 2swap 2drop - THEN -; - -: devalias ( "{alias-name}<>{device-specifier}<cr>" -- ) - parse-word parse-word dup IF set-alias - ELSE 2drop dup IF .alias - ELSE 2drop list-alias THEN THEN ; - -\ sub-alias does a single iteration of an alias at the beginning od dev path -\ expression. de-alias will repeat this until all indirect alising is resolved -: sub-alias ( arg-str arg-len -- arg' len' | false ) - 2dup - 2dup [char] / findchar ?dup IF ELSE 2dup [char] : findchar THEN - ( a l a l [p] -1|0 ) IF nip dup ELSE 2drop 0 THEN >r - ( a l l p -- R:p | a l -- R:0 ) - find-alias ?dup IF ( a l a' p' -- R:p | a' l' -- R:0 ) - r@ IF - 2swap r@ - swap r> + swap $cat strdup ( a" l-p+p' -- ) - ELSE - ( a' l' -- R:0 ) r> drop ( a' l' -- ) - THEN - ELSE - ( a l -- R:p | -- R:0 ) r> IF 2drop THEN - false ( 0 -- ) - THEN -; - -: de-alias ( arg-str arg-len -- arg' len' ) - BEGIN - over c@ [char] / <> dup IF drop 2dup sub-alias ?dup THEN - WHILE - 2swap 2drop - REPEAT -; - - -\ Display the device tree. -: +indent ( not-last? -- ) - IF s" | " ELSE s" " THEN $indent indent @ + swap move 4 indent +! ; -: -indent ( -- ) -4 indent +! ; - -: ls-phandle ( node -- ) . ." : " ; - -: ls-node ( node -- ) - cr dup ls-phandle - $indent indent @ type - dup peer IF ." |-- " ELSE ." +-- " THEN - node>qname type -; - -: (ls) ( node -- ) - child BEGIN dup WHILE dup ls-node dup child IF - dup peer +indent dup recurse -indent THEN peer REPEAT drop ; - -: ls ( -- ) - get-node cr - dup ls-phandle - dup node>path type - (ls) - 0 indent ! -; - -: show-devs ( {device-specifier}<eol> -- ) - skipws 0 parse dup IF de-alias ELSE 2drop s" /" THEN ( str len ) - find-node dup 0= ABORT" No such device path" (ls) -; - - -VARIABLE interpose-node -2VARIABLE interpose-args -: interpose ( arg len phandle -- ) interpose-node ! interpose-args 2! ; - - -0 VALUE user-instance-#units -CREATE user-instance-units 4 cells allot - -\ Copy the unit information (specified by the user) that we've found during -\ "find-component" into the current instance data structure -: copy-instance-unit ( -- ) - user-instance-#units IF - user-instance-#units my-self instance>#units ! - user-instance-units my-self instance>unit1 user-instance-#units cells move - 0 to user-instance-#units - THEN -; - - -: open-node ( arg len phandle -- ihandle|0 ) - current-node @ >r my-self >r \ Save current node and instance - set-node create-instance set-my-args - copy-instance-unit - \ Execute "open" method if available, and assume default of - \ success (=TRUE) for nodes without open method: - s" open" get-node find-method IF execute ELSE TRUE THEN - 0= IF - my-self destroy-instance 0 to my-self - THEN - my-self ( ihandle|0 ) - r> to my-self r> set-node \ Restore current node and instance - \ Handle interposition: - interpose-node @ IF - my-self >r to my-self - interpose-args 2@ interpose-node @ - interpose-node off recurse - r> to my-self - THEN -; - -: close-node ( ihandle -- ) - my-self >r to my-self - s" close" ['] $call-my-method CATCH IF 2drop THEN - my-self destroy-instance r> to my-self ; - -: close-dev ( ihandle -- ) - my-self >r to my-self - BEGIN my-self WHILE my-parent my-self close-node to my-self REPEAT - r> to my-self ; - -: new-device ( -- ) - my-self new-node ( parent-ihandle phandle ) - node>instance-template @ ( parent-ihandle ihandle ) - dup to my-self ( parent-ihanlde ihandle ) - instance>parent ! - get-node my-self instance>node ! - max-instance-size my-self instance>size ! -; - -: finish-device ( -- ) - \ Set unit address to first entry of reg property if it has not been set yet - get-node >space? 0= IF - s" reg" get-node get-property 0= IF - decode-int set-space 2drop - THEN - THEN - finish-node my-parent to my-self -; - -\ Set the instance template as current instance for extending it -\ (i.e. to be able to declare new INSTANCE VARIABLEs etc. there) -: extend-device ( phandle -- ) - my-self >r - dup set-node - node>instance-template @ - dup to my-self - r> swap instance>parent ! -; - -: split ( str len char -- left len right len ) - >r 2dup r> findchar IF >r over r@ 2swap r> 1+ /string ELSE 0 0 THEN ; -: generic-decode-unit ( str len ncells -- addr.lo ... addr.hi ) - dup >r -rot BEGIN r@ WHILE r> 1- >r [char] , split 2swap - $number IF 0 THEN r> swap >r >r REPEAT r> 3drop - BEGIN dup WHILE 1- r> swap REPEAT drop ; -: generic-encode-unit ( addr.lo ... addr.hi ncells -- str len ) - 0 0 rot ?dup IF 0 ?DO rot (u.) $cat s" ," $cat LOOP 1- THEN ; -: hex-decode-unit ( str len ncells -- addr.lo ... addr.hi ) - base @ >r hex generic-decode-unit r> base ! ; -: hex-encode-unit ( addr.lo ... addr.hi ncells -- str len ) - base @ >r hex generic-encode-unit r> base ! ; - -: hex64-decode-unit ( str len ncells -- addr.lo ... addr.hi ) - dup 2 <> IF - hex-decode-unit - ELSE - drop - base @ >r hex - $number IF 0 0 ELSE xlsplit THEN - r> base ! - THEN -; - -: hex64-encode-unit ( addr.lo ... addr.hi ncells -- str len ) - dup 2 <> IF - hex-encode-unit - ELSE - drop - base @ >r hex - lxjoin (u.) - r> base ! - THEN -; - -: handle-leading-/ ( path len -- path' len' ) - dup IF over c@ [char] / = IF 1 /string device-tree @ set-node THEN THEN ; -: match-name ( name len node -- match? ) - over 0= IF 3drop true EXIT THEN - s" name" rot get-property IF 2drop false EXIT THEN - 1- string=ci ; \ XXX should use decode-string - -0 VALUE #search-unit -CREATE search-unit 4 cells allot - -: match-unit ( node -- match? ) - \ A node with no space is a wildcard and will always match - dup >space? IF - node>space search-unit #search-unit 0 ?DO 2dup @ swap @ <> IF - 2drop false UNLOOP EXIT THEN cell+ swap cell+ swap LOOP 2drop true - ELSE drop true THEN -; -: match-node ( name len node -- match? ) - dup >r match-name r> match-unit and ; \ XXX e3d -: find-kid ( name len -- node|0 ) - dup -1 = IF \ are we supposed to stay in the same node? -> resolve-relatives - 2drop get-node - ELSE - get-node child >r BEGIN r@ WHILE 2dup r@ match-node - IF 2drop r> EXIT THEN r> peer >r REPEAT - r> 3drop false - THEN ; - -: set-search-unit ( unit len -- ) - 0 to #search-unit - 0 to user-instance-#units - dup 0= IF 2drop EXIT THEN - s" #address-cells" get-node get-property THROW - decode-int to #search-unit 2drop - s" decode-unit" get-node $call-static - #search-unit 0 ?DO search-unit i cells + ! LOOP -; - -: resolve-relatives ( path len -- path' len' ) - \ handle .. - 2dup 2 = swap s" .." comp 0= and IF - get-node parent ?dup IF - set-node drop -1 - ELSE - s" Already in root node." type - THEN - THEN - \ handle . - 2dup 1 = swap c@ [CHAR] . = and IF - drop -1 - THEN -; - -\ XXX This is an old hack that allows wildcard nodes to work -\ by not having a #address-cells in the parent and no -\ decode unit. This should be removed. -\ (It appears to be still used on js2x) -: set-instance-unit ( unitaddr len -- ) - dup 0= IF 2drop 0 to user-instance-#units EXIT THEN - 2dup 0 -rot bounds ?DO - i c@ [char] , = IF 1+ THEN \ Count the commas - LOOP - 1+ dup to user-instance-#units - hex-decode-unit - user-instance-#units 0 ?DO - user-instance-units i cells + ! - LOOP -; - -: split-component ( path. -- path'. args. name. unit. ) - [char] / split 2swap ( path'. component. ) - [char] : split 2swap ( path'. args. name@unit. ) - [char] @ split ( path'. args. name. unit. ) -; - -: find-component ( path len -- path' len' args len node|0 ) - debug-find-component? IF - ." find-component for " 2dup type cr - THEN - split-component ( path'. args. name. unit. ) - debug-find-component? IF - ." -> unit =" 2dup type cr - ." -> stack =" .s cr - THEN - ['] set-search-unit CATCH IF - \ XXX: See comment in set-instance-unit - ." WARNING: Obsolete old wildcard hack " .s cr - set-instance-unit - THEN - resolve-relatives find-kid ( path' len' args len node|0 ) - - \ If resolve returned a wildcard node, and we haven't hit - \ the above gross hack then copy the unit - dup IF dup >space? not #search-unit 0 > AND user-instance-#units 0= AND IF - #search-unit dup to user-instance-#units 0 ?DO - search-unit i cells + @ user-instance-units i cells + ! - LOOP - THEN THEN - - \ XXX This can go away with the old wildcard hack - dup IF dup >space? user-instance-#units 0 > AND IF - \ User supplied a unit value, but node also has different physical unit - cr ." find-component with unit mismatch!" .s cr - drop 0 - THEN THEN -; - -: .find-node ( path len -- phandle|0 ) - current-node @ >r - handle-leading-/ current-node @ 0= IF 2drop r> set-node 0 EXIT THEN - BEGIN dup WHILE \ handle one component: - find-component ( path len args len node ) dup 0= IF - 3drop 2drop r> set-node 0 EXIT THEN - set-node 2drop REPEAT 2drop - get-node r> set-node ; -' .find-node to find-node -: find-node ( path len -- phandle|0 ) de-alias find-node ; - -: delete-node ( phandle -- ) - dup node>instance-template @ max-instance-size free-mem - dup node>parent @ node>child @ ( phandle 1st peer ) - 2dup = IF - node>peer @ swap node>parent @ node>child ! - EXIT - THEN - dup node>peer @ - BEGIN - 2 pick 2dup <> - WHILE - drop - nip dup node>peer @ - dup 0= IF 2drop drop unloop EXIT THEN - REPEAT - drop - node>peer @ swap node>peer ! - drop -; - -: open-dev ( path len -- ihandle|0 ) - 0 to user-instance-#units - de-alias current-node @ >r - handle-leading-/ current-node @ 0= IF 2drop r> set-node 0 EXIT THEN - my-self >r - 0 to my-self - 0 0 >r >r - BEGIN - dup - WHILE \ handle one component: - ( arg len ) r> r> get-node open-node to my-self - find-component ( path len args len node ) dup 0= IF - 3drop 2drop my-self close-dev - r> to my-self - r> set-node - 0 EXIT - THEN - set-node - >r >r - REPEAT - 2drop - \ open final node - r> r> get-node open-node to my-self - my-self r> to my-self r> set-node -; - -: select-dev open-dev dup to my-self ihandle>phandle set-node ; -: unselect-dev my-self close-dev 0 to my-self device-end ; - -: find-device ( str len -- ) \ set as active node - find-node dup 0= ABORT" No such device path" set-node ; -: dev parse-word find-device ; - -: (lsprop) ( node --) - dup cr $indent indent @ type ." node: " node>qname type - false +indent (.properties) cr -indent -; -: (show-children) ( node -- ) - child BEGIN - dup - WHILE - dup (lsprop) dup child IF false +indent dup recurse -indent THEN peer - REPEAT - drop -; -: lsprop ( {device-specifier}<eol> -- ) - skipws 0 parse dup IF de-alias ELSE 2drop s" /" THEN - find-device get-node dup dup - cr ." node: " node>path type (.properties) cr (show-children) - 0 indent ! -; - - -\ node>path does not allot the memory, since it is internally only used -\ for typing. -\ The external variant needs to allot memory ! - -: (node>path) node>path ; - -: node>path ( phandle -- str len ) - node>path dup allot -; - -\ Support for support packages. - -\ The /packages node. -0 VALUE packages - -\ Find a support package (or arbitrary nodes when name is absolute) -: find-package ( name len -- false | phandle true ) - dup 0 <= IF - 2drop FALSE EXIT - THEN - \ According to IEEE 1275 Proposal 215 (Extensible Client Services Package), - \ the find-package method can be used to get the phandle of arbitrary nodes - \ (i.e. not only support packages) when the name starts with a slash. - \ Some FCODE programs depend on this behavior so let's support this, too! - over c@ [char] / = IF - find-node dup IF TRUE THEN EXIT - THEN - \ Ok, let's look for support packages instead. We can't use the standard - \ find-node stuff, as we are required to find the newest (i.e., last in our - \ tree) matching package, not just any. - 0 >r packages child - BEGIN - dup - WHILE - dup >r node>name 2over string=ci r> swap IF - r> drop dup >r - THEN - peer - REPEAT - 3drop - r> dup IF true THEN -; - -: open-package ( arg len phandle -- ihandle | 0 ) open-node ; -: close-package ( ihandle -- ) close-node ; -: $open-package ( arg len name len -- ihandle | 0 ) - find-package IF open-package ELSE 2drop false THEN ; - - -\ device tree translate-address -#include <translate.fs> diff --git a/qemu/roms/SLOF/slof/fs/nvram.fs b/qemu/roms/SLOF/slof/fs/nvram.fs deleted file mode 100644 index 5ea58d17f..000000000 --- a/qemu/roms/SLOF/slof/fs/nvram.fs +++ /dev/null @@ -1,182 +0,0 @@ -\ ***************************************************************************** -\ * Copyright (c) 2004, 2014 IBM Corporation -\ * All rights reserved. -\ * This program and the accompanying materials -\ * are made available under the terms of the BSD License -\ * which accompanies this distribution, and is available at -\ * http://www.opensource.org/licenses/bsd-license.php -\ * -\ * Contributors: -\ * IBM Corporation - initial implementation -\ ****************************************************************************/ - -51 CONSTANT nvram-partition-type-cpulog -\ types 53-55 are omitted because they have been used for -\ storing binary tables in the past -60 CONSTANT nvram-partition-type-sas -61 CONSTANT nvram-partition-type-sms -6e CONSTANT nvram-partition-type-debug -6f CONSTANT nvram-partition-type-history -70 CONSTANT nvram-partition-type-common -7f CONSTANT nvram-partition-type-freespace -a0 CONSTANT nvram-partition-type-linux - -: rztype ( str len -- ) \ stop at zero byte, read with nvram-c@ - 0 DO - dup i + nvram-c@ ?dup IF ( str char ) - emit - ELSE ( str ) - drop UNLOOP EXIT - THEN - LOOP -; - -create tmpStr 500 allot -: rzcount ( zstr -- str len ) - dup tmpStr >r BEGIN - dup nvram-c@ dup r> dup 1+ >r c! - WHILE - char+ - REPEAT - r> drop over - swap drop tmpStr swap -; - -: calc-header-cksum ( offset -- cksum ) - dup nvram-c@ - 10 2 DO - over I + nvram-c@ + - LOOP - wbsplit + nip -; - -: bad-header? ( offset -- flag ) - dup 2+ nvram-w@ ( offset length ) - 0= IF ( offset ) - drop true EXIT ( ) - THEN - dup calc-header-cksum ( offset checksum' ) - swap 1+ nvram-c@ ( checksum ' checksum ) - <> ( flag ) -; - -: .header ( offset -- ) - cr ( offset ) - dup bad-header? IF ( offset ) - ." BAD HEADER -- trying to print it anyway" cr - THEN - space ( offset ) - \ print type - dup nvram-c@ 2 0.r ( offset ) - space space ( offset ) - \ print length - dup 2+ nvram-w@ 10 * 5 .r ( offset ) - space space ( offset ) - \ print name - 4 + 0c rztype ( ) -; - -: .headers ( -- ) - cr cr ." Type Size Name" - cr ." ========================" - 0 BEGIN ( offset ) - dup nvram-c@ ( offset type ) - WHILE - dup .header ( offset ) - dup 2+ nvram-w@ 10 * + ( offset offset' ) - dup nvram-size < IF ( offset ) - ELSE - drop EXIT ( ) - THEN - REPEAT - drop ( ) - cr cr -; - -: reset-nvram ( -- ) - internal-reset-nvram -; - -: dump-partition ['] nvram-c@ 1 (dump) ; - -: type-no-zero ( addr len -- ) - 0 DO - dup I + dup nvram-c@ 0= IF drop ELSE nvram-c@ emit THEN - LOOP - drop -; - -: type-no-zero-part ( from-str cnt-str addr len ) - 0 DO - dup i + dup nvram-c@ 0= IF - drop - ELSE - ( from-str cnt-str addr addr+i ) - ( from-str==0 AND cnt-str > 0 ) - 3 pick 0= 3 pick 0 > AND IF - dup 1 type-no-zero - THEN - - nvram-c@ a = IF - 2 pick 0= IF - over 1- 0 max - rot drop swap - THEN - 2 pick 1- 0 max - 3 roll drop rot rot - ( from-str-- cnt-str-- addr addr+i ) - THEN - THEN - LOOP - drop -; - -: (dmesg-prepare) ( base-addr -- base-addr' addr len act-off ) - 10 - \ go back to header - dup 14 + nvram-l@ dup >r - ( base-addr act-off ) ( R: act-off ) - over over over + swap 10 + nvram-w@ + >r - ( base-addr act-off ) ( R: act-off nvram-act-addr ) - over 2 + nvram-w@ 10 * swap - over swap - ( base-addr base-addr start-size ) ( R: act-off nvram-act-addr ) - r> swap rot 10 + nvram-w@ - r> -; - -: .dmesg ( base-addr -- ) - (dmesg-prepare) >r - ( base-addr addr len ) - cr type-no-zero - ( base-addr ) ( R: act-off ) - dup 10 + nvram-w@ + r> type-no-zero -; - -: .dmesg-part ( from-str cnt-str base-addr -- ) - (dmesg-prepare) >r - ( from-str cnt-str base-addr addr len ) - >r >r -rot r> r> - ( base-addr from-str cnt-str addr len ) - cr type-no-zero-part rot - ( base-addr ) ( R: act-off ) - dup 10 + nvram-w@ + r> type-no-zero-part -; - -: dmesg-part ( from-str cnt-str -- left-from-str left-cnt-str ) - 2dup - s" ibm,CPU0log" get-named-nvram-partition IF - 2drop EXIT - THEN - drop .dmesg-part nip nip -; - -: dmesg2 ( -- ) - s" ibm,CPU1log" get-named-nvram-partition IF - ." No log partition." cr EXIT - THEN - drop .dmesg -; - -: dmesg ( -- ) - s" ibm,CPU0log" get-named-nvram-partition IF - ." No log partition." cr EXIT - THEN - drop .dmesg -; diff --git a/qemu/roms/SLOF/slof/fs/packages.fs b/qemu/roms/SLOF/slof/fs/packages.fs deleted file mode 100644 index f640d8f61..000000000 --- a/qemu/roms/SLOF/slof/fs/packages.fs +++ /dev/null @@ -1,52 +0,0 @@ -\ ***************************************************************************** -\ * Copyright (c) 2004, 2015 IBM Corporation -\ * All rights reserved. -\ * This program and the accompanying materials -\ * are made available under the terms of the BSD License -\ * which accompanies this distribution, and is available at -\ * http://www.opensource.org/licenses/bsd-license.php -\ * -\ * Contributors: -\ * IBM Corporation - initial implementation -\ ****************************************************************************/ - - -\ ============================================================================= -\ SUPPORT PACKAGES -\ ============================================================================= - - -s" packages" device-name -get-node to packages - -\ new-device -\ #include "packages/filler.fs" -\ finish-device - -new-device -#include "packages/deblocker.fs" -finish-device - -new-device -#include "packages/disk-label.fs" -finish-device - -new-device -#include "packages/fat-files.fs" -finish-device - -new-device -#include "packages/rom-files.fs" -finish-device - -new-device -#include "packages/ext2-files.fs" -finish-device - -new-device -#include "packages/obp-tftp.fs" -finish-device - -new-device -#include "packages/iso-9660.fs" -finish-device diff --git a/qemu/roms/SLOF/slof/fs/packages/deblocker.fs b/qemu/roms/SLOF/slof/fs/packages/deblocker.fs deleted file mode 100644 index 83cd71278..000000000 --- a/qemu/roms/SLOF/slof/fs/packages/deblocker.fs +++ /dev/null @@ -1,70 +0,0 @@ -\ ***************************************************************************** -\ * Copyright (c) 2004, 2008 IBM Corporation -\ * All rights reserved. -\ * This program and the accompanying materials -\ * are made available under the terms of the BSD License -\ * which accompanies this distribution, and is available at -\ * http://www.opensource.org/licenses/bsd-license.php -\ * -\ * Contributors: -\ * IBM Corporation - initial implementation -\ ****************************************************************************/ - - -\ ============================================================================= -\ ============================================================================= - - -\ The deblocker. Allows block devices to be used as a (seekable) byte device. - -s" deblocker" device-name - -INSTANCE VARIABLE offset -INSTANCE VARIABLE block-size -INSTANCE VARIABLE max-transfer -INSTANCE VARIABLE my-block -INSTANCE VARIABLE adr -INSTANCE VARIABLE len -INSTANCE VARIABLE fail-count - -: open - s" block-size" ['] $call-parent CATCH IF 2drop false EXIT THEN - block-size ! - s" max-transfer" ['] $call-parent CATCH IF 2drop false EXIT THEN - max-transfer ! - block-size @ alloc-mem my-block ! - 0 offset ! - true ; -: close my-block @ block-size @ free-mem ; - -: seek ( lo hi -- status ) \ XXX: perhaps we should fail if the underlying - \ device would fail at this offset - lxjoin offset ! 0 ; -: block+remainder ( -- block# remainder ) offset @ block-size @ u/mod swap ; -: read-blocks ( addr block# #blocks -- actual ) s" read-blocks" $call-parent ; -: read ( addr len -- actual ) - dup >r len ! adr ! - \ First, handle a partial block at the start. - block+remainder dup IF ( block# offset-in-block ) - >r my-block @ swap 1 read-blocks drop - my-block @ r@ + adr @ block-size @ r> - len @ min dup >r move - r> dup negate len +! dup adr +! offset +! ELSE 2drop THEN - - \ Now, in a loop read max. max-transfer sized runs of whole blocks. - 0 fail-count ! - BEGIN len @ block-size @ >= WHILE - adr @ block+remainder drop len @ max-transfer @ min block-size @ / read-blocks - dup 0= IF - 1 fail-count +! - fail-count @ 5 >= IF r> drop EXIT THEN - ELSE - 0 fail-count ! - THEN - block-size @ * dup negate len +! dup adr +! offset +! - REPEAT - - \ And lastly, handle a partial block at the end. - len @ IF my-block @ block+remainder drop 1 read-blocks drop - my-block @ adr @ len @ move THEN - - r> ; diff --git a/qemu/roms/SLOF/slof/fs/packages/disk-label.fs b/qemu/roms/SLOF/slof/fs/packages/disk-label.fs deleted file mode 100644 index e034d6408..000000000 --- a/qemu/roms/SLOF/slof/fs/packages/disk-label.fs +++ /dev/null @@ -1,710 +0,0 @@ -\ ***************************************************************************** -\ * Copyright (c) 2004, 2008 IBM Corporation -\ * All rights reserved. -\ * This program and the accompanying materials -\ * are made available under the terms of the BSD License -\ * which accompanies this distribution, and is available at -\ * http://www.opensource.org/licenses/bsd-license.php -\ * -\ * Contributors: -\ * IBM Corporation - initial implementation -\ ****************************************************************************/ - - -\ Set debug-disk-label? to true to get debug messages for the disk-label code. -false VALUE debug-disk-label? - -\ This value defines the maximum number of blocks (512b) to load from a PREP -\ partition. This is required to keep the load time in reasonable limits if the -\ PREP partition becomes big. -\ If we ever want to put a large kernel with initramfs from a PREP partition -\ we might need to increase this value. The default value is 65536 blocks (32MB) -d# 65536 value max-prep-partition-blocks -d# 4096 CONSTANT block-array-size - -s" disk-label" device-name - -0 INSTANCE VALUE partition -0 INSTANCE VALUE part-offset -0 INSTANCE VALUE disk-chrp-boot - -0 INSTANCE VALUE part-start -0 INSTANCE VALUE lpart-start -0 INSTANCE VALUE part-size -0 INSTANCE VALUE dos-logical-partitions - -0 INSTANCE VALUE block-size -0 INSTANCE VALUE block - -0 INSTANCE VALUE args -0 INSTANCE VALUE args-len - -0 INSTANCE VALUE gpt-part-size -0 INSTANCE VALUE seek-pos - - -INSTANCE VARIABLE block# \ variable to store logical sector# -INSTANCE VARIABLE hit# \ partition counter -INSTANCE VARIABLE success-flag - -\ ISO9660 specific information -0ff constant END-OF-DESC -3 constant PARTITION-ID -48 constant VOL-PART-LOC - - -\ DOS partition label (MBR) specific structures - -STRUCT - 1b8 field mbr>boot-loader - /l field mbr>disk-signature - /w field mbr>null - 40 field mbr>partition-table - /w field mbr>magic - -CONSTANT /mbr - -STRUCT - /c field part-entry>active - /c field part-entry>start-head - /c field part-entry>start-sect - /c field part-entry>start-cyl - /c field part-entry>id - /c field part-entry>end-head - /c field part-entry>end-sect - /c field part-entry>end-cyl - /l field part-entry>sector-offset - /l field part-entry>sector-count - -CONSTANT /partition-entry - -STRUCT - 8 field gpt>signature - 4 field gpt>revision - 4 field gpt>header-size - 4 field gpt>header-crc32 - 4 field gpt>reserved - 8 field gpt>current-lba - 8 field gpt>backup-lba - 8 field gpt>first-lba - 8 field gpt>last-lba - 10 field gpt>disk-guid - 8 field gpt>part-entry-lba - 4 field gpt>num-part-entry - 4 field gpt>part-entry-size - 4 field gpt>part-array-crc32 - 1a4 field gpt>reserved - -CONSTANT /gpt-header - -STRUCT - 10 field gpt-part-entry>part-type-guid - 10 field gpt-part-entry>part-guid - 8 field gpt-part-entry>first-lba - 8 field gpt-part-entry>last-lba - 8 field gpt-part-entry>attribute - 48 field gpt-part-entry>part-name - -CONSTANT /gpt-part-entry - -\ Defined by IEEE 1275-1994 (3.8.1) - -: offset ( d.rel -- d.abs ) - part-offset xlsplit d+ -; - -: seek ( pos.lo pos.hi -- status ) - offset - debug-disk-label? IF 2dup ." seek-parent: pos.hi=0x" u. ." pos.lo=0x" u. THEN - s" seek" $call-parent - debug-disk-label? IF dup ." status=" . cr THEN -; - -: read ( addr len -- actual ) - debug-disk-label? IF 2dup swap ." read-parent: addr=0x" u. ." len=" .d THEN - s" read" $call-parent - debug-disk-label? IF dup ." actual=" .d cr THEN -; - - -\ read sector to array "block" -: read-sector ( sector-number -- ) - \ block-size is 0x200 on disks, 0x800 on cdrom drives - block-size * 0 seek drop \ seek to sector - block block-size read drop \ read sector -; - -: (.part-entry) ( part-entry ) - cr ." part-entry>active: " dup part-entry>active c@ .d - cr ." part-entry>start-head: " dup part-entry>start-head c@ .d - cr ." part-entry>start-sect: " dup part-entry>start-sect c@ .d - cr ." part-entry>start-cyl: " dup part-entry>start-cyl c@ .d - cr ." part-entry>id: " dup part-entry>id c@ .d - cr ." part-entry>end-head: " dup part-entry>end-head c@ .d - cr ." part-entry>end-sect: " dup part-entry>end-sect c@ .d - cr ." part-entry>end-cyl: " dup part-entry>end-cyl c@ .d - cr ." part-entry>sector-offset: " dup part-entry>sector-offset l@-le .d - cr ." part-entry>sector-count: " dup part-entry>sector-count l@-le .d - cr -; - -: (.name) r@ begin cell - dup @ <colon> = UNTIL xt>name cr type space ; - -: init-block ( -- ) - s" block-size" ['] $call-parent CATCH IF ABORT" parent has no block-size." THEN - to block-size - block-array-size alloc-mem - dup block-array-size erase - to block - debug-disk-label? IF - ." init-block: block-size=" block-size .d ." block=0x" block u. cr - THEN -; - -: partition>part-entry ( partition -- part-entry ) - 1- /partition-entry * block mbr>partition-table + -; - -: partition>start-sector ( partition -- sector-offset ) - partition>part-entry part-entry>sector-offset l@-le -; - -\ This word returns true if the currently loaded block has _NO_ MBR magic -: no-mbr? ( -- true|false ) - 0 read-sector - 1 partition>part-entry part-entry>id c@ ee = IF TRUE EXIT THEN \ GPT partition found - block mbr>magic w@-le aa55 <> -; - -\ This word returns true if the currently loaded block has _NO_ GPT partition id -: no-gpt? ( -- true|false ) - 0 read-sector - 1 partition>part-entry part-entry>id c@ ee <> IF true EXIT THEN - block mbr>magic w@-le aa55 <> -; - -: pc-extended-partition? ( part-entry-addr -- true|false ) - part-entry>id c@ ( id ) - dup 5 = swap ( true|false id ) - dup f = swap ( true|false true|false id ) - 85 = ( true|false true|false true|false ) - or or ( true|false ) -; - -: count-dos-logical-partitions ( -- #logical-partitions ) - no-mbr? IF 0 EXIT THEN - 0 5 1 DO ( current ) - i partition>part-entry ( current part-entry ) - dup pc-extended-partition? IF - part-entry>sector-offset l@-le ( current sector ) - dup to part-start to lpart-start ( current ) - BEGIN - part-start read-sector \ read EBR - 1 partition>start-sector IF - \ ." Logical Partition found at " part-start .d cr - 1+ - THEN \ another logical partition - 2 partition>start-sector - ( current relative-sector ) - ?dup IF lpart-start + to part-start false ELSE true THEN - UNTIL - ELSE - drop - THEN - LOOP -; - -: (get-dos-partition-params) ( ext-part-start part-entry -- offset count active? id ) - dup part-entry>sector-offset l@-le rot + swap ( offset part-entry ) - dup part-entry>sector-count l@-le swap ( offset count part-entry ) - dup part-entry>active c@ 80 = swap ( offset count active? part-entry ) - part-entry>id c@ ( offset count active? id ) -; - -: find-dos-partition ( partition# -- false | offset count active? id true ) - to partition 0 to part-start 0 to part-offset - - \ no negative partitions - partition 0<= IF 0 to partition false EXIT THEN - - \ load MBR and check it - no-mbr? IF 0 to partition false EXIT THEN - - partition 4 <= IF \ Is this a primary partition? - 0 partition partition>part-entry - (get-dos-partition-params) - \ FIXME sanity checks? - true EXIT - ELSE - partition 4 - 0 5 1 DO ( logical-partition current ) - i partition>part-entry ( log-part current part-entry ) - dup pc-extended-partition? IF - part-entry>sector-offset l@-le ( log-part current sector ) - dup to part-start to lpart-start ( log-part current ) - BEGIN - part-start read-sector \ read EBR - 1 partition>start-sector IF \ first partition entry - 1+ 2dup = IF ( log-part current ) - 2drop - part-start 1 partition>part-entry - (get-dos-partition-params) - true UNLOOP EXIT - THEN - 2 partition>start-sector - ( log-part current relative-sector ) - - ?dup IF lpart-start + to part-start false ELSE true THEN - ELSE - true - THEN - UNTIL - ELSE - drop - THEN - LOOP - 2drop false - THEN -; - -: try-dos-partition ( -- okay? ) - \ Read partition table and check magic. - no-mbr? IF - debug-disk-label? IF cr ." No DOS disk-label found." cr THEN - false EXIT - THEN - - count-dos-logical-partitions TO dos-logical-partitions - - debug-disk-label? IF - ." Found " dos-logical-partitions .d ." logical partitions" cr - ." Partition = " partition .d cr - THEN - - partition 1 5 dos-logical-partitions + - within 0= IF - cr ." Partition # not 1-" 4 dos-logical-partitions + . cr false EXIT - THEN - - \ Could/should check for valid partition here... the magic is not enough really. - - \ Get the partition offset. - - partition find-dos-partition IF - ( offset count active? id ) - 2drop - to part-size - block-size * to part-offset - true - ELSE - false - THEN -; - -\ Check for an ISO-9660 filesystem on the disk -\ : try-iso9660-partition ( -- true|false ) -\ implement me if you can ;-) -\ ; - - -\ Check for an ISO-9660 filesystem on the disk -\ (cf. CHRP IEEE 1275 spec., chapter 11.1.2.3) -: has-iso9660-filesystem ( -- TRUE|FALSE ) - \ Seek to the beginning of logical 2048-byte sector 16 - \ refer to Chapter C.11.1 in PAPR 2.0 Spec - \ was: 10 read-sector, but this might cause trouble if you - \ try booting an ISO image from a device with 512b sectors. - 10 800 * 0 seek drop \ seek to sector - block 800 read drop \ read sector - \ Check for CD-ROM volume magic: - block c@ 1 = - block 1+ 5 s" CD001" str= - and - dup IF 800 to block-size THEN -; - - -\ Load from first active DOS boot partition. - -: fat-bootblock? ( addr -- flag ) - \ byte 0-2 of the bootblock is a jump instruction in - \ all FAT filesystems. - \ e9 and eb are jump instructions in x86 assembler. - dup c@ e9 = IF drop true EXIT THEN - dup c@ eb = swap 2+ c@ 90 = and -; - -\ NOTE: block-size is always 512 bytes for DOS partition tables. - -: load-from-dos-boot-partition ( addr -- size ) - no-mbr? IF drop FALSE EXIT THEN \ read MBR and check for DOS disk-label magic - - count-dos-logical-partitions TO dos-logical-partitions - - debug-disk-label? IF - ." Found " dos-logical-partitions .d ." logical partitions" cr - ." Partition = " partition .d cr - THEN - - \ Now walk through the partitions: - 5 dos-logical-partitions + 1 DO - \ ." checking partition " i . - i find-dos-partition IF ( addr offset count active? id ) - 41 = and ( addr offset count prep-boot-part? ) - IF ( addr offset count ) - max-prep-partition-blocks min \ reduce load size - swap ( addr count offset ) - block-size * to part-offset - 0 0 seek drop ( addr offset ) - block-size * read ( size ) - UNLOOP EXIT - ELSE - 2drop ( addr ) - THEN - THEN - LOOP - drop 0 -; - -\ Check for GPT PReP partition GUID. Only first 3 blocks are -\ byte-swapped treating last two blocks as contigous for simplifying -\ comparison -9E1A2D38 CONSTANT GPT-PREP-PARTITION-1 -C612 CONSTANT GPT-PREP-PARTITION-2 -4316 CONSTANT GPT-PREP-PARTITION-3 -AA268B49521E5A8B CONSTANT GPT-PREP-PARTITION-4 - -: gpt-prep-partition? ( -- true|false ) - block gpt-part-entry>part-type-guid - dup l@-le GPT-PREP-PARTITION-1 <> IF drop false EXIT THEN - dup 4 + w@-le GPT-PREP-PARTITION-2 <> IF drop false EXIT THEN - dup 6 + w@-le GPT-PREP-PARTITION-3 <> IF drop false EXIT THEN - 8 + x@ GPT-PREP-PARTITION-4 = -; - -\ Check for GPT MSFT BASIC DATA GUID - fat based -EBD0A0A2 CONSTANT GPT-BASIC-DATA-PARTITION-1 -B9E5 CONSTANT GPT-BASIC-DATA-PARTITION-2 -4433 CONSTANT GPT-BASIC-DATA-PARTITION-3 -87C068B6B72699C7 CONSTANT GPT-BASIC-DATA-PARTITION-4 - -: gpt-basic-data-partition? ( -- true|false ) - block gpt-part-entry>part-type-guid - dup l@-le GPT-BASIC-DATA-PARTITION-1 <> IF drop false EXIT THEN - dup 4 + w@-le GPT-BASIC-DATA-PARTITION-2 <> IF drop false EXIT THEN - dup 6 + w@-le GPT-BASIC-DATA-PARTITION-3 <> IF drop false EXIT THEN - 8 + x@ GPT-BASIC-DATA-PARTITION-4 = -; - -\ -\ GPT Signature -\ ("EFI PART", 45h 46h 49h 20h 50h 41h 52h 54h) -\ -4546492050415254 CONSTANT GPT-SIGNATURE - -\ The routine checks whether the protective MBR has GPT ID and then -\ reads the gpt data from the sector. Also set the seek position and -\ the partition size used in caller routines. - -: get-gpt-partition ( -- true|false ) - no-gpt? IF false EXIT THEN - debug-disk-label? IF cr ." GPT partition found " cr THEN - 1 read-sector - block gpt>part-entry-lba x@-le - block-size * to seek-pos - block gpt>part-entry-size l@-le to gpt-part-size - gpt-part-size block-array-size > IF - cr ." GPT part size exceeds buffer allocated " cr - false exit - THEN - block gpt>signature x@ GPT-SIGNATURE = -; - -: load-from-gpt-prep-partition ( addr -- size ) - get-gpt-partition 0= IF false EXIT THEN - block gpt>num-part-entry l@-le dup 0= IF false exit THEN - 1+ 1 ?DO - seek-pos 0 seek drop - block gpt-part-size read drop gpt-prep-partition? IF - debug-disk-label? IF ." GPT PReP partition found " cr THEN - block gpt-part-entry>first-lba x@-le ( addr first-lba ) - block gpt-part-entry>last-lba x@-le ( addr first-lba last-lba) - over - 1+ ( addr first-lba blocks ) - swap ( addr blocks first-lba ) - block-size * to part-offset ( addr blocks ) - 0 0 seek drop ( addr blocks ) - block-size * read ( size ) - UNLOOP EXIT - THEN - seek-pos gpt-part-size + to seek-pos - LOOP - false -; - -: try-gpt-dos-partition ( -- true|false ) - get-gpt-partition 0= IF false EXIT THEN - block gpt>num-part-entry l@-le dup 0= IF false EXIT THEN - 1+ 1 ?DO - seek-pos 0 seek drop - block gpt-part-size read drop - gpt-basic-data-partition? IF - debug-disk-label? IF ." GPT BASIC DATA partition found " cr THEN - block gpt-part-entry>first-lba x@-le ( first-lba ) - dup to part-start ( first-lba ) - block gpt-part-entry>last-lba x@-le ( first-lba last-lba ) - over - 1+ ( first-lba s1 ) - block-size * to part-size ( first-lba ) - block-size * to part-offset ( ) - 0 0 seek drop - block block-size read drop - block fat-bootblock? ( true|false ) - UNLOOP EXIT - THEN - seek-pos gpt-part-size + to seek-pos - LOOP - false -; - -\ Extract the boot loader path from a bootinfo.txt file -\ In: address and length of buffer where the bootinfo.txt has been loaded to. -\ Out: string address and length of the boot loader (within the input buffer) -\ or a string with length = 0 when parsing failed. - -\ Here is a sample bootinfo file: -\ <chrp-boot> -\ <description>Linux Distribution</description> -\ <os-name>Linux</os-name> -\ <boot-script>boot &device;:1,\boot\yaboot.ibm</boot-script> -\ <icon size=64,64 color-space=3,3,2> -\ <bitmap>[..]</bitmap> -\ </icon> -\ </chrp-boot> - -: parse-bootinfo-txt ( addr len -- str len ) - 2dup s" <boot-script>" find-substr ( addr len pos1 ) - 2dup = IF - \ String not found - 3drop 0 0 EXIT - THEN - dup >r - swap r> + swap ( addr1 len1 ) - - 2dup s" &device;:" find-substr ( addr1 len1 posdev ) - 2dup = IF - 3drop 0 0 EXIT - THEN - 9 + \ Skip the "&device;:" string - dup >r - swap r> + swap ( addr2 len2 ) - 2dup s" </boot-script>" find-substr nip ( addr2 len3 ) - - debug-disk-label? IF - ." Extracted boot loader from bootinfo.txt: '" - 2dup type ." '" cr - THEN -; - -\ Try to load \ppc\bootinfo.txt from the disk (used mainly on CD-ROMs), and if -\ available, get the boot loader path from this file and load it. -\ See the "CHRP system binding to IEEE 1275" specification for more information -\ about bootinfo.txt. An example file can be found in the comment of -\ parse-bootinfo-txt ( addr len -- str len ) - -: load-chrp-boot-file ( addr -- size ) - \ Create bootinfo.txt path name and load that file: - my-parent instance>path - disk-chrp-boot @ 1 = IF - s" :1,\ppc\bootinfo.txt" $cat strdup ( addr str len ) - ELSE - s" :\ppc\bootinfo.txt" $cat strdup ( addr str len ) - THEN - open-dev dup 0= IF 2drop 0 EXIT THEN - >r dup ( addr addr R:ihandle ) - dup s" load" r@ $call-method ( addr addr size R:ihandle ) - r> close-dev ( addr addr size ) - - \ Now parse the information from bootinfo.txt: - parse-bootinfo-txt ( addr fnstr fnlen ) - dup 0= IF 3drop 0 EXIT THEN - \ Does the string contain parameters (i.e. a white space)? - 2dup 20 findchar IF - ( addr fnstr fnlen offset ) - >r 2dup r@ - 1- swap r@ + 1+ swap ( addr fnstr fnlen pstr plen R: offset ) - encode-string s" bootargs" set-chosen - drop r> - THEN - - \ Create the full path to the boot loader: - my-parent instance>path ( addr fnstr fnlen nstr nlen ) - s" :" $cat 2swap $cat strdup ( addr str len ) - \ Update the bootpath: - 2dup encode-string s" bootpath" set-chosen - \ And finally load the boot loader itself: - open-dev dup 0= IF ." failed to load CHRP boot loader." 2drop 0 EXIT THEN - >r s" load" r@ $call-method ( size R:ihandle ) - r> close-dev ( size ) -; - -\ load from a bootable partition -: load-from-boot-partition ( addr -- size ) - debug-disk-label? IF ." Trying DOS boot " .s cr THEN - dup load-from-dos-boot-partition ?dup 0 <> IF nip EXIT THEN - - debug-disk-label? IF ." Trying CHRP boot " .s cr THEN - 1 disk-chrp-boot ! - dup load-chrp-boot-file ?dup 0 <> IF nip EXIT THEN - 0 disk-chrp-boot ! - - debug-disk-label? IF ." Trying GPT boot " .s cr THEN - load-from-gpt-prep-partition - \ More boot partition formats ... -; - -\ parse partition number from my-args - -\ my-args has the following format -\ [<partition>[,<path>]] - -\ | example my-args | example boot command | -\ +------------------+---------------------------+ -\ | 1,\boot\vmlinuz | boot disk:1,\boot\vmlinuz | -\ | 2 | boot disk:2 | - -\ 0 means the whole disk, this is the same behavior -\ as if no partition is specified (yaboot wants this). - -: parse-partition ( -- okay? ) - 0 to partition - 0 to part-offset - 0 to part-size - - my-args to args-len to args - - debug-disk-label? IF - cr ." disk-label parse-partition: my-args=" my-args type cr - THEN - - \ Called without arguments? - args-len 0 = IF true EXIT THEN - - \ Check for "full disk" arguments. - my-args [char] , findchar 0= IF \ no comma? - args c@ isdigit not IF \ ... and not a partition number? - true EXIT \ ... then it's not a partition we can parse - THEN - ELSE - drop - THEN - my-args [char] , split to args-len to args - dup 0= IF 2drop true EXIT THEN \ no first argument - - \ Check partition #. - base @ >r decimal $number r> base ! - IF cr ." Not a partition #" false EXIT THEN - - \ Store part #, done. - to partition - true -; - - -\ try-files and try-partitions - -: (interpose-filesystem) ( str len -- ) - find-package IF args args-len rot interpose THEN -; - -: try-dos-files ( -- found? ) - no-mbr? IF false EXIT THEN - - block fat-bootblock? 0= IF false EXIT THEN - s" fat-files" (interpose-filesystem) - true -; - -: try-ext2-files ( -- found? ) - 2 read-sector \ read first superblock - block d# 56 + w@-le \ fetch s_magic - ef53 <> IF false EXIT THEN \ s_magic found? - s" ext2-files" (interpose-filesystem) - true -; - - -: try-iso9660-files - has-iso9660-filesystem 0= IF false exit THEN - s" iso-9660" (interpose-filesystem) - true -; - -: try-files ( -- found? ) - \ If no path, then full disk. - args-len 0= IF true EXIT THEN - - try-dos-files IF true EXIT THEN - try-ext2-files IF true EXIT THEN - try-iso9660-files IF true EXIT THEN - - \ ... more filesystem types here ... - - false -; - -: try-partitions ( -- found? ) - try-dos-partition IF try-files EXIT THEN - try-gpt-dos-partition IF try-files EXIT THEN - \ try-iso9660-partition IF try-files EXIT THEN - \ ... more partition types here... - false -; - -\ Interface functions for disk-label package -\ as defined by IEEE 1275-1994 3.8.1 - -: close ( -- ) - debug-disk-label? IF ." Closing disk-label: block=0x" block u. ." block-size=" block-size .d cr THEN - block block-array-size free-mem -; - - -: open ( -- true|false ) - init-block - - parse-partition 0= IF - close - false EXIT - THEN - - partition IF - try-partitions - ELSE - try-files - THEN - dup 0= IF debug-disk-label? IF ." not found." cr THEN close THEN \ free memory again -; - - -\ Boot & Load w/o arguments is assumed to be boot from boot partition - -: load ( addr -- size ) - debug-disk-label? IF - ." load: " dup u. cr - THEN - - args-len IF - TRUE ABORT" Load done w/o filesystem" - ELSE - partition IF - 0 0 seek drop - part-size IF - part-size max-prep-partition-blocks min \ Load size - ELSE - max-prep-partition-blocks - THEN - 200 * read - ELSE - has-iso9660-filesystem IF - dup load-chrp-boot-file ?dup 0 > IF nip EXIT THEN - THEN - load-from-boot-partition - dup 0= ABORT" No boot partition found" - THEN - THEN -; diff --git a/qemu/roms/SLOF/slof/fs/packages/ext2-files.fs b/qemu/roms/SLOF/slof/fs/packages/ext2-files.fs deleted file mode 100644 index 262c64a34..000000000 --- a/qemu/roms/SLOF/slof/fs/packages/ext2-files.fs +++ /dev/null @@ -1,188 +0,0 @@ -\ ***************************************************************************** -\ * Copyright (c) 2004, 2011 IBM Corporation -\ * All rights reserved. -\ * This program and the accompanying materials -\ * are made available under the terms of the BSD License -\ * which accompanies this distribution, and is available at -\ * http://www.opensource.org/licenses/bsd-license.php -\ * -\ * Contributors: -\ * IBM Corporation - initial implementation -\ ****************************************************************************/ -s" ext2-files" device-name - -INSTANCE VARIABLE first-block -INSTANCE VARIABLE inode-size -INSTANCE VARIABLE block-size -INSTANCE VARIABLE inodes/group - -INSTANCE VARIABLE group-desc-size -INSTANCE VARIABLE group-descriptors - -: seek s" seek" $call-parent ; -: read s" read" $call-parent ; - -INSTANCE VARIABLE data -INSTANCE VARIABLE #data -INSTANCE VARIABLE indirect-block -INSTANCE VARIABLE dindirect-block - -: free-data - data @ ?dup IF #data @ free-mem 0 data ! THEN ; -: read-data ( offset size -- ) - free-data dup #data ! alloc-mem data ! - xlsplit seek -2 and ABORT" ext2-files read-data: seek failed" - data @ #data @ read #data @ <> ABORT" ext2-files read-data: read failed" ; - -: read-block ( block# -- ) - block-size @ * block-size @ read-data ; - -INSTANCE VARIABLE inode -INSTANCE VARIABLE file-len -INSTANCE VARIABLE blocks -INSTANCE VARIABLE #blocks -INSTANCE VARIABLE ^blocks -INSTANCE VARIABLE #blocks-left -: blocks-read ( n -- ) dup negate #blocks-left +! 4 * ^blocks +! ; -: read-indirect-blocks ( indirect-block# -- ) - read-block data @ data off - dup #blocks-left @ 4 * block-size @ min dup >r ^blocks @ swap move - r> 2 rshift blocks-read block-size @ free-mem ; - -: read-double-indirect-blocks ( double-indirect-block# -- ) - \ Resolve one level of indirection and call read-indirect-block - read-block data @ indirect-block ! data off - BEGIN - indirect-block @ l@-le dup 0 <> - WHILE - read-indirect-blocks - 4 indirect-block +! \ point to next indirect block - REPEAT - drop \ drop 0, the invalid block number -; - -: read-triple-indirect-blocks ( triple-indirect-block# -- ) - \ Resolve one level of indirection and call double-indirect-block - read-block data @ dindirect-block ! data off - BEGIN - dindirect-block @ l@-le dup 0 <> - WHILE - read-double-indirect-blocks - 4 dindirect-block +! \ point to next double indirect block - REPEAT - drop \ drop 0, the invalid block number -; - -: read-block#s ( -- ) - blocks @ ?dup IF #blocks @ 4 * free-mem THEN - inode @ 4 + l@-le file-len ! - file-len @ block-size @ // #blocks ! - #blocks @ 4 * alloc-mem blocks ! - blocks @ ^blocks ! #blocks @ #blocks-left ! - #blocks-left @ c min \ # direct blocks - inode @ 28 + over 4 * ^blocks @ swap move blocks-read - #blocks-left @ IF inode @ 58 + l@-le read-indirect-blocks THEN - #blocks-left @ IF inode @ 5c + l@-le read-double-indirect-blocks THEN - #blocks-left @ IF inode @ 60 + l@-le read-triple-indirect-blocks THEN ; -: read-inode ( inode# -- ) - 1- inodes/group @ u/mod \ # in group, group # - 20 * group-descriptors @ + 8 + l@-le block-size @ * \ # in group, inode table - swap inode-size @ * + xlsplit seek drop inode @ inode-size @ read drop -; - -: .rwx ( bits last-char-if-special special? -- ) - rot dup 4 and IF ." r" ELSE ." -" THEN - dup 2 and IF ." w" ELSE ." -" THEN - swap IF 1 and 0= IF upc THEN emit ELSE - 1 and IF ." x" ELSE ." -" THEN drop THEN ; -CREATE mode-chars 10 allot s" ?pc?d?b?-?l?s???" mode-chars swap move -: .mode ( mode -- ) - dup c rshift f and mode-chars + c@ emit - dup 6 rshift 7 and over 800 and 73 swap .rwx - dup 3 rshift 7 and over 400 and 73 swap .rwx - dup 7 and swap 200 and 74 swap .rwx ; -: .inode ( -- ) - base @ >r decimal - inode @ w@-le .mode \ file mode - inode @ 1a + w@-le 5 .r \ link count - inode @ 02 + w@-le 9 .r \ uid - inode @ 18 + w@-le 9 .r \ gid - inode @ 04 + l@-le 9 .r \ size - r> base ! ; - -: do-super ( -- ) - 400 400 read-data - data @ 14 + l@-le first-block ! - 400 data @ 18 + l@-le lshift block-size ! - data @ 28 + l@-le inodes/group ! - \ Check revision level... in revision 0, the inode size is always 128 - data @ 4c + l@-le 0= IF - 80 inode-size ! - ELSE - data @ 58 + w@-le inode-size ! - THEN - data @ 20 + l@-le group-desc-size ! - - \ Read the group descriptor table: - first-block @ 1+ block-size @ * - group-desc-size @ - read-data - data @ group-descriptors ! - - \ We keep the group-descriptor memory area, so clear data pointer: - data off -; - -INSTANCE VARIABLE current-pos - -: read ( adr len -- actual ) - file-len @ current-pos @ - min \ can't go past end of file - current-pos @ block-size @ u/mod 4 * blocks @ + l@-le read-block - block-size @ over - rot min >r ( adr off r: len ) - data @ + swap r@ move r> dup current-pos +! ; -: read ( adr len -- actual ) - ( check if a file is selected, first ) - dup >r BEGIN dup WHILE 2dup read dup 0= ABORT" ext2-files: read failed" - /string REPEAT 2drop r> ; -: seek ( lo hi -- status ) - lxjoin dup file-len @ > IF drop true EXIT THEN current-pos ! false ; -: load ( adr -- len ) - file-len @ read dup file-len @ <> ABORT" ext2-files: failed loading file" ; - -: .name ( adr -- ) dup 8 + swap 6 + c@ type ; -: read-dir ( inode# -- adr ) - read-inode read-block#s file-len @ alloc-mem - 0 0 seek ABORT" ext2-files read-dir: seek failed" - dup file-len @ read file-len @ <> ABORT" ext2-files read-dir: read failed" ; -: .dir ( inode# -- ) - read-dir dup BEGIN 2dup file-len @ - > over l@-le tuck and WHILE - cr dup 8 0.r space read-inode .inode space space dup .name - dup 4 + w@-le + REPEAT 2drop file-len @ free-mem ; -: (find-file) ( adr name len -- inode#|0 ) - 2>r dup BEGIN 2dup file-len @ - > over l@-le and WHILE - dup 8 + over 6 + c@ 2r@ str= IF 2r> 2drop nip l@-le EXIT THEN - dup 4 + w@-le + REPEAT 2drop 2r> 2drop 0 ; -: find-file ( inode# name len -- inode#|0 ) - 2>r read-dir dup 2r> (find-file) swap file-len @ free-mem ; -: find-path ( inode# name len -- inode#|0 ) - dup 0= IF 3drop 0 ." empty name " EXIT THEN - over c@ [char] \ = IF 1 /string ." slash " RECURSE EXIT THEN - [char] \ split 2>r find-file ?dup 0= IF - 2r> 2drop false ." not found " EXIT THEN - r@ 0<> IF 2r> ." more... " RECURSE EXIT THEN - 2r> 2drop ." got it " ; - -: close - inode @ inode-size @ free-mem - group-descriptors @ group-desc-size @ free-mem - free-data - blocks @ ?dup IF #blocks @ 4 * free-mem THEN -; - -: open - 0 data ! 0 blocks ! 0 #blocks ! - do-super - inode-size @ alloc-mem inode ! - my-args nip 0= IF 0 0 ELSE - 2 my-args find-path ?dup 0= IF close false EXIT THEN THEN - read-inode read-block#s 0 0 seek 0= ; diff --git a/qemu/roms/SLOF/slof/fs/packages/fat-files.fs b/qemu/roms/SLOF/slof/fs/packages/fat-files.fs deleted file mode 100644 index d9194527e..000000000 --- a/qemu/roms/SLOF/slof/fs/packages/fat-files.fs +++ /dev/null @@ -1,199 +0,0 @@ -\ ***************************************************************************** -\ * Copyright (c) 2004, 2008 IBM Corporation -\ * All rights reserved. -\ * This program and the accompanying materials -\ * are made available under the terms of the BSD License -\ * which accompanies this distribution, and is available at -\ * http://www.opensource.org/licenses/bsd-license.php -\ * -\ * Contributors: -\ * IBM Corporation - initial implementation -\ ****************************************************************************/ - - -s" fat-files" device-name - -INSTANCE VARIABLE bytes/sector -INSTANCE VARIABLE sectors/cluster -INSTANCE VARIABLE #reserved-sectors -INSTANCE VARIABLE #fats -INSTANCE VARIABLE #root-entries -INSTANCE VARIABLE fat32-root-cluster -INSTANCE VARIABLE total-#sectors -INSTANCE VARIABLE media-descriptor -INSTANCE VARIABLE sectors/fat -INSTANCE VARIABLE sectors/track -INSTANCE VARIABLE #heads -INSTANCE VARIABLE #hidden-sectors - -INSTANCE VARIABLE fat-type -INSTANCE VARIABLE bytes/cluster -INSTANCE VARIABLE fat-offset -INSTANCE VARIABLE root-offset -INSTANCE VARIABLE cluster-offset -INSTANCE VARIABLE #clusters - -: seek s" seek" $call-parent ; -: read s" read" $call-parent ; - -INSTANCE VARIABLE data -INSTANCE VARIABLE #data - -: free-data - data @ ?dup IF #data @ free-mem 0 data ! THEN ; -: read-data ( offset size -- ) - free-data dup #data ! alloc-mem data ! - xlsplit seek -2 and ABORT" fat-files read-data: seek failed" - data @ #data @ read #data @ <> ABORT" fat-files read-data: read failed" ; - -CREATE fat-buf 8 allot -: read-fat ( cluster# -- data ) - fat-buf 8 erase - 1 #split fat-type @ * 2/ 2/ fat-offset @ + - xlsplit seek -2 and ABORT" fat-files read-fat: seek failed" - fat-buf 8 read 8 <> ABORT" fat-files read-fat: read failed" - fat-buf 8c@ bxjoin fat-type @ dup >r 2* #split drop r> #split - rot IF swap THEN drop ; - -INSTANCE VARIABLE next-cluster - -: read-cluster ( cluster# -- ) - dup bytes/cluster @ * cluster-offset @ + bytes/cluster @ read-data - read-fat dup #clusters @ >= IF drop 0 THEN next-cluster ! ; - -: read-dir ( cluster# -- ) - ?dup 0= IF - #root-entries @ 0= IF - fat32-root-cluster @ read-cluster - ELSE - root-offset @ #root-entries @ 20 * read-data 0 next-cluster ! - THEN - ELSE - read-cluster - THEN -; - -: .time ( x -- ) - base @ >r decimal - b #split 2 0.r [char] : emit 5 #split 2 0.r [char] : emit 2* 2 0.r - r> base ! ; -: .date ( x -- ) - base @ >r decimal - 9 #split 7bc + 4 0.r [char] - emit 5 #split 2 0.r [char] - emit 2 0.r - r> base ! ; -: .attr ( attr -- ) - 6 0 DO dup 1 and IF s" RHSLDA" drop i + c@ ELSE bl THEN emit u2/ LOOP drop ; -: .dir-entry ( adr -- ) - dup 0b + c@ 8 and IF drop EXIT THEN \ volume label, not a file - dup c@ e5 = IF drop EXIT THEN \ deleted file - cr - dup 1a + 2c@ bwjoin [char] # emit 4 0.r space \ starting cluster - dup 18 + 2c@ bwjoin .date space - dup 16 + 2c@ bwjoin .time space - dup 1c + 4c@ bljoin base @ decimal swap a .r base ! space \ size in bytes - dup 0b + c@ .attr space - dup 8 BEGIN 2dup 1- + c@ 20 = over and WHILE 1- REPEAT type - dup 8 + 3 BEGIN 2dup 1- + c@ 20 = over and WHILE 1- REPEAT dup IF - [char] . emit type ELSE 2drop THEN - drop ; -: .dir-entries ( adr n -- ) - 0 ?DO dup i 20 * + dup c@ 0= IF drop LEAVE THEN .dir-entry LOOP drop ; -: .dir ( cluster# -- ) - read-dir BEGIN data @ #data @ 20 / .dir-entries next-cluster @ WHILE - next-cluster @ read-cluster REPEAT ; - -: str-upper ( str len adr -- ) \ Copy string to adr, uppercase - -rot bounds ?DO i c@ upc over c! char+ LOOP drop ; -CREATE dos-name b allot -: make-dos-name ( str len -- ) - dos-name b bl fill - 2dup [char] . findchar IF - 3dup 1+ /string 3 min dos-name 8 + str-upper nip THEN - 8 min dos-name str-upper ; - -: (find-file) ( -- cluster file-len is-dir? true | false ) - data @ BEGIN dup data @ #data @ + < WHILE - dup dos-name b comp WHILE 20 + REPEAT - dup 1a + 2c@ bwjoin swap dup 1c + 4c@ bljoin swap 0b + c@ 10 and 0<> true - ELSE drop false THEN ; -: find-file ( dir-cluster name len -- cluster file-len is-dir? true | false ) - make-dos-name read-dir BEGIN (find-file) 0= WHILE next-cluster @ WHILE - next-cluster @ read-cluster REPEAT false ELSE true THEN ; -: find-path ( dir-cluster name len -- cluster file-len true | false ) - dup 0= IF 3drop false ." empty name " EXIT THEN - over c@ [char] \ = IF 1 /string RECURSE EXIT THEN - [char] \ split 2>r find-file 0= IF 2r> 2drop false ." not found " EXIT THEN - r@ 0<> <> IF 2drop 2r> 2drop false ." no dir<->file match " EXIT THEN - r@ 0<> IF drop 2r> RECURSE EXIT THEN - 2r> 2drop true ; - -: do-super ( -- ) - 0 200 read-data - data @ 0b + 2c@ bwjoin bytes/sector ! - data @ 0d + c@ sectors/cluster ! - bytes/sector @ sectors/cluster @ * bytes/cluster ! - data @ 0e + 2c@ bwjoin #reserved-sectors ! - data @ 10 + c@ #fats ! - data @ 11 + 2c@ bwjoin #root-entries ! - data @ 13 + 2c@ bwjoin total-#sectors ! - data @ 15 + c@ media-descriptor ! - data @ 16 + 2c@ bwjoin sectors/fat ! - data @ 18 + 2c@ bwjoin sectors/track ! - data @ 1a + 2c@ bwjoin #heads ! - data @ 1c + 2c@ bwjoin #hidden-sectors ! - - \ For FAT16 and FAT32: - total-#sectors @ 0= IF data @ 20 + 4c@ bljoin total-#sectors ! THEN - - \ For FAT32: - sectors/fat @ 0= IF data @ 24 + 4c@ bljoin sectors/fat ! THEN - #root-entries @ 0= IF data @ 2c + 4c@ bljoin ELSE 0 THEN fat32-root-cluster ! - - \ XXX add other FAT32 stuff (offsets 28, 2c, 30) - - \ Compute the number of data clusters, decide what FAT type we are. - total-#sectors @ #reserved-sectors @ - sectors/fat @ #fats @ * - - #root-entries @ 20 * bytes/sector @ // - sectors/cluster @ / - dup #clusters ! - dup ff5 < IF drop c ELSE fff5 < IF 10 ELSE 20 THEN THEN fat-type ! - base @ decimal base ! - - \ Starting offset of first fat. - #reserved-sectors @ bytes/sector @ * fat-offset ! - - \ Starting offset of root dir. - #fats @ sectors/fat @ * bytes/sector @ * fat-offset @ + root-offset ! - - \ Starting offset of "cluster 0". - #root-entries @ 20 * bytes/sector @ tuck // * root-offset @ + - bytes/cluster @ 2* - cluster-offset ! ; - - -INSTANCE VARIABLE file-cluster -INSTANCE VARIABLE file-len -INSTANCE VARIABLE current-pos -INSTANCE VARIABLE pos-in-data - -: seek ( lo hi -- status ) - lxjoin dup current-pos ! file-cluster @ read-cluster - \ Read and skip blocks until we are where we want to be. - BEGIN dup #data @ >= WHILE #data @ - next-cluster @ dup 0= IF - 2drop true EXIT THEN read-cluster REPEAT pos-in-data ! false ; -: read ( adr len -- actual ) - file-len @ current-pos @ - min \ can't go past end of file - #data @ pos-in-data @ - min >r \ length for this transfer - data @ pos-in-data @ + swap r@ move \ move the data - r@ pos-in-data +! r@ current-pos +! pos-in-data @ #data @ = IF - next-cluster @ ?dup IF read-cluster 0 pos-in-data ! THEN THEN r> ; -: read ( adr len -- actual ) - file-len @ min \ len cannot be greater than file size - dup >r BEGIN dup WHILE 2dup read dup 0= ABORT" fat-files: read failed" - /string ( tuck - >r + r> ) REPEAT 2drop r> ; -: load ( adr -- len ) - file-len @ read dup file-len @ <> ABORT" fat-files: failed loading file" ; - -: close free-data ; -: open - do-super - 0 my-args find-path 0= IF close false EXIT THEN - file-len ! file-cluster ! 0 0 seek 0= ; diff --git a/qemu/roms/SLOF/slof/fs/packages/filler.fs b/qemu/roms/SLOF/slof/fs/packages/filler.fs deleted file mode 100644 index bd5c17a39..000000000 --- a/qemu/roms/SLOF/slof/fs/packages/filler.fs +++ /dev/null @@ -1,21 +0,0 @@ -\ ***************************************************************************** -\ * Copyright (c) 2004, 2008 IBM Corporation -\ * All rights reserved. -\ * This program and the accompanying materials -\ * are made available under the terms of the BSD License -\ * which accompanies this distribution, and is available at -\ * http://www.opensource.org/licenses/bsd-license.php -\ * -\ * Contributors: -\ * IBM Corporation - initial implementation -\ ****************************************************************************/ - - -s" filler" device-name - -: block-size s" block-size" $call-parent ; -: seek s" seek" $call-parent ; -: read s" read" $call-parent ; - -: open true ; -: close ; diff --git a/qemu/roms/SLOF/slof/fs/packages/iso-9660.fs b/qemu/roms/SLOF/slof/fs/packages/iso-9660.fs deleted file mode 100644 index 6eda8be70..000000000 --- a/qemu/roms/SLOF/slof/fs/packages/iso-9660.fs +++ /dev/null @@ -1,325 +0,0 @@ -\ ***************************************************************************** -\ * Copyright (c) 2004, 2008 IBM Corporation -\ * All rights reserved. -\ * This program and the accompanying materials -\ * are made available under the terms of the BSD License -\ * which accompanies this distribution, and is available at -\ * http://www.opensource.org/licenses/bsd-license.php -\ * -\ * Contributors: -\ * IBM Corporation - initial implementation -\ ****************************************************************************/ - - -s" iso-9660" device-name - - -0 VALUE iso-debug-flag - -\ Method for code clean up - For release version of code iso-debug-flag is -\ cleared and for debugging it is set - -: iso-debug-print ( str len -- ) iso-debug-flag IF type cr ELSE 2drop THEN ; - - -\ -------------------------------------------------------- -\ GLOBAL VARIABLES -\ -------------------------------------------------------- - - -0 VALUE path-tbl-size -0 VALUE path-tbl-addr -0 VALUE root-dir-size -0 VALUE vol-size -0 VALUE logical-blk-size -0 VALUE path-table -0 VALUE count - - -\ INSTANCE VARIABLES - - -INSTANCE VARIABLE dir-addr -INSTANCE VARIABLE data-buff -INSTANCE VARIABLE #data -INSTANCE VARIABLE ptable -INSTANCE VARIABLE file-loc -INSTANCE VARIABLE file-size -INSTANCE VARIABLE cur-file-offset -INSTANCE VARIABLE self -INSTANCE VARIABLE index - - -\ -------------------------------------------------------- -\ COLON DEFINITIONS -\ -------------------------------------------------------- - - -\ This method is used to seek to the required position -\ Which calls seek of disk-label - -: seek ( pos.lo pos.hi -- status ) s" seek" $call-parent ; - - -\ This method is used to read the contents of disk -\ it calls read of disk-label - - - : read ( addr len -- actual ) s" read" $call-parent ; - - -\ This method releases the memory used as scratch pad buffer. - -: free-data ( -- ) - data-buff @ ( data-buff ) - ?DUP IF #data @ free-mem 0 data-buff ! 0 #data ! THEN -; - - -\ This method will release the previous allocated scratch pad buffer and -\ allocates a fresh buffer and copies the required number of bytes from the -\ media in to it. - -: read-data ( offset size -- ) - dup #data @ > IF - free-data dup dup ( offset size size size ) - #data ! alloc-mem data-buff ! ( offset size ) - THEN - swap xlsplit ( size pos.lo pos.hi ) - seek -2 and ABORT" seek failed." - data-buff @ over read ( size actual ) - <> ABORT" read failed." -; - - -\ This method extracts the information required from primary volume -\ descriptor and stores the required information in the global variables - -: extract-vol-info ( -- ) - 10 800 * 800 read-data - data-buff @ 88 + l@-be to path-tbl-size \ read path table size - data-buff @ 94 + l@-be to path-tbl-addr \ read big-endian path table - data-buff @ a2 + l@-be dir-addr ! \ gather of root directory info - data-buff @ 0aa + l@-be to root-dir-size \ get volume info - data-buff @ 54 + l@-be to vol-size \ size in blocks - data-buff @ 82 + l@-be to logical-blk-size - path-tbl-size alloc-mem dup TO path-table path-tbl-size erase - path-tbl-addr 800 * xlsplit seek drop - path-table path-tbl-size read drop \ pathtable in-system-memory copy -; - - -\ This method coverts the iso file name to user readble form - -: file-name ( str len -- str' len' ) - 2dup [char] ; findchar IF - ( str len offset ) - nip \ Omit the trailing ";1" revision of ISO9660 file name - 2dup + 1- ( str newlen endptr ) - c@ [CHAR] . = IF - 1- ( str len' ) \ Remove trailing dot - THEN - THEN -; - - -\ triplicates top stack element - -: dup3 ( num -- num num num ) dup dup dup ; - - -\ This method is used for traversing records of path table. If the -\ file identifier length is odd 1 byte padding is done else not. - -: get-next-record ( rec-addr -- next-rec-offset ) - dup3 ( rec-addr rec-addr rec-addr rec-addr ) - self @ 1 + self ! ( rec-addr rec-addr rec-addr rec-addr ) - c@ 1 AND IF ( rec-addr rec-addr rec-addr ) - c@ + 9 ( rec-addr rec-addr' rec-len ) - ELSE - c@ + 8 ( rec-addr rec-addr' rec-len ) - THEN - + swap - ( next-rec-offset ) -; - - -\ This method does search of given directory name in the path table -\ and returns true if finds a match else false. - -: path-table-search ( str len -- TRUE | FALSE ) - path-table path-tbl-size + path-table ptable @ + DO ( str len ) - 2dup I 6 + w@-be index @ = ( str len str len ) - -rot I 8 + I c@ - iso-debug-flag IF - ." ISO: comparing path name '" - 4dup type ." ' with '" type ." '" cr - THEN - string=ci and IF ( str len ) - s" Directory Matched!! " iso-debug-print ( str len ) - self @ index ! ( str len ) - I 2 + l@-be dir-addr ! I dup ( str len rec-addr ) - get-next-record + path-table - ptable ! ( str len ) - 2drop TRUE UNLOOP EXIT ( TRUE ) - THEN - I get-next-record ( str len next-rec-offset ) - +LOOP - 2drop - FALSE ( FALSE ) - s" Invalid path / directory " iso-debug-print -; - - -\ METHOD for searching for a file with in a direcotory - -: search-file-dir ( str len -- TRUE | FALSE ) - dir-addr @ 800 * dir-addr ! ( str len ) - dir-addr @ 100 read-data ( str len ) - data-buff @ 0e + l@-be dup >r ( str len rec-len ) - 100 > IF ( str len ) - s" size dir record" iso-debug-print ( str len ) - dir-addr @ r@ read-data ( str len ) - THEN - r> data-buff @ + data-buff @ DO ( str len ) - I 19 + c@ 2 and 0= I c@ 0<> and IF ( str len ) - 2dup ( str len str len ) - I 21 + I 20 + c@ ( str len str len str' len' ) - iso-debug-flag IF - ." ISO: comparing file name '" - 4dup type ." ' with '" type ." '" cr - THEN - file-name string=ci IF ( str len ) - s" File found!" iso-debug-print ( str len ) - I 6 + l@-be 800 * ( str len file-loc ) - file-loc ! ( str len ) - I 0e + l@-be file-size ! ( str len ) - 2drop - TRUE ( TRUE ) - UNLOOP - EXIT - THEN - THEN - ( str len ) - I c@ ?dup 0= IF - 800 I 7ff AND - - iso-debug-flag IF - ." skipping " dup . ." bytes at end of sector" cr - THEN - THEN - ( str len offset ) - +LOOP - 2drop - FALSE ( FALSE ) - s" file not found" iso-debug-print -; - - -\ This method splits the given absolute path in to directories from root and -\ calls search-path-table. when string reaches to state when it can not be -\ split i.e., end of the path, calls search-file-dir is made to search for -\ file . - -: search-path ( str len -- FALSE|TRUE ) - 0 ptable ! - 1 self ! - 1 index ! - dup ( str len len ) - 0= IF - 3drop FALSE ( FALSE ) - s" Empty path name " iso-debug-print EXIT ( FALSE ) - THEN - OVER c@ ( str len char ) - [char] \ = IF ( str len ) - swap 1 + swap 1 - BEGIN ( str len ) - [char] \ split ( str len str' len ' ) - dup 0 = IF ( str len str' len ' ) - 2drop search-file-dir EXIT ( TRUE | FALSE ) - ELSE - 2swap path-table-search invert IF ( str' len ' ) - 2drop FALSE EXIT ( FALSE ) - THEN - THEN - AGAIN - ELSE BEGIN - [char] \ split dup 0 = IF ( str len str' len' ) - 2drop search-file-dir EXIT ( TRUE | FALSE ) - ELSE - 2swap path-table-search invert IF ( str' len ' ) - 2drop FALSE EXIT ( FALSE ) - THEN - THEN - AGAIN - THEN -; - - -\ this method will seek and read the file in to the given memory location - -0 VALUE loc -: load ( addr -- len ) - dup to loc ( addr ) - file-loc @ xlsplit seek drop - file-size @ read ( file-size ) - iso-debug-flag IF s" Bytes returned from read:" type dup . cr THEN - dup file-size @ <> ABORT" read failed!" -; - - - -\ memory used by the file system will be freed - -: close ( -- ) - free-data count 1 - dup to count 0 = IF - path-table path-tbl-size free-mem - 0 TO path-table - THEN -; - - -\ open method of the file system - -: open ( -- TRUE | FALSE ) - 0 data-buff ! - 0 #data ! - 0 ptable ! - 0 file-loc ! - 0 file-size ! - 0 cur-file-offset ! - 1 self ! - 1 index ! - count 0 = IF - s" extract-vol-info called " iso-debug-print - extract-vol-info - THEN - count 1 + to count - my-args search-path IF - file-loc @ xlsplit seek drop - TRUE ( TRUE ) - ELSE - close - FALSE ( FALSE ) - THEN - 0 cur-file-offset ! - s" opened ISO9660 package" iso-debug-print -; - - -\ public seek method - -: seek ( pos.lo pos.hi -- status ) - lxjoin dup cur-file-offset ! ( offset ) - file-loc @ + xlsplit ( pos.lo pos.hi ) - s" seek" $call-parent ( status ) -; - - -\ public read method - - : read ( addr len -- actual ) - file-size @ cur-file-offset @ - ( addr len remainder-of-file ) - min ( addr len|remainder-of-file ) - s" read" $call-parent ( actual ) - dup cur-file-offset @ + cur-file-offset ! ( actual ) - cur-file-offset @ ( offset actual ) - xlsplit seek drop ( actual ) -; - diff --git a/qemu/roms/SLOF/slof/fs/packages/obp-tftp.fs b/qemu/roms/SLOF/slof/fs/packages/obp-tftp.fs deleted file mode 100644 index 89143a669..000000000 --- a/qemu/roms/SLOF/slof/fs/packages/obp-tftp.fs +++ /dev/null @@ -1,71 +0,0 @@ -\ ***************************************************************************** -\ * Copyright (c) 2004, 2008 IBM Corporation -\ * All rights reserved. -\ * This program and the accompanying materials -\ * are made available under the terms of the BSD License -\ * which accompanies this distribution, and is available at -\ * http://www.opensource.org/licenses/bsd-license.php -\ * -\ * Contributors: -\ * IBM Corporation - initial implementation -\ ****************************************************************************/ - -s" obp-tftp" device-name - -INSTANCE VARIABLE ciregs-buffer - -: open ( -- okay? ) - ciregs-size alloc-mem ciregs-buffer ! - true -; - -: load ( addr -- size ) - - \ Save old client interface register - ciregs ciregs-buffer @ ciregs-size move - - s" bootargs" get-chosen 0= IF 0 0 THEN >r >r - s" bootpath" get-chosen 0= IF 0 0 THEN >r >r - - \ Set bootpath to current device - my-parent ihandle>phandle node>path encode-string - s" bootpath" set-chosen - - \ Generate arg string for snk like - \ "netboot load-addr length filename" - (u.) s" netboot " 2swap $cat s" 60000000 " $cat - - \ Allocate 1720 bytes to store the BOOTP-REPLY packet - 6B8 alloc-mem dup >r (u.) $cat s" " $cat - huge-tftp-load @ IF s" 1 " ELSE s" 0 " THEN $cat - \ Add desired TFTP-Blocksize as additional argument - s" 1432 " $cat - \ Add OBP-TFTP Bootstring argument, e.g. "10.128.0.1,bootrom.bin,10.128.40.1" - my-args $cat - - \ Call SNK netboot loadr - (client-exec) dup 0< IF drop 0 THEN - - \ Restore to old client interface register - ciregs-buffer @ ciregs ciregs-size move - - \ Recover buffer address of BOOTP-REPLY packet - r> - - r> r> over IF s" bootpath" set-chosen ELSE 2drop THEN - r> r> over IF s" bootargs" set-chosen ELSE 2drop THEN - - \ Store BOOTP-REPLY packet as property - dup 6B8 encode-bytes s" bootp-response" s" /chosen" find-node set-property - - \ free buffer - 6B8 free-mem -; - -: close ( -- ) - ciregs-buffer @ ciregs-size free-mem -; - -: ping ( -- ) - s" ping " my-args $cat (client-exec) -; diff --git a/qemu/roms/SLOF/slof/fs/packages/rom-files.fs b/qemu/roms/SLOF/slof/fs/packages/rom-files.fs deleted file mode 100644 index 418cf4e05..000000000 --- a/qemu/roms/SLOF/slof/fs/packages/rom-files.fs +++ /dev/null @@ -1,85 +0,0 @@ -\ ***************************************************************************** -\ * Copyright (c) 2004, 2008 IBM Corporation -\ * All rights reserved. -\ * This program and the accompanying materials -\ * are made available under the terms of the BSD License -\ * which accompanies this distribution, and is available at -\ * http://www.opensource.org/licenses/bsd-license.php -\ * -\ * Contributors: -\ * IBM Corporation - initial implementation -\ ****************************************************************************/ - - -\ package which adds support to read the romfs -\ this package is somehow limited as the maximum supported length -\ for a file name is hardcoded to 0x100 - -s" rom-files" device-name - -INSTANCE VARIABLE length -INSTANCE VARIABLE next-file -INSTANCE VARIABLE buffer -INSTANCE VARIABLE buffer-size -INSTANCE VARIABLE file -INSTANCE VARIABLE file-size -INSTANCE VARIABLE found - -: open true - 100 dup buffer-size ! alloc-mem buffer ! false found ! ; -: close buffer @ buffer-size @ free-mem ; - -: read ( addr len -- actual ) s" read" $call-parent ; - -: seek ( lo hi -- status ) s" seek" $call-parent ; - -: .read-file-name ( offset -- str len ) - \ move to the file name offset - 0 seek drop - \ read <buffer-size> bytes from that address - buffer @ buffer-size @ read drop - \ write a 0 to make sure it is a 0 terminated string - buffer-size @ 1 - buffer @ + 0 swap c! - buffer @ zcount ; - -: .print-info ( offset -- ) - dup 2 spaces 6 0.r 2 spaces dup - 8 + 0 seek drop length 8 read drop - 6 length @ swap 0.r 2 spaces - 20 + .read-file-name type cr ; - -: .list-header cr - s" --offset---size-----file-name----" type cr ; - -: list - .list-header - 0 0 BEGIN + dup - .print-info dup 0 seek drop - next-file 8 read drop next-file @ - dup 0= UNTIL 2drop ; - -: (find-file) ( name len -- offset | -1 ) - 0 0 seek drop false found ! - file-size ! file ! 0 0 BEGIN + dup - 20 + .read-file-name file @ file-size @ - str= IF true found ! THEN - dup 0 seek drop - next-file 8 read drop next-file @ - dup 0= found @ or UNTIL drop found @ 0= - IF drop -1 THEN ; - -: load ( addr -- size ) - my-parent instance>args 2@ [char] \ left-parse-string 2drop - (find-file) dup -1 = IF 2drop 0 ELSE - \ got to the beginning - 0 0 seek drop - \ read the file size - dup 8 + 0 seek drop - here 8 read drop here @ ( dest-addr offset file-size ) - \ read data start offset - over 18 + 0 seek drop - here 8 read drop here @ ( dest-addr offset file-size data-offset ) - rot + 0 seek drop ( dest-addr file-size ) - read - THEN -; diff --git a/qemu/roms/SLOF/slof/fs/packages/sms.fs b/qemu/roms/SLOF/slof/fs/packages/sms.fs deleted file mode 100644 index d8c672f72..000000000 --- a/qemu/roms/SLOF/slof/fs/packages/sms.fs +++ /dev/null @@ -1,29 +0,0 @@ -\ ***************************************************************************** -\ * Copyright (c) 2004, 2008 IBM Corporation -\ * All rights reserved. -\ * This program and the accompanying materials -\ * are made available under the terms of the BSD License -\ * which accompanies this distribution, and is available at -\ * http://www.opensource.org/licenses/bsd-license.php -\ * -\ * Contributors: -\ * IBM Corporation - initial implementation -\ ****************************************************************************/ - - -s" /packages" find-device - -new-device - s" sms" device-name - - : open true ; - - : close ; - - \ The rest of methods is loaded dynamically from the romfs - \ on a first call to sms-start - -finish-device - -device-end \ leave /packages - diff --git a/qemu/roms/SLOF/slof/fs/pci-bridge.fs b/qemu/roms/SLOF/slof/fs/pci-bridge.fs deleted file mode 100644 index e6af7b65c..000000000 --- a/qemu/roms/SLOF/slof/fs/pci-bridge.fs +++ /dev/null @@ -1,65 +0,0 @@ -\ ***************************************************************************** -\ * Copyright (c) 2004, 2008 IBM Corporation -\ * All rights reserved. -\ * This program and the accompanying materials -\ * are made available under the terms of the BSD License -\ * which accompanies this distribution, and is available at -\ * http://www.opensource.org/licenses/bsd-license.php -\ * -\ * Contributors: -\ * IBM Corporation - initial implementation -\ ****************************************************************************/ - -\ get the PUID from the node above -get-node CONSTANT my-phandle -s" my-puid" my-phandle parent $call-static CONSTANT my-puid - -\ Save the bus number provided by this bridge -pci-bus-number 1+ CONSTANT my-bus - -s" pci-config-bridge.fs" included -s" dma-function.fs" included - -\ generate the rom-fs filename from the vendor and device ID "pci-bridge_VENDORID_DEVICEID.fs" -: filename ( -- str len ) - s" pci-bridge_" - my-space pci-vendor@ 4 int2str $cat - s" _" $cat - my-space pci-device@ 4 int2str $cat - s" .fs" $cat -; - -\ Set up the Bridge with either default or special settings -: setup ( -- ) - \ is there special handling for this device, given vendor and device id? - filename romfs-lookup ?dup - IF - \ give it a special treatment - evaluate - ELSE - \ no special handling for this device, attempt autoconfiguration - my-space pci-class-name type 2a emit cr - my-space pci-bridge-generic-setup - my-space pci-reset-2nd - THEN -; - -\ Disable Bus Master, Memory Space and I/O Space for -\ this device and so for the scanning for the devices behind -pci-device-disable - -\ Enalbe #PERR and #SERR reporting -pci-error-enable - -\ Print out device information -my-space 42 pci-out \ config-addr ascii('B') - -\ and set up the bridge -setup - -\ And enable Bus Master IO and MEM access again. -\ we need that on bridges so that the devices behind -\ can set their state on their own. -pci-master-enable -pci-mem-enable -pci-io-enable diff --git a/qemu/roms/SLOF/slof/fs/pci-class-code-names.fs b/qemu/roms/SLOF/slof/fs/pci-class-code-names.fs deleted file mode 100644 index f3a49454d..000000000 --- a/qemu/roms/SLOF/slof/fs/pci-class-code-names.fs +++ /dev/null @@ -1,264 +0,0 @@ -\ ***************************************************************************** -\ * Copyright (c) 2004, 2008 IBM Corporation -\ * All rights reserved. -\ * This program and the accompanying materials -\ * are made available under the terms of the BSD License -\ * which accompanies this distribution, and is available at -\ * http://www.opensource.org/licenses/bsd-license.php -\ * -\ * Contributors: -\ * IBM Corporation - initial implementation -\ ****************************************************************************/ - -: pci-class-name-00 ( addr -- str len ) - pci-class@ 8 rshift FF and CASE - 01 OF s" display" ENDOF - dup OF s" unknown-legacy-device" ENDOF - ENDCASE -; - -: pci-class-name-01 ( addr -- str len ) - pci-class@ 8 rshift FF and CASE - 00 OF s" scsi" ENDOF - 01 OF s" ide" ENDOF - 02 OF s" fdc" ENDOF - 03 OF s" ipi" ENDOF - 04 OF s" raid" ENDOF - 05 OF s" ata" ENDOF - 06 OF s" sata" ENDOF - 07 OF s" sas" ENDOF - dup OF s" mass-storage" ENDOF - ENDCASE -; - -: pci-class-name-02 ( addr -- str len ) - pci-class@ 8 rshift FF and CASE - 00 OF s" ethernet" ENDOF - 01 OF s" token-ring" ENDOF - 02 OF s" fddi" ENDOF - 03 OF s" atm" ENDOF - 04 OF s" isdn" ENDOF - 05 OF s" worldfip" ENDOF - 05 OF s" picmg" ENDOF - dup OF s" network" ENDOF - ENDCASE -; - -: pci-class-name-03 ( addr -- str len ) - pci-class@ FFFF and CASE - 0000 OF s" vga" ENDOF - 0001 OF s" 8514-compatible" ENDOF - 0100 OF s" xga" ENDOF - 0200 OF s" 3d-controller" ENDOF - dup OF s" display" ENDOF - ENDCASE -; - -: pci-class-name-04 ( addr -- str len ) - pci-class@ 8 rshift FF and CASE - 00 OF s" video" ENDOF - 01 OF s" sound" ENDOF - 02 OF s" telephony" ENDOF - dup OF s" multimedia-device" ENDOF - ENDCASE -; - -: pci-class-name-05 ( addr -- str len ) - pci-class@ 8 rshift FF and CASE - 00 OF s" memory" ENDOF - 01 OF s" flash" ENDOF - dup OF s" memory-controller" ENDOF - ENDCASE -; - -: pci-class-name-06 ( addr -- str len ) - pci-class@ 8 rshift FF and CASE - 00 OF s" host" ENDOF - 01 OF s" isa" ENDOF - 02 OF s" eisa" ENDOF - 03 OF s" mca" ENDOF - 04 OF s" pci" ENDOF - 05 OF s" pcmcia" ENDOF - 06 OF s" nubus" ENDOF - 07 OF s" cardbus" ENDOF - 08 OF s" raceway" ENDOF - 09 OF s" semi-transparent-pci" ENDOF - 0A OF s" infiniband" ENDOF - dup OF s" unkown-bridge" ENDOF - ENDCASE -; - -: pci-class-name-07 ( addr -- str len ) - pci-class@ FFFF and CASE - 0000 OF s" serial" ENDOF - 0001 OF s" 16450-serial" ENDOF - 0002 OF s" 16550-serial" ENDOF - 0003 OF s" 16650-serial" ENDOF - 0004 OF s" 16750-serial" ENDOF - 0005 OF s" 16850-serial" ENDOF - 0006 OF s" 16950-serial" ENDOF - 0100 OF s" parallel" ENDOF - 0101 OF s" bi-directional-parallel" ENDOF - 0102 OF s" ecp-1.x-parallel" ENDOF - 0103 OF s" ieee1284-controller" ENDOF - 01FE OF s" ieee1284-device" ENDOF - 0200 OF s" multiport-serial" ENDOF - 0300 OF s" modem" ENDOF - 0301 OF s" 16450-modem" ENDOF - 0302 OF s" 16550-modem" ENDOF - 0303 OF s" 16650-modem" ENDOF - 0304 OF s" 16750-modem" ENDOF - 0400 OF s" gpib" ENDOF - 0500 OF s" smart-card" ENDOF - dup OF s" communication-controller" ENDOF - ENDCASE -; - - -: pci-class-name-08 ( addr -- str len ) - pci-class@ FFFF and CASE - 0000 OF s" interrupt-controller" ENDOF - 0001 OF s" isa-pic" ENDOF - 0002 OF s" eisa-pic" ENDOF - 0010 OF s" io-apic" ENDOF - 0020 OF s" iox-apic" ENDOF - 0100 OF s" dma-controller" ENDOF - 0101 OF s" isa-dma" ENDOF - 0102 OF s" eisa-dma" ENDOF - 0200 OF s" timer" ENDOF - 0201 OF s" isa-system-timer" ENDOF - 0202 OF s" eisa-system-timer" ENDOF - 0300 OF s" rtc" ENDOF - 0301 OF s" isa-rtc" ENDOF - 0400 OF s" hot-plug-controller" ENDOF - 0500 OF s" sd-host-conrtoller" ENDOF - dup OF s" system-periphal" ENDOF - ENDCASE -; - -: pci-class-name-09 ( addr -- str len ) - pci-class@ 8 rshift FF and CASE - 00 OF s" keyboard" ENDOF - 01 OF s" pen" ENDOF - 02 OF s" mouse" ENDOF - 03 OF s" scanner" ENDOF - 04 OF s" gameport" ENDOF - dup OF s" input-controller" ENDOF - ENDCASE -; - -: pci-class-name-0A ( addr -- str len ) - pci-class@ 8 rshift FF and CASE - 00 OF s" dock" ENDOF - dup OF s" docking-station" ENDOF - ENDCASE -; - -: pci-class-name-0B ( addr -- str len ) - pci-class@ 8 rshift FF and CASE - 00 OF s" 386" ENDOF - 01 OF s" 486" ENDOF - 02 OF s" pentium" ENDOF - 10 OF s" alpha" ENDOF - 20 OF s" powerpc" ENDOF - 30 OF s" mips" ENDOF - 40 OF s" co-processor" ENDOF - dup OF s" cpu" ENDOF - ENDCASE -; - -: pci-class-name-0C ( addr -- str len ) - pci-class@ FFFF and CASE - 0000 OF s" firewire" ENDOF - 0100 OF s" access-bus" ENDOF - 0200 OF s" ssa" ENDOF - 0300 OF s" usb-uhci" ENDOF - 0310 OF s" usb-ohci" ENDOF - 0320 OF s" usb-ehci" ENDOF - 0330 OF s" usb-xhci" ENDOF - 0380 OF s" usb" ENDOF - 03FE OF s" usb-device" ENDOF - 0400 OF s" fibre-channel" ENDOF - 0500 OF s" smb" ENDOF - 0600 OF s" infiniband" ENDOF - 0700 OF s" ipmi-smic" ENDOF - 0701 OF s" ipmi-kbrd" ENDOF - 0702 OF s" ipmi-bltr" ENDOF - 0800 OF s" sercos" ENDOF - 0900 OF s" canbus" ENDOF - dup OF s" serial-bus" ENDOF - ENDCASE -; - -: pci-class-name-0D ( addr -- str len ) - pci-class@ 8 rshift FF and CASE - 00 OF s" irda" ENDOF - 01 OF s" consumer-ir" ENDOF - 10 OF s" rf-controller" ENDOF - 11 OF s" bluetooth" ENDOF - 12 OF s" broadband" ENDOF - 20 OF s" enet-802.11a" ENDOF - 21 OF s" enet-802.11b" ENDOF - dup OF s" wireless-controller" ENDOF - ENDCASE -; - - -: pci-class-name-0E ( addr -- str len ) - pci-class@ 8 rshift FF and CASE - dup OF s" intelligent-io" ENDOF - ENDCASE -; - -: pci-class-name-0F ( addr -- str len ) - pci-class@ 8 rshift FF and CASE - 01 OF s" satelite-tv" ENDOF - 02 OF s" satelite-audio" ENDOF - 03 OF s" satelite-voice" ENDOF - 04 OF s" satelite-data" ENDOF - dup OF s" satelite-devoce" ENDOF - ENDCASE -; - -: pci-class-name-10 ( addr -- str len ) - pci-class@ 8 rshift FF and CASE - 00 OF s" network-encryption" ENDOF - 01 OF s" entertainment-encryption" ENDOF - dup OF s" encryption" ENDOF - ENDCASE -; - -: pci-class-name-11 ( addr -- str len ) - pci-class@ 8 rshift FF and CASE - 00 OF s" dpio" ENDOF - 01 OF s" counter" ENDOF - 10 OF s" measurement" ENDOF - 20 OF s" managment-card" ENDOF - dup OF s" data-processing-controller" ENDOF - ENDCASE -; - -\ create a string holding the predefined Class-Code-Names -: pci-class-name ( addr -- str len ) - dup pci-class@ 10 rshift CASE - 00 OF pci-class-name-00 ENDOF - 01 OF pci-class-name-01 ENDOF - 02 OF pci-class-name-02 ENDOF - 03 OF pci-class-name-03 ENDOF - 04 OF pci-class-name-04 ENDOF - 05 OF pci-class-name-05 ENDOF - 06 OF pci-class-name-06 ENDOF - 07 OF pci-class-name-07 ENDOF - 08 OF pci-class-name-08 ENDOF - 09 OF pci-class-name-09 ENDOF - 0A OF pci-class-name-0A ENDOF - 0B OF pci-class-name-0B ENDOF - 0C OF pci-class-name-0C ENDOF - 0C OF pci-class-name-0D ENDOF - 0C OF pci-class-name-0E ENDOF - 0C OF pci-class-name-0F ENDOF - 0C OF pci-class-name-10 ENDOF - 0C OF pci-class-name-11 ENDOF - dup OF drop s" unknown" ENDOF - ENDCASE -; diff --git a/qemu/roms/SLOF/slof/fs/pci-config-bridge.fs b/qemu/roms/SLOF/slof/fs/pci-config-bridge.fs deleted file mode 100644 index 1efbcd804..000000000 --- a/qemu/roms/SLOF/slof/fs/pci-config-bridge.fs +++ /dev/null @@ -1,91 +0,0 @@ -\ ***************************************************************************** -\ * Copyright (c) 2004, 2011 IBM Corporation -\ * All rights reserved. -\ * This program and the accompanying materials -\ * are made available under the terms of the BSD License -\ * which accompanies this distribution, and is available at -\ * http://www.opensource.org/licenses/bsd-license.php -\ * -\ * Contributors: -\ * IBM Corporation - initial implementation -\ ****************************************************************************/ - -\ Generic config space access function - xt is execution token of rtas-config-xx -: config-xt ( config-addr xt -- data ) - puid >r \ Safe puid - my-puid TO puid \ Set my-puid - swap dup ffff00 AND 0= IF \ Has bus-device-function been specified? - my-space OR \ No: use my-space instead - THEN - swap execute \ Execute the rtas-config-xx function - r> TO puid \ Restore previous puid -; - -\ define the config reads -: config-b@ ( config-addr -- data ) ['] rtas-config-b@ config-xt ; -: config-w@ ( config-addr -- data ) ['] rtas-config-w@ config-xt ; -: config-l@ ( config-addr -- data ) ['] rtas-config-l@ config-xt ; - -\ define the config writes -: config-b! ( data config-addr -- ) ['] rtas-config-b! config-xt ; -: config-w! ( data config-addr -- ) ['] rtas-config-w! config-xt ; -: config-l! ( data config-addr -- ) ['] rtas-config-l! config-xt ; - -\ for Debug purposes: dumps the whole config space -: config-dump puid >r my-puid TO puid my-space pci-dump r> TO puid ; - -\ needed to find the right path in the device tree -: decode-unit ( addr len -- phys.lo ... phys.hi ) - 2 hex-decode-unit \ decode string - B lshift swap \ shift the devicenumber to the right spot - 8 lshift or \ add the functionnumber - my-bus 10 lshift or \ add the busnumber - 0 0 rot \ make phys.lo = 0 = phys.mid -; - -\ needed to have the right unit address in the device tree listing -\ phys.lo=phys.mid=0 , phys.hi=config-address -: encode-unit ( phys.lo ... phys.hi -- unit-str unit-len ) - nip nip \ forget the both zeros - dup 8 rshift 7 and swap \ calc Functionnumber - B rshift 1F and \ calc Devicenumber - over IF \ IF Function!=0 - 2 hex-encode-unit \ | create string with DevNum,FnNum - ELSE \ ELSE - nip 1 hex-encode-unit \ | create string with only DevNum - THEN \ FI -; - -: map-in ( phys.lo phys.mid phys.hi size -- virt ) - \ ." map-in called: " .s cr - \ Ignore the size, phys.lo and phys.mid, get BAR from config space - drop nip nip ( phys.hi ) - \ Sanity check whether config address is in expected range: - dup FF AND dup 10 28 WITHIN NOT swap 30 <> AND IF - cr ." phys.hi = " . cr - ABORT" map-in with illegal config space address" - THEN - 00FFFFFF AND \ Need only bus-dev-fn+register bits - dup config-l@ ( phys.hi' bar.lo ) - dup 7 AND 4 = IF \ Is it a 64-bit BAR? - swap 4 + config-l@ lxjoin \ Add upper part of 64-bit BAR - ELSE - nip - THEN - F NOT AND \ Clear indicator bits - \ TODO: Use translate-address here! -; - -: map-out ( virt size -- ) - \ ." map-out called: " .s cr - 2drop -; - -: dma-sync ( virt devaddr size -- ) - \ XXX should we add at least a memory barrier here? - \ ." dma-sync called: " .s cr - 2drop drop -; - -: open true ; -: close ; diff --git a/qemu/roms/SLOF/slof/fs/pci-device.fs b/qemu/roms/SLOF/slof/fs/pci-device.fs deleted file mode 100644 index 7b177585a..000000000 --- a/qemu/roms/SLOF/slof/fs/pci-device.fs +++ /dev/null @@ -1,105 +0,0 @@ -\ ***************************************************************************** -\ * Copyright (c) 2004, 2008 IBM Corporation -\ * All rights reserved. -\ * This program and the accompanying materials -\ * are made available under the terms of the BSD License -\ * which accompanies this distribution, and is available at -\ * http://www.opensource.org/licenses/bsd-license.php -\ * -\ * Contributors: -\ * IBM Corporation - initial implementation -\ ****************************************************************************/ - -get-node CONSTANT my-phandle - -\ get the PUID from the node above -s" my-puid" my-phandle parent $call-static CONSTANT my-puid - -\ define the config reads -: config-b@ puid >r my-puid TO puid my-space + rtas-config-b@ r> TO puid ; -: config-w@ puid >r my-puid TO puid my-space + rtas-config-w@ r> TO puid ; -: config-l@ puid >r my-puid TO puid my-space + rtas-config-l@ r> TO puid ; - -\ define the config writes -: config-b! puid >r my-puid TO puid my-space + rtas-config-b! r> TO puid ; -: config-w! puid >r my-puid TO puid my-space + rtas-config-w! r> TO puid ; -: config-l! puid >r my-puid TO puid my-space + rtas-config-l! r> TO puid ; - -\ for Debug purposes: dumps the whole config space -: config-dump puid >r my-puid TO puid my-space pci-dump r> TO puid ; - -\ prepare the device for subsequent use -\ this word should be overloaded by the device file (if present) -\ the device file can call this file before implementing -\ its own open functionality -: open - puid >r \ save the old puid - my-puid TO puid \ set up the puid to the devices Hostbridge - pci-master-enable \ And enable Bus Master, IO and MEM access again. - pci-mem-enable \ enable mem access - pci-io-enable \ enable io access - r> TO puid \ restore puid - true -; - -\ close the previously opened device -\ this word should be overloaded by the device file (if present) -\ the device file can call this file after its implementation -\ of own close functionality -: close - puid >r \ save the old puid - my-puid TO puid \ set up the puid - pci-device-disable \ and disable the device - r> TO puid \ restore puid -; - -s" dma-function.fs" included - -\ generate the rom-fs filename from the vendor and device ID "pci-device_VENDORID_DEVICEID.fs" -: devicefile ( -- str len ) - s" pci-device_" - my-space pci-vendor@ 4 int2str $cat - s" _" $cat - my-space pci-device@ 4 int2str $cat - s" .fs" $cat -; - -\ generate the rom-fs filename from the base-class id "pci-class_BASECLASS.fs" -: classfile ( -- str len ) - s" pci-class_" - my-space pci-class@ 10 rshift 2 int2str $cat - s" .fs" $cat -; - -\ Set up the device with either default or special settings -: setup ( -- ) - \ is there special handling for this device, given vendor and device id? - devicefile romfs-lookup ?dup - IF - \ give it a special treatment - evaluate - ELSE - classfile romfs-lookup ?dup - IF - \ give it a pci-class related treatment - evaluate - ELSE - \ no special handling for this device, attempt autoconfiguration - my-space pci-class-name type 2a emit cr - my-space pci-device-generic-setup - THEN - THEN -; - -\ Disable Bus Master, Memory Space and I/O Space for this device -\ if Bus Master function is needed it should be enabled/disabled by open/close in the device driver code -pci-device-disable - -\ Enalbe #PERR and #SERR reporting -pci-error-enable - -\ Print out device information -my-space 44 pci-out \ config-addr ascii('D') - -\ and set up the device -setup diff --git a/qemu/roms/SLOF/slof/fs/pci-helper.fs b/qemu/roms/SLOF/slof/fs/pci-helper.fs deleted file mode 100644 index a4f69f1f3..000000000 --- a/qemu/roms/SLOF/slof/fs/pci-helper.fs +++ /dev/null @@ -1,195 +0,0 @@ -\ ***************************************************************************** -\ * Copyright (c) 2004, 2011 IBM Corporation -\ * All rights reserved. -\ * This program and the accompanying materials -\ * are made available under the terms of the BSD License -\ * which accompanies this distribution, and is available at -\ * http://www.opensource.org/licenses/bsd-license.php -\ * -\ * Contributors: -\ * IBM Corporation - initial implementation -\ ****************************************************************************/ - -\ ---------------------------------------------------------- -\ **************** PCI Helper functions ******************* -\ ---------------------------------------------------------- - -\ convert an integer to string of len digits -: int2str ( int len -- str len ) swap s>d rot <# 0 ?DO # LOOP #> ; - -\ convert addr to busnr -: pci-addr2bus ( addr -- busnr ) 10 rshift FF and ; - -\ convert addr to devnr -: pci-addr2dev ( addr -- dev ) B rshift 1F and ; - -\ convert addr to functionnumber -: pci-addr2fn ( addr -- dev ) 8 rshift 7 and ; - -\ convert busnr devnr to addr -: pci-bus2addr ( busnr devnr -- addr ) B lshift swap 10 lshift + ; - -\ print out a pci config addr -: pci-addr-out ( addr -- ) dup pci-addr2bus 2 0.r space FFFF and 4 0.r ; - -\ Dump out the whole configspace -: pci-dump ( addr -- ) - 10 0 DO - dup - cr i 4 * + - dup pci-addr-out space - rtas-config-l@ 8 0.r - LOOP - drop cr -; - - -\ ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -\ the following functions use l@ to fetch the data, -\ that's because the some pcie cores have probs with w@ -\ ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ - -\ read Vendor ID -: pci-vendor@ ( addr -- id ) rtas-config-l@ FFFF and ; - -\ read Device ID -: pci-device@ ( addr -- id ) rtas-config-l@ 10 rshift ; - -\ read Status -: pci-status@ ( addr -- status ) 4 + rtas-config-l@ 10 rshift ; - -\ read Revision ID -: pci-revision@ ( addr -- id ) 8 + rtas-config-b@ ; - -\ read Class Code -: pci-class@ ( addr -- class ) 8 + rtas-config-l@ 8 rshift ; - -\ read Cache Line Size -: pci-cache@ ( addr -- size ) C + rtas-config-b@ ; - -\ read Header Type -: pci-htype@ ( addr -- type ) E + rtas-config-b@ ; - -\ read Sub Vendor ID -: pci-sub-vendor@ ( addr -- sub-id ) 2C + rtas-config-l@ FFFF and ; - -\ read Sub Device ID -: pci-sub-device@ ( addr -- sub-id ) 2C + rtas-config-l@ 10 rshift FFFF and ; - -\ read Interrupt Pin -: pci-interrupt@ ( addr -- interrupt ) 3D + rtas-config-b@ ; - -\ read Minimum Grant -: pci-min-grant@ ( addr -- min-gnt ) 3E + rtas-config-b@ ; - -\ read Maximum Latency -: pci-max-lat@ ( addr -- max-lat ) 3F + rtas-config-b@ ; - -\ Check if Capabilities are valid -: pci-capabilities? ( addr -- 0|1 ) pci-status@ 4 rshift 1 and ; - -\ fetch the offset of the next capability -: pci-cap-next ( cap-addr -- next-cap-off ) rtas-config-b@ FC and ; - -\ calc the address of the next capability -: pci-cap-next-addr ( cap-addr -- next-cap-addr ) 1+ dup pci-cap-next dup IF swap -100 and + ELSE nip THEN ; - - -\ Dump out all capabilities -: pci-cap-dump ( addr -- ) - cr - dup pci-capabilities? IF - 33 + BEGIN - pci-cap-next-addr dup 0<> - WHILE - dup pci-addr-out s" : " type - dup rtas-config-b@ 2 0.r cr - REPEAT - s" end found " - ELSE - s" capabilities not enabled!" - THEN - type cr drop -; - -\ search the capability-list for this id -: pci-cap-find ( addr id -- capp-addr|0 ) - swap dup pci-capabilities? IF - 33 + BEGIN - pci-cap-next-addr dup 0<> IF - dup rtas-config-b@ 2 pick = - ELSE - true - THEN - UNTIL - nip - ELSE - 2drop 0 - THEN -; - -\ check wether this device is a pci-express device -: pci-express? ( addr -- 0|1 ) 10 pci-cap-find 0<> ; - -\ check wether this device is a pci-express device -: pci-x? ( addr -- 0|1 ) 07 pci-cap-find 0<> ; - -\ check wether this device has extended config space -: pci-config-ext? ( addr -- 0|1 ) pci-express? ; - - -\ Disable Bus Master, Memory Space and I/O Space for this device -: pci-device-disable ( -- ) my-space 4 + dup rtas-config-l@ 7 invert and swap rtas-config-l! ; - -\ Enable Bus Master -: pci-master-enable ( -- ) my-space 4 + dup rtas-config-l@ 4 or swap rtas-config-l! ; - -\ Disable Bus Master -: pci-master-disable ( -- ) my-space 4 + dup rtas-config-l@ 4 invert and swap rtas-config-l! ; - -\ Enable response to mem accesses of pci device -: pci-mem-enable ( -- ) my-space 4 + dup rtas-config-w@ 2 or swap rtas-config-w! ; - -\ Enable response to I/O accesses of pci-device -: pci-io-enable ( -- ) my-space 4 + dup rtas-config-w@ 1 or swap rtas-config-w! ; - -\ Enable Bus Master, I/O and mem access -: pci-enable ( -- ) my-space 4 + dup rtas-config-w@ 7 or swap rtas-config-w! ; - -\ Enable #PERR and #SERR errors of pci-device -: pci-error-enable ( -- ) my-space 4 + dup rtas-config-w@ 140 or swap rtas-config-w! ; - -\ prints out the ScanInformation about a device -\ char is a sign for device type e.g. D - device ; B - bridge -: pci-out ( addr char -- ) - 15 spaces - over pci-addr-out - s" (" type emit s" ) : " type - dup pci-vendor@ 4 0.r space - pci-device@ 4 0.r - 4 spaces -; - - -\ set and fetch the interrupt Pin -: pci-irq-line@ ( addr -- irq-pin ) 3C + rtas-config-b@ ; -: pci-irq-line! ( pin addr -- ) 3C + rtas-config-b! ; - -\ set and fetch primary bus number -: pci-bus-prim! ( nr addr -- ) 18 + dup rtas-config-l@ FFFFFF00 and rot + swap rtas-config-l! ; -: pci-bus-prim@ ( addr -- nr ) 18 + rtas-config-l@ FF and ; - -\ set and fetch secondary bus number -: pci-bus-scnd! ( nr addr -- ) 18 + dup rtas-config-l@ FFFF00FF and rot 8 lshift + swap rtas-config-l! ; -: pci-bus-scnd@ ( addr -- nr ) 18 + rtas-config-l@ 8 rshift FF and ; - -\ set and fetch subordinate bus number -: pci-bus-subo! ( nr addr -- ) 18 + dup rtas-config-l@ FF00FFFF and rot 10 lshift + swap rtas-config-l! ; -: pci-bus-subo@ ( addr -- nr ) 18 + rtas-config-l@ 10 rshift FF and ; - -\ set and fetch primary, secondary and subordinate bus number -: pci-bus! ( subo scnd prim addr -- ) swap rot 8 lshift + rot 10 lshift + swap 18 + dup rtas-config-l@ FF000000 and rot + swap rtas-config-l! ; -: pci-bus@ ( addr -- subo scnd prim ) 18 + rtas-config-l@ dup 10 rshift FF and swap dup 8 rshift FF and swap FF and ; - -\ Reset secondary Status -: pci-reset-2nd ( addr -- ) 1C + dup rtas-config-l@ FFFF0000 or swap rtas-config-l! ; diff --git a/qemu/roms/SLOF/slof/fs/pci-properties.fs b/qemu/roms/SLOF/slof/fs/pci-properties.fs deleted file mode 100644 index 4f134024f..000000000 --- a/qemu/roms/SLOF/slof/fs/pci-properties.fs +++ /dev/null @@ -1,668 +0,0 @@ -\ ***************************************************************************** -\ * Copyright (c) 2004, 2008 IBM Corporation -\ * All rights reserved. -\ * This program and the accompanying materials -\ * are made available under the terms of the BSD License -\ * which accompanies this distribution, and is available at -\ * http://www.opensource.org/licenses/bsd-license.php -\ * -\ * Contributors: -\ * IBM Corporation - initial implementation -\ ****************************************************************************/ - -#include "pci-class-code-names.fs" - -\ read the various bar type sizes -: pci-bar-size@ ( bar-addr -- bar-size ) -1 over rtas-config-l! rtas-config-l@ ; -: pci-bar-size-mem@ ( bar-addr -- mem-size ) pci-bar-size@ -10 and invert 1+ FFFFFFFF and ; -: pci-bar-size-io@ ( bar-addr -- io-size ) pci-bar-size@ -4 and invert 1+ FFFFFFFF and ; - -\ fetch raw bar size but keep original BAR value -: pci-bar-size ( bar-addr -- bar-size-raw ) - dup rtas-config-l@ swap \ fetch original Value ( bval baddr ) - -1 over rtas-config-l! \ make BAR show size ( bval baddr ) - dup rtas-config-l@ \ and fetch the size ( bval baddr bsize ) - -rot rtas-config-l! \ restore Value -; - -\ calc 32 bit MEM BAR size -: pci-bar-size-mem32 ( bar-addr -- bar-size ) - pci-bar-size \ fetch raw size - -10 and invert 1+ \ calc size - FFFFFFFF and \ keep lower 32 bits -; - -\ calc 32 bit ROM BAR size -: pci-bar-size-rom ( bar-addr -- bar-size ) - pci-bar-size \ fetch raw size - FFFFF800 and invert 1+ \ calc size - FFFFFFFF and \ keep lower 32 bits -; - -\ calc 64 bit MEM BAR size -: pci-bar-size-mem64 ( bar-addr -- bar-size ) - dup pci-bar-size \ fetch raw size lower 32 bits - swap 4 + pci-bar-size \ fetch raw size upper 32 bits - 20 lshift + \ and put them together - -10 and invert 1+ \ calc size -; - -\ calc IO BAR size -: pci-bar-size-io ( bar-addr -- bar-size ) - pci-bar-size \ fetch raw size - -4 and invert 1+ \ calc size - FFFFFFFF and \ keep lower 32 bits -; - - -\ decode the Bar Type -\ +----------------------------------------------------------------------------------------+ -\ | 3 2 1 0 | -\ | +----------------------------+-+--+-+ | -\ | MEM-BAR : | Base Address |P|TT|0| P - prefechtable ; TT - 00 : 32 Bit | -\ | +----------------------------+-+--+-+ 10 : 64 Bit | -\ | +-------------------------------+-+-+ | -\ | IO-BAR : | Base Address |0|1| | -\ | +-------------------------------+-+-+ | -\ | That is: 0 - no encoded BarType | -\ | 1 - IO - Bar | -\ | 2 - Memory 32 Bit | -\ | 3 - Memory 32 Bit prefetchable | -\ | 4 - Memory 64 Bit | -\ | 5 - Memory 64 Bit prefetchable | -\ +----------------------------------------------------------------------------------------+ -: pci-bar-code@ ( bar-addr -- 0|1..4|5 ) - rtas-config-l@ dup \ fetch the BaseAddressRegister - 1 and IF \ IO BAR ? - 2 and IF 0 ELSE 1 THEN \ only '01' is valid - ELSE \ Memory BAR ? - F and CASE - 0 OF 2 ENDOF \ Memory 32 Bit Non-Prefetchable - 8 OF 3 ENDOF \ Memory 32 Bit Prefetchable - 4 OF 4 ENDOF \ Memory 64 Bit Non-Prefetchable - C OF 5 ENDOF \ Memory 64 Bit Prefechtable - dup OF 0 ENDOF \ Not a valid BarType - ENDCASE - THEN -; - -\ *************************************************************************************** -\ Assigning the new Value to the BARs -\ *************************************************************************************** -\ align the current mem and set var to next mem -\ align with a size of 0 returns 0 !!! -: assign-var ( size var -- al-mem ) - 2dup @ \ ( size var size cur-mem ) read current free mem - swap #aligned \ ( size var al-mem ) align the mem to the size - dup 2swap -rot + \ ( al-mem var new-mem ) add size to aligned mem - swap ! \ ( al-mem ) set variable to new mem -; - -\ set bar to current free mem ( in variable ) and set variable to next free mem -: assign-bar-value32 ( bar size var -- 4 ) - over IF \ IF size > 0 - assign-var \ | ( bar al-mem ) set variable to next mem - swap rtas-config-l! \ | ( -- ) set the bar to al-mem - ELSE \ ELSE - 2drop drop \ | clear stack - THEN \ FI - 4 \ size of the base-address-register -; - -\ set bar to current free mem ( in variable ) and set variable to next free mem -: assign-bar-value64 ( bar size var -- 8 ) - over IF \ IF size > 0 - assign-var \ | ( bar al-mem ) set variable to next mem - swap \ | ( al-mem addr ) calc config-addr of this bar - 2dup rtas-config-l! \ | ( al-mem addr ) set the Lower part of the bar to al-mem - 4 + swap 20 rshift \ | ( al-mem>>32 addr ) prepare the upper part of the al-mem - swap rtas-config-l! \ | ( -- ) and set the upper part of the bar - ELSE \ ELSE - 2drop drop \ | clear stack - THEN \ FI - 8 \ size of the base-address-register -; - -\ Setup a prefetchable 64bit BAR and return its size -: assign-mem64-bar ( bar-addr -- 8 ) - dup pci-bar-size-mem64 \ fetch size - pci-next-mem64 @ 0 = IF \ Check if we have 64-bit memory range - pci-next-mem - ELSE - pci-next-mem64 - THEN - assign-bar-value64 \ and set it all -; - -\ Setup a prefetchable 32bit BAR and return its size -: assign-mem32-bar ( bar-addr -- 4 ) - dup pci-bar-size-mem32 \ fetch size - pci-next-mem \ var to change - assign-bar-value32 \ and set it all -; - -\ Setup a non-prefetchable 64bit BAR and return its size -: assign-mmio64-bar ( bar-addr -- 8 ) - dup pci-bar-size-mem64 \ fetch size - pci-next-mem64 @ 0 = IF \ Check if we have 64-bit memory range - pci-next-mmio - ELSE - pci-next-mem64 \ for board-qemu we will use same range - THEN - assign-bar-value64 \ and set it all -; - -\ Setup a non-prefetchable 32bit BAR and return its size -: assign-mmio32-bar ( bar-addr -- 4 ) - dup pci-bar-size-mem32 \ fetch size - pci-next-mmio \ var to change - assign-bar-value32 \ and set it all -; - -\ Setup an IO-Bar and return the size of the base-address-register -: assign-io-bar ( bar-addr -- 4 ) - dup pci-bar-size-io \ fetch size - pci-next-io \ var to change - assign-bar-value32 \ and set it all -; - -\ Setup an Expansion ROM bar -: assign-rom-bar ( bar-addr -- ) - dup pci-bar-size-rom \ fetch size - dup IF \ IF size > 0 - over >r \ | save bar addr for enable - pci-next-mmio \ | var to change - assign-bar-value32 \ | and set it - drop \ | forget the BAR length - r@ rtas-config-l@ \ | fetch BAR - 1 or r> rtas-config-l! \ | and enable the ROM - ELSE \ ELSE - 2drop \ | clear stack - THEN -; - -\ Setup the BAR due to its type and return the size of the register (4 or 8 Bytes ) used as increment for the BAR-Loop -: assign-bar ( bar-addr -- reg-size ) - dup pci-bar-code@ \ calc BAR type - dup IF \ IF >0 - CASE \ | CASE Setup the right type - 1 OF assign-io-bar ENDOF \ | - set up an IO-Bar - 2 OF assign-mmio32-bar ENDOF \ | - set up an 32bit MMIO-Bar - 3 OF assign-mem32-bar ENDOF \ | - set up an 32bit MEM-Bar (prefetchable) - 4 OF assign-mmio64-bar ENDOF \ | - set up an 64bit MMIO-Bar - 5 OF assign-mem64-bar ENDOF \ | - set up an 64bit MEM-Bar (prefetchable) - ENDCASE \ | ESAC - ELSE \ ELSE - ABORT \ | Throw an exception - THEN \ FI -; - -\ Setup all the bars of a pci device -: assign-all-device-bars ( configaddr -- ) - 28 10 DO \ BARs start at 10 and end at 27 - dup i + \ calc config-addr of the BAR - assign-bar \ and set it up - +LOOP \ add 4 or 8 to the index and loop - 30 + assign-rom-bar \ set up the ROM if available -; - -\ Setup all the bars of a pci device -: assign-all-bridge-bars ( configaddr -- ) - 18 10 DO \ BARs start at 10 and end at 17 - dup i + \ calc config-addr of the BAR - assign-bar \ and set it up - +LOOP \ add 4 or 8 to the index and loop - 38 + assign-rom-bar \ set up the ROM if available -; - -\ +---------------------------------------------------------------------------------------+ -\ | Numerical Representaton of a PCI address (PCI Bus Binding 2.2.1.1) | -\ | | -\ | 31 24 16 11 8 0 | -\ | +--------+--------+-----+---+--------+ | -\ | phys.hi: |npt000ss| bus | dev |fnc| reg | n - 0 relocatable | -\ | +--------+--------+-----+---+--------+ p - 1 prefetchable | -\ | t - 1 aliased or <1MB or <64KB | -\ | ss - 00 Configuration Space | -\ | 01 I/O Space | -\ | 10 Memory Space 32bits | -\ | 11 Memory Space 64bits | -\ +---------------------------------------------------------------------------------------+ - -\ *************************************************************************************** -\ Generating the assigned-addresses property -\ *************************************************************************************** -\ generate assigned-addresses property for 64Bit MEM-BAR and return BAR-reg-size -: gen-mem64-bar-prop ( prop-addr prop-len bar-addr -- prop-addr prop-len 8 ) - dup pci-bar-size-mem64 \ fetch BAR Size ( paddr plen baddr bsize ) - dup IF \ IF Size > 0 - >r dup rtas-config-l@ \ | save size and fetch lower 32 bits ( paddr plen baddr val.lo R: size) - over 4 + rtas-config-l@ \ | fetch upper 32 bits ( paddr plen baddr val.lo val.hi R: size) - 20 lshift + -10 and >r \ | calc 64 bit value and save it ( paddr plen baddr R: size val ) - 83000000 or encode-int+ \ | Encode config addr ( paddr plen R: size val ) - r> encode-64+ \ | Encode assigned addr ( paddr plen R: size ) - r> encode-64+ \ | Encode size ( paddr plen ) - ELSE \ ELSE - 2drop \ | don't do anything - THEN \ FI - 8 \ sizeof(BAR) = 8 Bytes -; - -\ generate assigned-addresses property for prefetchable 64Bit MEM-BAR and return BAR-reg-size -: gen-pmem64-bar-prop ( prop-addr prop-len bar-addr -- prop-addr prop-len 8 ) - dup pci-bar-size-mem64 \ fetch BAR Size ( paddr plen baddr bsize ) - dup IF \ IF Size > 0 - >r dup rtas-config-l@ \ | save size and fetch lower 32 bits ( paddr plen baddr val.lo R: size) - over 4 + rtas-config-l@ \ | fetch upper 32 bits ( paddr plen baddr val.lo val.hi R: size) - 20 lshift + -10 and >r \ | calc 64 bit value and save it ( paddr plen baddr R: size val ) - C3000000 or encode-int+ \ | Encode config addr ( paddr plen R: size val ) - r> encode-64+ \ | Encode assigned addr ( paddr plen R: size ) - r> encode-64+ \ | Encode size ( paddr plen ) - ELSE \ ELSE - 2drop \ | don't do anything - THEN \ FI - 8 \ sizeof(BAR) = 8 Bytes -; - -\ generate assigned-addresses property for 32Bit MEM-BAR and return BAR-reg-size -: gen-mem32-bar-prop ( prop-addr prop-len bar-addr -- prop-addr prop-len 4 ) - dup pci-bar-size-mem32 \ fetch BAR Size ( paddr plen baddr bsize ) - dup IF \ IF Size > 0 - >r dup rtas-config-l@ \ | save size and fetch value ( paddr plen baddr val R: size) - -10 and >r \ | calc 32 bit value and save it ( paddr plen baddr R: size val ) - 82000000 or encode-int+ \ | Encode config addr ( paddr plen R: size val ) - r> encode-64+ \ | Encode assigned addr ( paddr plen R: size ) - r> encode-64+ \ | Encode size ( paddr plen ) - ELSE \ ELSE - 2drop \ | don't do anything - THEN \ FI - 4 \ sizeof(BAR) = 4 Bytes -; - -\ generate assigned-addresses property for prefetchable 32Bit MEM-BAR and return BAR-reg-size -: gen-pmem32-bar-prop ( prop-addr prop-len bar-addr -- prop-addr prop-len 4 ) - dup pci-bar-size-mem32 \ fetch BAR Size ( paddr plen baddr bsize ) - dup IF \ IF Size > 0 - >r dup rtas-config-l@ \ | save size and fetch value ( paddr plen baddr val R: size) - -10 and >r \ | calc 32 bit value and save it ( paddr plen baddr R: size val ) - C2000000 or encode-int+ \ | Encode config addr ( paddr plen R: size val ) - r> encode-64+ \ | Encode assigned addr ( paddr plen R: size ) - r> encode-64+ \ | Encode size ( paddr plen ) - ELSE \ ELSE - 2drop \ | don't do anything - THEN \ FI - 4 \ sizeof(BAR) = 4 Bytes -; - -\ generate assigned-addresses property for IO-BAR and return BAR-reg-size -: gen-io-bar-prop ( prop-addr prop-len bar-addr -- prop-addr prop-len 4 ) - dup pci-bar-size-io \ fetch BAR Size ( paddr plen baddr bsize ) - dup IF \ IF Size > 0 - >r dup rtas-config-l@ \ | save size and fetch value ( paddr plen baddr val R: size) - -4 and >r \ | calc 32 bit value and save it ( paddr plen baddr R: size val ) - 81000000 or encode-int+ \ | Encode config addr ( paddr plen R: size val ) - r> encode-64+ \ | Encode assigned addr ( paddr plen R: size ) - r> encode-64+ \ | Encode size ( paddr plen ) - ELSE \ ELSE - 2drop \ | don't do anything - THEN \ FI - 4 \ sizeof(BAR) = 4 Bytes -; - -\ generate assigned-addresses property for ROM-BAR -: gen-rom-bar-prop ( prop-addr prop-len bar-addr -- prop-addr prop-len ) - dup pci-bar-size-rom \ fetch BAR Size ( paddr plen baddr bsize ) - dup IF \ IF Size > 0 - >r dup rtas-config-l@ \ | save size and fetch value ( paddr plen baddr val R: size) - FFFFF800 and >r \ | calc 32 bit value and save it ( paddr plen baddr R: size val ) - 82000000 or encode-int+ \ | Encode config addr ( paddr plen R: size val ) - r> encode-64+ \ | Encode assigned addr ( paddr plen R: size ) - r> encode-64+ \ | Encode size ( paddr plen ) - ELSE \ ELSE - 2drop \ | don't do anything - THEN \ FI -; - -\ add another BAR to the assigned addresses property and return the size of the encoded register -: pci-add-assigned-address ( prop-addr prop-len bar-addr -- prop-addr prop-len bsize ) - dup pci-bar-code@ \ calc BAR type ( paddr plen baddr btype) - CASE \ CASE for the BAR types ( paddr plen baddr ) - 0 OF drop 4 ENDOF \ - not a valid type so do nothing - 1 OF gen-io-bar-prop ENDOF \ - IO-BAR - 2 OF gen-mem32-bar-prop ENDOF \ - MEM32 - 3 OF gen-pmem32-bar-prop ENDOF \ - MEM32 prefetchable - 4 OF gen-mem64-bar-prop ENDOF \ - MEM64 - 5 OF gen-pmem64-bar-prop ENDOF \ - MEM64 prefetchable - ENDCASE \ ESAC ( paddr plen bsize ) -; - -\ generate the assigned address property for a PCI device -: pci-device-assigned-addresses-prop ( addr -- ) - encode-start \ provide mem for property ( addr paddr plen ) - 2 pick 30 + gen-rom-bar-prop \ assign the rom bar - 28 10 DO \ we have 6 possible BARs - 2 pick i + \ calc BAR address ( addr paddr plen bar-addr ) - pci-add-assigned-address \ and generate the props for the BAR - +LOOP \ increase Index by returned len - s" assigned-addresses" property drop \ and write it into the device tree -; - -\ generate the assigned address property for a PCI bridge -: pci-bridge-assigned-addresses-prop ( addr -- ) - encode-start \ provide mem for property - 2 pick 38 + gen-rom-bar-prop \ assign the rom bar - 18 10 DO \ we have 2 possible BARs - 2 pick i + \ ( addr paddr plen current-addr ) - pci-add-assigned-address \ and generate the props for the BAR - +LOOP \ increase Index by returned len - s" assigned-addresses" property drop \ and write it into the device tree -; - -\ check if the range is valid and if so encode it into -\ child.hi child.mid child.lo parent.hi parent.mid parent.lo size.hi size.lo -\ This is needed to translate the childrens addresses -\ We implement only 1:1 mapping for all PCI bridges -: pci-bridge-gen-range ( paddr plen base limit type -- paddr plen ) - >r over - \ calc size ( paddr plen base size R:type ) - dup 0< IF \ IF Size < 0 ( paddr plen base size R:type ) - 2drop r> drop \ | forget values ( paddr plen ) - ELSE \ ELSE - 1+ swap 2swap \ | adjust stack ( size base paddr plen R:type ) - r@ encode-int+ \ | Child type ( size base paddr plen R:type ) - 2 pick encode-64+ \ | Child address ( size base paddr plen R:type ) - r> encode-int+ \ | Parent type ( size base paddr plen ) - rot encode-64+ \ | Parent address ( size paddr plen ) - rot encode-64+ \ | Encode size ( paddr plen ) - THEN \ FI -; - - -\ generate an mmio space to the ranges property -: pci-bridge-gen-mmio-range ( addr prop-addr prop-len -- addr prop-addr prop-len ) - 2 pick 20 + rtas-config-l@ \ fetch Value ( addr paddr plen val ) - dup 0000FFF0 and 10 lshift \ calc base-address ( addr paddr plen val base ) - swap 000FFFFF or \ calc limit-address ( addr paddr plen base limit ) - 02000000 pci-bridge-gen-range \ and generate it ( addr paddr plen ) -; - -\ generate an mem space to the ranges property -: pci-bridge-gen-mem-range ( addr prop-addr prop-len -- addr prop-addr prop-len ) - 2 pick 24 + rtas-config-l@ \ fetch Value ( addr paddr plen val ) - dup 000FFFFF or \ calc limit Bits 31:0 ( addr paddr plen val limit.31:0 ) - swap 0000FFF0 and 10 lshift \ calc base Bits 31:0 ( addr paddr plen limit.31:0 base.31:0 ) - 4 pick 28 + rtas-config-l@ \ fetch upper Basebits ( addr paddr plen limit.31:0 base.31:0 base.63:32 ) - 20 lshift or swap \ and calc Base ( addr paddr plen base.63:0 limit.31:0 ) - 4 pick 2C + rtas-config-l@ \ fetch upper Limitbits ( addr paddr plen base.63:0 limit.31:0 limit.63:32 ) - 20 lshift or \ and calc Limit ( addr paddr plen base.63:0 limit.63:0 ) - 42000000 pci-bridge-gen-range \ and generate it ( addr paddr plen ) -; - -\ generate an io space to the ranges property -: pci-bridge-gen-io-range ( addr prop-addr prop-len -- addr prop-addr prop-len ) - 2 pick 1C + rtas-config-l@ \ fetch Value ( addr paddr plen val ) - dup 0000F000 and 00000FFF or \ calc Limit Bits 15:0 ( addr paddr plen val limit.15:0 ) - swap 000000F0 and 8 lshift \ calc Base Bits 15:0 ( addr paddr plen limit.15:0 base.15:0 ) - 4 pick 30 + rtas-config-l@ \ fetch upper Bits ( addr paddr plen limit.15:0 base.15:0 val ) - dup FFFF and 10 lshift rot or \ calc Base ( addr paddr plen limit.15:0 val base.31:0 ) - -rot FFFF0000 and or \ calc Limit ( addr paddr plen base.31:0 limit.31:0 ) - 01000000 pci-bridge-gen-range \ and generate it ( addr paddr plen ) -; - -\ generate the ranges property for a PCI bridge -: pci-bridge-range-props ( addr -- ) - encode-start \ provide mem for property - pci-bridge-gen-mmio-range \ generate the non prefetchable Memory Entry - pci-bridge-gen-mem-range \ generate the prefetchable Memory Entry - pci-bridge-gen-io-range \ generate the IO Entry - dup IF \ IF any space present (propsize>0) - s" ranges" property \ | write it into the device tree - ELSE \ ELSE - s" " s" ranges" property - 2drop \ | forget the properties - THEN \ FI - drop \ forget the address -; - -\ create the interrupt map for this bridge -: pci-bridge-interrupt-map ( -- ) - encode-start \ create the property ( paddr plen ) - get-node child \ find the first child ( paddr plen handle ) - BEGIN dup WHILE \ Loop as long as the handle is non-zero ( paddr plen handle ) - dup >r >space \ Get the my-space ( paddr plen addr R: handle ) - pci-gen-irq-entry \ and Encode the interrupt settings ( paddr plen R: handle) - r> peer \ Get neighbour ( paddr plen handle ) - REPEAT \ process next childe node ( paddr plen handle ) - drop \ forget the null ( paddr plen ) - s" interrupt-map" property \ and set it ( -- ) - 1 encode-int s" #interrupt-cells" property \ encode the cell# - f800 encode-int 0 encode-int+ 0 encode-int+ \ encode the bit mask for config addr (Dev only) - 7 encode-int+ s" interrupt-map-mask" property \ encode IRQ#=7 and generate property -; - -\ *************************************************************************************** -\ Generating the reg property -\ *************************************************************************************** -\ reg = config-addr 0 0 0 0 [BAR-config-addr 0 0 size.high size.low] - -\ encode the reg prop for a nonprefetchable 32bit MEM-BAR -: encode-mem32-bar ( prop-addr prop-len BAR-addr -- prop-addr prop-len 4 ) - dup pci-bar-size-mem32 \ calc BAR-size ( not changing the BAR ) - dup IF \ IF BAR-size > 0 ( paddr plen baddr bsize ) - >r 02000000 or encode-int+ \ | save size and encode BAR addr - 0 encode-64+ \ | make mid and lo zero - r> encode-64+ \ | encode size - ELSE \ ELSE - 2drop \ | don't do anything - THEN \ FI - 4 \ BAR-Len = 4 (32Bit) -; - -\ encode the reg prop for a prefetchable 32bit MEM-BAR -: encode-pmem32-bar ( prop-addr prop-len BAR-addr -- prop-addr prop-len 4 ) - dup pci-bar-size-mem32 \ calc BAR-size ( not changing the BAR ) - dup IF \ IF BAR-size > 0 ( paddr plen baddr bsize ) - >r 42000000 or encode-int+ \ | save size and encode BAR addr - 0 encode-64+ \ | make mid and lo zero - r> encode-64+ \ | encode size - ELSE \ ELSE - 2drop \ | don't do anything - THEN \ FI - 4 \ BAR-Len = 4 (32Bit) -; - -\ encode the reg prop for a nonprefetchable 64bit MEM-BAR -: encode-mem64-bar ( prop-addr prop-len BAR-addr -- prop-addr prop-len 8 ) - dup pci-bar-size-mem64 \ calc BAR-size ( not changing the BAR ) - dup IF \ IF BAR-size > 0 ( paddr plen baddr bsize ) - >r 03000000 or encode-int+ \ | save size and encode BAR addr - 0 encode-64+ \ | make mid and lo zero - r> encode-64+ \ | encode size - ELSE \ ELSE - 2drop \ | don't do anything - THEN \ FI - 8 \ BAR-Len = 8 (64Bit) -; - -\ encode the reg prop for a prefetchable 64bit MEM-BAR -: encode-pmem64-bar ( prop-addr prop-len BAR-addr -- prop-addr prop-len 8 ) - dup pci-bar-size-mem64 \ calc BAR-size ( not changing the BAR ) - dup IF \ IF BAR-size > 0 ( paddr plen baddr bsize ) - >r 43000000 or encode-int+ \ | save size and encode BAR addr - 0 encode-64+ \ | make mid and lo zero - r> encode-64+ \ | encode size - ELSE \ ELSE - 2drop \ | don't do anything - THEN \ FI - 8 \ BAR-Len = 8 (64Bit) -; - -\ encode the reg prop for a ROM-BAR -: encode-rom-bar ( prop-addr prop-len configaddr -- prop-addr prop-len ) - dup pci-bar-size-rom \ fetch raw BAR-size - dup IF \ IF BAR is used - >r 02000000 or encode-int+ \ | save size and encode BAR addr - 0 encode-64+ \ | make mid and lo zero - r> encode-64+ \ | calc and encode the size - ELSE \ ELSE - 2drop \ | don't do anything - THEN \ FI -; - -\ encode the reg prop for an IO-BAR -: encode-io-bar ( prop-addr prop-len BAR-addr BAR-value -- prop-addr prop-len 4 ) - dup pci-bar-size-io \ calc BAR-size ( not changing the BAR ) - dup IF \ IF BAR-size > 0 ( paddr plen baddr bsize ) - >r 01000000 or encode-int+ \ | save size and encode BAR addr - 0 encode-64+ \ | make mid and lo zero - r> encode-64+ \ | encode size - ELSE \ ELSE - 2drop \ | don't do anything - THEN \ FI - 4 \ BAR-Len = 4 (32Bit) -; - -\ write the representation of this BAR into the reg property -: encode-bar ( prop-addr prop-len bar-addr -- prop-addr prop-len bar-len ) - dup pci-bar-code@ \ calc BAR type - CASE \ CASE for the BAR types ( paddr plen baddr val ) - 0 OF drop 4 ENDOF \ - not a valid type so do nothing - 1 OF encode-io-bar ENDOF \ - IO-BAR - 2 OF encode-mem32-bar ENDOF \ - MEM32 - 3 OF encode-pmem32-bar ENDOF \ - MEM32 prefetchable - 4 OF encode-mem64-bar ENDOF \ - MEM64 - 5 OF encode-pmem64-bar ENDOF \ - MEM64 prefetchable - ENDCASE \ ESAC ( paddr plen blen ) -; - -\ Setup reg property -\ first encode the configuration space address -: pci-reg-props ( configaddr -- ) - dup encode-int \ configuration space ( caddr paddr plen ) - 0 encode-64+ \ make the rest 0 - 0 encode-64+ \ encode the size as 0 - 2 pick pci-htype@ \ fetch Header Type ( caddr paddr plen type ) - 1 and IF \ IF Bridge ( caddr paddr plen ) - 18 10 DO \ | loop over all BARs - 2 pick i + \ | calc bar-addr ( caddr paddr plen baddr ) - encode-bar \ | encode this BAR ( caddr paddr plen blen ) - +LOOP \ | increase LoopIndex by the BARlen - 2 pick 38 + \ | calc ROM-BAR for a bridge ( caddr paddr plen baddr ) - encode-rom-bar \ | encode the ROM-BAR ( caddr paddr plen ) - ELSE \ ELSE ordinary device ( caddr paddr plen ) - 28 10 DO \ | loop over all BARs - 2 pick i + \ | calc bar-addr ( caddr paddr plen baddr ) - encode-bar \ | encode this BAR ( caddr paddr plen blen ) - +LOOP \ | increase LoopIndex by the BARlen - 2 pick 30 + \ | calc ROM-BAR for a device ( caddr paddr plen baddr ) - encode-rom-bar \ | encode the ROM-BAR ( caddr paddr plen ) - THEN \ FI ( caddr paddr plen ) - s" reg" property \ and store it into the property - drop -; - -\ *************************************************************************************** -\ Generating common properties -\ *************************************************************************************** -\ set up common properties for devices and bridges -: pci-common-props ( addr -- ) - dup pci-class-name device-name - dup pci-vendor@ encode-int s" vendor-id" property - dup pci-device@ encode-int s" device-id" property - dup pci-revision@ encode-int s" revision-id" property - dup pci-class@ encode-int s" class-code" property - 3 encode-int s" #address-cells" property - 2 encode-int s" #size-cells" property - - dup pci-config-ext? IF 1 encode-int s" ibm,pci-config-space-type" property THEN - - dup pci-status@ - dup 9 rshift 3 and encode-int s" devsel-speed" property - dup 7 rshift 1 and IF 0 0 s" fast-back-to-back" property THEN - dup 6 rshift 1 and IF 0 0 s" 66mhz-capable" property THEN - 5 rshift 1 and IF 0 0 s" udf-supported" property THEN - dup pci-cache@ ?dup IF encode-int s" cache-line-size" property THEN - pci-interrupt@ ?dup IF encode-int s" interrupts" property THEN -; - -\ set up device only properties -: pci-device-props ( addr -- ) - \ FIXME no s" compatible" prop - \ FIXME no s" alternate-reg" prop - \ FIXME no s" fcode-rom-offset" prop - \ FIXME no s" power-consumption" prop - dup pci-common-props - dup pci-min-grant@ encode-int s" min-grant" property - dup pci-max-lat@ encode-int s" max-latency" property - dup pci-sub-device@ ?dup IF encode-int s" subsystem-id" property THEN - dup pci-sub-vendor@ ?dup IF encode-int s" subsystem-vendor-id" property THEN - dup pci-device-assigned-addresses-prop - pci-reg-props - pci-hotplug-enabled IF - \ QEMU uses static assignments for my-drc-index: - \ 40000000h + $bus << 8 + $slot << 3 - dup dup pci-addr2bus 8 lshift - swap pci-addr2dev 3 lshift or - 40000000 + encode-int s" ibm,my-drc-index" property - \ QEMU uses "Slot $bus*32$slotno" for loc-code - dup dup pci-addr2bus 20 * - swap pci-addr2dev + - a base ! - s" Slot " rot $cathex - hex - encode-string s" ibm,loc-code" property - THEN -; - -\ set up bridge only properties -: pci-bridge-props ( addr -- ) - \ FIXME no s" slot-names" prop - \ FIXME no s" bus-master-capable" prop - \ FIXME no s" clock-frequency" prop - dup pci-bus@ - encode-int s" primary-bus" property - encode-int s" secondary-bus" property - encode-int s" subordinate-bus" property - dup pci-bus@ drop encode-int rot encode-int+ s" bus-range" property - pci-device-slots encode-int s" slot-names" property - dup pci-bridge-range-props - dup pci-bridge-assigned-addresses-prop - \ Only create interrupt-map when it doesn't already exist - \ (it can be provided by qemu) - s" interrupt-map" get-node get-property IF - pci-bridge-interrupt-map - ELSE 2drop THEN - pci-reg-props -; - - -\ used to set up all unknown Bridges. -\ If a Bridge has no special handling for setup -\ the device file (pci-bridge_VENDOR_DEVICE.fs) can call -\ this word to setup busses and scan beyond. -: pci-bridge-generic-setup ( addr -- ) - pci-device-slots >r \ save the slot array on return stack - dup pci-common-props \ set the common properties before scanning the bus - s" pci" device-type \ the type is allways "pci" - dup pci-bridge-probe \ find all device connected to it - dup assign-all-bridge-bars \ set up all memory access BARs - dup pci-set-irq-line \ set the interrupt pin - dup pci-set-capabilities \ set up the capabilities - pci-bridge-props \ and generate all properties - r> TO pci-device-slots \ and reset the slot array -; - -DEFER func-pci-device-props - -\ used for an gerneric device set up -\ if a device has no special handling for setup -\ the device file (pci-device_VENDOR_DEVICE.fs) can call -\ this word to setup the device -: pci-device-generic-setup ( config-addr -- ) - dup assign-all-device-bars \ calc all BARs - dup pci-set-irq-line \ set the interrupt pin - dup pci-set-capabilities \ set up the capabilities - dup func-pci-device-props \ and generate all properties - drop \ forget the config-addr -; - -' pci-device-props TO func-pci-device-props diff --git a/qemu/roms/SLOF/slof/fs/pci-scan.fs b/qemu/roms/SLOF/slof/fs/pci-scan.fs deleted file mode 100644 index 2fdf0e8f5..000000000 --- a/qemu/roms/SLOF/slof/fs/pci-scan.fs +++ /dev/null @@ -1,351 +0,0 @@ -\ ***************************************************************************** -\ * Copyright (c) 2004, 2008 IBM Corporation -\ * All rights reserved. -\ * This program and the accompanying materials -\ * are made available under the terms of the BSD License -\ * which accompanies this distribution, and is available at -\ * http://www.opensource.org/licenses/bsd-license.php -\ * -\ * Contributors: -\ * IBM Corporation - initial implementation -\ ****************************************************************************/ - -\ ---------------------------------------------------------- -\ ********** Variables to be set by host bridge ********** -\ ---------------------------------------------------------- - -\ Values of the next free memory area -VARIABLE pci-next-mem \ prefetchable memory mapped -VARIABLE pci-max-mem -VARIABLE pci-next-mmio \ non-prefetchable memory -VARIABLE pci-max-mmio -VARIABLE pci-next-io \ I/O space -VARIABLE pci-max-io -VARIABLE pci-next-mem64 \ prefetchable 64-bit memory mapped -VARIABLE pci-max-mem64 - -\ Counter of busses found -0 VALUE pci-bus-number -\ Counter of devices found -0 VALUE pci-device-number -\ bit field of devices plugged into this bridge -0 VALUE pci-device-slots -\ byte field holding the device-slot number vector of the current device -\ the vector can be as deep as the max depth of bridges possible -\ 3,4,5 means -\ the 5th slot on the bus of the bridge in -\ the 4th slot on the bus of the bridge in -\ the 3rd slot on the HostBridge bus -here 100 allot CONSTANT pci-device-vec -0 VALUE pci-device-vec-len -\ enable/disable creation of hotplug-specific properties -0 VALUE pci-hotplug-enabled - - -\ Fixme Glue to the pci-devices ... remove this later -: next-pci-mem ( addr -- addr ) pci-next-mem ; -: next-pci-mmio ( addr -- addr ) pci-next-mmio ; -: next-pci-io ( addr -- addr ) pci-next-io ; - - -#include "pci-helper.fs" - -\ Dump out the pci device-slot vector -: pci-vec ( -- ) - cr s" device-vec(" type - pci-device-vec-len dup 2 0.r s" ):" type - 1+ 0 DO - pci-device-vec i + c@ - space 2 0.r - LOOP - cr -; - -\ prints out all relevant pci variables -: pci-var-out ( -- ) - s" mem:" type pci-next-mem @ 16 0.r cr - s" mmio:" type pci-next-mmio @ 16 0.r cr - s" io:" type pci-next-io @ 16 0.r cr -; - - -\ Update the device-slot number vector -\ Set the bit of the DeviceSlot in the Slot array -: pci-set-slot ( addr -- ) - pci-addr2dev dup \ calc slot number - pci-device-vec-len \ the end of the vector - pci-device-vec + c! \ and update the vector - 80000000 swap rshift \ calc bit position of the device slot - pci-device-slots or \ set this bit - TO pci-device-slots \ and write it back -; - -\ Update pci-next-mmio to be 1MB aligned and set the mmio-base register -\ and set the Limit register to the maximum available address space -\ needed for scanning possible devices behind the bridge -: pci-bridge-set-mmio-base ( addr -- ) - pci-next-mmio @ 100000 #aligned \ read the current Value and align to 1MB boundary - dup 100000 + pci-next-mmio ! \ and write back with 1MB for bridge - 10 rshift \ mmio-base reg is only the upper 16 bits - pci-max-mmio @ 1- FFFF0000 and or \ and Insert mmio Limit (set it to max) - swap 20 + rtas-config-l! \ and write it into the bridge -; - -\ Update pci-next-mmio to be 1MB aligned and set the mmio-limit register -\ The Limit Value is one less then the upper boundary -\ If the limit is less than the base the mmio is disabled -: pci-bridge-set-mmio-limit ( addr -- ) - pci-next-mmio @ 100000 #aligned \ fetch current value and align to 1MB - dup pci-next-mmio ! \ and write it back - 1- FFFF0000 and \ make it one less and keep upper 16 bits - over 20 + rtas-config-l@ 0000FFFF and \ fetch original value - or swap 20 + rtas-config-l! \ and write it into the Reg -; - -\ Update pci-next-mem to be 1MB aligned and set the mem-base and mem-base-upper register -\ and set the Limit register to the maximum available address space -\ needed for scanning possible devices behind the bridge -: pci-bridge-set-mem-base ( addr -- ) - pci-next-mem @ 100000 #aligned \ read the current Value and align to 1MB boundary - dup 100000 + pci-next-mem ! \ and write back with 1MB for bridge - over 24 + rtas-config-w@ \ check if 64bit support - 1 and IF \ IF 64 bit support - pci-next-mem64 @ 100000000 #aligned \ | read the current Value of 64-bit and align to 4GB boundary - dup 100000000 + pci-next-mem64 x! \ | and write back with 1GB for bridge - 2 pick swap \ | - 20 rshift \ | keep upper 32 bits - swap 28 + rtas-config-l! \ | and write it into the Base-Upper32-bits - pci-max-mem64 @ 20 rshift \ | fetch max Limit address and keep upper 32 bits - 2 pick 2C + rtas-config-l! \ | and set the Limit - THEN \ FI - 10 rshift \ keep upper 16 bits - pci-max-mem @ 1- FFFF0000 and or \ and Insert mmem Limit (set it to max) - swap 24 + rtas-config-l! \ and write it into the bridge -; - -\ Update pci-next-mem to be 1MB aligned and set the mem-limit register -\ The Limit Value is one less then the upper boundary -\ If the limit is less than the base the mem is disabled -: pci-bridge-set-mem-limit ( addr -- ) - pci-next-mem @ 100000 #aligned \ read the current Value and align to 1MB boundary - dup pci-next-mem ! \ and write it back - 1- \ make limit one less than boundary - over 24 + rtas-config-w@ \ check if 64bit support - 1 and IF \ IF 64 bit support - pci-next-mem64 @ 100000000 #aligned \ | Reat current value of 64-bar and align at 4GB - dup pci-next-mem64 x! \ | and write it back - 1- \ | make limite one less than boundary - 2 pick swap \ | - 20 rshift \ | keep upper 32 bits - swap 2C + rtas-config-l! \ | and write it into the Limit-Upper32-bits - THEN \ FI - FFFF0000 and \ keep upper 16 bits - over 24 + rtas-config-l@ 0000FFFF and \ fetch original Value - or swap 24 + rtas-config-l! \ and write it into the bridge -; - -\ Update pci-next-io to be 4KB aligned and set the io-base and io-base-upper register -\ and set the Limit register to the maximum available address space -\ needed for scanning possible devices behind the bridge -: pci-bridge-set-io-base ( addr -- ) - pci-next-io @ 1000 #aligned \ read the current Value and align to 4KB boundary - dup 1000 + pci-next-io ! \ and write back with 4K for bridge - over 1C + rtas-config-l@ \ check if 32bit support - 1 and IF \ IF 32 bit support - 2dup 10 rshift \ | keep upper 16 bits - pci-max-io @ FFFF0000 and or \ | insert upper 16 bits of Max-Limit - swap 30 + rtas-config-l! \ | and write it into the Base-Upper16-bits - THEN \ FI - 8 rshift 000000FF and \ keep upper 8 bits - pci-max-io @ 1- 0000FF00 and or \ insert upper 8 bits of Max-Limit - over rtas-config-l@ FFFF0000 and \ fetch original Value - or swap 1C + rtas-config-l! \ and write it into the bridge -; - -\ Update pci-next-io to be 4KB aligned and set the io-limit register -\ The Limit Value is one less then the upper boundary -\ If the limit is less than the base the io is disabled -: pci-bridge-set-io-limit ( addr -- ) - pci-next-io @ 1000 #aligned \ read the current Value and align to 4KB boundary - dup pci-next-io ! \ and write it back - 1- \ make limit one less than boundary - over 1D + rtas-config-b@ \ check if 32bit support - 1 and IF \ IF 32 bit support - 2dup FFFF0000 and \ | keep upper 16 bits - over 30 + rtas-config-l@ \ | fetch original Value - or swap 30 + rtas-config-l! \ | and write it into the Limit-Upper16-bits - THEN \ FI - 0000FF00 and \ keep upper 8 bits - over 1C + rtas-config-l@ FFFF00FF and \ fetch original Value - or swap 1C + rtas-config-l! \ and write it into the bridge -; - -\ set up all base registers to the current variable Values -: pci-bridge-set-bases ( addr -- ) - dup pci-bridge-set-mmio-base - dup pci-bridge-set-mem-base - pci-bridge-set-io-base -; - -\ set up all limit registers to the current variable Values -: pci-bridge-set-limits ( addr -- ) - dup pci-bridge-set-mmio-limit - dup pci-bridge-set-mem-limit - pci-bridge-set-io-limit -; - -\ ---------------------------------------------------------- -\ ****************** PCI Scan functions ****************** -\ ---------------------------------------------------------- - -\ define function pointer as forward declaration of pci-probe-bus -DEFER func-pci-probe-bus -DEFER func-pci-bridge-range-props - -\ Setup the Base and Limits in the Bridge -\ and scan the bus(es) beyond that Bridge -: pci-bridge-probe ( addr -- ) - dup pci-bridge-set-bases \ SetUp all Base Registers - dup func-pci-bridge-range-props \ Setup temporary "range - pci-bus-number 1+ TO pci-bus-number \ increase number of busses found - pci-device-vec-len 1+ TO pci-device-vec-len \ increase the device-slot vector depth - dup \ stack config-addr for pci-bus! - FF swap \ Subordinate Bus Number ( for now to max to open all subbusses ) - pci-bus-number swap \ Secondary Bus Number ( the new busnumber ) - dup pci-addr2bus swap \ Primary Bus Number ( the current bus ) - pci-bus! \ and set them into the bridge - pci-enable \ enable mem/IO transactions - dup pci-bus-scnd@ func-pci-probe-bus \ and probe the secondary bus - dup pci-bus-number swap pci-bus-subo! \ set SubOrdinate Bus Number to current number of busses - pci-device-vec-len 1- TO pci-device-vec-len \ decrease the device-slot vector depth - dup pci-bridge-set-limits \ SetUp all Limit Registers - drop \ forget the config-addr -; - -\ set up the pci-device -: pci-device-setup ( addr -- ) - drop \ since the config-addr is coded in my-space, drop it here - s" pci-device.fs" included \ and setup the device as node in the device tree -; - -\ set up the pci bridge -: pci-bridge-setup ( addr -- ) - drop \ since the config-addr is coded in my-space, drop it here - s" pci-bridge.fs" included \ and setup the bridge as node in the device tree -; - -\ add the new found device/bridge to the device tree and set it up -: pci-add-device ( addr -- ) - new-device \ create a new device-tree node - dup set-space \ set the config addr for this device tree entry - dup pci-set-slot \ set the slot bit - dup pci-htype@ \ read HEADER-Type - 7f and \ Mask bit 7 - multifunction device - CASE - 0 OF pci-device-setup ENDOF \ | set up the device - 1 OF pci-bridge-setup ENDOF \ | set up the bridge - dup OF dup pci-htype@ pci-out ENDOF - ENDCASE - finish-device \ and close the device-tree node -; - -\ check for multifunction and for each function -\ (dependig from header type) call device or bridge setup -: pci-setup-device ( addr -- ) - dup pci-htype@ \ read HEADER-Type - 80 and IF 8 ELSE 1 THEN \ check for multifunction - 0 DO \ LOOP over all possible functions (either 8 or only 1) - dup - i 8 lshift + \ calc device-function-config-addr - dup pci-vendor@ \ check if valid function - FFFF = IF - drop \ non-valid so forget the address - ELSE - pci-device-number 1+ \ increase the number of devices - TO pci-device-number \ and store it - pci-add-device \ and add the device to the device tree and set it up - THEN - LOOP \ next function - drop \ forget the device-addr -; - -\ check if a device is plugged into this bus at this device number -: pci-probe-device ( busnr devicenr -- ) - pci-bus2addr \ calc pci-address - dup pci-vendor@ \ fetch Vendor-ID - FFFF = IF \ check if valid - drop \ if not forget it - ELSE - pci-setup-device \ if valid setup the device - THEN -; - -\ walk through all 32 possible pci devices on this bus and probe them -: pci-probe-bus ( busnr -- ) - 0 TO pci-device-slots \ reset slot array to unpoppulated - 20 0 DO - dup - i pci-probe-device - LOOP - drop -; - -\ setup the function pointer used in pci-bridge-setup -' pci-probe-bus TO func-pci-probe-bus - -\ ---------------------------------------------------------- -\ ****************** System functions ******************** -\ ---------------------------------------------------------- -\ Setup the whole system for pci devices -\ start with the bus-min and try all busses -\ until at least 1 device was found -\ ( needed for HostBridges that don't start with Bus 0 ) -: pci-probe-all ( bus-max bus-min -- ) \ Check all busses from bus-min up to bus-max if needed - 0 TO pci-device-vec-len \ reset the device-slot vector - DO - i TO pci-bus-number \ set current Busnumber - 0 TO pci-device-number \ reset Device Number - pci-bus-number pci-probe-bus \ and probe this bus - pci-device-number 0 > IF LEAVE THEN \ if we found a device we're done - LOOP \ else next bus -; - -: (probe-pci-host-bridge) ( bus-max bus-min -- ) - 0d emit ." Adapters on " puid 10 0.r cr \ print the puid we're looking at - ( bus-max bus-min ) pci-probe-all \ and walk the bus - pci-device-number 0= IF \ IF no devices found - 15 spaces \ | indent the output - ." None" cr \ | tell the world our result - THEN \ FI -; - -\ probe the hostbridge that is specified in my-puid -\ for the mmio mem and io addresses: -\ base is the least available address -\ max is the highest available address -: probe-pci-host-bridge ( bus-max bus-min mmio-max mmio-base mem-max mem-base io-max io-base my-puid -- ) - puid >r TO puid \ save puid and set the new - pci-next-io ! \ save the next io-base address - pci-max-io ! \ save the max io-space address - pci-next-mem ! \ save the next mem-base address - pci-max-mem ! \ save the max mem-space address - pci-next-mmio ! \ save the next mmio-base address - pci-max-mmio ! \ save the max mmio-space address - (probe-pci-host-bridge) - r> TO puid \ restore puid -; - -\ provide the device-alias definition words -#include <pci-aliases.fs> - -\ provide all words for the interrupts settings -#include <pci-interrupts.fs> - -\ provide all words for the pci capabilities init -#include <pci-capabilities.fs> - -\ provide all words needed to generate the properties and/or assign BAR values -#include "pci-properties.fs" - -\ setup the function pointer for bridge ranges -' pci-bridge-range-props TO func-pci-bridge-range-props diff --git a/qemu/roms/SLOF/slof/fs/preprocessor.fs b/qemu/roms/SLOF/slof/fs/preprocessor.fs deleted file mode 100644 index a13fb3004..000000000 --- a/qemu/roms/SLOF/slof/fs/preprocessor.fs +++ /dev/null @@ -1,41 +0,0 @@ -\ ***************************************************************************** -\ * Copyright (c) 2004, 2008 IBM Corporation -\ * All rights reserved. -\ * This program and the accompanying materials -\ * are made available under the terms of the BSD License -\ * which accompanies this distribution, and is available at -\ * http://www.opensource.org/licenses/bsd-license.php -\ * -\ * Contributors: -\ * IBM Corporation - initial implementation -\ ****************************************************************************/ - -: ([IF]) - BEGIN - BEGIN parse-word dup 0= WHILE - 2drop refill - REPEAT - - 2dup s" [IF]" str= IF 1 throw THEN - 2dup s" [ELSE]" str= IF 2 throw THEN - 2dup s" [THEN]" str= IF 3 throw THEN - s" \" str= IF linefeed parse 2drop THEN - AGAIN - ; - -: [IF] ( flag -- ) - IF exit THEN - 1 BEGIN - ['] ([IF]) catch - CASE - 1 OF 1+ ENDOF - 2 OF dup 1 = if 1- then ENDOF - 3 OF 1- ENDOF - ENDCASE - dup 0 <= - UNTIL drop -; immediate - -: [ELSE] 0 [COMPILE] [IF] ; immediate -: [THEN] ; immediate - diff --git a/qemu/roms/SLOF/slof/fs/property.fs b/qemu/roms/SLOF/slof/fs/property.fs deleted file mode 100644 index cb99fbe9d..000000000 --- a/qemu/roms/SLOF/slof/fs/property.fs +++ /dev/null @@ -1,192 +0,0 @@ -\ ***************************************************************************** -\ * Copyright (c) 2004, 2008 IBM Corporation -\ * All rights reserved. -\ * This program and the accompanying materials -\ * are made available under the terms of the BSD License -\ * which accompanies this distribution, and is available at -\ * http://www.opensource.org/licenses/bsd-license.php -\ * -\ * Contributors: -\ * IBM Corporation - initial implementation -\ ****************************************************************************/ - - -\ Properties 5.3.5 - -\ Words on the property list for a node are actually executable words, -\ that return the address and length of the property's data. Special -\ nodes like /options can have their properties use specialized code to -\ dynamically generate their data; most nodes just use a 2CONSTANT. - -\ Put the type as byte before the property -\ { int = 1, bytes = 2, string = 3 } -\ This is used by .properties for pretty print - -\ Flag for type encoding, encode-* resets, set-property set the flag -true value encode-first? - -: decode-int over >r 4 /string r> 4c@ swap 2swap swap bljoin ; -: decode-64 decode-int -rot decode-int -rot 2swap swap lxjoin ; -: decode-string ( prop-addr1 prop-len1 -- prop-addr2 prop-len2 str len ) - dup 0= IF 2dup EXIT THEN \ string properties with zero length - over BEGIN dup c@ 0= IF 1+ -rot swap 2 pick over - rot over - -rot 1- - EXIT THEN 1+ AGAIN ; - -\ Remove a word from a wordlist. -: (prune) ( name len head -- ) - dup >r (find) ?dup IF r> BEGIN dup @ WHILE 2dup @ = IF - >r @ r> ! EXIT THEN @ REPEAT 2drop ELSE r> drop THEN ; -: prune ( name len -- ) last (prune) ; - -: set-property ( data dlen name nlen phandle -- ) - true to encode-first? - get-current >r node>properties @ set-current - 2dup prune $2CONSTANT r> set-current ; -: delete-property ( name nlen -- ) - get-node get-current >r node>properties @ set-current - prune r> set-current ; -: property ( data dlen name nlen -- ) get-node set-property ; -: get-property ( str len phandle -- true | data dlen false ) - ?dup 0= IF cr cr cr ." get-property for " type ." on zero phandle" - cr cr true EXIT THEN - node>properties @ voc-find dup IF link> execute false ELSE drop true THEN ; -: get-package-property ( str len phandle -- true | data dlen false ) - get-property ; -: get-my-property ( str len -- true | data dlen false ) - my-self ihandle>phandle get-property ; -: get-parent-property ( str len -- true | data dlen false ) - my-parent ihandle>phandle get-property ; - -: get-inherited-property ( str len -- true | data dlen false ) - my-self ihandle>phandle - BEGIN - 3dup get-property 0= IF - \ Property found - rot drop rot drop rot drop false EXIT - THEN - parent dup 0= IF - \ Root node has been reached, but property has not been found - 3drop true EXIT - THEN - AGAIN -; - -\ Print out properties. - -20 CONSTANT indent-prop - -: .prop-int ( str len -- ) - space - 400 min 0 - ?DO - i over + dup ( str act-addr act-addr ) - c@ 2 0.r 1+ dup c@ 2 0.r 1+ dup c@ 2 0.r 1+ c@ 2 0.r ( str ) - i c and c = IF \ check for multipleof 16 bytes - cr indent @ indent-prop + 1+ 0 \ linefeed + indent - DO - space \ print spaces - LOOP - ELSE - space space \ print two spaces - THEN - 4 +LOOP - drop -; - -: .prop-bytes ( str len -- ) - 2dup -4 and .prop-int ( str len ) - - dup 3 and dup IF ( str len len%4 ) - >r -4 and + r> ( str' len%4 ) - bounds ( str' str'+len%4 ) - DO - i c@ 2 0.r \ Print last 3 bytes - LOOP - ELSE - 3drop - THEN -; - -: .prop-string ( str len ) - 2dup space type - cr indent @ indent-prop + 0 DO space LOOP \ Linefeed - .prop-bytes -; - -: .propbytes ( xt -- ) - execute dup - IF - over cell- @ execute - ELSE - 2drop - THEN -; -: .property ( lfa -- ) - cr indent @ 0 - ?DO - space - LOOP - link> dup >name name>string 2dup type nip ( len ) - indent-prop swap - ( xt 20-len ) - dup 0< IF drop 0 THEN 0 ( xt number-of-space 0 ) - ?DO - space - LOOP - .propbytes -; -: (.properties) ( phandle -- ) - node>properties @ cell+ @ BEGIN dup WHILE dup .property @ REPEAT drop ; -: .properties ( -- ) - get-node (.properties) ; - -: next-property ( str len phandle -- false | str' len' true ) - ?dup 0= IF device-tree @ THEN \ XXX: is this line required? - node>properties @ - >r 2dup 0= swap 0= or IF 2drop r> cell+ ELSE r> voc-find THEN - @ dup IF link>name name>string true THEN ; - - -\ encode-* words and all helpers - -\ Start a encoded property string -: encode-start ( -- prop 0 ) - ['] .prop-int compile, - false to encode-first? - here 0 -; - -: encode-int ( val -- prop prop-len ) - encode-first? IF - ['] .prop-int compile, \ Execution token for print - false to encode-first? - THEN - here swap lbsplit c, c, c, c, /l -; -: encode-bytes ( str len -- prop-addr prop-len ) - encode-first? IF - ['] .prop-bytes compile, \ Execution token for print - false to encode-first? - THEN - here over 2dup 2>r allot swap move 2r> -; -: encode-string ( str len -- prop-addr prop-len ) - encode-first? IF - ['] .prop-string compile, \ Execution token for print - false to encode-first? - THEN - encode-bytes 0 c, char+ -; - -: encode+ ( prop1-addr prop1-len prop2-addr prop2-len -- prop-addr prop-len ) - nip + ; -: encode-int+ encode-int encode+ ; -: encode-64 xlsplit encode-int rot encode-int+ ; -: encode-64+ encode-64 encode+ ; - - -\ Helpers for common nodes. Should perhaps remove "compatible", as it's -\ not typically a single string. -: device-name encode-string s" name" property ; -: device-type encode-string s" device_type" property ; -: model encode-string s" model" property ; -: compatible encode-string s" compatible" property ; diff --git a/qemu/roms/SLOF/slof/fs/quiesce.fs b/qemu/roms/SLOF/slof/fs/quiesce.fs deleted file mode 100644 index 47006e44d..000000000 --- a/qemu/roms/SLOF/slof/fs/quiesce.fs +++ /dev/null @@ -1,58 +0,0 @@ -\ ***************************************************************************** -\ * Copyright (c) 2004, 2008 IBM Corporation -\ * All rights reserved. -\ * This program and the accompanying materials -\ * are made available under the terms of the BSD License -\ * which accompanies this distribution, and is available at -\ * http://www.opensource.org/licenses/bsd-license.php -\ * -\ * Contributors: -\ * IBM Corporation - initial implementation -\ ****************************************************************************/ - - -100 CONSTANT quiesce-xt# - -\ The array with the quiesce execution tokens: -CREATE quiesce-xts quiesce-xt# cells allot -quiesce-xts quiesce-xt# cells erase - -0 VALUE quiesce-done? - - -\ Add a token to the quiesce execution token array: -: add-quiesce-xt ( xt -- ) - quiesce-xt# 0 DO - quiesce-xts I cells + ( xt arrayptr ) - dup @ 0= ( xt arrayptr true|false ) - IF - ! UNLOOP EXIT - ELSE ( xt arrayptr ) - over swap ( xt xt arrayptr ) - @ = \ xt already stored ? - IF - drop UNLOOP EXIT - THEN ( xt ) - THEN - LOOP - drop ( xt -- ) - ." Warning: quiesce xt list is full." cr -; - - -\ The quiesce call asserts that the firmware and all hardware -\ is in a sane state (e.g. assert that no background DMA is -\ running anymore) -: quiesce ( -- ) - quiesce-done? IF EXIT THEN - true to quiesce-done? - quiesce-xt# 0 DO - quiesce-xts I cells + ( arrayptr ) - @ dup IF ( xt ) - EXECUTE - ELSE - drop UNLOOP EXIT - THEN - LOOP -; - diff --git a/qemu/roms/SLOF/slof/fs/romfs.fs b/qemu/roms/SLOF/slof/fs/romfs.fs deleted file mode 100644 index 7d7e4637e..000000000 --- a/qemu/roms/SLOF/slof/fs/romfs.fs +++ /dev/null @@ -1,123 +0,0 @@ -\ ***************************************************************************** -\ * Copyright (c) 2004, 2008 IBM Corporation -\ * All rights reserved. -\ * This program and the accompanying materials -\ * are made available under the terms of the BSD License -\ * which accompanies this distribution, and is available at -\ * http://www.opensource.org/licenses/bsd-license.php -\ * -\ * Contributors: -\ * IBM Corporation - initial implementation -\ ****************************************************************************/ - -STRUCT - cell field romfs>file-header - cell field romfs>data - cell field romfs>data-size - cell field romfs>flags - -CONSTANT /romfs-lookup-control-block - -CREATE romfs-lookup-cb /romfs-lookup-control-block allot -romfs-lookup-cb /romfs-lookup-control-block erase - -: create-filename ( string -- string\0 ) - here >r dup 8 + allot - r@ over 8 + erase - r@ zplace r> ; - -: romfs-lookup ( fn-str fn-len -- data size | false ) - create-filename romfs-base - romfs-lookup-cb romfs-lookup-entry call-c - 0= IF romfs-lookup-cb dup romfs>data @ swap romfs>data-size @ ELSE - false THEN ; - -: ibm,romfs-lookup ( fn-str fn-len -- data-high data-low size | 0 0 false ) - romfs-lookup dup - 0= if drop 0 0 false else - swap dup 20 rshift swap ffffffff and then ; - -\ FIXME For a short time ... -: romfs-lookup-client ibm,romfs-lookup ; - -\ Fixme temp implementation - -STRUCT - cell field romfs>next-off - cell field romfs>size - cell field romfs>flags - cell field romfs>data-off - cell field romfs>name - -CONSTANT /romfs-cb - -: romfs-map-file ( fn-str fn-len -- file-addr file-size ) - romfs-base >r - BEGIN 2dup r@ romfs>name zcount string=ci not WHILE - ( fn-str fn-len ) ( R: rom-cb-file-addr ) - r> romfs>next-off dup @ dup 0= IF 1 THROW THEN + >r REPEAT - ( fn-str fn-len ) ( R: rom-cb-file-addr ) - 2drop r@ romfs>data-off @ r@ + r> romfs>size @ ; - -\ returns address of romfs-header file -: flash-header ( -- address | false ) - get-flash-base 28 + \ prepare flash header file address - dup rx@ \ fetch "magic123" - 6d61676963313233 <> IF \ IF flash is not valid - drop \ | forget address - false \ | return false - THEN \ FI -; - -CREATE bdate-str 10 allot -: bdate2human ( -- addr len ) - flash-header 40 + rx@ (.) - drop dup 0 + bdate-str 6 + 4 move - dup 4 + bdate-str 0 + 2 move - dup 6 + bdate-str 3 + 2 move - dup 8 + bdate-str b + 2 move - a + bdate-str e + 2 move - 2d bdate-str 2 + c! - 2d bdate-str 5 + c! - 20 bdate-str a + c! - 3a bdate-str d + c! - bdate-str 10 -; - - -\ Look up a file in the ROM file system and evaluate it - -: included ( fn fn-len -- ) - 2dup >r >r romfs-lookup dup IF - r> drop r> drop evaluate - ELSE - drop ." Cannot open file : " r> r> type cr - THEN -; - -: include ( " fn " -- ) - parse-word included -; - -: ?include ( flag " fn " -- ) - parse-word rot IF included ELSE 2drop THEN -; - -: include? ( nargs flag " fn " -- ) - parse-word rot IF - rot drop included - ELSE - 2drop 0 ?DO drop LOOP - THEN -; - - -\ List files in ROMfs - -: (print-romfs-file-info) ( file-addr -- ) - 9 emit dup b 0.r 2 spaces dup 8 + @ 6 0.r 2 spaces 20 + zcount type cr -; - -: romfs-list ( -- ) - romfs-base 0 cr BEGIN + dup (print-romfs-file-info) dup @ dup 0= UNTIL 2drop -; diff --git a/qemu/roms/SLOF/slof/fs/root.fs b/qemu/roms/SLOF/slof/fs/root.fs deleted file mode 100644 index 952b00e75..000000000 --- a/qemu/roms/SLOF/slof/fs/root.fs +++ /dev/null @@ -1,83 +0,0 @@ -\ ***************************************************************************** -\ * Copyright (c) 2004, 2008 IBM Corporation -\ * All rights reserved. -\ * This program and the accompanying materials -\ * are made available under the terms of the BSD License -\ * which accompanies this distribution, and is available at -\ * http://www.opensource.org/licenses/bsd-license.php -\ * -\ * Contributors: -\ * IBM Corporation - initial implementation -\ ****************************************************************************/ - -\ this creates the root and common branches of the device tree - -defer (client-exec) -defer client-exec - -\ defined in slof/fs/client.fs -defer callback -defer continue-client - -0 VALUE chosen-node - -: chosen - chosen-node dup 0= IF - drop s" /chosen" find-node dup to chosen-node - THEN -; - -: set-chosen ( prop len name len -- ) - chosen set-property ; - -: get-chosen ( name len -- [ prop len ] success ) - chosen get-property 0= ; - -\ Look for an exising root, create one if needed -" /" find-node dup 0= IF - drop - new-device - s" /" device-name -ELSE - extend-device -THEN - -\ Create /chosen if it doesn't exist -" /chosen" find-node dup 0= IF - drop - new-device - s" chosen" device-name - s" " encode-string s" bootargs" property - s" " encode-string s" bootpath" property - finish-device -ELSE - drop -THEN - -\ Create /aliases -new-device - s" aliases" device-name -finish-device - -\ Create /options -new-device - s" options" device-name -finish-device - -\ Create /openprom -new-device - s" openprom" device-name - 0 0 s" relative-addressing" property -finish-device - -\ Create /packages -new-device -#include <packages.fs> -finish-device - -: open true ; -: close ; - -\ Finish root -finish-device - diff --git a/qemu/roms/SLOF/slof/fs/rtas/rtas-cpu.fs b/qemu/roms/SLOF/slof/fs/rtas/rtas-cpu.fs deleted file mode 100644 index c133abc40..000000000 --- a/qemu/roms/SLOF/slof/fs/rtas/rtas-cpu.fs +++ /dev/null @@ -1,23 +0,0 @@ -\ ***************************************************************************** -\ * Copyright (c) 2004, 2008 IBM Corporation -\ * All rights reserved. -\ * This program and the accompanying materials -\ * are made available under the terms of the BSD License -\ * which accompanies this distribution, and is available at -\ * http://www.opensource.org/licenses/bsd-license.php -\ * -\ * Contributors: -\ * IBM Corporation - initial implementation -\ ****************************************************************************/ - -: rtas-start-cpu ( pid loc r3 -- status ) - [ s" start-cpu" rtas-get-token ] LITERAL rtas-cb rtas>token l! - 3 rtas-cb rtas>nargs l! - 1 rtas-cb rtas>nret l! - rtas-cb rtas>args2 l! - rtas-cb rtas>args1 l! - rtas-cb rtas>args0 l! - 0 rtas-cb rtas>args3 l! - enter-rtas - rtas-cb rtas>args3 l@ -; diff --git a/qemu/roms/SLOF/slof/fs/rtas/rtas-flash.fs b/qemu/roms/SLOF/slof/fs/rtas/rtas-flash.fs deleted file mode 100644 index f8abeaaf0..000000000 --- a/qemu/roms/SLOF/slof/fs/rtas/rtas-flash.fs +++ /dev/null @@ -1,46 +0,0 @@ -\ ***************************************************************************** -\ * Copyright (c) 2004, 2008 IBM Corporation -\ * All rights reserved. -\ * This program and the accompanying materials -\ * are made available under the terms of the BSD License -\ * which accompanies this distribution, and is available at -\ * http://www.opensource.org/licenses/bsd-license.php -\ * -\ * Contributors: -\ * IBM Corporation - initial implementation -\ ****************************************************************************/ - -: rtas-ibm-update-flash-64-and-reboot ( block-list -- status ) - [ s" ibm,update-flash-64-and-reboot" rtas-get-token ] LITERAL rtas-cb rtas>token l! - 1 rtas-cb rtas>nargs l! - 1 rtas-cb rtas>nret l! - rtas-cb rtas>args0 l! - enter-rtas - rtas-cb rtas>args1 l@ -; - -: rtas-ibm-manage-flash-image ( image-to-commit -- status ) - [ s" ibm,manage-flash-image" rtas-get-token ] LITERAL rtas-cb rtas>token l! - 1 rtas-cb rtas>nargs l! - 1 rtas-cb rtas>nret l! - rtas-cb rtas>args0 l! - enter-rtas - rtas-cb rtas>args1 l@ -; - -: rtas-set-flashside ( flashside -- status ) - [ s" rtas-set-flashside" rtas-get-token ] LITERAL rtas-cb rtas>token l! - 1 rtas-cb rtas>nargs l! - 1 rtas-cb rtas>nret l! - rtas-cb rtas>args0 l! - enter-rtas - rtas-cb rtas>args1 l@ -; - -: rtas-get-flashside ( -- status ) - [ s" rtas-get-flashside" rtas-get-token ] LITERAL rtas-cb rtas>token l! - 0 rtas-cb rtas>nargs l! - 1 rtas-cb rtas>nret l! - enter-rtas - rtas-cb rtas>args0 l@ -; diff --git a/qemu/roms/SLOF/slof/fs/rtas/rtas-init.fs b/qemu/roms/SLOF/slof/fs/rtas/rtas-init.fs deleted file mode 100644 index 8451cfde7..000000000 --- a/qemu/roms/SLOF/slof/fs/rtas/rtas-init.fs +++ /dev/null @@ -1,121 +0,0 @@ -\ ***************************************************************************** -\ * Copyright (c) 2004, 2008 IBM Corporation -\ * All rights reserved. -\ * This program and the accompanying materials -\ * are made available under the terms of the BSD License -\ * which accompanies this distribution, and is available at -\ * http://www.opensource.org/licenses/bsd-license.php -\ * -\ * Contributors: -\ * IBM Corporation - initial implementation -\ ****************************************************************************/ - -\ (rtas-size) determines the size required for RTAS. -\ It looks at the rtas binary in the flash and reads the rtas-size from -\ its header at offset 8. -: (rtas-size) ( -- rtas-size ) - s" rtas" romfs-lookup dup 0= - ABORT" romfs-lookup for rtas failed" - drop 8 + @ -; - -(rtas-size) CONSTANT rtas-size - -: instantiate-rtas ( adr -- entry ) - dup rtas-size erase - s" rtas" romfs-lookup 0= - ABORT" romfs-lookup for rtas failed" - rtas-config swap start-rtas ; - -here fff + fffffffffffff000 and here - allot -here rtas-size allot CONSTANT rtas-start-addr - -rtas-start-addr instantiate-rtas CONSTANT rtas-entry-point - -: drone-rtas - rtas-start-addr - dup rtas-size erase - 2000000 start-rtas to rtas-entry-point -; - - -\ ffffffffffffffff CONSTANT rtas-entry-point - -\ rtas control block - -STRUCT - /l field rtas>token - /l field rtas>nargs - /l field rtas>nret - /l field rtas>args0 - /l field rtas>args1 - /l field rtas>args2 - /l field rtas>args3 - /l field rtas>args4 - /l field rtas>args5 - /l field rtas>args6 - /l field rtas>args7 - /l C * field rtas>args - /l field rtas>bla - -CONSTANT /rtas-control-block - -CREATE rtas-cb /rtas-control-block allot -rtas-cb /rtas-control-block erase - -\ call-c ( p0 p1 p2 entry -- ret ) - -: enter-rtas ( -- ) - rtas-cb rtas-start-addr 0 rtas-entry-point call-c drop ; - - -\ This is the structure of the RTAS function jump table in the C code: -STRUCT - cell FIELD rtasfunctab>name - cell FIELD rtasfunctab>func - cell FIELD rtasfunctab>flags -CONSTANT rtasfunctab-size - -\ Create RTAS token properties by analyzing the jump table in the C code: -: rtas-create-token-properties ( -- ) - rtas-start-addr 10 + @ rtas-start-addr + \ Get pointer to jump table - rtas-start-addr 18 + @ rtas-start-addr + l@ \ Get the number of entries - 0 DO - dup rtasfunctab>func @ 0<> \ function pointer must not be NULL - over rtasfunctab>flags @ 1 and 0= \ Check the only-internal flag - and - IF - i 1+ encode-int \ Create the token value - 2 pick rtasfunctab>name @ zcount \ Create the token name string - property \ Create the property - THEN - rtasfunctab-size + \ Proceed to the next entry - LOOP - drop -; - -\ Get the RTAS token that corresponds to an RTAS property name: -: rtas-get-token ( str len -- token|0 ) - rtas-start-addr 10 + @ rtas-start-addr + \ Get pointer to jump table - rtas-start-addr 18 + @ rtas-start-addr + l@ \ Get the number of entries - 0 DO - dup rtasfunctab>name @ \ Get pointer to function name - dup 0<> \ function name must not be NULL - over zcount 5 pick = nip and \ Check if both strings have same length - IF - 3 pick 3 pick \ Make a copy of the token name string - comp 0= - IF - drop 2drop - i 1+ \ If the name matched, return the token - UNLOOP EXIT - THEN - ELSE - drop - THEN - rtasfunctab-size + \ Proceed to the next entry - LOOP - drop - ." RTAS token not found: " type cr - 0 -; diff --git a/qemu/roms/SLOF/slof/fs/rtas/rtas-reboot.fs b/qemu/roms/SLOF/slof/fs/rtas/rtas-reboot.fs deleted file mode 100644 index a9539ecc1..000000000 --- a/qemu/roms/SLOF/slof/fs/rtas/rtas-reboot.fs +++ /dev/null @@ -1,33 +0,0 @@ -\ ***************************************************************************** -\ * Copyright (c) 2004, 2008 IBM Corporation -\ * All rights reserved. -\ * This program and the accompanying materials -\ * are made available under the terms of the BSD License -\ * which accompanies this distribution, and is available at -\ * http://www.opensource.org/licenses/bsd-license.php -\ * -\ * Contributors: -\ * IBM Corporation - initial implementation -\ ****************************************************************************/ - -: rtas-power-off ( x y -- status ) - [ s" power-off" rtas-get-token ] LITERAL rtas-cb rtas>token l! - 2 rtas-cb rtas>nargs l! - 1 rtas-cb rtas>nret l! - rtas-cb rtas>args0 l! - rtas-cb rtas>args1 l! - enter-rtas - rtas-cb rtas>args2 l@ -; - -: power-off ( -- ) 0 0 rtas-power-off ; - - -: rtas-system-reboot ( -- status ) - [ s" system-reboot" rtas-get-token ] LITERAL rtas-cb rtas>token l! - 0 rtas-cb rtas>nargs l! - 1 rtas-cb rtas>nret l! - rtas-cb rtas>args0 l! - enter-rtas - rtas-cb rtas>args1 l@ -; diff --git a/qemu/roms/SLOF/slof/fs/rtas/rtas-vpd.fs b/qemu/roms/SLOF/slof/fs/rtas/rtas-vpd.fs deleted file mode 100644 index 7fb4b547d..000000000 --- a/qemu/roms/SLOF/slof/fs/rtas/rtas-vpd.fs +++ /dev/null @@ -1,33 +0,0 @@ -\ ***************************************************************************** -\ * Copyright (c) 2004, 2008 IBM Corporation -\ * All rights reserved. -\ * This program and the accompanying materials -\ * are made available under the terms of the BSD License -\ * which accompanies this distribution, and is available at -\ * http://www.opensource.org/licenses/bsd-license.php -\ * -\ * Contributors: -\ * IBM Corporation - initial implementation -\ ****************************************************************************/ - -: rtas-read-vpd ( offset length data -- status ) - [ s" msg-read-vpd" rtas-get-token ] LITERAL rtas-cb rtas>token l! - 3 rtas-cb rtas>nargs l! - 1 rtas-cb rtas>nret l! - rtas-cb rtas>args2 l! - rtas-cb rtas>args1 l! - rtas-cb rtas>args0 l! - enter-rtas - rtas-cb rtas>args3 l@ -; - -: rtas-write-vpd ( offset length data -- status ) - [ s" msg-write-vpd" rtas-get-token ] LITERAL rtas-cb rtas>token l! - 3 rtas-cb rtas>nargs l! - 1 rtas-cb rtas>nret l! - rtas-cb rtas>args2 l! - rtas-cb rtas>args1 l! - rtas-cb rtas>args0 l! - enter-rtas - rtas-cb rtas>args3 l@ -; diff --git a/qemu/roms/SLOF/slof/fs/scsi-disk.fs b/qemu/roms/SLOF/slof/fs/scsi-disk.fs deleted file mode 100644 index 197847147..000000000 --- a/qemu/roms/SLOF/slof/fs/scsi-disk.fs +++ /dev/null @@ -1,324 +0,0 @@ -\ ***************************************************************************** -\ * Copyright (c) 2011 IBM Corporation -\ * All rights reserved. -\ * This program and the accompanying materials -\ * are made available under the terms of the BSD License -\ * which accompanies this distribution, and is available at -\ * http://www.opensource.org/licenses/bsd-license.php -\ * -\ * Contributors: -\ * IBM Corporation - initial implementation -\ ****************************************************************************/ - -\ Create new VSCSI child device - -\ Create device -new-device - -\ Set name -s" disk" device-name - -s" block" device-type - -false VALUE scsi-disk-debug? - -\ Get SCSI bits -scsi-open - -\ Send SCSI commands to controller - -: execute-scsi-command ( buf-addr buf-len dir cmd-addr cmd-len -- ... ) - ( ... [ sense-buf sense-len ] stat ) - " execute-scsi-command" $call-parent -; - -: retry-scsi-command ( buf-addr buf-len dir cmd-addr cmd-len #retries -- ... ) - ( ... 0 | [ sense-buf sense-len ] stat ) - " retry-scsi-command" $call-parent -; - -\ ---------------------------------\ -\ Common SCSI Commands and helpers \ -\ ---------------------------------\ - -0 INSTANCE VALUE block-size -0 INSTANCE VALUE max-transfer -0 INSTANCE VALUE max-block-num -0 INSTANCE VALUE is_cdrom -INSTANCE VARIABLE deblocker - -\ This scratch area is made global for now as we only -\ use it for small temporary commands such as inquiry -\ read-capacity or media events -CREATE scratch 100 allot -CREATE cdb 10 allot - -: dump-scsi-error ( sense-buf sense-len stat name namelen -- ) - ." SCSI-DISK: " my-self instance>path type ." ," type ." failed" cr - ." SCSI-DISK: Status " dup . .status-text - 0<> IF - ." Sense " scsi-get-sense-data dup . .sense-text - ." ASC " . ." ASCQ " . cr - ELSE drop THEN -; - -: read-blocks ( addr block# #blocks -- #read ) - scsi-disk-debug? IF - ." SCSI-DISK: read-blocks " .s cr - THEN - - \ Bound check. This should probably be done by deblocker - \ but it doesn't at this point so do it here - 2dup + max-block-num > IF - ." SCSI-DISK: Access beyond end of device ! " cr - drop - dup max-block-num > IF - drop drop 0 EXIT - THEN - dup max-block-num swap - - THEN - - dup block-size * ( addr block# #blocks len ) - >r rot r> ( block# #blocks addr len ) - 2swap ( addr len block# #blocks ) - dup >r - cdb scsi-build-read-10 ( addr len ) - r> -rot ( #blocks addr len ) - scsi-dir-read cdb scsi-param-size 10 - retry-scsi-command - ( #blocks [ sense-buf sense-len ] stat ) - dup 0<> IF " read-blocks" dump-scsi-error -65 throw ELSE drop THEN -; - -: (inquiry) ( size -- buffer | NULL ) - dup cdb scsi-build-inquiry - \ 16 retries for inquiry to flush out any UAs - scratch swap scsi-dir-read cdb scsi-param-size 10 retry-scsi-command - \ Success ? - 0= IF scratch ELSE 2drop 0 THEN -; - -: inquiry ( -- buffer | NULL ) - scsi-disk-debug? IF - ." SCSI-DISK: inquiry " .s cr - THEN - d# 36 (inquiry) 0= IF 0 EXIT THEN - scratch inquiry-data>add-length c@ 5 + - (inquiry) -; - -: read-capacity ( -- blocksize #blocks ) - \ Now issue the read-capacity command - scsi-disk-debug? IF - ." SCSI-DISK: read-capacity " .s cr - THEN - \ Make sure that there are zeros in the buffer in case something goes wrong: - scratch 10 erase - cdb scsi-build-read-cap-10 scratch scsi-length-read-cap-10-data scsi-dir-read - cdb scsi-param-size 1 retry-scsi-command - \ Success ? - dup 0<> IF " read-capacity" dump-scsi-error 0 0 EXIT THEN - drop scratch scsi-get-capacity-10 1 + -; - -100 CONSTANT test-unit-retries - -\ SCSI test-unit-read -: test-unit-ready ( true | [ ascq asc sense-key false ] ) - scsi-disk-debug? IF - ." SCSI-DISK: test-unit-ready " .s cr - THEN - cdb scsi-build-test-unit-ready - 0 0 0 cdb scsi-param-size test-unit-retries retry-scsi-command - \ stat == 0, return - 0= IF true EXIT THEN - \ check sense len, no sense -> return HW error - 0= IF drop 0 0 4 false EXIT THEN - \ get sense - scsi-get-sense-data false -; - - -: start-stop-unit ( state# -- true | false ) - scsi-disk-debug? IF - ." SCSI-DISK: start-stop-unit " .s cr - THEN - cdb scsi-build-start-stop-unit - 0 0 0 cdb scsi-param-size 10 retry-scsi-command - \ Success ? - 0= IF true ELSE 2drop false THEN -; - -: compare-sense ( ascq asc key ascq2 asc2 key2 -- true | false ) - 3 pick = ( ascq asc key ascq2 asc2 keycmp ) - swap 4 pick = ( ascq asc key ascq2 keycmp asccmp ) - rot 5 pick = ( ascq asc key keycmp asccmp ascqcmp ) - and and nip nip nip -; - -\ -------------------------\ -\ CDROM specific functions \ -\ -------------------------\ - -0 CONSTANT CDROM-READY -1 CONSTANT CDROM-NOT-READY -2 CONSTANT CDROM-NO-DISK -3 CONSTANT CDROM-TRAY-OPEN -4 CONSTANT CDROM-INIT-REQUIRED -5 CONSTANT CDROM-TRAY-MAYBE-OPEN - -: cdrom-try-close-tray ( -- ) - scsi-const-load start-stop-unit drop -; - -: cdrom-must-close-tray ( -- ) - scsi-const-load start-stop-unit not IF - ." Tray open !" cr -65 throw - THEN -; - -: get-media-event ( -- true | false ) - scsi-disk-debug? IF - ." SCSI-DISK: get-media-event " .s cr - THEN - cdb scsi-build-get-media-event - scratch scsi-length-media-event scsi-dir-read cdb scsi-param-size 1 retry-scsi-command - \ Success ? - 0= IF true ELSE 2drop false THEN -; - -: cdrom-status ( -- status ) - test-unit-ready - IF CDROM-READY EXIT THEN - - scsi-disk-debug? IF - ." TestUnitReady sense: " 3dup . . . cr - THEN - - 3dup 1 4 2 compare-sense IF - 3drop CDROM-NOT-READY EXIT - THEN - - get-media-event IF - scratch w@ 4 >= IF - scratch 2 + c@ 04 = IF - scratch 5 + c@ - dup 02 and 0<> IF drop 3drop CDROM-READY EXIT THEN - dup 01 and 0<> IF drop 3drop CDROM-TRAY-OPEN EXIT THEN - drop 3drop CDROM-NO-DISK EXIT - THEN - THEN - THEN - - 3dup 2 4 2 compare-sense IF - 3drop CDROM-INIT-REQUIRED EXIT - THEN - over 4 = over 2 = and IF - \ Format in progress... what do we do ? Just ignore - 3drop CDROM-READY EXIT - THEN - over 3a = IF - 3drop CDROM-NO-DISK EXIT - THEN - - \ Other error... - 3drop CDROM-TRAY-MAYBE-OPEN -; - -: prep-cdrom ( -- ready? ) - 5 0 DO - cdrom-status CASE - CDROM-READY OF UNLOOP true EXIT ENDOF - CDROM-NO-DISK OF ." No medium !" cr UNLOOP false EXIT ENDOF - CDROM-TRAY-OPEN OF cdrom-must-close-tray ENDOF - CDROM-INIT-REQUIRED OF cdrom-try-close-tray ENDOF - CDROM-TRAY-MAYBE-OPEN OF cdrom-try-close-tray ENDOF - ENDCASE - d# 1000 ms - LOOP - ." Drive not ready !" cr false -; - -\ ------------------------\ -\ Disk specific functions \ -\ ------------------------\ - -: prep-disk ( -- ready? ) - test-unit-ready not IF - ." SCSI-DISK: Disk not ready ! " - ." Sense " dup .sense-text ." [" . ." ]" - ." ASC " . ." ASCQ " . cr - false EXIT THEN true -; - -\ --------------------------\ -\ Standard device interface \ -\ --------------------------\ - -: open ( -- true | false ) - scsi-disk-debug? IF - ." SCSI-DISK: open [" .s ." ] unit is " my-unit . . ." [" .s ." ]" cr - THEN - my-unit " set-address" $call-parent - - inquiry dup 0= IF drop false EXIT THEN - scsi-disk-debug? IF - ." ---- inquiry: ----" cr - dup 100 dump cr - ." ------------------" cr - THEN - - \ Skip devices with PQ != 0 - dup inquiry-data>peripheral c@ e0 and 0 <> IF - ." SCSI-DISK: Unsupported PQ != 0" cr - false EXIT - THEN - - inquiry-data>peripheral c@ CASE - 5 OF true to is_cdrom ENDOF - 7 OF true to is_cdrom ENDOF - ENDCASE - - scsi-disk-debug? IF - is_cdrom IF - ." SCSI-DISK: device treated as CD-ROM" cr - ELSE - ." SCSI-DISK: device treated as disk" cr - THEN - THEN - - is_cdrom IF prep-cdrom ELSE prep-disk THEN - not IF false EXIT THEN - - " max-transfer" $call-parent to max-transfer - - read-capacity to max-block-num to block-size - max-block-num 0= block-size 0= OR IF - ." SCSI-DISK: Failed to get disk capacity!" cr - FALSE EXIT - THEN - - scsi-disk-debug? IF - ." Capacity: " max-block-num . ." blocks of " block-size . cr - THEN - - 0 0 " deblocker" $open-package dup deblocker ! dup IF - " disk-label" find-package IF - my-args rot interpose - THEN - THEN 0<> -; - -: close ( -- ) - deblocker @ close-package ; - -: seek ( pos.lo pos.hi -- status ) - s" seek" deblocker @ $call-method ; - -: read ( addr len -- actual ) - s" read" deblocker @ $call-method ; - -\ Get rid of SCSI bits -scsi-close - -finish-device diff --git a/qemu/roms/SLOF/slof/fs/scsi-host-helpers.fs b/qemu/roms/SLOF/slof/fs/scsi-host-helpers.fs deleted file mode 100644 index 579ce37f9..000000000 --- a/qemu/roms/SLOF/slof/fs/scsi-host-helpers.fs +++ /dev/null @@ -1,127 +0,0 @@ -\ This file is meant to be included by SCSI hosts to provide -\ helpers such as retry-scsi-command - -\ Returns 1 for retry, 0 for return with no error and -\ -1 for return with an error -\ -: check-retry-sense? ( sense-buf sense-len -- retry? ) - \ Check if the sense-len is at least 8 bytes - 8 < IF -1 EXIT THEN - - \ Fixed sense record, look for filemark etc... - dup sense-data>response-code c@ 7e and 70 = IF - dup sense-data>sense-key c@ e0 and IF drop -1 EXIT THEN - THEN - - \ Get sense data - scsi-get-sense-data? IF ( ascq asc sense-key ) - \ No sense or recoverable, return success - dup 2 < IF 3drop 0 EXIT THEN - \ not ready and unit attention, retry - dup 2 = swap 6 = or nip nip IF 1 EXIT THEN - THEN - \ Return failure - -1 -; - -\ This is almost as the standard retry-command but returns -\ additionally the length of the returned sense information -\ -\ The hw-err? field is gone, stat is -1 for a HW error, and -\ the sense data is provided iff stat is CHECK_CONDITION (02) -\ -\ Additionally we wait 10ms between retries -\ -0 INSTANCE VALUE rcmd-buf-addr -0 INSTANCE VALUE rcmd-buf-len -0 INSTANCE VALUE rcmd-dir -0 INSTANCE VALUE rcmd-cmd-addr -0 INSTANCE VALUE rcmd-cmd-len - -: retry-scsi-command ( buf-addr buf-len dir cmd-addr cmd-len #retries -- ... ) - ( ... 0 | [ sense-buf sense-len ] stat ) - >r \ stash #retries - to rcmd-cmd-len to rcmd-cmd-addr to rcmd-dir to rcmd-buf-len to rcmd-buf-addr - 0 \ dummy status & sense - r> \ retreive #retries ( stat #retries ) - 0 DO - \ drop previous status & sense - 0<> IF 2drop THEN - - \ Restore arguments - rcmd-buf-addr - rcmd-buf-len - rcmd-dir - rcmd-cmd-addr - rcmd-cmd-len - - \ Send command - execute-scsi-command ( [ sense-buf sense-len ] stat ) - - \ Success ? - dup 0= IF LEAVE THEN - - \ HW error ? - dup -1 = IF LEAVE THEN - - \ Check condition ? - dup 2 = IF ( sense-buf sense-len stat ) - >r \ stash stat ( sense-buf sense len ) - 2dup - check-retry-sense? ( sense-buf sense-len retry? ) - r> swap \ unstash stat ( sense-buf sense-len stat retry? ) - \ Check retry? result - CASE - 0 OF 3drop 0 LEAVE ENDOF \ Swallow error, return 0 - -1 OF LEAVE ENDOF \ No retry - ENDCASE - ELSE \ Anything other than busy -> exit - dup 8 <> IF LEAVE THEN - THEN - a ms - LOOP -; - -\ ----------------------------------------------------------- -\ Some command helpers -\ ----------------------------------------------------------- -\ -\ TODO: Get rid of global "sector" and instead return an -\ allocated block for the caller to free - -CREATE sector d# 512 allot -CREATE cdb 10 allot - -: (inquiry) ( size -- buffer | NULL ) - dup cdb scsi-build-inquiry - \ 16 retries for inquiry to flush out any UAs - sector swap scsi-dir-read cdb scsi-param-size 10 retry-scsi-command - \ Success ? - 0= IF sector ELSE 2drop 0 THEN -; - -\ Read the initial 36bytes and then decide how much more is to be read -: inquiry ( -- buffer | NULL ) - d# 36 (inquiry) 0= IF 0 EXIT THEN - sector inquiry-data>add-length c@ 5 + - (inquiry) -; - -: report-luns ( -- [ sector ] true | false ) - 200 cdb scsi-build-report-luns - \ 16 retries to flush out any UAs - sector 200 scsi-dir-read cdb scsi-param-size 10 retry-scsi-command - \ Success ? - 0= IF sector true ELSE drop false THEN -; - -\ This routine creates a disk alias for the first found disk/cdrom -: make-disk-alias ( $name srplun -- ) - >r 2dup r> -rot ( $name srplun $name) - find-alias 0<> IF 4drop exit THEN - get-node node>path - 20 allot - " /disk@" string-cat ( $name srplun npath npathl ) - rot base @ >r hex (u.) r> base ! string-cat ( $name $diskpath ) - set-alias -; diff --git a/qemu/roms/SLOF/slof/fs/scsi-loader.fs b/qemu/roms/SLOF/slof/fs/scsi-loader.fs deleted file mode 100644 index fec1f78dc..000000000 --- a/qemu/roms/SLOF/slof/fs/scsi-loader.fs +++ /dev/null @@ -1,77 +0,0 @@ -\ ***************************************************************************** -\ * Copyright (c) 2004, 2008 IBM Corporation -\ * All rights reserved. -\ * This program and the accompanying materials -\ * are made available under the terms of the BSD License -\ * which accompanies this distribution, and is available at -\ * http://www.opensource.org/licenses/bsd-license.php -\ * -\ * Contributors: -\ * IBM Corporation - initial implementation -\ ****************************************************************************/ - -\ ************************************** -\ Last change: MiR 13.11.2007 10:55:57 -\ ************************************** - -: .ansi-attr-off 1b emit ." [0m" ; \ ESC Sequence: all terminal attributes off -: .ansi-blue 1b emit ." [34m" ; \ ESC Sequence: foreground-color = blue -: .ansi-green 1b emit ." [32m" ; \ ESC Sequence: foreground-color = green -: .ansi-red 1b emit ." [31m" ; \ ESC Sequence: foreground-color = green -: .ansi-bold 1b emit ." [1m" ; \ ESC Sequence: foreground-color bold - -false VALUE scsi-supp-present? - -: scsi-xt-err ." SCSI-ERROR (Intern) " ; -' scsi-xt-err VALUE scsi-open-xt \ preset with an invalid token - -\ ************************************* -\ utility to show all active word-lists -\ ************************************* -: .wordlists ( -- ) - .ansi-red - get-order ( -- wid1 .. widn n ) - dup space 28 emit .d ." word lists : " - 0 DO - . 08 emit 2c emit - LOOP - 08 emit \ 'bs' - 29 emit \ ')' - cr space 28 emit - ." Context: " context dup . - @ 5b emit . 8 emit 5d emit - space - ." / Current: " current . - .ansi-attr-off - cr -; - -\ ************************************* -\ utility to show first word-lists -\ ************************************* -: .context ( num -- ) - .ansi-red - space - 5b emit - 23 emit . 3a emit - context @ - . 8 emit 5d emit space - .ansi-attr-off -; - -\ **************************************************************************** -\ open scsi-support by adding a new word list on top of search path -\ first check if scsi-support.fs must be included (first call) -\ when open use execution pointer to access version in new word list -\ **************************************************************************** -: scsi-open ( -- ) - scsi-supp-present? NOT - IF - s" scsi-support.fs" included ( xt-open ) - to scsi-open-xt ( ) - true to scsi-supp-present? - THEN - scsi-open-xt execute -; - - diff --git a/qemu/roms/SLOF/slof/fs/scsi-probe-helpers.fs b/qemu/roms/SLOF/slof/fs/scsi-probe-helpers.fs deleted file mode 100644 index 6aec8b159..000000000 --- a/qemu/roms/SLOF/slof/fs/scsi-probe-helpers.fs +++ /dev/null @@ -1,95 +0,0 @@ -\ This file is meant to be included by SCSI hosts to provide -\ probing helpers - scsi-find-disks - -: wrapped-inquiry ( -- true | false ) - inquiry 0= IF false EXIT THEN - \ Skip devices with PQ != 0 - sector inquiry-data>peripheral c@ e0 and 0 = -; - -: scsi-read-lun ( addr -- lun true | false ) - dup c@ C0 AND CASE - 40 OF w@-be 3FFF AND TRUE ENDOF - 0 OF w@-be TRUE ENDOF - dup dup OF ." Unsupported LUN format = " . cr FALSE ENDOF - ENDCASE -; - -: vscsi-report-luns ( -- array ndev ) - \ array of pointers, up to 8 devices - dev-max-target 3 << alloc-mem dup - 0 ( devarray devcur ndev ) - dev-max-target 0 DO - i 0 dev-generate-srplun (set-target) - report-luns nip IF - sector l@ ( devarray devcur ndev size ) - sector 8 + swap ( devarray devcur ndev lunarray size ) - dup 8 + dup alloc-mem ( devarray devcur ndev lunarray size size+ mem ) - dup rot 0 fill ( devarray devcur ndev lunarray size mem ) - dup >r swap move r> ( devarray devcur ndev mem ) - dup sector l@ 3 >> 0 ?DO ( devarray devcur ndev mem memcur ) - dup dup scsi-read-lun IF - j swap dev-generate-srplun swap x! 8 + - ELSE - 2drop - THEN - LOOP drop - rot ( devarray ndev mem devcur ) - dup >r x! r> 8 + ( devarray ndev devcur ) - swap 1 + - ELSE - dev-max-target 1 = IF - \ Some USB MSC devices do not implement report - \ luns. That will stall the bulk pipe. These devices are - \ single lun devices, report it accordingly - - ( devarray devcur ndev ) - 16 alloc-mem ( devarray devcur ndev mem ) - dup 16 0 fill ( devarray devcur ndev mem ) - dup 0 0 dev-generate-srplun swap x! ( devarray devcur ndev mem ) - rot x! ( devarray ndev ) - 1 + - UNLOOP EXIT - THEN - THEN - LOOP - nip -; - -: make-media-alias ( $name srplun -- ) - >r - get-next-alias ?dup IF - r> make-disk-alias - ELSE - r> drop - THEN -; - -: scsi-find-disks ( -- ) - ." SCSI: Looking for devices" cr - vscsi-report-luns - 0 ?DO - dup x@ - BEGIN - dup x@ - dup 0= IF drop TRUE ELSE - (set-target) wrapped-inquiry IF - ." " current-target (u.) type ." " - \ XXX FIXME: Check top bits to ignore unsupported units - \ and maybe provide better printout & more cases - \ XXX FIXME: Actually check for LUNs - sector inquiry-data>peripheral c@ CASE - 0 OF ." DISK : " " disk" current-target make-media-alias ENDOF - 5 OF ." CD-ROM : " " cdrom" current-target make-media-alias ENDOF - 7 OF ." OPTICAL : " " cdrom" current-target make-media-alias ENDOF - e OF ." RED-BLOCK: " " disk" current-target make-media-alias ENDOF - dup dup OF ." ? (" . 8 emit 29 emit 5 spaces ENDOF - ENDCASE - sector .inquiry-text cr - THEN - 8 + FALSE - THEN - UNTIL drop - 8 + - LOOP drop -; diff --git a/qemu/roms/SLOF/slof/fs/scsi-support.fs b/qemu/roms/SLOF/slof/fs/scsi-support.fs deleted file mode 100644 index 3e65c8781..000000000 --- a/qemu/roms/SLOF/slof/fs/scsi-support.fs +++ /dev/null @@ -1,847 +0,0 @@ -\ ***************************************************************************** -\ * Copyright (c) 2004, 2008 IBM Corporation -\ * All rights reserved. -\ * This program and the accompanying materials -\ * are made available under the terms of the BSD License -\ * which accompanies this distribution, and is available at -\ * http://www.opensource.org/licenses/bsd-license.php -\ * -\ * Contributors: -\ * IBM Corporation - initial implementation -\ ****************************************************************************/ - -\ ************************************************ -\ create a new scsi word-list named 'scsi-words' -\ ************************************************ -vocabulary scsi-words \ create new word list named 'scsi-words' -also scsi-words definitions \ place next definitions into new list - -\ for some commands specific parameters are used, which normally -\ need not to be altered. These values are preset at include time -\ or explicit by a call of 'scsi-supp-init' -false value scsi-param-debug \ common debugging flag -d# 0 value scsi-param-size \ length of CDB processed last -h# 0 value scsi-param-control \ control word for CDBs as defined in SAM-4 -d# 0 value scsi-param-errors \ counter for detected errors - -\ utility to increment error counter -: scsi-inc-errors - scsi-param-errors 1 + to scsi-param-errors -; - -\ *************************************************************************** -\ SCSI-Command: TEST UNIT READY -\ Type: Primary Command (SPC-3 clause 6.33) -\ *************************************************************************** -\ Forth Word: scsi-build-test-unit-ready ( cdb -- ) -\ *************************************************************************** -\ checks if a device is ready to receive commands -\ *************************************************************************** -\ command code: -00 CONSTANT scsi-cmd-test-unit-ready -\ CDB structure: -STRUCT - /c FIELD test-unit-ready>operation-code \ 00h - 4 FIELD test-unit-ready>reserved \ unused - /c FIELD test-unit-ready>control \ control byte as specified in SAM-4 -CONSTANT scsi-length-test-unit-ready - -\ cdb build: -\ all fields are zeroed -: scsi-build-test-unit-ready ( cdb -- ) - dup scsi-length-test-unit-ready erase ( cdb ) - scsi-param-control swap test-unit-ready>control c! ( ) - scsi-length-test-unit-ready to scsi-param-size \ update CDB length -; - -\ *************************************************************************** -\ SCSI-Command: REPORT LUNS -\ Type: Primary Command -\ *************************************************************************** -\ Forth Word: scsi-build-report-luns ( cdb -- ) -\ *************************************************************************** -\ report all LUNs supported by a device -\ *************************************************************************** -\ command code: -a0 CONSTANT scsi-cmd-report-luns -\ CDB structure: -STRUCT - /c FIELD report-luns>operation-code \ a0h - 1 FIELD report-luns>reserved \ unused - /c FIELD report-luns>select-report \ report select byte - 3 FIELD report-luns>reserved2 \ unused - /l FIELD report-luns>alloc-length \ report length - 1 FIELD report-luns>reserved3 \ unused - /c FIELD report-luns>control \ control byte -CONSTANT scsi-length-report-luns - -\ cdb build: -\ all fields are zeroed -: scsi-build-report-luns ( alloc-len cdb -- ) - dup scsi-length-report-luns erase \ 12 bytes CDB - scsi-cmd-report-luns over ( alloc-len cdb cmd cdb ) - report-luns>operation-code c! ( alloc-len cdb ) - scsi-param-control over report-luns>control c! ( alloc-len cdb ) - report-luns>alloc-length l! \ size of Data-In Buffer - scsi-length-report-luns to scsi-param-size \ update CDB length -; - -\ *************************************************************************** -\ SCSI-Command: REQUEST SENSE -\ Type: Primary Command (SPC-3 clause 6.27) -\ *************************************************************************** -\ Forth Word: scsi-build-request-sense ( cdb -- ) -\ *************************************************************************** -\ for return data a buffer of at least 252 bytes must be present! -\ see spec: SPC-3 (r23) / clauses 4.5 and 6.27 -\ *************************************************************************** -\ command code: -03 CONSTANT scsi-cmd-request-sense -\ CDB structure: -STRUCT - /c FIELD request-sense>operation-code \ 03h - 3 FIELD request-sense>reserved \ unused - /c FIELD request-sense>allocation-length \ buffer-length for data response - /c FIELD request-sense>control \ control byte as specified in SAM-4 -CONSTANT scsi-length-request-sense - -\ cdb build: -: scsi-build-request-sense ( alloc-len cdb -- ) - >r ( alloc-len ) ( R: -- cdb ) - r@ scsi-length-request-sense erase ( alloc-len ) - scsi-cmd-request-sense r@ ( alloc-len cmd cdb ) - request-sense>operation-code c! ( alloc-len ) - dup d# 252 > \ buffer length too big ? - IF - scsi-inc-errors - drop d# 252 \ replace with 252 - ELSE - dup d# 18 < \ allocated buffer too small ? - IF - scsi-inc-errors - drop 0 \ reject return data - THEN - THEN ( alloclen ) - r@ request-sense>allocation-length c! ( ) - scsi-param-control r> request-sense>control c! ( alloc-len cdb ) ( R: cdb -- ) - scsi-length-request-sense to scsi-param-size \ update CDB length -; - -\ ---------------------------------------- -\ SCSI-Response: SENSE_DATA -\ ---------------------------------------- -70 CONSTANT scsi-response(request-sense-0) -71 CONSTANT scsi-response(request-sense-1) - -STRUCT - /c FIELD sense-data>response-code \ 70h (current errors) or 71h (deferred errors) - /c FIELD sense-data>obsolete - /c FIELD sense-data>sense-key \ D3..D0 = sense key, D7 = EndOfMedium - /l FIELD sense-data>info - /c FIELD sense-data>alloc-length \ <= 244 (for max size) - /l FIELD sense-data>command-info - /c FIELD sense-data>asc \ additional sense key - /c FIELD sense-data>ascq \ additional sense key qualifier - /c FIELD sense-data>unit-code - 3 FIELD sense-data>key-specific - /c FIELD sense-data>add-sense-bytes \ start of appended extra bytes -CONSTANT scsi-length-sense-data - -\ ---------------------------------------- -\ get from SCSI response block: -\ - Additional Sense Code Qualifier -\ - Additional Sense Code -\ - sense-key -\ ---------------------------------------- -\ Forth Word: scsi-get-sense-data ( addr -- ascq asc sense-key ) -\ ---------------------------------------- -: scsi-get-sense-data ( addr -- ascq asc sense-key ) - >r ( R: -- addr ) - r@ sense-data>response-code c@ 7f and 72 >= IF - r@ 3 + c@ ( ascq ) - r@ 2 + c@ ( ascq asc ) - r> 1 + c@ 0f and ( ascq asc sense-key ) - ELSE - r@ sense-data>ASCQ c@ ( ascq ) - r@ sense-data>ASC c@ ( ascq asc ) - r> sense-data>sense-key c@ 0f and ( ascq asc sense-key ) ( R: addr -- ) - THEN -; - -\ -------------------------------------------------------------------------- -\ Forth Word: scsi-get-sense-data? ( addr -- false | ascq asc sense-key true ) -\ -------------------------------------------------------------------------- -: scsi-get-sense-data? ( addr -- false | ascq asc sense-key true ) - dup - sense-data>response-code c@ - 7e AND dup 70 = swap 72 = or \ Response code (some devices have MSB set) - IF - scsi-get-sense-data TRUE - ELSE - drop FALSE \ drop addr - THEN - -; - -\ -------------------------------------------------------------------------- -\ Forth Word: scsi-get-sense-ID? ( addr -- false | sense-ID true ) -\ same as scsi-get-sense-data? but returns -\ a single word composed of: sense-key<<16 | asc<<8 | ascq -\ -------------------------------------------------------------------------- -: scsi-get-sense-ID? ( addr -- false | ascq asc sense-key true ) - dup - sense-data>response-code c@ - 7e AND 70 = \ Response code (some devices have MSB set) - IF - scsi-get-sense-data ( ascq asc sense-key ) - 10 lshift ( ascq asc sense-key16 ) - swap 8 lshift or ( ascq sense-key+asc ) - swap or \ 24-bit sense-ID ( sense-key+asc+ascq ) - TRUE - ELSE - drop FALSE \ drop addr - THEN -; - -\ *************************************************************************** -\ SCSI-Command: INQUIRY -\ Type: Primary Command (SPC-3 clause 6.4) -\ *************************************************************************** -\ Forth Word: scsi-build-inquiry ( alloc-len cdb -- ) -\ *************************************************************************** -\ command code: -12 CONSTANT scsi-cmd-inquiry - -\ CDB structure -STRUCT - /c FIELD inquiry>operation-code \ 0x12 - /c FIELD inquiry>reserved \ + EVPD-Bit (vital product data) - /c FIELD inquiry>page-code \ page code for vital product data (if used) - /w FIELD inquiry>allocation-length \ length of Data-In-Buffer - /c FIELD inquiry>control \ control byte as specified in SAM-4 -CONSTANT scsi-length-inquiry - -\ Setup command INQUIRY -: scsi-build-inquiry ( alloc-len cdb -- ) - dup scsi-length-inquiry erase \ 6 bytes CDB - scsi-cmd-inquiry over ( alloc-len cdb cmd cdb ) - inquiry>operation-code c! ( alloc-len cdb ) - scsi-param-control over inquiry>control c! ( alloc-len cdb ) - inquiry>allocation-length w! \ size of Data-In Buffer - scsi-length-inquiry to scsi-param-size \ update CDB length -; - -\ ---------------------------------------- -\ block structure of inquiry return data: -\ ---------------------------------------- -STRUCT - /c FIELD inquiry-data>peripheral \ qualifier and device type - /c FIELD inquiry-data>reserved1 - /c FIELD inquiry-data>version \ supported SCSI version (1,2,3) - /c FIELD inquiry-data>data-format - /c FIELD inquiry-data>add-length \ total block length - 4 - /c FIELD inquiry-data>flags1 - /c FIELD inquiry-data>flags2 - /c FIELD inquiry-data>flags3 - d# 8 FIELD inquiry-data>vendor-ident \ vendor string - d# 16 FIELD inquiry-data>product-ident \ device string - /l FIELD inquiry-data>product-revision \ revision string - d# 20 FIELD inquiry-data>vendor-specific \ optional params -\ can be increased by vendor specific fields -CONSTANT scsi-length-inquiry-data - -\ *************************************************************************** -\ SCSI-Command: READ CAPACITY (10) -\ Type: Block Command (SBC-3 clause 5.12) -\ *************************************************************************** -\ Forth Word: scsi-build-read-capacity-10 ( cdb -- ) -\ *************************************************************************** -25 CONSTANT scsi-cmd-read-capacity-10 \ command code - -STRUCT \ SCSI 10-byte CDB structure - /c FIELD read-cap-10>operation-code - /c FIELD read-cap-10>reserved1 - /l FIELD read-cap-10>lba - /w FIELD read-cap-10>reserved2 - /c FIELD read-cap-10>reserved3 - /c FIELD read-cap-10>control -CONSTANT scsi-length-read-cap-10 - -\ Setup READ CAPACITY (10) command -: scsi-build-read-cap-10 ( cdb -- ) - dup scsi-length-read-cap-10 erase ( cdb ) - scsi-cmd-read-capacity-10 over ( cdb cmd cdb ) - read-cap-10>operation-code c! ( cdb ) - scsi-param-control swap read-cap-10>control c! ( ) - scsi-length-read-cap-10 to scsi-param-size \ update CDB length -; - -\ ---------------------------------------- -\ get from SCSI response block: -\ - Additional Sense Code Qualifier -\ - Additional Sense Code -\ - sense-key -\ ---------------------------------------- -\ Forth Word: scsi-get-capacity-10 ( addr -- block-size #blocks ) -\ ---------------------------------------- -\ Block structure -STRUCT - /l FIELD read-cap-10-data>max-lba - /l FIELD read-cap-10-data>block-size -CONSTANT scsi-length-read-cap-10-data - -\ get data-block -: scsi-get-capacity-10 ( addr -- block-size #blocks ) - >r ( addr -- ) ( R: -- addr ) - r@ read-cap-10-data>block-size l@ ( block-size ) - r> read-cap-10-data>max-lba l@ ( block-size #blocks ) ( R: addr -- ) -; - -\ *************************************************************************** -\ SCSI-Command: READ CAPACITY (16) -\ Type: Block Command (SBC-3 clause 5.13) -\ *************************************************************************** -\ Forth Word: scsi-build-read-capacity-16 ( cdb -- ) -\ *************************************************************************** -9e CONSTANT scsi-cmd-read-capacity-16 \ command code - -STRUCT \ SCSI 16-byte CDB structure - /c FIELD read-cap-16>operation-code - /c FIELD read-cap-16>service-action - /l FIELD read-cap-16>lba-high - /l FIELD read-cap-16>lba-low - /l FIELD read-cap-16>allocation-length \ should be 32 - /c FIELD read-cap-16>reserved - /c FIELD read-cap-16>control -CONSTANT scsi-length-read-cap-16 - -\ Setup READ CAPACITY (16) command -: scsi-build-read-cap-16 ( cdb -- ) - >r r@ ( R: -- cdb ) - scsi-length-read-cap-16 erase ( ) - scsi-cmd-read-capacity-16 ( code ) - r@ read-cap-16>operation-code c! ( ) - 10 r@ read-cap-16>service-action c! - d# 32 \ response size 32 bytes - r@ read-cap-16>allocation-length l! ( ) - scsi-param-control r> read-cap-16>control c! ( R: cdb -- ) - scsi-length-read-cap-16 to scsi-param-size \ update CDB length -; - -\ ---------------------------------------- -\ get from SCSI response block: -\ - Block Size (in Bytes) -\ - Number of Blocks -\ ---------------------------------------- -\ Forth Word: scsi-get-capacity-16 ( addr -- block-size #blocks ) -\ ---------------------------------------- -\ Block structure for return data -STRUCT - /l FIELD read-cap-16-data>max-lba-high \ upper quadlet of Max-LBA - /l FIELD read-cap-16-data>max-lba-low \ lower quadlet of Max-LBA - /l FIELD read-cap-16-data>block-size \ logical block length in bytes - /c FIELD read-cap-16-data>protect \ type of protection (4 bits) - /c FIELD read-cap-16-data>exponent \ logical blocks per physical blocks - /w FIELD read-cap-16-data>lowest-aligned \ first LBA of a phsy. block - 10 FIELD read-cap-16-data>reserved \ 16 reserved bytes -CONSTANT scsi-length-read-cap-16-data \ results in 32 - -\ get data-block -: scsi-get-capacity-16 ( addr -- block-size #blocks ) - >r ( R: -- addr ) - r@ read-cap-16-data>block-size l@ ( block-size ) - r@ read-cap-16-data>max-lba-high l@ ( block-size #blocks-high ) - d# 32 lshift ( block-size #blocks-upper ) - r> read-cap-16-data>max-lba-low l@ + ( block-size #blocks ) ( R: addr -- ) -; - -\ *************************************************************************** -\ SCSI-Command: MODE SENSE (10) -\ Type: Primary Command (SPC-3 clause 6.10) -\ *************************************************************************** -\ Forth Word: scsi-build-mode-sense-10 ( alloc-len subpage page cdb -- ) -\ *************************************************************************** -5a CONSTANT scsi-cmd-mode-sense-10 - -\ CDB structure -STRUCT - /c FIELD mode-sense-10>operation-code - /c FIELD mode-sense-10>res-llbaa-dbd-res - /c FIELD mode-sense-10>pc-page-code \ page code + page control - /c FIELD mode-sense-10>sub-page-code - 3 FIELD mode-sense-10>reserved2 - /w FIELD mode-sense-10>allocation-length - /c FIELD mode-sense-10>control -CONSTANT scsi-length-mode-sense-10 - -: scsi-build-mode-sense-10 ( alloc-len subpage page cdb -- ) - >r ( alloc-len subpage page ) ( R: -- cdb ) - r@ scsi-length-mode-sense-10 erase \ 10 bytes CDB - scsi-cmd-mode-sense-10 ( alloc-len subpage page cmd ) - r@ mode-sense-10>operation-code c! ( alloc-len subpage page ) - 10 r@ mode-sense-10>res-llbaa-dbd-res c! \ long LBAs accepted - r@ mode-sense-10>pc-page-code c! ( alloc-len subpage ) - r@ mode-sense-10>sub-page-code c! ( alloc-len ) - r@ mode-sense-10>allocation-length w! ( ) - - scsi-param-control r> mode-sense-10>control c! ( R: cdb -- ) - scsi-length-mode-sense-10 to scsi-param-size \ update CDB length -; - -\ return data processing -\ (see spec: SPC-3 clause 7.4.3) - -STRUCT - /w FIELD mode-sense-10-data>head-length - /c FIELD mode-sense-10-data>head-medium - /c FIELD mode-sense-10-data>head-param - /c FIELD mode-sense-10-data>head-longlba - /c FIELD mode-sense-10-data>head-reserved - /w FIELD mode-sense-10-data>head-descr-len -CONSTANT scsi-length-mode-sense-10-data - -\ **************************************** -\ This function shows the mode page header -\ helpful for further analysis -\ **************************************** -: .mode-sense-data ( addr -- ) - cr - dup mode-sense-10-data>head-length - w@ ." Mode Length: " .d space - dup mode-sense-10-data>head-medium - c@ ." / Medium Type: " .d space - dup mode-sense-10-data>head-longlba - c@ ." / Long LBA: " .d space - mode-sense-10-data>head-descr-len - w@ ." / Descr. Length: " .d -; - -\ *************************************************************************** -\ SCSI-Command: READ (6) -\ Type: Block Command (SBC-3 clause 5.7) -\ *************************************************************************** -\ Forth Word: scsi-build-read-6 ( block# #blocks cdb -- ) -\ *************************************************************************** -\ this SCSI command uses 21 bits to represent start LBA -\ and 8 bits to specify the numbers of blocks to read -\ The value of 0 blocks is interpreted as 256 blocks -\ -\ command code -08 CONSTANT scsi-cmd-read-6 - -\ CDB structure -STRUCT - /c FIELD read-6>operation-code \ 08h - /c FIELD read-6>block-address-msb \ upper 5 bits - /w FIELD read-6>block-address \ lower 16 bits - /c FIELD read-6>length \ number of blocks to read - /c FIELD read-6>control \ CDB control -CONSTANT scsi-length-read-6 - -: scsi-build-read-6 ( block# #blocks cdb -- ) - >r ( block# #blocks ) ( R: -- cdb ) - r@ scsi-length-read-6 erase \ 6 bytes CDB - scsi-cmd-read-6 r@ read-6>operation-code c! ( block# #blocks ) - - \ check block count to read (#blocks) - dup d# 255 > \ #blocks exceeded limit ? - IF - scsi-inc-errors - drop 1 \ replace with any valid number - THEN - r@ read-6>length c! \ set #blocks to read - - \ check starting block number (block#) - dup 1fffff > \ check address upper limit - IF - scsi-inc-errors - drop \ remove original block# - 1fffff \ replace with any valid address - THEN - dup d# 16 rshift - r@ read-6>block-address-msb c! \ set upper 5 bits - ffff and - r@ read-6>block-address w! \ set lower 16 bits - scsi-param-control r> read-6>control c! ( R: cdb -- ) - scsi-length-read-6 to scsi-param-size \ update CDB length -; - -\ *************************************************************************** -\ SCSI-Command: READ (10) -\ Type: Block Command (SBC-3 clause 5.8) -\ *************************************************************************** -\ Forth Word: scsi-build-read-10 ( block# #blocks cdb -- ) -\ *************************************************************************** -\ command code -28 CONSTANT scsi-cmd-read-10 - -\ CDB structure -STRUCT - /c FIELD read-10>operation-code - /c FIELD read-10>protect - /l FIELD read-10>block-address \ logical block address (32bits) - /c FIELD read-10>group - /w FIELD read-10>length \ transfer length (16-bits) - /c FIELD read-10>control -CONSTANT scsi-length-read-10 - -: scsi-build-read-10 ( block# #blocks cdb -- ) - >r ( block# #blocks ) ( R: -- cdb ) - r@ scsi-length-read-10 erase \ 10 bytes CDB - scsi-cmd-read-10 r@ read-10>operation-code c! ( block# #blocks ) - r@ read-10>length w! ( block# ) - r@ read-10>block-address l! ( ) - scsi-param-control r> read-10>control c! ( R: cdb -- ) - scsi-length-read-10 to scsi-param-size \ update CDB length -; - -\ *************************************************************************** -\ SCSI-Command: READ (12) -\ Type: Block Command (SBC-3 clause 5.9) -\ *************************************************************************** -\ Forth Word: scsi-build-read-12 ( block# #blocks cdb -- ) -\ *************************************************************************** -\ command code -a8 CONSTANT scsi-cmd-read-12 - -\ CDB structure -STRUCT - /c FIELD read-12>operation-code \ code: a8 - /c FIELD read-12>protect \ RDPROTECT, DPO, FUA, FUA_NV - /l FIELD read-12>block-address \ lba - /l FIELD read-12>length \ transfer length (32bits) - /c FIELD read-12>group \ group number - /c FIELD read-12>control -CONSTANT scsi-length-read-12 - -: scsi-build-read-12 ( block# #blocks cdb -- ) - >r ( block# #blocks ) ( R: -- cdb ) - r@ scsi-length-read-12 erase \ 12 bytes CDB - scsi-cmd-read-12 r@ read-12>operation-code c! ( block# #blocks ) - r@ read-12>length l! ( block# ) - r@ read-12>block-address l! ( ) - scsi-param-control r> read-12>control c! ( R: cdb -- ) - scsi-length-read-12 to scsi-param-size \ update CDB length -; - -\ *************************************************************************** -\ SCSI-Command: READ with autodetection of required command -\ read(10) or read(12) depending on parameter size -\ (read(6) removed because obsolete in some cases (USB)) -\ Type: Block Command -\ *************************************************************************** -\ Forth Word: scsi-build-read? ( block# #blocks cdb -- ) -\ -\ +----------------+---------------------------| -\ | block# (lba) | #block (transfer-length) | -\ +-----------+----------------+---------------------------| -\ | read-6 | 16-Bits | 8 Bits | -\ | read-10 | 32-Bits | 16 Bits | -\ | read-12 | 32-Bits | 32 Bits | -\ *************************************************************************** -: scsi-build-read? ( block# #blocks cdb -- length ) - over ( block# #blocks cdb #blocks ) - fffe > \ tx-length (#blocks) exceeds 16-bit limit ? - IF - scsi-build-read-12 ( block# #blocks cdb -- ) - scsi-length-read-12 ( length ) - ELSE ( block# #blocks cdb ) - scsi-build-read-10 ( block# #blocks cdb -- ) - scsi-length-read-10 ( length ) - THEN -; - -\ *************************************************************************** -\ SCSI-Command: START STOP UNIT -\ Type: Block Command (SBC-3 clause 5.19) -\ *************************************************************************** -\ Forth Word: scsi-build-start-stop-unit ( state# cdb -- ) -\ *************************************************************************** -\ command code -1b CONSTANT scsi-cmd-start-stop-unit - -\ CDB structure -STRUCT - /c FIELD start-stop-unit>operation-code - /c FIELD start-stop-unit>immed - /w FIELD start-stop-unit>reserved - /c FIELD start-stop-unit>pow-condition - /c FIELD start-stop-unit>control -CONSTANT scsi-length-start-stop-unit - -\ START/STOP constants -\ (see spec: SBC-3 clause 5.19) -f1 CONSTANT scsi-const-active-power \ param used for start-stop-unit -f2 CONSTANT scsi-const-idle-power \ param used for start-stop-unit -f3 CONSTANT scsi-const-standby-power \ param used for start-stop-unit -3 CONSTANT scsi-const-load \ param used for start-stop-unit -2 CONSTANT scsi-const-eject \ param used for start-stop-unit -1 CONSTANT scsi-const-start -0 CONSTANT scsi-const-stop - -: scsi-build-start-stop-unit ( state# cdb -- ) - >r ( state# ) ( R: -- cdb ) - r@ scsi-length-start-stop-unit erase \ 6 bytes CDB - scsi-cmd-start-stop-unit r@ start-stop-unit>operation-code c! - dup 3 > - IF - 4 lshift \ shift to upper nibble - THEN ( state ) - r@ start-stop-unit>pow-condition c! ( ) - scsi-param-control r> start-stop-unit>control c! ( R: cdb -- ) - scsi-length-start-stop-unit to scsi-param-size \ update CDB length -; - -\ *************************************************************************** -\ SCSI-Command: SEEK(10) -\ Type: Block Command (obsolete) -\ *************************************************************************** -\ Forth Word: scsi-build-seek ( state# cdb -- ) -\ Obsolete function (last listed in spec SBC / Nov. 1997) -\ implemented only for the sake of completeness -\ *************************************************************************** -\ command code -2b CONSTANT scsi-cmd-seek - -\ CDB structure -STRUCT - /c FIELD seek>operation-code - /c FIELD seek>reserved1 - /l FIELD seek>lba - 3 FIELD seek>reserved2 - /c FIELD seek>control -CONSTANT scsi-length-seek - -: scsi-build-seek ( lba cdb -- ) - >r ( lba ) ( R: -- cdb ) - r@ scsi-length-seek erase \ 10 bytes CDB - scsi-cmd-seek r@ seek>operation-code c! - r> seek>lba l! ( ) ( R: cdb -- ) - scsi-length-seek to scsi-param-size \ update CDB length -; - -\ **************************************************************************** -\ CDROM media event stuff -\ **************************************************************************** - -STRUCT - /w FIELD media-event-data-len - /c FIELD media-event-nea-class - /c FIELD media-event-supp-class - /l FIELD media-event-data -CONSTANT scsi-length-media-event - -: scsi-build-get-media-event ( cdb -- ) - dup c erase ( cdb ) - 4a over c! ( cdb ) - 01 over 1 + c! - 10 over 4 + c! - 08 over 8 + c! - drop -; - - - -\ *************************************************************************** -\ SCSI-Utility: .sense-code -\ *************************************************************************** -\ this utility prints a string associated to the sense code -\ see specs: SPC-3/r23 clause 4.5.6 -\ *************************************************************************** -: .sense-text ( scode -- ) - case - 0 OF s" OK" ENDOF - 1 OF s" RECOVERED ERR" ENDOF - 2 OF s" NOT READY" ENDOF - 3 OF s" MEDIUM ERROR" ENDOF - 4 OF s" HARDWARE ERR" ENDOF - 5 OF s" ILLEGAL REQUEST" ENDOF - 6 OF s" UNIT ATTENTION" ENDOF - 7 OF s" DATA PROTECT" ENDOF - 8 OF s" BLANK CHECK" ENDOF - 9 OF s" VENDOR SPECIFIC" ENDOF - a OF s" COPY ABORTED" ENDOF - b OF s" ABORTED COMMAND" ENDOF - d OF s" VOLUME OVERFLOW" ENDOF - e OF s" MISCOMPARE" ENDOF - dup OF s" UNKNOWN" ENDOF - endcase - 5b emit type 5d emit -; - -\ *************************************************************************** -\ SCSI-Utility: .status-code -\ *************************************************************************** -\ this utility prints a string associated to the status code -\ see specs: SAM-3/r14 clause 5.3 -\ *************************************************************************** -: .status-text ( stat -- ) - case - 00 OF s" GOOD" ENDOF - 02 OF s" CHECK CONDITION" ENDOF - 04 OF s" CONDITION MET" ENDOF - 08 OF s" BUSY" ENDOF - 18 OF s" RESERVATION CONFLICT" ENDOF - 28 OF s" TASK SET FULL" ENDOF - 30 OF s" ACA ACTIVE" ENDOF - 40 OF s" TASK ABORTED" ENDOF - dup OF s" UNKNOWN" ENDOF - endcase - 5b emit type 5d emit -; - -\ *************************************************************************** -\ SCSI-Utility: .capacity-text -\ *************************************************************************** -\ utility that shows total capacity on screen by use of the return data -\ from read-capacity calculation is SI conform (base 10) -\ *************************************************************************** -\ sub function to print a 3 digit decimal -\ number with 2 post decimal positions xxx.yy -: .dec3-2 ( prenum postnum -- ) - swap - base @ >r \ save actual base setting - decimal \ show decimal values - 4 .r 2e emit - dup 9 <= IF 30 emit THEN .d \ 3 pre-decimal, right aligned - r> base ! \ restore base -; - -: .capacity-text ( block-size #blocks -- ) - scsi-param-debug \ debugging flag set ? - IF \ show additional info - 2dup - cr - ." LBAs: " .d \ highest logical block number - ." / Block-Size: " .d - ." / Total Capacity: " - THEN - * \ calculate total capacity - dup d# 1000000000000 >= \ check terabyte limit - IF - d# 1000000000000 /mod - swap - d# 10000000000 / \ limit remainder to two digits - .dec3-2 ." TB" \ show terabytes as xxx.yy - ELSE - dup d# 1000000000 >= \ check gigabyte limit - IF - d# 1000000000 /mod - swap - d# 10000000 / - .dec3-2 ." GB" \ show gigabytes as xxx.yy - ELSE - dup d# 1000000 >= - IF - d# 1000000 /mod \ check mega byte limit - swap - d# 10000 / - .dec3-2 ." MB" \ show megabytes as xxx.yy - ELSE - dup d# 1000 >= \ check kilo byte limit - IF - d# 1000 /mod - swap - d# 10 / - .dec3-2 ." kB" - ELSE - .d ." Bytes" - THEN - THEN - THEN - THEN -; - -\ *************************************************************************** -\ SCSI-Utility: .inquiry-text ( addr -- ) -\ *************************************************************************** -\ utility that shows: -\ vendor-ident product-ident and revision -\ from an inquiry return data block (addr) -\ *************************************************************************** -: .inquiry-text ( addr -- ) - 22 emit \ enclose text with " - dup inquiry-data>vendor-ident 8 type space - dup inquiry-data>product-ident 10 type space - inquiry-data>product-revision 4 type - 22 emit -; - -\ *************************************************************************** -\ SCSI-Utility: scsi-supp-init ( -- ) -\ *************************************************************************** -\ utility that helps to ensure that parameters are set to valid values -: scsi-supp-init ( -- ) - false to scsi-param-debug \ no debug strings - h# 0 to scsi-param-size - h# 0 to scsi-param-control \ common CDB control byte - d# 0 to scsi-param-errors \ local errors (param limits) -; - -\ *************************************************************************** -\ Constants used by SCSI controller's execute-scsi-command -\ *************************************************************************** -true CONSTANT scsi-dir-read -false CONSTANT scsi-dir-write - - -\ *************************************************************************** -\ scsi loader -\ *************************************************************************** -0 VALUE scsi-context \ addr of word list on top - - -\ **************************************************************************** -\ open scsi-support by adding a new word list on top of search path -\ precondition: scsi-support.fs must have been included -\ **************************************************************************** -: scsi-init ( -- ) - also scsi-words \ append scsi word-list - context to scsi-context \ save for close process - scsi-supp-init \ preset all scsi-param-xxx values - scsi-param-debug - IF - space ." SCSI-SUPPORT OPENED" cr - .wordlists - THEN -; - -\ **************************************************************************** -\ close scsi-session and remove scsi word list (if exists) -\ **************************************************************************** -\ if 'previous' is used without a preceding 'also' all forth words are lost ! -\ **************************************************************************** -: scsi-close ( -- ) -\ FIXME This only works if scsi-words is the last vocabulary on the stack -\ Instead we could use get-order to find us on the "wordlist stack", -\ remove us and write the wordlist stack back with set-order. -\ BUT: Is this worth the effort? - - scsi-param-debug - IF - space ." Closing SCSI-SUPPORT .. " cr - THEN - context scsi-context = \ scsi word list still active ? - IF - scsi-param-errors 0<> \ any errors occurred ? - IF - cr ." ** WARNING: " scsi-param-errors .d - ." SCSI Errors occurred ** " cr - THEN - previous \ remove scsi word list on top - 0 to scsi-context \ prevent from being misinterpreted - ELSE - cr ." ** WARNING: Trying to close non-open SCSI-SUPPORT (1) ** " cr - THEN - scsi-param-debug - IF - .wordlists - THEN -; - - -s" scsi-init" $find drop \ return execution pointer, when included - -previous \ remove scsi word list from search path -definitions \ place next definitions into previous list - diff --git a/qemu/roms/SLOF/slof/fs/search.fs b/qemu/roms/SLOF/slof/fs/search.fs deleted file mode 100644 index 3acca2f11..000000000 --- a/qemu/roms/SLOF/slof/fs/search.fs +++ /dev/null @@ -1,89 +0,0 @@ -\ ***************************************************************************** -\ * Copyright (c) 2004, 2008 IBM Corporation -\ * All rights reserved. -\ * This program and the accompanying materials -\ * are made available under the terms of the BSD License -\ * which accompanies this distribution, and is available at -\ * http://www.opensource.org/licenses/bsd-license.php -\ * -\ * Contributors: -\ * IBM Corporation - initial implementation -\ ****************************************************************************/ -\ -\ Copyright 2002,2003,2004 Segher Boessenkool <segher@kernel.crashing.org> -\ - - -\ stuff we should already have: - -: linked ( var -- ) here over @ , swap ! ; - -HEX - -\ \ \ -\ \ \ Wordlists -\ \ \ - -VARIABLE wordlists forth-wordlist wordlists ! - -\ create a new wordlist -: wordlist ( -- wid ) here wordlists linked 0 , ; - - -\ \ \ -\ \ \ Search order -\ \ \ - -10 CONSTANT max-in-search-order \ should define elsewhere -\ CREATE search-order max-in-search-order cells allot \ stack of wids \ is in engine now -\ search-order VALUE context \ top of stack \ is in engine now - -: also ( -- ) clean-hash context dup cell+ dup to context >r @ r> ! ; -: previous ( -- ) clean-hash context cell- to context ; -: only ( -- ) clean-hash search-order to context ( minimal-wordlist search-order ! ) ; -: seal ( -- ) clean-hash context @ search-order dup to context ! ; - -: get-order ( -- wid_n .. wid_1 n ) - context >r search-order BEGIN dup r@ u<= WHILE - dup @ swap cell+ REPEAT r> drop - search-order - cell / ; -: set-order ( wid_n .. wid_1 n -- ) \ XXX: special cases for 0, -1 - clean-hash 1- cells search-order + dup to context - BEGIN dup search-order u>= WHILE - dup >r ! r> cell- REPEAT drop ; - - -\ \ \ -\ \ \ Compilation wordlist -\ \ \ - -: get-current ( -- wid ) current ; -: set-current ( wid -- ) to current ; - -: definitions ( -- ) context @ set-current ; - - -\ \ \ -\ \ \ Vocabularies -\ \ \ - -: VOCABULARY ( C: "name" -- ) ( -- ) CREATE wordlist drop DOES> clean-hash context ! ; -\ : VOCABULARY ( C: "name" -- ) ( -- ) wordlist CREATE , DOES> @ context ! ; -\ XXX we'd like to swap forth and forth-wordlist around (for .voc 's sake) -: FORTH ( -- ) clean-hash forth-wordlist context ! ; - -: .voc ( wid -- ) \ display name for wid \ needs work ( body> or something like that ) - dup cell- @ ['] vocabulary ['] forth within IF - 2 cells - >name name>string type ELSE u. THEN space ; -: vocs ( -- ) \ display all wordlist names - cr wordlists BEGIN @ dup WHILE dup .voc REPEAT drop ; -: order ( -- ) - cr ." context: " get-order 0 ?DO .voc LOOP - cr ." current: " get-current .voc ; - - - - -\ some handy helper -: voc-find ( wid -- 0 | link ) - clean-hash cell+ @ (find) clean-hash ; diff --git a/qemu/roms/SLOF/slof/fs/slof-logo.fs b/qemu/roms/SLOF/slof/fs/slof-logo.fs deleted file mode 100644 index 53d318447..000000000 --- a/qemu/roms/SLOF/slof/fs/slof-logo.fs +++ /dev/null @@ -1,20 +0,0 @@ -\ ***************************************************************************** -\ * Copyright (c) 2004, 2008 IBM Corporation -\ * All rights reserved. -\ * This program and the accompanying materials -\ * are made available under the terms of the BSD License -\ * which accompanies this distribution, and is available at -\ * http://www.opensource.org/licenses/bsd-license.php -\ * -\ * Contributors: -\ * IBM Corporation - initial implementation -\ ****************************************************************************/ - -: .slof-logo - cr ." ..`. .. ....... .. ...... ......." - cr ." ..`...`''.`'. .''``````..''. .`''```''`. `''``````" - cr ." .`` .:' ': `''..... .''. ''` .''..''......." - cr ." ``.':.';. ``````''`.''. .''. ''``''`````'`" - cr ." ``.':':` .....`''.`'`...... `'`.....`''.`'` " - cr ." .`.`'`` .'`'`````. ``'''''' ``''`'''`. `'` " -; diff --git a/qemu/roms/SLOF/slof/fs/sms/sms-load.fs b/qemu/roms/SLOF/slof/fs/sms/sms-load.fs deleted file mode 100644 index 8e4db8060..000000000 --- a/qemu/roms/SLOF/slof/fs/sms/sms-load.fs +++ /dev/null @@ -1,70 +0,0 @@ -\ ***************************************************************************** -\ * Copyright (c) 2004, 2008 IBM Corporation -\ * All rights reserved. -\ * This program and the accompanying materials -\ * are made available under the terms of the BSD License -\ * which accompanies this distribution, and is available at -\ * http://www.opensource.org/licenses/bsd-license.php -\ * -\ * Contributors: -\ * IBM Corporation - initial implementation -\ ****************************************************************************/ - -false VALUE (sms-loaded?) - -false value (sms-available?) - -s" sms.fs" romfs-lookup IF true to (sms-available?) drop THEN - -(sms-available?) [IF] - -#include "packages/sms.fs" - -\ Initialize SMS NVRAM handling. -#include "sms-nvram.fs" - -\ Dynamically load sms code from the romfs file -\ Assumption is that skeleton sms package already exists -\ but aside of open & close, all other methods are in a romfs file (sms.fs) -\ Here we open the package and load the rest of the functionality - -\ After that, one needs to find-device and execute sms-start method -\ The shorthand for that is given as (global) sms-start word - -: $sms-node s" /packages/sms" ; - -: (sms-init-package) ( -- true|false ) - (sms-loaded?) ?dup IF EXIT THEN - $sms-node ['] find-device catch IF 2drop false EXIT THEN - s" sms.fs" [COMPILE] included - device-end - true dup to (sms-loaded?) -; - -\ External wrapper for sms package method -: (sms-evaluate) ( addr len -- ) - (sms-init-package) not IF - cr ." SMS is not available." cr 2drop exit - THEN - - s" Entering SMS ..." type - disable-watchdog - reset-dual-emit - - \ if we only had execute-device-method... - 2>r $sms-node find-device - 2r> evaluate - device-end - vpd-boot-import -; - -: sms-start ( -- ) s" sms-start" (sms-evaluate) ; -: sms-fru-replacement ( -- ) s" sms-fru-replacement" (sms-evaluate) ; - -[ELSE] - -: sms-start ( -- ) cr ." SMS is not available." cr ; -: sms-fru-replacement ( -- ) cr ." SMS FRU replacement is not available." cr ; - -[THEN] - diff --git a/qemu/roms/SLOF/slof/fs/sms/sms-nvram.fs b/qemu/roms/SLOF/slof/fs/sms/sms-nvram.fs deleted file mode 100644 index 4f5d6ddd5..000000000 --- a/qemu/roms/SLOF/slof/fs/sms/sms-nvram.fs +++ /dev/null @@ -1,124 +0,0 @@ -\ ***************************************************************************** -\ * Copyright (c) 2004, 2008 IBM Corporation -\ * All rights reserved. -\ * This program and the accompanying materials -\ * are made available under the terms of the BSD License -\ * which accompanies this distribution, and is available at -\ * http://www.opensource.org/licenses/bsd-license.php -\ * -\ * Contributors: -\ * IBM Corporation - initial implementation -\ ****************************************************************************/ - -\ Initialize SMS NVRAM handling. - -: sms-init-nvram ( -- ) - nvram-partition-type-sms get-nvram-partition IF - cr ." Could not find SMS partition in NVRAM - " - nvram-partition-type-sms s" SMS" d# 1024 new-nvram-partition - ABORT" Failed to create SMS NVRAM partition" - 2dup erase-nvram-partition drop - - 2dup s" lang" s" 1" internal-set-env drop - - 2dup s" tftp-retries" s" 5" internal-set-env drop - 2dup s" tftp-blocksize" s" 512" internal-set-env drop - 2dup s" bootp-retries" s" 255" internal-set-env drop - 2dup s" client" s" 000.000.000.000" internal-set-env drop - 2dup s" server" s" 000.000.000.000" internal-set-env drop - 2dup s" gateway" s" 000.000.000.000" internal-set-env drop - 2dup s" netmask" s" 255.255.255.000" internal-set-env drop - 2dup s" net-protocol" s" 0" internal-set-env drop - 2dup s" net-flags" s" 0" internal-set-env drop - 2dup s" net-device" s" 0" internal-set-env drop - 2dup s" net-client-name" s" " internal-set-env drop - - 2dup s" scsi-spinup" s" 6" internal-set-env drop - 2dup s" scsi-id-0" s" 7" internal-set-env drop - 2dup s" scsi-id-1" s" 7" internal-set-env drop - 2dup s" scsi-id-2" s" 7" internal-set-env drop - 2dup s" scsi-id-3" s" 7" internal-set-env drop - ." created" cr - THEN - s" sms-nvram-partition" $2constant -; - -sms-init-nvram - -: sms-add-env ( "name" "value" -- ) sms-nvram-partition 2rot 2rot internal-add-env drop ; -: sms-set-env ( "name" "value" -- ) sms-nvram-partition 2rot 2rot internal-set-env drop ; -: sms-get-env ( "name" -- "value" TRUE | FALSE) sms-nvram-partition 2swap internal-get-env ; - -: sms-get-net-device ( -- n ) s" net-device" sms-get-env IF $dnumber IF 0 THEN ELSE 0 THEN ; -: sms-set-net-device ( n -- ) (.d) s" net-device" 2swap sms-set-env ; - -: sms-get-net-flags ( -- n ) s" net-flags" sms-get-env IF $dnumber IF 0 THEN ELSE 0 THEN ; -: sms-set-net-flags ( n -- ) (.d) s" net-flags" 2swap sms-set-env ; - -: sms-get-net-protocol ( -- n ) s" net-protocol" sms-get-env IF $dnumber IF 0 THEN ELSE 0 THEN ; -: sms-set-net-protocol ( n -- ) (.d) s" net-protocol" 2swap sms-set-env ; - -: sms-get-lang ( -- n ) s" lang" sms-get-env IF $dnumber IF 1 THEN ELSE 1 THEN ; -: sms-set-lang ( n -- ) (.d) s" lang" 2swap sms-set-env ; - -: sms-get-bootp-retries ( -- n ) s" bootp-retries" sms-get-env IF $dnumber IF 255 THEN ELSE 255 THEN ; -: sms-set-bootp-retries ( n -- ) (.d) s" bootp-retries" 2swap sms-set-env ; - -: sms-get-tftp-retries ( -- n ) s" tftp-retries" sms-get-env IF $dnumber IF 5 THEN ELSE 5 THEN ; -: sms-set-tftp-retries ( n -- ) (.d) s" tftp-retries" 2swap sms-set-env ; - -: sms-get-tftp-blocksize ( -- n ) s" tftp-blocksize" sms-get-env IF $dnumber IF 5 THEN ELSE 5 THEN ; -: sms-set-tftp-blocksize ( n -- ) (.d) s" tftp-blocksize" 2swap sms-set-env ; - -: sms-get-client ( -- FALSE | n1 n2 n3 n4 TRUE ) s" client" sms-get-env IF (ipaddr) ELSE false THEN ; -: sms-set-client ( n1 n2 n3 n4 -- ) (ipformat) s" client" 2swap sms-set-env ; - -: sms-get-server ( -- FALSE | n1 n2 n3 n4 TRUE ) s" server" sms-get-env IF (ipaddr) ELSE false THEN ; -: sms-set-server ( n1 n2 n3 n4 -- ) (ipformat) s" server" 2swap sms-set-env ; - -: sms-get-gateway ( -- FALSE | n1 n2 n3 n4 TRUE ) s" gateway" sms-get-env IF (ipaddr) ELSE false THEN ; -: sms-set-gateway ( n1 n2 n3 n4 -- ) (ipformat) s" gateway" 2swap sms-set-env ; - -: sms-get-subnet ( -- FALSE | n1 n2 n3 n4 TRUE ) s" netmask" sms-get-env IF (ipaddr) ELSE false THEN ; -: sms-set-subnet ( n1 n2 n3 n4 -- ) (ipformat) s" netmask" 2swap sms-set-env ; - -: sms-get-client-name ( -- FALSE | addr len TRUE ) s" net-client-name" sms-get-env ; -: sms-set-client-name ( addr len -- ) s" net-client-name" 2swap sms-set-env ; - -: sms-get-scsi-spinup ( -- n ) s" scsi-spinup" sms-get-env IF $dnumber IF 6 THEN ELSE 6 THEN ; -: sms-set-scsi-spinup ( n -- ) (.d) s" scsi-spinup" 2swap sms-set-env ; - -: sms-get-scsi-id ( n -- id ) s" scsi-id-" rot (.) $cat sms-get-env IF $dnumber IF 6 THEN ELSE 6 THEN ; -: sms-set-scsi-id ( id n -- ) swap (.d) rot s" scsi-id-" rot (.) $cat sms-set-env ; - - -\ generates the boot-file part of the boot string - -: sms-get-net-boot-file ( -- addr len ) - \ the format is - \ :[bootp,]siaddr,filename,ciaddr,giaddr,bootp-retries,tftp-retries - \ we choose dhcp as a default! - s" net" sms-get-net-device (.) $cat - s" :dhcp," $cat - sms-get-server IF (ipformat) $cat THEN - s" ," $cat - sms-get-client-name IF $cat THEN - s" ," $cat - sms-get-client IF (ipformat) $cat THEN - s" ," $cat - sms-get-gateway IF (ipformat) $cat THEN - s" ," $cat - \ If the number of retries is 255 (max), assume default timeout (10min) - sms-get-bootp-retries dup ff <> IF (.) $cat ELSE drop THEN - s" ," $cat - sms-get-tftp-retries (.) $cat - \ now write the string to the boot path - dup IF - \ This could be considered a memory leak, but it is only - \ executed once for booting so it is not a problem - strdup ( s" :" 2swap $cat strdup ) - THEN -; - -' sms-get-net-boot-file to furnish-boot-file - diff --git a/qemu/roms/SLOF/slof/fs/stack.fs b/qemu/roms/SLOF/slof/fs/stack.fs deleted file mode 100644 index 0f7e097bf..000000000 --- a/qemu/roms/SLOF/slof/fs/stack.fs +++ /dev/null @@ -1,57 +0,0 @@ -\ ***************************************************************************** -\ * Copyright (c) 2004, 2008 IBM Corporation -\ * All rights reserved. -\ * This program and the accompanying materials -\ * are made available under the terms of the BSD License -\ * which accompanies this distribution, and is available at -\ * http://www.opensource.org/licenses/bsd-license.php -\ * -\ * Contributors: -\ * IBM Corporation - initial implementation -\ ****************************************************************************/ - - -\ Example: -\ -\ To get a 30 element stack, go: -\ -\ 0 > 30 new-stack my-stack -\ 0 > my-stack -\ 0 > 20 push 30 push -\ 0 > pop pop .s - -0 value current-stack - -: new-stack ( cells <>name -- ) - create >r here ( here R: cells ) - dup r@ 2 + cells ( here here bytes R: cells ) - dup allot erase ( here R: cells) - cell+ r> ( here+1cell cells ) - swap ! ( ) - DOES> to current-stack -; - -: reset-stack ( -- ) - 0 current-stack ! -; - -: stack-depth ( -- depth ) - current-stack @ -; - -: push ( value -- ) - current-stack @ - current-stack cell+ @ over <= ABORT" Stack overflow" - cells - 1 current-stack +! - current-stack 2 cells + + ! -; - -: pop ( -- value ) - current-stack @ 0= ABORT" Stack underflow" - current-stack @ cells - current-stack + cell+ @ - -1 current-stack +! -; - - diff --git a/qemu/roms/SLOF/slof/fs/start-up.fs b/qemu/roms/SLOF/slof/fs/start-up.fs deleted file mode 100644 index f1488fa38..000000000 --- a/qemu/roms/SLOF/slof/fs/start-up.fs +++ /dev/null @@ -1,171 +0,0 @@ -\ ***************************************************************************** -\ * Copyright (c) 2004, 2008 IBM Corporation -\ * All rights reserved. -\ * This program and the accompanying materials -\ * are made available under the terms of the BSD License -\ * which accompanies this distribution, and is available at -\ * http://www.opensource.org/licenses/bsd-license.php -\ * -\ * Contributors: -\ * IBM Corporation - initial implementation -\ ****************************************************************************/ - -: (boot) ( -- ) - s" Executing following boot-command: " - boot-command $cat nvramlog-write-string-cr - s" boot-command" evaluate \ get boot command - ['] evaluate catch ?dup IF \ and execute it - ." boot attempt returned: " - abort"-str @ count type cr - nip nip \ drop string from 1st evaluate - throw - THEN -; - -\ Note: The following ESC sequences has to be handled: -\ 1B 4F 50 -\ 1B 5B 31 31 7E - -\ Reads and converts the function key. -\ key = F1 -- n = 1 -: (function-key) ( -- n ) - key? IF - key CASE - 50 OF 1 ENDOF - 7e OF 1 ENDOF - dup OF 0 ENDOF - ENDCASE - THEN -; - -\ Checks if an ESC sequence occurs. -: (esc-sequence) ( -- n ) - key? IF - key CASE - 4f OF (function-key) ENDOF - 5b OF - key key (function-key) ENDOF - dup OF 0 ENDOF - ENDCASE - THEN -; - -: (s-pressed) ( -- ) - s" An 's' has been pressed. Entering Open Firmware Prompt" - nvramlog-write-string-cr -; - -: (boot?) ( -- ) - of-prompt? not auto-boot? and IF - (boot) - THEN -; - - -#include "sms/sms-load.fs" - - -\ Watchdog will be rearmed during load if use-load-watchdog variable is TRUE -TRUE VALUE use-load-watchdog? - -1 value my-boot-dev -1 value digit-val -0 value boot-dev-no - -: boot-selected - 1 to my-boot-dev - BEGIN parse-word dup WHILE - boot-dev-no my-boot-dev = IF - s" boot " 2swap $cat - ['] evaluate catch ?dup IF \ and execute it - ." boot attempt returned: " - abort"-str @ count type cr - throw - THEN - 0 0 load-list 2! - UNLOOP EXIT - ELSE - 2drop - THEN - my-boot-dev 1 + to my-boot-dev - REPEAT 2drop 0 0 load-list 2! - - (boot) -; - -: boot-start - \ Remove multiple F12 key presses if any - BEGIN key? WHILE - key drop - REPEAT - - decimal - BEGIN parse-word dup WHILE - my-boot-dev (u.) s" . " $cat type 2dup type ." : " de-alias type cr - my-boot-dev 1 + to my-boot-dev - REPEAT 2drop 0 0 load-list 2! - - cr BEGIN KEY dup emit - dup isdigit IF - dup 30 - to digit-val - boot-dev-no a * digit-val + to boot-dev-no - THEN - d = UNTIL - - boot-dev-no my-boot-dev < IF - s" boot-selected " s" $bootdev" evaluate $cat strdup evaluate - ELSE - ." Invalid choice!" cr - THEN - hex -; - -: boot-menu-start - ." Select boot device:" cr cr - s" boot-start " s" $bootdev" evaluate $cat strdup evaluate -; - -: boot-menu-enabled? ( -- true|false ) - s" qemu,boot-menu" get-chosen IF - decode-int 1 = IF - 2drop TRUE EXIT - THEN - 2drop - THEN - FALSE -; - -: f12-pressed? - 34 = >r 32 = r> and IF - TRUE - ELSE - FALSE - THEN -; - -: start-it ( -- ) - key? IF - key CASE - [char] s OF (s-pressed) ENDOF - 1b OF - (esc-sequence) CASE - 1 OF - console-clean-fifo - f12-pressed? boot-menu-enabled? and IF - boot-menu-start - ELSE - (boot?) - THEN - ENDOF - dup OF (boot?) ENDOF - ENDCASE - ENDOF - dup OF (boot?) ENDOF - ENDCASE - ELSE - (boot?) - THEN - - disable-watchdog FALSE to use-load-watchdog? - .banner -; diff --git a/qemu/roms/SLOF/slof/fs/term-io.fs b/qemu/roms/SLOF/slof/fs/term-io.fs deleted file mode 100644 index 52ce12a5b..000000000 --- a/qemu/roms/SLOF/slof/fs/term-io.fs +++ /dev/null @@ -1,97 +0,0 @@ -\ ***************************************************************************** -\ * Copyright (c) 2004, 2008 IBM Corporation -\ * All rights reserved. -\ * This program and the accompanying materials -\ * are made available under the terms of the BSD License -\ * which accompanies this distribution, and is available at -\ * http://www.opensource.org/licenses/bsd-license.php -\ * -\ * Contributors: -\ * IBM Corporation - initial implementation -\ ****************************************************************************/ - - -: input ( dev-str dev-len -- ) - open-dev ?dup IF - \ Close old stdin: - s" stdin" get-chosen IF - decode-int nip nip ?dup IF close-dev THEN - THEN - \ Now set the new stdin: - encode-int s" stdin" set-chosen - THEN -; - -: output ( dev-str dev-len -- ) - open-dev ?dup IF - \ Close old stdout: - s" stdout" get-chosen IF - decode-int nip nip ?dup IF close-dev THEN - THEN - \ Now set the new stdout: - encode-int s" stdout" set-chosen - THEN -; - -: io ( dev-str dev-len -- ) - 2dup input output -; - - -1 BUFFER: (term-io-char-buf) - -: term-io-key ( -- char ) - s" stdin" get-chosen IF - decode-int nip nip dup 0= IF 0 EXIT THEN - >r BEGIN - (term-io-char-buf) 1 s" read" r@ $call-method - 0 > - UNTIL - (term-io-char-buf) c@ - r> drop - ELSE - [ ' key behavior compile, ] - THEN -; - -' term-io-key to key - -\ this word will check what the current chosen input device is: -\ - if it is a serial device, it will use serial-key? to check for available input -\ - if it is a keyboard, it will check if the "key-available?" method is implemented (i.e. for usb-keyboard) and use that -\ - if it's an hv console, use hvterm-key? -\ otherwise it will always return false -: term-io-key? ( -- true|false ) - s" stdin" get-chosen IF - decode-int nip nip dup 0= IF drop 0 EXIT THEN \ return false and exit if no stdin set - >r \ store ihandle on return stack - s" device_type" r@ ihandle>phandle ( propstr len phandle ) - get-property ( true | data dlen false ) - IF - \ device_type not found, return false and exit - false - ELSE - 1 - \ remove 1 from length to ignore null-termination char - \ device_type found, check wether it is serial or keyboard - 2dup s" serial" str= IF - 2drop serial-key? r> drop EXIT - THEN \ call serial-key, cleanup return-stack, exit - 2dup s" keyboard" str= IF - 2drop ( ) - \ keyboard found, check for key-available? method, execute it or return false - s" key-available?" r@ ihandle>phandle find-method IF - drop s" key-available?" r@ $call-method - ELSE - false - THEN - r> drop EXIT \ cleanup return-stack, exit - THEN - 2drop r> drop false EXIT \ unknown device_type cleanup return-stack, return false - THEN - ELSE - \ stdin not set, return false - false - THEN -; - -' term-io-key? to key? diff --git a/qemu/roms/SLOF/slof/fs/terminal.fs b/qemu/roms/SLOF/slof/fs/terminal.fs deleted file mode 100644 index dc82e7bf4..000000000 --- a/qemu/roms/SLOF/slof/fs/terminal.fs +++ /dev/null @@ -1,213 +0,0 @@ -\ ***************************************************************************** -\ * Copyright (c) 2004, 2008 IBM Corporation -\ * All rights reserved. -\ * This program and the accompanying materials -\ * are made available under the terms of the BSD License -\ * which accompanies this distribution, and is available at -\ * http://www.opensource.org/licenses/bsd-license.php -\ * -\ * Contributors: -\ * IBM Corporation - initial implementation -\ ****************************************************************************/ - -\ \\\\\\\\\\\\\\ Global Data - -0 VALUE line# -0 VALUE column# -false VALUE inverse? -false VALUE inverse-screen? -18 VALUE #lines -50 VALUE #columns - -false VALUE cursor -false VALUE saved-cursor - - -\ \\\\\\\\\\\\\\ Structure/Implementation Dependent Methods - -defer draw-character \ 2B inited by display driver -defer reset-screen \ 2B inited by display driver -defer toggle-cursor \ 2B inited by display driver -defer erase-screen \ 2B inited by display driver -defer blink-screen \ 2B inited by display driver -defer invert-screen \ 2B inited by display driver -defer insert-characters \ 2B inited by display driver -defer delete-characters \ 2B inited by display driver -defer insert-lines \ 2B inited by display driver -defer delete-lines \ 2B inited by display driver -defer draw-logo \ 2B inited by display driver - -: nop-toggle-cursor ( nop ) ; -' nop-toggle-cursor to toggle-cursor - -\ \\\\\\\\\\\\\\ Implementation Independent Methods (Depend on Previous) -\ * -\ * -: (cursor-off) ( -- ) cursor dup to saved-cursor - IF toggle-cursor false to cursor THEN ; -: (cursor-on) ( -- ) cursor dup to saved-cursor - 0= IF toggle-cursor true to cursor THEN ; -: restore-cursor ( -- ) saved-cursor dup cursor - <> IF toggle-cursor to cursor ELSE drop THEN ; - -' (cursor-off) to cursor-off -' (cursor-on) to cursor-on - -\ \\\\\\\\\\\\\\ Exported Interface: -\ * -\ Generic device methods: -\ * - - -\ \\\\\\\\\\\\\\ Exported Interface: -\ * -\ * - -false VALUE esc-on -false VALUE csi-on -defer esc-process -0 VALUE esc-num-parm -0 VALUE esc-num-parm2 -0 VALUE saved-line# -0 VALUE saved-column# - -: get-esc-parm ( default -- value ) - esc-num-parm dup 0> IF nip ELSE drop THEN 0 to esc-num-parm ; -: get-esc-parm2 ( default -- value ) - esc-num-parm2 dup 0> IF nip ELSE drop THEN 0 to esc-num-parm2 ; -: set-esc-parm ( newdigit -- ) [char] 0 - esc-num-parm a * + to esc-num-parm ; - -: reverse-cursor ( oldpos -- newpos) dup IF 1 get-esc-parm - THEN ; -: advance-cursor ( bound oldpos -- newpos) tuck > IF 1 get-esc-parm + THEN ; -: erase-in-line #columns column# - dup 0> IF delete-characters ELSE drop THEN ; - -: terminal-line++ ( -- ) - line# 1+ dup #lines = IF 1- 0 to line# 1 delete-lines THEN - to line# -; - -0 VALUE dang -0 VALUE blipp -false VALUE stopcsi -0 VALUE term-background -7 VALUE term-foreground - -: set-term-color - dup d# 30 d# 39 between IF dup d# 30 - to term-foreground THEN - dup d# 40 d# 49 between IF dup d# 40 - to term-background THEN - 0 = IF - 0 to term-background - 7 to term-foreground - THEN - term-foreground term-background <= to inverse? -; - -: ansi-esc ( char -- ) - csi-on IF - dup [char] 0 [char] 9 between IF set-esc-parm - ELSE true to stopcsi CASE - [char] A OF line# reverse-cursor to line# ENDOF - [char] B OF #lines line# advance-cursor to line# ENDOF - [char] C OF #columns column# advance-cursor to column# ENDOF - [char] D OF column# reverse-cursor to column# ENDOF - [char] E OF ( FIXME: Cursor Next Line - No idea what does it mean ) - #lines line# advance-cursor to line# - ENDOF - [char] f OF - 1 get-esc-parm2 to line# column# get-esc-parm to column# - ENDOF - [char] H OF - 1 get-esc-parm2 to line# column# get-esc-parm to column# - ENDOF - ( second parameter delimiter for f and H commands ) - [char] ; OF false to stopcsi 0 get-esc-parm to esc-num-parm2 ENDOF - [char] ? OF false to stopcsi ENDOF ( FIXME: Ignore that for now ) - [char] l OF ENDOF ( FIXME: ?25l should hide cursor ) - [char] h OF ENDOF ( FIXME: ?25h should show cursor ) - [char] J OF - #lines line# - dup 0> IF - line# 1+ to line# delete-lines line# 1- to line# - ELSE drop THEN - erase-in-line - ENDOF - [char] K OF erase-in-line ENDOF - [char] L OF 1 get-esc-parm insert-lines ENDOF - [char] M OF 1 get-esc-parm delete-lines ENDOF - [char] @ OF 1 get-esc-parm insert-characters ENDOF - [char] P OF 1 get-esc-parm delete-characters ENDOF - [char] m OF 0 get-esc-parm set-term-color ENDOF - ( These are non-ANSI commands recommended by OpenBoot ) - [char] p OF inverse-screen? IF false to inverse-screen? - inverse? 0= to inverse? invert-screen - THEN - ENDOF - [char] q OF inverse-screen? 0= IF true to inverse-screen? - inverse? 0= to inverse? invert-screen - THEN - ENDOF -\ [char] s OF reset-screen ENDOF ( FIXME: this conflicts w. ANSI ) -\ [char] s OF line# to saved-line# column# to saved-column# ENDOF - [char] u OF saved-line# to line# saved-column# to column# ENDOF - dup dup to dang OF blink-screen ENDOF - ENDCASE stopcsi IF false to csi-on - false to esc-on 0 to esc-num-parm 0 to esc-num-parm2 THEN - THEN - ELSE CASE - ( DEV VT compatibility stuff used by accept.fs ) - [char] 7 OF line# to saved-line# column# to saved-column# ENDOF - [char] 8 OF saved-line# to line# saved-column# to column# ENDOF - [char] [ OF true to csi-on ENDOF - dup dup OF false to esc-on to blipp ENDOF - ENDCASE - csi-on 0= IF false to esc-on THEN 0 to esc-num-parm 0 to esc-num-parm2 - THEN -; - -' ansi-esc to esc-process -CREATE twtracebuf 4000 allot twtracebuf 4000 erase -twtracebuf VALUE twbp -0 VALUE twbc -0 VALUE twtrace-enabled? - -: twtrace - twbc 4000 = IF 0 to twbc twtracebuf to twbp THEN - dup twbp c! twbp 1+ to twbp twbc 1+ to twbc -; - -: terminal-write ( addr len -- actual-len ) - cursor-off - tuck bounds ?DO i c@ - twtrace-enabled? IF twtrace THEN - esc-on IF esc-process - ELSE CASE - 1B OF true to esc-on ENDOF - carret OF 0 to column# ENDOF - linefeed OF terminal-line++ ENDOF - bell OF blink-screen ENDOF - 9 ( TAB ) OF column# 7 + -8 and dup #columns < IF - to column# - ELSE drop THEN - ENDOF - B ( VT ) OF line# ?dup IF 1- to line# THEN ENDOF - C ( FF ) OF 0 to line# 0 to column# erase-screen ENDOF - bs OF column# 1- dup 0< IF - line# IF - line# 1- to line# - drop #columns 1- - ELSE drop column# - THEN - THEN - to column# ( bl draw-character ) - ENDOF - dup OF - i c@ draw-character - column# 1+ dup #columns >= IF - drop 0 terminal-line++ - THEN - to column# - ENDOF - ENDCASE - THEN - LOOP - restore-cursor -; diff --git a/qemu/roms/SLOF/slof/fs/timebase.fs b/qemu/roms/SLOF/slof/fs/timebase.fs deleted file mode 100644 index 00a0bd203..000000000 --- a/qemu/roms/SLOF/slof/fs/timebase.fs +++ /dev/null @@ -1,24 +0,0 @@ -\ ***************************************************************************** -\ * Copyright (c) 2004, 2008 IBM Corporation -\ * All rights reserved. -\ * This program and the accompanying materials -\ * are made available under the terms of the BSD License -\ * which accompanies this distribution, and is available at -\ * http://www.opensource.org/licenses/bsd-license.php -\ * -\ * Contributors: -\ * IBM Corporation - initial implementation -\ ****************************************************************************/ -\ Define all timebase related words - -: tb@ ( -- tb ) - BEGIN tbu@ tbl@ tbu@ rot over <> WHILE 2drop REPEAT - 20 lshift swap ffffffff and or -; - -: milliseconds ( -- ms ) tb@ d# 1000 * tb-frequency / ; -: microseconds ( -- us ) tb@ d# 1000000 * tb-frequency / ; - -: ms ( ms-to-wait -- ) milliseconds + BEGIN milliseconds over >= UNTIL drop ; -: get-msecs ( -- n ) milliseconds ; -: us ( us-to-wait -- ) microseconds + BEGIN microseconds over >= UNTIL drop ; diff --git a/qemu/roms/SLOF/slof/fs/translate.fs b/qemu/roms/SLOF/slof/fs/translate.fs deleted file mode 100644 index 9654f242f..000000000 --- a/qemu/roms/SLOF/slof/fs/translate.fs +++ /dev/null @@ -1,150 +0,0 @@ -\ ***************************************************************************** -\ * Copyright (c) 2004, 2008 IBM Corporation -\ * All rights reserved. -\ * This program and the accompanying materials -\ * are made available under the terms of the BSD License -\ * which accompanies this distribution, and is available at -\ * http://www.opensource.org/licenses/bsd-license.php -\ * -\ * Contributors: -\ * IBM Corporation - initial implementation -\ ****************************************************************************/ - -\ this is a C-to-Forth translation from the translate -\ address code in the client -\ with extensions to handle different sizes of #size-cells - -\ this tries to figure out if it is a PCI device what kind of -\ translation is wanted -\ if prop_type is 0, "reg" property is used, otherwise "assigned-addresses" -: pci-address-type ( node address prop_type -- type ) - -rot 2 pick ( prop_type node address prop_type ) - 0= IF - swap s" reg" rot get-property ( prop_type address data dlen false ) - ELSE - swap s" assigned-addresses" rot get-property ( prop_type address data dlen false ) - THEN - IF 2drop -1 EXIT THEN 4 / 5 / - \ advance (phys-addr(3) size(2)) steps - 0 DO - \ BARs and Expansion ROM must be in assigned-addresses... - \ so if prop_type is 0 ("reg") and a config space offset is set - \ we skip this entry... - dup l@ FF AND 0<> ( prop_type address data cfgspace_offset? ) - 3 pick 0= ( prop_type address data cfgspace_offset? reg_prop? ) - AND NOT IF - 2dup 4 + ( prop_type address data address data' ) - 2dup @ 2 pick 8 + @ + <= -rot @ >= and IF - l@ 03000000 and 18 rshift nip - ( prop_type type ) - swap drop ( type ) - UNLOOP EXIT - THEN - THEN - \ advance in 4 byte steps and (phys-addr(3) size(2)) steps - 4 5 * + - LOOP - 3drop -1 -; - -: (range-read-cells) ( range-addr #cells -- range-value ) - \ if number of cells != 1; do 64bit read; else a 32bit read - 1 = IF l@ ELSE @ THEN -; - -\ this functions tries to find a mapping for the given address -\ it assumes that if we have #address-cells == 3 that we are trying -\ to do a PCI translation - -\ nac - #address-cells -\ nsc - #size-cells -\ pnac - parent #address-cells - -: (map-one-range) ( type range pnac nsc nac address -- address true | address false ) - \ only check for the type if nac == 3 (PCI) - over 3 = 5 pick l@ 3000000 and 18 rshift 7 pick <> and IF - >r 2drop 3drop r> false EXIT - THEN - \ get size - 4 pick 4 pick 3 pick + 4 * + - \ get nsc - 3 pick - \ read size - ( type range pnac nsc nac address range nsc ) - (range-read-cells) - ( type range pnac nsc nac address size ) - \ skip type if PCI - 5 pick 3 pick 3 = IF - 4 + - THEN - \ get nac - 3 pick - ( type range pnac nsc nac address size range nac ) - \ read child-mapping - (range-read-cells) - ( type range pnac nsc nac address size child-mapping ) - dup >r dup 3 pick > >r + over <= r> or IF - \ address is not inside the mapping range - >r 2drop 3drop r> r> drop false EXIT - THEN - dup r> - - ( type range pnac nsc nac address offset ) - \ add the offset on the parent mapping - 5 pick 5 pick 3 = IF - \ skip type if PCI - 4 + - THEN - 3 pick 4 * + - ( type range pnac nsc nac address offset parent-mapping-address ) - \ get pnac - 5 pick - \ read parent mapping - (range-read-cells) - ( type range pnac nsc nac address offset parent-mapping ) - + >r 3drop 3drop r> true -; - -\ this word translates the given address starting from the node specified -\ in node; the word will return to the node it was started from -: translate-address ( node address -- address ) - \ check for address type in "assigned-addresses" - 2dup 1 pci-address-type ( node address type ) - dup -1 = IF - \ not found in "assigned-addresses", check in "reg" - drop 2dup 0 pci-address-type ( node address type ) - THEN - rot parent BEGIN - \ check if it is the root node - dup parent 0= IF 2drop EXIT THEN - ( address type parent ) - s" #address-cells" 2 pick get-property 2drop l@ >r \ nac - s" #size-cells" 2 pick get-property 2drop l@ >r \ nsc - s" #address-cells" 2 pick parent get-property 2drop l@ >r \ pnac - -rot ( node address type ) - s" ranges" 4 pick get-property IF - 3drop - ABORT" no ranges property; not translatable" - THEN - r> r> r> 3 roll - ( node address type ranges pnac nsc nac length ) - 4 / >r 3dup + + >r 5 roll r> r> swap / 0 ?DO - ( node type ranges pnac nsc nac address ) - 6dup (map-one-range) IF - nip leave - THEN - nip - \ advance ranges - 4 roll - ( node type pnac nsc nac address ranges ) - 4 pick 4 pick 4 pick + + 4 * + 4 -roll - LOOP - >r 2drop 2drop r> ( node type address ) - swap rot parent ( address type node ) - dup 0= - UNTIL -; - -\ this words translates the given address starting from the current node -: translate-my-address ( address -- address' ) - get-node swap translate-address -; diff --git a/qemu/roms/SLOF/slof/fs/update_flash.fs b/qemu/roms/SLOF/slof/fs/update_flash.fs deleted file mode 100644 index e04869d77..000000000 --- a/qemu/roms/SLOF/slof/fs/update_flash.fs +++ /dev/null @@ -1,110 +0,0 @@ -\ ***************************************************************************** -\ * Copyright (c) 2004, 2008 IBM Corporation -\ * All rights reserved. -\ * This program and the accompanying materials -\ * are made available under the terms of the BSD License -\ * which accompanies this distribution, and is available at -\ * http://www.opensource.org/licenses/bsd-license.php -\ * -\ * Contributors: -\ * IBM Corporation - initial implementation -\ ****************************************************************************/ - -\ Set by update-flash -f to true, preventing update-flash -c -false value flash-new - -: update-flash-help ( -- ) - cr ." update-flash tool to flash host FW " cr - ." -f <filename> : Flash from file (e.g. net:\boot_rom.bin)" cr - ." -l : Flash from load-base" cr - ." -d : Flash from old load base (used by drone)" cr - ." -c : Flash from temp to perm" cr - ." -r : Flash from perm to temp" cr -; - -: flash-read-temp ( -- success? ) - get-flashside 1 = IF flash-addr get-load-base over flash-image-size rmove true - ELSE - false - THEN -; - -: flash-read-perm ( -- success? ) - get-flashside 0= IF - flash-addr get-load-base over flash-image-size rmove true - ELSE - false - THEN -; - -: flash-switch-side ( side -- success? ) - set-flashside 0<> IF - s" Cannot change flashside" type cr false - ELSE - true - THEN -; - -: flash-ensure-temp ( -- success? ) - get-flashside 0= IF - cr ." Cannot flash perm! Switching to temp side!" - 1 flash-switch-side - ELSE - true - THEN -; - -\ update-flash -f <filename> -\ -l -\ -c -\ -r - -: update-flash ( "text" ) - get-flashside >r \ Save old flashside - parse-word ( str len ) \ Parse first string - drop dup c@ ( str first-char ) - [char] - <> IF - update-flash-help r> 2drop EXIT - THEN - - 1+ c@ ( second-char ) - CASE - [char] f OF - parse-word cr s" do-load" evaluate - flash-ensure-temp TO flash-new - ENDOF - [char] l OF - flash-ensure-temp - ENDOF - [char] d OF - flash-load-base get-load-base 200000 move - flash-ensure-temp - ENDOF - [char] c OF - flash-read-temp 0= flash-new or IF - ." Cannot commit temp, need to boot on temp first " cr false - ELSE - 0 flash-switch-side - THEN - ENDOF - [char] r OF - flash-read-perm 0= IF - ." Cannot commit perm, need to boot on perm first " cr false - ELSE - 1 flash-switch-side - THEN - ENDOF - dup OF - false - ENDOF - ENDCASE - - ( true| false ) - - 0= IF - update-flash-help r> drop EXIT - THEN - - get-load-base flash-write 0= IF ." Flash write failed !! " cr THEN - r> set-flashside drop \ Restore old flashside -; diff --git a/qemu/roms/SLOF/slof/fs/usb/dev-hci.fs b/qemu/roms/SLOF/slof/fs/usb/dev-hci.fs deleted file mode 100644 index 5fb25b8b6..000000000 --- a/qemu/roms/SLOF/slof/fs/usb/dev-hci.fs +++ /dev/null @@ -1,71 +0,0 @@ -\ ***************************************************************************** -\ * Copyright (c) 2006, 2012, 2013 IBM Corporation -\ * All rights reserved. -\ * This program and the accompanying materials -\ * are made available under the terms of the BSD License -\ * which accompanies this distribution, and is available at -\ * http://www.opensource.org/licenses/bsd-license.php -\ * -\ * Contributors: -\ * IBM Corporation - initial implementation -\ ****************************************************************************/ -\ * -\ * [OEX]HCI functions -\ * -\ **************************************************************************** - -\ ( num $name type ) - -VALUE usb_type \ USB type - -\ Open Firmware Properties -device-type -" usb" 2dup device-name - -rot -VALUE usb_num \ controller number -usb_num $cathex strdup \ create alias name -2dup find-alias 0= IF - get-node node>path set-alias -ELSE 3drop THEN - -/hci-dev BUFFER: hcidev -usb_num hcidev usb-setup-hcidev -TRUE VALUE first-time-init? -0 VALUE open-count - -false VALUE dev-hci-debug? - -1 encode-int s" #address-cells" property -0 encode-int s" #size-cells" property - -\ converts physical address to text unit string -: encode-unit ( port -- unit-str unit-len ) 1 hex-encode-unit ; - -\ Converts text unit string to phyical address -: decode-unit ( addr len -- port ) 1 hex-decode-unit ; - -: get-hci-dev ( -- hcidev ) - hcidev -; - -: hc-cleanup ( -- ) - my-phandle set-node - dev-hci-debug? IF ." USB-HCI: Cleaning up " pwd cr THEN - hcidev USB-HCD-EXIT - 0 set-node -; - -: open ( -- true | false ) - true -; - -: close -; - -\ create a new entry to cleanup and suspend HCI -\ after first init -first-time-init? IF - ['] hc-cleanup add-quiesce-xt - false to first-time-init? -THEN diff --git a/qemu/roms/SLOF/slof/fs/usb/dev-hub.fs b/qemu/roms/SLOF/slof/fs/usb/dev-hub.fs deleted file mode 100644 index ba0b33437..000000000 --- a/qemu/roms/SLOF/slof/fs/usb/dev-hub.fs +++ /dev/null @@ -1,32 +0,0 @@ -new-device - -VALUE sudev - -s" slofdev.fs" included -sudev slof-dev>port l@ dup set-unit encode-phys " reg" property -sudev slof-dev>udev @ VALUE udev - -s" hub" device-name - -s" dev-parent-calls.fs" included - -1 encode-int s" #address-cells" property -0 encode-int s" #size-cells" property -: decode-unit 1 hex-decode-unit ; -: encode-unit 1 hex-encode-unit ; - -: usb-hub-init ( usbdev -- true | false ) - udev USB-HUB-INIT -; - -: open ( -- true | false ) - TRUE -; - -: close -; - -." USB HUB " cr -usb-hub-init drop - -finish-device diff --git a/qemu/roms/SLOF/slof/fs/usb/dev-keyb.fs b/qemu/roms/SLOF/slof/fs/usb/dev-keyb.fs deleted file mode 100644 index db9e23ef1..000000000 --- a/qemu/roms/SLOF/slof/fs/usb/dev-keyb.fs +++ /dev/null @@ -1,54 +0,0 @@ -new-device - -VALUE sudev -false VALUE usb-keyb-debug? - -s" slofdev.fs" included -sudev slof-dev>port l@ dup set-unit encode-phys " reg" property -sudev slof-dev>udev @ VALUE udev - -s" usb-keyboard" device-name -s" keyboard" device-type -s" EN" encode-string s" language" property -s" keyboard" get-node node>path set-alias - -s" dev-parent-calls.fs" included - -0 VALUE open-count - -: open ( -- true | false ) - usb-keyb-debug? IF ." USB-KEYB: Opening (count is " open-count . ." )" cr THEN - open-count 0= IF - udev USB-HID-INIT 0= IF - ." USB keyboard setup failed " pwd cr false EXIT - THEN - THEN - open-count 1 + to open-count - true -; - -: close - usb-keyb-debug? IF ." USB-KEYB: Closing (count is " open-count . ." )" cr THEN - open-count 0> IF - open-count 1 - dup to open-count - 0= IF - my-phandle set-node - udev USB-HID-EXIT drop - 0 set-node - THEN - THEN -; - -\ method to check if a key is present in output buffer -\ used by 'term-io.fs' -: key-available? ( -- true|false ) - udev USB-KEY-AVAILABLE IF TRUE ELSE FALSE THEN -; - -: read ( addr len -- actual ) - 0= IF drop 0 EXIT THEN - udev USB-READ-KEYB ?dup IF swap c! 1 ELSE 0 swap c! 0 then -; - -." USB Keyboard " cr -finish-device diff --git a/qemu/roms/SLOF/slof/fs/usb/dev-mouse.fs b/qemu/roms/SLOF/slof/fs/usb/dev-mouse.fs deleted file mode 100644 index f6acd7e28..000000000 --- a/qemu/roms/SLOF/slof/fs/usb/dev-mouse.fs +++ /dev/null @@ -1,20 +0,0 @@ -new-device - -VALUE sudev -s" slofdev.fs" included -sudev slof-dev>port l@ dup set-unit encode-phys " reg" property -sudev slof-dev>udev @ VALUE udev - -s" usb-mouse" device-name - -\ .S cr -\ dup slof-dev>udev dup . @ . cr -\ dup slof-dev>port dup . l@ . cr -\ dup slof-dev>devaddr dup . l@ . cr -\ dup slof-dev>hcitype dup . l@ . cr -\ dup slof-dev>num dup . l@ . cr -\ dup slof-dev>devtype dup . l@ . cr - -." USB mouse " cr - -finish-device diff --git a/qemu/roms/SLOF/slof/fs/usb/dev-parent-calls.fs b/qemu/roms/SLOF/slof/fs/usb/dev-parent-calls.fs deleted file mode 100644 index 57fa8ebdc..000000000 --- a/qemu/roms/SLOF/slof/fs/usb/dev-parent-calls.fs +++ /dev/null @@ -1,15 +0,0 @@ -\ ****************************************************************************/ -\ * Copyright (c) 2011 IBM Corporation -\ * All rights reserved. -\ * This program and the accompanying materials -\ * are made available under the terms of the BSD License -\ * which accompanies this distribution, and is available at -\ * http://www.opensource.org/licenses/bsd-license.php -\ * -\ * Contributors: -\ * IBM Corporation - initial implementation -\ ****************************************************************************/ - -get-node CONSTANT my-phandle - -s" dma-function.fs" included diff --git a/qemu/roms/SLOF/slof/fs/usb/dev-storage.fs b/qemu/roms/SLOF/slof/fs/usb/dev-storage.fs deleted file mode 100644 index 94f8421d3..000000000 --- a/qemu/roms/SLOF/slof/fs/usb/dev-storage.fs +++ /dev/null @@ -1,361 +0,0 @@ -\ ***************************************************************************** -\ * Copyright (c) 2013 IBM Corporation -\ * All rights reserved. -\ * This program and the accompanying materials -\ * are made available under the terms of the BSD License -\ * which accompanies this distribution, and is available at -\ * http://www.opensource.org/licenses/bsd-license.php -\ * -\ * Contributors: -\ * IBM Corporation - initial implementation -\ ****************************************************************************/ - -\ ( usbdev -- ) - -new-device - -VALUE usbdev - -s" slofdev.fs" included - -false VALUE usb-disk-debug? - -usbdev slof-dev>port l@ dup set-unit encode-phys " reg" property -s" storage" device-name - -s" dev-parent-calls.fs" included - -2 encode-int s" #address-cells" property -0 encode-int s" #size-cells" property - -: decode-unit 2 hex64-decode-unit ; -: encode-unit 2 hex64-encode-unit ; - -0 CONSTANT USB_PIPE_OUT -1 CONSTANT USB_PIPE_IN - -\ ----------------------------------------------------------- -\ Specific properties -\ ----------------------------------------------------------- - -usbdev slof-dev>udev @ VALUE udev -usbdev slof-dev>port l@ VALUE port -usbdev slof-dev>hcitype l@ VALUE hcitype - -0 INSTANCE VALUE lun -10000 VALUE dev-max-transfer -0 VALUE resp-buffer -0 VALUE resp-size -0f CONSTANT SCSI-COMMAND-OFFSET - -\ ------------------------------------------------------- -\ DMA-able buffers -\ ------------------------------------------------------- - -STRUCT - dev-max-transfer FIELD usb>data - 40 FIELD usb>cmd - 20 FIELD usb>csw -CONSTANT /dma-buf - -0 VALUE dma-buf -0 VALUE dma-buf-phys -0 VALUE td-buf -0 VALUE td-buf-phys -1000 CONSTANT /td-buf - -: (dma-buf-init) ( -- ) - /dma-buf dma-alloc TO dma-buf - dma-buf /dma-buf 0 dma-map-in TO dma-buf-phys - /td-buf dma-alloc TO td-buf - td-buf /td-buf 0 dma-map-in TO td-buf-phys -; - -: (dma-buf-free) ( -- ) - td-buf td-buf-phys /td-buf dma-map-out - td-buf /td-buf dma-free - 0 TO td-buf - 0 TO td-buf-phys - dma-buf dma-buf-phys /dma-buf dma-map-out - dma-buf /dma-buf dma-free - 0 TO dma-buf - 0 TO dma-buf-phys -; - - -scsi-open - -\ ----------------------------------------------------------- -\ Perform SCSI commands -\ ----------------------------------------------------------- - -0 INSTANCE VALUE current-target - -\ SCSI command. We do *NOT* implement the "standard" execute-command -\ because that doesn't have a way to return the sense buffer back, and -\ we do have auto-sense with some hosts. Instead we implement a made-up -\ do-scsi-command. -\ -\ Note: stat is -1 for "hw error" (ie, error queuing the command or -\ getting the response). -\ -\ A sense buffer is returned whenever the status is non-0 however -\ if sense-len is 0 then no sense data is actually present -\ - -: do-bulk-command ( resp-buffer resp-size -- TRUE | FALSE ) - TO resp-size - TO resp-buffer - udev USB_PIPE_OUT td-buf td-buf-phys dma-buf-phys usb>cmd 1F - usb-transfer-bulk IF \ transfer CBW - resp-size IF - d# 125 us - udev USB_PIPE_IN td-buf td-buf-phys resp-buffer resp-size - usb-transfer-bulk 1 = not IF \ transfer data - usb-disk-debug? IF ." Data phase failed " cr THEN - \ FALSE EXIT - \ in case of a stall/halted endpoint we clear the halt - \ Fall through and try reading the CSW - THEN - THEN - d# 125 us - udev USB_PIPE_IN td-buf td-buf-phys dma-buf-phys usb>csw 0D - usb-transfer-bulk \ transfer CSW - ELSE - FALSE EXIT - THEN -; - -STRUCT \ cbw - /l FIELD cbw>sig - /l FIELD cbw>tag - /l FIELD cbw>len - /c FIELD cbw>flags - /c FIELD cbw>lun \ 0:3 bits - /c FIELD cbw>cblen \ 0:4 bits -CONSTANT cbw-length - -STRUCT \ csw - /l FIELD csw>sig - /l FIELD csw>tag - /l FIELD csw>data-residue - /c FIELD csw>status -CONSTANT cbw-length - -0 VALUE cbw-addr -0 VALUE csw-addr - -: build-cbw ( tag xfer-len dir lun cmd-len addr -- ) - TO cbw-addr ( tag xfer-len dir lun cmd-len ) - cbw-addr cbw-length erase ( tag xfer-len dir lun cmd-len ) - cbw-addr cbw>cblen c! ( tag xfer-len dir lun ) - cbw-addr cbw>lun c! ( tag xfer-len dir ) - \ dir is true or false - \ bmCBWFlags - \ BIT 7 Direction - \ 0 - OUT - \ 1 - IN - IF 80 ELSE 0 THEN - cbw-addr cbw>flags c! ( tag xfer-len ) - cbw-addr cbw>len l!-le ( tag ) - cbw-addr cbw>tag l!-le ( ) - 43425355 cbw-addr cbw>sig l!-le -; - -0 INSTANCE VALUE usb-buf-addr -0 INSTANCE VALUE usb-buf-len -0 INSTANCE VALUE usb-dir -0 INSTANCE VALUE usb-cmd-addr -0 INSTANCE VALUE usb-cmd-len -1 VALUE tag - -: execute-scsi-command ( buf-addr buf-len dir cmd-addr cmd-len -- ... ) - ( ... [ sense-buf sense-len ] stat ) - \ Cleanup virtio request and response - to usb-cmd-len to usb-cmd-addr to usb-dir to usb-buf-len to usb-buf-addr - - dma-buf usb>cmd 40 0 fill - dma-buf usb>csw 20 0 fill - - tag usb-buf-len usb-dir lun usb-cmd-len dma-buf usb>cmd - ( tag transfer-len dir lun cmd-len addr ) - build-cbw - 1 tag + to tag - - usb-cmd-addr - dma-buf usb>cmd SCSI-COMMAND-OFFSET + - usb-cmd-len - move - - \ Send it - dma-buf-phys usb>data usb-buf-len - do-bulk-command IF - dma-buf usb>data usb-buf-addr usb-buf-len move - ELSE - ." USB-DISK: Bulk commad failed!" cr - 0 0 -1 EXIT - THEN - - dma-buf usb>csw to csw-addr - csw-addr csw>sig l@ 55534253 <> IF - ." USB-DISK: CSW signature invalid " cr - 0 0 -1 EXIT - THEN - - csw-addr csw>status c@ CASE - 0 OF ENDOF \ Good - 1 OF - usb-disk-debug? IF - ." USB-DISK: CSW Data residue: " - csw-addr csw>data-residue l@-le . cr - THEN - 0 0 8 EXIT ENDOF \ Command failed, Retry - dup OF 0 0 -1 EXIT ENDOF \ Anything else -> HW error - ENDCASE - - \ Other error status - csw-addr csw>status c@ dup 0<> IF - usb-disk-debug? IF - over scsi-get-sense-data - ." USB-DISK: Sense key [ " dup . ." ] " .sense-text - ." ASC,ASCQ: " . . cr - THEN - rot - THEN -; - -\ -------------------------------- -\ Include the generic host helpers -\ -------------------------------- - -" scsi-host-helpers.fs" included - -0 VALUE open-count - -: usb-storage-init ( -- TRUE ) - td-buf 0= IF - usb-disk-debug? IF ." USB-DISK: Allocating buffer " cr THEN - (dma-buf-init) - udev USB-MSC-INIT 0= IF - ." USB-DISK: Unable to initialize MSC " cr - FALSE - ELSE - TRUE - THEN - THEN -; - -: usb-storage-cleanup - td-buf 0<> IF - usb-disk-debug? IF ." USB-DISK: Freeing buffer " cr THEN - (dma-buf-free) - udev USB-MSC-EXIT 0= IF ." USB-DISK: Unable to exit MSC " cr THEN - THEN -; - -: open - usb-disk-debug? IF ." USB-DISK: Opening (count is " open-count . ." )" cr THEN - - open-count 0= IF - usb-storage-init IF - 1 to open-count true - ELSE ." USB-DISK initialization failed !" cr false THEN - ELSE - open-count 1 + to open-count - true - THEN -; - -: close - usb-disk-debug? IF ." USB-DISK: Closing (count is " open-count . ." )" cr THEN - - open-count 0> IF - open-count 1 - dup to open-count - 0= IF - usb-storage-cleanup - THEN - THEN -; - -\ ----------------------------------------------------------- -\ SCSI scan at boot and child device support -\ ----------------------------------------------------------- - -\ We use SRP luns of the form 01000000 | (target << 8) | lun -\ in the top 32 bits of the 64-bit LUN -: (set-target) - dup 20 >> FFFF and to lun - dup 30 >> FF and to port - to current-target - usb-disk-debug? IF ." USB-DISK: udev " udev . ." lun:" lun . ." port:" port . cr THEN -; - -: dev-generate-srplun ( target lun-id -- srplun ) - swap drop port 0100 or 10 << or 20 << -; - -\ FIXME: Check max transfer coming from virtio config -: max-transfer ( -- n ) - dev-max-transfer -; - -\ We obtain here a unit address on the stack, since our #address-cells -\ is 2, the 64-bit srplun is split in two cells that we need to join -\ -\ Note: This diverges a bit from the original OF scsi spec as the two -\ cells are the 2 words of a 64-bit SRP LUN -: set-address ( srplun.lo srplun.hi -- ) - lxjoin (set-target) - usb-disk-debug? IF ." USB-DISK: udev " udev . ." lun:" lun . ." port:" port . cr THEN -; - -1 CONSTANT #target -: dev-max-target ( -- #target ) - #target -; - -" scsi-probe-helpers.fs" included - -scsi-close \ no further scsi words required - -\ Set scsi alias if none is set yet -: setup-alias - s" scsi" find-alias 0= IF - s" scsi" get-node node>path set-alias - ELSE - drop - THEN -; - -: usb-storage-init-and-scan ( -- ) - usb-disk-debug? IF ." Initializing usb-disk: udev " udev . cr THEN - - \ Create instance for scanning: - 0 0 get-node open-node ?dup 0= IF EXIT THEN - my-self >r - dup to my-self - - hcitype - CASE - 1 OF 4000 TO dev-max-transfer ENDOF \ OHCI - 2 OF 10000 TO dev-max-transfer ENDOF \ EHCI - 3 OF F000 TO dev-max-transfer ENDOF \ XHCI - ENDCASE - usb-storage-init - scsi-find-disks - setup-alias - usb-storage-cleanup - \ Close the temporary instance: - close-node - r> to my-self -; - -." USB Storage " cr -: usb-scsi-add-disk - " scsi-disk.fs" included -; - -usb-scsi-add-disk -usb-storage-init-and-scan - -finish-device diff --git a/qemu/roms/SLOF/slof/fs/usb/slofdev.fs b/qemu/roms/SLOF/slof/fs/usb/slofdev.fs deleted file mode 100644 index d6e20fdcd..000000000 --- a/qemu/roms/SLOF/slof/fs/usb/slofdev.fs +++ /dev/null @@ -1,8 +0,0 @@ -STRUCT - /n FIELD slof-dev>udev - /l FIELD slof-dev>port - /l FIELD slof-dev>devaddr - /l FIELD slof-dev>hcitype - /l FIELD slof-dev>num - /l FIELD slof-dev>devtype -CONSTANT slof-usb-dev diff --git a/qemu/roms/SLOF/slof/fs/usb/usb-static.fs b/qemu/roms/SLOF/slof/fs/usb/usb-static.fs deleted file mode 100644 index 47db7276a..000000000 --- a/qemu/roms/SLOF/slof/fs/usb/usb-static.fs +++ /dev/null @@ -1,70 +0,0 @@ -\ ***************************************************************************** -\ * Copyright (c) 2004, 2011, 2013 IBM Corporation -\ * All rights reserved. -\ * This program and the accompanying materials -\ * are made available under the terms of the BSD License -\ * which accompanies this distribution, and is available at -\ * http://www.opensource.org/licenses/bsd-license.php -\ * -\ * Contributors: -\ * IBM Corporation - initial implementation -\ ****************************************************************************/ - -\ Load dev hci -: load-dev-hci ( num name-str name-len ) - s" dev-hci.fs" INCLUDED -; - -0 VALUE ohci-init -0 VALUE ehci-init -0 VALUE xhci-init -0 VALUE usb-alias-num - -: get-usb-alias-num - usb-alias-num dup 1+ to usb-alias-num -; - -\ create a new ohci device alias for the current node -: set-ohci-alias ( -- ) - 1 to ohci-init - get-usb-alias-num ( num ) - s" ohci" 1 load-dev-hci -; - -\ create a new ehci device alias for the current node -: set-ehci-alias ( -- ) - 1 to ehci-init - get-usb-alias-num ( num ) - s" ehci" 2 load-dev-hci -; - -\ create a new xhci device alias for the current node -: set-xhci-alias ( -- ) - 1 to xhci-init - get-usb-alias-num ( num ) - s" xhci" 3 load-dev-hci -; - -: usb-enumerate ( hcidev -- ) - USB-HCD-INIT -; - -: usb-scan ( -- ) - ." Scanning USB " cr - ohci-init 1 = IF USB-OHCI-REGISTER THEN - ehci-init 1 = IF USB-EHCI-REGISTER THEN - xhci-init 1 = IF USB-XHCI-REGISTER THEN - - usb-alias-num 0 ?DO - " usb" i $cathex find-device - " get-hci-dev" get-node find-method - IF - execute usb-enumerate - ELSE - ." get-base-address method not found for usb@" i . - ." Device type: " - " device_type" get-node get-property 0= IF decode-string type cr 2drop THEN - THEN - LOOP - 0 set-node \ FIXME Setting it back -; diff --git a/qemu/roms/SLOF/slof/fs/vpd-bootlist.fs b/qemu/roms/SLOF/slof/fs/vpd-bootlist.fs deleted file mode 100644 index 5a082156f..000000000 --- a/qemu/roms/SLOF/slof/fs/vpd-bootlist.fs +++ /dev/null @@ -1,134 +0,0 @@ -\ ***************************************************************************** -\ * Copyright (c) 2004, 2008 IBM Corporation -\ * All rights reserved. -\ * This program and the accompanying materials -\ * are made available under the terms of the BSD License -\ * which accompanies this distribution, and is available at -\ * http://www.opensource.org/licenses/bsd-license.php -\ * -\ * Contributors: -\ * IBM Corporation - initial implementation -\ ****************************************************************************/ - -4 CONSTANT vpd-bootlist-size - -\ Bootable devices -00 CONSTANT FLOPPY -01 CONSTANT USB -02 CONSTANT SAS -03 CONSTANT SATA -04 CONSTANT ISCSI -05 CONSTANT ISCSICRITICAL -06 CONSTANT NET -07 CONSTANT NOTSPECIFIED -08 CONSTANT HDD0 -09 CONSTANT HDD1 -0a CONSTANT HDD2 -0b CONSTANT HDD3 -0c CONSTANT CDROM -0e CONSTANT HDD4 -10 CONSTANT SCSI - -: check-bootlist ( -- true | false ) - vpd-bootlist l@ - dup 0= IF - ( bootlist == 0 means that probably nothing from vpd has been received ) - s" Boot list could not be read from VPD" log-string cr - s" Boot watchdog has been rearmed" log-string cr - 2 set-watchdog - EXIT - THEN - - FFFFFFFF = IF - ( bootlist all FFs means that the vpd has no useful information ) - .banner - -6b boot-exception-handler - \ The next message is duplicate, but sent w. log-string - s" Boot list successfully read from VPD but no useful information received" log-string cr - s" Please specify the boot device in the management module" log-string cr - s" Specified Boot Sequence not valid" mm-log-warning - false - EXIT - THEN - - true -; - -\ the following words are necessary for vpd-boot-import -defer set-boot-device -defer add-boot-device - -\ select-install? is a flag which is used in the SMS panel #20 -\ "Select/Install Boot Devices". -\ This panel can be used to temporarily override the boot device. -false VALUE select-install? - -\ select/install-path stores string address and string length of the -\ device node chosen in the SMS panel #20 "Select/Install Boot Devices" -\ This device node is prepended to the boot path if select-install? is -\ true. -CREATE select/install-path 2 cells allot - -\ Import boot device list from VPD -\ If none, keep the existing list in NVRAM -\ This word can be used to overwrite read-bootlist if wanted - -: vpd-boot-import ( -- ) - 0 0 set-boot-device - - select-install? IF - select/install-path 2@ add-boot-device - THEN - - vpd-read-bootlist - check-bootlist IF - 4 0 DO vpd-bootlist i + c@ - CASE - 6 OF \ cr s" 2B Booting from Network" log-string cr - furnish-boot-file strdup add-boot-device - ENDOF - - HDD0 OF \ cr s" 2B Booting from hdd0" log-string cr - s" disk hdd0" add-boot-device ENDOF - - HDD1 OF \ cr s" 2B Booting from hdd1" log-string cr - s" hdd1" add-boot-device ENDOF - - HDD2 OF \ cr s" 2B Booting from hdd2" log-string cr - s" hdd2" add-boot-device ENDOF - - HDD3 OF \ cr s" 2B Booting from hdd3" log-string cr - s" hdd3" add-boot-device ENDOF - - CDROM OF \ cr s" 2B Booting from CDROM" log-string cr - s" cdrom" add-boot-device ENDOF - - HDD4 OF \ cr s" 2B Booting from hdd4" log-string cr - s" hdd4" add-boot-device ENDOF - - F OF \ cr s" 2B Booting from SAS - w. Timeout" log-string cr - s" sas" add-boot-device ENDOF - - SCSI OF \ cr s" 2B Booting from SAS - Continuous Retry" log-string cr - s" sas" add-boot-device ENDOF - - ENDCASE - LOOP - bootdevice 2@ nip - IF 0 - ELSE - \ Check for all no device -> use boot-device - vpd-bootlist l@ 07070707 = IF 0 ELSE -6b THEN - THEN - ELSE -6a THEN - boot-exception-handler -; - -: vpd-bootlist-restore-default ( -- ) - NOTSPECIFIED vpd-bootlist 0 + c! - NOTSPECIFIED vpd-bootlist 1 + c! - NOTSPECIFIED vpd-bootlist 2 + c! - HDD0 vpd-bootlist 3 + c! - vpd-write-bootlist -; - diff --git a/qemu/roms/SLOF/slof/fs/xmodem.fs b/qemu/roms/SLOF/slof/fs/xmodem.fs deleted file mode 100644 index 122192212..000000000 --- a/qemu/roms/SLOF/slof/fs/xmodem.fs +++ /dev/null @@ -1,120 +0,0 @@ -\ ***************************************************************************** -\ * Copyright (c) 2004, 2008 IBM Corporation -\ * All rights reserved. -\ * This program and the accompanying materials -\ * are made available under the terms of the BSD License -\ * which accompanies this distribution, and is available at -\ * http://www.opensource.org/licenses/bsd-license.php -\ * -\ * Contributors: -\ * IBM Corporation - initial implementation -\ ****************************************************************************/ - - -01 CONSTANT XM-SOH \ Start of header -04 CONSTANT XM-EOT \ End-of-transmission -06 CONSTANT XM-ACK \ Acknowledge -15 CONSTANT XM-NAK \ Neg. acknowledge - -0 VALUE xm-retries \ Retry count -0 VALUE xm-block# - - -\ * -\ * Internal function: -\ * wait <timeout> seconds for a new character -\ * -: xmodem-get-byte ( timeout -- byte|-1 ) - d# 1000 * - 0 DO - key? IF key UNLOOP EXIT THEN - 1 ms - LOOP - -1 -; - - -\ * -\ * Internal function: -\ * Receive one XMODEM packet, check block number and check sum. -\ * -: xmodem-rx-packet ( address -- success? ) - 1 xmodem-get-byte \ Get block number - dup 0 < IF - 2drop false EXIT \ Timeout - THEN - 1 xmodem-get-byte \ Get neg. block number - dup 0 < IF - 3drop false EXIT \ Timeout - THEN - rot 0 ( blk# ~blk# address chksum ) - 80 0 DO - 1 xmodem-get-byte dup 0 < IF ( blk# ~blk# address chksum byte ) - 3drop 2drop UNLOOP FALSE EXIT - THEN - dup 3 pick c! ( blk# ~blk# address chksum byte ) - + swap 1+ swap ( blk# ~blk# address+1 chksum' ) - LOOP - ( blk# ~blk# address chksum ) - \ Check sum: - 0ff and - 1 xmodem-get-byte <> IF - \ CRC failed! - 3drop FALSE EXIT - THEN - drop ( blk# ~blk# ) - \ finally check if block numbers are ok: - over xm-block# <> IF - \ Wrong block number! - 2drop FALSE EXIT - THEN ( blk# ~blk# ) - ff xor = -; - - -\ * -\ * Internal function: -\ * Load file to given address via XMODEM protocol -\ * -: (xmodem-load) ( address -- bytes ) - 1 to xm-block# - 0 to xm-retries - dup - BEGIN - d# 10 xmodem-get-byte dup >r - CASE - XM-SOH OF - dup xmodem-rx-packet IF - \ A packet has been received successfully - XM-ACK emit - 80 + ( start-addr next-addr R: rx-byte ) - 0 to xm-retries \ Reset retry count - xm-block# 1+ ff and to xm-block# \ Increase current block# - ELSE - \ Error while receiving packet - XM-NAK emit - xm-retries 1+ to xm-retries \ Increase retry count - THEN - ENDOF - XM-EOT OF - XM-ACK emit - ENDOF - dup OF - XM-NAK emit - xm-retries 1+ to xm-retries \ Increase retry count - ENDOF - ENDCASE - r> XM-EOT = - xm-retries d# 10 >= OR - UNTIL ( start-address end-address ) - swap - ( bytes received ) -; - - -\ * -\ * Load file to load-base via XMODEM protocol -\ * -: xmodem-load ( -- bytes ) - cr ." Waiting for start of XMODEM upload..." cr - get-load-base (xmodem-load) -; |