Forth-eV Wiki

Benutzer-Werkzeuge

Webseiten-Werkzeuge

Sie befinden sich hier: Forth Wiki » papierkorb » Examples for lecture number five.
Zuletzt angesehen:
papierkorb:sample5.blk

Unterschiede

Hier werden die Unterschiede zwischen zwei Versionen angezeigt.

Link zu dieser Vergleichsansicht

papierkorb:sample5.blk [2025-08-16 17:50] – ↷ Seite von projects:sample5.blk nach papierkorb:sample5.blk verschoben mkapapierkorb:sample5.blk [Unbekanntes Datum] (aktuell) – gelöscht - Externe Bearbeitung (Unbekanntes Datum) 127.0.0.1
Zeile 1: Zeile 1:
-=== Examples for lecture number five. === 
-<code> 
-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                                                                  
- 
-</code> 
papierkorb/sample5.blk.1755359401.txt.gz · Zuletzt geändert: 2025-08-16 17:50 von mka