home *** CD-ROM | disk | FTP | other *** search
/ Power-Programmierung / CD1.mdf / forth / compiler / zen / inputout.src < prev    next >
Text File  |  1990-01-09  |  4KB  |  147 lines
  1. \*
  2.  *   ZEN 1.10  Input and output
  3.  *     C 1990  by Martin Tracy
  4.  *             Last modified  1.1.90
  5.  *\
  6.  
  7. VARIABLE SPAN   \ Count of chars from last EXPECT  CORE
  8.  
  9. \ Read up to +n chars into address or stop at EOL# or with the
  10. \ first non-printing char, which is stored just past the string
  11. : EXPECT ( addr +n) \ CORE
  12.    ( +n) >R  0 ( addr offset)
  13.    BEGIN  DUP R@ <
  14.    WHILE  KEY 127 ( 7-bit ASCII) AND
  15.      DUP [ BSP# ] LITERAL = OVER
  16.          [ DEL# ] LITERAL = OR
  17.      IF    DROP  DUP IF  1-  BACKSP COUNT TYPE  THEN
  18.      ELSE  >R  2DUP +         R@ [ EOL# ] LITERAL -
  19.        IF  R@ OVER C!  THEN   R> BL <
  20.        IF  DROP  SPAN !  R> 2DROP  EXIT
  21.        ELSE  1 TYPE  1+  THEN
  22.      THEN
  23.    REPEAT  SPAN !  R> 2DROP ;
  24.  
  25.  
  26. VARIABLE BASE   \ Number conversion base  CORE
  27.  
  28. \ Decimal number conversion base
  29. : DECIMAL ( ) \ CORE
  30.    10 BASE ! ;
  31.  
  32. \ Hexadecimal number conversion base
  33. : HEX ( ) \ EXT CORE
  34.    16 BASE ! ;
  35.  
  36.  
  37. 33 EQU Jot_Size   \ 32 digits in a double number + 1
  38.  
  39. Jot_Size ALLOT
  40. | THERE LABEL JOT   \ Output conversion area
  41.  
  42. CHAR A CHAR 9 1+ - EQU A-10
  43.  
  44. \ Keep together
  45.   VARIABLE DPL      \ Decimal point locator
  46. | VARIABLE 'VAL?    \ VAL? transfer vector
  47. | VARIABLE DIG?     \ True if any digit converted
  48.  
  49. \ True if the char c is a valid digit in the given base.
  50. : DIGIT ( c base - n t | ? 0)
  51.    SWAP [CHAR] 0 -  9 OVER <  DUP
  52.    IF  DROP [ A-10 ] LITERAL -  10  THEN
  53.    >R  DUP R@ -  ROT R> -  U< ;
  54.  
  55. \ Convert the char sequence at a+1 and accumulate it in +d.
  56. \ a2 is the address of the first non-convertable digit.
  57. : CONVERT ( ud a - ud2 a2) \ CORE
  58.    BEGIN  1+ DUP >R  C@ BASE @ DIGIT
  59.    WHILE  SWAP  BASE @ UM* DROP
  60.           ROT   BASE @ UM*  D+  DIG? ON  R>
  61.    REPEAT DROP  R> ;
  62.  
  63. \ String to number conversion primitive.  True if d is valid.
  64. \ Returns d if number ends in final '.' and sets dpl = 0
  65. \ Returns n if no punctuation present   and sets dpl = 0<
  66. | : (VAL?) ( a u - d 2 , n 1 , 0)
  67.    [ Jot_Size 1- ] LITERAL MIN
  68.    JOT 1- OVER -  TUCK >R  CMOVE
  69.    BL JOT 1-  DUP DPL ! C!  DIG? OFF  0 0 R>
  70.    DUP C@ [CHAR] - = DUP >R - 1-
  71.    BEGIN  CONVERT  DUP C@  DUP [CHAR] : =
  72.      SWAP [CHAR] , [CHAR] / 1+ WITHIN  OR
  73.    WHILE  DUP DPL !  REPEAT  R> SWAP >R IF  DNEGATE  THEN
  74.    JOT 1- DPL @ - 1- dpl !   R> JOT 1- =  DIG? @ AND ( valid?)
  75.    IF  DPL @ 0< IF  DROP 1 EXIT  THEN  2 EXIT  THEN
  76.    2DROP 0 ;
  77.  
  78. \ String to number conversion primitive.  True if d is valid.
  79. : VAL? ( a u - d 2 , n 1 , 0)
  80.  'VAL? PERFORM ;
  81.  
  82.  
  83. | CREATE BLANKS   \ 8 contiguous blanks
  84. BL C, BL C, BL C, BL C, BL C, BL C, BL C, BL C,
  85.  
  86. \ Output one blank
  87. : SPACE ( ) \ CORE
  88.    BLANKS 1 TYPE ;
  89.  
  90. \ Output n blanks
  91. : SPACES ( n) \ CORE
  92.    BLANKS  OVER 2/ 2/ 2/  0
  93.    ?DO  DUP 8 TYPE  LOOP  SWAP  7 AND TYPE ;
  94.  
  95.  
  96. | VARIABLE HLD    \ Output conversion place holder
  97.  
  98. \ Write a character
  99. : EMIT ( w) \ CORE
  100.    HLD C!  HLD 1 TYPE ;
  101.  
  102.  
  103. \ Begin output conversion
  104. : <# ( ) \ CORE
  105.    JOT HLD ! ;
  106.  
  107. \ End output conversion
  108. : #> ( wd - a u) \ CORE
  109.    2DROP  HLD @  JOT OVER - ;
  110.  
  111. \ Add character c to output string.
  112. : HOLD ( c) \ CORE
  113.    -1 HLD +!  HLD @ C! ;
  114.  
  115. \ Add "-" to output string if w is negative.
  116. : SIGN ( n) \ CORE
  117.    0< IF  [CHAR] - HOLD  THEN ;
  118.  
  119. \ Transfer the next digit of ud to the output string.
  120. : # ( ud - ud2) \ CORE
  121.    BASE @ >R  0 R@ UM/MOD  R> SWAP >R  UM/MOD  R>
  122.    ROT 9 OVER < IF [ A-10 ] LITERAL +  THEN
  123.    [CHAR] 0 + HOLD ;
  124.  
  125. \ Convert all remaining digits of ud.  ud2 is 0 0 .
  126. : #S ( ud - ud2) \ CORE
  127.    BEGIN  #  2DUP OR  0= UNTIL ;
  128.  
  129. \ Convert a double number to a string.
  130. | : (D.) ( d - a u)
  131.    TUCK  DABS  <#  #S ROT SIGN  #> ;
  132.  
  133. \ Type a double number followed by a space.
  134. : D. ( d) \ DOUBLE
  135.    (d.) TYPE SPACE ;
  136.  
  137. \ Type an unsigned number followed by a space.
  138. : U. ( u) \ CORE
  139.    0 D. ;
  140.  
  141. \ Type a signed number followed by a space.
  142. : . ( n) \ CORE
  143.    DUP 0< D. ;
  144.  
  145. \ Print d right-justified in field of width w.
  146. : D.R ( d n) \ EXT CORE
  147.    >R  (D.)  R> OVER - 0 MAX SPACES  TYPE ;