summaryrefslogtreecommitdiffstats
path: root/qemu/roms/SLOF/slof/fs
diff options
context:
space:
mode:
authorRajithaY <rajithax.yerrumsetty@intel.com>2017-04-25 03:31:15 -0700
committerRajitha Yerrumchetty <rajithax.yerrumsetty@intel.com>2017-05-22 06:48:08 +0000
commitbb756eebdac6fd24e8919e2c43f7d2c8c4091f59 (patch)
treeca11e03542edf2d8f631efeca5e1626d211107e3 /qemu/roms/SLOF/slof/fs
parenta14b48d18a9ed03ec191cf16b162206998a895ce (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')
-rw-r--r--qemu/roms/SLOF/slof/fs/accept.fs410
-rw-r--r--qemu/roms/SLOF/slof/fs/alloc-mem-debug.fs116
-rw-r--r--qemu/roms/SLOF/slof/fs/alloc-mem.fs75
-rw-r--r--qemu/roms/SLOF/slof/fs/available.fs72
-rw-r--r--qemu/roms/SLOF/slof/fs/banner.fs23
-rw-r--r--qemu/roms/SLOF/slof/fs/base.fs609
-rw-r--r--qemu/roms/SLOF/slof/fs/boot.fs296
-rw-r--r--qemu/roms/SLOF/slof/fs/bootmsg.fs74
-rw-r--r--qemu/roms/SLOF/slof/fs/claim.fs415
-rw-r--r--qemu/roms/SLOF/slof/fs/client.fs311
-rw-r--r--qemu/roms/SLOF/slof/fs/debug.fs422
-rw-r--r--qemu/roms/SLOF/slof/fs/devices/pci-class_02.fs37
-rw-r--r--qemu/roms/SLOF/slof/fs/devices/pci-class_0c.fs71
-rw-r--r--qemu/roms/SLOF/slof/fs/devices/pci-device_10de_0141.fs49
-rw-r--r--qemu/roms/SLOF/slof/fs/dictionary.fs74
-rw-r--r--qemu/roms/SLOF/slof/fs/display.fs123
-rw-r--r--qemu/roms/SLOF/slof/fs/dma-function.fs36
-rw-r--r--qemu/roms/SLOF/slof/fs/dump.fs42
-rw-r--r--qemu/roms/SLOF/slof/fs/elf.fs71
-rw-r--r--qemu/roms/SLOF/slof/fs/envvar.fs412
-rw-r--r--qemu/roms/SLOF/slof/fs/envvar_defaults.fs44
-rw-r--r--qemu/roms/SLOF/slof/fs/exception.fs154
-rw-r--r--qemu/roms/SLOF/slof/fs/fbuffer.fs266
-rw-r--r--qemu/roms/SLOF/slof/fs/fcode/1275.fs465
-rw-r--r--qemu/roms/SLOF/slof/fs/fcode/core.fs173
-rw-r--r--qemu/roms/SLOF/slof/fs/fcode/evaluator.fs119
-rw-r--r--qemu/roms/SLOF/slof/fs/fcode/little-big.fs96
-rw-r--r--qemu/roms/SLOF/slof/fs/fcode/locals.fs155
-rw-r--r--qemu/roms/SLOF/slof/fs/fcode/tokens.fs480
-rw-r--r--qemu/roms/SLOF/slof/fs/find-hash.fs77
-rw-r--r--qemu/roms/SLOF/slof/fs/generic-disk.fs68
-rw-r--r--qemu/roms/SLOF/slof/fs/graphics.fs87
-rw-r--r--qemu/roms/SLOF/slof/fs/history.fs107
-rw-r--r--qemu/roms/SLOF/slof/fs/ide.fs612
-rw-r--r--qemu/roms/SLOF/slof/fs/instance.fs193
-rw-r--r--qemu/roms/SLOF/slof/fs/little-endian.fs83
-rw-r--r--qemu/roms/SLOF/slof/fs/loaders.fs94
-rw-r--r--qemu/roms/SLOF/slof/fs/logging.fs45
-rw-r--r--qemu/roms/SLOF/slof/fs/node.fs766
-rw-r--r--qemu/roms/SLOF/slof/fs/nvram.fs182
-rw-r--r--qemu/roms/SLOF/slof/fs/packages.fs52
-rw-r--r--qemu/roms/SLOF/slof/fs/packages/deblocker.fs70
-rw-r--r--qemu/roms/SLOF/slof/fs/packages/disk-label.fs710
-rw-r--r--qemu/roms/SLOF/slof/fs/packages/ext2-files.fs188
-rw-r--r--qemu/roms/SLOF/slof/fs/packages/fat-files.fs199
-rw-r--r--qemu/roms/SLOF/slof/fs/packages/filler.fs21
-rw-r--r--qemu/roms/SLOF/slof/fs/packages/iso-9660.fs325
-rw-r--r--qemu/roms/SLOF/slof/fs/packages/obp-tftp.fs71
-rw-r--r--qemu/roms/SLOF/slof/fs/packages/rom-files.fs85
-rw-r--r--qemu/roms/SLOF/slof/fs/packages/sms.fs29
-rw-r--r--qemu/roms/SLOF/slof/fs/pci-bridge.fs65
-rw-r--r--qemu/roms/SLOF/slof/fs/pci-class-code-names.fs264
-rw-r--r--qemu/roms/SLOF/slof/fs/pci-config-bridge.fs91
-rw-r--r--qemu/roms/SLOF/slof/fs/pci-device.fs105
-rw-r--r--qemu/roms/SLOF/slof/fs/pci-helper.fs195
-rw-r--r--qemu/roms/SLOF/slof/fs/pci-properties.fs668
-rw-r--r--qemu/roms/SLOF/slof/fs/pci-scan.fs351
-rw-r--r--qemu/roms/SLOF/slof/fs/preprocessor.fs41
-rw-r--r--qemu/roms/SLOF/slof/fs/property.fs192
-rw-r--r--qemu/roms/SLOF/slof/fs/quiesce.fs58
-rw-r--r--qemu/roms/SLOF/slof/fs/romfs.fs123
-rw-r--r--qemu/roms/SLOF/slof/fs/root.fs83
-rw-r--r--qemu/roms/SLOF/slof/fs/rtas/rtas-cpu.fs23
-rw-r--r--qemu/roms/SLOF/slof/fs/rtas/rtas-flash.fs46
-rw-r--r--qemu/roms/SLOF/slof/fs/rtas/rtas-init.fs121
-rw-r--r--qemu/roms/SLOF/slof/fs/rtas/rtas-reboot.fs33
-rw-r--r--qemu/roms/SLOF/slof/fs/rtas/rtas-vpd.fs33
-rw-r--r--qemu/roms/SLOF/slof/fs/scsi-disk.fs324
-rw-r--r--qemu/roms/SLOF/slof/fs/scsi-host-helpers.fs127
-rw-r--r--qemu/roms/SLOF/slof/fs/scsi-loader.fs77
-rw-r--r--qemu/roms/SLOF/slof/fs/scsi-probe-helpers.fs95
-rw-r--r--qemu/roms/SLOF/slof/fs/scsi-support.fs847
-rw-r--r--qemu/roms/SLOF/slof/fs/search.fs89
-rw-r--r--qemu/roms/SLOF/slof/fs/slof-logo.fs20
-rw-r--r--qemu/roms/SLOF/slof/fs/sms/sms-load.fs70
-rw-r--r--qemu/roms/SLOF/slof/fs/sms/sms-nvram.fs124
-rw-r--r--qemu/roms/SLOF/slof/fs/stack.fs57
-rw-r--r--qemu/roms/SLOF/slof/fs/start-up.fs171
-rw-r--r--qemu/roms/SLOF/slof/fs/term-io.fs97
-rw-r--r--qemu/roms/SLOF/slof/fs/terminal.fs213
-rw-r--r--qemu/roms/SLOF/slof/fs/timebase.fs24
-rw-r--r--qemu/roms/SLOF/slof/fs/translate.fs150
-rw-r--r--qemu/roms/SLOF/slof/fs/update_flash.fs110
-rw-r--r--qemu/roms/SLOF/slof/fs/usb/dev-hci.fs71
-rw-r--r--qemu/roms/SLOF/slof/fs/usb/dev-hub.fs32
-rw-r--r--qemu/roms/SLOF/slof/fs/usb/dev-keyb.fs54
-rw-r--r--qemu/roms/SLOF/slof/fs/usb/dev-mouse.fs20
-rw-r--r--qemu/roms/SLOF/slof/fs/usb/dev-parent-calls.fs15
-rw-r--r--qemu/roms/SLOF/slof/fs/usb/dev-storage.fs361
-rw-r--r--qemu/roms/SLOF/slof/fs/usb/slofdev.fs8
-rw-r--r--qemu/roms/SLOF/slof/fs/usb/usb-static.fs70
-rw-r--r--qemu/roms/SLOF/slof/fs/vpd-bootlist.fs134
-rw-r--r--qemu/roms/SLOF/slof/fs/xmodem.fs120
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)
-;