r1232 - cpu/x86 forth/kernel

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