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