Return to nio.fs CVS log

Up to [gforth] / gforth / kernel

Annotation of gforth/kernel/nio.fs, revision 1.4

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
                     27:     pad cell - -1 chars over +! @ c! ;
                     28: 
                     29: : <# ( -- ) \ core     less-number-sign
                     30:     pad cell - dup ! ;
                     31: 
                     32: : #>      ( xd -- addr u ) \ core      number-sign-greater
                     33:     2drop pad cell - dup @ tuck - ;
                     34: 
                     35: : sign    ( n -- ) \ core
                     36:     0< IF  [char] - hold  THEN ;
                     37: 
                     38: : #       ( ud1 -- ud2 ) \ core                number-sign
                     39:     base @ 2 max ud/mod rot 9 over <
                     40:     IF
                     41:        [ char A char 9 - 1- ] Literal +
                     42:     THEN
                     43:     [char] 0 + hold ;
                     44: 
                     45: : #s      ( +d -- 0 0 ) \ core number-sign-s
                     46:     BEGIN
                     47:        # 2dup or 0=
                     48:     UNTIL ;
                     49: 
                     50: \ print numbers                                        07jun92py
                     51: 
                     52: : d.r ( d n -- ) \ double      d-dot-r
                     53:     >r tuck  dabs  <# #s  rot sign #>
                     54:     r> over - spaces  type ;
                     55: 
                     56: : ud.r ( ud n -- ) \ gforth    u-d-dot-r
                     57:     >r <# #s #> r> over - spaces type ;
                     58: 
                     59: : .r ( n1 n2 -- ) \ core-ext   dot-r
                     60:     >r s>d r> d.r ;
                     61: : u.r ( u n -- )  \ core-ext   u-dot-r
                     62:     0 swap ud.r ;
                     63: 
                     64: : d. ( d -- ) \ double d-dot
                     65:     0 d.r space ;
                     66: : ud. ( ud -- ) \ gforth       u-d-dot
                     67:     0 ud.r space ;
                     68: 
                     69: : . ( n -- ) \ core    dot
                     70:     s>d d. ;
                     71: : u. ( u -- ) \ core   u-dot
                     72:     0 ud. ;
                     73: