Forth-eV Wiki

Benutzer-Werkzeuge

Webseiten-Werkzeuge

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

Unterschiede

Hier werden die Unterschiede zwischen zwei Versionen angezeigt.

Link zu dieser Vergleichsansicht

papierkorb:sample10.blk [2025-08-16 17:50] – ↷ Seite von projects:sample10.blk nach papierkorb:sample10.blk verschoben mkapapierkorb:sample10.blk [Unbekanntes Datum] (aktuell) – gelöscht - Externe Bearbeitung (Unbekanntes Datum) 127.0.0.1
Zeile 1: Zeile 1:
-=== Examples for lecture number ten  ===  
-<code> 
-Screen 0 not modified      
- 0 \ Examples for lecture number ten.             17:25JWB11/29/85  
- 1 \ Last change:   Screen  037                   11:28jwb11/22/87  
- 2                                                                  
- 3                                                                  
- 4         Virtual Memory.                                          
- 5                                                                  
- 6                                                                  
- 7                                                                  
- 8                                                                  
- 9                                                                  
-10                                                                  
-11                                                                  
-12                                                                  
-13                                                                  
-14                                                                  
-15                                                                  
  
- 
-Screen 1 not modified      
- 0 \ Load screen                                  14:26JWB03/12/86  
- 1  ONLY FORTH DEFINITIONS ALSO                                     
- 2         7 VIEWS   B:LEDIT.BLK                                    
- 3         7 VIEW# ! FROM B:LEDIT.BLK  OK NEW-EXP                   
- 4         8 VIEWS   HELP.BLK                                       
- 5         8 VIEW# ! FROM HELP.BLK   OK                             
- 6         9 VIEWS   B:SAMPLE10.BLK                                 
- 7         9 VIEW# !                                                
- 8 ONLY FORTH DEFINITIONS ALSO                                      
- 9 : ESC[   27 EMIT ASCII [ EMIT ;                                  
-10 : CLS    ESC[ ." 2J" ;                                           
-11 : BRIGHT ESC[ ." 1m" ;                                           
-12 : NORMAL ESC[ ." 0m" ;                                           
-13 : BLUE   ESC[ ." 44m" ;                                          
-14 ONLY EDITOR ALSO FORTH DEFINITIONS                               
-15                                                                  
- 
- 
-Screen 2 not modified      
- 0 \ Execution vectors or defered words.          17:34JWB11/29/85  
- 1 \  EXECUTE  ( cfa    -- ) Execute the word whose cfa is on stack 
- 2 : F.HELLO  ." Hello,  I speak FORTH " ;                          
- 3   VARIABLE  INTRO                                                
- 4 : GREETING  INTRO @ EXECUTE ;                                    
- 5                                                                  
- 6 \  PERFORM  ( adr   -- )   Equivalent to   @ EXECUTE             
- 7 : GREETING1  INTRO  PERFORM  ;                                   
- 8                                                                  
- 9 \  IS {word}  ( adr  -- )  Store adr  in pfa of  {word}          
-10 \  Sample usage:   ' F.HELLO IS INTRO   etc                      
-11 : GREETING2  NOOP  ;                                             
-12                                                                  
-13 \ DEFER {word}  ( --  -- )  Like a variable except that it       
-14 \               fetches its contents and executes them.          
-15 DEFER  GREETING3                                                 
- 
- 
-Screen 3 not modified      
- 0 \ Extending the FORTH compiler with ...        17:43JWB11/29/85  
- 1 \ Template for creating new compilers:                           
- 2 \ : {compiler name}                                              
- 3 \       CREATE  {compile time code}                              
- 4 \       DOES>   {run time code}  ;                               
- 5 \ At runtime the pfa of the created word is put on the stack.    
- 6                                                                  
- 7   VARIABLE STORE?                                                
- 8 : =>    ( --  -- )  STORE? ON ;   \ Set STORE? to true.          
- 9                                                                  
-10 : SMART-VARIABLE                                                 
-11         CREATE  0  ,            \ Compile time action.           
-12         DOES>   STORE? @  STORE? OFF                             
-13                 IF    !  ELSE  @ THEN  ;                         
-14                                                                  
-15                                                                  
- 
- 
-Screen 4 not modified      
- 0 \ VECTOR                                       14:28JWB03/12/86  
- 1 \ Create a one dimensional vector n storage cells                
- 2 \ Usage:         VECTOR  {name}   ( n     -- )                   
- 3 \ Later:         {name}           ( index  adr )                 
- 4 : COMPILE-VECTOR                                                 
- 5         DUP ,                 \ Compile n, maximum subscript.    
- 6         0 DO 0 , LOOP   ;     \ Initialize vector to zeros.      
- 7 : RUN-VECTOR     ( index pfa   adr )                             
- 8         TUCK @  OVER           \ pfa index n index               
- 9         <= OVER 0< OR          \ pfa index flag                  
-10         ABORT" Subscript out of range."  \ Error message         
-11         1+  2* + ;             \ Compute address of ith element. 
-12 : VECTOR   ( n  -- )                                             
-13         DUP 1 < OVER 256 > OR  ABORT" Dimension out of range."   
-14         CREATE  COMPILE-VECTOR                                   
-15         DOES>   RUN-VECTOR ;                                     
- 
- 
-Screen 5 not modified      
- 0 \  Magic Variables.                            17:30JWB11/29/85  
- 1    VARIABLE  MESSAGE                                             
- 2 : FETCH    0 MESSAGE ! ;                                         
- 3 : =>       1 MESSAGE ! ;                                         
- 4 : DISPLAY  2 MESSAGE ! ;                                         
- 5 : SOUND    3 MESSAGE ! ;                                         
- 6 : PLOT     4 MESSAGE ! ;                                         
- 7 : CLEAR    5 MESSAGE ! ;                                         
- 8 : INC      6 MESSAGE ! ;                                         
- 9 : DEC      7 MESSAGE ! ;                                         
-10                                                                  
-11 : WAIT     5000 0 DO I DROP LOOP ;                               
-12                                                                  
-13 :  COMPILE-MAGIC-VARIABLE  ( --  -- )                            
-14         0 ,  ;                                                   
-15                                                                  
- 
- 
-Screen 6 not modified      
- 0 \ Magic Variables                              17:30JWB11/29/85  
- 1 ONLY EDITOR ALSO FORTH ALSO                                      
- 2 :  RUN-MAGIC-VARIABLE   ( val|--  val|-- )                       
- 3         MESSAGE @  MESSAGE OFF                                   
- 4         CASE                                                     
- 5         0 OF  @         ENDOF                                    
- 6         1 OF  !         ENDOF                                    
- 7         2 OF  @ .       ENDOF                                    
- 8         3 OF     @ 0 ?DO BEEP    WAIT  LOOP  ENDOF               
- 9         5 OF  OFF       ENDOF                                    
-10         6 OF  1 SWAP +! ENDOF                                    
-11         7 OF  -1 SWAP +! ENDOF                                   
-12         4 OF  CR @ 0 ?DO ASCII * EMIT  LOOP  ENDOF ENDCASE ;     
-13 : MAGIC-VARIABLE                                                 
-14         CREATE  COMPILE-MAGIC-VARIABLE                           
-15         DOES>   RUN-MAGIC-VARIABLE ;                             
- 
- 
-Screen 7 not modified      
- 0 \ Visible Arrays.                              21:59jwb11/29/85  
- 1 ONLY EDITOR ALSO FORTH ALSO                                      
- 2   VARIABLE  STORE?                                               
- 3   VARIABLE  SPEED    SPEED OFF                                   
- 4                                                                  
- 5 : WAIT   SPEED @  0 ?DO I DROP LOOP ;                            
- 6                                                                  
- 7 : ->     STORE? ON  ;   : => -> ;                                
- 8                                                                  
- 9 : DISPLAY       ( val  index   -- )                              
-10         1- 8 /MOD SWAP 8 *  SWAP AT  6 .R  WAIT ;                
-11                                                                  
-12 : RDISPLAY      ( val  index   -- )                              
-13         ['] VEMIT IS EMIT                                        
-14         2DUP 31 ATRIB !  DISPLAY 15 ATRIB ! DISPLAY              
-15         ['] (EMIT) IS EMIT ;                                     
- 
- 
-Screen 8 not modified      
- 0 \ The visible array.                           21:13jwb11/29/85  
- 1 : COMPILE-VISIBLE-ARRAY                                          
- 2         1+ 0 ?DO 0 , LOOP ;                                      
- 3                                                                  
- 4 : RUN-VISIBLE-ARRAY                                              
- 5         STORE? @  STORE? OFF                                     
- 6         IF   >R 2DUP 2* R> + ! RDISPLAY                          
- 7         ELSE SWAP 2* + @                                         
- 8         THEN ;                                                   
- 9                                                                  
-10 : VISIBLE-ARRAY                                                  
-11         CREATE COMPILE-VISIBLE-ARRAY                             
-12         DOES>  RUN-VISIBLE-ARRAY     ;                           
-13                                                                  
-14                                                                  
-15                                                                  
- 
- 
-Screen 9 not modified      
- 0 \ Variables and Random number generator        17:18JWB12/02/85  
- 1   VARIABLE  SEED        78765    SEED !  \ Random # seed         
- 2   VARIABLE  N-MAX       \ Array size.                            
- 3   VARIABLE  INCREMENT   \ Increment for insertion sort pass.     
- 4   VARIABLE  KEYTEMP     \ Temporary storage for current key.     
- 5 160 VISIBLE-ARRAY KEYS                                           
- 6 \ Make top of stack an odd number.                               
- 7 : ODD     ( n  odd )  DUP 1 AND + 1- ;                           
- 8 : (RND)   SEED @ 259 * 3 + 32757 AND DUP SEED ! ;                
- 9 :  RND    ( n   r ) (RND) 32767 */ ;                             
-10 \ Set up n random keys.                                          
-11 : SET-UP ( n  -- )                                               
-12         8 MAX 160 MIN N-MAX ! CLEARSCREEN                        
-13         N-MAX @ 1+ 1 DO 1000 RND I -> KEYS LOOP CR ;             
-14 : SET-EX  CLEARSCREEN 7 13 6 11 19 4 14 8 13 10                  
-15           10 N-MAX ! 11 1 DO -> I KEYS LOOP CR CR ;              
- 
- 
-Screen 10 not modified      
- 0 \  Shell Sort.                                 17:41JWB12/02/85  
- 1 : SHELL-SORT ( -- -- ) \ Ref 8086 BOOK by Rector & Alexy Sec 2-4 
- 2   N-MAX @ INCREMENT !                      \ Increment to n      
- 3   BEGIN INCREMENT @ 2/ ( ODD) DUP INCREMENT ! 0> \ Repeat till 0 
- 4   WHILE N-MAX @ 1+ INCREMENT @ 1+          \ I=subsort counter   
- 5   2 22 AT ." PASS INCREMENT =" INCREMENT ?  \ Document progress  
- 6     DO I KEYS  KEYTEMP !                 \ keytemp = key(i)      
- 7        I INCREMENT @ -                   \ index is on stack     
- 8        BEGIN DUP KEYS KEYTEMP @          \ key(index) < keytemp  
- 9              < NOT OVER 0> AND           \ and index > 0         
-10        WHILE DUP KEYS OVER INCREMENT @ + \ key(index+increment)  
-11              -> KEYS  INCREMENT @ -      \ = key(index)          
-12        REPEAT KEYTEMP @ SWAP             \ key(index+increment)  
-13        INCREMENT @ + -> KEYS             \ = keytemp             
-14     LOOP  KEY DROP      \  Note: I sort the keys, not records    
-15   REPEAT  CR  CR  ;     \  as in Rector and Alexy                
- 
- 
-Screen 11 not modified      
- 0 \ Virtual memory.                              15:47JWB11/29/85  
- 1 F83 virtual memory operates as follows:                          
- 2 The current file open on the mass storage unit is divided into   
- 3 consecutive blocks.  The block is the basic unit of storage.     
- 4 Each block holds 1024 bytes.  Blocks are numbered consecutively  
- 5 starting with block 0 at the beginning of the file.  On the      
- 6 mass storage device (disk or hard disk) the only limit to the    
- 7 number of blocks in a file is the capacity of the mass storage   
- 8 device.                                                          
- 9 In the ram memory of the computer there is an area reserved for  
-10 disk buffers.  One disk buffer will hold 1024 bytes.  In F83     
-11 there are 4 disk buffers.   Thus in the computers ram memory     
-12 there can only be 4 blocks at any one time.  FORTH's virtual     
-13 memory system keeps track of which blocks are in ram memory and  
-14 which block are on the mass storage device. This house keeping   
-15 is transparent to the user.                                      
- 
- 
-Screen 12 not modified      
- 0 \ BLOCK                                        16:03JWB11/29/85  
- 1   BLOCK   ( n   adr )   Given the block number n, BLOCK returns  
- 2         the in address, adr, of the assigned block buffer. The   
- 3         buffer address, adr, is the location of the first data   
- 4         storage cell of the buffer, which consists of 1024 bytes 
- 5   Notes: i) If block n is not already in one of the 4 buffers it 
- 6             will be transfered from mass storage to an assigned  
- 7             block buffer.                                        
- 8         ii) A block may not be assigned to more than one buffer. 
- 9        iii) If n isn't a valid block # an error condition exists 
-10         iv) If the block previously occupying the assigned       
-11             buffer has been modified (marked as UPDATEd) it will 
-12             be transfered back to mass storage before block n    
-13             is moved from mass storage into its assigned buffer. 
-14          v) The contents of a block buffer may not be changed    
-15             unless the change may be transfered to mass storage. 
- 
- 
-Screen 13 not modified      
- 0   BLOCK EXAMPLESE FOR ALL                                        
- 1 \  Try the following:                                            
- 2 \  13 BLOCK  100  DUMP                                           
- 3 \  13 BLOCK  64   TYPE                                           
- 4 \  CREATE NAME  ," BLOCK EXAMPLES"                               
- 5 \  NAME COUNT  13 BLOCK 2+ SWAP CMOVE                            
- 6 \  13 LIST  14 LIST  15 LIST 16 LIST 17 LIST                     
- 7 \  13 LIST                                                       
- 8                                                                  
- 9 \  UPDATE  ( --  -- )  Mark most recently referenced block as    
-10 \       modified.  Then if its block buffer is required it will  
-11 \       automatically be transfered back to mass storage.        
-12                                                                  
-13 \  Repeat above except type UPDATE after the CMOVE               
-14                                                                  
-15 \ Remind me to tell you about the editor bug.                    
- 
- 
-Screen 14 not modified      
- 0 \ BUFFER                                       16:50JWB11/29/85  
- 1 \ BUFFER  ( n  adr )  Assign block n the buffer storage area at  
- 2 \       adr .  The function is the same as for BLOCK  except     
- 3 \       that the contents of the data storage area are undefined 
- 4 \       That is . . .  The buffer is assigned only and the       
- 5 \       if the block is not already in memory its contents might 
- 6 \       not be transfered from mass storage.  Not often used.    
- 7                                                                  
- 8 \ EMPTY-BUFFERS  ( --  -- ) Erase all data in block buffers,     
- 9 \       initialize buffer pointers and mark buffers as empty.    
-10                                                                  
-11 \ SAVE-BUFFERS   ( --  -- ) Transfer all buffers marked as       
-12 \       updated to mass storage and then mark them as unmodified 
-13                                                                  
-14 \ FLUSH          ( --  -- ) Same effect as SAVE-BUFFERS followed 
-15 \       by EMPTY-BUFFERS .                                       
- 
- 
-Screen 15 not modified      
- 0 \ .BUF                                         22:43JWB11/30/85  
- 1 \ Each entry in the buffer-pointer array uses 8 bytes.  See next 
- 2 \ screen and use the word below to study them.                   
- 3 : .BUF  ( --  -- )                                               
- 4      BASE @  HEX                                                 
- 5      CR ." Buffer# Pointer  Block #  fcb     Data  Update "      
- 6      #BUFFERS 1+ 0 DO                                            
- 7      CR I 6 .R                          \ Print buffer#          
- 8         I BUFFER# 8 U.R                 \ Pointer address        
- 9         I BUFFER# @ 4  .R   DECIMAL     \ Block number           
-10         I BUFFER# @ 4  .R   HEX         \ Block number           
-11         I BUFFER# 2+ @ 8 U.R            \ File control block adr 
-12         I BUFFER# 4 + @ 8 U.R           \ Block buffer address   
-13         I BUFFER# 6 + @ 8 U.R           \ Update flag            
-14         I BUFFER# 4 + @ 20 4 SPACES TYPE                         
-15         LOOP BASE ! CR CR ;                                      
- 
- 
-Screen 16 not modified      
- 0 \ Buffer pointer array fields.                 22:46JWB11/30/85  
- 1 Buffer #                                                         
- 2 Buffer 0 is the transient buffer                                 
- 3 Buffer 1 is the most recently accessed buffer.                   
- 4  . . .                                                           
- 5 Buffer 4 is the least recently accessed buffer.                  
- 6                                                                  
- 7 Pointer is address in buffer pointer array.                      
- 8 Block # is the screen number or block number.                    
- 9 fcb     is the address of the file control block.                
-10 Data    is the address of the 1024 byte data storage area.       
-11 Update  is the current state of the update flag.                 
-12         values of 0 or 1 mean the buffer is unmodified.          
-13         value  of -1 or FFFF hex mean buffer has been UPDATEd.   
-14 Note:   If block numbers are the same and fcb's are different    
-15         system regards blocks as different.                      
- 
- 
-Screen 17 not modified      
- 0 \  Virtual array.                              23:04JWB11/30/85  
- 1   VARIABLE STORE?                                                
- 2 : -> STORE? ON  ;                                                
- 3 \ n is the block number where the virtual array data is stored.  
- 4 : VIRTUAL-VECTOR  ( n  -- )                                      
- 5         CREATE ,                                                 
- 6         DOES> STORE? @ >R STORE? OFF                             
- 7               OVER 510 > ABORT" Virtual subscript out of range." 
- 8               @ BLOCK SWAP 2* + R>                               
- 9               IF    ! UPDATE                                     
-10               ELSE  @                                            
-11               THEN  ;                                            
-12                                                                  
-13 20 VIRTUAL-VECTOR VV     21 VIRTUAL-VECTOR WW                    
-14 22 VIRTUAL-VECTOR XX     23 VIRTUAL-VECTOR YY                    
-15 24 VIRTUAL-VECTOR ZZ                                             
- 
- 
-Screen 18 not modified      
- 0 \  TEST1                                       23:18JWB11/30/85  
- 1                                                                  
- 2                                                                  
- 3 : TEST1                                                          
- 4          4 0 DO  1000 RND -> I VV  .BUF                          
- 5                  1000 RND -> I WW  .BUF                          
- 6                  1000 RND -> I XX  .BUF                          
- 7                  1000 RND -> I YY  .BUF                          
- 8                  1000 RND -> I ZZ  .BUF  KEY DROP                
- 9           LOOP  ;                                                
-10                                                                  
-11                                                                  
-12 \ >TYPE        Moves string to PAD before typing it.             
-13                                                                  
-14                                                                  
-15                                                                  
- 
-</code> 
papierkorb/sample10.blk.1755359401.txt.gz · Zuletzt geändert: 2025-08-16 17:50 von mka