Forth-eV Wiki

Benutzer-Werkzeuge

Webseiten-Werkzeuge

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

Unterschiede

Hier werden die Unterschiede zwischen zwei Versionen angezeigt.

Link zu dieser Vergleichsansicht

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