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

diff --git a/bif-img.c b/bif-img.c
index 8e6f54c..5848de0 100644 (file)
--- a/bif-img.c
+++ b/bif-img.c
@@ -1 +1 @@
-/* Tool for working with BIF-6809 images.\r// Written by Joel Matthew Rees, Amagasaki, Japan, April 2019,\r// Parts adapted from the author's 32col.c, written 1999.\r// Copyright 1999, 2019, Joel Matthew Rees.\r// Permission granted in advance for all uses\r// with the condition that this copyright and permission notice are retained.\r//\r// BIF-6809 project page: https://osdn.net/projects/bif-6809/\r*/\r\r#include <limits.h>\r#include <stdio.h>\r#include <stdlib.h>  /* for EXIT_SUCCESS */\r#include <string.h>\r#include <ctype.h>\r\r\r#define ScreenSize 1024\r#define ScreenWidth 32\r#define ScreenHeight ( ScreenSize / ScreenWidth )\r#define BufferPlay 3  /* room for CR/LF and NUL */\r#define BufferWidth ( ScreenWidth + BufferPlay ) \r\r\r#define TO_SCREEN 1\rconst char kTo_ScreenStr[] = "--to-screens";\r#define TO_EOLN_TEXT 2\rconst char kTo_EOLN_textStr[] = "--to-eoln-text";\r\rconst char kBlockSizeStr[] = "-size";\rconst char kBlockWidthStr[] = "-width";\rconst char kBlockOffsetStr[] = "-off";\rconst char kBlockCountStr[] = "-count";\rconst char kSuppressEndLinesStr[] = "-suppressEndLines";\r\rvoid toEOLNtext( FILE * input, FILE * output, char * buffer /* Must have room for BufferPlay extra bytes per line. */,\r                 unsigned blocksize, unsigned width, unsigned offset, unsigned count,\r                 int suppressEndLines /*, int linecountflag */ )\r{\r  unsigned long start = blocksize * offset;\r  unsigned long bytecount = blocksize * count;\r  unsigned long totalBytes = 0;\r\r/* dbg */ fprintf( stderr, "size: %u; width: %u; off: %u; count: %u\n", blocksize, width, offset, count ); \r\r  if ( start > 0 )\r  { fseek( input, start, SEEK_SET );\r  }\r  while ( !feof( input ) && ( totalBytes < bytecount ) )\r  {\r    int lineCount;\r    for ( lineCount = 0; lineCount < ScreenHeight && !feof( input ); ++lineCount )\r    {\r      char * linestart = buffer + lineCount * ( width + BufferPlay );\r      int length = fread( linestart, sizeof (char), width, input );\r      totalBytes += length;\r      while ( --length >= 0 \r          && ( isspace( linestart[ length ] ) \r             || !isprint( linestart[ length ] ) ) )\r        /* "empty" loop */;\r      linestart[ ++length ] = '\0';\r    }\r    if ( lineCount > 1 \r       || ( lineCount == 1 && buffer[ 0 ] != '\0' ) )\r    {\r      int line = 0;\r      if ( suppressEndLines )\r      { while ( --lineCount > 0 && buffer[ lineCount * ( width + BufferPlay ) ] == '\0' ) \r          { /* "empty" loop: note tested NUL is first character of line. */ }\r      }\r      else \r      { --lineCount;\r      }\r      for ( line = 0; line <= lineCount; ++line ) /* End condition intentional! */\r      { fputs( buffer + line * ( width + BufferPlay ), output );\r        fputc( '\n', output );\r      }\r      /* fputc( '\f', output ); This is not useful. */\r    }\r  }\r}\r\r\r#define FILE_START 0x200       /* beyond char range. */\r#define LINE_START 0x400       /* beyond char range. */\r\r\rvoid toScreens( FILE * input, FILE * output, char * bugffer /* Must have room for BufferPlay extra bytes per line. */,\r                 unsigned blocksize, unsigned width, unsigned offset, unsigned count\r                 /*, int linecountflag */ )\r{\r  char buffer[ ScreenHeight ][ BufferWidth ];\r\r  int eolFlag = FILE_START;\r  while ( !feof( input ) )\r  {\r    int lineCount;\r    for ( lineCount = 0; lineCount < ScreenHeight; ++lineCount )\r    {\r      int length = 0;\r      char * line = buffer[ lineCount ];\r      int ch = LINE_START;\r      while ( ( length < ScreenWidth ) && !feof( input ) )\r      { ch = fgetc( input );\r        if ( ( length == 0 )\r              && ( ( ( ch == '\r' ) && ( eolFlag == '\n' ) )\r                   || ( ( ch == '\n' ) && ( eolFlag == '\r' ) ) )\r           )\r        { ch = fgetc( input );\r        }\r        eolFlag = ch;\r        if ( ( ch == '\n' ) || ( ch == '\r' ) || feof( input ) )\r        { break;    /* The habit is to set a NUL, but not for SCREENs. */\r        }\r        line[ length++ ] = ch;\r/* dbg * / putchar( ch ); */\r      }\r/* dbg * / printf( "||end:%d:", length ); */\r      while ( length < ScreenWidth )\r      { line[ length++ ] = ' ';\r/* dbg * / putchar( '*' );*/\r      }\r/* dbg * / printf( "||:%d:%d\n", length, lineCount ); */\r    }\r/* dbg * / printf( "<<screen:%d:>>\n", lineCount ); */\r    if ( lineCount > 0 )\r    { int line = 0;\r      for ( line = 0; line < lineCount; ++line )\r      { fwrite( buffer[ line ], sizeof (char), ScreenWidth, output ); \r      }\r    }\r  }\r}\r\r\rint getNumericParameter( const char parameter[], char * argstr,\r                         unsigned long * rval, long low, unsigned long high )\r{\r  char * scanpt = argstr;\r  unsigned long result = 0;\r  size_t eqpt = strlen( parameter );\r  if ( strncmp( parameter, argstr, eqpt ) == 0 ) \r  {\r    if ( argstr[ eqpt ] != '=' )\r    { printf( "\t%s needs '=' in '%s', ", parameter, argstr );\r      return INT_MIN | 16;\r    }\r    ++eqpt;\r    scanpt += eqpt;\r    result = strtoul( scanpt, &scanpt, 0 );\r    if ( scanpt <= argstr + eqpt )\r    { printf( "\tBad %s value specified in '%s'\n,", parameter, argstr );\r      return INT_MIN | 32;\r    }\r    if ( ( result < low ) || ( result > high ) )\r    { fprintf( stderr, "\t%s value %lu out of range in '%s', try %lu\n,", parameter, result, argstr, * rval );\r      return INT_MIN | 64;\r    }\r    * rval = result;\r    return 1;\r  }\r  return 0;\r}\r\r\rint main(int argc, char * argv[] )\r{\r  FILE * input = stdin;\r  FILE * output = stdout;\r  char * buffer = NULL;\r  int direction = 0;\r  int errval = 0;\r  unsigned long blocksize = ScreenSize;\r  unsigned long width = ScreenWidth;\r  unsigned long offset = 0;\r  unsigned long count = UINT_MAX;\r  unsigned long suppressEndLines = 0;\r  int i;\r\r  for ( i = 4; i < argc; ++i )\r  { int berr = 0;\r    int werr = 0;\r    int oerr = 0;\r    int cerr = 0;\r    int serr = 0;\r    if ( ( ( berr |= getNumericParameter( kBlockSizeStr, argv[ i ], &blocksize, 1, 0x8000UL ) ) > 0 )\r         || ( ( werr |= getNumericParameter( kBlockWidthStr, argv[ i ], &width, 1, 1024 ) ) > 0 )\r         || ( ( oerr |= getNumericParameter( kBlockOffsetStr, argv[ i ], &offset, 0, USHRT_MAX ) ) > 0 )\r         || ( ( cerr |= getNumericParameter( kBlockCountStr, argv[ i ], &count, 1, USHRT_MAX ) ) > 0 ) \r         || ( ( serr |= getNumericParameter( kSuppressEndLinesStr, argv[ i ], &suppressEndLines, 0, 1 ) ) > 0 ) \r       )\r    { /* empty */ }\r    else\r    { printf( "\tUnrecognized %s\n", argv[ i ] ); /* This isn't firing for gobbledygook. */\r    }\r    errval |= berr | werr | oerr | cerr | serr;\r  }\r  if ( ( blocksize % width ) != 0 )\r  {\r    errval |= INT_MIN | 1024;\r    printf( "Block size %lu is not even multiple of edit width %lu.\n", blocksize, width );\r  }\r  if ( ( errval >= 0 ) && ( argc > 3 ) )\r  {\r    if ( strcmp( argv[ 1 ], kTo_ScreenStr ) == 0 )\r    {\r      direction = TO_SCREEN;\r    }\r    else if ( strcmp( argv[ 1 ], kTo_EOLN_textStr ) == 0 )\r    {\r      direction = TO_EOLN_TEXT;\r    }\r    if ( direction != 0 )\r    {\r      if ( strcmp( argv[ 2 ], "--" ) != 0 )\r      {\r        input = fopen( argv[ 2 ], "rb" );\r      }\r      if ( input == NULL )\r      {\r        fprintf( stderr, "Error opening file <%s> for input.\n", argv[ 2 ] );\r        direction |= INT_MIN | 4;\r      }\r      if ( strcmp( argv[ 3 ], "--" ) != 0 )\r      {\r        output = fopen( argv[ 3 ], "wb" );\r      }\r      if ( output == NULL )\r      {\r        fprintf( stderr, "Error opening file <%s> for output.\n", argv[ 3 ] );\r        fclose( input );\r        direction |= INT_MIN | 8;\r      }\r      if ( ( buffer = malloc( blocksize + BufferPlay * ( blocksize / width ) ) ) == NULL )\r      { fprintf( stderr, "Buffer allocation failure\n" );\r        direction |= INT_MIN | 16;\r      }\r    }\r  }\r  if ( direction < -1 )\r  {\r    fprintf( stderr, "*** %s quitting. ***\n", argv[ 0 ] );\r    return EXIT_FAILURE;\r  }\r  else if ( direction == 0 )\r  {\r    puts( "usage:" );\r    printf( "\t%s %s <infile> <outfile>\n", argv[ 0 ], kTo_ScreenStr );\r    printf( "\t%s %s <infile> <outfile> [ %s=<block-size> ] [ %s=<width> ] [ %s=<offset> ] [ %s=<count> ] [ %s={0|1} ]\n", \r            argv[ 0 ], kTo_EOLN_textStr, kBlockSizeStr, kBlockWidthStr, kBlockOffsetStr, kBlockCountStr, kSuppressEndLinesStr );\r    printf( "** Default block size is %d, compatible with Forth SCREENs.\n", ScreenSize );\r    printf( "** Default width is %d, compatible with Color Computer 1 & 2 text display.\n", ScreenWidth );\r    printf( "** Default count is length of input file.\n" );\r    printf( "** %s=1 to suppress trailing blank lines in SCREEN, default 0.\n", kSuppressEndLinesStr );\r    printf( "** 0xhexadecimal and 0octal permitted for size, etc.\n" );\r    printf( "** Replace <file> with -- for stdfiles in pipes\n" );\r    /* printf( "\t%s --to-image <filename> <imagename> <offset>\n", argv[ 0 ] ); */\r    return EXIT_SUCCESS;\r  }\r\r  switch ( direction )\r  {\r  case TO_SCREEN:\r    toScreens( input, output, buffer, blocksize, width, offset, count );\r    break;\r  case TO_EOLN_TEXT:\r    toEOLNtext( input, output, buffer, blocksize, width, offset, count, suppressEndLines );\r    break;\r  }\r\r  return EXIT_SUCCESS;\r}\r\r
\ No newline at end of file
+/* Tool for working with BIF-6809 images.\r// Written by Joel Matthew Rees, Amagasaki, Japan, April 2019,\r// Parts adapted from the author's 32col.c, written 1999.\r// Copyright 1999, 2019, Joel Matthew Rees.\r// Permission granted in advance for all uses\r// with the condition that this copyright and permission notice are retained.\r//\r// BIF-6809 project page: https://osdn.net/projects/bif-6809/\r*/\r\r#include <limits.h>\r#include <stdio.h>\r#include <stdlib.h>  /* for EXIT_SUCCESS */\r#include <string.h>\r#include <ctype.h>\r\r\r#define kScreenSize 1024\r#define kScreenWidth 32\r#define kScreenHeight ( kScreenSize / kScreenWidth )\r#define kBufferPlay 3  /* room for CR/LF and NUL */\r#define kBufferWidth ( kScreenWidth + kBufferPlay ) /* Should never be used. */\r\r\r#define TO_SCREEN 1\rconst char kTo_ScreenStr[] = "--to-screens";\r#define TO_EOLN_TEXT 2\rconst char kTo_EOLN_textStr[] = "--to-eoln-text";\r\rconst char kBlockSizeStr[] = "-size";\rconst char kBlockWidthStr[] = "-width";\rconst char kBlockOffsetStr[] = "-off";\rconst char kBlockCountStr[] = "-count";\rconst char kSuppressEndLinesStr[] = "-suppressEndLines";\r\rvoid toEOLNtext( FILE * input, FILE * output, char * buffer /* Must have room for kBufferPlay extra bytes per line. */,\r                 unsigned blocksize, unsigned width, unsigned offset, unsigned count,\r                 int suppressEndLines /*, int linecountflag */ )\r{\r  unsigned long start = blocksize * offset;\r  unsigned long bytecount = blocksize * count;\r  unsigned long totalBytes = 0;\r  unsigned screenHeight = blocksize / width;\r  unsigned bufferWidth = width + kBufferPlay;\r\r/* dbg */ fprintf( stderr, "size: %u; width: %u; off: %u; count: %u\n", blocksize, width, offset, count ); \r\r  if ( start > 0 )\r  { fseek( input, start, SEEK_SET );\r  }\r  while ( !feof( input ) && ( totalBytes < bytecount ) )\r  {\r    int lineCount;\r    for ( lineCount = 0; lineCount < screenHeight && !feof( input ); ++lineCount )\r    {\r      char * linestart = buffer + lineCount * bufferWidth;\r      int length = fread( linestart, sizeof (char), width, input );\r      totalBytes += length;\r      while ( --length >= 0 \r          && ( isspace( linestart[ length ] ) \r             || !isprint( linestart[ length ] ) ) )\r        /* "empty" loop */;\r      linestart[ ++length ] = '\0';\r    }\r    if ( lineCount > 1 \r       || ( lineCount == 1 && buffer[ 0 ] != '\0' ) )\r    {\r      int line = 0;\r      if ( suppressEndLines )\r      { while ( --lineCount > 0 && buffer[ lineCount * bufferWidth ] == '\0' ) \r          { /* "empty" loop: note tested NUL is first character of line. */ }\r      }\r      else \r      { --lineCount;\r      }\r      for ( line = 0; line <= lineCount; ++line ) /* End condition intentional! */\r      { fputs( buffer + line * bufferWidth, output );\r        fputc( '\n', output );\r      }\r      /* fputc( '\f', output ); This is not useful. */\r    }\r  }\r}\r\r\r#define FILE_START 0x200        /* beyond char range. */\r#define LINE_START 0x400       /* beyond char range. */\r\r\rvoid toScreens( FILE * input, FILE * output, char * buffer /* Must have room for kBufferPlay extra bytes per line. */,\r                 unsigned blocksize, unsigned width, unsigned offset, unsigned count\r                 /*, int linecountflag */ )\r{\r  unsigned long start = blocksize * offset;\r  unsigned screenHeight = ( blocksize / width );\r  unsigned bufferWidth = width + kBufferPlay;\r  int eolFlag = FILE_START;\r\r  if ( start > 0 )\r  { fseek( output, start, SEEK_SET );\r  }\r  while ( !feof( input ) )\r  {\r    int lineCount;\r    for ( lineCount = 0; lineCount < screenHeight; ++lineCount )\r    {\r      int length = 0;\r      char * line = buffer + lineCount * bufferWidth;\r      int ch = LINE_START;\r      while ( ( length < width ) && !feof( input ) )\r      { ch = fgetc( input );\r        if ( ( length == 0 )\r              && ( ( ( ch == '\r' ) && ( eolFlag == '\n' ) )\r                   || ( ( ch == '\n' ) && ( eolFlag == '\r' ) ) )\r           )\r        { ch = fgetc( input );\r        }\r        eolFlag = ch;\r        if ( ( ch == '\n' ) || ( ch == '\r' ) || feof( input ) )\r        { break;   /* The habit is to set a NUL, but not for SCREENs. */\r        }\r        line[ length++ ] = ch;\r/* dbg */ fputc( ch, stderr ); \r      }\r/* dbg */ fprintf( stderr, "||end:%d:", length );\r      while ( length < width )\r      { line[ length++ ] = ' ';\r/* dbg */ fputc( '*', stderr );\r      }\r/* dbg */ fprintf( stderr, "||:%d:%d\n", length, lineCount );\r    }\r/* dbg */ fprintf( stderr, "<<screen:%d:>>\n", lineCount );\r    if ( lineCount > 0 )\r    { int line = 0;\r      size_t count = 0;\r      int error = 0;\r      for ( line = 0; line < lineCount; ++line )\r      { count = fwrite( buffer + line * bufferWidth, sizeof (char), width, output ); \r        if ( ( count != width ) || ( ( error = ferror( output ) ) != 0 ) )\r        { int i;\r          fprintf( stderr, "Output error=%d; count: %lu::", error, count );\r          for ( i = 0; i < width; ++i ) fputc( buffer[ line * bufferWidth + i ], stderr );\r          fputc( '\n', stderr );\r        }\r      }\r    }\r  }\r}\r\r\rint getNumericParameter( const char parameter[], char * argstr,\r                         unsigned long * rval, long low, unsigned long high )\r{\r  char * scanpt = argstr;\r  unsigned long result = 0;\r  size_t eqpt = strlen( parameter );\r  if ( strncmp( parameter, argstr, eqpt ) == 0 ) \r  {\r    if ( argstr[ eqpt ] != '=' )\r    { printf( "\t%s needs '=' in '%s', ", parameter, argstr );\r      return INT_MIN | 16;\r    }\r    ++eqpt;\r    scanpt += eqpt;\r    result = strtoul( scanpt, &scanpt, 0 );\r    if ( scanpt <= argstr + eqpt )\r    { printf( "\tBad %s value specified in '%s'\n,", parameter, argstr );\r      return INT_MIN | 32;\r    }\r    if ( ( result < low ) || ( result > high ) )\r    { fprintf( stderr, "\t%s value %lu out of range in '%s', try %lu\n,", parameter, result, argstr, * rval );\r      return INT_MIN | 64;\r    }\r    * rval = result;\r    return 1;\r  }\r  return 0;\r}\r\r\rint main(int argc, char * argv[] )\r{\r  FILE * input = stdin;\r  FILE * output = stdout;\r  char * buffer = NULL;\r  int direction = 0;\r  int errval = 0;\r  unsigned long blocksize = kScreenSize;\r  unsigned long width = kScreenWidth;\r  unsigned long offset = 0;\r  unsigned long count = UINT_MAX;\r  unsigned long suppressEndLines = 0;\r  int i;\r\r  for ( i = 4; i < argc; ++i )\r  { int berr = 0;\r    int werr = 0;\r    int oerr = 0;\r    int cerr = 0;\r    int serr = 0;\r    if ( ( ( berr |= getNumericParameter( kBlockSizeStr, argv[ i ], &blocksize, 1, 0x8000UL ) ) > 0 )\r         || ( ( werr |= getNumericParameter( kBlockWidthStr, argv[ i ], &width, 1, 1024 ) ) > 0 )\r         || ( ( oerr |= getNumericParameter( kBlockOffsetStr, argv[ i ], &offset, 0, USHRT_MAX ) ) > 0 )\r         || ( ( cerr |= getNumericParameter( kBlockCountStr, argv[ i ], &count, 1, USHRT_MAX ) ) > 0 ) \r         || ( ( serr |= getNumericParameter( kSuppressEndLinesStr, argv[ i ], &suppressEndLines, 0, 1 ) ) > 0 ) \r       )\r    { /* empty */ }\r    else\r    { printf( "\tUnrecognized %s\n", argv[ i ] ); /* This isn't firing for gobbledygook. */\r    }\r    errval |= berr | werr | oerr | cerr | serr;\r  }\r  if ( ( blocksize % width ) != 0 )\r  {\r    errval |= INT_MIN | 1024;\r    printf( "Block size %lu is not even multiple of edit width %lu.\n", blocksize, width );\r  }\r  if ( ( errval >= 0 ) && ( argc > 3 ) )\r  {\r    if ( strcmp( argv[ 1 ], kTo_ScreenStr ) == 0 )\r    {\r      direction = TO_SCREEN;\r    }\r    else if ( strcmp( argv[ 1 ], kTo_EOLN_textStr ) == 0 )\r    {\r      direction = TO_EOLN_TEXT;\r    }\r    if ( direction != 0 )\r    {\r      if ( strcmp( argv[ 2 ], "--" ) != 0 )\r      {\r        input = fopen( argv[ 2 ], "rb" );\r      }\r      if ( input == NULL )\r      {\r        fprintf( stderr, "Error opening file <%s> for input.\n", argv[ 2 ] );\r        direction |= INT_MIN | 4;\r      }\r      if ( strcmp( argv[ 3 ], "--" ) != 0 )\r      {\r        output = fopen( argv[ 3 ], "r+b" );\r      }\r      if ( output == NULL )\r      {\r        fprintf( stderr, "Error opening file <%s> for output.\n", argv[ 3 ] );\r        fclose( input );\r        direction |= INT_MIN | 8;\r      }\r      if ( ( buffer = malloc( blocksize + kBufferPlay * ( blocksize / width ) ) ) == NULL )\r      { fprintf( stderr, "Buffer allocation failure\n" );\r        direction |= INT_MIN | 16;\r      }\r    }\r  }\r  if ( direction < -1 )\r  {\r    fprintf( stderr, "*** %s quitting. ***\n", argv[ 0 ] );\r    return EXIT_FAILURE;\r  }\r  else if ( direction == 0 )\r  {\r    puts( "usage:" );\r    printf( "\t%s %s <infile> <outfile> [ %s=<block-size> ] [ %s=<width> ] [ %s=<offset> ] [ %s=<count> ]\n", \r            argv[ 0 ], kTo_ScreenStr, kBlockSizeStr, kBlockWidthStr, kBlockOffsetStr, kBlockCountStr );\r    printf( "\t%s %s <infile> <outfile> [ %s=<block-size> ] [ %s=<width> ] [ %s=<offset> ] [ %s=<count> ] [ %s={0|1} ]\n", \r            argv[ 0 ], kTo_EOLN_textStr, kBlockSizeStr, kBlockWidthStr, kBlockOffsetStr, kBlockCountStr, kSuppressEndLinesStr );\r    printf( "** Default block size is %d, compatible with Forth SCREENs.\n", kScreenSize );\r    printf( "** Default width is %d, compatible with Color Computer 1 & 2 text display.\n", kScreenWidth );\r    printf( "** Default count is length of input file.\n" );\r    printf( "** %s=1 to suppress trailing blank lines in SCREEN, default 0.\n", kSuppressEndLinesStr );\r    printf( "** 0xhexadecimal and 0octal permitted for size, etc.\n" );\r    printf( "** Replace <file> with -- for stdfiles in pipes\n" );\r    /* printf( "\t%s --to-image <filename> <imagename> <offset>\n", argv[ 0 ] ); */\r    return EXIT_SUCCESS;\r  }\r\r  switch ( direction )\r  {\r  case TO_SCREEN:\r    toScreens( input, output, buffer, blocksize, width, offset, count );\r    break;\r  case TO_EOLN_TEXT:\r    toEOLNtext( input, output, buffer, blocksize, width, offset, count, suppressEndLines );\r    break;\r  }\r  if ( buffer != NULL )\r    free( buffer );\r  if ( output != stdout )\r    fclose( output );\r  if ( input != stdin )\r    fclose( input );\r\r  return EXIT_SUCCESS;\r}\r\r
\ No newline at end of file

diff --git a/testsource/rs_sieve_bif.fs b/testsource/rs_sieve_bif.fs
new file mode 100644 (file)
index 0000000..41e0895
--- /dev/null
+++ b/testsource/rs_sieve_bif.fs
@@ -0,0 +1,60 @@
+( from rosetta code )
+: prime? ( n -- ? )
+  HERE + C@ 0= ;
+
+: composite! ( n -- )
+  HERE + 1 SWAP C! ;
+
+( : 2dup OVER OVER ; )
+
+: showPrimes
+  ." Primes: "
+  2 DO I prime?
+    IF I . ENDIF
+  LOOP ;
+
+: countPrimes
+  ." Prime count: "
+  0 SWAP
+  2 DO I prime?
+    IF 1+ ENDIF
+  LOOP
+  . ;
+
+-->
+
+
+
+
+
+
+
+
+
+: sieve ( n -- )
+  HERE OVER ERASE
+  2
+  BEGIN
+    2dup DUP * >
+  WHILE
+    DUP prime? IF
+      2dup DUP * DO
+        I composite!
+      DUP +LOOP
+    ENDIF
+    1+
+  REPEAT
+  DROP
+  ;
+
+
+100 sieve
+
+dup 
+
+showPrimes
+
+countPrimes
+
+
+

diff --git a/testsource/sievefig.bif6809 b/testsource/sievefig.bif6809
new file mode 100644 (file)
index 0000000..1320e32
--- /dev/null
+++ b/testsource/sievefig.bif6809
@@ -0,0 +1,154 @@
+( Archetypical implementation )
+( of the sieve of eratosthenes )
+( in FORTH -- fig, bif-c --  )
+( using more )
+( of the FORTH idiom. )
+( Copyright 2015, 2019,
+( Joel Matthew Rees )
+( By Joel Matthew Rees, )
+( Amagasaki, Japan, 2015 )
+( All rights reserved. )
+( Permission granted by the )
+( author to use this code )
+( for any purpose,  )
+( on condition that )
+( substantial use  )
+( shall retain this copyright )
+( and permission notice. )
+
+
+
+VOCABULARY sieve-local 
+( Make a local symbol table. )
+sieve-local DEFINITIONS 
+( Switch to the )
+( local vocabulary. )
+
+
+256 CONSTANT MAXSIEVE
+MAXSIEVE 1 - 2 /
+   CONSTANT FINALPASS
+ -->
+
+
+5 CONSTANT DISPWIDTH 
+( enough digits )
+( to display MAXSIEVE )
+
+
+0 VARIABLE sieve 
+( Old FORTHs don't provide a ) 
+( default behavior for CREATE )
+( gforth will leave )
+( the zero there. )
+( Old FORTHs need )
+( an initial value. )
+
+   HERE sieve - DUP 
+( Old FORTHs don't provide )
+( a CELL width. )
+   MAXSIEVE SWAP - ALLOT 
+( Allocate the rest )
+( of the byte array. )
+
+   CONSTANT CELLWIDTH 
+( To show how it can be done. )
+
+  -->
+
+
+
+
+
+
+
+
+: sieveInit ( -- adr )
+0 sieve C!      
+( 0 is not prime. )
+0 sieve 1+ C!   
+( 1 is not prime. )
+sieve MAXSIEVE 2 DO    
+( set flags to true )
+( for 2 to FINALPASS. )
+   -1 OVER I + C! LOOP  
+( sieve pointer -- )
+( still on stack. )
+;
+
+ -->
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+: primePass ( adr prime -- adr )
+MAXSIEVE OVER DUP + DO    
+( start at first multiple )
+(  -- double. )
+   OVER I + 0 SWAP C!     
+( clear at this multiple. )
+   DUP +LOOP              
+( next multiple )
+DROP ;      
+( sieve address still )
+( on stack. )
+
+: findPrimes ( adr -- adr )
+FINALPASS 2 DO   
+( clear flags )
+( at all multiples. )
+   DUP I + C@ IF 
+( don't bother if not prime. )
+      I primePass
+   ENDIF
+LOOP ;           
+( sieve still on stack. )
+
+
+-->
+
+
+
+
+
+
+
+
+
+
+
+: printPrimes ( adr -- )
+MAXSIEVE 0 DO
+   I DISPWIDTH .R ." : is "
+   DUP I + C@ 0= IF
+      ." not "
+   ENDIF
+   ." prime." CR
+LOOP DROP ;
+
+
+FORTH DEFINITIONS
+
+: sieveMain ( -- )
+[ sieve-local ] sieveInit
+findPrimes
+printPrimes ;
+
+
+sieveMain
+
+

diff --git a/testsource/sievegforth.bif6809 b/testsource/sievegforth.bif6809
new file mode 100644 (file)
index 0000000..88a68a5
--- /dev/null
+++ b/testsource/sievegforth.bif6809
@@ -0,0 +1,67 @@
+( Archetypical implementation )
+( of the sieve of eratosthenes )
+( in FORTH -- BIF-6809 -- )
+( Copyright 2015, 2019, )
+( Joel Matthew Rees )
+( Written by Joel Mathew Rees, )
+( Amagasaki, Japan, 2015, 2019 )
+( All rights reserved. )
+( Permission granted by the )
+( author to use this code )
+( for any purpose,  )
+( on condition that )
+( substantial use  )
+( shall retain this copyright )
+( and permission notice. )
+
+256 constant MAXSIEVE
+MAXSIEVE 1- 2 / 
+  constant FINALPASS
+
+5 constant DISPWIDTH 
+( enough digits )
+( to display MAXSIEVE )
+
+create sieve MAXSIEVE allot
+
+ -->
+
+
+
+
+: sieveMain ( -- )
+0 sieve c!      
+( 0 is not prime. )
+0 sieve 1+ c!   
+( 1 is not prime. )
+sieve MAXSIEVE 2 do    
+( set flags to true ) 
+( for 2 to FINALPASS. )
+   -1 over i + c! loop  
+( sieve ptr still on stack. ) 
+FINALPASS 2 do 
+( clear flags at multiples. )
+   dup i + c@ if      
+( don't bother if not prime. )
+      MAXSIEVE i dup + ?do    
+( start at first multiple )
+( -- double. )
+         0 over i + c!      
+( clear at this multiple. )
+      j +loop           
+( sieve still on stack. )
+   then
+loop  ( sieve still on stack. )
+MAXSIEVE 0 do
+   i DISPWIDTH .r ." : is "
+   dup i + c@ 0= if 
+      ." not " 
+   then
+   ." prime." cr
+loop drop ;
+ -->
+
+
+sieveMain
+
+