add .R PAD U.R U> UNUSED WITHIN

optimize
Clyne 11 months ago
parent 6b1955a69e
commit 5ee8f7e01d
Signed by: clyne
GPG Key ID: 3267C8EBF3F9AFC7

@ -15,7 +15,7 @@ Alee Forth uses the [Forth 2012 test suite](https://github.com/gerryjackson/fort
**Missing** core extension words: **Missing** core extension words:
``` ```
.R HOLDS PAD PARSE PARSE-NAME REFILL RESTORE-INPUT S\" SAVE-INPUT SOURCE-ID U.R U> UNUSED WITHIN [COMPILE] PARSE PARSE-NAME REFILL RESTORE-INPUT S\" SAVE-INPUT SOURCE-ID [COMPILE]
``` ```
## Building ## Building

@ -90,13 +90,8 @@ void user_sys(State& state)
state.dict.read(Dictionary::Base)); state.dict.read(Dictionary::Base));
std::cout << buf << ' '; std::cout << buf << ' ';
break; break;
case 1: // u. case 1: // unused
{ state.push(static_cast<Addr>(state.dict.capacity() - state.dict.here()));
Addr ucell = static_cast<Addr>(state.pop());
std::to_chars(buf, buf + sizeof(buf), ucell,
state.dict.read(Dictionary::Base));
std::cout << buf << ' ';
}
break; break;
case 2: // emit case 2: // emit
std::cout << static_cast<char>(state.pop()); std::cout << static_cast<char>(state.pop());

@ -90,13 +90,8 @@ void user_sys(State& state)
state.dict.read(Dictionary::Base)); state.dict.read(Dictionary::Base));
std::cout << buf << ' '; std::cout << buf << ' ';
break; break;
case 1: // u. case 1: // unused
{ state.push(static_cast<Addr>(state.dict.capacity() - state.dict.here()));
Addr ucell = static_cast<Addr>(state.pop());
std::to_chars(buf, buf + sizeof(buf), ucell,
state.dict.read(Dictionary::Base));
std::cout << buf << ' ';
}
break; break;
case 2: // emit case 2: // emit
std::cout << static_cast<char>(state.pop()); std::cout << static_cast<char>(state.pop());

@ -1,6 +1,8 @@
-1 constant true -1 constant true
0 constant false 0 constant false
: unused 1 sys ;
: hex 16 base ! ; : hex 16 base ! ;
: nip swap drop ; : nip swap drop ;
@ -8,6 +10,9 @@
: 0> 0 > ; : 0> 0 > ;
: 0<> 0= 0= ; : 0<> 0= 0= ;
: u> swap u< ;
: within over - >r - r> swap u> ;
: 2r@ ['] r> , ['] r> , ['] 2dup , ['] >r , ['] >r , ['] swap , ; imm : 2r@ ['] r> , ['] r> , ['] 2dup , ['] >r , ['] >r , ['] swap , ; imm
@ -16,7 +21,7 @@
begin dup c@ while 0 over c! char+ repeat drop ; imm begin dup c@ while 0 over c! char+ repeat drop ; imm
: again postpone repeat ; imm : again postpone repeat ; imm
: ?do ['] 2dup , ['] _lit , here 0 , ['] >r , ['] = , postpone if : ?do ['] 2dup , ['] _lit , here 0 , ['] >r , ['] = , postpone if
['] 2drop , postpone 2r> ['] drop , ['] >r , ['] exit , ['] 2drop , postpone 2r> ['] drop , ['] >r , ['] leave ,
postpone then postpone 2>r here ; imm postpone then postpone 2>r here ; imm
: .( [char] ) word count type ; imm : .( [char] ) word count type ; imm
@ -36,7 +41,7 @@
: is state @ if postpone ['] postpone defer! else ' defer! then ; imm : is state @ if postpone ['] postpone defer! else ' defer! then ; imm
: action-of state @ if postpone ['] postpone defer@ else ' defer@ then ; imm : action-of state @ if postpone ['] postpone defer@ else ' defer@ then ; imm
: erase begin dup 0 > while swap 0 over ! 1+ swap 1- repeat ; : erase 0 fill ;
: roll dup if swap >r 1- recurse r> swap exit then drop ; : roll dup if swap >r 1- recurse r> swap exit then drop ;
: marker create _latest @ , here , does> : marker create _latest @ , here , does>
@ -49,3 +54,13 @@
: endcase swap 0 do dup @ swap here swap ! loop drop ['] drop , ; imm : endcase swap 0 do dup @ swap here swap ! loop drop ['] drop , ; imm
: holds begin dup while 1- 2dup + c@ hold repeat 2drop ; : holds begin dup while 1- 2dup + c@ hold repeat 2drop ;
: .r over dup 0< if 1 else 0 then
begin 1+ swap base @ / dup 0<> while swap repeat
drop - spaces . ;
: u.r over 0 begin 1+ swap 0 base @ _/ dup 0<> while swap repeat
drop - spaces u. ;
( WORD uses HERE and must be at least 33 characters. )
: pad here 50 chars + align ;

@ -8,7 +8,6 @@
: cells 2 * ; : cells 2 * ;
: . 0 sys ; : . 0 sys ;
: u. 1 sys ;
: emit 2 sys ; : emit 2 sys ;
: 1+ 1 + ; : 1+ 1 + ;
@ -229,3 +228,5 @@
if 7 + then 48 + hold ; if 7 + then 48 + hold ;
: #s begin # 2dup or 0= until ; : #s begin # 2dup or 0= until ;
: sign 0< if [char] - hold then ; : sign 0< if [char] - hold then ;
: u. 0 <# bl hold #s #> type ;

@ -0,0 +1,16 @@
1 constant bit0
2 constant bit1
4 constant bit2
8 constant bit3
16 constant bit4
32 constant bit5
64 constant bit6
128 constant bit7
1 constant port1
2 constant port2
3 constant port3
4 constant port4
5 constant port5
: pindef

@ -0,0 +1,25 @@
: .s depth dup 0 ?do dup i - pick . loop drop ;
: ? @ . ;
: dump hex 0 do i cells over + @ s>d <# # # # # bl hold #> type loop
drop decimal ;
7 cells 80 chars + constant _begin
: words _latest @ begin
dup @ dup 31 &
2 pick cell+ \ lt l len ws
2 pick 6 >> 1023 < if \ lt l len ws
rot 6 >> else \ lt len ws adv
>r cell+ rot drop r> @ then
-rot swap type space \ lt adv
over _begin <> while - repeat 2drop ;
( xt -- caddr u )
: _nameof _latest @ begin \ xt lt
2dup < while \ xt lt
dup @ \ xt lt l
dup 6 >> 1023 < if \ xt lt l
6 >> - else
drop dup cell+ @ - then \ xt lt
repeat nip \ lt
dup @ swap cell+ over 31 & \ l lt len
rot 6 >> 1023 = if swap cell+ swap then ; \ lt len

@ -143,13 +143,13 @@ void printint(DoubleCell n, char *buf)
void user_sys(State& state) void user_sys(State& state)
{ {
switch (state.pop()) { switch (state.pop()) {
case 0: case 0: // .
printint(state.pop(), strbuf); printint(state.pop(), strbuf);
break; break;
case 1: case 1: // unused
printint(static_cast<Addr>(state.pop()), strbuf); state.push(static_cast<Addr>(state.dict.capacity() - state.dict.here()));
break; break;
case 2: case 2: // emit
serput(state.pop()); serput(state.pop());
break; break;
case 3: case 3:

Loading…
Cancel
Save