| \ MakeKernal 12dec92py |
\ MakeKernal 12dec92py |
| |
|
| >MINIMAL |
>MINIMAL |
| : makekernal ( targetsize -- targetsize ) |
: makekernel ( targetsize -- targetsize ) |
| bit$ over 1- cell>bit rshift 1+ initmem |
bit$ over 1- cell>bit rshift 1+ initmem |
| image over initmem tdp off ; |
image over initmem tdp off ; |
| |
|
| : align+ ( taddr -- rest ) |
: align+ ( taddr -- rest ) |
| cell tuck 1- and - [ cell 1- ] Literal and ; |
cell tuck 1- and - [ cell 1- ] Literal and ; |
| : cfalign+ ( taddr -- rest ) |
: cfalign+ ( taddr -- rest ) |
| \ see kernal.fs:cfaligned |
\ see kernel.fs:cfaligned |
| float tuck 1- and - [ float 1- ] Literal and ; |
float tuck 1- and - [ float 1- ] Literal and ; |
| |
|
| >TARGET |
>TARGET |
| \ assumes cell alignment granularity (as GNU C) |
\ assumes cell alignment granularity (as GNU C) |
| |
|
| : cfaligned ( taddr1 -- taddr2 ) |
: cfaligned ( taddr1 -- taddr2 ) |
| \ see kernal.fs |
\ see kernel.fs |
| dup cfalign+ + ; |
dup cfalign+ + ; |
| |
|
| >CROSS |
>CROSS |
| source >in @ /string doc-file-id write-line throw |
source >in @ /string doc-file-id write-line throw |
| source >in ! drop ; immediate |
source >in ! drop ; immediate |
| |
|
| Variable to-doc |
Variable to-doc to-doc on |
| |
|
| : cross-doc-entry ( -- ) |
: cross-doc-entry ( -- ) |
| to-doc @ tlast @ 0<> and \ not an anonymous (i.e. noname) header |
to-doc @ tlast @ 0<> and \ not an anonymous (i.e. noname) header |
| [char] \ parse 2drop |
[char] \ parse 2drop |
| POSTPONE \g |
POSTPONE \g |
| >in ! |
>in ! |
| THEN to-doc on ; |
THEN ; |
| |
|
| \ Target TAGS creation |
\ Target TAGS creation |
| |
|
| s" kernal.TAGS" r/w create-file throw value tag-file-id |
s" kernel.TAGS" r/w create-file throw value tag-file-id |
| \ contains the file-id of the tags file |
\ contains the file-id of the tags file |
| |
|
| Create tag-beg 2 c, 7F c, bl c, |
Create tag-beg 2 c, 7F c, bl c, |
| |
|
| >TARGET |
>TARGET |
| : Alias ( cfa -- ) \ name |
: Alias ( cfa -- ) \ name |
| dup 0< IF to-doc off THEN |
|
| (THeader over resolve T A, H 80 flag! ; |
(THeader over resolve T A, H 80 flag! ; |
| >CROSS |
>CROSS |
| |
|
| : hex hex ; |
: hex hex ; |
| |
|
| : tudp T tudp H ; |
: tudp T tudp H ; |
| : tup T tup H ; minimal |
: tup T tup H ; |
| |
|
| |
: doc-off false T to-doc H ! ; |
| |
: doc-on true T to-doc H ! ; |
| |
|
| |
minimal |
| |
|
| \ for debugging... |
\ for debugging... |
| : order order ; |
: order order ; |