mirror of
https://github.com/nineties/planckforth
synced 2025-01-14 08:01:27 +01:00
Add cmove, string and string,
This commit is contained in:
parent
70ddb49017
commit
daef12b363
1 changed files with 39 additions and 3 deletions
42
bootstrap.fs
42
bootstrap.fs
|
@ -1096,6 +1096,40 @@ decimal \ set default to decimal
|
||||||
|
|
||||||
( === String === )
|
( === String === )
|
||||||
|
|
||||||
|
\ ( c-from c-to u -- )
|
||||||
|
\ Copy u bytes from c-from to c-to.
|
||||||
|
\ The memory regions must not be overlapped.
|
||||||
|
: cmove
|
||||||
|
begin dup 0> while
|
||||||
|
1- >r \ decrement u, save
|
||||||
|
over c@
|
||||||
|
over c! \ copy character
|
||||||
|
1+ >r \ increment c-to, save
|
||||||
|
1+ \ increment c-from
|
||||||
|
r> r>
|
||||||
|
repeat
|
||||||
|
drop drop drop
|
||||||
|
;
|
||||||
|
|
||||||
|
\ we already have cmove,
|
||||||
|
|
||||||
|
\ ( a-addr -- c-addr u )
|
||||||
|
\ Load address of length of a string from length-prefixed string
|
||||||
|
\ | length (1cell) | characters ... |
|
||||||
|
: string dup @ swap cell+ swap ;
|
||||||
|
|
||||||
|
\ ( c-addr u a-addr -- )
|
||||||
|
\ Store length-prefixed string to given address
|
||||||
|
: copy-string
|
||||||
|
2dup ! \ fill length
|
||||||
|
cell+ \ increment addr
|
||||||
|
swap cmove \ copy string
|
||||||
|
;
|
||||||
|
|
||||||
|
\ ( c-addr u -- )
|
||||||
|
\ Allocate memory and store length-prefixed string
|
||||||
|
: string, dup , cmove, ;
|
||||||
|
|
||||||
\ Print string
|
\ Print string
|
||||||
: type ( c-addr u -- )
|
: type ( c-addr u -- )
|
||||||
begin dup 0> while \ while u>0
|
begin dup 0> while \ while u>0
|
||||||
|
@ -1160,14 +1194,16 @@ char 0 char B - constant string-overflow-error \ -18
|
||||||
variable error-list
|
variable error-list
|
||||||
0 error-list !
|
0 error-list !
|
||||||
|
|
||||||
|
: error>next ( a-addr -- a-addr) @ ;
|
||||||
|
: error>message ( a-addr -- c-addr u ) 2 cells + string ;
|
||||||
|
: error>code ( a-addr -- n ) cell+ @ ;
|
||||||
|
|
||||||
: add-error ( n c-addr u -- )
|
: add-error ( n c-addr u -- )
|
||||||
error-list here
|
error-list here
|
||||||
over @ , \ fill link
|
over @ , \ fill link
|
||||||
swap ! \ update error-list
|
swap ! \ update error-list
|
||||||
rot , \ fill error-code
|
rot , \ fill error-code
|
||||||
dup , \ fill length
|
string, \ fill message
|
||||||
cmove, \ fill message
|
|
||||||
align
|
|
||||||
;
|
;
|
||||||
|
|
||||||
decimal
|
decimal
|
||||||
|
|
Loading…
Reference in a new issue