version 1.106, 2001/09/05 10:18:46
|
version 1.107, 2001/09/05 11:01:27
|
Line 23
|
Line 23
|
[IF] |
[IF] |
|
|
ToDo: |
ToDo: |
Crossdoc destination ./doc/crossdoc.fd makes no sense when |
- Crossdoc destination ./doc/crossdoc.fd makes no sense when |
cross.fs is uses seperately. jaw |
cross.fs is used seperately. jaw |
Do we need this char translation with >address and in branchoffset? |
- Do we need this char translation with >address and in branchoffset? |
(>body also affected) jaw |
(>body also affected) jaw |
Clean up mark> and >resolve stuff jaw |
- MAXU etc. can be done with dlit, |
|
|
[THEN] |
[THEN] |
|
|
Line 690 Variable ppi-temp 0 ppi-temp !
|
Line 690 Variable ppi-temp 0 ppi-temp !
|
POSTPONE ; ppi-temp @ ! 0 ppi-temp ! ; immediate |
POSTPONE ; ppi-temp @ ! 0 ppi-temp ! ; immediate |
|
|
|
|
|
Plugin dlit, ( d -- ) \ compile numerical value the target |
Plugin lit, ( n -- ) |
Plugin lit, ( n -- ) |
Plugin alit, ( n -- ) |
Plugin alit, ( n -- ) |
|
|
Line 1612 T has? relocate H
|
Line 1613 T has? relocate H
|
: A, ( w -- ) >address T here H relon T , H ; |
: A, ( w -- ) >address T here H relon T , H ; |
|
|
|
|
>CROSS |
|
|
|
: tcmove ( source dest len -- ) |
|
\G cmove in target memory |
|
tchar * bounds |
|
?DO dup T c@ H I T c! H 1+ |
|
tchar +LOOP drop ; |
|
|
|
|
|
\ \ Load Assembler |
|
|
|
>TARGET |
|
H also Forth definitions |
|
|
|
\ FIXME: should we include the assembler really in the forth |
|
\ dictionary?!?!?!? This conflicts with the existing assembler |
|
\ of the host forth system!! |
|
[IFDEF] asm-include asm-include [THEN] hex |
|
|
|
previous |
|
|
|
\ \ -------------------- Host/Target copy etc. 29aug01jaw |
\ \ -------------------- Host/Target copy etc. 29aug01jaw |
|
|
|
|
>CROSS |
>CROSS |
|
|
|
: TD! >image DS! ; |
|
: TD@ >image DS@ ; |
|
|
: th-count ( taddr -- host-addr len ) |
: th-count ( taddr -- host-addr len ) |
\G returns host address of target string |
\G returns host address of target string |
assert1( tbyte 1 = ) |
assert1( tbyte 1 = ) |
Line 1661 previous
|
Line 1644 previous
|
: on T -1 swap ! H ; |
: on T -1 swap ! H ; |
: off T 0 swap ! H ; |
: off T 0 swap ! H ; |
|
|
|
: tcmove ( source dest len -- ) |
|
\G cmove in target memory |
|
tchar * bounds |
|
?DO dup T c@ H I T c! H 1+ |
|
tchar +LOOP drop ; |
|
|
|
: td, ( d -- ) |
|
\G Store a host value as one cell into the target |
|
there tcell X allot TD! ; |
|
|
|
\ \ Load Assembler |
|
|
|
>TARGET |
|
H also Forth definitions |
|
|
|
\ FIXME: should we include the assembler really in the forth |
|
\ dictionary?!?!?!? This conflicts with the existing assembler |
|
\ of the host forth system!! |
|
[IFDEF] asm-include asm-include [THEN] hex |
|
|
|
previous |
|
|
|
|
>CROSS |
>CROSS |
|
|
: (cc) T a, H ; ' (cc) plugin-of colon, |
: (cc) T a, H ; ' (cc) plugin-of colon, |
Line 1682 previous
|
Line 1688 previous
|
|
|
>TARGET |
>TARGET |
: compile, ( xt -- ) |
: compile, ( xt -- ) |
dup xt>ghost >ghost-flags <primitive> get-flag |
dup xt>ghost >comp @ EXECUTE ; |
IF prim, ELSE colon, THEN ; |
|
>CROSS |
>CROSS |
|
|
\ resolve structure |
\ resolve structure |
Line 2228 T 2 cells H Value xt>body
|
Line 2233 T 2 cells H Value xt>body
|
[ T e? ec H 0= [IF] ] T here H tcell - reloff [ [THEN] ] |
[ T e? ec H 0= [IF] ] T here H tcell - reloff [ [THEN] ] |
2 fillcfa ; ' (dodoes,) plugin-of dodoes, |
2 fillcfa ; ' (dodoes,) plugin-of dodoes, |
|
|
: (lit,) ( n -- ) compile lit T , H ; ' (lit,) plugin-of lit, |
: (dlit,) ( n -- ) compile lit td, ; ' (dlit,) plugin-of dlit, |
|
|
|
: (lit,) ( n -- ) s>d dlit, ; ' (lit,) plugin-of lit, |
|
|
\ if we dont produce relocatable code alit, defaults to lit, jaw |
\ if we dont produce relocatable code alit, defaults to lit, jaw |
\ this is just for convenience, so we don't have to define alit, |
\ this is just for convenience, so we don't have to define alit, |
Line 2289 Cond: chars ;Cond
|
Line 2296 Cond: chars ;Cond
|
\ !! Known Bug: Special Literals and plug-ins work only correct |
\ !! Known Bug: Special Literals and plug-ins work only correct |
\ on 16 and 32 Bit Targets and 32 Bit Hosts! |
\ on 16 and 32 Bit Targets and 32 Bit Hosts! |
|
|
|
\ This section could be done with dlit, now. But first I need |
|
\ some test code JAW |
|
|
Cond: MAXU |
Cond: MAXU |
tcell 1 cells u> |
tcell 1 cells u> |
IF compile lit tcell 0 ?DO FF T c, H LOOP |
IF compile lit tcell 0 ?DO FF T c, H LOOP |
Line 2537 Cond: DOES>
|
Line 2547 Cond: DOES>
|
\ DO: ;DO 11may93jaw |
\ DO: ;DO 11may93jaw |
\ changed to ?EXIT 10may93jaw |
\ changed to ?EXIT 10may93jaw |
|
|
: DO: ( -- ghost [xt] [colon-sys] ) |
: DO: ( -- do-ghost [xt] [colon-sys] ) |
here ghostheader |
here ghostheader |
:noname postpone gdoes> ( postpone ?EXIT ) ; |
:noname postpone gdoes> ( postpone ?EXIT ) ; |
|
|
: by: ( -- ghost [xt] [colon-sys] ) \ name |
: by: ( -- do-ghost [xt] [colon-sys] ) \ name |
Ghost |
Ghost |
:noname postpone gdoes> ( postpone ?EXIT ) ; |
:noname postpone gdoes> ( postpone ?EXIT ) ; |
|
|
: ;DO ( ghost [xt] [colon-sys] -- addr ) |
: ;DO ( do-ghost [xt] [colon-sys] -- do-ghost ) |
postpone ; ( S addr xt ) |
postpone ; ( S addr xt ) |
over >exec ! ; immediate |
over >exec ! ; immediate |
|
|
: by ( -- addr ) \ Name |
: by ( -- do-ghost ) \ Name |
Ghost >do:ghost @ ; |
Ghost >do:ghost @ ; |
|
|
|
: compile: ( do-ghost -- do-ghost [xt] [colon-sys] ) |
|
\G defines a compile time action for created words |
|
\G by this builder |
|
:noname ; |
|
|
|
: ;compile ( do-ghost [xt] [colon-sys] -- do-ghost ) |
|
postpone ; over >comp ! ; immediate |
|
|
|
|
|
|
>TARGET |
>TARGET |
\ Variables and Constants 05dec92py |
\ Variables and Constants 05dec92py |
|
|