Changeset ff980cb6d9294b1f1ade981ddeed99c34c534c41

Commiter: Charles Childers

Author: Charles Childers

(2010/04/03 21:10) About 2 years ago

start using prefixes in the libraries

Affected files

	fb05358b51adf7ae34f8e167ec0d20584b5223c4		ff980cb6d9294b1f1ade981ddeed99c34c534c41
1	{{	1	: :create ( $- )
2	: keep-here ( $- )	2	here @last , !last ( field: link )
3	( $-$a$ ) here over	3	&.data , ( field: class )
4	( $a$-$an ) getLength	4	here push 0 , ( field: xt )
5	( $an-$an ) dup allot	5	here over getLength ( field: name )
6	( $an- ) copy 0 , ;	6	dup zallot copy 0 ,
7	---reveal---	7	here pop ! ( patch xt field ) ;
8	: :create ( $- )
9	( $-$a - ) here
10	( $-$ - ) last dup @ , !
11	( $-$ - ) ['] .data ,
12	( $-$ -$) here push 0 ,
13	( $- $-$) keep-here
14	( - $- ) here pop ! ;
15	}}

	fb05358b51adf7ae34f8e167ec0d20584b5223c4		ff980cb6d9294b1f1ade981ddeed99c34c534c41
8		8
9	{{	9	{{
10	: .esc ( a- ) 27 emit type ;	10	: .esc ( a- ) 27 emit type ;
11	: esc: ( $- ) create 32 accept tib keepString last @ d->xt ! ['] .esc reclass ;	11	: esc: ( $- ) create 32 accept tib keepString @last d->xt ! &.esc reclass ;
12	---reveal---	12	---reveal---
13	esc: black [30m esc: onBlack [40m	13	esc: black [30m esc: onBlack [40m
14	esc: red [31m esc: onRed [41m	14	esc: red [31m esc: onRed [41m

	fb05358b51adf7ae34f8e167ec0d20584b5223c4		ff980cb6d9294b1f1ade981ddeed99c34c534c41
13	{{	13	{{
14	: type ( a- ) 64 for @+ emit next drop cr ;	14	: type ( a- ) 64 for @+ emit next drop cr ;
15	: .line ( n- ) . 0 (line) type ;	15	: .line ( n- ) . 0 (line) type ;
16	: save ( -n ) blk @ 0 blk ! ;	16	: save ( -n ) @blk 0 !blk ;
17	: restore ( n- ) blk ! ;	17	: restore ( n- ) !blk ;
18	: list ( - ) cr #-blocks @ fori .line blk ++ nexti ;	18	: list ( - ) cr @#-blocks fori .line blk ++ nexti ;
19	---reveal---	19	---reveal---
20	: index ( - ) save list restore ;	20	: index ( - ) save list restore ;
21	}}	21	}}
22		22
23	: load ( n- ) blk @ push s e pop blk ! v ;	23	: load ( n- ) @blk push s e pop !blk v ;
24		24
25	{{	25	{{
26	: range ( h-ahn ) #-blocks @ 512 * ;	26	: range ( h-ahn ) @#-blocks 512 * ;
27	: read ( ha-ha ) 2dup fread drop 1+ ;	27	: read ( ha-ha ) 2dup fread drop 1+ ;
28	: write ( ah-ah ) push dup @ r fwrite drop 1+ pop ;	28	: write ( ah-ah ) push dup @ r fwrite drop 1+ pop ;
29	---reveal---	29	---reveal---
30	: saveBlocks ( - ) offset @ s" blocks.txt" :w fopen range for write next fclose 2drop ;	30	: saveBlocks ( - ) @offset s" blocks.txt" :w fopen range for write next fclose 2drop ;
31	: readBlocks ( - ) s" blocks.txt" :r fopen offset @ range for read next drop fclose drop ;	31	: readBlocks ( - ) s" blocks.txt" :r fopen @offset range for read next drop fclose drop ;
32	}}	32	}}

	fb05358b51adf7ae34f8e167ec0d20584b5223c4		ff980cb6d9294b1f1ade981ddeed99c34c534c41
22	create which 8 zallot	22	create which 8 zallot
23	variable n	23	variable n
24	: task-addr ( n-a ) which + ;	24	: task-addr ( n-a ) which + ;
25	: uncycle? n @ 1 <if 6 ;then n @ 1- ;	25	: uncycle? @n 1 <if 6 ;then @n 1- ;
26	: cycle? n @ 6 >if 0 n ! then n @ dup 1+ n ! ;	26	: cycle? @n 6 >if 0 !n then @n n ++ ;
27	---reveal---	27	---reveal---
28	: stop ( - ) 0 uncycle? task-addr ! ;	28	: stop ( - ) 0 uncycle? task-addr ! ;
29	: >task ( a- ) n @ task-addr ! 1 n +! n @ 6 =if 0 n ! then ;	29	: >task ( a- ) @n task-addr ! n ++ @n 6 =if 0 !n then ;
30	: task: ( - ) here >task ] ;	30	: task: ( - ) here >task ] ;
31	: yield ( - ) cycle? task-addr @ 0; execute ;	31	: yield ( - ) cycle? task-addr @ 0; execute ;
32	: idle ( - ) repeat yield again ;	32	: idle ( - ) repeat yield again ;

	fb05358b51adf7ae34f8e167ec0d20584b5223c4		ff980cb6d9294b1f1ade981ddeed99c34c534c41
9	{	9	{
10	variable n	10	variable n
11	: w ( - )	11	: w ( - )
12	0 n ! last repeat @ 0; dup d->name type 32 emit n ++ again ;	12	0 !n last repeat @ 0; dup d->name type 32 emit n ++ again ;
13	here is words ] w cr n @ . cr ;	13	here is words ] w cr @n . cr ;
14	}	14	}
15		15
16	{{	16	{{
17	variable myclass	17	variable myclass
18	: handle dup d->name over d->class @ myclass @ =if type space else drop then ;	18	: handle dup d->name over d->class @ @myclass =if type space else drop then ;
19	: (words) last swap myclass ! repeat @ handle 0; again ;	19	: (words) last swap !myclass repeat @ handle 0; again ;
20	---reveal---	20	---reveal---
21	: words-of ' .data ` (words) ; immediate	21	: words-of ' .data ` (words) ; immediate
22	}}	22	}}
23		23
24		24
25	: .vocabs ( - ) words-of .vocab ;	25	: .vocabs ( - ) words-of .vocab ;
26	: .words ( - ) words-of .word ;	26	: .words ( - ) words-of .word ;
27	: .macros ( - ) words-of .macro ;	27	: .macros ( - ) words-of .macro ;
28	: .compile-onlys ( - ) words-of .compiler ;	28	: .compile-onlys ( - ) words-of .compiler ;
29	: .primitives ( - ) words-of .primitive ;	29	: .primitives ( - ) words-of .primitive ;
		30	: .datas ( - ) words-of .data ;

	fb05358b51adf7ae34f8e167ec0d20584b5223c4		ff980cb6d9294b1f1ade981ddeed99c34c534c41
13	( ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ )	13	( ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ )
14	{{	14	{{
15	variable op	15	variable op
16	: begin ' op ! ;	16	: begin ' !op ;
17	: end? last @ d->name s" \|" compare ;	17	: end? @last d->name s" \|" compare ;
18	: update dup last @ d->xt ! op @ execute ;	18	: update dup @last d->xt ! @op execute ;
19	: cleanup last @ heap ! drop last @ @ last ! ;	19	: cleanup @last heap ! drop @last @ !last ;
20	---reveal---	20	---reveal---
21	: enum\| begin repeat create end? if cleanup ;then update again ;	21	: enum\| begin repeat create end? if cleanup ;then update again ;
22	}}	22	}}