Changeset 3125a52331ae6d7a6bb77d0ce92a95ddc2580547

User picture

Commiter: Charles Childers

Author: Charles Childers

Parent: fc349e2cf1

(2010/03/11 01:13) Almost 2 years ago

Merge branch 'master' of git.assembla.com:retro

Affected files

Updated forthlets/hangman/dict.retro Download diff

fc349e2cf15e1e11664eb67f38cf4acd59fe042c3125a52331ae6d7a6bb77d0ce92a95ddc2580547
7
( ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ )
7
( ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ )
8
8



9
include library/data/random-mwc.retro
9
include library/data/random-mwc.retro



10
include library/files.retro



10
11



11
( --[ Variables ]--------------------------------------------- )
12
( --[ Variables ]--------------------------------------------- )



12
13


...
...
28
: rand-off   ( -n ) dict-size @ >random ;
29
: rand-off   ( -n ) dict-size @ >random ;



29
: rand-pos   ( -n ) rand-off dict @ fseek drop ;
30
: rand-pos   ( -n ) rand-off dict @ fseek drop ;



30
31



31
: >line      ( -  ) repeat dict @ here fread drop
32
: >line      ( -  ) repeat dict @ fread 10 =if ;then again ;



32
                    here @ 10 =if ;then again ;



33
33



34
: readline   ( -  ) dict-word repeat dict @ over fread drop
34
: readline   ( -  ) dict-word repeat dict @ over fread! drop



35
                    dup @ 10 =if 0 swap ! ;; else 1+ then again ;
35
                    dup @ 10 =if 0 swap ! ;; else 1+ then again ;



36
36



37
: rand-word  ( -  ) rand-pos >line readline ;
37
: rand-word  ( -  ) rand-pos >line readline ;





          

  Updated
image/build.retro  Download diff




      
      
fc349e2cf15e1e11664eb67f38cf4acd59fe042c3125a52331ae6d7a6bb77d0ce92a95ddc2580547
1
include source/meta.retro



2
include source/core.retro



3
include source/stage2.retro



4
include source/vocabs.retro



5
include source/editor.retro
1
include source/editor.retro



6
include source/files.retro
2
include source/files.retro



7
include source/debug.retro
3
include source/debug.retro





          

  Updated
image/Makefile  Download diff




      
      
fc349e2cf15e1e11664eb67f38cf4acd59fe042c3125a52331ae6d7a6bb77d0ce92a95ddc2580547
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
	cp retroImage pristine



14



9
errors:
15
errors:



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



11
17





          

  Added
image/minimal.retro  Download diff




      
      
fc349e2cf15e1e11664eb67f38cf4acd59fe042c3125a52331ae6d7a6bb77d0ce92a95ddc2580547
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/files.retro  Download diff




      
      
fc349e2cf15e1e11664eb67f38cf4acd59fe042c3125a52331ae6d7a6bb77d0ce92a95ddc2580547
7
  : file.io ( n-f ) 4 out wait 4 in ;
7
  : file.io ( n-f ) 4 out wait 4 in ;



8
---reveal---
8
---reveal---



9
  : fopen  ( $m-f ) -1 file.io ;
9
  : fopen  ( $m-f ) -1 file.io ;



10
  : fread  ( hc-f ) -2 file.io ;
10
  : fread  (  h-f ) -2 file.io ;



11
  : fwrite ( ch-f ) -3 file.io ;
11
  : fwrite ( ch-f ) -3 file.io ;



12
  : fclose ( h -f ) -4 file.io ;
12
  : fclose ( h -f ) -4 file.io ;



13
  : fpos   ( h -n ) -5 file.io ;
13
  : fpos   ( h -n ) -5 file.io ;



14
  : fseek  ( nh-f ) -6 file.io ;
14
  : fseek  ( nh-f ) -6 file.io ;



15
  : fsize  ( h-n  ) -7 file.io ;
15
  : fsize  (  h-n ) -7 file.io ;



16
}}
16
}}



17
))
17
))



18
18





          

  Updated
image/source/meta.retro  Download diff




      
      
fc349e2cf15e1e11664eb67f38cf4acd59fe042c3125a52331ae6d7a6bb77d0ce92a95ddc2580547
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




      
      
fc349e2cf15e1e11664eb67f38cf4acd59fe042c3125a52331ae6d7a6bb77d0ce92a95ddc2580547
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




      
      
fc349e2cf15e1e11664eb67f38cf4acd59fe042c3125a52331ae6d7a6bb77d0ce92a95ddc2580547
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




      
      
fc349e2cf15e1e11664eb67f38cf4acd59fe042c3125a52331ae6d7a6bb77d0ce92a95ddc2580547
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




      
      
fc349e2cf15e1e11664eb67f38cf4acd59fe042c3125a52331ae6d7a6bb77d0ce92a95ddc2580547
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
  ( ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ )





          

  Updated
library/files.retro  Download diff




      
      
fc349e2cf15e1e11664eb67f38cf4acd59fe042c3125a52331ae6d7a6bb77d0ce92a95ddc2580547
4
( ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ )
4
( ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ )



5
' files open
5
' files open



6
6



7
: fread! ( ha-f ) swap fread dup rot ! ;



8



7
: slurp ( a"- )
9
: slurp ( a"- )



8
  :r fopen dup
10
  :r fopen dup



9
  if
11
  if



10
    swap repeat 2dup fread not if 0 swap ! fclose drop ;then 1+ again
12
    swap repeat 2dup fread! 0 =if 0 swap ! fclose drop ;then 1+ again



11
  else
13
  else



12
    drop 0 swap !
14
    drop 0 swap !



13
  then ;
15
  then ;





          

  Updated
Makefile  Download diff




      
      
fc349e2cf15e1e11664eb67f38cf4acd59fe042c3125a52331ae6d7a6bb77d0ce92a95ddc2580547
1
default: clean
1
default: clean retroImage



2
	@make -C vm/console
2
	@make -C vm/console



3
	@cp vm/console/retro ./retro
3
	@cp vm/console/retro ./retro



4
	@make -C vm/fast-console
4
	@make -C vm/fast-console



5
	@cp vm/fast-console/retro ./retro-fast
5
	@cp vm/fast-console/retro ./retro-fast



6
	@make -C image
6



7
retroImage:



7
	@cp image/retroImage .
8
	@cp image/retroImage .



8
	@echo "editor new editor save bye" | ./retro
9
	@echo "editor new editor save bye" | ./retro



9
10





          

  Updated
vm/console/files.c  Download diff




      
      
fc349e2cf15e1e11664eb67f38cf4acd59fe042c3125a52331ae6d7a6bb77d0ce92a95ddc2580547
30
}
30
}



31
31



32
int file_readc(VM *vm) {
32
int file_readc(VM *vm) {



33
  int cell = TOS; DROP;



34
  FILE *handle = (FILE *) TOS; DROP;
33
  FILE *handle = (FILE *) TOS; DROP;



35
  int c = fgetc(handle);
34
  int c = fgetc(handle);



36
  vm->image[cell] = c;



37
  if ( c == EOF ) {
35
  if ( c == EOF ) {



38
    return 0;
36
    return 0;



39
  } else {
37
  } else {



40
    return -1;
38
    return c;



41
  }
39
  }



42
}
40
}



43
41





          

  Updated
vm/fast-console/vm.c  Download diff




      
      
fc349e2cf15e1e11664eb67f38cf4acd59fe042c3125a52331ae6d7a6bb77d0ce92a95ddc2580547
541
541



542
          /* Read a char; response indicates success/failure */
542
          /* Read a char; response indicates success/failure */



543
          if (vm->ports[4] == -2) {
543
          if (vm->ports[4] == -2) {



544
            int cell = acc; DROP;



545
            FILE *handle = (FILE *) acc; DROP;
544
            FILE *handle = (FILE *) acc; DROP;



546
            int c = fgetc(handle);
545
            int c = fgetc(handle);



547
            vm->image[cell] = c;
546
            if   ( c == EOF ) vm->ports[4] = 0;



548
            if   ( c == EOF ) vm->ports[4] =  0;
547
            else              vm->ports[4] = c;



549
            else              vm->ports[4] = -1;



550
            vm->ports[0] = 1;
548
            vm->ports[0] = 1;



551
          }
549
          }



552
550





          

  Updated
vm/graphical/devices.c  Download diff




      
      
fc349e2cf15e1e11664eb67f38cf4acd59fe042c3125a52331ae6d7a6bb77d0ce92a95ddc2580547
330
330



331
    /* Read a char; response indicates success/failure */
331
    /* Read a char; response indicates success/failure */



332
    if (vm.ports[4] == -2) {
332
    if (vm.ports[4] == -2) {



333
      int cell = TOS; DROP;



334
      FILE *handle = (FILE *) TOS; DROP;
333
      FILE *handle = (FILE *) TOS; DROP;



335
      int c = fgetc(handle);
334
      int c = fgetc(handle);



336
      vm.image[cell] = c;
335
      if   ( c == EOF ) vm.ports[4] = 0;



337
      if   ( c == EOF ) vm.ports[4] =  0;
336
      else              vm.ports[4] = c;



338
      else              vm.ports[4] = -1;



339
      vm.ports[0] = 1;
337
      vm.ports[0] = 1;



340
    }
338
    }



341
339