Inline memory words.
This commit is contained in:
@ -14,7 +14,7 @@
|
|||||||
|
|
||||||
( Block Files )
|
( Block Files )
|
||||||
internals definitions
|
internals definitions
|
||||||
: clobber-line ( a -- a' ) dup 63 bl fill 63 + nl over c! 1+ ;
|
: clobber-line ( a -- a' ) dup 63 blank 63 + nl over c! 1+ ;
|
||||||
: clobber ( a -- ) 15 for clobber-line next drop ;
|
: clobber ( a -- ) 15 for clobber-line next drop ;
|
||||||
0 value block-dirty
|
0 value block-dirty
|
||||||
create block-data 1024 allot
|
create block-data 1024 allot
|
||||||
|
|||||||
@ -183,12 +183,6 @@ variable hld
|
|||||||
: s>z ( a n -- z ) here >r zplace r> ;
|
: s>z ( a n -- z ) here >r zplace r> ;
|
||||||
: z>s ( z -- a n ) 0 over begin dup c@ while 1+ swap 1+ swap repeat drop ;
|
: z>s ( z -- a n ) 0 over begin dup c@ while 1+ swap 1+ swap repeat drop ;
|
||||||
|
|
||||||
( Fill, Move )
|
|
||||||
: cmove ( a a n -- ) for aft >r dup c@ r@ c! 1+ r> 1+ then next 2drop ;
|
|
||||||
: cmove> ( a a n -- ) for aft 2dup swap r@ + c@ swap r@ + c! then next 2drop ;
|
|
||||||
: fill ( a n ch -- ) swap for swap aft 2dup c! 1 + then next 2drop ;
|
|
||||||
: erase ( a n -- ) 0 fill ; : blank ( a n -- ) bl fill ;
|
|
||||||
|
|
||||||
( Better Errors )
|
( Better Errors )
|
||||||
: notfound ( a n n -- )
|
: notfound ( a n n -- )
|
||||||
if cr ." ERROR: " type ." NOT FOUND!" cr -1 throw then ;
|
if cr ." ERROR: " type ." NOT FOUND!" cr -1 throw then ;
|
||||||
|
|||||||
@ -48,3 +48,9 @@
|
|||||||
: 2dup ( a b -- a b a b ) over over ;
|
: 2dup ( a b -- a b a b ) over over ;
|
||||||
: 2@ ( a -- lo hi ) dup @ swap cell+ @ ;
|
: 2@ ( a -- lo hi ) dup @ swap cell+ @ ;
|
||||||
: 2! ( lo hi a -- ) dup >r cell+ ! r> ! ;
|
: 2! ( lo hi a -- ) dup >r cell+ ! r> ! ;
|
||||||
|
|
||||||
|
( Fill, Move )
|
||||||
|
: cmove ( a a n -- ) for aft >r dup c@ r@ c! 1+ r> 1+ then next 2drop ;
|
||||||
|
: cmove> ( a a n -- ) for aft 2dup swap r@ + c@ swap r@ + c! then next 2drop ;
|
||||||
|
: fill ( a n ch -- ) swap for swap aft 2dup c! 1 + then next 2drop ;
|
||||||
|
: erase ( a n -- ) 0 fill ; : blank ( a n -- ) bl fill ;
|
||||||
|
|||||||
@ -44,8 +44,13 @@
|
|||||||
X("cell+", CELLPLUS, tos += sizeof(cell_t)) \
|
X("cell+", CELLPLUS, tos += sizeof(cell_t)) \
|
||||||
X("cells", CELLSTAR, tos *= sizeof(cell_t)) \
|
X("cells", CELLSTAR, tos *= sizeof(cell_t)) \
|
||||||
X("cell/", CELLSLASH, DUP; tos = sizeof(cell_t); DUP; *sp = 1; SSMOD_FUNC; NIP) \
|
X("cell/", CELLSLASH, DUP; tos = sizeof(cell_t); DUP; *sp = 1; SSMOD_FUNC; NIP) \
|
||||||
X("2drop", TWODROP, DROP; DROP) \
|
X("2drop", TWODROP, NIP; DROP) \
|
||||||
X("2dup", TWODUP, DUP; tos = sp[-1]; DUP; tos = sp[-1]) \
|
X("2dup", TWODUP, DUP; tos = sp[-1]; DUP; tos = sp[-1]) \
|
||||||
X("2@", TWOAT, DUP; *sp = ((cell_t *) tos)[1]; tos = *(cell_t *) tos) \
|
X("2@", TWOAT, DUP; *sp = ((cell_t *) tos)[1]; tos = *(cell_t *) tos) \
|
||||||
X("2!", TWOSTORE, DUP; ((cell_t *) tos)[0] = sp[-1]; \
|
X("2!", TWOSTORE, DUP; ((cell_t *) tos)[0] = sp[-1]; \
|
||||||
((cell_t *) tos)[1] = *sp; DROP; DROP; DROP)
|
((cell_t *) tos)[1] = *sp; sp -= 2; DROP) \
|
||||||
|
Y(cmove, memmove((void *) *sp, (void *) sp[-1], tos); sp -= 2; DROP) \
|
||||||
|
X("cmove>", cmove2, memmove((void *) *sp, (void *) sp[-1], tos); sp -= 2; DROP) \
|
||||||
|
Y(fill, memset((void *) sp[-1], tos, *sp); sp -= 2; DROP) \
|
||||||
|
Y(erase, memset((void *) *sp, 0, tos); NIP; DROP) \
|
||||||
|
Y(blank, memset((void *) *sp, ' ', tos); NIP; DROP)
|
||||||
|
|||||||
@ -55,11 +55,6 @@ e: check-boot
|
|||||||
out: tib
|
out: tib
|
||||||
out: accept
|
out: accept
|
||||||
out: echo
|
out: echo
|
||||||
out: blank
|
|
||||||
out: erase
|
|
||||||
out: fill
|
|
||||||
out: cmove>
|
|
||||||
out: cmove
|
|
||||||
out: z>s
|
out: z>s
|
||||||
out: s>z
|
out: s>z
|
||||||
out: r~
|
out: r~
|
||||||
@ -175,6 +170,12 @@ e: check-boot
|
|||||||
;e
|
;e
|
||||||
|
|
||||||
e: check-extra-opcodes
|
e: check-extra-opcodes
|
||||||
|
out: blank
|
||||||
|
out: erase
|
||||||
|
out: fill
|
||||||
|
out: cmove>
|
||||||
|
out: cmove
|
||||||
|
|
||||||
out: 2!
|
out: 2!
|
||||||
out: 2@
|
out: 2@
|
||||||
out: 2dup
|
out: 2dup
|
||||||
|
|||||||
@ -37,7 +37,7 @@ sockaddr httpd-port sockaddr client variable client-len
|
|||||||
sockfd client client-len sockaccept
|
sockfd client client-len sockaccept
|
||||||
dup 0< if drop 0 exit then
|
dup 0< if drop 0 exit then
|
||||||
to clientfd
|
to clientfd
|
||||||
chunk chunk-size 0 fill
|
chunk chunk-size erase
|
||||||
chunk chunk-size clientfd read-file throw to chunk-filled
|
chunk chunk-size clientfd read-file throw to chunk-filled
|
||||||
-1
|
-1
|
||||||
;
|
;
|
||||||
|
|||||||
Reference in New Issue
Block a user