Annotation of gforth/kernel/nio.fs, revision 1.8
1.1 anton 1: \ Number IO
2:
1.4 anton 3: \ Copyright (C) 1995,1996,1997,1998 Free Software Foundation, Inc.
1.1 anton 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: : pad ( -- addr ) \ core-ext
1.3 pazsan 22: here word-pno-size + aligned ;
1.1 anton 23:
24: \ hold <# #> sign # #s 25jan92py
25:
26: : hold ( char -- ) \ core
1.5 crook 27: \G Used within @code{<#} and @code{#>}. Append the character char
28: \G to the pictured numeric output string.
1.6 anton 29: -1 chars holdptr +!
30: holdptr @ dup holdbuf u< -&17 and throw
31: c! ;
1.1 anton 32:
33: : <# ( -- ) \ core less-number-sign
1.5 crook 34: \G Initialise/clear the pictured numeric output string.
1.7 anton 35: holdbuf-end dup holdptr ! holdend ! ;
1.1 anton 36:
37: : #> ( xd -- addr u ) \ core number-sign-greater
1.5 crook 38: \G Complete the pictured numeric output string by
39: \G discarding xd and returning addr u; the address and length
40: \G of the formatted string. A Standard program may modify characters
41: \G within the string.
1.7 anton 42: 2drop holdptr @ holdend @ over - ;
1.6 anton 43:
1.7 anton 44: : <<# ( -- ) \ gforth less-less-number-sign
1.6 anton 45: \G starts a hold area that ends with @code{#>>}. Can be nested in
46: \G each other and in @code{<#}. Note: if you do not match up the
47: \G @code{<<#}s with @code{#>>}s, you will eventually run out of
48: \G hold area; you can reset the hold area to empty with @code{<#}.
1.7 anton 49: holdend @ holdptr @ - hold
50: holdptr @ holdend ! ;
1.6 anton 51:
1.7 anton 52: : #>> ( -- ) \ gforth number-sign-greater-greater
53: \G releases the hold area started with @code{<<#}.
1.8 ! anton 54: holdend @ dup holdbuf-end u>= -&11 and throw
! 55: count chars bounds holdptr ! holdend ! ;
1.1 anton 56:
57: : sign ( n -- ) \ core
1.5 crook 58: \G Used within @code{<#} and @code{#>}. If n (a @var{single} number)
59: \G is negative, append the display code for a minus sign to the pictured
60: \G numeric output string. Since the string is built up "backwards"
61: \G this is usually used immediately prior to @code{#>}, as shown in
62: \G the examples below.
1.1 anton 63: 0< IF [char] - hold THEN ;
64:
65: : # ( ud1 -- ud2 ) \ core number-sign
1.5 crook 66: \G Used within @code{<#} and @code{#>}. Add the next least-significant
67: \G digit to the pictured numeric output string. This is achieved by dividing ud1
68: \G by the number in @code{base} to leave quotient ud2 and remainder n; n
69: \G is converted to the appropriate display code (eg ASCII code) and appended
70: \G to the string. If the number has been fully converted, ud1 will be 0 and
71: \G @code{#} will append a "0" to the string.
1.1 anton 72: base @ 2 max ud/mod rot 9 over <
73: IF
74: [ char A char 9 - 1- ] Literal +
75: THEN
76: [char] 0 + hold ;
77:
1.5 crook 78: : #s ( ud -- 0 0 ) \ core number-sign-s
79: \G Used within @code{<#} and @code{#>}. Convert all remaining digits
80: \G using the same algorithm as for @code{#}. @code{#s} will convert
81: \G at least one digit. Therefore, if ud is 0, @code{#s} will append
82: \G a "0" to the pictured numeric output string.
1.1 anton 83: BEGIN
84: # 2dup or 0=
85: UNTIL ;
86:
87: \ print numbers 07jun92py
88:
89: : d.r ( d n -- ) \ double d-dot-r
1.5 crook 90: \G Display d right-aligned in a field n characters wide. If more than
91: \G n characters are needed to display the number, all digits are displayed.
92: \G If appropriate, n must include a character for a leading "-".
1.7 anton 93: >r tuck dabs <<# #s rot sign #>
94: r> over - spaces type #>> ;
1.1 anton 95:
96: : ud.r ( ud n -- ) \ gforth u-d-dot-r
1.5 crook 97: \G Display ud right-aligned in a field n characters wide. If more than
98: \G n characters are needed to display the number, all digits are displayed.
1.7 anton 99: >r <<# #s #> r> over - spaces type #>> ;
1.1 anton 100:
101: : .r ( n1 n2 -- ) \ core-ext dot-r
1.5 crook 102: \G Display n1 right-aligned in a field n2 characters wide. If more than
103: \G n2 characters are needed to display the number, all digits are displayed.
104: \G If appropriate, n2 must include a character for a leading "-".
1.1 anton 105: >r s>d r> d.r ;
1.5 crook 106:
1.1 anton 107: : u.r ( u n -- ) \ core-ext u-dot-r
1.5 crook 108: \G Display u right-aligned in a field n characters wide. If more than
109: \G n characters are needed to display the number, all digits are displayed.
1.1 anton 110: 0 swap ud.r ;
111:
112: : d. ( d -- ) \ double d-dot
1.5 crook 113: \G Display (the signed double number) d in free-format. followed by a space.
1.1 anton 114: 0 d.r space ;
1.5 crook 115:
1.1 anton 116: : ud. ( ud -- ) \ gforth u-d-dot
1.5 crook 117: \G Display (the signed double number) ud in free-format, followed by a space.
1.1 anton 118: 0 ud.r space ;
119:
120: : . ( n -- ) \ core dot
1.5 crook 121: \G Display (the signed single number) n in free-format, followed by a space.
1.1 anton 122: s>d d. ;
1.5 crook 123:
1.1 anton 124: : u. ( u -- ) \ core u-dot
1.5 crook 125: \G Display (the unsigned single number) u in free-format, followed by a space.
1.1 anton 126: 0 ud. ;
127:
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>