Return to io.fs CVS log

Up to [gforth] / gforth / kernel

updated dates in copyright messages
inserted copyright messages in most files that did not have them
removed outdated files engine/32bit.h engine/strsig.c

    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: [IFUNDEF] (type)
   43: : (type)  BEGIN  dup  WHILE
   44:     >r dup c@ (emit) 1+ r> 1-  REPEAT  2drop ;
   45: [THEN]
   46: 
   47: Defer type ( c-addr u -- ) \ core
   48: ' (type) IS Type
   49: 
   50: Defer emit ( c -- ) \ core
   51: ' (Emit) IS Emit
   52: 
   53: Defer key ( -- c ) \ core
   54: ' (key) IS key
   55: 
   56: Defer key? ( -- flag ) \ core
   57: ' (key?) IS key?
   58: 
   59: : (.")     "lit count type ;
   60: : (S")     "lit count ;
   61: 
   62: \ Input                                                13feb93py
   63: 
   64: 07 constant #bell ( -- c ) \ gforth
   65: 08 constant #bs ( -- c ) \ gforth
   66: 09 constant #tab ( -- c ) \ gforth
   67: 7F constant #del ( -- c ) \ gforth
   68: 0D constant #cr   ( -- c ) \ gforth
   69: \ the newline key code
   70: 0C constant #ff ( -- c ) \ gforth
   71: 0A constant #lf ( -- c ) \ gforth
   72: 
   73: : bell  #bell emit [ has? os [IF] ] outfile-id flush-file drop [ [THEN] ] ;
   74: : cr ( -- ) \ core
   75:     \ emit a newline
   76: [ has? crlf [IF] ]	#cr emit #lf emit 
   77: [ [ELSE] ]		#lf emit
   78: [ [THEN] ]
   79:     ;
   80: 
   81: 1 [IF]
   82: \ space spaces		                                21mar93py
   83: decimal
   84: Create spaces ( u -- ) \ core
   85: bl 80 times \ times from target compiler! 11may93jaw
   86: DOES>   ( u -- )
   87:     swap
   88:     0 max 0 ?DO  I' I - &80 min 2dup type  +LOOP  drop ;
   89: Create backspaces
   90: 08 80 times \ times from target compiler! 11may93jaw
   91: DOES>   ( u -- )
   92:    swap
   93:    0 max 0 ?DO  I' I - &80 min 2dup type  +LOOP  drop ;
   94: hex
   95: : space ( -- ) \ core
   96:     1 spaces ;
   97: [ELSE]
   98: : space bl emit ;
   99: : spaces 0 max 0 ?DO space LOOP ;
  100: 
  101: [THEN]
  102: