Benutzer-Werkzeuge

Webseiten-Werkzeuge


projects:sample10.blk

Examples for lecture number ten

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                                                                 
projects/sample10.blk.txt · Zuletzt geändert: 2013-06-06 21:27 (Externe Bearbeitung)