From 48f8f8b02e872701d479cdd99bcf7515bbdbe02c Mon Sep 17 00:00:00 2001 From: mgcaret Date: Fri, 27 Nov 2020 11:53:49 -0800 Subject: [PATCH] make SLOF disk-label and fat-files packages compile --- ofw/of/base.fs | 85 ++- ofw/of/packages.fs | 2 + ofw/packages/disk-label.fs | 743 +++++++++++++++++++++++++++ ofw/packages/fat-files.fs | 208 ++++++++ platforms/GoSXB/cov.yml | 463 ----------------- platforms/GoSXB/romfs_files/AUTOEXEC | 2 +- 6 files changed, 1038 insertions(+), 465 deletions(-) create mode 100644 ofw/packages/disk-label.fs create mode 100644 ofw/packages/fat-files.fs delete mode 100644 platforms/GoSXB/cov.yml diff --git a/ofw/of/base.fs b/ofw/of/base.fs index f99ce27..a25a993 100644 --- a/ofw/of/base.fs +++ b/ofw/of/base.fs @@ -60,18 +60,28 @@ constant : 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 diff --git a/ofw/of/packages.fs b/ofw/of/packages.fs index 5ee3dfd..d5bacd1 100644 --- a/ofw/of/packages.fs +++ b/ofw/of/packages.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 diff --git a/ofw/packages/disk-label.fs b/ofw/packages/disk-label.fs new file mode 100644 index 0000000..bb64022 --- /dev/null +++ b/ofw/packages/disk-label.fs @@ -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 @ = 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: +\ +\ Linux Distribution +\ Linux +\ boot &device;:1,\boot\yaboot.ibm +\ +\ [..] +\ +\ + +: parse-bootinfo-txt ( addr len -- str len ) + 2dup s" " 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" " 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 +\ [[,]] + +\ | 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 +; diff --git a/ofw/packages/fat-files.fs b/ofw/packages/fat-files.fs new file mode 100644 index 0000000..0d90cae --- /dev/null +++ b/ofw/packages/fat-files.fs @@ -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= ; diff --git a/platforms/GoSXB/cov.yml b/platforms/GoSXB/cov.yml deleted file mode 100644 index d6d1940..0000000 --- a/platforms/GoSXB/cov.yml +++ /dev/null @@ -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 -"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 diff --git a/platforms/GoSXB/romfs_files/AUTOEXEC b/platforms/GoSXB/romfs_files/AUTOEXEC index 9df10d0..68a0b80 100644 --- a/platforms/GoSXB/romfs_files/AUTOEXEC +++ b/platforms/GoSXB/romfs_files/AUTOEXEC @@ -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