mirror of
https://github.com/hsoft/collapseos.git
synced 2024-11-23 16:28:05 +11:00
Remove Extra words
The few extra bytes they save in the core aren't worth the extra complexity. This was initially done in a context where I had troubles keeping the RC2014 binary with SDC inside the 8K limit. At this point, even with the few extra bytes we add here, we're at 7200 bytes, so I'd say we're fine.
This commit is contained in:
parent
7a5744a4c3
commit
a348ee9106
3
blk/001
3
blk/001
@ -1,8 +1,7 @@
|
||||
MASTER INDEX
|
||||
|
||||
5-99 unused
|
||||
100 Block editor
|
||||
120 Visual Editor 150 Extra words
|
||||
100 Block editor 120 Visual Editor
|
||||
160-199 unused
|
||||
200 Z80 assembler 260 Cross compilation
|
||||
280 Z80 boot code 350 Core words
|
||||
|
1
blk/125
1
blk/125
@ -1,3 +1,2 @@
|
||||
'? UPPER NOT [IF] 33 LOAD+ [THEN] DROP ( B158 )
|
||||
-20 LOAD+ ( B105, block editor )
|
||||
1 6 LOADR+
|
||||
|
1
blk/131
1
blk/131
@ -1,3 +1,4 @@
|
||||
: UPPER DUP 'a' 'z' =><= IF 32 - THEN ;
|
||||
: handle ( c -- f )
|
||||
DUP '0' '9' =><= IF num 0 EXIT THEN
|
||||
DUP CMD 2+ C! CMD FIND IF EXECUTE ELSE DROP THEN
|
||||
|
14
blk/150
14
blk/150
@ -1,14 +0,0 @@
|
||||
Extra words
|
||||
|
||||
The Core words (B350) section contains the absolute minimum
|
||||
needed to get a usable Forth interpreter with input buffer and
|
||||
disk blocks access running. The goal here is to minimize the
|
||||
binary size of a minimum Collapse OS install.
|
||||
|
||||
Extra words are words you will most likely want because they
|
||||
are generally useful.
|
||||
|
||||
Some programs need them, so they will automatically LOAD them.
|
||||
Because more than one program can use the same extra words,
|
||||
conditional loaders are recommended. If you want to load all
|
||||
words do "152 LOAD" which conditionally loads all extra words.
|
2
blk/152
2
blk/152
@ -1,2 +0,0 @@
|
||||
'? FILL NOT [IF] 3 LOAD+ [THEN] DROP
|
||||
'? WIPE NOT [IF] 5 LOAD+ [THEN] DROP
|
5
blk/155
5
blk/155
@ -1,5 +0,0 @@
|
||||
: FILL ( a n b -- )
|
||||
SWAP 2 PICK + ( a b a+n ) ROT ( b a+n a ) DO ( b )
|
||||
DUP I C!
|
||||
LOOP DROP ;
|
||||
: ALLOT0 ( n -- ) H@ OVER 0 FILL ALLOT ;
|
8
blk/157
8
blk/157
@ -1,8 +0,0 @@
|
||||
: WIPE BLK( 1024 0 FILL BLK!! ;
|
||||
: WIPED? ( -- f )
|
||||
1 ( f ) BLK) BLK( DO
|
||||
I C@ IF DROP 0 ( f ) LEAVE THEN LOOP ;
|
||||
: COPY ( src dst -- )
|
||||
FLUSH SWAP BLK@ BLK> ! BLK! ;
|
||||
: FREEBLKS? ( b1 b2 -- )
|
||||
1+ SWAP DO I BLK@ WIPED? IF I . SPC THEN LOOP ;
|
2
blk/158
2
blk/158
@ -1,2 +0,0 @@
|
||||
: LOWER DUP 'A' 'Z' =><= IF 32 + THEN ;
|
||||
: UPPER DUP 'a' 'z' =><= IF 32 - THEN ;
|
23
blk/355
23
blk/355
@ -1,14 +1,9 @@
|
||||
( r c -- r f )
|
||||
( Parse digit c and accumulate into result r.
|
||||
Flag f is 0 when c was a valid digit, 1 when c was WS,
|
||||
-1 when c was an invalid digit. )
|
||||
: _pdacc
|
||||
DUP 0x21 < IF DROP 1 EXIT THEN
|
||||
( parse char )
|
||||
( if bad, return "r -1" )
|
||||
'0' -
|
||||
DUP 10 < NOT IF DROP -1 EXIT THEN
|
||||
( good, add to running result )
|
||||
SWAP 10 * + ( r*10+n )
|
||||
0 ( good )
|
||||
;
|
||||
: +! TUCK @ + SWAP ! ;
|
||||
: / /MOD NIP ;
|
||||
: MOD /MOD DROP ;
|
||||
: ALLOT HERE +! ;
|
||||
: FILL ( a n b -- )
|
||||
SWAP 2 PICK + ( a b a+n ) ROT ( b a+n a ) DO ( b )
|
||||
DUP I C!
|
||||
LOOP DROP ;
|
||||
: ALLOT0 ( n -- ) H@ OVER 0 FILL ALLOT ;
|
||||
|
22
blk/358
22
blk/358
@ -1,10 +1,14 @@
|
||||
( strings being sent to parse routines are always null
|
||||
terminated )
|
||||
|
||||
: _pc ( a -- n f, parse character )
|
||||
( apostrophe is ASCII 39 )
|
||||
DUP 1+ C@ 39 = OVER 3 + C@ 39 = AND ( a f )
|
||||
NOT IF 0 EXIT THEN ( a 0 )
|
||||
( surrounded by apos, good, return )
|
||||
2+ C@ 1 ( n 1 )
|
||||
( r c -- r f )
|
||||
( Parse digit c and accumulate into result r.
|
||||
Flag f is 0 when c was a valid digit, 1 when c was WS,
|
||||
-1 when c was an invalid digit. )
|
||||
: _pdacc
|
||||
DUP 0x21 < IF DROP 1 EXIT THEN
|
||||
( parse char )
|
||||
( if bad, return "r -1" )
|
||||
'0' -
|
||||
DUP 10 < NOT IF DROP -1 EXIT THEN
|
||||
( good, add to running result )
|
||||
SWAP 10 * + ( r*10+n )
|
||||
0 ( good )
|
||||
;
|
||||
|
24
blk/360
24
blk/360
@ -1,16 +1,10 @@
|
||||
( returns negative value on error )
|
||||
: _ ( c -- n )
|
||||
DUP '0' '9' =><= IF '0' - EXIT THEN
|
||||
DUP 'a' 'f' =><= IF 0x57 ( 'a' - 10 ) - EXIT THEN
|
||||
DROP -1 ( bad )
|
||||
( strings being sent to parse routines are always null
|
||||
terminated )
|
||||
|
||||
: _pc ( a -- n f, parse character )
|
||||
( apostrophe is ASCII 39 )
|
||||
DUP 1+ C@ 39 = OVER 3 + C@ 39 = AND ( a f )
|
||||
NOT IF 0 EXIT THEN ( a 0 )
|
||||
( surrounded by apos, good, return )
|
||||
2+ C@ 1 ( n 1 )
|
||||
;
|
||||
: _ph ( a -- n f, parse hex )
|
||||
( '0': ASCII 0x30 'x': 0x78 0x7830 )
|
||||
DUP 1+ @ 0x7830 = NOT IF 0 EXIT THEN ( a 0 )
|
||||
( We have "0x" prefix )
|
||||
DUP C@ ( a len )
|
||||
0 SWAP 1+ ( len+1 ) 3 DO ( a r )
|
||||
OVER I + C@ ( a r c ) _ ( a r n )
|
||||
DUP 0< IF 2DROP 0 UNLOOP EXIT THEN
|
||||
SWAP 4 LSHIFT + ( a r*16+n ) LOOP
|
||||
NIP 1 ;
|
||||
|
16
blk/361
Normal file
16
blk/361
Normal file
@ -0,0 +1,16 @@
|
||||
( returns negative value on error )
|
||||
: _ ( c -- n )
|
||||
DUP '0' '9' =><= IF '0' - EXIT THEN
|
||||
DUP 'a' 'f' =><= IF 0x57 ( 'a' - 10 ) - EXIT THEN
|
||||
DROP -1 ( bad )
|
||||
;
|
||||
: _ph ( a -- n f, parse hex )
|
||||
( '0': ASCII 0x30 'x': 0x78 0x7830 )
|
||||
DUP 1+ @ 0x7830 = NOT IF 0 EXIT THEN ( a 0 )
|
||||
( We have "0x" prefix )
|
||||
DUP C@ ( a len )
|
||||
0 SWAP 1+ ( len+1 ) 3 DO ( a r )
|
||||
OVER I + C@ ( a r c ) _ ( a r n )
|
||||
DUP 0< IF 2DROP 0 UNLOOP EXIT THEN
|
||||
SWAP 4 LSHIFT + ( a r*16+n ) LOOP
|
||||
NIP 1 ;
|
8
blk/367
8
blk/367
@ -1,8 +0,0 @@
|
||||
: IMMEDIATE
|
||||
CURRENT @ 1-
|
||||
DUP C@ 128 OR SWAP C! ;
|
||||
: IMMED? 1- C@ 0x80 AND ;
|
||||
: +! TUCK @ + SWAP ! ;
|
||||
: / /MOD NIP ;
|
||||
: MOD /MOD DROP ;
|
||||
: ALLOT HERE +! ;
|
4
blk/369
4
blk/369
@ -1,3 +1,7 @@
|
||||
: IMMEDIATE
|
||||
CURRENT @ 1-
|
||||
DUP C@ 128 OR SWAP C! ;
|
||||
: IMMED? 1- C@ 0x80 AND ;
|
||||
: '? WORD FIND ;
|
||||
: ' '? NOT IF (wnf) THEN ;
|
||||
: ROLL
|
||||
|
10
blk/378
10
blk/378
@ -1,10 +1,14 @@
|
||||
: BLK! ( -- )
|
||||
BLK> @ BLK!* @ EXECUTE
|
||||
0 BLKDTY !
|
||||
;
|
||||
0 BLKDTY ! ;
|
||||
: FLUSH BLKDTY @ IF BLK! THEN ;
|
||||
: BLK@ ( n -- )
|
||||
DUP BLK> @ = IF DROP EXIT THEN
|
||||
FLUSH DUP BLK> ! BLK@* @ EXECUTE ;
|
||||
|
||||
: BLK!! 1 BLKDTY ! ;
|
||||
: WIPE BLK( 1024 0 FILL BLK!! ;
|
||||
: WIPED? ( -- f )
|
||||
1 ( f ) BLK) BLK( DO
|
||||
I C@ IF DROP 0 ( f ) LEAVE THEN LOOP ;
|
||||
: COPY ( src dst -- )
|
||||
FLUSH SWAP BLK@ BLK> ! BLK! ;
|
||||
|
BIN
cvm/forth.bin
BIN
cvm/forth.bin
Binary file not shown.
@ -6,7 +6,6 @@ RS_ADDR 0x80 - CONSTANT SYSVARS
|
||||
VARIABLE ORG
|
||||
CREATE BIN( 0 ,
|
||||
: PC H@ ORG @ - ;
|
||||
155 LOAD ( ALLOT0 )
|
||||
262 LOAD ( xcomp )
|
||||
270 LOAD ( xcomp overrides )
|
||||
|
||||
|
Loading…
Reference in New Issue
Block a user