Changeset dc16bb4852392bd8b084f5e35f2fff6e29a105cf

User picture

Commiter: Charles Childers

Author: Charles Childers

Parent: fbec8f49ae

(2010/03/10 14:24) About 2 years ago

remove TRUE and FALSE; fix bugs in building; pristine image now core+stage2+vocabs

Affected files

Updated image/Makefile Download diff

fbec8f49aece25bf72a68c06ecb0cd01dd84f757dc16bb4852392bd8b084f5e35f2fff6e29a105cf
4
default: image errors
4
default: image errors
5
5



6
image:
6
image:



7
	cp pristine retroImage



7
	$(VM) --shrink --with build.retro >build.log
8
	$(VM) --shrink --with build.retro >build.log



8
9



10
initial:



11
	cp pristine retroImage



12
	$(VM) --shrink --with minimal.retro >build.log



13



9
errors:
14
errors:



10
	cat build.log | grep -v ok
15
	cat build.log | grep -v ok



11
16





          

  Added
image/minimal.retro  Download diff




      
      
fbec8f49aece25bf72a68c06ecb0cd01dd84f757dc16bb4852392bd8b084f5e35f2fff6e29a105cf
1
include source/meta.retro



2
include source/core.retro



3
include source/stage2.retro



4
include source/vocabs.retro



5
save bye





    

    

          

  Updated
image/source/meta.retro  Download diff




      
      
fbec8f49aece25bf72a68c06ecb0cd01dd84f757dc16bb4852392bd8b084f5e35f2fff6e29a105cf
4
( License: ISC                                                )
4
( License: ISC                                                )



5
( ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ )
5
( ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ )



6
6



7



8
vocab meta
7
vocab meta



9
((
8
((



10
( ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ )
9
( ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ )


...
...
60
( ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ )
59
( ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ )



61
{{
60
{{



62
  variable getxt
61
  variable getxt



63
  : .colon getxt @ TRUE =if getxt off ;then m, ;
62
  : .colon getxt @ if getxt off ;then m, ;



64
---reveal---
63
---reveal---



65
  : t: ( "- ) label: nop, nop, ['] .colon last @ d->class ! ;
64
  : t: ( "- ) label: nop, nop, ['] .colon last @ d->class ! ;



66
  : t' ( "-a ) getxt on ;
65
  : t' ( "-a ) getxt on ;


...
...
108
  : !+       ( ca-a )  dup 1+ push ! pop ;
107
  : !+       ( ca-a )  dup 1+ push ! pop ;



109
  : copy     ( aan- )  for push @+ pop !+ next drop drop ;
108
  : copy     ( aan- )  for push @+ pop !+ next drop drop ;



110
  : wait     ( - )     0 0 out [ 30 , ] ;
109
  : wait     ( - )     0 0 out [ 30 , ] ;



111
  : save     ( - )     1 4 out 0 0 out wait [ 99 ,
110
  : save     ( - )     1 4 out 0 0 out wait -9 5 out wait ;



112
  : relocate ( - )     origin @ 0 IMAGE-SIZE copy ;
111
  : relocate ( - )     origin @ 0 IMAGE-SIZE copy ;



113
---reveal---
112
---reveal---



114
  : boot-new       ( - ) relocate [ 8 , 0 , ] ;
113
  : boot-new       ( - ) relocate [ 0 , ] ;



115
  : save-and-quit  ( - ) relocate save ;
114
  : save-and-quit  ( - ) relocate save ;



116
}}
115
}}



117
116


...
...
119
118



120
: ; ;, ;; [
119
: ; ;, ;; [



121
120



122
here IMAGE-SIZE allot target ! target @ origin !
121
here IMAGE-SIZE zallot target ! target @ origin !



123
jump, 0 m,
122
jump, 0 m,



124



125
))
123
))



126
' meta shut
124
' meta shut





          

  Updated
image/source/stage2.retro  Download diff




      
      
fbec8f49aece25bf72a68c06ecb0cd01dd84f757dc16bb4852392bd8b084f5e35f2fff6e29a105cf
168
( separate functions for the comparisons, so I define them    )
168
( separate functions for the comparisons, so I define them    )



169
( here.                                                       )
169
( here.                                                       )



170
( ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ )
170
( ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ )



171
-1 constant TRUE   ( -f )



172
 0 constant FALSE  ( -f )



173



174
: ahead ( -a  ) 8 , here 0 , ;
171
: ahead ( -a  ) 8 , here 0 , ;



175
: if    ( f-  ) FALSE literal, ` !if ; compile-only
172
: if    ( f-  ) 0 literal, ` !if ; compile-only



176
: if;   ( f-  ) ` not ` 0; ` drop ; compile-only
173
: if;   ( f-  ) ` not ` 0; ` drop ; compile-only



177
: ;then ( a-  ) ` ;; ` then ; compile-only
174
: ;then ( a-  ) ` ;; ` then ; compile-only



178
: else  ( a-a ) ahead swap ` then ; compile-only
175
: else  ( a-a ) ahead swap ` then ; compile-only



179
176



180
: =  ( xy-f )  =if TRUE ;then FALSE ;
177
: =  ( xy-f )  =if -1 ;then 0 ;



181
: <> ( xy-f )  !if TRUE ;then FALSE ;
178
: <> ( xy-f )  !if -1 ;then 0 ;



182
: >  ( xy-f )  >if TRUE ;then FALSE ;
179
: >  ( xy-f )  >if -1 ;then 0 ;



183
: <  ( xy-f )  <if TRUE ;then FALSE ;
180
: <  ( xy-f )  <if -1 ;then 0 ;



184
181



185
182



186
( ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ )
183
( ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ )





          

  Updated
image/source/vocabs.retro  Download diff




      
      
fbec8f49aece25bf72a68c06ecb0cd01dd84f757dc16bb4852392bd8b084f5e35f2fff6e29a105cf
21
  : fields  (  -   ) shown .shown 3 copy ;
21
  : fields  (  -   ) shown .shown 3 copy ;



22
  : open    ( a-   ) @ shown ! .hidden @ .shown @ ! ;
22
  : open    ( a-   ) @ shown ! .hidden @ .shown @ ! ;



23
  : shut    ( a-   ) @ shown ! .before @ .shown @ ! ;
23
  : shut    ( a-   ) @ shown ! .before @ .shown @ ! ;



24
  : :find   ( a-af ) last repeat @ 2dup =if drop @ TRUE ;then dup 0; drop again ;
24
  : :find   ( a-af ) last repeat @ 2dup =if drop @ -1 ;then dup 0; drop again ;



25
  : open?   ( a-af ) dup 1+ @ :find nip ;
25
  : open?   ( a-af ) dup 1+ @ :find nip ;



26
  : toggle  ( a-   ) open? if shut ;then open ;
26
  : toggle  ( a-   ) open? if shut ;then open ;



27
  : descend (  -   ) shown depth @ 3 * nest + 3 copy depth ++ ;
27
  : descend (  -   ) shown depth @ 3 * nest + 3 copy depth ++ ;


...
...
55
  expose ahead
55
  expose ahead



56
  expose else       expose ;then
56
  expose else       expose ;then



57
  expose if;        expose if
57
  expose if;        expose if



58
  expose FALSE      expose TRUE



59
  expose stub       expose `
58
  expose stub       expose `



60
  expose fill       expose copy
59
  expose fill       expose copy



61
  expose zallot     expose allot
60
  expose zallot     expose allot





          

  Updated
library/compat/forth94.retro  Download diff




      
      
fbec8f49aece25bf72a68c06ecb0cd01dd84f757dc16bb4852392bd8b084f5e35f2fff6e29a105cf
263
( 6.2.1343 ENDOF         )  stub ENDOF
263
( 6.2.1343 ENDOF         )  stub ENDOF



264
( 6.2.1350 ERASE         )  : ERASE 0 swap fill ;
264
( 6.2.1350 ERASE         )  : ERASE 0 swap fill ;



265
( 6.2.1390 EXPECT        )  obs: EXPECT
265
( 6.2.1390 EXPECT        )  obs: EXPECT



266
( 6.2.1485 FALSE         )  ( Supported by Retro )
266
( 6.2.1485 FALSE         )  0 constant FALSE



267
( 6.2.1660 HEX           )  alias HEX hex
267
( 6.2.1660 HEX           )  alias HEX hex



268
( 6.2.1850 MARKER        )  stub MARKER
268
( 6.2.1850 MARKER        )  stub MARKER



269
( 6.2.1930 NIP           )  alias NIP nip
269
( 6.2.1930 NIP           )  alias NIP nip


...
...
290
( 6.2.2240 SPAN          )  obs: SPAN
290
( 6.2.2240 SPAN          )  obs: SPAN



291
( 6.2.2290 TIB           )  obs: TIB
291
( 6.2.2290 TIB           )  obs: TIB



292
( 6.2.2295 TO            )  : TO ' .data ` ! ; IMMEDIATE
292
( 6.2.2295 TO            )  : TO ' .data ` ! ; IMMEDIATE



293
( 6.2.2298 TRUE          )  ( Supported by Retro )
293
( 6.2.2298 TRUE          )  -1 constant TRUE



294
( 6.2.2300 TUCK          )  : TUCK tuck ;
294
( 6.2.2300 TUCK          )  : TUCK tuck ;



295
( 6.2.2330 U.R           )  stub U.R
295
( 6.2.2330 U.R           )  stub U.R



296
( 6.2.2350 U>            )  stub U>
296
( 6.2.2350 U>            )  stub U>





          

  Updated
library/contrib/quirks.retro  Download diff




      
      
fbec8f49aece25bf72a68c06ecb0cd01dd84f757dc16bb4852392bd8b084f5e35f2fff6e29a105cf
13
  ( My < and > are comparison for "condition or equal", these   )
13
  ( My < and > are comparison for "condition or equal", these   )



14
  ( exclude equality.                                           )
14
  ( exclude equality.                                           )



15
  ( ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ )
15
  ( ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ )



16
  : <  ( xy-f ) >if FALSE ;then TRUE ;
16
  : <  ( xy-f ) >if 0 ;then -1 ;



17
  : >  ( xy-f ) <if FALSE ;then TRUE ;
17
  : >  ( xy-f ) <if 0 ;then -1 ;



18
18



19
19



20
  ( ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ )
20
  ( ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ )