Return to io.fs CVS log

Up to [gforth] / gforth / kernel

Added further options to shrink a kernel down
Cleaned up conditional primitives (works now for C-generated part, too)
Cleaned up mach files for embedded architectures
Cleaned up options in the kernel

    1: \ input output basics				(extra since)	02mar97jaw
    2: 
    3: \ Copyright (C) 1995,1996,1997,1998 Free Software Foundation, Inc.
    4: 
    5: \ This file is part of Gforth.
    6: 
    7: \ Gforth is free software; you can redistribute it and/or
    8: \ modify it under the terms of the GNU General Public License
    9: \ as published by the Free Software Foundation; either version 2
   10: \ of the License, or (at your option) any later version.
   11: 
   12: \ This program is distributed in the hope that it will be useful,
   13: \ but WITHOUT ANY WARRANTY; without even the implied warranty of
   14: \ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
   15: \ GNU General Public License for more details.
   16: 
   17: \ You should have received a copy of the GNU General Public License
   18: \ along with this program; if not, write to the Free Software
   19: \ Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
   20: 
   21: \ Output                                               13feb93py
   22: 
   23: has? os [IF]
   24: 0 Value outfile-id ( -- file-id ) \ gforth
   25: 0 Value infile-id ( -- file-id ) \ gforth
   26:     
   27: : (type) ( c-addr u -- ) \ gforth
   28:     outfile-id write-file drop \ !! use ?DUP-IF THROW ENDIF instead of DROP ?
   29: ;
   30: 
   31: : (emit) ( c -- ) \ gforth
   32:     outfile-id emit-file drop \ !! use ?DUP-IF THROW ENDIF instead of DROP ?
   33: ;
   34: 
   35: : (key) ( -- c ) \ gforth
   36:     infile-id key-file ;
   37: 
   38: : (key?) ( -- flag ) \ gforth
   39:     infile-id key?-file ;
   40: [THEN]
   41: 
   42: undef-words
   43:     
   44: Defer type ( c-addr u -- ) \ core
   45: : (type)  BEGIN  dup  WHILE
   46:     >r dup c@ (emit) 1+ r> 1-  REPEAT  2drop ;
   47: 
   48: [IFDEF] (type) ' (type) IS Type [THEN]
   49: 
   50: Defer emit ( c -- ) \ core
   51: : (emit) ( c -- ) \ gforth
   52:     0 emit-file drop \ !! use ?DUP-IF THROW ENDIF instead of DROP ?
   53: ;
   54: 
   55: [IFDEF] (emit) ' (emit) IS emit [THEN]
   56: 
   57: Defer key ( -- c ) \ core
   58: : (key) ( -- c ) \ gforth
   59:     0 key-file ;
   60: 
   61: [IFDEF] (key) ' (key) IS key [THEN]
   62: 
   63: Defer key? ( -- flag ) \ core
   64: : (key?) ( -- flag ) \ gforth
   65:     0 key?-file ;
   66: 
   67: [IFDEF] (key?) ' (key?) IS key? [THEN]
   68: 
   69: all-words
   70: 
   71: : (.")     "lit count type ;
   72: : (S")     "lit count ;
   73: 
   74: \ Input                                                13feb93py
   75: 
   76: 07 constant #bell ( -- c ) \ gforth
   77: 08 constant #bs ( -- c ) \ gforth
   78: 09 constant #tab ( -- c ) \ gforth
   79: 7F constant #del ( -- c ) \ gforth
   80: 0D constant #cr   ( -- c ) \ gforth
   81: \ the newline key code
   82: 0C constant #ff ( -- c ) \ gforth
   83: 0A constant #lf ( -- c ) \ gforth
   84: 
   85: : bell  #bell emit [ has? os [IF] ] outfile-id flush-file drop [ [THEN] ] ;
   86: : cr ( -- ) \ core
   87:     \ emit a newline
   88: [ has? crlf [IF] ]	#cr emit #lf emit 
   89: [ [ELSE] ]		#lf emit
   90: [ [THEN] ]
   91:     ;
   92: 
   93: : space bl emit ;
   94: has? ec [IF]
   95: : spaces 0 max 0 ?DO space LOOP ;
   96: : backspaces  0 max 0 ?DO  #bs emit  LOOP ;
   97: [ELSE]
   98: \ space spaces		                                21mar93py
   99: decimal
  100: Create spaces ( u -- ) \ core
  101: bl 80 times \ times from target compiler! 11may93jaw
  102: DOES>   ( u -- )
  103:     swap
  104:     0 max 0 ?DO  I' I - &80 min 2dup type  +LOOP  drop ;
  105: Create backspaces
  106: 08 80 times \ times from target compiler! 11may93jaw
  107: DOES>   ( u -- )
  108:    swap
  109:    0 max 0 ?DO  I' I - &80 min 2dup type  +LOOP  drop ;
  110: hex
  111: [THEN]
  112: