• R/O
  • HTTP
  • SSH
  • HTTPS

bif-6809: コミット

ソースコード及び仕様書など
Source and documentation


コミットメタ情報

リビジョンfcb9b0cd4f541742452d7f455ea4c93d38a798cb (tree)
日時2019-04-29 19:35:48
作者Joel Matthew Rees <joel.rees@gmai...>
コミッターJoel Matthew Rees

ログメッセージ

buggy bif_img, but it works if you're careful and don't mind things sliding a line or two.

変更サマリ

差分

--- a/bif-img.c
+++ b/bif-img.c
@@ -1 +1 @@
1-/* Tool for working with BIF-6809 images. // Written by Joel Matthew Rees, Amagasaki, Japan, April 2019, // Parts adapted from the author's 32col.c, written 1999. // Copyright 1999, 2019, Joel Matthew Rees. // Permission granted in advance for all uses // with the condition that this copyright and permission notice are retained. // // BIF-6809 project page: https://osdn.net/projects/bif-6809/ */ #include <limits.h> #include <stdio.h> #include <stdlib.h> /* for EXIT_SUCCESS */ #include <string.h> #include <ctype.h> #define ScreenSize 1024 #define ScreenWidth 32 #define ScreenHeight ( ScreenSize / ScreenWidth ) #define BufferPlay 3 /* room for CR/LF and NUL */ #define BufferWidth ( ScreenWidth + BufferPlay ) #define TO_SCREEN 1 const char kTo_ScreenStr[] = "--to-screens"; #define TO_EOLN_TEXT 2 const char kTo_EOLN_textStr[] = "--to-eoln-text"; const char kBlockSizeStr[] = "-size"; const char kBlockWidthStr[] = "-width"; const char kBlockOffsetStr[] = "-off"; const char kBlockCountStr[] = "-count"; const char kSuppressEndLinesStr[] = "-suppressEndLines"; void toEOLNtext( FILE * input, FILE * output, char * buffer /* Must have room for BufferPlay extra bytes per line. */, unsigned blocksize, unsigned width, unsigned offset, unsigned count, int suppressEndLines /*, int linecountflag */ ) { unsigned long start = blocksize * offset; unsigned long bytecount = blocksize * count; unsigned long totalBytes = 0; /* dbg */ fprintf( stderr, "size: %u; width: %u; off: %u; count: %u\n", blocksize, width, offset, count ); if ( start > 0 ) { fseek( input, start, SEEK_SET ); } while ( !feof( input ) && ( totalBytes < bytecount ) ) { int lineCount; for ( lineCount = 0; lineCount < ScreenHeight && !feof( input ); ++lineCount ) { char * linestart = buffer + lineCount * ( width + BufferPlay ); int length = fread( linestart, sizeof (char), width, input ); totalBytes += length; while ( --length >= 0 && ( isspace( linestart[ length ] ) || !isprint( linestart[ length ] ) ) ) /* "empty" loop */; linestart[ ++length ] = '\0'; } if ( lineCount > 1 || ( lineCount == 1 && buffer[ 0 ] != '\0' ) ) { int line = 0; if ( suppressEndLines ) { while ( --lineCount > 0 && buffer[ lineCount * ( width + BufferPlay ) ] == '\0' ) { /* "empty" loop: note tested NUL is first character of line. */ } } else { --lineCount; } for ( line = 0; line <= lineCount; ++line ) /* End condition intentional! */ { fputs( buffer + line * ( width + BufferPlay ), output ); fputc( '\n', output ); } /* fputc( '\f', output ); This is not useful. */ } } } #define FILE_START 0x200 /* beyond char range. */ #define LINE_START 0x400 /* beyond char range. */ void toScreens( FILE * input, FILE * output, char * bugffer /* Must have room for BufferPlay extra bytes per line. */, unsigned blocksize, unsigned width, unsigned offset, unsigned count /*, int linecountflag */ ) { char buffer[ ScreenHeight ][ BufferWidth ]; int eolFlag = FILE_START; while ( !feof( input ) ) { int lineCount; for ( lineCount = 0; lineCount < ScreenHeight; ++lineCount ) { int length = 0; char * line = buffer[ lineCount ]; int ch = LINE_START; while ( ( length < ScreenWidth ) && !feof( input ) ) { ch = fgetc( input ); if ( ( length == 0 ) && ( ( ( ch == '\r' ) && ( eolFlag == '\n' ) ) || ( ( ch == '\n' ) && ( eolFlag == '\r' ) ) ) ) { ch = fgetc( input ); } eolFlag = ch; if ( ( ch == '\n' ) || ( ch == '\r' ) || feof( input ) ) { break; /* The habit is to set a NUL, but not for SCREENs. */ } line[ length++ ] = ch; /* dbg * / putchar( ch ); */ } /* dbg * / printf( "||end:%d:", length ); */ while ( length < ScreenWidth ) { line[ length++ ] = ' '; /* dbg * / putchar( '*' );*/ } /* dbg * / printf( "||:%d:%d\n", length, lineCount ); */ } /* dbg * / printf( "<<screen:%d:>>\n", lineCount ); */ if ( lineCount > 0 ) { int line = 0; for ( line = 0; line < lineCount; ++line ) { fwrite( buffer[ line ], sizeof (char), ScreenWidth, output ); } } } } int getNumericParameter( const char parameter[], char * argstr, unsigned long * rval, long low, unsigned long high ) { char * scanpt = argstr; unsigned long result = 0; size_t eqpt = strlen( parameter ); if ( strncmp( parameter, argstr, eqpt ) == 0 ) { if ( argstr[ eqpt ] != '=' ) { printf( "\t%s needs '=' in '%s', ", parameter, argstr ); return INT_MIN | 16; } ++eqpt; scanpt += eqpt; result = strtoul( scanpt, &scanpt, 0 ); if ( scanpt <= argstr + eqpt ) { printf( "\tBad %s value specified in '%s'\n,", parameter, argstr ); return INT_MIN | 32; } if ( ( result < low ) || ( result > high ) ) { fprintf( stderr, "\t%s value %lu out of range in '%s', try %lu\n,", parameter, result, argstr, * rval ); return INT_MIN | 64; } * rval = result; return 1; } return 0; } int main(int argc, char * argv[] ) { FILE * input = stdin; FILE * output = stdout; char * buffer = NULL; int direction = 0; int errval = 0; unsigned long blocksize = ScreenSize; unsigned long width = ScreenWidth; unsigned long offset = 0; unsigned long count = UINT_MAX; unsigned long suppressEndLines = 0; int i; for ( i = 4; i < argc; ++i ) { int berr = 0; int werr = 0; int oerr = 0; int cerr = 0; int serr = 0; if ( ( ( berr |= getNumericParameter( kBlockSizeStr, argv[ i ], &blocksize, 1, 0x8000UL ) ) > 0 ) || ( ( werr |= getNumericParameter( kBlockWidthStr, argv[ i ], &width, 1, 1024 ) ) > 0 ) || ( ( oerr |= getNumericParameter( kBlockOffsetStr, argv[ i ], &offset, 0, USHRT_MAX ) ) > 0 ) || ( ( cerr |= getNumericParameter( kBlockCountStr, argv[ i ], &count, 1, USHRT_MAX ) ) > 0 ) || ( ( serr |= getNumericParameter( kSuppressEndLinesStr, argv[ i ], &suppressEndLines, 0, 1 ) ) > 0 ) ) { /* empty */ } else { printf( "\tUnrecognized %s\n", argv[ i ] ); /* This isn't firing for gobbledygook. */ } errval |= berr | werr | oerr | cerr | serr; } if ( ( blocksize % width ) != 0 ) { errval |= INT_MIN | 1024; printf( "Block size %lu is not even multiple of edit width %lu.\n", blocksize, width ); } if ( ( errval >= 0 ) && ( argc > 3 ) ) { if ( strcmp( argv[ 1 ], kTo_ScreenStr ) == 0 ) { direction = TO_SCREEN; } else if ( strcmp( argv[ 1 ], kTo_EOLN_textStr ) == 0 ) { direction = TO_EOLN_TEXT; } if ( direction != 0 ) { if ( strcmp( argv[ 2 ], "--" ) != 0 ) { input = fopen( argv[ 2 ], "rb" ); } if ( input == NULL ) { fprintf( stderr, "Error opening file <%s> for input.\n", argv[ 2 ] ); direction |= INT_MIN | 4; } if ( strcmp( argv[ 3 ], "--" ) != 0 ) { output = fopen( argv[ 3 ], "wb" ); } if ( output == NULL ) { fprintf( stderr, "Error opening file <%s> for output.\n", argv[ 3 ] ); fclose( input ); direction |= INT_MIN | 8; } if ( ( buffer = malloc( blocksize + BufferPlay * ( blocksize / width ) ) ) == NULL ) { fprintf( stderr, "Buffer allocation failure\n" ); direction |= INT_MIN | 16; } } } if ( direction < -1 ) { fprintf( stderr, "*** %s quitting. ***\n", argv[ 0 ] ); return EXIT_FAILURE; } else if ( direction == 0 ) { puts( "usage:" ); printf( "\t%s %s <infile> <outfile>\n", argv[ 0 ], kTo_ScreenStr ); printf( "\t%s %s <infile> <outfile> [ %s=<block-size> ] [ %s=<width> ] [ %s=<offset> ] [ %s=<count> ] [ %s={0|1} ]\n", argv[ 0 ], kTo_EOLN_textStr, kBlockSizeStr, kBlockWidthStr, kBlockOffsetStr, kBlockCountStr, kSuppressEndLinesStr ); printf( "** Default block size is %d, compatible with Forth SCREENs.\n", ScreenSize ); printf( "** Default width is %d, compatible with Color Computer 1 & 2 text display.\n", ScreenWidth ); printf( "** Default count is length of input file.\n" ); printf( "** %s=1 to suppress trailing blank lines in SCREEN, default 0.\n", kSuppressEndLinesStr ); printf( "** 0xhexadecimal and 0octal permitted for size, etc.\n" ); printf( "** Replace <file> with -- for stdfiles in pipes\n" ); /* printf( "\t%s --to-image <filename> <imagename> <offset>\n", argv[ 0 ] ); */ return EXIT_SUCCESS; } switch ( direction ) { case TO_SCREEN: toScreens( input, output, buffer, blocksize, width, offset, count ); break; case TO_EOLN_TEXT: toEOLNtext( input, output, buffer, blocksize, width, offset, count, suppressEndLines ); break; } return EXIT_SUCCESS; }
\ No newline at end of file
1+/* Tool for working with BIF-6809 images. // Written by Joel Matthew Rees, Amagasaki, Japan, April 2019, // Parts adapted from the author's 32col.c, written 1999. // Copyright 1999, 2019, Joel Matthew Rees. // Permission granted in advance for all uses // with the condition that this copyright and permission notice are retained. // // BIF-6809 project page: https://osdn.net/projects/bif-6809/ */ #include <limits.h> #include <stdio.h> #include <stdlib.h> /* for EXIT_SUCCESS */ #include <string.h> #include <ctype.h> #define kScreenSize 1024 #define kScreenWidth 32 #define kScreenHeight ( kScreenSize / kScreenWidth ) #define kBufferPlay 3 /* room for CR/LF and NUL */ #define kBufferWidth ( kScreenWidth + kBufferPlay ) /* Should never be used. */ #define TO_SCREEN 1 const char kTo_ScreenStr[] = "--to-screens"; #define TO_EOLN_TEXT 2 const char kTo_EOLN_textStr[] = "--to-eoln-text"; const char kBlockSizeStr[] = "-size"; const char kBlockWidthStr[] = "-width"; const char kBlockOffsetStr[] = "-off"; const char kBlockCountStr[] = "-count"; const char kSuppressEndLinesStr[] = "-suppressEndLines"; void toEOLNtext( FILE * input, FILE * output, char * buffer /* Must have room for kBufferPlay extra bytes per line. */, unsigned blocksize, unsigned width, unsigned offset, unsigned count, int suppressEndLines /*, int linecountflag */ ) { unsigned long start = blocksize * offset; unsigned long bytecount = blocksize * count; unsigned long totalBytes = 0; unsigned screenHeight = blocksize / width; unsigned bufferWidth = width + kBufferPlay; /* dbg */ fprintf( stderr, "size: %u; width: %u; off: %u; count: %u\n", blocksize, width, offset, count ); if ( start > 0 ) { fseek( input, start, SEEK_SET ); } while ( !feof( input ) && ( totalBytes < bytecount ) ) { int lineCount; for ( lineCount = 0; lineCount < screenHeight && !feof( input ); ++lineCount ) { char * linestart = buffer + lineCount * bufferWidth; int length = fread( linestart, sizeof (char), width, input ); totalBytes += length; while ( --length >= 0 && ( isspace( linestart[ length ] ) || !isprint( linestart[ length ] ) ) ) /* "empty" loop */; linestart[ ++length ] = '\0'; } if ( lineCount > 1 || ( lineCount == 1 && buffer[ 0 ] != '\0' ) ) { int line = 0; if ( suppressEndLines ) { while ( --lineCount > 0 && buffer[ lineCount * bufferWidth ] == '\0' ) { /* "empty" loop: note tested NUL is first character of line. */ } } else { --lineCount; } for ( line = 0; line <= lineCount; ++line ) /* End condition intentional! */ { fputs( buffer + line * bufferWidth, output ); fputc( '\n', output ); } /* fputc( '\f', output ); This is not useful. */ } } } #define FILE_START 0x200 /* beyond char range. */ #define LINE_START 0x400 /* beyond char range. */ void toScreens( FILE * input, FILE * output, char * buffer /* Must have room for kBufferPlay extra bytes per line. */, unsigned blocksize, unsigned width, unsigned offset, unsigned count /*, int linecountflag */ ) { unsigned long start = blocksize * offset; unsigned screenHeight = ( blocksize / width ); unsigned bufferWidth = width + kBufferPlay; int eolFlag = FILE_START; if ( start > 0 ) { fseek( output, start, SEEK_SET ); } while ( !feof( input ) ) { int lineCount; for ( lineCount = 0; lineCount < screenHeight; ++lineCount ) { int length = 0; char * line = buffer + lineCount * bufferWidth; int ch = LINE_START; while ( ( length < width ) && !feof( input ) ) { ch = fgetc( input ); if ( ( length == 0 ) && ( ( ( ch == '\r' ) && ( eolFlag == '\n' ) ) || ( ( ch == '\n' ) && ( eolFlag == '\r' ) ) ) ) { ch = fgetc( input ); } eolFlag = ch; if ( ( ch == '\n' ) || ( ch == '\r' ) || feof( input ) ) { break; /* The habit is to set a NUL, but not for SCREENs. */ } line[ length++ ] = ch; /* dbg */ fputc( ch, stderr ); } /* dbg */ fprintf( stderr, "||end:%d:", length ); while ( length < width ) { line[ length++ ] = ' '; /* dbg */ fputc( '*', stderr ); } /* dbg */ fprintf( stderr, "||:%d:%d\n", length, lineCount ); } /* dbg */ fprintf( stderr, "<<screen:%d:>>\n", lineCount ); if ( lineCount > 0 ) { int line = 0; size_t count = 0; int error = 0; for ( line = 0; line < lineCount; ++line ) { count = fwrite( buffer + line * bufferWidth, sizeof (char), width, output ); if ( ( count != width ) || ( ( error = ferror( output ) ) != 0 ) ) { int i; fprintf( stderr, "Output error=%d; count: %lu::", error, count ); for ( i = 0; i < width; ++i ) fputc( buffer[ line * bufferWidth + i ], stderr ); fputc( '\n', stderr ); } } } } } int getNumericParameter( const char parameter[], char * argstr, unsigned long * rval, long low, unsigned long high ) { char * scanpt = argstr; unsigned long result = 0; size_t eqpt = strlen( parameter ); if ( strncmp( parameter, argstr, eqpt ) == 0 ) { if ( argstr[ eqpt ] != '=' ) { printf( "\t%s needs '=' in '%s', ", parameter, argstr ); return INT_MIN | 16; } ++eqpt; scanpt += eqpt; result = strtoul( scanpt, &scanpt, 0 ); if ( scanpt <= argstr + eqpt ) { printf( "\tBad %s value specified in '%s'\n,", parameter, argstr ); return INT_MIN | 32; } if ( ( result < low ) || ( result > high ) ) { fprintf( stderr, "\t%s value %lu out of range in '%s', try %lu\n,", parameter, result, argstr, * rval ); return INT_MIN | 64; } * rval = result; return 1; } return 0; } int main(int argc, char * argv[] ) { FILE * input = stdin; FILE * output = stdout; char * buffer = NULL; int direction = 0; int errval = 0; unsigned long blocksize = kScreenSize; unsigned long width = kScreenWidth; unsigned long offset = 0; unsigned long count = UINT_MAX; unsigned long suppressEndLines = 0; int i; for ( i = 4; i < argc; ++i ) { int berr = 0; int werr = 0; int oerr = 0; int cerr = 0; int serr = 0; if ( ( ( berr |= getNumericParameter( kBlockSizeStr, argv[ i ], &blocksize, 1, 0x8000UL ) ) > 0 ) || ( ( werr |= getNumericParameter( kBlockWidthStr, argv[ i ], &width, 1, 1024 ) ) > 0 ) || ( ( oerr |= getNumericParameter( kBlockOffsetStr, argv[ i ], &offset, 0, USHRT_MAX ) ) > 0 ) || ( ( cerr |= getNumericParameter( kBlockCountStr, argv[ i ], &count, 1, USHRT_MAX ) ) > 0 ) || ( ( serr |= getNumericParameter( kSuppressEndLinesStr, argv[ i ], &suppressEndLines, 0, 1 ) ) > 0 ) ) { /* empty */ } else { printf( "\tUnrecognized %s\n", argv[ i ] ); /* This isn't firing for gobbledygook. */ } errval |= berr | werr | oerr | cerr | serr; } if ( ( blocksize % width ) != 0 ) { errval |= INT_MIN | 1024; printf( "Block size %lu is not even multiple of edit width %lu.\n", blocksize, width ); } if ( ( errval >= 0 ) && ( argc > 3 ) ) { if ( strcmp( argv[ 1 ], kTo_ScreenStr ) == 0 ) { direction = TO_SCREEN; } else if ( strcmp( argv[ 1 ], kTo_EOLN_textStr ) == 0 ) { direction = TO_EOLN_TEXT; } if ( direction != 0 ) { if ( strcmp( argv[ 2 ], "--" ) != 0 ) { input = fopen( argv[ 2 ], "rb" ); } if ( input == NULL ) { fprintf( stderr, "Error opening file <%s> for input.\n", argv[ 2 ] ); direction |= INT_MIN | 4; } if ( strcmp( argv[ 3 ], "--" ) != 0 ) { output = fopen( argv[ 3 ], "r+b" ); } if ( output == NULL ) { fprintf( stderr, "Error opening file <%s> for output.\n", argv[ 3 ] ); fclose( input ); direction |= INT_MIN | 8; } if ( ( buffer = malloc( blocksize + kBufferPlay * ( blocksize / width ) ) ) == NULL ) { fprintf( stderr, "Buffer allocation failure\n" ); direction |= INT_MIN | 16; } } } if ( direction < -1 ) { fprintf( stderr, "*** %s quitting. ***\n", argv[ 0 ] ); return EXIT_FAILURE; } else if ( direction == 0 ) { puts( "usage:" ); printf( "\t%s %s <infile> <outfile> [ %s=<block-size> ] [ %s=<width> ] [ %s=<offset> ] [ %s=<count> ]\n", argv[ 0 ], kTo_ScreenStr, kBlockSizeStr, kBlockWidthStr, kBlockOffsetStr, kBlockCountStr ); printf( "\t%s %s <infile> <outfile> [ %s=<block-size> ] [ %s=<width> ] [ %s=<offset> ] [ %s=<count> ] [ %s={0|1} ]\n", argv[ 0 ], kTo_EOLN_textStr, kBlockSizeStr, kBlockWidthStr, kBlockOffsetStr, kBlockCountStr, kSuppressEndLinesStr ); printf( "** Default block size is %d, compatible with Forth SCREENs.\n", kScreenSize ); printf( "** Default width is %d, compatible with Color Computer 1 & 2 text display.\n", kScreenWidth ); printf( "** Default count is length of input file.\n" ); printf( "** %s=1 to suppress trailing blank lines in SCREEN, default 0.\n", kSuppressEndLinesStr ); printf( "** 0xhexadecimal and 0octal permitted for size, etc.\n" ); printf( "** Replace <file> with -- for stdfiles in pipes\n" ); /* printf( "\t%s --to-image <filename> <imagename> <offset>\n", argv[ 0 ] ); */ return EXIT_SUCCESS; } switch ( direction ) { case TO_SCREEN: toScreens( input, output, buffer, blocksize, width, offset, count ); break; case TO_EOLN_TEXT: toEOLNtext( input, output, buffer, blocksize, width, offset, count, suppressEndLines ); break; } if ( buffer != NULL ) free( buffer ); if ( output != stdout ) fclose( output ); if ( input != stdin ) fclose( input ); return EXIT_SUCCESS; }
\ No newline at end of file
--- /dev/null
+++ b/testsource/rs_sieve_bif.fs
@@ -0,0 +1,60 @@
1+( from rosetta code )
2+: prime? ( n -- ? )
3+ HERE + C@ 0= ;
4+
5+: composite! ( n -- )
6+ HERE + 1 SWAP C! ;
7+
8+( : 2dup OVER OVER ; )
9+
10+: showPrimes
11+ ." Primes: "
12+ 2 DO I prime?
13+ IF I . ENDIF
14+ LOOP ;
15+
16+: countPrimes
17+ ." Prime count: "
18+ 0 SWAP
19+ 2 DO I prime?
20+ IF 1+ ENDIF
21+ LOOP
22+ . ;
23+
24+-->
25+
26+
27+
28+
29+
30+
31+
32+
33+
34+: sieve ( n -- )
35+ HERE OVER ERASE
36+ 2
37+ BEGIN
38+ 2dup DUP * >
39+ WHILE
40+ DUP prime? IF
41+ 2dup DUP * DO
42+ I composite!
43+ DUP +LOOP
44+ ENDIF
45+ 1+
46+ REPEAT
47+ DROP
48+ ;
49+
50+
51+100 sieve
52+
53+dup
54+
55+showPrimes
56+
57+countPrimes
58+
59+
60+
--- /dev/null
+++ b/testsource/sievefig.bif6809
@@ -0,0 +1,154 @@
1+( Archetypical implementation )
2+( of the sieve of eratosthenes )
3+( in FORTH -- fig, bif-c -- )
4+( using more )
5+( of the FORTH idiom. )
6+( Copyright 2015, 2019,
7+( Joel Matthew Rees )
8+( By Joel Matthew Rees, )
9+( Amagasaki, Japan, 2015 )
10+( All rights reserved. )
11+( Permission granted by the )
12+( author to use this code )
13+( for any purpose, )
14+( on condition that )
15+( substantial use )
16+( shall retain this copyright )
17+( and permission notice. )
18+
19+
20+
21+VOCABULARY sieve-local
22+( Make a local symbol table. )
23+sieve-local DEFINITIONS
24+( Switch to the )
25+( local vocabulary. )
26+
27+
28+256 CONSTANT MAXSIEVE
29+MAXSIEVE 1 - 2 /
30+ CONSTANT FINALPASS
31+ -->
32+
33+
34+5 CONSTANT DISPWIDTH
35+( enough digits )
36+( to display MAXSIEVE )
37+
38+
39+0 VARIABLE sieve
40+( Old FORTHs don't provide a )
41+( default behavior for CREATE )
42+( gforth will leave )
43+( the zero there. )
44+( Old FORTHs need )
45+( an initial value. )
46+
47+ HERE sieve - DUP
48+( Old FORTHs don't provide )
49+( a CELL width. )
50+ MAXSIEVE SWAP - ALLOT
51+( Allocate the rest )
52+( of the byte array. )
53+
54+ CONSTANT CELLWIDTH
55+( To show how it can be done. )
56+
57+ -->
58+
59+
60+
61+
62+
63+
64+
65+
66+: sieveInit ( -- adr )
67+0 sieve C!
68+( 0 is not prime. )
69+0 sieve 1+ C!
70+( 1 is not prime. )
71+sieve MAXSIEVE 2 DO
72+( set flags to true )
73+( for 2 to FINALPASS. )
74+ -1 OVER I + C! LOOP
75+( sieve pointer -- )
76+( still on stack. )
77+;
78+
79+ -->
80+
81+
82+
83+
84+
85+
86+
87+
88+
89+
90+
91+
92+
93+
94+
95+
96+
97+
98+: primePass ( adr prime -- adr )
99+MAXSIEVE OVER DUP + DO
100+( start at first multiple )
101+( -- double. )
102+ OVER I + 0 SWAP C!
103+( clear at this multiple. )
104+ DUP +LOOP
105+( next multiple )
106+DROP ;
107+( sieve address still )
108+( on stack. )
109+
110+: findPrimes ( adr -- adr )
111+FINALPASS 2 DO
112+( clear flags )
113+( at all multiples. )
114+ DUP I + C@ IF
115+( don't bother if not prime. )
116+ I primePass
117+ ENDIF
118+LOOP ;
119+( sieve still on stack. )
120+
121+
122+-->
123+
124+
125+
126+
127+
128+
129+
130+
131+
132+
133+
134+: printPrimes ( adr -- )
135+MAXSIEVE 0 DO
136+ I DISPWIDTH .R ." : is "
137+ DUP I + C@ 0= IF
138+ ." not "
139+ ENDIF
140+ ." prime." CR
141+LOOP DROP ;
142+
143+
144+FORTH DEFINITIONS
145+
146+: sieveMain ( -- )
147+[ sieve-local ] sieveInit
148+findPrimes
149+printPrimes ;
150+
151+
152+sieveMain
153+
154+
--- /dev/null
+++ b/testsource/sievegforth.bif6809
@@ -0,0 +1,67 @@
1+( Archetypical implementation )
2+( of the sieve of eratosthenes )
3+( in FORTH -- BIF-6809 -- )
4+( Copyright 2015, 2019, )
5+( Joel Matthew Rees )
6+( Written by Joel Mathew Rees, )
7+( Amagasaki, Japan, 2015, 2019 )
8+( All rights reserved. )
9+( Permission granted by the )
10+( author to use this code )
11+( for any purpose, )
12+( on condition that )
13+( substantial use )
14+( shall retain this copyright )
15+( and permission notice. )
16+
17+256 constant MAXSIEVE
18+MAXSIEVE 1- 2 /
19+ constant FINALPASS
20+
21+5 constant DISPWIDTH
22+( enough digits )
23+( to display MAXSIEVE )
24+
25+create sieve MAXSIEVE allot
26+
27+ -->
28+
29+
30+
31+
32+: sieveMain ( -- )
33+0 sieve c!
34+( 0 is not prime. )
35+0 sieve 1+ c!
36+( 1 is not prime. )
37+sieve MAXSIEVE 2 do
38+( set flags to true )
39+( for 2 to FINALPASS. )
40+ -1 over i + c! loop
41+( sieve ptr still on stack. )
42+FINALPASS 2 do
43+( clear flags at multiples. )
44+ dup i + c@ if
45+( don't bother if not prime. )
46+ MAXSIEVE i dup + ?do
47+( start at first multiple )
48+( -- double. )
49+ 0 over i + c!
50+( clear at this multiple. )
51+ j +loop
52+( sieve still on stack. )
53+ then
54+loop ( sieve still on stack. )
55+MAXSIEVE 0 do
56+ i DISPWIDTH .r ." : is "
57+ dup i + c@ 0= if
58+ ." not "
59+ then
60+ ." prime." cr
61+loop drop ;
62+ -->
63+
64+
65+sieveMain
66+
67+
旧リポジトリブラウザで表示