mirror of
https://github.com/mgcaret/of816.git
synced 2024-12-27 04:29:32 +00:00
make SLOF disk-label and fat-files packages compile
This commit is contained in:
mgcaret
parent
13bb6067f2
commit
48f8f8b02e
@ -60,18 +60,28 @@ constant <colon>
|
||||
|
||||
: 2variable create 2 cells allot ;
|
||||
|
||||
/n constant cell
|
||||
|
||||
: cell- /n - ;
|
||||
|
||||
\ Dictionary helpers
|
||||
: lfa>name cell+ dup 1+ swap c@ 7f and ;
|
||||
: lfa>xt lfa>name + ;
|
||||
: xt>lfa begin 1- dup c@ 80 and until cell- ;
|
||||
|
||||
alias xt>name >name
|
||||
|
||||
: 4drop 2drop 2drop ;
|
||||
|
||||
: isdigit ( char -- true | false )
|
||||
30 39 between
|
||||
;
|
||||
|
||||
: // 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@ ;
|
||||
|
||||
\ clever hack
|
||||
defer voc-find
|
||||
@ -116,4 +126,77 @@ CREATE $catpad 400 allot
|
||||
|
||||
: findchar left-parse-string nip nip swap if true else drop false then ;
|
||||
|
||||
: 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
|
||||
;
|
||||
|
||||
\ The following get the SLOF file system drivers to quick & dirty compile
|
||||
\ no guarantees they work...
|
||||
|
||||
: #split ( x #bits -- lo hi ) 2dup rshift dup >r swap lshift xor r> ;
|
||||
|
||||
\ Fake xlspit for 32-bit Forth
|
||||
: xlsplit 0 ;
|
||||
|
||||
\ bxjoin but fail if high 4 bytes are not 0
|
||||
: bxjoin bljoin bljoin abort" cannot bxjoin" bljoin ;
|
||||
|
||||
\ lxjoin but fail if high cell is not 0
|
||||
: lxjoin abort" cannot lxjoin" ;
|
||||
|
||||
: x! 0 swap 2! ;
|
||||
: x@ 2@ swap abort" x@ high cell not 0" ;
|
||||
|
||||
\ of816 is always little-endian
|
||||
alias l@-le l@
|
||||
alias w@-le w@
|
||||
alias l!-le l!
|
||||
alias w!-le w!
|
||||
alias x@-le x@
|
||||
|
||||
\ TPM ROFLOL
|
||||
: tpm-gpt-set-lba1 ;
|
||||
: tpm-gpt-add-entry ;
|
||||
|
||||
|
||||
#include <of/preprocessor.fs>
|
||||
|
||||
@ -28,6 +28,7 @@ finish-device
|
||||
new-device
|
||||
#include "packages/deblocker.fs"
|
||||
finish-device
|
||||
# endif
|
||||
|
||||
new-device
|
||||
#include "packages/disk-label.fs"
|
||||
@ -37,6 +38,7 @@ new-device
|
||||
#include "packages/fat-files.fs"
|
||||
finish-device
|
||||
|
||||
#if 0
|
||||
new-device
|
||||
#include "packages/rom-files.fs"
|
||||
finish-device
|
||||
|
||||
743
ofw/packages/disk-label.fs
Normal file
743
ofw/packages/disk-label.fs
Normal file
@ -0,0 +1,743 @@
|
||||
\ *****************************************************************************
|
||||
\ * 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
|
||||
;
|
||||
|
||||
: write ( addr len -- actual )
|
||||
debug-disk-label? IF 2dup swap ." write-parent: addr=0x" u. ." len=" .d THEN
|
||||
s" write" $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
|
||||
;
|
||||
|
||||
: measure-mbr ( addr length -- )
|
||||
s" /ibm,vtpm" find-node ?dup IF
|
||||
s" measure-hdd-mbr" rot $call-static
|
||||
ELSE
|
||||
2drop
|
||||
THEN
|
||||
;
|
||||
|
||||
\ 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 )
|
||||
block block-size measure-mbr
|
||||
UNLOOP EXIT
|
||||
ELSE
|
||||
2drop ( addr )
|
||||
THEN
|
||||
THEN
|
||||
LOOP
|
||||
drop 0
|
||||
;
|
||||
|
||||
: uuid! ( v1 v2 v3 v4 addr -- ) >r r@ 8 + x! r@ 6 + w!-le r@ 4 + w!-le r> l!-le ;
|
||||
: uuid= ( addr1 addr2 -- true|false ) 10 comp 0= ;
|
||||
|
||||
\ PowerPC PReP boot 9E1A2D38-C612-4316-AA26-8B49521E5A8B
|
||||
CREATE GPT-PREP-PARTITION 10 allot
|
||||
9E1A2D38 C612 4316 AA268B49521E5A8B GPT-PREP-PARTITION uuid!
|
||||
: gpt-prep-partition? ( -- true|false )
|
||||
block gpt-part-entry>part-type-guid
|
||||
GPT-PREP-PARTITION uuid=
|
||||
;
|
||||
|
||||
\ Check for GPT MSFT BASIC DATA GUID - fat based
|
||||
\ Windows Basic data partition EBD0A0A2-B9E5-4433-87C0-68B6B72699C7
|
||||
CREATE GPT-BASIC-DATA-PARTITION 10 allot
|
||||
EBD0A0A2 B9E5 4433 87C068B6B72699C7 GPT-BASIC-DATA-PARTITION uuid!
|
||||
: gpt-basic-data-partition? ( -- true|false )
|
||||
block gpt-part-entry>part-type-guid
|
||||
GPT-BASIC-DATA-PARTITION uuid=
|
||||
;
|
||||
|
||||
\ Linux filesystem data 0FC63DAF-8483-4772-8E79-3D69D8477DE4
|
||||
CREATE GPT-LINUX-PARTITION 10 allot
|
||||
0FC63DAF 8483 4772 8E793D69D8477DE4 GPT-LINUX-PARTITION uuid!
|
||||
: gpt-linux-partition? ( -- true|false )
|
||||
block gpt-part-entry>part-type-guid
|
||||
GPT-LINUX-PARTITION uuid=
|
||||
;
|
||||
|
||||
\
|
||||
\ 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 =
|
||||
;
|
||||
|
||||
\ Measure the GPT partition table by collecting its LBA1
|
||||
\ and GPT Entries and then measuring them.
|
||||
\ This function modifies 'block' and 'seek-pos'
|
||||
|
||||
: measure-gpt-partition ( -- )
|
||||
s" /ibm,vtpm" find-node ?dup IF
|
||||
get-gpt-partition 0= if drop EXIT THEN
|
||||
|
||||
block block-size tpm-gpt-set-lba1
|
||||
|
||||
block gpt>num-part-entry l@-le
|
||||
1+ 1 ?DO
|
||||
seek-pos 0 seek drop
|
||||
block gpt-part-size read drop
|
||||
block gpt-part-size tpm-gpt-add-entry
|
||||
seek-pos gpt-part-size + to seek-pos
|
||||
LOOP
|
||||
s" measure-gpt" rot $call-static
|
||||
THEN
|
||||
;
|
||||
|
||||
: 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
|
||||
;
|
||||
|
||||
: (interpose-filesystem) ( str len -- )
|
||||
find-package IF args args-len rot interpose THEN
|
||||
;
|
||||
|
||||
: 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-gpt-dos-partition ( -- true|false )
|
||||
measure-gpt-partition
|
||||
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? gpt-linux-partition? or 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
|
||||
|
||||
: 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-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
|
||||
;
|
||||
208
ofw/packages/fat-files.fs
Normal file
208
ofw/packages/fat-files.fs
Normal file
@ -0,0 +1,208 @@
|
||||
\ *****************************************************************************
|
||||
\ * 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
|
||||
;
|
||||
|
||||
\ Read cluster# from directory entry (handle FAT32 extension)
|
||||
: get-cluster ( direntry -- cluster# )
|
||||
fat-type @ 20 = IF
|
||||
dup 14 + 2c@ bwjoin 10 lshift
|
||||
ELSE 0 THEN
|
||||
swap 1a + 2c@ bwjoin +
|
||||
;
|
||||
|
||||
: .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 get-cluster [char] # emit 8 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 get-cluster
|
||||
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= ;
|
||||
@ -1,463 +0,0 @@
|
||||
---
|
||||
'1': 383
|
||||
dup: 37
|
||||
'2': 216
|
||||
2dup: 13
|
||||
'3': 69
|
||||
3dup: 1
|
||||
'0': 398
|
||||
"?dup": 2
|
||||
over: 1
|
||||
'4': 34
|
||||
2over: 1
|
||||
pick: 1
|
||||
tuck: 1
|
||||
clear: 2
|
||||
drop: 23
|
||||
2drop: 1
|
||||
3drop: 1
|
||||
nip: 14
|
||||
":": 52
|
||||
'100': 3
|
||||
'200': 1
|
||||
'300': 1
|
||||
'400': 1
|
||||
'500': 1
|
||||
";": 53
|
||||
roll: 4
|
||||
rot: 1
|
||||
"-rot": 1
|
||||
swap: 19
|
||||
2swap: 1
|
||||
">r": 11
|
||||
r>: 11
|
||||
r@: 1
|
||||
depth: 1
|
||||
if: 24
|
||||
else: 19
|
||||
then: 29
|
||||
"-1": 171
|
||||
msb: 15
|
||||
'5': 37
|
||||
"+": 21
|
||||
"-5": 10
|
||||
"-2": 48
|
||||
mid-uint: 68
|
||||
"-": 11
|
||||
mid-uint+1: 65
|
||||
"*": 12
|
||||
"-3": 22
|
||||
rshift: 11
|
||||
or: 5
|
||||
u*: 6
|
||||
"/": 22
|
||||
'7': 17
|
||||
"-7": 14
|
||||
max-int: 129
|
||||
min-int: 128
|
||||
"*/": 19
|
||||
mod: 21
|
||||
"/mod": 21
|
||||
"*/mod": 19
|
||||
u/mod: 7
|
||||
1+: 18
|
||||
1-: 17
|
||||
2+: 2
|
||||
2-: 2
|
||||
abs: 4
|
||||
negate: 5
|
||||
max: 16
|
||||
min: 16
|
||||
bounds: 2
|
||||
'10': 8
|
||||
even: 4
|
||||
lshift: 6
|
||||
f: 3
|
||||
1s: 22
|
||||
xor: 7
|
||||
'8000': 2
|
||||
and: 12
|
||||
2*: 6
|
||||
">>a": 8
|
||||
invert: 8
|
||||
">>": 5
|
||||
0<: 7
|
||||
"-4": 1
|
||||
!!str '<<': 3
|
||||
0s: 16
|
||||
'4000': 2
|
||||
2/: 6
|
||||
u2/: 3
|
||||
not: 2
|
||||
s>d: 85
|
||||
d+: 25
|
||||
min-intd: 5
|
||||
hi-2int: 6
|
||||
max-2int: 5
|
||||
min-2int: 7
|
||||
lo-2int: 5
|
||||
d-: 26
|
||||
max-intd: 1
|
||||
um*: 14
|
||||
m*: 38
|
||||
max-uint: 77
|
||||
um/mod: 7
|
||||
fm/mod: 34
|
||||
sm/rem: 30
|
||||
'01020304': 4
|
||||
lbsplit: 1
|
||||
lwsplit: 1
|
||||
'0102': 3
|
||||
wbsplit: 1
|
||||
'04': 1
|
||||
'03': 1
|
||||
'02': 2
|
||||
'01': 2
|
||||
bljoin: 1
|
||||
bwjoin: 1
|
||||
'0304': 1
|
||||
wljoin: 1
|
||||
wbflip: 1
|
||||
lbflip: 1
|
||||
lwflip: 1
|
||||
"/c": 1
|
||||
"/w": 1
|
||||
"/l": 1
|
||||
"/n": 1
|
||||
ca+: 1
|
||||
wa+: 1
|
||||
la+: 1
|
||||
na+: 2
|
||||
ca1+: 2
|
||||
wa1+: 3
|
||||
la1+: 3
|
||||
na1+: 2
|
||||
"/c*": 1
|
||||
"/w*": 2
|
||||
"/l*": 2
|
||||
"/n*": 1
|
||||
aligned: 6
|
||||
char+: 6
|
||||
cell+: 10
|
||||
chars: 13
|
||||
cells: 3
|
||||
1st: 21
|
||||
2nd: 5
|
||||
u<: 16
|
||||
"@": 33
|
||||
"!": 13
|
||||
'6': 8
|
||||
2@: 4
|
||||
2!: 3
|
||||
'off': 1
|
||||
'on': 1
|
||||
1stc: 7
|
||||
2ndc: 5
|
||||
c@: 10
|
||||
c!: 6
|
||||
1stw: 9
|
||||
2ndw: 5
|
||||
w@: 8
|
||||
w!: 3
|
||||
ffff: 2
|
||||
"<w@": 1
|
||||
1stl: 7
|
||||
2ndl: 5
|
||||
l@: 4
|
||||
l!: 2
|
||||
ua-addr: 1
|
||||
a-addr: 14
|
||||
'1234': 2
|
||||
'123': 29
|
||||
'456': 3
|
||||
"+!": 2
|
||||
fbuf: 12
|
||||
'20': 3
|
||||
fill: 5
|
||||
move: 6
|
||||
sbuf: 3
|
||||
pad: 13
|
||||
constant: 3
|
||||
maxchar: 7
|
||||
chars/pad: 6
|
||||
erase: 3
|
||||
'43': 3
|
||||
'9': 5
|
||||
'52': 2
|
||||
blank: 1
|
||||
bl: 8
|
||||
dumptst: 1
|
||||
dump: 1
|
||||
parse-word: 6
|
||||
unaligned-l@: 1
|
||||
"$find": 7
|
||||
unaligned-l!: 1
|
||||
unaligned-w@: 1
|
||||
unaligned-w!: 1
|
||||
alloc-mem: 1
|
||||
debug-mem: 2
|
||||
free-mem: 2
|
||||
"(": 2
|
||||
")": 2
|
||||
">in": 1
|
||||
0>: 17
|
||||
ascii: 10
|
||||
parse: 1
|
||||
test/: 1
|
||||
test: 3
|
||||
source: 1
|
||||
word: 6
|
||||
count: 3
|
||||
"'": 37
|
||||
key?: 1
|
||||
0=: 27
|
||||
key: 1
|
||||
expect: 1
|
||||
span: 1
|
||||
accept: 1
|
||||
bell: 1
|
||||
bs: 1
|
||||
carret: 1
|
||||
linefeed: 1
|
||||
a: 8
|
||||
char: 1
|
||||
"[char]": 1
|
||||
control: 1
|
||||
.": 1
|
||||
test": 3
|
||||
".(": 1
|
||||
test): 1
|
||||
'41': 3
|
||||
emit: 1
|
||||
type: 1
|
||||
cr: 1
|
||||
space: 1
|
||||
'8': 2
|
||||
spaces: 1
|
||||
"#line": 1
|
||||
0>=: 8
|
||||
"#out": 1
|
||||
exit?: 1
|
||||
s": 32
|
||||
test"(41)": 2
|
||||
testa": 1
|
||||
comp: 1
|
||||
aaaaa": 1
|
||||
bbbb": 1
|
||||
pack: 1
|
||||
lcc: 2
|
||||
"=": 14
|
||||
b: 4
|
||||
upc: 2
|
||||
abc: 2
|
||||
"-trailing": 1
|
||||
hex: 5
|
||||
base: 5
|
||||
decimal: 1
|
||||
octal: 1
|
||||
123": 1
|
||||
"$number": 2
|
||||
$xyz": 2
|
||||
456": 1
|
||||
">number": 2
|
||||
3a: 1
|
||||
'30': 1
|
||||
do: 37
|
||||
i: 16
|
||||
digit: 4
|
||||
loop: 29
|
||||
'47': 1
|
||||
'67': 2
|
||||
'61': 1
|
||||
6a: 1
|
||||
d#: 1
|
||||
h#: 1
|
||||
o#: 1
|
||||
".": 3
|
||||
s.: 3
|
||||
u.: 3
|
||||
".r": 1
|
||||
u.r: 1
|
||||
".d": 1
|
||||
'15': 1
|
||||
".h": 1
|
||||
".s": 1
|
||||
"?": 1
|
||||
"(.)": 3
|
||||
0": 2
|
||||
-1": 1
|
||||
1": 4
|
||||
"(u.)": 3
|
||||
ffffffff": 1
|
||||
"<#": 5
|
||||
hold: 2
|
||||
'42': 1
|
||||
"#>": 4
|
||||
ba": 1
|
||||
sign: 3
|
||||
--": 1
|
||||
"#": 2
|
||||
01": 1
|
||||
"#s": 1
|
||||
u#s: 1
|
||||
u#>: 1
|
||||
"<": 26
|
||||
">": 29
|
||||
">=": 10
|
||||
between: 8
|
||||
within: 128
|
||||
0<=: 6
|
||||
"<=": 10
|
||||
0<>: 7
|
||||
u<=: 6
|
||||
u>: 6
|
||||
u>=: 6
|
||||
'false': 16
|
||||
'true': 4
|
||||
'234': 7
|
||||
case: 16
|
||||
endcase: 16
|
||||
of: 28
|
||||
endof: 28
|
||||
begin: 14
|
||||
while: 15
|
||||
repeat: 10
|
||||
until: 4
|
||||
n: 1
|
||||
"--": 1
|
||||
0,1,..n: 1
|
||||
recurse: 1
|
||||
"+loop": 8
|
||||
j: 8
|
||||
leave: 4
|
||||
"?leave": 2
|
||||
evaluate: 3
|
||||
eval: 1
|
||||
ge4: 1
|
||||
execute: 4
|
||||
quit: 1
|
||||
abort: 1
|
||||
abort": 1
|
||||
'111': 6
|
||||
'222': 6
|
||||
'333': 4
|
||||
'999': 4
|
||||
'11': 4
|
||||
'22': 4
|
||||
'33': 4
|
||||
'44': 4
|
||||
'345': 6
|
||||
unloop: 3
|
||||
exit: 2
|
||||
noop: 1
|
||||
catch: 3
|
||||
throw: 1
|
||||
x123: 3
|
||||
y123: 2
|
||||
2constant: 3
|
||||
x123456: 3
|
||||
y123456: 2
|
||||
value: 3
|
||||
val1: 6
|
||||
"-999": 1
|
||||
val2: 5
|
||||
to: 4
|
||||
"-333": 1
|
||||
val3: 3
|
||||
immediate: 5
|
||||
literal: 3
|
||||
variable: 1
|
||||
v1: 3
|
||||
'buffer:': 1
|
||||
alias: 1
|
||||
al2: 2
|
||||
defer: 1
|
||||
df1: 7
|
||||
behavior: 2
|
||||
struct: 2
|
||||
field: 2
|
||||
fld1: 2
|
||||
fld2: 2
|
||||
postpone: 4
|
||||
nop1: 2
|
||||
nop2: 2
|
||||
does>: 4
|
||||
create: 3
|
||||
cr1: 6
|
||||
">body": 3
|
||||
",": 2
|
||||
forget: 2
|
||||
forgetme3": 1
|
||||
forgetme2": 1
|
||||
forgetme1": 1
|
||||
da1: 1
|
||||
here: 7
|
||||
c,: 2
|
||||
w,: 1
|
||||
l,: 1
|
||||
align: 2
|
||||
allot: 1
|
||||
"[']": 2
|
||||
gt1string: 2
|
||||
find: 9
|
||||
gt2string: 1
|
||||
state: 2
|
||||
"[": 3
|
||||
csr: 2
|
||||
"]": 3
|
||||
wxt: 2
|
||||
supercalafrag: 1
|
||||
bd1: 1
|
||||
body>: 1
|
||||
recursive: 1
|
||||
rrv1: 4
|
||||
forth: 1
|
||||
environment?: 1
|
||||
code: 1
|
||||
label: 1
|
||||
c;: 1
|
||||
end-code: 1
|
||||
binary: 1
|
||||
bsx: 4
|
||||
7f: 1
|
||||
'80': 1
|
||||
ff: 1
|
||||
wsx: 4
|
||||
7fff: 1
|
||||
rdrop: 1
|
||||
r+1: 1
|
||||
">r@": 1
|
||||
dm1": 2
|
||||
"$create": 1
|
||||
last: 1
|
||||
dm1: 2
|
||||
">link": 1
|
||||
">name": 1
|
||||
foobar": 1
|
||||
"$tmpstr": 1
|
||||
a": 2
|
||||
foobaz": 2
|
||||
"$2value": 3
|
||||
bazbar": 2
|
||||
foobaz: 2
|
||||
bazbar: 2
|
||||
aconcat: 1
|
||||
fbbb: 3
|
||||
foobazbazbar": 1
|
||||
"$hex(": 1
|
||||
414243): 1
|
||||
abc": 1
|
||||
foo": 2
|
||||
cicomp: 1
|
||||
":temp": 1
|
||||
"[:": 1
|
||||
";]": 1
|
||||
"$empty-wl": 1
|
||||
"$env?-wl": 1
|
||||
"$sysif": 1
|
||||
"$direct": 1
|
||||
sqrtrem: 4
|
||||
'25': 1
|
||||
'31': 1
|
||||
"$memtop": 1
|
||||
u.0: 1
|
||||
@ -4,7 +4,7 @@ also romfs also forth definitions
|
||||
2dup type cr included ;
|
||||
." ROMfs bootstrap by M.G." cr
|
||||
s" message.fs" ?romfs-run
|
||||
s" board.fs" ?romfs-run
|
||||
s" of.fs" ?romfs-run
|
||||
s" board.fs" ?romfs-run
|
||||
forth only definitions
|
||||
|
||||
|
||||
Loading…
Reference in New Issue
Block a user