projects:sample5.blk
Examples for lecture number five.
Screen 0 not modified
0 \ Examples for lecture number five. 10:03JWB02/07/86
1 \ Last change: Screen 001 16:23JWB04/22/87
2
3
4 Fixed point vs Floating point.
5 */ and scaling.
6 Fractions, arithmetic & display.
7 Rounding.
8 Timing.
9 DO ... LOOPs
10 Simple Floating Point.
11 A Fancy Line Editor. See file LEDIT.BLK
12
13
14
15
Screen 1 not modified
0 \ Load screen for help system. 16:23JWB04/22/87
1
2 \ The word FROM temporarily redirects the input to the
3 \ indicated block file for ONE screen load only.
4 \ However.... that one screen could specify that others be
5 \ loaded. This is the case with screen one of sample1.blk.
6 \ Go back and check it yourself.
7
8 FROM SAMPLE1.BLK 9 LOAD \ Load MQUIT
9 FROM LEDIT.BLK 1 LOAD \ Load the line editor.
10
11
12
13
14
15
Screen 2 not modified
0 \ Review-1 Return Stack 19:54JWB10/15/85
1 \ Note: D) indicates data stack, R) indicates return stack.
2 \ Transfer top data stack item to return stack.
3 \ >R ( n -- D) ( -- n R)
4 \ Transfer top return stack item to data stack.
5 \ R> ( -- n D) ( n -- R)
6 \ Copy top return stack item to data stack.
7 \ R@ ( -- n D) ( n n R)
8
9 \ 1. Do not test or execute these words interactively.
10 \ 2. Only use these words within colon definitions.
11 \ 3. Each use of >R must be balanced with a corresponding R>.
12 \ 4. Do not use >R R> and R@ within DO ... LOOPs. Loop control
13 \ info is kept on the return stack and could be destroyed.
14
15
Screen 3 not modified
0 \ Review-2 Memory Operators. 20:01JWB10/15/85
1 HEX ( -- -- ) Set system number BASE to 16 (decimal).
2 DECIMAL ( -- -- ) Set system number BASE to 10 (decimal).
3 TIB ( -- adr ) Leave address of terminal input buffer.
4 PAD ( -- adr ) Leave address of text output buffer.
5 HERE ( -- adr ) Leave address of word buffer.
6 DUMP ( adr n -- ) Dump n bytes of memory starting at adr.
7 ERASE ( adr n -- ) Erase n bytes of memory starting at adr
8 to zeros.
9 FILL ( adr n m -- ) Fill n bytes of memory starting at adr
10 with low 8 bits of m ( 0 - 255 ).
11 ! ( n adr -- ) Store 16b value n at address adr.
12 @ ( adr n ) Fetch 16b value at adr and leave as n.
13 C! ( n adr -- ) Store low 8 bits of n at address adr.
14 C@ ( adr n ) Fetch 8 bit value at adr and leave as n.
15 ? ( adr -- ) Display contents of cell at adr.
Screen 4 not modified
0 \ Review-3 Variables and Constants. 20:19JWB10/15/85
1
2 VARIABLE <name> ( -- -- ) Create 16bit data storage
3 called <name>.
4 <name> ( -- adr ) Leave storage address of <name>
5
6 CONSTANT <name> ( n -- ) Create a constant <name> whose
7 value is specified by n.
8 <name> ( -- n ) Leave value of <name> on stack.
9
10 +! ( n adr -- ) Add n to the value found at address adr
11 : DRIP 1 RAIN @ + RAIN ! ;
12 : DRIP 1 RAIN +! ;
13
14 ON ( adr -- ) Set cell at adr to true or -1.
15 OFF ( adr -- ) Set cell at addr to false or 0.
Screen 5 not modified
0 \ Review-4 Simple tables and arrays. 20:15JWB10/15/85
1 CREATE <name> ( -- -- ) Creates a dictionary entry named <name>
2 When executed, <name> leaves the address
3 <name> ( -- adr) of the first memory cell which follows
4 the word name. No memory is allocated.
5 ALLOT ( n -- ) Allocate n bytes of memory in the
6 dictionary.
7 , ( n -- ) Allocate 16 bits ( 2 bytes ) of memory
8 initializing it to the value n.
9 C, ( n -- ) Allocate 8 bits ( 1 byte ) of memory
10 initializing it to low 8 bits of n.
11 CREATE MARBLE 0 , 0 , 0 ,
12 0 CONSTANT RED 2 CONSTANT BLUE 4 CONSTANT YELLOW
13 : MARBLES MARBLE + ;
14 2 RED MARBLES ! 3 BLUE MARBLES ! 5 YELLOW MARBLES !
15
Screen 6 not modified
0 \ Review-5 Double Variables and Constants 20:23JWB10/15/85
1
2 2VARIABLE <name> Creates a 2 cell ( 4 byte ) variable
3 called <name>.
4 <name> ( -- adr ) When <name> is executed it will puse the
5 address of the first cell onto the stack
6
7 2CONSTANT <name> Creates a double constant called <name>
8 ( d -- ) with the initial value of d
9 <name> ( -- d ) When <name> is executed the double
10 number is pushed to the data stack.
11
12 2! ( d adr -- ) Store the double number d at adr.
13
14 2@ ( adr d ) Fetch the double number d from adr.
15
Screen 7 not modified
0 \ Review-6 User stacks. 20:49JWB10/15/85
1 CREATE P-STACK 20 ALLOT VARIABLE P-INDEX
2 : P-CLEAR ( -- -- D) ( ?? -- P) 0 P-INDEX ! P-STACK 20 ERASE ;
3 : P-DEPTH ( -- n D) P-INDEX @ 2/ ;
4 : P-INC ( -- -- D)
5 P-INDEX @ 20 = IF ." P-OVERFLOW" P-CLEAR
6 ELSE 2 P-INDEX +! THEN ;
7 : P-DEC ( -- -- D)
8 P-INDEX @ 0= IF ." P-UNDERFLOW"
9 ELSE -2 P-INDEX +! THEN ;
10
11 : >P ( n -- D) ( -- n P) P-INC P-INDEX @ P-STACK + ! ;
12 : P@ ( -- n D) ( n n P) P-INDEX @ P-STACK + @ ;
13 : P> ( -- n D) ( n -- P) P@ P-DEC ;
14 : .P P-DEPTH ?DUP IF 1+ 1 ?DO I 2* P-STACK + @ 8 .R LOOP
15 ELSE ." P-STACK EMPTY" THEN ;
Screen 8 not modified
0 \ Solution to Problem 8. 20:49JWB10/15/85
1 \ Write FORTH words for the following user stack operations.
2 \ The should leave the data stack unchanged!!!
3 : PDUP P@ >P ;
4 : PDROP P> DROP ;
5 : PSWAP P> P> SWAP >P >P ;
6 : POVER P> P@ SWAP >P >P ;
7 : PROT P> P> P> -ROT >P >P >P ;
8 : -PROT PROT PROT ;
9 : PTUCK PSWAP POVER ;
10 : PNIP PSWAP PDROP ;
11 : 2PDUP POVER POVER ;
12 : 3PDUP P> 2PDUP DUP >P -PROT >P ;
13 : 2PSWAP PROT P> PROT >P ;
14 : 2PDROP PDROP PDROP ;
15 : 2POVER 2PSWAP 2PDUP P> P> 2PSWAP >P >P ;
Screen 9 not modified
0 \ Review-8 Indexed arrays. 21:02JWB10/15/85
1 CREATE X 102 ALLOT \ Array for x coordinates
2 CREATE Y 102 ALLOT \ Array for y coordinates
3 VARIABLE #POINTS \ Number of points in polygon
4 VARIABLE SUM \ Sum of the x(i)y(i-1) - x(i)y(i+1)
5 \ Compute address of ith component.
6 : II ( i adr adr{i} )
7 SWAP 1- #POINTS @ MOD 1+ 2* + ;
8 \ Fetch ith x component.
9 : X@ ( i x{i} ) X II @ ;
10 \ Fetch ith y component.
11 : Y@ ( i y{i} ) Y II @ ;
12 \ Store ith x component.
13 : X! ( x i -- ) X II ! ;
14 \ Store ith y component.
15 : Y! ( y i -- ) Y II ! ;
Screen 10 not modified
0 \ Reasons for using Fixed-point arithmetic 21:50JWB10/15/85
1
2 To maximize the computers efficiency:
3 1. by making the program run as fast as possible.
4 2. by using as little computer memory as possible.
5
6 Applications such as:
7 Operating systems and utilities; Process control;
8 Graphics; Data base management; Accounting; Simulation;
9 Editors; Wordprocessors; etc.
10
11 Do not require floating point.
12
13 Read Brodie page 113-116
14
15
Screen 11 not modified
0 \ Reasons for using Floating-point. 21:54JWB10/15/85
1
2 1. Scientific and Engineering Calculations.
3 2. Programming time is more highly valued than program
4 execution time.
5 3. Application requires numbers with a large dynamic range
6 ( greater than -2 billion to +2 billion ).
7 4. Computer has hardware floating-point processor, and
8 thus we do not pay speed penalty for using floating-point.
9
10 To add floating point to F83 see:
11 FORTH Tools and Applications by G. Feierbach and P. Thomas
12 pages 51-58 for a high-level floating point package
13 with 16 bit exponent and 32 bit mantissa.
14 See screens 40-45 of this file for a floating point package
15 with 16 bit exponent and 16 bit mantissa.
Screen 12 not modified
0 \ Star-slash the scaler 22:56JWB10/15/85
1 \ */ ( a b c ab/c ) Perform multiplication and then division.
2 \ Star-slash multiplies 16bit a and 16bit b to form a 32bit
3 \ intermediate result which is then divided by 16bit c to give a
4 \ 16bit result. The 32bit intermediate product ensures accurate
5 \ results when multiplying by fractions.
6
7 \ We use */ to multiply a by the fraction b/c
8 \ Examples:
9 \ 15000 3 4 */ gives 11250 correct answer
10 \ 15000 3 * 4 / gives -5134 wrong answer
11 \ m is p % of n
12 : %% ( n p m ) * 100 / . ;
13 : % ( n p m ) 100 */ . ;
14 \ Try 1820 32 %% and 1820 32 %
15
Screen 13 not modified
0 \ Percentage calculations 23:07JWB10/15/85
1 \ Use % to find Result Actual
2 \ 15 % of 220 33.00
3 \ 15 % of 222 33.30
4 \ 15 % of 224 33.60
5
6 \ Rounding.
7
8 : %R 10 */ 5 + 10 / . ;
9
10 \ Use DEBUG to follow the operation of %R on the above
11 \ examples.
12
13 \ See Brodie pp116-119
14
15
Screen 14 not modified
0 \ Rational approximations. Problem 1. 23:27JWB10/15/85
1 \ See Brodie page 122 for more.
2 : *PI 355 113 */ ; \ Do problem 3 and 4
3 : *SQRT(2) 19601 13860 */ ; \ in Brodie page 125 .
4 : *SQRT(3) 18817 10864 */ ; \
5 : *E 28667 10546 */ ; \
6 \ Area of circle
7 : AREA ( r a )
8 DUP * *PI ;
9 \ Volume of sphere
10 : VS ( r v )
11 DUP DUP * * *PI 4 3 */ ;
12 \ Volume of a cone.
13 : VC ( h r v )
14 AREA SWAP 3 */ ;
15 \ Problem 1. Determine the valid ranges for r in above examples.
Screen 15 not modified
0 \ Brute force approach to fractions. 09:17JWB10/16/85
1 \ Display decimal equivalent of fraction m/n.
2 : .XXX ( m n -- )
3 2DUP > ABORT" Improper fraction."
4 >R 2000 R> */ 1+ 2/ ( Scale and round fraction )
5 ASCII . EMIT DUP 10 <
6 IF ASCII 0 DUP EMIT EMIT
7 ELSE DUP 100 < IF ASCII 0 EMIT THEN
8 THEN . ;
9 \ Print the decimal equivalent of the mixed fraction i+m/n
10 : I.XXX ( i m n -- )
11 ROT . CONTROL H EMIT .XXX ;
12 \ Display decimal equivalents of 1/n through (n-1)/n
13 : TEST ( n -- )
14 CR DUP 1 ?DO CR I OVER 2DUP SWAP
15 . ." /" . ." = " .XXX LOOP DROP ;
Screen 16 not modified
0 \ Star slash mod */MOD Problem 2. 00:30JWB10/16/85
1 \ Compute ab/c with 32bit intermediate product ab and leave
2 \ quotient q and remainder r . Note: Forth-83 */MOD uses
3 \ signed values a b c and uses floored symmetric division.
4 \ */MOD ( a b c r q )
5 \ Calculate area of a circle and display to 3 decimal places.
6 : AREA ( r -- )
7 DUP * 355 113 \ This is ratio for pi
8 */MOD SWAP 113 \ We need remainder for I.XXX
9 ." The area of the circle is " I.XXX ;
10 \ Calculate volume of a sphere and display to 3 decimals.
11 : VOLUME ( r -- )
12 DUP DUP * SWAP 1420 * ( r*r r*1420 )
13 339 */MOD SWAP 339
14 ." The volume of the sphere is " I.XXX ;
15 \ Problem 2. Do circle circumference and sphere surface area.
Screen 17 not modified
0 \ Rounding with */MOD 09:31JWB10/16/85
1 \ Example: The percent calculation.
2 \ Using */ we rounded this way.
3 : %R1 10 */ 5 + 10 / DROP ;
4 : %R2 50 */ 1+ 2/ DROP ;
5
6 : %R3 100 */MOD SWAP 50 + 100 / + DROP ;
7 : %R4 100 */MOD SWAP 49 > NEGATE + DROP ;
8
9 \ Note: Change the . to DROP when doing the timing tests.
10 \ Do this using the editor replace function.
11
12
13
14
15
Screen 18 not modified
0 \ Timer module 13:13JWB10/16/85
1 ONLY EDITOR ALSO FORTH ALSO DEFINITIONS
2 2VARIABLE TICKS
3 \ Return current time in ticks as a double integer.
4 \ ( 18.2 ticks/second ) .
5 CODE @TICKS ( -- dn )
6 0 # AH MOV IP PUSH RP PUSH 26 INT RP POP IP POP
7 DX PUSH CX PUSH NEXT END-CODE
8 \ Save current time in ticks.
9 : !TIMER ( -- -- )
10 @TICKS TICKS 2! ;
11 \ Fetch elapsed time in ticks.
12 : @TIMER ( -- dn )
13 @TICKS TICKS 2@ D- ;
14 : TIME.IT ;
15
Screen 19 not modified
0 \ Timing Template. 17:42 10/16/85
1 \ @TIMER gives time in ticks, 18.2 ticks/sec so if we perform
2 \ 1000 passes we can get count in micro-secs for one pass.
3 ONLY EDITOR ALSO FORTH DEFINITIONS
4 FORGET TIME.IT
5 : TIME.IT
6 !TIMER 1000 0 DO
7 \ blank loop ( 0-54 micro-sec )
8 \ 395 395 2DROP ( 54-109 micro-sec )
9 \ 1234 32 %R1 ( 2692 micro-sec )
10 1234 32 %R2 ( 1648 micro-sec )
11 \ 1234 32 %R3 ( 2692 micro-sec )
12 \ 1234 32 %R4 ( 1648 micro-sec )
13 LOOP @TIMER DROP CR
14 5000 91 */ . 230 EMIT ." -seconds for one pass." ;
15 : TEST CLEARSCREEN 5 0 DO TIME.IT LOOP ;
Screen 20 not modified
0 \ Infinite Loops. 19:59JWB10/17/85
1 The infinite loop with no exit. This is recommended only for
2 an end user application. Examples: FORTH's QUIT & MY.OUTER
3 step 1 is executed once; step 2 is repeated forever. Note:
4 step 3 is never executed.
5 ... (step 1) BEGIN (step2) AGAIN (step3) ...
6
7 The infinite loop with EXIT escape hatch.
8 step 1 is executed once; step 2 and step 3 are repeated until
9 condition is true. Note: step 4 will never be executed
10 because EXIT passes control back to the calling word!!
11 Examples: See #IN and GAME's in Screens 18-19 of SAMPLE3.BLK
12 ... (s1) BEGIN (s2)
13 (condition) IF EXIT THEN
14 (s3)
15 AGAIN (s4) ...
Screen 21 not modified
0 \ Indefinite Loops 20:15JWB10/17/85
1 \ In the indefinite loop the main action is repeated until a
2 \ condition is true. Step 1 is executed once, step 2 is
3 \ executed and (condition) is tested. If condition is false
4 \ step 2 is executed again, if condition is true then step 3
5 \ is executed. Note that step 3 following the loop will be
6 \ executed when loop is exited - this is not the case with
7 \ the infinite loop with EXIT of previous screen.
8 \
9 \ ... (s1) BEGIN (s2)
10 \ (condition)
11 \ UNTIL (s3) ...
12
13 : COUNT-UP 0 BEGIN 1+ DUP CR . KEY? UNTIL DROP ." DONE" ;
14 : COUNT.UP 0 BEGIN 1+ DUP CR .
15 KEY? IF EXIT THEN AGAIN ." DONE" ;
Screen 22 not modified
0 \ Indefinite Loops. Problem 3 & 4 21:10JWB10/17/85
1 \ Indefinite loop illustrates incredible integer property.
2 : DOIT ( n -- )
3 CR BEGIN DUP 2 MOD ( is n odd? )
4 IF 3 * 1+ ( tripple n and add 1 )
5 ELSE 2/ ( half n )
6 THEN
7 DUP 5 .R DUP 2 <
8 UNTIL DROP ;
9 \ Problem 3. Modify program to count the number of cycles
10 \ before termination. Will this program always end?
11 \ Hint: Use a variable to save the count.
12 \ Problem 4. Modify the program so the value of the largest
13 \ number encountered is printed when the program terminates.
14 \ Is there a limit to the maximum number? Are 16 bit numbers
15 \ large enough. Hint: Use a variable to same current maximum.
Screen 23 not modified
0 \ Indefinite Loop - another form. Prob 5. 21:23JWB10/17/85
1 \ In this form step 1 is executed once. Step 2 is executed
2 \ if condition is true do step 3 and repeat starting with (s2)
3 \ if condition is false leave loop and do step 4.
4 \ ... (s1) BEGIN (s2)
5 \ (condition)
6 \ WHILE (s3)
7 \ REPEAT (s4) ...
8 \ This word clears the data stack.
9 : CLEAR ( ?? -- )
10 BEGIN DEPTH
11 0<>
12 WHILE DROP
13 REPEAT ;
14 \ Problem 5. Can you write CLEAR using BEGIN ... UNTIL ?
15
Screen 24 not modified
0 \ Finite Loops. Problem 6. 21:49JWB10/17/85
1 \ ... (s1) l i DO (s2) LOOP (s3) ...
2 \ ... (s1) l i DO (s2) n +LOOP (s3) ...
3 \ ... (s1) l i ?DO (s2) LOOP (s3) ...
4 \ ... (s1) l i ?DO (s2) n +LOOP (s3) ...
5 \ Problem 6: Given the following loop testing words:
6 : DOLOOP DO CR I . LOOP ; \ All of these words take
7 : DO+LOOP DO CR I . 2 +LOOP ; \ the loop limit and the
8 : DO-LOOP DO CR I . -2 +LOOP ; \ initial value on the
9 : ?DOLOOP ?DO CR I . LOOP ; \ stack. ie ( l i -- )
10 : ?DO+LOOP ?DO CR I . 2 +LOOP ;
11 : ?DO-LOOP ?DO CR I . -2 +LOOP ;
12 \ Determine the output for the following stack inputs.
13 \ a) 10 8 b) 10 10 c) 10 12
14 \ Caution: Think first! Some may execute a long long time!!
15 \ DO PROBLEMS 1 THRU 6 PAGE 145 OF STARTING FORTH.
Screen 25 not modified
0 \ Leaving Loops early. 22:24JWB10/17/85
1 \ Execute step 1. Repeat loop as before executing step 2 and
2 \ step 4 on each pass - except that if condition is true
3 \ before loop is finished execute step 3 and leave loop to
4 \ execute step 5. Note: step 4 will not be executed if we
5 \ leave the loop early. Note: EXIT cannot be used in DO LOOPs
6 \ (s1) l i DO (s2)
7 \ (condition) IF (s3) LEAVE THEN
8 \ (s4)
9 \ LOOP (s5) ...
10 \
11 \ This is an alternative form if step 3 is not required.
12 \ (s1) l i DO (s2)
13 \ (condition) ?LEAVE
14 \ (s4)
15 \ LOOP (s5) ...
Screen 26 not modified
0 \ Example Problem 7. 22:24JWB10/17/85
1 VARIABLE SEED 1234 SEED !
2 : (RND) SEED @ 259 * 3 + 32767 AND DUP SEED ! ;
3 : RND ( n r ) \ r is a random number 0 <= r < n
4 (RND) 32767 */ ;
5 CREATE TABLE 100 ALLOT
6 : FILL-TABLE 100 0 DO 100 RND TABLE I + C! LOOP ;
7 : SEE-TABLE CR 100 0 DO TABLE I + C@ 4 .R LOOP ;
8 : MATCH ( n -- )
9 100 0 DO TABLE I + C@ OVER =
10 IF CR ." Its in the " I . ." th cell. "
11 LEAVE THEN
12 LOOP DROP ;
13 \ Problem 7: Write SIGMA a word which sums the numbers in
14 \ in TABLE until a 0 is encountered. It then prints the
15 \ number of numbers and the average.
Screen 27 not modified
0 \ Zen Floating Point Math 09:39JWB02/07/86
1
2 28 31 THRU
3
4 EXIT
5
6 "Less is more" floating point implementation by Martin Tracy.
7 Put in the public domain in 1984 Forml Proceedings.
8
9 10-20-85 Modified by JWB for compatibility with F83
10
11
12
13
14
15
Screen 28 not modified
0 \ ZEN MATH, documentation. 09:37JWB02/07/86
1 EXIT
2 Floating-point four-function single-precision match package
3 with four significant digits and an unlimited dynamic range.
4 Floating-point numbers are represented by a signed mantissa
5 and an exponent of ten, with the exponent on top of the stack.
6 fixed-number stack ( top -> )
7 1. FLOAT -> 1 0
8 3.1415 FLOAT -> 31415 -4
9 -1234500. FLOAT -> -12345 2
10
11 Used like 3.1415 FLOAT 12.5 FLOAT F* F.
12
13 FLOAT asumes that a number containing a decimal point is forced
14 to a double-integer and the number of digits following the
15 decimal point is stored in the variable DPL.
Screen 29 not modified
0 \ D10* TRIM ZEN MATH 09:38JWB02/07/86
1
2
3 ( d1 --- d2 ; multiplies d1 by 10 )
4 : D10* D2* 2DUP D2* D2* D+ ;
5
6 ( trims a double number mantissa and an exponent of ten to )
7 ( a reasonable floating point number; dn n --- f )
8 : TRIM >R SWAP OVER DABS
9 BEGIN OVER 0< OVER OR
10 WHILE 0 10 UM/MOD >R 10 UM/MOD SWAP DROP R> R> 1+ >R
11 REPEAT ROT ?DNEGATE DROP R> ;
12
13
14
15
Screen 30 not modified
0 \ F+ FNEGATE ZEN MATH 09:38JWB02/07/86
1 : F+ ( f1 f2 f1+f2 )
2 ROT 2DUP - DUP 0<
3 IF NEGATE ROT >R SWAP DROP >R SWAP R>
4 ELSE SWAP >R SWAP DROP
5 THEN >R S>D R> DUP 0
6 ?DO >R D10* R> 1- OVER ABS 6553 >
7 IF LEAVE THEN
8 LOOP R> OVER + >R
9 IF ROT DROP
10 ELSE ROT S>D D+
11 THEN R> TRIM ;
12
13 : FNEGATE ( f1 -f1 )
14 >R NEGATE R> ;
15
Screen 31 not modified
0 \ F- F* F/ ZEN MATH 09:38JWB02/07/86
1 : F- ( f1 f2 f1-f2 )
2 FNEGATE F+ ;
3 : F* ( f1 f2 f1*f2 )
4 ROT + >R
5 2DUP XOR >R ABS SWAP ABS UM* R> ?DNEGATE R> TRIM ;
6
7 : F/ ( f1 f2 f1/f2 )
8 OVER 0= ABORT" F/ by zero"
9 ROT SWAP - >R 2DUP XOR ROT ROT
10 ABS DUP 6553 MIN ROT ABS 0
11 BEGIN 2DUP D10* SWAP DROP 3 PICK <
12 WHILE D10* R> 1- >R
13 REPEAT
14 2SWAP DROP UM/MOD SWAP DROP 0 ROT ?DNEGATE R> TRIM ;
15
Screen 32 not modified
0 \ FLOAT F. ZEN MATH 09:25JWB02/07/86
1
2 \ Convert a double number to a floating point number.
3 : FLOAT ( d f )
4 DPL @ NEGATE TRIM ;
5
6 \ Print a floating point number.
7 : F. ( f -- )
8 2 ?ENOUGH
9 >R DUP ABS 0
10 <# R@ 0 MAX 0 ?DO ASCII 0 HOLD LOOP
11 R@ 0<
12 IF R@ NEGATE 0 MAX 0 ?DO # LOOP ASCII . HOLD
13 THEN R> DROP #S ROT SIGN
14 #> TYPE SPACE ;
15
projects/sample5.blk.txt · Zuletzt geändert: 2013-06-06 21:27 von 127.0.0.1