Annotation of gforth/kernel/io.fs, revision 1.5
1.1 anton 1: \ input output basics (extra since) 02mar97jaw
2:
3: \ Copyright (C) 1995-1997 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:
1.2 jwilke 21: \ Output 13feb93py
22:
1.3 jwilke 23: has? os [IF]
1.2 jwilke 24: 0 Value outfile-id ( -- file-id ) \ gforth
1.5 ! pazsan 25: 0 Value infile-id ( -- file-id ) \ gforth
1.2 jwilke 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: ;
1.5 ! pazsan 34:
! 35: : (key) ( -- c ) \ gforth
! 36: infile-id key-file ;
! 37:
! 38: : (key?) ( -- flag ) \ gforth
! 39: infile-id key?-file ;
1.2 jwilke 40: [THEN]
41:
1.4 pazsan 42: [IFUNDEF] (type)
43: : (type) BEGIN dup WHILE
44: >r dup c@ (emit) 1+ r> 1- REPEAT 2drop ;
45: [THEN]
46:
1.2 jwilke 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
1.5 ! pazsan 55:
! 56: Defer key? ( -- flag ) \ core
! 57: ' (key?) IS key?
1.2 jwilke 58:
59: : (.") "lit count type ;
60: : (S") "lit count ;
61:
1.1 anton 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:
1.3 jwilke 73: : bell #bell emit [ has? os [IF] ] outfile-id flush-file drop [ [THEN] ] ;
1.1 anton 74: : cr ( -- ) \ core
75: \ emit a newline
1.3 jwilke 76: [ has? crlf [IF] ] #cr emit #lf emit
1.1 anton 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:
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>