=== 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