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:
Virgil Dupras 2020-09-21 14:40:53 -04:00
parent 7a5744a4c3
commit a348ee9106
19 changed files with 60 additions and 85 deletions

View File

@ -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

View File

@ -1,2 +1 @@
'? FILL NOT [IF] 50 LOAD+ [THEN] DROP ( B155 )
1 7 LOADR+

View File

@ -1,3 +1,2 @@
'? UPPER NOT [IF] 33 LOAD+ [THEN] DROP ( B158 )
-20 LOAD+ ( B105, block editor )
1 6 LOADR+

View File

@ -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
View File

@ -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.

View File

@ -1,2 +0,0 @@
'? FILL NOT [IF] 3 LOAD+ [THEN] DROP
'? WIPE NOT [IF] 5 LOAD+ [THEN] DROP

View File

@ -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 ;

View File

@ -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 ;

View File

@ -1,2 +0,0 @@
: LOWER DUP 'A' 'Z' =><= IF 32 + THEN ;
: UPPER DUP 'a' 'z' =><= IF 32 - THEN ;

23
blk/355
View File

@ -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
View File

@ -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 )
;

View File

24
blk/360
View File

@ -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
View 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 ;

View File

@ -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 +! ;

View File

@ -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
View File

@ -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! ;

Binary file not shown.

View File

@ -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 )