Benutzer-Werkzeuge

Webseiten-Werkzeuge


projects:sample8.blk

Examples for lecture number eight.

Screen 0 not modified     
 0 \ Examples for lecture number eight.           11:18JWB02/28/86 
 1 \ Last change:   Screen  001                   17:03jwb03/24/87 
 2                                                                 
 3                                                                 
 4         Dictionary Structure.                                   
 5                                                                 
 6         Vocabularies.                                           
 7                                                                 
 8         Recursion.                                              
 9                                                                 
10                                                                 
11                                                                 
12                                                                 
13                                                                 
14                                                                 
15                                                                 


Screen 1 not modified     
 0 \ Load screen.                                 17:03jwb03/24/87 
 1 \ Typing  OK   always loads screen 1!                           
 2   FROM   SAMPLE1.BLK   9 LOAD   \ MQUIT                         
 3   6 VIEWS  B:LEDIT.BLK    \ Identify LEDIT.BLK as file # 6      
 4   6 VIEW#  !              \ Set current view number.            
 5   FROM B:LEDIT.BLK  OK    \ load the line editor                
 6   NEW-EXP                 \ activate the new line editor.       
 7                                                                 
 8   7 VIEWS B:SAMPLE8.BLK   \ Identify sample8.blk as file # 7    
 9   7 VIEW# !               \ Set current view number to 7        
10                                                                 
11     7 9  THRU    \ Load Number Format examples and Verify.      
12    16 18 THRU    \ Load SPY                                     
13                                                                 
14  ONLY FORTH ALSO EDITOR ALSO FORTH DEFINITIONS                  
15                                                                 


Screen 2 not modified     
 0 \ Review-1 Strings                             21:41JWB11/14/85 
 1   A counted string in memory is    |05|48|45|4C|4C|4F|   <-hex  
 2   preceded  by character count.    |05| H| E| L| L| O|          
 3                                                                 
 4   ," {text}"  ( --  -- )      ONLY USE OUTSIDE A WORD DEFINITION
 5  Compile a counted {text} string into dictionary. Do not use in 
 6  a word definition!!  System will crash (if you're lucky).      
 7                                                                 
 8  " {text}" ( --  adr count )  ONLY USE WITHIN A WORD DEFINITION 
 9  Compile a counted string into a word definition.  When word    
10  is later executed the address and count are returned.          
11                                                                 
12 Examples:                                                       
13 CREATE NAME$ ," George Smith"                                   
14 : JOB$  " FORTH Programmer" ;                                   
15                                                                 


Screen 3 not modified     
 0 \ Review-2 COUNT TYPE  EXPECT                  21:58JWB11/14/85 
 1                                                                 
 2   COUNT ( adr   adr+1 n)                                        
 3     If adr points to a counted string,  COUNT will fetch the    
 4   character count an increment adr to point to first character. 
 5   Count is often used to fetch successive characters of a string
 6                                                                 
 7   TYPE  ( adr n  -- )     Type n characters of string at adr.   
 8                                                                 
 9   FILL  ( adr  n c )   Fill string at adr with n copies of c .  
10   ERASE ( adr  n   )   Fill string at adr with n null's or 0's. 
11                                                                 
12   EXPECT ( adr n  -- )                                          
13   Input a string of length n to buffer at adr . Actual number   
14   of characters entered is stored in a variable called SPAN.    
15   Note:  EXPECT does not return a counted string.               


Screen 4 not modified     
 0 \ Review-3 Moving Strings.                     22:05JWB11/14/85 
 1                                                                 
 2 CMOVE    ( adrf  adrt  n  -- )   Use when  adrf > adrt          
 3 Move n bytes from adrf to adrt.  Left-most or low memory bytes  
 4 are moved first. ( ie  Move starts at beginning of string.)     
 5 Use CMOVE to move strings down to lower memory.                 
 6                                                                 
 7 CMOVE>   ( adrf  adrt  n  -- )  Use when adrf < adrt            
 8 Move n bytes from adrf to adrt. Right-most or high memory       
 9 bytes are moved first. ( ie Move starts at end of string.)      
10 Use CMOVE> to move strings up to higher memory.                 
11                                                                 
12 MOVE     ( adrf  adrt  n  -- )                                  
13 Move n bytes from adrf to adrt. If adrf < adrt use CMOVE>       
14 otherwise use CMOVE.  This will prevent overlap.                
15 Use MOVE when you can't remember whether to use CMOVE or CMOVE> 


Screen 5 not modified     
 0 \ Review-4 Strings                             22:10JWB11/14/85 
 1 \ Move a string at adrf and pack it at adrt with count n.       
 2 : CPACK  ( adrf adrt n  -- )                                    
 3         SWAP 2DUP  C!   \ Store string count.                   
 4         1+  SWAP  CMOVE  ;                                      
 5 \ Chopping n characters from the left of a string               
 6 : CHOP  ( adr count n  adr' count' )                            
 7         ROT OVER + -ROT - ;                    EXIT             
 8                                                                 
 9 -TRAILING ( adr count1   adr count2 ) Remove trailing blanks    
10                                                                 
11 \ CONVERT  ( d1  adr1    d2  adr2 )                             
12 \ Convert a string at adr1+1 accumulating number into d1.       
13 \ Stops at first non digit character at addr2.  adr1 is usually 
14 \ the address of a counted or packed digit string.  The first   
15 \ digit of the string will be at adr1+1   .                     


Screen 6 not modified     
 0 \ Review-5 Number formating                    19:01JWB11/18/85 
 1                                                                 
 2   PAD  ( --  adr )     Return address for string  output buffer.
 3   HLD  ( --  adr )     Pointer to current location in output buf
 4   HOLD ( n    -- )     Add character n to string being formed.  
 5   SIGN  ( n  -- )      If n is negative insert a -ve sign in the
 6                        output string.    DIFFERENT FROM BRODIE  
 7                                                                 
 8   <#   ( dn   dn )     Start number formating   ( PAD HLD ! ) . 
 9                        dn, the number to be formated, is not    
10                        used by <#  but is usually present.      
11   #  ( dn     dn' )    Convert one digit of dn using current    
12                        number BASE and remaining digits as dn' .
13   #S  ( dn  dn')       Convert a number until finished. When    
14                        conversion is finished  dn' will be zero.
15   #>   ( dn  adr len ) Terminate numeric conversion.            


Screen 7 not modified     
 0 \ Number formating examples.                   22:44JWB11/14/85 
 1 \ Print single number as four digit hex and preserve system base
 2 : H.     BASE @ >R 16 BASE !                                    
 3          0 <# # # # # #>                                        
 4          R> BASE !  TYPE SPACE ;                                
 5 \ Print 16-bit number as binary saving preserving current BASE. 
 6 : B.     BASE @ >R  2 BASE !                                    
 7          0 <#  # # # #  # # # #  # # # #  # # # #  #>           
 8          R> BASE !  TYPE SPACE ;                                
 9 \ Print double number as signed dollars and cents.              
10 : $.   ( dn   -- )                                              
11     TUCK DABS           \ Save sign as third item.              
12     <# ROT      SIGN                                            
13             (  0< IF ASCII - HOLD ELSE ASCII + HOLD THEN )      
14          # #  ASCII . HOLD  #S  ASCII $ HOLD                    
15                  #>  TYPE SPACE  ;                              


Screen 8 not modified     
 0 \ [IN]  .ASCII  ?SPACE  .RBYTE  HEAD           14:33JWB11/02/85 
 1 \ Leave true flag if  a <= x <= b .                             
 2 : [IN]  ( x a b  f )  1+ -ROT 1- OVER < -ROT > AND ;            
 3                                                                 
 4 : .ASCII ( n  -- ) \ EMIT n as printable ascii or a space.      
 5         127 AND DUP BL 126 [IN] NOT IF DROP BL THEN EMIT ;      
 6 \ Double space if i is equal to 8 .                             
 7 : ?SPACE ( i  -- ) 8 = IF SPACE SPACE THEN ;                    
 8 \ Print byte right justified in field w wide.                   
 9 : .RBYTE ( n w  -- )                                            
10          >R 0 <# # # #> R> OVER - SPACES TYPE ;                 
11 \ Based on address adr ,  display heading for VERIFY            
12 : HEAD  ( adr   -- )                                            
13       CR 5 SPACES 16 0 DO I OVER + 255 AND                      
14       I ?SPACE 3 .RBYTE LOOP                                    
15       2 SPACES 16 0 DO I OVER + 15 AND 1 .R LOOP DROP ;         


Screen 9 not modified     
 0 \ 1LINE VERIFY  PEEK    Problem 1.              14:39JWB11/02/85
 1 : 1LINE     ( adr   -- ) \ Verify 16 bytes from address.        
 2    DUP CR 0 4 D.R SPACE  DUP           \ Display address.       
 3    16 0 DO   I ?SPACE COUNT  3 .RBYTE  \ Display bytes in hex.  
 4         LOOP DROP 2 SPACES                                      
 5    16 0 DO   COUNT  .ASCII             \ Display bytes as ASCII.
 6         LOOP DROP SPACE   ;                                     
 7                                                                 
 8 : VERIFY ( adr  -- ) \ Only 32 bytes from adr with header.      
 9      BASE @ SWAP HEX DUP HEAD                                   
10      DUP 1LINE DUP 16 + 1LINE HEAD  CR BASE ! ;                 
11                                                                 
12 \ Dump out first 32 bytes of a word in the dictionary.          
13 : PEEK  ' >NAME  2-    VERIFY ;                                 
14 \ Problem 1:  Use  HEAD  and 1LINE to write a better memory     
15 \ DUMP utility.                                                 


Screen 10 not modified     
 0 \ CASE ... OF ... ENDOF ...  ENDCASE           11:24JWB02/28/86 
 1 \ First look at sample7.blk  screen number 28.                  
 2 \ CASE  causes an index value to be compared to a series        
 3 \ OF    values.  Any number of OF .. ENDOF  pairs may be used.  
 4 \ OF      is equivalent to  OVER = IF DROP                      
 5 \ ENDOF   is equivalent to  ELSE                                
 6 \ ENDCASE is equivalent of DROP and number of THENs             
 7 \ When the index value equals one of the OF values, the sequence
 8 \ between that OF and the corresponding ENDOF is executed.      
 9 \ Control then branches to the word following ENDCASE.          
10 \ If no match is found,  ENDCASE drops the index from the stack.
11                                                                 
12 \ The "otherwise" case may be handled by a sequence placed      
13 \ between the last ENDOF  and ENDCASE.  The index value must    
14 \ however be preserved across this otherwise sequence so that   
15 \ ENDCASE  may  DROP it.                                        


Screen 11 not modified     
 0 \ Multi-way branching   CASE  Statement        22:52JWB11/14/85 
 1 : TIS  ( --  -- ) CR  ."  THIS  IS  DIGIT  NUMBER  "  ;         
 2 : TEST2  ( --  -- )                                             
 3     BEGIN  KEY  DUP 13 <> WHILE                                 
 4     CASE                                                        
 5       ASCII 1  OF         TIS  ." ONE "     ENDOF               
 6       ASCII 2  OF         TIS  ." TWO "     ENDOF               
 7       ASCII 3  OF         TIS  ." THREE "   ENDOF               
 8       ASCII 4  OF         TIS  ." FOUR "    ENDOF               
 9       ASCII 5  OF         TIS  ." FIVE "    ENDOF               
10       ASCII 6  OF         TIS  ." SIX "     ENDOF               
11       ASCII 7  OF         TIS  ." SEVEN "   ENDOF               
12       ASCII 8  OF         TIS  ." EIGHT "   ENDOF               
13       ASCII 9  OF         TIS  ." NINE "    ENDOF               
14       ASCII 0  OF         TIS  ." ZERO "    ENDOF               
15     BEEP  ENDCASE                   REPEAT DROP ;               


Screen 12 not modified     
 0 \ Structure of a FORTH word definition.        19:24JWB11/18/85 
 1                                                                 
 2                   4-bits    12-bits                             
 3        vfa ->   | File # |   Block # |  View Field              
 4        lfa ->   | Link address       |  Link Field              
 5        nfa ->              |1PScount |  Name Field  count=5bits 
 6                            |0  char  |                          
 7                            |0  char  |   char=7bits             
 8                            |0  char  |                          
 9                            |1  char  |                          
10        cfa ->   | Addr Inner Interpr.|  Code field              
11        pfa ->   | Parameter List     |  Parameter Field         
12                 |    . .     . .     |  Also called the         
13                 |    . .     . .     |  BODY  of the word       
14                 |    . .     . .     |  definition.             
15                                                                 


Screen 13 not modified     
 0 \ View, Link, Name: Details                    19:26JWB11/18/85 
 1 View Field:  Contains the File #  as set by    VIEWS   and  the 
 2              Block # or screen # that the word definition is on.
 3 File #       The File # set by the VIEWS comand is in the top   
 4              or most significant 4 bits of the view field.      
 5 Block #      Or screen # is in the low 12 bits of view field.   
 6 Link Field:  Contains the address of the Name Field of the      
 7              of the previous word in the dictionary.            
 8                                                                 
 9 Name Field:  Byte 1:    1  Delimeter bit                        
10                         P  Precedence bit, 1 for IMMEDIATE words
11                         S  Smudge bit, HIDE sets REVEAL clears. 
12                       0 4  Character count max is 31            
13              Byte 2:    0char                                   
14                                                                 
15         Last Byte  :    1char   1 is delimiter.                 


Screen 14 not modified     
 0 \ Code and Parameter fields                    10:20JWB11/17/85 
 1 Code Field :    Contains pointer to ( ie address of ) the       
 2                 machine code of the routine that implements this
 3                 particular class of words. This will be         
 4                 different for constants, variables, colon,      
 5                 and machine code definitions.  It is called     
 6                 the code field because it always points to      
 7                 machine code for the host CPU!!                 
 8                                                                 
 9 Parameter Field The contents of this field depends on the type  
10                 of word.  For single (16-bit) variables and     
11                 and constants it contains their 16-bit value.   
12                 For a colon definition it contains a list of    
13                 the cfa's of the words that make up the colon   
14                 definition.  For a code definion it contains    
15                 the actual machine code for the word.           


Screen 15 not modified     
 0 \ Accessing a words fields.                    10:40JWB11/17/85 
 1                                                                 
 2  ' {word} ( --   cfa )    Leave code field address of {word}.   
 3                                                                 
 4 >VIEW    ( cfa  vfa )    Go to view field from code field.      
 5 >LINK    ( cfa  lfa )    Go to link field from code field.      
 6 >NAME    ( cfa  nfa )    Go to name field from code field.      
 7 >BODY    ( cfa  pfa )    Go to parameter field from code field. 
 8 VIEW>    ( vfa  cfa )    Go from view field to code field.      
 9 LINK>    ( lfa  cfa )    Go from link field to code field.      
10 NAME>    ( nfa  cfa )    Go from name field to code field.      
11 BODY>    ( pfa  cfa )    Go from body to code field.            
12 N>LINK   ( nfa  lfa )    Go from name field to link field.      
13 L>NAME   ( lfa  nfa )    Go from link field to name field.      
14 Hints:  Read  >VIEW   as  "to view field"                       
15                VIEW>  as  "from view field"                     


Screen 16 not modified     
 0 \ SPY-VFA                                      20:04JWB11/18/85 
 1 \ Display contents of field in both binary and hex.             
 2 : .RAW  ( adr   -- )                                            
 3    DUP H. ."  Contains: " @ DUP  H. ."  hex or " B. ."  bin" ;  
 4 : SPY-VFA  ( cfa  -- )                                          
 5    CR ." VFA: "                                                 
 6    >VIEW DUP .RAW  CR 11 SPACES   \ Display raw contents of vfa.
 7    @    DUP 4095 AND DUP          \ Mask top 4 bits to get scr# 
 8    IF   SWAP 4096 / 15 AND ?DUP   \ Extract view file number.   
 9        IF   2* VIEW-FILES + @     \ Find cfa of the view file.  
10             ." Located in file: " \ Display file name.          
11             >BODY .FILE                                         
12        ELSE ." May be in current file: "                        
13             FILE?                                               
14        THEN ." Screen # " .        \ Display screen number.     
15    ELSE  2DROP  ." Entered at the terminal." THEN  ;            


Screen 17 not modified     
 0 \  SPY-LFA  SPY-NFA                            13:52JWB11/17/85 
 1                                                                 
 2 : SPY-LFA ( cfa  -- )                                           
 3    CR ." LFA: "                                                 
 4    >LINK  DUP .RAW                                              
 5    CR 11 SPACES ." This word is linked to: "                    
 6    @  L>NAME  .ID  ;                                            
 7                                                                 
 8 : SPY-NFA ( cfa  -- )                                           
 9    CR ." NFA: "                                                 
10    >NAME  DUP .RAW CR DUP HEX  1LINE  DECIMAL                   
11    DUP C@  64 AND  CR 11 SPACES ." Precedence bit is "          
12    IF " on." ELSE ." off." THEN                                 
13    DUP C@  32 AND ."   Smudge bit is "                          
14    IF " on." ELSE ." off." THEN                                 
15    C@ 31 AND     ."   The word length is " . ;                  


Screen 18 not modified     
 0 \  SYP-CFA  SPY-PFA   SPY                      12:23JWB11/17/85 
 1                                                                 
 2 : SPY-CFA ( cfa  -- )                                           
 3    CR ." CFA: " .RAW   ;                                        
 4                                                                 
 5 : SPY-PFA ( cfa  -- )                                           
 6    >BODY  CR ." PFA: " .RAW   ;                                 
 7                                                                 
 8 : SPY  ( --  -- )                                               
 9   ' CR   DUP  SPY-VFA                                           
10     CR   DUP  SPY-LFA                                           
11     CR   DUP  SPY-NFA                                           
12     CR   DUP  SPY-CFA                                           
13     CR   DUP  SPY-PFA                                           
14     CR   KEY 13 = IF DROP  ELSE  (SEE) THEN ;                   
15                                                                 


Screen 19 not modified     
 0 \ The Smudge bit  and the Precedence  bit      20:00JWB11/18/85 
 1  HIDE   ( --  -- )     Removes last word defined by unlinking it
 2      from its vocabulary thread.  Previously smudge bit was set.
 3  REVEAL ( --  -- )     Link the most recently defined word into 
 4      the current vocabulary.  Previously smudge bit was cleared.
 5  IMMEDIATE ( --  -- )  Turn on the precedence bit of the most   
 6      recently defined word in the dictionary.                   
 7  IMMEDIATE  flags a definition so that it is executed during    
 8      compilation instead of being compiled.                     
 9  IMMEDIATE  marks the most recently compiled definition so that 
10  when it is encountered at compile time, it is executed rather  
11  than compiled.  Many compiler words are immediate.             
12  ['] {word} This is an IMMEDIATE word used within a definition. 
13       It used to compile the cfa of the following word as a     
14       LITERAL or number.  It is equivalent to the sequence      
15  [ ' {word} ] LITERAL                                           


Screen 20 not modified     
 0 \ DP HERE CURRENT #VOC CONTEXT                 14:26JWB11/17/85 
 1 DP      ( --  adr )     Variable containing the current top     
 2                         of the dicitionary.                     
 3 HERE    ( --  adr )     Returns top of dictionary as stored in  
 4                         DP                                      
 5 CURRENT ( --  adr )     Variable containing the pfa of the      
 6                         vocabulary in to which new definitions  
 7                         are compiled.                           
 8 #VOCS   ( --  n   )     Constant whose value is the maximum     
 9                         number of dictionaries that can be in   
10                         the search order.                       
11 CONTEXT ( --  adr )     Variable containing the address of the  
12                         array space that holds the 8=#VOCs      
13                         transient vocabulary pointers ( pfas)   
14                         The CONTEXT array specifies the search  
15                         order for the text interpreter.         


Screen 21 not modified     
 0 \ ORDER  VOC-LINK  VOCS  DEFINITIONS           14:37JWB11/17/85 
 1 ORDER     ( --  -- )    Display the vocabulary names forming the
 2                         search order in their present search    
 3                         order sequence. Then show vocabulary    
 4                         into which new definitions will be put. 
 5 VOC-LINK  ( --  adr )   Variable that contains pointer to the   
 6                         most recently defined vocabulary.       
 7                         The pointer is actually pfa+8 !!!       
 8                         Vocabularies are thus linked in the     
 9                         order of their creation.                
10 VOCS      ( --  -- )    List all vocabularies that exist in this
11                         FORTH system.                           
12 DEFINITIONS ( --  -- )  Select the transient vocabulary ( first 
13                         in the context array) as the compilation
14                         vocabulary into which all subsequent    
15                         new word definitions will be added.     


Screen 22 not modified     
 0 \ VOCABULARY  ALSO  PREVIOUS                   17:05JWB11/17/85 
 1                                                                 
 2 VOCABULARY  {name}  ( --  -- )                                  
 3  A dictionary entry for {name} is created which specifies a     
 4  new list of word definitions.  Subsequent execution of {name}  
 5  replaces the first vocabulary in the current search order      
 6  with {name}.  When name becomes the compilation vocabulary     
 7  new definitions will be appended to {name}'s word list.        
 8                                                                 
 9 ALSO     ( --  -- )                                             
10  Push transient vocabulary making it the first resident         
11  vocabulary in the search order.                                
12                                                                 
13 PREVIOUS ( --  -- )                                             
14  The inverse of ALSO, removes the most recently referenced      
15  vocabulary from the search order.                              


Screen 23 not modified     
 0 \ ROOT  ONLY  SEAL                             17:04JWB11/17/85 
 1                                                                 
 2 ROOT  ( --  -- )                                                
 3        A small vocabulary for controlling search order.         
 4                                                                 
 5 ONLY  ( --  -- )                                                
 6  Erases the search order and forces the ROOT vocabulary to be   
 7  the first and last.                                            
 8                                                                 
 9 SEAL  ( --  -- )                                                
10  Usage: SEAL FORTH will change the search order such that       
11  only FORTH will be searched. Used for turn-key applications.   
12                                                                 
13                                                                 
14                                                                 
15                                                                 


Screen 24 not modified     
 0 \                                              17:16JWB11/17/85 
 1 ONLY FORTH ALSO DEFINITIONS           CR ORDER                  
 2 VOCABULARY SOUND                      CR .( VOCS ) VOCS  CR     
 3 ROOT DEFINITIONS   : SOUND   SOUND ;  CR ORDER                  
 4 SOUND DEFINITIONS                     CR ORDER      HEX         
 5                                                                 
 6 \  PC!  ( byte  n   --  )  Output byte to port number n.        
 7 \  PC@  ( n        byte )  Input  byte from port number n.      
 8                                                                 
 9 :   S.ON  ( --  -- )      \  Turn speaker on.                   
10         61 PC@                                                  
11         3  OR   61 PC! ;                                        
12                                                                 
13 :   S.OFF ( --  -- )       \ Turn speaker off.                  
14         61 PC@                                                  
15         FFFC AND  61 PC! ; DECIMAL                              


Screen 25 not modified     
 0 \ TONE                                         17:09JWB11/17/85 
 1                                                                 
 2                                                                 
 3 : TONE  ( freq  -- )       \ Make tone of specified frequency.  
 4     21 MAX                 \ Lowest frequency.                  
 5     1.190000  ROT          \ Get divisor for timer.             
 6     MU/MOD                 \ 16bit.rem   32bit.quot             
 7     DROP NIP  [ HEX ]      \ Keep 16-bit quotient only.         
 8     0B6   043 PC!          \ Write to timer mode register.      
 9     100  /MOD SWAP         \ Split into hi and low byte.        
10     42 PC! 42 PC!          \ Store low and high byte in timer.  
11       S.ON ;  DECIMAL      \ turn speaker on.                   
12                                                                 
13                                                                 
14                                                                 
15                                                                 


Screen 26 not modified     
 0 \ SCALE                                        17:30JWB11/17/85 
 1                                                                 
 2 : C 131 TONE ;                                                  
 3 : D 147 TONE ;                                                  
 4 : E 165 TONE ;                                                  
 5 : F 175 TONE ;                                                  
 6 : G 196 TONE ;                                                  
 7 : A 220 TONE ;                                                  
 8 : B 247 TONE ;                                                  
 9 : CC 262 TONE ;                                                 
10                                                                 
11 : BEAT  20000 0 DO LOOP ;                                       
12                                                                 
13 : SCALE  C BEAT D BEAT E BEAT F BEAT G BEAT                     
14          A BEAT B BEAT CC BEAT BEAT BEAT S.OFF ;                
15                                                                 


Screen 27 not modified     
 0 \  Recursive Factorial Function.               21:34JWB11/18/85 
 1                                                                 
 2 : FACTORIAL   ( n  n! )                                         
 3   CR ." entering factorial" .S                                  
 4   DUP 0> IF    DUP 1-  [ REVEAL ] FACTORIAL [ HIDE ]   *        
 5          ELSE  DROP 1                                           
 6          THEN  CR ." leaving  factorial" .S ;    EXIT           
 7                                                                 
 8 \ RECURSIVE    Allow current definition to be self referencing. 
 9                                                                 
10 : FACTORIAL   ( n  n! ) RECURSIVE                               
11   CR ." entering factorial" .S                                  
12   DUP 0> IF    DUP 1-  FACTORIAL  *                             
13          ELSE  DROP 1                                           
14          THEN  CR ." leaving  factorial" .S ;                   
15                                                                 


Screen 28 not modified     
 0 \                                              22:53JWB11/14/85 
 1 : 2**   ( n   2**n )  RECURSIVE                                 
 2   CR ." entering" .S                                            
 3   DUP 0> IF   1-  2**  2*                                       
 4          ELSE DROP 1                                            
 5          THEN  CR ." leaving " .S ;                             
 6                                                                 
 7 : FIBONACCI ( n   fib )  RECURSIVE                              
 8   CR  ." entering" .S     DUP 0< ABORT" invalid argument"       
 9   DUP 1 >                                                       
10   IF    DUP  1-  FIBONACCI                                      
11         SWAP 2-  FIBONACCI  +                                   
12   THEN  CR ." leaving " .S ;                                    
13                                                                 
14 \ : MYSELF   LAST @ NAME>  ,  ;  IMMEDIATE                      
15 \ : RECURSE  LAST @ NAME>  ,  ;  IMMEDIATE                      


Screen 29 not modified     
 0 \ Stack Bubble Sort                            12:42JWB02/28/86 
 1                                                                 
 2 \ Recursive bubble sort                                         
 3 : BUBBLE  ( n n n ...  m m m ...  one pass )  RECURSIVE         
 4         CR  ." ENTERING " .S                                    
 5         DEPTH 1 >                                               
 6         IF   2DUP  <  IF SWAP THEN                              
 7              >R   BUBBLE   R>                                   
 8         THEN                                                    
 9         CR  ." LEAVING "  .S ;                                  
10                                                                 
11 : SORT ( n n n n ...    m m m m ... sorted )                    
12         DEPTH 1 > IF                                            
13         DEPTH 1-  0 DO  BUBBLE  LOOP  THEN ;                    
14                                                                 
15                                                                 


Screen 30 not modified     
 0 \ Stack Bubble Sort                            12:42JWB02/28/86 
 1   VARIABLE DIRECTION                                            
 2 : ASCENDING  DIRECTION ON  ; : DESCENDING  DIRECTION OFF ;      
 3 : COMPARE  DIRECTION @ IF  < ELSE > THEN ;                      
 4                                                                 
 5 : BUBBLE  ( n n n ...  m m m ...  one pass )  RECURSIVE         
 6         CR  ." ENTERING " .S                                    
 7         DEPTH 1 >                                               
 8         IF   2DUP COMPARE IF SWAP THEN                          
 9              >R   BUBBLE   R>                                   
10         THEN                                                    
11         CR  ." LEAVING "  .S ;                                  
12                                                                 
13 : SORT ( n n n n ...    m m m m ... sorted )                    
14         DEPTH 1 > IF                                            
15         DEPTH 1-  0 DO  BUBBLE  LOOP  THEN ;                    


Screen 31 not modified     
 0 \ Multi-way branching IF .. ELSE .. THEN       14:58JWB03/04/86 
 1 : TIS  ( --  -- ) CR  ."  THIS  IS  DIGIT  NUMBER  "  ;         
 2 : TEST1  ( --  -- )                                             
 3     BEGIN  KEY  DUP 13 <> WHILE                                 
 4       ASCII 1  OVER = IF DROP  TIS  ." ONE "     ELSE           
 5       ASCII 2  OVER = IF DROP  TIS  ." TWO "     ELSE           
 6       ASCII 3  OVER = IF DROP  TIS  ." THREE "   ELSE           
 7       ASCII 4  OVER = IF DROP  TIS  ." FOUR "    ELSE           
 8       ASCII 5  OVER = IF DROP  TIS  ." FIVE "    ELSE           
 9       ASCII 6  OVER = IF DROP  TIS  ." SIX "     ELSE           
10       ASCII 7  OVER = IF DROP  TIS  ." SEVEN "   ELSE           
11       ASCII 8  OVER = IF DROP  TIS  ." EIGHT "   ELSE           
12       ASCII 9  OVER = IF DROP  TIS  ." NINE "    ELSE           
13       ASCII 0  OVER = IF DROP  TIS  ." ZERO "    ELSE           
14      BEEP DROP  THEN  THEN  THEN  THEN  THEN                    
15                 THEN  THEN  THEN  THEN  THEN  REPEAT DROP ;     

projects/sample8.blk.txt · Zuletzt geändert: 2013-06-06 21:27 (Externe Bearbeitung)