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 von 127.0.0.1