File: nio.fs

package info (click to toggle)
gforth 0.7.0+ds2-0.1
  • links: PTS, VCS
  • area: main
  • in suites: wheezy
  • size: 5,808 kB
  • sloc: ansic: 8,506; sh: 3,660; lisp: 1,783; makefile: 993; yacc: 186; sed: 141; lex: 102; awk: 21
file content (143 lines) | stat: -rw-r--r-- 5,765 bytes parent folder | download | duplicates (5)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
\ Number IO

\ Copyright (C) 1995,1996,1997,1998,2000,2003,2006,2007 Free Software Foundation, Inc.

\ This file is part of Gforth.

\ Gforth is free software; you can redistribute it and/or
\ modify it under the terms of the GNU General Public License
\ as published by the Free Software Foundation, either version 3
\ of the License, or (at your option) any later version.

\ This program is distributed in the hope that it will be useful,
\ but WITHOUT ANY WARRANTY; without even the implied warranty of
\ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
\ GNU General Public License for more details.

\ You should have received a copy of the GNU General Public License
\ along with this program. If not, see http://www.gnu.org/licenses/.

require ./io.fs

: pad    ( -- c-addr ) \ core-ext
    \G @var{c-addr} is the address of a transient region that can be
    \G used as temporary data storage. At least 84 characters of space
    \G is available.
    [ has? flash [IF] ] normal-dp @ [ [ELSE] ] here [ [THEN] ]
    word-pno-size + aligned ;

\ hold <# #> sign # #s                                 25jan92py

has? EC [IF]
    : hld  ( -- addr )  pad cell - ;
    : hold  ( char -- )  hld -1 over +! @ c! ;
    : <#    hld dup ! ;
    : #>   ( d -- addr +n )  2drop hld dup @ tuck - ;
    ' <# alias <<#
    ' noop alias #>>
[ELSE]
: hold    ( char -- ) \ core
    \G Used within @code{<#} and @code{#>}. Append the character
    \G @var{char} to the pictured numeric output string.
    -1 chars holdptr +!
    holdptr @ dup holdbuf u< -&17 and throw
    c! ;

: <# ( -- ) \ core	less-number-sign
    \G Initialise/clear the pictured numeric output string.
    holdbuf-end dup holdptr ! holdend ! ;

: #>      ( xd -- addr u ) \ core	number-sign-greater
    \G Complete the pictured numeric output string by discarding
    \G @var{xd} and returning @var{addr u}; the address and length of
    \G the formatted string. A Standard program may modify characters
    \G within the string.
    2drop holdptr @ holdend @ over - ;

: <<# ( -- ) \ gforth	less-less-number-sign
    \G Start a hold area that ends with @code{#>>}. Can be nested in
    \G each other and in @code{<#}.  Note: if you do not match up the
    \G @code{<<#}s with @code{#>>}s, you will eventually run out of
    \G hold area; you can reset the hold area to empty with @code{<#}.
    holdend @ holdptr @ - hold
    holdptr @ holdend ! ;

: #>> ( -- ) \ gforth	number-sign-greater-greater
    \G Release the hold area started with @code{<<#}.
    holdend @ dup holdbuf-end u>= -&11 and throw
    count chars bounds holdptr ! holdend ! ;
[THEN]

: sign    ( n -- ) \ core
    \G Used within @code{<#} and @code{#>}. If @var{n} (a @var{single}
    \G number) is negative, append the display code for a minus sign
    \G to the pictured numeric output string. Since the string is
    \G built up ``backwards'' this is usually used immediately prior
    \G to @code{#>}, as shown in the examples below.
    0< IF  [char] - hold  THEN ;

: #       ( ud1 -- ud2 ) \ core		number-sign
    \G Used within @code{<#} and @code{#>}. Add the next
    \G least-significant digit to the pictured numeric output
    \G string. This is achieved by dividing @var{ud1} by the number in
    \G @code{base} to leave quotient @var{ud2} and remainder @var{n};
    \G @var{n} is converted to the appropriate display code (eg ASCII
    \G code) and appended to the string. If the number has been fully
    \G converted, @var{ud1} will be 0 and @code{#} will append a ``0''
    \G to the string.
    base @ ud/mod rot 9 over <
    IF
	[ char A char 9 - 1- ] Literal +
    THEN
    [char] 0 + hold ;

: #s      ( ud -- 0 0 ) \ core	number-sign-s
    \G Used within @code{<#} and @code{#>}. Convert all remaining digits
    \G using the same algorithm as for @code{#}. @code{#s} will convert
    \G at least one digit. Therefore, if @var{ud} is 0, @code{#s} will append
    \G a ``0'' to the pictured numeric output string.
    BEGIN
	# 2dup or 0=
    UNTIL ;

\ print numbers                                        07jun92py

: d.r ( d n -- ) \ double	d-dot-r
    \G Display @var{d} right-aligned in a field @var{n} characters wide. If more than
    \G @var{n} characters are needed to display the number, all digits are displayed.
    \G If appropriate, @var{n} must include a character for a leading ``-''.
    >r tuck  dabs  <<# #s  rot sign #>
    r> over - spaces  type #>> ;

: ud.r ( ud n -- ) \ gforth	u-d-dot-r
    \G Display @var{ud} right-aligned in a field @var{n} characters wide. If more than
    \G @var{n} characters are needed to display the number, all digits are displayed.
    >r <<# #s #> r> over - spaces type #>> ;

: .r ( n1 n2 -- ) \ core-ext	dot-r
    \G Display @var{n1} right-aligned in a field @var{n2} characters wide. If more than
    \G @var{n2} characters are needed to display the number, all digits are displayed.
    \G If appropriate, @var{n2} must include a character for a leading ``-''.
    >r s>d r> d.r ;

: u.r ( u n -- )  \ core-ext	u-dot-r
    \G Display @var{u} right-aligned in a field @var{n} characters wide. If more than
    \G @var{n} characters are needed to display the number, all digits are displayed.
    0 swap ud.r ;

: d. ( d -- ) \ double	d-dot
    \G Display (the signed double number) @var{d} in free-format. followed by a space.
    0 d.r space ;

: ud. ( ud -- ) \ gforth	u-d-dot
    \G Display (the signed double number) @var{ud} in free-format, followed by a space.
    0 ud.r space ;

: . ( n -- ) \ core	dot
    \G Display (the signed single number) @var{n} in free-format, followed by a space.
    s>d d. ;

: u. ( u -- ) \ core	u-dot
    \G Display (the unsigned single number) @var{u} in free-format, followed by a space.
    0 ud. ;