Author: wmb Date: 2009-07-03 06:06:23 +0200 (Fri, 03 Jul 2009) New Revision: 1232
Modified: cpu/x86/kerncode.fth cpu/x86/syscall.fth cpu/x86/target.fth forth/kernel/kernel.fth forth/kernel/sysio.fth Log: Kernel - added omit-files configuration option for smaller kernel.
Modified: cpu/x86/kerncode.fth =================================================================== --- cpu/x86/kerncode.fth 2009-07-01 00:25:47 UTC (rev 1231) +++ cpu/x86/kerncode.fth 2009-07-03 04:06:23 UTC (rev 1232) @@ -38,10 +38,17 @@
:-h /n* /n * ;-h
+[ifdef] omit-files \ assembler macro to assemble next :-h next + meta-asm[ ax lods 0 [ax] jmp ]meta-asm +;-h +[else] +\ assembler macro to assemble next +:-h next meta-asm[ up jmp ]meta-asm ;-h +[then]
:-h c; next end-code ;-h
Modified: cpu/x86/syscall.fth =================================================================== --- cpu/x86/syscall.fth 2009-07-01 00:25:47 UTC (rev 1231) +++ cpu/x86/syscall.fth 2009-07-03 04:06:23 UTC (rev 1232) @@ -171,16 +171,19 @@ \ systems (e.g. CP/M) require this; others which don't require it \ usually run faster with alignment than without.
+[ifndef] omit-files hex \ Aligns to a 512-byte boundary; this is okay for most systems. : _falign ( l.byte# fd -- l.aligned ) drop 1ff invert and ; : _dfalign ( d.byte# fd -- d.aligned ) drop swap 1ff invert and swap ; +[then]
: sys-init-io ( -- ) init-relocation \ must be first, for [is] to work install-wrapper-io
install-disk-io + \ Don't poll the keyboard under an OS; block waiting for a key ['] (key ['] key (is ;
Modified: cpu/x86/target.fth =================================================================== --- cpu/x86/target.fth 2009-07-01 00:25:47 UTC (rev 1231) +++ cpu/x86/target.fth 2009-07-03 04:06:23 UTC (rev 1232) @@ -29,11 +29,15 @@ \t16-t /w-t constant /link-t \t32-t /l-t constant /link-t /token-t constant /defer-t +[ifdef] omit-files +/n-t th 100 * constant user-size-t +[else] [ifdef] big-endian-t \ reloc code uses 300 in both cases. should we????? /n-t th 600 * constant user-size-t [else] /n-t th c00 * constant user-size-t [then] +[then] /n-t th 100 * constant ps-size-t /n-t th 100 * constant rs-size-t \t16-t /w-t constant /user#-t
Modified: forth/kernel/kernel.fth =================================================================== --- forth/kernel/kernel.fth 2009-07-01 00:25:47 UTC (rev 1231) +++ forth/kernel/kernel.fth 2009-07-03 04:06:23 UTC (rev 1232) @@ -1365,6 +1365,9 @@ nuser tag-file
decimal +[ifdef] omit-files +: $tagout 2drop ; +[else] : $tag-field ( $ -- ) tag-file @ fputs ; : tag-char ( char -- ) tag-file @ fputc ; : $tagout ( name$ -- ) @@ -1375,6 +1378,7 @@ base @ decimal source-id file-line (.) $tag-field base ! newline-string $tag-field ; +[then]
: $make-header ( adr len voc-acf -- ) -rot ( voc-acf adr,len ) @@ -1938,6 +1942,10 @@
[then]
+\ A place to put the last word returned by blword +0 value 'word + +[ifndef] omit-files \ From filecomm.fth
decimal @@ -2167,9 +2175,6 @@ ; : close-file ( fd -- ior ) fclose 0 ;
-\ A place to put the last word returned by blword -0 value 'word - headerless \ File descriptor allocation
@@ -2237,6 +2242,7 @@
file @ false ; +[then]
headerless \ A version that knows about multi-segment dictionaries can be installed @@ -2247,9 +2253,7 @@
defer .error# : (.error#) ( error# -- ) - dup d# -38 = if - ." The file '" opened-filename 2@ type ." ' cannot be opened." - else ." Error " . then + dup d# -38 = if .file-open-error else ." Error " . then ;
: .abort ( -- ) @@ -2328,6 +2332,10 @@ : warm (s -- ) single sp0 @ sp! quit ; [then]
+[ifdef] omit-files +: read-line ( adr len fd -- actual not-eof? error? ) 3drop 0 true ; +: .file-open-error ( -- ) ; +[else] \ From disk.fth
\ High level interface to disk files. @@ -2560,6 +2568,10 @@ 2 /n-t * ualloc-t user opened-filename headers
+: .file-open-error ( -- ) + ." The file '" opened-filename 2@ type ." ' cannot be opened." +; + : open-file ( adr len mode -- fd ior ) file @ >r \ Guard against re-entrancy
@@ -2722,6 +2734,7 @@ then ( ior ) ; \ Missing: file-status, create-file, delete-file, resize-file, rename-file +[then]
\ From cstrings.fth
@@ -2929,6 +2942,13 @@ throw ;
+defer prompt ( -- ) ' (prompt) is prompt + +defer quit ' (quit) is quit + +[ifdef] omit-files +: process-command-line ( -- ) ; +[else] : include-file ( fid -- ) /tib 4 + allocate throw ( fid adr ) save-input 2>r 2>r 2>r ( fid adr ) @@ -3004,10 +3024,6 @@ : null-environment? ( c-addr u -- false | i*x true ) 2drop false ; ' null-environment? is environment?
-defer prompt ( -- ) ' (prompt) is prompt - -defer quit ' (quit) is quit - : fload fl ;
: $report-name ( name$ -- name$ ) @@ -3072,6 +3088,8 @@ repeat bye ; +[then] + \ LICENSE_BEGIN \ Copyright (c) 2006 FirmWorks \
Modified: forth/kernel/sysio.fth =================================================================== --- forth/kernel/sysio.fth 2009-07-01 00:25:47 UTC (rev 1231) +++ forth/kernel/sysio.fth 2009-07-03 04:06:23 UTC (rev 1232) @@ -1,6 +1,9 @@ \ See license at end of file purpose: System I/O interfaces
+[ifdef] omit-files +: install-disk-io ; +[else] \ From sysdisk.fth
\ File I/O interface using the C wrapper program @@ -111,6 +114,7 @@ create lf-pstr 1 c, linefeed c, \ Unix create cr-pstr 1 c, carret c, \ Macintosh, OS-9 create crlf-pstr 2 c, carret c, linefeed c, \ DOS +[then]
\ From syskey.fth